t/4-interpreter/trefunge.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 #          Exported funcs.          #
  13 #-----------------------------------#
  14
  15 use strict;
  16 use Language::Befunge;
  17 use aliased 'Language::Befunge::Vector' => 'LBV';
  18
  19 use POSIX qw! tmpnam !;
  20 use Test::More;
  21
  22 # Vars.
  23 my ($file, $fh);
  24 my $tests;
  25 my $out;
  26 my $tref = Language::Befunge->new( {syntax=>'trefunge98'} );
  27 BEGIN { $tests = 0 };
  28
  29 # In order to see what happens...
  30 sub sel () {
  31     $file = tmpnam();
  32     open OUT, ">$file" or die $!;
  33     $fh = select OUT;
  34 }
  35 sub slurp () {
  36     select $fh;
  37     close OUT;
  38     open OUT, "<$file" or die $!;
  39     my $content;
  40     {
  41         local $/;
  42         $content = <OUT>;
  43     }
  44     close OUT;
  45     unlink $file;
  46     return $content;
  47 }
  48
  49 # Basic constructor.
  50 sel;
  51 $tref = Language::Befunge->new( {file=>'t/_resources/q.bf', syntax=>'trefunge98'} );
  52 $tref->run_code;
  53 $out = slurp;
  54 is( $out, '', 'constructor worked' );
  55 BEGIN { $tests += 1 };
  56
  57 # Custom constructor.
  58 $tref = Language::Befunge->new({
  59     syntax  => 'trefunge98',
  60     storage => 'Language::Befunge::Storage::Generic::Vec' });
  61 is(ref($tref->get_storage), 'Language::Befunge::Storage::Generic::Vec', 'storage specified');
  62 $tref = Language::Befunge->new({
  63     syntax   => 'trefunge98',
  64     wrapping => 'Language::Befunge::Wrapping::LaheySpace' });
  65 is(ref($tref->get_wrapping), 'Language::Befunge::Wrapping::LaheySpace', 'wrapping specified');
  66 $tref = Language::Befunge->new({
  67     syntax => 'trefunge98',
  68     ops    => 'Language::Befunge::Ops::GenericFunge98' });
  69 ok(exists($$tref{ops}{m}), 'ops specified');
  70 $tref = Language::Befunge->new({
  71     syntax => 'trefunge98',
  72     dims   => 4 });
  73 is($$tref{dimensions}, 4, 'dims specified');
  74 BEGIN { $tests += 4 };
  75
  76 # Basic reading.
  77 $tref = Language::Befunge->new( {syntax=>'trefunge98'} );
  78 sel;
  79 $tref->read_file( "t/_resources/q.bf" );
  80 $tref->run_code;
  81 $out = slurp;
  82 is( $out, "", 'read_file' );
  83 BEGIN { $tests += 1 };
  84
  85 # Basic storing.
  86 sel;
  87 $tref->store_code( <<'END_OF_CODE' );
  88 q
  89 END_OF_CODE
  90 $tref->run_code;
  91 $out = slurp;
  92 is( $out, '', 'store_code' );
  93 BEGIN { $tests += 1 };
  94
  95 # Interpreter must treat non-characters as if they were an 'r' instruction.
  96 sel;
  97 $tref->store_code( <<'END_OF_CODE' );
  98 01-c00p#q1.2 q
  99 END_OF_CODE
 100 $tref->run_code;
 101 $out = slurp;
 102 is( $out, "1 2 ", 'treats non-characters like "r"' );
 103 BEGIN { $tests += 1 };
 104
 105 # Interpreter must treat non-commands as if they were an 'r' instruction.
 106 sel;
 107 $tref->store_code( <<'END_OF_CODE' );
 108 01+c00p#q1.2 q
 109 END_OF_CODE
 110 $tref->run_code;
 111 $out = slurp;
 112 is( $out, "1 2 ", 'treats non-commands like "r"' );
 113 BEGIN { $tests += 1 };
 114
 115 # Interpreter reads trefunge code properly, and operates in 3 dimensions, and
 116 # knows that vectors are 3 integers.
 117 sel;
 118 my $code = <<"END_OF_CODE";
 119 #v401-11x
 120  >..q
 121 \f h>
 122   ^3   <
 123 END_OF_CODE
 124 $tref->store_code( $code );
 125 $tref->run_code;
 126 $out = slurp;
 127 is( $out, "3 4 ", 'full operation' );
 128 BEGIN { $tests += 1 };
 129
 130 # rectangle() returns the original box again
 131 chomp $code;
 132 is($tref->get_storage->rectangle(LBV->new(0,0,0), LBV->new(9,2,2)), $code, 'rectangle works');
 133 BEGIN { $tests += 1 };
 134
 135 BEGIN { plan tests => $tests };