#define PREREF(retval) return (REPORT2("preref",retval) PL_expect = XREF,PL_bufptr = s,(int)retval)
#define TERM(retval) return (CLINE, REPORT2("term",retval) PL_expect = XOPERATOR, PL_bufptr = s,(int)retval)
#define LOOPX(f) return(yylval.ival=f, REPORT("loopx",f) PL_expect = XTERM,PL_bufptr = s,(int)LOOPEX)
-#define FTST(f) return(yylval.ival=f, REPORT("ftst",f) PL_expect = XTERM,PL_bufptr = s,(int)UNIOP)
+#define FTST(f) return(yylval.ival=f, REPORT("ftst",f) PL_expect = XTERMORDORDOR,PL_bufptr = s,(int)UNIOP)
#define FUN0(f) return(yylval.ival = f, REPORT("fun0",f) PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC0)
#define FUN1(f) return(yylval.ival = f, REPORT("fun1",f) PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC1)
#define BOop(f) return ao((yylval.ival=f, REPORT("bitorop",f) PL_expect = XTERM,PL_bufptr = s,(int)BITOROP))
/* This bit of chicanery makes a unary function followed by
* a parenthesis into a function with one argument, highest precedence.
+ * The UNIDOR macro is for unary functions that can be followed by the //
+ * operator (such as C<shift // 0>).
*/
-#define UNI(f) return(yylval.ival = f, \
+#define UNI2(f,x) return(yylval.ival = f, \
REPORT("uni",f) \
- PL_expect = XTERM, \
+ PL_expect = x, \
PL_bufptr = s, \
PL_last_uni = PL_oldbufptr, \
PL_last_lop_op = f, \
(*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
+#define UNI(f) UNI2(f,XTERM)
+#define UNIDOR(f) UNI2(f,XTERMORDORDOR)
#define UNIBRACK(f) return(yylval.ival = f, \
REPORT("uni",f) \
}
yylval.opval = (OP*)newSVOP(op_type, 0, sv);
PL_lex_stuff = Nullsv;
+ /* Allow <FH> // "foo" */
+ if (op_type == OP_READLINE)
+ PL_expect = XTERMORDORDOR;
return THING;
}
if (min > max) {
Perl_croak(aTHX_
- "Invalid [] range \"%c-%c\" in transliteration operator",
+ "Invalid range \"%c-%c\" in transliteration operator",
(char)min, (char)max);
}
if (pdb)
return pdb;
- SETERRNO(0,SS$_NORMAL);
+ SETERRNO(0,SS_NORMAL);
return "BEGIN { require 'perl5db.pl' }";
}
return "";
PL_expect = XTERM; /* e.g. print $fh .3 */
else if (strchr("?-+", *s) && !isSPACE(s[1]) && s[1] != '=')
PL_expect = XTERM; /* e.g. print $fh -1 */
- else if (*s == '/') {
- if(s[1] == '/') {
- PL_expect=XOPERATOR;
- }
- else {
- PL_expect=XTERM;
- }
- }
+ else if (*s == '/' && !isSPACE(s[1]) && s[1] != '=' && s[1] != '/')
+ PL_expect = XTERM; /* e.g. print $fh /.../
+ XXX except DORDOR operator */
else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]) && s[2] != '=')
PL_expect = XTERM; /* print $fh <<"EOF" */
}
TERM('@');
case '/': /* may be division, defined-or, or pattern */
+ if (PL_expect == XTERMORDORDOR && s[1] == '/') {
+ s += 2;
+ AOPERATOR(DORDOR);
+ }
case '?': /* may either be conditional or pattern */
if(PL_expect == XOPERATOR) {
tmp = *s++;
TERM(THING);
}
/* avoid v123abc() or $h{v1}, allow C<print v10;> */
- else if (!isALPHA(*start) && (PL_expect == XTERM || PL_expect == XREF || PL_expect == XSTATE)) {
+ else if (!isALPHA(*start) && (PL_expect == XTERM
+ || PL_expect == XREF || PL_expect == XSTATE
+ || PL_expect == XTERMORDORDOR)) {
char c = *start;
GV *gv;
*start = '\0';
case 'z': case 'Z':
keylookup: {
+ I32 orig_keyword = 0;
gv = Nullgv;
gvp = 0;
}
}
if (ogv) {
+ orig_keyword = tmp;
tmp = 0; /* overridden by import or by GLOBAL */
}
else if (gv && !gvp
/* If followed by a bareword, see if it looks like indir obj. */
- if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') && (tmp = intuit_method(s,gv)))
+ if (!orig_keyword
+ && (isIDFIRST_lazy_if(s,UTF) || *s == '$')
+ && (tmp = intuit_method(s,gv)))
return tmp;
/* Not a method, so call it a subroutine (if defined) */
UNI(OP_GMTIME);
case KEY_getc:
- UNI(OP_GETC);
+ UNIDOR(OP_GETC);
case KEY_getppid:
FUN0(OP_GETPPID);
LOP(OP_PUSH,XTERM);
case KEY_pop:
- UNI(OP_POP);
+ UNIDOR(OP_POP);
case KEY_pos:
- UNI(OP_POS);
+ UNIDOR(OP_POS);
case KEY_pack:
LOP(OP_PACK,XTERM);
case KEY_readline:
set_csh();
- UNI(OP_READLINE);
+ UNIDOR(OP_READLINE);
case KEY_readpipe:
set_csh();
LOP(OP_REVERSE,XTERM);
case KEY_readlink:
- UNI(OP_READLINK);
+ UNIDOR(OP_READLINK);
case KEY_ref:
UNI(OP_REF);
LOP(OP_SSOCKOPT,XTERM);
case KEY_shift:
- UNI(OP_SHIFT);
+ UNIDOR(OP_SHIFT);
case KEY_shmctl:
LOP(OP_SHMCTL,XTERM);
LOP(OP_UNLINK,XTERM);
case KEY_undef:
- UNI(OP_UNDEF);
+ UNIDOR(OP_UNDEF);
case KEY_unpack:
LOP(OP_UNPACK,XTERM);
LOP(OP_UTIME,XTERM);
case KEY_umask:
- UNI(OP_UMASK);
+ UNIDOR(OP_UMASK);
case KEY_unshift:
LOP(OP_UNSHIFT,XTERM);
yyerror(Perl_form(aTHX_ "No package name allowed for "
"variable %s in \"our\"",
PL_tokenbuf));
- tmp = pad_allocmy(PL_tokenbuf);
+ tmp = 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);
+ yylval.opval->op_targ = allocmy(PL_tokenbuf);
return PRIVATEREF;
}
}
}
#endif /* USE_5005THREADS */
if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
- SV *namesv = AvARRAY(PL_comppad_name)[tmp];
/* might be an "our" variable" */
- if (SvFLAGS(namesv) & SVpad_OUR) {
+ if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
/* build ops for a bareword */
- SV *sym = newSVpv(HvNAME(GvSTASH(namesv)),0);
+ SV *sym = newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)), 0);
sv_catpvn(sym, "::", 2);
sv_catpv(sym, PL_tokenbuf+1);
yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
add symbol table ops
*/
if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
- SV *namesv = AvARRAY(PL_comppad_name)[tmp];
- if (SvFLAGS(namesv) & SVpad_OUR) {
- SV *sym = sv_2mortal(newSVpv(HvNAME(GvSTASH(namesv)),0));
+ if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
+ SV *sym = sv_2mortal(
+ newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)),0));
sv_catpvn(sym, "::", 2);
sv_catpv(sym, d+1);
d = SvPVX(sym);
{
I32 oldsavestack_ix = PL_savestack_ix;
CV* outsidecv = PL_compcv;
- AV* comppadlist;
if (PL_compcv) {
assert(SvTYPE(PL_compcv) == SVt_PVCV);
}
SAVEI32(PL_subline);
save_item(PL_subname);
- SAVEI32(PL_padix);
- SAVECOMPPAD();
- SAVESPTR(PL_comppad_name);
SAVESPTR(PL_compcv);
- SAVEI32(PL_comppad_name_fill);
- SAVEI32(PL_min_intro_pending);
- SAVEI32(PL_max_intro_pending);
- SAVEI32(PL_pad_reset_pending);
PL_compcv = (CV*)NEWSV(1104,0);
sv_upgrade((SV *)PL_compcv, is_format ? SVt_PVFM : SVt_PVCV);
CvFLAGS(PL_compcv) |= flags;
- PL_comppad = newAV();
- av_push(PL_comppad, Nullsv);
- PL_curpad = AvARRAY(PL_comppad);
- PL_comppad_name = newAV();
- PL_comppad_name_fill = 0;
- PL_min_intro_pending = 0;
- PL_padix = 0;
PL_subline = CopLINE(PL_curcop);
-#ifdef USE_5005THREADS
- av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
- PL_curpad[0] = (SV*)newAV();
- SvPADMY_on(PL_curpad[0]); /* XXX Needed? */
-#endif /* USE_5005THREADS */
-
- comppadlist = newAV();
- AvREAL_off(comppadlist);
- av_store(comppadlist, 0, (SV*)PL_comppad_name);
- av_store(comppadlist, 1, (SV*)PL_comppad);
-
- CvPADLIST(PL_compcv) = comppadlist;
+ CvPADLIST(PL_compcv) = pad_new(padnew_SAVE|padnew_SAVESUB);
CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv);
#ifdef USE_5005THREADS
CvOWNER(PL_compcv) = 0;