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
1 #define PERL_NO_GET_CONTEXT
2
3 #include "EXTERN.h"
4 #include "perl.h"
5 #include "XSUB.h"
6
7 #define MY_CXT_KEY "File::Glob::_guts" XS_VERSION
8
9 typedef struct {
10     HV *                x_DG_ENTRIES;
11     Perl_ophook_t       x_DG_OLD_OPHOOK;
12 } my_cxt_t;
13
14 START_MY_CXT
15
16 static void
17 glob_ophook(pTHX_ OP *o)
18 {
19     dMY_CXT;
20     if (!MY_CXT.x_DG_ENTRIES)
21         MY_CXT.x_DG_ENTRIES = get_hv("File::DosGlob::entries", 0);
22     if (MY_CXT.x_DG_ENTRIES)
23         hv_delete(MY_CXT.x_DG_ENTRIES, (char *)&o, sizeof(OP *),G_DISCARD);
24     if (MY_CXT.x_DG_OLD_OPHOOK) MY_CXT.x_DG_OLD_OPHOOK(aTHX_ o);
25 }
26
27 MODULE = File::DosGlob          PACKAGE = File::DosGlob
28
29 PROTOTYPES: DISABLE
30
31 BOOT:
32     MY_CXT_INIT;
33     {
34         dMY_CXT;
35         MY_CXT.x_DG_ENTRIES = NULL;
36         MY_CXT.x_DG_OLD_OPHOOK = PL_opfreehook;
37         PL_opfreehook = glob_ophook;
38     }
39
40 SV *
41 _callsite(...)
42     CODE:
43         RETVAL = newSVpvn(
44                    (char *)&cxstack[cxstack_ix].blk_sub.retop, sizeof(OP *)
45                  );
46     OUTPUT:
47         RETVAL