STMT_START { \
if (UTF) { \
SV *zlopp = newSV(2); \
- char *flrbbbbb = SvPVX(zlopp); \
- const char *const kapow = uvuni_to_utf8(flrbbbbb, uvc & 0xFF); \
+ unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp); \
+ unsigned const char *const kapow = uvuni_to_utf8(flrbbbbb, uvc & 0xFF); \
SvCUR_set(zlopp, kapow - flrbbbbb); \
SvPOK_on(zlopp); \
SvUTF8_on(zlopp); \
av_push(revcharmap, zlopp); \
} else { \
- unsigned char ooooff = uvc; \
+ char ooooff = (char)uvc; \
av_push(revcharmap, newSVpvn(&ooooff, 1)); \
} \
} STMT_END
trie->startstate = state;
trie->minlen -= (state - 1);
trie->maxlen -= (state - 1);
- DEBUG_r({
- regnode *fix = convert;
- U32 word = trie->wordcount;
- mjd_nodelen++;
- Set_Node_Offset_Length(convert, mjd_offset, state - 1);
- while( ++fix < n ) {
- Set_Node_Offset_Length(fix, 0, 0);
- }
- while (word--) {
- SV ** const tmp = av_fetch( trie_words, word, 0 );
- if (tmp) {
- if ( STR_LEN(convert) <= SvCUR(*tmp) )
- sv_chop(*tmp, SvPV_nolen(*tmp) + STR_LEN(convert));
- else
- sv_chop(*tmp, SvPV_nolen(*tmp) + SvCUR(*tmp));
- }
- }
- });
+#ifdef DEBUGGING
+ /* At least the UNICOS C compiler choked on this
+ * being argument to DEBUG_r(), so let's just have
+ * it right here. */
+ if (
+#ifdef PERL_EXT_RE_BUILD
+ 1
+#else
+ DEBUG_r_TEST
+#endif
+ ) {
+ regnode *fix = convert;
+ U32 word = trie->wordcount;
+ mjd_nodelen++;
+ Set_Node_Offset_Length(convert, mjd_offset, state - 1);
+ while( ++fix < n ) {
+ Set_Node_Offset_Length(fix, 0, 0);
+ }
+ while (word--) {
+ SV ** const tmp = av_fetch( trie_words, word, 0 );
+ if (tmp) {
+ if ( STR_LEN(convert) <= SvCUR(*tmp) )
+ sv_chop(*tmp, SvPV_nolen(*tmp) + STR_LEN(convert));
+ else
+ sv_chop(*tmp, SvPV_nolen(*tmp) + SvCUR(*tmp));
+ }
+ }
+ }
+#endif
if (trie->maxlen) {
convert = n;
} else {
last = cur;
}
} else {
- if ( last ) {
+/*
+ Currently we assume that the trie can handle unicode and ascii
+ matches fold cased matches. If this proves true then the following
+ define will prevent tries in this situation.
+
+ #define TRIE_TYPE_IS_SAFE (UTF || optype==EXACT)
+*/
+#define TRIE_TYPE_IS_SAFE 1
+ if ( last && TRIE_TYPE_IS_SAFE ) {
make_trie( pRExC_state,
startbranch, first, cur, tail, count,
optype, depth+1 );
"", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
});
- if ( last ) {
+
+ if ( last && TRIE_TYPE_IS_SAFE ) {
made= make_trie( pRExC_state, startbranch, first, scan, tail, count, optype, depth+1 );
#ifdef TRIE_STUDY_OPT
if ( ((made == MADE_EXACT_TRIE &&
SV*
Perl_reg_named_buff_firstkey(pTHX_ REGEXP * const rx, const U32 flags)
{
- (void)hv_iterinit(rx->paren_names);
+ if ( rx && rx->paren_names ) {
+ (void)hv_iterinit(rx->paren_names);
- return CALLREG_NAMED_BUFF_NEXTKEY(rx, NULL, flags & ~RXapif_FIRSTKEY);
+ return CALLREG_NAMED_BUFF_NEXTKEY(rx, NULL, flags & ~RXapif_FIRSTKEY);
+ } else {
+ return FALSE;
+ }
}
SV*
Perl_reg_qr_package(pTHX_ REGEXP * const rx)
{
PERL_UNUSED_ARG(rx);
- return newSVpvs("Regexp");
+ return NULL;
}
/* Scans the name of a named buffer from the pattern.
| PERL_SCAN_DISALLOW_PREFIX
| (SIZE_ONLY ? PERL_SCAN_SILENT_ILLDIGIT : 0);
UV cp;
- unsigned char string;
+ char string;
len = (STRLEN)(endbrace - name - 2);
cp = grok_hex(name + 2, &len, &fl, NULL);
if ( len != (STRLEN)(endbrace - name - 2) ) {
*valuep = cp;
return NULL;
}
- string = (unsigned char) cp;
+ string = (char)cp;
sv_str= newSVpvn(&string, 1);
} else {
/* fetch the charnames handler for this scope */
case 0xDF:
case 0xC3:
case 0xCE:
+ do_foldchar:
if (!LOC && FOLD) {
U32 len,cp;
len=0; /* silence a spurious compiler warning */
required, as the default for this switch is to jump to the
literal text handling code.
*/
- switch (*++RExC_parse) {
+ switch ((U8)*++RExC_parse) {
+ case 0xDF:
+ case 0xC3:
+ case 0xCE:
+ goto do_foldchar;
/* Special Escapes */
case 'A':
RExC_seen_zerolen++;
RExC_seen_zerolen++;
ret = reg_node(pRExC_state, KEEPS);
*flagp |= SIMPLE;
+ /* XXX:dmq : disabling in-place substitution seems to
+ * be necessary here to avoid cases of memory corruption, as
+ * with: C<$_="x" x 80; s/x\K/y/> -- rgs
+ */
+ RExC_seen |= REG_SEEN_LOOKBEHIND;
goto finish_meta_pat;
case 'Z':
ret = reg_node(pRExC_state, SEOL);
an unescaped equivalent literal.
*/
- switch (*++p) {
+ switch ((U8)*++p) {
/* These are all the special escapes. */
+ case 0xDF:
+ case 0xC3:
+ case 0xCE:
+ if (LOC || !FOLD || !is_TRICKYFOLD_safe(p,RExC_end,UTF))
+ goto normal_default;
case 'A': /* Start assertion */
case 'b': case 'B': /* Word-boundary assertion*/
case 'C': /* Single char !DANGEROUS! */
k = PL_regkind[OP(o)];
if (k == EXACT) {
- SV * const dsv = sv_2mortal(newSVpvs(""));
+ sv_catpvs(sv, " ");
/* Using is_utf8_string() (via PERL_PV_UNI_DETECT)
* is a crude hack but it may be the best for now since
* we have no flag "this EXACTish node was UTF-8"
* --jhi */
- const char * const s =
- pv_pretty(dsv, STRING(o), STR_LEN(o), 60,
- PL_colors[0], PL_colors[1],
- PERL_PV_ESCAPE_UNI_DETECT |
- PERL_PV_PRETTY_ELLIPSES |
- PERL_PV_PRETTY_LTGT
- );
- Perl_sv_catpvf(aTHX_ sv, " %s", s );
+ pv_pretty(sv, STRING(o), STR_LEN(o), 60, PL_colors[0], PL_colors[1],
+ PERL_PV_ESCAPE_UNI_DETECT |
+ PERL_PV_PRETTY_ELLIPSES |
+ PERL_PV_PRETTY_LTGT |
+ PERL_PV_PRETTY_NOCLEAR
+ );
} else if (k == TRIE) {
/* print the details of the trie in dumpuntil instead, as
* progi->data isn't available here */
if (!isPRINT(c))
Perl_sv_catpvf(aTHX_ sv, "\\%o", c);
else {
- const unsigned char string = (unsigned char) c;
+ const char string = c;
if (c == '-' || c == ']' || c == '\\' || c == '^')
sv_catpvs(sv, "\\");
sv_catpvn(sv, &string, 1);
https://perl5.git.perl.org / perl5.git / blobdiff