Skip Menu |
 

This queue is for tickets about the Test-Unit CPAN distribution.

Report information
The Basics
Id: 4613
Status: open
Priority: 0/
Queue: Test-Unit

People
Owner: mca1001 [...] users.sourceforge.net
Requestors: Marek.Rouchal [...] gmx.net
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: 0.24
Fixed in: (no value)

Attachments


Subject: assertions for objects
Download (untitled) / with headers
text/plain 371b
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
Download Test-Unit.diff
text/x-diff 5.6k
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.
Download (untitled) / with headers
text/plain 561b
I've applied your patch to CVS, plus some small changes to error messages, http://cvs.sourceforge.net/viewcvs.py/perlunit/src/Test-Unit/lib/Test/Unit/Assert.pm http://cvs.sourceforge.net/viewcvs.py/perlunit/src/Test-Unit/t/tlib/AssertTest.pm I see that you have explicitly rejected assert_isa("Superclass", "Class") and assert_can("method", "Class"). I thought this might be worth discussing on the list - more to follow. I already have a fix for examples/fail_example.pm & t/try_examples.t so I didn't use that part of the patch. Thanks for your help.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.