blob: 2c944482694ec7f84c39d5ab7e91fd13c33524a0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
#! /usr/local/perl -w
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
#########################
use Test::More qw/no_plan/;
my $Verbose;
# do strict lax tests in a sub to isolate a package to test importing
SKIP: {
skip 'No extended regexes Perl < 5.006', 172
if $] < 5.006_000;
strict_lax_tests();
}
sub strict_lax_tests {
package temp12345;
# copied from perl core test t/op/packagev.t
# format: STRING STRICT_OK LAX_OK
my $strict_lax_data = << 'CASE_DATA';
1.00 pass pass
1.00001 pass pass
0.123 pass pass
12.345 pass pass
42 pass pass
0 pass pass
0.0 pass pass
v1.2.3 pass pass
v1.2.3.4 pass pass
v0.1.2 pass pass
v0.0.0 pass pass
01 fail pass
01.0203 fail pass
v01 fail pass
v01.02.03 fail pass
.1 fail pass
.1.2 fail pass
1. fail pass
1.a fail fail
1._ fail fail
1.02_03 fail pass
v1.2_3 fail pass
v1.02_03 fail pass
v1.2_3_4 fail fail
v1.2_3.4 fail fail
1.2_3.4 fail fail
0_ fail fail
1_ fail fail
1_. fail fail
1.1_ fail fail
1.02_03_04 fail fail
1.2.3 fail pass
v1.2 fail pass
v0 fail pass
v1 fail pass
v.1.2.3 fail fail
v fail fail
v1.2345.6 fail pass
undef fail pass
1a fail fail
1.2a3 fail fail
bar fail fail
_ fail fail
CASE_DATA
require version;
version->import( qw/is_strict is_lax/ );
for my $case ( split qr/\n/, $strict_lax_data ) {
my ($v, $strict, $lax) = split qr/\t+/, $case;
main::ok( $strict eq 'pass' ? is_strict($v) : ! is_strict($v), "is_strict($v) [$strict]" );
main::ok( $strict eq 'pass' ? version::is_strict($v) : ! version::is_strict($v), "version::is_strict($v) [$strict]" );
main::ok( $lax eq 'pass' ? is_lax($v) : ! is_lax($v), "is_lax($v) [$lax]" );
main::ok( $lax eq 'pass' ? version::is_lax($v) : ! version::is_lax($v), "version::is_lax($v) [$lax]" );
}
}
|
