From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Wed, 1 Jul 2009 10:28:04 +0000 (+0200)
Subject: Make C<undef ~~ 0> and C<undef ~~ ""> not match (like in 5.10.0)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fb51372e8e462d7f3320e8a1b91a913f976aae12;p=p5sagit%2Fp5-mst-13.2.git

Make C<undef ~~ 0> and C<undef ~~ ""> not match (like in 5.10.0)

This makes ~~ commutative with regard to undef, and fixes an
inconsistency, since C<undef ~~ [0]> was not matching, and ~~
should be distributive in this case.
---

diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod
index 2ba30d8..9212573 100644
--- a/pod/perlsyn.pod
+++ b/pod/perlsyn.pod
@@ -720,6 +720,7 @@ and "Array" entries apply in those cases. (For blessed references, the
     Object  Any       invokes ~~ overloading on $object, or falls back:
     Any     Num       numeric equality         $a == $b
     Num     numish[4] numeric equality         $a == $b
+    undef   Any       undefined                !defined($b)
     Any     Any       string equality          $a eq $b
 
  1 - empty hashes or arrays will match.
diff --git a/pp_ctl.c b/pp_ctl.c
index 6bb5b40..59ac8c1 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4393,6 +4393,10 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 	SP -= 2;
 	goto sm_any_scalar;
     }
+    else if (!SvOK(d)) {
+	/* undef ~~ scalar ; we already know that the scalar is SvOK */
+	RETPUSHNO;
+    }
     else
   sm_any_scalar:
     if (SvNIOK(e) || (SvPOK(e) && looks_like_number(e) && SvNIOK(d))) {
diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
index 58466af..cb0e656 100644
--- a/t/op/smartmatch.t
+++ b/t/op/smartmatch.t
@@ -70,7 +70,7 @@ my %keyandmore = map { $_ => 0 } @keyandmore;
 my %fooormore = map { $_ => 0 } @fooormore;
 
 # Load and run the tests
-plan tests => 314;
+plan tests => 322;
 
 while (<DATA>) {
     next if /^#/ || !/\S/;
@@ -371,7 +371,7 @@ __DATA__
 	["foo", "bar"]		[["foo"], ["bar"]]
 !	["foo", "bar"]		[qr/o/, "foo"]
 	["foo", undef, "bar"]	[qr/o/, undef, "bar"]
-	["foo", undef, "bar"]	[qr/o/, "",    "bar"]
+!	["foo", undef, "bar"]	[qr/o/, "",    "bar"]
 !	["foo", "", "bar"]	[qr/o/, undef, "bar"]
 	$deep1			$deep1
 	@$deep1			@$deep1
@@ -409,6 +409,11 @@ __DATA__
 !	undef		[1, 2, [undef], 4]
 !	undef		@fooormore
 	undef		@sparse
+	undef		[undef]
+!	0		[undef]
+!	""		[undef]
+!	undef		[0]
+!	undef		[""]
 
 # - nested arrays and ~~ distributivity
 	11		[[11]]
@@ -422,7 +427,8 @@ __DATA__
 !	2		3
 	0		FALSE
 	3-2		TRUE
-	undef		0
+!	undef		0
+!	(my $u)		0
 
 # Number against string
 =	2		"2"
@@ -430,6 +436,8 @@ __DATA__
 !	2		"2bananas"
 !=	2_3		"2_3"		NOWARNINGS
 	FALSE		"0"
+!	undef		"0"
+!	undef		""
 
 # Regex against string
 	"x"		qr/x/
diff --git a/t/op/switch.t b/t/op/switch.t
index d8cb781..2012c6c 100644
--- a/t/op/switch.t
+++ b/t/op/switch.t
@@ -133,15 +133,15 @@ sub check_outside1 { is($_, "outside", "\$_ lexically scoped") }
 }
 {
     no warnings "uninitialized";
-    my $ok = 0;
-    given (undef) { when(0) {$ok = 1} }
+    my $ok = 1;
+    given (undef) { when(0) {$ok = 0} }
     is($ok, 1, "Given(undef) when(0)");
 }
 {
     no warnings "uninitialized";
     my $undef;
-    my $ok = 0;
-    given ($undef) { when(0) {$ok = 1} }
+    my $ok = 1;
+    given ($undef) { when(0) {$ok = 0} }
     is($ok, 1, 'Given($undef) when(0)');
 }
 ########
@@ -158,15 +158,15 @@ sub check_outside1 { is($_, "outside", "\$_ lexically scoped") }
 }
 {
     no warnings "uninitialized";
-    my $ok = 0;
-    given (undef) { when("") {$ok = 1} }
+    my $ok = 1;
+    given (undef) { when("") {$ok = 0} }
     is($ok, 1, 'Given(undef) when("")');
 }
 {
     no warnings "uninitialized";
     my $undef;
-    my $ok = 0;
-    given ($undef) { when("") {$ok = 1} }
+    my $ok = 1;
+    given ($undef) { when("") {$ok = 0} }
     is($ok, 1, 'Given($undef) when("")');
 }
 ########