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