Initial Commit

database/perl/vendor/lib/Test/Object.pm

@@ -0,0 +1,174 @@
+package Test::Object; # git description: 1392ed9
+
+=pod
+
+=head1 NAME
+
+Test::Object - Thoroughly testing objects via registered handlers
+
+=head1 VERSION
+
+version 0.08
+
+=head1 SYNOPSIS
+
+  ###################################################################
+  # In your test module, register test handlers again class names   #
+  ###################################################################
+  
+  package My::ModuleTester;
+  
+  use Test::More;
+  use Test::Object;
+  
+  # Foo::Bar is a subclass of Foo
+  Test::Object->register(
+  	class => 'Foo',
+  	tests => 5,
+  	code  => \&foo_ok,
+  	);
+  Test::Object->register(
+  	class => 'Foo::Bar',
+  	# No fixed number of tests
+  	code  => \&foobar_ok,
+  	);
+  
+  sub foo_ok {
+  	my $object = shift;
+  	ok( $object->foo, '->foo returns true' );
+  }
+  
+  sub foobar_ok {
+  	my $object = shift;
+  	is( $object->foo, 'bar', '->foo returns "bar"' );
+  }
+  
+  1;
+  
+  
+  
+  ###################################################################
+  # In test script, test object against all registered classes      #
+  ###################################################################
+  
+  #!/usr/bin/perl -w
+  
+  use Test::More 'no_plan';
+  use Test::Object;
+  use My::ModuleTester;
+  
+  my $object = Foo::Bar->new;
+  isa_ok( $object, 'Foo::Bar' );
+  object_ok( $object );
+
+=head1 DESCRIPTION
+
+In situations where you have deep trees of classes, there is a common
+situation in which you test a module 4 or 5 subclasses down, which should
+follow the correct behaviour of not just the subclass, but of all the
+parent classes.
+
+This should be done to ensure that the implementation of a subclass has
+not somehow "broken" the object's behaviour in a more general sense.
+
+C<Test::Object> is a testing package designed to allow you to easily test
+what you believe is a valid object against the expected behaviour of B<all>
+of the classes in its inheritance tree in one single call.
+
+To do this, you "register" tests (in the form of CODE or function
+references) with C<Test::Object>, with each test associated with a
+particular class.
+
+When you call C<object_ok> in your test script, C<Test::Object> will check
+the object against all registered tests. For each class that your object
+responds to C<$object-E<gt>isa($class)> for, the appropriate testing
+function will be called.
+
+Doing it this way allows adapter objects and other things that respond
+to C<isa> differently that the default to still be tested against the
+classes that it is advertising itself as correctly.
+
+This also means that more than one test might be "counted" for each call
+to C<object_ok>. You should account for this correctly in your expected
+test count.
+
+=cut
+
+use strict;
+use Carp               ();
+use Exporter           ();
+use Test::More         ();
+use Scalar::Util       ();
+use Test::Object::Test ();
+
+our $VERSION = '0.08';
+use vars qw{@ISA @EXPORT};
+BEGIN {
+	@ISA     = 'Exporter';
+	@EXPORT  = 'object_ok';
+}
+
+
+
+
+
+#####################################################################
+# Registration and Planning
+
+my @TESTS = ();
+
+sub register {
+	my $class = shift;
+	push @TESTS, Test::Object::Test->new( @_ );
+}
+
+
+
+
+
+#####################################################################
+# Testing Functions
+
+sub object_ok {
+	my $object = Scalar::Util::blessed($_[0]) ? shift
+		: Carp::croak("Did not provide an object to object_ok");
+
+	# Iterate over the tests and run any we ->isa
+	foreach my $test ( @TESTS ) {
+		$test->run( $object ) if $object->isa( $test->class );
+	}
+
+	1;
+}
+
+1;
+
+=pod
+
+=head1 SUPPORT
+
+Bugs should be submitted via the CPAN bug tracker, located at
+
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Object>
+
+For other issues, contact the author.
+
+=head1 AUTHOR
+
+Adam Kennedy E<lt>adamk@cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+L<http://ali.as/>, L<Test::More>, L<Test::Builder::Tester>, L<Test::Class>
+
+=head1 COPYRIGHT
+
+Copyright 2005, 2006 Adam Kennedy.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut