3 # This file is part of Language::Befunge::Vector::XS.
4 # Copyright (c) 2008 Jerome Quelin, all rights reserved.
6 # This program is free software; you can redistribute it and/or modify
7 # it under the same terms as Perl itself.
12 # Language::Befunge::Vector::XS tests
13 # taken from Language::Befunge::Vector
19 use Test::More tests => 73;
21 use Language::Befunge::IP;
22 use Language::Befunge::Vector;
24 my $ip = Language::Befunge::IP->new;
31 $v1 = Language::Befunge::Vector->new(2, 1, 0);
32 isa_ok($v1, "Language::Befunge::Vector");
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 is($v1->as_string, '(2,1,0)', "stringifies back to (2,1,0)");
38 is("$v1", '(2,1,0)', "overloaded stringify back to (2,1,0)");
41 $v1 = Language::Befunge::Vector->new_zeroes(4);
42 isa_ok( $v1, "Language::Befunge::Vector");
43 is($v1->get_dims, 4, "four dimensions");
44 is("$v1", '(0,0,0,0)', "all values are 0");
50 is("$v1", "$v2", "v1 has been copied");
51 $v1 += Language::Befunge::Vector->new(1,1,1,1);
52 is("$v1", "(1,1,1,1)", "v1 has had 1 added");
53 is("$v2", "(0,0,0,0)", "v2 hasn't changed");
54 is("$v3", "(0,0,0,0)", "v3 hasn't changed");
61 # get_dims() has already been tested above...
63 # get_component() is tested all over this script.
65 # get_all_components()
66 my @list = $v1->get_all_components;
67 is(scalar @list, 4, "get_all_components returned 2 elements");
68 is($list[0], 1, "X is 1");
69 is($list[1], 1, "Y is 1");
70 is($list[2], 1, "Z is 1");
71 is($list[3], 1, "T is 1");
73 # as_string() is already tested above.
79 is($v1->get_component(0), 0, "X is now 0");
80 is($v1->get_component(1), 0, "Y is now 0");
83 $v1->set_component(0,3);
84 $v1->set_component(1,2);
85 is($v1->get_component(0), 3, "X is now 1");
86 is($v1->get_component(1), 2, "Y is now 2");
87 is($v1->as_string, "(3,2,0,0)", "set_component() works");
92 $v1 = Language::Befunge::Vector->new(-1, -1);
93 $v2 = Language::Befunge::Vector->new(2, 2);
94 $v3 = Language::Befunge::Vector->new(-1, -2);
95 ok(!$v3->bounds_check($v1, $v2), "(-1,-2) is out of bounds");
96 $v3 = Language::Befunge::Vector->new(0, -1);
97 ok( $v3->bounds_check($v1, $v2), "(0,-1) is within bounds");
98 $v3 = Language::Befunge::Vector->new(2, 2);
99 ok( $v3->bounds_check($v1, $v2), "(2,2) is within bounds");
100 $v3 = Language::Befunge::Vector->new(3, 2);
101 ok(!$v3->bounds_check($v1, $v2), "(3,2) is out of bounds");
102 $v3 = Language::Befunge::Vector->new(-1, -1);
103 ok( $v3->bounds_check($v1, $v2), "(-1,-1) is within bounds");
104 $v3 = Language::Befunge::Vector->new(23, 0);
105 ok(!$v3->bounds_check($v1, $v2), "(23,0) is out of bounds");
106 $v3 = Language::Befunge::Vector->new(0, 23);
107 ok(!$v3->bounds_check($v1, $v2), "(0,23) is out of bounds");
112 $v1 = Language::Befunge::Vector->new(5, 6);
113 $v4 = Language::Befunge::Vector->new(1, 1);
115 is($v1->get_component(0), 5, "X hasn't changed in v1");
116 is($v1->get_component(1), 6, "Y hasn't changed in v1");
117 is($v4->get_component(0), 1, "X hasn't changed in v4");
118 is($v4->get_component(1), 1, "Y hasn't changed in v4");
119 is($v2->get_component(0), 6, "X is v1's X plus v4's X");
120 is($v2->get_component(1), 7, "Y is v1's Y plus v4's Y");
123 $v1 = Language::Befunge::Vector->new(5, 6);
125 is($v1->get_component(0), 5, "X hasn't changed in v1");
126 is($v1->get_component(1), 6, "Y hasn't changed in v1");
127 is($v2->get_component(0), -5, "X is the inverse of v1's");
128 is($v2->get_component(1), -6, "Y is the inverse of v1's");
135 is("$v1", "(6,7)", "v1 has had 1 added in X/Y");
136 is("$v2", "(5,6)", "v2 hasn't changed");
137 is("$v4", "(1,1)", "v4 hasn't changed");
139 # inplace substraction
142 is("$v3", "(5,6)", "v3 has had 1 substracted in X/Y");
143 is("$v1", "(6,7)", "v1 hasn't changed");
144 is("$v4", "(1,1)", "v4 hasn't changed");
150 $v1 = Language::Befunge::Vector->new(1, 1);
151 $v2 = Language::Befunge::Vector->new(1, 1);
152 $v3 = Language::Befunge::Vector->new(1, 2);
153 ok( $v1 == $v2 , "v1 == v2");
154 ok( $v2 == $v1 , "v2 == v1");
155 ok( $v1 == $v1 , "v1 == v1");
156 ok(!($v1 == $v3), "!(v1 == v3)");
157 ok(!($v2 == $v3), "!(v2 == v3)");
160 $v1 = Language::Befunge::Vector->new(1, 1);
161 $v2 = Language::Befunge::Vector->new(1, 1);
162 $v3 = Language::Befunge::Vector->new(1, 2);
163 ok(!($v1 != $v2), "!(v1 != v2)");
164 ok(!($v2 != $v1), "!(v2 != v1)");
165 ok(!($v1 != $v1), "!(v1 != v1)");
166 ok( ($v1 != $v3), "v1 != v3");
167 ok( ($v2 != $v3), "v2 != v3");
169 # finally, test all the possible ways to die
171 eval { require Test::Exception; Test::Exception->import; };
172 skip 'need Test::Exception', 18 unless defined $Test::Exception::VERSION;
176 throws_ok(sub { Language::Befunge::Vector->new() },
177 qr/Usage/, "Vector->new needs a defined 'dimensions' argument");
179 throws_ok(sub { Language::Befunge::Vector->new_zeroes() },
180 qr/Usage/, "Vector->new_zeroes needs a defined 'dimensions' argument");
181 throws_ok(sub { Language::Befunge::Vector->new_zeroes(0) },
182 qr/Usage/, "Vector->new_zeroes needs a non-zero 'dimensions' argument");
183 my $tref_v = Language::Befunge::Vector->new(4, 5, 6);
184 my $bef_v = Language::Befunge::Vector->new(3, 4);
188 throws_ok(sub { $tref_v->get_component(3) },
189 qr/No such dimension/, "get_component takes dimension range 0..2 for 3d");
190 throws_ok(sub { $bef_v->get_component(-1) },
191 qr/No such dimension/, "get_component takes dimension range 0..1 for 2d");
195 throws_ok(sub { $tref_v->set_component(3, 0) },
196 qr/No such dimension/, "set_component takes dimension range 0..2 for 3d");
197 throws_ok(sub { $bef_v->set_component(-1, 0) },
198 qr/No such dimension/, "set_component takes dimension range 0..1 for 2d");
200 #- other public methods
202 throws_ok(sub { $tref_v->bounds_check($v1, $v2) },
203 qr/uneven dimensions/, "bounds check catches wrong dimension in first arg");
204 throws_ok(sub { $v1->bounds_check($tref_v, $v2) },
205 qr/uneven dimensions/, "bounds check catches wrong dimension in second arg");
206 throws_ok(sub { $v1->bounds_check($v2, $tref_v) },
207 qr/uneven dimensions/, "bounds check catches wrong dimension in third arg");
211 throws_ok(sub { my $blah = $tref_v + $bef_v },
212 qr/uneven dimensions/, "misaligned vector arithmetic (+)");
214 throws_ok(sub { my $blah = $tref_v - $bef_v },
215 qr/uneven dimensions/, "misaligned vector arithmetic (-)");
219 throws_ok(sub { $tref_v += $bef_v },
220 qr/uneven dimensions/, "misaligned vector arithmetic (+=)");
221 # inplace substraction
222 throws_ok(sub { $tref_v -= $bef_v },
223 qr/uneven dimensions/, "misaligned vector arithmetic (-=)");
227 throws_ok(sub { $tref_v == $bef_v },
228 qr/uneven dimensions/, "misaligned vector arithmetic (==)");
230 throws_ok(sub { $tref_v != $bef_v },
231 qr/uneven dimensions/, "misaligned vector arithmetic (!=)");