diff options
| author | David Golden <dagolden@cpan.org> | 2010-04-25 20:26:44 -0400 |
|---|---|---|
| committer | David Golden <dagolden@cpan.org> | 2010-04-25 20:33:56 -0400 |
| commit | 9b463b21d3655b79309f8b461042cebb5733c54e (patch) | |
| tree | 8c929bb4c878d92bd663beeb950b165c52fd8b46 /lib/version.t | |
| parent | 88f31b8c13e67525fb34e29a043ddcca6830c3e7 (diff) | |
| download | perl-9b463b21d3655b79309f8b461042cebb5733c54e.tar.gz | |
add tests for version::is_strict() and version::is_lax()
Diffstat (limited to 'lib/version.t')
| -rw-r--r-- | lib/version.t | 63 |
1 files changed, 63 insertions, 0 deletions
diff --git a/lib/version.t b/lib/version.t index f44cfea93f..7bce0ebbd9 100644 --- a/lib/version.t +++ b/lib/version.t @@ -96,6 +96,69 @@ like($@, qr/Invalid version object/, eval { my $test = ($testobj > 1.0) }; like($@, qr/Invalid version object/, "Bad subclass vcmp"); +strict_lax_tests(); + +# do strict lax tests in a sub to isolate a package to test importing +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]" ); + } +} sub BaseTests { |