summaryrefslogtreecommitdiff
path: root/lib/overload.t
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2007-10-03 20:34:13 +0000
committerNicholas Clark <nick@ccl4.org>2007-10-03 20:34:13 +0000
commit2c615c57764e17cd374cd39caf4823ee12d15cbe (patch)
tree31f7bb4d130c4976d7f1c161c34c65522da1c796 /lib/overload.t
parentc3c974a67f0c45348e2d8d31bc20ceb1672d9fa5 (diff)
downloadperl-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.t44
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");
+}