t/1-classes/vector.t

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