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
CommitLineData
c619428f
FC
1#define PERL_NO_GET_CONTEXT
2
3#include "EXTERN.h"
4#include "perl.h"
5#include "XSUB.h"
6
7fddb138
FC
7#define MY_CXT_KEY "File::Glob::_guts" XS_VERSION
8
9typedef struct {
10 HV * x_DG_ENTRIES;
11 Perl_ophook_t x_DG_OLD_OPHOOK;
12} my_cxt_t;
13
14START_MY_CXT
15
16static void
17glob_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
c619428f
FC
27MODULE = File::DosGlob PACKAGE = File::DosGlob
28
29PROTOTYPES: DISABLE
30
7fddb138
FC
31BOOT:
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
c619428f
FC
40SV *
41_callsite(...)
42 CODE:
43 RETVAL = newSVpvn(
44 (char *)&cxstack[cxstack_ix].blk_sub.retop, sizeof(OP *)
45 );
46 OUTPUT:
47 RETVAL