t/1-classes/vector.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 #          The Vector module.          #
  13 #--------------------------------------#
  14
  15 use strict;
  16 use warnings;
  17
  18 use Test::More tests => 91;
  19
  20 use Language::Befunge::IP;
  21 use Language::Befunge::Vector;
  22
  23 my $ip = Language::Befunge::IP->new;
  24
  25
  26 # CONSTRUCTORS
  27 # ->new()
  28 my $v1 = Language::Befunge::Vector->new(3, 2, 1, 0);
  29 isa_ok($v1,                          "Language::Befunge::Vector");
  30 is($v1->get_dims,                 3, "three dimensions");
  31 is($v1->get_component(0),         2, "X is correct");
  32 is($v1->get_component(1),         1, "Y is correct");
  33 is($v1->get_component(2),         0, "Z is correct");
  34 is($v1->vector_as_string, '(2,1,0)', "stringifies back to (2,1,0)");
  35 is("$v1",                 '(2,1,0)', "overloaded stringify back to (2,1,0)");
  36
  37 # ->new_zeroes()
  38 $v1 = Language::Befunge::Vector->new_zeroes(4);
  39 isa_ok( $v1,              "Language::Befunge::Vector");
  40 is($v1->get_dims, 4,      "four dimensions");
  41 is("$v1",    '(0,0,0,0)', "all values are 0");
  42
  43
  44 # METHODS
  45
  46 # get_dims() has already been tested above...
  47
  48 # vector_invert
  49    $v1 = Language::Befunge::Vector->new(2, 5, 6);
  50 my $v2 = -$v1;
  51 my $v3 = $v1->vector_invert();
  52 is($v1->get_component(0), 5,  "X hasn't changed in v1");
  53 is($v1->get_component(1), 6,  "Y hasn't changed in v1");
  54 is($v2->get_component(0), -5, "X is the inverse of v1's");
  55 is($v2->get_component(1), -6, "Y is the inverse of v1's");
  56 is($v3->get_component(0), -5, "X is the inverse of v1's");
  57 is($v3->get_component(1), -6, "Y is the inverse of v1's");
  58
  59 # vector_add
  60 my $v4 = Language::Befunge::Vector->new(2, 1, 1);
  61 $v2 = $v1 + $v4;
  62 $v3 = $v1->vector_add($v4);
  63 is($v1->get_component(0), 5, "X hasn't changed in v1");
  64 is($v1->get_component(1), 6, "Y hasn't changed in v1");
  65 is($v4->get_component(0), 1, "X hasn't changed in v4");
  66 is($v4->get_component(1), 1, "Y hasn't changed in v4");
  67 is($v2->get_component(0), 6, "X is v1's X plus v4's X");
  68 is($v2->get_component(1), 7, "Y is v1's Y plus v4's Y");
  69 is($v3->get_component(0), 6, "X is v1's X plus v4's X");
  70 is($v3->get_component(1), 7, "Y is v1's Y plus v4's Y");
  71
  72 # vector_add_inplace
  73 $v2 = $v1->vector_copy();
  74 $v1 += $v4;
  75 $v2->vector_add_inplace($v4);
  76 is($v1->get_component(0), 6, "X has had 1 added in v1");
  77 is($v1->get_component(1), 7, "Y has had 1 added in v1");
  78 is($v2->get_component(0), 6, "X has had 1 added in v2");
  79 is($v2->get_component(1), 7, "Y has had 1 added in v2");
  80 is($v4->get_component(0), 1, "X hasn't changed in v4");
  81 is($v4->get_component(1), 1, "Y hasn't changed in v4");
  82
  83 # vector_copy
  84 $v2 = $v1->vector_copy();
  85 $v3 = $v1;
  86 is($v1->get_component(0), $v2->get_component(0), "X has been copied");
  87 is($v1->get_component(1), $v2->get_component(1), "Y has been copied");
  88 $v1 += $v4;
  89 is($v1->get_component(0), 7, "X has had 1 added in v1");
  90 is($v1->get_component(1), 8, "Y has had 1 added in v1");
  91 is($v2->get_component(0), 6, "X hasn't changed in v2");
  92 is($v2->get_component(1), 7, "Y hasn't changed in v2");
  93 is($v3->get_component(0), 6, "X hasn't changed in v3");
  94 is($v3->get_component(1), 7, "Y hasn't changed in v3");
  95
  96 # setd
  97 $v1->set_component(0,1);
  98 $v1->set_component(1,2);
  99 is($v1->get_component(0),       1, "X is now 1");
 100 is($v1->get_component(1),       2, "Y is now 2");
 101 is($v1->vector_as_string, "(1,2)", "setd works");
 102
 103 # getd is tested all over this script.
 104
 105 # get_all_components
 106 my @list = $v1->get_all_components;
 107 is(scalar @list, 2, "get_all_components returned 2 elements");
 108 is($list[0], 1, "X is 1");
 109 is($list[1], 2, "Y is 2");
 110
 111 # zero
 112 $v1->zero();
 113 is($v1->get_component(0), 0, "X is now 0");
 114 is($v1->get_component(1), 0, "Y is now 0");
 115
 116 # bounds_check
 117 $v1 = Language::Befunge::Vector->new(2, -1, -1);
 118 $v2 = Language::Befunge::Vector->new(2,  2,  2);
 119 $v3 = Language::Befunge::Vector->new(2, -1, -2);
 120 ok(!$v3->bounds_check($v1, $v2), "(-1,-2) is out of bounds");
 121 $v3 = Language::Befunge::Vector->new(2,  0, -1);
 122 ok( $v3->bounds_check($v1, $v2), "(0,-1) is within bounds");
 123 $v3 = Language::Befunge::Vector->new(2,  2, 2);
 124 ok( $v3->bounds_check($v1, $v2), "(2,2) is within bounds");
 125 $v3 = Language::Befunge::Vector->new(2,  3, 2);
 126 ok(!$v3->bounds_check($v1, $v2), "(3,2) is out of bounds");
 127 $v3 = Language::Befunge::Vector->new(2,  -1, -1);
 128 ok( $v3->bounds_check($v1, $v2), "(-1,-1) is within bounds");
 129 $v3 = Language::Befunge::Vector->new(2,  23, 0);
 130 ok(!$v3->bounds_check($v1, $v2), "(23,0) is out of bounds");
 131 $v3 = Language::Befunge::Vector->new(2,  0, 23);
 132 ok(!$v3->bounds_check($v1, $v2), "(0,23) is out of bounds");
 133
 134 # vector_as_string is already tested, above
 135
 136 # vector_equality
 137 $v1 = Language::Befunge::Vector->new(2, 1, 1);
 138 $v2 = Language::Befunge::Vector->new(2, 1, 1);
 139 $v3 = Language::Befunge::Vector->new(2, 1, 2);
 140 ok(  $v1 == $v2 , "v1 == v2");
 141 ok(  $v2 == $v1 , "v2 == v1");
 142 ok(  $v1 == $v1 , "v1 == v1");
 143 ok(!($v1 == $v3), "!(v1 == v3)");
 144 ok(!($v2 == $v3), "!(v2 == v3)");
 145 ok(  $v1->vector_equality($v2) , "v1 == v2");
 146 ok(  $v2->vector_equality($v1) , "v2 == v1");
 147 ok(  $v1->vector_equality($v1) , "v1 == v1");
 148 ok(!($v1->vector_equality($v3)), "!(v1 == v3)");
 149 ok(!($v2->vector_equality($v3)), "!(v2 == v3)");
 150
 151 # vector_inequality
 152 $v1 = Language::Befunge::Vector->new(2, 1, 1);
 153 $v2 = Language::Befunge::Vector->new(2, 1, 1);
 154 $v3 = Language::Befunge::Vector->new(2, 1, 2);
 155 ok(!($v1 != $v2), "!(v1 != v2)");
 156 ok(!($v2 != $v1), "!(v2 != v1)");
 157 ok(!($v1 != $v1), "!(v1 != v1)");
 158 ok( ($v1 != $v3), "v1 != v3");
 159 ok( ($v2 != $v3), "v2 != v3");
 160 ok(!($v1->vector_inequality($v2)), "!(v1 != v2)");
 161 ok(!($v2->vector_inequality($v1)), "!(v2 != v1)");
 162 ok(!($v1->vector_inequality($v1)), "!(v1 != v1)");
 163 ok( ($v1->vector_inequality($v3)), "v1 != v3");
 164 ok( ($v2->vector_inequality($v3)), "v2 != v3");
 165
 166 # finally, test all the possible ways to die
 167 SKIP: {
 168     eval { require Test::Exception; Test::Exception->import; };
 169     skip 'need Test::Exception', 18 unless defined $Test::Exception::VERSION;
 170
 171         # new
 172         throws_ok(sub { Language::Befunge::Vector->new() },
 173                 qr/Usage/, "Vector->new needs a defined 'dimensions' argument");
 174         throws_ok(sub { Language::Befunge::Vector->new(0) },
 175                 qr/Usage/, "Vector->new needs a non-zero 'dimensions' argument");
 176         throws_ok(sub { Language::Befunge::Vector->new(1) },
 177                 qr/Usage/, "Vector->new checks the number of args it got");
 178         throws_ok(sub { Language::Befunge::Vector->new(1, 2, 3) },
 179                 qr/Usage/, "Vector->new checks the number of args it got");
 180         # new_zeroes
 181         throws_ok(sub { Language::Befunge::Vector->new_zeroes() },
 182                 qr/Usage/, "Vector->new_zeroes needs a defined 'dimensions' argument");
 183         throws_ok(sub { Language::Befunge::Vector->new_zeroes(0) },
 184                 qr/Usage/, "Vector->new_zeroes needs a non-zero 'dimensions' argument");
 185         my $tref_v = Language::Befunge::Vector->new(3, 4, 5, 6);
 186         my  $bef_v = Language::Befunge::Vector->new(2, 3, 4);
 187         # vector_subtract
 188         throws_ok(sub { my $blah = $tref_v - $bef_v },
 189                 qr/uneven dimensions/, "misaligned vector arithmetic (-)");
 190         # vector_add
 191         throws_ok(sub { my $blah = $tref_v + $bef_v },
 192                 qr/uneven dimensions/, "misaligned vector arithmetic (+)");
 193         # vector_add_inplace
 194         throws_ok(sub { $tref_v += $bef_v },
 195                 qr/uneven dimensions/, "misaligned vector arithmetic (+=)");
 196         # setd
 197         throws_ok(sub { $tref_v->set_component(3, 0) },
 198                 qr/No such dimension/, "setd takes dimension range 0..2 for 3d");
 199         throws_ok(sub { $bef_v->set_component(-1, 0) },
 200                 qr/No such dimension/, "setd takes dimension range 0..1 for 2d");
 201         # getd
 202         throws_ok(sub { $tref_v->get_component(3) },
 203                 qr/No such dimension/, "getd takes dimension range 0..2 for 3d");
 204         throws_ok(sub { $bef_v->get_component(-1) },
 205                 qr/No such dimension/, "getd takes dimension range 0..1 for 2d");
 206         # bounds_check
 207         throws_ok(sub { $tref_v->bounds_check($v1, $v2) },
 208                 qr/uneven dimensions/, "bounds check catches wrong dimension in first arg");
 209         throws_ok(sub { $v1->bounds_check($tref_v, $v2) },
 210                 qr/uneven dimensions/, "bounds check catches wrong dimension in second arg");
 211         throws_ok(sub { $v1->bounds_check($v2, $tref_v) },
 212                 qr/uneven dimensions/, "bounds check catches wrong dimension in third arg");
 213         # vector_equality
 214         throws_ok(sub { $tref_v == $bef_v },
 215                 qr/uneven dimensions/, "misaligned vector arithmetic (==)");
 216         # vector_inequality
 217         throws_ok(sub { $tref_v != $bef_v },
 218                 qr/uneven dimensions/, "misaligned vector arithmetic (!=)");
 219 }
 220
 221