]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blob - Valgrind.xs
Make Test::Valgrind skip if no appropriate suppressions are available
[perl/modules/Test-Valgrind.git] / Valgrind.xs
1 /* This file is part of the Test::Valgrind Perl module.
2  * See http://search.cpan.org/dist/Test::Valgrind/ */
3
4 #define PERL_NO_GET_CONTEXT
5 #include "EXTERN.h"
6 #include "perl.h"
7 #include "XSUB.h"
8
9 #define __PACKAGE__ "Test::Valgrind"
10
11 #ifndef Newx
12 # define Newx(v, n, c) New(0, v, n, c)
13 #endif
14
15 #ifndef DEBUGGING
16 # define DEBUGGING 0
17 #endif
18
19 const char *tv_leaky = NULL;
20
21 /* malloc() on Windows needs the current interpreter. */
22
23 #ifdef PERL_IMPLICIT_SYS
24 # define TV_LEAK_PROTO pTHX
25 # define TV_LEAK_ARG   aTHX
26 #else
27 # define TV_LEAK_PROTO void
28 # define TV_LEAK_ARG
29 #endif
30
31 extern void tv_leak(TV_LEAK_PROTO);
32
33 extern void tv_leak(TV_LEAK_PROTO) {
34  tv_leaky = malloc(10000);
35
36  return;
37 }
38
39 /* --- XS ------------------------------------------------------------------ */
40
41 MODULE = Test::Valgrind            PACKAGE = Test::Valgrind
42
43 PROTOTYPES: DISABLE
44
45 BOOT:
46 {
47  HV *stash = gv_stashpv(__PACKAGE__, 1);
48  newCONSTSUB(stash, "DEBUGGING", newSVuv(DEBUGGING));
49 }
50
51 void
52 leak()
53 CODE:
54  tv_leak(TV_LEAK_ARG);
55  XSRETURN_UNDEF;
56
57 SV *
58 notleak(SV *sv)
59 CODE:
60  Newx(tv_leaky, 10000, char);
61  Safefree(tv_leaky);
62  RETVAL = newSVsv(sv);
63 OUTPUT:
64  RETVAL