From 11ddfebc6e521f916fd05108e3faa74e7ed132b8 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 9 Dec 2012 06:05:22 -0800
Subject: [PATCH] =?utf8?q?Don=E2=80=99t=20leak=20when=20partly=20iterated?=
 =?utf8?q?=20glob=20op=20is=20freed?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

File::Glob keeps its own hash of arrays of file names.  Each array corresponds to one call site.  When iteration finishes, it deletes
the array.  But if iteration never finishes, and the op at the call
site is freed, the array remains.  So eval "scalar<*>" will cause a
memory leak.

We already have a mechanism for hooking the freeing of ops.  So
File::Glob can use that.
---
 ext/File-Glob/Glob.xs | 17 +++++++++++++++++
 t/op/svleak.t         |  6 +++++-
 2 files changed, 22 insertions(+), 1 deletion(-)

diff --git a/ext/File-Glob/Glob.xs b/ext/File-Glob/Glob.xs
index 50bb2da..4c08776 100644
--- a/ext/File-Glob/Glob.xs
+++ b/ext/File-Glob/Glob.xs
@@ -312,6 +312,19 @@ doglob_iter_wrapper(pTHX_ AV *entries, SV *patsv)
     return FALSE;
 }
 
+static Perl_ophook_t old_ophook;
+
+static void
+glob_ophook(pTHX_ OP *o)
+{
+    dMY_CXT;
+    if (MY_CXT.x_GLOB_ENTRIES
+     && (o->op_type == OP_GLOB || o->op_type == OP_ENTERSUB))
+	hv_delete(MY_CXT.x_GLOB_ENTRIES, (char *)&o, sizeof(OP *),
+		  G_DISCARD);
+    if (old_ophook) old_ophook(aTHX_ o);
+}
+
 MODULE = File::Glob		PACKAGE = File::Glob
 
 int
@@ -385,6 +398,10 @@ BOOT:
 	dMY_CXT;
 	MY_CXT.x_GLOB_ENTRIES = NULL;
     }  
+    OP_REFCNT_LOCK;
+    old_ophook = PL_opfreehook;
+    PL_opfreehook = glob_ophook;
+    OP_REFCNT_UNLOCK;
 }
 
 INCLUDE: const-xs.inc
diff --git a/t/op/svleak.t b/t/op/svleak.t
index 13c800f..e7c5988 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
 
 use Config;
 
-plan tests => 111;
+plan tests => 112;
 
 # run some code N times. If the number of SVs at the end of loop N is
 # greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -107,6 +107,10 @@ eleak(2, 0, "$all v111111111111111111111111111111111111111111111111",
      'vstring num overflow with fatal warnings');
 
 eleak(2, 0, 'sub{<*>}');
+# Use a random number of ops, so that the glob op does not reuse the same
+# address each time, giving us false passes.
+leak(2, 0, sub { eval '$x+'x(rand() * 100) . '<*>'; },
+    'freeing partly iterated glob');
 
 eleak(2, 0, 'goto sub {}', 'goto &sub in eval');
 eleak(2, 0, '() = sort { goto sub {} } 1,2', 'goto &sub in sort');
-- 
1.8.3.1