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

diff --git a/lib/overload.t b/lib/overload.t
index b004cff..2af4c37 100644 (file)
--- 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");
+}