From: Dave Mitchell <davem@fdisolutions.com>
Date: Fri, 26 Mar 2004 01:16:55 +0000 (+0000)
Subject: [perl #27268] Blessed reference to anonymous glob
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ec5f3c78a7539e41900be465ef86bff34f621939;p=p5sagit%2Fp5-mst-13.2.git

[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
--- 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
--- 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