This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
8e8f19f9b3af4c9953878dda9aaa1cf187c26a2e
[perl5.git] / t / op / packagev.t
1 #!./perl
2
3 BEGIN {
4     chdir 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 # XXX remove this later -- dagolden, 2010-01-13
10 # local *STDERR = *STDOUT;
11
12 my @syntax_cases = (
13     'package Foo',
14     'package Bar 1.23',
15     'package Baz v1.2.3',
16 );
17
18 my @version_cases = <DATA>;
19
20 plan tests => 5 * @syntax_cases + 5 * (grep { $_ !~ /^#/ } @version_cases)
21             + 3;
22
23 use warnings qw/syntax/;
24 use version;
25
26 for my $string ( @syntax_cases ) {
27     eval "$string";
28     is( $@, '', qq/eval "$string"/ );
29     eval "$string;";
30     is( $@, '', qq/eval "$string;"/ );
31     eval "$string ;";
32     is( $@, '', qq/eval "$string ;"/ );
33     eval "{$string}";
34     is( $@, '', qq/eval "{$string}"/ );
35     eval "{ $string }";
36     is( $@, '', qq/eval "{ $string }"/ );
37 }
38
39 LINE:
40 for my $line (@version_cases) {
41     chomp $line;
42     # comments in data section are just diagnostics
43     if ($line =~ /^#/) {
44         diag $line;
45         next LINE;
46     }
47
48     my ($v, $package, $quoted, $bare, $match) = split /\t+/, $line;
49     my $warning = "";
50     local $SIG{__WARN__} = sub { $warning .= $_[0] . "\n" };
51     $match = defined $match ? $match : "";
52     $match =~ s/\s*\z//; # kill trailing spaces
53
54     # First handle the 'package NAME VERSION' case
55     $withversion::VERSION = undef;
56     if ($package eq 'fail') {
57         eval "package withversion $v";
58         like($@, qr/$match/, "package withversion $v -> syntax error ($match)");
59         ok(! version::is_strict($v), qq{... and "$v" should also fail STRICT regex});
60     }
61     else {
62         my $ok = eval "package withversion $v; $v eq \$withversion::VERSION";
63         ok($ok, "package withversion $v")
64           or diag( $@ ? $@ : "and \$VERSION = $withversion::VERSION");
65         ok( version::is_strict($v), qq{... and "$v" should pass STRICT regex});
66     }
67
68
69     # Now check the version->new("V") case
70     my $ver = undef;
71     eval qq/\$ver = version->new("$v")/;
72     if ($quoted eq 'fail') {
73         like($@, qr/$match/, qq{version->new("$v") -> invalid format ($match)})
74           or diag( $@ ? $@ : "and \$ver = $ver" );
75         ok( ! version::is_lax($v), qq{... and "$v" should fail LAX regex});
76     }
77     else {
78         is($@, "", qq{version->new("$v")});
79         ok( version::is_lax($v), qq{... and "$v" should pass LAX regex});
80     }
81
82     # Now check the version->new(V) case, unless we're skipping it
83     if ( $bare eq 'na' ) {
84         pass( "... skipping version->new($v)" );
85         next LINE;
86     }
87     $ver = undef;
88     eval qq/\$ver = version->new($v)/;
89     if ($bare eq 'fail') {
90         like($@, qr/$match/m, qq{... and unquoted version->new($v) has same error})
91           or diag( $@ ? $@ : "and \$ver = $ver" );
92     }
93     else {
94         is($@, "", qq{... and version->new($v) is ok});
95     }
96 }
97
98 #
99 # Tests for #72432 - which reports a syntax error if there's a newline
100 # between the package name and the version.
101 #
102 # Note that we are using 'run_perl' here - there's no problem if 
103 # "package Foo\n1;" is evalled.
104 #
105 for my $v ("1", "1.23", "v1.2.3") {
106     ok (run_perl (prog => "package Foo\n$v; print 1;"),
107                           "New line between package name and version");
108 }
109
110 # The data is organized in tab delimited format with these columns:
111 #
112 # value         package         version->new    version->new    regex
113 #                               quoted          unquoted
114 #
115 # For each value, it is tested using eval in the following expressions
116 #
117 #       package foo $value;                     # column 2
118 # and
119 #       my $ver = version->new("$value");       # column 3
120 # and
121 #       my $ver = version->new($value);         # column 4
122 #
123 # The second through fourth columns can contain 'pass' or 'fail'.
124 #
125 # For any column with 'pass', the tests makes sure that no warning/error
126 # was thrown.  For any column with 'fail', the tests make sure that the
127 # error thrown matches the regex in the last column.  The unquoted column
128 # may also have 'na' indicating that it's pointless to test as behavior
129 # is subject to the perl parser before a stringifiable value is available
130 # to version->new
131 #
132 # If all columns are marked 'pass', the regex column is left empty.
133 #
134 # there are multiple ways that underscores can fail depending on strict
135 # vs lax format so these test do not distinguish between them
136 #
137 # If the DATA line begins with a # mark, it is used as a diag comment
138 __DATA__
139 1.00            pass    pass    pass
140 1.00001         pass    pass    pass
141 0.123           pass    pass    pass
142 12.345          pass    pass    pass
143 42              pass    pass    pass
144 0               pass    pass    pass
145 0.0             pass    pass    pass
146 v1.2.3          pass    pass    pass
147 v1.2.3.4        pass    pass    pass
148 v0.1.2          pass    pass    pass
149 v0.0.0          pass    pass    pass
150 01              fail    pass    pass    no leading zeros
151 01.0203         fail    pass    pass    no leading zeros
152 v01             fail    pass    pass    no leading zeros
153 v01.02.03       fail    pass    pass    no leading zeros
154 .1              fail    pass    pass    0 before decimal required
155 .1.2            fail    pass    pass    0 before decimal required
156 1.              fail    pass    pass    fractional part required
157 1.a             fail    fail    na      fractional part required
158 1._             fail    fail    na      fractional part required
159 1.02_03         fail    pass    pass    underscore
160 v1.2_3          fail    pass    pass    underscore
161 v1.02_03        fail    pass    pass    underscore
162 v1.2_3_4        fail    fail    fail    underscore
163 v1.2_3.4        fail    fail    fail    underscore
164 1.2_3.4         fail    fail    fail    underscore
165 0_              fail    fail    na      underscore
166 1_              fail    fail    na      underscore
167 1_.             fail    fail    na      underscore
168 1.1_            fail    fail    na      underscore
169 1.02_03_04      fail    fail    na      underscore
170 1.2.3           fail    pass    pass    dotted-decimal versions must begin with 'v'
171 v1.2            fail    pass    pass    dotted-decimal versions require at least three parts
172 v0              fail    pass    pass    dotted-decimal versions require at least three parts
173 v1              fail    pass    pass    dotted-decimal versions require at least three parts
174 v.1.2.3         fail    fail    na      dotted-decimal versions require at least three parts
175 v               fail    fail    na      dotted-decimal versions require at least three parts
176 v1.2345.6       fail    pass    pass    maximum 3 digits between decimals
177 undef           fail    pass    pass    non-numeric data
178 1a              fail    fail    na      non-numeric data
179 1.2a3           fail    fail    na      non-numeric data
180 bar             fail    fail    na      non-numeric data
181 _               fail    fail    na      non-numeric data