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