# define PERL_NO_GET_CONTEXT
#endif
-/*SUPPRESS 112*/
/*
* pregcomp and pregexec -- regsub and regerror are not used in perl
*
MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \
__LINE__, (node), (byte))); \
if((node) < 0) { \
- Perl_croak(aTHX_ "value of node is %d in Offset macro", node); \
+ Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \
} else { \
RExC_offsets[2*(node)-1] = (byte); \
} \
#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__, (node), (len))); \
+ __LINE__, (int)(node), (int)(len))); \
if((node) < 0) { \
- Perl_croak(aTHX_ "value of node is %d in Length macro", node); \
+ Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \
} else { \
RExC_offsets[2*(node)] = (len); \
} \
DEBUG_TRIE_COMPILE_r({ \
SV *tmp; \
if ( UTF ) { \
- tmp = newSVpv( "", 0 ); \
+ tmp = newSVpvn( "", 0 ); \
pv_uni_display( tmp, uc, len, 60, UNI_DISPLAY_REGEX ); \
} else { \
tmp = Perl_newSVpvf_nocontext( "%c", (int)uvc ); \
} STMT_END
#define TRIE_LIST_NEW(state) STMT_START { \
- Newz( 1023, trie->states[ state ].trans.list, \
+ Newxz( trie->states[ state ].trans.list, \
4, reg_trie_trans_le ); \
TRIE_LIST_CUR( state ) = 1; \
TRIE_LIST_LEN( state ) = 4; \
GET_RE_DEBUG_FLAGS_DECL;
- Newz( 848200, trie, 1, reg_trie_data );
+ Newxz( trie, 1, reg_trie_data );
trie->refcount = 1;
RExC_rx->data->data[ data_slot ] = (void*)trie;
- Newz( 848201, trie->charmap, 256, U16 );
+ Newxz( trie->charmap, 256, U16 );
DEBUG_r({
trie->words = newAV();
trie->revcharmap = newAV();
STRLEN transcount = 1;
- Newz( 848204, trie->states, trie->charcount + 2, reg_trie_state );
+ Newxz( trie->states, trie->charcount + 2, reg_trie_state );
TRIE_LIST_NEW(1);
next_alloc = 2;
PerlIO_printf( Perl_debug_log, "\n\n" );
});
- Newz( 848203, trie->trans, transcount ,reg_trie_trans );
+ Newxz( trie->trans, transcount ,reg_trie_trans );
{
U32 state;
U32 tp = 0;
*/
- Newz( 848203, trie->trans, ( trie->charcount + 1 ) * trie->uniquecharcount + 1,
+ Newxz( trie->trans, ( trie->charcount + 1 ) * trie->uniquecharcount + 1,
reg_trie_trans );
- Newz( 848204, trie->states, trie->charcount + 2, reg_trie_state );
+ Newxz( trie->states, trie->charcount + 2, reg_trie_state );
next_alloc = trie->uniquecharcount + 1;
for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
STATIC I32
-S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags, U32 depth)
+S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
+ regnode *last, scan_data_t *data, U32 flags, U32 depth)
/* scanp: Start here (read-write). */
/* deltap: Write maxlen-minlen here. */
/* last: Stop before this one. */
/* dont use tail as the end marker for this traverse */
for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
- regnode *noper = NEXTOPER( cur );
- regnode *noper_next = regnext( noper );
+ regnode * const noper = NEXTOPER( cur );
+ regnode * const noper_next = regnext( noper );
DEBUG_OPTIMISE_r({
regprop( mysv, cur);
}
sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan));
{
- SV * sv = data->last_found;
+ SV * const sv = data->last_found;
MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ?
mg_find(sv, PERL_MAGIC_utf8) : NULL;
if (mg && mg->mg_len >= 0)
}
if (!scan) /* It was not CURLYX, but CURLY. */
scan = next;
- if (ckWARN(WARN_REGEXP)
- /* ? quantifier ok, except for (?{ ... }) */
- && (next_is_eval || !(mincount == 0 && maxcount == 1))
+ if ( /* ? quantifier ok, except for (?{ ... }) */
+ (next_is_eval || !(mincount == 0 && maxcount == 1))
&& (minnext == 0) && (deltanext == 0)
&& data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
- && maxcount <= REG_INFTY/3) /* Complement check for big count */
+ && maxcount <= REG_INFTY/3 /* Complement check for big count */
+ && ckWARN(WARN_REGEXP))
{
vWARN(RExC_parse,
"Quantifier unexpected on zero-length expression");
RExC_rx->data->count += n;
}
else {
- Newc(1207, RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1),
+ Newxc(RExC_rx->data, sizeof(*RExC_rx->data) + sizeof(void*) * (n - 1),
char, struct reg_data);
- New(1208, RExC_rx->data->what, n, U8);
+ Newx(RExC_rx->data->what, n, U8);
RExC_rx->data->count = n;
}
Copy(s, RExC_rx->data->what + RExC_rx->data->count - n, n, U8);
RExC_whilem_seen = 15;
/* Allocate space and initialize. */
- Newc(1001, r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode),
+ Newxc(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode),
char, regexp);
if (r == NULL)
FAIL("Regexp out of space");
r->startp = 0; /* Useful during FAIL. */
r->endp = 0; /* Useful during FAIL. */
- Newz(1304, r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
+ Newxz(r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
if (r->offsets) {
r->offsets[0] = RExC_size;
}
/* XXXX To minimize changes to RE engine we always allocate
3-units-long substrs field. */
- Newz(1004, r->substrs, 1, struct reg_substr_data);
+ Newxz(r->substrs, 1, struct reg_substr_data);
StructCopy(&zero_scan_data, &data, scan_data_t);
/* XXXX Should not we check for something else? Usually it is OPEN1... */
{
const I32 n = add_data(pRExC_state, 1, "f");
- New(1006, RExC_rx->data->data[n], 1,
+ Newx(RExC_rx->data->data[n], 1,
struct regnode_charclass_class);
StructCopy(data.start_class,
(struct regnode_charclass_class*)RExC_rx->data->data[n],
{
const I32 n = add_data(pRExC_state, 1, "f");
- New(1006, RExC_rx->data->data[n], 1,
+ Newx(RExC_rx->data->data[n], 1,
struct regnode_charclass_class);
StructCopy(data.start_class,
(struct regnode_charclass_class*)RExC_rx->data->data[n],
r->reganch |= ROPT_EVAL_SEEN;
if (RExC_seen & REG_SEEN_CANY)
r->reganch |= ROPT_CANY_SEEN;
- Newz(1002, r->startp, RExC_npar, I32);
- Newz(1002, r->endp, RExC_npar, I32);
+ Newxz(r->startp, RExC_npar, I32);
+ Newxz(r->endp, RExC_npar, I32);
PL_regdata = r->data; /* for regprop() */
DEBUG_COMPILE_r(regdump(r));
return(r);
goto do_curly;
}
nest_check:
- if (ckWARN(WARN_REGEXP) && !SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3) {
+ if (!SIZE_ONLY && !(flags&HASWIDTH) && max > REG_INFTY/3 && ckWARN(WARN_REGEXP)) {
vWARN3(RExC_parse,
"%.*s matches null string many times",
RExC_parse - origparse,
FAIL("Trailing \\");
/* FALL THROUGH */
default:
- if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(*p))
+ if (!SIZE_ONLY&& isALPHA(*p) && ckWARN(WARN_REGEXP))
vWARN2(p + 1, "Unrecognized escape \\%c passed through", UCHARAT(p));
goto normal_default;
}
break;
}
default:
- if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(value))
+ if (!SIZE_ONLY && isALPHA(value) && ckWARN(WARN_REGEXP))
vWARN2(RExC_parse,
"Unrecognized escape \\%c in character class passed through",
(int)value);
k = PL_regkind[(U8)OP(o)];
if (k == EXACT) {
- SV *dsv = sv_2mortal(newSVpvn("", 0));
+ SV * const dsv = sv_2mortal(newSVpvn("", 0));
/* Using is_utf8_string() 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 bool do_utf8 = is_utf8_string((U8*)STRING(o), STR_LEN(o));
- const char *s = do_utf8 ?
+ const char * const s = do_utf8 ?
pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60,
UNI_DISPLAY_REGEX) :
STRING(o);
Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* 2: embedded, otherwise 1 */
else if (k == ANYOF) {
int i, rangestart = -1;
- U8 flags = ANYOF_FLAGS(o);
+ const U8 flags = ANYOF_FLAGS(o);
const char * const anyofs[] = { /* Should be synchronized with
* ANYOF_ #xdefines in regcomp.h */
"\\w",
{
SV *lv;
- SV *sw = regclass_swash(o, FALSE, &lv, 0);
+ SV * const sw = regclass_swash(o, FALSE, &lv, 0);
if (lv) {
if (sw) {
if (rangestart == -1)
rangestart = i;
} else if (rangestart != -1) {
- U8 *p;
-
if (i <= rangestart + 3)
for (; rangestart < i; rangestart++) {
- U8 *e;
- for(e = uvchr_to_utf8(s, rangestart), p = s; p < e; p++)
+ const U8 * const e = uvchr_to_utf8(s,rangestart);
+ U8 *p;
+ for(p = s; p < e; p++)
put_byte(sv, *p);
}
else {
- U8 *e;
- for (e = uvchr_to_utf8(s, rangestart), p = s; p < e; p++)
+ const U8 *e = uvchr_to_utf8(s,rangestart);
+ U8 *p;
+ for (p = s; p < e; p++)
put_byte(sv, *p);
- sv_catpv(sv, "-");
- for (e = uvchr_to_utf8(s, i - 1), p = s; p < e; p++)
+ sv_catpvn(sv, "-", 1);
+ e = uvchr_to_utf8(s, i-1);
+ for (p = s; p < e; p++)
put_byte(sv, *p);
}
rangestart = -1;
while(*s && *s != '\n') s++;
if (*s == '\n') {
- const char *t = ++s;
+ const char * const t = ++s;
while (*s) {
if (*s == '\n')
GET_RE_DEBUG_FLAGS_DECL;
DEBUG_COMPILE_r(
{
- const char *s = SvPV_nolen_const(prog->check_substr
+ const char * const s = SvPV_nolen_const(prog->check_substr
? prog->check_substr : prog->check_utf8);
if (!PL_colorset) reginitcolors();
len > 60 ? "..." : "");
});
- if (r->precomp)
- Safefree(r->precomp);
- if (r->offsets) /* 20010421 MJD */
- Safefree(r->offsets);
+ /* gcov results gave these as non-null 100% of the time, so there's no
+ optimisation in checking them before calling Safefree */
+ Safefree(r->precomp);
+ Safefree(r->offsets); /* 20010421 MJD */
RX_MATCH_COPY_FREE(r);
#ifdef PERL_OLD_COPY_ON_WRITE
if (r->saved_copy)
reg_trie_data *trie=(reg_trie_data*)r->data->data[n];
U32 refcount;
OP_REFCNT_LOCK;
- refcount = trie->refcount--;
+ refcount = --trie->refcount;
OP_REFCNT_UNLOCK;
if ( !refcount ) {
- if (trie->charmap)
- Safefree(trie->charmap);
+ Safefree(trie->charmap);
if (trie->widecharmap)
SvREFCNT_dec((SV*)trie->widecharmap);
- if (trie->states)
- Safefree(trie->states);
- if (trie->trans)
- Safefree(trie->trans);
+ Safefree(trie->states);
+ Safefree(trie->trans);
#ifdef DEBUGGING
if (trie->words)
SvREFCNT_dec((SV*)trie->words);
for (i = 1; i <= rx->nparens; i++) {
GV *mgv;
char digits[TYPE_CHARS(long)];
- sprintf(digits, "%lu", (long)i);
- if ((mgv = gv_fetchpv(digits, FALSE, SVt_PV)))
+ const STRLEN len = my_sprintf(digits, "%lu", (long)i);
+ if ((mgv = gv_fetchpvn_flags(digits, len, FALSE, SVt_PV)))
save_scalar(mgv);
}
}
https://perl5.git.perl.org / perl5.git / blobdiff