t/befunge/c-maths.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 #          The math functions.          #
  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 # Multiplication.
  49 sel; # regular multiplication.
  50 $bef->store_code( <<'END_OF_CODE' );
  51 49*.q
  52 END_OF_CODE
  53 $bef->run_code;
  54 $out = slurp;
  55 ok( $out, "36 " );
  56 sel; # empty stack.
  57 $bef->store_code( <<'END_OF_CODE' );
  58 4*.q
  59 END_OF_CODE
  60 $bef->run_code;
  61 $out = slurp;
  62 ok( $out, "0 " );
  63 sel; # program overflow.
  64 $bef->store_code( <<'END_OF_CODE' );
  65 aaa** aaa** * aaa** aaa** *  * . q
  66 END_OF_CODE
  67 eval { $bef->run_code; };
  68 $out = slurp;
  69 ok( $@, qr/program overflow while performing multiplication/ );
  70 sel; # program underflow.
  71 $bef->store_code( <<'END_OF_CODE' );
  72 1- aaa*** aaa** * aaa** aaa** *  * . q
  73 END_OF_CODE
  74 eval { $bef->run_code; };
  75 $out = slurp;
  76 ok( $@, qr/program underflow while performing multiplication/ );
  77 BEGIN { $tests += 4 };
  78
  79
  80 # Addition.
  81 sel; # regular addition.
  82 $bef->store_code( <<'END_OF_CODE' );
  83 35+.q
  84 END_OF_CODE
  85 $bef->run_code;
  86 $out = slurp;
  87 ok( $out, "8 " );
  88 sel; # empty stack.
  89 $bef->store_code( <<'END_OF_CODE' );
  90 f+.q
  91 END_OF_CODE
  92 $bef->run_code;
  93 $out = slurp;
  94 ok( $out, "15 " );
  95 sel; # program overflow.
  96 $bef->store_code( <<'END_OF_CODE' );
  97 2+a* 1+a* 4+a* 7+a* 4+a* 8+a* 3+a* 6+a* 4+a* 6+ f+ .q
  98 END_OF_CODE
  99 eval { $bef->run_code; };
 100 $out = slurp;
 101 ok( $@, qr/program overflow while performing addition/ );
 102 sel; # program underflow.
 103 $bef->store_code( <<'END_OF_CODE' );
 104 2+a* 1+a* 4+a* 7+a* 4+a* 8+a* 3+a* 6+a* 4+a* 6+ - 0f- + .q
 105 END_OF_CODE
 106 eval { $bef->run_code; };
 107 $out = slurp;
 108 ok( $@, qr/program underflow while performing addition/ );
 109 BEGIN { $tests += 4 };
 110
 111
 112 # Substraction.
 113 sel; # regular substraction.
 114 $bef->store_code( <<'END_OF_CODE' );
 115 93-.q
 116 END_OF_CODE
 117 $bef->run_code;
 118 $out = slurp;
 119 ok( $out, "6 " );
 120 sel; # regular substraction (negative).
 121 $bef->store_code( <<'END_OF_CODE' );
 122 35-.q
 123 END_OF_CODE
 124 $bef->run_code;
 125 $out = slurp;
 126 ok( $out, "-2 " );
 127 sel; # empty stack.
 128 $bef->store_code( <<'END_OF_CODE' );
 129 f-.q
 130 END_OF_CODE
 131 $bef->run_code;
 132 $out = slurp;
 133 ok( $out, "-15 " );
 134 sel; # program overflow.
 135 $bef->store_code( <<'END_OF_CODE' );
 136 2+a* 1+a* 4+a* 7+a* 4+a* 8+a* 3+a* 6+a* 4+a* 6+ 0f- - .q
 137 END_OF_CODE
 138 eval { $bef->run_code; };
 139 $out = slurp;
 140 ok( $@, qr/program overflow while performing substraction/ );
 141 sel; # program underflow.
 142 $bef->store_code( <<'END_OF_CODE' );
 143 2+a* 1+a* 4+a* 7+a* 4+a* 8+a* 3+a* 6+a* 4+a* 6+ - f- .q
 144 END_OF_CODE
 145 eval { $bef->run_code; };
 146 $out = slurp;
 147 ok( $@, qr/program underflow while performing substraction/ );
 148 BEGIN { $tests += 5 };
 149
 150
 151 # Division.
 152 sel; # regular division.
 153 $bef->store_code( <<'END_OF_CODE' );
 154 93/.q
 155 END_OF_CODE
 156 $bef->run_code;
 157 $out = slurp;
 158 ok( $out, "3 " );
 159 sel; # regular division (non-integer).
 160 $bef->store_code( <<'END_OF_CODE' );
 161 54/.q
 162 END_OF_CODE
 163 $bef->run_code;
 164 $out = slurp;
 165 ok( $out, "1 " );
 166 sel; # empty stack.
 167 $bef->store_code( <<'END_OF_CODE' );
 168 f/.q
 169 END_OF_CODE
 170 $bef->run_code;
 171 $out = slurp;
 172 ok( $out, "0 " );
 173 sel; # division by zero.
 174 $bef->store_code( <<'END_OF_CODE' );
 175 a0/.q
 176 END_OF_CODE
 177 $bef->run_code;
 178 $out = slurp;
 179 ok( $out, "0 " );
 180 # Can't over/underflow integer division.
 181 BEGIN { $tests += 4 };
 182
 183 # Remainder.
 184 sel; # regular remainder.
 185 $bef->store_code( <<'END_OF_CODE' );
 186 93%.q
 187 END_OF_CODE
 188 $bef->run_code;
 189 $out = slurp;
 190 ok( $out, "0 " );
 191 sel; # regular remainder (non-integer).
 192 $bef->store_code( <<'END_OF_CODE' );
 193 54/.q
 194 END_OF_CODE
 195 $bef->run_code;
 196 $out = slurp;
 197 ok( $out, "1 " );
 198 sel; # empty stack.
 199 $bef->store_code( <<'END_OF_CODE' );
 200 f%.q
 201 END_OF_CODE
 202 $bef->run_code;
 203 $out = slurp;
 204 ok( $out, "0 " );
 205 sel; # remainder by zero.
 206 $bef->store_code( <<'END_OF_CODE' );
 207 a0%.q
 208 END_OF_CODE
 209 $bef->run_code;
 210 $out = slurp;
 211 ok( $out, "0 " );
 212 # Can't over/underflow integer remainder.
 213 BEGIN { $tests += 4 };
 214
 215
 216 BEGIN { plan tests => $tests };
 217