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 7use Test::More qw/no_plan/; 8 9# do strict lax tests in a sub to isolate a package to test importing 10SKIP: { 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 { # https://rt.cpan.org/Ticket/Display.html?id=114712 17 my ($v) = ( "snapshot-1.2.3ga-001-432" =~ /($version::LAX)/ ); 18 is $v, '1.2.3', "Extract just the version: $v"; 19 ($v) = ( "snapshot-1.2ga-001-432" =~ /($version::LAX)/ ); 20 is $v, '1.2', "Extract just the version: $v"; 21 ($v) = ( "snapshot-v1.2.3ga-001-432" =~ /($version::STRICT)/ ); 22 is $v, 'v1.2.3', "Extract just the version: $v"; 23 } 24 25 is ref($version::LAX_DECIMAL_VERSION), 'Regexp', 'Can see $version::LAX_DECIMAL_VERSION '.$version::LAX_DECIMAL_VERSION ; 26 is ref($version::LAX_DOTTED_DECIMAL_VERSION), 'Regexp', 'Can see $version::LAX_DOTTED_DECIMAL_VERSION '.$version::LAX_DOTTED_DECIMAL_VERSION ; 27 is ref($version::STRICT_DECIMAL_VERSION), 'Regexp', 'Can see $version::STRICT_DECIMAL_VERSION '.$version::STRICT_DECIMAL_VERSION; 28 is ref($version::STRICT_DOTTED_DECIMAL_VERSION), 'Regexp', 'Can see $version::STRICT_DOTTED_DECIMAL_VERSION '.$version::STRICT_DOTTED_DECIMAL_VERSION; 29 { # https://rt.cpan.org/Ticket/Display.html?id=119669 30 ($v) = ( "snapshot-1.2.3ga-001-432" =~ /($version::LAX_DOTTED_DECIMAL_VERSION)/ ); 31 is $v, '1.2.3', "Extract just the version: $v"; 32 ($v) = ( "snapshot-1.2ga-001-432" =~ /($version::LAX_DECIMAL_VERSION)/ ); 33 is $v, '1.2', "Extract just the version: $v"; 34 ($v) = ( "snapshot-v1.2.3ga-001-432" =~ /($version::STRICT_DOTTED_DECIMAL_VERSION)/ ); 35 is $v, 'v1.2.3', "Extract just the version: $v"; 36 ($v) = ( "snapshot-1.2ga-001-432" =~ /($version::STRICT_DECIMAL_VERSION)/ ); 37 is $v, '1.2', "Extract just the version: $v"; 38 } 39} 40 41 42sub strict_lax_tests { 43 package temp12345; 44 # copied from perl core test t/op/packagev.t 45 # format: STRING STRICT_OK LAX_OK 46 my $strict_lax_data = << 'CASE_DATA'; 471.00 pass pass 481.00001 pass pass 490.123 pass pass 5012.345 pass pass 5142 pass pass 520 pass pass 530.0 pass pass 54v1.2.3 pass pass 55v1.2.3.4 pass pass 56v0.1.2 pass pass 57v0.0.0 pass pass 5801 fail pass 5901.0203 fail pass 60v01 fail pass 61v01.02.03 fail pass 62.1 fail pass 63.1.2 fail pass 641. fail pass 651.a fail fail 661._ fail fail 671.02_03 fail pass 68v1.2_3 fail pass 69v1.02_03 fail pass 70v1.2_3_4 fail fail 71v1.2_3.4 fail fail 721.2_3.4 fail fail 730_ fail fail 741_ fail fail 751_. fail fail 761.1_ fail fail 771.02_03_04 fail fail 781.2.3 fail pass 79v1.2 fail pass 80v0 fail pass 81v1 fail pass 82v.1.2.3 fail fail 83v fail fail 84v1.2345.6 fail pass 85undef fail pass 861a fail fail 871.2a3 fail fail 88bar fail fail 89_ fail fail 90CASE_DATA 91 92 require version; 93 version->import( qw/is_strict is_lax/ ); 94 for my $case ( split qr/\n/, $strict_lax_data ) { 95 my ($v, $strict, $lax) = split qr/\t+/, $case; 96 main::ok( $strict eq 'pass' ? is_strict($v) : ! is_strict($v), "is_strict($v) [$strict]" ); 97 main::ok( $strict eq 'pass' ? version::is_strict($v) : ! version::is_strict($v), "version::is_strict($v) [$strict]" ); 98 main::ok( $lax eq 'pass' ? is_lax($v) : ! is_lax($v), "is_lax($v) [$lax]" ); 99 main::ok( $lax eq 'pass' ? version::is_lax($v) : ! version::is_lax($v), "version::is_lax($v) [$lax]" ); 100 } 101} 102