This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
DosGlob: Don’t leak when caller’s op tree is freed
[perl5.git] / ext / File-DosGlob / DosGlob.xs
index b8a0612..ce59830 100644 (file)
@@ -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: