3 # This file is part of Language::Befunge.
4 # Copyright (c) 2001-2008 Jerome Quelin, all rights reserved.
6 # This program is free software; you can redistribute it and/or modify
7 # it under the same terms as Perl itself.
11 #----------------------------------#
13 #----------------------------------#
16 use Language::Befunge;
17 use Language::Befunge::IP;
18 use POSIX qw! tmpnam !;
27 my $bef = Language::Befunge->new;
30 # In order to see what happens...
33 open OUT, ">$file" or die $!;
39 open OUT, "<$file" or die $!;
52 $bef->store_code( <<'END_OF_CODE' );
59 # testing output error.
60 local $SIG{__WARN__} = sub{};
62 open OUT, ">$file" or die $!;
65 my $ip = Language::Befunge::IP->new;
66 $ip->set_delta( Language::Befunge::Vector->new(1,0) );
69 $bef->get_ops->{","}->($bef);
70 is( $ip->get_delta, "(-1,0)", "output error reverse ip delta" );
72 BEGIN { $tests += 2 };
77 $bef->store_code( <<'END_OF_CODE' );
84 # testing output error.
85 local $SIG{__WARN__} = sub{};
87 open OUT, ">$file" or die $!;
90 my $ip = Language::Befunge::IP->new;
91 $ip->set_delta( Language::Befunge::Vector->new(1,0) );
94 $bef->get_ops->{"."}->($bef);
95 is( $ip->get_delta, "(-1,0)", "output error reverse ip delta" );
97 BEGIN { $tests += 2 };
101 # If somebody know how to test input automatically...
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 ^
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 ^
126 is( $out, "6 3 2 35 hello world!\n" );
127 BEGIN { $tests += 2 };
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
138 is( $bef->storage->rectangle
139 ( Language::Befunge::Vector->new( 6, 9),
140 Language::Befunge::Vector->new( 71, 1) ),
141 qq{v q ,,,,,,,,,,,,,"hello world!"a <\n> ^} );
143 BEGIN { $tests += 2 };
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 ^
157 $bef->store_code( <<'END_OF_CODE' );
158 v q o "t/foo.txt"0 0 ;flag; <
159 > ;size; 4 4 ;offset; 3 2 ^
167 open FOO, "<t/foo.txt" or die $!;
172 is( $slurp, "foo!\n \n;-) \n " );
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 ^
185 open FOO, "<t/foo.txt" or die $!;
190 is( $slurp, "foo!\n\n;-)\n" );
192 BEGIN { $tests += 5 };
194 # testing unability to
197 BEGIN { plan tests => $tests };