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