#!/usr/bin/perl -w use strict; use Test::More tests => 15; BEGIN { use_ok 'Class::Virtual'; } my @vmeths = qw(new foo bar this that); my $ok; package Test::Virtual; use base qw(Class::Virtual); __PACKAGE__->virtual_methods(@vmeths); ::is_deeply([sort __PACKAGE__->virtual_methods], [sort @vmeths], 'Declaring virtual methods' ); eval { __PACKAGE__->virtual_methods(qw(this wont work)); }; ::like($@, qr/^Attempt to reset virtual methods/, "Disallow reseting by virtual class" ); package Test::This; use base qw(Test::Virtual); ::is_deeply([sort __PACKAGE__->virtual_methods], [sort @vmeths], 'Subclass listing virtual methods'); ::is_deeply([sort __PACKAGE__->missing_methods], [sort @vmeths], 'Subclass listing missing methods'); *foo = sub { 42 }; *bar = sub { 23 }; ::ok( defined &foo && defined &bar ); ::is_deeply([sort __PACKAGE__->missing_methods], [sort qw(new this that)], 'Subclass handling some methods'); eval { __PACKAGE__->virtual_methods(qw(this wont work)); }; ::like($@, qr/^Attempt to reset virtual methods/, "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); ::is_deeply([sort __PACKAGE__->virtual_methods], [sort qw(bing)], 'Virtual classes not interfering' ); ::is_deeply([sort __PACKAGE__->missing_methods], [sort qw(bing)], 'Missing methods not interfering' ); ::is_deeply([sort Test::This->virtual_methods], [sort @vmeths], 'Not overwriting virtual methods'); ::is_deeply([sort Test::This->missing_methods], [sort qw(new this that)], 'Not overwriting missing methods'); eval { Test::This->new; }; ::like( $@, qr/^Test::This forgot to implement new\(\) at/, 'virtual method unimplemented, ok'); eval { Test::This->bing; }; ::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 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' ); }