3 # This file is part of Language::Befunge.
4 # Copyright (c) 2001-2007 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.
11 #--------------------------------------#
12 # The Vector module. #
13 #--------------------------------------#
17 use Language::Befunge::IP;
18 use Language::Befunge::Vector;
19 BEGIN { use_ok ('Test::Exception') };
20 my $test_exception_loaded = defined($Test::Exception::VERSION);
23 my $ip = Language::Befunge::IP->new;
29 my $v1 = Language::Befunge::Vector->new(3, 2, 1, 0);
30 isa_ok( $v1, "Language::Befunge::Vector");
31 is($v1->get_dims, 3, "three dimensions");
32 is($v1->get_component(0), 2, "X is correct");
33 is($v1->get_component(1), 1, "Y is correct");
34 is($v1->get_component(2), 0, "Z is correct");
35 is($v1->vector_as_string, '(2,1,0)', "stringifies back to (2,1,0)");
36 is("$v1", '(2,1,0)', "overloaded stringify back to (2,1,0)");
37 BEGIN { $tests += 7 };
40 $v1 = Language::Befunge::Vector->new_zeroes(4);
41 isa_ok( $v1, "Language::Befunge::Vector");
42 is($v1->get_dims, 4, "four dimensions");
43 is("$v1", '(0,0,0,0)', "all values are 0");
44 BEGIN { $tests += 3 };
49 # get_dims() has already been tested above...
52 $v1 = Language::Befunge::Vector->new(2, 5, 6);
54 my $v3 = $v1->vector_invert();
55 is($v1->get_component(0), 5, "X hasn't changed in v1");
56 is($v1->get_component(1), 6, "Y hasn't changed in v1");
57 is($v2->get_component(0), -5, "X is the inverse of v1's");
58 is($v2->get_component(1), -6, "Y is the inverse of v1's");
59 is($v3->get_component(0), -5, "X is the inverse of v1's");
60 is($v3->get_component(1), -6, "Y is the inverse of v1's");
61 BEGIN { $tests += 6 };
64 my $v4 = Language::Befunge::Vector->new(2, 1, 1);
66 $v3 = $v1->vector_add($v4);
67 is($v1->get_component(0), 5, "X hasn't changed in v1");
68 is($v1->get_component(1), 6, "Y hasn't changed in v1");
69 is($v4->get_component(0), 1, "X hasn't changed in v4");
70 is($v4->get_component(1), 1, "Y hasn't changed in v4");
71 is($v2->get_component(0), 6, "X is v1's X plus v4's X");
72 is($v2->get_component(1), 7, "Y is v1's Y plus v4's Y");
73 is($v3->get_component(0), 6, "X is v1's X plus v4's X");
74 is($v3->get_component(1), 7, "Y is v1's Y plus v4's Y");
75 BEGIN { $tests += 8 };
78 $v2 = $v1->vector_copy();
80 $v2->vector_add_inplace($v4);
81 is($v1->get_component(0), 6, "X has had 1 added in v1");
82 is($v1->get_component(1), 7, "Y has had 1 added in v1");
83 is($v2->get_component(0), 6, "X has had 1 added in v2");
84 is($v2->get_component(1), 7, "Y has had 1 added in v2");
85 is($v4->get_component(0), 1, "X hasn't changed in v4");
86 is($v4->get_component(1), 1, "Y hasn't changed in v4");
87 BEGIN { $tests += 6 };
90 $v2 = $v1->vector_copy();
92 is($v1->get_component(0), $v2->get_component(0), "X has been copied");
93 is($v1->get_component(1), $v2->get_component(1), "Y has been copied");
95 is($v1->get_component(0), 7, "X has had 1 added in v1");
96 is($v1->get_component(1), 8, "Y has had 1 added in v1");
97 is($v2->get_component(0), 6, "X hasn't changed in v2");
98 is($v2->get_component(1), 7, "Y hasn't changed in v2");
99 is($v3->get_component(0), 6, "X hasn't changed in v3");
100 is($v3->get_component(1), 7, "Y hasn't changed in v3");
101 BEGIN { $tests += 8 };
104 $v1->set_component(0,1);
105 $v1->set_component(1,2);
106 is($v1->get_component(0), 1, "X is now 1");
107 is($v1->get_component(1), 2, "Y is now 2");
108 is($v1->vector_as_string, "(1,2)", "setd works");
109 BEGIN { $tests += 3 };
111 # getd is tested all over this script.
114 my @list = $v1->get_all_components;
115 is(scalar @list, 2, "get_all_components returned 2 elements");
116 is($list[0], 1, "X is 1");
117 is($list[1], 2, "Y is 2");
118 BEGIN { $tests += 3 };
122 is($v1->get_component(0), 0, "X is now 0");
123 is($v1->get_component(1), 0, "Y is now 0");
124 BEGIN { $tests += 2 };
127 $v1 = Language::Befunge::Vector->new(2, -1, -1);
128 $v2 = Language::Befunge::Vector->new(2, 2, 2);
129 $v3 = Language::Befunge::Vector->new(2, -1, -2);
130 ok(!$v3->bounds_check($v1, $v2), "(-1,-2) is out of bounds");
131 $v3 = Language::Befunge::Vector->new(2, 0, -1);
132 ok( $v3->bounds_check($v1, $v2), "(0,-1) is within bounds");
133 $v3 = Language::Befunge::Vector->new(2, 2, 2);
134 ok( $v3->bounds_check($v1, $v2), "(2,2) is within bounds");
135 $v3 = Language::Befunge::Vector->new(2, 3, 2);
136 ok(!$v3->bounds_check($v1, $v2), "(3,2) is out of bounds");
137 $v3 = Language::Befunge::Vector->new(2, -1, -1);
138 ok( $v3->bounds_check($v1, $v2), "(-1,-1) is within bounds");
139 $v3 = Language::Befunge::Vector->new(2, 23, 0);
140 ok(!$v3->bounds_check($v1, $v2), "(23,0) is out of bounds");
141 $v3 = Language::Befunge::Vector->new(2, 0, 23);
142 ok(!$v3->bounds_check($v1, $v2), "(0,23) is out of bounds");
143 BEGIN { $tests += 7 };
145 # vector_as_string is already tested, above
148 $v1 = Language::Befunge::Vector->new(2, 1, 1);
149 $v2 = Language::Befunge::Vector->new(2, 1, 1);
150 $v3 = Language::Befunge::Vector->new(2, 1, 2);
151 ok( $v1 == $v2 , "v1 == v2");
152 ok( $v2 == $v1 , "v2 == v1");
153 ok( $v1 == $v1 , "v1 == v1");
154 ok(!($v1 == $v3), "!(v1 == v3)");
155 ok(!($v2 == $v3), "!(v2 == v3)");
156 ok( $v1->vector_equality($v2) , "v1 == v2");
157 ok( $v2->vector_equality($v1) , "v2 == v1");
158 ok( $v1->vector_equality($v1) , "v1 == v1");
159 ok(!($v1->vector_equality($v3)), "!(v1 == v3)");
160 ok(!($v2->vector_equality($v3)), "!(v2 == v3)");
161 BEGIN { $tests += 10 };
164 $v1 = Language::Befunge::Vector->new(2, 1, 1);
165 $v2 = Language::Befunge::Vector->new(2, 1, 1);
166 $v3 = Language::Befunge::Vector->new(2, 1, 2);
167 ok(!($v1 != $v2), "!(v1 != v2)");
168 ok(!($v2 != $v1), "!(v2 != v1)");
169 ok(!($v1 != $v1), "!(v1 != v1)");
170 ok( ($v1 != $v3), "v1 != v3");
171 ok( ($v2 != $v3), "v2 != v3");
172 ok(!($v1->vector_inequality($v2)), "!(v1 != v2)");
173 ok(!($v2->vector_inequality($v1)), "!(v2 != v1)");
174 ok(!($v1->vector_inequality($v1)), "!(v1 != v1)");
175 ok( ($v1->vector_inequality($v3)), "v1 != v3");
176 ok( ($v2->vector_inequality($v3)), "v2 != v3");
177 BEGIN { $tests += 10 };
179 # finally, test all the possible ways to die
181 skip 'need Test::Exception', 18 unless $test_exception_loaded;
183 throws_ok(sub { Language::Befunge::Vector->new() },
184 qr/Usage/, "Vector->new needs a defined 'dimensions' argument");
185 throws_ok(sub { Language::Befunge::Vector->new(0) },
186 qr/Usage/, "Vector->new needs a non-zero 'dimensions' argument");
187 throws_ok(sub { Language::Befunge::Vector->new(1) },
188 qr/Usage/, "Vector->new checks the number of args it got");
189 throws_ok(sub { Language::Befunge::Vector->new(1, 2, 3) },
190 qr/Usage/, "Vector->new checks the number of args it got");
192 throws_ok(sub { Language::Befunge::Vector->new_zeroes() },
193 qr/Usage/, "Vector->new_zeroes needs a defined 'dimensions' argument");
194 throws_ok(sub { Language::Befunge::Vector->new_zeroes(0) },
195 qr/Usage/, "Vector->new_zeroes needs a non-zero 'dimensions' argument");
196 my $tref_v = Language::Befunge::Vector->new(3, 4, 5, 6);
197 my $bef_v = Language::Befunge::Vector->new(2, 3, 4);
199 throws_ok(sub { my $blah = $tref_v - $bef_v },
200 qr/uneven dimensions/, "misaligned vector arithmetic (-)");
202 throws_ok(sub { my $blah = $tref_v + $bef_v },
203 qr/uneven dimensions/, "misaligned vector arithmetic (+)");
205 throws_ok(sub { $tref_v += $bef_v },
206 qr/uneven dimensions/, "misaligned vector arithmetic (+=)");
208 throws_ok(sub { $tref_v->set_component(3, 0) },
209 qr/No such dimension/, "setd takes dimension range 0..2 for 3d");
210 throws_ok(sub { $bef_v->set_component(-1, 0) },
211 qr/No such dimension/, "setd takes dimension range 0..1 for 2d");
213 throws_ok(sub { $tref_v->get_component(3) },
214 qr/No such dimension/, "getd takes dimension range 0..2 for 3d");
215 throws_ok(sub { $bef_v->get_component(-1) },
216 qr/No such dimension/, "getd takes dimension range 0..1 for 2d");
218 throws_ok(sub { $tref_v->bounds_check($v1, $v2) },
219 qr/uneven dimensions/, "bounds check catches wrong dimension in first arg");
220 throws_ok(sub { $v1->bounds_check($tref_v, $v2) },
221 qr/uneven dimensions/, "bounds check catches wrong dimension in second arg");
222 throws_ok(sub { $v1->bounds_check($v2, $tref_v) },
223 qr/uneven dimensions/, "bounds check catches wrong dimension in third arg");
225 throws_ok(sub { $tref_v == $bef_v },
226 qr/uneven dimensions/, "misaligned vector arithmetic (==)");
228 throws_ok(sub { $tref_v != $bef_v },
229 qr/uneven dimensions/, "misaligned vector arithmetic (!=)");
231 BEGIN { $tests += 18 };
237 BEGIN { plan tests => $tests };