t/5-befunge/e-flow.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 #          Flow control.          #
  13 #---------------------------------#
  14
  15 use strict;
  16 use Language::Befunge;
  17 use Language::Befunge::IP;
  18 use Language::Befunge::Vector;
  19 use POSIX qw! tmpnam !;
  20 use Test;
  21
  22 # Vars.
  23 my $file;
  24 my $fh;
  25 my $tests;
  26 my $out;
  27 my $bef = Language::Befunge->new;
  28 BEGIN { $tests = 0 };
  29
  30 # In order to see what happens...
  31 sub sel () {
  32     $file = tmpnam();
  33     open OUT, ">$file" or die $!;
  34     $fh = select OUT;
  35 }
  36 sub slurp () {
  37     select $fh;
  38     close OUT;
  39     open OUT, "<$file" or die $!;
  40     my $content;
  41     {
  42         local $/;
  43         $content = <OUT>;
  44     }
  45     close OUT;
  46     unlink $file;
  47     return $content;
  48 }
  49
  50 # Space is a no-op.
  51 sel;
  52 $bef->store_code( <<'END_OF_CODE' );
  53    f   f  +     7       +  ,   q
  54 END_OF_CODE
  55 $bef->run_code;
  56 $out = slurp;
  57 ok( $out, "%" );
  58 BEGIN { $tests += 1 };
  59
  60 # z is a true no-op.
  61 sel;
  62 $bef->store_code( <<'END_OF_CODE' );
  63 zzzfzzzfzz+zzzzz7zzzzzzz+zz,zzzq
  64 END_OF_CODE
  65 $bef->run_code;
  66 $out = slurp;
  67 ok( $out, "%" );
  68 BEGIN { $tests += 1 };
  69
  70 # Trampoline.
  71 sel;
  72 $bef->store_code( <<'END_OF_CODE' );
  73 1#2.q
  74 END_OF_CODE
  75 $bef->run_code;
  76 $out = slurp;
  77 ok( $out, "1 " );
  78 BEGIN { $tests += 1 };
  79
  80 # Stop.
  81 sel;
  82 $bef->store_code( <<'END_OF_CODE' );
  83 1.@
  84 END_OF_CODE
  85 $bef->run_code;
  86 $out = slurp;
  87 ok( $out, "1 " );
  88 BEGIN { $tests += 1 };
  89
  90 # Comments / Jump over.
  91 sel;
  92 $bef->store_code( <<'END_OF_CODE' );
  93 2;this is a comment;1+.@
  94 END_OF_CODE
  95 $bef->run_code;
  96 $out = slurp;
  97 ok( $out, "3 " );
  98 BEGIN { $tests += 1 };
  99
 100 # Jump to.
 101 sel; # Positive.
 102 $bef->store_code( <<'END_OF_CODE' );
 103 2j123..q
 104 END_OF_CODE
 105 $bef->run_code;
 106 $out = slurp;
 107 ok( $out, "3 0 " );
 108 sel; # Null.
 109 $bef->store_code( <<'END_OF_CODE' );
 110 0j1.q
 111 END_OF_CODE
 112 $bef->run_code;
 113 $out = slurp;
 114 ok( $out, "1 " );
 115 sel; # Negative.
 116 $bef->store_code( <<'END_OF_CODE' );
 117 v   q.1 <>06-j2.q
 118 >        ^
 119 END_OF_CODE
 120 $bef->run_code;
 121 $out = slurp;
 122 ok( $out, "1 " );
 123 BEGIN { $tests += 3 };
 124
 125 # Quit instruction.
 126 sel;
 127 $bef->store_code( <<'END_OF_CODE' );
 128 af.q
 129 END_OF_CODE
 130 my $rv = $bef->run_code;
 131 $out = slurp;
 132 ok( $out, "15 " );
 133 ok( $rv, 10 );
 134 BEGIN { $tests += 2 };
 135
 136 # Repeat instruction (glurps).
 137 sel; # normal repeat.
 138 $bef->store_code( <<'END_OF_CODE' );
 139 3572k.q
 140 END_OF_CODE
 141 $bef->run_code;
 142 $out = slurp;
 143 ok( $out, "7 5 3 " );
 144 sel; # null repeat.
 145 $bef->store_code( <<'END_OF_CODE' );
 146 0k.q
 147 END_OF_CODE
 148 $bef->run_code;
 149 $out = slurp;
 150 ok( $out, "" );
 151 sel; # useless repeat.
 152 $bef->store_code( <<'END_OF_CODE' );
 153 5kv
 154  > 1.q
 155   >2.q
 156 END_OF_CODE
 157 $bef->run_code;
 158 $out = slurp;
 159 ok( $out, "1 " );
 160 sel; # repeat negative.
 161 $bef->store_code( <<'END_OF_CODE' );
 162 5-k43.q
 163 END_OF_CODE
 164 eval { $bef->run_code; };
 165 $out = slurp;
 166 ok( $out, "3 " );
 167 sel; # repeat forbidden char.
 168 $bef->store_code( <<'END_OF_CODE' );
 169 5k;q
 170 END_OF_CODE
 171 eval { $bef->run_code; };
 172 $out = slurp;
 173 ok( $out eq '' );
 174 sel; # repeat repeat.
 175 $bef->store_code( <<'END_OF_CODE' );
 176 5kkq
 177 END_OF_CODE
 178 eval { $bef->run_code; };
 179 $out = slurp;
 180 ok( $out eq '' );
 181 sel; # move_ip() short circuits on a dead end
 182 $bef->store_code( <<'END_OF_CODE' );
 183
 184 END_OF_CODE
 185 $bef->set_curip( Language::Befunge::IP->new );
 186 $bef->get_curip->set_position( Language::Befunge::Vector->new_zeroes(2) );
 187 eval {
 188     local $SIG{ALRM} = sub { die "timeout\n" };
 189     alarm 10;
 190     $bef->move_ip($bef->get_curip, qr/ /);
 191     alarm 0;
 192 };
 193 $out = slurp;
 194 ok( $@, qr/infinite loop/ );
 195 BEGIN { $tests += 7 };
 196
 197
 198
 199 BEGIN { plan tests => $tests };
 200