[perl #122556] Make undef $s free refs forthwith

2 files changed, 20 insertions, 2 deletions

diff --git a/pp.c b/pp.c
index 9b8dd9058c..f86e276934 100644
--- a/pp.c
+++ b/pp.c
@@ -972,7 +972,8 @@ PP(pp_undef)
     if (!sv)
 	RETPUSHUNDEF;
 
-    SV_CHECK_THINKFIRST_COW_DROP(sv);
+    if (SvTHINKFIRST(sv))
+	sv_force_normal_flags(sv, SV_COW_DROP_PV|SV_IMMEDIATE_UNREF);
 
     switch (SvTYPE(sv)) {
     case SVt_NULL:
diff --git a/t/op/undef.t b/t/op/undef.t
index 366c3d241c..ddef596386 100644
--- a/t/op/undef.t
+++ b/t/op/undef.t
@@ -10,7 +10,7 @@ use strict;
 
 use vars qw(@ary %ary %hash);
 
-plan 73;
+plan 74;
 
 ok !defined($a);
 
@@ -128,6 +128,23 @@ for (z,z) {
 }
 is $_[0], $_[1], 'undef constants preserve identity';
 
+# [perl #122556]
+my $messages;
+package Thingie;
+DESTROY { $messages .= 'destroyed ' }
+package main;
+sub body {
+    sub {
+        my $t = bless [], 'Thingie';
+        undef $t;
+    }->(), $messages .= 'after ';
+
+    return;
+}
+body();
+is $messages, 'destroyed after ', 'undef $scalar frees refs immediately';
+
+
 # this will segfault if it fails
 
 sub PVBM () { 'foo' }