From: Fergal Daly <fergal@esatclear.ie>
Date: Tue, 2 Dec 2003 23:18:18 +0000 (+0000)
Subject: [perl #24506] [PATCH] cannot weaken refs to read only values
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e6469971c726b88fe545b74db248847f2ef9b3e3;p=p5sagit%2Fp5-mst-13.2.git

[perl #24506] [PATCH] cannot weaken refs to read only values
Message-Id: <200312022318.18353.fergal@esatclear.ie>

(tweaked so the test is skipped on perls < 5.9.0)

p4raw-id: //depot/perl@21955
---

diff --git a/ext/List/Util/t/weak.t b/ext/List/Util/t/weak.t
index 7941205..d38c305 100755
--- a/ext/List/Util/t/weak.t
+++ b/ext/List/Util/t/weak.t
@@ -35,7 +35,7 @@ BEGIN {
 
 eval <<'EOT' unless $skip;
 use Scalar::Util qw(weaken isweak);
-print "1..17\n";
+print "1..22\n";
 
 ######################### End of black magic.
 
@@ -44,6 +44,7 @@ $cnt = 0;
 sub ok {
 	++$cnt;
 	if($_[0]) { print "ok $cnt\n"; } else {print "not ok $cnt\n"; }
+	return $_[0];
 }
 
 $| = 1;
@@ -205,6 +206,29 @@ weaken($x->{Y} = \$a);
 ok(isweak($x->{Y}));
 ok(!isweak($x->{Z}));
 
+#
+# Case 7: test weaken on a read only ref
+#
+
+if ($] < 5.009) {
+    # Doesn't work for older perls, see bug [perl #24506]
+    print "# Skip next 5 tests on perl $]\n";
+    for (1..5) {
+	ok(1);
+    }
+}
+else {
+    $a = eval '\"hello"';
+    ok(ref($a)) or print "# didn't get a ref from eval\n";
+    $b = $a;
+    eval{weaken($b)};
+    # we didn't die
+    ok($@ eq "") or print "# died with $@\n";
+    ok(isweak($b));
+    ok($$b eq "hello") or print "# b is '$$b'\n";
+    $a="";
+    ok(not $b) or print "# b didn't go away\n";
+}
 
 package Dest;
 
diff --git a/sv.c b/sv.c
index 1202fe2..05deb5a 100644
--- a/sv.c
+++ b/sv.c
@@ -4899,6 +4899,7 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
 	    && how != PERL_MAGIC_bm
 	    && how != PERL_MAGIC_fm
 	    && how != PERL_MAGIC_sv
+	    && how != PERL_MAGIC_backref
 	   )
 	{
 	    Perl_croak(aTHX_ PL_no_modify);