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