DosGlob: Don’t leak when caller’s op tree is freed

File::DosGlob 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 under the scope of ‘use File::DosGlob "glob"’.

We already have a mechanism for hooking the freeing of ops.  So
File::DosGlob can use that.

This is similar to 11ddfebc6e which fixed up File::Glob, but that com-
mit mistakenly used a C static for storing the old hook, even though
PL_opfreehook is an interpreter variable, not a global.  (The next
commit will fix that.)

diff --git a/ext/File-DosGlob/DosGlob.xs b/ext/File-DosGlob/DosGlob.xs
index b8a0612..ce59830 100644 (file)
--- a/ext/File-DosGlob/DosGlob.xs
+++ b/ext/File-DosGlob/DosGlob.xs
@@ -4,10 +4,39 @@
 #include "perl.h"
 #include "XSUB.h"
 
+#define MY_CXT_KEY "File::Glob::_guts" XS_VERSION
+
+typedef struct {
+    HV *               x_DG_ENTRIES;
+    Perl_ophook_t      x_DG_OLD_OPHOOK;
+} my_cxt_t;
+
+START_MY_CXT
+
+static void
+glob_ophook(pTHX_ OP *o)
+{
+    dMY_CXT;
+    if (!MY_CXT.x_DG_ENTRIES)
+       MY_CXT.x_DG_ENTRIES = get_hv("File::DosGlob::entries", 0);
+    if (MY_CXT.x_DG_ENTRIES)
+       hv_delete(MY_CXT.x_DG_ENTRIES, (char *)&o, sizeof(OP *),G_DISCARD);
+    if (MY_CXT.x_DG_OLD_OPHOOK) MY_CXT.x_DG_OLD_OPHOOK(aTHX_ o);
+}
+
 MODULE = File::DosGlob         PACKAGE = File::DosGlob
 
 PROTOTYPES: DISABLE
 
+BOOT:
+    MY_CXT_INIT;
+    {
+       dMY_CXT;
+       MY_CXT.x_DG_ENTRIES = NULL;
+       MY_CXT.x_DG_OLD_OPHOOK = PL_opfreehook;
+       PL_opfreehook = glob_ophook;
+    }
+
 SV *
 _callsite(...)
     CODE:

diff --git a/ext/File-DosGlob/lib/File/DosGlob.pm b/ext/File-DosGlob/lib/File/DosGlob.pm
index 792944b..8a85d04 100644 (file)
--- a/ext/File-DosGlob/lib/File/DosGlob.pm
+++ b/ext/File-DosGlob/lib/File/DosGlob.pm
@@ -103,7 +103,7 @@ sub doglob {
 #
 
 # context (keyed by second cxix arg provided by core)
-my %entries;
+our %entries;
 
 sub glob {
     my($pat,$cxix) = ($_[0], _callsite());

diff --git a/ext/File-DosGlob/t/DosGlob.t b/ext/File-DosGlob/t/DosGlob.t
index 1e4f7f3..b3302b8 100644 (file)
--- a/ext/File-DosGlob/t/DosGlob.t
+++ b/ext/File-DosGlob/t/DosGlob.t
@@ -14,7 +14,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-use Test::More tests => 20;
+use Test::More tests => 21;
 
 # override it in main::
 use File::DosGlob 'glob';
@@ -135,3 +135,21 @@ if ($cwd =~ /^([a-zA-Z]:)/) {
 } else {
     pass();
 }
+
+# Test that our internal data are freed when the caller’s op tree is freed,
+# even if iteration has not finished.
+# Using XS::APItest is the only simple way to test this.  Since this is a
+# core-only module, this should be OK.
+SKIP: {
+    require Config;
+    skip "no XS::APItest"
+     unless eval { require XS::APItest; import XS::APItest "sv_count"; 1 };
+    # Use a random number of ops, so that the glob op does not reuse the
+    # same address each time, giving us false passes.
+    my($count,$count2);
+    eval '$x+'x(rand() * 100) . '<*>';
+    $count = sv_count();
+    eval '$x+'x(rand() * 100) . '<*>';
+    $count2 = sv_count();
+    is $count2, $count, 'no leak when partly iterated caller is freed';
+}