t/befunge/f-decis.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 #          Decision making instructions.          #
  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 # Logical not.
  49 sel; # true.
  50 $bef->store_code( <<'END_OF_CODE' );
  51 a!.q
  52 END_OF_CODE
  53 $bef->run_code;
  54 $out = slurp;
  55 ok( $out, "0 " );
  56 sel; # negative.
  57 $bef->store_code( <<'END_OF_CODE' );
  58 05-!.q
  59 END_OF_CODE
  60 $bef->run_code;
  61 $out = slurp;
  62 ok( $out, "0 " );
  63 sel; # false.
  64 $bef->store_code( <<'END_OF_CODE' );
  65 0!.q
  66 END_OF_CODE
  67 $bef->run_code;
  68 $out = slurp;
  69 ok( $out, "1 " );
  70 BEGIN { $tests += 3 };
  71
  72 # Comparison.
  73 sel; # greater.
  74 $bef->store_code( <<'END_OF_CODE' );
  75 53`.q
  76 END_OF_CODE
  77 $bef->run_code;
  78 $out = slurp;
  79 ok( $out, "1 " );
  80 sel; # equal.
  81 $bef->store_code( <<'END_OF_CODE' );
  82 55`.q
  83 END_OF_CODE
  84 $bef->run_code;
  85 $out = slurp;
  86 ok( $out, "0 " );
  87 sel; # smaller.
  88 $bef->store_code( <<'END_OF_CODE' );
  89 35`.q
  90 END_OF_CODE
  91 $bef->run_code;
  92 $out = slurp;
  93 ok( $out, "0 " );
  94 BEGIN { $tests += 3 };
  95
  96 # Horizontal if.
  97 sel; # left from north.
  98 $bef->store_code( <<'END_OF_CODE' );
  99 1    v
 100  q.3 _ 4.q
 101 END_OF_CODE
 102 $bef->run_code;
 103 $out = slurp;
 104 ok( $out, "3 " );
 105 sel; # right from north
 106 $bef->store_code( <<'END_OF_CODE' );
 107 0    v
 108  q.3 _ 4.q
 109 END_OF_CODE
 110 $bef->run_code;
 111 $out = slurp;
 112 ok( $out, "4 " );
 113 sel; # left from south.
 114 $bef->store_code( <<'END_OF_CODE' );
 115 1    ^
 116  q.3 _ 4.q
 117 END_OF_CODE
 118 $bef->run_code;
 119 $out = slurp;
 120 ok( $out, "3 " );
 121 sel; # right from south
 122 $bef->store_code( <<'END_OF_CODE' );
 123 0    ^
 124  q.3 _ 4.q
 125 END_OF_CODE
 126 $bef->run_code;
 127 $out = slurp;
 128 ok( $out, "4 " );
 129 BEGIN { $tests += 4 };
 130
 131 # Vertical if.
 132 sel; # north from left.
 133 $bef->store_code( <<'END_OF_CODE' );
 134 1 v   >3.q
 135   >   |
 136       >4.q
 137 END_OF_CODE
 138 $bef->run_code;
 139 $out = slurp;
 140 ok( $out, "3 " );
 141 sel; # south from left.
 142 $bef->store_code( <<'END_OF_CODE' );
 143 0 v   >3.q
 144   >   |
 145       >4.q
 146 END_OF_CODE
 147 $bef->run_code;
 148 $out = slurp;
 149 ok( $out, "4 " );
 150 sel; # north from right.
 151 $bef->store_code( <<'END_OF_CODE' );
 152 1 v   >3.q
 153   <   |
 154       >4.q
 155 END_OF_CODE
 156 $bef->run_code;
 157 $out = slurp;
 158 ok( $out, "3 " );
 159 sel; # south from right.
 160 $bef->store_code( <<'END_OF_CODE' );
 161 0 v   >3.q
 162   <   |
 163       >4.q
 164 END_OF_CODE
 165 $bef->run_code;
 166 $out = slurp;
 167 ok( $out, "4 " );
 168 BEGIN { $tests += 4 };
 169
 170 # Compare (3 branches if).
 171 sel; # greater.
 172 $bef->store_code( <<'END_OF_CODE' );
 173 34     v
 174  q..1  w  01-..q
 175        > 0..q
 176 END_OF_CODE
 177 $bef->run_code;
 178 $out = slurp;
 179 ok( $out, "-1 0 " );
 180 sel; # equal.
 181 $bef->store_code( <<'END_OF_CODE' );
 182 33     v
 183  q..1  w  01-..q
 184        > 0..q
 185 END_OF_CODE
 186 $bef->run_code;
 187 $out = slurp;
 188 ok( $out, "0 0 " );
 189 sel; # smaller.
 190 $bef->store_code( <<'END_OF_CODE' );
 191 43     v
 192  q..1  w  01-..q
 193        > 0..q
 194 END_OF_CODE
 195 $bef->run_code;
 196 $out = slurp;
 197 ok( $out, "1 0 " );
 198 BEGIN { $tests += 3 };
 199
 200
 201 BEGIN { plan tests => $tests };
 202