Recoving dup tests for VMS
[p5sagit/p5-mst-13.2.git] / ext / re / re.xs
1 #define PERL_NO_GET_CONTEXT
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5
6 #ifdef WAS_NOT_DEBUGGING
7 void Perl_deb(pTHX_ const char* pat, ...) { }
8 #endif
9
10 extern regexp*  my_regcomp (pTHX_ char* exp, char* xend, PMOP* pm);
11 extern I32      my_regexec (pTHX_ regexp* prog, char* stringarg, char* strend,
12                             char* strbeg, I32 minend, SV* screamer,
13                             void* data, U32 flags);
14 extern void     my_regfree (pTHX_ struct regexp* r);
15 extern char*    my_re_intuit_start (pTHX_ regexp *prog, SV *sv, char *strpos,
16                                     char *strend, U32 flags,
17                                     struct re_scream_pos_data_s *data);
18 extern SV*      my_re_intuit_string (pTHX_ regexp *prog);
19
20 #define MY_CXT_KEY "re::_guts" XS_VERSION
21
22 typedef struct {
23     int         x_oldflag;              /* debug flag */
24 } my_cxt_t;
25
26 START_MY_CXT
27
28 #define oldflag         (MY_CXT.x_oldflag)
29
30 static void
31 uninstall(pTHX)
32 {
33     dMY_CXT;
34     PL_regexecp = Perl_regexec_flags;
35     PL_regcompp = Perl_pregcomp;
36     PL_regint_start = Perl_re_intuit_start;
37     PL_regint_string = Perl_re_intuit_string;
38     PL_regfree = Perl_pregfree;
39
40     if (!oldflag)
41         PL_debug &= ~DEBUG_r_FLAG;
42 }
43
44 static void
45 install(pTHX)
46 {
47     dMY_CXT;
48     PL_colorset = 0;                    /* Allow reinspection of ENV. */
49     PL_regexecp = &my_regexec;
50     PL_regcompp = &my_regcomp;
51     PL_regint_start = &my_re_intuit_start;
52     PL_regint_string = &my_re_intuit_string;
53     PL_regfree = &my_regfree;
54     oldflag = PL_debug & DEBUG_r_FLAG;
55     PL_debug |= DEBUG_r_FLAG;
56 }
57
58 MODULE = re     PACKAGE = re
59
60 BOOT:
61 {
62    MY_CXT_INIT;
63 }
64
65
66 void
67 install()
68   CODE:
69     install(aTHX);
70
71 void
72 uninstall()
73   CODE:
74     uninstall(aTHX);