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