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