t/5-befunge/i-sos.t

   1 #!perl
   2 #
   3 # This file is part of Language::Befunge.
   4 # Copyright (c) 2001-2008 Jerome Quelin, all rights reserved.
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the same terms as Perl itself.
   8 #
   9 #
  10
  11 #----------------------------------------------#
  12 #          Stack of stack operations.          #
  13 #----------------------------------------------#
  14
  15 use strict;
  16 use Language::Befunge;
  17 use POSIX qw! tmpnam !;
  18 use Test;
  19
  20 # Vars.
  21 my $file;
  22 my $fh;
  23 my $tests;
  24 my $out;
  25 my $bef = Language::Befunge->new;
  26 BEGIN { $tests = 0 };
  27
  28 # In order to see what happens...
  29 sub sel () {
  30     $file = tmpnam();
  31     open OUT, ">$file" or die $!;
  32     $fh = select OUT;
  33 }
  34 sub slurp () {
  35     select $fh;
  36     close OUT;
  37     open OUT, "<$file" or die $!;
  38     my $content;
  39     {
  40         local $/;
  41         $content = <OUT>;
  42     }
  43     close OUT;
  44     unlink $file;
  45     return $content;
  46 }
  47
  48 # The big fat one.
  49 sel;
  50 $bef->store_code( <<'END_OF_CODE' );
  51 123 2 { ... 3 { .... 0 { 3 .. 987 01- { . 3 u ... 4 u .. v
  52 0u... 456 02- u 56 04- u 163 2 } .......   2 01-u 2 }  v >
  53 ..  4 01- u 0 } .. 004 03-u 02- } .. q                 >
  54 END_OF_CODE
  55 my $exp = "";
  56 # (6,0) { new, >0, enough
  57 #   * bef: ( [1 2 3 2] )      Storage (0,0)
  58 #   * aft: ( [2 3] [1 0 0] )  Storage (7,0)
  59 $exp .= "3 2 0 ";
  60 # (14,0) { new, >0, not enough
  61 #   * bef: ( [3] [1 0 0] )            Storage (7,0)
  62 #   * aft: ( [0 0 0] [7 0] [1 0 0] )  Storage (15,0)
  63 $exp .= "0 0 0 0 ";
  64 # (23,0) { new, =0
  65 #   * bef: ( [0] [7 0] [1 0 0] )        Storage (15,0)
  66 #   * aft: ( [] [15 0] [7 0] [1 0 0] )  Storage (24,0)
  67 $exp .= "3 0 ";
  68 # (37,0) { new, <0
  69 #   * bef: ( [9 8 7 -1] [15 0] [7 0] [1 0 0] )        Storage (24,0)
  70 #   * aft: ( [] [9 8 7 0 24 0] [15 0] [7 0] [1 0 0] ) Storage (38,0)
  71 $exp .= "0 ";
  72 # (44,0) u transfer, >0, enough
  73 #   * bef: ( [3] [9 8 7 0 24 0] [15 0] [7 0] [1 0 0] ) Storage (38,0)
  74 #   * aft: ( [0 24 0] [9 8 7] [15 0] [7 0] [1 0 0] )
  75 $exp .= "0 24 0 ";
  76 # (51,0) u transfer, >0, not enough
  77 #   * bef: ( [6] [9 8 7] [15 0] [7 0] [1 0 0] )  Storage (38,0)
  78 #   * aft: ( [7 8 9 0] [] [15 0] [7 0] [1 0 0] )
  79 $exp .= "0 9 ";
  80 # (1,1) u transfer, =0
  81 #   * bef: ( [7 8 0] [] [15 0] [7 0] [1 0 0] ) Storage (38,0)
  82 #   * aft: ( [7 8] [] [15 0] [7 0] [1 0 0] )
  83 $exp .= "8 7 0 ";
  84 # (14,1) u transfer, <0, enough
  85 #   * bef: ( [4 5 6 -2] [] [15 0] [7 0] [1 0 0] ) Storage (38,0)
  86 #   * aft: ( [4] [6 5] [15 0] [7 0] [1 0 0] )
  87 # (23,1) u transfer, <0, not enough
  88 #   * bef: ( [4 5 6 -4] [6 5] [15 0] [7 0] [1 0 0] ) Storage (38,0)
  89 #   * aft: ( [] [6 5 6 5 4 0] [15 0] [7 0] [1 0 0] )
  90 # (31,1) } destroy, >0, enough
  91 #   * bef: ( [1 6 3 2] [6 5 6 5 4 0] [15 0] [7 0] [1 0 0] ) Storage (38,0)
  92 #   * aft: ( [6 5 6 5 6 3] [15 0] [7 0] [1 0 0] )           Storage (4,0)
  93 $exp .= "3 6 5 6 5 6 0 ";
  94 # (52,1) } destroy, >0, not enough
  95 #   * bef: ( [2] [15 0 2] [7 0] [1 0 0] ) Storage (4,0)
  96 #   * aft: ( [] [7 0] [1 0 0] )         Storage (0,2)
  97 $exp .= "0 0 ";
  98 # (14,2) } destroy, =0
  99 #   * bef: ( [0] [7 0 4] [1 0 0] ) Storage (0,2)
 100 #   * aft: ( [7] [1 0 0] )         Storage (0,4)
 101 $exp .= "7 0 ";
 102 # (32,2) } destroy, <0
 103 #   * bef: ( [-2] [1 0 0 4 0 0] ) Storage (0,4)
 104 #   * aft: ( [1 0] )          Storage (0,0)
 105 $exp .= "0 1 ";
 106 $bef->run_code;
 107 $out = slurp;
 108 ok( $out, $exp );
 109 BEGIN { $tests += 1 };
 110
 111 # Checking storage offset.
 112 sel; # New storage offset.
 113 $bef->store_code( <<'END_OF_CODE' );
 114 0      {  01+a*1+a*8+ 11p v
 115     q.2                   <
 116          >  1.q
 117 END_OF_CODE
 118 $bef->run_code;
 119 $out = slurp;
 120 ok( $out, "1 " );
 121 sel; # Retrieving old storage offset.
 122 $bef->store_code( <<'END_OF_CODE' );
 123 0      { 22+ 0 } 01+a*1+a*8+ 61p v
 124  q.2                             <
 125       >  1.q
 126 END_OF_CODE
 127 $bef->run_code;
 128 $out = slurp;
 129 ok( $out, "1 " );
 130 BEGIN { $tests += 2 };
 131
 132 # Checking non-valid end-of-block.
 133 sel; # Retrieving old storage offset.
 134 $bef->store_code( <<'END_OF_CODE' );
 135    #v  } 2.q
 136     > 1.q
 137 END_OF_CODE
 138 $bef->run_code;
 139 $out = slurp;
 140 ok( $out, "1 " );
 141 BEGIN { $tests += 1};
 142
 143
 144 BEGIN { plan tests => $tests };
 145