This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Apply NetBSD patch-ad: a gcc sparc64 code generation bug.
[perl5.git] / regcomp.c
CommitLineData
a0d0e21e
LW
1/* regcomp.c
2 */
3
4/*
5 * "A fair jaw-cracker dwarf-language must be." --Samwise Gamgee
6 */
7
a687059c
LW
8/* NOTE: this is derived from Henry Spencer's regexp code, and should not
9 * confused with the original package (see point 3 below). Thanks, Henry!
10 */
11
12/* Additional note: this code is very heavily munged from Henry's version
13 * in places. In some spots I've traded clarity for efficiency, so don't
14 * blame Henry for some of the lack of readability.
15 */
16
e50aee73
AD
17/* The names of the functions have been changed from regcomp and
18 * regexec to pregcomp and pregexec in order to avoid conflicts
19 * with the POSIX routines of the same names.
20*/
21
b9d5759e
AD
22#ifdef PERL_EXT_RE_BUILD
23/* need to replace pregcomp et al, so enable that */
24# ifndef PERL_IN_XSUB_RE
25# define PERL_IN_XSUB_RE
26# endif
27/* need access to debugger hooks */
cad2e5aa 28# if defined(PERL_EXT_RE_DEBUG) && !defined(DEBUGGING)
b9d5759e
AD
29# define DEBUGGING
30# endif
31#endif
32
33#ifdef PERL_IN_XSUB_RE
d06ea78c 34/* We *really* need to overwrite these symbols: */
56953603
IZ
35# define Perl_pregcomp my_regcomp
36# define Perl_regdump my_regdump
37# define Perl_regprop my_regprop
d06ea78c 38# define Perl_pregfree my_regfree
cad2e5aa
JH
39# define Perl_re_intuit_string my_re_intuit_string
40/* *These* symbols are masked to allow static link. */
d06ea78c 41# define Perl_regnext my_regnext
f0b8d043 42# define Perl_save_re_context my_save_re_context
b81d288d 43# define Perl_reginitcolors my_reginitcolors
c5be433b
GS
44
45# define PERL_NO_GET_CONTEXT
b81d288d 46#endif
56953603 47
f0fcb552 48/*SUPPRESS 112*/
a687059c 49/*
e50aee73 50 * pregcomp and pregexec -- regsub and regerror are not used in perl
a687059c
LW
51 *
52 * Copyright (c) 1986 by University of Toronto.
53 * Written by Henry Spencer. Not derived from licensed software.
54 *
55 * Permission is granted to anyone to use this software for any
56 * purpose on any computer system, and to redistribute it freely,
57 * subject to the following restrictions:
58 *
59 * 1. The author is not responsible for the consequences of use of
60 * this software, no matter how awful, even if they arise
61 * from defects in it.
62 *
63 * 2. The origin of this software must not be misrepresented, either
64 * by explicit claim or by omission.
65 *
66 * 3. Altered versions must be plainly marked as such, and must not
67 * be misrepresented as being the original software.
68 *
69 *
70 **** Alterations to Henry's code are...
71 ****
bc89e66f 72 **** Copyright (c) 1991-2001, Larry Wall
a687059c 73 ****
9ef589d8
LW
74 **** You may distribute under the terms of either the GNU General Public
75 **** License or the Artistic License, as specified in the README file.
76
a687059c
LW
77 *
78 * Beware that some of this code is subtly aware of the way operator
79 * precedence is structured in regular expressions. Serious changes in
80 * regular-expression syntax might require a total rethink.
81 */
82#include "EXTERN.h"
864dbfa3 83#define PERL_IN_REGCOMP_C
a687059c 84#include "perl.h"
d06ea78c 85
acfe0abc 86#ifndef PERL_IN_XSUB_RE
d06ea78c
GS
87# include "INTERN.h"
88#endif
c277df42
IZ
89
90#define REG_COMP_C
a687059c
LW
91#include "regcomp.h"
92
d4cce5f1 93#ifdef op
11343788 94#undef op
d4cce5f1 95#endif /* op */
11343788 96
fe14fcc3
LW
97#ifdef MSDOS
98# if defined(BUGGY_MSC6)
99 /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
100 # pragma optimize("a",off)
101 /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
102 # pragma optimize("w",on )
103# endif /* BUGGY_MSC6 */
104#endif /* MSDOS */
105
a687059c
LW
106#ifndef STATIC
107#define STATIC static
108#endif
109
830247a4
IZ
110typedef struct RExC_state_t {
111 U16 flags16; /* are we folding, multilining? */
112 char *precomp; /* uncompiled string. */
113 regexp *rx;
fac92740 114 char *start; /* Start of input for compile */
830247a4
IZ
115 char *end; /* End of input for compile */
116 char *parse; /* Input-scan pointer. */
117 I32 whilem_seen; /* number of WHILEM in this expr */
fac92740 118 regnode *emit_start; /* Start of emitted-code area */
ffc61ed2 119 regnode *emit; /* Code-emit pointer; &regdummy = don't = compiling */
830247a4
IZ
120 I32 naughty; /* How bad is this pattern? */
121 I32 sawback; /* Did we see \1, ...? */
122 U32 seen;
123 I32 size; /* Code size. */
124 I32 npar; /* () count. */
125 I32 extralen;
126 I32 seen_zerolen;
127 I32 seen_evals;
1aa99e6b 128 I32 utf8;
830247a4
IZ
129#if ADD_TO_REGEXEC
130 char *starttry; /* -Dr: where regtry was called. */
131#define RExC_starttry (pRExC_state->starttry)
132#endif
133} RExC_state_t;
134
135#define RExC_flags16 (pRExC_state->flags16)
136#define RExC_precomp (pRExC_state->precomp)
137#define RExC_rx (pRExC_state->rx)
fac92740 138#define RExC_start (pRExC_state->start)
830247a4
IZ
139#define RExC_end (pRExC_state->end)
140#define RExC_parse (pRExC_state->parse)
141#define RExC_whilem_seen (pRExC_state->whilem_seen)
fac92740 142#define RExC_offsets (pRExC_state->rx->offsets) /* I am not like the others */
830247a4 143#define RExC_emit (pRExC_state->emit)
fac92740 144#define RExC_emit_start (pRExC_state->emit_start)
830247a4
IZ
145#define RExC_naughty (pRExC_state->naughty)
146#define RExC_sawback (pRExC_state->sawback)
147#define RExC_seen (pRExC_state->seen)
148#define RExC_size (pRExC_state->size)
149#define RExC_npar (pRExC_state->npar)
150#define RExC_extralen (pRExC_state->extralen)
151#define RExC_seen_zerolen (pRExC_state->seen_zerolen)
152#define RExC_seen_evals (pRExC_state->seen_evals)
1aa99e6b 153#define RExC_utf8 (pRExC_state->utf8)
830247a4 154
a687059c
LW
155#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
156#define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
157 ((*s) == '{' && regcurly(s)))
a687059c 158
35c8bce7
LW
159#ifdef SPSTART
160#undef SPSTART /* dratted cpp namespace... */
161#endif
a687059c
LW
162/*
163 * Flags to be passed up and down.
164 */
a687059c 165#define WORST 0 /* Worst case. */
821b33a5 166#define HASWIDTH 0x1 /* Known to match non-null strings. */
a0d0e21e
LW
167#define SIMPLE 0x2 /* Simple enough to be STAR/PLUS operand. */
168#define SPSTART 0x4 /* Starts with * or +. */
169#define TRYAGAIN 0x8 /* Weeded out a declaration. */
a687059c 170
2c2d71f5
JH
171/* Length of a variant. */
172
173typedef struct scan_data_t {
174 I32 len_min;
175 I32 len_delta;
176 I32 pos_min;
177 I32 pos_delta;
178 SV *last_found;
179 I32 last_end; /* min value, <0 unless valid. */
180 I32 last_start_min;
181 I32 last_start_max;
182 SV **longest; /* Either &l_fixed, or &l_float. */
183 SV *longest_fixed;
184 I32 offset_fixed;
185 SV *longest_float;
186 I32 offset_float_min;
187 I32 offset_float_max;
188 I32 flags;
189 I32 whilem_c;
cb434fcc 190 I32 *last_closep;
653099ff 191 struct regnode_charclass_class *start_class;
2c2d71f5
JH
192} scan_data_t;
193
a687059c 194/*
e50aee73 195 * Forward declarations for pregcomp()'s friends.
a687059c 196 */
a0d0e21e 197
b81d288d 198static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
cb434fcc 199 0, 0, 0, 0, 0, 0};
c277df42
IZ
200
201#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
202#define SF_BEFORE_SEOL 0x1
203#define SF_BEFORE_MEOL 0x2
204#define SF_FIX_BEFORE_EOL (SF_FIX_BEFORE_SEOL|SF_FIX_BEFORE_MEOL)
205#define SF_FL_BEFORE_EOL (SF_FL_BEFORE_SEOL|SF_FL_BEFORE_MEOL)
206
09b7f37c
CB
207#ifdef NO_UNARY_PLUS
208# define SF_FIX_SHIFT_EOL (0+2)
209# define SF_FL_SHIFT_EOL (0+4)
210#else
211# define SF_FIX_SHIFT_EOL (+2)
212# define SF_FL_SHIFT_EOL (+4)
213#endif
c277df42
IZ
214
215#define SF_FIX_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FIX_SHIFT_EOL)
216#define SF_FIX_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FIX_SHIFT_EOL)
217
218#define SF_FL_BEFORE_SEOL (SF_BEFORE_SEOL << SF_FL_SHIFT_EOL)
219#define SF_FL_BEFORE_MEOL (SF_BEFORE_MEOL << SF_FL_SHIFT_EOL) /* 0x20 */
220#define SF_IS_INF 0x40
221#define SF_HAS_PAR 0x80
222#define SF_IN_PAR 0x100
223#define SF_HAS_EVAL 0x200
4bfe0158 224#define SCF_DO_SUBSTR 0x400
653099ff
GS
225#define SCF_DO_STCLASS_AND 0x0800
226#define SCF_DO_STCLASS_OR 0x1000
227#define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
e1901655 228#define SCF_WHILEM_VISITED_POS 0x2000
c277df42 229
1aa99e6b 230#define UTF RExC_utf8
830247a4
IZ
231#define LOC (RExC_flags16 & PMf_LOCALE)
232#define FOLD (RExC_flags16 & PMf_FOLD)
a0ed51b3 233
ffc61ed2 234#define OOB_UNICODE 12345678
93733859 235#define OOB_NAMEDCLASS -1
b8c5462f 236
a0ed51b3
LW
237#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
238#define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
239
8615cb43 240
b45f050a
JF
241/* length of regex to show in messages that don't mark a position within */
242#define RegexLengthToShowInErrorMessages 127
243
244/*
245 * If MARKER[12] are adjusted, be sure to adjust the constants at the top
246 * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
247 * op/pragma/warn/regcomp.
248 */
7253e4e3
RK
249#define MARKER1 "<-- HERE" /* marker as it appears in the description */
250#define MARKER2 " <-- HERE " /* marker as it appears within the regex */
b81d288d 251
7253e4e3 252#define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%.*s" MARKER2 "%s/"
b45f050a
JF
253
254/*
255 * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
256 * arg. Show regex, up to a maximum length. If it's too long, chop and add
257 * "...".
258 */
a4eb266f 259#define FAIL(msg) \
8615cb43 260 STMT_START { \
a4eb266f 261 char *ellipses = ""; \
7a799e20 262 IV len = RExC_end - RExC_precomp; \
b45f050a 263 \
8615cb43 264 if (!SIZE_ONLY) \
830247a4 265 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
b45f050a
JF
266 \
267 if (len > RegexLengthToShowInErrorMessages) { \
268 /* chop 10 shorter than the max, to ensure meaning of "..." */ \
269 len = RegexLengthToShowInErrorMessages - 10; \
a4eb266f 270 ellipses = "..."; \
b45f050a
JF
271 } \
272 Perl_croak(aTHX_ "%s in regex m/%.*s%s/", \
830247a4 273 msg, (int)len, RExC_precomp, ellipses); \
8615cb43
JF
274 } STMT_END
275
b45f050a
JF
276/*
277 * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
278 * args. Show regex, up to a maximum length. If it's too long, chop and add
279 * "...".
280 */
a4eb266f 281#define FAIL2(pat,msg) \
8615cb43 282 STMT_START { \
a4eb266f 283 char *ellipses = ""; \
7a799e20 284 IV len = RExC_end - RExC_precomp; \
b45f050a 285 \
8615cb43 286 if (!SIZE_ONLY) \
830247a4 287 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
8615cb43 288 \
b45f050a
JF
289 if (len > RegexLengthToShowInErrorMessages) { \
290 /* chop 10 shorter than the max, to ensure meaning of "..." */ \
291 len = RegexLengthToShowInErrorMessages - 10; \
a4eb266f 292 ellipses = "..."; \
b45f050a
JF
293 } \
294 S_re_croak2(aTHX_ pat, " in regex m/%.*s%s/", \
830247a4 295 msg, (int)len, RExC_precomp, ellipses); \
b45f050a
JF
296 } STMT_END
297
298
299/*
300 * Simple_vFAIL -- like FAIL, but marks the current location in the scan
301 */
302#define Simple_vFAIL(m) \
303 STMT_START { \
7a799e20 304 IV offset = RExC_parse - RExC_precomp; \
b45f050a
JF
305 \
306 Perl_croak(aTHX_ "%s" REPORT_LOCATION, \
830247a4 307 m, (int)offset, RExC_precomp, RExC_precomp + offset); \
b45f050a
JF
308 } STMT_END
309
310/*
311 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
312 */
313#define vFAIL(m) \
314 STMT_START { \
315 if (!SIZE_ONLY) \
830247a4 316 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
b45f050a
JF
317 Simple_vFAIL(m); \
318 } STMT_END
319
320/*
321 * Like Simple_vFAIL(), but accepts two arguments.
322 */
323#define Simple_vFAIL2(m,a1) \
324 STMT_START { \
7a799e20 325 IV offset = RExC_parse - RExC_precomp; \
b45f050a
JF
326 \
327 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, \
830247a4 328 (int)offset, RExC_precomp, RExC_precomp + offset); \
b45f050a
JF
329 } STMT_END
330
331/*
332 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
333 */
334#define vFAIL2(m,a1) \
335 STMT_START { \
336 if (!SIZE_ONLY) \
830247a4 337 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
b45f050a
JF
338 Simple_vFAIL2(m, a1); \
339 } STMT_END
340
341
342/*
343 * Like Simple_vFAIL(), but accepts three arguments.
344 */
345#define Simple_vFAIL3(m, a1, a2) \
346 STMT_START { \
7a799e20 347 IV offset = RExC_parse - RExC_precomp; \
b45f050a
JF
348 \
349 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, \
830247a4 350 (int)offset, RExC_precomp, RExC_precomp + offset); \
b45f050a
JF
351 } STMT_END
352
353/*
354 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
355 */
356#define vFAIL3(m,a1,a2) \
357 STMT_START { \
358 if (!SIZE_ONLY) \
830247a4 359 SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \
b45f050a
JF
360 Simple_vFAIL3(m, a1, a2); \
361 } STMT_END
362
363/*
364 * Like Simple_vFAIL(), but accepts four arguments.
365 */
366#define Simple_vFAIL4(m, a1, a2, a3) \
367 STMT_START { \
7a799e20 368 IV offset = RExC_parse - RExC_precomp; \
b45f050a
JF
369 \
370 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3,\
830247a4 371 (int)offset, RExC_precomp, RExC_precomp + offset); \
b45f050a
JF
372 } STMT_END
373
374/*
375 * Like Simple_vFAIL(), but accepts five arguments.
376 */
377#define Simple_vFAIL5(m, a1, a2, a3, a4) \
378 STMT_START { \
7a799e20 379 IV offset = RExC_parse - RExC_precomp; \
b45f050a 380 S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3, a4,\
830247a4 381 (int)offset, RExC_precomp, RExC_precomp + offset); \
b45f050a
JF
382 } STMT_END
383
384
385#define vWARN(loc,m) \
386 STMT_START { \
7a799e20 387 IV offset = loc - RExC_precomp; \
b45f050a 388 Perl_warner(aTHX_ WARN_REGEXP, "%s" REPORT_LOCATION,\
830247a4 389 m, (int)offset, RExC_precomp, RExC_precomp + offset); \
b45f050a
JF
390 } STMT_END \
391
f9373011
PM
392#define vWARNdep(loc,m) \
393 STMT_START { \
7a799e20 394 IV offset = loc - RExC_precomp; \
f9373011
PM
395 int warn_cat = ckWARN(WARN_REGEXP) ? WARN_REGEXP : WARN_DEPRECATED; \
396 Perl_warner(aTHX_ warn_cat, "%s" REPORT_LOCATION,\
397 m, (int)offset, RExC_precomp, RExC_precomp + offset); \
398 } STMT_END \
399
b45f050a
JF
400
401#define vWARN2(loc, m, a1) \
402 STMT_START { \
7a799e20 403 IV offset = loc - RExC_precomp; \
b45f050a
JF
404 Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,\
405 a1, \
830247a4 406 (int)offset, RExC_precomp, RExC_precomp + offset); \
b45f050a
JF
407 } STMT_END
408
409#define vWARN3(loc, m, a1, a2) \
410 STMT_START { \
7a799e20 411 IV offset = loc - RExC_precomp; \
b45f050a
JF
412 Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION, \
413 a1, a2, \
830247a4 414 (int)offset, RExC_precomp, RExC_precomp + offset); \
b45f050a
JF
415 } STMT_END
416
417#define vWARN4(loc, m, a1, a2, a3) \
418 STMT_START { \
7a799e20 419 IV offset = loc - RExC_precomp; \
b45f050a
JF
420 Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,\
421 a1, a2, a3, \
830247a4 422 (int)offset, RExC_precomp, RExC_precomp + offset); \
8615cb43
JF
423 } STMT_END
424
9d1d55b5
JP
425/* used for the parse_flags section for (?c) -- japhy */
426#define vWARN5(loc, m, a1, a2, a3, a4) \
427 STMT_START { \
7a799e20 428 IV offset = loc - RExC_precomp; \
9d1d55b5
JP
429 Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION, \
430 a1, a2, a3, a4, \
431 (int)offset, RExC_precomp, RExC_precomp + offset); \
432 } STMT_END
433
8615cb43 434
cd439c50 435/* Allow for side effects in s */
fd3f0ae2 436#define REGC(c,s) STMT_START { if (!SIZE_ONLY) *(s) = (c); else (void)(s);} STMT_END
cd439c50 437
fac92740
MJD
438/* Macros for recording node offsets. 20001227 mjd@plover.com
439 * Nodes are numbered 1, 2, 3, 4. Node #n's position is recorded in
440 * element 2*n-1 of the array. Element #2n holds the byte length node #n.
441 * Element 0 holds the number n.
442 */
443
444#define MJD_OFFSET_DEBUG(x)
445/* #define MJD_OFFSET_DEBUG(x) fprintf x */
446
447
448# define Set_Node_Offset_To_R(node,byte) \
449 STMT_START { \
450 if (! SIZE_ONLY) { \
451 if((node) < 0) { \
452 Perl_croak(aTHX_ "value of node is %d in Offset macro", node); \
453 } else { \
454 RExC_offsets[2*(node)-1] = (byte); \
455 } \
456 } \
457 } STMT_END
458
459# define Set_Node_Offset(node,byte) Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start)
460# define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
461
462# define Set_Node_Length_To_R(node,len) \
463 STMT_START { \
464 if (! SIZE_ONLY) { \
465 MJD_OFFSET_DEBUG((stderr, "** (%d) size of node %d is %d.\n", __LINE__, (node), (len))); \
466 if((node) < 0) { \
467 Perl_croak(aTHX_ "value of node is %d in Length macro", node); \
468 } else { \
469 RExC_offsets[2*(node)] = (len); \
470 } \
471 } \
472 } STMT_END
473
474# define Set_Node_Length(node,len) Set_Node_Length_To_R((node)-RExC_emit_start, len)
475# define Set_Cur_Node_Length(len) Set_Node_Length(RExC_emit, len)
476# define Set_Node_Cur_Length(node) Set_Node_Length(node, RExC_parse - parse_start)
477
478/* Get offsets and lengths */
479#define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
480#define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
481
acfe0abc 482static void clear_re(pTHX_ void *r);
4327152a 483
653099ff
GS
484/* Mark that we cannot extend a found fixed substring at this point.
485 Updata the longest found anchored substring and the longest found
486 floating substrings if needed. */
487
4327152a 488STATIC void
830247a4 489S_scan_commit(pTHX_ RExC_state_t *pRExC_state, scan_data_t *data)
c277df42 490{
a0ed51b3
LW
491 STRLEN l = CHR_SVLEN(data->last_found);
492 STRLEN old_l = CHR_SVLEN(*data->longest);
b81d288d 493
c277df42
IZ
494 if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
495 sv_setsv(*data->longest, data->last_found);
496 if (*data->longest == data->longest_fixed) {
497 data->offset_fixed = l ? data->last_start_min : data->pos_min;
498 if (data->flags & SF_BEFORE_EOL)
b81d288d 499 data->flags
c277df42
IZ
500 |= ((data->flags & SF_BEFORE_EOL) << SF_FIX_SHIFT_EOL);
501 else
502 data->flags &= ~SF_FIX_BEFORE_EOL;
a0ed51b3
LW
503 }
504 else {
c277df42 505 data->offset_float_min = l ? data->last_start_min : data->pos_min;
b81d288d
AB
506 data->offset_float_max = (l
507 ? data->last_start_max
c277df42
IZ
508 : data->pos_min + data->pos_delta);
509 if (data->flags & SF_BEFORE_EOL)
b81d288d 510 data->flags
c277df42
IZ
511 |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
512 else
513 data->flags &= ~SF_FL_BEFORE_EOL;
514 }
515 }
516 SvCUR_set(data->last_found, 0);
517 data->last_end = -1;
518 data->flags &= ~SF_BEFORE_EOL;
519}
520
653099ff
GS
521/* Can match anything (initialization) */
522STATIC void
830247a4 523S_cl_anything(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
653099ff 524{
653099ff 525 ANYOF_CLASS_ZERO(cl);
f8bef550 526 ANYOF_BITMAP_SETALL(cl);
1aa99e6b 527 cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL;
653099ff
GS
528 if (LOC)
529 cl->flags |= ANYOF_LOCALE;
530}
531
532/* Can match anything (initialization) */
533STATIC int
534S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl)
535{
536 int value;
537
aaa51d5e 538 for (value = 0; value <= ANYOF_MAX; value += 2)
653099ff
GS
539 if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1))
540 return 1;
1aa99e6b
IH
541 if (!(cl->flags & ANYOF_UNICODE_ALL))
542 return 0;
f8bef550
NC
543 if (!ANYOF_BITMAP_TESTALLSET(cl))
544 return 0;
653099ff
GS
545 return 1;
546}
547
548/* Can match anything (initialization) */
549STATIC void
830247a4 550S_cl_init(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
653099ff 551{
8ecf7187 552 Zero(cl, 1, struct regnode_charclass_class);
653099ff 553 cl->type = ANYOF;
830247a4 554 cl_anything(pRExC_state, cl);
653099ff
GS
555}
556
557STATIC void
830247a4 558S_cl_init_zero(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
653099ff 559{
8ecf7187 560 Zero(cl, 1, struct regnode_charclass_class);
653099ff 561 cl->type = ANYOF;
830247a4 562 cl_anything(pRExC_state, cl);
653099ff
GS
563 if (LOC)
564 cl->flags |= ANYOF_LOCALE;
565}
566
567/* 'And' a given class with another one. Can create false positives */
568/* We assume that cl is not inverted */
569STATIC void
570S_cl_and(pTHX_ struct regnode_charclass_class *cl,
571 struct regnode_charclass_class *and_with)
572{
653099ff
GS
573 if (!(and_with->flags & ANYOF_CLASS)
574 && !(cl->flags & ANYOF_CLASS)
575 && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
576 && !(and_with->flags & ANYOF_FOLD)
577 && !(cl->flags & ANYOF_FOLD)) {
578 int i;
579
580 if (and_with->flags & ANYOF_INVERT)
581 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
582 cl->bitmap[i] &= ~and_with->bitmap[i];
583 else
584 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
585 cl->bitmap[i] &= and_with->bitmap[i];
586 } /* XXXX: logic is complicated otherwise, leave it along for a moment. */
587 if (!(and_with->flags & ANYOF_EOS))
588 cl->flags &= ~ANYOF_EOS;
1aa99e6b
IH
589
590 if (cl->flags & ANYOF_UNICODE_ALL && and_with->flags & ANYOF_UNICODE) {
591 cl->flags &= ~ANYOF_UNICODE_ALL;
592 cl->flags |= ANYOF_UNICODE;
593 ARG_SET(cl, ARG(and_with));
594 }
595 if (!(and_with->flags & ANYOF_UNICODE_ALL))
596 cl->flags &= ~ANYOF_UNICODE_ALL;
597 if (!(and_with->flags & (ANYOF_UNICODE|ANYOF_UNICODE_ALL)))
598 cl->flags &= ~ANYOF_UNICODE;
653099ff
GS
599}
600
601/* 'OR' a given class with another one. Can create false positives */
602/* We assume that cl is not inverted */
603STATIC void
830247a4 604S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, struct regnode_charclass_class *or_with)
653099ff 605{
653099ff
GS
606 if (or_with->flags & ANYOF_INVERT) {
607 /* We do not use
608 * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2))
609 * <= (B1 | !B2) | (CL1 | !CL2)
610 * which is wasteful if CL2 is small, but we ignore CL2:
611 * (B1 | CL1) | (!B2 & !CL2) <= (B1 | CL1) | !B2 = (B1 | !B2) | CL1
612 * XXXX Can we handle case-fold? Unclear:
613 * (OK1(i) | OK1(i')) | !(OK1(i) | OK1(i')) =
614 * (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i'))
615 */
616 if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
617 && !(or_with->flags & ANYOF_FOLD)
618 && !(cl->flags & ANYOF_FOLD) ) {
619 int i;
620
621 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
622 cl->bitmap[i] |= ~or_with->bitmap[i];
623 } /* XXXX: logic is complicated otherwise */
624 else {
830247a4 625 cl_anything(pRExC_state, cl);
653099ff
GS
626 }
627 } else {
628 /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */
629 if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE)
b81d288d 630 && (!(or_with->flags & ANYOF_FOLD)
653099ff
GS
631 || (cl->flags & ANYOF_FOLD)) ) {
632 int i;
633
634 /* OR char bitmap and class bitmap separately */
635 for (i = 0; i < ANYOF_BITMAP_SIZE; i++)
636 cl->bitmap[i] |= or_with->bitmap[i];
637 if (or_with->flags & ANYOF_CLASS) {
638 for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++)
639 cl->classflags[i] |= or_with->classflags[i];
640 cl->flags |= ANYOF_CLASS;
641 }
642 }
643 else { /* XXXX: logic is complicated, leave it along for a moment. */
830247a4 644 cl_anything(pRExC_state, cl);
653099ff
GS
645 }
646 }
647 if (or_with->flags & ANYOF_EOS)
648 cl->flags |= ANYOF_EOS;
1aa99e6b
IH
649
650 if (cl->flags & ANYOF_UNICODE && or_with->flags & ANYOF_UNICODE &&
651 ARG(cl) != ARG(or_with)) {
652 cl->flags |= ANYOF_UNICODE_ALL;
653 cl->flags &= ~ANYOF_UNICODE;
654 }
655 if (or_with->flags & ANYOF_UNICODE_ALL) {
656 cl->flags |= ANYOF_UNICODE_ALL;
657 cl->flags &= ~ANYOF_UNICODE;
658 }
653099ff
GS
659}
660
661/* REx optimizer. Converts nodes into quickier variants "in place".
662 Finds fixed substrings. */
663
c277df42
IZ
664/* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set
665 to the position after last scanned or to NULL. */
666
76e3520e 667STATIC I32
830247a4 668S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags)
c277df42
IZ
669 /* scanp: Start here (read-write). */
670 /* deltap: Write maxlen-minlen here. */
671 /* last: Stop before this one. */
672{
673 I32 min = 0, pars = 0, code;
674 regnode *scan = *scanp, *next;
675 I32 delta = 0;
676 int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
aca2d497 677 int is_inf_internal = 0; /* The studied chunk is infinite */
c277df42
IZ
678 I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
679 scan_data_t data_fake;
653099ff 680 struct regnode_charclass_class and_with; /* Valid if flags & SCF_DO_STCLASS_OR */
b81d288d 681
c277df42
IZ
682 while (scan && OP(scan) != END && scan < last) {
683 /* Peephole optimizer: */
684
22c35a8c 685 if (PL_regkind[(U8)OP(scan)] == EXACT) {
653099ff 686 /* Merge several consecutive EXACTish nodes into one. */
c277df42
IZ
687 regnode *n = regnext(scan);
688 U32 stringok = 1;
689#ifdef DEBUGGING
690 regnode *stop = scan;
b81d288d 691#endif
c277df42 692
cd439c50 693 next = scan + NODE_SZ_STR(scan);
c277df42
IZ
694 /* Skip NOTHING, merge EXACT*. */
695 while (n &&
b81d288d 696 ( PL_regkind[(U8)OP(n)] == NOTHING ||
c277df42
IZ
697 (stringok && (OP(n) == OP(scan))))
698 && NEXT_OFF(n)
699 && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
700 if (OP(n) == TAIL || n > next)
701 stringok = 0;
22c35a8c 702 if (PL_regkind[(U8)OP(n)] == NOTHING) {
c277df42
IZ
703 NEXT_OFF(scan) += NEXT_OFF(n);
704 next = n + NODE_STEP_REGNODE;
705#ifdef DEBUGGING
706 if (stringok)
707 stop = n;
b81d288d 708#endif
c277df42 709 n = regnext(n);
a0ed51b3 710 }
f49d4d0f 711 else if (stringok) {
cd439c50 712 int oldl = STR_LEN(scan);
c277df42 713 regnode *nnext = regnext(n);
f49d4d0f 714
b81d288d 715 if (oldl + STR_LEN(n) > U8_MAX)
c277df42
IZ
716 break;
717 NEXT_OFF(scan) += NEXT_OFF(n);
cd439c50
IZ
718 STR_LEN(scan) += STR_LEN(n);
719 next = n + NODE_SZ_STR(n);
c277df42 720 /* Now we can overwrite *n : */
f49d4d0f 721 Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
c277df42 722#ifdef DEBUGGING
f49d4d0f 723 stop = next - 1;
b81d288d 724#endif
c277df42
IZ
725 n = nnext;
726 }
727 }
728#ifdef DEBUGGING
729 /* Allow dumping */
cd439c50 730 n = scan + NODE_SZ_STR(scan);
c277df42 731 while (n <= stop) {
22c35a8c 732 if (PL_regkind[(U8)OP(n)] != NOTHING || OP(n) == NOTHING) {
c277df42
IZ
733 OP(n) = OPTIMIZED;
734 NEXT_OFF(n) = 0;
735 }
736 n++;
737 }
653099ff 738#endif
c277df42 739 }
653099ff
GS
740 /* Follow the next-chain of the current node and optimize
741 away all the NOTHINGs from it. */
c277df42 742 if (OP(scan) != CURLYX) {
048cfca1
GS
743 int max = (reg_off_by_arg[OP(scan)]
744 ? I32_MAX
745 /* I32 may be smaller than U16 on CRAYs! */
746 : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
c277df42
IZ
747 int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
748 int noff;
749 regnode *n = scan;
b81d288d 750
c277df42
IZ
751 /* Skip NOTHING and LONGJMP. */
752 while ((n = regnext(n))
22c35a8c 753 && ((PL_regkind[(U8)OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
c277df42
IZ
754 || ((OP(n) == LONGJMP) && (noff = ARG(n))))
755 && off + noff < max)
756 off += noff;
757 if (reg_off_by_arg[OP(scan)])
758 ARG(scan) = off;
b81d288d 759 else
c277df42
IZ
760 NEXT_OFF(scan) = off;
761 }
653099ff
GS
762 /* The principal pseudo-switch. Cannot be a switch, since we
763 look into several different things. */
b81d288d 764 if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
c277df42
IZ
765 || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
766 next = regnext(scan);
767 code = OP(scan);
b81d288d
AB
768
769 if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
c277df42 770 I32 max1 = 0, min1 = I32_MAX, num = 0;
653099ff 771 struct regnode_charclass_class accum;
c277df42 772
653099ff 773 if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
830247a4 774 scan_commit(pRExC_state, data); /* Cannot merge strings after this. */
653099ff 775 if (flags & SCF_DO_STCLASS)
830247a4 776 cl_init_zero(pRExC_state, &accum);
c277df42 777 while (OP(scan) == code) {
830247a4 778 I32 deltanext, minnext, f = 0, fake;
653099ff 779 struct regnode_charclass_class this_class;
c277df42
IZ
780
781 num++;
782 data_fake.flags = 0;
b81d288d 783 if (data) {
2c2d71f5 784 data_fake.whilem_c = data->whilem_c;
cb434fcc
IZ
785 data_fake.last_closep = data->last_closep;
786 }
787 else
788 data_fake.last_closep = &fake;
c277df42
IZ
789 next = regnext(scan);
790 scan = NEXTOPER(scan);
791 if (code != BRANCH)
792 scan = NEXTOPER(scan);
653099ff 793 if (flags & SCF_DO_STCLASS) {
830247a4 794 cl_init(pRExC_state, &this_class);
653099ff
GS
795 data_fake.start_class = &this_class;
796 f = SCF_DO_STCLASS_AND;
b81d288d 797 }
e1901655
IZ
798 if (flags & SCF_WHILEM_VISITED_POS)
799 f |= SCF_WHILEM_VISITED_POS;
653099ff 800 /* we suppose the run is continuous, last=next...*/
830247a4
IZ
801 minnext = study_chunk(pRExC_state, &scan, &deltanext,
802 next, &data_fake, f);
b81d288d 803 if (min1 > minnext)
c277df42
IZ
804 min1 = minnext;
805 if (max1 < minnext + deltanext)
806 max1 = minnext + deltanext;
807 if (deltanext == I32_MAX)
aca2d497 808 is_inf = is_inf_internal = 1;
c277df42
IZ
809 scan = next;
810 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
811 pars++;
405ff068 812 if (data && (data_fake.flags & SF_HAS_EVAL))
c277df42 813 data->flags |= SF_HAS_EVAL;
2c2d71f5
JH
814 if (data)
815 data->whilem_c = data_fake.whilem_c;
653099ff 816 if (flags & SCF_DO_STCLASS)
830247a4 817 cl_or(pRExC_state, &accum, &this_class);
b81d288d 818 if (code == SUSPEND)
c277df42
IZ
819 break;
820 }
821 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
822 min1 = 0;
823 if (flags & SCF_DO_SUBSTR) {
824 data->pos_min += min1;
825 data->pos_delta += max1 - min1;
826 if (max1 != min1 || is_inf)
827 data->longest = &(data->longest_float);
828 }
829 min += min1;
830 delta += max1 - min1;
653099ff 831 if (flags & SCF_DO_STCLASS_OR) {
830247a4 832 cl_or(pRExC_state, data->start_class, &accum);
653099ff
GS
833 if (min1) {
834 cl_and(data->start_class, &and_with);
835 flags &= ~SCF_DO_STCLASS;
836 }
837 }
838 else if (flags & SCF_DO_STCLASS_AND) {
de0c8cb8
GS
839 if (min1) {
840 cl_and(data->start_class, &accum);
653099ff 841 flags &= ~SCF_DO_STCLASS;
de0c8cb8
GS
842 }
843 else {
b81d288d 844 /* Switch to OR mode: cache the old value of
de0c8cb8
GS
845 * data->start_class */
846 StructCopy(data->start_class, &and_with,
847 struct regnode_charclass_class);
848 flags &= ~SCF_DO_STCLASS_AND;
849 StructCopy(&accum, data->start_class,
850 struct regnode_charclass_class);
851 flags |= SCF_DO_STCLASS_OR;
852 data->start_class->flags |= ANYOF_EOS;
853 }
653099ff 854 }
a0ed51b3
LW
855 }
856 else if (code == BRANCHJ) /* single branch is optimized. */
c277df42
IZ
857 scan = NEXTOPER(NEXTOPER(scan));
858 else /* single branch is optimized. */
859 scan = NEXTOPER(scan);
860 continue;
a0ed51b3
LW
861 }
862 else if (OP(scan) == EXACT) {
cd439c50 863 I32 l = STR_LEN(scan);
1aa99e6b 864 UV uc = *((U8*)STRING(scan));
a0ed51b3 865 if (UTF) {
1aa99e6b
IH
866 U8 *s = (U8*)STRING(scan);
867 l = utf8_length(s, s + l);
9041c2e3 868 uc = utf8_to_uvchr(s, NULL);
a0ed51b3
LW
869 }
870 min += l;
c277df42 871 if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
c277df42
IZ
872 /* The code below prefers earlier match for fixed
873 offset, later match for variable offset. */
874 if (data->last_end == -1) { /* Update the start info. */
875 data->last_start_min = data->pos_min;
876 data->last_start_max = is_inf
b81d288d 877 ? I32_MAX : data->pos_min + data->pos_delta;
c277df42 878 }
cd439c50 879 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
c277df42
IZ
880 data->last_end = data->pos_min + l;
881 data->pos_min += l; /* As in the first entry. */
882 data->flags &= ~SF_BEFORE_EOL;
883 }
653099ff
GS
884 if (flags & SCF_DO_STCLASS_AND) {
885 /* Check whether it is compatible with what we know already! */
886 int compat = 1;
887
1aa99e6b 888 if (uc >= 0x100 ||
516a5887 889 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
1aa99e6b 890 && !ANYOF_BITMAP_TEST(data->start_class, uc)
653099ff 891 && (!(data->start_class->flags & ANYOF_FOLD)
1aa99e6b 892 || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
516a5887 893 )
653099ff
GS
894 compat = 0;
895 ANYOF_CLASS_ZERO(data->start_class);
896 ANYOF_BITMAP_ZERO(data->start_class);
897 if (compat)
1aa99e6b 898 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff 899 data->start_class->flags &= ~ANYOF_EOS;
9b877dbb
IH
900 if (uc < 0x100)
901 data->start_class->flags &= ~ANYOF_UNICODE_ALL;
653099ff
GS
902 }
903 else if (flags & SCF_DO_STCLASS_OR) {
904 /* false positive possible if the class is case-folded */
1aa99e6b 905 if (uc < 0x100)
9b877dbb
IH
906 ANYOF_BITMAP_SET(data->start_class, uc);
907 else
908 data->start_class->flags |= ANYOF_UNICODE_ALL;
653099ff
GS
909 data->start_class->flags &= ~ANYOF_EOS;
910 cl_and(data->start_class, &and_with);
911 }
912 flags &= ~SCF_DO_STCLASS;
a0ed51b3 913 }
653099ff 914 else if (PL_regkind[(U8)OP(scan)] == EXACT) { /* But OP != EXACT! */
cd439c50 915 I32 l = STR_LEN(scan);
1aa99e6b 916 UV uc = *((U8*)STRING(scan));
653099ff
GS
917
918 /* Search for fixed substrings supports EXACT only. */
b81d288d 919 if (flags & SCF_DO_SUBSTR)
830247a4 920 scan_commit(pRExC_state, data);
a0ed51b3 921 if (UTF) {
1aa99e6b
IH
922 U8 *s = (U8 *)STRING(scan);
923 l = utf8_length(s, s + l);
9041c2e3 924 uc = utf8_to_uvchr(s, NULL);
a0ed51b3
LW
925 }
926 min += l;
c277df42 927 if (data && (flags & SCF_DO_SUBSTR))
a0ed51b3 928 data->pos_min += l;
653099ff
GS
929 if (flags & SCF_DO_STCLASS_AND) {
930 /* Check whether it is compatible with what we know already! */
931 int compat = 1;
932
1aa99e6b 933 if (uc >= 0x100 ||
516a5887 934 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
1aa99e6b 935 && !ANYOF_BITMAP_TEST(data->start_class, uc)
516a5887 936 && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
653099ff
GS
937 compat = 0;
938 ANYOF_CLASS_ZERO(data->start_class);
939 ANYOF_BITMAP_ZERO(data->start_class);
940 if (compat) {
1aa99e6b 941 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff
GS
942 data->start_class->flags &= ~ANYOF_EOS;
943 data->start_class->flags |= ANYOF_FOLD;
944 if (OP(scan) == EXACTFL)
945 data->start_class->flags |= ANYOF_LOCALE;
946 }
947 }
948 else if (flags & SCF_DO_STCLASS_OR) {
949 if (data->start_class->flags & ANYOF_FOLD) {
950 /* false positive possible if the class is case-folded.
951 Assume that the locale settings are the same... */
1aa99e6b
IH
952 if (uc < 0x100)
953 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff
GS
954 data->start_class->flags &= ~ANYOF_EOS;
955 }
956 cl_and(data->start_class, &and_with);
957 }
958 flags &= ~SCF_DO_STCLASS;
a0ed51b3 959 }
4d61ec05 960 else if (strchr((char*)PL_varies,OP(scan))) {
9c5ffd7c 961 I32 mincount, maxcount, minnext, deltanext, fl = 0;
aa7a4b56 962 I32 f = flags, pos_before = 0;
c277df42 963 regnode *oscan = scan;
653099ff
GS
964 struct regnode_charclass_class this_class;
965 struct regnode_charclass_class *oclass = NULL;
727f22e3 966 I32 next_is_eval = 0;
653099ff 967
22c35a8c 968 switch (PL_regkind[(U8)OP(scan)]) {
653099ff 969 case WHILEM: /* End of (?:...)* . */
c277df42
IZ
970 scan = NEXTOPER(scan);
971 goto finish;
972 case PLUS:
653099ff 973 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
c277df42 974 next = NEXTOPER(scan);
653099ff 975 if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
b81d288d
AB
976 mincount = 1;
977 maxcount = REG_INFTY;
c277df42
IZ
978 next = regnext(scan);
979 scan = NEXTOPER(scan);
980 goto do_curly;
981 }
982 }
983 if (flags & SCF_DO_SUBSTR)
984 data->pos_min++;
985 min++;
986 /* Fall through. */
987 case STAR:
653099ff
GS
988 if (flags & SCF_DO_STCLASS) {
989 mincount = 0;
b81d288d 990 maxcount = REG_INFTY;
653099ff
GS
991 next = regnext(scan);
992 scan = NEXTOPER(scan);
993 goto do_curly;
994 }
b81d288d 995 is_inf = is_inf_internal = 1;
c277df42
IZ
996 scan = regnext(scan);
997 if (flags & SCF_DO_SUBSTR) {
830247a4 998 scan_commit(pRExC_state, data); /* Cannot extend fixed substrings */
c277df42
IZ
999 data->longest = &(data->longest_float);
1000 }
1001 goto optimize_curly_tail;
1002 case CURLY:
b81d288d 1003 mincount = ARG1(scan);
c277df42
IZ
1004 maxcount = ARG2(scan);
1005 next = regnext(scan);
cb434fcc
IZ
1006 if (OP(scan) == CURLYX) {
1007 I32 lp = (data ? *(data->last_closep) : 0);
1008
1009 scan->flags = ((lp <= U8_MAX) ? lp : U8_MAX);
1010 }
c277df42 1011 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
727f22e3 1012 next_is_eval = (OP(scan) == EVAL);
c277df42
IZ
1013 do_curly:
1014 if (flags & SCF_DO_SUBSTR) {
830247a4 1015 if (mincount == 0) scan_commit(pRExC_state,data); /* Cannot extend fixed substrings */
c277df42
IZ
1016 pos_before = data->pos_min;
1017 }
1018 if (data) {
1019 fl = data->flags;
1020 data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
1021 if (is_inf)
1022 data->flags |= SF_IS_INF;
1023 }
653099ff 1024 if (flags & SCF_DO_STCLASS) {
830247a4 1025 cl_init(pRExC_state, &this_class);
653099ff
GS
1026 oclass = data->start_class;
1027 data->start_class = &this_class;
1028 f |= SCF_DO_STCLASS_AND;
1029 f &= ~SCF_DO_STCLASS_OR;
1030 }
e1901655
IZ
1031 /* These are the cases when once a subexpression
1032 fails at a particular position, it cannot succeed
1033 even after backtracking at the enclosing scope.
b81d288d 1034
e1901655
IZ
1035 XXXX what if minimal match and we are at the
1036 initial run of {n,m}? */
1037 if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
1038 f &= ~SCF_WHILEM_VISITED_POS;
653099ff 1039
c277df42 1040 /* This will finish on WHILEM, setting scan, or on NULL: */
b81d288d
AB
1041 minnext = study_chunk(pRExC_state, &scan, &deltanext, last, data,
1042 mincount == 0
653099ff
GS
1043 ? (f & ~SCF_DO_SUBSTR) : f);
1044
1045 if (flags & SCF_DO_STCLASS)
1046 data->start_class = oclass;
1047 if (mincount == 0 || minnext == 0) {
1048 if (flags & SCF_DO_STCLASS_OR) {
830247a4 1049 cl_or(pRExC_state, data->start_class, &this_class);
653099ff
GS
1050 }
1051 else if (flags & SCF_DO_STCLASS_AND) {
b81d288d 1052 /* Switch to OR mode: cache the old value of
653099ff
GS
1053 * data->start_class */
1054 StructCopy(data->start_class, &and_with,
1055 struct regnode_charclass_class);
1056 flags &= ~SCF_DO_STCLASS_AND;
1057 StructCopy(&this_class, data->start_class,
1058 struct regnode_charclass_class);
1059 flags |= SCF_DO_STCLASS_OR;
1060 data->start_class->flags |= ANYOF_EOS;
1061 }
1062 } else { /* Non-zero len */
1063 if (flags & SCF_DO_STCLASS_OR) {
830247a4 1064 cl_or(pRExC_state, data->start_class, &this_class);
653099ff
GS
1065 cl_and(data->start_class, &and_with);
1066 }
1067 else if (flags & SCF_DO_STCLASS_AND)
1068 cl_and(data->start_class, &this_class);
1069 flags &= ~SCF_DO_STCLASS;
1070 }
c277df42
IZ
1071 if (!scan) /* It was not CURLYX, but CURLY. */
1072 scan = next;
84037bb0 1073 if (ckWARN(WARN_REGEXP)
727f22e3
JP
1074 /* ? quantifier ok, except for (?{ ... }) */
1075 && (next_is_eval || !(mincount == 0 && maxcount == 1))
84037bb0 1076 && (minnext == 0) && (deltanext == 0)
99799961 1077 && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
17feb5d5 1078 && maxcount <= REG_INFTY/3) /* Complement check for big count */
b45f050a 1079 {
830247a4 1080 vWARN(RExC_parse,
b45f050a
JF
1081 "Quantifier unexpected on zero-length expression");
1082 }
1083
c277df42 1084 min += minnext * mincount;
b81d288d 1085 is_inf_internal |= ((maxcount == REG_INFTY
155aba94
GS
1086 && (minnext + deltanext) > 0)
1087 || deltanext == I32_MAX);
aca2d497 1088 is_inf |= is_inf_internal;
c277df42
IZ
1089 delta += (minnext + deltanext) * maxcount - minnext * mincount;
1090
1091 /* Try powerful optimization CURLYX => CURLYN. */
b81d288d 1092 if ( OP(oscan) == CURLYX && data
c277df42
IZ
1093 && data->flags & SF_IN_PAR
1094 && !(data->flags & SF_HAS_EVAL)
1095 && !deltanext && minnext == 1 ) {
1096 /* Try to optimize to CURLYN. */
1097 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
497b47a8
JH
1098 regnode *nxt1 = nxt;
1099#ifdef DEBUGGING
1100 regnode *nxt2;
1101#endif
c277df42
IZ
1102
1103 /* Skip open. */
1104 nxt = regnext(nxt);
4d61ec05 1105 if (!strchr((char*)PL_simple,OP(nxt))
22c35a8c 1106 && !(PL_regkind[(U8)OP(nxt)] == EXACT
b81d288d 1107 && STR_LEN(nxt) == 1))
c277df42 1108 goto nogo;
497b47a8 1109#ifdef DEBUGGING
c277df42 1110 nxt2 = nxt;
497b47a8 1111#endif
c277df42 1112 nxt = regnext(nxt);
b81d288d 1113 if (OP(nxt) != CLOSE)
c277df42
IZ
1114 goto nogo;
1115 /* Now we know that nxt2 is the only contents: */
1116 oscan->flags = ARG(nxt);
1117 OP(oscan) = CURLYN;
1118 OP(nxt1) = NOTHING; /* was OPEN. */
1119#ifdef DEBUGGING
1120 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
1121 NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
1122 NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
1123 OP(nxt) = OPTIMIZED; /* was CLOSE. */
1124 OP(nxt + 1) = OPTIMIZED; /* was count. */
1125 NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
b81d288d 1126#endif
c277df42 1127 }
c277df42
IZ
1128 nogo:
1129
1130 /* Try optimization CURLYX => CURLYM. */
b81d288d 1131 if ( OP(oscan) == CURLYX && data
c277df42 1132 && !(data->flags & SF_HAS_PAR)
c277df42
IZ
1133 && !(data->flags & SF_HAS_EVAL)
1134 && !deltanext ) {
1135 /* XXXX How to optimize if data == 0? */
1136 /* Optimize to a simpler form. */
1137 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
1138 regnode *nxt2;
1139
1140 OP(oscan) = CURLYM;
1141 while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
b81d288d 1142 && (OP(nxt2) != WHILEM))
c277df42
IZ
1143 nxt = nxt2;
1144 OP(nxt2) = SUCCEED; /* Whas WHILEM */
c277df42
IZ
1145 /* Need to optimize away parenths. */
1146 if (data->flags & SF_IN_PAR) {
1147 /* Set the parenth number. */
1148 regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
1149
b81d288d 1150 if (OP(nxt) != CLOSE)
b45f050a 1151 FAIL("Panic opt close");
c277df42
IZ
1152 oscan->flags = ARG(nxt);
1153 OP(nxt1) = OPTIMIZED; /* was OPEN. */
1154 OP(nxt) = OPTIMIZED; /* was CLOSE. */
1155#ifdef DEBUGGING
1156 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
1157 OP(nxt + 1) = OPTIMIZED; /* was count. */
1158 NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
1159 NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
b81d288d 1160#endif
c277df42
IZ
1161#if 0
1162 while ( nxt1 && (OP(nxt1) != WHILEM)) {
1163 regnode *nnxt = regnext(nxt1);
b81d288d 1164
c277df42
IZ
1165 if (nnxt == nxt) {
1166 if (reg_off_by_arg[OP(nxt1)])
1167 ARG_SET(nxt1, nxt2 - nxt1);
1168 else if (nxt2 - nxt1 < U16_MAX)
1169 NEXT_OFF(nxt1) = nxt2 - nxt1;
1170 else
1171 OP(nxt) = NOTHING; /* Cannot beautify */
1172 }
1173 nxt1 = nnxt;
1174 }
1175#endif
1176 /* Optimize again: */
b81d288d 1177 study_chunk(pRExC_state, &nxt1, &deltanext, nxt,
e1901655 1178 NULL, 0);
a0ed51b3
LW
1179 }
1180 else
c277df42 1181 oscan->flags = 0;
c277df42 1182 }
e1901655
IZ
1183 else if ((OP(oscan) == CURLYX)
1184 && (flags & SCF_WHILEM_VISITED_POS)
1185 /* See the comment on a similar expression above.
1186 However, this time it not a subexpression
1187 we care about, but the expression itself. */
1188 && (maxcount == REG_INFTY)
1189 && data && ++data->whilem_c < 16) {
1190 /* This stays as CURLYX, we can put the count/of pair. */
2c2d71f5
JH
1191 /* Find WHILEM (as in regexec.c) */
1192 regnode *nxt = oscan + NEXT_OFF(oscan);
1193
1194 if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
1195 nxt += ARG(nxt);
1196 PREVOPER(nxt)->flags = data->whilem_c
830247a4 1197 | (RExC_whilem_seen << 4); /* On WHILEM */
2c2d71f5 1198 }
b81d288d 1199 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
c277df42
IZ
1200 pars++;
1201 if (flags & SCF_DO_SUBSTR) {
1202 SV *last_str = Nullsv;
1203 int counted = mincount != 0;
1204
1205 if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
b81d288d 1206 I32 b = pos_before >= data->last_start_min
c277df42
IZ
1207 ? pos_before : data->last_start_min;
1208 STRLEN l;
1209 char *s = SvPV(data->last_found, l);
a0ed51b3
LW
1210 I32 old = b - data->last_start_min;
1211
1212 if (UTF)
1213 old = utf8_hop((U8*)s, old) - (U8*)s;
c277df42 1214
a0ed51b3 1215 l -= old;
c277df42 1216 /* Get the added string: */
79cb57f6 1217 last_str = newSVpvn(s + old, l);
c277df42
IZ
1218 if (deltanext == 0 && pos_before == b) {
1219 /* What was added is a constant string */
1220 if (mincount > 1) {
1221 SvGROW(last_str, (mincount * l) + 1);
b81d288d 1222 repeatcpy(SvPVX(last_str) + l,
c277df42
IZ
1223 SvPVX(last_str), l, mincount - 1);
1224 SvCUR(last_str) *= mincount;
1225 /* Add additional parts. */
b81d288d 1226 SvCUR_set(data->last_found,
c277df42
IZ
1227 SvCUR(data->last_found) - l);
1228 sv_catsv(data->last_found, last_str);
1229 data->last_end += l * (mincount - 1);
1230 }
2a8d9689
HS
1231 } else {
1232 /* start offset must point into the last copy */
1233 data->last_start_min += minnext * (mincount - 1);
4b2cff9a
HS
1234 data->last_start_max += is_inf ? 0 : (maxcount - 1)
1235 * (minnext + data->pos_delta);
c277df42
IZ
1236 }
1237 }
1238 /* It is counted once already... */
1239 data->pos_min += minnext * (mincount - counted);
1240 data->pos_delta += - counted * deltanext +
1241 (minnext + deltanext) * maxcount - minnext * mincount;
1242 if (mincount != maxcount) {
653099ff
GS
1243 /* Cannot extend fixed substrings found inside
1244 the group. */
830247a4 1245 scan_commit(pRExC_state,data);
c277df42
IZ
1246 if (mincount && last_str) {
1247 sv_setsv(data->last_found, last_str);
1248 data->last_end = data->pos_min;
b81d288d 1249 data->last_start_min =
a0ed51b3 1250 data->pos_min - CHR_SVLEN(last_str);
b81d288d
AB
1251 data->last_start_max = is_inf
1252 ? I32_MAX
c277df42 1253 : data->pos_min + data->pos_delta
a0ed51b3 1254 - CHR_SVLEN(last_str);
c277df42
IZ
1255 }
1256 data->longest = &(data->longest_float);
1257 }
aca2d497 1258 SvREFCNT_dec(last_str);
c277df42 1259 }
405ff068 1260 if (data && (fl & SF_HAS_EVAL))
c277df42
IZ
1261 data->flags |= SF_HAS_EVAL;
1262 optimize_curly_tail:
c277df42 1263 if (OP(oscan) != CURLYX) {
22c35a8c 1264 while (PL_regkind[(U8)OP(next = regnext(oscan))] == NOTHING
c277df42
IZ
1265 && NEXT_OFF(next))
1266 NEXT_OFF(oscan) += NEXT_OFF(next);
1267 }
c277df42 1268 continue;
653099ff 1269 default: /* REF and CLUMP only? */
c277df42 1270 if (flags & SCF_DO_SUBSTR) {
830247a4 1271 scan_commit(pRExC_state,data); /* Cannot expect anything... */
c277df42
IZ
1272 data->longest = &(data->longest_float);
1273 }
aca2d497 1274 is_inf = is_inf_internal = 1;
653099ff 1275 if (flags & SCF_DO_STCLASS_OR)
830247a4 1276 cl_anything(pRExC_state, data->start_class);
653099ff 1277 flags &= ~SCF_DO_STCLASS;
c277df42
IZ
1278 break;
1279 }
a0ed51b3 1280 }
ffc61ed2 1281 else if (strchr((char*)PL_simple,OP(scan))) {
9c5ffd7c 1282 int value = 0;
653099ff 1283
c277df42 1284 if (flags & SCF_DO_SUBSTR) {
830247a4 1285 scan_commit(pRExC_state,data);
c277df42
IZ
1286 data->pos_min++;
1287 }
1288 min++;
653099ff
GS
1289 if (flags & SCF_DO_STCLASS) {
1290 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
1291
1292 /* Some of the logic below assumes that switching
1293 locale on will only add false positives. */
1294 switch (PL_regkind[(U8)OP(scan)]) {
653099ff 1295 case SANY:
653099ff
GS
1296 default:
1297 do_default:
1298 /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
1299 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
830247a4 1300 cl_anything(pRExC_state, data->start_class);
653099ff
GS
1301 break;
1302 case REG_ANY:
1303 if (OP(scan) == SANY)
1304 goto do_default;
1305 if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
1306 value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
1307 || (data->start_class->flags & ANYOF_CLASS));
830247a4 1308 cl_anything(pRExC_state, data->start_class);
653099ff
GS
1309 }
1310 if (flags & SCF_DO_STCLASS_AND || !value)
1311 ANYOF_BITMAP_CLEAR(data->start_class,'\n');
1312 break;
1313 case ANYOF:
1314 if (flags & SCF_DO_STCLASS_AND)
1315 cl_and(data->start_class,
1316 (struct regnode_charclass_class*)scan);
1317 else
830247a4 1318 cl_or(pRExC_state, data->start_class,
653099ff
GS
1319 (struct regnode_charclass_class*)scan);
1320 break;
1321 case ALNUM:
1322 if (flags & SCF_DO_STCLASS_AND) {
1323 if (!(data->start_class->flags & ANYOF_LOCALE)) {
1324 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
1325 for (value = 0; value < 256; value++)
1326 if (!isALNUM(value))
1327 ANYOF_BITMAP_CLEAR(data->start_class, value);
1328 }
1329 }
1330 else {
1331 if (data->start_class->flags & ANYOF_LOCALE)
1332 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
1333 else {
1334 for (value = 0; value < 256; value++)
1335 if (isALNUM(value))
b81d288d 1336 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
1337 }
1338 }
1339 break;
1340 case ALNUML:
1341 if (flags & SCF_DO_STCLASS_AND) {
1342 if (data->start_class->flags & ANYOF_LOCALE)
1343 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
1344 }
1345 else {
1346 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
1347 data->start_class->flags |= ANYOF_LOCALE;
1348 }
1349 break;
1350 case NALNUM:
1351 if (flags & SCF_DO_STCLASS_AND) {
1352 if (!(data->start_class->flags & ANYOF_LOCALE)) {
1353 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
1354 for (value = 0; value < 256; value++)
1355 if (isALNUM(value))
1356 ANYOF_BITMAP_CLEAR(data->start_class, value);
1357 }
1358 }
1359 else {
1360 if (data->start_class->flags & ANYOF_LOCALE)
1361 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
1362 else {
1363 for (value = 0; value < 256; value++)
1364 if (!isALNUM(value))
b81d288d 1365 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
1366 }
1367 }
1368 break;
1369 case NALNUML:
1370 if (flags & SCF_DO_STCLASS_AND) {
1371 if (data->start_class->flags & ANYOF_LOCALE)
1372 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
1373 }
1374 else {
1375 data->start_class->flags |= ANYOF_LOCALE;
1376 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
1377 }
1378 break;
1379 case SPACE:
1380 if (flags & SCF_DO_STCLASS_AND) {
1381 if (!(data->start_class->flags & ANYOF_LOCALE)) {
1382 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
1383 for (value = 0; value < 256; value++)
1384 if (!isSPACE(value))
1385 ANYOF_BITMAP_CLEAR(data->start_class, value);
1386 }
1387 }
1388 else {
1389 if (data->start_class->flags & ANYOF_LOCALE)
1390 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
1391 else {
1392 for (value = 0; value < 256; value++)
1393 if (isSPACE(value))
b81d288d 1394 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
1395 }
1396 }
1397 break;
1398 case SPACEL:
1399 if (flags & SCF_DO_STCLASS_AND) {
1400 if (data->start_class->flags & ANYOF_LOCALE)
1401 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
1402 }
1403 else {
1404 data->start_class->flags |= ANYOF_LOCALE;
1405 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
1406 }
1407 break;
1408 case NSPACE:
1409 if (flags & SCF_DO_STCLASS_AND) {
1410 if (!(data->start_class->flags & ANYOF_LOCALE)) {
1411 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
1412 for (value = 0; value < 256; value++)
1413 if (isSPACE(value))
1414 ANYOF_BITMAP_CLEAR(data->start_class, value);
1415 }
1416 }
1417 else {
1418 if (data->start_class->flags & ANYOF_LOCALE)
1419 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
1420 else {
1421 for (value = 0; value < 256; value++)
1422 if (!isSPACE(value))
b81d288d 1423 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
1424 }
1425 }
1426 break;
1427 case NSPACEL:
1428 if (flags & SCF_DO_STCLASS_AND) {
1429 if (data->start_class->flags & ANYOF_LOCALE) {
1430 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
1431 for (value = 0; value < 256; value++)
1432 if (!isSPACE(value))
1433 ANYOF_BITMAP_CLEAR(data->start_class, value);
1434 }
1435 }
1436 else {
1437 data->start_class->flags |= ANYOF_LOCALE;
1438 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
1439 }
1440 break;
1441 case DIGIT:
1442 if (flags & SCF_DO_STCLASS_AND) {
1443 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
1444 for (value = 0; value < 256; value++)
1445 if (!isDIGIT(value))
1446 ANYOF_BITMAP_CLEAR(data->start_class, value);
1447 }
1448 else {
1449 if (data->start_class->flags & ANYOF_LOCALE)
1450 ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
1451 else {
1452 for (value = 0; value < 256; value++)
1453 if (isDIGIT(value))
b81d288d 1454 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
1455 }
1456 }
1457 break;
1458 case NDIGIT:
1459 if (flags & SCF_DO_STCLASS_AND) {
1460 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
1461 for (value = 0; value < 256; value++)
1462 if (isDIGIT(value))
1463 ANYOF_BITMAP_CLEAR(data->start_class, value);
1464 }
1465 else {
1466 if (data->start_class->flags & ANYOF_LOCALE)
1467 ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
1468 else {
1469 for (value = 0; value < 256; value++)
1470 if (!isDIGIT(value))
b81d288d 1471 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS
1472 }
1473 }
1474 break;
1475 }
1476 if (flags & SCF_DO_STCLASS_OR)
1477 cl_and(data->start_class, &and_with);
1478 flags &= ~SCF_DO_STCLASS;
1479 }
a0ed51b3 1480 }
22c35a8c 1481 else if (PL_regkind[(U8)OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
c277df42
IZ
1482 data->flags |= (OP(scan) == MEOL
1483 ? SF_BEFORE_MEOL
1484 : SF_BEFORE_SEOL);
a0ed51b3 1485 }
653099ff
GS
1486 else if ( PL_regkind[(U8)OP(scan)] == BRANCHJ
1487 /* Lookbehind, or need to calculate parens/evals/stclass: */
1488 && (scan->flags || data || (flags & SCF_DO_STCLASS))
c277df42 1489 && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
653099ff 1490 /* Lookahead/lookbehind */
cb434fcc 1491 I32 deltanext, minnext, fake = 0;
c277df42 1492 regnode *nscan;
653099ff
GS
1493 struct regnode_charclass_class intrnl;
1494 int f = 0;
c277df42
IZ
1495
1496 data_fake.flags = 0;
b81d288d 1497 if (data) {
2c2d71f5 1498 data_fake.whilem_c = data->whilem_c;
cb434fcc
IZ
1499 data_fake.last_closep = data->last_closep;
1500 }
1501 else
1502 data_fake.last_closep = &fake;
653099ff
GS
1503 if ( flags & SCF_DO_STCLASS && !scan->flags
1504 && OP(scan) == IFMATCH ) { /* Lookahead */
830247a4 1505 cl_init(pRExC_state, &intrnl);
653099ff 1506 data_fake.start_class = &intrnl;
e1901655 1507 f |= SCF_DO_STCLASS_AND;
653099ff 1508 }
e1901655
IZ
1509 if (flags & SCF_WHILEM_VISITED_POS)
1510 f |= SCF_WHILEM_VISITED_POS;
c277df42
IZ
1511 next = regnext(scan);
1512 nscan = NEXTOPER(NEXTOPER(scan));
830247a4 1513 minnext = study_chunk(pRExC_state, &nscan, &deltanext, last, &data_fake, f);
c277df42
IZ
1514 if (scan->flags) {
1515 if (deltanext) {
9baa0206 1516 vFAIL("Variable length lookbehind not implemented");
a0ed51b3
LW
1517 }
1518 else if (minnext > U8_MAX) {
9baa0206 1519 vFAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
c277df42
IZ
1520 }
1521 scan->flags = minnext;
1522 }
1523 if (data && data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
1524 pars++;
405ff068 1525 if (data && (data_fake.flags & SF_HAS_EVAL))
c277df42 1526 data->flags |= SF_HAS_EVAL;
2c2d71f5
JH
1527 if (data)
1528 data->whilem_c = data_fake.whilem_c;
e1901655 1529 if (f & SCF_DO_STCLASS_AND) {
653099ff
GS
1530 int was = (data->start_class->flags & ANYOF_EOS);
1531
1532 cl_and(data->start_class, &intrnl);
1533 if (was)
1534 data->start_class->flags |= ANYOF_EOS;
1535 }
a0ed51b3
LW
1536 }
1537 else if (OP(scan) == OPEN) {
c277df42 1538 pars++;
a0ed51b3 1539 }
cb434fcc
IZ
1540 else if (OP(scan) == CLOSE) {
1541 if (ARG(scan) == is_par) {
1542 next = regnext(scan);
c277df42 1543
cb434fcc
IZ
1544 if ( next && (OP(next) != WHILEM) && next < last)
1545 is_par = 0; /* Disable optimization */
1546 }
1547 if (data)
1548 *(data->last_closep) = ARG(scan);
a0ed51b3
LW
1549 }
1550 else if (OP(scan) == EVAL) {
c277df42
IZ
1551 if (data)
1552 data->flags |= SF_HAS_EVAL;
1553 }
96776eda 1554 else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded follows */
0f5d15d6 1555 if (flags & SCF_DO_SUBSTR) {
830247a4 1556 scan_commit(pRExC_state,data);
0f5d15d6
IZ
1557 data->longest = &(data->longest_float);
1558 }
1559 is_inf = is_inf_internal = 1;
653099ff 1560 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
830247a4 1561 cl_anything(pRExC_state, data->start_class);
96776eda 1562 flags &= ~SCF_DO_STCLASS;
0f5d15d6 1563 }
c277df42
IZ
1564 /* Else: zero-length, ignore. */
1565 scan = regnext(scan);
1566 }
1567
1568 finish:
1569 *scanp = scan;
aca2d497 1570 *deltap = is_inf_internal ? I32_MAX : delta;
b81d288d 1571 if (flags & SCF_DO_SUBSTR && is_inf)
c277df42
IZ
1572 data->pos_delta = I32_MAX - data->pos_min;
1573 if (is_par > U8_MAX)
1574 is_par = 0;
1575 if (is_par && pars==1 && data) {
1576 data->flags |= SF_IN_PAR;
1577 data->flags &= ~SF_HAS_PAR;
a0ed51b3
LW
1578 }
1579 else if (pars && data) {
c277df42
IZ
1580 data->flags |= SF_HAS_PAR;
1581 data->flags &= ~SF_IN_PAR;
1582 }
653099ff
GS
1583 if (flags & SCF_DO_STCLASS_OR)
1584 cl_and(data->start_class, &and_with);
c277df42
IZ
1585 return min;
1586}
1587
76e3520e 1588STATIC I32
830247a4 1589S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, char *s)
c277df42 1590{
830247a4 1591 if (RExC_rx->data) {
b81d288d
AB
1592 Renewc(RExC_rx->data,
1593 sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count + n - 1),
c277df42 1594 char, struct reg_data);
830247a4
IZ
1595 Renew(RExC_rx->data->what, RExC_rx->data->count + n, U8);
1596 RExC_rx->data->count += n;
a0ed51b3
LW
1597 }
1598 else {
830247a4 1599 Newc(1207, RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1),
c277df42 1600 char, struct reg_data);
830247a4
IZ
1601 New(1208, RExC_rx->data->what, n, U8);
1602 RExC_rx->data->count = n;
c277df42 1603 }
830247a4
IZ
1604 Copy(s, RExC_rx->data->what + RExC_rx->data->count - n, n, U8);
1605 return RExC_rx->data->count - n;
c277df42
IZ
1606}
1607
d88dccdf 1608void
864dbfa3 1609Perl_reginitcolors(pTHX)
d88dccdf 1610{
d88dccdf
IZ
1611 int i = 0;
1612 char *s = PerlEnv_getenv("PERL_RE_COLORS");
b81d288d 1613
d88dccdf
IZ
1614 if (s) {
1615 PL_colors[0] = s = savepv(s);
1616 while (++i < 6) {
1617 s = strchr(s, '\t');
1618 if (s) {
1619 *s = '\0';
1620 PL_colors[i] = ++s;
1621 }
1622 else
c712d376 1623 PL_colors[i] = s = "";
d88dccdf
IZ
1624 }
1625 } else {
b81d288d 1626 while (i < 6)
d88dccdf
IZ
1627 PL_colors[i++] = "";
1628 }
1629 PL_colorset = 1;
1630}
1631
8615cb43 1632
a687059c 1633/*
e50aee73 1634 - pregcomp - compile a regular expression into internal code
a687059c
LW
1635 *
1636 * We can't allocate space until we know how big the compiled form will be,
1637 * but we can't compile it (and thus know how big it is) until we've got a
1638 * place to put the code. So we cheat: we compile it twice, once with code
1639 * generation turned off and size counting turned on, and once "for real".
1640 * This also means that we don't allocate space until we are sure that the
1641 * thing really will compile successfully, and we never have to move the
1642 * code and thus invalidate pointers into it. (Note that it has to be in
1643 * one piece because free() must be able to free it all.) [NB: not true in perl]
1644 *
1645 * Beware that the optimization-preparation code in here knows about some
1646 * of the structure of the compiled regexp. [I'll say.]
1647 */
1648regexp *
864dbfa3 1649Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
a687059c 1650{
a0d0e21e 1651 register regexp *r;
c277df42 1652 regnode *scan;
c277df42 1653 regnode *first;
a0d0e21e 1654 I32 flags;
a0d0e21e
LW
1655 I32 minlen = 0;
1656 I32 sawplus = 0;
1657 I32 sawopen = 0;
2c2d71f5 1658 scan_data_t data;
830247a4
IZ
1659 RExC_state_t RExC_state;
1660 RExC_state_t *pRExC_state = &RExC_state;
a0d0e21e
LW
1661
1662 if (exp == NULL)
c277df42 1663 FAIL("NULL regexp argument");
a0d0e21e 1664
84e09d5e
JH
1665 /* XXXX This looks very suspicious... */
1666 if (pm->op_pmdynflags & PMdf_CMP_UTF8)
1667 RExC_utf8 = 1;
1668 else
1669 RExC_utf8 = 0;
a0ed51b3 1670
5cfc7842 1671 RExC_precomp = exp;
35ef4773 1672 DEBUG_r(if (!PL_colorset) reginitcolors());
2c2d71f5 1673 DEBUG_r(PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n",
d88dccdf 1674 PL_colors[4],PL_colors[5],PL_colors[0],
830247a4
IZ
1675 (int)(xend - exp), RExC_precomp, PL_colors[1]));
1676 RExC_flags16 = pm->op_pmflags;
1677 RExC_sawback = 0;
bbce6d69 1678
830247a4
IZ
1679 RExC_seen = 0;
1680 RExC_seen_zerolen = *exp == '^' ? -1 : 0;
1681 RExC_seen_evals = 0;
1682 RExC_extralen = 0;
c277df42 1683
bbce6d69 1684 /* First pass: determine size, legality. */
830247a4 1685 RExC_parse = exp;
fac92740 1686 RExC_start = exp;
830247a4
IZ
1687 RExC_end = xend;
1688 RExC_naughty = 0;
1689 RExC_npar = 1;
1690 RExC_size = 0L;
1691 RExC_emit = &PL_regdummy;
1692 RExC_whilem_seen = 0;
85ddcde9
JH
1693#if 0 /* REGC() is (currently) a NOP at the first pass.
1694 * Clever compilers notice this and complain. --jhi */
830247a4 1695 REGC((U8)REG_MAGIC, (char*)RExC_emit);
85ddcde9 1696#endif
830247a4 1697 if (reg(pRExC_state, 0, &flags) == NULL) {
830247a4 1698 RExC_precomp = Nullch;
a0d0e21e
LW
1699 return(NULL);
1700 }
830247a4 1701 DEBUG_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)RExC_size));
c277df42 1702
c277df42
IZ
1703 /* Small enough for pointer-storage convention?
1704 If extralen==0, this means that we will not need long jumps. */
830247a4
IZ
1705 if (RExC_size >= 0x10000L && RExC_extralen)
1706 RExC_size += RExC_extralen;
c277df42 1707 else
830247a4
IZ
1708 RExC_extralen = 0;
1709 if (RExC_whilem_seen > 15)
1710 RExC_whilem_seen = 15;
a0d0e21e 1711
bbce6d69 1712 /* Allocate space and initialize. */
830247a4 1713 Newc(1001, r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode),
c277df42 1714 char, regexp);
a0d0e21e 1715 if (r == NULL)
b45f050a
JF
1716 FAIL("Regexp out of space");
1717
0f79a09d
GS
1718#ifdef DEBUGGING
1719 /* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
830247a4 1720 Zero(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode), char);
0f79a09d 1721#endif
c277df42 1722 r->refcnt = 1;
bbce6d69 1723 r->prelen = xend - exp;
5cfc7842 1724 r->precomp = savepvn(RExC_precomp, r->prelen);
cf93c79d
IZ
1725 r->subbeg = NULL;
1726 r->reganch = pm->op_pmflags & PMf_COMPILETIME;
830247a4 1727 r->nparens = RExC_npar - 1; /* set early to validate backrefs */
4327152a
IZ
1728
1729 r->substrs = 0; /* Useful during FAIL. */
1730 r->startp = 0; /* Useful during FAIL. */
1731 r->endp = 0; /* Useful during FAIL. */
1732
fac92740
MJD
1733 Newz(1304, r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
1734 if (r->offsets) {
1735 r->offsets[0] = RExC_size;
1736 }
1737 DEBUG_r(PerlIO_printf(Perl_debug_log,
392fbf5d 1738 "%s %"UVuf" bytes for offset annotations.\n",
fac92740 1739 r->offsets ? "Got" : "Couldn't get",
392fbf5d 1740 (UV)((2*RExC_size+1) * sizeof(U32))));
fac92740 1741
830247a4 1742 RExC_rx = r;
bbce6d69 1743
1744 /* Second pass: emit code. */
055bb491 1745 RExC_flags16 = pm->op_pmflags; /* don't let top level (?i) bleed */
830247a4
IZ
1746 RExC_parse = exp;
1747 RExC_end = xend;
1748 RExC_naughty = 0;
1749 RExC_npar = 1;
fac92740 1750 RExC_emit_start = r->program;
830247a4 1751 RExC_emit = r->program;
2cd61cdb 1752 /* Store the count of eval-groups for security checks: */
830247a4
IZ
1753 RExC_emit->next_off = ((RExC_seen_evals > U16_MAX) ? U16_MAX : RExC_seen_evals);
1754 REGC((U8)REG_MAGIC, (char*) RExC_emit++);
c277df42 1755 r->data = 0;
830247a4 1756 if (reg(pRExC_state, 0, &flags) == NULL)
a0d0e21e
LW
1757 return(NULL);
1758
1759 /* Dig out information for optimizations. */
cf93c79d 1760 r->reganch = pm->op_pmflags & PMf_COMPILETIME; /* Again? */
830247a4 1761 pm->op_pmflags = RExC_flags16;
a0ed51b3 1762 if (UTF)
5ff6fc6d 1763 r->reganch |= ROPT_UTF8; /* Unicode in it? */
c277df42 1764 r->regstclass = NULL;
830247a4 1765 if (RExC_naughty >= 10) /* Probably an expensive pattern. */
a0ed51b3 1766 r->reganch |= ROPT_NAUGHTY;
c277df42 1767 scan = r->program + 1; /* First BRANCH. */
2779dcf1
IZ
1768
1769 /* XXXX To minimize changes to RE engine we always allocate
1770 3-units-long substrs field. */
1771 Newz(1004, r->substrs, 1, struct reg_substr_data);
1772
2c2d71f5 1773 StructCopy(&zero_scan_data, &data, scan_data_t);
653099ff 1774 /* XXXX Should not we check for something else? Usually it is OPEN1... */
c277df42 1775 if (OP(scan) != BRANCH) { /* Only one top-level choice. */
c277df42 1776 I32 fake;
c5254dd6 1777 STRLEN longest_float_length, longest_fixed_length;
653099ff
GS
1778 struct regnode_charclass_class ch_class;
1779 int stclass_flag;
cb434fcc 1780 I32 last_close = 0;
a0d0e21e
LW
1781
1782 first = scan;
c277df42 1783 /* Skip introductions and multiplicators >= 1. */
a0d0e21e 1784 while ((OP(first) == OPEN && (sawopen = 1)) ||
653099ff 1785 /* An OR of *one* alternative - should not happen now. */
a0d0e21e
LW
1786 (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
1787 (OP(first) == PLUS) ||
1788 (OP(first) == MINMOD) ||
653099ff 1789 /* An {n,m} with n>0 */
22c35a8c 1790 (PL_regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
a0d0e21e
LW
1791 if (OP(first) == PLUS)
1792 sawplus = 1;
1793 else
1794 first += regarglen[(U8)OP(first)];
1795 first = NEXTOPER(first);
a687059c
LW
1796 }
1797
a0d0e21e
LW
1798 /* Starting-point info. */
1799 again:
653099ff 1800 if (PL_regkind[(U8)OP(first)] == EXACT) {
1aa99e6b
IH
1801 if (OP(first) == EXACT)
1802 ; /* Empty, get anchored substr later. */
1803 else if ((OP(first) == EXACTF || OP(first) == EXACTFL))
b3c9acc1
IZ
1804 r->regstclass = first;
1805 }
653099ff 1806 else if (strchr((char*)PL_simple,OP(first)))
a0d0e21e 1807 r->regstclass = first;
22c35a8c
GS
1808 else if (PL_regkind[(U8)OP(first)] == BOUND ||
1809 PL_regkind[(U8)OP(first)] == NBOUND)
a0d0e21e 1810 r->regstclass = first;
22c35a8c 1811 else if (PL_regkind[(U8)OP(first)] == BOL) {
cad2e5aa
JH
1812 r->reganch |= (OP(first) == MBOL
1813 ? ROPT_ANCH_MBOL
1814 : (OP(first) == SBOL
1815 ? ROPT_ANCH_SBOL
1816 : ROPT_ANCH_BOL));
a0d0e21e 1817 first = NEXTOPER(first);
774d564b 1818 goto again;
1819 }
1820 else if (OP(first) == GPOS) {
1821 r->reganch |= ROPT_ANCH_GPOS;
1822 first = NEXTOPER(first);
1823 goto again;
a0d0e21e
LW
1824 }
1825 else if ((OP(first) == STAR &&
22c35a8c 1826 PL_regkind[(U8)OP(NEXTOPER(first))] == REG_ANY) &&
a0d0e21e
LW
1827 !(r->reganch & ROPT_ANCH) )
1828 {
1829 /* turn .* into ^.* with an implied $*=1 */
cad2e5aa
JH
1830 int type = OP(NEXTOPER(first));
1831
ffc61ed2 1832 if (type == REG_ANY)
cad2e5aa
JH
1833 type = ROPT_ANCH_MBOL;
1834 else
1835 type = ROPT_ANCH_SBOL;
1836
1837 r->reganch |= type | ROPT_IMPLICIT;
a0d0e21e 1838 first = NEXTOPER(first);
774d564b 1839 goto again;
a0d0e21e 1840 }
b81d288d 1841 if (sawplus && (!sawopen || !RExC_sawback)
830247a4 1842 && !(RExC_seen & REG_SEEN_EVAL)) /* May examine pos and $& */
cad2e5aa
JH
1843 /* x+ must match at the 1st pos of run of x's */
1844 r->reganch |= ROPT_SKIP;
a0d0e21e 1845
c277df42 1846 /* Scan is after the zeroth branch, first is atomic matcher. */
b81d288d 1847 DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
b900a521 1848 (IV)(first - scan + 1)));
a0d0e21e
LW
1849 /*
1850 * If there's something expensive in the r.e., find the
1851 * longest literal string that must appear and make it the
1852 * regmust. Resolve ties in favor of later strings, since
1853 * the regstart check works with the beginning of the r.e.
1854 * and avoiding duplication strengthens checking. Not a
1855 * strong reason, but sufficient in the absence of others.
1856 * [Now we resolve ties in favor of the earlier string if
c277df42 1857 * it happens that c_offset_min has been invalidated, since the
a0d0e21e
LW
1858 * earlier string may buy us something the later one won't.]
1859 */
a0d0e21e 1860 minlen = 0;
a687059c 1861
79cb57f6
GS
1862 data.longest_fixed = newSVpvn("",0);
1863 data.longest_float = newSVpvn("",0);
1864 data.last_found = newSVpvn("",0);
c277df42
IZ
1865 data.longest = &(data.longest_fixed);
1866 first = scan;
653099ff 1867 if (!r->regstclass) {
830247a4 1868 cl_init(pRExC_state, &ch_class);
653099ff
GS
1869 data.start_class = &ch_class;
1870 stclass_flag = SCF_DO_STCLASS_AND;
1871 } else /* XXXX Check for BOUND? */
1872 stclass_flag = 0;
cb434fcc 1873 data.last_closep = &last_close;
653099ff 1874
830247a4 1875 minlen = study_chunk(pRExC_state, &first, &fake, scan + RExC_size, /* Up to end */
e1901655 1876 &data, SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag);
830247a4 1877 if ( RExC_npar == 1 && data.longest == &(data.longest_fixed)
b81d288d 1878 && data.last_start_min == 0 && data.last_end > 0
830247a4
IZ
1879 && !RExC_seen_zerolen
1880 && (!(RExC_seen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS)))
c277df42 1881 r->reganch |= ROPT_CHECK_ALL;
830247a4 1882 scan_commit(pRExC_state, &data);
c277df42
IZ
1883 SvREFCNT_dec(data.last_found);
1884
a0ed51b3 1885 longest_float_length = CHR_SVLEN(data.longest_float);
c5254dd6 1886 if (longest_float_length
c277df42
IZ
1887 || (data.flags & SF_FL_BEFORE_EOL
1888 && (!(data.flags & SF_FL_BEFORE_MEOL)
830247a4 1889 || (RExC_flags16 & PMf_MULTILINE)))) {
cf93c79d
IZ
1890 int t;
1891
a0ed51b3 1892 if (SvCUR(data.longest_fixed) /* ok to leave SvCUR */
aca2d497
IZ
1893 && data.offset_fixed == data.offset_float_min
1894 && SvCUR(data.longest_fixed) == SvCUR(data.longest_float))
1895 goto remove_float; /* As in (a)+. */
1896
c277df42
IZ
1897 r->float_substr = data.longest_float;
1898 r->float_min_offset = data.offset_float_min;
1899 r->float_max_offset = data.offset_float_max;
cf93c79d
IZ
1900 t = (data.flags & SF_FL_BEFORE_EOL /* Can't have SEOL and MULTI */
1901 && (!(data.flags & SF_FL_BEFORE_MEOL)
830247a4 1902 || (RExC_flags16 & PMf_MULTILINE)));
cf93c79d 1903 fbm_compile(r->float_substr, t ? FBMcf_TAIL : 0);
a0ed51b3
LW
1904 }
1905 else {
aca2d497 1906 remove_float:
c277df42
IZ
1907 r->float_substr = Nullsv;
1908 SvREFCNT_dec(data.longest_float);
c5254dd6 1909 longest_float_length = 0;
a0d0e21e 1910 }
c277df42 1911
a0ed51b3 1912 longest_fixed_length = CHR_SVLEN(data.longest_fixed);
c5254dd6 1913 if (longest_fixed_length
c277df42
IZ
1914 || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
1915 && (!(data.flags & SF_FIX_BEFORE_MEOL)
830247a4 1916 || (RExC_flags16 & PMf_MULTILINE)))) {
cf93c79d
IZ
1917 int t;
1918
c277df42
IZ
1919 r->anchored_substr = data.longest_fixed;
1920 r->anchored_offset = data.offset_fixed;
cf93c79d
IZ
1921 t = (data.flags & SF_FIX_BEFORE_EOL /* Can't have SEOL and MULTI */
1922 && (!(data.flags & SF_FIX_BEFORE_MEOL)
830247a4 1923 || (RExC_flags16 & PMf_MULTILINE)));
cf93c79d 1924 fbm_compile(r->anchored_substr, t ? FBMcf_TAIL : 0);
a0ed51b3
LW
1925 }
1926 else {
c277df42
IZ
1927 r->anchored_substr = Nullsv;
1928 SvREFCNT_dec(data.longest_fixed);
c5254dd6 1929 longest_fixed_length = 0;
a0d0e21e 1930 }
b81d288d 1931 if (r->regstclass
ffc61ed2 1932 && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == SANY))
653099ff
GS
1933 r->regstclass = NULL;
1934 if ((!r->anchored_substr || r->anchored_offset) && stclass_flag
1935 && !(data.start_class->flags & ANYOF_EOS)
1936 && !cl_is_anything(data.start_class)) {
830247a4 1937 I32 n = add_data(pRExC_state, 1, "f");
653099ff 1938
b81d288d 1939 New(1006, RExC_rx->data->data[n], 1,
653099ff
GS
1940 struct regnode_charclass_class);
1941 StructCopy(data.start_class,
830247a4 1942 (struct regnode_charclass_class*)RExC_rx->data->data[n],
653099ff 1943 struct regnode_charclass_class);
830247a4 1944 r->regstclass = (regnode*)RExC_rx->data->data[n];
653099ff 1945 r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */
ffc61ed2 1946 PL_regdata = r->data; /* for regprop() */
9c5ffd7c
JH
1947 DEBUG_r({ SV *sv = sv_newmortal();
1948 regprop(sv, (regnode*)data.start_class);
1949 PerlIO_printf(Perl_debug_log,
1950 "synthetic stclass `%s'.\n",
1951 SvPVX(sv));});
653099ff 1952 }
c277df42
IZ
1953
1954 /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
c5254dd6 1955 if (longest_fixed_length > longest_float_length) {
c277df42
IZ
1956 r->check_substr = r->anchored_substr;
1957 r->check_offset_min = r->check_offset_max = r->anchored_offset;
1958 if (r->reganch & ROPT_ANCH_SINGLE)
1959 r->reganch |= ROPT_NOSCAN;
a0ed51b3
LW
1960 }
1961 else {
c277df42
IZ
1962 r->check_substr = r->float_substr;
1963 r->check_offset_min = data.offset_float_min;
1964 r->check_offset_max = data.offset_float_max;
a0d0e21e 1965 }
30382c73
IZ
1966 /* XXXX Currently intuiting is not compatible with ANCH_GPOS.
1967 This should be changed ASAP! */
1968 if (r->check_substr && !(r->reganch & ROPT_ANCH_GPOS)) {
cad2e5aa
JH
1969 r->reganch |= RE_USE_INTUIT;
1970 if (SvTAIL(r->check_substr))
1971 r->reganch |= RE_INTUIT_TAIL;
1972 }
a0ed51b3
LW
1973 }
1974 else {
c277df42
IZ
1975 /* Several toplevels. Best we can is to set minlen. */
1976 I32 fake;
653099ff 1977 struct regnode_charclass_class ch_class;
cb434fcc 1978 I32 last_close = 0;
c277df42
IZ
1979
1980 DEBUG_r(PerlIO_printf(Perl_debug_log, "\n"));
1981 scan = r->program + 1;
830247a4 1982 cl_init(pRExC_state, &ch_class);
653099ff 1983 data.start_class = &ch_class;
cb434fcc 1984 data.last_closep = &last_close;
e1901655 1985 minlen = study_chunk(pRExC_state, &scan, &fake, scan + RExC_size, &data, SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS);
c277df42 1986 r->check_substr = r->anchored_substr = r->float_substr = Nullsv;
653099ff
GS
1987 if (!(data.start_class->flags & ANYOF_EOS)
1988 && !cl_is_anything(data.start_class)) {
830247a4 1989 I32 n = add_data(pRExC_state, 1, "f");
653099ff 1990
b81d288d 1991 New(1006, RExC_rx->data->data[n], 1,
653099ff
GS
1992 struct regnode_charclass_class);
1993 StructCopy(data.start_class,
830247a4 1994 (struct regnode_charclass_class*)RExC_rx->data->data[n],
653099ff 1995 struct regnode_charclass_class);
830247a4 1996 r->regstclass = (regnode*)RExC_rx->data->data[n];
653099ff 1997 r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */
9c5ffd7c
JH
1998 DEBUG_r({ SV* sv = sv_newmortal();
1999 regprop(sv, (regnode*)data.start_class);
2000 PerlIO_printf(Perl_debug_log,
2001 "synthetic stclass `%s'.\n",
2002 SvPVX(sv));});
653099ff 2003 }
a0d0e21e
LW
2004 }
2005
a0d0e21e 2006 r->minlen = minlen;
b81d288d 2007 if (RExC_seen & REG_SEEN_GPOS)
c277df42 2008 r->reganch |= ROPT_GPOS_SEEN;
830247a4 2009 if (RExC_seen & REG_SEEN_LOOKBEHIND)
c277df42 2010 r->reganch |= ROPT_LOOKBEHIND_SEEN;
830247a4 2011 if (RExC_seen & REG_SEEN_EVAL)
ce862d02 2012 r->reganch |= ROPT_EVAL_SEEN;
f33976b4
DB
2013 if (RExC_seen & REG_SEEN_CANY)
2014 r->reganch |= ROPT_CANY_SEEN;
830247a4
IZ
2015 Newz(1002, r->startp, RExC_npar, I32);
2016 Newz(1002, r->endp, RExC_npar, I32);
ffc61ed2 2017 PL_regdata = r->data; /* for regprop() */
a0d0e21e
LW
2018 DEBUG_r(regdump(r));
2019 return(r);
a687059c
LW
2020}
2021
2022/*
2023 - reg - regular expression, i.e. main body or parenthesized thing
2024 *
2025 * Caller must absorb opening parenthesis.
2026 *
2027 * Combining parenthesis handling with the base level of regular expression
2028 * is a trifle forced, but the need to tie the tails of the branches to what
2029 * follows makes it hard to avoid.
2030 */
76e3520e 2031STATIC regnode *
830247a4 2032S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
c277df42 2033 /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
a687059c 2034{
c277df42
IZ
2035 register regnode *ret; /* Will be the head of the group. */
2036 register regnode *br;
2037 register regnode *lastbr;
2038 register regnode *ender = 0;
a0d0e21e 2039 register I32 parno = 0;
830247a4 2040 I32 flags, oregflags = RExC_flags16, have_branch = 0, open = 0;
9d1d55b5
JP
2041
2042 /* for (?g), (?gc), and (?o) warnings; warning
2043 about (?c) will warn about (?g) -- japhy */
2044
2045 I32 wastedflags = 0x00,
2046 wasted_o = 0x01,
2047 wasted_g = 0x02,
2048 wasted_gc = 0x02 | 0x04,
2049 wasted_c = 0x04;
2050
fac92740 2051 char * parse_start = RExC_parse; /* MJD */
830247a4 2052 char *oregcomp_parse = RExC_parse;
c277df42 2053 char c;
a0d0e21e 2054
821b33a5 2055 *flagp = 0; /* Tentatively. */
a0d0e21e 2056
9d1d55b5 2057
a0d0e21e
LW
2058 /* Make an OPEN node, if parenthesized. */
2059 if (paren) {
fac92740 2060 if (*RExC_parse == '?') { /* (?...) */
ca9dfc88
IZ
2061 U16 posflags = 0, negflags = 0;
2062 U16 *flagsp = &posflags;
0f5d15d6 2063 int logical = 0;
830247a4 2064 char *seqstart = RExC_parse;
ca9dfc88 2065
830247a4
IZ
2066 RExC_parse++;
2067 paren = *RExC_parse++;
c277df42 2068 ret = NULL; /* For look-ahead/behind. */
a0d0e21e 2069 switch (paren) {
fac92740 2070 case '<': /* (?<...) */
830247a4 2071 RExC_seen |= REG_SEEN_LOOKBEHIND;
b81d288d 2072 if (*RExC_parse == '!')
c277df42 2073 paren = ',';
b81d288d 2074 if (*RExC_parse != '=' && *RExC_parse != '!')
c277df42 2075 goto unknown;
830247a4 2076 RExC_parse++;
fac92740
MJD
2077 case '=': /* (?=...) */
2078 case '!': /* (?!...) */
830247a4 2079 RExC_seen_zerolen++;
fac92740
MJD
2080 case ':': /* (?:...) */
2081 case '>': /* (?>...) */
a0d0e21e 2082 break;
fac92740
MJD
2083 case '$': /* (?$...) */
2084 case '@': /* (?@...) */
8615cb43 2085 vFAIL2("Sequence (?%c...) not implemented", (int)paren);
a0d0e21e 2086 break;
fac92740 2087 case '#': /* (?#...) */
830247a4
IZ
2088 while (*RExC_parse && *RExC_parse != ')')
2089 RExC_parse++;
2090 if (*RExC_parse != ')')
c277df42 2091 FAIL("Sequence (?#... not terminated");
830247a4 2092 nextchar(pRExC_state);
a0d0e21e
LW
2093 *flagp = TRYAGAIN;
2094 return NULL;
fac92740 2095 case 'p': /* (?p...) */
f9373011
PM
2096 if (SIZE_ONLY && ckWARN2(WARN_DEPRECATED, WARN_REGEXP))
2097 vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})");
8c8ad484 2098 /* FALL THROUGH*/
fac92740 2099 case '?': /* (??...) */
0f5d15d6 2100 logical = 1;
830247a4 2101 paren = *RExC_parse++;
0f5d15d6 2102 /* FALL THROUGH */
fac92740 2103 case '{': /* (?{...}) */
c277df42 2104 {
c277df42
IZ
2105 I32 count = 1, n = 0;
2106 char c;
830247a4 2107 char *s = RExC_parse;
c277df42
IZ
2108 SV *sv;
2109 OP_4tree *sop, *rop;
2110
830247a4
IZ
2111 RExC_seen_zerolen++;
2112 RExC_seen |= REG_SEEN_EVAL;
2113 while (count && (c = *RExC_parse)) {
2114 if (c == '\\' && RExC_parse[1])
2115 RExC_parse++;
b81d288d 2116 else if (c == '{')
c277df42 2117 count++;
b81d288d 2118 else if (c == '}')
c277df42 2119 count--;
830247a4 2120 RExC_parse++;
c277df42 2121 }
830247a4 2122 if (*RExC_parse != ')')
b45f050a 2123 {
b81d288d 2124 RExC_parse = s;
b45f050a
JF
2125 vFAIL("Sequence (?{...}) not terminated or not {}-balanced");
2126 }
c277df42
IZ
2127 if (!SIZE_ONLY) {
2128 AV *av;
b81d288d
AB
2129
2130 if (RExC_parse - 1 - s)
830247a4 2131 sv = newSVpvn(s, RExC_parse - 1 - s);
c277df42 2132 else
79cb57f6 2133 sv = newSVpvn("", 0);
c277df42 2134
569233ed
SB
2135 ENTER;
2136 Perl_save_re_context(aTHX);
c277df42 2137 rop = sv_compile_2op(sv, &sop, "re", &av);
9b978d73
DM
2138 sop->op_private |= OPpREFCOUNTED;
2139 /* re_dup will OpREFCNT_inc */
2140 OpREFCNT_set(sop, 1);
569233ed 2141 LEAVE;
c277df42 2142
830247a4
IZ
2143 n = add_data(pRExC_state, 3, "nop");
2144 RExC_rx->data->data[n] = (void*)rop;
2145 RExC_rx->data->data[n+1] = (void*)sop;
2146 RExC_rx->data->data[n+2] = (void*)av;
c277df42 2147 SvREFCNT_dec(sv);
a0ed51b3 2148 }
e24b16f9 2149 else { /* First pass */
830247a4 2150 if (PL_reginterp_cnt < ++RExC_seen_evals
e24b16f9 2151 && PL_curcop != &PL_compiling)
2cd61cdb
IZ
2152 /* No compiled RE interpolated, has runtime
2153 components ===> unsafe. */
2154 FAIL("Eval-group not allowed at runtime, use re 'eval'");
5b61d3f7 2155 if (PL_tainting && PL_tainted)
cc6b7395 2156 FAIL("Eval-group in insecure regular expression");
c277df42
IZ
2157 }
2158
830247a4 2159 nextchar(pRExC_state);
0f5d15d6 2160 if (logical) {
830247a4 2161 ret = reg_node(pRExC_state, LOGICAL);
0f5d15d6
IZ
2162 if (!SIZE_ONLY)
2163 ret->flags = 2;
830247a4 2164 regtail(pRExC_state, ret, reganode(pRExC_state, EVAL, n));
fac92740 2165 /* deal with the length of this later - MJD */
0f5d15d6
IZ
2166 return ret;
2167 }
830247a4 2168 return reganode(pRExC_state, EVAL, n);
c277df42 2169 }
fac92740 2170 case '(': /* (?(?{...})...) and (?(?=...)...) */
c277df42 2171 {
fac92740 2172 if (RExC_parse[0] == '?') { /* (?(?...)) */
b81d288d
AB
2173 if (RExC_parse[1] == '=' || RExC_parse[1] == '!'
2174 || RExC_parse[1] == '<'
830247a4 2175 || RExC_parse[1] == '{') { /* Lookahead or eval. */
c277df42
IZ
2176 I32 flag;
2177
830247a4 2178 ret = reg_node(pRExC_state, LOGICAL);
0f5d15d6
IZ
2179 if (!SIZE_ONLY)
2180 ret->flags = 1;
830247a4 2181 regtail(pRExC_state, ret, reg(pRExC_state, 1, &flag));
c277df42 2182 goto insert_if;
b81d288d 2183 }
a0ed51b3 2184 }
830247a4 2185 else if (RExC_parse[0] >= '1' && RExC_parse[0] <= '9' ) {
fac92740 2186 /* (?(1)...) */
830247a4 2187 parno = atoi(RExC_parse++);
c277df42 2188
830247a4
IZ
2189 while (isDIGIT(*RExC_parse))
2190 RExC_parse++;
fac92740
MJD
2191 ret = reganode(pRExC_state, GROUPP, parno);
2192
830247a4 2193 if ((c = *nextchar(pRExC_state)) != ')')
b45f050a 2194 vFAIL("Switch condition not recognized");
c277df42 2195 insert_if:
830247a4
IZ
2196 regtail(pRExC_state, ret, reganode(pRExC_state, IFTHEN, 0));
2197 br = regbranch(pRExC_state, &flags, 1);
c277df42 2198 if (br == NULL)
830247a4 2199 br = reganode(pRExC_state, LONGJMP, 0);
c277df42 2200 else
830247a4
IZ
2201 regtail(pRExC_state, br, reganode(pRExC_state, LONGJMP, 0));
2202 c = *nextchar(pRExC_state);
d1b80229
IZ
2203 if (flags&HASWIDTH)
2204 *flagp |= HASWIDTH;
c277df42 2205 if (c == '|') {
830247a4
IZ
2206 lastbr = reganode(pRExC_state, IFTHEN, 0); /* Fake one for optimizer. */
2207 regbranch(pRExC_state, &flags, 1);
2208 regtail(pRExC_state, ret, lastbr);
d1b80229
IZ
2209 if (flags&HASWIDTH)
2210 *flagp |= HASWIDTH;
830247a4 2211 c = *nextchar(pRExC_state);
a0ed51b3
LW
2212 }
2213 else
c277df42
IZ
2214 lastbr = NULL;
2215 if (c != ')')
8615cb43 2216 vFAIL("Switch (?(condition)... contains too many branches");
830247a4
IZ
2217 ender = reg_node(pRExC_state, TAIL);
2218 regtail(pRExC_state, br, ender);
c277df42 2219 if (lastbr) {
830247a4
IZ
2220 regtail(pRExC_state, lastbr, ender);
2221 regtail(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender);
a0ed51b3
LW
2222 }
2223 else
830247a4 2224 regtail(pRExC_state, ret, ender);
c277df42 2225 return ret;
a0ed51b3
LW
2226 }
2227 else {
830247a4 2228 vFAIL2("Unknown switch condition (?(%.2s", RExC_parse);
c277df42
IZ
2229 }
2230 }
1b1626e4 2231 case 0:
830247a4 2232 RExC_parse--; /* for vFAIL to print correctly */
8615cb43 2233 vFAIL("Sequence (? incomplete");
1b1626e4 2234 break;
a0d0e21e 2235 default:
830247a4 2236 --RExC_parse;
fac92740 2237 parse_flags: /* (?i) */
830247a4 2238 while (*RExC_parse && strchr("iogcmsx", *RExC_parse)) {
9d1d55b5
JP
2239 /* (?g), (?gc) and (?o) are useless here
2240 and must be globally applied -- japhy */
2241
2242 if (*RExC_parse == 'o' || *RExC_parse == 'g') {
2243 if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
2244 I32 wflagbit = *RExC_parse == 'o' ? wasted_o : wasted_g;
2245 if (! (wastedflags & wflagbit) ) {
2246 wastedflags |= wflagbit;
2247 vWARN5(
2248 RExC_parse + 1,
2249 "Useless (%s%c) - %suse /%c modifier",
2250 flagsp == &negflags ? "?-" : "?",
2251 *RExC_parse,
2252 flagsp == &negflags ? "don't " : "",
2253 *RExC_parse
2254 );
2255 }
2256 }
2257 }
2258 else if (*RExC_parse == 'c') {
2259 if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
2260 if (! (wastedflags & wasted_c) ) {
2261 wastedflags |= wasted_gc;
2262 vWARN3(
2263 RExC_parse + 1,
2264 "Useless (%sc) - %suse /gc modifier",
2265 flagsp == &negflags ? "?-" : "?",
2266 flagsp == &negflags ? "don't " : ""
2267 );
2268 }
2269 }
2270 }
2271 else { pmflag(flagsp, *RExC_parse); }
2272
830247a4 2273 ++RExC_parse;
ca9dfc88 2274 }
830247a4 2275 if (*RExC_parse == '-') {
ca9dfc88 2276 flagsp = &negflags;
9d1d55b5 2277 wastedflags = 0; /* reset so (?g-c) warns twice */
830247a4 2278 ++RExC_parse;
ca9dfc88 2279 goto parse_flags;
48c036b1 2280 }
830247a4
IZ
2281 RExC_flags16 |= posflags;
2282 RExC_flags16 &= ~negflags;
2283 if (*RExC_parse == ':') {
2284 RExC_parse++;
ca9dfc88
IZ
2285 paren = ':';
2286 break;
2287 }
c277df42 2288 unknown:
830247a4
IZ
2289 if (*RExC_parse != ')') {
2290 RExC_parse++;
2291 vFAIL3("Sequence (%.*s...) not recognized", RExC_parse-seqstart, seqstart);
b45f050a 2292 }
830247a4 2293 nextchar(pRExC_state);
a0d0e21e
LW
2294 *flagp = TRYAGAIN;
2295 return NULL;
2296 }
2297 }
fac92740 2298 else { /* (...) */
830247a4
IZ
2299 parno = RExC_npar;
2300 RExC_npar++;
2301 ret = reganode(pRExC_state, OPEN, parno);
fac92740
MJD
2302 Set_Node_Length(ret, 1); /* MJD */
2303 Set_Node_Offset(ret, RExC_parse); /* MJD */
c277df42 2304 open = 1;
a0d0e21e 2305 }
a0ed51b3 2306 }
fac92740 2307 else /* ! paren */
a0d0e21e
LW
2308 ret = NULL;
2309
2310 /* Pick up the branches, linking them together. */
fac92740 2311 parse_start = RExC_parse; /* MJD */
830247a4 2312 br = regbranch(pRExC_state, &flags, 1);
fac92740
MJD
2313 /* branch_len = (paren != 0); */
2314
a0d0e21e
LW
2315 if (br == NULL)
2316 return(NULL);
830247a4
IZ
2317 if (*RExC_parse == '|') {
2318 if (!SIZE_ONLY && RExC_extralen) {
2319 reginsert(pRExC_state, BRANCHJ, br);
a0ed51b3 2320 }
fac92740 2321 else { /* MJD */
830247a4 2322 reginsert(pRExC_state, BRANCH, br);
fac92740
MJD
2323 Set_Node_Length(br, paren != 0);
2324 Set_Node_Offset_To_R(br-RExC_emit_start, parse_start-RExC_start);
2325 }
c277df42
IZ
2326 have_branch = 1;
2327 if (SIZE_ONLY)
830247a4 2328 RExC_extralen += 1; /* For BRANCHJ-BRANCH. */
a0ed51b3
LW
2329 }
2330 else if (paren == ':') {
c277df42
IZ
2331 *flagp |= flags&SIMPLE;
2332 }
2333 if (open) { /* Starts with OPEN. */
830247a4 2334 regtail(pRExC_state, ret, br); /* OPEN -> first. */
a0ed51b3
LW
2335 }
2336 else if (paren != '?') /* Not Conditional */
a0d0e21e 2337 ret = br;
821b33a5
IZ
2338 if (flags&HASWIDTH)
2339 *flagp |= HASWIDTH;
a0d0e21e 2340 *flagp |= flags&SPSTART;
c277df42 2341 lastbr = br;
830247a4
IZ
2342 while (*RExC_parse == '|') {
2343 if (!SIZE_ONLY && RExC_extralen) {
2344 ender = reganode(pRExC_state, LONGJMP,0);
2345 regtail(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
c277df42
IZ
2346 }
2347 if (SIZE_ONLY)
830247a4
IZ
2348 RExC_extralen += 2; /* Account for LONGJMP. */
2349 nextchar(pRExC_state);
2350 br = regbranch(pRExC_state, &flags, 0);
fac92740 2351
a687059c 2352 if (br == NULL)
a0d0e21e 2353 return(NULL);
830247a4 2354 regtail(pRExC_state, lastbr, br); /* BRANCH -> BRANCH. */
c277df42 2355 lastbr = br;
821b33a5
IZ
2356 if (flags&HASWIDTH)
2357 *flagp |= HASWIDTH;
a687059c 2358 *flagp |= flags&SPSTART;
a0d0e21e
LW
2359 }
2360
c277df42
IZ
2361 if (have_branch || paren != ':') {
2362 /* Make a closing node, and hook it on the end. */
2363 switch (paren) {
2364 case ':':
830247a4 2365 ender = reg_node(pRExC_state, TAIL);
c277df42
IZ
2366 break;
2367 case 1:
830247a4 2368 ender = reganode(pRExC_state, CLOSE, parno);
fac92740
MJD
2369 Set_Node_Offset(ender,RExC_parse+1); /* MJD */
2370 Set_Node_Length(ender,1); /* MJD */
c277df42
IZ
2371 break;
2372 case '<':
c277df42
IZ
2373 case ',':
2374 case '=':
2375 case '!':
c277df42 2376 *flagp &= ~HASWIDTH;
821b33a5
IZ
2377 /* FALL THROUGH */
2378 case '>':
830247a4 2379 ender = reg_node(pRExC_state, SUCCEED);
c277df42
IZ
2380 break;
2381 case 0:
830247a4 2382 ender = reg_node(pRExC_state, END);
c277df42
IZ
2383 break;
2384 }
830247a4 2385 regtail(pRExC_state, lastbr, ender);
a0d0e21e 2386
c277df42
IZ
2387 if (have_branch) {
2388 /* Hook the tails of the branches to the closing node. */
2389 for (br = ret; br != NULL; br = regnext(br)) {
830247a4 2390 regoptail(pRExC_state, br, ender);
c277df42
IZ
2391 }
2392 }
a0d0e21e 2393 }
c277df42
IZ
2394
2395 {
2396 char *p;
2397 static char parens[] = "=!<,>";
2398
2399 if (paren && (p = strchr(parens, paren))) {
2400 int node = ((p - parens) % 2) ? UNLESSM : IFMATCH;
2401 int flag = (p - parens) > 1;
2402
2403 if (paren == '>')
2404 node = SUSPEND, flag = 0;
830247a4 2405 reginsert(pRExC_state, node,ret);
c277df42 2406 ret->flags = flag;
830247a4 2407 regtail(pRExC_state, ret, reg_node(pRExC_state, TAIL));
c277df42 2408 }
a0d0e21e
LW
2409 }
2410
2411 /* Check for proper termination. */
ce3e6498 2412 if (paren) {
830247a4
IZ
2413 RExC_flags16 = oregflags;
2414 if (RExC_parse >= RExC_end || *nextchar(pRExC_state) != ')') {
2415 RExC_parse = oregcomp_parse;
380a0633 2416 vFAIL("Unmatched (");
ce3e6498 2417 }
a0ed51b3 2418 }
830247a4
IZ
2419 else if (!paren && RExC_parse < RExC_end) {
2420 if (*RExC_parse == ')') {
2421 RExC_parse++;
380a0633 2422 vFAIL("Unmatched )");
a0ed51b3
LW
2423 }
2424 else
b45f050a 2425 FAIL("Junk on end of regexp"); /* "Can't happen". */
a0d0e21e
LW
2426 /* NOTREACHED */
2427 }
a687059c 2428
a0d0e21e 2429 return(ret);
a687059c
LW
2430}
2431
2432/*
2433 - regbranch - one alternative of an | operator
2434 *
2435 * Implements the concatenation operator.
2436 */
76e3520e 2437STATIC regnode *
830247a4 2438S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first)
a687059c 2439{
c277df42
IZ
2440 register regnode *ret;
2441 register regnode *chain = NULL;
2442 register regnode *latest;
2443 I32 flags = 0, c = 0;
a0d0e21e 2444
b81d288d 2445 if (first)
c277df42
IZ
2446 ret = NULL;
2447 else {
b81d288d 2448 if (!SIZE_ONLY && RExC_extralen)
830247a4 2449 ret = reganode(pRExC_state, BRANCHJ,0);
fac92740 2450 else {
830247a4 2451 ret = reg_node(pRExC_state, BRANCH);
fac92740
MJD
2452 Set_Node_Length(ret, 1);
2453 }
c277df42
IZ
2454 }
2455
b81d288d 2456 if (!first && SIZE_ONLY)
830247a4 2457 RExC_extralen += 1; /* BRANCHJ */
b81d288d 2458
c277df42 2459 *flagp = WORST; /* Tentatively. */
a0d0e21e 2460
830247a4
IZ
2461 RExC_parse--;
2462 nextchar(pRExC_state);
2463 while (RExC_parse < RExC_end && *RExC_parse != '|' && *RExC_parse != ')') {
a0d0e21e 2464 flags &= ~TRYAGAIN;
830247a4 2465 latest = regpiece(pRExC_state, &flags);
a0d0e21e
LW
2466 if (latest == NULL) {
2467 if (flags & TRYAGAIN)
2468 continue;
2469 return(NULL);
a0ed51b3
LW
2470 }
2471 else if (ret == NULL)
c277df42 2472 ret = latest;
a0d0e21e 2473 *flagp |= flags&HASWIDTH;
c277df42 2474 if (chain == NULL) /* First piece. */
a0d0e21e
LW
2475 *flagp |= flags&SPSTART;
2476 else {
830247a4
IZ
2477 RExC_naughty++;
2478 regtail(pRExC_state, chain, latest);
a687059c 2479 }
a0d0e21e 2480 chain = latest;
c277df42
IZ
2481 c++;
2482 }
2483 if (chain == NULL) { /* Loop ran zero times. */
830247a4 2484 chain = reg_node(pRExC_state, NOTHING);
c277df42
IZ
2485 if (ret == NULL)
2486 ret = chain;
2487 }
2488 if (c == 1) {
2489 *flagp |= flags&SIMPLE;
a0d0e21e 2490 }
a687059c 2491
a0d0e21e 2492 return(ret);
a687059c
LW
2493}
2494
2495/*
2496 - regpiece - something followed by possible [*+?]
2497 *
2498 * Note that the branching code sequences used for ? and the general cases
2499 * of * and + are somewhat optimized: they use the same NOTHING node as
2500 * both the endmarker for their branch list and the body of the last branch.
2501 * It might seem that this node could be dispensed with entirely, but the
2502 * endmarker role is not redundant.
2503 */
76e3520e 2504STATIC regnode *
830247a4 2505S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
a687059c 2506{
c277df42 2507 register regnode *ret;
a0d0e21e
LW
2508 register char op;
2509 register char *next;
2510 I32 flags;
830247a4 2511 char *origparse = RExC_parse;
a0d0e21e
LW
2512 char *maxpos;
2513 I32 min;
c277df42 2514 I32 max = REG_INFTY;
fac92740 2515 char *parse_start;
a0d0e21e 2516
830247a4 2517 ret = regatom(pRExC_state, &flags);
a0d0e21e
LW
2518 if (ret == NULL) {
2519 if (flags & TRYAGAIN)
2520 *flagp |= TRYAGAIN;
2521 return(NULL);
2522 }
2523
830247a4 2524 op = *RExC_parse;
a0d0e21e 2525
830247a4 2526 if (op == '{' && regcurly(RExC_parse)) {
fac92740 2527 parse_start = RExC_parse; /* MJD */
830247a4 2528 next = RExC_parse + 1;
a0d0e21e
LW
2529 maxpos = Nullch;
2530 while (isDIGIT(*next) || *next == ',') {
2531 if (*next == ',') {
2532 if (maxpos)
2533 break;
2534 else
2535 maxpos = next;
a687059c 2536 }
a0d0e21e
LW
2537 next++;
2538 }
2539 if (*next == '}') { /* got one */
2540 if (!maxpos)
2541 maxpos = next;
830247a4
IZ
2542 RExC_parse++;
2543 min = atoi(RExC_parse);
a0d0e21e
LW
2544 if (*maxpos == ',')
2545 maxpos++;
2546 else
830247a4 2547 maxpos = RExC_parse;
a0d0e21e
LW
2548 max = atoi(maxpos);
2549 if (!max && *maxpos != '0')
c277df42
IZ
2550 max = REG_INFTY; /* meaning "infinity" */
2551 else if (max >= REG_INFTY)
8615cb43 2552 vFAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1);
830247a4
IZ
2553 RExC_parse = next;
2554 nextchar(pRExC_state);
a0d0e21e
LW
2555
2556 do_curly:
2557 if ((flags&SIMPLE)) {
830247a4
IZ
2558 RExC_naughty += 2 + RExC_naughty / 2;
2559 reginsert(pRExC_state, CURLY, ret);
fac92740
MJD
2560 Set_Node_Offset(ret, parse_start+1); /* MJD */
2561 Set_Node_Cur_Length(ret);
a0d0e21e
LW
2562 }
2563 else {
830247a4 2564 regnode *w = reg_node(pRExC_state, WHILEM);
2c2d71f5
JH
2565
2566 w->flags = 0;
830247a4
IZ
2567 regtail(pRExC_state, ret, w);
2568 if (!SIZE_ONLY && RExC_extralen) {
2569 reginsert(pRExC_state, LONGJMP,ret);
2570 reginsert(pRExC_state, NOTHING,ret);
c277df42
IZ
2571 NEXT_OFF(ret) = 3; /* Go over LONGJMP. */
2572 }
830247a4 2573 reginsert(pRExC_state, CURLYX,ret);
fac92740
MJD
2574 /* MJD hk */
2575 Set_Node_Offset(ret, parse_start+1);
2576 Set_Node_Length(ret,
2577 op == '{' ? (RExC_parse - parse_start) : 1);
2578
830247a4 2579 if (!SIZE_ONLY && RExC_extralen)
c277df42 2580 NEXT_OFF(ret) = 3; /* Go over NOTHING to LONGJMP. */
830247a4 2581 regtail(pRExC_state, ret, reg_node(pRExC_state, NOTHING));
c277df42 2582 if (SIZE_ONLY)
830247a4
IZ
2583 RExC_whilem_seen++, RExC_extralen += 3;
2584 RExC_naughty += 4 + RExC_naughty; /* compound interest */
a0d0e21e 2585 }
c277df42 2586 ret->flags = 0;
a0d0e21e
LW
2587
2588 if (min > 0)
821b33a5
IZ
2589 *flagp = WORST;
2590 if (max > 0)
2591 *flagp |= HASWIDTH;
a0d0e21e 2592 if (max && max < min)
8615cb43 2593 vFAIL("Can't do {n,m} with n > m");
c277df42
IZ
2594 if (!SIZE_ONLY) {
2595 ARG1_SET(ret, min);
2596 ARG2_SET(ret, max);
a687059c 2597 }
a687059c 2598
a0d0e21e 2599 goto nest_check;
a687059c 2600 }
a0d0e21e 2601 }
a687059c 2602
a0d0e21e
LW
2603 if (!ISMULT1(op)) {
2604 *flagp = flags;
a687059c 2605 return(ret);
a0d0e21e 2606 }
bb20fd44 2607
c277df42 2608#if 0 /* Now runtime fix should be reliable. */
b45f050a
JF
2609
2610 /* if this is reinstated, don't forget to put this back into perldiag:
2611
2612 =item Regexp *+ operand could be empty at {#} in regex m/%s/
2613
2614 (F) The part of the regexp subject to either the * or + quantifier
2615 could match an empty string. The {#} shows in the regular
2616 expression about where the problem was discovered.
2617
2618 */
2619
bb20fd44 2620 if (!(flags&HASWIDTH) && op != '?')
b45f050a 2621 vFAIL("Regexp *+ operand could be empty");
b81d288d 2622#endif
bb20fd44 2623
fac92740 2624 parse_start = RExC_parse;
830247a4 2625 nextchar(pRExC_state);
a0d0e21e 2626
821b33a5 2627 *flagp = (op != '+') ? (WORST|SPSTART|HASWIDTH) : (WORST|HASWIDTH);
a0d0e21e
LW
2628
2629 if (op == '*' && (flags&SIMPLE)) {
830247a4 2630 reginsert(pRExC_state, STAR, ret);
c277df42 2631 ret->flags = 0;
830247a4 2632 RExC_naughty += 4;
a0d0e21e
LW
2633 }
2634 else if (op == '*') {
2635 min = 0;
2636 goto do_curly;
a0ed51b3
LW
2637 }
2638 else if (op == '+' && (flags&SIMPLE)) {
830247a4 2639 reginsert(pRExC_state, PLUS, ret);
c277df42 2640 ret->flags = 0;
830247a4 2641 RExC_naughty += 3;
a0d0e21e
LW
2642 }
2643 else if (op == '+') {
2644 min = 1;
2645 goto do_curly;
a0ed51b3
LW
2646 }
2647 else if (op == '?') {
a0d0e21e
LW
2648 min = 0; max = 1;
2649 goto do_curly;
2650 }
2651 nest_check:
e476b1b5 2652 if (ckWARN(WARN_REGEXP) && !SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3) {
830247a4 2653 vWARN3(RExC_parse,
b45f050a 2654 "%.*s matches null string many times",
830247a4 2655 RExC_parse - origparse,
b45f050a 2656 origparse);
a0d0e21e
LW
2657 }
2658
830247a4
IZ
2659 if (*RExC_parse == '?') {
2660 nextchar(pRExC_state);
2661 reginsert(pRExC_state, MINMOD, ret);
2662 regtail(pRExC_state, ret, ret + NODE_STEP_REGNODE);
a0d0e21e 2663 }
830247a4
IZ
2664 if (ISMULT2(RExC_parse)) {
2665 RExC_parse++;
b45f050a
JF
2666 vFAIL("Nested quantifiers");
2667 }
a0d0e21e
LW
2668
2669 return(ret);
a687059c
LW
2670}
2671
2672/*
2673 - regatom - the lowest level
2674 *
2675 * Optimization: gobbles an entire sequence of ordinary characters so that
2676 * it can turn them into a single node, which is smaller to store and
2677 * faster to run. Backslashed characters are exceptions, each becoming a
2678 * separate node; the code is simpler that way and it's not worth fixing.
2679 *
b45f050a 2680 * [Yes, it is worth fixing, some scripts can run twice the speed.] */
76e3520e 2681STATIC regnode *
830247a4 2682S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
a687059c 2683{
c277df42 2684 register regnode *ret = 0;
a0d0e21e 2685 I32 flags;
f06dbbb7 2686 char *parse_start = 0;
a0d0e21e
LW
2687
2688 *flagp = WORST; /* Tentatively. */
2689
2690tryagain:
830247a4 2691 switch (*RExC_parse) {
a0d0e21e 2692 case '^':
830247a4
IZ
2693 RExC_seen_zerolen++;
2694 nextchar(pRExC_state);
2695 if (RExC_flags16 & PMf_MULTILINE)
2696 ret = reg_node(pRExC_state, MBOL);
2697 else if (RExC_flags16 & PMf_SINGLELINE)
2698 ret = reg_node(pRExC_state, SBOL);
a0d0e21e 2699 else
830247a4 2700 ret = reg_node(pRExC_state, BOL);
fac92740 2701 Set_Node_Length(ret, 1); /* MJD */
a0d0e21e
LW
2702 break;
2703 case '$':
830247a4 2704 nextchar(pRExC_state);
b81d288d 2705 if (*RExC_parse)
830247a4
IZ
2706 RExC_seen_zerolen++;
2707 if (RExC_flags16 & PMf_MULTILINE)
2708 ret = reg_node(pRExC_state, MEOL);
2709 else if (RExC_flags16 & PMf_SINGLELINE)
2710 ret = reg_node(pRExC_state, SEOL);
a0d0e21e 2711 else
830247a4 2712 ret = reg_node(pRExC_state, EOL);
fac92740 2713 Set_Node_Length(ret, 1); /* MJD */
a0d0e21e
LW
2714 break;
2715 case '.':
830247a4 2716 nextchar(pRExC_state);
cce850e4 2717 if (RExC_flags16 & PMf_SINGLELINE)
ffc61ed2
JH
2718 ret = reg_node(pRExC_state, SANY);
2719 else
2720 ret = reg_node(pRExC_state, REG_ANY);
2721 *flagp |= HASWIDTH|SIMPLE;
830247a4 2722 RExC_naughty++;
fac92740 2723 Set_Node_Length(ret, 1); /* MJD */
a0d0e21e
LW
2724 break;
2725 case '[':
b45f050a 2726 {
830247a4 2727 char *oregcomp_parse = ++RExC_parse;
ffc61ed2 2728 ret = regclass(pRExC_state);
830247a4
IZ
2729 if (*RExC_parse != ']') {
2730 RExC_parse = oregcomp_parse;
b45f050a
JF
2731 vFAIL("Unmatched [");
2732 }
830247a4 2733 nextchar(pRExC_state);
a0d0e21e 2734 *flagp |= HASWIDTH|SIMPLE;
fac92740 2735 Set_Node_Length(ret, RExC_parse - oregcomp_parse + 1); /* MJD */
a0d0e21e 2736 break;
b45f050a 2737 }
a0d0e21e 2738 case '(':
830247a4
IZ
2739 nextchar(pRExC_state);
2740 ret = reg(pRExC_state, 1, &flags);
a0d0e21e 2741 if (ret == NULL) {
bf93d4cc 2742 if (flags & TRYAGAIN) {
830247a4 2743 if (RExC_parse == RExC_end) {
bf93d4cc
GS
2744 /* Make parent create an empty node if needed. */
2745 *flagp |= TRYAGAIN;
2746 return(NULL);
2747 }
a0d0e21e 2748 goto tryagain;
bf93d4cc 2749 }
a0d0e21e
LW
2750 return(NULL);
2751 }
c277df42 2752 *flagp |= flags&(HASWIDTH|SPSTART|SIMPLE);
a0d0e21e
LW
2753 break;
2754 case '|':
2755 case ')':
2756 if (flags & TRYAGAIN) {
2757 *flagp |= TRYAGAIN;
2758 return NULL;
2759 }
b45f050a 2760 vFAIL("Internal urp");
a0d0e21e
LW
2761 /* Supposed to be caught earlier. */
2762 break;
85afd4ae 2763 case '{':
830247a4
IZ
2764 if (!regcurly(RExC_parse)) {
2765 RExC_parse++;
85afd4ae
CS
2766 goto defchar;
2767 }
2768 /* FALL THROUGH */
a0d0e21e
LW
2769 case '?':
2770 case '+':
2771 case '*':
830247a4 2772 RExC_parse++;
b45f050a 2773 vFAIL("Quantifier follows nothing");
a0d0e21e
LW
2774 break;
2775 case '\\':
830247a4 2776 switch (*++RExC_parse) {
a0d0e21e 2777 case 'A':
830247a4
IZ
2778 RExC_seen_zerolen++;
2779 ret = reg_node(pRExC_state, SBOL);
a0d0e21e 2780 *flagp |= SIMPLE;
830247a4 2781 nextchar(pRExC_state);
fac92740 2782 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW
2783 break;
2784 case 'G':
830247a4
IZ
2785 ret = reg_node(pRExC_state, GPOS);
2786 RExC_seen |= REG_SEEN_GPOS;
a0d0e21e 2787 *flagp |= SIMPLE;
830247a4 2788 nextchar(pRExC_state);
fac92740 2789 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW
2790 break;
2791 case 'Z':
830247a4 2792 ret = reg_node(pRExC_state, SEOL);
a0d0e21e 2793 *flagp |= SIMPLE;
a1917ab9 2794 RExC_seen_zerolen++; /* Do not optimize RE away */
830247a4 2795 nextchar(pRExC_state);
a0d0e21e 2796 break;
b85d18e9 2797 case 'z':
830247a4 2798 ret = reg_node(pRExC_state, EOS);
b85d18e9 2799 *flagp |= SIMPLE;
830247a4
IZ
2800 RExC_seen_zerolen++; /* Do not optimize RE away */
2801 nextchar(pRExC_state);
fac92740 2802 Set_Node_Length(ret, 2); /* MJD */
b85d18e9 2803 break;
4a2d328f 2804 case 'C':
f33976b4
DB
2805 ret = reg_node(pRExC_state, CANY);
2806 RExC_seen |= REG_SEEN_CANY;
a0ed51b3 2807 *flagp |= HASWIDTH|SIMPLE;
830247a4 2808 nextchar(pRExC_state);
fac92740 2809 Set_Node_Length(ret, 2); /* MJD */
a0ed51b3
LW
2810 break;
2811 case 'X':
830247a4 2812 ret = reg_node(pRExC_state, CLUMP);
a0ed51b3 2813 *flagp |= HASWIDTH;
830247a4 2814 nextchar(pRExC_state);
fac92740 2815 Set_Node_Length(ret, 2); /* MJD */
a0ed51b3 2816 break;
a0d0e21e 2817 case 'w':
ffc61ed2 2818 ret = reg_node(pRExC_state, LOC ? ALNUML : ALNUM);
a0d0e21e 2819 *flagp |= HASWIDTH|SIMPLE;
830247a4 2820 nextchar(pRExC_state);
fac92740 2821 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW
2822 break;
2823 case 'W':
ffc61ed2 2824 ret = reg_node(pRExC_state, LOC ? NALNUML : NALNUM);
a0d0e21e 2825 *flagp |= HASWIDTH|SIMPLE;
830247a4 2826 nextchar(pRExC_state);
fac92740 2827 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW
2828 break;
2829 case 'b':
830247a4
IZ
2830 RExC_seen_zerolen++;
2831 RExC_seen |= REG_SEEN_LOOKBEHIND;
ffc61ed2 2832 ret = reg_node(pRExC_state, LOC ? BOUNDL : BOUND);
a0d0e21e 2833 *flagp |= SIMPLE;
830247a4 2834 nextchar(pRExC_state);
fac92740 2835 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW
2836 break;
2837 case 'B':
830247a4
IZ
2838 RExC_seen_zerolen++;
2839 RExC_seen |= REG_SEEN_LOOKBEHIND;
ffc61ed2 2840 ret = reg_node(pRExC_state, LOC ? NBOUNDL : NBOUND);
a0d0e21e 2841 *flagp |= SIMPLE;
830247a4 2842 nextchar(pRExC_state);
fac92740 2843 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW
2844 break;
2845 case 's':
ffc61ed2 2846 ret = reg_node(pRExC_state, LOC ? SPACEL : SPACE);
a0d0e21e 2847 *flagp |= HASWIDTH|SIMPLE;
830247a4 2848 nextchar(pRExC_state);
fac92740 2849 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW
2850 break;
2851 case 'S':
ffc61ed2 2852 ret = reg_node(pRExC_state, LOC ? NSPACEL : NSPACE);
a0d0e21e 2853 *flagp |= HASWIDTH|SIMPLE;
830247a4 2854 nextchar(pRExC_state);
fac92740 2855 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW
2856 break;
2857 case 'd':
ffc61ed2 2858 ret = reg_node(pRExC_state, DIGIT);
a0d0e21e 2859 *flagp |= HASWIDTH|SIMPLE;
830247a4 2860 nextchar(pRExC_state);
fac92740 2861 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW
2862 break;
2863 case 'D':
ffc61ed2 2864 ret = reg_node(pRExC_state, NDIGIT);
a0d0e21e 2865 *flagp |= HASWIDTH|SIMPLE;
830247a4 2866 nextchar(pRExC_state);
fac92740 2867 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e 2868 break;
a14b48bc
LW
2869 case 'p':
2870 case 'P':
3568d838 2871 {
830247a4 2872 char* oldregxend = RExC_end;
fac92740 2873 char* parse_start = RExC_parse;
a14b48bc 2874
830247a4 2875 if (RExC_parse[1] == '{') {
3568d838 2876 /* a lovely hack--pretend we saw [\pX] instead */
830247a4
IZ
2877 RExC_end = strchr(RExC_parse, '}');
2878 if (!RExC_end) {
0da60cf5 2879 U8 c = (U8)*RExC_parse;
830247a4
IZ
2880 RExC_parse += 2;
2881 RExC_end = oldregxend;
0da60cf5 2882 vFAIL2("Missing right brace on \\%c{}", c);
b45f050a 2883 }
830247a4 2884 RExC_end++;
a14b48bc
LW
2885 }
2886 else
830247a4
IZ
2887 RExC_end = RExC_parse + 2;
2888 RExC_parse--;
a14b48bc 2889
ffc61ed2 2890 ret = regclass(pRExC_state);
a14b48bc 2891
830247a4
IZ
2892 RExC_end = oldregxend;
2893 RExC_parse--;
fac92740 2894 Set_Node_Cur_Length(ret); /* MJD */
830247a4 2895 nextchar(pRExC_state);
a14b48bc
LW
2896 *flagp |= HASWIDTH|SIMPLE;
2897 }
2898 break;
a0d0e21e
LW
2899 case 'n':
2900 case 'r':
2901 case 't':
2902 case 'f':
2903 case 'e':
2904 case 'a':
2905 case 'x':
2906 case 'c':
2907 case '0':
2908 goto defchar;
2909 case '1': case '2': case '3': case '4':
2910 case '5': case '6': case '7': case '8': case '9':
2911 {
830247a4 2912 I32 num = atoi(RExC_parse);
a0d0e21e 2913
830247a4 2914 if (num > 9 && num >= RExC_npar)
a0d0e21e
LW
2915 goto defchar;
2916 else {
fac92740 2917 char * parse_start = RExC_parse - 1; /* MJD */
830247a4
IZ
2918 while (isDIGIT(*RExC_parse))
2919 RExC_parse++;
b45f050a 2920
830247a4 2921 if (!SIZE_ONLY && num > RExC_rx->nparens)
9baa0206 2922 vFAIL("Reference to nonexistent group");
830247a4
IZ
2923 RExC_sawback = 1;
2924 ret = reganode(pRExC_state, FOLD
a0ed51b3 2925 ? (LOC ? REFFL : REFF)
c8756f30 2926 : REF, num);
a0d0e21e 2927 *flagp |= HASWIDTH;
fac92740
MJD
2928
2929 /* override incorrect value set in reganode MJD */
2930 Set_Node_Offset(ret, parse_start+1);
2931 Set_Node_Cur_Length(ret); /* MJD */
830247a4
IZ
2932 RExC_parse--;
2933 nextchar(pRExC_state);
a0d0e21e
LW
2934 }
2935 }
2936 break;
2937 case '\0':
830247a4 2938 if (RExC_parse >= RExC_end)
b45f050a 2939 FAIL("Trailing \\");
a0d0e21e
LW
2940 /* FALL THROUGH */
2941 default:
c9f97d15
IZ
2942 /* Do not generate `unrecognized' warnings here, we fall
2943 back into the quick-grab loop below */
a0d0e21e
LW
2944 goto defchar;
2945 }
2946 break;
4633a7c4
LW
2947
2948 case '#':
830247a4
IZ
2949 if (RExC_flags16 & PMf_EXTENDED) {
2950 while (RExC_parse < RExC_end && *RExC_parse != '\n') RExC_parse++;
2951 if (RExC_parse < RExC_end)
4633a7c4
LW
2952 goto tryagain;
2953 }
2954 /* FALL THROUGH */
2955
a0d0e21e 2956 default: {
ba210ebe 2957 register STRLEN len;
a0ed51b3 2958 register UV ender;
a0d0e21e 2959 register char *p;
c277df42 2960 char *oldp, *s;
ba210ebe 2961 STRLEN numlen;
a2a2844f
JH
2962 STRLEN ulen;
2963 U8 tmpbuf[UTF8_MAXLEN*2+1];
f06dbbb7
JH
2964
2965 parse_start = RExC_parse - 1;
a0d0e21e 2966
830247a4 2967 RExC_parse++;
a0d0e21e
LW
2968
2969 defchar:
830247a4 2970 ret = reg_node(pRExC_state, FOLD
a0ed51b3 2971 ? (LOC ? EXACTFL : EXACTF)
bbce6d69 2972 : EXACT);
cd439c50 2973 s = STRING(ret);
830247a4
IZ
2974 for (len = 0, p = RExC_parse - 1;
2975 len < 127 && p < RExC_end;
a0d0e21e
LW
2976 len++)
2977 {
2978 oldp = p;
5b5a24f7 2979
830247a4
IZ
2980 if (RExC_flags16 & PMf_EXTENDED)
2981 p = regwhite(p, RExC_end);
a0d0e21e
LW
2982 switch (*p) {
2983 case '^':
2984 case '$':
2985 case '.':
2986 case '[':
2987 case '(':
2988 case ')':
2989 case '|':
2990 goto loopdone;
2991 case '\\':
2992 switch (*++p) {
2993 case 'A':
2994 case 'G':
2995 case 'Z':
b85d18e9 2996 case 'z':
a0d0e21e
LW
2997 case 'w':
2998 case 'W':
2999 case 'b':
3000 case 'B':
3001 case 's':
3002 case 'S':
3003 case 'd':
3004 case 'D':
a14b48bc
LW
3005 case 'p':
3006 case 'P':
a0d0e21e
LW
3007 --p;
3008 goto loopdone;
3009 case 'n':
3010 ender = '\n';
3011 p++;
a687059c 3012 break;
a0d0e21e
LW
3013 case 'r':
3014 ender = '\r';
3015 p++;
a687059c 3016 break;
a0d0e21e
LW
3017 case 't':
3018 ender = '\t';
3019 p++;
a687059c 3020 break;
a0d0e21e
LW
3021 case 'f':
3022 ender = '\f';
3023 p++;
a687059c 3024 break;
a0d0e21e 3025 case 'e':
c7f1f016 3026 ender = ASCII_TO_NATIVE('\033');
a0d0e21e 3027 p++;
a687059c 3028 break;
a0d0e21e 3029 case 'a':
c7f1f016 3030 ender = ASCII_TO_NATIVE('\007');
a0d0e21e 3031 p++;
a687059c 3032 break;
a0d0e21e 3033 case 'x':
a0ed51b3
LW
3034 if (*++p == '{') {
3035 char* e = strchr(p, '}');
b81d288d 3036
b45f050a 3037 if (!e) {
830247a4 3038 RExC_parse = p + 1;
b45f050a
JF
3039 vFAIL("Missing right brace on \\x{}");
3040 }
de5f0749 3041 else {
a4c04bdc
NC
3042 I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
3043 | PERL_SCAN_DISALLOW_PREFIX;
53305cf1
NC
3044 numlen = e - p - 1;
3045 ender = grok_hex(p + 1, &numlen, &flags, NULL);
aaa80028
JH
3046 if (ender > 0xff)
3047 RExC_utf8 = 1;
b21ed0a9
GS
3048 /* numlen is generous */
3049 if (numlen + len >= 127) {
a0ed51b3
LW
3050 p--;
3051 goto loopdone;
3052 }
3053 p = e + 1;
3054 }
a0ed51b3
LW
3055 }
3056 else {
a4c04bdc 3057 I32 flags = PERL_SCAN_DISALLOW_PREFIX;
53305cf1
NC
3058 numlen = 2;
3059 ender = grok_hex(p, &numlen, &flags, NULL);
a0ed51b3
LW
3060 p += numlen;
3061 }
a687059c 3062 break;
a0d0e21e
LW
3063 case 'c':
3064 p++;
bbce6d69 3065 ender = UCHARAT(p++);
3066 ender = toCTRL(ender);
a687059c 3067 break;
a0d0e21e
LW
3068 case '0': case '1': case '2': case '3':case '4':
3069 case '5': case '6': case '7': case '8':case '9':
3070 if (*p == '0' ||
830247a4 3071 (isDIGIT(p[1]) && atoi(p) >= RExC_npar) ) {
53305cf1
NC
3072 I32 flags = 0;
3073 numlen = 3;
3074 ender = grok_oct(p, &numlen, &flags, NULL);
a0d0e21e
LW
3075 p += numlen;
3076 }
3077 else {
3078 --p;
3079 goto loopdone;
a687059c
LW
3080 }
3081 break;
a0d0e21e 3082 case '\0':
830247a4 3083 if (p >= RExC_end)
b45f050a 3084 FAIL("Trailing \\");
a687059c 3085 /* FALL THROUGH */
a0d0e21e 3086 default:
e476b1b5 3087 if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(*p))
4193bef7 3088 vWARN2(p + 1, "Unrecognized escape \\%c passed through", UCHARAT(p));
a0ed51b3 3089 goto normal_default;
a0d0e21e
LW
3090 }
3091 break;
a687059c 3092 default:
a0ed51b3 3093 normal_default:
fd400ab9 3094 if (UTF8_IS_START(*p) && UTF) {
5e12f4fb 3095 ender = utf8n_to_uvchr((U8*)p, RExC_end - p,
ba210ebe 3096 &numlen, 0);
a0ed51b3
LW
3097 p += numlen;
3098 }
3099 else
3100 ender = *p++;
a0d0e21e 3101 break;
a687059c 3102 }
830247a4
IZ
3103 if (RExC_flags16 & PMf_EXTENDED)
3104 p = regwhite(p, RExC_end);
a0ed51b3 3105 if (UTF && FOLD) {
a2a2844f
JH
3106 toLOWER_uni(ender, tmpbuf, &ulen);
3107 ender = utf8_to_uvchr(tmpbuf, 0);
a0ed51b3 3108 }
a0d0e21e
LW
3109 if (ISMULT2(p)) { /* Back off on ?+*. */
3110 if (len)
3111 p = oldp;
2b9d42f0 3112 else if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(ender)) && UTF) {
830247a4 3113 reguni(pRExC_state, ender, s, &numlen);
a0ed51b3
LW
3114 s += numlen;
3115 len += numlen;
3116 }
a0d0e21e
LW
3117 else {
3118 len++;
cd439c50 3119 REGC(ender, s++);
a0d0e21e
LW
3120 }
3121 break;
a687059c 3122 }
2b9d42f0 3123 if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(ender)) && UTF) {
830247a4 3124 reguni(pRExC_state, ender, s, &numlen);
a0ed51b3
LW
3125 s += numlen;
3126 len += numlen - 1;
3127 }
3128 else
cd439c50 3129 REGC(ender, s++);
a0d0e21e
LW
3130 }
3131 loopdone:
830247a4 3132 RExC_parse = p - 1;
fac92740 3133 Set_Node_Cur_Length(ret); /* MJD */
830247a4 3134 nextchar(pRExC_state);
793db0cb
JH
3135 {
3136 /* len is STRLEN which is unsigned, need to copy to signed */
3137 IV iv = len;
3138 if (iv < 0)
3139 vFAIL("Internal disaster");
3140 }
a0d0e21e
LW
3141 if (len > 0)
3142 *flagp |= HASWIDTH;
3143 if (len == 1)
3144 *flagp |= SIMPLE;
c277df42 3145 if (!SIZE_ONLY)
cd439c50
IZ
3146 STR_LEN(ret) = len;
3147 if (SIZE_ONLY)
830247a4 3148 RExC_size += STR_SZ(len);
cd439c50 3149 else
830247a4 3150 RExC_emit += STR_SZ(len);
a687059c 3151 }
a0d0e21e
LW
3152 break;
3153 }
a687059c 3154
a72c7584
JH
3155 if (PL_encoding && PL_regkind[(U8)OP(ret)] == EXACT && !RExC_utf8) {
3156 STRLEN oldlen = STR_LEN(ret);
3157 SV *sv = sv_2mortal(newSVpvn(STRING(ret), oldlen));
3158 char *s = Perl_sv_recode_to_utf8(aTHX_ sv, PL_encoding);
3159 STRLEN newlen = SvCUR(sv);
3160 if (!SIZE_ONLY) {
3161 DEBUG_r(PerlIO_printf(Perl_debug_log, "recode %*s to %*s\n",
3162 oldlen, STRING(ret), newlen, s));
3163 Copy(s, STRING(ret), newlen, char);
3164 STR_LEN(ret) += newlen - oldlen;
3165 RExC_emit += STR_SZ(newlen) - STR_SZ(oldlen);
3166 } else
3167 RExC_size += STR_SZ(newlen) - STR_SZ(oldlen);
5ff6fc6d 3168 RExC_utf8 = 1;
a72c7584
JH
3169 }
3170
a0d0e21e 3171 return(ret);
a687059c
LW
3172}
3173
873ef191 3174STATIC char *
cea2e8a9 3175S_regwhite(pTHX_ char *p, char *e)
5b5a24f7
CS
3176{
3177 while (p < e) {
3178 if (isSPACE(*p))
3179 ++p;
3180 else if (*p == '#') {
3181 do {
3182 p++;
3183 } while (p < e && *p != '\n');
3184 }
3185 else
3186 break;
3187 }
3188 return p;
3189}
3190
b8c5462f
JH
3191/* Parse POSIX character classes: [[:foo:]], [[=foo=]], [[.foo.]].
3192 Character classes ([:foo:]) can also be negated ([:^foo:]).
3193 Returns a named class id (ANYOF_XXX) if successful, -1 otherwise.
3194 Equivalence classes ([=foo=]) and composites ([.foo.]) are parsed,
beeb77fc 3195 but trigger failures because they are currently unimplemented. */
9a86a77b
JH
3196
3197#define POSIXCC_DONE(c) ((c) == ':')
3198#define POSIXCC_NOTYET(c) ((c) == '=' || (c) == '.')
3199#define POSIXCC(c) (POSIXCC_DONE(c) || POSIXCC_NOTYET(c))
3200
b8c5462f 3201STATIC I32
830247a4 3202S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
620e46c5
JH
3203{
3204 char *posixcc = 0;
936ed897 3205 I32 namedclass = OOB_NAMEDCLASS;
620e46c5 3206
830247a4 3207 if (value == '[' && RExC_parse + 1 < RExC_end &&
620e46c5 3208 /* I smell either [: or [= or [. -- POSIX has been here, right? */
9a86a77b
JH
3209 POSIXCC(UCHARAT(RExC_parse))) {
3210 char c = UCHARAT(RExC_parse);
830247a4 3211 char* s = RExC_parse++;
b81d288d 3212
9a86a77b 3213 while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != c)
830247a4
IZ
3214 RExC_parse++;
3215 if (RExC_parse == RExC_end)
620e46c5 3216 /* Grandfather lone [:, [=, [. */
830247a4 3217 RExC_parse = s;
620e46c5 3218 else {
830247a4 3219 char* t = RExC_parse++; /* skip over the c */
b8c5462f 3220
9a86a77b 3221 if (UCHARAT(RExC_parse) == ']') {
830247a4 3222 RExC_parse++; /* skip over the ending ] */
b8c5462f
JH
3223 posixcc = s + 1;
3224 if (*s == ':') {
3225 I32 complement = *posixcc == '^' ? *posixcc++ : 0;
3226 I32 skip = 5; /* the most common skip */
3227
3228 switch (*posixcc) {
3229 case 'a':
3230 if (strnEQ(posixcc, "alnum", 5))
3231 namedclass =
3232 complement ? ANYOF_NALNUMC : ANYOF_ALNUMC;
3233 else if (strnEQ(posixcc, "alpha", 5))
3234 namedclass =
3235 complement ? ANYOF_NALPHA : ANYOF_ALPHA;
3236 else if (strnEQ(posixcc, "ascii", 5))
3237 namedclass =
3238 complement ? ANYOF_NASCII : ANYOF_ASCII;
3239 break;
aaa51d5e
JF
3240 case 'b':
3241 if (strnEQ(posixcc, "blank", 5))
3242 namedclass =
3243 complement ? ANYOF_NBLANK : ANYOF_BLANK;
3244 break;
b8c5462f
JH
3245 case 'c':
3246 if (strnEQ(posixcc, "cntrl", 5))
3247 namedclass =
3248 complement ? ANYOF_NCNTRL : ANYOF_CNTRL;
3249 break;
3250 case 'd':
3251 if (strnEQ(posixcc, "digit", 5))
3252 namedclass =
3253 complement ? ANYOF_NDIGIT : ANYOF_DIGIT;
3254 break;
3255 case 'g':
3256 if (strnEQ(posixcc, "graph", 5))
3257 namedclass =
3258 complement ? ANYOF_NGRAPH : ANYOF_GRAPH;
3259 break;
3260 case 'l':
3261 if (strnEQ(posixcc, "lower", 5))
3262 namedclass =
3263 complement ? ANYOF_NLOWER : ANYOF_LOWER;
3264 break;
3265 case 'p':
3266 if (strnEQ(posixcc, "print", 5))
3267 namedclass =
3268 complement ? ANYOF_NPRINT : ANYOF_PRINT;
3269 else if (strnEQ(posixcc, "punct", 5))
3270 namedclass =
3271 complement ? ANYOF_NPUNCT : ANYOF_PUNCT;
3272 break;
3273 case 's':
3274 if (strnEQ(posixcc, "space", 5))
3275 namedclass =
aaa51d5e 3276 complement ? ANYOF_NPSXSPC : ANYOF_PSXSPC;
cc4319de 3277 break;
b8c5462f
JH
3278 case 'u':
3279 if (strnEQ(posixcc, "upper", 5))
3280 namedclass =
3281 complement ? ANYOF_NUPPER : ANYOF_UPPER;
3282 break;
3283 case 'w': /* this is not POSIX, this is the Perl \w */
3284 if (strnEQ(posixcc, "word", 4)) {
3285 namedclass =
3286 complement ? ANYOF_NALNUM : ANYOF_ALNUM;
3287 skip = 4;
3288 }
3289 break;
3290 case 'x':
3291 if (strnEQ(posixcc, "xdigit", 6)) {
3292 namedclass =
3293 complement ? ANYOF_NXDIGIT : ANYOF_XDIGIT;
3294 skip = 6;
3295 }
3296 break;
3297 }
ac561586
JH
3298 if (namedclass == OOB_NAMEDCLASS ||
3299 posixcc[skip] != ':' ||
3300 posixcc[skip+1] != ']')
b45f050a
JF
3301 {
3302 Simple_vFAIL3("POSIX class [:%.*s:] unknown",
3303 t - s - 1, s + 1);
3304 }
3305 } else if (!SIZE_ONLY) {
b8c5462f 3306 /* [[=foo=]] and [[.foo.]] are still future. */
b45f050a 3307
830247a4 3308 /* adjust RExC_parse so the warning shows after
b45f050a 3309 the class closes */
9a86a77b 3310 while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse) != ']')
830247a4 3311 RExC_parse++;
b45f050a
JF
3312 Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
3313 }
b8c5462f
JH
3314 } else {
3315 /* Maternal grandfather:
3316 * "[:" ending in ":" but not in ":]" */
830247a4 3317 RExC_parse = s;
767d463e 3318 }
620e46c5
JH
3319 }
3320 }
3321
b8c5462f
JH
3322 return namedclass;
3323}
3324
3325STATIC void
830247a4 3326S_checkposixcc(pTHX_ RExC_state_t *pRExC_state)
b8c5462f 3327{
e476b1b5 3328 if (!SIZE_ONLY && ckWARN(WARN_REGEXP) &&
9a86a77b 3329 POSIXCC(UCHARAT(RExC_parse))) {
830247a4 3330 char *s = RExC_parse;
93733859 3331 char c = *s++;
b8c5462f
JH
3332
3333 while(*s && isALNUM(*s))
3334 s++;
3335 if (*s && c == *s && s[1] == ']') {
b45f050a
JF
3336 vWARN3(s+2, "POSIX syntax [%c %c] belongs inside character classes", c, c);
3337
3338 /* [[=foo=]] and [[.foo.]] are still future. */
9a86a77b 3339 if (POSIXCC_NOTYET(c)) {
830247a4 3340 /* adjust RExC_parse so the error shows after
b45f050a 3341 the class closes */
9a86a77b 3342 while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse++) != ']')
b45f050a
JF
3343 ;
3344 Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
3345 }
b8c5462f
JH
3346 }
3347 }
620e46c5
JH
3348}
3349
76e3520e 3350STATIC regnode *
830247a4 3351S_regclass(pTHX_ RExC_state_t *pRExC_state)
a687059c 3352{
ffc61ed2 3353 register UV value;
9a86a77b 3354 register UV nextvalue;
3568d838 3355 register IV prevvalue = OOB_UNICODE;
ffc61ed2 3356 register IV range = 0;
c277df42 3357 register regnode *ret;
ba210ebe 3358 STRLEN numlen;
ffc61ed2 3359 IV namedclass;
9c5ffd7c 3360 char *rangebegin = 0;
936ed897 3361 bool need_class = 0;
9c5ffd7c 3362 SV *listsv = Nullsv;
ffc61ed2
JH
3363 register char *e;
3364 UV n;
3568d838 3365 bool optimize_invert = TRUE;
ffc61ed2
JH
3366
3367 ret = reganode(pRExC_state, ANYOF, 0);
3368
3369 if (!SIZE_ONLY)
3370 ANYOF_FLAGS(ret) = 0;
3371
9a86a77b 3372 if (UCHARAT(RExC_parse) == '^') { /* Complement of range. */
ffc61ed2
JH
3373 RExC_naughty++;
3374 RExC_parse++;
3375 if (!SIZE_ONLY)
3376 ANYOF_FLAGS(ret) |= ANYOF_INVERT;
3377 }
a0d0e21e 3378
936ed897 3379 if (SIZE_ONLY)
830247a4 3380 RExC_size += ANYOF_SKIP;
936ed897 3381 else {
830247a4 3382 RExC_emit += ANYOF_SKIP;
936ed897
IZ
3383 if (FOLD)
3384 ANYOF_FLAGS(ret) |= ANYOF_FOLD;
3385 if (LOC)
3386 ANYOF_FLAGS(ret) |= ANYOF_LOCALE;
ffc61ed2
JH
3387 ANYOF_BITMAP_ZERO(ret);
3388 listsv = newSVpvn("# comment\n", 10);
a0d0e21e 3389 }
b8c5462f 3390
9a86a77b
JH
3391 nextvalue = RExC_parse < RExC_end ? UCHARAT(RExC_parse) : 0;
3392
3393 if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && POSIXCC(nextvalue))
830247a4 3394 checkposixcc(pRExC_state);
b8c5462f 3395
9a86a77b 3396 if (UCHARAT(RExC_parse) == ']' || UCHARAT(RExC_parse) == '-')
ffc61ed2
JH
3397 goto charclassloop; /* allow 1st char to be ] or - */
3398
9a86a77b 3399 while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != ']') {
ffc61ed2
JH
3400
3401 charclassloop:
3402
3403 namedclass = OOB_NAMEDCLASS; /* initialize as illegal */
3404
73b437c8 3405 if (!range)
830247a4 3406 rangebegin = RExC_parse;
ffc61ed2 3407 if (UTF) {
5e12f4fb 3408 value = utf8n_to_uvchr((U8*)RExC_parse,
3568d838
JH
3409 RExC_end - RExC_parse,
3410 &numlen, 0);
ffc61ed2
JH
3411 RExC_parse += numlen;
3412 }
3413 else
3414 value = UCHARAT(RExC_parse++);
9a86a77b
JH
3415 nextvalue = RExC_parse < RExC_end ? UCHARAT(RExC_parse) : 0;
3416 if (value == '[' && POSIXCC(nextvalue))
830247a4 3417 namedclass = regpposixcc(pRExC_state, value);
620e46c5 3418 else if (value == '\\') {
ffc61ed2 3419 if (UTF) {
5e12f4fb 3420 value = utf8n_to_uvchr((U8*)RExC_parse,
ffc61ed2
JH
3421 RExC_end - RExC_parse,
3422 &numlen, 0);
3423 RExC_parse += numlen;
3424 }
3425 else
3426 value = UCHARAT(RExC_parse++);
470c3474 3427 /* Some compilers cannot handle switching on 64-bit integer
ffc61ed2 3428 * values, therefore value cannot be an UV. Yes, this will
e2962f66
JH
3429 * be a problem later if we want switch on Unicode.
3430 * A similar issue a little bit later when switching on
3431 * namedclass. --jhi */
ffc61ed2 3432 switch ((I32)value) {
b8c5462f
JH
3433 case 'w': namedclass = ANYOF_ALNUM; break;
3434 case 'W': namedclass = ANYOF_NALNUM; break;
3435 case 's': namedclass = ANYOF_SPACE; break;
3436 case 'S': namedclass = ANYOF_NSPACE; break;
3437 case 'd': namedclass = ANYOF_DIGIT; break;
3438 case 'D': namedclass = ANYOF_NDIGIT; break;
ffc61ed2
JH
3439 case 'p':
3440 case 'P':
3441 if (*RExC_parse == '{') {
0da60cf5 3442 U8 c = (U8)value;
ffc61ed2
JH
3443 e = strchr(RExC_parse++, '}');
3444 if (!e)
0da60cf5 3445 vFAIL2("Missing right brace on \\%c{}", c);
ab13f0c7
JH
3446 while (isSPACE(UCHARAT(RExC_parse)))
3447 RExC_parse++;
3448 if (e == RExC_parse)
0da60cf5 3449 vFAIL2("Empty \\%c{}", c);
ffc61ed2