static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append));
static void restore_rsfp _((void *f));
-static char too_long[] = "Identifier too long";
+static char ident_too_long[] = "Identifier too long";
static char *linestart; /* beg. of most recently read line */
lex_start(line)
SV *line;
{
+ dTHR;
char *s;
STRLEN len;
incline(s)
char *s;
{
+ dTHR;
char *t;
char *n;
char ch;
skipspace(s)
register char *s;
{
+ dTHR;
if (lex_formbrack && lex_brackets <= lex_formbrack) {
while (s < bufend && (*s == ' ' || *s == '\t'))
s++;
char *s;
#endif /* CAN_PROTOTYPE */
{
+ dTHR;
yylval.ival = f;
CLINE;
expect = x;
int kind;
{
if (s && *s) {
- OP* op = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
- nextval[nexttoke].opval = op;
+ OP* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
+ nextval[nexttoke].opval = o;
force_next(WORD);
if (kind) {
- op->op_private = OPpCONST_ENTERED;
+ dTHR; /* just for in_eval */
+ o->op_private = OPpCONST_ENTERED;
/* XXX see note in pp_entereval() for why we forgo typo
warnings if the symbol must be introduced in an eval.
GSAR 96-10-12 */
static I32
sublex_push()
{
+ dTHR;
push_scope();
lex_state = sublex_info.super_state;
register char *d = SvPVX(sv);
bool dorange = FALSE;
I32 len;
- char *leave =
+ char *leaveit =
lex_inpat
? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]} \t\n\r\f\v#"
: (lex_inwhat & OP_TRANS)
}
if (*s == '\\' && s+1 < send) {
s++;
- if (*s && strchr(leave, *s)) {
+ if (*s && strchr(leaveit, *s)) {
*d++ = '\\';
*d++ = *s++;
continue;
int
yylex()
{
+ dTHR;
register char *s;
register char *d;
register I32 tmp;
return PRIVATEREF;
}
- if (!strchr(tokenbuf,':') && (tmp = pad_findmy(tokenbuf))) {
+ if (!strchr(tokenbuf,':')
+ && (tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
if (last_lop_op == OP_SORT &&
tokenbuf[0] == '$' &&
(tokenbuf[1] == 'a' || tokenbuf[1] == 'b')
case KEY_DESTROY:
case KEY_BEGIN:
case KEY_END:
+ case KEY_INIT:
if (expect == XSTATE) {
s = bufptr;
goto really_sub;
case KEY_listen:
LOP(OP_LISTEN,XTERM);
+ case KEY_lock:
+ UNI(OP_LOCK);
+
case KEY_lstat:
UNI(OP_LSTAT);
case KEY_my:
in_my = TRUE;
+ s = skipspace(s);
+ if (isIDFIRST(*s)) {
+ s = scan_word(s, tokenbuf, sizeof tokenbuf, TRUE, &len);
+ in_my_stash = gv_stashpv(tokenbuf, FALSE);
+ if (!in_my_stash) {
+ char tmpbuf[1024];
+ bufptr = s;
+ sprintf(tmpbuf, "No such class %.1000s", tokenbuf);
+ yyerror(tmpbuf);
+ }
+ }
OPERATOR(MY);
case KEY_next:
case 'h':
if (strEQ(d,"hex")) return -KEY_hex;
break;
+ case 'I':
+ if (strEQ(d,"INIT")) return KEY_INIT;
+ break;
case 'i':
switch (len) {
case 2:
case 4:
if (strEQ(d,"last")) return KEY_last;
if (strEQ(d,"link")) return -KEY_link;
+ if (strEQ(d,"lock")) return -KEY_lock;
break;
case 5:
if (strEQ(d,"local")) return KEY_local;
register char *e = d + destlen - 3; /* two-character token, ending NUL */
for (;;) {
if (d >= e)
- croak(too_long);
+ croak(ident_too_long);
if (isALNUM(*s))
*d++ = *s++;
else if (*s == '\'' && allow_package && isIDFIRST(s[1])) {
if (isDIGIT(*s)) {
while (isDIGIT(*s)) {
if (d >= e)
- croak(too_long);
+ croak(ident_too_long);
*d++ = *s++;
}
}
else {
for (;;) {
if (d >= e)
- croak(too_long);
+ croak(ident_too_long);
if (isALNUM(*s))
*d++ = *s++;
else if (*s == '\'' && isIDFIRST(s[1])) {
*pmfl |= PMf_FOLD;
else if (ch == 'g')
*pmfl |= PMf_GLOBAL;
+ else if (ch == 'c')
+ *pmfl |= PMf_CONTINUE;
else if (ch == 'o')
*pmfl |= PMf_KEEP;
else if (ch == 'm')
pm = (PMOP*)newPMOP(OP_MATCH, 0);
if (multi_open == '?')
pm->op_pmflags |= PMf_ONCE;
- while (*s && strchr("iogmsx", *s))
+ while (*s && strchr("iogcmsx", *s))
pmflag(&pm->op_pmflags,*s++);
pm->op_pmpermflags = pm->op_pmflags;
multi_start = first_start; /* so whole substitution is taken together */
pm = (PMOP*)newPMOP(OP_SUBST, 0);
- while (*s && strchr("iogmsex", *s)) {
+ while (*s && strchr("iogcmsex", *s)) {
if (*s == 'e') {
s++;
es++;
hoistmust(pm)
register PMOP *pm;
{
+ dTHR;
if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
(!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH)
) {
char *start;
{
register char* s;
- OP *op;
+ OP *o;
short *tbl;
I32 squash;
I32 delete;
}
New(803,tbl,256,short);
- op = newPVOP(OP_TRANS, 0, (char*)tbl);
+ o = newPVOP(OP_TRANS, 0, (char*)tbl);
complement = delete = squash = 0;
while (*s == 'c' || *s == 'd' || *s == 's') {
squash = OPpTRANS_SQUASH;
s++;
}
- op->op_private = delete|squash|complement;
+ o->op_private = delete|squash|complement;
- lex_op = op;
+ lex_op = o;
yylval.ival = OP_TRANS;
return s;
}
scan_heredoc(s)
register char *s;
{
+ dTHR;
SV *herewas;
I32 op_type = OP_SCALAR;
I32 len;
SV *tmpstr;
char term;
register char *d;
+ register char *e;
char *peek;
int outer = (rsfp && !lex_inwhat);
s += 2;
d = tokenbuf;
+ e = tokenbuf + sizeof tokenbuf - 1;
if (!outer)
*d++ = '\n';
for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
if (*peek && strchr("`'\"",*peek)) {
s = peek;
term = *s++;
- s = cpytill(d,s,bufend,term,&len);
+ s = delimcpy(d, e, s, bufend, term, &len);
+ d += len;
if (s < bufend)
s++;
- d += len;
}
else {
if (*s == '\\')
term = '"';
if (!isALNUM(*s))
deprecate("bare << to mean <<\"\"");
- while (isALNUM(*s))
- *d++ = *s++;
- } /* assuming tokenbuf won't clobber */
+ for (; isALNUM(*s); s++) {
+ if (d < e)
+ *d++ = *s;
+ }
+ }
+ if (d >= tokenbuf + sizeof tokenbuf - 1)
+ croak("Delimiter for here document is too long");
*d++ = '\n';
*d = '\0';
len = d - tokenbuf;
{
register char *s = start;
register char *d;
+ register char *e;
I32 len;
d = tokenbuf;
- s = cpytill(d, s+1, bufend, '>', &len);
- if (s < bufend)
- s++;
- else
+ e = tokenbuf + sizeof tokenbuf;
+ s = delimcpy(d, e, s + 1, bufend, '>', &len);
+ if (len >= sizeof tokenbuf)
+ croak("Excessively long <> operator");
+ if (s >= bufend)
croak("Unterminated <> operator");
-
+ s++;
if (*d == '$' && d[1]) d++;
while (*d && (isALNUM(*d) || *d == '\'' || *d == ':'))
d++;
(void)strcpy(d,"ARGV");
if (*d == '$') {
I32 tmp;
- if (tmp = pad_findmy(d)) {
- OP *op = newOP(OP_PADSV, 0);
- op->op_targ = tmp;
- lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, op));
+ if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
+ OP *o = newOP(OP_PADSV, 0);
+ o->op_targ = tmp;
+ lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, o));
}
else {
GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
scan_str(start)
char *start;
{
+ dTHR;
SV *sv;
char *tmps;
register char *s = start;
{
register char *s = start;
register char *d;
+ register char *e;
I32 tryiv;
double value;
SV *sv;
I32 floatit;
char *lastub = 0;
+ static char number_too_long[] = "Number too long";
switch (*s) {
default:
case '6': case '7': case '8': case '9': case '.':
decimal:
d = tokenbuf;
+ e = tokenbuf + sizeof tokenbuf - 6; /* room for various punctuation */
floatit = FALSE;
while (isDIGIT(*s) || *s == '_') {
if (*s == '_') {
warn("Misplaced _ in number");
lastub = ++s;
}
- else
+ else {
+ if (d >= e)
+ croak(number_too_long);
*d++ = *s++;
+ }
}
if (dowarn && lastub && s - lastub != 3)
warn("Misplaced _ in number");
if (*s == '.' && s[1] != '.') {
floatit = TRUE;
*d++ = *s++;
- while (isDIGIT(*s) || *s == '_') {
- if (*s == '_')
- s++;
- else
- *d++ = *s++;
+ for (; isDIGIT(*s) || *s == '_'; s++) {
+ if (d >= e)
+ croak(number_too_long);
+ if (*s != '_')
+ *d++ = *s;
}
}
if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
*d++ = 'e'; /* At least some Mach atof()s don't grok 'E' */
if (*s == '+' || *s == '-')
*d++ = *s++;
- while (isDIGIT(*s))
+ while (isDIGIT(*s)) {
+ if (d >= e)
+ croak(number_too_long);
*d++ = *s++;
+ }
}
*d = '\0';
sv = NEWSV(92,0);
scan_formline(s)
register char *s;
{
+ dTHR;
register char *eol;
register char *t;
SV *stuff = newSVpv("",0);
I32 is_format;
U32 flags;
{
+ dTHR;
I32 oldsavestack_ix = savestack_ix;
CV* outsidecv = compcv;
AV* comppadlist;
CvFLAGS(compcv) |= flags;
comppad = newAV();
+ av_push(comppad, Nullsv);
+ curpad = AvARRAY(comppad);
comppad_name = newAV();
comppad_name_fill = 0;
min_intro_pending = 0;
- av_push(comppad, Nullsv);
- curpad = AvARRAY(comppad);
padix = 0;
subline = curcop->cop_line;
+#ifdef USE_THREADS
+ av_store(comppad_name, 0, newSVpv("@_", 2));
+ curpad[0] = (SV*)newAV();
+ SvPADMY_on(curpad[0]); /* XXX Needed? */
+ CvOWNER(compcv) = 0;
+ New(666, CvMUTEXP(compcv), 1, perl_mutex);
+ MUTEX_INIT(CvMUTEXP(compcv));
+ New(666, CvCONDP(compcv), 1, perl_cond);
+ COND_INIT(CvCONDP(compcv));
+#endif /* USE_THREADS */
comppadlist = newAV();
AvREAL_off(comppadlist);
CvPADLIST(compcv) = comppadlist;
CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv);
+#ifdef USE_THREADS
+ CvOWNER(compcv) = 0;
+ New(666, CvMUTEXP(compcv), 1, perl_mutex);
+ MUTEX_INIT(CvMUTEXP(compcv));
+ New(666, CvCONDP(compcv), 1, perl_cond);
+ COND_INIT(CvCONDP(compcv));
+#endif /* USE_THREADS */
return oldsavestack_ix;
}
yywarn(s)
char *s;
{
+ dTHR;
--error_count;
in_eval |= 2;
yyerror(s);
yyerror(s)
char *s;
{
+ dTHR;
char *where = NULL;
char *context = NULL;
int contlen = -1;
where = SvPVX(where_sv);
}
msg = sv_2mortal(newSVpv(s, 0));
- sv_catpvf(msg, " at %S line %ld, ",
+ sv_catpvf(msg, " at %_ line %ld, ",
GvSV(curcop->cop_filegv), (long)curcop->cop_line);
if (context)
sv_catpvf(msg, "near \"%.*s\"\n", contlen, context);
multi_end = 0;
}
if (in_eval & 2)
- warn("%S", msg);
+ warn("%_", msg);
else if (in_eval)
sv_catsv(GvSV(errgv), msg);
else
PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
if (++error_count >= 10)
- croak("%S has too many errors.\n", GvSV(curcop->cop_filegv));
+ croak("%_ has too many errors.\n", GvSV(curcop->cop_filegv));
in_my = 0;
+ in_my_stash = Nullhv;
return 0;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff