Class-MethodMaker-2.19/ 0000755 0001750 0001750 00000000000 12253325547 012726 5 ustar ss5 ss5 Class-MethodMaker-2.19/t/ 0000755 0001750 0001750 00000000000 12253325547 013171 5 ustar ss5 ss5 Class-MethodMaker-2.19/t/v1_static_hash.t 0000644 0001750 0001750 00000002714 11735360552 016261 0 ustar ss5 ss5 #!/usr/local/bin/perl
use lib qw ( ./t );
use test_v1;
package X;
use Class::MethodMaker
static_hash => [ qw / a b / ],
static_hash => 'c';
sub new { bless {}, shift; }
package main;
Class::MethodMaker->VERSION eq '2.08' || Class::MethodMaker->VERSION >= 2.00
or die "Wrong C::MM: ", Class::MethodMaker->VERSION, "\n";
my $o = new X;
my $o2 = new X;
TEST { 1 };
TEST { ! scalar keys %{$o->a} };
TEST { ! defined $o->a('foo') };
TEST { $o->a('foo', 'baz') };
TEST { $o->a('foo') eq 'baz' };
TEST { $o->a('bar', 'baz2') };
TEST {
my @l = $o->a([qw / foo bar / ]);
$l[0] eq 'baz' and $l[1] eq 'baz2'
};
TEST { $o->a(qw / a b c d / ) };
TEST {
my %h = $o->a;
my @l = sort keys %h;
$l[0] eq 'a' and
$l[1] eq 'bar' and
$l[2] eq 'c' and
$l[3] eq 'foo'
};
TEST {
my %h=('w' => 'x', 'y' => 'z');
my $rh = \%h;
my $r = $o->a($rh);
};
TEST {
my @l = sort $o->a_keys;
$l[0] eq 'a' and
$l[1] eq 'bar' and
$l[2] eq 'c' and
$l[3] eq 'foo' and
$l[4] eq 'w' and
$l[5] eq 'y'
};
TEST {
my @l = sort $o->a_values;
$l[0] eq 'b' and
$l[1] eq 'baz' and
$l[2] eq 'baz2' and
$l[3] eq 'd' and
$l[4] eq 'x' and
$l[5] eq 'z'
};
TEST { $o->b_tally(qw / a b c a b a d / ); };
TEST {
my %h = $o->b;
$h{'a'} == 3 and
$h{'b'} == 2 and
$h{'c'} == 1 and
$h{'d'} == 1
};
TEST { ! defined $o->c('foo') };
TEST { defined $o->c };
TEST {
my @a = $o->a;
my @a2 = $o2->a;
(@a == @a2) &&
! grep $a[$_] ne $a2[$_], 0..$#a;
};
exit 0;
Class-MethodMaker-2.19/t/v1_get_concat.t 0000644 0001750 0001750 00000001276 11735360552 016077 0 ustar ss5 ss5 #!/usr/local/bin/perl
package X;
use Class::MethodMaker
get_concat => 'x',
get_concat => {'name' => 'y', 'join' => "\t"},
;
sub new { bless {}, shift; }
package main;
use lib qw ( ./t );
use test_v1;
Class::MethodMaker->VERSION eq '2.08' || Class::MethodMaker->VERSION >= 2.00
or die "Wrong C::MM: ", Class::MethodMaker->VERSION, "\n";
my $o = new X;
TEST { 1 };
TEST { ! defined $o->x };
TEST { $o->x('foo') };
TEST { $o->x eq 'foo' };
TEST { $o->x('bar') };
TEST { $o->x eq 'foobar' };
TEST { ! defined $o->clear_x };
TEST { ! defined $o->x };
TEST { ! defined $o->y };
TEST { $o->y ('one') };
TEST { $o->y eq 'one' };
TEST { $o->y ('two') };
TEST { $o->y eq "one\ttwo" };
exit 0;
Class-MethodMaker-2.19/t/redefine-warnings.t 0000644 0001750 0001750 00000003135 11735360552 016766 0 ustar ss5 ss5 # (X)Emacs mode: -*- cperl -*-
use strict;
=head1 Unit Test Package for Class::MethodMaker
This package tests the basic utility of Class::MethodMaker
=cut
use FindBin 1.42 qw( $Bin );
use Test 1.13 qw( ok plan skip );
use lib $Bin;
use test qw( DATA_DIR
evcheck save_output restore_output );
BEGIN {
# 1 for compilation test,
plan tests => 2,
todo => [],
}
# ----------------------------------------------------------------------------
=head2 Test 1: compilation
This test confirms that the test script and the modules it calls compiled
successfully.
=cut
ok 1, 1, 'compilation';
# -------------------------------------
=head2 Test 2: no warnings generated
This tests for a bug in 2.00 where warnings are generated complaining of
'prototype mismatch' and 'INTEGER redefined' when using Class::MethodMaker
with certain other modules. Currently IPC::Run is tested, which is
unfortunate, since it is non-core. If someone can suggest a core module that
displays this issue with 2.00, that wouldd be great.
=cut
my $if_MSWin = $^O =~ m/MSWin/ ? 'Skip if under MSWin' : '';
if ($if_MSWin) {
skip($if_MSWin, 1, 1, "No warnings generated" );
}
else
{
save_output('stderr', *STDERR{IO});
eval {
require IPC::Run;
};
my $run_failed = $@;
defined $run_failed && $run_failed =~ s/\(.*$//
unless defined $ENV{TEST_DEBUG} and $ENV{TEST_DEBUG} > 1;
eval {
require Class::MethodMaker;
};
my $err = restore_output('stderr');
skip $run_failed, $err, '', "No warnings generated\n";
}
# ----------------------------------------------------------------------------
Class-MethodMaker-2.19/t/basic.t 0000644 0001750 0001750 00000002224 11735360552 014436 0 ustar ss5 ss5 # (X)Emacs mode: -*- cperl -*-
use strict;
=head1 Unit Test Package for Class::MethodMaker
This package tests the basic compilation and working of Class::MethodMaker
=cut
use Data::Dumper qw( );
use FindBin 1.42 qw( $Bin );
use Test 1.13 qw( ok plan );
use lib $Bin;
use test qw( DATA_DIR
evcheck );
BEGIN {
# 1 for compilation test,
plan tests => 2,
todo => [],
}
# ----------------------------------------------------------------------------
=head2 Test 1: compilation
This test confirms that the test script and the modules it calls compiled
successfully.
=cut
use Class::MethodMaker;
ok 1, 1, 'compilation';
# -------------------------------------
=head2 Test 2: scalar
=cut
package bob;
use Class::MethodMaker
[ scalar =>[qw/ foo /] ];
package main;
my $bob = bless {}, 'bob';
print Data::Dumper->Dump([ $bob ], [qw( bob )])
if $ENV{TEST_DEBUG};
$bob->foo("x");
print Data::Dumper->Dump([ $bob ], [qw( bob )])
if $ENV{TEST_DEBUG};
ok $bob->foo, "x", 'scalar ( 1)';
# ----------------------------------------------------------------------------
Class-MethodMaker-2.19/t/warnings.t 0000644 0001750 0001750 00000002663 11735360552 015214 0 ustar ss5 ss5 #!perl -w
# (X)Emacs mode: -*- cperl -*-
use strict;
use warnings;
=head1 Unit Test Package for Class::MethodMaker
This package tests the basic compilation and working of Class::MethodMaker
similar to basic but with warnings explicitely on to check for 5.13.2-related
new warnings.
=cut
use Data::Dumper qw( );
use FindBin 1.42 qw( $Bin );
use Test 1.13 qw( ok plan );
use lib $Bin;
use test qw( DATA_DIR
evcheck );
use vars qw(@MYWARNINGS);
BEGIN { $SIG{__WARN__} = sub { push @MYWARNINGS, $_[0] }; }
BEGIN {
# 1 for compilation test,
plan tests => 3,
todo => [],
}
# ----------------------------------------------------------------------------
=head2 Test 1: compilation
This test confirms that the test script and the modules it calls compiled
successfully.
=cut
use Class::MethodMaker;
ok 1, 1, 'compilation';
# -------------------------------------
=head2 Test 2: scalar
=cut
package bob;
local $^W = 1;
use Class::MethodMaker
[ scalar =>[qw/ foo /] ];
package main;
local $^W = 1;
my $bob = bless {}, 'bob';
print Data::Dumper->Dump([ $bob ], [qw( bob )])
if $ENV{TEST_DEBUG};
$bob->foo("x");
print Data::Dumper->Dump([ $bob ], [qw( bob )])
if $ENV{TEST_DEBUG};
ok $bob->foo, "x", 'scalar ( 1)';
# ----------------------------------------------------------------------------
ok scalar(@MYWARNINGS), 0, 'no warnings occurred';
Class-MethodMaker-2.19/t/v1_counter.t 0000644 0001750 0001750 00000001166 11735360552 015446 0 ustar ss5 ss5 #!/usr/local/bin/perl
package X;
use Class::MethodMaker
counter => [ qw / a b / ],
abstract => 'c';
sub new { bless {}, shift; }
package main;
use lib qw ( ./t );
use test_v1;
Class::MethodMaker->VERSION eq '2.08' || Class::MethodMaker->VERSION >= 2.00
or die "Wrong C::MM: ", Class::MethodMaker->VERSION, "\n";
my $o = new X;
TEST { 1 };
TEST { $o->a == 0 };
TEST { $o->a == 0 };
TEST { $o->a_incr == 1 };
TEST { $o->a_incr == 2 };
TEST { $o->a == 2 };
TEST { eval { $o->a_reset }; ! length $@ };
TEST { $o->a == 0 };
TEST { $o->a_incr(2) == 2 };
TEST { $o->a_incr(3) == 5 };
TEST { $o->a_incr == 6 };
exit 0;
Class-MethodMaker-2.19/t/v1_get_set.t 0000644 0001750 0001750 00000002643 11735360552 015422 0 ustar ss5 ss5 #!/usr/local/bin/perl
use lib qw ( ./t );
use test_v1;
package X;
use Class::MethodMaker
get_set => [qw/ a b /],
get_set => 'c',
get_set => [
[ undef, undef, 'get_*', 'set_*' ] => qw/ d e /,
-noclear => 'f',
-eiffel => 'g',
-java => 'H',
-compatibility => 'i',
];
sub new { bless {}, shift; }
package main;
Class::MethodMaker->VERSION eq '2.08' || Class::MethodMaker->VERSION >= 2.00
or die "Wrong C::MM: ", Class::MethodMaker->VERSION, "\n";
my $o = new X;
TEST { 1 };
TEST { ! defined $o->a };
TEST { $o->a(123) };
TEST { $o->a == 123 };
TEST { ! defined $o->clear_a };
TEST { ! defined $o->a };
TEST { $o->a(456) };
TEST { $o->a == 456 };
TEST { ! defined $o->a (undef) };
TEST { ! defined $o->a };
TEST { defined *X::clear_a{CODE} };
TEST { ! $o->can ('d') };
TEST { ! $o->can ('clear_e') };
TEST { ! defined $o->get_d };
TEST { ! defined $o->set_d ('foo') };
TEST { $o->get_d eq 'foo' };
TEST { ! defined $o->set_d (undef) };
TEST { ! defined $o->get_d };
TEST { $o->can ('f') and ! $o->can ('clear_f') and
! $o->can ('set_f') and ! $o->can ('get_f') };
TEST { $o->can ('g') and ! $o->can ('clear_g') and
$o->can ('set_g') and ! $o->can ('get_g') };
TEST { ! $o->can ('h') and ! $o->can ('clear_h') and
$o->can ('setH') and $o->can ('getH') };
TEST { $o->can ('i') and $o->can ('clear_i') and
! $o->can ('set_i') and ! $o->can ('get_i') };
exit 0;
Class-MethodMaker-2.19/t/v1_get_set_hi.t 0000644 0001750 0001750 00000001272 11735360552 016077 0 ustar ss5 ss5 #!/usr/local/bin/perl
use lib qw ( ./t );
use test_v1;
# Tests for interaction of get_set with new_hash_init
package Person;
use Class::MethodMaker
new_hash_init => 'new' ,
get_set => [ -java => 'Status',
-eiffel => 'size', 'name', ]
;
package main;
Class::MethodMaker->VERSION eq '2.08' || Class::MethodMaker->VERSION >= 2.00
or die "Wrong C::MM: ", Class::MethodMaker->VERSION, "\n";
my $p = Person->new(name =>'Homer',
size =>'54',
Status =>'Comical Moron');
TEST { 1 };
TEST { $p->name eq 'Homer' };
TEST { $p->size == 54 };
TEST { $p->getStatus eq 'Comical Moron' };
exit 0;
Class-MethodMaker-2.19/t/v1_object_list.t 0000644 0001750 0001750 00000003446 11735360552 016273 0 ustar ss5 ss5 #!/usr/local/bin/perl
use lib qw ( ./t );
use test_v1;
package Y;
my $count = 0;
sub new { bless { id => $count++ }, shift; }
sub id { shift->{id}; }
package X;
use Class::MethodMaker
object_list => [
'Y' => { slot => 'a', comp_mthds => 'id' },
];
sub new { bless {}, shift; }
my $o = new X;
package main;
Class::MethodMaker->VERSION eq '2.08' || Class::MethodMaker->VERSION >= 2.00
or die "Wrong C::MM: ", Class::MethodMaker->VERSION, "\n";
# 1
TEST { 1 };
# 2-3
TEST { $o->a_push (Y->new) };
TEST { $o->a_push (Y->new) };
# 4-6
TEST { $o->a_pop->id == 1 };
TEST { $o->a_push (Y->new) };
TEST { @b = $o->a; @b == 2 };
# 7-9
TEST { join (' ', $o->id) eq '0 2' };
TEST { $a = 1; for ($o->a) { $a &&= ( ref ($_) eq 'Y' ) }; $a };
TEST { $o->a_shift->id == 0 };
# 10-12
TEST { $o->a_unshift ( Y->new ) };
TEST { @b = $o->a; @b == 2 };
TEST { $a = 1; for ($o->a) { $a &&= ( ref ($_) eq 'Y' ) }; $a };
# 13-15
TEST { join (' ', $o->id) eq '3 2' };
TEST { ref($o->a_index(0)) eq 'Y' };
TEST { $o->a_set(0 => Y->new); 1 };
# 16-17
TEST { $o->a_index(0)->id == 4};
TEST { @b = $o->a; @b == 2 };
# 18
TEST { $o->a_clear; $o->a_count == 0 };
# Backwards compatibility test
# 19-21
TEST { $o->push_a (Y->new) };
TEST { $o->push_a (Y->new) };
TEST { $o->pop_a->id == 6 };
# 22-24
TEST { $o->push_a (Y->new) };
TEST { @b = $o->a; @b == 2 };
TEST { join (' ', $o->id) eq '5 7' };
# 25-27
TEST { $a = 1; for ($o->a) { $a &&= ( ref ($_) eq 'Y' ) }; $a };
TEST { $o->shift_a->id == 5 };
TEST { $o->unshift_a ( Y->new ) };
# 28-30
TEST { @b = $o->a; @b == 2 };
TEST { $a = 1; for ($o->a) { $a &&= ( ref ($_) eq 'Y' ) }; $a };
TEST { join (' ', $o->id) eq '8 7' };
# 31-33
TEST { ref($o->index_a(0)) eq 'Y' };
TEST { $o->set_a(0 => Y->new); 1 };
TEST { $o->a_index(0)->id == 9};
# 34
TEST { @b = $o->a; @b == 2 };
exit 0;
Class-MethodMaker-2.19/t/diffclass.t 0000644 0001750 0001750 00000007555 11735360552 015327 0 ustar ss5 ss5 # (X)Emacs mode: -*- cperl -*-
use strict;
=head1 Unit Test Package for Class::MethodMaker
This package tests the ability of Class::MethodMaker to insert methods into a
class other than the "Calling" class.
=cut
use Data::Dumper qw( Dumper );
use Fatal 1.02 qw( sysopen close );
use Fcntl 1.03 qw( :DEFAULT );
use File::stat qw( stat );
use FindBin 1.42 qw( $Bin $Script );
use IO::File 1.08 qw( );
use POSIX 1.03 qw( S_ISREG );
use Test 1.13 qw( ok plan );
use lib $Bin;
use test qw( DATA_DIR
evcheck restore_output save_output );
BEGIN {
# 1 for compilation test,
plan tests => 22,
todo => [],
}
# ----------------------------------------------------------------------------
=head2 Test 1: compilation
This test confirms that the test script and the modules it calls compiled
successfully.
=cut
use Class::MethodMaker
[ -target_class => 'X',
scalar => [qw/ a /],
-target_class => 'Y',
scalar => [qw/ b /],
];
ok 1, 1, 'compilation';
# -------------------------------------
=head2 Test 2: bless
=cut
my ($x, $y);
ok evcheck(sub { $x = bless {}, 'X'; $y = bless {}, 'Y'; },
'bless ( 1)'), 1, 'bless ( 1)';
goto "TEST_$ENV{START_TEST}"
if $ENV{START_TEST};
# -------------------------------------
=head2 Tests 3--22: simple non-static
=cut
{
my $n;
ok(evcheck(sub { $n = $x->a_isset; }, 'simple non-static ( 1)'), 1,
'simple non-static ( 1)');
ok ! $n; # simple non-static ( 2)
ok(evcheck(sub { $n = $x->b_isset; }, 'simple non-static ( 3)'), 0,
'simple non-static ( 3)');
ok(evcheck(sub { $n = $y->b_isset; }, 'simple non-static ( 4)'), 1,
'simple non-static ( 4)');
ok(evcheck(sub { $x->a(4); }, 'simple non-static ( 5)'),
1, 'simple non-static ( 5)');
ok(evcheck(sub { $n = $x->a; }, 'simple non-static ( 6)'), 1,
'simple non-static ( 6)');
ok $n, 4, 'simple non-static ( 7)';
ok(evcheck(sub { $n = $x->a(7); }, 'simple non-static ( 8)'), 1,
'simple non-static ( 8)');
ok $n, 7, 'simple non-static ( 9)';
ok(evcheck(sub { $n = $x->a_isset; }, 'simple non-static (10)'), 1,
'simple non-static (10)');
ok $n; # simple non-static (11)
ok(evcheck(sub { $n = $y->b_isset; }, 'simple non-static (12)'), 1,
'simple non-static (12)');
ok ! $n; # simple non-static (13)
ok(evcheck(sub { $n = $x->a_reset; }, 'simple non-static (14)'), 1,
'simple non-static (14)');
ok(evcheck(sub { $n = $x->a_isset; }, 'simple non-static (15)'), 1,
'simple non-static (15)');
ok ! $n; # simple non-static (16)
ok(evcheck(sub { $n = $x->a; }, 'simple non-static (17)'), 1,
'simple non-static (17)');
ok $n, undef, 'simple non-static (18)';
ok(evcheck(sub { $n = $x->a_isset; }, 'simple non-static (19)'), 1,
'simple non-static (19)');
ok ! $n; # simple non-static (20)
}
# -------------------------------------
Class-MethodMaker-2.19/t/v1_static_list.t 0000644 0001750 0001750 00000003354 11735360552 016312 0 ustar ss5 ss5 #!/usr/local/bin/perl
use lib qw ( ./t );
use test_v1;
package X;
use Class::MethodMaker
static_list => [ qw / a b / ],
static_list => 'c';
sub new { bless {}, shift; }
package main;
Class::MethodMaker->VERSION eq '2.08' || Class::MethodMaker->VERSION >= 2.00
or die "Wrong C::MM: ", Class::MethodMaker->VERSION, "\n";
use Data::Dumper;
my $o = new X;
my $o2 = new X;
# 1--6
TEST { 1 };
TEST { ! scalar @{$o->a} };
TEST { $o->a_push(123, 456) };
TEST { $o->a_unshift('baz') };
TEST { $o->a_pop == 456 };
TEST { $o->a_shift eq 'baz' };
#7--8
TEST { $o->b_push(123, 'foo', [ qw / a b c / ], 'bar') };
TEST {
my @l = $o->b;
print STDERR Data::Dumper->Dump([\@l],['l'])
if exists $ENV{TEST_DEBUG} && $ENV{TEST_DEBUG};
$l[0] == 123 and
$l[1] eq 'foo' and
$l[2]->[0] eq 'a' and
$l[2]->[1] eq 'b' and
$l[2]->[2] eq 'c' and
$l[3] eq 'bar'
};
# 9
TEST {
$o->b_splice(1, 2, 'baz');
my @l = $o->b;
print STDERR Data::Dumper->Dump([\@l],['l'])
if exists $ENV{TEST_DEBUG} && $ENV{TEST_DEBUG};
$l[0] == 123 and
$l[1] eq 'baz' and
$l[2] eq 'bar'
};
# 10--12
TEST { ref $o->b_ref eq 'ARRAY' };
TEST { ! scalar $o->b_clear };
TEST { ! scalar @{$o->b} };
$o->b_unshift(qw/ a b c /);
my @x = $o->b_index (2, 1, 1, 2);
# 13--15
TEST { @x == 4 };
TEST { $x[0] eq 'c' and $x[3] eq 'c' };
TEST { $x[1] eq 'b' and $x[2] eq 'b' };
$o->b_set ( 1 => 'd' );
@x = $o->b;
# 16--19
TEST { @x == 3 };
TEST { $x[0] eq 'a' };
TEST { $x[1] eq 'd' };
TEST { $x[2] eq 'c' };
eval {
$o->b_set ( 0 => 'e', 1 );
};
# 20--21
TEST { $@ };
TEST { ($o->b)[0] eq ($o2->b)[0] };
eval {
$o->b ( 'e' );
};
# 22--26
TEST { ! $@ };
TEST { ($o->b)[0] eq 'e' };
TEST { (my @a = $o->b) == 1 };
TEST { ($o2->b)[0] eq 'e' };
TEST { (my @a = $o2->b) == 1 };
exit 0;
Class-MethodMaker-2.19/t/test.pm 0000644 0001750 0001750 00000057541 11735360552 014521 0 ustar ss5 ss5 # (X)Emacs mode: -*- cperl -*-
package test;
=head1 NAME
test - tools for helping in test suites (not including running externalprograms).
=head1 SYNOPSIS
use FindBin 1.42 qw( $Bin );
use Test 1.13 qw( ok plan );
BEGIN { unshift @INC, $Bin };
use test qw( DATA_DIR
evcheck runcheck );
BEGIN {
plan tests => 3,
todo => [],
;
}
ok evcheck(sub {
open my $fh, '>', 'foo';
print $fh "$_\n"
for 'Bulgaria', 'Cholet';
close $fh;
}, 'write foo'), 1, 'write foo';
save_output('stderr', *STDERR{IO});
warn 'Hello, Mum!';
print restore_output('stderr');
=head1 DESCRIPTION
This package provides some variables, and sets up an environment, for test
scripts, such as those used in F.
This package does not including running external programs; that is provided by
C. This is so that suites not needing that can include only
test.pm, and so not require the presence of C.
Setting up the environment includes:
=over 4
=item Prepending F onto the path
=item Pushing the module F dir onto the @PERL5LIB var
For executed scripts.
=item Pushing the module F dir onto the @INC var
For internal C