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