This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Synch cpan/version/* and other files with CPAN version 0.9921.
[perl5.git] / cpan / version / t / 02derived.t
CommitLineData
543eec9e
JP
1#! /usr/local/perl -w
2# Before `make install' is performed this script should be runnable with
3# `make test'. After `make install' it should work as `perl test.pl'
4
5#########################
6
7use Test::More qw/no_plan/;
14f3031b 8use File::Spec;
543eec9e
JP
9use File::Temp qw/tempfile/;
10
11BEGIN {
dddb2275
JP
12 my $coretests = File::Spec->rel2abs(
13 File::Spec->catpath(
14 (File::Spec->splitpath($0))[0,1], 'coretests.pm'
15 )
14f3031b 16 );
543eec9e 17 require $coretests;
d3a5b29c 18 use_ok("version", 0.9921);
543eec9e
JP
19 # If we made it this far, we are ok.
20}
21
22use lib qw/./;
23
24package version::Bad;
4141ef59 25use parent 'version';
543eec9e
JP
26sub new { my($self,$n)=@_; bless \$n, $self }
27
28# Bad subclass for SemVer failures seen with pure Perl version.pm only
29package version::Bad2;
4141ef59 30use parent 'version';
543eec9e
JP
31sub new {
32 my ($class, $val) = @_;
33 die 'Invalid version string format' unless version::is_strict($val);
34 my $self = $class->SUPER::new($val);
35 return $self;
36}
37sub declare {
38 my ($class, $val) = @_;
39 my $self = $class->SUPER::declare($val);
40 return $self;
41}
42
43package main;
44
45my $warning;
46local $SIG{__WARN__} = sub { $warning = $_[0] };
47# dummy up a legal module for testing RT#19017
48my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
49(my $package = basename($filename)) =~ s/\.pm$//;
50print $fh <<"EOF";
51# This is an empty subclass
52package $package;
4141ef59 53use parent 'version';
543eec9e
JP
54use vars '\$VERSION';
55\$VERSION=0.001;
56EOF
57close $fh;
58
59sub main_reset {
60 delete $main::INC{'$package'};
61 undef &qv; undef *::qv; # avoid 'used once' warning
62 undef &declare; undef *::declare; # avoid 'used once' warning
63}
64
543eec9e
JP
65use_ok($package, 0.001);
66my $testobj = $package->new(1.002_003);
67isa_ok( $testobj, $package );
68ok( $testobj->numify == 1.002003, "Numified correctly" );
69ok( $testobj->stringify eq "1.002003", "Stringified correctly" );
70ok( $testobj->normal eq "v1.2.3", "Normalified correctly" );
71
72my $verobj = version::->new("1.2.4");
73ok( $verobj > $testobj, "Comparison vs parent class" );
74
75BaseTests($package, "new", "qv");
76main_reset;
77use_ok($package, 0.001, "declare");
78BaseTests($package, "new", "declare");
79main_reset;
80use_ok($package, 0.001);
81BaseTests($package, "parse", "qv");
82main_reset;
83use_ok($package, 0.001, "declare");
84BaseTests($package, "parse", "declare");
85
543eec9e
JP
86$testobj = version::Bad->new(1.002_003);
87isa_ok( $testobj, "version::Bad" );
88eval { my $string = $testobj->numify };
89like($@, qr/Invalid version object/,
90 "Bad subclass numify");
91eval { my $string = $testobj->normal };
92like($@, qr/Invalid version object/,
93 "Bad subclass normal");
94eval { my $string = $testobj->stringify };
95like($@, qr/Invalid version object/,
96 "Bad subclass stringify");
97eval { my $test = ($testobj > 1.0) };
98like($@, qr/Invalid version object/,
99 "Bad subclass vcmp");
100
101# Bad subclassing for SemVer with pure Perl version.pm only
102eval { my $test = version::Bad2->new("01.1.2") };
103like($@, qr/Invalid version string format/,
104 "Correctly found invalid version");
105
106eval { my $test = version::Bad2->declare("01.1.2") };
107unlike($@, qr/Invalid version string format/,
108 "Correctly ignored invalid version");