File Coverage

GNU.xs
Criterion Covered Total %
statement 262 402 65.1
branch 151 336 44.9
condition n/a
subroutine n/a
pod n/a
total 413 738 55.9


line stmt bran cond sub pod time code
1             #define PERL_NO_GET_CONTEXT 1
2             #include "EXTERN.h"
3             #include "perl.h"
4             #include "XSUB.h"
5              
6             #include "ppport.h"
7              
8             #include "config_REGEXP.h"
9             #include "regex.c"
10              
11             /* Things that MUST be supported */
12             #if ! REGEXP_PPRIVATE_CAN
13             # error "pprivate not found in structure regexp"
14             #endif
15              
16             #ifndef RX_WRAPPED
17             # if ! REGEXP_WRAPPED_CAN
18             # error "RX_WRAPPED macro not found"
19             # else
20             # define RX_WRAPPED(rx) (_RegSV(rx))->wrapped
21             # endif
22             #endif
23              
24             #ifndef RX_WRAPLEN
25             # if ! REGEXP_WRAPLEN_CAN
26             # error "RX_WRAPLEN macro not found"
27             # else
28             # define RX_WRAPLEN(rx) (_RegSV(rx))->wraplen
29             # endif
30             #endif
31              
32             /* #define PERL_5_10_METHOD */
33              
34             static regexp_engine engine_GNU;
35              
36             typedef struct GNU_private {
37             SV *sv_pattern;
38             SV *sv_syntax;
39             bool is_utf8;
40             int isDebug;
41             regex_t regex;
42             } GNU_private_t;
43              
44             /******************************************************************/
45             /* Copy of DROLSKY/Params-Validate-1.18/lib/Params/Validate/XS.xs */
46             /******************************************************************/
47             /* type constants */
48             #define SCALAR 1
49             #define ARRAYREF 2
50             #define HASHREF 4
51             #define CODEREF 8
52             #define GLOB 16
53             #define GLOBREF 32
54             #define SCALARREF 64
55             #define UNKNOWN 128
56             #define UNDEF 256
57             #define OBJECT 512
58             #define HANDLE (GLOB | GLOBREF)
59             #define BOOLEAN (SCALAR | UNDEF)
60              
61             GNU_STATIC
62 0           void GNU_dump_pattern(pTHX_ char *logHeader, REGEXP *rx)
63             {
64 0           SV *sv_stringification = newSVpvn_utf8(RX_WRAPPED(rx), RX_WRAPLEN(rx), 1);
65 0           fprintf(stderr, "%s: ... pattern:\n", logHeader);
66 0           sv_dump(sv_stringification);
67 0           SvREFCNT_dec(sv_stringification);
68 0           }
69              
70             GNU_STATIC
71             IV
72 12           get_type(pTHX_ SV* sv) {
73 12           IV type = 0;
74              
75 12 50         if (SvTYPE(sv) == SVt_PVGV) {
76 0           return GLOB;
77             }
78 12 50         if (!SvOK(sv)) {
    0          
    0          
79 0           return UNDEF;
80             }
81 12 100         if (!SvROK(sv)) {
82 9           return SCALAR;
83             }
84              
85 3           switch (SvTYPE(SvRV(sv))) {
86             case SVt_NULL:
87             case SVt_IV:
88             case SVt_NV:
89             case SVt_PV:
90             #if PERL_VERSION <= 10
91             case SVt_RV:
92             #endif
93             case SVt_PVMG:
94             case SVt_PVIV:
95             case SVt_PVNV:
96             #if PERL_VERSION <= 8
97             case SVt_PVBM:
98             #elif PERL_VERSION >= 11
99             case SVt_REGEXP:
100             #endif
101 0           type = SCALARREF;
102 0           break;
103             case SVt_PVAV:
104 1           type = ARRAYREF;
105 1           break;
106             case SVt_PVHV:
107 2           type = HASHREF;
108 2           break;
109             case SVt_PVCV:
110 0           type = CODEREF;
111 0           break;
112             case SVt_PVGV:
113 0           type = GLOBREF;
114 0           break;
115             /* Perl 5.10 has a bunch of new types that I don't think will ever
116             actually show up here (I hope), but not handling them makes the
117             C compiler cranky. */
118             default:
119 0           type = UNKNOWN;
120 0           break;
121             }
122              
123 3 50         if (type) {
124 3 50         if (sv_isobject(sv)) return type | OBJECT;
125 3           return type;
126             }
127              
128             /* Getting here should not be possible */
129 0           return UNKNOWN;
130             }
131              
132             SV* debugkey_sv;
133             SV* syntaxkey_sv;
134 12           int GNU_key2int(pTHX_ const char *key, SV * const key_sv) {
135 12 50         if (GvHV(PL_hintgv) && (PL_hints & HINT_LOCALIZE_HH) == HINT_LOCALIZE_HH) {
    100          
136 6           HE* const he = hv_fetch_ent(GvHV(PL_hintgv), key_sv, FALSE, 0U);
137 6 100         if (he != NULL) {
138 3           SV* val = HeVAL(he);
139 3 50         if (val != &PL_sv_placeholder) {
140 3 50         return (int)SvIV(val);
141             }
142             }
143             }
144              
145 9           return 0;
146             }
147              
148             #ifdef HAVE_REGEXP_ENGINE_COMP
149             GNU_STATIC
150             #if PERL_VERSION <= 10
151             REGEXP * GNU_comp(pTHX_ const SV * const pattern, const U32 flags)
152             #else
153 6           REGEXP * GNU_comp(pTHX_ SV * const pattern, const U32 flags)
154             #endif
155             {
156             REGEXP *rx; /* SV */
157             struct regexp *r; /* union part that really points to regexp structure */
158             GNU_private_t *ri;
159 6           int isDebug = GNU_key2int(aTHX_ "re::engine::GNU/debug", debugkey_sv);
160 6           int defaultSyntax = GNU_key2int(aTHX_ "re::engine::GNU/syntax", syntaxkey_sv);
161 6           char *logHeader = "[re::engine::GNU] GNU_comp";
162 6 50         bool is_utf8 = DO_UTF8(pattern);
    0          
163              
164             /* Input as char * */
165             STRLEN plen;
166             char *exp;
167              
168             /* Copy of flags in input */
169 6           U32 extflags = flags;
170              
171             /* SVs that are in input */
172 6           IV pattern_type = get_type(aTHX_ (SV *)pattern);
173             SV *sv_pattern;
174 6           SV *sv_syntax = NULL;
175              
176             reg_errcode_t ret;
177             SV * sv_stringification;
178              
179 6 50         if (isDebug) {
180 0           fprintf(stderr, "%s: pattern=%p flags=0x%lx\n", logHeader, pattern, (unsigned long) flags);
181 0           fprintf(stderr, "%s: ... default syntax: %d\n", logHeader, defaultSyntax);
182             }
183              
184             /********************/
185             /* GNU engine setup */
186             /********************/
187 6           Newxz(ri, 1, GNU_private_t);
188 6 50         if (isDebug) {
189 0           fprintf(stderr, "%s: ... allocated private structure ri=%p\n", logHeader, ri);
190             }
191              
192             /* We accept in input: */
193             /* - a scalar */
194             /* - an arrayref with at least 2 members: the syntax and the pattern */
195             /* - a hash with with at least the key 'pattern', eventually 'syntax' */
196              
197 6 100         if (pattern_type == SCALAR) {
198              
199 3 50         if (isDebug) {
200 0           fprintf(stderr, "%s: ... input is a scalar\n", logHeader);
201             }
202              
203 3           sv_pattern = newSVsv((SV *)pattern);
204              
205 3 100         } else if (pattern_type == ARRAYREF) {
206 1           AV *av = (AV *)SvRV((SV *) pattern);
207             SV **a_pattern;
208             SV **a_syntax;
209              
210 1 50         if (isDebug) {
211 0           fprintf(stderr, "%s: ... input is an array ref\n", logHeader);
212             }
213              
214 1 50         if (av_len(av) < 1) {
215 0           croak("%s: array ref must have at least two elements, i.e. [syntax => pattern]", logHeader);
216             }
217 1           a_pattern = av_fetch(av, 1, 1);
218 1           a_syntax = av_fetch(av, 0, 1);
219              
220 1 50         if (a_pattern == NULL || get_type(aTHX_ (SV *)*a_pattern) != SCALAR) {
    50          
221 0           croak("%s: array ref must have a scalar as second element, got %" IVdf, logHeader, get_type(aTHX_ (SV *)a_pattern));
222             }
223 1 50         if (a_syntax == NULL || get_type(aTHX_ (SV *)*a_syntax) != SCALAR) {
    50          
224 0           croak("%s: array ref must have a scalar as first element, got %" IVdf, logHeader, get_type(aTHX_ (SV *)a_syntax));
225             }
226              
227 1           sv_pattern = newSVsv(*a_pattern);
228 1           sv_syntax = newSVsv(*a_syntax);
229              
230 2 50         } else if (pattern_type == HASHREF) {
231 2           HV *hv = (HV *)SvRV((SV *) pattern);
232 2           SV **h_pattern = hv_fetch(hv, "pattern", 7, 0);
233 2           SV **h_syntax = hv_fetch(hv, "syntax", 6, 0);
234              
235 2 50         if (isDebug) {
236 0           fprintf(stderr, "%s: ... input is a hash ref\n", logHeader);
237             }
238              
239 2 50         if (h_pattern == NULL || get_type(aTHX_ (SV *)*h_pattern) != SCALAR) {
    50          
240 0           croak("%s: hash ref key must have a key 'pattern' refering to a scalar", logHeader);
241             }
242 2 50         if (h_syntax == NULL || get_type(aTHX_ (SV *)*h_syntax) != SCALAR) {
    50          
243 0           croak("%s: hash ref key must have a key 'syntax' refering to a scalar", logHeader);
244             }
245              
246 2           sv_pattern = newSVsv(*h_pattern);
247 2           sv_syntax = newSVsv(*h_syntax);
248              
249             } else {
250 0           croak("%s: pattern must be a scalar, an array ref [syntax => pattern], or a hash ref {'syntax' => syntax, 'pattern' => pattern} where syntax and flavour are exclusive", logHeader);
251             }
252              
253 6 50         exp = SvPV(sv_pattern, plen);
254              
255             {
256             /************************************************************/
257             /* split optimizations - copied from re-engine-xxx by avar */
258             /************************************************************/
259             #if (defined(RXf_SPLIT) && defined(RXf_SKIPWHITE) && defined(RXf_WHITE))
260             /* C, bypass the PCRE engine alltogether and act as perl does */
261 6 50         if (flags & RXf_SPLIT && plen == 1 && exp[0] == ' ') {
    0          
    0          
262 0 0         if (isDebug) {
263 0           fprintf(stderr, "%s: ... split ' ' optimization\n", logHeader);
264             }
265 0           extflags |= (RXf_SKIPWHITE|RXf_WHITE);
266             }
267             #endif
268              
269             #ifdef RXf_NULL
270             /* RXf_NULL - Have C split by characters */
271 6 50         if (plen == 0) {
272 0 0         if (isDebug) {
273 0           fprintf(stderr, "%s: ... split // optimization\n", logHeader);
274             }
275 0           extflags |= RXf_NULL;
276             }
277             #endif
278              
279             #ifdef RXf_START_ONLY
280             /* RXf_START_ONLY - Have C split on newlines */
281 6 50         if (plen == 1 && exp[0] == '^') {
    0          
282 0 0         if (isDebug) {
283 0           fprintf(stderr, "%s: ... split /^/ optimization", logHeader);
284             }
285 0           extflags |= RXf_START_ONLY;
286             }
287             #endif
288              
289             #ifdef RXf_WHITE
290             /* RXf_WHITE - Have C split on whitespace */
291 6 50         if (plen == 3 && strnEQ("\\s+", exp, 3)) {
    0          
292 0 0         if (isDebug) {
293 0           fprintf(stderr, "%s: ... split /\\s+/ optimization\n", logHeader);
294             }
295 0           extflags |= RXf_WHITE;
296             }
297             #endif
298             }
299              
300 6           ri->sv_pattern = sv_pattern;
301 6           ri->sv_syntax = sv_syntax;
302 6           ri->is_utf8 = is_utf8;
303 6           ri->isDebug = isDebug;
304 6           ri->regex.buffer = NULL;
305 6           ri->regex.allocated = 0;
306 6           ri->regex.used = 0;
307 6 100         ri->regex.syntax = (sv_syntax != NULL) ? (int)SvUV(sv_syntax) : defaultSyntax;
    50          
308 6           ri->regex.fastmap = NULL;
309 6           ri->regex.translate = NULL;
310 6           ri->regex.re_nsub = 0;
311 6           ri->regex.can_be_null = 0;
312 6           ri->regex.regs_allocated = 0;
313 6           ri->regex.fastmap_accurate = 0;
314 6           ri->regex.no_sub = 0;
315 6           ri->regex.not_bol = 0;
316 6           ri->regex.not_eol = 0;
317 6           ri->regex.newline_anchor = 0;
318              
319             /* /msixp flags */
320             #ifdef RXf_PMf_MULTILINE
321             /* /m */
322 6 50         if ((flags & RXf_PMf_MULTILINE) == RXf_PMf_MULTILINE) {
323 0 0         if (isDebug) {
324 0           fprintf(stderr, "%s: ... /m flag\n", logHeader);
325             }
326 0           ri->regex.newline_anchor = 1;
327             } else {
328 6 50         if (isDebug) {
329 0           fprintf(stderr, "%s: ... no /m flag\n", logHeader);
330             }
331             }
332             #endif
333             #ifdef RXf_PMf_SINGLELINE
334             /* /s */
335 6 50         if ((flags & RXf_PMf_SINGLELINE) == RXf_PMf_SINGLELINE) {
336 0 0         if (isDebug) {
337 0           fprintf(stderr, "%s: ... /s flag\n", logHeader);
338             }
339 0           ri->regex.syntax |= RE_DOT_NEWLINE;
340             } else {
341 6 50         if (isDebug) {
342 0           fprintf(stderr, "%s: ... no /s flag\n", logHeader);
343             }
344             }
345             #endif
346             #ifdef RXf_PMf_FOLD
347             /* /i */
348 6 50         if ((flags & RXf_PMf_FOLD) == RXf_PMf_FOLD) {
349 0 0         if (isDebug) {
350 0           fprintf(stderr, "%s: ... /i flag\n", logHeader);
351             }
352 0           ri->regex.syntax |= RE_ICASE;
353             } else {
354 6 50         if (isDebug) {
355 0           fprintf(stderr, "%s: ... no /i flag\n", logHeader);
356             }
357             }
358             #endif
359             #ifdef RXf_PMf_EXTENDED
360             /* /x */
361 6 50         if ((flags & RXf_PMf_EXTENDED) == RXf_PMf_EXTENDED) {
362             /* Not supported: explicitely removed */
363 0 0         if (isDebug) {
364 0           fprintf(stderr, "%s: ... /x flag removed\n", logHeader);
365             }
366 0           extflags &= ~RXf_PMf_EXTENDED;
367             }
368             #endif
369             #ifdef RXf_PMf_KEEPCOPY
370             /* /p */
371 6 100         if ((flags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY) {
372 1 50         if (isDebug) {
373 1           fprintf(stderr, "%s: ... /p flag\n", logHeader);
374             }
375             } else {
376 5 50         if (isDebug) {
377 0           fprintf(stderr, "%s: ... no /p flag\n", logHeader);
378             }
379             }
380             #endif
381              
382             /* REGEX structure for perl */
383             #if PERL_VERSION > 10
384 6           rx = (REGEXP*) newSV_type(SVt_REGEXP);
385             #else
386             Newxz(rx, 1, REGEXP);
387             #endif
388              
389 6           r = _RegSV(rx);
390             REGEXP_REFCNT_SET(r, 1);
391 6           REGEXP_EXTFLAGS_SET(r, extflags);
392 6           REGEXP_ENGINE_SET(r, &engine_GNU);
393              
394             /* AFAIK prelen and precomp macros do not always provide an lvalue */
395             /*
396             REGEXP_PRELEN_SET(r, (I32)plen);
397             REGEXP_PRECOMP_SET(r, (exp != NULL) ? savepvn(exp, plen) : NULL);
398             */
399              
400             /* qr// stringification */
401 6 50         if (isDebug) {
402 0           fprintf(stderr, "%s: ... allocating wrapped\n", logHeader);
403             }
404 6           sv_stringification = newSVpvn("(?", 2);
405              
406 6 50         if (ri->regex.newline_anchor == 1) {
407 0           sv_catpvn(sv_stringification, "m", 1);
408             }
409 6 50         if ((ri->regex.syntax & RE_DOT_NEWLINE) == RE_DOT_NEWLINE) {
410 0           sv_catpvn(sv_stringification, "s", 1);
411             }
412 6 100         if ((ri->regex.syntax & RE_ICASE) == RE_ICASE) {
413 1           sv_catpvn(sv_stringification, "i", 1);
414             }
415 6           sv_catpvn(sv_stringification, ":", 1);
416 6           sv_catpvn(sv_stringification, "(?#re::engine::GNU", 18);
417             {
418             char tmp[50];
419              
420 6           sprintf(tmp, "%d", defaultSyntax);
421 6           sv_catpvn(sv_stringification, "/syntax=", 8);
422 6           sv_catpvn(sv_stringification, tmp, strlen(tmp));
423             }
424 6           sv_catpvn(sv_stringification, ")", 1);
425              
426 6           sv_catpvn(sv_stringification, exp, plen);
427 6           sv_catpvn(sv_stringification, ")", 1);
428 6           RX_WRAPPED(rx) = savepvn(SvPVX(sv_stringification), SvCUR(sv_stringification));
429 6           RX_WRAPLEN(rx) = SvCUR(sv_stringification);
430 6 50         if (isDebug) {
431 0           GNU_dump_pattern(aTHX_ logHeader, rx);
432             }
433 6           SvREFCNT_dec(sv_stringification);
434              
435 6 50         if (isDebug) {
436 0           fprintf(stderr, "%s: ... re_compile_internal(preg=%p, pattern=\"%s\", length=%ld, syntax=0x%lx, is_utf8=%d)\n", logHeader, &(ri->regex), exp, (unsigned long) plen, (unsigned long) ri->regex.syntax, (int) ri->is_utf8);
437             }
438              
439 6           ret = re_compile_internal (aTHX_ &(ri->regex), exp, plen, ri->regex.syntax, ri->is_utf8);
440              
441 6 50         if (ret != _REG_NOERROR) {
442             extern const char __re_error_msgid[];
443             extern const size_t __re_error_msgid_idx[];
444 0           croak("%s: %s", logHeader, __re_error_msgid + __re_error_msgid_idx[(int) ret]);
445             }
446              
447 6           REGEXP_PPRIVATE_SET(r, ri);
448 6           REGEXP_LASTPAREN_SET(r, 0);
449 6           REGEXP_LASTCLOSEPAREN_SET(r, 0);
450 6           REGEXP_NPARENS_SET(r, (U32)ri->regex.re_nsub); /* cast from size_t */
451             REGEXP_LOGICAL_NPARENS_SET(r, (U32)ri->regex.re_nsub);
452              
453 6 50         if (isDebug) {
454 0           fprintf(stderr, "%s: ... %d () detected\n", logHeader, (int) ri->regex.re_nsub);
455             }
456              
457             /*
458             Tell perl how many match vars we have and allocate space for
459             them, at least one is always allocated for $&
460             */
461             /* Note: we made sure that offs is always supported whatever the perl version */
462 6 50         Newxz(REGEXP_OFFS_GET(r), REGEXP_NPARENS_GET(r) + 1, regexp_paren_pair);
463              
464 6 50         if (isDebug) {
465 0           fprintf(stderr, "%s: return %p\n", logHeader, rx);
466             }
467              
468             /* return the regexp structure to perl */
469 6           return rx;
470             }
471             #endif /* HAVE_REGEXP_ENGINE_COMP */
472              
473             #ifdef HAVE_REGEXP_ENGINE_EXEC
474              
475             /* Copy of http://perl5.git.perl.org/perl.git/blob_plain/HEAD:/regexec.c */
476             /* and little adaptation -; 2015.03.15 */
477              
478             GNU_STATIC
479             void
480 12           GNU_exec_set_capture_string(pTHX_ REGEXP * const rx,
481             char *strbeg,
482             char *strend,
483             SV *sv,
484             U32 flags,
485             short utf8_target)
486             {
487 12           char *logHeader = "[re::engine::GNU] GNU_exec_set_capture_string";
488 12           struct regexp *r = _RegSV(rx);
489 12           GNU_private_t *ri = REGEXP_PPRIVATE_GET(r);
490 12           int isDebug = ri->isDebug;
491              
492 12 50         if (isDebug) {
493 0           fprintf(stderr, "%s: rx=%p, strbeg=%p, strend=%p, sv=%p, flags=0x%lx, utf8_target=%d\n", logHeader, rx, strbeg, strend, sv, (unsigned long) flags, (int) utf8_target);
494             }
495              
496 12 50         if ((flags & REXEC_COPY_STR) == REXEC_COPY_STR) {
497             /* It is perl that decides if this version is COW enabled or not */
498             /* From our point of view, it is equivalent to test if saved_copy */
499             /* is available */
500             #if REGEXP_SAVED_COPY_CAN
501             #ifdef PERL_ANY_COW
502 12 50         short canCow = SvCANCOW(sv);
    50          
    50          
    0          
    0          
503             #else
504             short canCow = 0;
505             #endif
506             #else
507             short canCow = 0;
508             #endif
509 12 50         if (canCow != 0) {
510             #if REGEXP_SAVED_COPY_CAN
511 12 100         if ((REGEXP_SAVED_COPY_GET(r) != NULL)
512 7 50         && SvIsCOW(REGEXP_SAVED_COPY_GET(r))
513 7 50         && SvPOKp(REGEXP_SAVED_COPY_GET(r))
514 7 50         && SvIsCOW(sv)
515 7 50         && SvPOKp(sv)
516 7 50         && (SvPVX(sv) == SvPVX(REGEXP_SAVED_COPY_GET(r)))) {
517             /* just reuse saved_copy SV */
518 7 50         if (isDebug) {
519 0           fprintf(stderr, "%s: ... reusing save_copy SV\n", logHeader);
520             }
521 7 50         if (RX_MATCH_COPIED(rx)) {
522             #if REGEXP_SUBBEG_CAN
523 0           Safefree(REGEXP_SUBBEG_GET(r));
524             #endif /* REGEXP_SUBBEG_CAN */
525 0           RX_MATCH_COPIED_off(rx);
526             }
527             } else {
528 5 50         if (isDebug) {
529 0           fprintf(stderr, "%s: ... creating new COW sv\n", logHeader);
530             }
531 5 50         RX_MATCH_COPY_FREE(rx);
    0          
    50          
532 5           REGEXP_SAVED_COPY_SET(r, sv_setsv_cow(REGEXP_SAVED_COPY_GET(r), sv));
533             }
534 12           REGEXP_SUBBEG_SET(r, (char *)SvPVX_const(REGEXP_SAVED_COPY_GET(r)));
535 12           REGEXP_SUBLEN_SET(r, strend - strbeg);
536 12           REGEXP_SUBOFFSET_SET(r, 0);
537 12           REGEXP_SUBCOFFSET_SET(r, 0);
538 12 50         if (isDebug) {
539 12           fprintf(stderr, "%s: ..."
540             #if REGEXP_SUBBEG_CAN
541             " subbeg=%p"
542             #endif
543             #if REGEXP_SUBLEN_CAN
544             " sublen=%" IVdf
545             #endif
546             #if REGEXP_SUBOFFSET_CAN
547             " suboffset=%" IVdf
548             #endif
549             #if REGEXP_SUBCOFFSET_CAN
550             " subcoffset=%" IVdf
551             #endif
552             "\n", logHeader
553             #if REGEXP_SUBBEG_CAN
554             , REGEXP_SUBBEG_GET(r)
555             #endif
556             #if REGEXP_SUBLEN_CAN
557 0           , (IV)REGEXP_SUBLEN_GET(r)
558             #endif
559             #if REGEXP_SUBOFFSET_CAN
560 0           , (IV)REGEXP_SUBOFFSET_GET(r)
561             #endif
562             #if REGEXP_SUBCOFFSET_CAN
563 0           , (IV)REGEXP_SUBCOFFSET_GET(r)
564             #endif
565             );
566             }
567             #endif /* REGEXP_SAVED_COPY_CAN */
568             } else {
569             /* The following are optimizations that appeared in 5.20. This is almost */
570             /* copied verbatim from it */
571             #if REGEXP_EXTFLAGS_CAN && REGEXP_LASTPAREN_CAN && REGEXP_OFFS_CAN && REGEXP_SUBLEN_CAN && REGEXP_SUBBEG_CAN
572             {
573 0           SSize_t min = 0;
574 0           SSize_t max = strend - strbeg;
575             SSize_t sublen;
576             #if defined(RXf_PMf_KEEPCOPY) && defined(PL_sawampersand) && defined(REXEC_COPY_SKIP_POST) && defined(SAWAMPERSAND_RIGHT) && defined(REXEC_COPY_SKIP_PRE) && defined(SAWAMPERSAND_LEFT)
577             /* $' and $` optimizations */
578              
579             if (((flags & REXEC_COPY_SKIP_POST) == REXEC_COPY_SKIP_POST)
580             && !((REGEXP_EXTFLAGS_GET(r) & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY) /* //p */
581             && !((PL_sawampersand & SAWAMPERSAND_RIGHT) == SAWAMPERSAND_RIGHT)
582             ) {
583             /* don't copy $' part of string */
584             U32 n = 0;
585             max = -1;
586             /* calculate the right-most part of the string covered
587             * by a capture. Due to look-ahead, this may be to
588             * the right of $&, so we have to scan all captures */
589             if (isDebug) {
590             fprintf(stderr, "%s: ... calculate right-most part of the string coverred by a capture\n", logHeader);
591             }
592             while (n <= REGEXP_LASTPAREN_GET(r)) {
593             if (REGEXP_OFFS_GET(r)[n].end > max) {
594             max = REGEXP_OFFS_GET(r)[n].end;
595             }
596             n++;
597             }
598             if (max == -1)
599             max = ((PL_sawampersand & SAWAMPERSAND_LEFT) == SAWAMPERSAND_LEFT)
600             ? REGEXP_OFFS_GET(r)[0].start
601             : 0;
602             }
603             if (((flags & REXEC_COPY_SKIP_PRE) == REXEC_COPY_SKIP_PRE)
604             && !((REGEXP_EXTFLAGS_GET(r) & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY) /* //p */
605             && !((PL_sawampersand & SAWAMPERSAND_LEFT) == SAWAMPERSAND_LEFT)
606             ) {
607             /* don't copy $` part of string */
608             U32 n = 0;
609             min = max;
610             /* calculate the left-most part of the string covered
611             * by a capture. Due to look-behind, this may be to
612             * the left of $&, so we have to scan all captures */
613             if (isDebug) {
614             fprintf(stderr, "%s: ... calculate left-most part of the string coverred by a capture\n", logHeader);
615             }
616             while (min && n <= REGEXP_LASTPAREN_GET(r)) {
617             if ( REGEXP_OFFS_GET(r)[n].start != -1
618             && REGEXP_OFFS_GET(r)[n].start < min)
619             {
620             min = REGEXP_OFFS_GET(r)[n].start;
621             }
622             n++;
623             }
624             if (((PL_sawampersand & SAWAMPERSAND_RIGHT) == SAWAMPERSAND_RIGHT)
625             && min > REGEXP_OFFS_GET(r)[0].end
626             )
627             min = REGEXP_OFFS_GET(r)[0].end;
628             }
629             #endif /* RXf_PMf_KEEPCOPY && PL_sawampersand && REXEC_COPY_SKIP_POST && SAWAMPERSAND_RIGHT && REXEC_COPY_SKIP_PRE && SAWAMPERSAND_LEFT */
630              
631 0           sublen = max - min;
632              
633 0 0         if (RX_MATCH_COPIED(rx)) {
634 0 0         if (sublen > REGEXP_SUBLEN_GET(r))
635 0           REGEXP_SUBBEG_SET(r, (char*)saferealloc(REGEXP_SUBBEG_GET(r), sublen+1));
636             }
637             else {
638 0           REGEXP_SUBBEG_SET(r, (char*)safemalloc(sublen+1));
639             }
640 0           Copy(strbeg + min, REGEXP_SUBBEG_GET(r), sublen, char);
641 0           REGEXP_SUBBEG_GET(r)[sublen] = '\0';
642 0           REGEXP_SUBOFFSET_SET(r, min);
643 0           REGEXP_SUBLEN_SET(r, sublen);
644 0           RX_MATCH_COPIED_on(rx);
645 0 0         if (isDebug) {
646 0           fprintf(stderr, "%s: ..."
647             #if REGEXP_SUBBEG_CAN
648             " subbeg=%p"
649             #endif
650             #if REGEXP_SUBLEN_CAN
651             " sublen=%" IVdf
652             #endif
653             #if REGEXP_SUBOFFSET_CAN
654             " suboffset=%" IVdf
655             #endif
656             #if REGEXP_SUBCOFFSET_CAN
657             " subcoffset=%" IVdf
658             #endif
659             "\n", logHeader
660             #if REGEXP_SUBBEG_CAN
661             , REGEXP_SUBBEG_GET(r)
662             #endif
663             #if REGEXP_SUBLEN_CAN
664 0           , (IV)REGEXP_SUBLEN_GET(r)
665             #endif
666             #if REGEXP_SUBOFFSET_CAN
667 0           , (IV)REGEXP_SUBOFFSET_GET(r)
668             #endif
669             #if REGEXP_SUBCOFFSET_CAN
670 0           , (IV)REGEXP_SUBCOFFSET_GET(r)
671             #endif
672             );
673             }
674             }
675             #endif /* REGEXP_EXTFLAGS_CAN && REGEXP_LASTPAREN_CAN && REGEXP_OFFS_CAN && REGEXP_SUBLEN_CAN && REGEXP_SUBBEG_CAN */
676              
677             #if REGEXP_SUBCOFFSET_CAN && REGEXP_SUBOFFSET_CAN
678 0           REGEXP_SUBCOFFSET_SET(r, REGEXP_SUBOFFSET_GET(r));
679 0 0         if (REGEXP_SUBOFFSET_GET(r) != 0 && utf8_target != 0) {
    0          
680             /* Convert byte offset to chars.
681             * XXX ideally should only compute this if @-/@+
682             * has been seen, a la PL_sawampersand ??? */
683              
684             /* If there's a direct correspondence between the
685             * string which we're matching and the original SV,
686             * then we can use the utf8 len cache associated with
687             * the SV. In particular, it means that under //g,
688             * sv_pos_b2u() will use the previously cached
689             * position to speed up working out the new length of
690             * subcoffset, rather than counting from the start of
691             * the string each time. This stops
692             * $x = "\x{100}" x 1E6; 1 while $x =~ /(.)/g;
693             * from going quadratic */
694             #ifdef HAVE_SV_POS_B2U_FLAGS
695 0 0         if (SvPOKp(sv) && SvPVX(sv) == strbeg)
    0          
696 0           REGEXP_SUBCOFFSET_SET(r, sv_pos_b2u_flags(sv, REGEXP_SUBCOFFSET_GET(r),
697             SV_GMAGIC|SV_CONST_RETURN));
698             else
699             #endif
700 0           REGEXP_SUBCOFFSET_SET(r, utf8_length((U8*)strbeg,
701             (U8*)(strbeg + REGEXP_SUBOFFSET_GET(r))));
702             }
703 0 0         if (isDebug) {
704 12           fprintf(stderr, "%s: ... suboffset=%" IVdf " and utf8target=%" IVdf " => subcoffset=%" IVdf "\n",
705 0           logHeader, (IV)REGEXP_SUBOFFSET_GET(r), (IV)utf8_target, (IV)REGEXP_SUBCOFFSET_GET(r));
706             }
707             #endif /* REGEXP_SUBCOFFSET_CAN && REGEXP_SUBOFFSET_CAN */
708             }
709             } else {
710 0 0         RX_MATCH_COPY_FREE(rx);
    0          
    0          
711 0           REGEXP_SUBBEG_SET(r, strbeg);
712 0           REGEXP_SUBOFFSET_SET(r, 0);
713 0           REGEXP_SUBCOFFSET_SET(r, 0);
714 0           REGEXP_SUBLEN_SET(r, strend - strbeg);
715             }
716              
717 12 50         if (isDebug) {
718 0           fprintf(stderr, "%s: return void\n", logHeader);
719             }
720              
721 12           }
722              
723             GNU_STATIC
724             I32
725             #if PERL_VERSION >= 19
726 14           GNU_exec(pTHX_ REGEXP * const rx, char *stringarg, char *strend, char *strbeg, SSize_t minend, SV * sv, void *data, U32 flags)
727             #else
728             GNU_exec(pTHX_ REGEXP * const rx, char *stringarg, char *strend, char *strbeg, I32 minend, SV * sv, void *data, U32 flags)
729             #endif
730             {
731 14           struct regexp *r = _RegSV(rx);
732 14           GNU_private_t *ri = REGEXP_PPRIVATE_GET(r);
733 14           int isDebug = ri->isDebug;
734             regoff_t rc;
735             U32 i;
736             struct re_registers regs; /* for subexpression matches */
737 14           char *logHeader = "[re::engine::GNU] GNU_exec";
738 14 100         short utf8_target = DO_UTF8(sv) ? 1 : 0;
    50          
739              
740 14           regs.num_regs = 0;
741 14           regs.start = NULL;
742 14           regs.end = NULL;
743              
744 14 50         if (isDebug) {
745 0           fprintf(stderr, "%s: rx=%p, stringarg=%p, strend=%p, strbeg=%p, minend=%d, sv=%p, data=%p, flags=0x%lx\n", logHeader, rx, stringarg, strend, strbeg, (int) minend, sv, data, (unsigned long) flags);
746 0           GNU_dump_pattern(aTHX_ logHeader, rx);
747             }
748              
749             /* Take care: strend points to the character following the end of the physical string */
750 14 50         if (isDebug) {
751 0           fprintf(stderr, "%s: ... re_search(bufp=%p, string=%p, length=%d, sv=%p, start=%d, range=%d, regs=%p)\n", logHeader, &(ri->regex), strbeg, (int) (strend - strbeg), sv, (int) (stringarg - strbeg), (int) (strend - stringarg), ®s);
752             }
753 14           rc = re_search(aTHX_ &(ri->regex), strbeg, strend - strbeg, sv, stringarg - strbeg, strend - stringarg, ®s);
754              
755 14 50         if (rc <= -2) {
756 0           croak("%s: Internal error in re_search()", logHeader);
757 14 100         } else if (rc == -1) {
758 2 50         if (isDebug) {
759 0           fprintf(stderr, "%s: return 0 (no match)\n", logHeader);
760             }
761 2           return 0;
762             }
763              
764             /* Why isn't it done by the higher level ? */
765 12 100         RX_MATCH_UTF8_set(rx, utf8_target);
766 12           RX_MATCH_TAINTED_off(rx);
767              
768 12           REGEXP_LASTPAREN_SET(r, REGEXP_NPARENS_GET(r));
769 12           REGEXP_LASTCLOSEPAREN_SET(r, REGEXP_NPARENS_GET(r));
770              
771             /* There is always at least the index 0 for $& */
772 37 100         for (i = 0; i < REGEXP_NPARENS_GET(r) + 1; i++) {
773 25 50         if (isDebug) {
774 0           fprintf(stderr, "%s: ... Match No %d: [%d,%d]\n", logHeader, i, (int) regs.start[i], (int) regs.end[i]);
775             }
776             #if REGEXP_OFFS_CAN
777 25           REGEXP_OFFS_GET(r)[i].start = regs.start[i];
778 25           REGEXP_OFFS_GET(r)[i].end = regs.end[i];
779             #endif
780             }
781              
782             #ifndef PERL_5_10_METHOD
783 12 50         if ((flags & REXEC_NOT_FIRST) != REXEC_NOT_FIRST) {
784 12           GNU_exec_set_capture_string(aTHX_ rx, strbeg, strend, sv, flags, utf8_target);
785             }
786             #else
787             /* This is the perl-5.10 method */
788             if ((flags & REXEC_NOT_FIRST) != REXEC_NOT_FIRST) {
789             const I32 length = strend - strbeg;
790             #if REGEXP_SAVED_COPY_CAN
791             #ifdef PERL_ANY_COW
792             short canCow = SvCANCOW(sv);
793             #else
794             short canCow = 0;
795             #endif
796             short doCow = canCow ? ((REGEXP_SAVED_COPY_GET(r) != NULL)
797             && SvIsCOW(REGEXP_SAVED_COPY_GET(r))
798             && SvPOKp(REGEXP_SAVED_COPY_GET(r))
799             && SvIsCOW(sv)
800             && SvPOKp(sv)
801             && (SvPVX(sv) == SvPVX(REGEXP_SAVED_COPY_GET(r)))) : 0;
802             #else
803             short canCow = 0;
804             short doCow = 0;
805             #endif
806             RX_MATCH_COPY_FREE(rx);
807             if ((flags & REXEC_COPY_STR) == REXEC_COPY_STR) {
808             /* Adapted from perl-5.10. Not performant, I know */
809             if ((canCow != 0) && (doCow != 0)) {
810             #if REGEXP_SAVED_COPY_CAN
811             if (isDebug) {
812             fprintf(stderr, "%s: ... reusing save_copy SV\n", logHeader);
813             }
814             REGEXP_SAVED_COPY_SET(r, sv_setsv_cow(REGEXP_SAVED_COPY_GET(r), sv));
815             #if REGEXP_SUBBEG_CAN
816             {
817             SV *csv = REGEXP_SAVED_COPY_GET(r);
818             char *s = (char *) SvPVX_const(csv);
819             REGEXP_SUBBEG_SET(r, s);
820             }
821             #endif
822             #endif
823             } else {
824             RX_MATCH_COPIED_on(rx);
825             #if REGEXP_SUBBEG_CAN
826             REGEXP_SUBBEG_SET(r, savepvn(strbeg, length));
827             #endif
828             }
829             } else {
830             REGEXP_SUBBEG_SET(r, strbeg);
831             }
832             REGEXP_SUBLEN_SET(r, length);
833             REGEXP_SUBOFFSET_SET(r, 0);
834             REGEXP_SUBCOFFSET_SET(r, 0);
835             }
836             #endif /* PERL_5_10_METHOD */
837              
838 12 50         if (regs.start != NULL) {
839 12           Safefree(regs.start);
840             }
841 12 50         if (regs.end != NULL) {
842 12           Safefree(regs.end);
843             }
844              
845 12 50         if (isDebug) {
846 0           fprintf(stderr, "%s: return 1 (match)\n", logHeader);
847             }
848              
849 14           return 1;
850             }
851             #endif /* HAVE_REGEXP_ENGINE_EXEC */
852              
853             #ifdef HAVE_REGEXP_ENGINE_INTUIT
854             GNU_STATIC
855             char *
856             #if PERL_VERSION >= 19
857 0           GNU_intuit(pTHX_ REGEXP * const rx, SV * sv, const char *strbeg, char *strpos, char *strend, U32 flags, re_scream_pos_data *data)
858             #else
859             GNU_intuit(pTHX_ REGEXP * const rx, SV * sv, char *strpos, char *strend, U32 flags, re_scream_pos_data *data)
860             #endif
861             {
862 0           struct regexp *r = _RegSV(rx);
863 0           GNU_private_t *ri = REGEXP_PPRIVATE_GET(r);
864 0           int isDebug = ri->isDebug;
865 0           char *logHeader = "[re::engine::GNU] GNU_intuit";
866              
867             PERL_UNUSED_ARG(rx);
868             PERL_UNUSED_ARG(sv);
869             #if PERL_VERSION >= 19
870             PERL_UNUSED_ARG(strbeg);
871             #endif
872             PERL_UNUSED_ARG(strpos);
873             PERL_UNUSED_ARG(strend);
874             PERL_UNUSED_ARG(flags);
875             PERL_UNUSED_ARG(data);
876              
877 0 0         if (isDebug) {
878 0           fprintf(stderr, "%s: rx=%p, sv=%p, strpos=%p, strend=%p, flags=0x%lx, data=%p\n", logHeader, rx, sv, strpos, strend, (unsigned long) flags, data);
879 0           GNU_dump_pattern(aTHX_ logHeader, rx);
880 0           fprintf(stderr, "%s: return NULL\n", logHeader);
881             }
882              
883 0           return NULL;
884             }
885             #endif
886              
887             #ifdef HAVE_REGEXP_ENGINE_CHECKSTR
888             GNU_STATIC
889             SV *
890 0           GNU_checkstr(pTHX_ REGEXP * const rx)
891             {
892 0           struct regexp *r = _RegSV(rx);
893 0           GNU_private_t *ri = REGEXP_PPRIVATE_GET(r);
894 0           int isDebug = ri->isDebug;
895 0           char *logHeader = "[re::engine::GNU] GNU_checkstr";
896              
897             PERL_UNUSED_ARG(rx);
898              
899 0 0         if (isDebug) {
900 0           fprintf(stderr, "%s: rx=%p\n", logHeader, rx);
901 0           GNU_dump_pattern(aTHX_ logHeader, rx);
902 0           fprintf(stderr, "%s: return NULL\n", logHeader);
903             }
904              
905 0           return NULL;
906             }
907             #endif
908              
909             #if (defined(HAVE_REGEXP_ENGINE_FREE) || defined(HAVE_REGEXP_ENGINE_RXFREE))
910             GNU_STATIC
911             void
912 6           GNU_free(pTHX_ REGEXP * const rx)
913             {
914 6           struct regexp *r = _RegSV(rx);
915 6           GNU_private_t *ri = REGEXP_PPRIVATE_GET(r);
916 6           int isDebug = ri->isDebug;
917 6           char *logHeader = "[re::engine::GNU] GNU_free";
918              
919 6 50         if (isDebug) {
920 0           fprintf(stderr, "%s: rx=%p\n", logHeader, rx);
921 0           GNU_dump_pattern(aTHX_ logHeader, rx);
922             }
923              
924 6 50         if (isDebug) {
925 0           fprintf(stderr, "%s: ... SvREFCNT_dec(ri->sv_pattern=%p)\n", logHeader, ri->sv_pattern);
926             }
927 6           SvREFCNT_dec(ri->sv_pattern);
928 6 100         if (ri->sv_syntax != NULL) {
929 3 50         if (isDebug) {
930 0           fprintf(stderr, "%s: ... SvREFCNT_dec(ri->sv_syntax=%p)\n", logHeader, ri->sv_syntax);
931             }
932 3           SvREFCNT_dec(ri->sv_syntax);
933             }
934              
935 6 50         if (isDebug) {
936 0           fprintf(stderr, "%s: ... regfree(preg=%p)\n", logHeader, &(ri->regex));
937             }
938 6           regfree(aTHX_ &(ri->regex));
939              
940 6 50         if (isDebug) {
941 0           fprintf(stderr, "%s: ... Safefree(ri=%p)\n", logHeader, ri);
942             }
943 6           Safefree(ri);
944              
945 6 50         if (isDebug) {
946 0           fprintf(stderr, "%s: return void\n", logHeader);
947             }
948              
949 6           }
950             #endif
951              
952             #ifdef HAVE_REGEXP_ENGINE_QR_PACKAGE
953             GNU_STATIC
954             SV *
955 2           GNU_qr_package(pTHX_ REGEXP * const rx)
956             {
957 2           struct regexp *r = _RegSV(rx);
958 2           GNU_private_t *ri = REGEXP_PPRIVATE_GET(r);
959 2           int isDebug = ri->isDebug;
960 2           char *logHeader = "[re::engine::GNU] GNU_qr_package";
961             SV *rc;
962              
963             PERL_UNUSED_ARG(rx);
964              
965 2 50         if (isDebug) {
966 0           fprintf(stderr, "%s: rx=%p\n", logHeader, rx);
967 0           GNU_dump_pattern(aTHX_ logHeader, rx);
968             }
969              
970 2           rc = newSVpvs("re::engine::GNU");
971              
972 2 50         if (isDebug) {
973 0           fprintf(stderr, "%s: return %p\n", logHeader, rc);
974             }
975              
976 2           return rc;
977              
978             }
979             #endif
980              
981             #ifdef HAVE_REGEXP_ENGINE_DUPE
982             GNU_STATIC
983             void *
984             GNU_dupe(pTHX_ REGEXP * const rx, CLONE_PARAMS *param)
985             {
986             char *logHeader = "[re::engine::GNU] GNU_dupe";
987             struct regexp *r = _RegSV(rx);
988             GNU_private_t *oldri = REGEXP_PPRIVATE_GET(r);
989             int isDebug = oldri->isDebug;
990             GNU_private_t *ri;
991             STRLEN plen;
992             char *exp;
993             reg_errcode_t ret;
994              
995             PERL_UNUSED_ARG(param);
996              
997             Newxz(ri, 1, GNU_private_t);
998             if (isDebug) {
999             fprintf(stderr, "%s: ... allocated private structure ri=%p\n", logHeader, ri);
1000             }
1001              
1002             if (isDebug) {
1003             fprintf(stderr, "%s: rx=%p, param=%p\n", logHeader, rx, param);
1004             GNU_dump_pattern(aTHX_ logHeader, rx);
1005             }
1006              
1007             ri->sv_pattern = newSVsv(oldri->sv_pattern);
1008             ri->sv_syntax = oldri->sv_syntax != NULL ? newSVsv(oldri->sv_syntax) : NULL;
1009             ri->isDebug = oldri->isDebug;
1010             ri->is_utf8 = oldri->is_utf8;
1011             ri->regex.buffer = NULL;
1012             ri->regex.allocated = 0;
1013             ri->regex.used = 0;
1014             ri->regex.syntax = oldri->regex.syntax;
1015             ri->regex.fastmap = NULL;
1016             ri->regex.translate = NULL;
1017             ri->regex.re_nsub = 0;
1018             ri->regex.can_be_null = 0;
1019             ri->regex.regs_allocated = 0;
1020             ri->regex.fastmap_accurate = 0;
1021             ri->regex.no_sub = 0;
1022             ri->regex.not_bol = 0;
1023             ri->regex.not_eol = 0;
1024             ri->regex.newline_anchor = oldri->regex.newline_anchor;
1025              
1026             exp = SvPV(ri->sv_pattern, plen);
1027              
1028             if (isDebug) {
1029             fprintf(stderr, "%s: ... re_compile_internal(preg=%p, pattern=\"%s\", length=%ld, syntax=0x%lx, is_utf8=%d)\n", logHeader, &(ri->regex), exp, (unsigned long) plen, (unsigned long) ri->regex.syntax, (int) ri->is_utf8);
1030             }
1031              
1032             ret = re_compile_internal (aTHX_ &(ri->regex), exp, plen, ri->regex.syntax, ri->is_utf8);
1033              
1034             if (ret != _REG_NOERROR) {
1035             extern const char __re_error_msgid[];
1036             extern const size_t __re_error_msgid_idx[];
1037             croak("%s: %s", logHeader, __re_error_msgid + __re_error_msgid_idx[(int) ret]);
1038             }
1039              
1040             if (isDebug) {
1041             fprintf(stderr, "%s: return %p\n", logHeader, ri);
1042             }
1043              
1044             return ri;
1045             }
1046             #endif
1047              
1048             MODULE = re::engine::GNU PACKAGE = re::engine::GNU
1049             PROTOTYPES: ENABLE
1050              
1051             BOOT:
1052 2           debugkey_sv = newSVpvs_share("re::engine::GNU/debug");
1053 2           syntaxkey_sv = newSVpvs_share("re::engine::GNU/syntax");
1054             #ifdef HAVE_REGEXP_ENGINE_COMP
1055 2           engine_GNU.comp = GNU_comp;
1056             #endif
1057             #ifdef HAVE_REGEXP_ENGINE_EXEC
1058 2           engine_GNU.exec = GNU_exec;
1059             #endif
1060             #ifdef HAVE_REGEXP_ENGINE_INTUIT
1061 2           engine_GNU.intuit = GNU_intuit;
1062             #endif
1063             #ifdef HAVE_REGEXP_ENGINE_CHECKSTR
1064 2           engine_GNU.checkstr = GNU_checkstr;
1065             #endif
1066             #ifdef HAVE_REGEXP_ENGINE_FREE
1067             # undef _PREVIOUS_FREE_MACRO
1068             # ifdef free
1069             # define _PREVIOUS_FREE_MACRO free
1070             # endif
1071             # undef free
1072             engine_GNU.free = GNU_free;
1073             # ifdef _PREVIOUS_FREE_MACRO
1074             # define free _PREVIOUS_FREE_MACRO
1075             # endif
1076             #endif
1077             #ifdef HAVE_REGEXP_ENGINE_RXFREE
1078 2           engine_GNU.rxfree = GNU_free;
1079             #endif
1080             #ifdef HAVE_REGEXP_ENGINE_NUMBERED_BUFF_FETCH
1081             #ifdef HAVE_PERL_REG_NUMBERED_BUFF_FETCH
1082 2           engine_GNU.numbered_buff_FETCH = Perl_reg_numbered_buff_fetch;
1083             #else
1084             engine_GNU.numbered_buff_FETCH = NULL;
1085             #endif
1086             #endif
1087             #ifdef HAVE_REGEXP_ENGINE_NUMBERED_BUFF_STORE
1088             #ifdef HAVE_PERL_REG_NUMBERED_BUFF_STORE
1089 2           engine_GNU.numbered_buff_STORE = Perl_reg_numbered_buff_store;
1090             #else
1091             engine_GNU.numbered_buff_STORE = NULL;
1092             #endif
1093             #endif
1094             #ifdef HAVE_REGEXP_ENGINE_NUMBERED_BUFF_LENGTH
1095             #ifdef HAVE_PERL_REG_NUMBERED_BUFF_LENGTH
1096 2           engine_GNU.numbered_buff_LENGTH = Perl_reg_numbered_buff_length;
1097             #else
1098             engine_GNU.numbered_buff_LENGTH = NULL;
1099             #endif
1100             #endif
1101             #ifdef HAVE_REGEXP_ENGINE_NAMED_BUFF
1102             #ifdef HAVE_PERL_REG_NAMED_BUFF
1103 2           engine_GNU.named_buff = Perl_reg_named_buff;
1104             #else
1105             engine_GNU.named_buff = NULL;
1106             #endif
1107             #endif
1108             #ifdef HAVE_REGEXP_ENGINE_NAMED_BUFF_ITER
1109             #ifdef HAVE_PERL_REG_NAMED_BUFF_ITER
1110 2           engine_GNU.named_buff_iter = Perl_reg_named_buff_iter;
1111             #else
1112             engine_GNU.named_buff_iter = NULL;
1113             #endif
1114             #endif
1115             #ifdef HAVE_REGEXP_ENGINE_QR_PACKAGE
1116 2           engine_GNU.qr_package = GNU_qr_package;
1117             #endif
1118             #ifdef HAVE_REGEXP_ENGINE_DUPE
1119             engine_GNU.dupe = GNU_dupe;
1120             #endif
1121              
1122             void
1123             ENGINE(...)
1124             PROTOTYPE:
1125             PPCODE:
1126 12 50         XPUSHs(sv_2mortal(newSViv(PTR2IV(&engine_GNU))));
1127              
1128             void
1129             RE_SYNTAX_AWK(...)
1130             PROTOTYPE:
1131             PPCODE:
1132 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_AWK)));
1133              
1134             void
1135             RE_SYNTAX_ED(...)
1136             PROTOTYPE:
1137             PPCODE:
1138 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_ED)));
1139              
1140             void
1141             RE_SYNTAX_EGREP(...)
1142             PROTOTYPE:
1143             PPCODE:
1144 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_EGREP)));
1145              
1146             void
1147             RE_SYNTAX_EMACS(...)
1148             PROTOTYPE:
1149             PPCODE:
1150 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_EMACS)));
1151              
1152             void
1153             RE_SYNTAX_GNU_AWK(...)
1154             PROTOTYPE:
1155             PPCODE:
1156 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_GNU_AWK)));
1157              
1158             void
1159             RE_SYNTAX_GREP(...)
1160             PROTOTYPE:
1161             PPCODE:
1162 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_GREP)));
1163              
1164             void
1165             RE_SYNTAX_POSIX_AWK(...)
1166             PROTOTYPE:
1167             PPCODE:
1168 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_POSIX_AWK)));
1169              
1170             void
1171             RE_SYNTAX_POSIX_BASIC(...)
1172             PROTOTYPE:
1173             PPCODE:
1174 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_POSIX_BASIC)));
1175              
1176             void
1177             RE_SYNTAX_POSIX_EGREP(...)
1178             PROTOTYPE:
1179             PPCODE:
1180 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_POSIX_EGREP)));
1181              
1182             void
1183             RE_SYNTAX_POSIX_EXTENDED(...)
1184             PROTOTYPE:
1185             PPCODE:
1186 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_POSIX_EXTENDED)));
1187              
1188             void
1189             RE_SYNTAX_POSIX_MINIMAL_BASIC(...)
1190             PROTOTYPE:
1191             PPCODE:
1192 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_POSIX_MINIMAL_BASIC)));
1193              
1194             void
1195             RE_SYNTAX_POSIX_MINIMAL_EXTENDED(...)
1196             PROTOTYPE:
1197             PPCODE:
1198 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_POSIX_MINIMAL_EXTENDED)));
1199              
1200             void
1201             RE_SYNTAX_SED(...)
1202             PROTOTYPE:
1203             PPCODE:
1204 2 50         XPUSHs(sv_2mortal(newSViv(RE_SYNTAX_SED)));
1205              
1206             void
1207             RE_BACKSLASH_ESCAPE_IN_LISTS(...)
1208             PROTOTYPE:
1209             PPCODE:
1210 2 50         XPUSHs(sv_2mortal(newSViv(RE_BACKSLASH_ESCAPE_IN_LISTS)));
1211              
1212             void
1213             RE_BK_PLUS_QM(...)
1214             PROTOTYPE:
1215             PPCODE:
1216 2 50         XPUSHs(sv_2mortal(newSViv(RE_BK_PLUS_QM)));
1217              
1218             void
1219             RE_CHAR_CLASSES(...)
1220             PROTOTYPE:
1221             PPCODE:
1222 2 50         XPUSHs(sv_2mortal(newSViv(RE_CHAR_CLASSES)));
1223              
1224             void
1225             RE_CONTEXT_INDEP_ANCHORS(...)
1226             PROTOTYPE:
1227             PPCODE:
1228 2 50         XPUSHs(sv_2mortal(newSViv(RE_CONTEXT_INDEP_ANCHORS)));
1229              
1230             void
1231             RE_CONTEXT_INDEP_OPS(...)
1232             PROTOTYPE:
1233             PPCODE:
1234 2 50         XPUSHs(sv_2mortal(newSViv(RE_CONTEXT_INDEP_OPS)));
1235              
1236             void
1237             RE_CONTEXT_INVALID_OPS(...)
1238             PROTOTYPE:
1239             PPCODE:
1240 2 50         XPUSHs(sv_2mortal(newSViv(RE_CONTEXT_INVALID_OPS)));
1241              
1242             void
1243             RE_DOT_NEWLINE(...)
1244             PROTOTYPE:
1245             PPCODE:
1246 2 50         XPUSHs(sv_2mortal(newSViv(RE_DOT_NEWLINE)));
1247              
1248             void
1249             RE_DOT_NOT_NULL(...)
1250             PROTOTYPE:
1251             PPCODE:
1252 2 50         XPUSHs(sv_2mortal(newSViv(RE_DOT_NOT_NULL)));
1253              
1254             void
1255             RE_HAT_LISTS_NOT_NEWLINE(...)
1256             PROTOTYPE:
1257             PPCODE:
1258 2 50         XPUSHs(sv_2mortal(newSViv(RE_HAT_LISTS_NOT_NEWLINE)));
1259              
1260             void
1261             RE_INTERVALS(...)
1262             PROTOTYPE:
1263             PPCODE:
1264 2 50         XPUSHs(sv_2mortal(newSViv(RE_INTERVALS)));
1265              
1266             void
1267             RE_LIMITED_OPS(...)
1268             PROTOTYPE:
1269             PPCODE:
1270 2 50         XPUSHs(sv_2mortal(newSViv(RE_LIMITED_OPS)));
1271              
1272             void
1273             RE_NEWLINE_ALT(...)
1274             PROTOTYPE:
1275             PPCODE:
1276 2 50         XPUSHs(sv_2mortal(newSViv(RE_NEWLINE_ALT)));
1277              
1278             void
1279             RE_NO_BK_BRACES(...)
1280             PROTOTYPE:
1281             PPCODE:
1282 2 50         XPUSHs(sv_2mortal(newSViv(RE_NO_BK_BRACES)));
1283              
1284             void
1285             RE_NO_BK_PARENS(...)
1286             PROTOTYPE:
1287             PPCODE:
1288 2 50         XPUSHs(sv_2mortal(newSViv(RE_NO_BK_PARENS)));
1289              
1290             void
1291             RE_NO_BK_REFS(...)
1292             PROTOTYPE:
1293             PPCODE:
1294 2 50         XPUSHs(sv_2mortal(newSViv(RE_NO_BK_REFS)));
1295              
1296             void
1297             RE_NO_BK_VBAR(...)
1298             PROTOTYPE:
1299             PPCODE:
1300 2 50         XPUSHs(sv_2mortal(newSViv(RE_NO_BK_VBAR)));
1301              
1302             void
1303             RE_NO_EMPTY_RANGES(...)
1304             PROTOTYPE:
1305             PPCODE:
1306 2 50         XPUSHs(sv_2mortal(newSViv(RE_NO_EMPTY_RANGES)));
1307              
1308             void
1309             RE_UNMATCHED_RIGHT_PAREN_ORD(...)
1310             PROTOTYPE:
1311             PPCODE:
1312 2 50         XPUSHs(sv_2mortal(newSViv(RE_UNMATCHED_RIGHT_PAREN_ORD)));
1313              
1314             void
1315             RE_NO_POSIX_BACKTRACKING(...)
1316             PROTOTYPE:
1317             PPCODE:
1318 2 50         XPUSHs(sv_2mortal(newSViv(RE_NO_POSIX_BACKTRACKING)));
1319              
1320             void
1321             RE_NO_GNU_OPS(...)
1322             PROTOTYPE:
1323             PPCODE:
1324 2 50         XPUSHs(sv_2mortal(newSViv(RE_NO_GNU_OPS)));
1325              
1326             void
1327             RE_DEBUG(...)
1328             PROTOTYPE:
1329             PPCODE:
1330 2 50         XPUSHs(sv_2mortal(newSViv(RE_DEBUG)));
1331              
1332             void
1333             RE_INVALID_INTERVAL_ORD(...)
1334             PROTOTYPE:
1335             PPCODE:
1336 2 50         XPUSHs(sv_2mortal(newSViv(RE_INVALID_INTERVAL_ORD)));
1337              
1338             void
1339             RE_ICASE(...)
1340             PROTOTYPE:
1341             PPCODE:
1342 2 50         XPUSHs(sv_2mortal(newSViv(RE_ICASE)));
1343              
1344             void
1345             RE_CARET_ANCHORS_HERE(...)
1346             PROTOTYPE:
1347             PPCODE:
1348 2 50         XPUSHs(sv_2mortal(newSViv(RE_CARET_ANCHORS_HERE)));
1349              
1350             void
1351             RE_CONTEXT_INVALID_DUP(...)
1352             PROTOTYPE:
1353             PPCODE:
1354 2 50         XPUSHs(sv_2mortal(newSViv(RE_CONTEXT_INVALID_DUP)));
1355              
1356             void
1357             RE_NO_SUB(...)
1358             PROTOTYPE:
1359             PPCODE:
1360 2 50         XPUSHs(sv_2mortal(newSViv(RE_NO_SUB)));