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