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