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 {
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_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 */
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);
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 */
int i;
int rangestart = -1;
U8* bitmap = IS_ANYOF_TRIE(op) ? (U8*)ANYOF_BITMAP(o) : (U8*)TRIE_BITMAP(trie);
- Perl_sv_catpvf(aTHX_ sv, "[");
+ sv_catpvs(sv, "[");
for (i = 0; i <= 256; i++) {
if (i < 256 && BITMAP_TEST(bitmap,i)) {
if (rangestart == -1)
rangestart = -1;
}
}
- Perl_sv_catpvf(aTHX_ sv, "]");
+ sv_catpvs(sv, "]");
}
} else if (k == CURLY) {
STATIC void
S_put_byte(pTHX_ SV *sv, int c)
{
- if (isCNTRL(c) || c == 255 || !isPRINT(c))
+ /* Our definition of isPRINT() ignores locales, so only bytes that are
+ not part of UTF-8 are considered printable. I assume that the same
+ holds for UTF-EBCDIC.
+ Also, code point 255 is not printable in either (it's E0 in EBCDIC,
+ which Wikipedia says:
+
+ EO, or Eight Ones, is an 8-bit EBCDIC character code represented as all
+ ones (binary 1111 1111, hexadecimal FF). It is similar, but not
+ identical, to the ASCII delete (DEL) or rubout control character.
+ ) So the old condition can be simplified to !isPRINT(c) */
+ 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);