[libclass-virtual-perl] 06/11: Changing to Test::More
dom at earth.li
dom at earth.li
Wed Aug 23 14:00:16 UTC 2017
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 dc64676098e1ac22e431da2d479e8ab2ca670446
Author: Michael G. Schwern <schwern at pobox.com>
Date: Fri Dec 31 06:26:31 2004 +0000
Changing to Test::More
git-svn-id: file:///Users/schwern/tmp/svn/CPAN/Class-Virtual/trunk@2285 8151f2b9-fde8-0310-94fd-f048d12aab9e
---
Makefile.PL | 5 +--
t/Abstract.t | 131 ++++++++++++++++++++---------------------------------------
2 files changed, 45 insertions(+), 91 deletions(-)
diff --git a/Makefile.PL b/Makefile.PL
index b51e7ee..d286d9f 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -32,9 +32,6 @@ WriteMakefile(
Class::Data::Inheritable => 0.02,
Class::ISA => 0.31,
Carp::Assert => 0.10,
- },
- 'dist' => { COMPRESS => 'gzip -9',
- SUFFIX => '.gz',
- DIST_DEFAULT => 'all tardist',
+ Test::More => 0.50,
},
);
diff --git a/t/Abstract.t b/t/Abstract.t
index 354563e..c45ca73 100644
--- a/t/Abstract.t
+++ b/t/Abstract.t
@@ -1,66 +1,19 @@
-# 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 => 18;
-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::Virtually::Abstract;
-$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++;
-}
+BEGIN { use_ok 'Class::Virtually::Abstract'; }
-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;
-}
-
-# Change this to your # of ok() calls + 1
-BEGIN { $Total_tests = 16 }
my @vmeths = qw(new foo bar this that);
my $ok;
-package Test::Virtual;
+package Foo::Virtual;
use base qw(Class::Virtually::Abstract);
__PACKAGE__->virtual_methods(@vmeths);
-::ok( ::eqarray([sort __PACKAGE__->virtual_methods], [sort @vmeths]),
+::is_deeply([sort __PACKAGE__->virtual_methods], [sort @vmeths],
'Declaring virtual methods' );
eval {
@@ -70,12 +23,12 @@ $ok = $@ =~ /^Attempt to reset virtual methods/;
::ok( $ok, "Disallow reseting by virtual class" );
-package Test::This;
-use base qw(Test::Virtual);
+package Foo::This;
+use base qw(Foo::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,76 +36,80 @@ 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;
+package Foo::Virtual::Again;
use base qw(Class::Virtually::Abstract);
__PACKAGE__->virtual_methods('bing');
-package Test::Again;
-use base qw(Test::Virtual::Again);
-::ok( ::eqarray([sort __PACKAGE__->virtual_methods], [sort qw(bing)] ),
+package Foo::Again;
+use base qw(Foo::Virtual::Again);
+::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 Foo::This->virtual_methods], [sort @vmeths],
'Not overwriting virtual methods');
-::ok( ::eqarray([sort Test::This->missing_methods], [sort qw(new this that)]),
+::is_deeply([sort Foo::This->missing_methods], [sort qw(new this that)],
'Not overwriting missing methods');
eval {
- Test::This->new;
+ Foo::This->new;
};
-::ok( $@ =~ /^Test::This forgot to implement new\(\) at/,
- 'virtual method unimplemented, ok');
+::like( $@, qr/^Foo::This forgot to implement new\(\) at/,
+ 'virtual method unimplemented, ok');
eval {
- Test::This->bing;
+ Foo::This->bing;
};
-::ok( $@ =~ /^Can't locate object method "bing" via package "Test::This" at/,
- 'virtual methods not leaking'); #')
+::like( $@, qr/^Can't locate object method "bing" via package "Foo::This" at/,
+ 'virtual methods not leaking'); #')
eval {
- Test::Again->import;
+ Foo::Again->import;
};
-::ok( $@ =~ /^Class Test::Again must define bing for class Test::Virtual::Again/ );
+::like( $@, qr/^Class Foo::Again must define bing for class Foo::Virtual::Again/ );
-package Test::More;
-use base qw(Test::Again);
+package Foo::More;
+use Test::More import => [qw($TODO)];
+use base qw(Foo::Again);
sub import { 42 }
-eval {
- Test::More->import;
-};
-# ::ok( $@ =~ /^Class Test::More must define bing for class Test::Virtual::Again/ ); # TODO
-
+{
+ local $TODO = 'defeated by import() routine';
+ eval {
+ Foo::More->import;
+ };
+ ::like( $@, qr/^Class Foo::More must define bing for class Foo::Virtual::Again/ );
+}
-package Test::Yet::Again;
+package Foo::Yet::Again;
use base qw(Class::Virtually::Abstract);
__PACKAGE__->virtual_methods('foo');
sub import {
- $Test::Yet::Again = 42;
+ $Foo::Yet::Again = 42;
}
-package Test::Yet;
-use base qw(Test::Yet::Again);
+package Foo::Yet;
+use base qw(Foo::Yet::Again);
sub foo { 23 }
eval {
- Test::Yet->import;
+ Foo::Yet->import;
};
-::ok( !$@ and $Test::Yet::Again == 42 );
+::is( $@, '' );
+::is( $Foo::Yet::Again, 42 );
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libclass-virtual-perl.git
More information about the Pkg-perl-cvs-commits
mailing list