t/19storg.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 #          Storage operations.          #
  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 # put instruction.
  49 sel; # New storage offset.
  50 $bef->store_code( <<'END_OF_CODE' );
  51 0      {  01+a*1+a*8+ 11p v
  52     q.2                   <
  53          >  1.q
  54 END_OF_CODE
  55 $bef->run_code;
  56 $out = slurp;
  57 ok( $out, "1 " );
  58 sel; # Retrieving old storage offset.
  59 $bef->store_code( <<'END_OF_CODE' );
  60 0      { 22+ 0 } 01+a*1+a*8+ 61p v
  61  q.2                             <
  62       >  1.q
  63 END_OF_CODE
  64 $bef->run_code;
  65 $out = slurp;
  66 ok( $out, "1 " );
  67 BEGIN { $tests += 2 };
  68
  69 # get instruction.
  70 sel; # New storage offset.
  71 $bef->store_code( <<'END_OF_CODE' );
  72 0  ;blah;{  04-0g ,q
  73 END_OF_CODE
  74 $bef->run_code;
  75 $out = slurp;
  76 ok( $out, "a" );
  77 sel; # Retrieving old storage offset.
  78 $bef->store_code( <<'END_OF_CODE' );
  79 0  ;blah;  { 22+ 0 } 40g ,q
  80 END_OF_CODE
  81 $bef->run_code;
  82 $out = slurp;
  83 ok( $out, "b" );
  84 BEGIN { $tests += 2 };
  85
  86 # Medley.
  87 sel; # Positive values.
  88 $bef->store_code( <<'END_OF_CODE' );
  89 0  'G14p . 14g ,q
  90 END_OF_CODE
  91 $bef->run_code;
  92 $out = slurp;
  93 ok( $out, "0 G" );
  94 sel; # Negative values.
  95 $bef->store_code( <<'END_OF_CODE' );
  96 0  'f01-04- p . 01-04-g ,q
  97 END_OF_CODE
  98 $bef->run_code;
  99 $out = slurp;
 100 ok( $out, "0 f" );
 101 BEGIN { $tests += 2 };
 102
 103 BEGIN { plan tests => $tests };
 104