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 # Language::Befunge::Vector tests
  13 #
  14
  15 use strict;
  16 use warnings;
  17
  18 use Test::More tests => 94;
  19
  20 use Language::Befunge::Vector;
  21
  22
  23 # check prereq for test
  24 eval "use Test::Exception";
  25 my $has_test_exception = defined($Test::Exception::VERSION);
  26
  27
  28 my ($v1, $v2, $v3, $v4, @coords);
  29 my $v2d = Language::Befunge::Vector->new(3,4);
  30 my $v3d = Language::Befunge::Vector->new(5,6,7);
  31
  32
  33 # -- CONSTRUCTORS
  34
  35 # new()
  36 $v1 = Language::Befunge::Vector->new(7,8,9);
  37 isa_ok($v1,                          "Language::Befunge::Vector");
  38 is($v1->get_dims,                 3, "three dimensions");
  39 is($v1->get_component(0),         7, "X is correct");
  40 is($v1->get_component(1),         8, "Y is correct");
  41 is($v1->get_component(2),         9, "Z is correct");
  42 is($v1->as_string,        '(7,8,9)', "stringifies back to (7,8,9)");
  43 is("$v1",                 '(7,8,9)', "overloaded stringify back to (7,8,9)");
  44 SKIP: {
  45     skip "need Test::Exception", 1 unless $has_test_exception;
  46         throws_ok(sub { Language::Befunge::Vector->new() },
  47                 qr/Usage/, "LBV->new needs a defined 'dimensions' argument");
  48 }
  49
  50
  51 # new_zeroes()
  52 $v1 = Language::Befunge::Vector->new_zeroes(4);
  53 isa_ok($v1,                            "Language::Befunge::Vector");
  54 is($v1->get_dims,                   4, "four dimensions");
  55 is($v1->get_component(0),           0, "X is correct");
  56 is($v1->get_component(1),           0, "Y is correct");
  57 is($v1->get_component(2),           0, "Z is correct");
  58 is($v1->get_component(3),           0, "T is correct");
  59 is("$v1",                 '(0,0,0,0)', "all values are 0");
  60 SKIP: {
  61     skip "need Test::Exception", 2 unless $has_test_exception;
  62         throws_ok(sub { Language::Befunge::Vector->new_zeroes() },
  63                 qr/Usage/, "LBV->new_zeroes needs a defined 'dimensions' argument");
  64         throws_ok(sub { Language::Befunge::Vector->new_zeroes(0) },
  65                 qr/Usage/, "LBV->new_zeroes needs a non-zero 'dimensions' argument");
  66 }
  67
  68
  69 # copy()
  70 $v1 = Language::Befunge::Vector->new(2,3,4,5);
  71 $v4 = Language::Befunge::Vector->new(6,7,8,9);
  72 $v2 = $v1->copy;
  73 $v3 = $v1;
  74 is("$v1", "$v2", "v1 has been copied");
  75 $v1 += $v4;
  76 is("$v1", "(8,10,12,14)", "v1 has had v4 added");
  77 is("$v2",    "(2,3,4,5)", "v2 hasn't changed");
  78 is("$v3",    "(2,3,4,5)", "v3 hasn't changed");
  79
  80
  81
  82 # -- PUBLIC METHODS
  83
  84 #- accessors
  85
  86 # get_dims() has already been tested above...
  87
  88
  89 # get_component()
  90 # regular behaviour is tested all over this script.
  91 $v1 = Language::Befunge::Vector->new(2,3);
  92 SKIP: {
  93     skip "need Test::Exception", 2 unless $has_test_exception;
  94         throws_ok(sub { $v2d->get_component(-1) },
  95                 qr/No such dimension/, "get_component() checks min dimension");
  96         throws_ok(sub { $v1->get_component(2) },
  97                 qr/No such dimension/, "get_component() checks max dimension");
  98 }
  99
 100
 101 # get_all_components()
 102 $v1 = Language::Befunge::Vector->new(2,3,4,5);
 103 my @list = $v1->get_all_components;
 104 is(scalar @list, 4, "get_all_components() returned 4 elements");
 105 is($list[0], 2, "X is 2");
 106 is($list[1], 3, "Y is 3");
 107 is($list[2], 4, "Z is 4");
 108 is($list[3], 5, "T is 5");
 109
 110
 111 # as_string() is already tested above.
 112
 113
 114 #- mutators
 115
 116 # clear()
 117 $v1 = Language::Befunge::Vector->new(2,3,4,5);
 118 $v1->clear;
 119 is("$v1",                 '(0,0,0,0)', "clear() sets all values are 0");
 120 is($v1->get_component(0),           0, "X is now 0");
 121 is($v1->get_component(1),           0, "Y is now 0");
 122 is($v1->get_component(2),           0, "Z is now 0");
 123 is($v1->get_component(3),           0, "T is now 0");
 124
 125
 126 # set_component()
 127 $v1 = Language::Befunge::Vector->new(2,3,4,5);
 128 $v1->set_component(0,9);
 129 $v1->set_component(1,6);
 130 is($v1->as_string,        "(9,6,4,5)", "set_component() works");
 131 is($v1->get_component(0),           9, "X is now 9");
 132 is($v1->get_component(1),           6, "Y is now 6");
 133 is($v1->get_component(2),           4, "Z is still 4");
 134 is($v1->get_component(3),           5, "T is still 5");
 135 SKIP: {
 136     skip "need Test::Exception", 2 unless $has_test_exception;
 137         throws_ok(sub { $v1->set_component(-1, 0) },
 138                 qr/No such dimension/, "set_component() checks min dimension");
 139         throws_ok(sub { $v1->set_component(4, 0) },
 140                 qr/No such dimension/, "set_component() checks max dimension");
 141 }
 142
 143
 144 #- other methods
 145
 146 # bounds_check()
 147 $v1 = Language::Befunge::Vector->new(-1, -1);
 148 $v2 = Language::Befunge::Vector->new( 2,  2);
 149 @coords = ( [1,1], [-1,1], [1,-1], [-1,-1], [2,1], [1,2], [2,2] );
 150 foreach my $coords ( @coords ) {
 151     $v3 = Language::Befunge::Vector->new(@$coords);
 152     ok($v3->bounds_check($v1, $v2), "$v3 is within bounds");
 153 }
 154 @coords = ( [3,3], [3,1], [1,3], [-2,1], [1,-2], [-2,-2] );
 155 foreach my $coords ( @coords ) {
 156     $v3 = Language::Befunge::Vector->new(@$coords);
 157     ok(!$v3->bounds_check($v1, $v2), "$v3 is within bounds");
 158 }
 159 SKIP: {
 160     skip "need Test::Exception", 3 unless $has_test_exception;
 161         throws_ok(sub { $v3d->bounds_check($v1, $v2) },
 162                 qr/uneven dimensions/, "bounds_check() catches wrong dimension in first arg");
 163         throws_ok(sub { $v1->bounds_check($v3d, $v2) },
 164                 qr/uneven dimensions/, "bounds_check() catches wrong dimension in second arg");
 165         throws_ok(sub { $v1->bounds_check($v2, $v3d) },
 166                 qr/uneven dimensions/, "bounds_check() catches wrong dimension in third arg");
 167 }
 168
 169
 170 #- math ops
 171
 172 # addition
 173 $v1 = Language::Befunge::Vector->new(4,5,6);
 174 $v2 = Language::Befunge::Vector->new(1,2,3);
 175 $v3 = $v1 + $v2;
 176 is("$v1",   '(4,5,6)', "addition doesn't change v1");
 177 is("$v2",   '(1,2,3)', "addition doesn't change v2");
 178 isa_ok($v3,            "Language::Befunge::Vector");
 179 is("$v3",   '(5,7,9)', "v3 is v1 plus v2");
 180 SKIP: {
 181     skip "need Test::Exception", 1 unless $has_test_exception;
 182         throws_ok(sub { my $blah = $v2d + $v3d },
 183                 qr/uneven dimensions/, "misaligned vector arithmetic (+)");
 184 }
 185
 186
 187 # substraction
 188 $v1 = Language::Befunge::Vector->new(4,5,6);
 189 $v2 = Language::Befunge::Vector->new(3,2,1);
 190 $v3 = $v1 - $v2;
 191 is("$v1",   '(4,5,6)', "substraction doesn't change v1");
 192 is("$v2",   '(3,2,1)', "substraction doesn't change v2");
 193 isa_ok($v3,            "Language::Befunge::Vector");
 194 is("$v3",   '(1,3,5)', "v3 is v1 minus v2");
 195 SKIP: {
 196     skip "need Test::Exception", 1 unless $has_test_exception;
 197         throws_ok(sub { my $blah = $v2d - $v3d },
 198                 qr/uneven dimensions/, "misaligned vector arithmetic (-)");
 199 }
 200
 201
 202 # inversion
 203 $v1 = Language::Befunge::Vector->new(4,5,6);
 204 $v2 = -$v1;
 205 is("$v1",      '(4,5,6)', "inversion doesn't change v1");
 206 is("$v2",   '(-4,-5,-6)', "inversion doesn't change v2");
 207
 208
 209 #- inplace math ops
 210
 211 # inplace addition
 212 $v1 = Language::Befunge::Vector->new(4,5,6);
 213 $v2 = Language::Befunge::Vector->new(1,2,3);
 214 $v1 += $v2;
 215 is("$v1", "(5,7,9)", "inplace addition changes v1");
 216 is("$v2", "(1,2,3)", "inplace addition doesn't change v2");
 217 SKIP: {
 218     skip "need Test::Exception", 1 unless $has_test_exception;
 219         throws_ok(sub { $v2d += $v3d },
 220                 qr/uneven dimensions/, "misaligned vector arithmetic (+=)");
 221 }
 222
 223
 224 # inplace substraction
 225 $v1 = Language::Befunge::Vector->new(4,5,6);
 226 $v2 = Language::Befunge::Vector->new(3,2,1);
 227 $v1 -= $v2;
 228 is("$v1", "(1,3,5)", "inplace substraction changes v1");
 229 is("$v2", "(3,2,1)", "inplace substraction doesn't change v2");
 230 SKIP: {
 231     skip "need Test::Exception", 1 unless $has_test_exception;
 232         throws_ok(sub { $v2d -= $v3d },
 233                 qr/uneven dimensions/, "misaligned vector arithmetic (-=)");
 234 }
 235
 236
 237 #- comparison
 238
 239 # equality
 240 $v1 = Language::Befunge::Vector->new(1,2,3);
 241 $v2 = Language::Befunge::Vector->new(1,2,3);
 242 ok($v1 == $v1, "v1 == v1");
 243 ok($v1 == $v2, "v1 == v2");
 244 ok($v2 == $v1, "v2 == v1");
 245 @coords = ( [0,2,3], [1,0,3], [1,2,0] );
 246 foreach my $coords ( @coords ) {
 247     $v3 = Language::Befunge::Vector->new(@$coords);
 248     ok(!($v1 == $v3), "!(v1 == $v3)");
 249     ok(!($v2 == $v3), "!(v2 == $v3)");
 250 }
 251 SKIP: {
 252     skip "need Test::Exception", 1 unless $has_test_exception;
 253         throws_ok(sub { $v2d == $v3d },
 254                 qr/uneven dimensions/, "misaligned vector arithmetic (==)");
 255 }
 256
 257
 258 # inequality
 259 $v1 = Language::Befunge::Vector->new(1,2,3);
 260 $v2 = Language::Befunge::Vector->new(1,2,3);
 261 ok(!($v1 != $v1), "!(v1 != v1)");
 262 ok(!($v1 != $v2), "!(v1 != v2)");
 263 ok(!($v2 != $v1), "!(v2 != v1)");
 264 @coords = ( [0,2,3], [1,0,3], [1,2,0] );
 265 foreach my $coords ( @coords ) {
 266     $v3 = Language::Befunge::Vector->new(@$coords);
 267     ok($v1 != $v3, "v1 != $v3)");
 268     ok($v2 != $v3, "v2 != $v3)");
 269 }
 270 SKIP: {
 271     skip "need Test::Exception", 1 unless $has_test_exception;
 272         throws_ok(sub { $v2d != $v3d },
 273                 qr/uneven dimensions/, "misaligned vector arithmetic (!=)");
 274 }
 275