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