This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don’t leak when partly iterated glob op is freed
authorFather Chrysostomos <sprout@cpan.org>
Sun, 9 Dec 2012 14:05:22 +0000 (06:05 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 10 Dec 2012 02:47:21 +0000 (18:47 -0800)
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
t/op/svleak.t

index 50bb2da..4c08776 100644 (file)
@@ -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
index 13c800f..e7c5988 100644 (file)
@@ -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');