From: David Golden <dagolden@cpan.org>
Date: Mon, 26 Apr 2010 00:26:44 +0000 (-0400)
Subject: add tests for version::is_strict() and version::is_lax()
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9b463b21d3655b79309f8b461042cebb5733c54e;p=p5sagit%2Fp5-mst-13.2.git

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

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