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  tv_leaky = malloc(10000);
  33
  34  return;
  35 }
  36
  37 /* --- XS ------------------------------------------------------------------ */
  38
  39 MODULE = Test::Valgrind            PACKAGE = Test::Valgrind
  40
  41 PROTOTYPES: DISABLE
  42
  43 BOOT:
  44 {
  45  HV *stash = gv_stashpv(__PACKAGE__, 1);
  46  newCONSTSUB(stash, "DEBUGGING", newSVuv(DEBUGGING));
  47 }
  48
  49 void
  50 leak()
  51 CODE:
  52  tv_leak(TV_LEAK_ARG);
  53  XSRETURN_UNDEF;
  54
  55 SV *
  56 notleak(SV *sv)
  57 CODE:
  58  Newx(tv_leaky, 10000, char);
  59  Safefree(tv_leaky);
  60  RETVAL = newSVsv(sv);
  61 OUTPUT:
  62  RETVAL