3 # This file is part of Language::Befunge.
4 # Copyright (c) 2001-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 tests
18 use Test::More tests => 73;
20 use Language::Befunge::IP;
21 use Language::Befunge::Vector;
23 my $ip = Language::Befunge::IP->new;
30 $v1 = Language::Befunge::Vector->new(2, 1, 0);
31 isa_ok($v1, "Language::Befunge::Vector");
32 is($v1->get_dims, 3, "three dimensions");
33 is($v1->get_component(0), 2, "X is correct");
34 is($v1->get_component(1), 1, "Y is correct");
35 is($v1->get_component(2), 0, "Z is correct");
36 is($v1->as_string, '(2,1,0)', "stringifies back to (2,1,0)");
37 is("$v1", '(2,1,0)', "overloaded stringify back to (2,1,0)");
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");
49 is("$v1", "$v2", "v1 has been copied");
50 $v1 += Language::Befunge::Vector->new(1,1,1,1);
51 is("$v1", "(1,1,1,1)", "v1 has had 1 added");
52 is("$v2", "(0,0,0,0)", "v2 hasn't changed");
53 is("$v3", "(0,0,0,0)", "v3 hasn't changed");
60 # get_dims() has already been tested above...
62 # get_component() is tested all over this script.
64 # get_all_components()
65 my @list = $v1->get_all_components;
66 is(scalar @list, 4, "get_all_components returned 2 elements");
67 is($list[0], 1, "X is 1");
68 is($list[1], 1, "Y is 1");
69 is($list[2], 1, "Z is 1");
70 is($list[3], 1, "T is 1");
72 # as_string() is already tested above.
78 is($v1->get_component(0), 0, "X is now 0");
79 is($v1->get_component(1), 0, "Y is now 0");
82 $v1->set_component(0,3);
83 $v1->set_component(1,2);
84 is($v1->get_component(0), 3, "X is now 1");
85 is($v1->get_component(1), 2, "Y is now 2");
86 is($v1->as_string, "(3,2,0,0)", "set_component() works");
91 $v1 = Language::Befunge::Vector->new(-1, -1);
92 $v2 = Language::Befunge::Vector->new(2, 2);
93 $v3 = Language::Befunge::Vector->new(-1, -2);
94 ok(!$v3->bounds_check($v1, $v2), "(-1,-2) is out of bounds");
95 $v3 = Language::Befunge::Vector->new(0, -1);
96 ok( $v3->bounds_check($v1, $v2), "(0,-1) is within bounds");
97 $v3 = Language::Befunge::Vector->new(2, 2);
98 ok( $v3->bounds_check($v1, $v2), "(2,2) is within bounds");
99 $v3 = Language::Befunge::Vector->new(3, 2);
100 ok(!$v3->bounds_check($v1, $v2), "(3,2) is out of bounds");
101 $v3 = Language::Befunge::Vector->new(-1, -1);
102 ok( $v3->bounds_check($v1, $v2), "(-1,-1) is within bounds");
103 $v3 = Language::Befunge::Vector->new(23, 0);
104 ok(!$v3->bounds_check($v1, $v2), "(23,0) is out of bounds");
105 $v3 = Language::Befunge::Vector->new(0, 23);
106 ok(!$v3->bounds_check($v1, $v2), "(0,23) is out of bounds");
111 $v1 = Language::Befunge::Vector->new(5, 6);
112 $v4 = Language::Befunge::Vector->new(1, 1);
114 is($v1->get_component(0), 5, "X hasn't changed in v1");
115 is($v1->get_component(1), 6, "Y hasn't changed in v1");
116 is($v4->get_component(0), 1, "X hasn't changed in v4");
117 is($v4->get_component(1), 1, "Y hasn't changed in v4");
118 is($v2->get_component(0), 6, "X is v1's X plus v4's X");
119 is($v2->get_component(1), 7, "Y is v1's Y plus v4's Y");
122 $v1 = Language::Befunge::Vector->new(5, 6);
124 is($v1->get_component(0), 5, "X hasn't changed in v1");
125 is($v1->get_component(1), 6, "Y hasn't changed in v1");
126 is($v2->get_component(0), -5, "X is the inverse of v1's");
127 is($v2->get_component(1), -6, "Y is the inverse of v1's");
134 is("$v1", "(6,7)", "v1 has had 1 added in X/Y");
135 is("$v2", "(5,6)", "v2 hasn't changed");
136 is("$v4", "(1,1)", "v4 hasn't changed");
138 # inplace substraction
141 is("$v3", "(5,6)", "v3 has had 1 substracted in X/Y");
142 is("$v1", "(6,7)", "v1 hasn't changed");
143 is("$v4", "(1,1)", "v4 hasn't changed");
149 $v1 = Language::Befunge::Vector->new(1, 1);
150 $v2 = Language::Befunge::Vector->new(1, 1);
151 $v3 = Language::Befunge::Vector->new(1, 2);
152 ok( $v1 == $v2 , "v1 == v2");
153 ok( $v2 == $v1 , "v2 == v1");
154 ok( $v1 == $v1 , "v1 == v1");
155 ok(!($v1 == $v3), "!(v1 == v3)");
156 ok(!($v2 == $v3), "!(v2 == v3)");
159 $v1 = Language::Befunge::Vector->new(1, 1);
160 $v2 = Language::Befunge::Vector->new(1, 1);
161 $v3 = Language::Befunge::Vector->new(1, 2);
162 ok(!($v1 != $v2), "!(v1 != v2)");
163 ok(!($v2 != $v1), "!(v2 != v1)");
164 ok(!($v1 != $v1), "!(v1 != v1)");
165 ok( ($v1 != $v3), "v1 != v3");
166 ok( ($v2 != $v3), "v2 != v3");
168 # finally, test all the possible ways to die
170 eval { require Test::Exception; Test::Exception->import; };
171 skip 'need Test::Exception', 18 unless defined $Test::Exception::VERSION;
175 throws_ok(sub { Language::Befunge::Vector->new() },
176 qr/Usage/, "Vector->new needs a defined 'dimensions' argument");
178 throws_ok(sub { Language::Befunge::Vector->new_zeroes() },
179 qr/Usage/, "Vector->new_zeroes needs a defined 'dimensions' argument");
180 throws_ok(sub { Language::Befunge::Vector->new_zeroes(0) },
181 qr/Usage/, "Vector->new_zeroes needs a non-zero 'dimensions' argument");
182 my $tref_v = Language::Befunge::Vector->new(4, 5, 6);
183 my $bef_v = Language::Befunge::Vector->new(3, 4);
187 throws_ok(sub { $tref_v->get_component(3) },
188 qr/No such dimension/, "get_component takes dimension range 0..2 for 3d");
189 throws_ok(sub { $bef_v->get_component(-1) },
190 qr/No such dimension/, "get_component takes dimension range 0..1 for 2d");
194 throws_ok(sub { $tref_v->set_component(3, 0) },
195 qr/No such dimension/, "set_component takes dimension range 0..2 for 3d");
196 throws_ok(sub { $bef_v->set_component(-1, 0) },
197 qr/No such dimension/, "set_component takes dimension range 0..1 for 2d");
199 #- other public methods
201 throws_ok(sub { $tref_v->bounds_check($v1, $v2) },
202 qr/uneven dimensions/, "bounds check catches wrong dimension in first arg");
203 throws_ok(sub { $v1->bounds_check($tref_v, $v2) },
204 qr/uneven dimensions/, "bounds check catches wrong dimension in second arg");
205 throws_ok(sub { $v1->bounds_check($v2, $tref_v) },
206 qr/uneven dimensions/, "bounds check catches wrong dimension in third arg");
210 throws_ok(sub { my $blah = $tref_v + $bef_v },
211 qr/uneven dimensions/, "misaligned vector arithmetic (+)");
213 throws_ok(sub { my $blah = $tref_v - $bef_v },
214 qr/uneven dimensions/, "misaligned vector arithmetic (-)");
218 throws_ok(sub { $tref_v += $bef_v },
219 qr/uneven dimensions/, "misaligned vector arithmetic (+=)");
220 # inplace substraction
221 throws_ok(sub { $tref_v -= $bef_v },
222 qr/uneven dimensions/, "misaligned vector arithmetic (-=)");
226 throws_ok(sub { $tref_v == $bef_v },
227 qr/uneven dimensions/, "misaligned vector arithmetic (==)");
229 throws_ok(sub { $tref_v != $bef_v },
230 qr/uneven dimensions/, "misaligned vector arithmetic (!=)");