t/1-classes/interpreter.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 # Language::Befunge::Interpreter tests
  13 #
  14
  15 use strict;
  16 use warnings;
  17
  18 use Test::Exception;
  19 use Test::More tests => 46;
  20 use Language::Befunge::Interpreter;
  21
  22
  23 #-- new()
  24 # defaults
  25 my $interp = Language::Befunge::Interpreter->new();
  26 isa_ok($interp, "Language::Befunge::Interpreter");
  27 is($interp->get_dimensions, 2, "default number of dimensions");
  28 is(scalar @{$interp->get_ips()}, 0, "starts out with no IPs");
  29 isa_ok($interp->get_storage, 'Language::Befunge::Storage::2D::Sparse', "storage object");
  30 is($interp->get_storage->get_dims, 2, "storage has same number of dimensions");
  31
  32 # templates
  33 $interp = Language::Befunge::Interpreter->new({ syntax => 'befunge98' });
  34 isa_ok($interp, "Language::Befunge::Interpreter");
  35 is($interp->get_dimensions, 2, "default number of dimensions");
  36 is(scalar @{$interp->get_ips()}, 0, "starts out with no IPs");
  37 isa_ok($interp->get_storage, 'Language::Befunge::Storage::2D::Sparse', "storage object");
  38 is($interp->get_storage->get_dims, 2, "storage has same number of dimensions");
  39
  40 $interp = Language::Befunge::Interpreter->new({ syntax => 'unefunge98' });
  41 isa_ok($interp, "Language::Befunge::Interpreter");
  42 is($interp->get_dimensions, 1, "correct number of dimensions");
  43 is(scalar @{$interp->get_ips()}, 0, "starts out with no IPs");
  44 isa_ok($interp->get_storage, 'Language::Befunge::Storage::Generic::AoA', "storage object");
  45 is($interp->get_storage->get_dims, 1, "storage has same number of dimensions");
  46
  47 $interp = Language::Befunge::Interpreter->new({ syntax => 'trefunge98' });
  48 isa_ok($interp, "Language::Befunge::Interpreter");
  49 is($interp->get_dimensions, 3, "correct number of dimensions");
  50 is(scalar @{$interp->get_ips()}, 0, "starts out with no IPs");
  51 isa_ok($interp->get_storage, 'Language::Befunge::Storage::Generic::AoA', "storage object");
  52 is($interp->get_storage->get_dims, 3, "storage has same number of dimensions");
  53
  54 # by dims
  55 $interp = Language::Befunge::Interpreter->new({ dims => 5 });
  56 isa_ok($interp, "Language::Befunge::Interpreter");
  57 is($interp->get_dimensions, 5, "correct number of dimensions");
  58 is(scalar @{$interp->get_ips()}, 0, "starts out with no IPs");
  59 isa_ok($interp->get_storage, 'Language::Befunge::Storage::Generic::AoA', "storage object");
  60 is($interp->get_storage->get_dims, 5, "storage has same number of dimensions");
  61
  62 # special storage requirement
  63 $interp = Language::Befunge::Interpreter->new({
  64     storage => 'Language::Befunge::Storage::Generic::Vec'
  65 });
  66 isa_ok($interp, "Language::Befunge::Interpreter");
  67 is($interp->get_dimensions, 2, "correct number of dimensions");
  68 is(scalar @{$interp->get_ips()}, 0, "starts out with no IPs");
  69 isa_ok($interp->get_storage, 'Language::Befunge::Storage::Generic::Vec', "storage object");
  70 is($interp->get_storage->get_dims, 2, "storage has same number of dimensions");
  71
  72 # syntax combinations like "4funge98" are supported
  73 $interp = Language::Befunge::Interpreter->new({
  74     syntax  => '4funge98',
  75     storage => 'Language::Befunge::Storage::Generic::Vec' });
  76 is(ref($interp->get_storage), 'Language::Befunge::Storage::Generic::Vec', 'storage specified');
  77 is($$interp{dimensions}, 4, 'dims inferred from syntax name');
  78 ok(exists($$interp{ops}{m}), 'GenericFunge98 ops used');
  79 $interp = Language::Befunge::Interpreter->new({
  80     syntax   => '4funge98',
  81     wrapping => 'Language::Befunge::Wrapping::LaheySpace' });
  82 is(ref($interp->_wrapping), 'Language::Befunge::Wrapping::LaheySpace', 'wrapping specified');
  83 is(ref($interp->get_storage), 'Language::Befunge::Storage::Generic::AoA', 'default storage');
  84 $interp = Language::Befunge::Interpreter->new({
  85     syntax => '4funge98',
  86     ops    => 'Language::Befunge::Ops::Unefunge98' });
  87 ok(!exists($$interp{ops}{m}), 'ops specified');
  88 $interp = Language::Befunge::Interpreter->new({
  89     syntax => '4funge98',
  90     dims   => 5 });
  91 is($$interp{dimensions}, 5, 'dims specified');
  92
  93 # accessor methods not tested anywhere else
  94 $interp->set_handprint('TEST');
  95 is($interp->get_handprint(), 'TEST', 'set_handprint');
  96 $interp->set_dimensions(6);
  97 is($interp->get_dimensions(), 6, 'set_dimensions');
  98 $interp->set_ops(Language::Befunge::Ops::GenericFunge98->get_ops_map);
  99 ok(exists($$interp{ops}{m}), 'set_ops');
 100
 101 # unrecognized arguments are rejected
 102 throws_ok(sub { Language::Befunge::Interpreter->new({ syntax => 'crashme' }) },
 103     qr/not recognized/, "unknown 'syntax' arguments are rejected");
 104
 105 # nonsensical combinations are rejected
 106 throws_ok(sub { Language::Befunge::Interpreter->new({ dims => 3, syntax => 'befunge98' }) },
 107     qr/only useful for 2-dimensional/, "LBS2S rejects non-2D");
 108 throws_ok(sub { Language::Befunge::Interpreter->new({ storage => 'Nonexistent::Module' }) },
 109     qr/via package "Nonexistent::Module"/, "unfound Storage module");
 110 throws_ok(sub { Language::Befunge::Interpreter->new({ ops => 'Nonexistent::Module' }) },
 111     qr/via package "Nonexistent::Module"/, "unfound Ops module");
 112 throws_ok(sub { Language::Befunge::Interpreter->new({ wrapping => 'Nonexistent::Module' }) },
 113     qr/via package "Nonexistent::Module"/, "unfound Wrapping module");
 114 throws_ok(sub { Language::Befunge::Interpreter->new({ dims => 'abc' }) },
 115     qr/must be numeric/, "non-numeric dimensions");
 116