From 26f331eef6766f6a72ef639b213a4177a0f3d564 Mon Sep 17 00:00:00 2001
From: =?utf8?q?J=C3=A9r=C3=B4me=20Quelin?= <jquelin@gmail.com>
Date: Fri, 18 Jan 2008 16:35:21 +0100
Subject: [PATCH] rewrote vector tests

- more complete
      - missing tests added for substraction
      - testing some more isa_ok
      - some border cases added
      - etc.
- simpler (using more stringification)
- tests start aclean (new vecs) before each tests, in order to be able
  to move them within file easily
- test::exception skips are spread out near the feature they test,
  instead of grouped at the end of the file
- exact test count, even without test::exception
---
 t/1-classes/vector.t | 508 ++++++++++++++++++++++++++++-----------------------
 1 file changed, 275 insertions(+), 233 deletions(-)
 rewrite t/1-classes/vector.t (75%)

diff --git a/t/1-classes/vector.t b/t/1-classes/vector.t
dissimilarity index 75%
index 08dfb80..fb2fbc8 100644
--- a/t/1-classes/vector.t
+++ b/t/1-classes/vector.t
@@ -1,233 +1,275 @@
-#!perl
-#
-# This file is part of Language::Befunge.
-# Copyright (c) 2001-2008 Jerome Quelin, all rights reserved.
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the same terms as Perl itself.
-#
-#
-
-#
-# Language::Befunge::Vector tests
-#
-
-use strict;
-use warnings;
-
-use Test::More tests => 73;
-
-use Language::Befunge::IP;
-use Language::Befunge::Vector;
-
-my $ip = Language::Befunge::IP->new;
-my ($v1,$v2,$v3,$v4);
-
-
-# -- CONSTRUCTORS
-
-# new()
-$v1 = Language::Befunge::Vector->new(2, 1, 0);
-isa_ok($v1,                          "Language::Befunge::Vector");
-is($v1->get_dims,                 3, "three dimensions");
-is($v1->get_component(0),         2, "X is correct");
-is($v1->get_component(1),         1, "Y is correct");
-is($v1->get_component(2),         0, "Z is correct");
-is($v1->as_string,        '(2,1,0)', "stringifies back to (2,1,0)");
-is("$v1",                 '(2,1,0)', "overloaded stringify back to (2,1,0)");
-
-# new_zeroes()
-$v1 = Language::Befunge::Vector->new_zeroes(4);
-isa_ok( $v1,              "Language::Befunge::Vector");
-is($v1->get_dims, 4,      "four dimensions");
-is("$v1",    '(0,0,0,0)', "all values are 0");
-
-
-# copy()
-$v2 = $v1->copy;
-$v3 = $v1;
-is("$v1", "$v2", "v1 has been copied");
-$v1 += Language::Befunge::Vector->new(1,1,1,1);
-is("$v1", "(1,1,1,1)", "v1 has had 1 added");
-is("$v2", "(0,0,0,0)", "v2 hasn't changed");
-is("$v3", "(0,0,0,0)", "v3 hasn't changed");
-
-
-# -- PUBLIC METHODS
-
-#- accessors
-
-# get_dims() has already been tested above...
-
-# get_component() is tested all over this script.
-
-# get_all_components()
-my @list = $v1->get_all_components;
-is(scalar @list, 4, "get_all_components returned 2 elements");
-is($list[0], 1, "X is 1");
-is($list[1], 1, "Y is 1");
-is($list[2], 1, "Z is 1");
-is($list[3], 1, "T is 1");
-
-# as_string() is already tested above.
-
-#- mutators
-
-# clear()
-$v1->clear;
-is($v1->get_component(0), 0, "X is now 0");
-is($v1->get_component(1), 0, "Y is now 0");
-
-# set_component()
-$v1->set_component(0,3);
-$v1->set_component(1,2);
-is($v1->get_component(0),           3, "X is now 1");
-is($v1->get_component(1),           2, "Y is now 2");
-is($v1->as_string,        "(3,2,0,0)", "set_component() works");
-
-#- other methods
-
-# bounds_check()
-$v1 = Language::Befunge::Vector->new(-1, -1);
-$v2 = Language::Befunge::Vector->new(2,  2);
-$v3 = Language::Befunge::Vector->new(-1, -2);
-ok(!$v3->bounds_check($v1, $v2), "(-1,-2) is out of bounds");
-$v3 = Language::Befunge::Vector->new(0, -1);
-ok( $v3->bounds_check($v1, $v2), "(0,-1) is within bounds");
-$v3 = Language::Befunge::Vector->new(2, 2);
-ok( $v3->bounds_check($v1, $v2), "(2,2) is within bounds");
-$v3 = Language::Befunge::Vector->new(3, 2);
-ok(!$v3->bounds_check($v1, $v2), "(3,2) is out of bounds");
-$v3 = Language::Befunge::Vector->new(-1, -1);
-ok( $v3->bounds_check($v1, $v2), "(-1,-1) is within bounds");
-$v3 = Language::Befunge::Vector->new(23, 0);
-ok(!$v3->bounds_check($v1, $v2), "(23,0) is out of bounds");
-$v3 = Language::Befunge::Vector->new(0, 23);
-ok(!$v3->bounds_check($v1, $v2), "(0,23) is out of bounds");
-
-#- math ops
-
-# addition
-$v1 = Language::Befunge::Vector->new(5, 6);
-$v4 = Language::Befunge::Vector->new(1, 1);
-$v2 = $v1 + $v4;
-is($v1->get_component(0), 5, "X hasn't changed in v1");
-is($v1->get_component(1), 6, "Y hasn't changed in v1");
-is($v4->get_component(0), 1, "X hasn't changed in v4");
-is($v4->get_component(1), 1, "Y hasn't changed in v4");
-is($v2->get_component(0), 6, "X is v1's X plus v4's X");
-is($v2->get_component(1), 7, "Y is v1's Y plus v4's Y");
-
-# inversion
-$v1 = Language::Befunge::Vector->new(5, 6);
-$v2 = -$v1;
-is($v1->get_component(0),  5, "X hasn't changed in v1");
-is($v1->get_component(1),  6, "Y hasn't changed in v1");
-is($v2->get_component(0), -5, "X is the inverse of v1's");
-is($v2->get_component(1), -6, "Y is the inverse of v1's");
-
-#- inplace math ops
-
-# inplace addition
-$v2 = $v1->copy;
-$v1 += $v4;
-is("$v1", "(6,7)", "v1 has had 1 added in X/Y");
-is("$v2", "(5,6)", "v2 hasn't changed");
-is("$v4", "(1,1)", "v4 hasn't changed");
-
-# inplace substraction
-$v3 = $v1->copy;
-$v3 -= $v4;
-is("$v3", "(5,6)", "v3 has had 1 substracted in X/Y");
-is("$v1", "(6,7)", "v1 hasn't changed");
-is("$v4", "(1,1)", "v4 hasn't changed");
-
-
-#- comparison
-
-# equality
-$v1 = Language::Befunge::Vector->new(1, 1);
-$v2 = Language::Befunge::Vector->new(1, 1);
-$v3 = Language::Befunge::Vector->new(1, 2);
-ok(  $v1 == $v2 , "v1 == v2");
-ok(  $v2 == $v1 , "v2 == v1");
-ok(  $v1 == $v1 , "v1 == v1");
-ok(!($v1 == $v3), "!(v1 == v3)");
-ok(!($v2 == $v3), "!(v2 == v3)");
-
-# inequality
-$v1 = Language::Befunge::Vector->new(1, 1);
-$v2 = Language::Befunge::Vector->new(1, 1);
-$v3 = Language::Befunge::Vector->new(1, 2);
-ok(!($v1 != $v2), "!(v1 != v2)");
-ok(!($v2 != $v1), "!(v2 != v1)");
-ok(!($v1 != $v1), "!(v1 != v1)");
-ok( ($v1 != $v3), "v1 != v3");
-ok( ($v2 != $v3), "v2 != v3");
-
-# finally, test all the possible ways to die
-SKIP: {
-    eval { require Test::Exception; Test::Exception->import; };
-    skip 'need Test::Exception', 18 unless defined $Test::Exception::VERSION;
-
-    #- constructors
-	# new()
-	throws_ok(sub { Language::Befunge::Vector->new() },
-		qr/Usage/, "Vector->new needs a defined 'dimensions' argument");
-	# new_zeroes()
-	throws_ok(sub { Language::Befunge::Vector->new_zeroes() },
-		qr/Usage/, "Vector->new_zeroes needs a defined 'dimensions' argument");
-	throws_ok(sub { Language::Befunge::Vector->new_zeroes(0) },
-		qr/Usage/, "Vector->new_zeroes needs a non-zero 'dimensions' argument");
-	my $tref_v = Language::Befunge::Vector->new(4, 5, 6);
-	my  $bef_v = Language::Befunge::Vector->new(3, 4);
-
-    #- accessors
-	# get_component()
-	throws_ok(sub { $tref_v->get_component(3) },
-		qr/No such dimension/, "get_component takes dimension range 0..2 for 3d");
-	throws_ok(sub { $bef_v->get_component(-1) },
-		qr/No such dimension/, "get_component takes dimension range 0..1 for 2d");
-
-    #- mutators
-	# set_component()
-	throws_ok(sub { $tref_v->set_component(3, 0) },
-		qr/No such dimension/, "set_component takes dimension range 0..2 for 3d");
-	throws_ok(sub { $bef_v->set_component(-1, 0) },
-		qr/No such dimension/, "set_component takes dimension range 0..1 for 2d");
-
-    #- other public methods
-	# bounds_check()
-	throws_ok(sub { $tref_v->bounds_check($v1, $v2) },
-		qr/uneven dimensions/, "bounds check catches wrong dimension in first arg");
-	throws_ok(sub { $v1->bounds_check($tref_v, $v2) },
-		qr/uneven dimensions/, "bounds check catches wrong dimension in second arg");
-	throws_ok(sub { $v1->bounds_check($v2, $tref_v) },
-		qr/uneven dimensions/, "bounds check catches wrong dimension in third arg");
-
-    #- math ops
-	# addition
-	throws_ok(sub { my $blah = $tref_v + $bef_v },
-		qr/uneven dimensions/, "misaligned vector arithmetic (+)");
-	# substraction
-	throws_ok(sub { my $blah = $tref_v - $bef_v },
-		qr/uneven dimensions/, "misaligned vector arithmetic (-)");
-
-    #- inplace math ops
-	# inplace addition
-	throws_ok(sub { $tref_v += $bef_v },
-		qr/uneven dimensions/, "misaligned vector arithmetic (+=)");
-	# inplace substraction
-	throws_ok(sub { $tref_v -= $bef_v },
-		qr/uneven dimensions/, "misaligned vector arithmetic (-=)");
-
-	#- comparison
-    # equality
-	throws_ok(sub { $tref_v == $bef_v },
-		qr/uneven dimensions/, "misaligned vector arithmetic (==)");
-	# inequality
-	throws_ok(sub { $tref_v != $bef_v },
-		qr/uneven dimensions/, "misaligned vector arithmetic (!=)");
-}
-
-
+#!perl
+#
+# This file is part of Language::Befunge.
+# Copyright (c) 2001-2008 Jerome Quelin, all rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+#
+
+#
+# Language::Befunge::Vector tests
+#
+
+use strict;
+use warnings;
+
+use Test::More tests => 94;
+
+use Language::Befunge::Vector;
+
+
+# check prereq for test
+eval "use Test::Exception";
+my $has_test_exception = defined($Test::Exception::VERSION);
+
+
+my ($v1, $v2, $v3, $v4, @coords);
+my $v2d = Language::Befunge::Vector->new(3,4);
+my $v3d = Language::Befunge::Vector->new(5,6,7);
+
+
+# -- CONSTRUCTORS
+
+# new()
+$v1 = Language::Befunge::Vector->new(7,8,9);
+isa_ok($v1,                          "Language::Befunge::Vector");
+is($v1->get_dims,                 3, "three dimensions");
+is($v1->get_component(0),         7, "X is correct");
+is($v1->get_component(1),         8, "Y is correct");
+is($v1->get_component(2),         9, "Z is correct");
+is($v1->as_string,        '(7,8,9)', "stringifies back to (7,8,9)");
+is("$v1",                 '(7,8,9)', "overloaded stringify back to (7,8,9)");
+SKIP: {
+    skip "need Test::Exception", 1 unless $has_test_exception;
+	throws_ok(sub { Language::Befunge::Vector->new() },
+		qr/Usage/, "LBV->new needs a defined 'dimensions' argument");
+}
+
+
+# new_zeroes()
+$v1 = Language::Befunge::Vector->new_zeroes(4);
+isa_ok($v1,                            "Language::Befunge::Vector");
+is($v1->get_dims,                   4, "four dimensions");
+is($v1->get_component(0),           0, "X is correct");
+is($v1->get_component(1),           0, "Y is correct");
+is($v1->get_component(2),           0, "Z is correct");
+is($v1->get_component(3),           0, "T is correct");
+is("$v1",                 '(0,0,0,0)', "all values are 0");
+SKIP: {
+    skip "need Test::Exception", 2 unless $has_test_exception;
+	throws_ok(sub { Language::Befunge::Vector->new_zeroes() },
+		qr/Usage/, "LBV->new_zeroes needs a defined 'dimensions' argument");
+	throws_ok(sub { Language::Befunge::Vector->new_zeroes(0) },
+		qr/Usage/, "LBV->new_zeroes needs a non-zero 'dimensions' argument");
+}
+
+
+# copy()
+$v1 = Language::Befunge::Vector->new(2,3,4,5);
+$v4 = Language::Befunge::Vector->new(6,7,8,9);
+$v2 = $v1->copy;
+$v3 = $v1;
+is("$v1", "$v2", "v1 has been copied");
+$v1 += $v4;
+is("$v1", "(8,10,12,14)", "v1 has had v4 added");
+is("$v2",    "(2,3,4,5)", "v2 hasn't changed");
+is("$v3",    "(2,3,4,5)", "v3 hasn't changed");
+
+
+
+# -- PUBLIC METHODS
+
+#- accessors
+
+# get_dims() has already been tested above...
+
+
+# get_component()
+# regular behaviour is tested all over this script.
+$v1 = Language::Befunge::Vector->new(2,3);
+SKIP: {
+    skip "need Test::Exception", 2 unless $has_test_exception;
+	throws_ok(sub { $v2d->get_component(-1) },
+		qr/No such dimension/, "get_component() checks min dimension");
+	throws_ok(sub { $v1->get_component(2) },
+		qr/No such dimension/, "get_component() checks max dimension");
+}
+
+
+# get_all_components()
+$v1 = Language::Befunge::Vector->new(2,3,4,5);
+my @list = $v1->get_all_components;
+is(scalar @list, 4, "get_all_components() returned 4 elements");
+is($list[0], 2, "X is 2");
+is($list[1], 3, "Y is 3");
+is($list[2], 4, "Z is 4");
+is($list[3], 5, "T is 5");
+
+
+# as_string() is already tested above.
+
+
+#- mutators
+
+# clear()
+$v1 = Language::Befunge::Vector->new(2,3,4,5);
+$v1->clear;
+is("$v1",                 '(0,0,0,0)', "clear() sets all values are 0");
+is($v1->get_component(0),           0, "X is now 0");
+is($v1->get_component(1),           0, "Y is now 0");
+is($v1->get_component(2),           0, "Z is now 0");
+is($v1->get_component(3),           0, "T is now 0");
+
+
+# set_component()
+$v1 = Language::Befunge::Vector->new(2,3,4,5);
+$v1->set_component(0,9);
+$v1->set_component(1,6);
+is($v1->as_string,        "(9,6,4,5)", "set_component() works");
+is($v1->get_component(0),           9, "X is now 9");
+is($v1->get_component(1),           6, "Y is now 6");
+is($v1->get_component(2),           4, "Z is still 4");
+is($v1->get_component(3),           5, "T is still 5");
+SKIP: {
+    skip "need Test::Exception", 2 unless $has_test_exception;
+	throws_ok(sub { $v1->set_component(-1, 0) },
+		qr/No such dimension/, "set_component() checks min dimension");
+	throws_ok(sub { $v1->set_component(4, 0) },
+		qr/No such dimension/, "set_component() checks max dimension");
+}
+
+
+#- other methods
+
+# bounds_check()
+$v1 = Language::Befunge::Vector->new(-1, -1);
+$v2 = Language::Befunge::Vector->new( 2,  2);
+@coords = ( [1,1], [-1,1], [1,-1], [-1,-1], [2,1], [1,2], [2,2] );
+foreach my $coords ( @coords ) {
+    $v3 = Language::Befunge::Vector->new(@$coords);
+    ok($v3->bounds_check($v1, $v2), "$v3 is within bounds");
+}
+@coords = ( [3,3], [3,1], [1,3], [-2,1], [1,-2], [-2,-2] );
+foreach my $coords ( @coords ) {
+    $v3 = Language::Befunge::Vector->new(@$coords);
+    ok(!$v3->bounds_check($v1, $v2), "$v3 is within bounds");
+}
+SKIP: {
+    skip "need Test::Exception", 3 unless $has_test_exception;
+	throws_ok(sub { $v3d->bounds_check($v1, $v2) },
+		qr/uneven dimensions/, "bounds_check() catches wrong dimension in first arg");
+	throws_ok(sub { $v1->bounds_check($v3d, $v2) },
+		qr/uneven dimensions/, "bounds_check() catches wrong dimension in second arg");
+	throws_ok(sub { $v1->bounds_check($v2, $v3d) },
+		qr/uneven dimensions/, "bounds_check() catches wrong dimension in third arg");
+}
+
+
+#- math ops
+
+# addition
+$v1 = Language::Befunge::Vector->new(4,5,6);
+$v2 = Language::Befunge::Vector->new(1,2,3);
+$v3 = $v1 + $v2;
+is("$v1",   '(4,5,6)', "addition doesn't change v1");
+is("$v2",   '(1,2,3)', "addition doesn't change v2");
+isa_ok($v3,            "Language::Befunge::Vector");
+is("$v3",   '(5,7,9)', "v3 is v1 plus v2");
+SKIP: {
+    skip "need Test::Exception", 1 unless $has_test_exception;
+	throws_ok(sub { my $blah = $v2d + $v3d },
+		qr/uneven dimensions/, "misaligned vector arithmetic (+)");
+}
+
+
+# substraction
+$v1 = Language::Befunge::Vector->new(4,5,6);
+$v2 = Language::Befunge::Vector->new(3,2,1);
+$v3 = $v1 - $v2;
+is("$v1",   '(4,5,6)', "substraction doesn't change v1");
+is("$v2",   '(3,2,1)', "substraction doesn't change v2");
+isa_ok($v3,            "Language::Befunge::Vector");
+is("$v3",   '(1,3,5)', "v3 is v1 minus v2");
+SKIP: {
+    skip "need Test::Exception", 1 unless $has_test_exception;
+	throws_ok(sub { my $blah = $v2d - $v3d },
+		qr/uneven dimensions/, "misaligned vector arithmetic (-)");
+}
+
+
+# inversion
+$v1 = Language::Befunge::Vector->new(4,5,6);
+$v2 = -$v1;
+is("$v1",      '(4,5,6)', "inversion doesn't change v1");
+is("$v2",   '(-4,-5,-6)', "inversion doesn't change v2");
+
+
+#- inplace math ops
+
+# inplace addition
+$v1 = Language::Befunge::Vector->new(4,5,6);
+$v2 = Language::Befunge::Vector->new(1,2,3);
+$v1 += $v2;
+is("$v1", "(5,7,9)", "inplace addition changes v1");
+is("$v2", "(1,2,3)", "inplace addition doesn't change v2");
+SKIP: {
+    skip "need Test::Exception", 1 unless $has_test_exception;
+	throws_ok(sub { $v2d += $v3d },
+		qr/uneven dimensions/, "misaligned vector arithmetic (+=)");
+}
+
+
+# inplace substraction
+$v1 = Language::Befunge::Vector->new(4,5,6);
+$v2 = Language::Befunge::Vector->new(3,2,1);
+$v1 -= $v2;
+is("$v1", "(1,3,5)", "inplace substraction changes v1");
+is("$v2", "(3,2,1)", "inplace substraction doesn't change v2");
+SKIP: {
+    skip "need Test::Exception", 1 unless $has_test_exception;
+	throws_ok(sub { $v2d -= $v3d },
+		qr/uneven dimensions/, "misaligned vector arithmetic (-=)");
+}
+
+
+#- comparison
+
+# equality
+$v1 = Language::Befunge::Vector->new(1,2,3);
+$v2 = Language::Befunge::Vector->new(1,2,3);
+ok($v1 == $v1, "v1 == v1");
+ok($v1 == $v2, "v1 == v2");
+ok($v2 == $v1, "v2 == v1");
+@coords = ( [0,2,3], [1,0,3], [1,2,0] );
+foreach my $coords ( @coords ) {
+    $v3 = Language::Befunge::Vector->new(@$coords);
+    ok(!($v1 == $v3), "!(v1 == $v3)");
+    ok(!($v2 == $v3), "!(v2 == $v3)");
+}
+SKIP: {
+    skip "need Test::Exception", 1 unless $has_test_exception;
+	throws_ok(sub { $v2d == $v3d },
+		qr/uneven dimensions/, "misaligned vector arithmetic (==)");
+}
+
+
+# inequality
+$v1 = Language::Befunge::Vector->new(1,2,3);
+$v2 = Language::Befunge::Vector->new(1,2,3);
+ok(!($v1 != $v1), "!(v1 != v1)");
+ok(!($v1 != $v2), "!(v1 != v2)");
+ok(!($v2 != $v1), "!(v2 != v1)");
+@coords = ( [0,2,3], [1,0,3], [1,2,0] );
+foreach my $coords ( @coords ) {
+    $v3 = Language::Befunge::Vector->new(@$coords);
+    ok($v1 != $v3, "v1 != $v3)");
+    ok($v2 != $v3, "v2 != $v3)");
+}
+SKIP: {
+    skip "need Test::Exception", 1 unless $has_test_exception;
+	throws_ok(sub { $v2d != $v3d },
+		qr/uneven dimensions/, "misaligned vector arithmetic (!=)");
+}
+
-- 
2.11.4.GIT