diff options
author | Nicholas Clark <nick@ccl4.org> | 2007-10-03 20:34:13 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2007-10-03 20:34:13 +0000 |
commit | 2c615c57764e17cd374cd39caf4823ee12d15cbe (patch) | |
tree | 31f7bb4d130c4976d7f1c161c34c65522da1c796 /lib/overload.t | |
parent | c3c974a67f0c45348e2d8d31bc20ceb1672d9fa5 (diff) | |
download | perl-2c615c57764e17cd374cd39caf4823ee12d15cbe.tar.gz |
Test for a subtle pre-5.10 bug. Before 5.10 the overloading flag was
stored on the reference rather than the referent. Despite the fact that
objects can only be accessed via references (even internally), the
referent actually knows that it's blessed, not the references. So
taking a new, unrelated, reference to it gives an object. However, the
overloading-or-not flag was on the reference prior to 5.10, and taking
a new reference didn't (use to) copy it (prior to 5.8.9).
So test that the bug can't return - overloading should work on a
reference to something already blessed into a package with overloading.
p4raw-id: //depot/perl@32016
Diffstat (limited to 'lib/overload.t')
-rw-r--r-- | lib/overload.t | 44 |
1 files changed, 43 insertions, 1 deletions
diff --git a/lib/overload.t b/lib/overload.t index b004cff0fa..2af4c37ebf 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -47,7 +47,7 @@ sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead package main; $| = 1; -use Test::More tests => 522; +use Test::More tests => 528; $a = new Oscalar "087"; @@ -1333,3 +1333,45 @@ foreach my $op (qw(<=> == != < <= > >=)) { like($warning, qr/isn't numeric/, 'cmp should return number'); } + +{ + # Subtle bug pre 5.10, as a side effect of the overloading flag being + # stored on the reference rather than the referant. Despite the fact that + # objects can only be accessed via references (even internally), the + # referant actually knows that it's blessed, not the references. So taking + # a new, unrelated, reference to it gives an object. However, the + # overloading-or-not flag was on the reference prior to 5.10, and taking + # a new reference didn't (use to) copy it. + + package kayo; + + use overload '""' => sub {${$_[0]}}; + + sub Pie { + return "$_[0], $_[1]"; + } + + package main; + + my $class = 'kayo'; + my $string = 'bam'; + my $crunch_eth = bless \$string, $class; + + is("$crunch_eth", $string); + is ($crunch_eth->Pie("Meat"), "$string, Meat"); + + my $wham_eth = \$string; + + is("$wham_eth", $string, + 'This reference did not have overloading in 5.8.8 and earlier'); + is ($crunch_eth->Pie("Apple"), "$string, Apple"); + + my $class = ref $wham_eth; + $class =~ s/=.*//; + + # Bless it back into its own class! + bless $wham_eth, $class; + + is("$wham_eth", $string); + is ($crunch_eth->Pie("Blackbird"), "$string, Blackbird"); +} |