addmad(newMADsv(slot, sv), where, 0);
}
#else
-# define start_force(where) /*EMPTY*/
-# define curmad(slot, sv) /*EMPTY*/
+# define start_force(where) NOOP
+# define curmad(slot, sv) NOOP
#endif
/*
IoANY(datasv) = FPTR2DPTR(void *, funcp); /* stash funcp into spare field */
IoFLAGS(datasv) |= IOf_FAKE_DIRP;
DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
- IoANY(datasv), SvPV_nolen(datasv)));
+ FPTR2DPTR(void *, IoANY(datasv)),
+ SvPV_nolen(datasv)));
av_unshift(PL_rsfp_filters, 1);
av_store(PL_rsfp_filters, 0, datasv) ;
return(datasv);
SV *datasv;
#ifdef DEBUGGING
- DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", FPTR2DPTR(XPVIO *, funcp)));
+ DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p",
+ FPTR2DPTR(void*, funcp)));
#endif
if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
/* This API is bad. It should have been using unsigned int for maxlen.
Not sure if we want to change the API, but if not we should sanity
check the value here. */
- const unsigned int correct_length = maxlen < 0 ? INT_MAX : maxlen;
+ const unsigned int correct_length
+ = maxlen < 0 ?
+#ifdef PERL_MICRO
+ 0x7FFFFFFF
+#else
+ INT_MAX
+#endif
+ : maxlen;
if (!PL_rsfp_filters)
return -1;
funcp = DPTR2FPTR(filter_t, IoANY(datasv));
DEBUG_P(PerlIO_printf(Perl_debug_log,
"filter_read %d: via function %p (%s)\n",
- idx, datasv, SvPV_nolen_const(datasv)));
+ idx, (void*)datasv, SvPV_nolen_const(datasv)));
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
attrs = NULL;
while (isIDFIRST_lazy_if(s,UTF)) {
I32 tmp;
+ SV *sv;
d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
if (isLOWER(*s) && (tmp = keyword(PL_tokenbuf, len))) {
if (tmp < 0) tmp = -tmp;
break;
}
}
+ sv = newSVpvn(s, len);
if (*d == '(') {
d = scan_str(d,TRUE,TRUE);
if (!d) {
yyerror("Unterminated attribute parameter in attribute list");
if (attrs)
op_free(attrs);
+ sv_free(sv);
return REPORT(0); /* EOF indicator */
}
}
if (PL_lex_stuff) {
- SV *sv = newSVpvn(s, len);
sv_catsv(sv, PL_lex_stuff);
attrs = append_elem(OP_LIST, attrs,
newSVOP(OP_CONST, 0, sv));
PL_lex_stuff = NULL;
}
else {
- if (len == 6 && strnEQ(s, "unique", len)) {
+ if (len == 6 && strnEQ(SvPVX(sv), "unique", len)) {
+ sv_free(sv);
if (PL_in_my == KEY_our) {
#ifdef USE_ITHREADS
GvUNIQUE_on(cGVOPx_gv(yylval.opval));
/* NOTE: any CV attrs applied here need to be part of
the CVf_BUILTIN_ATTRS define in cv.h! */
- else if (!PL_in_my && len == 6 && strnEQ(s, "lvalue", len))
+ else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "lvalue", len)) {
+ sv_free(sv);
CvLVALUE_on(PL_compcv);
- else if (!PL_in_my && len == 6 && strnEQ(s, "locked", len))
+ }
+ else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "locked", len)) {
+ sv_free(sv);
CvLOCKED_on(PL_compcv);
- else if (!PL_in_my && len == 6 && strnEQ(s, "method", len))
+ }
+ else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "method", len)) {
+ sv_free(sv);
CvMETHOD_on(PL_compcv);
- else if (!PL_in_my && len == 9 && strnEQ(s, "assertion", len))
+ }
+ else if (!PL_in_my && len == 9 && strnEQ(SvPVX(sv), "assertion", len)) {
+ sv_free(sv);
CvASSERTION_on(PL_compcv);
+ }
/* After we've set the flags, it could be argued that
we don't need to do the attributes.pm-based setting
process, and shouldn't bother appending recognized
else
attrs = append_elem(OP_LIST, attrs,
newSVOP(OP_CONST, 0,
- newSVpvn(s, len)));
+ sv));
}
s = PEEKSPACE(d);
if (*s == ':' && s[1] != ':')
PUTBACK;
PerlIO_apply_layers(aTHX_ PL_rsfp, NULL,
Perl_form(aTHX_ ":encoding(%"SVf")",
- name));
+ (void*)name));
FREETMPS;
LEAVE;
}
case KEY_our:
case KEY_my:
+ case KEY_state:
PL_in_my = tmp;
s = SKIPSPACE1(s);
if (isIDFIRST_lazy_if(s,UTF)) {
if (!PL_in_my_stash) {
char tmpbuf[1024];
PL_bufptr = s;
+#ifdef USE_SNPRINTF
+ snprintf(tmpbuf, sizeof(tmpbuf), "No such class %.1000s", PL_tokenbuf);
+#else
sprintf(tmpbuf, "No such class %.1000s", PL_tokenbuf);
+#endif /* #ifdef USE_SNPRINTF */
yyerror(tmpbuf);
}
#ifdef PERL_MAD
if (bad_proto && ckWARN(WARN_SYNTAX))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Illegal character in prototype for %"SVf" : %s",
- PL_subname, d);
+ (void*)PL_subname, d);
SvCUR_set(PL_lex_stuff, tmp);
have_proto = TRUE;
if (!have_name)
Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
else if (*s != ';')
- Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, PL_subname);
+ Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, (void*)PL_subname);
}
#ifdef PERL_MAD
{
dVAR;
register char *d;
- register I32 tmp = 0;
+ register PADOFFSET tmp = 0;
/* pit holds the identifier we read and pending_ident is reset */
char pit = PL_pending_ident;
PL_pending_ident = 0;
}
else {
if (strchr(PL_tokenbuf,':'))
- yyerror(Perl_form(aTHX_ PL_no_myglob,PL_tokenbuf));
+ yyerror(Perl_form(aTHX_ PL_no_myglob,
+ PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf));
yylval.opval = newOP(OP_PADANY, 0);
yylval.opval->op_targ = allocmy(PL_tokenbuf);
I32
Perl_keyword (pTHX_ const char *name, I32 len)
{
- dVAR;
+ dVAR;
switch (len)
{
case 1: /* 5 tokens of length 1 */
switch (name[1])
{
case 'a':
- switch (name[2])
- {
- case 'i':
- if (name[3] == 't')
- { /* wait */
- return -KEY_wait;
- }
+ switch (name[2])
+ {
+ case 'i':
+ if (name[3] == 't')
+ { /* wait */
+ return -KEY_wait;
+ }
- goto unknown;
+ goto unknown;
- case 'r':
- if (name[3] == 'n')
- { /* warn */
- return -KEY_warn;
- }
+ case 'r':
+ if (name[3] == 'n')
+ { /* warn */
+ return -KEY_warn;
+ }
- goto unknown;
+ goto unknown;
- default:
- goto unknown;
- }
+ default:
+ goto unknown;
+ }
case 'h':
if (name[2] == 'e' &&
name[3] == 'n')
{ /* when */
return (FEATURE_IS_ENABLED("switch") ? KEY_when : 0);
- }
+ }
- goto unknown;
+ goto unknown;
- default:
- goto unknown;
- }
+ default:
+ goto unknown;
+ }
default:
goto unknown;
}
- case 5: /* 38 tokens of length 5 */
+ case 5: /* 39 tokens of length 5 */
switch (name[0])
{
case 'B':
{
case 'l':
if (name[2] == 'e' &&
- name[3] == 's' &&
- name[4] == 's')
- { /* bless */
- return -KEY_bless;
- }
+ name[3] == 's' &&
+ name[4] == 's')
+ { /* bless */
+ return -KEY_bless;
+ }
- goto unknown;
+ goto unknown;
case 'r':
if (name[2] == 'e' &&
goto unknown;
case 't':
- if (name[2] == 'u' &&
- name[3] == 'd' &&
- name[4] == 'y')
- { /* study */
- return KEY_study;
- }
+ switch (name[2])
+ {
+ case 'a':
+ if (name[3] == 't' &&
+ name[4] == 'e')
+ { /* state */
+ return (FEATURE_IS_ENABLED("state") ? KEY_state : 0);
+ }
- goto unknown;
+ goto unknown;
+
+ case 'u':
+ if (name[3] == 'd' &&
+ name[4] == 'y')
+ { /* study */
+ return KEY_study;
+ }
+
+ goto unknown;
+
+ default:
+ goto unknown;
+ }
default:
goto unknown;
case 'i':
if (name[4] == 'n' &&
- name[5] == 'e' &&
- name[6] == 'd')
- { /* defined */
- return KEY_defined;
- }
+ name[5] == 'e' &&
+ name[6] == 'd')
+ { /* defined */
+ return KEY_defined;
+ }
- goto unknown;
+ goto unknown;
- default:
- goto unknown;
- }
+ default:
+ goto unknown;
+ }
}
goto unknown;
or if it didn't end, or if we see a newline
*/
- if (len >= sizeof PL_tokenbuf)
+ if (len >= (I32)sizeof PL_tokenbuf)
Perl_croak(aTHX_ "Excessively long <> operator");
if (s >= end)
Perl_croak(aTHX_ "Unterminated <> operator");
filehandle
*/
if (*d == '$') {
- I32 tmp;
+ PADOFFSET tmp;
/* try to find it in the pad for this block, otherwise find
add symbol table ops
PL_multi_end = 0;
}
if (PL_in_eval & EVAL_WARNONLY && ckWARN_d(WARN_SYNTAX))
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, msg);
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, (void*)msg);
else
qerror(msg);
if (PL_error_count >= 10) {
if (PL_in_eval && SvCUR(ERRSV))
Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n",
- ERRSV, OutCopFILE(PL_curcop));
+ (void*)ERRSV, OutCopFILE(PL_curcop));
else
Perl_croak(aTHX_ "%s has too many errors.\n",
OutCopFILE(PL_curcop));
const I32 count = FILTER_READ(idx+1, sv, maxlen);
DEBUG_P(PerlIO_printf(Perl_debug_log,
"utf16_textfilter(%p): %d %d (%d)\n",
- utf16_textfilter, idx, maxlen, (int) count));
+ FPTR2DPTR(void *, utf16_textfilter),
+ idx, maxlen, (int) count));
if (count) {
U8* tmps;
I32 newlen;
const I32 count = FILTER_READ(idx+1, sv, maxlen);
DEBUG_P(PerlIO_printf(Perl_debug_log,
"utf16rev_textfilter(%p): %d %d (%d)\n",
- utf16rev_textfilter, idx, maxlen, (int) count));
+ FPTR2DPTR(void *, utf16rev_textfilter),
+ idx, maxlen, (int) count));
if (count) {
U8* tmps;
I32 newlen;
projects / p5sagit/p5-mst-13.2.git / blobdiff