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