t/5-befunge/a-stdio.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 basic I/O.          #
  13 #----------------------------------#
  14
  15 use strict;
  16 use Language::Befunge;
  17 use Language::Befunge::IP;
  18 use POSIX qw! tmpnam !;
  19 use Test::More;
  20
  21 # Vars.
  22 my $file;
  23 my $fh;
  24 my $tests;
  25 my $out;
  26 my $slurp;
  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 # ascii output.
  51 sel;
  52 $bef->store_code( <<'END_OF_CODE' );
  53 ff+7+,q
  54 END_OF_CODE
  55 $bef->run_code;
  56 $out = slurp;
  57 is( $out, "%" );
  58 {
  59     # testing output error.
  60     local $SIG{__WARN__} = sub{};
  61     $file = tmpnam();
  62     open OUT, ">$file" or die $!;
  63     $fh = select OUT;
  64     close OUT;
  65     my $ip = Language::Befunge::IP->new;
  66     $ip->set_delta( Language::Befunge::Vector->new(1,0) );
  67     $ip->spush( 65 );
  68     $bef->set_curip($ip);
  69     $bef->get_ops->{","}->($bef);
  70     is( $ip->get_delta, "(-1,0)", "output error reverse ip delta" );
  71 }
  72 BEGIN { $tests += 2 };
  73
  74
  75 # number output.
  76 sel;
  77 $bef->store_code( <<'END_OF_CODE' );
  78 f.q
  79 END_OF_CODE
  80 $bef->run_code;
  81 $out = slurp;
  82 is( $out, "15 " );
  83 {
  84     # testing output error.
  85     local $SIG{__WARN__} = sub{};
  86     $file = tmpnam();
  87     open OUT, ">$file" or die $!;
  88     $fh = select OUT;
  89     close OUT;
  90     my $ip = Language::Befunge::IP->new;
  91     $ip->set_delta( Language::Befunge::Vector->new(1,0) );
  92     $ip->spush( 65 );
  93     $bef->set_curip($ip);
  94     $bef->get_ops->{"."}->($bef);
  95     is( $ip->get_delta, "(-1,0)", "output error reverse ip delta" );
  96 }
  97 BEGIN { $tests += 2 };
  98
  99
 100 # Not testing input.
 101 # If somebody know how to test input automatically...
 102
 103
 104 # file input.
 105 sel; # unknown file.
 106 $bef->store_code( <<'END_OF_CODE' );
 107 v q.2 i v# "/dev/a_file_that_probably_does_not_exist"0 <
 108 >                 ;vector; 3 6   ;flag; 0              ^
 109         > 1.q
 110 END_OF_CODE
 111 $bef->run_code;
 112 $out = slurp;
 113 is( $out, "1 " );
 114 sel; # existant file.
 115 $bef->store_code( <<'END_OF_CODE' );
 116 v v i "t/_resources/hello.bf"0   <
 117 >     ;vector; 3 6  ;flag; 0     ^
 118   .
 119   .
 120   .
 121   .
 122   >
 123 END_OF_CODE
 124 $bef->run_code;
 125 $out = slurp;
 126 is( $out, "6 3 2 35 hello world!\n" );
 127 BEGIN { $tests += 2 };
 128
 129 # binary file input
 130 sel;
 131 $bef->store_code( <<'END_OF_CODE' );
 132 v qiv# "t/_resources/hello.bf"0  <
 133 >     ;vector; 6 9 ;flag; 1      ^
 134     <q ,,,,,,,,,"IO Error"a
 135 END_OF_CODE
 136 $bef->run_code;
 137 $out = slurp;
 138 is( $bef->get_storage->rectangle
 139     ( Language::Befunge::Vector->new( 6, 9),
 140       Language::Befunge::Vector->new( 71, 1) ),
 141     qq{v q  ,,,,,,,,,,,,,"hello world!"a <\n>                                 ^} );
 142 is( $out, "" );
 143 BEGIN { $tests += 2 };
 144
 145
 146 # File output.
 147 sel; # unknown file.
 148 $bef->store_code( <<'END_OF_CODE' );
 149 v q.2 o v# "/ved/a_file_that_probably_does_not_exist"0 <
 150 >          ;size; 4 5   ;offset; 7 8       ;flag; 0    ^
 151     q.1 <
 152 END_OF_CODE
 153 $bef->run_code;
 154 $out = slurp;
 155 is( $out, "1 " );
 156 sel; # valid file.
 157 $bef->store_code( <<'END_OF_CODE' );
 158 v q o "t/foo.txt"0  0 ;flag;     <
 159 >     ;size; 4 4   ;offset; 3 2  ^
 160    foo!
 161
 162    ;-)
 163 END_OF_CODE
 164 $bef->run_code;
 165 $out = slurp;
 166 is( $out, "" );
 167 open FOO, "<t/foo.txt" or die $!;
 168 {
 169     local $/;
 170     $slurp = <FOO>;
 171 }
 172 is( $slurp, "foo!\n    \n;-) \n    " );
 173 unlink "t/foo.txt";
 174 sel; # flag: text file.
 175 $bef->store_code( <<'END_OF_CODE' );
 176 v q o "t/foo.txt"0  1 ;flag;     <
 177 >     ;size; 4 4   ;offset; 3 2  ^
 178    foo!
 179
 180    ;-)
 181 END_OF_CODE
 182 $bef->run_code;
 183 $out = slurp;
 184 is( $out, "" );
 185 open FOO, "<t/foo.txt" or die $!;
 186 {
 187     local $/;
 188     $slurp = <FOO>;
 189 }
 190 is( $slurp, "foo!\n\n;-)\n" );
 191 unlink "t/foo.txt";
 192 BEGIN { $tests += 5 };
 193
 194 # testing unability to
 195
 196
 197 BEGIN { plan tests => $tests };
 198