DEBUG_TRIE_COMPILE_r(
PerlIO_printf( Perl_debug_log, "TRIE(%s): W:%d C:%d Uq:%d \n",
( trie->widecharmap ? "UTF8" : "NATIVE" ), trie->wordcount,
- trie->charcount, trie->uniquecharcount )
+ (int)trie->charcount, trie->uniquecharcount )
);
DEBUG_TRIE_COMPILE_MORE_r(
PerlIO_printf( Perl_debug_log,
" Alloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
- ( ( trie->charcount + 1 ) * trie->uniquecharcount + 1 ), (IV)next_alloc, (IV)pos,
+ (int)( ( trie->charcount + 1 ) * trie->uniquecharcount + 1 ),
+ (IV)next_alloc,
+ (IV)pos,
( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
);
/* REx optimizer. Converts nodes into quickier variants "in place".
Finds fixed substrings. */
-/* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set
+/* Stops at toplevel WHILEM as well as at "last". At end *scanp is set
to the position after last scanned or to NULL. */
void
Perl_reginitcolors(pTHX)
{
- int i = 0;
- char *s = PerlEnv_getenv("PERL_RE_COLORS");
-
+ const char * const s = PerlEnv_getenv("PERL_RE_COLORS");
if (s) {
- PL_colors[0] = s = savepv(s);
+ char *t = savepv(s);
+ int i = 0;
+ PL_colors[0] = t;
while (++i < 6) {
- s = strchr(s, '\t');
- if (s) {
- *s = '\0';
- PL_colors[i] = ++s;
+ t = strchr(t, '\t');
+ if (t) {
+ *t = '\0';
+ PL_colors[i] = ++t;
}
else
- PL_colors[i] = s = (char *)"";
+ PL_colors[i] = t = (char *)"";
}
} else {
+ int i = 0;
while (i < 6)
PL_colors[i++] = (char *)"";
}
!(r->reganch & ROPT_ANCH) )
{
/* turn .* into ^.* with an implied $*=1 */
- int type = OP(NEXTOPER(first));
-
- if (type == REG_ANY)
- type = ROPT_ANCH_MBOL;
- else
- type = ROPT_ANCH_SBOL;
-
+ const int type =
+ (OP(NEXTOPER(first)) == REG_ANY)
+ ? ROPT_ANCH_MBOL
+ : ROPT_ANCH_SBOL;
r->reganch |= type | ROPT_IMPLICIT;
first = NEXTOPER(first);
goto again;
&& !(data.start_class->flags & ANYOF_EOS)
&& !cl_is_anything(data.start_class))
{
- I32 n = add_data(pRExC_state, 1, "f");
+ const I32 n = add_data(pRExC_state, 1, "f");
New(1006, RExC_rx->data->data[n], 1,
struct regnode_charclass_class);
DEBUG_COMPILE_r({ SV *sv = sv_newmortal();
regprop(sv, (regnode*)data.start_class);
PerlIO_printf(Perl_debug_log,
- "synthetic stclass `%s'.\n",
+ "synthetic stclass \"%s\".\n",
SvPVX(sv));});
}
if (!(data.start_class->flags & ANYOF_EOS)
&& !cl_is_anything(data.start_class))
{
- I32 n = add_data(pRExC_state, 1, "f");
+ const I32 n = add_data(pRExC_state, 1, "f");
New(1006, RExC_rx->data->data[n], 1,
struct regnode_charclass_class);
DEBUG_COMPILE_r({ SV* sv = sv_newmortal();
regprop(sv, (regnode*)data.start_class);
PerlIO_printf(Perl_debug_log,
- "synthetic stclass `%s'.\n",
+ "synthetic stclass \"%s\".\n",
SvPVX(sv));});
}
}
register char op;
register char *next;
I32 flags;
- char *origparse = RExC_parse;
+ const char * const origparse = RExC_parse;
char *maxpos;
I32 min;
I32 max = REG_INFTY;
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
{
- I32 num = atoi(RExC_parse);
+ const I32 num = atoi(RExC_parse);
if (num > 9 && num >= RExC_npar)
goto defchar;
FAIL("Trailing \\");
/* FALL THROUGH */
default:
- /* Do not generate `unrecognized' warnings here, we fall
+ /* Do not generate "unrecognized" warnings here, we fall
back into the quick-grab loop below */
parse_start--;
goto defchar;
register UV ender;
register char *p;
char *oldp, *s;
- STRLEN numlen;
STRLEN foldlen;
U8 tmpbuf[UTF8_MAXBYTES_CASE+1], *foldbuf;
break;
case 'x':
if (*++p == '{') {
- char* e = strchr(p, '}');
+ char* const e = strchr(p, '}');
if (!e) {
RExC_parse = p + 1;
else {
I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
| PERL_SCAN_DISALLOW_PREFIX;
- numlen = e - p - 1;
+ STRLEN numlen = e - p - 1;
ender = grok_hex(p + 1, &numlen, &flags, NULL);
if (ender > 0xff)
RExC_utf8 = 1;
}
else {
I32 flags = PERL_SCAN_DISALLOW_PREFIX;
- numlen = 2;
+ STRLEN numlen = 2;
ender = grok_hex(p, &numlen, &flags, NULL);
p += numlen;
}
if (*p == '0' ||
(isDIGIT(p[1]) && atoi(p) >= RExC_npar) ) {
I32 flags = 0;
- numlen = 3;
+ STRLEN numlen = 3;
ender = grok_oct(p, &numlen, &flags, NULL);
p += numlen;
}
default:
normal_default:
if (UTF8_IS_START(*p) && UTF) {
+ STRLEN numlen;
ender = utf8n_to_uvchr((U8*)p, RExC_end - p,
&numlen, 0);
p += numlen;
if (FOLD) {
/* Emit all the Unicode characters. */
+ STRLEN numlen;
for (foldbuf = tmpbuf;
foldlen;
foldlen -= numlen) {
if (FOLD) {
/* Emit all the Unicode characters. */
+ STRLEN numlen;
for (foldbuf = tmpbuf;
foldlen;
foldlen -= numlen) {
if (RExC_utf8)
SvUTF8_on(sv);
if (sv_utf8_downgrade(sv, TRUE)) {
- char *s = sv_recode_to_utf8(sv, PL_encoding);
- STRLEN newlen = SvCUR(sv);
+ const char * const s = sv_recode_to_utf8(sv, PL_encoding);
+ const STRLEN newlen = SvCUR(sv);
if (SvUTF8(sv))
RExC_utf8 = 1;
}
STATIC char *
-S_regwhite(pTHX_ char *p, char *e)
+S_regwhite(pTHX_ char *p, const char *e)
{
while (p < e) {
if (isSPACE(*p))
if (value == '[' && RExC_parse + 1 < RExC_end &&
/* I smell either [: or [= or [. -- POSIX has been here, right? */
POSIXCC(UCHARAT(RExC_parse))) {
- char c = UCHARAT(RExC_parse);
+ const char c = UCHARAT(RExC_parse);
char* s = RExC_parse++;
while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != c)
/* Grandfather lone [:, [=, [. */
RExC_parse = s;
else {
- char* t = RExC_parse++; /* skip over the c */
+ const char* t = RExC_parse++; /* skip over the c */
assert(*t == c);
RExC_parse++; /* skip over the ending ] */
posixcc = s + 1;
if (*s == ':') {
- I32 complement = *posixcc == '^' ? *posixcc++ : 0;
- I32 skip = t - posixcc;
+ const I32 complement = *posixcc == '^' ? *posixcc++ : 0;
+ const I32 skip = t - posixcc;
/* Initially switch on the length of the name. */
switch (skip) {
S_checkposixcc(pTHX_ RExC_state_t *pRExC_state)
{
if (!SIZE_ONLY && POSIXCC(UCHARAT(RExC_parse))) {
- char *s = RExC_parse;
- char c = *s++;
+ const char *s = RExC_parse;
+ const char c = *s++;
while(*s && isALNUM(*s))
s++;
if (RExC_parse >= RExC_end)
vFAIL2("Empty \\%c{}", (U8)value);
if (*RExC_parse == '{') {
- U8 c = (U8)value;
+ const U8 c = (U8)value;
e = strchr(RExC_parse++, '}');
if (!e)
vFAIL2("Missing right brace on \\%c{}", c);
IV i;
if (prevvalue < 256) {
- IV ceilvalue = value < 256 ? value : 255;
+ const IV ceilvalue = value < 256 ? value : 255;
#ifdef EBCDIC
/* In EBCDIC [\x89-\x91] should include
ANYOF_BITMAP_SET(ret, i);
}
if (value > 255 || UTF) {
- UV prevnatvalue = NATIVE_TO_UNI(prevvalue);
- UV natvalue = NATIVE_TO_UNI(value);
+ const UV prevnatvalue = NATIVE_TO_UNI(prevvalue);
+ const UV natvalue = NATIVE_TO_UNI(value);
ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
if (prevnatvalue < natvalue) { /* what about > ? */
if (FOLD) {
U8 foldbuf[UTF8_MAXBYTES_CASE+1];
STRLEN foldlen;
- UV f = to_uni_fold(natvalue, foldbuf, &foldlen);
+ const UV f = to_uni_fold(natvalue, foldbuf, &foldlen);
/* If folding and foldable and a single
* character, insert also the folded version
STATIC regnode * /* Location. */
S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op)
{
- register regnode *ret;
register regnode *ptr;
+ regnode * const ret = RExC_emit;
- ret = RExC_emit;
if (SIZE_ONLY) {
SIZE_ALIGN(RExC_size);
RExC_size += 1;
STATIC regnode * /* Location. */
S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg)
{
- register regnode *ret;
register regnode *ptr;
+ regnode * const ret = RExC_emit;
- ret = RExC_emit;
if (SIZE_ONLY) {
SIZE_ALIGN(RExC_size);
RExC_size += 2;
register regnode *src;
register regnode *dst;
register regnode *place;
- register int offset = regarglen[(U8)op];
+ const int offset = regarglen[(U8)op];
/* (PL_regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */
S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, regnode *val)
{
register regnode *scan;
- register regnode *temp;
if (SIZE_ONLY)
return;
/* Find last node. */
scan = p;
for (;;) {
- temp = regnext(scan);
+ regnode * const temp = regnext(scan);
if (temp == NULL)
break;
scan = temp;
I32 word_idx;
PerlIO_printf(Perl_debug_log,
"%*s[Words:%d Chars Stored:%d Unique Chars:%d States:%"IVdf"%s]\n",
- (int)(2*(l+3)), "",
+ (int)(2*(l+3)),
+ "",
trie->wordcount,
- trie->charcount,
+ (int)trie->charcount,
trie->uniquecharcount,
(IV)trie->laststate-1,
node->flags ? " EVAL mode" : "");
node += regarglen[(U8)op];
}
- else if ( op == CURLY) { /* `next' might be very big: optimizer */
+ else if ( op == CURLY) { /* "next" might be very big: optimizer */
node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1);
}
/* Header fields of interest. */
if (r->anchored_substr)
PerlIO_printf(Perl_debug_log,
- "anchored `%s%.*s%s'%s at %"IVdf" ",
+ "anchored \"%s%.*s%s\"%s at %"IVdf" ",
PL_colors[0],
(int)(SvCUR(r->anchored_substr) - (SvTAIL(r->anchored_substr)!=0)),
SvPVX(r->anchored_substr),
(IV)r->anchored_offset);
else if (r->anchored_utf8)
PerlIO_printf(Perl_debug_log,
- "anchored utf8 `%s%.*s%s'%s at %"IVdf" ",
+ "anchored utf8 \"%s%.*s%s\"%s at %"IVdf" ",
PL_colors[0],
(int)(SvCUR(r->anchored_utf8) - (SvTAIL(r->anchored_utf8)!=0)),
SvPVX(r->anchored_utf8),
(IV)r->anchored_offset);
if (r->float_substr)
PerlIO_printf(Perl_debug_log,
- "floating `%s%.*s%s'%s at %"IVdf"..%"UVuf" ",
+ "floating \"%s%.*s%s\"%s at %"IVdf"..%"UVuf" ",
PL_colors[0],
(int)(SvCUR(r->float_substr) - (SvTAIL(r->float_substr)!=0)),
SvPVX(r->float_substr),
(IV)r->float_min_offset, (UV)r->float_max_offset);
else if (r->float_utf8)
PerlIO_printf(Perl_debug_log,
- "floating utf8 `%s%.*s%s'%s at %"IVdf"..%"UVuf" ",
+ "floating utf8 \"%s%.*s%s\"%s at %"IVdf"..%"UVuf" ",
PL_colors[0],
(int)(SvCUR(r->float_utf8) - (SvTAIL(r->float_utf8)!=0)),
SvPVX(r->float_utf8),
if (r->regstclass) {
regprop(sv, r->regstclass);
- PerlIO_printf(Perl_debug_log, "stclass `%s' ", SvPVX(sv));
+ PerlIO_printf(Perl_debug_log, "stclass \"%s\" ", SvPVX(sv));
}
if (r->reganch & ROPT_ANCH) {
PerlIO_printf(Perl_debug_log, "anchored");
PerlIO_printf(Perl_debug_log, "with eval ");
PerlIO_printf(Perl_debug_log, "\n");
if (r->offsets) {
- U32 i;
const U32 len = r->offsets[0];
GET_RE_DEBUG_FLAGS_DECL;
DEBUG_OFFSETS_r({
+ U32 i;
PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)r->offsets[0]);
for (i = 1; i <= len; i++)
PerlIO_printf(Perl_debug_log, "%"UVuf"[%"UVuf"] ",
/* 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 */
- bool do_utf8 = is_utf8_string((U8*)STRING(o), STR_LEN(o));
- char *s = do_utf8 ?
+ const bool do_utf8 = is_utf8_string((U8*)STRING(o), STR_LEN(o));
+ const char *s = do_utf8 ?
pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60,
UNI_DISPLAY_REGEX) :
STRING(o);
U8 s[UTF8_MAXBYTES_CASE+1];
for (i = 0; i <= 256; i++) { /* just the first 256 */
- U8 *e = uvchr_to_utf8(s, i);
+ uvchr_to_utf8(s, i);
if (i < 256 && swash_fetch(sw, s, TRUE)) {
if (rangestart == -1)
if (i <= rangestart + 3)
for (; rangestart < i; rangestart++) {
+ U8 *e;
for(e = uvchr_to_utf8(s, rangestart), p = s; p < e; p++)
put_byte(sv, *p);
}
else {
+ U8 *e;
for (e = uvchr_to_utf8(s, rangestart), 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++)
- put_byte(sv, *p);
+ for (e = uvchr_to_utf8(s, i - 1), p = s; p < e; p++)
+ put_byte(sv, *p);
}
rangestart = -1;
}
while(*s && *s != '\n') s++;
if (*s == '\n') {
- char *t = ++s;
+ const char *t = ++s;
while (*s) {
if (*s == '\n')
if (!PL_colorset) reginitcolors();
PerlIO_printf(Perl_debug_log,
- "%sUsing REx %ssubstr:%s `%s%.60s%s%s'\n",
+ "%sUsing REx %ssubstr:%s \"%s%.60s%s%s\"\n",
PL_colors[4],
prog->check_substr ? "" : "utf8 ",
PL_colors[5],PL_colors[0],
{
/* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */
- U32 i;
- GV *mgv;
REGEXP *rx;
- char digits[TYPE_CHARS(long)];
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
+ U32 i;
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)))
save_scalar(mgv);
https://perl5.git.perl.org / perl5.git / blobdiff