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