#! /usr/local/perl -w
BEGIN {
my
$coretests
= File::Spec->rel2abs(
File::Spec->catpath(
(File::Spec->splitpath($0))[0,1],
'coretests.pm'
)
);
require
$coretests
;
use_ok(
"version"
, 0.9933);
}
sub
new {
my
(
$self
,
$n
)=
@_
;
bless
\
$n
,
$self
}
sub
new {
my
(
$class
,
$val
) =
@_
;
die
'Invalid version string format'
unless
version::is_strict(
$val
);
my
$self
=
$class
->SUPER::new(
$val
);
return
$self
;
}
sub
declare {
my
(
$class
,
$val
) =
@_
;
my
$self
=
$class
->SUPER::declare(
$val
);
return
$self
;
}
my
$warning
;
local
$SIG
{__WARN__} =
sub
{
$warning
=
$_
[0] };
my
(
$fh
,
$filename
) = tempfile(
'tXXXXXXX'
,
SUFFIX
=>
'.pm'
,
UNLINK
=> 1);
(
my
$package
= basename(
$filename
)) =~ s/\.pm$//;
print
$fh
<<"EOF";
# This is an empty subclass
package $package;
use base 'version';
our \$VERSION = 0.001;
EOF
close
$fh
;
sub
main_reset {
delete
$main::INC
{
'$package'
};
undef
&qv
;
undef
*::qv;
undef
&declare
;
undef
*::declare;
}
use_ok(
$package
, 0.001);
my
$testobj
=
$package
->new(1.002_003);
isa_ok(
$testobj
,
$package
);
ok(
$testobj
->numify == 1.002003,
"Numified correctly"
);
ok(
$testobj
->stringify eq
"1.002003"
,
"Stringified correctly"
);
ok(
$testobj
->normal eq
"v1.2.3"
,
"Normalified correctly"
);
my
$verobj
= version::->new(
"1.2.4"
);
ok(
$verobj
>
$testobj
,
"Comparison vs parent class"
);
BaseTests(
$package
,
"new"
,
"qv"
);
main_reset;
use_ok(
$package
, 0.001,
"declare"
);
BaseTests(
$package
,
"new"
,
"declare"
);
main_reset;
use_ok(
$package
, 0.001);
BaseTests(
$package
,
"parse"
,
"qv"
);
main_reset;
use_ok(
$package
, 0.001,
"declare"
);
BaseTests(
$package
,
"parse"
,
"declare"
);
$testobj
= version::Bad->new(1.002_003);
isa_ok(
$testobj
,
"version::Bad"
);
eval
{
my
$string
=
$testobj
->numify };
like($@,
qr/Invalid version object/
,
"Bad subclass numify"
);
eval
{
my
$string
=
$testobj
->normal };
like($@,
qr/Invalid version object/
,
"Bad subclass normal"
);
eval
{
my
$string
=
$testobj
->stringify };
like($@,
qr/Invalid version object/
,
"Bad subclass stringify"
);
eval
{
my
$test
= (
$testobj
> 1.0) };
like($@,
qr/Invalid version object/
,
"Bad subclass vcmp"
);
eval
{
my
$test
= version::Bad2->new(
"01.1.2"
) };
like($@,
qr/Invalid version string format/
,
"Correctly found invalid version"
);
eval
{
my
$test
= version::Bad2->declare(
"01.1.2"
) };
unlike($@,
qr/Invalid version string format/
,
"Correctly ignored invalid version"
);