diff options
author | David Mitchell <davem@iabyn.com> | 2010-05-08 21:25:47 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2010-05-08 21:28:27 +0100 |
commit | bdbefedf6ca6c8253d0fccc6b9d99d7ae86dcd96 (patch) | |
tree | 32f5a51595ef89fa1c242783b2b2c1f73206f281 /t/op/sort.t | |
parent | aee036bb6c99459a0e305ff4008b983591ce8a4b (diff) | |
download | perl-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.t | 31 |
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'); +} |