From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Fri, 13 Mar 2009 10:47:58 +0000 (+0100)
Subject: Make smart matching ~~ undef dispatch only on the RHS
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=62ec5f58625ce7dd38f2ee3ba00b450373b0de40;p=p5sagit%2Fp5-mst-13.2.git

Make smart matching ~~ undef dispatch only on the RHS
---

diff --git a/pp_ctl.c b/pp_ctl.c
index 33ac1ee..db4ba16 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4042,12 +4042,6 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 	&& (this_regex = (REGEXP*) This)				\
 	&& (Other = d))	)
 	
-
-#   define SM_OBJECT ( \
-	   (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP))		\
-    ||									\
-	   (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) )	\
-
 #   define SM_OTHER_REF(type) \
 	(SvROK(Other) && SvTYPE(SvRV(Other)) == SVt_##type)
 
@@ -4063,7 +4057,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 	sv_2mortal(newSViv(PTR2IV(sv))), 0)
 
     tryAMAGICbinSET(smart, 0);
-    
+
     SP -= 2;	/* Pop the values */
 
     /* Take care only to invoke mg_get() once for each argument. 
@@ -4079,13 +4073,17 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
     if (SvGMAGICAL(e))
 	e = sv_mortalcopy(e);
 
-    if (SM_OBJECT) {
-	if (!SvOK(d) || !SvOK(e))
+    if (!SvOK(e)) {
+	if (SvOK(d))
 	    RETPUSHNO;
 	else
-	    Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
+	    RETPUSHYES;
     }
 
+    if ((sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP))
+	    || (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)))
+	Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
+
     if (SM_REF(PVCV)) {
 	I32 c;
 	ENTER;
@@ -4305,12 +4303,6 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 	    RETPUSHNO;
 	}
     }
-    else if (!SvOK(d) || !SvOK(e)) {
-	if (!SvOK(d) && !SvOK(e))
-	    RETPUSHYES;
-	else
-	    RETPUSHNO;
-    }
     else if (SM_REGEX) {
 	PMOP * const matcher = make_matcher(this_regex);
 
diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
index 52e7f91..0097bff 100644
--- a/t/op/smartmatch.t
+++ b/t/op/smartmatch.t
@@ -135,6 +135,7 @@ __DATA__
 !	""		undef
 !	!1		undef
 	undef		undef
+	(my $u)		undef
 
 # Any ~~ object overloaded
 # object overloaded ~~ Any
diff --git a/t/op/switch.t b/t/op/switch.t
index b00ade8..de44082 100644
--- a/t/op/switch.t
+++ b/t/op/switch.t
@@ -133,14 +133,16 @@ sub check_outside1 { is($_, "outside", "\$_ lexically scoped") }
     is($ok, 1, "Given(0) when($undef++)");
 }
 {
-    my $ok = 1;
-    given (undef) { when(0) {$ok = 0} }
+    no warnings "uninitialized";
+    my $ok = 0;
+    given (undef) { when(0) {$ok = 1} }
     is($ok, 1, "Given(undef) when(0)");
 }
 {
+    no warnings "uninitialized";
     my $undef;
-    my $ok = 1;
-    given ($undef) { when(0) {$ok = 0} }
+    my $ok = 0;
+    given ($undef) { when(0) {$ok = 1} }
     is($ok, 1, 'Given($undef) when(0)');
 }
 ########
@@ -156,14 +158,16 @@ sub check_outside1 { is($_, "outside", "\$_ lexically scoped") }
     is($ok, 1, 'Given("") when($undef)');
 }
 {
-    my $ok = 1;
-    given (undef) { when("") {$ok = 0} }
+    no warnings "uninitialized";
+    my $ok = 0;
+    given (undef) { when("") {$ok = 1} }
     is($ok, 1, 'Given(undef) when("")');
 }
 {
+    no warnings "uninitialized";
     my $undef;
-    my $ok = 1;
-    given ($undef) { when("") {$ok = 0} }
+    my $ok = 0;
+    given ($undef) { when("") {$ok = 1} }
     is($ok, 1, 'Given($undef) when("")');
 }
 ########
@@ -617,6 +621,7 @@ my $f = tie my $v, "FetchCounter";
     my $ok;
     $v = undef;
     is($f->count(), 0, "Sanity check: $test_name");
+    no warnings "uninitialized";
     given(my $undef) {
     	when(sub{0}->()) {}
 	when("21")  {}