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