| Subject: | assertions for objects |
We're happily using Test::Unit, and I'd like to contribute this patch
proposal, which implements assert_isa and assert_can to test properties
of objects.
Please check the attached patch, I tried to be consistent in the code,
the POD and the test; feel free to take it as is or to modify it such
that it fits in the general Test::Unit philosophy.
Best regards,
Marek
diff -ruN Test-Unit-0.24/examples/fail_example.pm Test-Unit-0.24p1/examples/fail_example.pm
--- Test-Unit-0.24/examples/fail_example.pm 2001-12-04 16:35:14.000000000 +0100
+++ Test-Unit-0.24p1/examples/fail_example.pm 2003-12-09 14:52:42.000000000 +0100
@@ -7,6 +7,12 @@
use base qw(Test::Unit::TestCase);
+# make sure we're running the correct order
+sub list_tests
+{
+ return sort shift->SUPER::list_tests;
+}
+
sub test_ok {
my $self = shift();
$self->assert(23 == 23);
diff -ruN Test-Unit-0.24/lib/Test/Unit/Assert.pm Test-Unit-0.24p1/lib/Test/Unit/Assert.pm
--- Test-Unit-0.24/lib/Test/Unit/Assert.pm 2002-06-12 20:50:43.000000000 +0200
+++ Test-Unit-0.24p1/lib/Test/Unit/Assert.pm 2003-12-09 14:37:45.000000000 +0100
@@ -470,6 +470,48 @@
Test::Unit::Failure->throw
(-text => @_ ? join('', @_) : "<undef> unexpected");
},
+ isa => sub {
+ my $class = shift;
+ my $obj = shift;
+ defined $class or
+ Test::Unit::Failure->throw(
+ -text => @_ ? join('',@_) :
+ "expected value was undef; should be using assert_null?"
+ );
+ defined $obj or
+ Test::Unit::Failure->throw(
+ -text => @_ ? join('',@_) : "expected class '$class', got undef"
+ );
+ (ref($obj) && ref($obj) !~ /^(SCALAR|ARRAY|HASH|CODE|REF|GLOB|LVALUE|Regexp)$/) or
+ Test::Unit::Failure->throw(
+ -text => @_ ? join('',@_) : "expected class '$class', got unblessed reference"
+ );
+ $obj->isa($class) or
+ Test::Unit::Failure->throw(
+ -text => @_ ? join('',@_) : "expected object of class '$class', got '".ref($obj)."'"
+ );
+ },
+ can => sub {
+ my $method = shift;
+ my $obj = shift;
+ defined $method or
+ Test::Unit::Failure->throw(
+ -text => @_ ? join('',@_) :
+ "expected value was undef; should be using assert_null?"
+ );
+ defined $obj or
+ Test::Unit::Failure->throw(
+ -text => @_ ? join('',@_) : "expected object, got undef"
+ );
+ (ref($obj) && ref($obj) !~ /^(SCALAR|ARRAY|HASH|CODE|REF|GLOB|LVALUE|Regexp)$/) or
+ Test::Unit::Failure->throw(
+ -text => @_ ? join('',@_) : "expected object, got unblessed reference"
+ );
+ $obj->can($method) or
+ Test::Unit::Failure->throw(
+ -text => @_ ? join('',@_) : "expected object that can '$method', but it cannot"
+ );
+ },
);
foreach my $type (keys %assert_subs) {
my $assertion = Test::Unit::Assertion::CodeRef->new($assert_subs{$type});
@@ -565,6 +607,10 @@
$self->assert_null(undef);
$self->assert_not_null('');
+ # assert object properties
+ $self->assert_isa('Critter', $object);
+ $self->assert_can('frobnicate', $object);
+
=head1 DESCRIPTION
This class contains the various standard assertions used within the
@@ -627,6 +673,12 @@
Assert that ARG is defined or not defined.
+=item assert_isa(CLASS, OBJECT [, MESSAGE])
+
+=item assert_can(METHOD, OBJECT [, MESSAGE])
+
+Assert that OBJECT belongs to a CLASS or can execute a METHOD.
+
=item assert(BOOLEAN [, MESSAGE])
Checks if the BOOLEAN expression returns a true value that is neither
diff -ruN Test-Unit-0.24/t/tlib/AssertTest.pm Test-Unit-0.24p1/t/tlib/AssertTest.pm
--- Test-Unit-0.24/t/tlib/AssertTest.pm 2002-05-23 17:08:33.000000000 +0200
+++ Test-Unit-0.24p1/t/tlib/AssertTest.pm 2003-12-09 14:50:05.000000000 +0100
@@ -328,6 +328,44 @@
$self->assert_not_null(10);
}
+sub test_succeed_assert_isa {
+ my $self = shift;
+ $self->assert_isa('TestObject', TestObject->new);
+}
+
+sub test_fail_assert_isa {
+ my $self = shift;
+ $self->check_failures(
+ "expected class 'FooBar', got undef"
+ => [ __LINE__, sub { shift->assert_isa('FooBar', undef) } ],
+ "expected class 'FooBar', got unblessed reference"
+ => [ __LINE__, sub { shift->assert_isa('FooBar', 123) } ],
+ "expected class 'FooBar', got unblessed reference"
+ => [ __LINE__, sub { shift->assert_isa('FooBar', [ qw( 1 2 3) ]) } ],
+ "expected object of class 'FooBar', got 'TestObject'"
+ => [ __LINE__, sub { shift->assert_isa('FooBar', TestObject->new) } ],
+ );
+}
+
+sub test_succeed_assert_can {
+ my $self = shift;
+ $self->assert_can('new', TestObject->new);
+}
+
+sub test_fail_assert_can {
+ my $self = shift;
+ $self->check_failures(
+ "expected object, got undef"
+ => [ __LINE__, sub { shift->assert_can('FooBar', undef) } ],
+ "expected object, got unblessed reference"
+ => [ __LINE__, sub { shift->assert_can('FooBar', 123) } ],
+ "expected object, got unblessed reference"
+ => [ __LINE__, sub { shift->assert_can('FooBar', [ qw( 1 2 3) ]) } ],
+ "expected object that can 'blah', but it cannot"
+ => [ __LINE__, sub { shift->assert_can('blah', TestObject->new) } ],
+ );
+}
+
sub test_assert_deep_equals {
my $self = shift;
diff -ruN Test-Unit-0.24/t/try_examples.t Test-Unit-0.24p1/t/try_examples.t
--- Test-Unit-0.24/t/try_examples.t 2001-12-11 16:17:11.000000000 +0100
+++ Test-Unit-0.24p1/t/try_examples.t 2003-12-09 14:53:36.000000000 +0100
@@ -58,7 +58,7 @@
Run: 2, Failures: 1, Errors: 0
There was 1 failure:
-1) examples/fail_example.pm:19 - test_fail(fail_example)
+1) examples/fail_example.pm:25 - test_fail(fail_example)
Born to lose ...
Test was not successful.