t/op/packagev.t

   1 #!./perl
   2
   3 BEGIN {
   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
  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 => 7 * @syntax_cases + 7 * (grep { $_ !~ /^#/ } @version_cases)
  21             + 2 * 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     eval "${string}{}";
  38     is( $@, '', qq/eval "${string}{}"/ );
  39     eval "$string {}";
  40     is( $@, '', qq/eval "$string {}"/ );
  41 }
  42
  43 LINE:
  44 for 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 #
 110 for 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__
 146 1.00            pass    pass    pass
 147 1.00001         pass    pass    pass
 148 0.123           pass    pass    pass
 149 12.345          pass    pass    pass
 150 42              pass    pass    pass
 151 0               pass    pass    pass
 152 0.0             pass    pass    pass
 153 v1.2.3          pass    pass    pass
 154 v1.2.3.4        pass    pass    pass
 155 v0.1.2          pass    pass    pass
 156 v0.0.0          pass    pass    pass
 157 01              fail    pass    pass    no leading zeros
 158 01.0203         fail    pass    pass    no leading zeros
 159 v01             fail    pass    pass    no leading zeros
 160 v01.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
 163 1.              fail    pass    pass    fractional part required
 164 1.a             fail    fail    na      fractional part required
 165 1._             fail    fail    na      fractional part required
 166 1.02_03         fail    pass    pass    underscore
 167 v1.2_3          fail    pass    pass    underscore
 168 v1.02_03        fail    pass    pass    underscore
 169 0_              fail    fail    na      underscore
 170 1_              fail    fail    na      underscore
 171 1_.             fail    fail    na      underscore
 172 1.1_            fail    fail    na      underscore
 173 1.02_03_04      fail    fail    na      underscore
 174 1.2.3           fail    pass    pass    dotted-decimal versions must begin with 'v'
 175 v1.2            fail    pass    pass    dotted-decimal versions require at least three parts
 176 v0              fail    pass    pass    dotted-decimal versions require at least three parts
 177 v1              fail    pass    pass    dotted-decimal versions require at least three parts
 178 v.1.2.3         fail    fail    na      dotted-decimal versions require at least three parts
 179 v               fail    fail    na      dotted-decimal versions require at least three parts
 180 v1.2345.6       fail    pass    pass    maximum 3 digits between decimals
 181 undef           fail    pass    pass    non-numeric data
 182 1a              fail    fail    na      non-numeric data
 183 1.2a3           fail    fail    na      non-numeric data
 184 bar             fail    fail    na      non-numeric data
 185 _               fail    fail    na      non-numeric data