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 (file)
--- 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 (file)
--- 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');
+}