This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix regression with $version::LAX and bump release
[perl5.git] / cpan / version / t / 04strict_lax.t
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
7 use Test::More qw/no_plan/;
8
9 # do strict lax tests in a sub to isolate a package to test importing
10 SKIP: {
11     skip 'No extended regexes Perl < 5.006', 174
12         if $] < 5.006_000;
13     strict_lax_tests();
14     is ref($version::LAX), 'Regexp', 'Can see $version::LAX '.$version::LAX ;
15     is ref($version::STRICT), 'Regexp', 'Can see $version::STRICT '.$version::STRICT;
16 }
17
18
19 sub strict_lax_tests {
20   package temp12345;
21   # copied from perl core test t/op/packagev.t
22   # format: STRING STRICT_OK LAX_OK
23   my $strict_lax_data = << 'CASE_DATA';
24 1.00            pass    pass
25 1.00001         pass    pass
26 0.123           pass    pass
27 12.345          pass    pass
28 42              pass    pass
29 0               pass    pass
30 0.0             pass    pass
31 v1.2.3          pass    pass
32 v1.2.3.4        pass    pass
33 v0.1.2          pass    pass
34 v0.0.0          pass    pass
35 01              fail    pass
36 01.0203         fail    pass
37 v01             fail    pass
38 v01.02.03       fail    pass
39 .1              fail    pass
40 .1.2            fail    pass
41 1.              fail    pass
42 1.a             fail    fail
43 1._             fail    fail
44 1.02_03         fail    pass
45 v1.2_3          fail    pass
46 v1.02_03        fail    pass
47 v1.2_3_4        fail    fail
48 v1.2_3.4        fail    fail
49 1.2_3.4         fail    fail
50 0_              fail    fail
51 1_              fail    fail
52 1_.             fail    fail
53 1.1_            fail    fail
54 1.02_03_04      fail    fail
55 1.2.3           fail    pass
56 v1.2            fail    pass
57 v0              fail    pass
58 v1              fail    pass
59 v.1.2.3         fail    fail
60 v               fail    fail
61 v1.2345.6       fail    pass
62 undef           fail    pass
63 1a              fail    fail
64 1.2a3           fail    fail
65 bar             fail    fail
66 _               fail    fail
67 CASE_DATA
68
69   require version;
70   version->import( qw/is_strict is_lax/ );
71   for my $case ( split qr/\n/, $strict_lax_data ) {
72     my ($v, $strict, $lax) = split qr/\t+/, $case;
73     main::ok( $strict eq 'pass' ? is_strict($v) : ! is_strict($v), "is_strict($v) [$strict]" );
74     main::ok( $strict eq 'pass' ? version::is_strict($v) : ! version::is_strict($v), "version::is_strict($v) [$strict]" );
75     main::ok( $lax eq 'pass' ? is_lax($v) : ! is_lax($v), "is_lax($v) [$lax]" );
76     main::ok( $lax eq 'pass' ? version::is_lax($v) : ! version::is_lax($v), "version::is_lax($v) [$lax]" );
77   }
78 }