* LOOPX : loop exiting command (goto, last, dump, etc)
* FTST : file test operator
* FUN0 : zero-argument function
- * FUN1 : not used
+ * FUN1 : not used, except for not, which isn't a UNIOP
* BOop : bitwise or or xor
* BAop : bitwise and
* SHop : shift operator
char *oldbp = PL_bufptr;
bool is_first = (PL_oldbufptr == PL_linestart);
- assert(s >= oldbp);
- PL_bufptr = s;
+ if (!s)
+ s = oldbp;
+ else {
+ assert(s >= oldbp);
+ PL_bufptr = s;
+ }
yywarn(Perl_form(aTHX_ "%s found where operator expected", what));
if (is_first)
Perl_warn(aTHX_ "\t(Missing semicolon on previous line?)\n");
if it's a legal name, the OP is a PADANY.
*/
if (PL_in_my) {
- if (strchr(PL_tokenbuf,':'))
- yyerror(Perl_form(aTHX_ PL_no_myglob,PL_tokenbuf));
+ if (PL_in_my == KEY_our) { /* "our" is merely analogous to "my" */
+ tmp = pad_allocmy(PL_tokenbuf);
+ }
+ else {
+ if (strchr(PL_tokenbuf,':'))
+ yyerror(Perl_form(aTHX_ PL_no_myglob,PL_tokenbuf));
- yylval.opval = newOP(OP_PADANY, 0);
- yylval.opval->op_targ = pad_allocmy(PL_tokenbuf);
- return PRIVATEREF;
+ yylval.opval = newOP(OP_PADANY, 0);
+ yylval.opval->op_targ = pad_allocmy(PL_tokenbuf);
+ return PRIVATEREF;
+ }
}
/*
}
#endif /* USE_THREADS */
if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
+ /* might be an "our" variable" */
+ if (SvFLAGS(AvARRAY(PL_comppad_name)[tmp]) & SVpad_OUR) {
+ /* build ops for a bareword */
+ yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0));
+ yylval.opval->op_private = OPpCONST_ENTERED;
+ gv_fetchpv(PL_tokenbuf+1,
+ (PL_in_eval
+ ? (GV_ADDMULTI | GV_ADDINEVAL | GV_ADDOUR)
+ : GV_ADDOUR
+ ),
+ ((PL_tokenbuf[0] == '$') ? SVt_PV
+ : (PL_tokenbuf[0] == '@') ? SVt_PVAV
+ : SVt_PVHV));
+ return WORD;
+ }
+
/* if it's a sort block and they're naming $a or $b */
if (PL_last_lop_op == OP_SORT &&
PL_tokenbuf[0] == '$' &&
PL_oldoldbufptr = PL_oldbufptr;
PL_oldbufptr = s;
DEBUG_p( {
- PerlIO_printf(PerlIO_stderr(), "### Tokener expecting %s at %s\n", exp_name[PL_expect], s);
+ PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at %s\n",
+ exp_name[PL_expect], s);
} )
retry:
* Look for options.
*/
d = instr(s,"perl -");
- if (!d)
+ if (!d) {
d = instr(s,"perl");
+#if defined(DOSISH)
+ /* avoid getting into infinite loops when shebang
+ * line contains "Perl" rather than "perl" */
+ if (!d) {
+ for (d = ipathend-4; d >= ipath; --d) {
+ if ((*d == 'p' || *d == 'P')
+ && !ibcmp(d, "perl", 4))
+ {
+ break;
+ }
+ }
+ if (d < ipath)
+ d = Nullch;
+ }
+#endif
+ }
#ifdef ALTERNATE_SHEBANG
/*
* If the ALTERNATE_SHEBANG on this system starts with a
if (PL_oldoldbufptr &&
PL_oldoldbufptr < PL_bufptr &&
- (PL_oldoldbufptr == PL_last_lop || PL_oldoldbufptr == PL_last_uni) &&
+ (PL_oldoldbufptr == PL_last_lop
+ || PL_oldoldbufptr == PL_last_uni) &&
/* NO SKIPSPACE BEFORE HERE! */
(PL_expect == XREF ||
((PL_opargs[PL_last_lop_op] >> OASHIFT)& 7) == OA_FILEREF))
TERM(THING);
case KEY___LINE__:
-#ifdef IV_IS_QUAD
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
- Perl_newSVpvf(aTHX_ "%" PERL_PRId64, (IV)PL_curcop->cop_line));
-#else
- yylval.opval = (OP*)newSVOP(OP_CONST, 0,
- Perl_newSVpvf(aTHX_ "%ld", (long)PL_curcop->cop_line));
-#endif
+ Perl_newSVpvf(aTHX_ "%"IVdf, (IV)PL_curcop->cop_line));
TERM(THING);
case KEY___PACKAGE__:
if ((PL_bufend - p) >= 3 &&
strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
p += 2;
+ else if ((PL_bufend - p) >= 4 &&
+ strnEQ(p, "our", 3) && isSPACE(*(p + 3)))
+ p += 3;
p = skipspace(p);
- if (isIDFIRST_lazy(p))
+ if (isIDFIRST_lazy(p)) {
+ p = scan_ident(p, PL_bufend,
+ PL_tokenbuf, sizeof PL_tokenbuf, TRUE);
+ p = skipspace(p);
+ }
+ if (*p != '$')
Perl_croak(aTHX_ "Missing $ on loop variable");
}
OPERATOR(FOR);
case KEY_msgsnd:
LOP(OP_MSGSND,XTERM);
+ case KEY_our:
case KEY_my:
- PL_in_my = TRUE;
+ PL_in_my = tmp;
s = skipspace(s);
if (isIDFIRST_lazy(s)) {
s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
OPERATOR(USE);
case KEY_not:
- OPERATOR(NOTOP);
+ if (*s == '(' || (s = skipspace(s), *s == '('))
+ FUN1(OP_NOT);
+ else
+ OPERATOR(NOTOP);
case KEY_open:
s = skipspace(s);
case 3:
if (strEQ(d,"ord")) return -KEY_ord;
if (strEQ(d,"oct")) return -KEY_oct;
- if (strEQ(d,"our")) { deprecate("reserved word \"our\"");
- return 0;}
+ if (strEQ(d,"our")) return KEY_our;
break;
case 4:
if (strEQ(d,"open")) return -KEY_open;
if (*w)
for (; *w && isSPACE(*w); w++) ;
if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */
- Perl_warner(aTHX_ WARN_SYNTAX, "%s (...) interpreted as function",name);
+ Perl_warner(aTHX_ WARN_SYNTAX,
+ "%s (...) interpreted as function",name);
}
}
while (s < PL_bufend && isSPACE(*s))
s += 2;
}
/* check for a decimal in disguise */
- else if (strchr(".Ee", s[1]))
+ else if (s[1] == '.' || s[1] == 'e' || s[1] == 'E')
goto decimal;
/* so it must be octal */
else
dTHR;
overflowed = TRUE;
n = (NV) u;
- if (ckWARN_d(WARN_UNSAFE))
- Perl_warner(aTHX_ ((shift == 3) ?
- WARN_OCTAL : WARN_UNSAFE),
+ if (ckWARN_d(WARN_OVERFLOW))
+ Perl_warner(aTHX_ WARN_OVERFLOW,
"Integer overflow in %s number",
base);
} else
sv = NEWSV(92,0);
if (overflowed) {
dTHR;
- if (ckWARN(WARN_UNSAFE) && n > 4294967295.0)
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_PORTABLE) && n > 4294967295.0)
+ Perl_warner(aTHX_ WARN_PORTABLE,
"%s number > %s non-portable",
Base, max);
sv_setnv(sv, n);
}
else {
-#if UV_SIZEOF > 4
+#if UVSIZE > 4
dTHR;
- if (ckWARN(WARN_UNSAFE) && u > 0xffffffff)
- Perl_warner(aTHX_ WARN_UNSAFE,
+ if (ckWARN(WARN_PORTABLE) && u > 0xffffffff)
+ Perl_warner(aTHX_ WARN_PORTABLE,
"%s number > %s non-portable",
Base, max);
#endif
Perl_yywarn(pTHX_ char *s)
{
dTHR;
- --PL_error_count;
PL_in_eval |= EVAL_WARNONLY;
yyerror(s);
PL_in_eval &= ~EVAL_WARNONLY;
where = SvPVX(where_sv);
}
msg = sv_2mortal(newSVpv(s, 0));
-#ifdef IV_IS_QUAD
- Perl_sv_catpvf(aTHX_ msg, " at %_ line %" PERL_PRId64 ", ",
+ Perl_sv_catpvf(aTHX_ msg, " at %_ line %"IVdf", ",
GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line);
-#else
- Perl_sv_catpvf(aTHX_ msg, " at %_ line %ld, ",
- GvSV(PL_curcop->cop_filegv), (long)PL_curcop->cop_line);
-#endif
if (context)
Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
else
Perl_sv_catpvf(aTHX_ msg, "%s\n", where);
if (PL_multi_start < PL_multi_end && (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) {
-#ifdef IV_IS_QUAD
Perl_sv_catpvf(aTHX_ msg,
- " (Might be a runaway multi-line %c%c string starting on line %" PERL_\
-PRId64 ")\n",
+ " (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
(int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start);
-#else
- Perl_sv_catpvf(aTHX_ msg,
- " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
- (int)PL_multi_open,(int)PL_multi_close,(long)PL_multi_start);
-#endif
PL_multi_end = 0;
}
if (PL_in_eval & EVAL_WARNONLY)
Perl_warn(aTHX_ "%_", msg);
- else if (PL_in_eval)
- sv_catsv(ERRSV, msg);
else
- PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
- if (++PL_error_count >= 10)
+ qerror(msg);
+ if (PL_error_count >= 10)
Perl_croak(aTHX_ "%_ has too many errors.\n", GvSV(PL_curcop->cop_filegv));
PL_in_my = 0;
PL_in_my_stash = Nullhv;
projects / p5sagit/p5-mst-13.2.git / blobdiff