From: David Mitchell <davem@iabyn.com>
Date: Sat, 8 May 2010 20:25:47 +0000 (+0100)
Subject: RT #34604 didn't honour tied overloaded values
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bdbefedf6ca6c8253d0fccc6b9d99d7ae86dcd96;p=p5sagit%2Fp5-mst-13.2.git

RT #34604 didn't honour tied overloaded values

A tied hash lookup could return an overloaded object but sort wouldn't
notice that it was overloaded because it checked for overload before doing
mg_get().
---

diff --git a/pp_sort.c b/pp_sort.c
index 12e77f9..b0f2be1 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1589,33 +1589,23 @@ PP(pp_sort)
 	    if (!PL_sortcop) {
 		if (priv & OPpSORT_NUMERIC) {
 		    if (priv & OPpSORT_INTEGER) {
-			if (!SvIOK(*p1)) {
-			    if (SvAMAGIC(*p1))
-				overloading = 1;
-			    else
-				(void)sv_2iv(*p1);
-			}
+			if (!SvIOK(*p1))
+			    (void)sv_2iv_flags(*p1, SV_GMAGIC|SV_SKIP_OVERLOAD);
 		    }
 		    else {
-			if (!SvNSIOK(*p1)) {
-			    if (SvAMAGIC(*p1))
-				overloading = 1;
-			    else
-				(void)sv_2nv(*p1);
-			}
+			if (!SvNSIOK(*p1))
+			    (void)sv_2nv_flags(*p1, SV_GMAGIC|SV_SKIP_OVERLOAD);
 			if (all_SIVs && !SvSIOK(*p1))
 			    all_SIVs = 0;
 		    }
 		}
 		else {
-		    if (!SvPOK(*p1)) {
-			if (SvAMAGIC(*p1))
-			    overloading = 1;
-			else
-			    (void)sv_2pv_flags(*p1, 0,
-					       SV_GMAGIC|SV_CONST_RETURN);
-		    }
+		    if (!SvPOK(*p1))
+			(void)sv_2pv_flags(*p1, 0,
+			    SV_GMAGIC|SV_CONST_RETURN|SV_SKIP_OVERLOAD);
 		}
+		if (SvAMAGIC(*p1))
+		    overloading = 1;
 	    }
 	    p1++;
 	}
diff --git a/t/op/sort.t b/t/op/sort.t
index 6261f22..351a194 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 use warnings;
-plan( tests => 148 );
+plan( tests => 151 );
 
 # these shouldn't hang
 {
@@ -814,3 +814,32 @@ sub cmp_as_string($$) { $_[0] < $_[1] ? "-1" : $_[0] == $_[1] ? "0" : "+1" }
 is("@b", "1 2 3 3 4 5 7", "comparison result as string");
 @b = sort cmp_as_string (1,5,4,7,3,2,3);
 is("@b", "1 2 3 3 4 5 7", "comparison result as string");
+
+# RT #34604: sort didn't honour overloading if the overloaded elements
+# were retrieved via tie
+
+{
+    package RT34604;
+
+    sub TIEHASH { bless {
+			p => bless({ val => 2 }),
+			q => bless({ val => 1 }),
+		    }
+		}
+    sub FETCH { $_[0]{$_[1] } }
+
+    my $cc = 0;
+    sub compare { $cc++; $_[0]{val} cmp $_[1]{val} }
+    my $cs = 0;
+    sub str { $cs++; $_[0]{val} }
+
+    use overload 'cmp' => \&compare, '""' => \&str;
+
+    package main;
+
+    tie my %h, 'RT34604';
+    my @sorted = sort @h{qw(p q)};
+    is($cc, 1, 'overload compare called once');
+    is("@sorted","1 2", 'overload sort result');
+    is($cs, 2, 'overload string called twice');
+}