Numeric comparison operators mustn't compare addresses of references
Nicholas Clark [Wed, 14 Jul 2004 15:36:57 +0000 (15:36 +0000)]
that are overloaded.

p4raw-id: //depot/perl@23106

lib/overload.t
pp.c
pp_hot.c

index 4184e23..519c6d8 100644 (file)
@@ -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 (file)
--- 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));
index b7aad81..382030d 100644 (file)
--- 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;