1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
|
use strict;
use warnings;
use Test::More tests => 7;
use Digest::Whirlpool;
=head1 DESCRIPTION
Test the XS constructor, should be equivalent to:
sub new
{
my $proto = shift;
bless {}, ref $proto || $proto;
}
These tests are taken from the (as of writing) yet-to-be released
L<Cwlib> (unix-cw wrapper) test suite.
=head1 TESTS
=over
=cut
=item * Plain object construction works
=cut
{
my $cw = Digest::Whirlpool->new;
isa_ok($cw, 'Digest::Whirlpool');
}
=item * Direct call to the constructor using a READONLY SV
=cut
{
my $cw = Digest::Whirlpool::new('Digest::Whirlpool');
isa_ok($cw, 'Digest::Whirlpool');
}
=item * Direct call to the constructor using a normal SV
=cut
{
my $pkg = 'Digest::Whirlpool';
my $cw = Digest::Whirlpool::new($pkg);
isa_ok($cw, $pkg);
}
=item * Direct call to the constructor using a non-existing package name
=cut
{
my $pkg = 'Digest::Whirlpool::Subclass::One';
my $cw = Digest::Whirlpool::new($pkg);
isa_ok($cw, $pkg);
}
=item * Direct call to the constructor using an existing package name
=cut
{
package Digest::Whirlpool::Subclass::Two;
package main;
my $pkg = 'Digest::Whirlpool::Subclass::Two';
my $cw = Digest::Whirlpool::new($pkg);
isa_ok($cw, $pkg);
}
=item * Construction using a package reference.
=cut
{
my $cw = Digest::Whirlpool->new->new;
isa_ok($cw, 'Digest::Whirlpool');
}
=item * Construction of a subclassed package
=cut
{
package Digest::Whirlpool::Subclass::Three;
use strict;
use warnings;
BEGIN { our @ISA = 'Digest::Whirlpool' }
package main;
my $pkg = 'Digest::Whirlpool::Subclass::Three';
my $cw = $pkg->new;
isa_ok($cw, $pkg);
}
=back
=cut
|