#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:
@INC = '../lib';
}
-use Test::More tests => 20;
+use Test::More tests => 21;
# override it in main::
use File::DosGlob 'glob';
} 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';
+}