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