/
regcomp.c
21020 lines (18650 loc) · 795 KB
/
regcomp.c
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/* regcomp.c
*/
/*
* 'A fair jaw-cracker dwarf-language must be.' --Samwise Gamgee
*
* [p.285 of _The Lord of the Rings_, II/iii: "The Ring Goes South"]
*/
/* This file contains functions for compiling a regular expression. See
* also regexec.c which funnily enough, contains functions for executing
* a regular expression.
*
* This file is also copied at build time to ext/re/re_comp.c, where
* it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
* This causes the main functions to be compiled under new names and with
* debugging support added, which makes "use re 'debug'" work.
*/
/* NOTE: this is derived from Henry Spencer's regexp code, and should not
* confused with the original package (see point 3 below). Thanks, Henry!
*/
/* Additional note: this code is very heavily munged from Henry's version
* in places. In some spots I've traded clarity for efficiency, so don't
* blame Henry for some of the lack of readability.
*/
/* The names of the functions have been changed from regcomp and
* regexec to pregcomp and pregexec in order to avoid conflicts
* with the POSIX routines of the same names.
*/
#ifdef PERL_EXT_RE_BUILD
#include "re_top.h"
#endif
/*
* pregcomp and pregexec -- regsub and regerror are not used in perl
*
* Copyright (c) 1986 by University of Toronto.
* Written by Henry Spencer. Not derived from licensed software.
*
* Permission is granted to anyone to use this software for any
* purpose on any computer system, and to redistribute it freely,
* subject to the following restrictions:
*
* 1. The author is not responsible for the consequences of use of
* this software, no matter how awful, even if they arise
* from defects in it.
*
* 2. The origin of this software must not be misrepresented, either
* by explicit claim or by omission.
*
* 3. Altered versions must be plainly marked as such, and must not
* be misrepresented as being the original software.
*
*
**** Alterations to Henry's code are...
****
**** Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
**** 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
**** by Larry Wall and others
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
*
* Beware that some of this code is subtly aware of the way operator
* precedence is structured in regular expressions. Serious changes in
* regular-expression syntax might require a total rethink.
*/
#include "EXTERN.h"
#define PERL_IN_REGCOMP_C
#include "perl.h"
#ifndef PERL_IN_XSUB_RE
# include "INTERN.h"
#endif
#define REG_COMP_C
#ifdef PERL_IN_XSUB_RE
# include "re_comp.h"
EXTERN_C const struct regexp_engine my_reg_engine;
#else
# include "regcomp.h"
#endif
#include "dquote_inline.h"
#include "invlist_inline.h"
#include "unicode_constants.h"
#define HAS_NONLATIN1_FOLD_CLOSURE(i) \
_HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
#define HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(i) \
_HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
#define IS_NON_FINAL_FOLD(c) _IS_NON_FINAL_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c)
#define IS_IN_SOME_FOLD_L1(c) _IS_IN_SOME_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c)
#ifndef STATIC
#define STATIC static
#endif
/* this is a chain of data about sub patterns we are processing that
need to be handled separately/specially in study_chunk. Its so
we can simulate recursion without losing state. */
struct scan_frame;
typedef struct scan_frame {
regnode *last_regnode; /* last node to process in this frame */
regnode *next_regnode; /* next node to process when last is reached */
U32 prev_recursed_depth;
I32 stopparen; /* what stopparen do we use */
struct scan_frame *this_prev_frame; /* this previous frame */
struct scan_frame *prev_frame; /* previous frame */
struct scan_frame *next_frame; /* next frame */
} scan_frame;
/* Certain characters are output as a sequence with the first being a
* backslash. */
#define isBACKSLASHED_PUNCT(c) strchr("-[]\\^", c)
struct RExC_state_t {
U32 flags; /* RXf_* are we folding, multilining? */
U32 pm_flags; /* PMf_* stuff from the calling PMOP */
char *precomp; /* uncompiled string. */
char *precomp_end; /* pointer to end of uncompiled string. */
REGEXP *rx_sv; /* The SV that is the regexp. */
regexp *rx; /* perl core regexp structure */
regexp_internal *rxi; /* internal data for regexp object
pprivate field */
char *start; /* Start of input for compile */
char *end; /* End of input for compile */
char *parse; /* Input-scan pointer. */
char *adjusted_start; /* 'start', adjusted. See code use */
STRLEN precomp_adj; /* an offset beyond precomp. See code use */
SSize_t whilem_seen; /* number of WHILEM in this expr */
regnode *emit_start; /* Start of emitted-code area */
regnode *emit_bound; /* First regnode outside of the
allocated space */
regnode *emit; /* Code-emit pointer; if = &emit_dummy,
implies compiling, so don't emit */
regnode_ssc emit_dummy; /* placeholder for emit to point to;
large enough for the largest
non-EXACTish node, so can use it as
scratch in pass1 */
I32 naughty; /* How bad is this pattern? */
I32 sawback; /* Did we see \1, ...? */
U32 seen;
SSize_t size; /* Code size. */
I32 npar; /* Capture buffer count, (OPEN) plus
one. ("par" 0 is the whole
pattern)*/
I32 nestroot; /* root parens we are in - used by
accept */
I32 extralen;
I32 seen_zerolen;
regnode **open_parens; /* pointers to open parens */
regnode **close_parens; /* pointers to close parens */
regnode *end_op; /* END node in program */
I32 utf8; /* whether the pattern is utf8 or not */
I32 orig_utf8; /* whether the pattern was originally in utf8 */
/* XXX use this for future optimisation of case
* where pattern must be upgraded to utf8. */
I32 uni_semantics; /* If a d charset modifier should use unicode
rules, even if the pattern is not in
utf8 */
HV *paren_names; /* Paren names */
regnode **recurse; /* Recurse regops */
I32 recurse_count; /* Number of recurse regops we have generated */
U8 *study_chunk_recursed; /* bitmap of which subs we have moved
through */
U32 study_chunk_recursed_bytes; /* bytes in bitmap */
I32 in_lookbehind;
I32 contains_locale;
I32 override_recoding;
#ifdef EBCDIC
I32 recode_x_to_native;
#endif
I32 in_multi_char_class;
struct reg_code_blocks *code_blocks;/* positions of literal (?{})
within pattern */
int code_index; /* next code_blocks[] slot */
SSize_t maxlen; /* mininum possible number of chars in string to match */
scan_frame *frame_head;
scan_frame *frame_last;
U32 frame_count;
AV *warn_text;
#ifdef ADD_TO_REGEXEC
char *starttry; /* -Dr: where regtry was called. */
#define RExC_starttry (pRExC_state->starttry)
#endif
SV *runtime_code_qr; /* qr with the runtime code blocks */
#ifdef DEBUGGING
const char *lastparse;
I32 lastnum;
AV *paren_name_list; /* idx -> name */
U32 study_chunk_recursed_count;
SV *mysv1;
SV *mysv2;
#define RExC_lastparse (pRExC_state->lastparse)
#define RExC_lastnum (pRExC_state->lastnum)
#define RExC_paren_name_list (pRExC_state->paren_name_list)
#define RExC_study_chunk_recursed_count (pRExC_state->study_chunk_recursed_count)
#define RExC_mysv (pRExC_state->mysv1)
#define RExC_mysv1 (pRExC_state->mysv1)
#define RExC_mysv2 (pRExC_state->mysv2)
#endif
bool seen_unfolded_sharp_s;
bool strict;
bool study_started;
bool in_script_run;
};
#define RExC_flags (pRExC_state->flags)
#define RExC_pm_flags (pRExC_state->pm_flags)
#define RExC_precomp (pRExC_state->precomp)
#define RExC_precomp_adj (pRExC_state->precomp_adj)
#define RExC_adjusted_start (pRExC_state->adjusted_start)
#define RExC_precomp_end (pRExC_state->precomp_end)
#define RExC_rx_sv (pRExC_state->rx_sv)
#define RExC_rx (pRExC_state->rx)
#define RExC_rxi (pRExC_state->rxi)
#define RExC_start (pRExC_state->start)
#define RExC_end (pRExC_state->end)
#define RExC_parse (pRExC_state->parse)
#define RExC_whilem_seen (pRExC_state->whilem_seen)
/* Set during the sizing pass when there is a LATIN SMALL LETTER SHARP S in any
* EXACTF node, hence was parsed under /di rules. If later in the parse,
* something forces the pattern into using /ui rules, the sharp s should be
* folded into the sequence 'ss', which takes up more space than previously
* calculated. This means that the sizing pass needs to be restarted. (The
* node also becomes an EXACTFU_SS.) For all other characters, an EXACTF node
* that gets converted to /ui (and EXACTFU) occupies the same amount of space,
* so there is no need to resize [perl #125990]. */
#define RExC_seen_unfolded_sharp_s (pRExC_state->seen_unfolded_sharp_s)
#ifdef RE_TRACK_PATTERN_OFFSETS
#define RExC_offsets (pRExC_state->rxi->u.offsets) /* I am not like the
others */
#endif
#define RExC_emit (pRExC_state->emit)
#define RExC_emit_dummy (pRExC_state->emit_dummy)
#define RExC_emit_start (pRExC_state->emit_start)
#define RExC_emit_bound (pRExC_state->emit_bound)
#define RExC_sawback (pRExC_state->sawback)
#define RExC_seen (pRExC_state->seen)
#define RExC_size (pRExC_state->size)
#define RExC_maxlen (pRExC_state->maxlen)
#define RExC_npar (pRExC_state->npar)
#define RExC_nestroot (pRExC_state->nestroot)
#define RExC_extralen (pRExC_state->extralen)
#define RExC_seen_zerolen (pRExC_state->seen_zerolen)
#define RExC_utf8 (pRExC_state->utf8)
#define RExC_uni_semantics (pRExC_state->uni_semantics)
#define RExC_orig_utf8 (pRExC_state->orig_utf8)
#define RExC_open_parens (pRExC_state->open_parens)
#define RExC_close_parens (pRExC_state->close_parens)
#define RExC_end_op (pRExC_state->end_op)
#define RExC_paren_names (pRExC_state->paren_names)
#define RExC_recurse (pRExC_state->recurse)
#define RExC_recurse_count (pRExC_state->recurse_count)
#define RExC_study_chunk_recursed (pRExC_state->study_chunk_recursed)
#define RExC_study_chunk_recursed_bytes \
(pRExC_state->study_chunk_recursed_bytes)
#define RExC_in_lookbehind (pRExC_state->in_lookbehind)
#define RExC_contains_locale (pRExC_state->contains_locale)
#ifdef EBCDIC
# define RExC_recode_x_to_native (pRExC_state->recode_x_to_native)
#endif
#define RExC_in_multi_char_class (pRExC_state->in_multi_char_class)
#define RExC_frame_head (pRExC_state->frame_head)
#define RExC_frame_last (pRExC_state->frame_last)
#define RExC_frame_count (pRExC_state->frame_count)
#define RExC_strict (pRExC_state->strict)
#define RExC_study_started (pRExC_state->study_started)
#define RExC_warn_text (pRExC_state->warn_text)
#define RExC_in_script_run (pRExC_state->in_script_run)
/* Heuristic check on the complexity of the pattern: if TOO_NAUGHTY, we set
* a flag to disable back-off on the fixed/floating substrings - if it's
* a high complexity pattern we assume the benefit of avoiding a full match
* is worth the cost of checking for the substrings even if they rarely help.
*/
#define RExC_naughty (pRExC_state->naughty)
#define TOO_NAUGHTY (10)
#define MARK_NAUGHTY(add) \
if (RExC_naughty < TOO_NAUGHTY) \
RExC_naughty += (add)
#define MARK_NAUGHTY_EXP(exp, add) \
if (RExC_naughty < TOO_NAUGHTY) \
RExC_naughty += RExC_naughty / (exp) + (add)
#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
#define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
((*s) == '{' && regcurly(s)))
/*
* Flags to be passed up and down.
*/
#define WORST 0 /* Worst case. */
#define HASWIDTH 0x01 /* Known to match non-null strings. */
/* Simple enough to be STAR/PLUS operand; in an EXACTish node must be a single
* character. (There needs to be a case: in the switch statement in regexec.c
* for any node marked SIMPLE.) Note that this is not the same thing as
* REGNODE_SIMPLE */
#define SIMPLE 0x02
#define SPSTART 0x04 /* Starts with * or + */
#define POSTPONED 0x08 /* (?1),(?&name), (??{...}) or similar */
#define TRYAGAIN 0x10 /* Weeded out a declaration. */
#define RESTART_PASS1 0x20 /* Need to restart sizing pass */
#define NEED_UTF8 0x40 /* In conjunction with RESTART_PASS1, need to
calcuate sizes as UTF-8 */
#define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1)
/* whether trie related optimizations are enabled */
#if PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION
#define TRIE_STUDY_OPT
#define FULL_TRIE_STUDY
#define TRIE_STCLASS
#endif
#define PBYTE(u8str,paren) ((U8*)(u8str))[(paren) >> 3]
#define PBITVAL(paren) (1 << ((paren) & 7))
#define PAREN_TEST(u8str,paren) ( PBYTE(u8str,paren) & PBITVAL(paren))
#define PAREN_SET(u8str,paren) PBYTE(u8str,paren) |= PBITVAL(paren)
#define PAREN_UNSET(u8str,paren) PBYTE(u8str,paren) &= (~PBITVAL(paren))
#define REQUIRE_UTF8(flagp) STMT_START { \
if (!UTF) { \
assert(PASS1); \
*flagp = RESTART_PASS1|NEED_UTF8; \
return NULL; \
} \
} STMT_END
/* Change from /d into /u rules, and restart the parse if we've already seen
* something whose size would increase as a result, by setting *flagp and
* returning 'restart_retval'. RExC_uni_semantics is a flag that indicates
* we've change to /u during the parse. */
#define REQUIRE_UNI_RULES(flagp, restart_retval) \
STMT_START { \
if (DEPENDS_SEMANTICS) { \
assert(PASS1); \
set_regex_charset(&RExC_flags, REGEX_UNICODE_CHARSET); \
RExC_uni_semantics = 1; \
if (RExC_seen_unfolded_sharp_s) { \
*flagp |= RESTART_PASS1; \
return restart_retval; \
} \
} \
} STMT_END
/* This converts the named class defined in regcomp.h to its equivalent class
* number defined in handy.h. */
#define namedclass_to_classnum(class) ((int) ((class) / 2))
#define classnum_to_namedclass(classnum) ((classnum) * 2)
#define _invlist_union_complement_2nd(a, b, output) \
_invlist_union_maybe_complement_2nd(a, b, TRUE, output)
#define _invlist_intersection_complement_2nd(a, b, output) \
_invlist_intersection_maybe_complement_2nd(a, b, TRUE, output)
/* About scan_data_t.
During optimisation we recurse through the regexp program performing
various inplace (keyhole style) optimisations. In addition study_chunk
and scan_commit populate this data structure with information about
what strings MUST appear in the pattern. We look for the longest
string that must appear at a fixed location, and we look for the
longest string that may appear at a floating location. So for instance
in the pattern:
/FOO[xX]A.*B[xX]BAR/
Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating
strings (because they follow a .* construct). study_chunk will identify
both FOO and BAR as being the longest fixed and floating strings respectively.
The strings can be composites, for instance
/(f)(o)(o)/
will result in a composite fixed substring 'foo'.
For each string some basic information is maintained:
- min_offset
This is the position the string must appear at, or not before.
It also implicitly (when combined with minlenp) tells us how many
characters must match before the string we are searching for.
Likewise when combined with minlenp and the length of the string it
tells us how many characters must appear after the string we have
found.
- max_offset
Only used for floating strings. This is the rightmost point that
the string can appear at. If set to SSize_t_MAX it indicates that the
string can occur infinitely far to the right.
For fixed strings, it is equal to min_offset.
- minlenp
A pointer to the minimum number of characters of the pattern that the
string was found inside. This is important as in the case of positive
lookahead or positive lookbehind we can have multiple patterns
involved. Consider
/(?=FOO).*F/
The minimum length of the pattern overall is 3, the minimum length
of the lookahead part is 3, but the minimum length of the part that
will actually match is 1. So 'FOO's minimum length is 3, but the
minimum length for the F is 1. This is important as the minimum length
is used to determine offsets in front of and behind the string being
looked for. Since strings can be composites this is the length of the
pattern at the time it was committed with a scan_commit. Note that
the length is calculated by study_chunk, so that the minimum lengths
are not known until the full pattern has been compiled, thus the
pointer to the value.
- lookbehind
In the case of lookbehind the string being searched for can be
offset past the start point of the final matching string.
If this value was just blithely removed from the min_offset it would
invalidate some of the calculations for how many chars must match
before or after (as they are derived from min_offset and minlen and
the length of the string being searched for).
When the final pattern is compiled and the data is moved from the
scan_data_t structure into the regexp structure the information
about lookbehind is factored in, with the information that would
have been lost precalculated in the end_shift field for the
associated string.
The fields pos_min and pos_delta are used to store the minimum offset
and the delta to the maximum offset at the current point in the pattern.
*/
struct scan_data_substrs {
SV *str; /* longest substring found in pattern */
SSize_t min_offset; /* earliest point in string it can appear */
SSize_t max_offset; /* latest point in string it can appear */
SSize_t *minlenp; /* pointer to the minlen relevant to the string */
SSize_t lookbehind; /* is the pos of the string modified by LB */
I32 flags; /* per substring SF_* and SCF_* flags */
};
typedef struct scan_data_t {
/*I32 len_min; unused */
/*I32 len_delta; unused */
SSize_t pos_min;
SSize_t pos_delta;
SV *last_found;
SSize_t last_end; /* min value, <0 unless valid. */
SSize_t last_start_min;
SSize_t last_start_max;
U8 cur_is_floating; /* whether the last_* values should be set as
* the next fixed (0) or floating (1)
* substring */
/* [0] is longest fixed substring so far, [1] is longest float so far */
struct scan_data_substrs substrs[2];
I32 flags; /* common SF_* and SCF_* flags */
I32 whilem_c;
SSize_t *last_closep;
regnode_ssc *start_class;
} scan_data_t;
/*
* Forward declarations for pregcomp()'s friends.
*/
static const scan_data_t zero_scan_data = {
0, 0, NULL, 0, 0, 0, 0,
{
{ NULL, 0, 0, 0, 0, 0 },
{ NULL, 0, 0, 0, 0, 0 },
},
0, 0, NULL, NULL
};
/* study flags */
#define SF_BEFORE_SEOL 0x0001
#define SF_BEFORE_MEOL 0x0002
#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
#define SF_IS_INF 0x0040
#define SF_HAS_PAR 0x0080
#define SF_IN_PAR 0x0100
#define SF_HAS_EVAL 0x0200
/* SCF_DO_SUBSTR is the flag that tells the regexp analyzer to track the
* longest substring in the pattern. When it is not set the optimiser keeps
* track of position, but does not keep track of the actual strings seen,
*
* So for instance /foo/ will be parsed with SCF_DO_SUBSTR being true, but
* /foo/i will not.
*
* Similarly, /foo.*(blah|erm|huh).*fnorble/ will have "foo" and "fnorble"
* parsed with SCF_DO_SUBSTR on, but while processing the (...) it will be
* turned off because of the alternation (BRANCH). */
#define SCF_DO_SUBSTR 0x0400
#define SCF_DO_STCLASS_AND 0x0800
#define SCF_DO_STCLASS_OR 0x1000
#define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
#define SCF_WHILEM_VISITED_POS 0x2000
#define SCF_TRIE_RESTUDY 0x4000 /* Do restudy? */
#define SCF_SEEN_ACCEPT 0x8000
#define SCF_TRIE_DOING_RESTUDY 0x10000
#define SCF_IN_DEFINE 0x20000
#define UTF cBOOL(RExC_utf8)
/* The enums for all these are ordered so things work out correctly */
#define LOC (get_regex_charset(RExC_flags) == REGEX_LOCALE_CHARSET)
#define DEPENDS_SEMANTICS (get_regex_charset(RExC_flags) \
== REGEX_DEPENDS_CHARSET)
#define UNI_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_UNICODE_CHARSET)
#define AT_LEAST_UNI_SEMANTICS (get_regex_charset(RExC_flags) \
>= REGEX_UNICODE_CHARSET)
#define ASCII_RESTRICTED (get_regex_charset(RExC_flags) \
== REGEX_ASCII_RESTRICTED_CHARSET)
#define AT_LEAST_ASCII_RESTRICTED (get_regex_charset(RExC_flags) \
>= REGEX_ASCII_RESTRICTED_CHARSET)
#define ASCII_FOLD_RESTRICTED (get_regex_charset(RExC_flags) \
== REGEX_ASCII_MORE_RESTRICTED_CHARSET)
#define FOLD cBOOL(RExC_flags & RXf_PMf_FOLD)
/* For programs that want to be strictly Unicode compatible by dying if any
* attempt is made to match a non-Unicode code point against a Unicode
* property. */
#define ALWAYS_WARN_SUPER ckDEAD(packWARN(WARN_NON_UNICODE))
#define OOB_NAMEDCLASS -1
/* There is no code point that is out-of-bounds, so this is problematic. But
* its only current use is to initialize a variable that is always set before
* looked at. */
#define OOB_UNICODE 0xDEADBEEF
#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
/* length of regex to show in messages that don't mark a position within */
#define RegexLengthToShowInErrorMessages 127
/*
* If MARKER[12] are adjusted, be sure to adjust the constants at the top
* of t/op/regmesg.t, the tests in t/op/re_tests, and those in
* op/pragma/warn/regcomp.
*/
#define MARKER1 "<-- HERE" /* marker as it appears in the description */
#define MARKER2 " <-- HERE " /* marker as it appears within the regex */
#define REPORT_LOCATION " in regex; marked by " MARKER1 \
" in m/%" UTF8f MARKER2 "%" UTF8f "/"
/* The code in this file in places uses one level of recursion with parsing
* rebased to an alternate string constructed by us in memory. This can take
* the form of something that is completely different from the input, or
* something that uses the input as part of the alternate. In the first case,
* there should be no possibility of an error, as we are in complete control of
* the alternate string. But in the second case we don't control the input
* portion, so there may be errors in that. Here's an example:
* /[abc\x{DF}def]/ui
* is handled specially because \x{df} folds to a sequence of more than one
* character, 'ss'. What is done is to create and parse an alternate string,
* which looks like this:
* /(?:\x{DF}|[abc\x{DF}def])/ui
* where it uses the input unchanged in the middle of something it constructs,
* which is a branch for the DF outside the character class, and clustering
* parens around the whole thing. (It knows enough to skip the DF inside the
* class while in this substitute parse.) 'abc' and 'def' may have errors that
* need to be reported. The general situation looks like this:
*
* sI tI xI eI
* Input: ----------------------------------------------------
* Constructed: ---------------------------------------------------
* sC tC xC eC EC
*
* The input string sI..eI is the input pattern. The string sC..EC is the
* constructed substitute parse string. The portions sC..tC and eC..EC are
* constructed by us. The portion tC..eC is an exact duplicate of the input
* pattern tI..eI. In the diagram, these are vertically aligned. Suppose that
* while parsing, we find an error at xC. We want to display a message showing
* the real input string. Thus we need to find the point xI in it which
* corresponds to xC. xC >= tC, since the portion of the string sC..tC has
* been constructed by us, and so shouldn't have errors. We get:
*
* xI = sI + (tI - sI) + (xC - tC)
*
* and, the offset into sI is:
*
* (xI - sI) = (tI - sI) + (xC - tC)
*
* When the substitute is constructed, we save (tI -sI) as RExC_precomp_adj,
* and we save tC as RExC_adjusted_start.
*
* During normal processing of the input pattern, everything points to that,
* with RExC_precomp_adj set to 0, and RExC_adjusted_start set to sI.
*/
#define tI_sI RExC_precomp_adj
#define tC RExC_adjusted_start
#define sC RExC_precomp
#define xI_offset(xC) ((IV) (tI_sI + (xC - tC)))
#define xI(xC) (sC + xI_offset(xC))
#define eC RExC_precomp_end
#define REPORT_LOCATION_ARGS(xC) \
UTF8fARG(UTF, \
(xI(xC) > eC) /* Don't run off end */ \
? eC - sC /* Length before the <--HERE */ \
: ( __ASSERT_(xI_offset(xC) >= 0) xI_offset(xC) ), \
sC), /* The input pattern printed up to the <--HERE */ \
UTF8fARG(UTF, \
(xI(xC) > eC) ? 0 : eC - xI(xC), /* Length after <--HERE */ \
(xI(xC) > eC) ? eC : xI(xC)) /* pattern after <--HERE */
/* Used to point after bad bytes for an error message, but avoid skipping
* past a nul byte. */
#define SKIP_IF_CHAR(s) (!*(s) ? 0 : UTF ? UTF8SKIP(s) : 1)
/*
* Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
* arg. Show regex, up to a maximum length. If it's too long, chop and add
* "...".
*/
#define _FAIL(code) STMT_START { \
const char *ellipses = ""; \
IV len = RExC_precomp_end - RExC_precomp; \
\
if (!SIZE_ONLY) \
SAVEFREESV(RExC_rx_sv); \
if (len > RegexLengthToShowInErrorMessages) { \
/* chop 10 shorter than the max, to ensure meaning of "..." */ \
len = RegexLengthToShowInErrorMessages - 10; \
ellipses = "..."; \
} \
code; \
} STMT_END
#define FAIL(msg) _FAIL( \
Perl_croak(aTHX_ "%s in regex m/%" UTF8f "%s/", \
msg, UTF8fARG(UTF, len, RExC_precomp), ellipses))
#define FAIL2(msg,arg) _FAIL( \
Perl_croak(aTHX_ msg " in regex m/%" UTF8f "%s/", \
arg, UTF8fARG(UTF, len, RExC_precomp), ellipses))
/*
* Simple_vFAIL -- like FAIL, but marks the current location in the scan
*/
#define Simple_vFAIL(m) STMT_START { \
Perl_croak(aTHX_ "%s" REPORT_LOCATION, \
m, REPORT_LOCATION_ARGS(RExC_parse)); \
} STMT_END
/*
* Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
*/
#define vFAIL(m) STMT_START { \
if (!SIZE_ONLY) \
SAVEFREESV(RExC_rx_sv); \
Simple_vFAIL(m); \
} STMT_END
/*
* Like Simple_vFAIL(), but accepts two arguments.
*/
#define Simple_vFAIL2(m,a1) STMT_START { \
S_re_croak2(aTHX_ UTF, m, REPORT_LOCATION, a1, \
REPORT_LOCATION_ARGS(RExC_parse)); \
} STMT_END
/*
* Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
*/
#define vFAIL2(m,a1) STMT_START { \
if (!SIZE_ONLY) \
SAVEFREESV(RExC_rx_sv); \
Simple_vFAIL2(m, a1); \
} STMT_END
/*
* Like Simple_vFAIL(), but accepts three arguments.
*/
#define Simple_vFAIL3(m, a1, a2) STMT_START { \
S_re_croak2(aTHX_ UTF, m, REPORT_LOCATION, a1, a2, \
REPORT_LOCATION_ARGS(RExC_parse)); \
} STMT_END
/*
* Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
*/
#define vFAIL3(m,a1,a2) STMT_START { \
if (!SIZE_ONLY) \
SAVEFREESV(RExC_rx_sv); \
Simple_vFAIL3(m, a1, a2); \
} STMT_END
/*
* Like Simple_vFAIL(), but accepts four arguments.
*/
#define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \
S_re_croak2(aTHX_ UTF, m, REPORT_LOCATION, a1, a2, a3, \
REPORT_LOCATION_ARGS(RExC_parse)); \
} STMT_END
#define vFAIL4(m,a1,a2,a3) STMT_START { \
if (!SIZE_ONLY) \
SAVEFREESV(RExC_rx_sv); \
Simple_vFAIL4(m, a1, a2, a3); \
} STMT_END
/* A specialized version of vFAIL2 that works with UTF8f */
#define vFAIL2utf8f(m, a1) STMT_START { \
if (!SIZE_ONLY) \
SAVEFREESV(RExC_rx_sv); \
S_re_croak2(aTHX_ UTF, m, REPORT_LOCATION, a1, \
REPORT_LOCATION_ARGS(RExC_parse)); \
} STMT_END
#define vFAIL3utf8f(m, a1, a2) STMT_START { \
if (!SIZE_ONLY) \
SAVEFREESV(RExC_rx_sv); \
S_re_croak2(aTHX_ UTF, m, REPORT_LOCATION, a1, a2, \
REPORT_LOCATION_ARGS(RExC_parse)); \
} STMT_END
/* These have asserts in them because of [perl #122671] Many warnings in
* regcomp.c can occur twice. If they get output in pass1 and later in that
* pass, the pattern has to be converted to UTF-8 and the pass restarted, they
* would get output again. So they should be output in pass2, and these
* asserts make sure new warnings follow that paradigm. */
/* m is not necessarily a "literal string", in this macro */
#define reg_warn_non_literal_string(loc, m) STMT_START { \
__ASSERT_(PASS2) Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
"%s" REPORT_LOCATION, \
m, REPORT_LOCATION_ARGS(loc)); \
} STMT_END
#define ckWARNreg(loc,m) STMT_START { \
__ASSERT_(PASS2) Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \
m REPORT_LOCATION, \
REPORT_LOCATION_ARGS(loc)); \
} STMT_END
#define vWARN(loc, m) STMT_START { \
__ASSERT_(PASS2) Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
m REPORT_LOCATION, \
REPORT_LOCATION_ARGS(loc)); \
} STMT_END
#define vWARN_dep(loc, m) STMT_START { \
__ASSERT_(PASS2) Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), \
m REPORT_LOCATION, \
REPORT_LOCATION_ARGS(loc)); \
} STMT_END
#define ckWARNdep(loc,m) STMT_START { \
__ASSERT_(PASS2) Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \
m REPORT_LOCATION, \
REPORT_LOCATION_ARGS(loc)); \
} STMT_END
#define ckWARNregdep(loc,m) STMT_START { \
__ASSERT_(PASS2) Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, \
WARN_REGEXP), \
m REPORT_LOCATION, \
REPORT_LOCATION_ARGS(loc)); \
} STMT_END
#define ckWARN2reg_d(loc,m, a1) STMT_START { \
__ASSERT_(PASS2) Perl_ck_warner_d(aTHX_ packWARN(WARN_REGEXP), \
m REPORT_LOCATION, \
a1, REPORT_LOCATION_ARGS(loc)); \
} STMT_END
#define ckWARN2reg(loc, m, a1) STMT_START { \
__ASSERT_(PASS2) Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \
m REPORT_LOCATION, \
a1, REPORT_LOCATION_ARGS(loc)); \
} STMT_END
#define vWARN3(loc, m, a1, a2) STMT_START { \
__ASSERT_(PASS2) Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
m REPORT_LOCATION, \
a1, a2, REPORT_LOCATION_ARGS(loc)); \
} STMT_END
#define ckWARN3reg(loc, m, a1, a2) STMT_START { \
__ASSERT_(PASS2) Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \
m REPORT_LOCATION, \
a1, a2, \
REPORT_LOCATION_ARGS(loc)); \
} STMT_END
#define vWARN4(loc, m, a1, a2, a3) STMT_START { \
__ASSERT_(PASS2) Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
m REPORT_LOCATION, \
a1, a2, a3, \
REPORT_LOCATION_ARGS(loc)); \
} STMT_END
#define ckWARN4reg(loc, m, a1, a2, a3) STMT_START { \
__ASSERT_(PASS2) Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \
m REPORT_LOCATION, \
a1, a2, a3, \
REPORT_LOCATION_ARGS(loc)); \
} STMT_END
#define vWARN5(loc, m, a1, a2, a3, a4) STMT_START { \
__ASSERT_(PASS2) Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
m REPORT_LOCATION, \
a1, a2, a3, a4, \
REPORT_LOCATION_ARGS(loc)); \
} STMT_END
/* Macros for recording node offsets. 20001227 mjd@plover.com
* Nodes are numbered 1, 2, 3, 4. Node #n's position is recorded in
* element 2*n-1 of the array. Element #2n holds the byte length node #n.
* Element 0 holds the number n.
* Position is 1 indexed.
*/
#ifndef RE_TRACK_PATTERN_OFFSETS
#define Set_Node_Offset_To_R(node,byte)
#define Set_Node_Offset(node,byte)
#define Set_Cur_Node_Offset
#define Set_Node_Length_To_R(node,len)
#define Set_Node_Length(node,len)
#define Set_Node_Cur_Length(node,start)
#define Node_Offset(n)
#define Node_Length(n)
#define Set_Node_Offset_Length(node,offset,len)
#define ProgLen(ri) ri->u.proglen
#define SetProgLen(ri,x) ri->u.proglen = x
#else
#define ProgLen(ri) ri->u.offsets[0]
#define SetProgLen(ri,x) ri->u.offsets[0] = x
#define Set_Node_Offset_To_R(node,byte) STMT_START { \
if (! SIZE_ONLY) { \
MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \
__LINE__, (int)(node), (int)(byte))); \
if((node) < 0) { \
Perl_croak(aTHX_ "value of node is %d in Offset macro", \
(int)(node)); \
} else { \
RExC_offsets[2*(node)-1] = (byte); \
} \
} \
} STMT_END
#define Set_Node_Offset(node,byte) \
Set_Node_Offset_To_R((node)-RExC_emit_start, (byte)-RExC_start)
#define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
#define Set_Node_Length_To_R(node,len) STMT_START { \
if (! SIZE_ONLY) { \
MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \
__LINE__, (int)(node), (int)(len))); \
if((node) < 0) { \
Perl_croak(aTHX_ "value of node is %d in Length macro", \
(int)(node)); \
} else { \
RExC_offsets[2*(node)] = (len); \
} \
} \
} STMT_END
#define Set_Node_Length(node,len) \
Set_Node_Length_To_R((node)-RExC_emit_start, len)
#define Set_Node_Cur_Length(node, start) \
Set_Node_Length(node, RExC_parse - start)
/* Get offsets and lengths */
#define Node_Offset(n) (RExC_offsets[2*((n)-RExC_emit_start)-1])
#define Node_Length(n) (RExC_offsets[2*((n)-RExC_emit_start)])
#define Set_Node_Offset_Length(node,offset,len) STMT_START { \
Set_Node_Offset_To_R((node)-RExC_emit_start, (offset)); \
Set_Node_Length_To_R((node)-RExC_emit_start, (len)); \
} STMT_END
#endif
#if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS
#define EXPERIMENTAL_INPLACESCAN
#endif /*PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS*/
#ifdef DEBUGGING
int
Perl_re_printf(pTHX_ const char *fmt, ...)
{
va_list ap;
int result;
PerlIO *f= Perl_debug_log;
PERL_ARGS_ASSERT_RE_PRINTF;
va_start(ap, fmt);
result = PerlIO_vprintf(f, fmt, ap);
va_end(ap);
return result;
}
int
Perl_re_indentf(pTHX_ const char *fmt, U32 depth, ...)
{
va_list ap;
int result;
PerlIO *f= Perl_debug_log;
PERL_ARGS_ASSERT_RE_INDENTF;
va_start(ap, depth);
PerlIO_printf(f, "%*s", ( (int)depth % 20 ) * 2, "");
result = PerlIO_vprintf(f, fmt, ap);
va_end(ap);
return result;
}
#endif /* DEBUGGING */
#define DEBUG_RExC_seen() \
DEBUG_OPTIMISE_MORE_r({ \
Perl_re_printf( aTHX_ "RExC_seen: "); \
\
if (RExC_seen & REG_ZERO_LEN_SEEN) \
Perl_re_printf( aTHX_ "REG_ZERO_LEN_SEEN "); \
\
if (RExC_seen & REG_LOOKBEHIND_SEEN) \
Perl_re_printf( aTHX_ "REG_LOOKBEHIND_SEEN "); \
\
if (RExC_seen & REG_GPOS_SEEN) \
Perl_re_printf( aTHX_ "REG_GPOS_SEEN "); \
\
if (RExC_seen & REG_RECURSE_SEEN) \
Perl_re_printf( aTHX_ "REG_RECURSE_SEEN "); \
\
if (RExC_seen & REG_TOP_LEVEL_BRANCHES_SEEN) \
Perl_re_printf( aTHX_ "REG_TOP_LEVEL_BRANCHES_SEEN "); \
\
if (RExC_seen & REG_VERBARG_SEEN) \
Perl_re_printf( aTHX_ "REG_VERBARG_SEEN "); \
\
if (RExC_seen & REG_CUTGROUP_SEEN) \
Perl_re_printf( aTHX_ "REG_CUTGROUP_SEEN "); \
\
if (RExC_seen & REG_RUN_ON_COMMENT_SEEN) \
Perl_re_printf( aTHX_ "REG_RUN_ON_COMMENT_SEEN "); \
\
if (RExC_seen & REG_UNFOLDED_MULTI_SEEN) \
Perl_re_printf( aTHX_ "REG_UNFOLDED_MULTI_SEEN "); \
\
if (RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN) \
Perl_re_printf( aTHX_ "REG_UNBOUNDED_QUANTIFIER_SEEN "); \
\
Perl_re_printf( aTHX_ "\n"); \
});
#define DEBUG_SHOW_STUDY_FLAG(flags,flag) \
if ((flags) & flag) Perl_re_printf( aTHX_ "%s ", #flag)
#ifdef DEBUGGING
static void
S_debug_show_study_flags(pTHX_ U32 flags, const char *open_str,
const char *close_str)
{
if (!flags)
return;
Perl_re_printf( aTHX_ "%s", open_str);
DEBUG_SHOW_STUDY_FLAG(flags, SF_BEFORE_SEOL);
DEBUG_SHOW_STUDY_FLAG(flags, SF_BEFORE_MEOL);
DEBUG_SHOW_STUDY_FLAG(flags, SF_IS_INF);
DEBUG_SHOW_STUDY_FLAG(flags, SF_HAS_PAR);
DEBUG_SHOW_STUDY_FLAG(flags, SF_IN_PAR);
DEBUG_SHOW_STUDY_FLAG(flags, SF_HAS_EVAL);
DEBUG_SHOW_STUDY_FLAG(flags, SCF_DO_SUBSTR);
DEBUG_SHOW_STUDY_FLAG(flags, SCF_DO_STCLASS_AND);
DEBUG_SHOW_STUDY_FLAG(flags, SCF_DO_STCLASS_OR);
DEBUG_SHOW_STUDY_FLAG(flags, SCF_DO_STCLASS);
DEBUG_SHOW_STUDY_FLAG(flags, SCF_WHILEM_VISITED_POS);
DEBUG_SHOW_STUDY_FLAG(flags, SCF_TRIE_RESTUDY);