This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Test for a subtle pre-5.10 bug. Before 5.10 the overloading flag was
authorNicholas Clark <nick@ccl4.org>
Wed, 3 Oct 2007 20:34:13 +0000 (20:34 +0000)
committerNicholas Clark <nick@ccl4.org>
Wed, 3 Oct 2007 20:34:13 +0000 (20:34 +0000)
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

lib/overload.t

index b004cff..2af4c37 100644 (file)
@@ -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");
+}