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