t/17stack.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 #          Stack 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 # Pop.
  49 sel; # normal.
  50 $bef->store_code( <<'END_OF_CODE' );
  51 12345$..q
  52 END_OF_CODE
  53 $bef->run_code;
  54 $out = slurp;
  55 ok( $out, "4 3 " );
  56 sel; # empty stack.
  57 $bef->store_code( <<'END_OF_CODE' );
  58 $..q
  59 END_OF_CODE
  60 $bef->run_code;
  61 $out = slurp;
  62 ok( $out, "0 0 " );
  63 BEGIN { $tests += 2 };
  64
  65 # Duplicate.
  66 sel; # normal.
  67 $bef->store_code( <<'END_OF_CODE' );
  68 4:..q
  69 END_OF_CODE
  70 $bef->run_code;
  71 $out = slurp;
  72 ok( $out, "4 4 " );
  73 sel; # empty stack.
  74 $bef->store_code( <<'END_OF_CODE' );
  75 :..q
  76 END_OF_CODE
  77 $bef->run_code;
  78 $out = slurp;
  79 ok( $out, "0 0 " );
  80 BEGIN { $tests += 2 };
  81
  82 # Swap stack.
  83 sel; # normal.
  84 $bef->store_code( <<'END_OF_CODE' );
  85 34\..q
  86 END_OF_CODE
  87 $bef->run_code;
  88 $out = slurp;
  89 ok( $out, "3 4 " );
  90 sel; # empty stack.
  91 $bef->store_code( <<'END_OF_CODE' );
  92 3\..q
  93 END_OF_CODE
  94 $bef->run_code;
  95 $out = slurp;
  96 ok( $out, "0 3 " );
  97 BEGIN { $tests += 2 };
  98
  99 # Clear stack.
 100 sel;
 101 $bef->store_code( <<'END_OF_CODE' );
 102 12345678"azertyuiop"n..q
 103 END_OF_CODE
 104 $bef->run_code;
 105 $out = slurp;
 106 ok( $out, "0 0 " );
 107 BEGIN { $tests += 1 };
 108
 109 BEGIN { plan tests => $tests };
 110