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/;
8use File::Spec;
9use File::Temp qw/tempfile/;
10
11BEGIN {
12    my $coretests = File::Spec->rel2abs(
13        File::Spec->catpath(
14            (File::Spec->splitpath($0))[0,1], 'coretests.pm'
15        )
16    );
17    require $coretests;
18    use_ok("version", 0.9929);
19    # If we made it this far, we are ok.
20}
21
22use lib qw/./;
23
24package version::Bad;
25use base 'version';
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;
30use base 'version';
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;
53use base 'version';
54our \$VERSION = 0.001;
55EOF
56close $fh;
57
58sub main_reset {
59    delete $main::INC{'$package'};
60    undef &qv; undef *::qv; # avoid 'used once' warning
61    undef &declare; undef *::declare; # avoid 'used once' warning
62}
63
64use_ok($package, 0.001);
65my $testobj = $package->new(1.002_003);
66isa_ok( $testobj, $package );
67ok( $testobj->numify == 1.002003, "Numified correctly" );
68ok( $testobj->stringify eq "1.002003", "Stringified correctly" );
69ok( $testobj->normal eq "v1.2.3", "Normalified correctly" );
70
71my $verobj = version::->new("1.2.4");
72ok( $verobj > $testobj, "Comparison vs parent class" );
73
74BaseTests($package, "new", "qv");
75main_reset;
76use_ok($package, 0.001, "declare");
77BaseTests($package, "new", "declare");
78main_reset;
79use_ok($package, 0.001);
80BaseTests($package, "parse", "qv");
81main_reset;
82use_ok($package, 0.001, "declare");
83BaseTests($package, "parse", "declare");
84
85$testobj = version::Bad->new(1.002_003);
86isa_ok( $testobj, "version::Bad" );
87eval { my $string = $testobj->numify };
88like($@, qr/Invalid version object/,
89    "Bad subclass numify");
90eval { my $string = $testobj->normal };
91like($@, qr/Invalid version object/,
92    "Bad subclass normal");
93eval { my $string = $testobj->stringify };
94like($@, qr/Invalid version object/,
95    "Bad subclass stringify");
96eval { my $test = ($testobj > 1.0) };
97like($@, qr/Invalid version object/,
98    "Bad subclass vcmp");
99
100# Bad subclassing for SemVer with pure Perl version.pm only
101eval { my $test = version::Bad2->new("01.1.2") };
102like($@, qr/Invalid version string format/,
103    "Correctly found invalid version");
104
105eval { my $test = version::Bad2->declare("01.1.2") };
106unlike($@, qr/Invalid version string format/,
107    "Correctly ignored invalid version");
108