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