t/befunge/d-dir.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 #          Direction changing.          #
  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 # Go west.
  49 sel;
  50 $bef->store_code( <<'END_OF_CODE' );
  51 <q.a
  52 END_OF_CODE
  53 $bef->run_code;
  54 $out = slurp;
  55 ok( $out, "10 " );
  56 BEGIN { $tests += 1 };
  57
  58 # Go south.
  59 sel;
  60 $bef->store_code( <<'END_OF_CODE' );
  61 v
  62 a
  63 .
  64 q
  65 END_OF_CODE
  66 $bef->run_code;
  67 $out = slurp;
  68 ok( $out, "10 " );
  69 BEGIN { $tests += 1 };
  70
  71 # Go north.
  72 sel;
  73 $bef->store_code( <<'END_OF_CODE' );
  74 ^
  75 q
  76 .
  77 a
  78 END_OF_CODE
  79 $bef->run_code;
  80 $out = slurp;
  81 ok( $out, "10 " );
  82 BEGIN { $tests += 1 };
  83
  84 # Go east.
  85 sel;
  86 $bef->store_code( <<'END_OF_CODE' );
  87 v   > a . q
  88 >   ^
  89 END_OF_CODE
  90 $bef->run_code;
  91 $out = slurp;
  92 ok( $out, "10 " );
  93 BEGIN { $tests += 1 };
  94
  95 # Go away.
  96 sel;
  97 $bef->store_code( <<'END_OF_CODE' );
  98 v    > 2.q
  99 >  #v? 1.q
 100      > 3.q
 101     >  4.q
 102 END_OF_CODE
 103 $bef->run_code;
 104 $out = slurp;
 105 ok( $out, qr/^[1-4] $/ );
 106 BEGIN { $tests += 1 };
 107
 108 # Turn left.
 109 sel; # from west.
 110 $bef->store_code( <<'END_OF_CODE' );
 111 v  > 1.q
 112 >  [
 113    > 2.q
 114 END_OF_CODE
 115 $bef->run_code;
 116 $out = slurp;
 117 ok( $out, "1 " );
 118 sel; # from east.
 119 $bef->store_code( <<'END_OF_CODE' );
 120 v  > 1.q
 121 <  [
 122    > 2.q
 123 END_OF_CODE
 124 $bef->run_code;
 125 $out = slurp;
 126 ok( $out, "2 " );
 127 sel; # from north.
 128 $bef->store_code( <<'END_OF_CODE' );
 129 >     v
 130   q.2 [ 1.q
 131 END_OF_CODE
 132 $bef->run_code;
 133 $out = slurp;
 134 ok( $out, "1 " );
 135 sel; # from south.
 136 $bef->store_code( <<'END_OF_CODE' );
 137 >     ^
 138   q.2 [ 1.q
 139 END_OF_CODE
 140 $bef->run_code;
 141 $out = slurp;
 142 ok( $out, "2 " );
 143 BEGIN { $tests += 4 };
 144
 145 # Turn right.
 146 sel; # from west.
 147 $bef->store_code( <<'END_OF_CODE' );
 148 v  > 1.q
 149 >  ]
 150    > 2.q
 151 END_OF_CODE
 152 $bef->run_code;
 153 $out = slurp;
 154 ok( $out, "2 " );
 155 sel; # from east.
 156 $bef->store_code( <<'END_OF_CODE' );
 157 v  > 1.q
 158 <  ]
 159    > 2.q
 160 END_OF_CODE
 161 $bef->run_code;
 162 $out = slurp;
 163 ok( $out, "1 " );
 164 sel; # from north.
 165 $bef->store_code( <<'END_OF_CODE' );
 166 >     v
 167   q.2 ] 1.q
 168 END_OF_CODE
 169 $bef->run_code;
 170 $out = slurp;
 171 ok( $out, "2 " );
 172 sel; # from south.
 173 $bef->store_code( <<'END_OF_CODE' );
 174 >     ^
 175   q.2 ] 1.q
 176 END_OF_CODE
 177 $bef->run_code;
 178 $out = slurp;
 179 ok( $out, "1 " );
 180 BEGIN { $tests += 4 };
 181
 182 # Reverse.
 183 sel; # from west.
 184 $bef->store_code( <<'END_OF_CODE' );
 185 >  #vr 2.q
 186     >  1.q
 187 END_OF_CODE
 188 $bef->run_code;
 189 $out = slurp;
 190 ok( $out, "1 " );
 191 sel; # from east.
 192 $bef->store_code( <<'END_OF_CODE' );
 193 <  q.2  rv#
 194    q.1   <
 195 END_OF_CODE
 196 $bef->run_code;
 197 $out = slurp;
 198 ok( $out, "1 " );
 199 sel; # from north.
 200 $bef->store_code( <<'END_OF_CODE' );
 201 >     v
 202       #
 203       > 1.q
 204       r
 205       > 2.q
 206 END_OF_CODE
 207 $bef->run_code;
 208 $out = slurp;
 209 ok( $out, "1 " );
 210 sel; # from south.
 211 $bef->store_code( <<'END_OF_CODE' );
 212 >     ^
 213       > 2.q
 214       r
 215       > 1.q
 216       #
 217 END_OF_CODE
 218 $bef->run_code;
 219 $out = slurp;
 220 ok( $out, "1 " );
 221 BEGIN { $tests += 4 };
 222
 223 # Absolute vector.
 224 sel; # diagonal.
 225 $bef->store_code( <<'END_OF_CODE' );
 226 11x
 227    1
 228     .
 229      q
 230 END_OF_CODE
 231 $bef->run_code;
 232 $out = slurp;
 233 ok( $out, "1 " );
 234 sel; # diagonal/out-of-bounds.
 235 $bef->store_code( <<'END_OF_CODE' );
 236 101-x
 237    q
 238   .
 239  1
 240 END_OF_CODE
 241 $bef->run_code;
 242 $out = slurp;
 243 ok( $out, "1 " );
 244 BEGIN { $tests += 2 };
 245
 246
 247 BEGIN { plan tests => $tests };
 248