[libclass-virtual-perl] 08/11: Convert to Test::More

[dom at earth.li]

This is an automated email from the git hooks/post-receive script.

dom pushed a commit to tag v0.06
in repository libclass-virtual-perl.

commit 40a58c06497c03b9639dc603473ec90f93a6a82a
Author: Michael G. Schwern <schwern at pobox.com>
Date:   Fri Dec 31 06:34:09 2004 +0000

    Convert to Test::More
    
    git-svn-id: file:///Users/schwern/tmp/svn/CPAN/Class-Virtual/trunk@2287 8151f2b9-fde8-0310-94fd-f048d12aab9e
---
 t/Virtual.t | 117 +++++++++++++++++++-----------------------------------------
 1 file changed, 37 insertions(+), 80 deletions(-)

diff --git a/t/Virtual.t b/t/Virtual.t
index bead3bf..3a7d22f 100644
--- a/t/Virtual.t
+++ b/t/Virtual.t
@@ -1,57 +1,10 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
+#!/usr/bin/perl -w
 
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
 use strict;
+use Test::More tests => 15;
 
-use vars qw($Total_tests);
-
-my $loaded;
-my $test_num = 1;
-BEGIN { $| = 1; $^W = 1; }
-END {print "not ok $test_num\n" unless $loaded;}
-print "1..$Total_tests\n";
-use Class::Virtual;
-$loaded = 1;
-ok(1, 'compile');
-######################### End of black magic.
-
-# Utility testing functions.
-sub ok {
-    my($test, $name) = @_;
-    print "not " unless $test;
-    print "ok $test_num";
-    print " - $name" if defined $name;
-    print "\n";
-    $test_num++;
-}
-
-sub eqarray  {
-    my($a1, $a2) = @_;
-    return 0 unless @$a1 == @$a2;
-    my $ok = 1;
-    for (0..$#{$a1}) {
-        my($e1,$e2) = ($a1->[$_], $a2->[$_]);
-        unless($e1 eq $e2) {
-            if( UNIVERSAL::isa($e1, 'ARRAY') and 
-                UNIVERSAL::isa($e2, 'ARRAY') ) 
-            {
-                $ok = eqarray($e1, $e2);
-            }
-            else {
-                $ok = 0;
-            }
-            last unless $ok;
-        }
-    }
-    return $ok;
-}
+BEGIN { use_ok 'Class::Virtual'; }
 
-# Change this to your # of ok() calls + 1
-BEGIN { $Total_tests = 14 }
 
 my @vmeths = qw(new foo bar this that);
 my $ok;
@@ -60,22 +13,22 @@ package Test::Virtual;
 use base qw(Class::Virtual);
 __PACKAGE__->virtual_methods(@vmeths);
 
-::ok( ::eqarray([sort __PACKAGE__->virtual_methods], [sort @vmeths]),
+::is_deeply([sort __PACKAGE__->virtual_methods], [sort @vmeths],
     'Declaring virtual methods' );
 
 eval {
     __PACKAGE__->virtual_methods(qw(this wont work));
 };
-$ok = $@ =~ /^Attempt to reset virtual methods/;
-::ok( $ok,        "Disallow reseting by virtual class" );
+::like($@, qr/^Attempt to reset virtual methods/,
+       "Disallow reseting by virtual class" );
 
 
 package Test::This;
 use base qw(Test::Virtual);
 
-::ok( ::eqarray([sort __PACKAGE__->virtual_methods], [sort @vmeths]),
+::is_deeply([sort __PACKAGE__->virtual_methods], [sort @vmeths],
     'Subclass listing virtual methods');
-::ok( ::eqarray([sort __PACKAGE__->missing_methods], [sort @vmeths]),
+::is_deeply([sort __PACKAGE__->missing_methods], [sort @vmeths],
     'Subclass listing missing methods');
 
 *foo = sub { 42 };
@@ -83,14 +36,14 @@ use base qw(Test::Virtual);
 
 ::ok( defined &foo && defined &bar );
 
-::ok( ::eqarray([sort __PACKAGE__->missing_methods], [sort qw(new this that)]),
+::is_deeply([sort __PACKAGE__->missing_methods], [sort qw(new this that)],
       'Subclass handling some methods');
 
 eval {
     __PACKAGE__->virtual_methods(qw(this wont work));
 };
-$ok = $@ =~ /^Attempt to reset virtual methods/;
-::ok( $ok,        "Disallow reseting by subclass" );
+::like($@, qr/^Attempt to reset virtual methods/,
+       "Disallow reseting by subclass" );
 
 
 package Test::Virtual::Again;
@@ -99,45 +52,49 @@ __PACKAGE__->virtual_methods('bing');
 
 package Test::Again;
 use base qw(Test::Virtual::Again);
-::ok( ::eqarray([sort __PACKAGE__->virtual_methods], [sort qw(bing)] ),
+::is_deeply([sort __PACKAGE__->virtual_methods], [sort qw(bing)],
       'Virtual classes not interfering' );
-::ok( ::eqarray([sort __PACKAGE__->missing_methods], [sort qw(bing)] ),
+::is_deeply([sort __PACKAGE__->missing_methods], [sort qw(bing)],
       'Missing methods not interfering' );
 
-::ok( ::eqarray([sort Test::This->virtual_methods], [sort @vmeths]),
+::is_deeply([sort Test::This->virtual_methods], [sort @vmeths],
       'Not overwriting virtual methods');
-::ok( ::eqarray([sort Test::This->missing_methods], [sort qw(new this that)]),
+::is_deeply([sort Test::This->missing_methods], [sort qw(new this that)],
       'Not overwriting missing methods');
 
 eval {
     Test::This->new;
 };
-::ok( $@ =~ /^Test::This forgot to implement new\(\) at/,
+::like( $@, qr/^Test::This forgot to implement new\(\) at/,
       'virtual method unimplemented, ok');
 
 eval {
     Test::This->bing;
 };
-::ok( $@ =~ /^Can't locate object method "bing" via package "Test::This" at/,
+::like( $@, qr/^Can't locate object method "bing" via package "Test::This" at/,
       'virtual methods not leaking');
 
 
 
 ###  This test doesn't work and probably never will.
 ###
-# package Test::That;
-# use base qw(Test::Virtual);
-
-# # Let's see how things work with an autoloader.
-# use vars qw($AUTOLOAD);
-# sub AUTOLOAD {
-#     if( $AUTOLOAD =~ /(foo|bar)/ ) {
-#         return "Yay!";
-#     }
-#     else {
-#         die "ARrrrrrrrrrrgh!\n";
-#     }
-# }
-
-# ::ok( ::eqarray([sort __PACKAGE__->missing_methods], [sort qw(new this that)]),
-#       'Autoloaded methods recognized' );
+package Test::That;
+use Test::More import => [qw($TODO)];
+use base qw(Test::Virtual);
+
+# Let's see how things work with an autoloader.
+use vars qw($AUTOLOAD);
+sub AUTOLOAD {
+    if( $AUTOLOAD =~ /(foo|bar)/ ) {
+        return "Yay!";
+    }
+    else {
+        die "ARrrrrrrrrrrgh!\n";
+    }
+}
+
+{
+    local $TODO = 'autoloaded methods';
+    ::is_deeply([sort __PACKAGE__->missing_methods], [sort qw(new this that)],
+                'Autoloaded methods recognized' );
+}

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libclass-virtual-perl.git