#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) \
/*
* S_ao
*
- * This subroutine detects &&= and ||= and turns an ANDAND or OROR
- * into an OP_ANDASSIGN or OP_ORASSIGN
+ * This subroutine detects &&=, ||=, and //= and turns an ANDAND, OROR or DORDOR
+ * into an OP_ANDASSIGN, OP_ORASSIGN, or OP_DORASSIGN
*/
STATIC int
yylval.ival = OP_ANDASSIGN;
else if (toketype == OROR)
yylval.ival = OP_ORASSIGN;
+ else if (toketype == DORDOR)
+ yylval.ival = OP_DORASSIGN;
toketype = ASSIGNOP;
}
return toketype;
if (SvREADONLY(PL_linestr))
PL_linestr = sv_2mortal(newSVsv(PL_linestr));
s = SvPV(PL_linestr, len);
- if (len && s[len-1] != ';') {
+ if (!len || s[len-1] != ';') {
if (!(SvFLAGS(PL_linestr) & SVs_TEMP))
PL_linestr = sv_2mortal(newSVsv(PL_linestr));
sv_catpvn(PL_linestr, "\n;", 2);
}
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 "";
sv_setpvn(x, ipath, ipathend - ipath);
SvSETMAGIC(x);
}
+ else {
+ STRLEN blen;
+ STRLEN llen;
+ char *bstart = SvPV(CopFILESV(PL_curcop),blen);
+ char *lstart = SvPV(x,llen);
+ if (llen < blen) {
+ bstart += blen - llen;
+ if (strnEQ(bstart, lstart, llen) && bstart[-1] == '/') {
+ sv_setpvn(x, ipath, ipathend - ipath);
+ SvSETMAGIC(x);
+ }
+ }
+ }
TAINT_NOT; /* $^X is always tainted, but that's OK */
}
#endif /* ARG_ZERO_IS_SCRIPT */
switch (tmp) {
case KEY_or:
case KEY_and:
+ case KEY_err:
case KEY_for:
case KEY_unless:
case KEY_if:
break; /* require real whitespace or :'s */
}
tmp = (PL_expect == XOPERATOR ? '=' : '{'); /*'}(' for vi */
- if (*s != ';' && *s != tmp && (tmp != '=' || *s != ')')) {
+ if (*s != ';' && *s != '}' && *s != tmp && (tmp != '=' || *s != ')')) {
char q = ((*s == '\'') ? '"' : '\'');
/* If here for an expression, and parsed no attrs, back off. */
if (tmp == '=' && !attrs) {
PL_expect = XTERM; /* e.g. print $fh 3 */
else if (*s == '.' && isDIGIT(s[1]))
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 (strchr("?-+", *s) && !isSPACE(s[1]) && s[1] != '=')
+ PL_expect = XTERM; /* e.g. print $fh -1 */
+ 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" */
}
PL_pending_ident = '@';
TERM('@');
- case '/': /* may either be division or pattern */
- case '?': /* may either be conditional or pattern */
- if (PL_expect != XOPERATOR) {
- /* Disable warning on "study /blah/" */
- if (PL_oldoldbufptr == PL_last_uni
- && (*PL_last_uni != 's' || s - PL_last_uni < 5
- || memNE(PL_last_uni, "study", 5)
- || isALNUM_lazy_if(PL_last_uni+5,UTF)))
- check_uni();
- s = scan_pat(s,OP_MATCH);
- TERM(sublex_start());
- }
- tmp = *s++;
- if (tmp == '/')
- Mop(OP_DIVIDE);
- OPERATOR(tmp);
+ 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++;
+ if(tmp == '?') {
+ OPERATOR('?');
+ }
+ else {
+ tmp = *s++;
+ if(tmp == '/') {
+ /* A // operator. */
+ AOPERATOR(DORDOR);
+ }
+ else {
+ s--;
+ Mop(OP_DIVIDE);
+ }
+ }
+ }
+ else {
+ /* Disable warning on "study /blah/" */
+ if (PL_oldoldbufptr == PL_last_uni
+ && (*PL_last_uni != 's' || s - PL_last_uni < 5
+ || memNE(PL_last_uni, "study", 5)
+ || isALNUM_lazy_if(PL_last_uni+5,UTF)
+ ))
+ check_uni();
+ s = scan_pat(s,OP_MATCH);
+ TERM(sublex_start());
+ }
case '.':
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack
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) */
case KEY_eof:
UNI(OP_EOF);
+ case KEY_err:
+ OPERATOR(DOROP);
+
case KEY_exp:
UNI(OP_EXP);
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);
break;
case 3:
if (strEQ(d,"eof")) return -KEY_eof;
+ if (strEQ(d,"err")) return -KEY_err;
if (strEQ(d,"exp")) return -KEY_exp;
break;
case 4:
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);
case 'v':
vstring:
sv = NEWSV(92,5); /* preallocate storage space */
- s = new_vstring(s,sv);
+ s = scan_vstring(s,sv);
break;
}
{
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;