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::Exception;
  19 use Test::More tests => 122;
  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 $v1 = Language::Befunge::Vector->new(-1, -1, -1);
 153 $v2 = Language::Befunge::Vector->new(1, 1, 1);
 154 my @expectations = (
 155     [-1, -1, -1], [ 0, -1, -1], [ 1, -1, -1],
 156     [-1,  0, -1], [ 0,  0, -1], [ 1,  0, -1],
 157     [-1,  1, -1], [ 0,  1, -1], [ 1,  1, -1],
 158     [-1, -1,  0], [ 0, -1,  0], [ 1, -1,  0],
 159     [-1,  0,  0], [ 0,  0,  0], [ 1,  0,  0],
 160     [-1,  1,  0], [ 0,  1,  0], [ 1,  1,  0],
 161     [-1, -1,  1], [ 0, -1,  1], [ 1, -1,  1],
 162     [-1,  0,  1], [ 0,  0,  1], [ 1,  0,  1],
 163     [-1,  1,  1], [ 0,  1,  1], [ 1,  1,  1]);
 164 for($v3 = $v1->copy(); scalar @expectations; $v3 = $v3->rasterize($v1, $v2)) {
 165     my $expect = shift @expectations;
 166     $expect = Language::Befunge::Vector->new(@$expect);
 167     is($v3, $expect, "next one is $expect");
 168 }
 169 is($v3, undef, "rasterize returns undef at end of loop");
 170
 171
 172 #- math ops
 173
 174 # addition
 175 $v1 = Language::Befunge::Vector->new(4,5,6);
 176 $v2 = Language::Befunge::Vector->new(1,2,3);
 177 $v3 = $v1 + $v2;
 178 is("$v1",   '(4,5,6)', "addition doesn't change v1");
 179 is("$v2",   '(1,2,3)', "addition doesn't change v2");
 180 isa_ok($v3,            "Language::Befunge::Vector");
 181 is("$v3",   '(5,7,9)', "v3 is v1 plus v2");
 182 throws_ok(sub { my $blah = $v2d + $v3d },
 183         qr/uneven dimensions/, "misaligned vector arithmetic (+)");
 184
 185
 186 # substraction
 187 $v1 = Language::Befunge::Vector->new(4,5,6);
 188 $v2 = Language::Befunge::Vector->new(3,2,1);
 189 $v3 = $v1 - $v2;
 190 is("$v1",   '(4,5,6)', "substraction doesn't change v1");
 191 is("$v2",   '(3,2,1)', "substraction doesn't change v2");
 192 isa_ok($v3,            "Language::Befunge::Vector");
 193 is("$v3",   '(1,3,5)', "v3 is v1 minus v2");
 194 throws_ok(sub { my $blah = $v2d - $v3d },
 195         qr/uneven dimensions/, "misaligned vector arithmetic (-)");
 196
 197
 198 # inversion
 199 $v1 = Language::Befunge::Vector->new(4,5,6);
 200 $v2 = -$v1;
 201 is("$v1",      '(4,5,6)', "inversion doesn't change v1");
 202 is("$v2",   '(-4,-5,-6)', "inversion doesn't change v2");
 203
 204
 205 #- inplace math ops
 206
 207 # inplace addition
 208 $v1 = Language::Befunge::Vector->new(4,5,6);
 209 $v2 = Language::Befunge::Vector->new(1,2,3);
 210 $v1 += $v2;
 211 is("$v1", "(5,7,9)", "inplace addition changes v1");
 212 is("$v2", "(1,2,3)", "inplace addition doesn't change v2");
 213 throws_ok(sub { $v2d += $v3d },
 214         qr/uneven dimensions/, "misaligned vector arithmetic (+=)");
 215
 216
 217 # inplace substraction
 218 $v1 = Language::Befunge::Vector->new(4,5,6);
 219 $v2 = Language::Befunge::Vector->new(3,2,1);
 220 $v1 -= $v2;
 221 is("$v1", "(1,3,5)", "inplace substraction changes v1");
 222 is("$v2", "(3,2,1)", "inplace substraction doesn't change v2");
 223 throws_ok(sub { $v2d -= $v3d },
 224         qr/uneven dimensions/, "misaligned vector arithmetic (-=)");
 225
 226
 227 #- comparison
 228
 229 # equality
 230 $v1 = Language::Befunge::Vector->new(1,2,3);
 231 $v2 = Language::Befunge::Vector->new(1,2,3);
 232 ok($v1 == $v1, "v1 == v1");
 233 ok($v1 == $v2, "v1 == v2");
 234 ok($v2 == $v1, "v2 == v1");
 235 @coords = ( [0,2,3], [1,0,3], [1,2,0] );
 236 foreach my $coords ( @coords ) {
 237     $v3 = Language::Befunge::Vector->new(@$coords);
 238     ok(!($v1 == $v3), "!(v1 == $v3)");
 239     ok(!($v2 == $v3), "!(v2 == $v3)");
 240 }
 241 throws_ok(sub { $v2d == $v3d },
 242         qr/uneven dimensions/, "misaligned vector arithmetic (==)");
 243
 244
 245 # inequality
 246 $v1 = Language::Befunge::Vector->new(1,2,3);
 247 $v2 = Language::Befunge::Vector->new(1,2,3);
 248 ok(!($v1 != $v1), "!(v1 != v1)");
 249 ok(!($v1 != $v2), "!(v1 != v2)");
 250 ok(!($v2 != $v1), "!(v2 != v1)");
 251 @coords = ( [0,2,3], [1,0,3], [1,2,0] );
 252 foreach my $coords ( @coords ) {
 253     $v3 = Language::Befunge::Vector->new(@$coords);
 254     ok($v1 != $v3, "v1 != $v3)");
 255     ok($v2 != $v3, "v2 != $v3)");
 256 }
 257 throws_ok(sub { $v2d != $v3d },
 258         qr/uneven dimensions/, "misaligned vector arithmetic (!=)");
 259