add tests for version::is_strict() and version::is_lax()

diff --git a/lib/version.t b/lib/version.t
index f44cfea..7bce0eb 100644 (file)
--- 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 {