# (X)Emacs mode: -*- cperl -*-
use strict;
=head1 Unit Test Package for Class::MethodMaker
This package tests the scalar type of Class::MethodMaker
=cut
use FindBin 1.42 qw( $Bin $Script );
use Test 1.13 qw( ok plan );
use lib $Bin;
use test qw( evcheck );
BEGIN {
plan tests => 32,
todo => [],
}
# ----------------------------------------------------------------------------
=head2 Test 1: compilation
This test confirms that the test script and the modules it calls compiled
successfully.
=cut
package X;
use Class::MethodMaker
[ new => 'new',
new => [qw/ -hash new_hash_init /],
new => [qw/ -init new_with_init
-hash new_both /],
];
my @args_in_init;
my $foo_called;
my $bar_called;
sub init {
my ($self, @args) = @_;
@args_in_init = @args;
}
sub foo {
my ($self, $new) = @_;
defined $new and $self->{'foo'} = $new;
$foo_called = 1;
$self->{'foo'};
}
sub bar {
my ($self, $new) = @_;
defined $new and $self->{'bar'} = $new;
$bar_called = 1;
$self->{'bar'};
}
package main;
ok 1, 1, 'compilation';
# -------------------------------------
=head Tests 2--3: new
=cut
{
my $o;
ok evcheck(sub { $o = new X; }, 'new ( 1)'), 1, 'new ( 1)';
ok ref $o, 'X', 'new ( 2)';
}
# -------------------------------------
=head Tests 4--9: new_with_init
=cut
{
my $o;
my @args = (1, 2, 3);
ok(evcheck(sub { $o = X->new_with_init(@args) }, 'new_with_init ( 1)'), 1,
'new_with_init ( 1)');
ok ref $o, 'X', 'new_with_init ( 2)';
ok $#args_in_init, $#args, 'new_with_init ( 3)';
ok $args_in_init[$_], $args[$_], sprintf('new_with_init (%2d)', $_+4)
for 0..$#args;
@args_in_init = ();
}
# -------------------------------------
=head Tests 10--15: new_hash_init
=cut
{
my $o;
ok(evcheck(sub { $o = X->new_hash_init( 'foo' => 123, 'bar' => 456 ) },
'new_hash_init ( 1)'), 1, 'new_hash_init ( 1)');
ok ref $o, 'X', 'new_hash_init ( 2)';
ok $foo_called, 1, 'new_hash_init ( 3)';
ok $bar_called, 1, 'new_hash_init ( 4)';
ok $o->foo, 123, 'new_hash_init ( 5)';
ok $o->bar, 456, 'new_hash_init ( 6)';
$foo_called = 0;
$bar_called = 0;
}
# -------------------------------------
=head Tests 16--21: new_hash_init (taking hashref)
=cut
{
my $o;
$foo_called = 0;
$bar_called = 0;
ok(evcheck(sub { $o = X->new_hash_init({ 'foo' => 111, 'bar' => 444 }) },
'new_hash_init (taking hashref) ( 1)'), 1,
'new_hash_init (taking hashref) ( 1)');
ok ref $o, 'X', 'new_hash_init (taking hashref) ( 2)';
ok $foo_called, 1, 'new_hash_init (taking hashref) ( 3)';
ok $bar_called, 1, 'new_hash_init (taking hashref) ( 4)';
ok $o->foo, 111, 'new_hash_init (taking hashref) ( 5)';
ok $o->bar, 444, 'new_hash_init (taking hashref) ( 6)';
$foo_called = 0;
$bar_called = 0;
}
# -------------------------------------
=head Tests 22--32: new_hash_init (with init)
=cut
{
my $o;
my @args = ('foo' => 987, 'bar' => 654);
ok(evcheck(sub { $o = X->new_both(@args) },
'new_hash_init (with init) ( 1)'), 1,
'new_hash_init (with init) ( 1)');
ok ref $o, 'X', 'new_hash_init (with init) ( 2)';
ok $foo_called, 1, 'new_hash_init (with init) ( 3)';
ok $bar_called, 1, 'new_hash_init (with init) ( 4)';
ok $o->foo, 987, 'new_hash_init (with init) ( 5)';
ok $o->bar, 654, 'new_hash_init (with init) ( 6)';
ok $#args_in_init, $#args, 'new_hash_init (with init) ( 7)';
ok($args_in_init[$_], $args[$_],
sprintf('new_hash_init (with init) (%2d)', $_+8))
for 0..$#args;
$foo_called = 0;
$bar_called = 0;
@args_in_init = ();
}
# ----------------------------------------------------------------------------