This is an automated email from the git hooks/post-receive script. dom pushed a commit to tag v0.03 in repository libclass-virtual-perl.
commit 5978c09524afaac1b085de4036f97e01b385f137 Author: Michael G. Schwern <[email protected]> Date: Fri Mar 2 07:39:17 2001 +0000 0.03 Fri Mar 2 01:33:07 EST 2001 * Officially distributing Class::Virtually::Abstract * Virtual responsibility was leaking across all virtual classes - Started using Carp::Assert git-svn-id: file:///Users/schwern/tmp/svn/CPAN/Class-Virtual/trunk@2278 8151f2b9-fde8-0310-94fd-f048d12aab9e --- Changes | 14 +++++ MANIFEST | 3 + Makefile.PL | 1 + lib/Class/Virtual.pm | 24 +++++--- lib/Class/Virtually/Abstract.pm | 129 ++++++++++++++++++++++++++++++++++++++++ t/{Virtual.t => Abstract.t} | 87 ++++++++++++++++++++------- t/Virtual.t | 32 +++++++++- 7 files changed, 260 insertions(+), 30 deletions(-) diff --git a/Changes b/Changes new file mode 100644 index 0000000..5bfdebd --- /dev/null +++ b/Changes @@ -0,0 +1,14 @@ +Change log for Perl module Class::Virtual + +0.03 Fri Mar 2 01:33:07 EST 2001 + * Officially distributing Class::Virtually::Abstract + * Virtual responsibility was leaking across all virtual classes + - Started using Carp::Assert + +0.02 Fri Feb 9 13:17:34 GMT 2001 + - Fixed wierd bug with fully qualified Carp::carp calls. + +0.01 Tue Nov 28 03:03:35 GMT 2000 + - First working version released to CPAN. + + diff --git a/MANIFEST b/MANIFEST index f763a20..7bdbfc4 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,4 +1,7 @@ +Changes MANIFEST Makefile.PL lib/Class/Virtual.pm +lib/Class/Virtually/Abstract.pm +t/Abstract.t t/Virtual.t diff --git a/Makefile.PL b/Makefile.PL index 3d56540..b51e7ee 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -31,6 +31,7 @@ WriteMakefile( PREREQ_PM => { Class::Data::Inheritable => 0.02, Class::ISA => 0.31, + Carp::Assert => 0.10, }, 'dist' => { COMPRESS => 'gzip -9', SUFFIX => '.gz', diff --git a/lib/Class/Virtual.pm b/lib/Class/Virtual.pm index 09d4ca1..cc51669 100644 --- a/lib/Class/Virtual.pm +++ b/lib/Class/Virtual.pm @@ -2,8 +2,9 @@ package Class::Virtual; use strict; use vars qw($VERSION); -$VERSION = '0.02'; +$VERSION = '0.03'; +use Carp::Assert; use Class::ISA; # Class::ISA doesn't export?! *self_and_super_path = \&Class::ISA::self_and_super_path; @@ -24,7 +25,7 @@ Class::Virtual - Base class for virtual base classes. package My::Virtual::Idaho; use base qw(Class::Virtual); - __PACKAGE__->virtual_methods(new foo bar this that); + __PACKAGE__->virtual_methods(qw(new foo bar this that)); package My::Private::Idaho; @@ -109,9 +110,9 @@ sub _mk_virtual_methods { my($this_class, @methods) = @_; $this_class->__Virtual_Methods(\@methods); - + # private method to return the virtual base class - *__virtual_base_class = sub { + *{$this_class.'::__virtual_base_class'} = sub { return $this_class; }; @@ -124,7 +125,7 @@ sub _mk_virtual_methods { } # Create a virtual method. - *{$meth} = sub { + *{$this_class.'::'.$meth} = sub { my($self) = shift; my($class) = ref $self || $self; @@ -140,7 +141,7 @@ sub _mk_virtual_methods { } }; } -} +} =pod @@ -165,6 +166,7 @@ sub missing_methods { my $sclass; do { $sclass = pop @super_classes; + assert( defined $sclass ) if DEBUG; } until $sclass eq $vclass; my @missing = (); @@ -189,12 +191,18 @@ sub missing_methods { =head1 CAVEATS and BUGS -Autoloaded methods are currently not recognized. +Autoloaded methods are currently not recognized. I have no idea +how to solve this. =head1 AUTHOR -Michael G Schwern <[email protected]> +Michael G Schwern E<lt>[email protected]<gt> + + +=head1 SEE ALSO + +L<Class::Virtually::Abstract> =cut diff --git a/lib/Class/Virtually/Abstract.pm b/lib/Class/Virtually/Abstract.pm new file mode 100644 index 0000000..a112263 --- /dev/null +++ b/lib/Class/Virtually/Abstract.pm @@ -0,0 +1,129 @@ +package Class::Virtually::Abstract; + +use strict; +use base qw(Class::Virtual); +use Carp::Assert; + +use vars qw(%Registered); + +{ + no strict 'refs'; + + sub virtual_methods { + my($base_class) = shift; + + if( @_ and !$Registered{$base_class} ) { + $Registered{$base_class} = 1; + + my($has_orig_import) = 0; + + # Shut up "subroutine import redefined" + local $^W = 0; + + if( defined &{$base_class.'::import'} ) { + # Divert the existing import method. + $has_orig_import = 1; + *{$base_class.'::__orig_import'} = \&{$base_class.'::import'}; + } + + # We can't use a closure here, SUPER wouldn't work right. :( + eval <<"IMPORT"; + package $base_class; + + sub import { + my \$class = shift; + return if \$class eq '$base_class'; + + my \@missing_methods = \$class->missing_methods; + if (\@missing_methods) { + require Carp; + Carp::croak("Class \$class must define ". + join(', ', \@missing_methods). + " for class $base_class"); + } + + # Since import() is typically caller() sensitive, these + # must be gotos. + if( $has_orig_import ) { + goto &${base_class}::__orig_import; + } + elsif( my \$super_import = \$class->can('SUPER::import') ) { + goto &\$super_import; + } + } +IMPORT + + } + + $base_class->SUPER::virtual_methods(@_); + } +} + +1; + + +=pod + +=head1 NAME + +Class::Virtually::Abstract - Compile-time enforcement of Class::Virtual + + +=head1 SYNOPSIS + + package My::Virtual::Idaho; + use base qw(Class::Virtually::Abstract); + + __PACKAGE__->virtual_methods(qw(new foo bar this that)); + + + package My::Private::Idaho; + use base qw(My::Virtual::Idaho); + + sub new { ... } + sub foo { ... } + sub bar { ... } + sub this { ... } + # oops, forgot to implement that()!! Whatever will happen?! + + + # Meanwhile, in another piece of code! + # KA-BLAM! My::Private::Idaho fails to compile because it didn't + # fully implement My::Virtual::Idaho. + use My::Private::Idaho; + +=head1 DESCRIPTION + +This subclass of Class::Virtual provides B<compile-time> enforcement. +That means subclasses of your virtual class are B<required> to +implement all virtual methods or else it will not compile. + + +=head1 BUGS and CAVEATS + +Because this relies on import() it is important that your classes are +B<use>d instead of B<require>d. This is a problem, and I'm trying to +figure a way around it. + +Also, if a subclass defines its own import() routine (why would a +class need to export stuff? I've done it) +Class::Virtually::Abstract's compile-time checking is defeated. + +Got to think of a better way to do this besides import(). + + +=head1 AUTHOR + +Original idea from Ben Tilly's AbstractClass +http://www.perlmonks.org/index.pl?node_id=44300&lastnode_id=45341 + +Embraced and Extended by Michael G Schwern E<lt>[email protected]<gt> + + +=head1 SEE ALSO + +L<Class::Virtual> + +=cut + +1; diff --git a/t/Virtual.t b/t/Abstract.t similarity index 58% copy from t/Virtual.t copy to t/Abstract.t index c258020..354563e 100644 --- a/t/Virtual.t +++ b/t/Abstract.t @@ -14,7 +14,7 @@ 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; +use Class::Virtually::Abstract; $loaded = 1; ok(1, 'compile'); ######################### End of black magic. @@ -51,13 +51,13 @@ sub eqarray { } # Change this to your # of ok() calls + 1 -BEGIN { $Total_tests = 9 } +BEGIN { $Total_tests = 16 } my @vmeths = qw(new foo bar this that); my $ok; package Test::Virtual; -use base qw(Class::Virtual); +use base qw(Class::Virtually::Abstract); __PACKAGE__->virtual_methods(@vmeths); ::ok( ::eqarray([sort __PACKAGE__->virtual_methods], [sort @vmeths]), @@ -93,21 +93,66 @@ $ok = $@ =~ /^Attempt to reset virtual methods/; ::ok( $ok, "Disallow reseting by subclass" ); -### 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::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)] ), + 'Virtual classes not interfering' ); +::ok( ::eqarray([sort __PACKAGE__->missing_methods], [sort qw(bing)] ), + 'Missing methods not interfering' ); + +::ok( ::eqarray([sort Test::This->virtual_methods], [sort @vmeths]), + 'Not overwriting virtual methods'); +::ok( ::eqarray([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/, + 'virtual method unimplemented, ok'); + +eval { + Test::This->bing; +}; +::ok( $@ =~ /^Can't locate object method "bing" via package "Test::This" at/, + 'virtual methods not leaking'); #') + + +eval { + Test::Again->import; +}; +::ok( $@ =~ /^Class Test::Again must define bing for class Test::Virtual::Again/ ); + +package Test::More; +use base qw(Test::Again); +sub import { 42 } + +eval { + Test::More->import; +}; +# ::ok( $@ =~ /^Class Test::More must define bing for class Test::Virtual::Again/ ); # TODO + + + +package Test::Yet::Again; +use base qw(Class::Virtually::Abstract); +__PACKAGE__->virtual_methods('foo'); + +sub import { + $Test::Yet::Again = 42; +} + + +package Test::Yet; +use base qw(Test::Yet::Again); + +sub foo { 23 } + +eval { + Test::Yet->import; +}; +::ok( !$@ and $Test::Yet::Again == 42 ); diff --git a/t/Virtual.t b/t/Virtual.t index c258020..bead3bf 100644 --- a/t/Virtual.t +++ b/t/Virtual.t @@ -51,7 +51,7 @@ sub eqarray { } # Change this to your # of ok() calls + 1 -BEGIN { $Total_tests = 9 } +BEGIN { $Total_tests = 14 } my @vmeths = qw(new foo bar this that); my $ok; @@ -93,6 +93,36 @@ $ok = $@ =~ /^Attempt to reset virtual methods/; ::ok( $ok, "Disallow reseting by subclass" ); +package Test::Virtual::Again; +use base qw(Class::Virtual); +__PACKAGE__->virtual_methods('bing'); + +package Test::Again; +use base qw(Test::Virtual::Again); +::ok( ::eqarray([sort __PACKAGE__->virtual_methods], [sort qw(bing)] ), + 'Virtual classes not interfering' ); +::ok( ::eqarray([sort __PACKAGE__->missing_methods], [sort qw(bing)] ), + 'Missing methods not interfering' ); + +::ok( ::eqarray([sort Test::This->virtual_methods], [sort @vmeths]), + 'Not overwriting virtual methods'); +::ok( ::eqarray([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/, + 'virtual method unimplemented, ok'); + +eval { + Test::This->bing; +}; +::ok( $@ =~ /^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; -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libclass-virtual-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
