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