#define OOB_UNICODE 0xDEADBEEF
#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
-#define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
/* length of regex to show in messages that don't mark a position within */
#define MARKER2 " <-- HERE " /* marker as it appears within the regex */
#define REPORT_LOCATION " in regex; marked by " MARKER1 \
- " in m/%"UTF8f MARKER2 "%"UTF8f"/"
+ " 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
} STMT_END
#define FAIL(msg) _FAIL( \
- Perl_croak(aTHX_ "%s in regex m/%"UTF8f"%s/", \
+ 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/", \
+ Perl_croak(aTHX_ msg " in regex m/%" UTF8f "%s/", \
arg, UTF8fARG(UTF, len, RExC_precomp), ellipses))
/*
#define DEBUG_STUDYDATA(str,data,depth) \
DEBUG_OPTIMISE_MORE_r(if(data){ \
- Perl_re_indentf( aTHX_ "" str "Pos:%"IVdf"/%"IVdf \
- " Flags: 0x%"UVXf, \
+ Perl_re_indentf( aTHX_ "" str "Pos:%" IVdf "/%" IVdf \
+ " Flags: 0x%" UVXf, \
depth, \
(IV)((data)->pos_min), \
(IV)((data)->pos_delta), \
(UV)((data)->flags) \
); \
DEBUG_SHOW_STUDY_FLAGS((data)->flags," [ ","]"); \
- Perl_re_printf( aTHX_ \
- " Whilem_c: %"IVdf" Lcp: %"IVdf" %s", \
+ Perl_re_printf( aTHX_ \
+ " Whilem_c: %" IVdf " Lcp: %" IVdf " %s", \
(IV)((data)->whilem_c), \
(IV)((data)->last_closep ? *((data)->last_closep) : -1), \
is_inf ? "INF " : "" \
); \
if ((data)->last_found) \
- Perl_re_printf( aTHX_ \
- "Last:'%s' %"IVdf":%"IVdf"/%"IVdf" %sFixed:'%s' @ %"IVdf \
- " %sFloat: '%s' @ %"IVdf"/%"IVdf"", \
+ Perl_re_printf( aTHX_ \
+ "Last:'%s' %" IVdf ":%" IVdf "/%" IVdf \
+ " %sFixed:'%s' @ %" IVdf \
+ " %sFloat: '%s' @ %" IVdf "/%" IVdf, \
SvPVX_const((data)->last_found), \
(IV)((data)->last_end), \
(IV)((data)->last_start_min), \
for( state = 1 ; state < trie->statecount ; state++ ) {
const U32 base = trie->states[ state ].trans.base;
- Perl_re_indentf( aTHX_ "#%4"UVXf"|", depth+1, (UV)state);
+ Perl_re_indentf( aTHX_ "#%4" UVXf "|", depth+1, (UV)state);
if ( trie->states[ state ].wordnum ) {
Perl_re_printf( aTHX_ " W%4X", trie->states[ state ].wordnum );
Perl_re_printf( aTHX_ "%6s", "" );
}
- Perl_re_printf( aTHX_ " @%4"UVXf" ", (UV)base );
+ Perl_re_printf( aTHX_ " @%4" UVXf " ", (UV)base );
if ( base ) {
U32 ofs = 0;
!= state))
ofs++;
- Perl_re_printf( aTHX_ "+%2"UVXf"[ ", (UV)ofs);
+ Perl_re_printf( aTHX_ "+%2" UVXf "[ ", (UV)ofs);
for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
if ( ( base + ofs >= trie->uniquecharcount )
&& trie->trans[ base + ofs
- trie->uniquecharcount ].check == state )
{
- Perl_re_printf( aTHX_ "%*"UVXf, colwidth,
+ Perl_re_printf( aTHX_ "%*" UVXf, colwidth,
(UV)trie->trans[ base + ofs - trie->uniquecharcount ].next
);
} else {
for( state=1 ; state < next_alloc ; state ++ ) {
U16 charid;
- Perl_re_indentf( aTHX_ " %4"UVXf" :",
+ Perl_re_indentf( aTHX_ " %4" UVXf " :",
depth+1, (UV)state );
if ( ! trie->states[ state ].wordnum ) {
Perl_re_printf( aTHX_ "%5s| ","");
SV ** const tmp = av_fetch( revcharmap,
TRIE_LIST_ITEM(state,charid).forid, 0);
if ( tmp ) {
- Perl_re_printf( aTHX_ "%*s:%3X=%4"UVXf" | ",
+ Perl_re_printf( aTHX_ "%*s:%3X=%4" UVXf " | ",
colwidth,
pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp),
colwidth,
for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
- Perl_re_indentf( aTHX_ "%4"UVXf" : ",
+ Perl_re_indentf( aTHX_ "%4" UVXf " : ",
depth+1,
(UV)TRIE_NODENUM( state ) );
for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next );
if (v)
- Perl_re_printf( aTHX_ "%*"UVXf, colwidth, v );
+ Perl_re_printf( aTHX_ "%*" UVXf, colwidth, v );
else
Perl_re_printf( aTHX_ "%*s", colwidth, "." );
}
if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
- Perl_re_printf( aTHX_ " (%4"UVXf")\n",
+ Perl_re_printf( aTHX_ " (%4" UVXf ")\n",
(UV)trie->trans[ state ].check );
} else {
- Perl_re_printf( aTHX_ " (%4"UVXf") W%4X\n",
+ Perl_re_printf( aTHX_ " (%4" UVXf ") W%4X\n",
(UV)trie->trans[ state ].check,
trie->states[ TRIE_NODENUM( state ) ].wordnum );
}
: ( state==1 ? special : 0 ) \
)
+#define TRIE_BITMAP_SET_FOLDED(trie, uvc, folder) \
+STMT_START { \
+ TRIE_BITMAP_SET(trie, uvc); \
+ /* store the folded codepoint */ \
+ if ( folder ) \
+ TRIE_BITMAP_SET(trie, folder[(U8) uvc ]); \
+ \
+ if ( !UTF ) { \
+ /* store first byte of utf8 representation of */ \
+ /* variant codepoints */ \
+ if (! UVCHR_IS_INVARIANT(uvc)) { \
+ TRIE_BITMAP_SET(trie, UTF8_TWO_BYTE_HI(uvc)); \
+ } \
+ } \
+} STMT_END
#define MADE_TRIE 1
#define MADE_JUMP_TRIE 2
#define MADE_EXACT_TRIE 4
bitmap?*/
if (OP(noper) == NOTHING) {
+ /* skip past a NOTHING at the start of an alternation
+ * eg, /(?:)a|(?:b)/ should be the same as /a|b/
+ */
regnode *noper_next= regnext(noper);
if (noper_next < tail)
noper= noper_next;
}
- if ( noper < tail && ( OP(noper) == flags || ( flags == EXACTFU && OP(noper) == EXACTFU_SS ) ) ) {
+ if ( noper < tail &&
+ (
+ OP(noper) == flags ||
+ (
+ flags == EXACTFU &&
+ OP(noper) == EXACTFU_SS
+ )
+ )
+ ) {
uc= (U8*)STRING(noper);
e= uc + STR_LEN(noper);
} else {
TRIE_BITMAP_SET(trie, LATIN_SMALL_LETTER_SHARP_S);
}
}
+
for ( ; uc < e ; uc += len ) { /* Look at each char in the current
branch */
TRIE_CHARCOUNT(trie)++;
if ( set_bit ) {
/* store the codepoint in the bitmap, and its folded
* equivalent. */
- TRIE_BITMAP_SET(trie, uvc);
-
- /* store the folded codepoint */
- if ( folder ) TRIE_BITMAP_SET(trie, folder[(U8) uvc ]);
-
- if ( !UTF ) {
- /* store first byte of utf8 representation of
- variant codepoints */
- if (! UVCHR_IS_INVARIANT(uvc)) {
- TRIE_BITMAP_SET(trie, UTF8_TWO_BYTE_HI(uvc));
- }
- }
+ TRIE_BITMAP_SET_FOLDED(trie, uvc, folder);
set_bit = 0; /* We've done our bit :-) */
}
} else {
svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 1 );
if ( !svpp )
- Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
+ Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%" UVXf, uvc );
if ( !SvTRUE( *svpp ) ) {
sv_setiv( *svpp, ++trie->uniquecharcount );
}
state = newstate;
} else {
- Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
+ Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %" IVdf, uvc );
}
}
}
}
state = trie->trans[ state + charid ].next;
} else {
- Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
+ Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %" IVdf, uvc );
}
/* charid is now 0 if we dont know the char read, or
* nonzero if we do */
PerlMemShared_realloc( trie->states, laststate
* sizeof(reg_trie_state) );
DEBUG_TRIE_COMPILE_MORE_r(
- Perl_re_indentf( aTHX_ "Alloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
+ Perl_re_indentf( aTHX_ "Alloc: %d Orig: %" IVdf " elements, Final:%" IVdf ". Savings of %%%5.2f\n",
depth+1,
(int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount
+ 1 ),
} /* end table compress */
}
DEBUG_TRIE_COMPILE_MORE_r(
- Perl_re_indentf( aTHX_ "Statecount:%"UVxf" Lasttrans:%"UVxf"\n",
+ Perl_re_indentf( aTHX_ "Statecount:%" UVxf " Lasttrans:%" UVxf "\n",
depth+1,
(UV)trie->statecount,
(UV)trie->lasttrans)
});
}
DEBUG_OPTIMISE_r(
- Perl_re_indentf( aTHX_ "MJD offset:%"UVuf" MJD length:%"UVuf"\n",
+ Perl_re_indentf( aTHX_ "MJD offset:%" UVuf " MJD length:%" UVuf "\n",
depth+1,
(UV)mjd_offset, (UV)mjd_nodelen)
);
split out as an EXACT and put in front of the TRIE node. */
trie->startstate= 1;
if ( trie->bitmap && !widecharmap && !trie->jump ) {
+ /* we want to find the first state that has more than
+ * one transition, if that state is not the first state
+ * then we have a common prefix which we can remove.
+ */
U32 state;
for ( state = 1 ; state < trie->statecount-1 ; state++ ) {
U32 ofs = 0;
- I32 idx = -1;
+ I32 first_ofs = -1; /* keeps track of the ofs of the first
+ transition, -1 means none */
U32 count = 0;
const U32 base = trie->states[ state ].trans.base;
+ /* does this state terminate an alternation? */
if ( trie->states[state].wordnum )
count = 1;
trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
{
if ( ++count > 1 ) {
- SV **tmp = av_fetch( revcharmap, ofs, 0);
- const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
+ /* we have more than one transition */
+ SV **tmp;
+ U8 *ch;
+ /* if this is the first state there is no common prefix
+ * to extract, so we can exit */
if ( state == 1 ) break;
+ tmp = av_fetch( revcharmap, ofs, 0);
+ ch = (U8*)SvPV_nolen_const( *tmp );
+
+ /* if we are on count 2 then we need to initialize the
+ * bitmap, and store the previous char if there was one
+ * in it*/
if ( count == 2 ) {
+ /* clear the bitmap */
Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
DEBUG_OPTIMISE_r(
- Perl_re_indentf( aTHX_ "New Start State=%"UVuf" Class: [",
+ Perl_re_indentf( aTHX_ "New Start State=%" UVuf " Class: [",
depth+1,
(UV)state));
- if (idx >= 0) {
- SV ** const tmp = av_fetch( revcharmap, idx, 0);
+ if (first_ofs >= 0) {
+ SV ** const tmp = av_fetch( revcharmap, first_ofs, 0);
const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
- TRIE_BITMAP_SET(trie,*ch);
- if ( folder )
- TRIE_BITMAP_SET(trie, folder[ *ch ]);
+ TRIE_BITMAP_SET_FOLDED(trie,*ch,folder);
DEBUG_OPTIMISE_r(
Perl_re_printf( aTHX_ "%s", (char*)ch)
);
}
}
- TRIE_BITMAP_SET(trie,*ch);
- if ( folder )
- TRIE_BITMAP_SET(trie,folder[ *ch ]);
+ /* store the current firstchar in the bitmap */
+ TRIE_BITMAP_SET_FOLDED(trie,*ch,folder);
DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ "%s", ch));
}
- idx = ofs;
+ first_ofs = ofs;
}
}
if ( count == 1 ) {
- SV **tmp = av_fetch( revcharmap, idx, 0);
+ /* This state has only one transition, its transition is part
+ * of a common prefix - we need to concatenate the char it
+ * represents to what we have so far. */
+ SV **tmp = av_fetch( revcharmap, first_ofs, 0);
STRLEN len;
char *ch = SvPV( *tmp, len );
DEBUG_OPTIMISE_r({
SV *sv=sv_newmortal();
- Perl_re_indentf( aTHX_ "Prefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
+ Perl_re_indentf( aTHX_ "Prefix State: %" UVuf " Ofs:%" UVuf " Char='%s'\n",
depth+1,
- (UV)state, (UV)idx,
+ (UV)state, (UV)first_ofs,
pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6,
PL_colors[0], PL_colors[1],
(SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
*/
fail[ 0 ] = fail[ 1 ] = 0;
DEBUG_TRIE_COMPILE_r({
- Perl_re_indentf( aTHX_ "Stclass Failtable (%"UVuf" states): 0",
+ Perl_re_indentf( aTHX_ "Stclass Failtable (%" UVuf " states): 0",
depth, (UV)numstates
);
for( q_read=1; q_read<numstates; q_read++ ) {
- Perl_re_printf( aTHX_ ", %"UVuf, (UV)fail[q_read]);
+ Perl_re_printf( aTHX_ ", %" UVuf, (UV)fail[q_read]);
}
Perl_re_printf( aTHX_ "\n");
});
}
else {
STRLEN len;
- _to_utf8_fold_flags(s, d, &len, FOLD_FLAGS_FULL);
+ _toFOLD_utf8_flags(s, s_end, d, &len, FOLD_FLAGS_FULL);
d += len;
}
s += s_len;
DEBUG_TRIE_COMPILE_r({
regprop(RExC_rx, RExC_mysv, tail, NULL, pRExC_state);
- Perl_re_indentf( aTHX_ "%s %"UVuf":%s\n",
+ Perl_re_indentf( aTHX_ "%s %" UVuf ":%s\n",
depth+1,
"Looking for TRIE'able sequences. Tail node is ",
(UV)(tail - RExC_emit_start),
SAVEFREESV(RExC_rx_sv);
Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP),
"Quantifier unexpected on zero-length expression "
- "in regex m/%"UTF8f"/",
+ "in regex m/%" UTF8f "/",
UTF8fARG(UTF, RExC_precomp_end - RExC_precomp,
RExC_precomp));
(void)ReREFCNT_inc(RExC_rx_sv);
/* It is counted once already... */
data->pos_min += minnext * (mincount - counted);
#if 0
-Perl_re_printf( aTHX_ "counted=%"UVuf" deltanext=%"UVuf
- " SSize_t_MAX=%"UVuf" minnext=%"UVuf
- " maxcount=%"UVuf" mincount=%"UVuf"\n",
+Perl_re_printf( aTHX_ "counted=%" UVuf " deltanext=%" UVuf
+ " SSize_t_MAX=%" UVuf " minnext=%" UVuf
+ " maxcount=%" UVuf " mincount=%" UVuf "\n",
(UV)counted, (UV)deltanext, (UV)SSize_t_MAX, (UV)minnext, (UV)maxcount,
(UV)mincount);
if (deltanext != SSize_t_MAX)
-Perl_re_printf( aTHX_ "LHS=%"UVuf" RHS=%"UVuf"\n",
+Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n",
(UV)(-counted * deltanext + (minnext + deltanext) * maxcount
- minnext * mincount), (UV)(SSize_t_MAX - data->pos_delta));
#endif
FAIL("Variable length lookbehind not implemented");
}
else if (minnext > (I32)U8_MAX) {
- FAIL2("Lookbehind longer than %"UVuf" not implemented",
+ FAIL2("Lookbehind longer than %" UVuf " not implemented",
(UV)U8_MAX);
}
scan->flags = (U8)minnext;
FAIL("Variable length lookbehind not implemented");
}
else if (*minnextp > (I32)U8_MAX) {
- FAIL2("Lookbehind longer than %"UVuf" not implemented",
+ FAIL2("Lookbehind longer than %" UVuf " not implemented",
(UV)U8_MAX);
}
scan->flags = (U8)*minnextp;
/* Dispatch a request to compile a regexp to correct regexp engine. */
DEBUG_COMPILE_r({
- Perl_re_printf( aTHX_ "Using engine %"UVxf"\n",
+ Perl_re_printf( aTHX_ "Using engine %" UVxf "\n",
PTR2UV(eng));
});
return CALLREGCOMP_ENG(eng, pattern, flags);
{
Safefree(pRExC_state->code_blocks);
/* use croak_sv ? */
- Perl_croak_nocontext("%"SVf, SVfARG(errsv));
+ Perl_croak_nocontext("%" SVf, SVfARG(errsv));
}
}
assert(SvROK(qr_ref));
calculate it.*/
ml = minlen ? *(minlen) : (SSize_t)longest_length;
*rx_end_shift = ml - offset
- - longest_length + (SvTAIL(sv_longest) != 0)
+ - longest_length
+ /* XXX SvTAIL is always false here - did you mean FBMcf_TAIL
+ * intead? - DAPM
+ + (SvTAIL(sv_longest) != 0)
+ */
+ lookbehind;
t = (eol/* Can't have SEOL and MULTI */
goto redo_first_pass;
}
- Perl_croak(aTHX_ "panic: reg returned NULL to re_op_compile for sizing pass, flags=%#"UVxf"", (UV) flags);
+ Perl_croak(aTHX_ "panic: reg returned NULL to re_op_compile for sizing pass, flags=%#" UVxf, (UV) flags);
}
if (code_blocksv)
SvLEN_set(code_blocksv,0); /* no you can't have it, sv_clear */
DEBUG_PARSE_r({
Perl_re_printf( aTHX_
- "Required size %"IVdf" nodes\n"
+ "Required size %" IVdf " nodes\n"
"Starting second pass (creation)\n",
(IV)RExC_size);
RExC_lastnum=0;
#ifdef RE_TRACK_PATTERN_OFFSETS
Newxz(ri->u.offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
DEBUG_OFFSETS_r(Perl_re_printf( aTHX_
- "%s %"UVuf" bytes for offset annotations.\n",
+ "%s %" UVuf " bytes for offset annotations.\n",
ri->u.offsets ? "Got" : "Couldn't get",
(UV)((2*RExC_size+1) * sizeof(U32))));
#endif
RExC_npar = 1;
if (reg(pRExC_state, 0, &flags,1) == NULL) {
ReREFCNT_dec(rx);
- Perl_croak(aTHX_ "panic: reg returned NULL to re_op_compile for generation pass, flags=%#"UVxf"", (UV) flags);
+ Perl_croak(aTHX_ "panic: reg returned NULL to re_op_compile for generation pass, flags=%#" UVxf, (UV) flags);
}
DEBUG_OPTIMISE_r(
Perl_re_printf( aTHX_ "Starting post parse optimization\n");
#ifdef TRIE_STUDY_OPT
DEBUG_PARSE_r(
if (!restudied)
- Perl_re_printf( aTHX_ "first at %"IVdf"\n",
+ Perl_re_printf( aTHX_ "first at %" IVdf "\n",
(IV)(first - scan + 1))
);
#else
DEBUG_PARSE_r(
- Perl_re_printf( aTHX_ "first at %"IVdf"\n",
+ Perl_re_printf( aTHX_ "first at %" IVdf "\n",
(IV)(first - scan + 1))
);
#endif
/* Guard against an embedded (?=) or (?<=) with a longer minlen than
the "real" pattern. */
DEBUG_OPTIMISE_r({
- Perl_re_printf( aTHX_ "minlen: %"IVdf" r->minlen:%"IVdf" maxlen:%"IVdf"\n",
+ Perl_re_printf( aTHX_ "minlen: %" IVdf " r->minlen:%" IVdf " maxlen:%" IVdf "\n",
(IV)minlen, (IV)r->minlen, (IV)RExC_maxlen);
});
r->minlenret = minlen;
STRLEN i;
GET_RE_DEBUG_FLAGS_DECL;
Perl_re_printf( aTHX_
- "Offsets: [%"UVuf"]\n\t", (UV)ri->u.offsets[0]);
+ "Offsets: [%" UVuf "]\n\t", (UV)ri->u.offsets[0]);
for (i = 1; i <= len; i++) {
if (ri->u.offsets[i*2-1] || ri->u.offsets[i*2])
- Perl_re_printf( aTHX_ "%"UVuf":%"UVuf"[%"UVuf"] ",
+ Perl_re_printf( aTHX_ "%" UVuf ":%" UVuf "[%" UVuf "] ",
(UV)i, (UV)ri->u.offsets[i*2-1], (UV)ri->u.offsets[i*2]);
}
Perl_re_printf( aTHX_ "\n");
}
} else {
ret_undef:
- sv_setsv(sv,&PL_sv_undef);
+ sv_set_undef(sv);
return;
}
}
assert (RExC_parse <= RExC_end);
if (RExC_parse == RExC_end) NOOP;
- else if (isIDFIRST_lazy_if(RExC_parse, UTF)) {
+ else if (isIDFIRST_lazy_if_safe(RExC_parse, RExC_end, UTF)) {
/* Note that the code here assumes well-formed UTF-8. Skip IDFIRST by
* using do...while */
if (UTF)
do {
RExC_parse += UTF8SKIP(RExC_parse);
- } while (isWORDCHAR_utf8((U8*)RExC_parse));
+ } while ( RExC_parse < RExC_end
+ && isWORDCHAR_utf8_safe((U8*)RExC_parse, (U8*) RExC_end));
else
do {
RExC_parse++;
- } while (isWORDCHAR(*RExC_parse));
+ } while (RExC_parse < RExC_end && isWORDCHAR(*RExC_parse));
} else {
RExC_parse++; /* so the <- from the vFAIL is after the offending
character */
STATIC void
S_invlist_replace_list_destroys_src(pTHX_ SV * dest, SV * src)
{
- /* Replaces the inversion list in 'src' with the one in 'dest'. It steals
- * the list from 'src', so 'src' is made to have a NULL list. This is
- * similar to what SvSetMagicSV() would do, if it were implemented on
+ /* Replaces the inversion list in 'dest' with the one from 'src'. It
+ * steals the list from 'src', so 'src' is made to have a NULL list. This
+ * is similar to what SvSetMagicSV() would do, if it were implemented on
* inversion lists, though this routine avoids a copy */
const UV src_len = _invlist_len(src);
if ( array[final_element] > start
|| ELEMENT_RANGE_MATCHES_INVLIST(final_element))
{
- Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list, final=%"UVuf", start=%"UVuf", match=%c",
+ Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list, final=%" UVuf ", start=%" UVuf ", match=%c",
array[final_element], start,
ELEMENT_RANGE_MATCHES_INVLIST(final_element) ? 't' : 'f');
}
Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b,
const bool complement_b, SV** output)
{
- /* Take the union of two inversion lists and point <output> to it. *output
- * SHOULD BE DEFINED upon input, and if it points to one of the two lists,
- * the reference count to that list will be decremented if not already a
- * temporary (mortal); otherwise just its contents will be modified to be
- * the union. The first list, <a>, may be NULL, in which case a copy of
- * the second list is returned. If <complement_b> is TRUE, the union is
- * taken of the complement (inversion) of <b> instead of b itself.
+ /* Take the union of two inversion lists and point '*output' to it. On
+ * input, '*output' MUST POINT TO NULL OR TO AN SV* INVERSION LIST (possibly
+ * even 'a' or 'b'). If to an inversion list, the contents of the original
+ * list will be replaced by the union. The first list, 'a', may be
+ * NULL, in which case a copy of the second list is placed in '*output'.
+ * If 'complement_b' is TRUE, the union is taken of the complement
+ * (inversion) of 'b' instead of b itself.
*
* The basis for this comes from "Unicode Demystified" Chapter 13 by
* Richard Gillam, published by Addison-Wesley, and explained at some
PERL_ARGS_ASSERT__INVLIST_UNION_MAYBE_COMPLEMENT_2ND;
assert(a != b);
+ assert(*output == NULL || SvTYPE(*output) == SVt_INVLIST);
len_b = _invlist_len(b);
if (len_b == 0) {
- /* Here, 'b' is empty. If the output is the complement of 'b', the
- * union is all possible code points, and we need not even look at 'a'.
- * It's easiest to create a new inversion list that matches everything.
- * */
+ /* Here, 'b' is empty, hence it's complement is all possible code
+ * points. So if the union includes the complement of 'b', it includes
+ * everything, and we need not even look at 'a'. It's easiest to
+ * create a new inversion list that matches everything. */
if (complement_b) {
SV* everything = _add_range_to_invlist(NULL, 0, UV_MAX);
- /* If the output didn't exist, just point it at the new list */
- if (*output == NULL) {
+ if (*output == NULL) { /* If the output didn't exist, just point it
+ at the new list */
*output = everything;
- return;
+ }
+ else { /* Otherwise, replace its contents with the new list */
+ invlist_replace_list_destroys_src(*output, everything);
+ SvREFCNT_dec_NN(everything);
}
- /* Otherwise, replace its contents with the new list */
- invlist_replace_list_destroys_src(*output, everything);
- SvREFCNT_dec_NN(everything);
return;
}
- /* Here, we don't want the complement of 'b', and since it is empty,
+ /* Here, we don't want the complement of 'b', and since 'b' is empty,
* the union will come entirely from 'a'. If 'a' is NULL or empty, the
* output will be empty */
- if (a == NULL) {
- *output = _new_invlist(0);
+ if (a == NULL || _invlist_len(a) == 0) {
+ if (*output == NULL) {
+ *output = _new_invlist(0);
+ }
+ else {
+ invlist_clear(*output);
+ }
return;
}
- if (_invlist_len(a) == 0) {
- invlist_clear(*output);
+ /* Here, 'a' is not empty, but 'b' is, so 'a' entirely determines the
+ * union. We can just return a copy of 'a' if '*output' doesn't point
+ * to an existing list */
+ if (*output == NULL) {
+ *output = invlist_clone(a);
return;
}
- /* Here, 'a' is not empty, and entirely determines the union. If the
- * output is not to overwrite 'b', we can just return 'a'. */
- if (*output != b) {
-
- /* If the output is to overwrite 'a', we have a no-op, as it's
- * already in 'a' */
- if (*output == a) {
- return;
- }
-
- /* But otherwise we have to copy 'a' to the output */
- *output = invlist_clone(a);
+ /* If the output is to overwrite 'a', we have a no-op, as it's
+ * already in 'a' */
+ if (*output == a) {
return;
}
- /* Here, 'b' is to be overwritten by the output, which will be 'a' */
+ /* Here, '*output' is to be overwritten by 'a' */
u = invlist_clone(a);
invlist_replace_list_destroys_src(*output, u);
SvREFCNT_dec_NN(u);
return;
}
+ /* Here 'b' is not empty. See about 'a' */
+
if (a == NULL || ((len_a = _invlist_len(a)) == 0)) {
/* Here, 'a' is empty (and b is not). That means the union will come
- * entirely from 'b'. If the output is not to overwrite 'a', we can
- * just return what's in 'b'. */
- if (*output != a) {
-
- /* If the output is to overwrite 'b', it's already in 'b', but
- * otherwise we have to copy 'b' to the output */
- if (*output != b) {
- *output = invlist_clone(b);
- }
-
- /* And if the output is to be the inversion of 'b', do that */
- if (complement_b) {
- _invlist_invert(*output);
- }
+ * entirely from 'b'. If '*output' is NULL, we can directly return a
+ * clone of 'b'. Otherwise, we replace the contents of '*output' with
+ * the clone */
- return;
+ SV ** dest = (*output == NULL) ? output : &u;
+ *dest = invlist_clone(b);
+ if (complement_b) {
+ _invlist_invert(*dest);
}
- /* Here, 'a', which is empty or even NULL, is to be overwritten by the
- * output, which will either be 'b' or the complement of 'b' */
-
- if (a == NULL) {
- *output = invlist_clone(b);
- }
- else {
- u = invlist_clone(b);
+ if (dest == &u) {
invlist_replace_list_destroys_src(*output, u);
SvREFCNT_dec_NN(u);
- }
-
- if (complement_b) {
- _invlist_invert(*output);
}
return;
array_u = _invlist_array_init(u, ( len_a > 0 && array_a[0] == 0)
|| (len_b > 0 && array_b[0] == 0));
- /* Go through each input list item by item, stopping when exhausted one of
- * them */
+ /* Go through each input list item by item, stopping when have exhausted
+ * one of them */
while (i_a < len_a && i_b < len_b) {
UV cp; /* The element to potentially add to the union's array */
bool cp_in_set; /* is it in the the input list's set or not */
array_u = invlist_array(u);
}
- /* If the output is not to overwrite either of the inputs, just return the
- * calculated union */
- if (a != *output && b != *output) {
+ if (*output == NULL) { /* Simply return the new inversion list */
*output = u;
}
else {
- /* Here, the output is to be the same as one of the input scalars,
- * hence replacing it. The simple thing to do is to free the input
- * scalar, making it instead be the output one. But experience has
- * shown [perl #127392] that if the input is a mortal, we can get a
- * huge build-up of these during regex compilation before they get
- * freed. So for that case, replace just the input's interior with
- * the union's, and then free the union */
-
- assert(! invlist_is_iterating(*output));
-
- if (! SvTEMP(*output)) {
- SvREFCNT_dec_NN(*output);
- *output = u;
- }
- else {
- invlist_replace_list_destroys_src(*output, u);
- SvREFCNT_dec_NN(u);
- }
+ /* Otherwise, overwrite the inversion list that was in '*output'. We
+ * could instead free '*output', and then set it to 'u', but experience
+ * has shown [perl #127392] that if the input is a mortal, we can get a
+ * huge build-up of these during regex compilation before they get
+ * freed. */
+ invlist_replace_list_destroys_src(*output, u);
+ SvREFCNT_dec_NN(u);
}
return;
Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b,
const bool complement_b, SV** i)
{
- /* Take the intersection of two inversion lists and point <i> to it. *i
- * SHOULD BE DEFINED upon input, and if it points to one of the two lists,
- * the reference count to that list will be decremented if not already a
- * temporary (mortal); otherwise just its contents will be modified to be
- * the intersection. The first list, <a>, may be NULL, in which case an
- * empty list is returned. If <complement_b> is TRUE, the result will be
- * the intersection of <a> and the complement (or inversion) of <b> instead
- * of <b> directly.
+ /* Take the intersection of two inversion lists and point '*i' to it. On
+ * input, '*i' MUST POINT TO NULL OR TO AN SV* INVERSION LIST (possibly
+ * even 'a' or 'b'). If to an inversion list, the contents of the original
+ * list will be replaced by the intersection. The first list, 'a', may be
+ * NULL, in which case '*i' will be an empty list. If 'complement_b' is
+ * TRUE, the result will be the intersection of 'a' and the complement (or
+ * inversion) of 'b' instead of 'b' directly.
*
* The basis for this comes from "Unicode Demystified" Chapter 13 by
* Richard Gillam, published by Addison-Wesley, and explained at some
PERL_ARGS_ASSERT__INVLIST_INTERSECTION_MAYBE_COMPLEMENT_2ND;
assert(a != b);
+ assert(*i == NULL || SvTYPE(*i) == SVt_INVLIST);
/* Special case if either one is empty */
len_a = (a == NULL) ? 0 : _invlist_len(a);
return;
}
- /* If not overwriting either input, just make a copy of 'a' */
- if (*i != b) {
+ if (*i == NULL) {
*i = invlist_clone(a);
return;
}
- /* Here we are overwriting 'b' with 'a's contents */
r = invlist_clone(a);
invlist_replace_list_destroys_src(*i, r);
SvREFCNT_dec_NN(r);
array_r = _invlist_array_init(r, len_a > 0 && array_a[0] == 0
&& len_b > 0 && array_b[0] == 0);
- /* Go through each list item by item, stopping when exhausted one of
+ /* Go through each list item by item, stopping when have exhausted one of
* them */
while (i_a < len_a && i_b < len_b) {
UV cp; /* The element to potentially add to the intersection's
array_r = invlist_array(r);
}
- /* Finish outputting any remaining */
- if (count >= 2) { /* At most one will have a non-zero copy count */
- IV copy_count;
- if ((copy_count = len_a - i_a) > 0) {
- Copy(array_a + i_a, array_r + i_r, copy_count, UV);
- }
- else if ((copy_count = len_b - i_b) > 0) {
- Copy(array_b + i_b, array_r + i_r, copy_count, UV);
- }
- }
-
- /* If the output is not to overwrite either of the inputs, just return the
- * calculated intersection */
- if (a != *i && b != *i) {
+ if (*i == NULL) { /* Simply return the calculated intersection */
*i = r;
}
- else {
- /* Here, the output is to be the same as one of the input scalars,
- * hence replacing it. The simple thing to do is to free the input
- * scalar, making it instead be the output one. But experience has
- * shown [perl #127392] that if the input is a mortal, we can get a
- * huge build-up of these during regex compilation before they get
- * freed. So for that case, replace just the input's interior with
- * the output's, and then free the output. A short-cut in this case
- * is if the output is empty, we can just set the input to be empty */
-
- assert(! invlist_is_iterating(*i));
-
- if (! SvTEMP(*i)) {
- SvREFCNT_dec_NN(*i);
- *i = r;
+ else { /* Otherwise, replace the existing inversion list in '*i'. We could
+ instead free '*i', and then set it to 'r', but experience has
+ shown [perl #127392] that if the input is a mortal, we can get a
+ huge build-up of these during regex compilation before they get
+ freed. */
+ if (len_r) {
+ invlist_replace_list_destroys_src(*i, r);
}
else {
- if (len_r) {
- invlist_replace_list_destroys_src(*i, r);
- }
- else {
- invlist_clear(*i);
- }
- SvREFCNT_dec_NN(r);
+ invlist_clear(*i);
}
+ SvREFCNT_dec_NN(r);
}
return;
invlist_iterinit(invlist);
while (invlist_iternext(invlist, &start, &end)) {
if (end == UV_MAX) {
- Perl_sv_catpvf(aTHX_ output, "%04"UVXf"%cINFINITY%c",
+ Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%cINFINITY%c",
start, intra_range_delimiter,
inter_range_delimiter);
}
else if (end != start) {
- Perl_sv_catpvf(aTHX_ output, "%04"UVXf"%c%04"UVXf"%c",
+ Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%c%04" UVXf "%c",
start,
intra_range_delimiter,
end, inter_range_delimiter);
}
else {
- Perl_sv_catpvf(aTHX_ output, "%04"UVXf"%c",
+ Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%c",
start, inter_range_delimiter);
}
}
while (invlist_iternext(invlist, &start, &end)) {
if (end == UV_MAX) {
Perl_dump_indent(aTHX_ level, file,
- "%s[%"UVuf"] 0x%04"UVXf" .. INFINITY\n",
+ "%s[%" UVuf "] 0x%04" UVXf " .. INFINITY\n",
indent, (UV)count, start);
}
else if (end != start) {
Perl_dump_indent(aTHX_ level, file,
- "%s[%"UVuf"] 0x%04"UVXf" .. 0x%04"UVXf"\n",
+ "%s[%" UVuf "] 0x%04" UVXf " .. 0x%04" UVXf "\n",
indent, (UV)count, start, end);
}
else {
- Perl_dump_indent(aTHX_ level, file, "%s[%"UVuf"] 0x%04"UVXf"\n",
+ Perl_dump_indent(aTHX_ level, file, "%s[%" UVuf "] 0x%04" UVXf "\n",
indent, (UV)count, start);
}
count += 2;
U8 dummy[UTF8_MAXBYTES_CASE+1];
/* This string is just a short named one above \xff */
- to_utf8_fold((U8*) HYPHEN_UTF8, dummy, NULL);
+ toFOLD_utf8_safe((U8*) HYPHEN_UTF8,
+ (U8 *) HYPHEN_UTF8 + sizeof(HYPHEN_UTF8),
+ dummy, NULL);
assert(PL_utf8_tofold); /* Verify that worked */
}
PL_utf8_foldclosures = _swash_inversion_hash(PL_utf8_tofold);
UV len_a = _invlist_len(a);
UV len_b = _invlist_len(b);
- UV i = 0; /* current index into the arrays */
- bool retval = TRUE; /* Assume are identical until proven otherwise */
-
PERL_ARGS_ASSERT__INVLISTEQ;
/* If are to compare 'a' with the complement of b, set it
}
}
- /* Make sure that the lengths are the same, as well as the final element
- * before looping through the remainder. (Thus we test the length, final,
- * and first elements right off the bat) */
- if (len_a != len_b || array_a[len_a-1] != array_b[len_a-1]) {
- retval = FALSE;
- }
- else for (i = 0; i < len_a - 1; i++) {
- if (array_a[i] != array_b[i]) {
- retval = FALSE;
- break;
- }
- }
+ return len_a == len_b
+ && memEQ(array_a, array_b, len_a * sizeof(array_a[0]));
- return retval;
}
#endif
}
else {
STRLEN len;
- to_utf8_fold(s, d, &len);
+ toFOLD_utf8_safe(s, e, d, &len);
d += len;
s += UTF8SKIP(s);
}
fail_modifiers:
RExC_parse += SKIP_IF_CHAR(RExC_parse);
/* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */
- vFAIL2utf8f("Sequence (%"UTF8f"...) not recognized",
+ vFAIL2utf8f("Sequence (%" UTF8f "...) not recognized",
UTF8fARG(UTF, RExC_parse-seqstart, seqstart));
NOT_REACHED; /*NOTREACHED*/
}
if ( ! op ) {
RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1;
vFAIL2utf8f(
- "Unknown verb pattern '%"UTF8f"'",
+ "Unknown verb pattern '%" UTF8f "'",
UTF8fARG(UTF, verb_len, start_verb));
}
if ( arg_required && !start_arg ) {
}
RExC_recurse_count++;
DEBUG_OPTIMISE_MORE_r(Perl_re_printf( aTHX_
- "%*s%*s Recurse #%"UVuf" to %"IVdf"\n",
+ "%*s%*s Recurse #%" UVuf " to %" IVdf "\n",
22, "| |", (int)(depth * 2 + 1), "",
(UV)ARG(ret), (IV)ARG2L(ret)));
}
RExC_parse += SKIP_IF_CHAR(RExC_parse);
/* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */
vFAIL2utf8f(
- "Sequence (%"UTF8f"...) not recognized",
+ "Sequence (%" UTF8f "...) not recognized",
UTF8fARG(UTF, RExC_parse-seqstart, seqstart));
NOT_REACHED; /*NOTREACHED*/
}
*flagp = flags & (RESTART_PASS1|NEED_UTF8);
return NULL;
}
- FAIL2("panic: regbranch returned NULL, flags=%#"UVxf"",
+ FAIL2("panic: regbranch returned NULL, flags=%#" UVxf,
(UV) flags);
} else
REGTAIL(pRExC_state, br, reganode(pRExC_state,
*flagp = flags & (RESTART_PASS1|NEED_UTF8);
return NULL;
}
- FAIL2("panic: regbranch returned NULL, flags=%#"UVxf"",
+ FAIL2("panic: regbranch returned NULL, flags=%#" UVxf,
(UV) flags);
}
REGTAIL(pRExC_state, ret, lastbr);
if (RExC_open_parens && !RExC_open_parens[parno])
{
DEBUG_OPTIMISE_MORE_r(Perl_re_printf( aTHX_
- "%*s%*s Setting open paren #%"IVdf" to %d\n",
+ "%*s%*s Setting open paren #%" IVdf " to %d\n",
22, "| |", (int)(depth * 2 + 1), "",
(IV)parno, REG_NODE_NUM(ret)));
RExC_open_parens[parno]= ret;
*flagp = flags & (RESTART_PASS1|NEED_UTF8);
return NULL;
}
- FAIL2("panic: regbranch returned NULL, flags=%#"UVxf"", (UV) flags);
+ FAIL2("panic: regbranch returned NULL, flags=%#" UVxf, (UV) flags);
}
if (*RExC_parse == '|') {
if (!SIZE_ONLY && RExC_extralen) {
*flagp = flags & (RESTART_PASS1|NEED_UTF8);
return NULL;
}
- FAIL2("panic: regbranch returned NULL, flags=%#"UVxf"", (UV) flags);
+ FAIL2("panic: regbranch returned NULL, flags=%#" UVxf, (UV) flags);
}
REGTAIL(pRExC_state, lastbr, br); /* BRANCH -> BRANCH. */
lastbr = br;
ender = reganode(pRExC_state, CLOSE, parno);
if ( RExC_close_parens ) {
DEBUG_OPTIMISE_MORE_r(Perl_re_printf( aTHX_
- "%*s%*s Setting close paren #%"IVdf" to %d\n",
+ "%*s%*s Setting close paren #%" IVdf " to %d\n",
22, "| |", (int)(depth * 2 + 1), "", (IV)parno, REG_NODE_NUM(ender)));
RExC_close_parens[parno]= ender;
if (RExC_nestroot == parno)
DEBUG_PARSE_MSG("lsbr");
regprop(RExC_rx, RExC_mysv1, lastbr, NULL, pRExC_state);
regprop(RExC_rx, RExC_mysv2, ender, NULL, pRExC_state);
- Perl_re_printf( aTHX_ "~ tying lastbr %s (%"IVdf") to ender %s (%"IVdf") offset %"IVdf"\n",
+ Perl_re_printf( aTHX_ "~ tying lastbr %s (%" IVdf ") to ender %s (%" IVdf ") offset %" IVdf "\n",
SvPV_nolen_const(RExC_mysv1),
(IV)REG_NODE_NUM(lastbr),
SvPV_nolen_const(RExC_mysv2),
DEBUG_PARSE_MSG("NADA");
regprop(RExC_rx, RExC_mysv1, ret, NULL, pRExC_state);
regprop(RExC_rx, RExC_mysv2, ender, NULL, pRExC_state);
- Perl_re_printf( aTHX_ "~ converting ret %s (%"IVdf") to ender %s (%"IVdf") offset %"IVdf"\n",
+ Perl_re_printf( aTHX_ "~ converting ret %s (%" IVdf ") to ender %s (%" IVdf ") offset %" IVdf "\n",
SvPV_nolen_const(RExC_mysv1),
(IV)REG_NODE_NUM(ret),
SvPV_nolen_const(RExC_mysv2),
*flagp = flags & (RESTART_PASS1|NEED_UTF8);
return NULL;
}
- FAIL2("panic: regpiece returned NULL, flags=%#"UVxf"", (UV) flags);
+ FAIL2("panic: regpiece returned NULL, flags=%#" UVxf, (UV) flags);
}
else if (ret == NULL)
ret = latest;
if (flags & (TRYAGAIN|RESTART_PASS1|NEED_UTF8))
*flagp |= flags & (TRYAGAIN|RESTART_PASS1|NEED_UTF8);
else
- FAIL2("panic: regatom returned NULL, flags=%#"UVxf"", (UV) flags);
+ FAIL2("panic: regatom returned NULL, flags=%#" UVxf, (UV) flags);
return(NULL);
}
if (!SIZE_ONLY && !(flags&(HASWIDTH|POSTPONED)) && max > REG_INFTY/3) {
SAVEFREESV(RExC_rx_sv); /* in case of fatal warnings */
ckWARN2reg(RExC_parse,
- "%"UTF8f" matches null string many times",
+ "%" UTF8f " matches null string many times",
UTF8fARG(UTF, (RExC_parse >= origparse
? RExC_parse - origparse
: 0),
RExC_parse++; /* Skip past the '{' */
- if (! (endbrace = strchr(RExC_parse, '}')) /* no trailing brace */
- || ! (endbrace == RExC_parse /* nothing between the {} */
+ if (! (endbrace = strchr(RExC_parse, '}'))) { /* no trailing brace */
+ vFAIL2("Missing right brace on \\%c{}", 'N');
+ }
+ else if(!(endbrace == RExC_parse /* nothing between the {} */
|| (endbrace - RExC_parse >= 2 /* U+ (bad hex is checked... */
&& strnEQ(RExC_parse, "U+", 2)))) /* ... below for a better
error msg) */
{
- if (endbrace) RExC_parse = endbrace; /* position msg's '<--HERE' */
+ RExC_parse = endbrace; /* position msg's '<--HERE' */
vFAIL("\\N{NAME} must be resolved by the lexer");
}
*flagp = flags & (RESTART_PASS1|NEED_UTF8);
return FALSE;
}
- FAIL2("panic: reg returned NULL to grok_bslash_N, flags=%#"UVxf"",
+ FAIL2("panic: reg returned NULL to grok_bslash_N, flags=%#" UVxf,
(UV) flags);
}
*flagp |= flags&(HASWIDTH|SPSTART|SIMPLE|POSTPONED);
if (ret == NULL) {
if (*flagp & (RESTART_PASS1|NEED_UTF8))
return NULL;
- FAIL2("panic: regclass returned NULL to regatom, flags=%#"UVxf"",
+ FAIL2("panic: regclass returned NULL to regatom, flags=%#" UVxf,
(UV) *flagp);
}
if (*RExC_parse != ']') {
*flagp = flags & (RESTART_PASS1|NEED_UTF8);
return NULL;
}
- FAIL2("panic: reg returned NULL to regatom, flags=%#"UVxf"",
+ FAIL2("panic: reg returned NULL to regatom, flags=%#" UVxf,
(UV) flags);
}
*flagp |= flags&(HASWIDTH|SPSTART|SIMPLE|POSTPONED);
bad_bound_type:
RExC_parse = endbrace;
vFAIL2utf8f(
- "'%"UTF8f"' is an unknown bound type",
+ "'%" UTF8f "' is an unknown bound type",
UTF8fARG(UTF, length, endbrace - length));
NOT_REACHED; /*NOTREACHED*/
}
/* regclass() can only return RESTART_PASS1 and NEED_UTF8 if
* multi-char folds are allowed. */
if (!ret)
- FAIL2("panic: regclass returned NULL to regatom, flags=%#"UVxf"",
+ FAIL2("panic: regclass returned NULL to regatom, flags=%#" UVxf,
(UV) *flagp);
RExC_parse--;
? "^"
: "";
RExC_parse = (char *) p;
- vFAIL3utf8f("POSIX class [:%s%"UTF8f":] unknown",
+ vFAIL3utf8f("POSIX class [:%s%" UTF8f ":] unknown",
complement_string,
UTF8fARG(UTF, RExC_parse - name_start - 2, name_start));
}
&posix_warnings
))
FAIL2("panic: regclass returned NULL to handle_sets, "
- "flags=%#"UVxf"", (UV) *flagp);
+ "flags=%#" UVxf, (UV) *flagp);
/* function call leaves parse pointing to the ']', except
* if we faked it */
NULL))
{
FAIL2("panic: regclass returned NULL to handle_sets, "
- "flags=%#"UVxf"", (UV) *flagp);
+ "flags=%#" UVxf, (UV) *flagp);
}
/* regclass() will return with parsing just the \ sequence,
))
{
FAIL2("panic: regclass returned NULL to handle_sets, "
- "flags=%#"UVxf"", (UV) *flagp);
+ "flags=%#" UVxf, (UV) *flagp);
}
/* function call leaves parse pointing to the ']', except if we
{
SV* i = NULL;
SV* u = NULL;
- SV* element;
_invlist_union(lhs, rhs, &u);
_invlist_intersection(lhs, rhs, &i);
- /* _invlist_subtract will overwrite rhs
- without freeing what it already contains */
- element = rhs;
_invlist_subtract(u, i, &rhs);
SvREFCNT_dec_NN(i);
SvREFCNT_dec_NN(u);
- SvREFCNT_dec_NN(element);
break;
}
}
result_string = newSVpvs("");
while (invlist_iternext(final, &start, &end)) {
if (start == end) {
- Perl_sv_catpvf(aTHX_ result_string, "\\x{%"UVXf"}", start);
+ Perl_sv_catpvf(aTHX_ result_string, "\\x{%" UVXf "}", start);
}
else {
- Perl_sv_catpvf(aTHX_ result_string, "\\x{%"UVXf"}-\\x{%"UVXf"}",
+ Perl_sv_catpvf(aTHX_ result_string, "\\x{%" UVXf "}-\\x{%" UVXf "}",
start, end);
}
}
NULL
);
if (!node)
- FAIL2("panic: regclass returned NULL to handle_sets, flags=%#"UVxf,
+ FAIL2("panic: regclass returned NULL to handle_sets, flags=%#" UVxf,
PTR2UV(flagp));
/* Fix up the node type if we are in locale. (We have pretended we are
RExC_parse = e + 1;
/* diag_listed_as: Can't find Unicode property definition "%s" */
- vFAIL3utf8f("%s \"%"UTF8f"\"",
+ vFAIL3utf8f("%s \"%" UTF8f "\"",
msg, UTF8fARG(UTF, n, name));
}
SAVEFREEPV(name);
}
}
- Perl_sv_catpvf(aTHX_ listsv, "%cutf8::%s%"UTF8f"%s\n",
+ Perl_sv_catpvf(aTHX_ listsv, "%cutf8::%s%" UTF8f "%s\n",
(value == 'p' ? '+' : '!'),
(FOLD) ? "__" : "",
UTF8fARG(UTF, n, name),
: 0;
if (strict) {
vFAIL2utf8f(
- "False [] range \"%"UTF8f"\"",
+ "False [] range \"%" UTF8f "\"",
UTF8fARG(UTF, w, rangebegin));
}
else {
SAVEFREESV(RExC_rx_sv); /* in case of fatal warnings */
ckWARN2reg(RExC_parse,
- "False [] range \"%"UTF8f"\"",
+ "False [] range \"%" UTF8f "\"",
UTF8fARG(UTF, w, rangebegin));
(void)ReREFCNT_inc(RExC_rx_sv);
cp_list = add_cp_to_invlist(cp_list, '-');
#endif
w = RExC_parse - rangebegin;
vFAIL2utf8f(
- "Invalid [] range \"%"UTF8f"\"",
+ "Invalid [] range \"%" UTF8f "\"",
UTF8fARG(UTF, w, rangebegin));
NOT_REACHED; /* NOTREACHED */
}
foldbuf + foldlen);
SV* multi_fold = sv_2mortal(newSVpvs(""));
- Perl_sv_catpvf(aTHX_ multi_fold, "\\x{%"UVXf"}", value);
+ Perl_sv_catpvf(aTHX_ multi_fold, "\\x{%" UVXf "}", value);
multi_char_matches
= add_multi_match(multi_char_matches,
#else
if (RExC_offsets) { /* MJD */
MJD_OFFSET_DEBUG(
- ("%s:%d: (op %s) %s %"UVuf" (len %"UVuf") (max %"UVuf").\n",
+ ("%s:%d: (op %s) %s %" UVuf " (len %" UVuf ") (max %" UVuf ").\n",
name, __LINE__,
PL_reg_name[op],
(UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0]
dst = RExC_emit;
if (RExC_open_parens) {
int paren;
- /*DEBUG_PARSE_FMT("inst"," - %"IVdf, (IV)RExC_npar);*/
+ /*DEBUG_PARSE_FMT("inst"," - %" IVdf, (IV)RExC_npar);*/
/* remember that RExC_npar is rex->nparens + 1,
* iow it is 1 more than the number of parens seen in
* the pattern so far. */
#ifdef RE_TRACK_PATTERN_OFFSETS
if (RExC_offsets) { /* MJD 20010112 */
MJD_OFFSET_DEBUG(
- ("%s(%d): (op %s) %s copy %"UVuf" -> %"UVuf" (max %"UVuf").\n",
+ ("%s(%d): (op %s) %s copy %" UVuf " -> %" UVuf " (max %" UVuf ").\n",
"reg_insert",
__LINE__,
PL_reg_name[op],
#ifdef RE_TRACK_PATTERN_OFFSETS
if (RExC_offsets) { /* MJD */
MJD_OFFSET_DEBUG(
- ("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n",
+ ("%s(%d): (op %s) %s %" UVuf " <- %" UVuf " (max %" UVuf ").\n",
"reginsert",
__LINE__,
PL_reg_name[op],
DEBUG_PARSE_MSG("");
regprop(RExC_rx, RExC_mysv, val, NULL, pRExC_state);
Perl_re_printf( aTHX_
- "~ attach to %s (%"IVdf") offset to %"IVdf"\n",
+ "~ attach to %s (%" IVdf ") offset to %" IVdf "\n",
SvPV_nolen_const(RExC_mysv),
(IV)REG_NODE_NUM(val),
(IV)(val - scan)
RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->anchored_substr),
RE_SV_DUMPLEN(r->anchored_substr), 30);
Perl_re_printf( aTHX_
- "anchored %s%s at %"IVdf" ",
+ "anchored %s%s at %" IVdf " ",
s, RE_SV_TAIL(r->anchored_substr),
(IV)r->anchored_offset);
} else if (r->anchored_utf8) {
RE_PV_QUOTED_DECL(s, 1, dsv, SvPVX_const(r->anchored_utf8),
RE_SV_DUMPLEN(r->anchored_utf8), 30);
Perl_re_printf( aTHX_
- "anchored utf8 %s%s at %"IVdf" ",
+ "anchored utf8 %s%s at %" IVdf " ",
s, RE_SV_TAIL(r->anchored_utf8),
(IV)r->anchored_offset);
}
RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->float_substr),
RE_SV_DUMPLEN(r->float_substr), 30);
Perl_re_printf( aTHX_
- "floating %s%s at %"IVdf"..%"UVuf" ",
+ "floating %s%s at %" IVdf "..%" UVuf " ",
s, RE_SV_TAIL(r->float_substr),
(IV)r->float_min_offset, (UV)r->float_max_offset);
} else if (r->float_utf8) {
RE_PV_QUOTED_DECL(s, 1, dsv, SvPVX_const(r->float_utf8),
RE_SV_DUMPLEN(r->float_utf8), 30);
Perl_re_printf( aTHX_
- "floating utf8 %s%s at %"IVdf"..%"UVuf" ",
+ "floating utf8 %s%s at %" IVdf "..%" UVuf " ",
s, RE_SV_TAIL(r->float_utf8),
(IV)r->float_min_offset, (UV)r->float_max_offset);
}
Perl_re_printf( aTHX_ " ");
}
if (r->intflags & PREGf_GPOS_SEEN)
- Perl_re_printf( aTHX_ "GPOS:%"UVuf" ", (UV)r->gofs);
+ Perl_re_printf( aTHX_ "GPOS:%" UVuf " ", (UV)r->gofs);
if (r->intflags & PREGf_SKIP)
Perl_re_printf( aTHX_ "plus ");
if (r->intflags & PREGf_IMPLICIT)
Perl_re_printf( aTHX_ "implicit ");
- Perl_re_printf( aTHX_ "minlen %"IVdf" ", (IV)r->minlen);
+ Perl_re_printf( aTHX_ "minlen %" IVdf " ", (IV)r->minlen);
if (r->extflags & RXf_EVAL_SEEN)
Perl_re_printf( aTHX_ "with eval ");
Perl_re_printf( aTHX_ "\n");
if (trie->jump)
sv_catpvs(sv, "(JUMP)");
Perl_sv_catpvf(aTHX_ sv,
- "<S:%"UVuf"/%"IVdf" W:%"UVuf" L:%"UVuf"/%"UVuf" C:%"UVuf"/%"UVuf">",
+ "<S:%" UVuf "/%" IVdf " W:%" UVuf " L:%" UVuf "/%" UVuf " C:%" UVuf "/%" UVuf ">",
(UV)trie->startstate,
(IV)trie->statecount-1, /* -1 because of the unused 0 element */
(UV)trie->wordcount,
{
AV *name_list= NULL;
U32 parno= OP(o) == ACCEPT ? (U32)ARG2L(o) : ARG(o);
- Perl_sv_catpvf(aTHX_ sv, "%"UVuf, (UV)parno); /* Parenth number */
+ Perl_sv_catpvf(aTHX_ sv, "%" UVuf, (UV)parno); /* Parenth number */
if ( RXp_PAREN_NAMES(prog) ) {
name_list= MUTABLE_AV(progi->data->data[progi->name_list_idx]);
} else if ( pRExC_state ) {
if ( k != REF || (OP(o) < NREF)) {
SV **name= av_fetch(name_list, parno, 0 );
if (name)
- Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", SVfARG(*name));
+ Perl_sv_catpvf(aTHX_ sv, " '%" SVf "'", SVfARG(*name));
}
else {
SV *sv_dat= MUTABLE_SV(progi->data->data[ parno ]);
I32 n;
if (name) {
for ( n=0; n<SvIVX(sv_dat); n++ ) {
- Perl_sv_catpvf(aTHX_ sv, "%s%"IVdf,
+ Perl_sv_catpvf(aTHX_ sv, "%s%" IVdf,
(n ? "," : ""), (IV)nums[n]);
}
- Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", SVfARG(*name));
+ Perl_sv_catpvf(aTHX_ sv, " '%" SVf "'", SVfARG(*name));
}
}
}
if (name_list) {
SV **name= av_fetch(name_list, ARG(o), 0 );
if (name)
- Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", SVfARG(*name));
+ Perl_sv_catpvf(aTHX_ sv, " '%" SVf "'", SVfARG(*name));
}
}
else if (k == LOGICAL)
/* add on the verb argument if there is one */
if ( ( k == VERB || OP(o) == ACCEPT || OP(o) == OPFAIL ) && o->flags) {
- Perl_sv_catpvf(aTHX_ sv, ":%"SVf,
+ Perl_sv_catpvf(aTHX_ sv, ":%" SVf,
SVfARG((MUTABLE_SV(progi->data->data[ ARG( o ) ]))));
}
#else
l1 = 512;
Copy(message, buf, l1 , char);
/* l1-1 to avoid \n */
- Perl_croak(aTHX_ "%"UTF8f, UTF8fARG(utf8, l1-1, buf));
+ Perl_croak(aTHX_ "%" UTF8f, UTF8fARG(utf8, l1-1, buf));
}
/* XXX Here's a total kludge. But we need to re-enter for swash routines. */
PERL_ARGS_ASSERT_PUT_CODE_POINT;
if (c > 255) {
- Perl_sv_catpvf(aTHX_ sv, "\\x{%04"UVXf"}", c);
+ Perl_sv_catpvf(aTHX_ sv, "\\x{%04" UVXf "}", c);
}
else if (isPRINT(c)) {
const char string = (char) c;
: NUM_ANYOF_CODE_POINTS - 1;
#if NUM_ANYOF_CODE_POINTS > 256
format = (this_end < 256)
- ? "\\x%02"UVXf"-\\x%02"UVXf""
- : "\\x{%04"UVXf"}-\\x{%04"UVXf"}";
+ ? "\\x%02" UVXf "-\\x%02" UVXf
+ : "\\x{%04" UVXf "}-\\x{%04" UVXf "}";
#else
- format = "\\x%02"UVXf"-\\x%02"UVXf"";
+ format = "\\x%02" UVXf "-\\x%02" UVXf;
#endif
GCC_DIAG_IGNORE(-Wformat-nonliteral);
Perl_sv_catpvf(aTHX_ sv, format, start, this_end);
#define CLEAR_OPTSTART \
if (optstart) STMT_START { \
DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ \
- " (%"IVdf" nodes)\n", (IV)(node - optstart))); \
+ " (%" IVdf " nodes)\n", (IV)(node - optstart))); \
optstart=NULL; \
} STMT_END
CLEAR_OPTSTART;
regprop(r, sv, node, NULL, NULL);
- Perl_re_printf( aTHX_ "%4"IVdf":%*s%s", (IV)(node - start),
+ Perl_re_printf( aTHX_ "%4" IVdf ":%*s%s", (IV)(node - start),
(int)(2*indent + 1), "", SvPVX_const(sv));
if (OP(node) != OPTIMIZED) {
&& PL_regkind[OP(next)] != BRANCH )
Perl_re_printf( aTHX_ " (FAIL)");
else
- Perl_re_printf( aTHX_ " (%"IVdf")", (IV)(next - start));
+ Perl_re_printf( aTHX_ " (%" IVdf ")", (IV)(next - start));
Perl_re_printf( aTHX_ "\n");
}
);
if (trie->jump) {
U16 dist= trie->jump[word_idx+1];
- Perl_re_printf( aTHX_ "(%"UVuf")\n",
+ Perl_re_printf( aTHX_ "(%" UVuf ")\n",
(UV)((dist ? this_trie + dist : next) - start));
if (dist) {
if (!nextbranch)
https://perl5.git.perl.org / perl5.git / blobdiff