[perl #27268] Blessed reference to anonymous glob

Stop *$$x=$x giving "Attempt to free unreferenced scalar" warning

p4raw-id: //depot/perl@22591

diff --git a/sv.c b/sv.c
index 00c5cde..8e88ae2 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -410,6 +410,7 @@ do_clean_named_objs(pTHX_ SV *sv)
             (GvCV(sv) && SvOBJECT(GvCV(sv))) )
        {
            DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv)));
+           SvFLAGS(sv) |= SVf_BREAK;
            SvREFCNT_dec(sv);
        }
     }

diff --git a/t/op/ref.t b/t/op/ref.t
index 3bb280c..597e036 100755 (executable)
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = qw(. ../lib);
 }
 
-print "1..68\n";
+print "1..69\n";
 
 require 'test.pl';
 
@@ -357,6 +357,16 @@ runperl(prog => 'sub f { my $x = shift; *z = $x; } f({}); f();');
 if ($? != 0) { print "not " };
 print "ok ",++$test," - coredump on typeglob = (SvRV && !SvROK)\n";
 
+# bug #27268: freeing self-referential typeglobs could trigger
+# "Attempt to free unreferenced scalar" warnings
+
+$result = runperl(
+    prog => 'use Symbol;my $x=bless \gensym,"t"; print;*$$x=$x',
+    stderr => 1
+);
+print "not " if length $result;
+print "ok ",++$test," - freeing self-referential typeglob\n";
+print "# got: $result\n" if length $result;
 
 # test global destruction