This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(??{ }) anomaly
[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 ****
be3c0a43 72 **** Copyright (c) 1991-2002, 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
5d1c421c
JH		 661/*
662 * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
663 * These need to be revisited when a newer toolchain becomes available.
664 */
665#if defined(__sparc64__) && defined(__GNUC__)
666# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
667# undef SPARC64_GCC_WORKAROUND
668# define SPARC64_GCC_WORKAROUND 1
669# endif
670#endif
671
653099ff
GS		 672/* REx optimizer. Converts nodes into quickier variants "in place".
673 Finds fixed substrings. */
674
c277df42
IZ		 675/* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set
676 to the position after last scanned or to NULL. */
677
76e3520e 678STATIC I32
830247a4 679S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags)
c277df42
IZ		 680 /* scanp: Start here (read-write). */
681 /* deltap: Write maxlen-minlen here. */
682 /* last: Stop before this one. */
683{
684 I32 min = 0, pars = 0, code;
685 regnode *scan = *scanp, *next;
686 I32 delta = 0;
687 int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
aca2d497 688 int is_inf_internal = 0; /* The studied chunk is infinite */
c277df42
IZ		 689 I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
690 scan_data_t data_fake;
653099ff 691 struct regnode_charclass_class and_with; /* Valid if flags & SCF_DO_STCLASS_OR */
b81d288d 692
c277df42
IZ		 693 while (scan && OP(scan) != END && scan < last) {
694 /* Peephole optimizer: */
695
22c35a8c 696 if (PL_regkind[(U8)OP(scan)] == EXACT) {
653099ff 697 /* Merge several consecutive EXACTish nodes into one. */
c277df42
IZ		 698 regnode *n = regnext(scan);
699 U32 stringok = 1;
700#ifdef DEBUGGING
701 regnode *stop = scan;
b81d288d 702#endif
c277df42 703
cd439c50 704 next = scan + NODE_SZ_STR(scan);
c277df42
IZ		 705 /* Skip NOTHING, merge EXACT*. */
706 while (n &&
b81d288d 707 ( PL_regkind[(U8)OP(n)] == NOTHING ||
c277df42
IZ		 708 (stringok && (OP(n) == OP(scan))))
709 && NEXT_OFF(n)
710 && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
711 if (OP(n) == TAIL || n > next)
712 stringok = 0;
22c35a8c 713 if (PL_regkind[(U8)OP(n)] == NOTHING) {
c277df42
IZ		 714 NEXT_OFF(scan) += NEXT_OFF(n);
715 next = n + NODE_STEP_REGNODE;
716#ifdef DEBUGGING
717 if (stringok)
718 stop = n;
b81d288d 719#endif
c277df42 720 n = regnext(n);
a0ed51b3 721 }
f49d4d0f 722 else if (stringok) {
cd439c50 723 int oldl = STR_LEN(scan);
c277df42 724 regnode *nnext = regnext(n);
f49d4d0f 725
b81d288d 726 if (oldl + STR_LEN(n) > U8_MAX)
c277df42
IZ		 727 break;
728 NEXT_OFF(scan) += NEXT_OFF(n);
cd439c50
IZ		 729 STR_LEN(scan) += STR_LEN(n);
730 next = n + NODE_SZ_STR(n);
c277df42 731 /* Now we can overwrite *n : */
f49d4d0f 732 Move(STRING(n), STRING(scan) + oldl, STR_LEN(n), char);
c277df42 733#ifdef DEBUGGING
f49d4d0f 734 stop = next - 1;
b81d288d 735#endif
c277df42
IZ		 736 n = nnext;
737 }
738 }
61a36c01 739
d65e4eab 740 if (UTF && OP(scan) == EXACTF && STR_LEN(scan) >= 6) {
61a36c01
JH		 741/*
742 Two problematic code points in Unicode casefolding of EXACT nodes:
743
744 U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
745 U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
746
747 which casefold to
748
749 Unicode UTF-8
750
751 U+03B9 U+0308 U+0301 0xCE 0xB9 0xCC 0x88 0xCC 0x81
752 U+03C5 U+0308 U+0301 0xCF 0x85 0xCC 0x88 0xCC 0x81
753
754 This means that in case-insensitive matching (or "loose matching",
755 as Unicode calls it), an EXACTF of length six (the UTF-8 encoded byte
756 length of the above casefolded versions) can match a target string
757 of length two (the byte length of UTF-8 encoded U+0390 or U+03B0).
758 This would rather mess up the minimum length computation.
759
760 What we'll do is to look for the tail four bytes, and then peek
761 at the preceding two bytes to see whether we need to decrease
762 the minimum length by four (six minus two).
763
764 Thanks to the design of UTF-8, there cannot be false matches:
765 A sequence of valid UTF-8 bytes cannot be a subsequence of
766 another valid sequence of UTF-8 bytes.
767
768*/
769 char *s0 = STRING(scan), *s, *t;
770 char *s1 = s0 + STR_LEN(scan) - 1, *s2 = s1 - 4;
771 char *t0 = "\xcc\x88\xcc\x81";
772 char *t1 = t0 + 3;
773
774 for (s = s0 + 2;
775 s < s2 && (t = ninstr(s, s1, t0, t1));
776 s = t + 4) {
777 if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
778 ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
779 min -= 4;
780 }
781 }
782
c277df42
IZ		 783#ifdef DEBUGGING
784 /* Allow dumping */
cd439c50 785 n = scan + NODE_SZ_STR(scan);
c277df42 786 while (n <= stop) {
22c35a8c 787 if (PL_regkind[(U8)OP(n)] != NOTHING || OP(n) == NOTHING) {
c277df42
IZ		 788 OP(n) = OPTIMIZED;
789 NEXT_OFF(n) = 0;
790 }
791 n++;
792 }
653099ff 793#endif
c277df42 794 }
653099ff
GS		 795 /* Follow the next-chain of the current node and optimize
796 away all the NOTHINGs from it. */
c277df42 797 if (OP(scan) != CURLYX) {
048cfca1
GS		 798 int max = (reg_off_by_arg[OP(scan)]
799 ? I32_MAX
800 /* I32 may be smaller than U16 on CRAYs! */
801 : (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
c277df42
IZ		 802 int off = (reg_off_by_arg[OP(scan)] ? ARG(scan) : NEXT_OFF(scan));
803 int noff;
804 regnode *n = scan;
b81d288d 805
c277df42
IZ		 806 /* Skip NOTHING and LONGJMP. */
807 while ((n = regnext(n))
22c35a8c 808 && ((PL_regkind[(U8)OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
c277df42
IZ		 809 || ((OP(n) == LONGJMP) && (noff = ARG(n))))
810 && off + noff < max)
811 off += noff;
812 if (reg_off_by_arg[OP(scan)])
813 ARG(scan) = off;
b81d288d 814 else
c277df42
IZ		 815 NEXT_OFF(scan) = off;
816 }
653099ff
GS		 817 /* The principal pseudo-switch. Cannot be a switch, since we
818 look into several different things. */
b81d288d 819 if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
c277df42
IZ		 820 || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
821 next = regnext(scan);
822 code = OP(scan);
b81d288d
AB		 823
824 if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
c277df42 825 I32 max1 = 0, min1 = I32_MAX, num = 0;
653099ff 826 struct regnode_charclass_class accum;
c277df42 827
653099ff 828 if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
830247a4 829 scan_commit(pRExC_state, data); /* Cannot merge strings after this. */
653099ff 830 if (flags & SCF_DO_STCLASS)
830247a4 831 cl_init_zero(pRExC_state, &accum);
c277df42 832 while (OP(scan) == code) {
830247a4 833 I32 deltanext, minnext, f = 0, fake;
653099ff 834 struct regnode_charclass_class this_class;
c277df42
IZ		 835
836 num++;
837 data_fake.flags = 0;
b81d288d 838 if (data) {
2c2d71f5 839 data_fake.whilem_c = data->whilem_c;
cb434fcc
IZ		 840 data_fake.last_closep = data->last_closep;
841 }
842 else
843 data_fake.last_closep = &fake;
c277df42
IZ		 844 next = regnext(scan);
845 scan = NEXTOPER(scan);
846 if (code != BRANCH)
847 scan = NEXTOPER(scan);
653099ff 848 if (flags & SCF_DO_STCLASS) {
830247a4 849 cl_init(pRExC_state, &this_class);
653099ff
GS		 850 data_fake.start_class = &this_class;
851 f = SCF_DO_STCLASS_AND;
b81d288d 852 }
e1901655
IZ		 853 if (flags & SCF_WHILEM_VISITED_POS)
854 f |= SCF_WHILEM_VISITED_POS;
653099ff 855 /* we suppose the run is continuous, last=next...*/
830247a4
IZ		 856 minnext = study_chunk(pRExC_state, &scan, &deltanext,
857 next, &data_fake, f);
b81d288d 858 if (min1 > minnext)
c277df42
IZ		 859 min1 = minnext;
860 if (max1 < minnext + deltanext)
861 max1 = minnext + deltanext;
862 if (deltanext == I32_MAX)
aca2d497 863 is_inf = is_inf_internal = 1;
c277df42
IZ		 864 scan = next;
865 if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
866 pars++;
405ff068 867 if (data && (data_fake.flags & SF_HAS_EVAL))
c277df42 868 data->flags |= SF_HAS_EVAL;
2c2d71f5
JH		 869 if (data)
870 data->whilem_c = data_fake.whilem_c;
653099ff 871 if (flags & SCF_DO_STCLASS)
830247a4 872 cl_or(pRExC_state, &accum, &this_class);
b81d288d 873 if (code == SUSPEND)
c277df42
IZ		 874 break;
875 }
876 if (code == IFTHEN && num < 2) /* Empty ELSE branch */
877 min1 = 0;
878 if (flags & SCF_DO_SUBSTR) {
879 data->pos_min += min1;
880 data->pos_delta += max1 - min1;
881 if (max1 != min1 || is_inf)
882 data->longest = &(data->longest_float);
883 }
884 min += min1;
885 delta += max1 - min1;
653099ff 886 if (flags & SCF_DO_STCLASS_OR) {
830247a4 887 cl_or(pRExC_state, data->start_class, &accum);
653099ff
GS		 888 if (min1) {
889 cl_and(data->start_class, &and_with);
890 flags &= ~SCF_DO_STCLASS;
891 }
892 }
893 else if (flags & SCF_DO_STCLASS_AND) {
de0c8cb8
GS		 894 if (min1) {
895 cl_and(data->start_class, &accum);
653099ff 896 flags &= ~SCF_DO_STCLASS;
de0c8cb8
GS		 897 }
898 else {
b81d288d 899 /* Switch to OR mode: cache the old value of
de0c8cb8
GS		 900 * data->start_class */
901 StructCopy(data->start_class, &and_with,
902 struct regnode_charclass_class);
903 flags &= ~SCF_DO_STCLASS_AND;
904 StructCopy(&accum, data->start_class,
905 struct regnode_charclass_class);
906 flags |= SCF_DO_STCLASS_OR;
907 data->start_class->flags |= ANYOF_EOS;
908 }
653099ff 909 }
a0ed51b3
LW		 910 }
911 else if (code == BRANCHJ) /* single branch is optimized. */
c277df42
IZ		 912 scan = NEXTOPER(NEXTOPER(scan));
913 else /* single branch is optimized. */
914 scan = NEXTOPER(scan);
915 continue;
a0ed51b3
LW		 916 }
917 else if (OP(scan) == EXACT) {
cd439c50 918 I32 l = STR_LEN(scan);
1aa99e6b 919 UV uc = *((U8*)STRING(scan));
a0ed51b3 920 if (UTF) {
1aa99e6b
IH		 921 U8 *s = (U8*)STRING(scan);
922 l = utf8_length(s, s + l);
9041c2e3 923 uc = utf8_to_uvchr(s, NULL);
a0ed51b3
LW		 924 }
925 min += l;
c277df42 926 if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */
c277df42
IZ		 927 /* The code below prefers earlier match for fixed
928 offset, later match for variable offset. */
929 if (data->last_end == -1) { /* Update the start info. */
930 data->last_start_min = data->pos_min;
931 data->last_start_max = is_inf
b81d288d 932 ? I32_MAX : data->pos_min + data->pos_delta;
c277df42 933 }
cd439c50 934 sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
c277df42
IZ		 935 data->last_end = data->pos_min + l;
936 data->pos_min += l; /* As in the first entry. */
937 data->flags &= ~SF_BEFORE_EOL;
938 }
653099ff
GS		 939 if (flags & SCF_DO_STCLASS_AND) {
940 /* Check whether it is compatible with what we know already! */
941 int compat = 1;
942
1aa99e6b 943 if (uc >= 0x100 ||
516a5887 944 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
1aa99e6b 945 && !ANYOF_BITMAP_TEST(data->start_class, uc)
653099ff 946 && (!(data->start_class->flags & ANYOF_FOLD)
1aa99e6b 947 || !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
516a5887 948 )
653099ff
GS		 949 compat = 0;
950 ANYOF_CLASS_ZERO(data->start_class);
951 ANYOF_BITMAP_ZERO(data->start_class);
952 if (compat)
1aa99e6b 953 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff 954 data->start_class->flags &= ~ANYOF_EOS;
9b877dbb
IH		 955 if (uc < 0x100)
956 data->start_class->flags &= ~ANYOF_UNICODE_ALL;
653099ff
GS		 957 }
958 else if (flags & SCF_DO_STCLASS_OR) {
959 /* false positive possible if the class is case-folded */
1aa99e6b 960 if (uc < 0x100)
9b877dbb
IH		 961 ANYOF_BITMAP_SET(data->start_class, uc);
962 else
963 data->start_class->flags |= ANYOF_UNICODE_ALL;
653099ff
GS		 964 data->start_class->flags &= ~ANYOF_EOS;
965 cl_and(data->start_class, &and_with);
966 }
967 flags &= ~SCF_DO_STCLASS;
a0ed51b3 968 }
653099ff 969 else if (PL_regkind[(U8)OP(scan)] == EXACT) { /* But OP != EXACT! */
cd439c50 970 I32 l = STR_LEN(scan);
1aa99e6b 971 UV uc = *((U8*)STRING(scan));
653099ff
GS		 972
973 /* Search for fixed substrings supports EXACT only. */
b81d288d 974 if (flags & SCF_DO_SUBSTR)
830247a4 975 scan_commit(pRExC_state, data);
a0ed51b3 976 if (UTF) {
1aa99e6b
IH		 977 U8 *s = (U8 *)STRING(scan);
978 l = utf8_length(s, s + l);
9041c2e3 979 uc = utf8_to_uvchr(s, NULL);
a0ed51b3
LW		 980 }
981 min += l;
c277df42 982 if (data && (flags & SCF_DO_SUBSTR))
a0ed51b3 983 data->pos_min += l;
653099ff
GS		 984 if (flags & SCF_DO_STCLASS_AND) {
985 /* Check whether it is compatible with what we know already! */
986 int compat = 1;
987
1aa99e6b 988 if (uc >= 0x100 ||
516a5887 989 (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE))
1aa99e6b 990 && !ANYOF_BITMAP_TEST(data->start_class, uc)
516a5887 991 && !ANYOF_BITMAP_TEST(data->start_class, PL_fold[uc])))
653099ff
GS		 992 compat = 0;
993 ANYOF_CLASS_ZERO(data->start_class);
994 ANYOF_BITMAP_ZERO(data->start_class);
995 if (compat) {
1aa99e6b 996 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff
GS		 997 data->start_class->flags &= ~ANYOF_EOS;
998 data->start_class->flags |= ANYOF_FOLD;
999 if (OP(scan) == EXACTFL)
1000 data->start_class->flags |= ANYOF_LOCALE;
1001 }
1002 }
1003 else if (flags & SCF_DO_STCLASS_OR) {
1004 if (data->start_class->flags & ANYOF_FOLD) {
1005 /* false positive possible if the class is case-folded.
1006 Assume that the locale settings are the same... */
1aa99e6b
IH		 1007 if (uc < 0x100)
1008 ANYOF_BITMAP_SET(data->start_class, uc);
653099ff
GS		 1009 data->start_class->flags &= ~ANYOF_EOS;
1010 }
1011 cl_and(data->start_class, &and_with);
1012 }
1013 flags &= ~SCF_DO_STCLASS;
a0ed51b3 1014 }
4d61ec05 1015 else if (strchr((char*)PL_varies,OP(scan))) {
9c5ffd7c 1016 I32 mincount, maxcount, minnext, deltanext, fl = 0;
aa7a4b56 1017 I32 f = flags, pos_before = 0;
c277df42 1018 regnode *oscan = scan;
653099ff
GS		 1019 struct regnode_charclass_class this_class;
1020 struct regnode_charclass_class *oclass = NULL;
727f22e3 1021 I32 next_is_eval = 0;
653099ff 1022
22c35a8c 1023 switch (PL_regkind[(U8)OP(scan)]) {
653099ff 1024 case WHILEM: /* End of (?:...)* . */
c277df42
IZ		 1025 scan = NEXTOPER(scan);
1026 goto finish;
1027 case PLUS:
653099ff 1028 if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) {
c277df42 1029 next = NEXTOPER(scan);
653099ff 1030 if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) {
b81d288d
AB		 1031 mincount = 1;
1032 maxcount = REG_INFTY;
c277df42
IZ		 1033 next = regnext(scan);
1034 scan = NEXTOPER(scan);
1035 goto do_curly;
1036 }
1037 }
1038 if (flags & SCF_DO_SUBSTR)
1039 data->pos_min++;
1040 min++;
1041 /* Fall through. */
1042 case STAR:
653099ff
GS		 1043 if (flags & SCF_DO_STCLASS) {
1044 mincount = 0;
b81d288d 1045 maxcount = REG_INFTY;
653099ff
GS		 1046 next = regnext(scan);
1047 scan = NEXTOPER(scan);
1048 goto do_curly;
1049 }
b81d288d 1050 is_inf = is_inf_internal = 1;
c277df42
IZ		 1051 scan = regnext(scan);
1052 if (flags & SCF_DO_SUBSTR) {
830247a4 1053 scan_commit(pRExC_state, data); /* Cannot extend fixed substrings */
c277df42
IZ		 1054 data->longest = &(data->longest_float);
1055 }
1056 goto optimize_curly_tail;
1057 case CURLY:
b81d288d 1058 mincount = ARG1(scan);
c277df42
IZ		 1059 maxcount = ARG2(scan);
1060 next = regnext(scan);
cb434fcc
IZ		 1061 if (OP(scan) == CURLYX) {
1062 I32 lp = (data ? *(data->last_closep) : 0);
1063
1064 scan->flags = ((lp <= U8_MAX) ? lp : U8_MAX);
1065 }
c277df42 1066 scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
727f22e3 1067 next_is_eval = (OP(scan) == EVAL);
c277df42
IZ		 1068 do_curly:
1069 if (flags & SCF_DO_SUBSTR) {
830247a4 1070 if (mincount == 0) scan_commit(pRExC_state,data); /* Cannot extend fixed substrings */
c277df42
IZ		 1071 pos_before = data->pos_min;
1072 }
1073 if (data) {
1074 fl = data->flags;
1075 data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL);
1076 if (is_inf)
1077 data->flags |= SF_IS_INF;
1078 }
653099ff 1079 if (flags & SCF_DO_STCLASS) {
830247a4 1080 cl_init(pRExC_state, &this_class);
653099ff
GS		 1081 oclass = data->start_class;
1082 data->start_class = &this_class;
1083 f |= SCF_DO_STCLASS_AND;
1084 f &= ~SCF_DO_STCLASS_OR;
1085 }
e1901655
IZ		 1086 /* These are the cases when once a subexpression
1087 fails at a particular position, it cannot succeed
1088 even after backtracking at the enclosing scope.
b81d288d 1089
e1901655
IZ		 1090 XXXX what if minimal match and we are at the
1091 initial run of {n,m}? */
1092 if ((mincount != maxcount - 1) && (maxcount != REG_INFTY))
1093 f &= ~SCF_WHILEM_VISITED_POS;
653099ff 1094
c277df42 1095 /* This will finish on WHILEM, setting scan, or on NULL: */
b81d288d
AB		 1096 minnext = study_chunk(pRExC_state, &scan, &deltanext, last, data,
1097 mincount == 0
653099ff
GS		 1098 ? (f & ~SCF_DO_SUBSTR) : f);
1099
1100 if (flags & SCF_DO_STCLASS)
1101 data->start_class = oclass;
1102 if (mincount == 0 || minnext == 0) {
1103 if (flags & SCF_DO_STCLASS_OR) {
830247a4 1104 cl_or(pRExC_state, data->start_class, &this_class);
653099ff
GS		 1105 }
1106 else if (flags & SCF_DO_STCLASS_AND) {
b81d288d 1107 /* Switch to OR mode: cache the old value of
653099ff
GS		 1108 * data->start_class */
1109 StructCopy(data->start_class, &and_with,
1110 struct regnode_charclass_class);
1111 flags &= ~SCF_DO_STCLASS_AND;
1112 StructCopy(&this_class, data->start_class,
1113 struct regnode_charclass_class);
1114 flags |= SCF_DO_STCLASS_OR;
1115 data->start_class->flags |= ANYOF_EOS;
1116 }
1117 } else { /* Non-zero len */
1118 if (flags & SCF_DO_STCLASS_OR) {
830247a4 1119 cl_or(pRExC_state, data->start_class, &this_class);
653099ff
GS		 1120 cl_and(data->start_class, &and_with);
1121 }
1122 else if (flags & SCF_DO_STCLASS_AND)
1123 cl_and(data->start_class, &this_class);
1124 flags &= ~SCF_DO_STCLASS;
1125 }
c277df42
IZ		 1126 if (!scan) /* It was not CURLYX, but CURLY. */
1127 scan = next;
84037bb0 1128 if (ckWARN(WARN_REGEXP)
727f22e3
JP		 1129 /* ? quantifier ok, except for (?{ ... }) */
1130 && (next_is_eval || !(mincount == 0 && maxcount == 1))
84037bb0 1131 && (minnext == 0) && (deltanext == 0)
99799961 1132 && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
17feb5d5 1133 && maxcount <= REG_INFTY/3) /* Complement check for big count */
b45f050a 1134 {
830247a4 1135 vWARN(RExC_parse,
b45f050a
JF		 1136 "Quantifier unexpected on zero-length expression");
1137 }
1138
c277df42 1139 min += minnext * mincount;
b81d288d 1140 is_inf_internal |= ((maxcount == REG_INFTY
155aba94
GS		 1141 && (minnext + deltanext) > 0)
1142 || deltanext == I32_MAX);
aca2d497 1143 is_inf |= is_inf_internal;
c277df42
IZ		 1144 delta += (minnext + deltanext) * maxcount - minnext * mincount;
1145
1146 /* Try powerful optimization CURLYX => CURLYN. */
b81d288d 1147 if ( OP(oscan) == CURLYX && data
c277df42
IZ		 1148 && data->flags & SF_IN_PAR
1149 && !(data->flags & SF_HAS_EVAL)
1150 && !deltanext && minnext == 1 ) {
1151 /* Try to optimize to CURLYN. */
1152 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
497b47a8
JH		 1153 regnode *nxt1 = nxt;
1154#ifdef DEBUGGING
1155 regnode *nxt2;
1156#endif
c277df42
IZ		 1157
1158 /* Skip open. */
1159 nxt = regnext(nxt);
4d61ec05 1160 if (!strchr((char*)PL_simple,OP(nxt))
22c35a8c 1161 && !(PL_regkind[(U8)OP(nxt)] == EXACT
b81d288d 1162 && STR_LEN(nxt) == 1))
c277df42 1163 goto nogo;
497b47a8 1164#ifdef DEBUGGING
c277df42 1165 nxt2 = nxt;
497b47a8 1166#endif
c277df42 1167 nxt = regnext(nxt);
b81d288d 1168 if (OP(nxt) != CLOSE)
c277df42
IZ		 1169 goto nogo;
1170 /* Now we know that nxt2 is the only contents: */
1171 oscan->flags = ARG(nxt);
1172 OP(oscan) = CURLYN;
1173 OP(nxt1) = NOTHING; /* was OPEN. */
1174#ifdef DEBUGGING
1175 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
1176 NEXT_OFF(nxt1+ 1) = 0; /* just for consistancy. */
1177 NEXT_OFF(nxt2) = 0; /* just for consistancy with CURLY. */
1178 OP(nxt) = OPTIMIZED; /* was CLOSE. */
1179 OP(nxt + 1) = OPTIMIZED; /* was count. */
1180 NEXT_OFF(nxt+ 1) = 0; /* just for consistancy. */
b81d288d 1181#endif
c277df42 1182 }
c277df42
IZ		 1183 nogo:
1184
1185 /* Try optimization CURLYX => CURLYM. */
b81d288d 1186 if ( OP(oscan) == CURLYX && data
c277df42 1187 && !(data->flags & SF_HAS_PAR)
c277df42
IZ		 1188 && !(data->flags & SF_HAS_EVAL)
1189 && !deltanext ) {
1190 /* XXXX How to optimize if data == 0? */
1191 /* Optimize to a simpler form. */
1192 regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */
1193 regnode *nxt2;
1194
1195 OP(oscan) = CURLYM;
1196 while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/
b81d288d 1197 && (OP(nxt2) != WHILEM))
c277df42
IZ		 1198 nxt = nxt2;
1199 OP(nxt2) = SUCCEED; /* Whas WHILEM */
c277df42
IZ		 1200 /* Need to optimize away parenths. */
1201 if (data->flags & SF_IN_PAR) {
1202 /* Set the parenth number. */
1203 regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/
1204
b81d288d 1205 if (OP(nxt) != CLOSE)
b45f050a 1206 FAIL("Panic opt close");
c277df42
IZ		 1207 oscan->flags = ARG(nxt);
1208 OP(nxt1) = OPTIMIZED; /* was OPEN. */
1209 OP(nxt) = OPTIMIZED; /* was CLOSE. */
1210#ifdef DEBUGGING
1211 OP(nxt1 + 1) = OPTIMIZED; /* was count. */
1212 OP(nxt + 1) = OPTIMIZED; /* was count. */
1213 NEXT_OFF(nxt1 + 1) = 0; /* just for consistancy. */
1214 NEXT_OFF(nxt + 1) = 0; /* just for consistancy. */
b81d288d 1215#endif
c277df42
IZ		 1216#if 0
1217 while ( nxt1 && (OP(nxt1) != WHILEM)) {
1218 regnode *nnxt = regnext(nxt1);
b81d288d 1219
c277df42
IZ		 1220 if (nnxt == nxt) {
1221 if (reg_off_by_arg[OP(nxt1)])
1222 ARG_SET(nxt1, nxt2 - nxt1);
1223 else if (nxt2 - nxt1 < U16_MAX)
1224 NEXT_OFF(nxt1) = nxt2 - nxt1;
1225 else
1226 OP(nxt) = NOTHING; /* Cannot beautify */
1227 }
1228 nxt1 = nnxt;
1229 }
1230#endif
1231 /* Optimize again: */
b81d288d 1232 study_chunk(pRExC_state, &nxt1, &deltanext, nxt,
e1901655 1233 NULL, 0);
a0ed51b3
LW		 1234 }
1235 else
c277df42 1236 oscan->flags = 0;
c277df42 1237 }
e1901655
IZ		 1238 else if ((OP(oscan) == CURLYX)
1239 && (flags & SCF_WHILEM_VISITED_POS)
1240 /* See the comment on a similar expression above.
1241 However, this time it not a subexpression
1242 we care about, but the expression itself. */
1243 && (maxcount == REG_INFTY)
1244 && data && ++data->whilem_c < 16) {
1245 /* This stays as CURLYX, we can put the count/of pair. */
2c2d71f5
JH		 1246 /* Find WHILEM (as in regexec.c) */
1247 regnode *nxt = oscan + NEXT_OFF(oscan);
1248
1249 if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */
1250 nxt += ARG(nxt);
1251 PREVOPER(nxt)->flags = data->whilem_c
830247a4 1252 | (RExC_whilem_seen << 4); /* On WHILEM */
2c2d71f5 1253 }
b81d288d 1254 if (data && fl & (SF_HAS_PAR|SF_IN_PAR))
c277df42
IZ		 1255 pars++;
1256 if (flags & SCF_DO_SUBSTR) {
1257 SV *last_str = Nullsv;
1258 int counted = mincount != 0;
1259
1260 if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
5d1c421c
JH		 1261#if defined(SPARC64_GCC_WORKAROUND)
1262 I32 b = 0;
1263 STRLEN l = 0;
1264 char *s = NULL;
1265 I32 old = 0;
1266
1267 if (pos_before >= data->last_start_min)
1268 b = pos_before;
1269 else
1270 b = data->last_start_min;
1271
1272 l = 0;
1273 s = SvPV(data->last_found, l);
1274 old = b - data->last_start_min;
1275
1276#else
b81d288d 1277 I32 b = pos_before >= data->last_start_min
c277df42
IZ		 1278 ? pos_before : data->last_start_min;
1279 STRLEN l;
1280 char *s = SvPV(data->last_found, l);
a0ed51b3 1281 I32 old = b - data->last_start_min;
5d1c421c 1282#endif
a0ed51b3
LW		 1283
1284 if (UTF)
1285 old = utf8_hop((U8*)s, old) - (U8*)s;
c277df42 1286
a0ed51b3 1287 l -= old;
c277df42 1288 /* Get the added string: */
79cb57f6 1289 last_str = newSVpvn(s + old, l);
c277df42
IZ		 1290 if (deltanext == 0 && pos_before == b) {
1291 /* What was added is a constant string */
1292 if (mincount > 1) {
1293 SvGROW(last_str, (mincount * l) + 1);
b81d288d 1294 repeatcpy(SvPVX(last_str) + l,
c277df42
IZ		 1295 SvPVX(last_str), l, mincount - 1);
1296 SvCUR(last_str) *= mincount;
1297 /* Add additional parts. */
b81d288d 1298 SvCUR_set(data->last_found,
c277df42
IZ		 1299 SvCUR(data->last_found) - l);
1300 sv_catsv(data->last_found, last_str);
1301 data->last_end += l * (mincount - 1);
1302 }
2a8d9689
HS		 1303 } else {
1304 /* start offset must point into the last copy */
1305 data->last_start_min += minnext * (mincount - 1);
4b2cff9a
HS		 1306 data->last_start_max += is_inf ? 0 : (maxcount - 1)
1307 * (minnext + data->pos_delta);
c277df42
IZ		 1308 }
1309 }
1310 /* It is counted once already... */
1311 data->pos_min += minnext * (mincount - counted);
1312 data->pos_delta += - counted * deltanext +
1313 (minnext + deltanext) * maxcount - minnext * mincount;
1314 if (mincount != maxcount) {
653099ff
GS		 1315 /* Cannot extend fixed substrings found inside
1316 the group. */
830247a4 1317 scan_commit(pRExC_state,data);
c277df42
IZ		 1318 if (mincount && last_str) {
1319 sv_setsv(data->last_found, last_str);
1320 data->last_end = data->pos_min;
b81d288d 1321 data->last_start_min =
a0ed51b3 1322 data->pos_min - CHR_SVLEN(last_str);
b81d288d
AB		 1323 data->last_start_max = is_inf
1324 ? I32_MAX
c277df42 1325 : data->pos_min + data->pos_delta
a0ed51b3 1326 - CHR_SVLEN(last_str);
c277df42
IZ		 1327 }
1328 data->longest = &(data->longest_float);
1329 }
aca2d497 1330 SvREFCNT_dec(last_str);
c277df42 1331 }
405ff068 1332 if (data && (fl & SF_HAS_EVAL))
c277df42
IZ		 1333 data->flags |= SF_HAS_EVAL;
1334 optimize_curly_tail:
c277df42 1335 if (OP(oscan) != CURLYX) {
22c35a8c 1336 while (PL_regkind[(U8)OP(next = regnext(oscan))] == NOTHING
c277df42
IZ		 1337 && NEXT_OFF(next))
1338 NEXT_OFF(oscan) += NEXT_OFF(next);
1339 }
c277df42 1340 continue;
653099ff 1341 default: /* REF and CLUMP only? */
c277df42 1342 if (flags & SCF_DO_SUBSTR) {
830247a4 1343 scan_commit(pRExC_state,data); /* Cannot expect anything... */
c277df42
IZ		 1344 data->longest = &(data->longest_float);
1345 }
aca2d497 1346 is_inf = is_inf_internal = 1;
653099ff 1347 if (flags & SCF_DO_STCLASS_OR)
830247a4 1348 cl_anything(pRExC_state, data->start_class);
653099ff 1349 flags &= ~SCF_DO_STCLASS;
c277df42
IZ		 1350 break;
1351 }
a0ed51b3 1352 }
ffc61ed2 1353 else if (strchr((char*)PL_simple,OP(scan))) {
9c5ffd7c 1354 int value = 0;
653099ff 1355
c277df42 1356 if (flags & SCF_DO_SUBSTR) {
830247a4 1357 scan_commit(pRExC_state,data);
c277df42
IZ		 1358 data->pos_min++;
1359 }
1360 min++;
653099ff
GS		 1361 if (flags & SCF_DO_STCLASS) {
1362 data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */
1363
1364 /* Some of the logic below assumes that switching
1365 locale on will only add false positives. */
1366 switch (PL_regkind[(U8)OP(scan)]) {
653099ff 1367 case SANY:
653099ff
GS		 1368 default:
1369 do_default:
1370 /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */
1371 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
830247a4 1372 cl_anything(pRExC_state, data->start_class);
653099ff
GS		 1373 break;
1374 case REG_ANY:
1375 if (OP(scan) == SANY)
1376 goto do_default;
1377 if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */
1378 value = (ANYOF_BITMAP_TEST(data->start_class,'\n')
1379 || (data->start_class->flags & ANYOF_CLASS));
830247a4 1380 cl_anything(pRExC_state, data->start_class);
653099ff
GS		 1381 }
1382 if (flags & SCF_DO_STCLASS_AND || !value)
1383 ANYOF_BITMAP_CLEAR(data->start_class,'\n');
1384 break;
1385 case ANYOF:
1386 if (flags & SCF_DO_STCLASS_AND)
1387 cl_and(data->start_class,
1388 (struct regnode_charclass_class*)scan);
1389 else
830247a4 1390 cl_or(pRExC_state, data->start_class,
653099ff
GS		 1391 (struct regnode_charclass_class*)scan);
1392 break;
1393 case ALNUM:
1394 if (flags & SCF_DO_STCLASS_AND) {
1395 if (!(data->start_class->flags & ANYOF_LOCALE)) {
1396 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
1397 for (value = 0; value < 256; value++)
1398 if (!isALNUM(value))
1399 ANYOF_BITMAP_CLEAR(data->start_class, value);
1400 }
1401 }
1402 else {
1403 if (data->start_class->flags & ANYOF_LOCALE)
1404 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
1405 else {
1406 for (value = 0; value < 256; value++)
1407 if (isALNUM(value))
b81d288d 1408 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS		 1409 }
1410 }
1411 break;
1412 case ALNUML:
1413 if (flags & SCF_DO_STCLASS_AND) {
1414 if (data->start_class->flags & ANYOF_LOCALE)
1415 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM);
1416 }
1417 else {
1418 ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM);
1419 data->start_class->flags |= ANYOF_LOCALE;
1420 }
1421 break;
1422 case NALNUM:
1423 if (flags & SCF_DO_STCLASS_AND) {
1424 if (!(data->start_class->flags & ANYOF_LOCALE)) {
1425 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
1426 for (value = 0; value < 256; value++)
1427 if (isALNUM(value))
1428 ANYOF_BITMAP_CLEAR(data->start_class, value);
1429 }
1430 }
1431 else {
1432 if (data->start_class->flags & ANYOF_LOCALE)
1433 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
1434 else {
1435 for (value = 0; value < 256; value++)
1436 if (!isALNUM(value))
b81d288d 1437 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS		 1438 }
1439 }
1440 break;
1441 case NALNUML:
1442 if (flags & SCF_DO_STCLASS_AND) {
1443 if (data->start_class->flags & ANYOF_LOCALE)
1444 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM);
1445 }
1446 else {
1447 data->start_class->flags |= ANYOF_LOCALE;
1448 ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM);
1449 }
1450 break;
1451 case SPACE:
1452 if (flags & SCF_DO_STCLASS_AND) {
1453 if (!(data->start_class->flags & ANYOF_LOCALE)) {
1454 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
1455 for (value = 0; value < 256; value++)
1456 if (!isSPACE(value))
1457 ANYOF_BITMAP_CLEAR(data->start_class, value);
1458 }
1459 }
1460 else {
1461 if (data->start_class->flags & ANYOF_LOCALE)
1462 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
1463 else {
1464 for (value = 0; value < 256; value++)
1465 if (isSPACE(value))
b81d288d 1466 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS		 1467 }
1468 }
1469 break;
1470 case SPACEL:
1471 if (flags & SCF_DO_STCLASS_AND) {
1472 if (data->start_class->flags & ANYOF_LOCALE)
1473 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE);
1474 }
1475 else {
1476 data->start_class->flags |= ANYOF_LOCALE;
1477 ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE);
1478 }
1479 break;
1480 case NSPACE:
1481 if (flags & SCF_DO_STCLASS_AND) {
1482 if (!(data->start_class->flags & ANYOF_LOCALE)) {
1483 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
1484 for (value = 0; value < 256; value++)
1485 if (isSPACE(value))
1486 ANYOF_BITMAP_CLEAR(data->start_class, value);
1487 }
1488 }
1489 else {
1490 if (data->start_class->flags & ANYOF_LOCALE)
1491 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
1492 else {
1493 for (value = 0; value < 256; value++)
1494 if (!isSPACE(value))
b81d288d 1495 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS		 1496 }
1497 }
1498 break;
1499 case NSPACEL:
1500 if (flags & SCF_DO_STCLASS_AND) {
1501 if (data->start_class->flags & ANYOF_LOCALE) {
1502 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE);
1503 for (value = 0; value < 256; value++)
1504 if (!isSPACE(value))
1505 ANYOF_BITMAP_CLEAR(data->start_class, value);
1506 }
1507 }
1508 else {
1509 data->start_class->flags |= ANYOF_LOCALE;
1510 ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE);
1511 }
1512 break;
1513 case DIGIT:
1514 if (flags & SCF_DO_STCLASS_AND) {
1515 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT);
1516 for (value = 0; value < 256; value++)
1517 if (!isDIGIT(value))
1518 ANYOF_BITMAP_CLEAR(data->start_class, value);
1519 }
1520 else {
1521 if (data->start_class->flags & ANYOF_LOCALE)
1522 ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT);
1523 else {
1524 for (value = 0; value < 256; value++)
1525 if (isDIGIT(value))
b81d288d 1526 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS		 1527 }
1528 }
1529 break;
1530 case NDIGIT:
1531 if (flags & SCF_DO_STCLASS_AND) {
1532 ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT);
1533 for (value = 0; value < 256; value++)
1534 if (isDIGIT(value))
1535 ANYOF_BITMAP_CLEAR(data->start_class, value);
1536 }
1537 else {
1538 if (data->start_class->flags & ANYOF_LOCALE)
1539 ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT);
1540 else {
1541 for (value = 0; value < 256; value++)
1542 if (!isDIGIT(value))
b81d288d 1543 ANYOF_BITMAP_SET(data->start_class, value);
653099ff
GS		 1544 }
1545 }
1546 break;
1547 }
1548 if (flags & SCF_DO_STCLASS_OR)
1549 cl_and(data->start_class, &and_with);
1550 flags &= ~SCF_DO_STCLASS;
1551 }
a0ed51b3 1552 }
22c35a8c 1553 else if (PL_regkind[(U8)OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
c277df42
IZ		 1554 data->flags |= (OP(scan) == MEOL
1555 ? SF_BEFORE_MEOL
1556 : SF_BEFORE_SEOL);
a0ed51b3 1557 }
653099ff
GS		 1558 else if ( PL_regkind[(U8)OP(scan)] == BRANCHJ
1559 /* Lookbehind, or need to calculate parens/evals/stclass: */
1560 && (scan->flags || data || (flags & SCF_DO_STCLASS))
c277df42 1561 && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
653099ff 1562 /* Lookahead/lookbehind */
cb434fcc 1563 I32 deltanext, minnext, fake = 0;
c277df42 1564 regnode *nscan;
653099ff
GS		 1565 struct regnode_charclass_class intrnl;
1566 int f = 0;
c277df42
IZ		 1567
1568 data_fake.flags = 0;
b81d288d 1569 if (data) {
2c2d71f5 1570 data_fake.whilem_c = data->whilem_c;
cb434fcc
IZ		 1571 data_fake.last_closep = data->last_closep;
1572 }
1573 else
1574 data_fake.last_closep = &fake;
653099ff
GS		 1575 if ( flags & SCF_DO_STCLASS && !scan->flags
1576 && OP(scan) == IFMATCH ) { /* Lookahead */
830247a4 1577 cl_init(pRExC_state, &intrnl);
653099ff 1578 data_fake.start_class = &intrnl;
e1901655 1579 f |= SCF_DO_STCLASS_AND;
653099ff 1580 }
e1901655
IZ		 1581 if (flags & SCF_WHILEM_VISITED_POS)
1582 f |= SCF_WHILEM_VISITED_POS;
c277df42
IZ		 1583 next = regnext(scan);
1584 nscan = NEXTOPER(NEXTOPER(scan));
830247a4 1585 minnext = study_chunk(pRExC_state, &nscan, &deltanext, last, &data_fake, f);
c277df42
IZ		 1586 if (scan->flags) {
1587 if (deltanext) {
9baa0206 1588 vFAIL("Variable length lookbehind not implemented");
a0ed51b3
LW		 1589 }
1590 else if (minnext > U8_MAX) {
9baa0206 1591 vFAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
c277df42
IZ		 1592 }
1593 scan->flags = minnext;
1594 }
1595 if (data && data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
1596 pars++;
405ff068 1597 if (data && (data_fake.flags & SF_HAS_EVAL))
c277df42 1598 data->flags |= SF_HAS_EVAL;
2c2d71f5
JH		 1599 if (data)
1600 data->whilem_c = data_fake.whilem_c;
e1901655 1601 if (f & SCF_DO_STCLASS_AND) {
653099ff
GS		 1602 int was = (data->start_class->flags & ANYOF_EOS);
1603
1604 cl_and(data->start_class, &intrnl);
1605 if (was)
1606 data->start_class->flags |= ANYOF_EOS;
1607 }
a0ed51b3
LW		 1608 }
1609 else if (OP(scan) == OPEN) {
c277df42 1610 pars++;
a0ed51b3 1611 }
cb434fcc
IZ		 1612 else if (OP(scan) == CLOSE) {
1613 if (ARG(scan) == is_par) {
1614 next = regnext(scan);
c277df42 1615
cb434fcc
IZ		 1616 if ( next && (OP(next) != WHILEM) && next < last)
1617 is_par = 0; /* Disable optimization */
1618 }
1619 if (data)
1620 *(data->last_closep) = ARG(scan);
a0ed51b3
LW		 1621 }
1622 else if (OP(scan) == EVAL) {
c277df42
IZ		 1623 if (data)
1624 data->flags |= SF_HAS_EVAL;
1625 }
96776eda 1626 else if (OP(scan) == LOGICAL && scan->flags == 2) { /* Embedded follows */
0f5d15d6 1627 if (flags & SCF_DO_SUBSTR) {
830247a4 1628 scan_commit(pRExC_state,data);
0f5d15d6
IZ		 1629 data->longest = &(data->longest_float);
1630 }
1631 is_inf = is_inf_internal = 1;
653099ff 1632 if (flags & SCF_DO_STCLASS_OR) /* Allow everything */
830247a4 1633 cl_anything(pRExC_state, data->start_class);
96776eda 1634 flags &= ~SCF_DO_STCLASS;
0f5d15d6 1635 }
c277df42
IZ		 1636 /* Else: zero-length, ignore. */
1637 scan = regnext(scan);
1638 }
1639
1640 finish:
1641 *scanp = scan;
aca2d497 1642 *deltap = is_inf_internal ? I32_MAX : delta;
b81d288d 1643 if (flags & SCF_DO_SUBSTR && is_inf)
c277df42
IZ		 1644 data->pos_delta = I32_MAX - data->pos_min;
1645 if (is_par > U8_MAX)
1646 is_par = 0;
1647 if (is_par && pars==1 && data) {
1648 data->flags |= SF_IN_PAR;
1649 data->flags &= ~SF_HAS_PAR;
a0ed51b3
LW		 1650 }
1651 else if (pars && data) {
c277df42
IZ		 1652 data->flags |= SF_HAS_PAR;
1653 data->flags &= ~SF_IN_PAR;
1654 }
653099ff
GS		 1655 if (flags & SCF_DO_STCLASS_OR)
1656 cl_and(data->start_class, &and_with);
c277df42
IZ		 1657 return min;
1658}
1659
76e3520e 1660STATIC I32
830247a4 1661S_add_data(pTHX_ RExC_state_t *pRExC_state, I32 n, char *s)
c277df42 1662{
830247a4 1663 if (RExC_rx->data) {
b81d288d
AB		 1664 Renewc(RExC_rx->data,
1665 sizeof(*RExC_rx->data) + sizeof(void*) * (RExC_rx->data->count + n - 1),
c277df42 1666 char, struct reg_data);
830247a4
IZ		 1667 Renew(RExC_rx->data->what, RExC_rx->data->count + n, U8);
1668 RExC_rx->data->count += n;
a0ed51b3
LW		 1669 }
1670 else {
830247a4 1671 Newc(1207, RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1),
c277df42 1672 char, struct reg_data);
830247a4
IZ		 1673 New(1208, RExC_rx->data->what, n, U8);
1674 RExC_rx->data->count = n;
c277df42 1675 }
830247a4
IZ		 1676 Copy(s, RExC_rx->data->what + RExC_rx->data->count - n, n, U8);
1677 return RExC_rx->data->count - n;
c277df42
IZ		 1678}
1679
d88dccdf 1680void
864dbfa3 1681Perl_reginitcolors(pTHX)
d88dccdf 1682{
d88dccdf
IZ		 1683 int i = 0;
1684 char *s = PerlEnv_getenv("PERL_RE_COLORS");
b81d288d 1685
d88dccdf
IZ		 1686 if (s) {
1687 PL_colors[0] = s = savepv(s);
1688 while (++i < 6) {
1689 s = strchr(s, '\t');
1690 if (s) {
1691 *s = '\0';
1692 PL_colors[i] = ++s;
1693 }
1694 else
c712d376 1695 PL_colors[i] = s = "";
d88dccdf
IZ		 1696 }
1697 } else {
b81d288d 1698 while (i < 6)
d88dccdf
IZ		 1699 PL_colors[i++] = "";
1700 }
1701 PL_colorset = 1;
1702}
1703
8615cb43 1704
a687059c 1705/*
e50aee73 1706 - pregcomp - compile a regular expression into internal code
a687059c
LW		 1707 *
1708 * We can't allocate space until we know how big the compiled form will be,
1709 * but we can't compile it (and thus know how big it is) until we've got a
1710 * place to put the code. So we cheat: we compile it twice, once with code
1711 * generation turned off and size counting turned on, and once "for real".
1712 * This also means that we don't allocate space until we are sure that the
1713 * thing really will compile successfully, and we never have to move the
1714 * code and thus invalidate pointers into it. (Note that it has to be in
1715 * one piece because free() must be able to free it all.) [NB: not true in perl]
1716 *
1717 * Beware that the optimization-preparation code in here knows about some
1718 * of the structure of the compiled regexp. [I'll say.]
1719 */
1720regexp *
864dbfa3 1721Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
a687059c 1722{
a0d0e21e 1723 register regexp *r;
c277df42 1724 regnode *scan;
c277df42 1725 regnode *first;
a0d0e21e 1726 I32 flags;
a0d0e21e
LW		 1727 I32 minlen = 0;
1728 I32 sawplus = 0;
1729 I32 sawopen = 0;
2c2d71f5 1730 scan_data_t data;
830247a4
IZ		 1731 RExC_state_t RExC_state;
1732 RExC_state_t *pRExC_state = &RExC_state;
a0d0e21e
LW		 1733
1734 if (exp == NULL)
c277df42 1735 FAIL("NULL regexp argument");
a0d0e21e 1736
a5961de5 1737 RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
a0ed51b3 1738
5cfc7842 1739 RExC_precomp = exp;
a5961de5
JH		 1740 DEBUG_r({
1741 if (!PL_colorset) reginitcolors();
1742 PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n",
1743 PL_colors[4],PL_colors[5],PL_colors[0],
1744 (int)(xend - exp), RExC_precomp, PL_colors[1]);
1745 });
830247a4
IZ		 1746 RExC_flags16 = pm->op_pmflags;
1747 RExC_sawback = 0;
bbce6d69 1748
830247a4
IZ		 1749 RExC_seen = 0;
1750 RExC_seen_zerolen = *exp == '^' ? -1 : 0;
1751 RExC_seen_evals = 0;
1752 RExC_extralen = 0;
c277df42 1753
bbce6d69 1754 /* First pass: determine size, legality. */
830247a4 1755 RExC_parse = exp;
fac92740 1756 RExC_start = exp;
830247a4
IZ		 1757 RExC_end = xend;
1758 RExC_naughty = 0;
1759 RExC_npar = 1;
1760 RExC_size = 0L;
1761 RExC_emit = &PL_regdummy;
1762 RExC_whilem_seen = 0;
85ddcde9
JH		 1763#if 0 /* REGC() is (currently) a NOP at the first pass.
1764 * Clever compilers notice this and complain. --jhi */
830247a4 1765 REGC((U8)REG_MAGIC, (char*)RExC_emit);
85ddcde9 1766#endif
830247a4 1767 if (reg(pRExC_state, 0, &flags) == NULL) {
830247a4 1768 RExC_precomp = Nullch;
a0d0e21e
LW		 1769 return(NULL);
1770 }
830247a4 1771 DEBUG_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)RExC_size));
c277df42 1772
c277df42
IZ		 1773 /* Small enough for pointer-storage convention?
1774 If extralen==0, this means that we will not need long jumps. */
830247a4
IZ		 1775 if (RExC_size >= 0x10000L && RExC_extralen)
1776 RExC_size += RExC_extralen;
c277df42 1777 else
830247a4
IZ		 1778 RExC_extralen = 0;
1779 if (RExC_whilem_seen > 15)
1780 RExC_whilem_seen = 15;
a0d0e21e 1781
bbce6d69 1782 /* Allocate space and initialize. */
830247a4 1783 Newc(1001, r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode),
c277df42 1784 char, regexp);
a0d0e21e 1785 if (r == NULL)
b45f050a
JF		 1786 FAIL("Regexp out of space");
1787
0f79a09d
GS		 1788#ifdef DEBUGGING
1789 /* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
830247a4 1790 Zero(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode), char);
0f79a09d 1791#endif
c277df42 1792 r->refcnt = 1;
bbce6d69 1793 r->prelen = xend - exp;
5cfc7842 1794 r->precomp = savepvn(RExC_precomp, r->prelen);
cf93c79d
IZ		 1795 r->subbeg = NULL;
1796 r->reganch = pm->op_pmflags & PMf_COMPILETIME;
830247a4 1797 r->nparens = RExC_npar - 1; /* set early to validate backrefs */
4327152a
IZ		 1798
1799 r->substrs = 0; /* Useful during FAIL. */
1800 r->startp = 0; /* Useful during FAIL. */
1801 r->endp = 0; /* Useful during FAIL. */
1802
fac92740
MJD		 1803 Newz(1304, r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
1804 if (r->offsets) {
1805 r->offsets[0] = RExC_size;
1806 }
1807 DEBUG_r(PerlIO_printf(Perl_debug_log,
392fbf5d 1808 "%s %"UVuf" bytes for offset annotations.\n",
fac92740 1809 r->offsets ? "Got" : "Couldn't get",
392fbf5d 1810 (UV)((2*RExC_size+1) * sizeof(U32))));
fac92740 1811
830247a4 1812 RExC_rx = r;
bbce6d69 1813
1814 /* Second pass: emit code. */
055bb491 1815 RExC_flags16 = pm->op_pmflags; /* don't let top level (?i) bleed */
830247a4
IZ		 1816 RExC_parse = exp;
1817 RExC_end = xend;
1818 RExC_naughty = 0;
1819 RExC_npar = 1;
fac92740 1820 RExC_emit_start = r->program;
830247a4 1821 RExC_emit = r->program;
2cd61cdb 1822 /* Store the count of eval-groups for security checks: */
830247a4
IZ		 1823 RExC_emit->next_off = ((RExC_seen_evals > U16_MAX) ? U16_MAX : RExC_seen_evals);
1824 REGC((U8)REG_MAGIC, (char*) RExC_emit++);
c277df42 1825 r->data = 0;
830247a4 1826 if (reg(pRExC_state, 0, &flags) == NULL)
a0d0e21e
LW		 1827 return(NULL);
1828
1829 /* Dig out information for optimizations. */
cf93c79d 1830 r->reganch = pm->op_pmflags & PMf_COMPILETIME; /* Again? */
830247a4 1831 pm->op_pmflags = RExC_flags16;
a0ed51b3 1832 if (UTF)
5ff6fc6d 1833 r->reganch |= ROPT_UTF8; /* Unicode in it? */
c277df42 1834 r->regstclass = NULL;
830247a4 1835 if (RExC_naughty >= 10) /* Probably an expensive pattern. */
a0ed51b3 1836 r->reganch |= ROPT_NAUGHTY;
c277df42 1837 scan = r->program + 1; /* First BRANCH. */
2779dcf1
IZ		 1838
1839 /* XXXX To minimize changes to RE engine we always allocate
1840 3-units-long substrs field. */
1841 Newz(1004, r->substrs, 1, struct reg_substr_data);
1842
2c2d71f5 1843 StructCopy(&zero_scan_data, &data, scan_data_t);
653099ff 1844 /* XXXX Should not we check for something else? Usually it is OPEN1... */
c277df42 1845 if (OP(scan) != BRANCH) { /* Only one top-level choice. */
c277df42 1846 I32 fake;
c5254dd6 1847 STRLEN longest_float_length, longest_fixed_length;
653099ff
GS		 1848 struct regnode_charclass_class ch_class;
1849 int stclass_flag;
cb434fcc 1850 I32 last_close = 0;
a0d0e21e
LW		 1851
1852 first = scan;
c277df42 1853 /* Skip introductions and multiplicators >= 1. */
a0d0e21e 1854 while ((OP(first) == OPEN && (sawopen = 1)) ||
653099ff 1855 /* An OR of *one* alternative - should not happen now. */
a0d0e21e
LW		 1856 (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
1857 (OP(first) == PLUS) ||
1858 (OP(first) == MINMOD) ||
653099ff 1859 /* An {n,m} with n>0 */
22c35a8c 1860 (PL_regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
a0d0e21e
LW		 1861 if (OP(first) == PLUS)
1862 sawplus = 1;
1863 else
1864 first += regarglen[(U8)OP(first)];
1865 first = NEXTOPER(first);
a687059c
LW		 1866 }
1867
a0d0e21e
LW		 1868 /* Starting-point info. */
1869 again:
653099ff 1870 if (PL_regkind[(U8)OP(first)] == EXACT) {
1aa99e6b
IH		 1871 if (OP(first) == EXACT)
1872 ; /* Empty, get anchored substr later. */
1873 else if ((OP(first) == EXACTF || OP(first) == EXACTFL))
b3c9acc1
IZ		 1874 r->regstclass = first;
1875 }
653099ff 1876 else if (strchr((char*)PL_simple,OP(first)))
a0d0e21e 1877 r->regstclass = first;
22c35a8c
GS		 1878 else if (PL_regkind[(U8)OP(first)] == BOUND ||
1879 PL_regkind[(U8)OP(first)] == NBOUND)
a0d0e21e 1880 r->regstclass = first;
22c35a8c 1881 else if (PL_regkind[(U8)OP(first)] == BOL) {
cad2e5aa
JH		 1882 r->reganch |= (OP(first) == MBOL
1883 ? ROPT_ANCH_MBOL
1884 : (OP(first) == SBOL
1885 ? ROPT_ANCH_SBOL
1886 : ROPT_ANCH_BOL));
a0d0e21e 1887 first = NEXTOPER(first);
774d564b 1888 goto again;
1889 }
1890 else if (OP(first) == GPOS) {
1891 r->reganch |= ROPT_ANCH_GPOS;
1892 first = NEXTOPER(first);
1893 goto again;
a0d0e21e 1894 }
e09294f4 1895 else if (!sawopen && (OP(first) == STAR &&
22c35a8c 1896 PL_regkind[(U8)OP(NEXTOPER(first))] == REG_ANY) &&
a0d0e21e
LW		 1897 !(r->reganch & ROPT_ANCH) )
1898 {
1899 /* turn .* into ^.* with an implied $*=1 */
cad2e5aa
JH		 1900 int type = OP(NEXTOPER(first));
1901
ffc61ed2 1902 if (type == REG_ANY)
cad2e5aa
JH		 1903 type = ROPT_ANCH_MBOL;
1904 else
1905 type = ROPT_ANCH_SBOL;
1906
1907 r->reganch |= type | ROPT_IMPLICIT;
a0d0e21e 1908 first = NEXTOPER(first);
774d564b 1909 goto again;
a0d0e21e 1910 }
b81d288d 1911 if (sawplus && (!sawopen || !RExC_sawback)
830247a4 1912 && !(RExC_seen & REG_SEEN_EVAL)) /* May examine pos and $& */
cad2e5aa
JH		 1913 /* x+ must match at the 1st pos of run of x's */
1914 r->reganch |= ROPT_SKIP;
a0d0e21e 1915
c277df42 1916 /* Scan is after the zeroth branch, first is atomic matcher. */
b81d288d 1917 DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
b900a521 1918 (IV)(first - scan + 1)));
a0d0e21e
LW		 1919 /*
1920 * If there's something expensive in the r.e., find the
1921 * longest literal string that must appear and make it the
1922 * regmust. Resolve ties in favor of later strings, since
1923 * the regstart check works with the beginning of the r.e.
1924 * and avoiding duplication strengthens checking. Not a
1925 * strong reason, but sufficient in the absence of others.
1926 * [Now we resolve ties in favor of the earlier string if
c277df42 1927 * it happens that c_offset_min has been invalidated, since the
a0d0e21e
LW		 1928 * earlier string may buy us something the later one won't.]
1929 */
a0d0e21e 1930 minlen = 0;
a687059c 1931
79cb57f6
GS		 1932 data.longest_fixed = newSVpvn("",0);
1933 data.longest_float = newSVpvn("",0);
1934 data.last_found = newSVpvn("",0);
c277df42
IZ		 1935 data.longest = &(data.longest_fixed);
1936 first = scan;
653099ff 1937 if (!r->regstclass) {
830247a4 1938 cl_init(pRExC_state, &ch_class);
653099ff
GS		 1939 data.start_class = &ch_class;
1940 stclass_flag = SCF_DO_STCLASS_AND;
1941 } else /* XXXX Check for BOUND? */
1942 stclass_flag = 0;
cb434fcc 1943 data.last_closep = &last_close;
653099ff 1944
830247a4 1945 minlen = study_chunk(pRExC_state, &first, &fake, scan + RExC_size, /* Up to end */
e1901655 1946 &data, SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag);
830247a4 1947 if ( RExC_npar == 1 && data.longest == &(data.longest_fixed)
b81d288d 1948 && data.last_start_min == 0 && data.last_end > 0
830247a4
IZ		 1949 && !RExC_seen_zerolen
1950 && (!(RExC_seen & REG_SEEN_GPOS) || (r->reganch & ROPT_ANCH_GPOS)))
c277df42 1951 r->reganch |= ROPT_CHECK_ALL;
830247a4 1952 scan_commit(pRExC_state, &data);
c277df42
IZ		 1953 SvREFCNT_dec(data.last_found);
1954
a0ed51b3 1955 longest_float_length = CHR_SVLEN(data.longest_float);
c5254dd6 1956 if (longest_float_length
c277df42
IZ		 1957 || (data.flags & SF_FL_BEFORE_EOL
1958 && (!(data.flags & SF_FL_BEFORE_MEOL)
830247a4 1959 || (RExC_flags16 & PMf_MULTILINE)))) {
cf93c79d
IZ		 1960 int t;
1961
a0ed51b3 1962 if (SvCUR(data.longest_fixed) /* ok to leave SvCUR */
aca2d497
IZ		 1963 && data.offset_fixed == data.offset_float_min
1964 && SvCUR(data.longest_fixed) == SvCUR(data.longest_float))
1965 goto remove_float; /* As in (a)+. */
1966
c277df42
IZ		 1967 r->float_substr = data.longest_float;
1968 r->float_min_offset = data.offset_float_min;
1969 r->float_max_offset = data.offset_float_max;
cf93c79d
IZ		 1970 t = (data.flags & SF_FL_BEFORE_EOL /* Can't have SEOL and MULTI */
1971 && (!(data.flags & SF_FL_BEFORE_MEOL)
830247a4 1972 || (RExC_flags16 & PMf_MULTILINE)));
cf93c79d 1973 fbm_compile(r->float_substr, t ? FBMcf_TAIL : 0);
a0ed51b3
LW		 1974 }
1975 else {
aca2d497 1976 remove_float:
c277df42
IZ		 1977 r->float_substr = Nullsv;
1978 SvREFCNT_dec(data.longest_float);
c5254dd6 1979 longest_float_length = 0;
a0d0e21e 1980 }
c277df42 1981
a0ed51b3 1982 longest_fixed_length = CHR_SVLEN(data.longest_fixed);
c5254dd6 1983 if (longest_fixed_length
c277df42
IZ		 1984 || (data.flags & SF_FIX_BEFORE_EOL /* Cannot have SEOL and MULTI */
1985 && (!(data.flags & SF_FIX_BEFORE_MEOL)
830247a4 1986 || (RExC_flags16 & PMf_MULTILINE)))) {
cf93c79d
IZ		 1987 int t;
1988
c277df42
IZ		 1989 r->anchored_substr = data.longest_fixed;
1990 r->anchored_offset = data.offset_fixed;
cf93c79d
IZ		 1991 t = (data.flags & SF_FIX_BEFORE_EOL /* Can't have SEOL and MULTI */
1992 && (!(data.flags & SF_FIX_BEFORE_MEOL)
830247a4 1993 || (RExC_flags16 & PMf_MULTILINE)));
cf93c79d 1994 fbm_compile(r->anchored_substr, t ? FBMcf_TAIL : 0);
a0ed51b3
LW		 1995 }
1996 else {
c277df42
IZ		 1997 r->anchored_substr = Nullsv;
1998 SvREFCNT_dec(data.longest_fixed);
c5254dd6 1999 longest_fixed_length = 0;
a0d0e21e 2000 }
b81d288d 2001 if (r->regstclass
ffc61ed2 2002 && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == SANY))
653099ff
GS		 2003 r->regstclass = NULL;
2004 if ((!r->anchored_substr || r->anchored_offset) && stclass_flag
2005 && !(data.start_class->flags & ANYOF_EOS)
2006 && !cl_is_anything(data.start_class)) {
830247a4 2007 I32 n = add_data(pRExC_state, 1, "f");
653099ff 2008
b81d288d 2009 New(1006, RExC_rx->data->data[n], 1,
653099ff
GS		 2010 struct regnode_charclass_class);
2011 StructCopy(data.start_class,
830247a4 2012 (struct regnode_charclass_class*)RExC_rx->data->data[n],
653099ff 2013 struct regnode_charclass_class);
830247a4 2014 r->regstclass = (regnode*)RExC_rx->data->data[n];
653099ff 2015 r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */
ffc61ed2 2016 PL_regdata = r->data; /* for regprop() */
9c5ffd7c
JH		 2017 DEBUG_r({ SV *sv = sv_newmortal();
2018 regprop(sv, (regnode*)data.start_class);
2019 PerlIO_printf(Perl_debug_log,
2020 "synthetic stclass `%s'.\n",
2021 SvPVX(sv));});
653099ff 2022 }
c277df42
IZ		 2023
2024 /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
c5254dd6 2025 if (longest_fixed_length > longest_float_length) {
c277df42
IZ		 2026 r->check_substr = r->anchored_substr;
2027 r->check_offset_min = r->check_offset_max = r->anchored_offset;
2028 if (r->reganch & ROPT_ANCH_SINGLE)
2029 r->reganch |= ROPT_NOSCAN;
a0ed51b3
LW		 2030 }
2031 else {
c277df42
IZ		 2032 r->check_substr = r->float_substr;
2033 r->check_offset_min = data.offset_float_min;
2034 r->check_offset_max = data.offset_float_max;
a0d0e21e 2035 }
30382c73
IZ		 2036 /* XXXX Currently intuiting is not compatible with ANCH_GPOS.
2037 This should be changed ASAP! */
2038 if (r->check_substr && !(r->reganch & ROPT_ANCH_GPOS)) {
cad2e5aa
JH		 2039 r->reganch |= RE_USE_INTUIT;
2040 if (SvTAIL(r->check_substr))
2041 r->reganch |= RE_INTUIT_TAIL;
2042 }
a0ed51b3
LW		 2043 }
2044 else {
c277df42
IZ		 2045 /* Several toplevels. Best we can is to set minlen. */
2046 I32 fake;
653099ff 2047 struct regnode_charclass_class ch_class;
cb434fcc 2048 I32 last_close = 0;
c277df42
IZ		 2049
2050 DEBUG_r(PerlIO_printf(Perl_debug_log, "\n"));
2051 scan = r->program + 1;
830247a4 2052 cl_init(pRExC_state, &ch_class);
653099ff 2053 data.start_class = &ch_class;
cb434fcc 2054 data.last_closep = &last_close;
e1901655 2055 minlen = study_chunk(pRExC_state, &scan, &fake, scan + RExC_size, &data, SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS);
c277df42 2056 r->check_substr = r->anchored_substr = r->float_substr = Nullsv;
653099ff
GS		 2057 if (!(data.start_class->flags & ANYOF_EOS)
2058 && !cl_is_anything(data.start_class)) {
830247a4 2059 I32 n = add_data(pRExC_state, 1, "f");
653099ff 2060
b81d288d 2061 New(1006, RExC_rx->data->data[n], 1,
653099ff
GS		 2062 struct regnode_charclass_class);
2063 StructCopy(data.start_class,
830247a4 2064 (struct regnode_charclass_class*)RExC_rx->data->data[n],
653099ff 2065 struct regnode_charclass_class);
830247a4 2066 r->regstclass = (regnode*)RExC_rx->data->data[n];
653099ff 2067 r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */
9c5ffd7c
JH		 2068 DEBUG_r({ SV* sv = sv_newmortal();
2069 regprop(sv, (regnode*)data.start_class);
2070 PerlIO_printf(Perl_debug_log,
2071 "synthetic stclass `%s'.\n",
2072 SvPVX(sv));});
653099ff 2073 }
a0d0e21e
LW		 2074 }
2075
a0d0e21e 2076 r->minlen = minlen;
b81d288d 2077 if (RExC_seen & REG_SEEN_GPOS)
c277df42 2078 r->reganch |= ROPT_GPOS_SEEN;
830247a4 2079 if (RExC_seen & REG_SEEN_LOOKBEHIND)
c277df42 2080 r->reganch |= ROPT_LOOKBEHIND_SEEN;
830247a4 2081 if (RExC_seen & REG_SEEN_EVAL)
ce862d02 2082 r->reganch |= ROPT_EVAL_SEEN;
f33976b4
DB		 2083 if (RExC_seen & REG_SEEN_CANY)
2084 r->reganch |= ROPT_CANY_SEEN;
830247a4
IZ		 2085 Newz(1002, r->startp, RExC_npar, I32);
2086 Newz(1002, r->endp, RExC_npar, I32);
ffc61ed2 2087 PL_regdata = r->data; /* for regprop() */
a0d0e21e
LW		 2088 DEBUG_r(regdump(r));
2089 return(r);
a687059c
LW		 2090}
2091
2092/*
2093 - reg - regular expression, i.e. main body or parenthesized thing
2094 *
2095 * Caller must absorb opening parenthesis.
2096 *
2097 * Combining parenthesis handling with the base level of regular expression
2098 * is a trifle forced, but the need to tie the tails of the branches to what
2099 * follows makes it hard to avoid.
2100 */
76e3520e 2101STATIC regnode *
830247a4 2102S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
c277df42 2103 /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
a687059c 2104{
c277df42
IZ		 2105 register regnode *ret; /* Will be the head of the group. */
2106 register regnode *br;
2107 register regnode *lastbr;
2108 register regnode *ender = 0;
a0d0e21e 2109 register I32 parno = 0;
830247a4 2110 I32 flags, oregflags = RExC_flags16, have_branch = 0, open = 0;
9d1d55b5
JP		 2111
2112 /* for (?g), (?gc), and (?o) warnings; warning
2113 about (?c) will warn about (?g) -- japhy */
2114
2115 I32 wastedflags = 0x00,
2116 wasted_o = 0x01,
2117 wasted_g = 0x02,
2118 wasted_gc = 0x02 | 0x04,
2119 wasted_c = 0x04;
2120
fac92740 2121 char * parse_start = RExC_parse; /* MJD */
830247a4 2122 char *oregcomp_parse = RExC_parse;
c277df42 2123 char c;
a0d0e21e 2124
821b33a5 2125 *flagp = 0; /* Tentatively. */
a0d0e21e 2126
9d1d55b5 2127
a0d0e21e
LW		 2128 /* Make an OPEN node, if parenthesized. */
2129 if (paren) {
fac92740 2130 if (*RExC_parse == '?') { /* (?...) */
ca9dfc88
IZ		 2131 U16 posflags = 0, negflags = 0;
2132 U16 *flagsp = &posflags;
0f5d15d6 2133 int logical = 0;
830247a4 2134 char *seqstart = RExC_parse;
ca9dfc88 2135
830247a4
IZ		 2136 RExC_parse++;
2137 paren = *RExC_parse++;
c277df42 2138 ret = NULL; /* For look-ahead/behind. */
a0d0e21e 2139 switch (paren) {
fac92740 2140 case '<': /* (?<...) */
830247a4 2141 RExC_seen |= REG_SEEN_LOOKBEHIND;
b81d288d 2142 if (*RExC_parse == '!')
c277df42 2143 paren = ',';
b81d288d 2144 if (*RExC_parse != '=' && *RExC_parse != '!')
c277df42 2145 goto unknown;
830247a4 2146 RExC_parse++;
fac92740
MJD		 2147 case '=': /* (?=...) */
2148 case '!': /* (?!...) */
830247a4 2149 RExC_seen_zerolen++;
fac92740
MJD		 2150 case ':': /* (?:...) */
2151 case '>': /* (?>...) */
a0d0e21e 2152 break;
fac92740
MJD		 2153 case '$': /* (?$...) */
2154 case '@': /* (?@...) */
8615cb43 2155 vFAIL2("Sequence (?%c...) not implemented", (int)paren);
a0d0e21e 2156 break;
fac92740 2157 case '#': /* (?#...) */
830247a4
IZ		 2158 while (*RExC_parse && *RExC_parse != ')')
2159 RExC_parse++;
2160 if (*RExC_parse != ')')
c277df42 2161 FAIL("Sequence (?#... not terminated");
830247a4 2162 nextchar(pRExC_state);
a0d0e21e
LW		 2163 *flagp = TRYAGAIN;
2164 return NULL;
fac92740 2165 case 'p': /* (?p...) */
f9373011
PM		 2166 if (SIZE_ONLY && ckWARN2(WARN_DEPRECATED, WARN_REGEXP))
2167 vWARNdep(RExC_parse, "(?p{}) is deprecated - use (??{})");
8c8ad484 2168 /* FALL THROUGH*/
fac92740 2169 case '?': /* (??...) */
0f5d15d6 2170 logical = 1;
438a3801
YST		 2171 if (*RExC_parse != '{')
2172 goto unknown;
830247a4 2173 paren = *RExC_parse++;
0f5d15d6 2174 /* FALL THROUGH */
fac92740 2175 case '{': /* (?{...}) */
c277df42 2176 {
c277df42
IZ		 2177 I32 count = 1, n = 0;
2178 char c;
830247a4 2179 char *s = RExC_parse;
c277df42
IZ		 2180 SV *sv;
2181 OP_4tree *sop, *rop;
2182
830247a4
IZ		 2183 RExC_seen_zerolen++;
2184 RExC_seen |= REG_SEEN_EVAL;
2185 while (count && (c = *RExC_parse)) {
2186 if (c == '\\' && RExC_parse[1])
2187 RExC_parse++;
b81d288d 2188 else if (c == '{')
c277df42 2189 count++;
b81d288d 2190 else if (c == '}')
c277df42 2191 count--;
830247a4 2192 RExC_parse++;
c277df42 2193 }
830247a4 2194 if (*RExC_parse != ')')
b45f050a 2195 {
b81d288d 2196 RExC_parse = s;
b45f050a
JF		 2197 vFAIL("Sequence (?{...}) not terminated or not {}-balanced");
2198 }
c277df42
IZ		 2199 if (!SIZE_ONLY) {
2200 AV *av;
b81d288d
AB		 2201
2202 if (RExC_parse - 1 - s)
830247a4 2203 sv = newSVpvn(s, RExC_parse - 1 - s);
c277df42 2204 else
79cb57f6 2205 sv = newSVpvn("", 0);
c277df42 2206
569233ed
SB		 2207 ENTER;
2208 Perl_save_re_context(aTHX);
c277df42 2209 rop = sv_compile_2op(sv, &sop, "re", &av);
9b978d73
DM		 2210 sop->op_private |= OPpREFCOUNTED;
2211 /* re_dup will OpREFCNT_inc */
2212 OpREFCNT_set(sop, 1);
569233ed 2213 LEAVE;
c277df42 2214
830247a4
IZ		 2215 n = add_data(pRExC_state, 3, "nop");
2216 RExC_rx->data->data[n] = (void*)rop;
2217 RExC_rx->data->data[n+1] = (void*)sop;
2218 RExC_rx->data->data[n+2] = (void*)av;
c277df42 2219 SvREFCNT_dec(sv);
a0ed51b3 2220 }
e24b16f9 2221 else { /* First pass */
830247a4 2222 if (PL_reginterp_cnt < ++RExC_seen_evals
e24b16f9 2223 && PL_curcop != &PL_compiling)
2cd61cdb
IZ		 2224 /* No compiled RE interpolated, has runtime
2225 components ===> unsafe. */
2226 FAIL("Eval-group not allowed at runtime, use re 'eval'");
5b61d3f7 2227 if (PL_tainting && PL_tainted)
cc6b7395 2228 FAIL("Eval-group in insecure regular expression");
c277df42
IZ		 2229 }
2230
830247a4 2231 nextchar(pRExC_state);
0f5d15d6 2232 if (logical) {
830247a4 2233 ret = reg_node(pRExC_state, LOGICAL);
0f5d15d6
IZ		 2234 if (!SIZE_ONLY)
2235 ret->flags = 2;
830247a4 2236 regtail(pRExC_state, ret, reganode(pRExC_state, EVAL, n));
fac92740 2237 /* deal with the length of this later - MJD */
0f5d15d6
IZ		 2238 return ret;
2239 }
830247a4 2240 return reganode(pRExC_state, EVAL, n);
c277df42 2241 }
fac92740 2242 case '(': /* (?(?{...})...) and (?(?=...)...) */
c277df42 2243 {
fac92740 2244 if (RExC_parse[0] == '?') { /* (?(?...)) */
b81d288d
AB		 2245 if (RExC_parse[1] == '=' || RExC_parse[1] == '!'
2246 || RExC_parse[1] == '<'
830247a4 2247 || RExC_parse[1] == '{') { /* Lookahead or eval. */
c277df42
IZ		 2248 I32 flag;
2249
830247a4 2250 ret = reg_node(pRExC_state, LOGICAL);
0f5d15d6
IZ		 2251 if (!SIZE_ONLY)
2252 ret->flags = 1;
830247a4 2253 regtail(pRExC_state, ret, reg(pRExC_state, 1, &flag));
c277df42 2254 goto insert_if;
b81d288d 2255 }
a0ed51b3 2256 }
830247a4 2257 else if (RExC_parse[0] >= '1' && RExC_parse[0] <= '9' ) {
fac92740 2258 /* (?(1)...) */
830247a4 2259 parno = atoi(RExC_parse++);
c277df42 2260
830247a4
IZ		 2261 while (isDIGIT(*RExC_parse))
2262 RExC_parse++;
fac92740
MJD		 2263 ret = reganode(pRExC_state, GROUPP, parno);
2264
830247a4 2265 if ((c = *nextchar(pRExC_state)) != ')')
b45f050a 2266 vFAIL("Switch condition not recognized");
c277df42 2267 insert_if:
830247a4
IZ		 2268 regtail(pRExC_state, ret, reganode(pRExC_state, IFTHEN, 0));
2269 br = regbranch(pRExC_state, &flags, 1);
c277df42 2270 if (br == NULL)
830247a4 2271 br = reganode(pRExC_state, LONGJMP, 0);
c277df42 2272 else
830247a4
IZ		 2273 regtail(pRExC_state, br, reganode(pRExC_state, LONGJMP, 0));
2274 c = *nextchar(pRExC_state);
d1b80229
IZ		 2275 if (flags&HASWIDTH)
2276 *flagp |= HASWIDTH;
c277df42 2277 if (c == '|') {
830247a4
IZ		 2278 lastbr = reganode(pRExC_state, IFTHEN, 0); /* Fake one for optimizer. */
2279 regbranch(pRExC_state, &flags, 1);
2280 regtail(pRExC_state, ret, lastbr);
d1b80229
IZ		 2281 if (flags&HASWIDTH)
2282 *flagp |= HASWIDTH;
830247a4 2283 c = *nextchar(pRExC_state);
a0ed51b3
LW		 2284 }
2285 else
c277df42
IZ		 2286 lastbr = NULL;
2287 if (c != ')')
8615cb43 2288 vFAIL("Switch (?(condition)... contains too many branches");
830247a4
IZ		 2289 ender = reg_node(pRExC_state, TAIL);
2290 regtail(pRExC_state, br, ender);
c277df42 2291 if (lastbr) {
830247a4
IZ		 2292 regtail(pRExC_state, lastbr, ender);
2293 regtail(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender);
a0ed51b3
LW		 2294 }
2295 else
830247a4 2296 regtail(pRExC_state, ret, ender);
c277df42 2297 return ret;
a0ed51b3
LW		 2298 }
2299 else {
830247a4 2300 vFAIL2("Unknown switch condition (?(%.2s", RExC_parse);
c277df42
IZ		 2301 }
2302 }
1b1626e4 2303 case 0:
830247a4 2304 RExC_parse--; /* for vFAIL to print correctly */
8615cb43 2305 vFAIL("Sequence (? incomplete");
1b1626e4 2306 break;
a0d0e21e 2307 default:
830247a4 2308 --RExC_parse;
fac92740 2309 parse_flags: /* (?i) */
830247a4 2310 while (*RExC_parse && strchr("iogcmsx", *RExC_parse)) {
9d1d55b5
JP		 2311 /* (?g), (?gc) and (?o) are useless here
2312 and must be globally applied -- japhy */
2313
2314 if (*RExC_parse == 'o' || *RExC_parse == 'g') {
2315 if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
2316 I32 wflagbit = *RExC_parse == 'o' ? wasted_o : wasted_g;
2317 if (! (wastedflags & wflagbit) ) {
2318 wastedflags |= wflagbit;
2319 vWARN5(
2320 RExC_parse + 1,
2321 "Useless (%s%c) - %suse /%c modifier",
2322 flagsp == &negflags ? "?-" : "?",
2323 *RExC_parse,
2324 flagsp == &negflags ? "don't " : "",
2325 *RExC_parse
2326 );
2327 }
2328 }
2329 }
2330 else if (*RExC_parse == 'c') {
2331 if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
2332 if (! (wastedflags & wasted_c) ) {
2333 wastedflags |= wasted_gc;
2334 vWARN3(
2335 RExC_parse + 1,
2336 "Useless (%sc) - %suse /gc modifier",
2337 flagsp == &negflags ? "?-" : "?",
2338 flagsp == &negflags ? "don't " : ""
2339 );
2340 }
2341 }
2342 }
2343 else { pmflag(flagsp, *RExC_parse); }
2344
830247a4 2345 ++RExC_parse;
ca9dfc88 2346 }
830247a4 2347 if (*RExC_parse == '-') {
ca9dfc88 2348 flagsp = &negflags;
9d1d55b5 2349 wastedflags = 0; /* reset so (?g-c) warns twice */
830247a4 2350 ++RExC_parse;
ca9dfc88 2351 goto parse_flags;
48c036b1 2352 }
830247a4
IZ		 2353 RExC_flags16 |= posflags;
2354 RExC_flags16 &= ~negflags;
2355 if (*RExC_parse == ':') {
2356 RExC_parse++;
ca9dfc88
IZ		 2357 paren = ':';
2358 break;
2359 }
c277df42 2360 unknown:
830247a4
IZ		 2361 if (*RExC_parse != ')') {
2362 RExC_parse++;
2363 vFAIL3("Sequence (%.*s...) not recognized", RExC_parse-seqstart, seqstart);
b45f050a 2364 }
830247a4 2365 nextchar(pRExC_state);
a0d0e21e
LW		 2366 *flagp = TRYAGAIN;
2367 return NULL;
2368 }
2369 }
fac92740 2370 else { /* (...) */
830247a4
IZ		 2371 parno = RExC_npar;
2372 RExC_npar++;
2373 ret = reganode(pRExC_state, OPEN, parno);
fac92740
MJD		 2374 Set_Node_Length(ret, 1); /* MJD */
2375 Set_Node_Offset(ret, RExC_parse); /* MJD */
c277df42 2376 open = 1;
a0d0e21e 2377 }
a0ed51b3 2378 }
fac92740 2379 else /* ! paren */
a0d0e21e
LW		 2380 ret = NULL;
2381
2382 /* Pick up the branches, linking them together. */
fac92740 2383 parse_start = RExC_parse; /* MJD */
830247a4 2384 br = regbranch(pRExC_state, &flags, 1);
fac92740
MJD		 2385 /* branch_len = (paren != 0); */
2386
a0d0e21e
LW		 2387 if (br == NULL)
2388 return(NULL);
830247a4
IZ		 2389 if (*RExC_parse == '|') {
2390 if (!SIZE_ONLY && RExC_extralen) {
2391 reginsert(pRExC_state, BRANCHJ, br);
a0ed51b3 2392 }
fac92740 2393 else { /* MJD */
830247a4 2394 reginsert(pRExC_state, BRANCH, br);
fac92740
MJD		 2395 Set_Node_Length(br, paren != 0);
2396 Set_Node_Offset_To_R(br-RExC_emit_start, parse_start-RExC_start);
2397 }
c277df42
IZ		 2398 have_branch = 1;
2399 if (SIZE_ONLY)
830247a4 2400 RExC_extralen += 1; /* For BRANCHJ-BRANCH. */
a0ed51b3
LW		 2401 }
2402 else if (paren == ':') {
c277df42
IZ		 2403 *flagp |= flags&SIMPLE;
2404 }
2405 if (open) { /* Starts with OPEN. */
830247a4 2406 regtail(pRExC_state, ret, br); /* OPEN -> first. */
a0ed51b3
LW		 2407 }
2408 else if (paren != '?') /* Not Conditional */
a0d0e21e 2409 ret = br;
32a0ca98 2410 *flagp |= flags & (SPSTART | HASWIDTH);
c277df42 2411 lastbr = br;
830247a4
IZ		 2412 while (*RExC_parse == '|') {
2413 if (!SIZE_ONLY && RExC_extralen) {
2414 ender = reganode(pRExC_state, LONGJMP,0);
2415 regtail(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
c277df42
IZ		 2416 }
2417 if (SIZE_ONLY)
830247a4
IZ		 2418 RExC_extralen += 2; /* Account for LONGJMP. */
2419 nextchar(pRExC_state);
2420 br = regbranch(pRExC_state, &flags, 0);
fac92740 2421
a687059c 2422 if (br == NULL)
a0d0e21e 2423 return(NULL);
830247a4 2424 regtail(pRExC_state, lastbr, br); /* BRANCH -> BRANCH. */
c277df42 2425 lastbr = br;
821b33a5
IZ		 2426 if (flags&HASWIDTH)
2427 *flagp |= HASWIDTH;
a687059c 2428 *flagp |= flags&SPSTART;
a0d0e21e
LW		 2429 }
2430
c277df42
IZ		 2431 if (have_branch || paren != ':') {
2432 /* Make a closing node, and hook it on the end. */
2433 switch (paren) {
2434 case ':':
830247a4 2435 ender = reg_node(pRExC_state, TAIL);
c277df42
IZ		 2436 break;
2437 case 1:
830247a4 2438 ender = reganode(pRExC_state, CLOSE, parno);
fac92740
MJD		 2439 Set_Node_Offset(ender,RExC_parse+1); /* MJD */
2440 Set_Node_Length(ender,1); /* MJD */
c277df42
IZ		 2441 break;
2442 case '<':
c277df42
IZ		 2443 case ',':
2444 case '=':
2445 case '!':
c277df42 2446 *flagp &= ~HASWIDTH;
821b33a5
IZ		 2447 /* FALL THROUGH */
2448 case '>':
830247a4 2449 ender = reg_node(pRExC_state, SUCCEED);
c277df42
IZ		 2450 break;
2451 case 0:
830247a4 2452 ender = reg_node(pRExC_state, END);
c277df42
IZ		 2453 break;
2454 }
830247a4 2455 regtail(pRExC_state, lastbr, ender);
a0d0e21e 2456
c277df42
IZ		 2457 if (have_branch) {
2458 /* Hook the tails of the branches to the closing node. */
2459 for (br = ret; br != NULL; br = regnext(br)) {
830247a4 2460 regoptail(pRExC_state, br, ender);
c277df42
IZ		 2461 }
2462 }
a0d0e21e 2463 }
c277df42
IZ		 2464
2465 {
2466 char *p;
2467 static char parens[] = "=!<,>";
2468
2469 if (paren && (p = strchr(parens, paren))) {
2470 int node = ((p - parens) % 2) ? UNLESSM : IFMATCH;
2471 int flag = (p - parens) > 1;
2472
2473 if (paren == '>')
2474 node = SUSPEND, flag = 0;
830247a4 2475 reginsert(pRExC_state, node,ret);
c277df42 2476 ret->flags = flag;
830247a4 2477 regtail(pRExC_state, ret, reg_node(pRExC_state, TAIL));
c277df42 2478 }
a0d0e21e
LW		 2479 }
2480
2481 /* Check for proper termination. */
ce3e6498 2482 if (paren) {
830247a4
IZ		 2483 RExC_flags16 = oregflags;
2484 if (RExC_parse >= RExC_end || *nextchar(pRExC_state) != ')') {
2485 RExC_parse = oregcomp_parse;
380a0633 2486 vFAIL("Unmatched (");
ce3e6498 2487 }
a0ed51b3 2488 }
830247a4
IZ		 2489 else if (!paren && RExC_parse < RExC_end) {
2490 if (*RExC_parse == ')') {
2491 RExC_parse++;
380a0633 2492 vFAIL("Unmatched )");
a0ed51b3
LW		 2493 }
2494 else
b45f050a 2495 FAIL("Junk on end of regexp"); /* "Can't happen". */
a0d0e21e
LW		 2496 /* NOTREACHED */
2497 }
a687059c 2498
a0d0e21e 2499 return(ret);
a687059c
LW		 2500}
2501
2502/*
2503 - regbranch - one alternative of an | operator
2504 *
2505 * Implements the concatenation operator.
2506 */
76e3520e 2507STATIC regnode *
830247a4 2508S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first)
a687059c 2509{
c277df42
IZ		 2510 register regnode *ret;
2511 register regnode *chain = NULL;
2512 register regnode *latest;
2513 I32 flags = 0, c = 0;
a0d0e21e 2514
b81d288d 2515 if (first)
c277df42
IZ		 2516 ret = NULL;
2517 else {
b81d288d 2518 if (!SIZE_ONLY && RExC_extralen)
830247a4 2519 ret = reganode(pRExC_state, BRANCHJ,0);
fac92740 2520 else {
830247a4 2521 ret = reg_node(pRExC_state, BRANCH);
fac92740
MJD		 2522 Set_Node_Length(ret, 1);
2523 }
c277df42
IZ		 2524 }
2525
b81d288d 2526 if (!first && SIZE_ONLY)
830247a4 2527 RExC_extralen += 1; /* BRANCHJ */
b81d288d 2528
c277df42 2529 *flagp = WORST; /* Tentatively. */
a0d0e21e 2530
830247a4
IZ		 2531 RExC_parse--;
2532 nextchar(pRExC_state);
2533 while (RExC_parse < RExC_end && *RExC_parse != '|' && *RExC_parse != ')') {
a0d0e21e 2534 flags &= ~TRYAGAIN;
830247a4 2535 latest = regpiece(pRExC_state, &flags);
a0d0e21e
LW		 2536 if (latest == NULL) {
2537 if (flags & TRYAGAIN)
2538 continue;
2539 return(NULL);
a0ed51b3
LW		 2540 }
2541 else if (ret == NULL)
c277df42 2542 ret = latest;
a0d0e21e 2543 *flagp |= flags&HASWIDTH;
c277df42 2544 if (chain == NULL) /* First piece. */
a0d0e21e
LW		 2545 *flagp |= flags&SPSTART;
2546 else {
830247a4
IZ		 2547 RExC_naughty++;
2548 regtail(pRExC_state, chain, latest);
a687059c 2549 }
a0d0e21e 2550 chain = latest;
c277df42
IZ		 2551 c++;
2552 }
2553 if (chain == NULL) { /* Loop ran zero times. */
830247a4 2554 chain = reg_node(pRExC_state, NOTHING);
c277df42
IZ		 2555 if (ret == NULL)
2556 ret = chain;
2557 }
2558 if (c == 1) {
2559 *flagp |= flags&SIMPLE;
a0d0e21e 2560 }
a687059c 2561
a0d0e21e 2562 return(ret);
a687059c
LW		 2563}
2564
2565/*
2566 - regpiece - something followed by possible [*+?]
2567 *
2568 * Note that the branching code sequences used for ? and the general cases
2569 * of * and + are somewhat optimized: they use the same NOTHING node as
2570 * both the endmarker for their branch list and the body of the last branch.
2571 * It might seem that this node could be dispensed with entirely, but the
2572 * endmarker role is not redundant.
2573 */
76e3520e 2574STATIC regnode *
830247a4 2575S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
a687059c 2576{
c277df42 2577 register regnode *ret;
a0d0e21e
LW		 2578 register char op;
2579 register char *next;
2580 I32 flags;
830247a4 2581 char *origparse = RExC_parse;
a0d0e21e
LW		 2582 char *maxpos;
2583 I32 min;
c277df42 2584 I32 max = REG_INFTY;
fac92740 2585 char *parse_start;
a0d0e21e 2586
830247a4 2587 ret = regatom(pRExC_state, &flags);
a0d0e21e
LW		 2588 if (ret == NULL) {
2589 if (flags & TRYAGAIN)
2590 *flagp |= TRYAGAIN;
2591 return(NULL);
2592 }
2593
830247a4 2594 op = *RExC_parse;
a0d0e21e 2595
830247a4 2596 if (op == '{' && regcurly(RExC_parse)) {
fac92740 2597 parse_start = RExC_parse; /* MJD */
830247a4 2598 next = RExC_parse + 1;
a0d0e21e
LW		 2599 maxpos = Nullch;
2600 while (isDIGIT(*next) || *next == ',') {
2601 if (*next == ',') {
2602 if (maxpos)
2603 break;
2604 else
2605 maxpos = next;
a687059c 2606 }
a0d0e21e
LW		 2607 next++;
2608 }
2609 if (*next == '}') { /* got one */
2610 if (!maxpos)
2611 maxpos = next;
830247a4
IZ		 2612 RExC_parse++;
2613 min = atoi(RExC_parse);
a0d0e21e
LW		 2614 if (*maxpos == ',')
2615 maxpos++;
2616 else
830247a4 2617 maxpos = RExC_parse;
a0d0e21e
LW		 2618 max = atoi(maxpos);
2619 if (!max && *maxpos != '0')
c277df42
IZ		 2620 max = REG_INFTY; /* meaning "infinity" */
2621 else if (max >= REG_INFTY)
8615cb43 2622 vFAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1);
830247a4
IZ		 2623 RExC_parse = next;
2624 nextchar(pRExC_state);
a0d0e21e
LW		 2625
2626 do_curly:
2627 if ((flags&SIMPLE)) {
830247a4
IZ		 2628 RExC_naughty += 2 + RExC_naughty / 2;
2629 reginsert(pRExC_state, CURLY, ret);
fac92740
MJD		 2630 Set_Node_Offset(ret, parse_start+1); /* MJD */
2631 Set_Node_Cur_Length(ret);
a0d0e21e
LW		 2632 }
2633 else {
830247a4 2634 regnode *w = reg_node(pRExC_state, WHILEM);
2c2d71f5
JH		 2635
2636 w->flags = 0;
830247a4
IZ		 2637 regtail(pRExC_state, ret, w);
2638 if (!SIZE_ONLY && RExC_extralen) {
2639 reginsert(pRExC_state, LONGJMP,ret);
2640 reginsert(pRExC_state, NOTHING,ret);
c277df42
IZ		 2641 NEXT_OFF(ret) = 3; /* Go over LONGJMP. */
2642 }
830247a4 2643 reginsert(pRExC_state, CURLYX,ret);
fac92740
MJD		 2644 /* MJD hk */
2645 Set_Node_Offset(ret, parse_start+1);
2646 Set_Node_Length(ret,
2647 op == '{' ? (RExC_parse - parse_start) : 1);
2648
830247a4 2649 if (!SIZE_ONLY && RExC_extralen)
c277df42 2650 NEXT_OFF(ret) = 3; /* Go over NOTHING to LONGJMP. */
830247a4 2651 regtail(pRExC_state, ret, reg_node(pRExC_state, NOTHING));
c277df42 2652 if (SIZE_ONLY)
830247a4
IZ		 2653 RExC_whilem_seen++, RExC_extralen += 3;
2654 RExC_naughty += 4 + RExC_naughty; /* compound interest */
a0d0e21e 2655 }
c277df42 2656 ret->flags = 0;
a0d0e21e
LW		 2657
2658 if (min > 0)
821b33a5
IZ		 2659 *flagp = WORST;
2660 if (max > 0)
2661 *flagp |= HASWIDTH;
a0d0e21e 2662 if (max && max < min)
8615cb43 2663 vFAIL("Can't do {n,m} with n > m");
c277df42
IZ		 2664 if (!SIZE_ONLY) {
2665 ARG1_SET(ret, min);
2666 ARG2_SET(ret, max);
a687059c 2667 }
a687059c 2668
a0d0e21e 2669 goto nest_check;
a687059c 2670 }
a0d0e21e 2671 }
a687059c 2672
a0d0e21e
LW		 2673 if (!ISMULT1(op)) {
2674 *flagp = flags;
a687059c 2675 return(ret);
a0d0e21e 2676 }
bb20fd44 2677
c277df42 2678#if 0 /* Now runtime fix should be reliable. */
b45f050a
JF		 2679
2680 /* if this is reinstated, don't forget to put this back into perldiag:
2681
2682 =item Regexp *+ operand could be empty at {#} in regex m/%s/
2683
2684 (F) The part of the regexp subject to either the * or + quantifier
2685 could match an empty string. The {#} shows in the regular
2686 expression about where the problem was discovered.
2687
2688 */
2689
bb20fd44 2690 if (!(flags&HASWIDTH) && op != '?')
b45f050a 2691 vFAIL("Regexp *+ operand could be empty");
b81d288d 2692#endif
bb20fd44 2693
fac92740 2694 parse_start = RExC_parse;
830247a4 2695 nextchar(pRExC_state);
a0d0e21e 2696
821b33a5 2697 *flagp = (op != '+') ? (WORST|SPSTART|HASWIDTH) : (WORST|HASWIDTH);
a0d0e21e
LW		 2698
2699 if (op == '*' && (flags&SIMPLE)) {
830247a4 2700 reginsert(pRExC_state, STAR, ret);
c277df42 2701 ret->flags = 0;
830247a4 2702 RExC_naughty += 4;
a0d0e21e
LW		 2703 }
2704 else if (op == '*') {
2705 min = 0;
2706 goto do_curly;
a0ed51b3
LW		 2707 }
2708 else if (op == '+' && (flags&SIMPLE)) {
830247a4 2709 reginsert(pRExC_state, PLUS, ret);
c277df42 2710 ret->flags = 0;
830247a4 2711 RExC_naughty += 3;
a0d0e21e
LW		 2712 }
2713 else if (op == '+') {
2714 min = 1;
2715 goto do_curly;
a0ed51b3
LW		 2716 }
2717 else if (op == '?') {
a0d0e21e
LW		 2718 min = 0; max = 1;
2719 goto do_curly;
2720 }
2721 nest_check:
e476b1b5 2722 if (ckWARN(WARN_REGEXP) && !SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3) {
830247a4 2723 vWARN3(RExC_parse,
b45f050a 2724 "%.*s matches null string many times",
830247a4 2725 RExC_parse - origparse,
b45f050a 2726 origparse);
a0d0e21e
LW		 2727 }
2728
830247a4
IZ		 2729 if (*RExC_parse == '?') {
2730 nextchar(pRExC_state);
2731 reginsert(pRExC_state, MINMOD, ret);
2732 regtail(pRExC_state, ret, ret + NODE_STEP_REGNODE);
a0d0e21e 2733 }
830247a4
IZ		 2734 if (ISMULT2(RExC_parse)) {
2735 RExC_parse++;
b45f050a
JF		 2736 vFAIL("Nested quantifiers");
2737 }
a0d0e21e
LW		 2738
2739 return(ret);
a687059c
LW		 2740}
2741
2742/*
2743 - regatom - the lowest level
2744 *
2745 * Optimization: gobbles an entire sequence of ordinary characters so that
2746 * it can turn them into a single node, which is smaller to store and
2747 * faster to run. Backslashed characters are exceptions, each becoming a
2748 * separate node; the code is simpler that way and it's not worth fixing.
2749 *
b45f050a 2750 * [Yes, it is worth fixing, some scripts can run twice the speed.] */
76e3520e 2751STATIC regnode *
830247a4 2752S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
a687059c 2753{
c277df42 2754 register regnode *ret = 0;
a0d0e21e 2755 I32 flags;
f06dbbb7 2756 char *parse_start = 0;
a0d0e21e
LW		 2757
2758 *flagp = WORST; /* Tentatively. */
2759
2760tryagain:
830247a4 2761 switch (*RExC_parse) {
a0d0e21e 2762 case '^':
830247a4
IZ		 2763 RExC_seen_zerolen++;
2764 nextchar(pRExC_state);
2765 if (RExC_flags16 & PMf_MULTILINE)
2766 ret = reg_node(pRExC_state, MBOL);
2767 else if (RExC_flags16 & PMf_SINGLELINE)
2768 ret = reg_node(pRExC_state, SBOL);
a0d0e21e 2769 else
830247a4 2770 ret = reg_node(pRExC_state, BOL);
fac92740 2771 Set_Node_Length(ret, 1); /* MJD */
a0d0e21e
LW		 2772 break;
2773 case '$':
830247a4 2774 nextchar(pRExC_state);
b81d288d 2775 if (*RExC_parse)
830247a4
IZ		 2776 RExC_seen_zerolen++;
2777 if (RExC_flags16 & PMf_MULTILINE)
2778 ret = reg_node(pRExC_state, MEOL);
2779 else if (RExC_flags16 & PMf_SINGLELINE)
2780 ret = reg_node(pRExC_state, SEOL);
a0d0e21e 2781 else
830247a4 2782 ret = reg_node(pRExC_state, EOL);
fac92740 2783 Set_Node_Length(ret, 1); /* MJD */
a0d0e21e
LW		 2784 break;
2785 case '.':
830247a4 2786 nextchar(pRExC_state);
cce850e4 2787 if (RExC_flags16 & PMf_SINGLELINE)
ffc61ed2
JH		 2788 ret = reg_node(pRExC_state, SANY);
2789 else
2790 ret = reg_node(pRExC_state, REG_ANY);
2791 *flagp |= HASWIDTH|SIMPLE;
830247a4 2792 RExC_naughty++;
fac92740 2793 Set_Node_Length(ret, 1); /* MJD */
a0d0e21e
LW		 2794 break;
2795 case '[':
b45f050a 2796 {
830247a4 2797 char *oregcomp_parse = ++RExC_parse;
ffc61ed2 2798 ret = regclass(pRExC_state);
830247a4
IZ		 2799 if (*RExC_parse != ']') {
2800 RExC_parse = oregcomp_parse;
b45f050a
JF		 2801 vFAIL("Unmatched [");
2802 }
830247a4 2803 nextchar(pRExC_state);
a0d0e21e 2804 *flagp |= HASWIDTH|SIMPLE;
fac92740 2805 Set_Node_Length(ret, RExC_parse - oregcomp_parse + 1); /* MJD */
a0d0e21e 2806 break;
b45f050a 2807 }
a0d0e21e 2808 case '(':
830247a4
IZ		 2809 nextchar(pRExC_state);
2810 ret = reg(pRExC_state, 1, &flags);
a0d0e21e 2811 if (ret == NULL) {
bf93d4cc 2812 if (flags & TRYAGAIN) {
830247a4 2813 if (RExC_parse == RExC_end) {
bf93d4cc
GS		 2814 /* Make parent create an empty node if needed. */
2815 *flagp |= TRYAGAIN;
2816 return(NULL);
2817 }
a0d0e21e 2818 goto tryagain;
bf93d4cc 2819 }
a0d0e21e
LW		 2820 return(NULL);
2821 }
c277df42 2822 *flagp |= flags&(HASWIDTH|SPSTART|SIMPLE);
a0d0e21e
LW		 2823 break;
2824 case '|':
2825 case ')':
2826 if (flags & TRYAGAIN) {
2827 *flagp |= TRYAGAIN;
2828 return NULL;
2829 }
b45f050a 2830 vFAIL("Internal urp");
a0d0e21e
LW		 2831 /* Supposed to be caught earlier. */
2832 break;
85afd4ae 2833 case '{':
830247a4
IZ		 2834 if (!regcurly(RExC_parse)) {
2835 RExC_parse++;
85afd4ae
CS		 2836 goto defchar;
2837 }
2838 /* FALL THROUGH */
a0d0e21e
LW		 2839 case '?':
2840 case '+':
2841 case '*':
830247a4 2842 RExC_parse++;
b45f050a 2843 vFAIL("Quantifier follows nothing");
a0d0e21e
LW		 2844 break;
2845 case '\\':
830247a4 2846 switch (*++RExC_parse) {
a0d0e21e 2847 case 'A':
830247a4
IZ		 2848 RExC_seen_zerolen++;
2849 ret = reg_node(pRExC_state, SBOL);
a0d0e21e 2850 *flagp |= SIMPLE;
830247a4 2851 nextchar(pRExC_state);
fac92740 2852 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW		 2853 break;
2854 case 'G':
830247a4
IZ		 2855 ret = reg_node(pRExC_state, GPOS);
2856 RExC_seen |= REG_SEEN_GPOS;
a0d0e21e 2857 *flagp |= SIMPLE;
830247a4 2858 nextchar(pRExC_state);
fac92740 2859 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW		 2860 break;
2861 case 'Z':
830247a4 2862 ret = reg_node(pRExC_state, SEOL);
a0d0e21e 2863 *flagp |= SIMPLE;
a1917ab9 2864 RExC_seen_zerolen++; /* Do not optimize RE away */
830247a4 2865 nextchar(pRExC_state);
a0d0e21e 2866 break;
b85d18e9 2867 case 'z':
830247a4 2868 ret = reg_node(pRExC_state, EOS);
b85d18e9 2869 *flagp |= SIMPLE;
830247a4
IZ		 2870 RExC_seen_zerolen++; /* Do not optimize RE away */
2871 nextchar(pRExC_state);
fac92740 2872 Set_Node_Length(ret, 2); /* MJD */
b85d18e9 2873 break;
4a2d328f 2874 case 'C':
f33976b4
DB		 2875 ret = reg_node(pRExC_state, CANY);
2876 RExC_seen |= REG_SEEN_CANY;
a0ed51b3 2877 *flagp |= HASWIDTH|SIMPLE;
830247a4 2878 nextchar(pRExC_state);
fac92740 2879 Set_Node_Length(ret, 2); /* MJD */
a0ed51b3
LW		 2880 break;
2881 case 'X':
830247a4 2882 ret = reg_node(pRExC_state, CLUMP);
a0ed51b3 2883 *flagp |= HASWIDTH;
830247a4 2884 nextchar(pRExC_state);
fac92740 2885 Set_Node_Length(ret, 2); /* MJD */
a0ed51b3 2886 break;
a0d0e21e 2887 case 'w':
ffc61ed2 2888 ret = reg_node(pRExC_state, LOC ? ALNUML : ALNUM);
a0d0e21e 2889 *flagp |= HASWIDTH|SIMPLE;
830247a4 2890 nextchar(pRExC_state);
fac92740 2891 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW		 2892 break;
2893 case 'W':
ffc61ed2 2894 ret = reg_node(pRExC_state, LOC ? NALNUML : NALNUM);
a0d0e21e 2895 *flagp |= HASWIDTH|SIMPLE;
830247a4 2896 nextchar(pRExC_state);
fac92740 2897 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW		 2898 break;
2899 case 'b':
830247a4
IZ		 2900 RExC_seen_zerolen++;
2901 RExC_seen |= REG_SEEN_LOOKBEHIND;
ffc61ed2 2902 ret = reg_node(pRExC_state, LOC ? BOUNDL : BOUND);
a0d0e21e 2903 *flagp |= SIMPLE;
830247a4 2904 nextchar(pRExC_state);
fac92740 2905 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW		 2906 break;
2907 case 'B':
830247a4
IZ		 2908 RExC_seen_zerolen++;
2909 RExC_seen |= REG_SEEN_LOOKBEHIND;
ffc61ed2 2910 ret = reg_node(pRExC_state, LOC ? NBOUNDL : NBOUND);
a0d0e21e 2911 *flagp |= SIMPLE;
830247a4 2912 nextchar(pRExC_state);
fac92740 2913 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW		 2914 break;
2915 case 's':
ffc61ed2 2916 ret = reg_node(pRExC_state, LOC ? SPACEL : SPACE);
a0d0e21e 2917 *flagp |= HASWIDTH|SIMPLE;
830247a4 2918 nextchar(pRExC_state);
fac92740 2919 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW		 2920 break;
2921 case 'S':
ffc61ed2 2922 ret = reg_node(pRExC_state, LOC ? NSPACEL : NSPACE);
a0d0e21e 2923 *flagp |= HASWIDTH|SIMPLE;
830247a4 2924 nextchar(pRExC_state);
fac92740 2925 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW		 2926 break;
2927 case 'd':
ffc61ed2 2928 ret = reg_node(pRExC_state, DIGIT);
a0d0e21e 2929 *flagp |= HASWIDTH|SIMPLE;
830247a4 2930 nextchar(pRExC_state);
fac92740 2931 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e
LW		 2932 break;
2933 case 'D':
ffc61ed2 2934 ret = reg_node(pRExC_state, NDIGIT);
a0d0e21e 2935 *flagp |= HASWIDTH|SIMPLE;
830247a4 2936 nextchar(pRExC_state);
fac92740 2937 Set_Node_Length(ret, 2); /* MJD */
a0d0e21e 2938 break;
a14b48bc
LW		 2939 case 'p':
2940 case 'P':
3568d838 2941 {
830247a4 2942 char* oldregxend = RExC_end;
fac92740 2943 char* parse_start = RExC_parse;
a14b48bc 2944
830247a4 2945 if (RExC_parse[1] == '{') {
3568d838 2946 /* a lovely hack--pretend we saw [\pX] instead */
830247a4
IZ		 2947 RExC_end = strchr(RExC_parse, '}');
2948 if (!RExC_end) {
0da60cf5 2949 U8 c = (U8)*RExC_parse;
830247a4
IZ		 2950 RExC_parse += 2;
2951 RExC_end = oldregxend;
0da60cf5 2952 vFAIL2("Missing right brace on \\%c{}", c);
b45f050a 2953 }
830247a4 2954 RExC_end++;
a14b48bc
LW		 2955 }
2956 else
830247a4
IZ		 2957 RExC_end = RExC_parse + 2;
2958 RExC_parse--;
a14b48bc 2959
ffc61ed2 2960 ret = regclass(pRExC_state);
a14b48bc 2961
830247a4
IZ		 2962 RExC_end = oldregxend;
2963 RExC_parse--;
fac92740 2964 Set_Node_Cur_Length(ret); /* MJD */
830247a4 2965 nextchar(pRExC_state);
a14b48bc
LW		 2966 *flagp |= HASWIDTH|SIMPLE;
2967 }
2968 break;
a0d0e21e
LW		 2969 case 'n':
2970 case 'r':
2971 case 't':
2972 case 'f':
2973 case 'e':
2974 case 'a':
2975 case 'x':
2976 case 'c':
2977 case '0':
2978 goto defchar;
2979 case '1': case '2': case '3': case '4':
2980 case '5': case '6': case '7': case '8': case '9':
2981 {
830247a4 2982 I32 num = atoi(RExC_parse);
a0d0e21e 2983
830247a4 2984 if (num > 9 && num >= RExC_npar)
a0d0e21e
LW		 2985 goto defchar;
2986 else {
fac92740 2987 char * parse_start = RExC_parse - 1; /* MJD */
830247a4
IZ		 2988 while (isDIGIT(*RExC_parse))
2989 RExC_parse++;
b45f050a 2990
830247a4 2991 if (!SIZE_ONLY && num > RExC_rx->nparens)
9baa0206 2992 vFAIL("Reference to nonexistent group");
830247a4
IZ		 2993 RExC_sawback = 1;
2994 ret = reganode(pRExC_state, FOLD
a0ed51b3 2995 ? (LOC ? REFFL : REFF)
c8756f30 2996 : REF, num);
a0d0e21e 2997 *flagp |= HASWIDTH;
fac92740
MJD		 2998
2999 /* override incorrect value set in reganode MJD */
3000 Set_Node_Offset(ret, parse_start+1);
3001 Set_Node_Cur_Length(ret); /* MJD */
830247a4
IZ		 3002 RExC_parse--;
3003 nextchar(pRExC_state);
a0d0e21e
LW		 3004 }
3005 }
3006 break;
3007 case '\0':
830247a4 3008 if (RExC_parse >= RExC_end)
b45f050a 3009 FAIL("Trailing \\");
a0d0e21e
LW		 3010 /* FALL THROUGH */
3011 default:
c9f97d15
IZ		 3012 /* Do not generate `unrecognized' warnings here, we fall
3013 back into the quick-grab loop below */
a0d0e21e
LW		 3014 goto defchar;
3015 }
3016 break;
4633a7c4
LW		 3017
3018 case '#':
830247a4
IZ		 3019 if (RExC_flags16 & PMf_EXTENDED) {
3020 while (RExC_parse < RExC_end && *RExC_parse != '\n') RExC_parse++;
3021 if (RExC_parse < RExC_end)
4633a7c4
LW		 3022 goto tryagain;
3023 }
3024 /* FALL THROUGH */
3025
a0d0e21e 3026 default: {
ba210ebe 3027 register STRLEN len;
a0ed51b3 3028 register UV ender;
a0d0e21e 3029 register char *p;
c277df42 3030 char *oldp, *s;
ba210ebe 3031 STRLEN numlen;
80aecb99 3032 STRLEN foldlen;
60a8b682 3033 U8 tmpbuf[UTF8_MAXLEN_FOLD+1], *foldbuf;
f06dbbb7
JH		 3034
3035 parse_start = RExC_parse - 1;
a0d0e21e 3036
830247a4 3037 RExC_parse++;
a0d0e21e
LW		 3038
3039 defchar:
830247a4 3040 ret = reg_node(pRExC_state, FOLD
a0ed51b3 3041 ? (LOC ? EXACTFL : EXACTF)
bbce6d69 3042 : EXACT);
cd439c50 3043 s = STRING(ret);
830247a4
IZ		 3044 for (len = 0, p = RExC_parse - 1;
3045 len < 127 && p < RExC_end;
a0d0e21e
LW		 3046 len++)
3047 {
3048 oldp = p;
5b5a24f7 3049
830247a4
IZ		 3050 if (RExC_flags16 & PMf_EXTENDED)
3051 p = regwhite(p, RExC_end);
a0d0e21e
LW		 3052 switch (*p) {
3053 case '^':
3054 case '$':
3055 case '.':
3056 case '[':
3057 case '(':
3058 case ')':
3059 case '|':
3060 goto loopdone;
3061 case '\\':
3062 switch (*++p) {
3063 case 'A':
1ed8eac0
JF		 3064 case 'C':
3065 case 'X':
a0d0e21e
LW		 3066 case 'G':
3067 case 'Z':
b85d18e9 3068 case 'z':
a0d0e21e
LW		 3069 case 'w':
3070 case 'W':
3071 case 'b':
3072 case 'B':
3073 case 's':
3074 case 'S':
3075 case 'd':
3076 case 'D':
a14b48bc
LW		 3077 case 'p':
3078 case 'P':
a0d0e21e
LW		 3079 --p;
3080 goto loopdone;
3081 case 'n':
3082 ender = '\n';
3083 p++;
a687059c 3084 break;
a0d0e21e
LW		 3085 case 'r':
3086 ender = '\r';
3087 p++;
a687059c 3088 break;
a0d0e21e
LW		 3089 case 't':
3090 ender = '\t';
3091 p++;
a687059c 3092 break;
a0d0e21e
LW		 3093 case 'f':
3094 ender = '\f';
3095 p++;
a687059c 3096 break;
a0d0e21e 3097 case 'e':
c7f1f016 3098 ender = ASCII_TO_NATIVE('\033');
a0d0e21e 3099 p++;
a687059c 3100 break;
a0d0e21e 3101 case 'a':
c7f1f016 3102 ender = ASCII_TO_NATIVE('\007');
a0d0e21e 3103 p++;
a687059c 3104 break;
a0d0e21e 3105 case 'x':
a0ed51b3
LW		 3106 if (*++p == '{') {
3107 char* e = strchr(p, '}');
b81d288d 3108
b45f050a 3109 if (!e) {
830247a4 3110 RExC_parse = p + 1;
b45f050a
JF		 3111 vFAIL("Missing right brace on \\x{}");
3112 }
de5f0749 3113 else {
a4c04bdc
NC		 3114 I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
3115 | PERL_SCAN_DISALLOW_PREFIX;
53305cf1
NC		 3116 numlen = e - p - 1;
3117 ender = grok_hex(p + 1, &numlen, &flags, NULL);
aaa80028
JH		 3118 if (ender > 0xff)
3119 RExC_utf8 = 1;
b21ed0a9
GS		 3120 /* numlen is generous */
3121 if (numlen + len >= 127) {
a0ed51b3
LW		 3122 p--;
3123 goto loopdone;
3124 }
3125 p = e + 1;
3126 }
a0ed51b3
LW		 3127 }
3128 else {
a4c04bdc 3129 I32 flags = PERL_SCAN_DISALLOW_PREFIX;
53305cf1
NC		 3130 numlen = 2;
3131 ender = grok_hex(p, &numlen, &flags, NULL);
a0ed51b3
LW		 3132 p += numlen;
3133 }
a687059c 3134 break;
a0d0e21e
LW		 3135 case 'c':
3136 p++;
bbce6d69 3137 ender = UCHARAT(p++);
3138 ender = toCTRL(ender);
a687059c 3139 break;
a0d0e21e
LW		 3140 case '0': case '1': case '2': case '3':case '4':
3141 case '5': case '6': case '7': case '8':case '9':
3142 if (*p == '0' ||
830247a4 3143 (isDIGIT(p[1]) && atoi(p) >= RExC_npar) ) {
53305cf1
NC		 3144 I32 flags = 0;
3145 numlen = 3;
3146 ender = grok_oct(p, &numlen, &flags, NULL);
a0d0e21e
LW		 3147 p += numlen;
3148 }
3149 else {
3150 --p;
3151 goto loopdone;
a687059c
LW		 3152 }
3153 break;
a0d0e21e 3154 case '\0':
830247a4 3155 if (p >= RExC_end)
b45f050a 3156 FAIL("Trailing \\");
a687059c 3157 /* FALL THROUGH */
a0d0e21e 3158 default:
e476b1b5 3159 if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(*p))
4193bef7 3160 vWARN2(p + 1, "Unrecognized escape \\%c passed through", UCHARAT(p));
a0ed51b3 3161 goto normal_default;
a0d0e21e
LW		 3162 }
3163 break;
a687059c 3164 default:
a0ed51b3 3165 normal_default:
fd400ab9 3166 if (UTF8_IS_START(*p) && UTF) {
5e12f4fb 3167 ender = utf8n_to_uvchr((U8*)p, RExC_end - p,
ba210ebe 3168 &numlen, 0);
a0ed51b3
LW		 3169 p += numlen;
3170 }
3171 else
3172 ender = *p++;
a0d0e21e 3173 break;
a687059c 3174 }
830247a4
IZ		 3175 if (RExC_flags16 & PMf_EXTENDED)
3176 p = regwhite(p, RExC_end);
60a8b682
JH		 3177 if (UTF && FOLD) {
3178 /* Prime the casefolded buffer. */
ac7e0132 3179 ender = toFOLD_uni(ender, tmpbuf, &foldlen);
60a8b682 3180 }
a0d0e21e
LW		 3181 if (ISMULT2(p)) { /* Back off on ?+*. */
3182 if (len)
3183 p = oldp;
16ea2a2e 3184 else if (UTF) {
80aecb99 3185 if (FOLD) {
60a8b682 3186 /* Emit all the Unicode characters. */
80aecb99
JH		 3187 for (foldbuf = tmpbuf;
3188 foldlen;
3189 foldlen -= numlen) {
3190 ender = utf8_to_uvchr(foldbuf, &numlen);
3191 reguni(pRExC_state, ender, s, &numlen);
3192 s += numlen;
3193 len += numlen;
3194 foldbuf += numlen;
3195 }
3196 }
3197 else {
3198 reguni(pRExC_state, ender, s, &numlen);
3199 s += numlen;
3200 len += numlen;
3201 }
a0ed51b3 3202 }
a0d0e21e
LW		 3203 else {
3204 len++;
cd439c50 3205 REGC(ender, s++);
a0d0e21e
LW		 3206 }
3207 break;
a687059c 3208 }
16ea2a2e 3209 if (UTF) {
80aecb99 3210 if (FOLD) {
60a8b682 3211 /* Emit all the Unicode characters. */
80aecb99
JH		 3212 for (foldbuf = tmpbuf;
3213 foldlen;
3214 foldlen -= numlen) {
3215 ender = utf8_to_uvchr(foldbuf, &numlen);
3216 reguni(pRExC_state, ender, s, &numlen);
3217 s += numlen;
3218 len += numlen;
3219 foldbuf += numlen;
3220 }
3221 }
3222 else {
3223 reguni(pRExC_state, ender, s, &numlen);
3224 s += numlen;
3225 len += numlen;
3226 }
3227 len--;
a0ed51b3
LW		 3228 }
3229 else
cd439c50 3230 REGC(ender, s++);
a0d0e21e
LW		 3231 }
3232 loopdone:
830247a4 3233 RExC_parse = p - 1;
fac92740 3234 Set_Node_Cur_Length(ret); /* MJD */
830247a4 3235 nextchar(pRExC_state);
793db0cb
JH		 3236 {
3237 /* len is STRLEN which is unsigned, need to copy to signed */
3238 IV iv = len;
3239 if (iv < 0)
3240 vFAIL("Internal disaster");
3241 }
a0d0e21e
LW		 3242 if (len > 0)
3243 *flagp |= HASWIDTH;
3244 if (len == 1)
3245 *flagp |= SIMPLE;
c277df42 3246 if (!SIZE_ONLY)
cd439c50
IZ		 3247 STR_LEN(ret) = len;
3248 if (SIZE_ONLY)
830247a4 3249 RExC_size += STR_SZ(len);
cd439c50 3250 else
830247a4 3251 RExC_emit += STR_SZ(len);
a687059c 3252 }
a0d0e21e
LW		 3253 break;
3254 }
a687059c 3255
60a8b682
JH		 3256 /* If the encoding pragma is in effect recode the text of
3257 * any EXACT-kind nodes. */
22c54be3 3258 if (PL_encoding && PL_regkind[(U8)OP(ret)] == EXACT) {
a72c7584
JH		 3259 STRLEN oldlen = STR_LEN(ret);
3260 SV *sv = sv_2mortal(newSVpvn(STRING(ret), oldlen));
22c54be3
JH		 3261
3262 if (RExC_utf8)
3263 SvUTF8_on(sv);
3264 if (sv_utf8_downgrade(sv, TRUE)) {
3265 char *s = Perl_sv_recode_to_utf8(aTHX_ sv, PL_encoding);
3266 STRLEN newlen = SvCUR(sv);
3267
3268 if (!SIZE_ONLY) {
3269 DEBUG_r(PerlIO_printf(Perl_debug_log, "recode %*s to %*s\n",
3270 (int)oldlen, STRING(ret),
3271 (int)newlen, s));
3272 Copy(s, STRING(ret), newlen, char);
3273 STR_LEN(ret) += newlen - oldlen;
3274 RExC_emit += STR_SZ(newlen) - STR_SZ(oldlen);
3275 } else
3276 RExC_size += STR_SZ(newlen) - STR_SZ(oldlen);
3277 }
a72c7584
JH		 3278 }
3279
a0d0e21e 3280 return(ret);
a687059c
LW		 3281}
3282
873ef191 3283STATIC char *
cea2e8a9 3284S_regwhite(pTHX_ char *p, char *e)
5b5a24f7
CS		 3285{
3286 while (p < e) {
3287 if (isSPACE(*p))
3288 ++p;
3289 else if (*p == '#') {
3290 do {
3291 p++;
3292 } while (p < e && *p != '\n');
3293 }
3294 else
3295 break;
3296 }
3297 return p;
3298}
3299
b8c5462f
JH		 3300/* Parse POSIX character classes: [[:foo:]], [[=foo=]], [[.foo.]].
3301 Character classes ([:foo:]) can also be negated ([:^foo:]).
3302 Returns a named class id (ANYOF_XXX) if successful, -1 otherwise.
3303 Equivalence classes ([=foo=]) and composites ([.foo.]) are parsed,
beeb77fc 3304 but trigger failures because they are currently unimplemented. */
9a86a77b
JH		 3305
3306#define POSIXCC_DONE(c) ((c) == ':')
3307#define POSIXCC_NOTYET(c) ((c) == '=' || (c) == '.')
3308#define POSIXCC(c) (POSIXCC_DONE(c) || POSIXCC_NOTYET(c))
3309
b8c5462f 3310STATIC I32
830247a4 3311S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
620e46c5
JH		 3312{
3313 char *posixcc = 0;
936ed897 3314 I32 namedclass = OOB_NAMEDCLASS;
620e46c5 3315
830247a4 3316 if (value == '[' && RExC_parse + 1 < RExC_end &&
620e46c5 3317 /* I smell either [: or [= or [. -- POSIX has been here, right? */
9a86a77b
JH		 3318 POSIXCC(UCHARAT(RExC_parse))) {
3319 char c = UCHARAT(RExC_parse);
830247a4 3320 char* s = RExC_parse++;
b81d288d 3321
9a86a77b 3322 while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != c)
830247a4
IZ		 3323 RExC_parse++;
3324 if (RExC_parse == RExC_end)
620e46c5 3325 /* Grandfather lone [:, [=, [. */
830247a4 3326 RExC_parse = s;
620e46c5 3327 else {
830247a4 3328 char* t = RExC_parse++; /* skip over the c */
b8c5462f 3329
9a86a77b 3330 if (UCHARAT(RExC_parse) == ']') {
830247a4 3331 RExC_parse++; /* skip over the ending ] */
b8c5462f
JH		 3332 posixcc = s + 1;
3333 if (*s == ':') {
3334 I32 complement = *posixcc == '^' ? *posixcc++ : 0;
3335 I32 skip = 5; /* the most common skip */
3336
3337 switch (*posixcc) {
3338 case 'a':
3339 if (strnEQ(posixcc, "alnum", 5))
3340 namedclass =
3341 complement ? ANYOF_NALNUMC : ANYOF_ALNUMC;
3342 else if (strnEQ(posixcc, "alpha", 5))
3343 namedclass =
3344 complement ? ANYOF_NALPHA : ANYOF_ALPHA;
3345 else if (strnEQ(posixcc, "ascii", 5))
3346 namedclass =
3347 complement ? ANYOF_NASCII : ANYOF_ASCII;
3348 break;
aaa51d5e
JF		 3349 case 'b':
3350 if (strnEQ(posixcc, "blank", 5))
3351 namedclass =
3352 complement ? ANYOF_NBLANK : ANYOF_BLANK;
3353 break;
b8c5462f
JH		 3354 case 'c':
3355 if (strnEQ(posixcc, "cntrl", 5))
3356 namedclass =
3357 complement ? ANYOF_NCNTRL : ANYOF_CNTRL;
3358 break;
3359 case 'd':
3360 if (strnEQ(posixcc, "digit", 5))
3361 namedclass =
3362 complement ? ANYOF_NDIGIT : ANYOF_DIGIT;
3363 break;
3364 case 'g':
3365 if (strnEQ(posixcc, "graph", 5))
3366 namedclass =
3367 complement ? ANYOF_NGRAPH : ANYOF_GRAPH;
3368 break;
3369 case 'l':
3370 if (strnEQ(posixcc, "lower", 5))
3371 namedclass =
3372 complement ? ANYOF_NLOWER : ANYOF_LOWER;
3373 break;
3374 case 'p':
3375 if (strnEQ(posixcc, "print", 5))
3376 namedclass =
3377 complement ? ANYOF_NPRINT : ANYOF_PRINT;
3378 else if (strnEQ(posixcc, "punct", 5))
3379 namedclass =
3380 complement ? ANYOF_NPUNCT : ANYOF_PUNCT;
3381 break;
3382 case 's':
3383 if (strnEQ(posixcc, "space", 5))
3384 namedclass =
aaa51d5e 3385 complement ? ANYOF_NPSXSPC : ANYOF_PSXSPC;
cc4319de 3386 break;
b8c5462f
JH		 3387 case 'u':
3388 if (strnEQ(posixcc, "upper", 5))
3389 namedclass =
3390 complement ? ANYOF_NUPPER : ANYOF_UPPER;
3391 break;
3392 case 'w': /* this is not POSIX, this is the Perl \w */
3393 if (strnEQ(posixcc, "word", 4)) {
3394 namedclass =
3395 complement ? ANYOF_NALNUM : ANYOF_ALNUM;
3396 skip = 4;
3397 }
3398 break;
3399 case 'x':
3400 if (strnEQ(posixcc, "xdigit", 6)) {
3401 namedclass =
3402 complement ? ANYOF_NXDIGIT : ANYOF_XDIGIT;
3403 skip = 6;
3404 }
3405 break;
3406 }
ac561586
JH		 3407 if (namedclass == OOB_NAMEDCLASS ||
3408 posixcc[skip] != ':' ||
3409 posixcc[skip+1] != ']')
b45f050a
JF		 3410 {
3411 Simple_vFAIL3("POSIX class [:%.*s:] unknown",
3412 t - s - 1, s + 1);
3413 }
3414 } else if (!SIZE_ONLY) {
b8c5462f 3415 /* [[=foo=]] and [[.foo.]] are still future. */
b45f050a 3416
830247a4 3417 /* adjust RExC_parse so the warning shows after
b45f050a 3418 the class closes */
9a86a77b 3419 while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse) != ']')
830247a4 3420 RExC_parse++;
b45f050a
JF		 3421 Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
3422 }
b8c5462f
JH		 3423 } else {
3424 /* Maternal grandfather:
3425 * "[:" ending in ":" but not in ":]" */
830247a4 3426 RExC_parse = s;
767d463e 3427 }
620e46c5
JH		 3428 }
3429 }
3430
b8c5462f
JH		 3431 return namedclass;
3432}
3433
3434STATIC void
830247a4 3435S_checkposixcc(pTHX_ RExC_state_t *pRExC_state)
b8c5462f 3436{
e476b1b5 3437 if (!SIZE_ONLY && ckWARN(WARN_REGEXP) &&
9a86a77b 3438 POSIXCC(UCHARAT(RExC_parse))) {
830247a4 3439 char *s = RExC_parse;
93733859 3440 char c = *s++;
b8c5462f
JH		 3441
3442 while(*s && isALNUM(*s))
3443 s++;
3444 if (*s && c == *s && s[1] == ']') {
b45f050a
JF		 3445 vWARN3(s+2, "POSIX syntax [%c %c] belongs inside character classes", c, c);
3446
3447 /* [[=foo=]] and [[.foo.]] are still future. */
9a86a77b 3448 if (POSIXCC_NOTYET(c)) {
830247a4 3449 /* adjust RExC_parse so the error shows after
b45f050a 3450 the class closes */
9a86a77b 3451 while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse++) != ']')
b45f050a
JF		 3452 ;
3453 Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
3454 }
b8c5462f
JH		 3455 }
3456 }
620e46c5
JH		 3457}
3458
76e3520e 3459STATIC regnode *
830247a4 3460S_regclass(pTHX_ RExC_state_t *pRExC_state)
a687059c 3461{
ffc61ed2 3462 register UV value;
9a86a77b 3463 register UV nextvalue;
3568d838 3464 register IV prevvalue = OOB_UNICODE;
ffc61ed2 3465 register IV range = 0;
c277df42 3466 register regnode *ret;
ba210ebe 3467 STRLEN numlen;
ffc61ed2 3468 IV namedclass;
9c5ffd7c 3469 char *rangebegin = 0;
936ed897 3470 bool need_class = 0;
9c5ffd7c 3471 SV *listsv = Nullsv;
ffc61ed2
JH		 3472 register char *e;
3473 UV n;