From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 14 Jul 2004 15:36:57 +0000 (+0000)
Subject: Numeric comparison operators mustn't compare addresses of references
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0bdaccee393e6b53324e029b6bf5b646d5d93331;p=p5sagit%2Fp5-mst-13.2.git

Numeric comparison operators mustn't compare addresses of references
that are overloaded.

p4raw-id: //depot/perl@23106
---

diff --git a/lib/overload.t b/lib/overload.t
index 4184e23..519c6d8 100644
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -57,16 +57,20 @@ sub test {
     $comment = " # " . $_ [2] if @_ > 2;
     if ($_[0] eq $_[1]) {
       print "ok $test$comment\n";
+      return 1;
     } else {
       $comment .= ": '$_[0]' ne '$_[1]'";
       print "not ok $test$comment\n";
+      return 0;
     }
   } else {
     if (shift) {
       print "ok $test\n";
+      return 1;
     } else {
       print "not ok $test\n";
-    } 
+      return 0;
+    }
   }
 }
 
@@ -1123,5 +1127,37 @@ test (overload::StrVal(qr/a/) =~ /^Regexp=SCALAR\(0x[0-9a-f]+\)$/);
     test($out2, 17, "#24313");	# 232
 }
 
+{
+    package Numify;
+    use overload (qw(0+ numify fallback 1));
+
+    sub new {
+	my $val = $_[1];
+	bless \$val, $_[0];
+    }
+
+    sub numify { ${$_[0]} }
+}
+
+# These are all check that overloaded values rather than reference addressess
+# are what is getting tested.
+my ($two, $one, $un, $deux) = map {new Numify $_} 2, 1, 1, 2;
+my ($ein, $zwei) = (1, 2);
+
+my %map = (one => 1, un => 1, ein => 1, deux => 2, two => 2, zwei => 2);
+foreach my $op (qw(<=> == != < <= > >=)) {
+    foreach my $l (keys %map) {
+	foreach my $r (keys %map) {
+	    my $ocode = "\$$l $op \$$r";
+	    my $rcode = "$map{$l} $op $map{$r}";
+
+	    my $got = eval $ocode;
+	    die if $@;
+	    my $expect = eval $rcode;
+	    die if $@;
+	    test ($got, $expect, $ocode) or print "# $rcode\n";
+	}
+    }
+}
 # Last test is:
-sub last {232}
+sub last {484}
diff --git a/pp.c b/pp.c
index 659366f..51cd5d4 100644
--- a/pp.c
+++ b/pp.c
@@ -1731,11 +1731,11 @@ PP(pp_lt)
 #ifdef PERL_PRESERVE_IVUV
     else
 #endif
-        if (SvROK(TOPs) && SvROK(TOPm1s)) {
-            SP--;
-            SETs(boolSV(SvRV(TOPs) < SvRV(TOPp1s)));
-            RETURN;
-        }
+    if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
+	SP--;
+	SETs(boolSV(SvRV(TOPs) < SvRV(TOPp1s)));
+	RETURN;
+    }
 #endif
     {
       dPOPnv;
@@ -1809,7 +1809,7 @@ PP(pp_gt)
 #ifdef PERL_PRESERVE_IVUV
     else
 #endif
-        if (SvROK(TOPs) && SvROK(TOPm1s)) {
+    if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
         SP--;
         SETs(boolSV(SvRV(TOPs) > SvRV(TOPp1s)));
         RETURN;
@@ -1887,7 +1887,7 @@ PP(pp_le)
 #ifdef PERL_PRESERVE_IVUV
     else
 #endif
-        if (SvROK(TOPs) && SvROK(TOPm1s)) {
+    if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
         SP--;
         SETs(boolSV(SvRV(TOPs) <= SvRV(TOPp1s)));
         RETURN;
@@ -1965,7 +1965,7 @@ PP(pp_ge)
 #ifdef PERL_PRESERVE_IVUV
     else
 #endif
-        if (SvROK(TOPs) && SvROK(TOPm1s)) {
+    if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
         SP--;
         SETs(boolSV(SvRV(TOPs) >= SvRV(TOPp1s)));
         RETURN;
@@ -1982,7 +1982,7 @@ PP(pp_ne)
 {
     dSP; tryAMAGICbinSET(ne,0);
 #ifndef NV_PRESERVES_UV
-    if (SvROK(TOPs) && SvROK(TOPm1s)) {
+    if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
         SP--;
 	SETs(boolSV(SvRV(TOPs) != SvRV(TOPp1s)));
 	RETURN;
@@ -2051,7 +2051,7 @@ PP(pp_ncmp)
 {
     dSP; dTARGET; tryAMAGICbin(ncmp,0);
 #ifndef NV_PRESERVES_UV
-    if (SvROK(TOPs) && SvROK(TOPm1s)) {
+    if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
         UV right = PTR2UV(SvRV(POPs));
         UV left = PTR2UV(SvRV(TOPs));
 	SETi((left > right) - (left < right));
diff --git a/pp_hot.c b/pp_hot.c
index b7aad81..382030d 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -231,7 +231,7 @@ PP(pp_eq)
 {
     dSP; tryAMAGICbinSET(eq,0);
 #ifndef NV_PRESERVES_UV
-    if (SvROK(TOPs) && SvROK(TOPm1s)) {
+    if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
         SP--;
 	SETs(boolSV(SvRV(TOPs) == SvRV(TOPp1s)));
 	RETURN;