Disallow weakening of read-only references

$ perl -MScalar::Util=weaken -le 'DESTROY{return if$_++;weaken$_[0]}$x=bless[]'
DESTROY created new reference to dead object 'main' during global destruction.

It says that because the reference count has gone down to -1 (or the
max unsigned value, whichever it is), and the error occurs when
SvREFCNT is true.  So there is no new reference to the dead object;
it’s just the refcount that’s off.

This case is worse:

$ perl -MScalar::Util=weaken -le 'DESTROY{weaken$_[0];$x=$_[0]}bless[];'
Segmentation fault

$_[0]’s reference count is normally lowered manually by sv_clear, to
avoid a recursive call to sv_clear (as lowering the reference count
normally triggers that).  If the variable has been weakened, then
$_[0] no longer holds a reference count.  sv_clear proceeds to destroy
at, as its reference count is 1 (held by $x), causing $x to point to a
freed scalar.  Not good.

Since $_[0] is read-only anyway, it should not be weakenable.

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 1a63173..9c3de2d 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -100,6 +100,11 @@ C<EXPORT_XSUB_SYMBOLS> keyword, see L<perlxs> for details.
 All support for the Borland compiler has been dropped.  The code had not
 worked for a long time anyway.
 
+=head2 Weakening read-only references
+
+Weakening read-only references is no longer permitted.  It should never
+hove worked anyway, and in some cases could result in crashes.
+
 =head1 Deprecations
 
 XXX Any deprecated features, syntax, modules etc. should be listed here.
@@ -783,6 +788,12 @@ C<shmread> was not setting the scalar flags correctly when reading from
 shared memory, causing the existing cached numeric representation in the
 scalar to persist [perl #98480].
 
+=item *
+
+Weakening the first argument to an automatically-invoked C<DESTROY> method
+could result in erroneous "DESTROY created new reference" errors or
+crashes.  Now it is an error to weaken a read-only reference.
+
 =back
 
 =head1 Known Problems

diff --git a/sv.c b/sv.c
index 88e8e7c..d6d32e7 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5395,6 +5395,7 @@ Perl_sv_rvweaken(pTHX_ SV *const sv)
        Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Reference is already weak");
        return sv;
     }
+    else if (SvREADONLY(sv)) croak_no_modify();
     tsv = SvRV(sv);
     Perl_sv_add_backref(aTHX_ tsv, sv);
     SvWEAKREF_on(sv);

diff --git a/t/op/ref.t b/t/op/ref.t
index 2266a74..75fb275 100644 (file)
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -8,7 +8,7 @@ BEGIN {
 
 use strict qw(refs subs);
 
-plan(221);
+plan(222);
 
 # Test glob operations.
 
@@ -748,6 +748,27 @@ EOF
 
 }
 
+SKIP:{
+    skip_if_miniperl "no Scalar::Util on miniperl", 1;
+    my $error;
+    *hassgropper::DESTROY = sub {
+        require Scalar::Util;
+        eval { Scalar::Util::weaken($_[0]) };
+        $error = $@;
+        # This line caused a crash before weaken refused to weaken a
+        # read-only reference:
+        $do::not::overwrite::this = $_[0];
+    };
+    my $xs = bless [], "hassgropper";
+    undef $xs;
+    like $error, qr/^Modification of a read-only/,
+       'weaken refuses to weaken a read-only ref';
+    # Now that the test has passed, avoid sabotaging global destruction:
+    undef *hassgropper::DESTROY;
+    undef $do::not::overwrite::this;
+}
+
+
 # Bit of a hack to make test.pl happy. There are 3 more tests after it leaves.
 $test = curr_test();
 curr_test($test + 3);