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