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