#!/usr/bin/perl -w

use strict;
use Test::More tests => 18;

BEGIN { use_ok 'Class::Virtually::Abstract'; }


my @vmeths = qw(new foo bar this that);
my $ok;

package Foo::Virtual;
use base qw(Class::Virtually::Abstract);
__PACKAGE__->virtual_methods(@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" );


package Foo::This;
use base qw(Foo::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 Foo::Virtual::Again;
use base qw(Class::Virtually::Abstract);
__PACKAGE__->virtual_methods('bing');

package Foo::Again;
use base qw(Foo::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 Foo::This->virtual_methods], [sort @vmeths],
      'Not overwriting virtual methods');
::is_deeply([sort Foo::This->missing_methods], [sort qw(new this that)],
      'Not overwriting missing methods');

eval {
    Foo::This->new;
};
::like( $@, qr/^Foo::This forgot to implement new\(\) at/,
        'virtual method unimplemented, ok');

eval {
    Foo::This->bing;
};
::like( $@, qr/^Can't locate object method "bing" via package "Foo::This"/,
        'virtual methods not leaking');   #')


eval {
    Foo::Again->import;
};
::like( $@, qr/^Class Foo::Again must define bing for class Foo::Virtual::Again/ );

package Foo::More;
use Test::More import => [qw($TODO)];
use base qw(Foo::Again);
sub import { 42 }

{
    local $TODO = 'defeated by import() routine';
    eval {
        Foo::More->import;
    };
    ::like( $@, qr/^Class Foo::More must define bing for class Foo::Virtual::Again/ );
}


package Foo::Yet::Again;
use base qw(Class::Virtually::Abstract);
__PACKAGE__->virtual_methods('foo');

sub import {
    $Foo::Yet::Again = 42;
}


package Foo::Yet;
use base qw(Foo::Yet::Again);

sub foo { 23 }

eval {
    Foo::Yet->import;
};
::is( $@, '' );
::is( $Foo::Yet::Again, 42 );


syntax highlighted by Code2HTML, v. 0.9.1