t/14flow.t

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