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