From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Thu, 12 Mar 2009 09:55:44 +0000 (+0100)
Subject: Some tests reorgarnisation for ~~ against undef and objects
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=85af77a5094f7cce94729e17e3c28f0a2e709ebe;p=p5sagit%2Fp5-mst-13.2.git

Some tests reorgarnisation for ~~ against undef and objects
---

diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
index 685216d..52e7f91 100644
--- a/t/op/smartmatch.t
+++ b/t/op/smartmatch.t
@@ -50,34 +50,33 @@ while (<DATA>) {
     my ($yn, $left, $right, $note) = split /\t+/;
 
     local $::TODO = $note =~ /TODO/;
-    match_test($yn, $left, $right);
-    match_test($yn, $right, $left);
-}
-
-sub match_test {
-    my ($yn, $left, $right) = @_;
 
-    die "Bad test spec: ($yn, $left, $right)"
-	unless $yn eq "" || $yn eq "!" || $yn eq '@';
+    die "Bad test spec: ($yn, $left, $right)" if $yn =~ /[^!@=]/;
 
     my $tstr = "$left ~~ $right";
 
+    test_again:
     my $res = eval $tstr;
 
     chomp $@;
 
-    if ( $yn eq '@' ) {
+    if ( $yn =~ /@/ ) {
 	ok( $@ ne '', "$tstr dies" )
 	    and print "# \$\@ was: $@\n";
     } else {
-	my $test_name = $tstr . ($yn eq '!' ? " does not match" : " matches");
+	my $test_name = $tstr . ($yn =~ /!/ ? " does not match" : " matches");
 	if ( $@ ne '' ) {
 	    fail($test_name);
 	    print "# \$\@ was: $@\n";
 	} else {
-	    ok( ($yn eq '!' xor $res), $test_name );
+	    ok( ($yn =~ /!/ xor $res), $test_name );
 	}
     }
+
+    if ( $yn =~ s/=// ) {
+	$tstr = "$right ~~ $left";
+	goto test_again;
+    }
 }
 
 
@@ -87,8 +86,6 @@ sub bar {42}
 sub gorch {42}
 sub fatal {die "fatal sub\n"}
 
-sub a_const() {die "const\n" if @_; "a constant"}
-sub b_const() {die "const\n" if @_; "a constant"}
 sub FALSE() { 0 }
 sub TRUE() { 1 }
 sub TWO() { 1 }
@@ -97,63 +94,91 @@ sub TWO() { 1 }
 #   - expected to match
 # ! - expected to not match
 # @ - expected to be a compilation failure
+# = - expected to match symmetrically (runs test twice)
 # Data types to test :
+#   undef
 #   Object-overloaded
 #   Object
-#   Code
-#   Code()
 #   Coderef
 #   Hash
 #   Hashref
 #   Array
 #   Arrayref
+#   Tied arrays and hashes
+#   Arrays that reference themselves
 #   Regex (// and qr//)
+#   Range
 #   Num
 #   Str
-#   undef
+# Other syntactic items of interest:
+#   Constants
+#   Values returned by a sub call
 __DATA__
-# OBJECT
-# - overloaded
-	$ov_obj		"key"
-!	$ov_obj		"foo"
-	$ov_obj		{"key" => 1}
-	$ov_obj		{"key" => 1, bar => 2}		TODO
-!	$ov_obj		{"foo" => 1}
-	$ov_obj		["key" => 1]
-!	$ov_obj		["foo" => 1]
-	$ov_obj		@keyandmore
-!	$ov_obj		@fooormore
-	$ov_obj		%keyandmore			TODO
-!	$ov_obj		%fooormore
-	$ov_obj		/key/
-!	$ov_obj		/foo/
-	$ov_obj		qr/Key/i
-!	$ov_obj		qr/foo/
-	$ov_obj		sub { shift ~~ "key" }
-!	$ov_obj		sub { shift eq "key" }
-!	$ov_obj		sub { shift ~~ "foo" }
-!	$ov_obj		\&foo
-	$ov_obj		\&bar
-@	$ov_obj		\&fatal
-!	$ov_obj		FALSE
-!	$ov_obj		\&FALSE
+# Any ~~ undef
 !	$ov_obj		undef
+!	$obj		undef
+!	sub {}		undef
+!	%hash		undef
+!	\%hash		undef
+!	{}		undef
+!	@nums		undef
+!	\@nums		undef
+!	[]		undef
+!	%tied_hash	undef
+!	@tied_nums	undef
+!	$deep1		undef
+!	/foo/		undef
+!	qr/foo/		undef
+!	21..30		undef
+!	189		undef
+!	"foo"		undef
+!	""		undef
+!	!1		undef
+	undef		undef
+
+# Any ~~ object overloaded
+# object overloaded ~~ Any
 	$ov_obj		$ov_obj
+=@	$ov_obj		\&fatal
+=!	$ov_obj		\&FALSE
+=!	$ov_obj		\&foo
+=	$ov_obj		\&bar
+=	$ov_obj		sub { shift ~~ "key" }
+=!	$ov_obj		sub { shift eq "key" }
+=!	$ov_obj		sub { shift ~~ "foo" }
+=	$ov_obj		%keyandmore			TODO
+=!	$ov_obj		%fooormore
+=	$ov_obj		{"key" => 1}
+=	$ov_obj		{"key" => 1, bar => 2}		TODO
+=!	$ov_obj		{"foo" => 1}
+=	$ov_obj		@keyandmore
+=!	$ov_obj		@fooormore
+=	$ov_obj		["key" => 1]
+=!	$ov_obj		["foo" => 1]
+=	$ov_obj		/key/
+=!	$ov_obj		/foo/
+=	$ov_obj		qr/Key/i
+=!	$ov_obj		qr/foo/
+=	$ov_obj		"key"
+=!	$ov_obj		"foo"
+=!	$ov_obj		FALSE
 
 # regular object
-@	$obj	"key"
-@	$obj	{"key" => 1}
-@	$obj	["key" => 1]
-@	$obj	/key/
-@	$obj	qr/key/
-@	$obj	sub { 1 }
-@	$obj	sub { 0 }
-@	$obj	\&foo
-@	$obj	\&fatal
-@	$obj	FALSE
-@	$obj	\&FALSE
-!	$obj	undef
-@	$obj	$obj
+=@	$obj	$ov_obj
+=@	$obj	$obj
+=@	$obj	\&fatal
+=@	$obj	\&FALSE
+=@	$obj	\&foo
+=@	$obj	sub { 1 }
+=@	$obj	sub { 0 }
+=@	$obj	%keyandmore
+=@	$obj	{"key" => 1}
+=@	$obj	@fooormore
+=@	$obj	["key" => 1]
+=@	$obj	/key/
+=@	$obj	qr/key/
+=@	$obj	"key"
+=@	$obj	FALSE
 
 # CODE ref against argument
 #  - arg is code ref
@@ -186,9 +211,6 @@ __DATA__
 	/fooormore/	sub{ref $_[0] eq 'Regexp'}
 
 # - null-prototyped subs
-	a_const		"a constant"
-	a_const		a_const
-	a_const		b_const
 !	undef		\&FALSE
 	undef		\&TRUE
 !	0		\&FALSE
@@ -303,20 +325,3 @@ __DATA__
 	@nums		{  1, '',  2, '' }
 	@nums		{  1, '', 12, '' }
 !	@nums		{ 11, '', 12, '' }
-
-# UNDEF
-!	3		undef
-!	1		undef
-!	[]		undef
-!	{}		undef
-!	\%::main	undef
-!	[1,2]		undef
-!	%hash		undef
-!	@nums		undef
-!	"foo"		undef
-!	""		undef
-!	!1		undef
-!	\&foo		undef
-!	sub { }		undef
-	undef		undef
-	$::undef	undef