#define LOP(f,x) return lop(f,x,s)
static I32
-lop(f,x,s)
+lop
+#ifdef CAN_PROTOTYPE
+ (I32 f, expectation x, char *s)
+#else
+ (f,x,s)
I32 f;
expectation x;
char *s;
+#endif /* CAN_PROTOTYPE */
{
yylval.ival = f;
CLINE;
die("Can't upgrade filter_add data to SVt_PVIO");
IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
if (filter_debug)
- warn("filter_add func %lx (%s)", funcp, SvPV(datasv,na));
+ warn("filter_add func %p (%s)", funcp, SvPV(datasv,na));
av_unshift(rsfp_filters, 1);
av_store(rsfp_filters, 0, datasv) ;
return(datasv);
filter_t funcp;
{
if (filter_debug)
- warn("filter_del func %lx", funcp);
+ warn("filter_del func %p", funcp);
if (!rsfp_filters || AvFILL(rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
/* Get function pointer hidden within datasv */
funcp = (filter_t)IoDIRP(datasv);
if (filter_debug)
- warn("filter_read %d: via function %lx (%s)\n",
+ warn("filter_read %d: via function %p (%s)\n",
idx, funcp, SvPV(datasv,na));
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
#endif /* ALTERNATE_SHEBANG */
}
if (d) {
- /*
- * HP-UX (at least) sets argv[0] to the script name,
- * which makes $^X incorrect. And Digital UNIX and Linux,
- * at least, set argv[0] to the basename of the Perl
- * interpreter. So, having found "#!", we'll set it right.
- */
- SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
char *ipath;
- char *ibase;
+ char *ipathend;
- while (*d == ' ' || *d == '\t')
+ while (isSPACE(*d))
d++;
ipath = d;
- ibase = Nullch;
- while (*d && !isSPACE(*d)) {
- if (*d++ == '/')
- ibase = d;
+ while (*d && !isSPACE(*d))
+ d++;
+ ipathend = d;
+
+#ifdef ARG_ZERO_IS_SCRIPT
+ if (ipathend > ipath) {
+ /*
+ * HP-UX (at least) sets argv[0] to the script name,
+ * which makes $^X incorrect. And Digital UNIX and Linux,
+ * at least, set argv[0] to the basename of the Perl
+ * interpreter. So, having found "#!", we'll set it right.
+ */
+ SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
+ assert(SvPOK(x) || SvGMAGICAL(x));
+ if (sv_eq(x, GvSV(curcop->cop_filegv)))
+ sv_setpvn(x, ipath, ipathend - ipath);
+ TAINT_NOT; /* $^X is always tainted, but that's OK */
}
- assert(SvPOK(x) || SvGMAGICAL(x));
- if (sv_eq(x, GvSV(curcop->cop_filegv))
- || (ibase
- && SvCUR(x) == (d - ibase)
- && strnEQ(SvPVX(x), ibase, d - ibase)))
- sv_setpvn(x, ipath, d - ipath);
- /*
- * $^X is always tainted, but taintedness must be off
- * when parsing code, so forget we ever saw it.
- */
- TAINT_NOT;
+#endif /* ARG_ZERO_IS_SCRIPT */
/*
* Look for options.
* other interpreter. Similarly, if "perl" is there, but
* not in the first 'word' of the line, we assume the line
* contains the start of the Perl program.
- * This isn't foolproof, but it's generally a good guess.
*/
if (d && *s != '#') {
- char *c = s;
+ char *c = ipath;
while (*c && !strchr("; \t\r\n\f\v#", *c))
c++;
if (c < d)
else
*s = '#'; /* Don't try to parse shebang line */
}
-#endif
+#endif /* ALTERNATE_SHEBANG */
if (!d &&
*s == '#' &&
+ ipathend > ipath &&
!minus_c &&
!instr(s,"indir") &&
instr(origargv[0],"perl"))
{
char **newargv;
- char *cmd;
- s += 2;
- if (*s == ' ')
- s++;
- cmd = s;
- while (s < bufend && !isSPACE(*s))
- s++;
- *s++ = '\0';
+ *ipathend = '\0';
+ s = ipathend + 1;
while (s < bufend && isSPACE(*s))
s++;
if (s < bufend) {
}
else
newargv = origargv;
- newargv[0] = cmd;
- execv(cmd,newargv);
- croak("Can't exec %s", cmd);
+ newargv[0] = ipath;
+ execv(ipath, newargv);
+ croak("Can't exec %s", ipath);
}
if (d) {
int oldpdb = perldb;
return yylex();
}
goto retry;
- case ' ': case '\t': case '\f': case '\r': case 013:
+ case '\r':
+ croak("Illegal character \\%03o (carriage return)", '\r');
+ case ' ': case '\t': case '\f': case 013:
s++;
goto retry;
case '#':
if (strnEQ(s,"=>",2)) {
if (dowarn)
warn("Ambiguous use of -%c => resolved to \"-%c\" =>",
- tmp, tmp);
+ (int)tmp, (int)tmp);
s = force_word(bufptr,WORD,FALSE,FALSE,FALSE);
OPERATOR('-'); /* unary minus */
}
case 'A': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTATIME);
case 'C': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTCTIME);
default:
- croak("Unrecognized file test: -%c", tmp);
+ croak("Unrecognized file test: -%c", (int)tmp);
break;
}
}
if (tmp == '~')
PMop(OP_MATCH);
if (dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
- warn("Reversed %c= operator",tmp);
+ warn("Reversed %c= operator",(int)tmp);
s--;
if (expect == XSTATE && isALPHA(tmp) &&
(s == linestart+1 || s[-2] == '\n') )
return s;
}
if (*s == '$' && s[1] &&
- (isALPHA(s[1]) || strchr("$_{", s[1]) || strnEQ(s+1,"::",2)) )
+ (isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
return s;
if (*s == '{') {
bracket = s;
{
register char *s;
register PMOP *pm;
+ I32 first_start;
I32 es = 0;
yylval.ival = OP_NULL;
if (s[-1] == multi_open)
s--;
+ first_start = multi_start;
s = scan_str(s);
if (!s) {
if (lex_stuff)
lex_repl = Nullsv;
croak("Substitution replacement not terminated");
}
+ multi_start = first_start; /* so whole substitution is taken together */
pm = (PMOP*)newPMOP(OP_SUBST, 0);
while (*s && strchr("iogmsex", *s)) {
return;
}
}
- if (!pm->op_pmshort || /* promote the better string */
- ((pm->op_pmflags & PMf_SCANFIRST) &&
- (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)) )){
+ /* promote the better string */
+ if ((!pm->op_pmshort && !(pm->op_pmregexp->reganch & ROPT_ANCH)) ||
+ ((pm->op_pmflags & PMf_SCANFIRST) &&
+ (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)))) {
SvREFCNT_dec(pm->op_pmshort); /* ok if null */
pm->op_pmshort = pm->op_pmregexp->regmust;
pm->op_pmslen = SvCUR(pm->op_pmshort);
}
int
-start_subparse(flags)
+start_subparse(is_format, flags)
+I32 is_format;
U32 flags;
{
int oldsavestack_ix = savestack_ix;
SAVEI32(pad_reset_pending);
compcv = (CV*)NEWSV(1104,0);
- sv_upgrade((SV *)compcv, (flags & CVf_FORMAT) ? SVt_PVFM : SVt_PVCV);
+ sv_upgrade((SV *)compcv, is_format ? SVt_PVFM : SVt_PVCV);
CvFLAGS(compcv) |= flags;
comppad = newAV();
(void)sprintf(tname,"next char %c",yychar);
(void)sprintf(buf, "%s at %s line %d, %s\n",
s,SvPVX(GvSV(curcop->cop_filegv)),curcop->cop_line,tname);
- if (curcop->cop_line == multi_end && multi_start < multi_end) {
+ if (multi_start < multi_end && (U32)(curcop->cop_line - multi_end) <= 1) {
sprintf(buf+strlen(buf),
- " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
- multi_open,multi_close,(long)multi_start);
+ " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
+ (int)multi_open,(int)multi_close,(long)multi_start);
multi_end = 0;
}
if (in_eval & 2)
projects / p5sagit/p5-mst-13.2.git / blobdiff