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