summaryrefslogtreecommitdiff
path: root/t/op/sort.t
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2010-05-08 21:25:47 +0100
committerDavid Mitchell <davem@iabyn.com>2010-05-08 21:28:27 +0100
commitbdbefedf6ca6c8253d0fccc6b9d99d7ae86dcd96 (patch)
tree32f5a51595ef89fa1c242783b2b2c1f73206f281 /t/op/sort.t
parentaee036bb6c99459a0e305ff4008b983591ce8a4b (diff)
downloadperl-bdbefedf6ca6c8253d0fccc6b9d99d7ae86dcd96.tar.gz
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().
Diffstat (limited to 't/op/sort.t')
-rw-r--r--t/op/sort.t31
1 files changed, 30 insertions, 1 deletions
diff --git a/t/op/sort.t b/t/op/sort.t
index 6261f22a59..351a194e6f 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');
+}