This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
end pod processing when source file is closed (prevents it carrying
[perl5.git] / toke.c
CommitLineData
a0d0e21e 1/* toke.c
a687059c 2 *
9607fc9c 3 * Copyright (c) 1991-1997, Larry Wall
a687059c 4 *
d48672a2
LW		 5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
378cc40b 7 *
a0d0e21e
LW		 8 */
9
10/*
11 * "It all comes from here, the stench and the peril." --Frodo
378cc40b
LW		 12 */
13
14#include "EXTERN.h"
15#include "perl.h"
378cc40b 16
76e3520e 17#ifndef PERL_OBJECT
a0d0e21e
LW		 18static void check_uni _((void));
19static void force_next _((I32 type));
89bfa8cd 20static char *force_version _((char *start));
a0d0e21e 21static char *force_word _((char *start, int token, int check_keyword, int allow_pack, int allow_tick));
76e3520e 22static SV *tokeq _((SV *sv));
a0d0e21e
LW		 23static char *scan_const _((char *start));
24static char *scan_formline _((char *s));
25static char *scan_heredoc _((char *s));
8903cb82 26static char *scan_ident _((char *s, char *send, char *dest, STRLEN destlen,
27 I32 ck_uni));
a0d0e21e 28static char *scan_inputsymbol _((char *start));
8782bef2 29static char *scan_pat _((char *start, I32 type));
a0d0e21e
LW		 30static char *scan_str _((char *start));
31static char *scan_subst _((char *start));
32static char *scan_trans _((char *start));
8903cb82 33static char *scan_word _((char *s, char *dest, STRLEN destlen,
34 int allow_package, STRLEN *slp));
a0d0e21e
LW		 35static char *skipspace _((char *s));
36static void checkcomma _((char *s, char *name, char *what));
37static void force_ident _((char *s, int kind));
38static void incline _((char *s));
39static int intuit_method _((char *s, GV *gv));
40static int intuit_more _((char *s));
41static I32 lop _((I32 f, expectation x, char *s));
42static void missingterm _((char *s));
43static void no_op _((char *what, char *s));
44static void set_csh _((void));
45static I32 sublex_done _((void));
55497cff 46static I32 sublex_push _((void));
a0d0e21e
LW		 47static I32 sublex_start _((void));
48#ifdef CRIPPLED_CC
49static int uni _((I32 f, char *s));
50#endif
fd049845 51static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append));
6d5fb7e3 52static void restore_rsfp _((void *f));
b3ac6de7 53static SV *new_constant _((char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type));
49d8d3a1
MB		 54static void restore_expect _((void *e));
55static void restore_lex_expect _((void *e));
76e3520e 56#endif /* PERL_OBJECT */
2f3197b3 57
fc36a67e 58static char ident_too_long[] = "Identifier too long";
8903cb82 59
79072805
LW		 60/* The following are arranged oddly so that the guard on the switch statement
61 * can get by with a single comparison (if the compiler is smart enough).
62 */
63
fb73857a 64/* #define LEX_NOTPARSING 11 is done in perl.h. */
65
55497cff 66#define LEX_NORMAL 10
67#define LEX_INTERPNORMAL 9
68#define LEX_INTERPCASEMOD 8
69#define LEX_INTERPPUSH 7
70#define LEX_INTERPSTART 6
71#define LEX_INTERPEND 5
72#define LEX_INTERPENDMAYBE 4
73#define LEX_INTERPCONCAT 3
74#define LEX_INTERPCONST 2
75#define LEX_FORMLINE 1
76#define LEX_KNOWNEXT 0
79072805 77
395c3793
LW		 78#ifdef I_FCNTL
79#include <fcntl.h>
80#endif
fe14fcc3
LW		 81#ifdef I_SYS_FILE
82#include <sys/file.h>
83#endif
395c3793 84
a790bc05 85/* XXX If this causes problems, set i_unistd=undef in the hint file. */
86#ifdef I_UNISTD
87# include <unistd.h> /* Needed for execv() */
88#endif
89
90
79072805
LW		 91#ifdef ff_next
92#undef ff_next
d48672a2
LW		 93#endif
94
79072805 95#include "keywords.h"
fe14fcc3 96
ae986130
LW		 97#ifdef CLINE
98#undef CLINE
99#endif
3280af22
NIS		 100#define CLINE (PL_copline = (PL_curcop->cop_line < PL_copline ? PL_curcop->cop_line : PL_copline))
101
102#define TOKEN(retval) return (PL_bufptr = s,(int)retval)
103#define OPERATOR(retval) return (PL_expect = XTERM,PL_bufptr = s,(int)retval)
104#define AOPERATOR(retval) return ao((PL_expect = XTERM,PL_bufptr = s,(int)retval))
105#define PREBLOCK(retval) return (PL_expect = XBLOCK,PL_bufptr = s,(int)retval)
106#define PRETERMBLOCK(retval) return (PL_expect = XTERMBLOCK,PL_bufptr = s,(int)retval)
107#define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s,(int)retval)
108#define TERM(retval) return (CLINE, PL_expect = XOPERATOR,PL_bufptr = s,(int)retval)
109#define LOOPX(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LOOPEX)
110#define FTST(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)UNIOP)
111#define FUN0(f) return(yylval.ival = f,PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC0)
112#define FUN1(f) return(yylval.ival = f,PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC1)
113#define BOop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)BITOROP))
114#define BAop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)BITANDOP))
115#define SHop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)SHIFTOP))
116#define PWop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)POWOP))
117#define PMop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)MATCHOP)
118#define Aop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)ADDOP))
119#define Mop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)MULOP))
120#define Eop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)EQOP)
121#define Rop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)RELOP)
2f3197b3 122
a687059c
LW		 123/* This bit of chicanery makes a unary function followed by
124 * a parenthesis into a function with one argument, highest precedence.
125 */
2f3197b3 126#define UNI(f) return(yylval.ival = f, \
3280af22
NIS		 127 PL_expect = XTERM, \
128 PL_bufptr = s, \
129 PL_last_uni = PL_oldbufptr, \
130 PL_last_lop_op = f, \
a687059c
LW		 131 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
132
79072805 133#define UNIBRACK(f) return(yylval.ival = f, \
3280af22
NIS		 134 PL_bufptr = s, \
135 PL_last_uni = PL_oldbufptr, \
79072805
LW		 136 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
137
9f68db38 138/* grandfather return to old style */
3280af22 139#define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
79072805 140
76e3520e 141STATIC int
8ac85365 142ao(int toketype)
a0d0e21e 143{
3280af22
NIS		 144 if (*PL_bufptr == '=') {
145 PL_bufptr++;
a0d0e21e
LW		 146 if (toketype == ANDAND)
147 yylval.ival = OP_ANDASSIGN;
148 else if (toketype == OROR)
149 yylval.ival = OP_ORASSIGN;
150 toketype = ASSIGNOP;
151 }
152 return toketype;
153}
154
76e3520e 155STATIC void
8ac85365 156no_op(char *what, char *s)
463ee0b2 157{
3280af22
NIS		 158 char *oldbp = PL_bufptr;
159 bool is_first = (PL_oldbufptr == PL_linestart);
68dc0745 160
3280af22 161 PL_bufptr = s;
46fc3d4c 162 yywarn(form("%s found where operator expected", what));
748a9306 163 if (is_first)
a0d0e21e 164 warn("\t(Missing semicolon on previous line?)\n");
3280af22 165 else if (PL_oldoldbufptr && isIDFIRST(*PL_oldoldbufptr)) {
748a9306 166 char *t;
3280af22
NIS		 167 for (t = PL_oldoldbufptr; *t && (isALNUM(*t) || *t == ':'); t++) ;
168 if (t < PL_bufptr && isSPACE(*t))
748a9306 169 warn("\t(Do you need to predeclare %.*s?)\n",
3280af22 170 t - PL_oldoldbufptr, PL_oldoldbufptr);
748a9306
LW		 171
172 }
173 else
174 warn("\t(Missing operator before %.*s?)\n", s - oldbp, oldbp);
3280af22 175 PL_bufptr = oldbp;
8990e307
LW		 176}
177
76e3520e 178STATIC void
8ac85365 179missingterm(char *s)
8990e307
LW		 180{
181 char tmpbuf[3];
182 char q;
183 if (s) {
184 char *nl = strrchr(s,'\n');
d2719217 185 if (nl)
8990e307
LW		 186 *nl = '\0';
187 }
9d116dd7
JH		 188 else if (
189#ifdef EBCDIC
190 iscntrl(PL_multi_close)
191#else
192 PL_multi_close < 32 || PL_multi_close == 127
193#endif
194 ) {
8990e307 195 *tmpbuf = '^';
3280af22 196 tmpbuf[1] = toCTRL(PL_multi_close);
8990e307
LW		 197 s = "\\n";
198 tmpbuf[2] = '\0';
199 s = tmpbuf;
200 }
201 else {
3280af22 202 *tmpbuf = PL_multi_close;
8990e307
LW		 203 tmpbuf[1] = '\0';
204 s = tmpbuf;
205 }
206 q = strchr(s,'"') ? '\'' : '"';
207 croak("Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
463ee0b2 208}
79072805
LW		 209
210void
8ac85365 211deprecate(char *s)
a0d0e21e 212{
3280af22 213 if (PL_dowarn)
a0d0e21e
LW		 214 warn("Use of %s is deprecated", s);
215}
216
76e3520e 217STATIC void
8ac85365 218depcom(void)
a0d0e21e
LW		 219{
220 deprecate("comma-less variable list");
221}
222
a868473f
NIS		 223#ifdef WIN32
224
76e3520e 225STATIC I32
a868473f
NIS		 226win32_textfilter(int idx, SV *sv, int maxlen)
227{
228 I32 count = FILTER_READ(idx+1, sv, maxlen);
229 if (count > 0 && !maxlen)
230 win32_strip_return(sv);
231 return count;
232}
233#endif
234
235
a0d0e21e 236void
8ac85365 237lex_start(SV *line)
79072805 238{
0f15f207 239 dTHR;
8990e307
LW		 240 char *s;
241 STRLEN len;
242
3280af22
NIS		 243 SAVEI32(PL_lex_dojoin);
244 SAVEI32(PL_lex_brackets);
245 SAVEI32(PL_lex_fakebrack);
246 SAVEI32(PL_lex_casemods);
247 SAVEI32(PL_lex_starts);
248 SAVEI32(PL_lex_state);
249 SAVESPTR(PL_lex_inpat);
250 SAVEI32(PL_lex_inwhat);
251 SAVEI16(PL_curcop->cop_line);
252 SAVEPPTR(PL_bufptr);
253 SAVEPPTR(PL_bufend);
254 SAVEPPTR(PL_oldbufptr);
255 SAVEPPTR(PL_oldoldbufptr);
256 SAVEPPTR(PL_linestart);
257 SAVESPTR(PL_linestr);
258 SAVEPPTR(PL_lex_brackstack);
259 SAVEPPTR(PL_lex_casestack);
260 SAVEDESTRUCTOR(restore_rsfp, PL_rsfp);
261 SAVESPTR(PL_lex_stuff);
262 SAVEI32(PL_lex_defer);
263 SAVESPTR(PL_lex_repl);
264 SAVEDESTRUCTOR(restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */
265 SAVEDESTRUCTOR(restore_lex_expect, PL_tokenbuf + PL_expect);
266
267 PL_lex_state = LEX_NORMAL;
268 PL_lex_defer = 0;
269 PL_expect = XSTATE;
270 PL_lex_brackets = 0;
271 PL_lex_fakebrack = 0;
272 New(899, PL_lex_brackstack, 120, char);
273 New(899, PL_lex_casestack, 12, char);
274 SAVEFREEPV(PL_lex_brackstack);
275 SAVEFREEPV(PL_lex_casestack);
276 PL_lex_casemods = 0;
277 *PL_lex_casestack = '\0';
278 PL_lex_dojoin = 0;
279 PL_lex_starts = 0;
280 PL_lex_stuff = Nullsv;
281 PL_lex_repl = Nullsv;
282 PL_lex_inpat = 0;
283 PL_lex_inwhat = 0;
284 PL_linestr = line;
285 if (SvREADONLY(PL_linestr))
286 PL_linestr = sv_2mortal(newSVsv(PL_linestr));
287 s = SvPV(PL_linestr, len);
8990e307 288 if (len && s[len-1] != ';') {
3280af22
NIS		 289 if (!(SvFLAGS(PL_linestr) & SVs_TEMP))
290 PL_linestr = sv_2mortal(newSVsv(PL_linestr));
291 sv_catpvn(PL_linestr, "\n;", 2);
8990e307 292 }
3280af22
NIS		 293 SvTEMP_off(PL_linestr);
294 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
295 PL_bufend = PL_bufptr + SvCUR(PL_linestr);
296 SvREFCNT_dec(PL_rs);
297 PL_rs = newSVpv("\n", 1);
298 PL_rsfp = 0;
79072805 299}
a687059c 300
463ee0b2 301void
8ac85365 302lex_end(void)
463ee0b2 303{
3280af22 304 PL_doextract = FALSE;
463ee0b2
LW		 305}
306
76e3520e 307STATIC void
8ac85365 308restore_rsfp(void *f)
6d5fb7e3 309{
760ac839 310 PerlIO *fp = (PerlIO*)f;
6d5fb7e3 311
3280af22
NIS		 312 if (PL_rsfp == PerlIO_stdin())
313 PerlIO_clearerr(PL_rsfp);
314 else if (PL_rsfp && (PL_rsfp != fp))
315 PerlIO_close(PL_rsfp);
316 PL_rsfp = fp;
6d5fb7e3
CS		 317}
318
76e3520e 319STATIC void
7fae4e64 320restore_expect(void *e)
49d8d3a1
MB		 321{
322 /* a safe way to store a small integer in a pointer */
3280af22 323 PL_expect = (expectation)((char *)e - PL_tokenbuf);
49d8d3a1
MB		 324}
325
837485b6 326STATIC void
7fae4e64 327restore_lex_expect(void *e)
49d8d3a1
MB		 328{
329 /* a safe way to store a small integer in a pointer */
3280af22 330 PL_lex_expect = (expectation)((char *)e - PL_tokenbuf);
49d8d3a1
MB		 331}
332
837485b6 333STATIC void
8ac85365 334incline(char *s)
463ee0b2 335{
0f15f207 336 dTHR;
463ee0b2
LW		 337 char *t;
338 char *n;
339 char ch;
340 int sawline = 0;
341
3280af22 342 PL_curcop->cop_line++;
463ee0b2
LW		 343 if (*s++ != '#')
344 return;
345 while (*s == ' ' || *s == '\t') s++;
346 if (strnEQ(s, "line ", 5)) {
347 s += 5;
348 sawline = 1;
349 }
350 if (!isDIGIT(*s))
351 return;
352 n = s;
353 while (isDIGIT(*s))
354 s++;
355 while (*s == ' ' || *s == '\t')
356 s++;
357 if (*s == '"' && (t = strchr(s+1, '"')))
358 s++;
359 else {
360 if (!sawline)
361 return; /* false alarm */
362 for (t = s; !isSPACE(*t); t++) ;
363 }
364 ch = *t;
365 *t = '\0';
366 if (t - s > 0)
3280af22 367 PL_curcop->cop_filegv = gv_fetchfile(s);
463ee0b2 368 else
3280af22 369 PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename);
463ee0b2 370 *t = ch;
3280af22 371 PL_curcop->cop_line = atoi(n)-1;
463ee0b2
LW		 372}
373
76e3520e 374STATIC char *
8ac85365 375skipspace(register char *s)
a687059c 376{
11343788 377 dTHR;
3280af22
NIS		 378 if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
379 while (s < PL_bufend && (*s == ' ' || *s == '\t'))
463ee0b2
LW		 380 s++;
381 return s;
382 }
383 for (;;) {
fd049845 384 STRLEN prevlen;
3280af22 385 while (s < PL_bufend && isSPACE(*s))
463ee0b2 386 s++;
3280af22
NIS		 387 if (s < PL_bufend && *s == '#') {
388 while (s < PL_bufend && *s != '\n')
463ee0b2 389 s++;
3280af22 390 if (s < PL_bufend)
463ee0b2
LW		 391 s++;
392 }
3280af22 393 if (s < PL_bufend || !PL_rsfp || PL_lex_state != LEX_NORMAL)
463ee0b2 394 return s;
3280af22
NIS		 395 if ((s = filter_gets(PL_linestr, PL_rsfp, (prevlen = SvCUR(PL_linestr)))) == Nullch) {
396 if (PL_minus_n || PL_minus_p) {
397 sv_setpv(PL_linestr,PL_minus_p ?
08e9d68e
DD		 398 ";}continue{print or die qq(-p destination: $!\\n)" :
399 "");
3280af22
NIS		 400 sv_catpv(PL_linestr,";}");
401 PL_minus_n = PL_minus_p = 0;
a0d0e21e
LW		 402 }
403 else
3280af22
NIS		 404 sv_setpv(PL_linestr,";");
405 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
406 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
407 if (PL_preprocess && !PL_in_eval)
408 (void)PerlProc_pclose(PL_rsfp);
409 else if ((PerlIO*)PL_rsfp == PerlIO_stdin())
410 PerlIO_clearerr(PL_rsfp);
8990e307 411 else
3280af22
NIS		 412 (void)PerlIO_close(PL_rsfp);
413 PL_rsfp = Nullfp;
463ee0b2
LW		 414 return s;
415 }
3280af22
NIS		 416 PL_linestart = PL_bufptr = s + prevlen;
417 PL_bufend = s + SvCUR(PL_linestr);
418 s = PL_bufptr;
a0d0e21e 419 incline(s);
3280af22 420 if (PERLDB_LINE && PL_curstash != PL_debstash) {
8990e307
LW		 421 SV *sv = NEWSV(85,0);
422
423 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 424 sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
425 av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
8990e307 426 }
463ee0b2 427 }
a687059c 428}
378cc40b 429
76e3520e 430STATIC void
8ac85365 431check_uni(void) {
2f3197b3
LW		 432 char *s;
433 char ch;
a0d0e21e 434 char *t;
2f3197b3 435
3280af22 436 if (PL_oldoldbufptr != PL_last_uni)
2f3197b3 437 return;
3280af22
NIS		 438 while (isSPACE(*PL_last_uni))
439 PL_last_uni++;
440 for (s = PL_last_uni; isALNUM(*s) || *s == '-'; s++) ;
441 if ((t = strchr(s, '(')) && t < PL_bufptr)
a0d0e21e 442 return;
2f3197b3
LW		 443 ch = *s;
444 *s = '\0';
3280af22 445 warn("Warning: Use of \"%s\" without parens is ambiguous", PL_last_uni);
2f3197b3
LW		 446 *s = ch;
447}
448
ffed7fef
LW		 449#ifdef CRIPPLED_CC
450
451#undef UNI
ffed7fef 452#define UNI(f) return uni(f,s)
ffed7fef 453
76e3520e 454STATIC int
8ac85365 455uni(I32 f, char *s)
ffed7fef
LW		 456{
457 yylval.ival = f;
3280af22
NIS		 458 PL_expect = XTERM;
459 PL_bufptr = s;
8f872242
NIS		 460 PL_last_uni = PL_oldbufptr;
461 PL_last_lop_op = f;
ffed7fef
LW		 462 if (*s == '(')
463 return FUNC1;
464 s = skipspace(s);
465 if (*s == '(')
466 return FUNC1;
467 else
468 return UNIOP;
469}
470
a0d0e21e
LW		 471#endif /* CRIPPLED_CC */
472
473#define LOP(f,x) return lop(f,x,s)
474
76e3520e 475STATIC I32
0fa19009 476lop(I32 f, expectation x, char *s)
ffed7fef 477{
0f15f207 478 dTHR;
79072805 479 yylval.ival = f;
35c8bce7 480 CLINE;
3280af22
NIS		 481 PL_expect = x;
482 PL_bufptr = s;
483 PL_last_lop = PL_oldbufptr;
484 PL_last_lop_op = f;
485 if (PL_nexttoke)
a0d0e21e 486 return LSTOP;
79072805
LW		 487 if (*s == '(')
488 return FUNC;
489 s = skipspace(s);
490 if (*s == '(')
491 return FUNC;
492 else
493 return LSTOP;
494}
495
76e3520e 496STATIC void
8ac85365 497force_next(I32 type)
79072805 498{
3280af22
NIS		 499 PL_nexttype[PL_nexttoke] = type;
500 PL_nexttoke++;
501 if (PL_lex_state != LEX_KNOWNEXT) {
502 PL_lex_defer = PL_lex_state;
503 PL_lex_expect = PL_expect;
504 PL_lex_state = LEX_KNOWNEXT;
79072805
LW		 505 }
506}
507
76e3520e 508STATIC char *
15f0808c 509force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
79072805 510{
463ee0b2
LW		 511 register char *s;
512 STRLEN len;
513
514 start = skipspace(start);
515 s = start;
a0d0e21e
LW		 516 if (isIDFIRST(*s) ||
517 (allow_pack && *s == ':') ||
15f0808c 518 (allow_initial_tick && *s == '\'') )
a0d0e21e 519 {
3280af22
NIS		 520 s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len);
521 if (check_keyword && keyword(PL_tokenbuf, len))
463ee0b2
LW		 522 return start;
523 if (token == METHOD) {
524 s = skipspace(s);
525 if (*s == '(')
3280af22 526 PL_expect = XTERM;
463ee0b2 527 else {
3280af22 528 PL_expect = XOPERATOR;
463ee0b2
LW		 529 force_next(')');
530 force_next('(');
531 }
79072805 532 }
3280af22
NIS		 533 PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(PL_tokenbuf,0));
534 PL_nextval[PL_nexttoke].opval->op_private |= OPpCONST_BARE;
79072805
LW		 535 force_next(token);
536 }
537 return s;
538}
539
76e3520e 540STATIC void
8ac85365 541force_ident(register char *s, int kind)
79072805
LW		 542{
543 if (s && *s) {
11343788 544 OP* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
3280af22 545 PL_nextval[PL_nexttoke].opval = o;
79072805 546 force_next(WORD);
748a9306 547 if (kind) {
e858de61 548 dTHR; /* just for in_eval */
11343788 549 o->op_private = OPpCONST_ENTERED;
55497cff 550 /* XXX see note in pp_entereval() for why we forgo typo
551 warnings if the symbol must be introduced in an eval.
552 GSAR 96-10-12 */
3280af22 553 gv_fetchpv(s, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
a0d0e21e
LW		 554 kind == '$' ? SVt_PV :
555 kind == '@' ? SVt_PVAV :
556 kind == '%' ? SVt_PVHV :
557 SVt_PVGV
558 );
748a9306 559 }
79072805
LW		 560 }
561}
562
76e3520e 563STATIC char *
8ac85365 564force_version(char *s)
89bfa8cd 565{
566 OP *version = Nullop;
567
568 s = skipspace(s);
569
570 /* default VERSION number -- GBARR */
571
572 if(isDIGIT(*s)) {
573 char *d;
574 int c;
55497cff 575 for( d=s, c = 1; isDIGIT(*d) || *d == '_' || (*d == '.' && c--); d++);
89bfa8cd 576 if((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') {
577 s = scan_num(s);
578 /* real VERSION number -- GBARR */
579 version = yylval.opval;
580 }
581 }
582
583 /* NOTE: The parser sees the package name and the VERSION swapped */
3280af22 584 PL_nextval[PL_nexttoke].opval = version;
89bfa8cd 585 force_next(WORD);
586
587 return (s);
588}
589
76e3520e
GS		 590STATIC SV *
591tokeq(SV *sv)
79072805
LW		 592{
593 register char *s;
594 register char *send;
595 register char *d;
b3ac6de7
IZ		 596 STRLEN len = 0;
597 SV *pv = sv;
79072805
LW		 598
599 if (!SvLEN(sv))
b3ac6de7 600 goto finish;
79072805 601
a0d0e21e 602 s = SvPV_force(sv, len);
748a9306 603 if (SvIVX(sv) == -1)
b3ac6de7 604 goto finish;
463ee0b2 605 send = s + len;
79072805
LW		 606 while (s < send && *s != '\\')
607 s++;
608 if (s == send)
b3ac6de7 609 goto finish;
79072805 610 d = s;
3280af22 611 if ( PL_hints & HINT_NEW_STRING )
b3ac6de7 612 pv = sv_2mortal(newSVpv(SvPVX(pv), len));
79072805
LW		 613 while (s < send) {
614 if (*s == '\\') {
a0d0e21e 615 if (s + 1 < send && (s[1] == '\\'))
79072805
LW		 616 s++; /* all that, just for this */
617 }
618 *d++ = *s++;
619 }
620 *d = '\0';
463ee0b2 621 SvCUR_set(sv, d - SvPVX(sv));
b3ac6de7 622 finish:
3280af22 623 if ( PL_hints & HINT_NEW_STRING )
b3ac6de7 624 return new_constant(NULL, 0, "q", sv, pv, "q");
79072805
LW		 625 return sv;
626}
627
76e3520e 628STATIC I32
8ac85365 629sublex_start(void)
79072805
LW		 630{
631 register I32 op_type = yylval.ival;
79072805
LW		 632
633 if (op_type == OP_NULL) {
3280af22
NIS		 634 yylval.opval = PL_lex_op;
635 PL_lex_op = Nullop;
79072805
LW		 636 return THING;
637 }
638 if (op_type == OP_CONST || op_type == OP_READLINE) {
3280af22 639 SV *sv = tokeq(PL_lex_stuff);
b3ac6de7
IZ		 640
641 if (SvTYPE(sv) == SVt_PVIV) {
642 /* Overloaded constants, nothing fancy: Convert to SVt_PV: */
643 STRLEN len;
644 char *p;
645 SV *nsv;
646
647 p = SvPV(sv, len);
648 nsv = newSVpv(p, len);
649 SvREFCNT_dec(sv);
650 sv = nsv;
651 }
652 yylval.opval = (OP*)newSVOP(op_type, 0, sv);
3280af22 653 PL_lex_stuff = Nullsv;
79072805
LW		 654 return THING;
655 }
656
3280af22
NIS		 657 PL_sublex_info.super_state = PL_lex_state;
658 PL_sublex_info.sub_inwhat = op_type;
659 PL_sublex_info.sub_op = PL_lex_op;
660 PL_lex_state = LEX_INTERPPUSH;
55497cff 661
3280af22
NIS		 662 PL_expect = XTERM;
663 if (PL_lex_op) {
664 yylval.opval = PL_lex_op;
665 PL_lex_op = Nullop;
55497cff 666 return PMFUNC;
667 }
668 else
669 return FUNC;
670}
671
76e3520e 672STATIC I32
8ac85365 673sublex_push(void)
55497cff 674{
0f15f207 675 dTHR;
f46d017c 676 ENTER;
55497cff 677
3280af22
NIS		 678 PL_lex_state = PL_sublex_info.super_state;
679 SAVEI32(PL_lex_dojoin);
680 SAVEI32(PL_lex_brackets);
681 SAVEI32(PL_lex_fakebrack);
682 SAVEI32(PL_lex_casemods);
683 SAVEI32(PL_lex_starts);
684 SAVEI32(PL_lex_state);
685 SAVESPTR(PL_lex_inpat);
686 SAVEI32(PL_lex_inwhat);
687 SAVEI16(PL_curcop->cop_line);
688 SAVEPPTR(PL_bufptr);
689 SAVEPPTR(PL_oldbufptr);
690 SAVEPPTR(PL_oldoldbufptr);
691 SAVEPPTR(PL_linestart);
692 SAVESPTR(PL_linestr);
693 SAVEPPTR(PL_lex_brackstack);
694 SAVEPPTR(PL_lex_casestack);
695
696 PL_linestr = PL_lex_stuff;
697 PL_lex_stuff = Nullsv;
698
699 PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
700 PL_bufend += SvCUR(PL_linestr);
701 SAVEFREESV(PL_linestr);
702
703 PL_lex_dojoin = FALSE;
704 PL_lex_brackets = 0;
705 PL_lex_fakebrack = 0;
706 New(899, PL_lex_brackstack, 120, char);
707 New(899, PL_lex_casestack, 12, char);
708 SAVEFREEPV(PL_lex_brackstack);
709 SAVEFREEPV(PL_lex_casestack);
710 PL_lex_casemods = 0;
711 *PL_lex_casestack = '\0';
712 PL_lex_starts = 0;
713 PL_lex_state = LEX_INTERPCONCAT;
714 PL_curcop->cop_line = PL_multi_start;
715
716 PL_lex_inwhat = PL_sublex_info.sub_inwhat;
717 if (PL_lex_inwhat == OP_MATCH || PL_lex_inwhat == OP_QR || PL_lex_inwhat == OP_SUBST)
718 PL_lex_inpat = PL_sublex_info.sub_op;
79072805 719 else
3280af22 720 PL_lex_inpat = Nullop;
79072805 721
55497cff 722 return '(';
79072805
LW		 723}
724
76e3520e 725STATIC I32
8ac85365 726sublex_done(void)
79072805 727{
3280af22
NIS		 728 if (!PL_lex_starts++) {
729 PL_expect = XOPERATOR;
93a17b20 730 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv("",0));
79072805
LW		 731 return THING;
732 }
733
3280af22
NIS		 734 if (PL_lex_casemods) { /* oops, we've got some unbalanced parens */
735 PL_lex_state = LEX_INTERPCASEMOD;
79072805
LW		 736 return yylex();
737 }
738
79072805 739 /* Is there a right-hand side to take care of? */
3280af22
NIS		 740 if (PL_lex_repl && (PL_lex_inwhat == OP_SUBST || PL_lex_inwhat == OP_TRANS)) {
741 PL_linestr = PL_lex_repl;
742 PL_lex_inpat = 0;
743 PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
744 PL_bufend += SvCUR(PL_linestr);
745 SAVEFREESV(PL_linestr);
746 PL_lex_dojoin = FALSE;
747 PL_lex_brackets = 0;
748 PL_lex_fakebrack = 0;
749 PL_lex_casemods = 0;
750 *PL_lex_casestack = '\0';
751 PL_lex_starts = 0;
752 if (SvCOMPILED(PL_lex_repl)) {
753 PL_lex_state = LEX_INTERPNORMAL;
754 PL_lex_starts++;
79072805
LW		 755 }
756 else
3280af22
NIS		 757 PL_lex_state = LEX_INTERPCONCAT;
758 PL_lex_repl = Nullsv;
79072805 759 return ',';
ffed7fef
LW		 760 }
761 else {
f46d017c 762 LEAVE;
3280af22
NIS		 763 PL_bufend = SvPVX(PL_linestr);
764 PL_bufend += SvCUR(PL_linestr);
765 PL_expect = XOPERATOR;
79072805 766 return ')';
ffed7fef
LW		 767 }
768}
769
02aa26ce
NT		 770/*
771 scan_const
772
773 Extracts a pattern, double-quoted string, or transliteration. This
774 is terrifying code.
775
3280af22
NIS		 776 It looks at lex_inwhat and PL_lex_inpat to find out whether it's
777 processing a pattern (PL_lex_inpat is true), a transliteration
02aa26ce
NT		 778 (lex_inwhat & OP_TRANS is true), or a double-quoted string.
779
9b599b2a
GS		 780 Returns a pointer to the character scanned up to. Iff this is
781 advanced from the start pointer supplied (ie if anything was
782 successfully parsed), will leave an OP for the substring scanned
783 in yylval. Caller must intuit reason for not parsing further
784 by looking at the next characters herself.
785
02aa26ce
NT		 786 In patterns:
787 backslashes:
788 double-quoted style: \r and \n
789 regexp special ones: \D \s
790 constants: \x3
791 backrefs: \1 (deprecated in substitution replacements)
792 case and quoting: \U \Q \E
793 stops on @ and $, but not for $ as tail anchor
794
795 In transliterations:
796 characters are VERY literal, except for - not at the start or end
797 of the string, which indicates a range. scan_const expands the
798 range to the full set of intermediate characters.
799
800 In double-quoted strings:
801 backslashes:
802 double-quoted style: \r and \n
803 constants: \x3
804 backrefs: \1 (deprecated)
805 case and quoting: \U \Q \E
806 stops on @ and $
807
808 scan_const does *not* construct ops to handle interpolated strings.
809 It stops processing as soon as it finds an embedded $ or @ variable
810 and leaves it to the caller to work out what's going on.
811
812 @ in pattern could be: @foo, @{foo}, @$foo, @'foo, @:foo.
813
814 $ in pattern could be $foo or could be tail anchor. Assumption:
815 it's a tail anchor if $ is the last thing in the string, or if it's
816 followed by one of ")| \n\t"
817
818 \1 (backreferences) are turned into $1
819
820 The structure of the code is
821 while (there's a character to process) {
822 handle transliteration ranges
823 skip regexp comments
824 skip # initiated comments in //x patterns
825 check for embedded @foo
826 check for embedded scalars
827 if (backslash) {
828 leave intact backslashes from leave (below)
829 deprecate \1 in strings and sub replacements
830 handle string-changing backslashes \l \U \Q \E, etc.
831 switch (what was escaped) {
832 handle - in a transliteration (becomes a literal -)
833 handle \132 octal characters
834 handle 0x15 hex characters
835 handle \cV (control V)
836 handle printf backslashes (\f, \r, \n, etc)
837 } (end switch)
838 } (end if backslash)
839 } (end while character to read)
840
841*/
842
76e3520e 843STATIC char *
8ac85365 844scan_const(char *start)
79072805 845{
3280af22 846 register char *send = PL_bufend; /* end of the constant */
02aa26ce
NT		 847 SV *sv = NEWSV(93, send - start); /* sv for the constant */
848 register char *s = start; /* start of the constant */
849 register char *d = SvPVX(sv); /* destination for copies */
850 bool dorange = FALSE; /* are we in a translit range? */
851 I32 len; /* ? */
852
9b599b2a 853 /* leaveit is the set of acceptably-backslashed characters */
72aaf631 854 char *leaveit =
3280af22 855 PL_lex_inpat
b85d18e9 856 ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#"
9b599b2a 857 : "";
79072805
LW		 858
859 while (s < send || dorange) {
02aa26ce 860 /* get transliterations out of the way (they're most literal) */
3280af22 861 if (PL_lex_inwhat == OP_TRANS) {
02aa26ce 862 /* expand a range A-Z to the full set of characters. AIE! */
79072805 863 if (dorange) {
02aa26ce
NT		 864 I32 i; /* current expanded character */
865 I32 max; /* last character in range */
866
867 i = d - SvPVX(sv); /* remember current offset */
868 SvGROW(sv, SvLEN(sv) + 256); /* expand the sv -- there'll never be more'n 256 chars in a range for it to grow by */
869 d = SvPVX(sv) + i; /* restore d after the grow potentially has changed the ptr */
870 d -= 2; /* eat the first char and the - */
871
872 max = (U8)d[1]; /* last char in range */
873
91b7def8 874 for (i = (U8)*d; i <= max; i++)
79072805 875 *d++ = i;
02aa26ce
NT		 876
877 /* mark the range as done, and continue */
79072805
LW		 878 dorange = FALSE;
879 continue;
880 }
02aa26ce
NT		 881
882 /* range begins (ignore - as first or last char) */
79072805
LW		 883 else if (*s == '-' && s+1 < send && s != start) {
884 dorange = TRUE;
885 s++;
886 }
887 }
02aa26ce
NT		 888
889 /* if we get here, we're not doing a transliteration */
890
891 /* skip for regexp comments /(?#comment)/ */
3280af22 892 else if (*s == '(' && PL_lex_inpat && s[1] == '?') {
cc6b7395
IZ		 893 if (s[2] == '#') {
894 while (s < send && *s != ')')
895 *d++ = *s++;
896 } else if (s[2] == '{') { /* This should march regcomp.c */
897 I32 count = 1;
d9f97599 898 char *regparse = s + 3;
cc6b7395
IZ		 899 char c;
900
d9f97599
GS		 901 while (count && (c = *regparse)) {
902 if (c == '\\' && regparse[1])
903 regparse++;
cc6b7395
IZ		 904 else if (c == '{')
905 count++;
906 else if (c == '}')
907 count--;
d9f97599 908 regparse++;
cc6b7395 909 }
d9f97599
GS		 910 if (*regparse == ')')
911 regparse++;
cc6b7395
IZ		 912 else
913 yyerror("Sequence (?{...}) not terminated or not {}-balanced");
d9f97599 914 while (s < regparse && *s != ')')
cc6b7395
IZ		 915 *d++ = *s++;
916 }
748a9306 917 }
02aa26ce
NT		 918
919 /* likewise skip #-initiated comments in //x patterns */
3280af22
NIS		 920 else if (*s == '#' && PL_lex_inpat &&
921 ((PMOP*)PL_lex_inpat)->op_pmflags & PMf_EXTENDED) {
748a9306
LW		 922 while (s+1 < send && *s != '\n')
923 *d++ = *s++;
924 }
02aa26ce
NT		 925
926 /* check for embedded arrays (@foo, @:foo, @'foo, @{foo}, @$foo) */
a0d0e21e 927 else if (*s == '@' && s[1] && (isALNUM(s[1]) || strchr(":'{$", s[1])))
79072805 928 break;
02aa26ce
NT		 929
930 /* check for embedded scalars. only stop if we're sure it's a
931 variable.
932 */
79072805 933 else if (*s == '$') {
3280af22 934 if (!PL_lex_inpat) /* not a regexp, so $ must be var */
79072805 935 break;
c277df42 936 if (s + 1 < send && !strchr("()| \n\t", s[1]))
79072805
LW		 937 break; /* in regexp, $ might be tail anchor */
938 }
02aa26ce
NT		 939
940 /* backslashes */
79072805
LW		 941 if (*s == '\\' && s+1 < send) {
942 s++;
02aa26ce
NT		 943
944 /* some backslashes we leave behind */
72aaf631 945 if (*s && strchr(leaveit, *s)) {
79072805
LW		 946 *d++ = '\\';
947 *d++ = *s++;
948 continue;
949 }
02aa26ce
NT		 950
951 /* deprecate \1 in strings and substitution replacements */
3280af22 952 if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
a0d0e21e 953 isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
79072805 954 {
3280af22 955 if (PL_dowarn)
a0d0e21e 956 warn("\\%c better written as $%c", *s, *s);
79072805
LW		 957 *--s = '$';
958 break;
959 }
02aa26ce
NT		 960
961 /* string-change backslash escapes */
3280af22 962 if (PL_lex_inwhat != OP_TRANS && *s && strchr("lLuUEQ", *s)) {
79072805
LW		 963 --s;
964 break;
965 }
02aa26ce
NT		 966
967 /* if we get here, it's either a quoted -, or a digit */
79072805 968 switch (*s) {
02aa26ce
NT		 969
970 /* quoted - in transliterations */
79072805 971 case '-':
3280af22 972 if (PL_lex_inwhat == OP_TRANS) {
79072805
LW		 973 *d++ = *s++;
974 continue;
975 }
976 /* FALL THROUGH */
02aa26ce 977 /* default action is to copy the quoted character */
79072805
LW		 978 default:
979 *d++ = *s++;
980 continue;
02aa26ce
NT		 981
982 /* \132 indicates an octal constant */
79072805
LW		 983 case '0': case '1': case '2': case '3':
984 case '4': case '5': case '6': case '7':
985 *d++ = scan_oct(s, 3, &len);
986 s += len;
987 continue;
02aa26ce
NT		 988
989 /* \x24 indicates a hex constant */
79072805
LW		 990 case 'x':
991 *d++ = scan_hex(++s, 2, &len);
992 s += len;
993 continue;
02aa26ce
NT		 994
995 /* \c is a control character */
79072805
LW		 996 case 'c':
997 s++;
9d116dd7
JH		 998#ifdef EBCDIC
999 *d = *s++;
1000 if (isLOWER(*d))
1001 *d = toUPPER(*d);
1002 *d++ = toCTRL(*d);
1003#else
bbce6d69 1004 len = *s++;
1005 *d++ = toCTRL(len);
9d116dd7 1006#endif
79072805 1007 continue;
02aa26ce
NT		 1008
1009 /* printf-style backslashes, formfeeds, newlines, etc */
79072805
LW		 1010 case 'b':
1011 *d++ = '\b';
1012 break;
1013 case 'n':
1014 *d++ = '\n';
1015 break;
1016 case 'r':
1017 *d++ = '\r';
1018 break;
1019 case 'f':
1020 *d++ = '\f';
1021 break;
1022 case 't':
1023 *d++ = '\t';
1024 break;
1025 case 'e':
1026 *d++ = '\033';
1027 break;
1028 case 'a':
1029 *d++ = '\007';
1030 break;
02aa26ce
NT		 1031 } /* end switch */
1032
79072805
LW		 1033 s++;
1034 continue;
02aa26ce
NT		 1035 } /* end if (backslash) */
1036
79072805 1037 *d++ = *s++;
02aa26ce
NT		 1038 } /* while loop to process each character */
1039
1040 /* terminate the string and set up the sv */
79072805 1041 *d = '\0';
463ee0b2 1042 SvCUR_set(sv, d - SvPVX(sv));
79072805
LW		 1043 SvPOK_on(sv);
1044
02aa26ce 1045 /* shrink the sv if we allocated more than we used */
79072805
LW		 1046 if (SvCUR(sv) + 5 < SvLEN(sv)) {
1047 SvLEN_set(sv, SvCUR(sv) + 1);
463ee0b2 1048 Renew(SvPVX(sv), SvLEN(sv), char);
79072805 1049 }
02aa26ce 1050
9b599b2a 1051 /* return the substring (via yylval) only if we parsed anything */
3280af22
NIS		 1052 if (s > PL_bufptr) {
1053 if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) )
1054 sv = new_constant(start, s - start, (PL_lex_inpat ? "qr" : "q"),
b3ac6de7 1055 sv, Nullsv,
3280af22 1056 ( PL_lex_inwhat == OP_TRANS
b3ac6de7 1057 ? "tr"
3280af22 1058 : ( (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat)
b3ac6de7
IZ		 1059 ? "s"
1060 : "qq")));
79072805 1061 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
b3ac6de7 1062 } else
8990e307 1063 SvREFCNT_dec(sv);
79072805
LW		 1064 return s;
1065}
1066
1067/* This is the one truly awful dwimmer necessary to conflate C and sed. */
76e3520e 1068STATIC int
8ac85365 1069intuit_more(register char *s)
79072805 1070{
3280af22 1071 if (PL_lex_brackets)
79072805
LW		 1072 return TRUE;
1073 if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
1074 return TRUE;
1075 if (*s != '{' && *s != '[')
1076 return FALSE;
3280af22 1077 if (!PL_lex_inpat)
79072805
LW		 1078 return TRUE;
1079
1080 /* In a pattern, so maybe we have {n,m}. */
1081 if (*s == '{') {
1082 s++;
1083 if (!isDIGIT(*s))
1084 return TRUE;
1085 while (isDIGIT(*s))
1086 s++;
1087 if (*s == ',')
1088 s++;
1089 while (isDIGIT(*s))
1090 s++;
1091 if (*s == '}')
1092 return FALSE;
1093 return TRUE;
1094
1095 }
1096
1097 /* On the other hand, maybe we have a character class */
1098
1099 s++;
1100 if (*s == ']' || *s == '^')
1101 return FALSE;
1102 else {
1103 int weight = 2; /* let's weigh the evidence */
1104 char seen[256];
f27ffc4a 1105 unsigned char un_char = 255, last_un_char;
93a17b20 1106 char *send = strchr(s,']');
3280af22 1107 char tmpbuf[sizeof PL_tokenbuf * 4];
79072805
LW		 1108
1109 if (!send) /* has to be an expression */
1110 return TRUE;
1111
1112 Zero(seen,256,char);
1113 if (*s == '$')
1114 weight -= 3;
1115 else if (isDIGIT(*s)) {
1116 if (s[1] != ']') {
1117 if (isDIGIT(s[1]) && s[2] == ']')
1118 weight -= 10;
1119 }
1120 else
1121 weight -= 100;
1122 }
1123 for (; s < send; s++) {
1124 last_un_char = un_char;
1125 un_char = (unsigned char)*s;
1126 switch (*s) {
1127 case '@':
1128 case '&':
1129 case '$':
1130 weight -= seen[un_char] * 10;
1131 if (isALNUM(s[1])) {
8903cb82 1132 scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE);
a0d0e21e 1133 if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
79072805
LW		 1134 weight -= 100;
1135 else
1136 weight -= 10;
1137 }
1138 else if (*s == '$' && s[1] &&
93a17b20
LW		 1139 strchr("[#!%*<>()-=",s[1])) {
1140 if (/*{*/ strchr("])} =",s[2]))
79072805
LW		 1141 weight -= 10;
1142 else
1143 weight -= 1;
1144 }
1145 break;
1146 case '\\':
1147 un_char = 254;
1148 if (s[1]) {
93a17b20 1149 if (strchr("wds]",s[1]))
79072805
LW		 1150 weight += 100;
1151 else if (seen['\''] || seen['"'])
1152 weight += 1;
93a17b20 1153 else if (strchr("rnftbxcav",s[1]))
79072805
LW		 1154 weight += 40;
1155 else if (isDIGIT(s[1])) {
1156 weight += 40;
1157 while (s[1] && isDIGIT(s[1]))
1158 s++;
1159 }
1160 }
1161 else
1162 weight += 100;
1163 break;
1164 case '-':
1165 if (s[1] == '\\')
1166 weight += 50;
93a17b20 1167 if (strchr("aA01! ",last_un_char))
79072805 1168 weight += 30;
93a17b20 1169 if (strchr("zZ79~",s[1]))
79072805 1170 weight += 30;
f27ffc4a
GS		 1171 if (last_un_char == 255 && (isDIGIT(s[1]) || s[1] == '$'))
1172 weight -= 5; /* cope with negative subscript */
79072805
LW		 1173 break;
1174 default:
93a17b20 1175 if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
79072805
LW		 1176 isALPHA(*s) && s[1] && isALPHA(s[1])) {
1177 char *d = tmpbuf;
1178 while (isALPHA(*s))
1179 *d++ = *s++;
1180 *d = '\0';
1181 if (keyword(tmpbuf, d - tmpbuf))
1182 weight -= 150;
1183 }
1184 if (un_char == last_un_char + 1)
1185 weight += 5;
1186 weight -= seen[un_char];
1187 break;
1188 }
1189 seen[un_char]++;
1190 }
1191 if (weight >= 0) /* probably a character class */
1192 return FALSE;
1193 }
1194
1195 return TRUE;
1196}
ffed7fef 1197
76e3520e 1198STATIC int
8ac85365 1199intuit_method(char *start, GV *gv)
a0d0e21e
LW		 1200{
1201 char *s = start + (*start == '$');
3280af22 1202 char tmpbuf[sizeof PL_tokenbuf];
a0d0e21e
LW		 1203 STRLEN len;
1204 GV* indirgv;
1205
1206 if (gv) {
b6c543e3 1207 CV *cv;
a0d0e21e
LW		 1208 if (GvIO(gv))
1209 return 0;
b6c543e3
IZ		 1210 if ((cv = GvCVu(gv))) {
1211 char *proto = SvPVX(cv);
1212 if (proto) {
1213 if (*proto == ';')
1214 proto++;
1215 if (*proto == '*')
1216 return 0;
1217 }
1218 } else
a0d0e21e
LW		 1219 gv = 0;
1220 }
8903cb82 1221 s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
a0d0e21e 1222 if (*start == '$') {
3280af22 1223 if (gv || PL_last_lop_op == OP_PRINT || isUPPER(*PL_tokenbuf))
a0d0e21e
LW		 1224 return 0;
1225 s = skipspace(s);
3280af22
NIS		 1226 PL_bufptr = start;
1227 PL_expect = XREF;
a0d0e21e
LW		 1228 return *s == '(' ? FUNCMETH : METHOD;
1229 }
1230 if (!keyword(tmpbuf, len)) {
c3e0f903
GS		 1231 if (len > 2 && tmpbuf[len - 2] == ':' && tmpbuf[len - 1] == ':') {
1232 len -= 2;
1233 tmpbuf[len] = '\0';
1234 goto bare_package;
1235 }
1236 indirgv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
8ebc5c01 1237 if (indirgv && GvCVu(indirgv))
a0d0e21e
LW		 1238 return 0;
1239 /* filehandle or package name makes it a method */
89bfa8cd 1240 if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) {
a0d0e21e 1241 s = skipspace(s);
3280af22 1242 if ((PL_bufend - s) >= 2 && *s == '=' && *(s+1) == '>')
55497cff 1243 return 0; /* no assumptions -- "=>" quotes bearword */
c3e0f903 1244 bare_package:
3280af22 1245 PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0,
c3e0f903 1246 newSVpv(tmpbuf,0));
3280af22
NIS		 1247 PL_nextval[PL_nexttoke].opval->op_private = OPpCONST_BARE;
1248 PL_expect = XTERM;
a0d0e21e 1249 force_next(WORD);
3280af22 1250 PL_bufptr = s;
a0d0e21e
LW		 1251 return *s == '(' ? FUNCMETH : METHOD;
1252 }
1253 }
1254 return 0;
1255}
1256
76e3520e 1257STATIC char*
8ac85365 1258incl_perldb(void)
a0d0e21e 1259{
3280af22 1260 if (PL_perldb) {
76e3520e 1261 char *pdb = PerlEnv_getenv("PERL5DB");
a0d0e21e
LW		 1262
1263 if (pdb)
1264 return pdb;
61bb5906 1265 SETERRNO(0,SS$_NORMAL);
a0d0e21e
LW		 1266 return "BEGIN { require 'perl5db.pl' }";
1267 }
1268 return "";
1269}
1270
1271
16d20bd9
AD		 1272/* Encoded script support. filter_add() effectively inserts a
1273 * 'pre-processing' function into the current source input stream.
1274 * Note that the filter function only applies to the current source file
1275 * (e.g., it will not affect files 'require'd or 'use'd by this one).
1276 *
1277 * The datasv parameter (which may be NULL) can be used to pass
1278 * private data to this instance of the filter. The filter function
1279 * can recover the SV using the FILTER_DATA macro and use it to
1280 * store private buffers and state information.
1281 *
1282 * The supplied datasv parameter is upgraded to a PVIO type
1283 * and the IoDIRP field is used to store the function pointer.
1284 * Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
1285 * private use must be set using malloc'd pointers.
1286 */
1287static int filter_debug = 0;
1288
1289SV *
8ac85365 1290filter_add(filter_t funcp, SV *datasv)
16d20bd9
AD		 1291{
1292 if (!funcp){ /* temporary handy debugging hack to be deleted */
1293 filter_debug = atoi((char*)datasv);
1294 return NULL;
1295 }
3280af22
NIS		 1296 if (!PL_rsfp_filters)
1297 PL_rsfp_filters = newAV();
16d20bd9 1298 if (!datasv)
8c52afec 1299 datasv = NEWSV(255,0);
16d20bd9
AD		 1300 if (!SvUPGRADE(datasv, SVt_PVIO))
1301 die("Can't upgrade filter_add data to SVt_PVIO");
1302 IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
1303 if (filter_debug)
3280af22
NIS		 1304 warn("filter_add func %p (%s)", funcp, SvPV(datasv,PL_na));
1305 av_unshift(PL_rsfp_filters, 1);
1306 av_store(PL_rsfp_filters, 0, datasv) ;
16d20bd9
AD		 1307 return(datasv);
1308}
1309
1310
1311/* Delete most recently added instance of this filter function. */
a0d0e21e 1312void
8ac85365 1313filter_del(filter_t funcp)
16d20bd9
AD		 1314{
1315 if (filter_debug)
ff0cee69 1316 warn("filter_del func %p", funcp);
3280af22 1317 if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
16d20bd9
AD		 1318 return;
1319 /* if filter is on top of stack (usual case) just pop it off */
3280af22
NIS		 1320 if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (void*)funcp){
1321 sv_free(av_pop(PL_rsfp_filters));
e50aee73 1322
16d20bd9
AD		 1323 return;
1324 }
1325 /* we need to search for the correct entry and clear it */
1326 die("filter_del can only delete in reverse order (currently)");
1327}
1328
1329
1330/* Invoke the n'th filter function for the current rsfp. */
1331I32
8ac85365
NIS		 1332filter_read(int idx, SV *buf_sv, int maxlen)
1333
1334
1335 /* 0 = read one text line */
a0d0e21e 1336{
16d20bd9
AD		 1337 filter_t funcp;
1338 SV *datasv = NULL;
e50aee73 1339
3280af22 1340 if (!PL_rsfp_filters)
16d20bd9 1341 return -1;
3280af22 1342 if (idx > AvFILLp(PL_rsfp_filters)){ /* Any more filters? */
16d20bd9
AD		 1343 /* Provide a default input filter to make life easy. */
1344 /* Note that we append to the line. This is handy. */
16d20bd9
AD		 1345 if (filter_debug)
1346 warn("filter_read %d: from rsfp\n", idx);
1347 if (maxlen) {
1348 /* Want a block */
1349 int len ;
1350 int old_len = SvCUR(buf_sv) ;
1351
1352 /* ensure buf_sv is large enough */
1353 SvGROW(buf_sv, old_len + maxlen) ;
3280af22
NIS		 1354 if ((len = PerlIO_read(PL_rsfp, SvPVX(buf_sv) + old_len, maxlen)) <= 0){
1355 if (PerlIO_error(PL_rsfp))
37120919
AD		 1356 return -1; /* error */
1357 else
1358 return 0 ; /* end of file */
1359 }
16d20bd9
AD		 1360 SvCUR_set(buf_sv, old_len + len) ;
1361 } else {
1362 /* Want a line */
3280af22
NIS		 1363 if (sv_gets(buf_sv, PL_rsfp, SvCUR(buf_sv)) == NULL) {
1364 if (PerlIO_error(PL_rsfp))
37120919
AD		 1365 return -1; /* error */
1366 else
1367 return 0 ; /* end of file */
1368 }
16d20bd9
AD		 1369 }
1370 return SvCUR(buf_sv);
1371 }
1372 /* Skip this filter slot if filter has been deleted */
3280af22 1373 if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef){
16d20bd9
AD		 1374 if (filter_debug)
1375 warn("filter_read %d: skipped (filter deleted)\n", idx);
1376 return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
1377 }
1378 /* Get function pointer hidden within datasv */
1379 funcp = (filter_t)IoDIRP(datasv);
1380 if (filter_debug)
ff0cee69 1381 warn("filter_read %d: via function %p (%s)\n",
3280af22 1382 idx, funcp, SvPV(datasv,PL_na));
16d20bd9
AD		 1383 /* Call function. The function is expected to */
1384 /* call "FILTER_READ(idx+1, buf_sv)" first. */
37120919 1385 /* Return: <0:error, =0:eof, >0:not eof */
1d583055 1386 return (*funcp)(PERL_OBJECT_THIS_ idx, buf_sv, maxlen);
16d20bd9
AD		 1387}
1388
76e3520e
GS		 1389STATIC char *
1390filter_gets(register SV *sv, register PerlIO *fp, STRLEN append)
16d20bd9 1391{
a868473f 1392#ifdef WIN32FILTER
3280af22 1393 if (!PL_rsfp_filters) {
a868473f
NIS		 1394 filter_add(win32_textfilter,NULL);
1395 }
1396#endif
3280af22 1397 if (PL_rsfp_filters) {
16d20bd9 1398
55497cff 1399 if (!append)
1400 SvCUR_set(sv, 0); /* start with empty line */
16d20bd9
AD		 1401 if (FILTER_READ(0, sv, 0) > 0)
1402 return ( SvPVX(sv) ) ;
1403 else
1404 return Nullch ;
1405 }
9d116dd7 1406 else
fd049845 1407 return (sv_gets(sv, fp, append));
a0d0e21e
LW		 1408}
1409
1410
748a9306
LW		 1411#ifdef DEBUGGING
1412 static char* exp_name[] =
a0d0e21e 1413 { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "TERMBLOCK" };
748a9306 1414#endif
463ee0b2 1415
71be2cbc 1416EXT int yychar; /* last token */
463ee0b2 1417
02aa26ce
NT		 1418/*
1419 yylex
1420
1421 Works out what to call the token just pulled out of the input
1422 stream. The yacc parser takes care of taking the ops we return and
1423 stitching them into a tree.
1424
1425 Returns:
1426 PRIVATEREF
1427
1428 Structure:
1429 if read an identifier
1430 if we're in a my declaration
1431 croak if they tried to say my($foo::bar)
1432 build the ops for a my() declaration
1433 if it's an access to a my() variable
1434 are we in a sort block?
1435 croak if my($a); $a <=> $b
1436 build ops for access to a my() variable
1437 if in a dq string, and they've said @foo and we can't find @foo
1438 croak
1439 build ops for a bareword
1440 if we already built the token before, use it.
1441*/
1442
2f3197b3 1443int
8ac85365 1444yylex(void)
378cc40b 1445{
11343788 1446 dTHR;
79072805 1447 register char *s;
378cc40b 1448 register char *d;
79072805 1449 register I32 tmp;
463ee0b2 1450 STRLEN len;
161b471a
NIS		 1451 GV *gv = Nullgv;
1452 GV **gvp = 0;
a687059c 1453
02aa26ce 1454 /* check if there's an identifier for us to look at */
3280af22 1455 if (PL_pending_ident) {
02aa26ce 1456 /* pit holds the identifier we read and pending_ident is reset */
3280af22
NIS		 1457 char pit = PL_pending_ident;
1458 PL_pending_ident = 0;
bbce6d69 1459
02aa26ce
NT		 1460 /* if we're in a my(), we can't allow dynamics here.
1461 $foo'bar has already been turned into $foo::bar, so
1462 just check for colons.
1463
1464 if it's a legal name, the OP is a PADANY.
1465 */
3280af22
NIS		 1466 if (PL_in_my) {
1467 if (strchr(PL_tokenbuf,':'))
1468 croak(no_myglob,PL_tokenbuf);
02aa26ce 1469
bbce6d69 1470 yylval.opval = newOP(OP_PADANY, 0);
3280af22 1471 yylval.opval->op_targ = pad_allocmy(PL_tokenbuf);
bbce6d69 1472 return PRIVATEREF;
1473 }
1474
02aa26ce
NT		 1475 /*
1476 build the ops for accesses to a my() variable.
1477
1478 Deny my($a) or my($b) in a sort block, *if* $a or $b is
1479 then used in a comparison. This catches most, but not
1480 all cases. For instance, it catches
1481 sort { my($a); $a <=> $b }
1482 but not
1483 sort { my($a); $a < $b ? -1 : $a == $b ? 0 : 1; }
1484 (although why you'd do that is anyone's guess).
1485 */
1486
3280af22 1487 if (!strchr(PL_tokenbuf,':')) {
a863c7d1 1488#ifdef USE_THREADS
54b9620d 1489 /* Check for single character per-thread SVs */
3280af22
NIS		 1490 if (PL_tokenbuf[0] == '$' && PL_tokenbuf[2] == '\0'
1491 && !isALPHA(PL_tokenbuf[1]) /* Rule out obvious non-threadsvs */
1492 && (tmp = find_threadsv(&PL_tokenbuf[1])) != NOT_IN_PAD)
554b3eca 1493 {
2faa37cc 1494 yylval.opval = newOP(OP_THREADSV, 0);
a863c7d1
MB		 1495 yylval.opval->op_targ = tmp;
1496 return PRIVATEREF;
1497 }
1498#endif /* USE_THREADS */
3280af22 1499 if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
02aa26ce 1500 /* if it's a sort block and they're naming $a or $b */
3280af22
NIS		 1501 if (PL_last_lop_op == OP_SORT &&
1502 PL_tokenbuf[0] == '$' &&
1503 (PL_tokenbuf[1] == 'a' || PL_tokenbuf[1] == 'b')
1504 && !PL_tokenbuf[2])
bbce6d69 1505 {
3280af22
NIS		 1506 for (d = PL_in_eval ? PL_oldoldbufptr : PL_linestart;
1507 d < PL_bufend && *d != '\n';
a863c7d1
MB		 1508 d++)
1509 {
1510 if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
1511 croak("Can't use \"my %s\" in sort comparison",
3280af22 1512 PL_tokenbuf);
a863c7d1 1513 }
bbce6d69 1514 }
1515 }
bbce6d69 1516
a863c7d1
MB		 1517 yylval.opval = newOP(OP_PADANY, 0);
1518 yylval.opval->op_targ = tmp;
1519 return PRIVATEREF;
1520 }
bbce6d69 1521 }
1522
02aa26ce
NT		 1523 /*
1524 Whine if they've said @foo in a doublequoted string,
1525 and @foo isn't a variable we can find in the symbol
1526 table.
1527 */
3280af22
NIS		 1528 if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
1529 GV *gv = gv_fetchpv(PL_tokenbuf+1, FALSE, SVt_PVAV);
1530 if (!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
46fc3d4c 1531 yyerror(form("In string, %s now must be written as \\%s",
3280af22 1532 PL_tokenbuf, PL_tokenbuf));
bbce6d69 1533 }
1534
02aa26ce 1535 /* build ops for a bareword */
3280af22 1536 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0));
bbce6d69 1537 yylval.opval->op_private = OPpCONST_ENTERED;
3280af22
NIS		 1538 gv_fetchpv(PL_tokenbuf+1, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
1539 ((PL_tokenbuf[0] == '$') ? SVt_PV
1540 : (PL_tokenbuf[0] == '@') ? SVt_PVAV
bbce6d69 1541 : SVt_PVHV));
1542 return WORD;
1543 }
1544
02aa26ce
NT		 1545 /* no identifier pending identification */
1546
3280af22 1547 switch (PL_lex_state) {
79072805
LW		 1548#ifdef COMMENTARY
1549 case LEX_NORMAL: /* Some compilers will produce faster */
1550 case LEX_INTERPNORMAL: /* code if we comment these out. */
1551 break;
1552#endif
1553
02aa26ce 1554 /* when we're already built the next token, just pull it out the queue */
79072805 1555 case LEX_KNOWNEXT:
3280af22
NIS		 1556 PL_nexttoke--;
1557 yylval = PL_nextval[PL_nexttoke];
1558 if (!PL_nexttoke) {
1559 PL_lex_state = PL_lex_defer;
1560 PL_expect = PL_lex_expect;
1561 PL_lex_defer = LEX_NORMAL;
463ee0b2 1562 }
3280af22 1563 return(PL_nexttype[PL_nexttoke]);
79072805 1564
02aa26ce 1565 /* interpolated case modifiers like \L \U, including \Q and \E.
3280af22 1566 when we get here, PL_bufptr is at the \
02aa26ce 1567 */
79072805
LW		 1568 case LEX_INTERPCASEMOD:
1569#ifdef DEBUGGING
3280af22 1570 if (PL_bufptr != PL_bufend && *PL_bufptr != '\\')
463ee0b2 1571 croak("panic: INTERPCASEMOD");
79072805 1572#endif
02aa26ce 1573 /* handle \E or end of string */
3280af22 1574 if (PL_bufptr == PL_bufend || PL_bufptr[1] == 'E') {
a0d0e21e 1575 char oldmod;
02aa26ce
NT		 1576
1577 /* if at a \E */
3280af22
NIS		 1578 if (PL_lex_casemods) {
1579 oldmod = PL_lex_casestack[--PL_lex_casemods];
1580 PL_lex_casestack[PL_lex_casemods] = '\0';
02aa26ce 1581
3280af22
NIS		 1582 if (PL_bufptr != PL_bufend && strchr("LUQ", oldmod)) {
1583 PL_bufptr += 2;
1584 PL_lex_state = LEX_INTERPCONCAT;
a0d0e21e 1585 }
79072805
LW		 1586 return ')';
1587 }
3280af22
NIS		 1588 if (PL_bufptr != PL_bufend)
1589 PL_bufptr += 2;
1590 PL_lex_state = LEX_INTERPCONCAT;
79072805
LW		 1591 return yylex();
1592 }
1593 else {
3280af22 1594 s = PL_bufptr + 1;
79072805
LW		 1595 if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
1596 tmp = *s, *s = s[2], s[2] = tmp; /* misordered... */
a0d0e21e 1597 if (strchr("LU", *s) &&
3280af22 1598 (strchr(PL_lex_casestack, 'L') || strchr(PL_lex_casestack, 'U')))
a0d0e21e 1599 {
3280af22 1600 PL_lex_casestack[--PL_lex_casemods] = '\0';
a0d0e21e
LW		 1601 return ')';
1602 }
3280af22
NIS		 1603 if (PL_lex_casemods > 10) {
1604 char* newlb = Renew(PL_lex_casestack, PL_lex_casemods + 2, char);
1605 if (newlb != PL_lex_casestack) {
a0d0e21e 1606 SAVEFREEPV(newlb);
3280af22 1607 PL_lex_casestack = newlb;
a0d0e21e
LW		 1608 }
1609 }
3280af22
NIS		 1610 PL_lex_casestack[PL_lex_casemods++] = *s;
1611 PL_lex_casestack[PL_lex_casemods] = '\0';
1612 PL_lex_state = LEX_INTERPCONCAT;
1613 PL_nextval[PL_nexttoke].ival = 0;
79072805
LW		 1614 force_next('(');
1615 if (*s == 'l')
3280af22 1616 PL_nextval[PL_nexttoke].ival = OP_LCFIRST;
79072805 1617 else if (*s == 'u')
3280af22 1618 PL_nextval[PL_nexttoke].ival = OP_UCFIRST;
79072805 1619 else if (*s == 'L')
3280af22 1620 PL_nextval[PL_nexttoke].ival = OP_LC;
79072805 1621 else if (*s == 'U')
3280af22 1622 PL_nextval[PL_nexttoke].ival = OP_UC;
a0d0e21e 1623 else if (*s == 'Q')
3280af22 1624 PL_nextval[PL_nexttoke].ival = OP_QUOTEMETA;
79072805 1625 else
463ee0b2 1626 croak("panic: yylex");
3280af22 1627 PL_bufptr = s + 1;
79072805 1628 force_next(FUNC);
3280af22
NIS		 1629 if (PL_lex_starts) {
1630 s = PL_bufptr;
1631 PL_lex_starts = 0;
79072805
LW		 1632 Aop(OP_CONCAT);
1633 }
1634 else
1635 return yylex();
1636 }
1637
55497cff 1638 case LEX_INTERPPUSH:
1639 return sublex_push();
1640
79072805 1641 case LEX_INTERPSTART:
3280af22 1642 if (PL_bufptr == PL_bufend)
79072805 1643 return sublex_done();
3280af22
NIS		 1644 PL_expect = XTERM;
1645 PL_lex_dojoin = (*PL_bufptr == '@');
1646 PL_lex_state = LEX_INTERPNORMAL;
1647 if (PL_lex_dojoin) {
1648 PL_nextval[PL_nexttoke].ival = 0;
79072805 1649 force_next(',');
554b3eca 1650#ifdef USE_THREADS
533c011a
NIS		 1651 PL_nextval[PL_nexttoke].opval = newOP(OP_THREADSV, 0);
1652 PL_nextval[PL_nexttoke].opval->op_targ = find_threadsv("\"");
554b3eca
MB		 1653 force_next(PRIVATEREF);
1654#else
a0d0e21e 1655 force_ident("\"", '$');
554b3eca 1656#endif /* USE_THREADS */
3280af22 1657 PL_nextval[PL_nexttoke].ival = 0;
79072805 1658 force_next('$');
3280af22 1659 PL_nextval[PL_nexttoke].ival = 0;
79072805 1660 force_next('(');
3280af22 1661 PL_nextval[PL_nexttoke].ival = OP_JOIN; /* emulate join($", ...) */
79072805
LW		 1662 force_next(FUNC);
1663 }
3280af22
NIS		 1664 if (PL_lex_starts++) {
1665 s = PL_bufptr;
79072805
LW		 1666 Aop(OP_CONCAT);
1667 }
68dc0745 1668 return yylex();
79072805
LW		 1669
1670 case LEX_INTERPENDMAYBE:
3280af22
NIS		 1671 if (intuit_more(PL_bufptr)) {
1672 PL_lex_state = LEX_INTERPNORMAL; /* false alarm, more expr */
79072805
LW		 1673 break;
1674 }
1675 /* FALL THROUGH */
1676
1677 case LEX_INTERPEND:
3280af22
NIS		 1678 if (PL_lex_dojoin) {
1679 PL_lex_dojoin = FALSE;
1680 PL_lex_state = LEX_INTERPCONCAT;
79072805
LW		 1681 return ')';
1682 }
1683 /* FALLTHROUGH */
1684 case LEX_INTERPCONCAT:
1685#ifdef DEBUGGING
3280af22 1686 if (PL_lex_brackets)
463ee0b2 1687 croak("panic: INTERPCONCAT");
79072805 1688#endif
3280af22 1689 if (PL_bufptr == PL_bufend)
79072805
LW		 1690 return sublex_done();
1691
3280af22
NIS		 1692 if (SvIVX(PL_linestr) == '\'') {
1693 SV *sv = newSVsv(PL_linestr);
1694 if (!PL_lex_inpat)
76e3520e 1695 sv = tokeq(sv);
3280af22 1696 else if ( PL_hints & HINT_NEW_RE )
b3ac6de7 1697 sv = new_constant(NULL, 0, "qr", sv, sv, "q");
79072805 1698 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
3280af22 1699 s = PL_bufend;
79072805
LW		 1700 }
1701 else {
3280af22 1702 s = scan_const(PL_bufptr);
79072805 1703 if (*s == '\\')
3280af22 1704 PL_lex_state = LEX_INTERPCASEMOD;
79072805 1705 else
3280af22 1706 PL_lex_state = LEX_INTERPSTART;
79072805
LW		 1707 }
1708
3280af22
NIS		 1709 if (s != PL_bufptr) {
1710 PL_nextval[PL_nexttoke] = yylval;
1711 PL_expect = XTERM;
79072805 1712 force_next(THING);
3280af22 1713 if (PL_lex_starts++)
79072805
LW		 1714 Aop(OP_CONCAT);
1715 else {
3280af22 1716 PL_bufptr = s;
79072805
LW		 1717 return yylex();
1718 }
1719 }
1720
1721 return yylex();
a0d0e21e 1722 case LEX_FORMLINE:
3280af22
NIS		 1723 PL_lex_state = LEX_NORMAL;
1724 s = scan_formline(PL_bufptr);
1725 if (!PL_lex_formbrack)
a0d0e21e
LW		 1726 goto rightbracket;
1727 OPERATOR(';');
79072805
LW		 1728 }
1729
3280af22
NIS		 1730 s = PL_bufptr;
1731 PL_oldoldbufptr = PL_oldbufptr;
1732 PL_oldbufptr = s;
79072805 1733 DEBUG_p( {
3280af22 1734 PerlIO_printf(PerlIO_stderr(), "### Tokener expecting %s at %s\n", exp_name[PL_expect], s);
79072805 1735 } )
463ee0b2
LW		 1736
1737 retry:
378cc40b
LW		 1738 switch (*s) {
1739 default:
54310121 1740 croak("Unrecognized character \\%03o", *s & 255);
e929a76b
LW		 1741 case 4:
1742 case 26:
1743 goto fake_eof; /* emulate EOF on ^D or ^Z */
378cc40b 1744 case 0:
3280af22
NIS		 1745 if (!PL_rsfp) {
1746 PL_last_uni = 0;
1747 PL_last_lop = 0;
1748 if (PL_lex_brackets)
463ee0b2 1749 yyerror("Missing right bracket");
79072805 1750 TOKEN(0);
463ee0b2 1751 }
3280af22 1752 if (s++ < PL_bufend)
a687059c 1753 goto retry; /* ignore stray nulls */
3280af22
NIS		 1754 PL_last_uni = 0;
1755 PL_last_lop = 0;
1756 if (!PL_in_eval && !PL_preambled) {
1757 PL_preambled = TRUE;
1758 sv_setpv(PL_linestr,incl_perldb());
1759 if (SvCUR(PL_linestr))
1760 sv_catpv(PL_linestr,";");
1761 if (PL_preambleav){
1762 while(AvFILLp(PL_preambleav) >= 0) {
1763 SV *tmpsv = av_shift(PL_preambleav);
1764 sv_catsv(PL_linestr, tmpsv);
1765 sv_catpv(PL_linestr, ";");
91b7def8 1766 sv_free(tmpsv);
1767 }
3280af22
NIS		 1768 sv_free((SV*)PL_preambleav);
1769 PL_preambleav = NULL;
91b7def8 1770 }
3280af22
NIS		 1771 if (PL_minus_n || PL_minus_p) {
1772 sv_catpv(PL_linestr, "LINE: while (<>) {");
1773 if (PL_minus_l)
1774 sv_catpv(PL_linestr,"chomp;");
1775 if (PL_minus_a) {
8fd239a7
CS		 1776 GV* gv = gv_fetchpv("::F", TRUE, SVt_PVAV);
1777 if (gv)
1778 GvIMPORTED_AV_on(gv);
3280af22
NIS		 1779 if (PL_minus_F) {
1780 if (strchr("/'\"", *PL_splitstr)
1781 && strchr(PL_splitstr + 1, *PL_splitstr))
1782 sv_catpvf(PL_linestr, "@F=split(%s);", PL_splitstr);
54310121 1783 else {
1784 char delim;
1785 s = "'~#\200\1'"; /* surely one char is unused...*/
3280af22 1786 while (s[1] && strchr(PL_splitstr, *s)) s++;
54310121 1787 delim = *s;
3280af22 1788 sv_catpvf(PL_linestr, "@F=split(%s%c",
46fc3d4c 1789 "q" + (delim == '\''), delim);
3280af22 1790 for (s = PL_splitstr; *s; s++) {
54310121 1791 if (*s == '\\')
3280af22
NIS		 1792 sv_catpvn(PL_linestr, "\\", 1);
1793 sv_catpvn(PL_linestr, s, 1);
54310121 1794 }
3280af22 1795 sv_catpvf(PL_linestr, "%c);", delim);
54310121 1796 }
2304df62
AD		 1797 }
1798 else
3280af22 1799 sv_catpv(PL_linestr,"@F=split(' ');");
2304df62 1800 }
79072805 1801 }
3280af22
NIS		 1802 sv_catpv(PL_linestr, "\n");
1803 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
1804 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
1805 if (PERLDB_LINE && PL_curstash != PL_debstash) {
a0d0e21e
LW		 1806 SV *sv = NEWSV(85,0);
1807
1808 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 1809 sv_setsv(sv,PL_linestr);
1810 av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
a0d0e21e 1811 }
79072805 1812 goto retry;
a687059c 1813 }
e929a76b 1814 do {
3280af22 1815 if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
e929a76b 1816 fake_eof:
3280af22
NIS		 1817 if (PL_rsfp) {
1818 if (PL_preprocess && !PL_in_eval)
1819 (void)PerlProc_pclose(PL_rsfp);
1820 else if ((PerlIO *)PL_rsfp == PerlIO_stdin())
1821 PerlIO_clearerr(PL_rsfp);
395c3793 1822 else
3280af22
NIS		 1823 (void)PerlIO_close(PL_rsfp);
1824 PL_rsfp = Nullfp;
4a9ae47a 1825 PL_doextract = FALSE;
395c3793 1826 }
3280af22
NIS		 1827 if (!PL_in_eval && (PL_minus_n || PL_minus_p)) {
1828 sv_setpv(PL_linestr,PL_minus_p ? ";}continue{print" : "");
1829 sv_catpv(PL_linestr,";}");
1830 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
1831 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
1832 PL_minus_n = PL_minus_p = 0;
e929a76b
LW		 1833 goto retry;
1834 }
3280af22
NIS		 1835 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
1836 sv_setpv(PL_linestr,"");
79072805 1837 TOKEN(';'); /* not infinite loop because rsfp is NULL now */
378cc40b 1838 }
3280af22 1839 if (PL_doextract) {
a0d0e21e 1840 if (*s == '#' && s[1] == '!' && instr(s,"perl"))
3280af22 1841 PL_doextract = FALSE;
a0d0e21e
LW		 1842
1843 /* Incest with pod. */
1844 if (*s == '=' && strnEQ(s, "=cut", 4)) {
3280af22
NIS		 1845 sv_setpv(PL_linestr, "");
1846 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
1847 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
1848 PL_doextract = FALSE;
a0d0e21e
LW		 1849 }
1850 }
463ee0b2 1851 incline(s);
3280af22
NIS		 1852 } while (PL_doextract);
1853 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
1854 if (PERLDB_LINE && PL_curstash != PL_debstash) {
79072805 1855 SV *sv = NEWSV(85,0);
a687059c 1856
93a17b20 1857 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 1858 sv_setsv(sv,PL_linestr);
1859 av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
a687059c 1860 }
3280af22
NIS		 1861 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
1862 if (PL_curcop->cop_line == 1) {
1863 while (s < PL_bufend && isSPACE(*s))
79072805 1864 s++;
a0d0e21e 1865 if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
79072805 1866 s++;
44a8e56a 1867 d = Nullch;
3280af22 1868 if (!PL_in_eval) {
44a8e56a 1869 if (*s == '#' && *(s+1) == '!')
1870 d = s + 2;
1871#ifdef ALTERNATE_SHEBANG
1872 else {
1873 static char as[] = ALTERNATE_SHEBANG;
1874 if (*s == as[0] && strnEQ(s, as, sizeof(as) - 1))
1875 d = s + (sizeof(as) - 1);
1876 }
1877#endif /* ALTERNATE_SHEBANG */
1878 }
1879 if (d) {
b8378b72 1880 char *ipath;
774d564b 1881 char *ipathend;
b8378b72 1882
774d564b 1883 while (isSPACE(*d))
b8378b72
CS		 1884 d++;
1885 ipath = d;
774d564b 1886 while (*d && !isSPACE(*d))
1887 d++;
1888 ipathend = d;
1889
1890#ifdef ARG_ZERO_IS_SCRIPT
1891 if (ipathend > ipath) {
1892 /*
1893 * HP-UX (at least) sets argv[0] to the script name,
1894 * which makes $^X incorrect. And Digital UNIX and Linux,
1895 * at least, set argv[0] to the basename of the Perl
1896 * interpreter. So, having found "#!", we'll set it right.
1897 */
1898 SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
1899 assert(SvPOK(x) || SvGMAGICAL(x));
6b88bc9c 1900 if (sv_eq(x, GvSV(PL_curcop->cop_filegv))) {
774d564b 1901 sv_setpvn(x, ipath, ipathend - ipath);
9607fc9c 1902 SvSETMAGIC(x);
1903 }
774d564b 1904 TAINT_NOT; /* $^X is always tainted, but that's OK */
8ebc5c01 1905 }
774d564b 1906#endif /* ARG_ZERO_IS_SCRIPT */
b8378b72
CS		 1907
1908 /*
1909 * Look for options.
1910 */
748a9306
LW		 1911 d = instr(s,"perl -");
1912 if (!d)
1913 d = instr(s,"perl");
44a8e56a 1914#ifdef ALTERNATE_SHEBANG
1915 /*
1916 * If the ALTERNATE_SHEBANG on this system starts with a
1917 * character that can be part of a Perl expression, then if
1918 * we see it but not "perl", we're probably looking at the
1919 * start of Perl code, not a request to hand off to some
1920 * other interpreter. Similarly, if "perl" is there, but
1921 * not in the first 'word' of the line, we assume the line
1922 * contains the start of the Perl program.
44a8e56a 1923 */
1924 if (d && *s != '#') {
774d564b 1925 char *c = ipath;
44a8e56a 1926 while (*c && !strchr("; \t\r\n\f\v#", *c))
1927 c++;
1928 if (c < d)
1929 d = Nullch; /* "perl" not in first word; ignore */
1930 else
1931 *s = '#'; /* Don't try to parse shebang line */
1932 }
774d564b 1933#endif /* ALTERNATE_SHEBANG */
748a9306 1934 if (!d &&
44a8e56a 1935 *s == '#' &&
774d564b 1936 ipathend > ipath &&
3280af22 1937 !PL_minus_c &&
748a9306 1938 !instr(s,"indir") &&
3280af22 1939 instr(PL_origargv[0],"perl"))
748a9306 1940 {
9f68db38 1941 char **newargv;
9f68db38 1942
774d564b 1943 *ipathend = '\0';
1944 s = ipathend + 1;
3280af22 1945 while (s < PL_bufend && isSPACE(*s))
9f68db38 1946 s++;
3280af22
NIS		 1947 if (s < PL_bufend) {
1948 Newz(899,newargv,PL_origargc+3,char*);
9f68db38 1949 newargv[1] = s;
3280af22 1950 while (s < PL_bufend && !isSPACE(*s))
9f68db38
LW		 1951 s++;
1952 *s = '\0';
3280af22 1953 Copy(PL_origargv+1, newargv+2, PL_origargc+1, char*);
9f68db38
LW		 1954 }
1955 else
3280af22 1956 newargv = PL_origargv;
774d564b 1957 newargv[0] = ipath;
1958 execv(ipath, newargv);
1959 croak("Can't exec %s", ipath);
9f68db38 1960 }
748a9306 1961 if (d) {
3280af22
NIS		 1962 U32 oldpdb = PL_perldb;
1963 bool oldn = PL_minus_n;
1964 bool oldp = PL_minus_p;
748a9306
LW		 1965
1966 while (*d && !isSPACE(*d)) d++;
89bfa8cd 1967 while (*d == ' ' || *d == '\t') d++;
748a9306
LW		 1968
1969 if (*d++ == '-') {
8cc95fdb 1970 do {
1971 if (*d == 'M' || *d == 'm') {
1972 char *m = d;
1973 while (*d && !isSPACE(*d)) d++;
1974 croak("Too late for \"-%.*s\" option",
1975 (int)(d - m), m);
1976 }
1977 d = moreswitches(d);
1978 } while (d);
84902520 1979 if (PERLDB_LINE && !oldpdb ||
3280af22 1980 ( PL_minus_n || PL_minus_p ) && !(oldn || oldp) )
b084f20b 1981 /* if we have already added "LINE: while (<>) {",
1982 we must not do it again */
748a9306 1983 {
3280af22
NIS		 1984 sv_setpv(PL_linestr, "");
1985 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
1986 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
1987 PL_preambled = FALSE;
84902520 1988 if (PERLDB_LINE)
3280af22 1989 (void)gv_fetchfile(PL_origfilename);
748a9306
LW		 1990 goto retry;
1991 }
a0d0e21e 1992 }
79072805 1993 }
9f68db38 1994 }
79072805 1995 }
3280af22
NIS		 1996 if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
1997 PL_bufptr = s;
1998 PL_lex_state = LEX_FORMLINE;
a0d0e21e 1999 return yylex();
ae986130 2000 }
378cc40b 2001 goto retry;
4fdae800 2002 case '\r':
b8957cf1 2003#ifdef PERL_STRICT_CR
54310121 2004 warn("Illegal character \\%03o (carriage return)", '\r');
2005 croak(
2006 "(Maybe you didn't strip carriage returns after a network transfer?)\n");
a868473f 2007#endif
4fdae800 2008 case ' ': case '\t': case '\f': case 013:
378cc40b
LW		 2009 s++;
2010 goto retry;
378cc40b 2011 case '#':
e929a76b 2012 case '\n':
3280af22
NIS		 2013 if (PL_lex_state != LEX_NORMAL || (PL_in_eval && !PL_rsfp)) {
2014 d = PL_bufend;
a687059c 2015 while (s < d && *s != '\n')
378cc40b 2016 s++;
0f85fab0 2017 if (s < d)
378cc40b 2018 s++;
463ee0b2 2019 incline(s);
3280af22
NIS		 2020 if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
2021 PL_bufptr = s;
2022 PL_lex_state = LEX_FORMLINE;
a0d0e21e 2023 return yylex();
a687059c 2024 }
378cc40b 2025 }
a687059c 2026 else {
378cc40b 2027 *s = '\0';
3280af22 2028 PL_bufend = s;
a687059c 2029 }
378cc40b
LW		 2030 goto retry;
2031 case '-':
79072805 2032 if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
378cc40b 2033 s++;
3280af22 2034 PL_bufptr = s;
748a9306
LW		 2035 tmp = *s++;
2036
3280af22 2037 while (s < PL_bufend && (*s == ' ' || *s == '\t'))
748a9306
LW		 2038 s++;
2039
2040 if (strnEQ(s,"=>",2)) {
3280af22 2041 s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
748a9306
LW		 2042 OPERATOR('-'); /* unary minus */
2043 }
3280af22
NIS		 2044 PL_last_uni = PL_oldbufptr;
2045 PL_last_lop_op = OP_FTEREAD; /* good enough */
748a9306 2046 switch (tmp) {
79072805
LW		 2047 case 'r': FTST(OP_FTEREAD);
2048 case 'w': FTST(OP_FTEWRITE);
2049 case 'x': FTST(OP_FTEEXEC);
2050 case 'o': FTST(OP_FTEOWNED);
2051 case 'R': FTST(OP_FTRREAD);
2052 case 'W': FTST(OP_FTRWRITE);
2053 case 'X': FTST(OP_FTREXEC);
2054 case 'O': FTST(OP_FTROWNED);
2055 case 'e': FTST(OP_FTIS);
2056 case 'z': FTST(OP_FTZERO);
2057 case 's': FTST(OP_FTSIZE);
2058 case 'f': FTST(OP_FTFILE);
2059 case 'd': FTST(OP_FTDIR);
2060 case 'l': FTST(OP_FTLINK);
2061 case 'p': FTST(OP_FTPIPE);
2062 case 'S': FTST(OP_FTSOCK);
2063 case 'u': FTST(OP_FTSUID);
2064 case 'g': FTST(OP_FTSGID);
2065 case 'k': FTST(OP_FTSVTX);
2066 case 'b': FTST(OP_FTBLK);
2067 case 'c': FTST(OP_FTCHR);
2068 case 't': FTST(OP_FTTTY);
2069 case 'T': FTST(OP_FTTEXT);
2070 case 'B': FTST(OP_FTBINARY);
85e6fe83
LW		 2071 case 'M': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTMTIME);
2072 case 'A': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTATIME);
2073 case 'C': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTCTIME);
378cc40b 2074 default:
ff0cee69 2075 croak("Unrecognized file test: -%c", (int)tmp);
378cc40b
LW		 2076 break;
2077 }
2078 }
a687059c
LW		 2079 tmp = *s++;
2080 if (*s == tmp) {
2081 s++;
3280af22 2082 if (PL_expect == XOPERATOR)
79072805
LW		 2083 TERM(POSTDEC);
2084 else
2085 OPERATOR(PREDEC);
2086 }
2087 else if (*s == '>') {
2088 s++;
2089 s = skipspace(s);
2090 if (isIDFIRST(*s)) {
a0d0e21e 2091 s = force_word(s,METHOD,FALSE,TRUE,FALSE);
463ee0b2 2092 TOKEN(ARROW);
79072805 2093 }
748a9306
LW		 2094 else if (*s == '$')
2095 OPERATOR(ARROW);
463ee0b2 2096 else
748a9306 2097 TERM(ARROW);
a687059c 2098 }
3280af22 2099 if (PL_expect == XOPERATOR)
79072805
LW		 2100 Aop(OP_SUBTRACT);
2101 else {
3280af22 2102 if (isSPACE(*s) || !isSPACE(*PL_bufptr))
2f3197b3 2103 check_uni();
79072805 2104 OPERATOR('-'); /* unary minus */
2f3197b3 2105 }
79072805 2106
378cc40b 2107 case '+':
a687059c
LW		 2108 tmp = *s++;
2109 if (*s == tmp) {
378cc40b 2110 s++;
3280af22 2111 if (PL_expect == XOPERATOR)
79072805
LW		 2112 TERM(POSTINC);
2113 else
2114 OPERATOR(PREINC);
378cc40b 2115 }
3280af22 2116 if (PL_expect == XOPERATOR)
79072805
LW		 2117 Aop(OP_ADD);
2118 else {
3280af22 2119 if (isSPACE(*s) || !isSPACE(*PL_bufptr))
2f3197b3 2120 check_uni();
a687059c 2121 OPERATOR('+');
2f3197b3 2122 }
a687059c 2123
378cc40b 2124 case '*':
3280af22
NIS		 2125 if (PL_expect != XOPERATOR) {
2126 s = scan_ident(s, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE);
2127 PL_expect = XOPERATOR;
2128 force_ident(PL_tokenbuf, '*');
2129 if (!*PL_tokenbuf)
a0d0e21e 2130 PREREF('*');
79072805 2131 TERM('*');
a687059c 2132 }
79072805
LW		 2133 s++;
2134 if (*s == '*') {
a687059c 2135 s++;
79072805 2136 PWop(OP_POW);
a687059c 2137 }
79072805
LW		 2138 Mop(OP_MULTIPLY);
2139
378cc40b 2140 case '%':
3280af22 2141 if (PL_expect == XOPERATOR) {
bbce6d69 2142 ++s;
2143 Mop(OP_MODULO);
a687059c 2144 }
3280af22
NIS		 2145 PL_tokenbuf[0] = '%';
2146 s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, TRUE);
2147 if (!PL_tokenbuf[1]) {
2148 if (s == PL_bufend)
bbce6d69 2149 yyerror("Final % should be \\% or %name");
2150 PREREF('%');
a687059c 2151 }
3280af22 2152 PL_pending_ident = '%';
bbce6d69 2153 TERM('%');
a687059c 2154
378cc40b 2155 case '^':
79072805 2156 s++;
a0d0e21e 2157 BOop(OP_BIT_XOR);
79072805 2158 case '[':
3280af22 2159 PL_lex_brackets++;
79072805 2160 /* FALL THROUGH */
378cc40b 2161 case '~':
378cc40b 2162 case ',':
378cc40b
LW		 2163 tmp = *s++;
2164 OPERATOR(tmp);
a0d0e21e
LW		 2165 case ':':
2166 if (s[1] == ':') {
2167 len = 0;
2168 goto just_a_word;
2169 }
2170 s++;
2171 OPERATOR(':');
8990e307
LW		 2172 case '(':
2173 s++;
3280af22
NIS		 2174 if (PL_last_lop == PL_oldoldbufptr || PL_last_uni == PL_oldoldbufptr)
2175 PL_oldbufptr = PL_oldoldbufptr; /* allow print(STDOUT 123) */
a0d0e21e 2176 else
3280af22 2177 PL_expect = XTERM;
a0d0e21e 2178 TOKEN('(');
378cc40b 2179 case ';':
3280af22
NIS		 2180 if (PL_curcop->cop_line < PL_copline)
2181 PL_copline = PL_curcop->cop_line;
378cc40b
LW		 2182 tmp = *s++;
2183 OPERATOR(tmp);
2184 case ')':
378cc40b 2185 tmp = *s++;
16d20bd9
AD		 2186 s = skipspace(s);
2187 if (*s == '{')
2188 PREBLOCK(tmp);
378cc40b 2189 TERM(tmp);
79072805
LW		 2190 case ']':
2191 s++;
3280af22 2192 if (PL_lex_brackets <= 0)
463ee0b2
LW		 2193 yyerror("Unmatched right bracket");
2194 else
3280af22
NIS		 2195 --PL_lex_brackets;
2196 if (PL_lex_state == LEX_INTERPNORMAL) {
2197 if (PL_lex_brackets == 0) {
a0d0e21e 2198 if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
3280af22 2199 PL_lex_state = LEX_INTERPEND;
79072805
LW		 2200 }
2201 }
4633a7c4 2202 TERM(']');
79072805
LW		 2203 case '{':
2204 leftbracket:
79072805 2205 s++;
3280af22
NIS		 2206 if (PL_lex_brackets > 100) {
2207 char* newlb = Renew(PL_lex_brackstack, PL_lex_brackets + 1, char);
2208 if (newlb != PL_lex_brackstack) {
8990e307 2209 SAVEFREEPV(newlb);
3280af22 2210 PL_lex_brackstack = newlb;
8990e307
LW		 2211 }
2212 }
3280af22 2213 switch (PL_expect) {
a0d0e21e 2214 case XTERM:
3280af22 2215 if (PL_lex_formbrack) {
a0d0e21e
LW		 2216 s--;
2217 PRETERMBLOCK(DO);
2218 }
3280af22
NIS		 2219 if (PL_oldoldbufptr == PL_last_lop)
2220 PL_lex_brackstack[PL_lex_brackets++] = XTERM;
a0d0e21e 2221 else
3280af22 2222 PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
79072805 2223 OPERATOR(HASHBRACK);
a0d0e21e 2224 case XOPERATOR:
3280af22 2225 while (s < PL_bufend && (*s == ' ' || *s == '\t'))
748a9306 2226 s++;
44a8e56a 2227 d = s;
3280af22
NIS		 2228 PL_tokenbuf[0] = '\0';
2229 if (d < PL_bufend && *d == '-') {
2230 PL_tokenbuf[0] = '-';
44a8e56a 2231 d++;
3280af22 2232 while (d < PL_bufend && (*d == ' ' || *d == '\t'))
44a8e56a 2233 d++;
2234 }
3280af22
NIS		 2235 if (d < PL_bufend && isIDFIRST(*d)) {
2236 d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
8903cb82 2237 FALSE, &len);
3280af22 2238 while (d < PL_bufend && (*d == ' ' || *d == '\t'))
748a9306
LW		 2239 d++;
2240 if (*d == '}') {
3280af22 2241 char minus = (PL_tokenbuf[0] == '-');
44a8e56a 2242 s = force_word(s + minus, WORD, FALSE, TRUE, FALSE);
2243 if (minus)
2244 force_next('-');
748a9306
LW		 2245 }
2246 }
2247 /* FALL THROUGH */
2248 case XBLOCK:
3280af22
NIS		 2249 PL_lex_brackstack[PL_lex_brackets++] = XSTATE;
2250 PL_expect = XSTATE;
a0d0e21e
LW		 2251 break;
2252 case XTERMBLOCK:
3280af22
NIS		 2253 PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
2254 PL_expect = XSTATE;
a0d0e21e
LW		 2255 break;
2256 default: {
2257 char *t;
3280af22
NIS		 2258 if (PL_oldoldbufptr == PL_last_lop)
2259 PL_lex_brackstack[PL_lex_brackets++] = XTERM;
a0d0e21e 2260 else
3280af22 2261 PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
a0d0e21e 2262 s = skipspace(s);
09ecc4b6 2263 if (*s == '}')
a0d0e21e 2264 OPERATOR(HASHBRACK);
b8a4b1be
GS		 2265 /* This hack serves to disambiguate a pair of curlies
2266 * as being a block or an anon hash. Normally, expectation
2267 * determines that, but in cases where we're not in a
2268 * position to expect anything in particular (like inside
2269 * eval"") we have to resolve the ambiguity. This code
2270 * covers the case where the first term in the curlies is a
2271 * quoted string. Most other cases need to be explicitly
2272 * disambiguated by prepending a `+' before the opening
2273 * curly in order to force resolution as an anon hash.
2274 *
2275 * XXX should probably propagate the outer expectation
2276 * into eval"" to rely less on this hack, but that could
2277 * potentially break current behavior of eval"".
2278 * GSAR 97-07-21
2279 */
2280 t = s;
2281 if (*s == '\'' || *s == '"' || *s == '`') {
2282 /* common case: get past first string, handling escapes */
3280af22 2283 for (t++; t < PL_bufend && *t != *s;)
b8a4b1be
GS		 2284 if (*t++ == '\\' && (*t == '\\' || *t == *s))
2285 t++;
2286 t++;
a0d0e21e 2287 }
b8a4b1be 2288 else if (*s == 'q') {
3280af22 2289 if (++t < PL_bufend
b8a4b1be 2290 && (!isALNUM(*t)
3280af22 2291 || ((*t == 'q' || *t == 'x') && ++t < PL_bufend
b8a4b1be
GS		 2292 && !isALNUM(*t)))) {
2293 char *tmps;
2294 char open, close, term;
2295 I32 brackets = 1;
2296
3280af22 2297 while (t < PL_bufend && isSPACE(*t))
b8a4b1be
GS		 2298 t++;
2299 term = *t;
2300 open = term;
2301 if (term && (tmps = strchr("([{< )]}> )]}>",term)))
2302 term = tmps[5];
2303 close = term;
2304 if (open == close)
3280af22
NIS		 2305 for (t++; t < PL_bufend; t++) {
2306 if (*t == '\\' && t+1 < PL_bufend && open != '\\')
b8a4b1be 2307 t++;
6d07e5e9 2308 else if (*t == open)
b8a4b1be
GS		 2309 break;
2310 }
2311 else
3280af22
NIS		 2312 for (t++; t < PL_bufend; t++) {
2313 if (*t == '\\' && t+1 < PL_bufend)
b8a4b1be 2314 t++;
6d07e5e9 2315 else if (*t == close && --brackets <= 0)
b8a4b1be
GS		 2316 break;
2317 else if (*t == open)
2318 brackets++;
2319 }
2320 }
2321 t++;
a0d0e21e 2322 }
b8a4b1be 2323 else if (isALPHA(*s)) {
3280af22 2324 for (t++; t < PL_bufend && isALNUM(*t); t++) ;
a0d0e21e 2325 }
3280af22 2326 while (t < PL_bufend && isSPACE(*t))
a0d0e21e 2327 t++;
b8a4b1be
GS		 2328 /* if comma follows first term, call it an anon hash */
2329 /* XXX it could be a comma expression with loop modifiers */
3280af22 2330 if (t < PL_bufend && ((*t == ',' && (*s == 'q' || !isLOWER(*s)))
b8a4b1be 2331 || (*t == '=' && t[1] == '>')))
a0d0e21e 2332 OPERATOR(HASHBRACK);
3280af22
NIS		 2333 if (PL_expect == XREF)
2334 PL_expect = XTERM;
a0d0e21e 2335 else {
3280af22
NIS		 2336 PL_lex_brackstack[PL_lex_brackets-1] = XSTATE;
2337 PL_expect = XSTATE;
a0d0e21e 2338 }
8990e307 2339 }
a0d0e21e 2340 break;
463ee0b2 2341 }
3280af22 2342 yylval.ival = PL_curcop->cop_line;
79072805 2343 if (isSPACE(*s) || *s == '#')
3280af22 2344 PL_copline = NOLINE; /* invalidate current command line number */
79072805 2345 TOKEN('{');
378cc40b 2346 case '}':
79072805
LW		 2347 rightbracket:
2348 s++;
3280af22 2349 if (PL_lex_brackets <= 0)
463ee0b2
LW		 2350 yyerror("Unmatched right bracket");
2351 else
3280af22
NIS		 2352 PL_expect = (expectation)PL_lex_brackstack[--PL_lex_brackets];
2353 if (PL_lex_brackets < PL_lex_formbrack)
2354 PL_lex_formbrack = 0;
2355 if (PL_lex_state == LEX_INTERPNORMAL) {
2356 if (PL_lex_brackets == 0) {
2357 if (PL_lex_fakebrack) {
2358 PL_lex_state = LEX_INTERPEND;
2359 PL_bufptr = s;
79072805
LW		 2360 return yylex(); /* ignore fake brackets */
2361 }
fa83b5b6 2362 if (*s == '-' && s[1] == '>')
3280af22 2363 PL_lex_state = LEX_INTERPENDMAYBE;
fa83b5b6 2364 else if (*s != '[' && *s != '{')
3280af22 2365 PL_lex_state = LEX_INTERPEND;
79072805
LW		 2366 }
2367 }
3280af22
NIS		 2368 if (PL_lex_brackets < PL_lex_fakebrack) {
2369 PL_bufptr = s;
2370 PL_lex_fakebrack = 0;
748a9306
LW		 2371 return yylex(); /* ignore fake brackets */
2372 }
79072805
LW		 2373 force_next('}');
2374 TOKEN(';');
378cc40b
LW		 2375 case '&':
2376 s++;
2377 tmp = *s++;
2378 if (tmp == '&')
a0d0e21e 2379 AOPERATOR(ANDAND);
378cc40b 2380 s--;
3280af22
NIS		 2381 if (PL_expect == XOPERATOR) {
2382 if (PL_dowarn && isALPHA(*s) && PL_bufptr == PL_linestart) {
2383 PL_curcop->cop_line--;
463ee0b2 2384 warn(warn_nosemi);
3280af22 2385 PL_curcop->cop_line++;
463ee0b2 2386 }
79072805 2387 BAop(OP_BIT_AND);
463ee0b2 2388 }
79072805 2389
3280af22
NIS		 2390 s = scan_ident(s - 1, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE);
2391 if (*PL_tokenbuf) {
2392 PL_expect = XOPERATOR;
2393 force_ident(PL_tokenbuf, '&');
463ee0b2 2394 }
79072805
LW		 2395 else
2396 PREREF('&');
c07a80fd 2397 yylval.ival = (OPpENTERSUB_AMPER<<8);
79072805
LW		 2398 TERM('&');
2399
378cc40b
LW		 2400 case '|':
2401 s++;
2402 tmp = *s++;
2403 if (tmp == '|')
a0d0e21e 2404 AOPERATOR(OROR);
378cc40b 2405 s--;
79072805 2406 BOop(OP_BIT_OR);
378cc40b
LW		 2407 case '=':
2408 s++;
2409 tmp = *s++;
2410 if (tmp == '=')
79072805
LW		 2411 Eop(OP_EQ);
2412 if (tmp == '>')
2413 OPERATOR(',');
378cc40b 2414 if (tmp == '~')
79072805 2415 PMop(OP_MATCH);
3280af22 2416 if (PL_dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
ff0cee69 2417 warn("Reversed %c= operator",(int)tmp);
378cc40b 2418 s--;
3280af22
NIS		 2419 if (PL_expect == XSTATE && isALPHA(tmp) &&
2420 (s == PL_linestart+1 || s[-2] == '\n') )
748a9306 2421 {
3280af22
NIS		 2422 if (PL_in_eval && !PL_rsfp) {
2423 d = PL_bufend;
a5f75d66
AD		 2424 while (s < d) {
2425 if (*s++ == '\n') {
2426 incline(s);
2427 if (strnEQ(s,"=cut",4)) {
2428 s = strchr(s,'\n');
2429 if (s)
2430 s++;
2431 else
2432 s = d;
2433 incline(s);
2434 goto retry;
2435 }
2436 }
2437 }
2438 goto retry;
2439 }
3280af22
NIS		 2440 s = PL_bufend;
2441 PL_doextract = TRUE;
a0d0e21e
LW		 2442 goto retry;
2443 }
3280af22 2444 if (PL_lex_brackets < PL_lex_formbrack) {
a0d0e21e
LW		 2445 char *t;
2446 for (t = s; *t == ' ' || *t == '\t'; t++) ;
2447 if (*t == '\n' || *t == '#') {
2448 s--;
3280af22 2449 PL_expect = XBLOCK;
a0d0e21e
LW		 2450 goto leftbracket;
2451 }
79072805 2452 }
a0d0e21e
LW		 2453 yylval.ival = 0;
2454 OPERATOR(ASSIGNOP);
378cc40b
LW		 2455 case '!':
2456 s++;
2457 tmp = *s++;
2458 if (tmp == '=')
79072805 2459 Eop(OP_NE);
378cc40b 2460 if (tmp == '~')
79072805 2461 PMop(OP_NOT);
378cc40b
LW		 2462 s--;
2463 OPERATOR('!');
2464 case '<':
3280af22 2465 if (PL_expect != XOPERATOR) {
93a17b20 2466 if (s[1] != '<' && !strchr(s,'>'))
2f3197b3 2467 check_uni();
79072805
LW		 2468 if (s[1] == '<')
2469 s = scan_heredoc(s);
2470 else
2471 s = scan_inputsymbol(s);
2472 TERM(sublex_start());
378cc40b
LW		 2473 }
2474 s++;
2475 tmp = *s++;
2476 if (tmp == '<')
79072805 2477 SHop(OP_LEFT_SHIFT);
395c3793
LW		 2478 if (tmp == '=') {
2479 tmp = *s++;
2480 if (tmp == '>')
79072805 2481 Eop(OP_NCMP);
395c3793 2482 s--;
79072805 2483 Rop(OP_LE);
395c3793 2484 }
378cc40b 2485 s--;
79072805 2486 Rop(OP_LT);
378cc40b
LW		 2487 case '>':
2488 s++;
2489 tmp = *s++;
2490 if (tmp == '>')
79072805 2491 SHop(OP_RIGHT_SHIFT);
378cc40b 2492 if (tmp == '=')
79072805 2493 Rop(OP_GE);
378cc40b 2494 s--;
79072805 2495 Rop(OP_GT);
378cc40b
LW		 2496
2497 case '$':
bbce6d69 2498 CLINE;
2499
3280af22
NIS		 2500 if (PL_expect == XOPERATOR) {
2501 if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
2502 PL_expect = XTERM;
a0d0e21e 2503 depcom();
bbce6d69 2504 return ','; /* grandfather non-comma-format format */
a0d0e21e 2505 }
8990e307 2506 }
a0d0e21e 2507
bbce6d69 2508 if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$:", s[2]))) {
3280af22
NIS		 2509 if (PL_expect == XOPERATOR)
2510 no_op("Array length", PL_bufptr);
2511 PL_tokenbuf[0] = '@';
2512 s = scan_ident(s + 1, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
8903cb82 2513 FALSE);
3280af22 2514 if (!PL_tokenbuf[1])
a0d0e21e 2515 PREREF(DOLSHARP);
3280af22
NIS		 2516 PL_expect = XOPERATOR;
2517 PL_pending_ident = '#';
463ee0b2 2518 TOKEN(DOLSHARP);
79072805 2519 }
bbce6d69 2520
3280af22
NIS		 2521 if (PL_expect == XOPERATOR)
2522 no_op("Scalar", PL_bufptr);
2523 PL_tokenbuf[0] = '$';
2524 s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
2525 if (!PL_tokenbuf[1]) {
2526 if (s == PL_bufend)
bbce6d69 2527 yyerror("Final $ should be \\$ or $name");
2528 PREREF('$');
8990e307 2529 }
a0d0e21e 2530
bbce6d69 2531 /* This kludge not intended to be bulletproof. */
3280af22 2532 if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) {
bbce6d69 2533 yylval.opval = newSVOP(OP_CONST, 0,
3280af22 2534 newSViv((IV)PL_compiling.cop_arybase));
bbce6d69 2535 yylval.opval->op_private = OPpCONST_ARYBASE;
2536 TERM(THING);
2537 }
2538
ff68c719 2539 d = s;
3280af22 2540 if (PL_lex_state == LEX_NORMAL)
ff68c719 2541 s = skipspace(s);
2542
3280af22 2543 if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
bbce6d69 2544 char *t;
2545 if (*s == '[') {
3280af22
NIS		 2546 PL_tokenbuf[0] = '@';
2547 if (PL_dowarn) {
bbce6d69 2548 for(t = s + 1;
2549 isSPACE(*t) || isALNUM(*t) || *t == '$';
2550 t++) ;
a0d0e21e 2551 if (*t++ == ',') {
3280af22
NIS		 2552 PL_bufptr = skipspace(PL_bufptr);
2553 while (t < PL_bufend && *t != ']')
bbce6d69 2554 t++;
a0d0e21e 2555 warn("Multidimensional syntax %.*s not supported",
3280af22 2556 (t - PL_bufptr) + 1, PL_bufptr);
a0d0e21e
LW		 2557 }
2558 }
bbce6d69 2559 }
2560 else if (*s == '{') {
3280af22
NIS		 2561 PL_tokenbuf[0] = '%';
2562 if (PL_dowarn && strEQ(PL_tokenbuf+1, "SIG") &&
bbce6d69 2563 (t = strchr(s, '}')) && (t = strchr(t, '=')))
2564 {
3280af22 2565 char tmpbuf[sizeof PL_tokenbuf];
a0d0e21e
LW		 2566 STRLEN len;
2567 for (t++; isSPACE(*t); t++) ;
748a9306 2568 if (isIDFIRST(*t)) {
8903cb82 2569 t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
748a9306
LW		 2570 if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
2571 warn("You need to quote \"%s\"", tmpbuf);
2572 }
93a17b20
LW		 2573 }
2574 }
2f3197b3 2575 }
bbce6d69 2576
3280af22
NIS		 2577 PL_expect = XOPERATOR;
2578 if (PL_lex_state == LEX_NORMAL && isSPACE(*d)) {
2579 bool islop = (PL_last_lop == PL_oldoldbufptr);
2580 if (!islop || PL_last_lop_op == OP_GREPSTART)
2581 PL_expect = XOPERATOR;
bbce6d69 2582 else if (strchr("$@\"'`q", *s))
3280af22 2583 PL_expect = XTERM; /* e.g. print $fh "foo" */
bbce6d69 2584 else if (strchr("&*<%", *s) && isIDFIRST(s[1]))
3280af22 2585 PL_expect = XTERM; /* e.g. print $fh &sub */
68dc0745 2586 else if (isIDFIRST(*s)) {
3280af22 2587 char tmpbuf[sizeof PL_tokenbuf];
8903cb82 2588 scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
84902520
TB		 2589 if (tmp = keyword(tmpbuf, len)) {
2590 /* binary operators exclude handle interpretations */
2591 switch (tmp) {
2592 case -KEY_x:
2593 case -KEY_eq:
2594 case -KEY_ne:
2595 case -KEY_gt:
2596 case -KEY_lt:
2597 case -KEY_ge:
2598 case -KEY_le:
2599 case -KEY_cmp:
2600 break;
2601 default:
3280af22 2602 PL_expect = XTERM; /* e.g. print $fh length() */
84902520
TB		 2603 break;
2604 }
2605 }
68dc0745 2606 else {
2607 GV *gv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
2608 if (gv && GvCVu(gv))
3280af22 2609 PL_expect = XTERM; /* e.g. print $fh subr() */
93a17b20 2610 }
93a17b20 2611 }
bbce6d69 2612 else if (isDIGIT(*s))
3280af22 2613 PL_expect = XTERM; /* e.g. print $fh 3 */
bbce6d69 2614 else if (*s == '.' && isDIGIT(s[1]))
3280af22 2615 PL_expect = XTERM; /* e.g. print $fh .3 */
bbce6d69 2616 else if (strchr("/?-+", *s) && !isSPACE(s[1]))
3280af22 2617 PL_expect = XTERM; /* e.g. print $fh -1 */
bbce6d69 2618 else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]))
3280af22 2619 PL_expect = XTERM; /* print $fh <<"EOF" */
bbce6d69 2620 }
3280af22 2621 PL_pending_ident = '$';
79072805 2622 TOKEN('$');
378cc40b
LW		 2623
2624 case '@':
3280af22 2625 if (PL_expect == XOPERATOR)
bbce6d69 2626 no_op("Array", s);
3280af22
NIS		 2627 PL_tokenbuf[0] = '@';
2628 s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
2629 if (!PL_tokenbuf[1]) {
2630 if (s == PL_bufend)
bbce6d69 2631 yyerror("Final @ should be \\@ or @name");
2632 PREREF('@');
2633 }
3280af22 2634 if (PL_lex_state == LEX_NORMAL)
ff68c719 2635 s = skipspace(s);
3280af22 2636 if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
bbce6d69 2637 if (*s == '{')
3280af22 2638 PL_tokenbuf[0] = '%';
a0d0e21e
LW		 2639
2640 /* Warn about @ where they meant $. */
3280af22 2641 if (PL_dowarn) {
a0d0e21e
LW		 2642 if (*s == '[' || *s == '{') {
2643 char *t = s + 1;
2644 while (*t && (isALNUM(*t) || strchr(" \t$#+-'\"", *t)))
2645 t++;
2646 if (*t == '}' || *t == ']') {
2647 t++;
3280af22 2648 PL_bufptr = skipspace(PL_bufptr);
a0d0e21e 2649 warn("Scalar value %.*s better written as $%.*s",
3280af22 2650 t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1);
a0d0e21e 2651 }
93a17b20
LW		 2652 }
2653 }
463ee0b2 2654 }
3280af22 2655 PL_pending_ident = '@';
79072805 2656 TERM('@');
378cc40b
LW		 2657
2658 case '/': /* may either be division or pattern */
2659 case '?': /* may either be conditional or pattern */
3280af22 2660 if (PL_expect != XOPERATOR) {
c277df42 2661 /* Disable warning on "study /blah/" */
3280af22
NIS		 2662 if (PL_oldoldbufptr == PL_last_uni
2663 && (*PL_last_uni != 's' || s - PL_last_uni < 5
2664 || memNE(PL_last_uni, "study", 5) || isALNUM(PL_last_uni[5])))
c277df42 2665 check_uni();
8782bef2 2666 s = scan_pat(s,OP_MATCH);
79072805 2667 TERM(sublex_start());
378cc40b
LW		 2668 }
2669 tmp = *s++;
a687059c 2670 if (tmp == '/')
79072805 2671 Mop(OP_DIVIDE);
378cc40b
LW		 2672 OPERATOR(tmp);
2673
2674 case '.':
3280af22
NIS		 2675 if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack && s[1] == '\n' &&
2676 (s == PL_linestart || s[-1] == '\n') ) {
2677 PL_lex_formbrack = 0;
2678 PL_expect = XSTATE;
79072805
LW		 2679 goto rightbracket;
2680 }
3280af22 2681 if (PL_expect == XOPERATOR || !isDIGIT(s[1])) {
378cc40b 2682 tmp = *s++;
a687059c
LW		 2683 if (*s == tmp) {
2684 s++;
2f3197b3
LW		 2685 if (*s == tmp) {
2686 s++;
79072805 2687 yylval.ival = OPf_SPECIAL;
2f3197b3
LW		 2688 }
2689 else
79072805 2690 yylval.ival = 0;
378cc40b 2691 OPERATOR(DOTDOT);
a687059c 2692 }
3280af22 2693 if (PL_expect != XOPERATOR)
2f3197b3 2694 check_uni();
79072805 2695 Aop(OP_CONCAT);
378cc40b
LW		 2696 }
2697 /* FALL THROUGH */
2698 case '0': case '1': case '2': case '3': case '4':
2699 case '5': case '6': case '7': case '8': case '9':
79072805 2700 s = scan_num(s);
3280af22 2701 if (PL_expect == XOPERATOR)
8990e307 2702 no_op("Number",s);
79072805
LW		 2703 TERM(THING);
2704
2705 case '\'':
8990e307 2706 s = scan_str(s);
3280af22
NIS		 2707 if (PL_expect == XOPERATOR) {
2708 if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
2709 PL_expect = XTERM;
a0d0e21e
LW		 2710 depcom();
2711 return ','; /* grandfather non-comma-format format */
2712 }
463ee0b2 2713 else
8990e307 2714 no_op("String",s);
463ee0b2 2715 }
79072805 2716 if (!s)
85e6fe83 2717 missingterm((char*)0);
79072805
LW		 2718 yylval.ival = OP_CONST;
2719 TERM(sublex_start());
2720
2721 case '"':
8990e307 2722 s = scan_str(s);
3280af22
NIS		 2723 if (PL_expect == XOPERATOR) {
2724 if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
2725 PL_expect = XTERM;
a0d0e21e
LW		 2726 depcom();
2727 return ','; /* grandfather non-comma-format format */
2728 }
463ee0b2 2729 else
8990e307 2730 no_op("String",s);
463ee0b2 2731 }
79072805 2732 if (!s)
85e6fe83 2733 missingterm((char*)0);
4633a7c4 2734 yylval.ival = OP_CONST;
3280af22 2735 for (d = SvPV(PL_lex_stuff, len); len; len--, d++) {
4633a7c4
LW		 2736 if (*d == '$' || *d == '@' || *d == '\\') {
2737 yylval.ival = OP_STRINGIFY;
2738 break;
2739 }
2740 }
79072805
LW		 2741 TERM(sublex_start());
2742
2743 case '`':
2744 s = scan_str(s);
3280af22 2745 if (PL_expect == XOPERATOR)
8990e307 2746 no_op("Backticks",s);
79072805 2747 if (!s)
85e6fe83 2748 missingterm((char*)0);
79072805
LW		 2749 yylval.ival = OP_BACKTICK;
2750 set_csh();
2751 TERM(sublex_start());
2752
2753 case '\\':
2754 s++;
3280af22 2755 if (PL_dowarn && PL_lex_inwhat && isDIGIT(*s))
748a9306 2756 warn("Can't use \\%c to mean $%c in expression", *s, *s);
3280af22 2757 if (PL_expect == XOPERATOR)
8990e307 2758 no_op("Backslash",s);
79072805
LW		 2759 OPERATOR(REFGEN);
2760
2761 case 'x':
3280af22 2762 if (isDIGIT(s[1]) && PL_expect == XOPERATOR) {
79072805
LW		 2763 s++;
2764 Mop(OP_REPEAT);
2f3197b3 2765 }
79072805
LW		 2766 goto keylookup;
2767
378cc40b 2768 case '_':
79072805
LW		 2769 case 'a': case 'A':
2770 case 'b': case 'B':
2771 case 'c': case 'C':
2772 case 'd': case 'D':
2773 case 'e': case 'E':
2774 case 'f': case 'F':
2775 case 'g': case 'G':
2776 case 'h': case 'H':
2777 case 'i': case 'I':
2778 case 'j': case 'J':
2779 case 'k': case 'K':
2780 case 'l': case 'L':
2781 case 'm': case 'M':
2782 case 'n': case 'N':
2783 case 'o': case 'O':
2784 case 'p': case 'P':
2785 case 'q': case 'Q':
2786 case 'r': case 'R':
2787 case 's': case 'S':
2788 case 't': case 'T':
2789 case 'u': case 'U':
2790 case 'v': case 'V':
2791 case 'w': case 'W':
2792 case 'X':
2793 case 'y': case 'Y':
2794 case 'z': case 'Z':
2795
49dc05e3 2796 keylookup: {
161b471a
NIS		 2797 gv = Nullgv;
2798 gvp = 0;
49dc05e3 2799
3280af22
NIS		 2800 PL_bufptr = s;
2801 s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
8ebc5c01 2802
2803 /* Some keywords can be followed by any delimiter, including ':' */
3280af22
NIS		 2804 tmp = (len == 1 && strchr("msyq", PL_tokenbuf[0]) ||
2805 len == 2 && ((PL_tokenbuf[0] == 't' && PL_tokenbuf[1] == 'r') ||
2806 (PL_tokenbuf[0] == 'q' &&
2807 strchr("qwxr", PL_tokenbuf[1]))));
8ebc5c01 2808
2809 /* x::* is just a word, unless x is "CORE" */
3280af22 2810 if (!tmp && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE"))
4633a7c4
LW		 2811 goto just_a_word;
2812
3643fb5f 2813 d = s;
3280af22 2814 while (d < PL_bufend && isSPACE(*d))
3643fb5f
CS		 2815 d++; /* no comments skipped here, or s### is misparsed */
2816
2817 /* Is this a label? */
3280af22
NIS		 2818 if (!tmp && PL_expect == XSTATE
2819 && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
8ebc5c01 2820 s = d + 1;
3280af22 2821 yylval.pval = savepv(PL_tokenbuf);
8ebc5c01 2822 CLINE;
2823 TOKEN(LABEL);
3643fb5f
CS		 2824 }
2825
2826 /* Check for keywords */
3280af22 2827 tmp = keyword(PL_tokenbuf, len);
748a9306
LW		 2828
2829 /* Is this a word before a => operator? */
748a9306
LW		 2830 if (strnEQ(d,"=>",2)) {
2831 CLINE;
3280af22 2832 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
748a9306
LW		 2833 yylval.opval->op_private = OPpCONST_BARE;
2834 TERM(WORD);
2835 }
2836
a0d0e21e 2837 if (tmp < 0) { /* second-class keyword? */
56f7f34b
CS		 2838 GV *ogv = Nullgv; /* override (winner) */
2839 GV *hgv = Nullgv; /* hidden (loser) */
3280af22 2840 if (PL_expect != XOPERATOR && (*s != ':' || s[1] != ':')) {
56f7f34b 2841 CV *cv;
3280af22 2842 if ((gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV)) &&
56f7f34b
CS		 2843 (cv = GvCVu(gv)))
2844 {
2845 if (GvIMPORTED_CV(gv))
2846 ogv = gv;
2847 else if (! CvMETHOD(cv))
2848 hgv = gv;
2849 }
2850 if (!ogv &&
3280af22
NIS		 2851 (gvp = (GV**)hv_fetch(PL_globalstash,PL_tokenbuf,len,FALSE)) &&
2852 (gv = *gvp) != (GV*)&PL_sv_undef &&
56f7f34b
CS		 2853 GvCVu(gv) && GvIMPORTED_CV(gv))
2854 {
2855 ogv = gv;
2856 }
2857 }
2858 if (ogv) {
2859 tmp = 0; /* overridden by import or by GLOBAL */
6e7b2336
GS		 2860 }
2861 else if (gv && !gvp
2862 && -tmp==KEY_lock /* XXX generalizable kludge */
3280af22 2863 && !hv_fetch(GvHVn(PL_incgv), "Thread.pm", 9, FALSE))
6e7b2336
GS		 2864 {
2865 tmp = 0; /* any sub overrides "weak" keyword */
a0d0e21e 2866 }
56f7f34b
CS		 2867 else { /* no override */
2868 tmp = -tmp;
2869 gv = Nullgv;
2870 gvp = 0;
3280af22 2871 if (PL_dowarn && hgv)
54fcf5cb 2872 warn("Ambiguous call resolved as CORE::%s(), %s",
2f3ca594 2873 GvENAME(hgv), "qualify as such or use &");
49dc05e3 2874 }
a0d0e21e
LW		 2875 }
2876
2877 reserved_word:
2878 switch (tmp) {
79072805
LW		 2879
2880 default: /* not a keyword */
93a17b20 2881 just_a_word: {
96e4d5b1 2882 SV *sv;
3280af22 2883 char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
8990e307
LW		 2884
2885 /* Get the rest if it looks like a package qualifier */
2886
a0d0e21e 2887 if (*s == '\'' || *s == ':' && s[1] == ':') {
c3e0f903 2888 STRLEN morelen;
3280af22 2889 s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len,
c3e0f903
GS		 2890 TRUE, &morelen);
2891 if (!morelen)
3280af22 2892 croak("Bad name after %s%s", PL_tokenbuf,
ec2ab091 2893 *s == '\'' ? "'" : "::");
c3e0f903 2894 len += morelen;
a0d0e21e 2895 }
8990e307 2896
3280af22
NIS		 2897 if (PL_expect == XOPERATOR) {
2898 if (PL_bufptr == PL_linestart) {
2899 PL_curcop->cop_line--;
463ee0b2 2900 warn(warn_nosemi);
3280af22 2901 PL_curcop->cop_line++;
463ee0b2
LW		 2902 }
2903 else
54310121 2904 no_op("Bareword",s);
463ee0b2 2905 }
8990e307 2906
c3e0f903
GS		 2907 /* Look for a subroutine with this name in current package,
2908 unless name is "Foo::", in which case Foo is a bearword
2909 (and a package name). */
2910
2911 if (len > 2 &&
3280af22 2912 PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
c3e0f903 2913 {
3280af22 2914 if (PL_dowarn && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
c3e0f903 2915 warn("Bareword \"%s\" refers to nonexistent package",
3280af22 2916 PL_tokenbuf);
c3e0f903 2917 len -= 2;
3280af22 2918 PL_tokenbuf[len] = '\0';
c3e0f903
GS		 2919 gv = Nullgv;
2920 gvp = 0;
2921 }
2922 else {
2923 len = 0;
2924 if (!gv)
3280af22 2925 gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV);
c3e0f903
GS		 2926 }
2927
2928 /* if we saw a global override before, get the right name */
8990e307 2929
49dc05e3
GS		 2930 if (gvp) {
2931 sv = newSVpv("CORE::GLOBAL::",14);
3280af22 2932 sv_catpv(sv,PL_tokenbuf);
49dc05e3
GS		 2933 }
2934 else
3280af22 2935 sv = newSVpv(PL_tokenbuf,0);
8990e307 2936
a0d0e21e
LW		 2937 /* Presume this is going to be a bareword of some sort. */
2938
2939 CLINE;
49dc05e3 2940 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
a0d0e21e
LW		 2941 yylval.opval->op_private = OPpCONST_BARE;
2942
c3e0f903
GS		 2943 /* And if "Foo::", then that's what it certainly is. */
2944
2945 if (len)
2946 goto safe_bareword;
2947
8990e307
LW		 2948 /* See if it's the indirect object for a list operator. */
2949
3280af22
NIS		 2950 if (PL_oldoldbufptr &&
2951 PL_oldoldbufptr < PL_bufptr &&
2952 (PL_oldoldbufptr == PL_last_lop || PL_oldoldbufptr == PL_last_uni) &&
a0d0e21e 2953 /* NO SKIPSPACE BEFORE HERE! */
3280af22
NIS		 2954 (PL_expect == XREF
2955 || ((opargs[PL_last_lop_op] >> OASHIFT)& 7) == OA_FILEREF
2956 || (PL_last_lop_op == OP_ENTERSUB
2957 && PL_last_proto
2958 && PL_last_proto[PL_last_proto[0] == ';' ? 1 : 0] == '*')) )
a0d0e21e 2959 {
748a9306
LW		 2960 bool immediate_paren = *s == '(';
2961
a0d0e21e
LW		 2962 /* (Now we can afford to cross potential line boundary.) */
2963 s = skipspace(s);
2964
2965 /* Two barewords in a row may indicate method call. */
2966
2967 if ((isALPHA(*s) || *s == '$') && (tmp=intuit_method(s,gv)))
2968 return tmp;
2969
2970 /* If not a declared subroutine, it's an indirect object. */
2971 /* (But it's an indir obj regardless for sort.) */
2972
3280af22 2973 if ((PL_last_lop_op == OP_SORT ||
8ebc5c01 2974 (!immediate_paren && (!gv || !GvCVu(gv))) ) &&
3280af22
NIS		 2975 (PL_last_lop_op != OP_MAPSTART && PL_last_lop_op != OP_GREPSTART)){
2976 PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
748a9306 2977 goto bareword;
93a17b20
LW		 2978 }
2979 }
8990e307
LW		 2980
2981 /* If followed by a paren, it's certainly a subroutine. */
2982
3280af22 2983 PL_expect = XOPERATOR;
8990e307 2984 s = skipspace(s);
93a17b20 2985 if (*s == '(') {
79072805 2986 CLINE;
96e4d5b1 2987 if (gv && GvCVu(gv)) {
2988 for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
2989 if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
2990 s = d + 1;
2991 goto its_constant;
2992 }
2993 }
3280af22
NIS		 2994 PL_nextval[PL_nexttoke].opval = yylval.opval;
2995 PL_expect = XOPERATOR;
93a17b20 2996 force_next(WORD);
c07a80fd 2997 yylval.ival = 0;
463ee0b2 2998 TOKEN('&');
79072805 2999 }
93a17b20 3000
a0d0e21e 3001 /* If followed by var or block, call it a method (unless sub) */
8990e307 3002
8ebc5c01 3003 if ((*s == '$' || *s == '{') && (!gv || !GvCVu(gv))) {
3280af22
NIS		 3004 PL_last_lop = PL_oldbufptr;
3005 PL_last_lop_op = OP_METHOD;
93a17b20 3006 PREBLOCK(METHOD);
463ee0b2
LW		 3007 }
3008
8990e307
LW		 3009 /* If followed by a bareword, see if it looks like indir obj. */
3010
a0d0e21e
LW		 3011 if ((isALPHA(*s) || *s == '$') && (tmp = intuit_method(s,gv)))
3012 return tmp;
93a17b20 3013
8990e307
LW		 3014 /* Not a method, so call it a subroutine (if defined) */
3015
8ebc5c01 3016 if (gv && GvCVu(gv)) {
46fc3d4c 3017 CV* cv;
748a9306 3018 if (lastchar == '-')
c2960299 3019 warn("Ambiguous use of -%s resolved as -&%s()",
3280af22
NIS		 3020 PL_tokenbuf, PL_tokenbuf);
3021 PL_last_lop = PL_oldbufptr;
3022 PL_last_lop_op = OP_ENTERSUB;
89bfa8cd 3023 /* Check for a constant sub */
46fc3d4c 3024 cv = GvCV(gv);
96e4d5b1 3025 if ((sv = cv_const_sv(cv))) {
3026 its_constant:
3027 SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
3028 ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc(sv);
3029 yylval.opval->op_private = 0;
3030 TOKEN(WORD);
89bfa8cd 3031 }
3032
a5f75d66
AD		 3033 /* Resolve to GV now. */
3034 op_free(yylval.opval);
3035 yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
4633a7c4
LW		 3036 /* Is there a prototype? */
3037 if (SvPOK(cv)) {
3038 STRLEN len;
3280af22 3039 PL_last_proto = SvPV((SV*)cv, len);
4633a7c4
LW		 3040 if (!len)
3041 TERM(FUNC0SUB);
3280af22 3042 if (strEQ(PL_last_proto, "$"))
4633a7c4 3043 OPERATOR(UNIOPSUB);
3280af22
NIS		 3044 if (*PL_last_proto == '&' && *s == '{') {
3045 sv_setpv(PL_subname,"__ANON__");
4633a7c4
LW		 3046 PREBLOCK(LSTOPSUB);
3047 }
2a841d13 3048 } else
3280af22
NIS		 3049 PL_last_proto = NULL;
3050 PL_nextval[PL_nexttoke].opval = yylval.opval;
3051 PL_expect = XTERM;
8990e307
LW		 3052 force_next(WORD);
3053 TOKEN(NOAMP);
3054 }
748a9306 3055
3280af22 3056 if (PL_hints & HINT_STRICT_SUBS &&
748a9306 3057 lastchar != '-' &&
a0d0e21e 3058 strnNE(s,"->",2) &&
3280af22
NIS		 3059 PL_last_lop_op != OP_TRUNCATE && /* S/F prototype in opcode.pl */
3060 PL_last_lop_op != OP_ACCEPT &&
3061 PL_last_lop_op != OP_PIPE_OP &&
3062 PL_last_lop_op != OP_SOCKPAIR)
a0d0e21e
LW		 3063 {
3064 warn(
3065 "Bareword \"%s\" not allowed while \"strict subs\" in use",
3280af22
NIS		 3066 PL_tokenbuf);
3067 ++PL_error_count;
85e6fe83 3068 }
8990e307
LW		 3069
3070 /* Call it a bare word */
3071
748a9306 3072 bareword:
3280af22 3073 if (PL_dowarn) {
748a9306 3074 if (lastchar != '-') {
3280af22 3075 for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
748a9306 3076 if (!*d)
3280af22 3077 warn(warn_reserved, PL_tokenbuf);
748a9306
LW		 3078 }
3079 }
c3e0f903
GS		 3080
3081 safe_bareword:
748a9306
LW		 3082 if (lastchar && strchr("*%&", lastchar)) {
3083 warn("Operator or semicolon missing before %c%s",
3280af22 3084 lastchar, PL_tokenbuf);
c2960299 3085 warn("Ambiguous use of %c resolved as operator %c",
748a9306
LW		 3086 lastchar, lastchar);
3087 }
93a17b20 3088 TOKEN(WORD);
79072805 3089 }
79072805 3090
68dc0745 3091 case KEY___FILE__:
46fc3d4c 3092 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3280af22 3093 newSVsv(GvSV(PL_curcop->cop_filegv)));
46fc3d4c 3094 TERM(THING);
3095
79072805 3096 case KEY___LINE__:
46fc3d4c 3097 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3280af22 3098 newSVpvf("%ld", (long)PL_curcop->cop_line));
79072805 3099 TERM(THING);
68dc0745 3100
3101 case KEY___PACKAGE__:
3102 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3280af22
NIS		 3103 (PL_curstash
3104 ? newSVsv(PL_curstname)
3105 : &PL_sv_undef));
79072805 3106 TERM(THING);
79072805 3107
e50aee73 3108 case KEY___DATA__:
79072805
LW		 3109 case KEY___END__: {
3110 GV *gv;
79072805
LW		 3111
3112 /*SUPPRESS 560*/
3280af22 3113 if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D')) {
e50aee73 3114 char *pname = "main";
3280af22
NIS		 3115 if (PL_tokenbuf[2] == 'D')
3116 pname = HvNAME(PL_curstash ? PL_curstash : PL_defstash);
46fc3d4c 3117 gv = gv_fetchpv(form("%s::DATA", pname), TRUE, SVt_PVIO);
a5f75d66 3118 GvMULTI_on(gv);
79072805 3119 if (!GvIO(gv))
a0d0e21e 3120 GvIOp(gv) = newIO();
3280af22 3121 IoIFP(GvIOp(gv)) = PL_rsfp;
a0d0e21e
LW		 3122#if defined(HAS_FCNTL) && defined(F_SETFD)
3123 {
3280af22 3124 int fd = PerlIO_fileno(PL_rsfp);
a0d0e21e
LW		 3125 fcntl(fd,F_SETFD,fd >= 3);
3126 }
79072805 3127#endif
fd049845 3128 /* Mark this internal pseudo-handle as clean */
3129 IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT;
3280af22 3130 if (PL_preprocess)
a0d0e21e 3131 IoTYPE(GvIOp(gv)) = '|';
3280af22 3132 else if ((PerlIO*)PL_rsfp == PerlIO_stdin())
a0d0e21e 3133 IoTYPE(GvIOp(gv)) = '-';
79072805 3134 else
a0d0e21e 3135 IoTYPE(GvIOp(gv)) = '<';
3280af22 3136 PL_rsfp = Nullfp;
79072805
LW		 3137 }
3138 goto fake_eof;
e929a76b 3139 }
de3bb511 3140
8990e307 3141 case KEY_AUTOLOAD:
ed6116ce 3142 case KEY_DESTROY:
79072805
LW		 3143 case KEY_BEGIN:
3144 case KEY_END:
7d07dbc2 3145 case KEY_INIT:
3280af22
NIS		 3146 if (PL_expect == XSTATE) {
3147 s = PL_bufptr;
93a17b20 3148 goto really_sub;
79072805
LW		 3149 }
3150 goto just_a_word;
3151
a0d0e21e
LW		 3152 case KEY_CORE:
3153 if (*s == ':' && s[1] == ':') {
3154 s += 2;
748a9306 3155 d = s;
3280af22
NIS		 3156 s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
3157 tmp = keyword(PL_tokenbuf, len);
a0d0e21e
LW		 3158 if (tmp < 0)
3159 tmp = -tmp;
3160 goto reserved_word;
3161 }
3162 goto just_a_word;
3163
463ee0b2
LW		 3164 case KEY_abs:
3165 UNI(OP_ABS);
3166
79072805
LW		 3167 case KEY_alarm:
3168 UNI(OP_ALARM);
3169
3170 case KEY_accept:
a0d0e21e 3171 LOP(OP_ACCEPT,XTERM);
79072805 3172
463ee0b2
LW		 3173 case KEY_and:
3174 OPERATOR(ANDOP);
3175
79072805 3176 case KEY_atan2:
a0d0e21e 3177 LOP(OP_ATAN2,XTERM);
85e6fe83 3178
79072805 3179 case KEY_bind:
a0d0e21e 3180 LOP(OP_BIND,XTERM);
79072805
LW		 3181
3182 case KEY_binmode:
3183 UNI(OP_BINMODE);
3184
3185 case KEY_bless:
a0d0e21e 3186 LOP(OP_BLESS,XTERM);
79072805
LW		 3187
3188 case KEY_chop:
3189 UNI(OP_CHOP);
3190
3191 case KEY_continue:
3192 PREBLOCK(CONTINUE);
3193
3194 case KEY_chdir:
85e6fe83 3195 (void)gv_fetchpv("ENV",TRUE, SVt_PVHV); /* may use HOME */
79072805
LW		 3196 UNI(OP_CHDIR);
3197
3198 case KEY_close:
3199 UNI(OP_CLOSE);
3200
3201 case KEY_closedir:
3202 UNI(OP_CLOSEDIR);
3203
3204 case KEY_cmp:
3205 Eop(OP_SCMP);
3206
3207 case KEY_caller:
3208 UNI(OP_CALLER);
3209
3210 case KEY_crypt:
3211#ifdef FCRYPT
6b88bc9c 3212 if (!PL_cryptseen++)
de3bb511 3213 init_des();
a687059c 3214#endif
a0d0e21e 3215 LOP(OP_CRYPT,XTERM);
79072805
LW		 3216
3217 case KEY_chmod:
3280af22
NIS		 3218 if (PL_dowarn) {
3219 for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
748a9306
LW		 3220 if (*d != '0' && isDIGIT(*d))
3221 yywarn("chmod: mode argument is missing initial 0");
3222 }
a0d0e21e 3223 LOP(OP_CHMOD,XTERM);
79072805
LW		 3224
3225 case KEY_chown:
a0d0e21e 3226 LOP(OP_CHOWN,XTERM);
79072805
LW		 3227
3228 case KEY_connect:
a0d0e21e 3229 LOP(OP_CONNECT,XTERM);
79072805 3230
463ee0b2
LW		 3231 case KEY_chr:
3232 UNI(OP_CHR);
3233
79072805
LW		 3234 case KEY_cos:
3235 UNI(OP_COS);
3236
3237 case KEY_chroot:
3238 UNI(OP_CHROOT);
3239
3240 case KEY_do:
3241 s = skipspace(s);
3242 if (*s == '{')
a0d0e21e 3243 PRETERMBLOCK(DO);
79072805 3244 if (*s != '\'')
a0d0e21e 3245 s = force_word(s,WORD,FALSE,TRUE,FALSE);
378cc40b 3246 OPERATOR(DO);
79072805
LW		 3247
3248 case KEY_die:
3280af22 3249 PL_hints |= HINT_BLOCK_SCOPE;
a0d0e21e 3250 LOP(OP_DIE,XTERM);
79072805
LW		 3251
3252 case KEY_defined:
3253 UNI(OP_DEFINED);
3254
3255 case KEY_delete:
a0d0e21e 3256 UNI(OP_DELETE);
79072805
LW		 3257
3258 case KEY_dbmopen:
a0d0e21e
LW		 3259 gv_fetchpv("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV);
3260 LOP(OP_DBMOPEN,XTERM);
79072805
LW		 3261
3262 case KEY_dbmclose:
3263 UNI(OP_DBMCLOSE);
3264
3265 case KEY_dump:
a0d0e21e 3266 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3267 LOOPX(OP_DUMP);
3268
3269 case KEY_else:
3270 PREBLOCK(ELSE);
3271
3272 case KEY_elsif:
3280af22 3273 yylval.ival = PL_curcop->cop_line;
79072805
LW		 3274 OPERATOR(ELSIF);
3275
3276 case KEY_eq:
3277 Eop(OP_SEQ);
3278
a0d0e21e
LW		 3279 case KEY_exists:
3280 UNI(OP_EXISTS);
3281
79072805
LW		 3282 case KEY_exit:
3283 UNI(OP_EXIT);
3284
3285 case KEY_eval:
79072805 3286 s = skipspace(s);
3280af22 3287 PL_expect = (*s == '{') ? XTERMBLOCK : XTERM;
463ee0b2 3288 UNIBRACK(OP_ENTEREVAL);
79072805
LW		 3289
3290 case KEY_eof:
3291 UNI(OP_EOF);
3292
3293 case KEY_exp:
3294 UNI(OP_EXP);
3295
3296 case KEY_each:
3297 UNI(OP_EACH);
3298
3299 case KEY_exec:
3300 set_csh();
a0d0e21e 3301 LOP(OP_EXEC,XREF);
79072805
LW		 3302
3303 case KEY_endhostent:
3304 FUN0(OP_EHOSTENT);
3305
3306 case KEY_endnetent:
3307 FUN0(OP_ENETENT);
3308
3309 case KEY_endservent:
3310 FUN0(OP_ESERVENT);
3311
3312 case KEY_endprotoent:
3313 FUN0(OP_EPROTOENT);
3314
3315 case KEY_endpwent:
3316 FUN0(OP_EPWENT);
3317
3318 case KEY_endgrent:
3319 FUN0(OP_EGRENT);
3320
3321 case KEY_for:
3322 case KEY_foreach:
3280af22 3323 yylval.ival = PL_curcop->cop_line;
55497cff 3324 s = skipspace(s);
3280af22 3325 if (PL_expect == XSTATE && isIDFIRST(*s)) {
55497cff 3326 char *p = s;
3280af22 3327 if ((PL_bufend - p) >= 3 &&
55497cff 3328 strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
3329 p += 2;
3330 p = skipspace(p);
3331 if (isIDFIRST(*p))
3332 croak("Missing $ on loop variable");
3333 }
79072805
LW		 3334 OPERATOR(FOR);
3335
3336 case KEY_formline:
a0d0e21e 3337 LOP(OP_FORMLINE,XTERM);
79072805
LW		 3338
3339 case KEY_fork:
3340 FUN0(OP_FORK);
3341
3342 case KEY_fcntl:
a0d0e21e 3343 LOP(OP_FCNTL,XTERM);
79072805
LW		 3344
3345 case KEY_fileno:
3346 UNI(OP_FILENO);
3347
3348 case KEY_flock:
a0d0e21e 3349 LOP(OP_FLOCK,XTERM);
79072805
LW		 3350
3351 case KEY_gt:
3352 Rop(OP_SGT);
3353
3354 case KEY_ge:
3355 Rop(OP_SGE);
3356
3357 case KEY_grep:
a0d0e21e 3358 LOP(OP_GREPSTART, *s == '(' ? XTERM : XREF);
79072805
LW		 3359
3360 case KEY_goto:
a0d0e21e 3361 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3362 LOOPX(OP_GOTO);
3363
3364 case KEY_gmtime:
3365 UNI(OP_GMTIME);
3366
3367 case KEY_getc:
3368 UNI(OP_GETC);
3369
3370 case KEY_getppid:
3371 FUN0(OP_GETPPID);
3372
3373 case KEY_getpgrp:
3374 UNI(OP_GETPGRP);
3375
3376 case KEY_getpriority:
a0d0e21e 3377 LOP(OP_GETPRIORITY,XTERM);
79072805
LW		 3378
3379 case KEY_getprotobyname:
3380 UNI(OP_GPBYNAME);
3381
3382 case KEY_getprotobynumber:
a0d0e21e 3383 LOP(OP_GPBYNUMBER,XTERM);
79072805
LW		 3384
3385 case KEY_getprotoent:
3386 FUN0(OP_GPROTOENT);
3387
3388 case KEY_getpwent:
3389 FUN0(OP_GPWENT);
3390
3391 case KEY_getpwnam:
ff68c719 3392 UNI(OP_GPWNAM);
79072805
LW		 3393
3394 case KEY_getpwuid:
ff68c719 3395 UNI(OP_GPWUID);
79072805
LW		 3396
3397 case KEY_getpeername:
3398 UNI(OP_GETPEERNAME);
3399
3400 case KEY_gethostbyname:
3401 UNI(OP_GHBYNAME);
3402
3403 case KEY_gethostbyaddr:
a0d0e21e 3404 LOP(OP_GHBYADDR,XTERM);
79072805
LW		 3405
3406 case KEY_gethostent:
3407 FUN0(OP_GHOSTENT);
3408
3409 case KEY_getnetbyname:
3410 UNI(OP_GNBYNAME);
3411
3412 case KEY_getnetbyaddr:
a0d0e21e 3413 LOP(OP_GNBYADDR,XTERM);
79072805
LW		 3414
3415 case KEY_getnetent:
3416 FUN0(OP_GNETENT);
3417
3418 case KEY_getservbyname:
a0d0e21e 3419 LOP(OP_GSBYNAME,XTERM);
79072805
LW		 3420
3421 case KEY_getservbyport:
a0d0e21e 3422 LOP(OP_GSBYPORT,XTERM);
79072805
LW		 3423
3424 case KEY_getservent:
3425 FUN0(OP_GSERVENT);
3426
3427 case KEY_getsockname:
3428 UNI(OP_GETSOCKNAME);
3429
3430 case KEY_getsockopt:
a0d0e21e 3431 LOP(OP_GSOCKOPT,XTERM);
79072805
LW		 3432
3433 case KEY_getgrent:
3434 FUN0(OP_GGRENT);
3435
3436 case KEY_getgrnam:
ff68c719 3437 UNI(OP_GGRNAM);
79072805
LW		 3438
3439 case KEY_getgrgid:
ff68c719 3440 UNI(OP_GGRGID);
79072805
LW		 3441
3442 case KEY_getlogin:
3443 FUN0(OP_GETLOGIN);
3444
93a17b20 3445 case KEY_glob:
a0d0e21e
LW		 3446 set_csh();
3447 LOP(OP_GLOB,XTERM);
93a17b20 3448
79072805
LW		 3449 case KEY_hex:
3450 UNI(OP_HEX);
3451
3452 case KEY_if:
3280af22 3453 yylval.ival = PL_curcop->cop_line;
79072805
LW		 3454 OPERATOR(IF);
3455
3456 case KEY_index:
a0d0e21e 3457 LOP(OP_INDEX,XTERM);
79072805
LW		 3458
3459 case KEY_int:
3460 UNI(OP_INT);
3461
3462 case KEY_ioctl:
a0d0e21e 3463 LOP(OP_IOCTL,XTERM);
79072805
LW		 3464
3465 case KEY_join:
a0d0e21e 3466 LOP(OP_JOIN,XTERM);
79072805
LW		 3467
3468 case KEY_keys:
3469 UNI(OP_KEYS);
3470
3471 case KEY_kill:
a0d0e21e 3472 LOP(OP_KILL,XTERM);
79072805
LW		 3473
3474 case KEY_last:
a0d0e21e 3475 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805 3476 LOOPX(OP_LAST);
a0d0e21e 3477
79072805
LW		 3478 case KEY_lc:
3479 UNI(OP_LC);
3480
3481 case KEY_lcfirst:
3482 UNI(OP_LCFIRST);
3483
3484 case KEY_local:
3485 OPERATOR(LOCAL);
3486
3487 case KEY_length:
3488 UNI(OP_LENGTH);
3489
3490 case KEY_lt:
3491 Rop(OP_SLT);
3492
3493 case KEY_le:
3494 Rop(OP_SLE);
3495
3496 case KEY_localtime:
3497 UNI(OP_LOCALTIME);
3498
3499 case KEY_log:
3500 UNI(OP_LOG);
3501
3502 case KEY_link:
a0d0e21e 3503 LOP(OP_LINK,XTERM);
79072805
LW		 3504
3505 case KEY_listen:
a0d0e21e 3506 LOP(OP_LISTEN,XTERM);
79072805 3507
c0329465
MB		 3508 case KEY_lock:
3509 UNI(OP_LOCK);
3510
79072805
LW		 3511 case KEY_lstat:
3512 UNI(OP_LSTAT);
3513
3514 case KEY_m:
8782bef2 3515 s = scan_pat(s,OP_MATCH);
79072805
LW		 3516 TERM(sublex_start());
3517
a0d0e21e
LW		 3518 case KEY_map:
3519 LOP(OP_MAPSTART,XREF);
3520
79072805 3521 case KEY_mkdir:
a0d0e21e 3522 LOP(OP_MKDIR,XTERM);
79072805
LW		 3523
3524 case KEY_msgctl:
a0d0e21e 3525 LOP(OP_MSGCTL,XTERM);
79072805
LW		 3526
3527 case KEY_msgget:
a0d0e21e 3528 LOP(OP_MSGGET,XTERM);
79072805
LW		 3529
3530 case KEY_msgrcv:
a0d0e21e 3531 LOP(OP_MSGRCV,XTERM);
79072805
LW		 3532
3533 case KEY_msgsnd:
a0d0e21e 3534 LOP(OP_MSGSND,XTERM);
79072805 3535
93a17b20 3536 case KEY_my:
3280af22 3537 PL_in_my = TRUE;
c750a3ec
MB		 3538 s = skipspace(s);
3539 if (isIDFIRST(*s)) {
3280af22
NIS		 3540 s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
3541 PL_in_my_stash = gv_stashpv(PL_tokenbuf, FALSE);
3542 if (!PL_in_my_stash) {
c750a3ec 3543 char tmpbuf[1024];
3280af22
NIS		 3544 PL_bufptr = s;
3545 sprintf(tmpbuf, "No such class %.1000s", PL_tokenbuf);
c750a3ec
MB		 3546 yyerror(tmpbuf);
3547 }
3548 }
55497cff 3549 OPERATOR(MY);
93a17b20 3550
79072805 3551 case KEY_next:
a0d0e21e 3552 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3553 LOOPX(OP_NEXT);
3554
3555 case KEY_ne:
3556 Eop(OP_SNE);
3557
a0d0e21e 3558 case KEY_no:
3280af22 3559 if (PL_expect != XSTATE)
a0d0e21e
LW		 3560 yyerror("\"no\" not allowed in expression");
3561 s = force_word(s,WORD,FALSE,TRUE,FALSE);
89bfa8cd 3562 s = force_version(s);
a0d0e21e
LW		 3563 yylval.ival = 0;
3564 OPERATOR(USE);
3565
3566 case KEY_not:
3567 OPERATOR(NOTOP);
3568
79072805 3569 case KEY_open:
93a17b20
LW		 3570 s = skipspace(s);
3571 if (isIDFIRST(*s)) {
3572 char *t;
3573 for (d = s; isALNUM(*d); d++) ;
3574 t = skipspace(d);
3575 if (strchr("|&*+-=!?:.", *t))
3576 warn("Precedence problem: open %.*s should be open(%.*s)",
3577 d-s,s, d-s,s);
3578 }
a0d0e21e 3579 LOP(OP_OPEN,XTERM);
79072805 3580
463ee0b2 3581 case KEY_or:
a0d0e21e 3582 yylval.ival = OP_OR;
463ee0b2
LW		 3583 OPERATOR(OROP);
3584
79072805
LW		 3585 case KEY_ord:
3586 UNI(OP_ORD);
3587
3588 case KEY_oct:
3589 UNI(OP_OCT);
3590
3591 case KEY_opendir:
a0d0e21e 3592 LOP(OP_OPEN_DIR,XTERM);
79072805
LW		 3593
3594 case KEY_print:
3280af22 3595 checkcomma(s,PL_tokenbuf,"filehandle");
a0d0e21e 3596 LOP(OP_PRINT,XREF);
79072805
LW		 3597
3598 case KEY_printf:
3280af22 3599 checkcomma(s,PL_tokenbuf,"filehandle");
a0d0e21e 3600 LOP(OP_PRTF,XREF);
79072805 3601
c07a80fd 3602 case KEY_prototype:
3603 UNI(OP_PROTOTYPE);
3604
79072805 3605 case KEY_push:
a0d0e21e 3606 LOP(OP_PUSH,XTERM);
79072805
LW		 3607
3608 case KEY_pop:
3609 UNI(OP_POP);
3610
a0d0e21e
LW		 3611 case KEY_pos:
3612 UNI(OP_POS);
3613
79072805 3614 case KEY_pack:
a0d0e21e 3615 LOP(OP_PACK,XTERM);
79072805
LW		 3616
3617 case KEY_package:
a0d0e21e 3618 s = force_word(s,WORD,FALSE,TRUE,FALSE);
79072805
LW		 3619 OPERATOR(PACKAGE);