t/1-vector.t

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