This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
additional test for IPC::Open3 (courtesy RonaldWS@aol.com)
[perl5.git] / toke.c
CommitLineData
a0d0e21e 1/* toke.c
a687059c 2 *
4eb8286e 3 * Copyright (c) 1991-1999, Larry Wall
a687059c 4 *
d48672a2
LW		 5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
378cc40b 7 *
a0d0e21e
LW		 8 */
9
10/*
11 * "It all comes from here, the stench and the peril." --Frodo
378cc40b
LW		 12 */
13
14#include "EXTERN.h"
15#include "perl.h"
378cc40b 16
d3b6f988
GS		 17#define yychar PL_yychar
18#define yylval PL_yylval
19
76e3520e 20#ifndef PERL_OBJECT
a0d0e21e
LW		 21static void check_uni _((void));
22static void force_next _((I32 type));
89bfa8cd 23static char *force_version _((char *start));
a0d0e21e 24static char *force_word _((char *start, int token, int check_keyword, int allow_pack, int allow_tick));
76e3520e 25static SV *tokeq _((SV *sv));
a0d0e21e
LW		 26static char *scan_const _((char *start));
27static char *scan_formline _((char *s));
28static char *scan_heredoc _((char *s));
8903cb82 29static char *scan_ident _((char *s, char *send, char *dest, STRLEN destlen,
30 I32 ck_uni));
a0d0e21e 31static char *scan_inputsymbol _((char *start));
8782bef2 32static char *scan_pat _((char *start, I32 type));
a0d0e21e
LW		 33static char *scan_str _((char *start));
34static char *scan_subst _((char *start));
35static char *scan_trans _((char *start));
8903cb82 36static char *scan_word _((char *s, char *dest, STRLEN destlen,
37 int allow_package, STRLEN *slp));
a0d0e21e
LW		 38static char *skipspace _((char *s));
39static void checkcomma _((char *s, char *name, char *what));
40static void force_ident _((char *s, int kind));
41static void incline _((char *s));
42static int intuit_method _((char *s, GV *gv));
43static int intuit_more _((char *s));
44static I32 lop _((I32 f, expectation x, char *s));
45static void missingterm _((char *s));
46static void no_op _((char *what, char *s));
47static void set_csh _((void));
48static I32 sublex_done _((void));
55497cff 49static I32 sublex_push _((void));
a0d0e21e
LW		 50static I32 sublex_start _((void));
51#ifdef CRIPPLED_CC
52static int uni _((I32 f, char *s));
53#endif
fd049845 54static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append));
6d5fb7e3 55static void restore_rsfp _((void *f));
b3ac6de7 56static SV *new_constant _((char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type));
49d8d3a1
MB		 57static void restore_expect _((void *e));
58static void restore_lex_expect _((void *e));
76e3520e 59#endif /* PERL_OBJECT */
2f3197b3 60
fc36a67e 61static char ident_too_long[] = "Identifier too long";
8903cb82 62
a0ed51b3 63#define UTF (PL_hints & HINT_UTF8)
834a4ddd
LW		 64/*
65 * Note: we try to be careful never to call the isXXX_utf8() functions
66 * unless we're pretty sure we've seen the beginning of a UTF-8 character
67 * (that is, the two high bits are set). Otherwise we risk loading in the
68 * heavy-duty SWASHINIT and SWASHGET routines unnecessarily.
69 */
70#define isIDFIRST_lazy(p) ((!UTF || (*((U8*)p) < 0xc0)) \
71 ? isIDFIRST(*(p)) \
72 : isIDFIRST_utf8((U8*)p))
73#define isALNUM_lazy(p) ((!UTF || (*((U8*)p) < 0xc0)) \
74 ? isALNUM(*(p)) \
75 : isALNUM_utf8((U8*)p))
a0ed51b3 76
2b92dfce
GS		 77/* In variables name $^X, these are the legal values for X.
78 * 1999-02-27 mjd-perl-patch@plover.com */
79#define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
80
79072805
LW		 81/* The following are arranged oddly so that the guard on the switch statement
82 * can get by with a single comparison (if the compiler is smart enough).
83 */
84
fb73857a 85/* #define LEX_NOTPARSING 11 is done in perl.h. */
86
55497cff 87#define LEX_NORMAL 10
88#define LEX_INTERPNORMAL 9
89#define LEX_INTERPCASEMOD 8
90#define LEX_INTERPPUSH 7
91#define LEX_INTERPSTART 6
92#define LEX_INTERPEND 5
93#define LEX_INTERPENDMAYBE 4
94#define LEX_INTERPCONCAT 3
95#define LEX_INTERPCONST 2
96#define LEX_FORMLINE 1
97#define LEX_KNOWNEXT 0
79072805 98
395c3793
LW		 99#ifdef I_FCNTL
100#include <fcntl.h>
101#endif
fe14fcc3
LW		 102#ifdef I_SYS_FILE
103#include <sys/file.h>
104#endif
395c3793 105
a790bc05 106/* XXX If this causes problems, set i_unistd=undef in the hint file. */
107#ifdef I_UNISTD
108# include <unistd.h> /* Needed for execv() */
109#endif
110
111
79072805
LW		 112#ifdef ff_next
113#undef ff_next
d48672a2
LW		 114#endif
115
a1a0e61e
TD		 116#ifdef USE_PURE_BISON
117YYSTYPE* yylval_pointer = NULL;
118int* yychar_pointer = NULL;
22c35a8c
GS		 119# undef yylval
120# undef yychar
e4bfbdd4
JH		 121# define yylval (*yylval_pointer)
122# define yychar (*yychar_pointer)
123# define PERL_YYLEX_PARAM yylval_pointer,yychar_pointer
a1a0e61e 124#else
e4bfbdd4 125# define PERL_YYLEX_PARAM
a1a0e61e
TD		 126#endif
127
79072805 128#include "keywords.h"
fe14fcc3 129
ae986130
LW		 130#ifdef CLINE
131#undef CLINE
132#endif
3280af22
NIS		 133#define CLINE (PL_copline = (PL_curcop->cop_line < PL_copline ? PL_curcop->cop_line : PL_copline))
134
135#define TOKEN(retval) return (PL_bufptr = s,(int)retval)
136#define OPERATOR(retval) return (PL_expect = XTERM,PL_bufptr = s,(int)retval)
137#define AOPERATOR(retval) return ao((PL_expect = XTERM,PL_bufptr = s,(int)retval))
138#define PREBLOCK(retval) return (PL_expect = XBLOCK,PL_bufptr = s,(int)retval)
139#define PRETERMBLOCK(retval) return (PL_expect = XTERMBLOCK,PL_bufptr = s,(int)retval)
140#define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s,(int)retval)
141#define TERM(retval) return (CLINE, PL_expect = XOPERATOR,PL_bufptr = s,(int)retval)
142#define LOOPX(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LOOPEX)
143#define FTST(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)UNIOP)
144#define FUN0(f) return(yylval.ival = f,PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC0)
145#define FUN1(f) return(yylval.ival = f,PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC1)
146#define BOop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)BITOROP))
147#define BAop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)BITANDOP))
148#define SHop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)SHIFTOP))
149#define PWop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)POWOP))
150#define PMop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)MATCHOP)
151#define Aop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)ADDOP))
152#define Mop(f) return ao((yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)MULOP))
153#define Eop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)EQOP)
154#define Rop(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)RELOP)
2f3197b3 155
a687059c
LW		 156/* This bit of chicanery makes a unary function followed by
157 * a parenthesis into a function with one argument, highest precedence.
158 */
2f3197b3 159#define UNI(f) return(yylval.ival = f, \
3280af22
NIS		 160 PL_expect = XTERM, \
161 PL_bufptr = s, \
162 PL_last_uni = PL_oldbufptr, \
163 PL_last_lop_op = f, \
a687059c
LW		 164 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
165
79072805 166#define UNIBRACK(f) return(yylval.ival = f, \
3280af22
NIS		 167 PL_bufptr = s, \
168 PL_last_uni = PL_oldbufptr, \
79072805
LW		 169 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
170
9f68db38 171/* grandfather return to old style */
3280af22 172#define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
79072805 173
76e3520e 174STATIC int
8ac85365 175ao(int toketype)
a0d0e21e 176{
3280af22
NIS		 177 if (*PL_bufptr == '=') {
178 PL_bufptr++;
a0d0e21e
LW		 179 if (toketype == ANDAND)
180 yylval.ival = OP_ANDASSIGN;
181 else if (toketype == OROR)
182 yylval.ival = OP_ORASSIGN;
183 toketype = ASSIGNOP;
184 }
185 return toketype;
186}
187
76e3520e 188STATIC void
8ac85365 189no_op(char *what, char *s)
463ee0b2 190{
3280af22
NIS		 191 char *oldbp = PL_bufptr;
192 bool is_first = (PL_oldbufptr == PL_linestart);
68dc0745 193
3280af22 194 PL_bufptr = s;
46fc3d4c 195 yywarn(form("%s found where operator expected", what));
748a9306 196 if (is_first)
a0d0e21e 197 warn("\t(Missing semicolon on previous line?)\n");
834a4ddd 198 else if (PL_oldoldbufptr && isIDFIRST_lazy(PL_oldoldbufptr)) {
748a9306 199 char *t;
834a4ddd 200 for (t = PL_oldoldbufptr; *t && (isALNUM_lazy(t) || *t == ':'); t++) ;
3280af22 201 if (t < PL_bufptr && isSPACE(*t))
748a9306 202 warn("\t(Do you need to predeclare %.*s?)\n",
3280af22 203 t - PL_oldoldbufptr, PL_oldoldbufptr);
748a9306
LW		 204
205 }
d194fe61
GS		 206 else if (s <= oldbp)
207 warn("\t(Missing operator before end of line?)\n");
748a9306
LW		 208 else
209 warn("\t(Missing operator before %.*s?)\n", s - oldbp, oldbp);
3280af22 210 PL_bufptr = oldbp;
8990e307
LW		 211}
212
76e3520e 213STATIC void
8ac85365 214missingterm(char *s)
8990e307
LW		 215{
216 char tmpbuf[3];
217 char q;
218 if (s) {
219 char *nl = strrchr(s,'\n');
d2719217 220 if (nl)
8990e307
LW		 221 *nl = '\0';
222 }
9d116dd7
JH		 223 else if (
224#ifdef EBCDIC
225 iscntrl(PL_multi_close)
226#else
227 PL_multi_close < 32 || PL_multi_close == 127
228#endif
229 ) {
8990e307 230 *tmpbuf = '^';
3280af22 231 tmpbuf[1] = toCTRL(PL_multi_close);
8990e307
LW		 232 s = "\\n";
233 tmpbuf[2] = '\0';
234 s = tmpbuf;
235 }
236 else {
3280af22 237 *tmpbuf = PL_multi_close;
8990e307
LW		 238 tmpbuf[1] = '\0';
239 s = tmpbuf;
240 }
241 q = strchr(s,'"') ? '\'' : '"';
242 croak("Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
463ee0b2 243}
79072805
LW		 244
245void
8ac85365 246deprecate(char *s)
a0d0e21e 247{
d008e5eb 248 dTHR;
599cee73
PM		 249 if (ckWARN(WARN_DEPRECATED))
250 warner(WARN_DEPRECATED, "Use of %s is deprecated", s);
a0d0e21e
LW		 251}
252
76e3520e 253STATIC void
8ac85365 254depcom(void)
a0d0e21e
LW		 255{
256 deprecate("comma-less variable list");
257}
258
a868473f
NIS		 259#ifdef WIN32
260
76e3520e 261STATIC I32
a868473f
NIS		 262win32_textfilter(int idx, SV *sv, int maxlen)
263{
264 I32 count = FILTER_READ(idx+1, sv, maxlen);
265 if (count > 0 && !maxlen)
266 win32_strip_return(sv);
267 return count;
268}
269#endif
270
dfe13c55
GS		 271#ifndef PERL_OBJECT
272
a0ed51b3
LW		 273STATIC I32
274utf16_textfilter(int idx, SV *sv, int maxlen)
275{
276 I32 count = FILTER_READ(idx+1, sv, maxlen);
277 if (count) {
dfe13c55
GS		 278 U8* tmps;
279 U8* tend;
280 New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
a0ed51b3 281 tend = utf16_to_utf8((U16*)SvPVX(sv), tmps, SvCUR(sv));
dfe13c55 282 sv_usepvn(sv, (char*)tmps, tend - tmps);
a0ed51b3
LW		 283
284 }
285 return count;
286}
287
288STATIC I32
289utf16rev_textfilter(int idx, SV *sv, int maxlen)
290{
291 I32 count = FILTER_READ(idx+1, sv, maxlen);
292 if (count) {
dfe13c55
GS		 293 U8* tmps;
294 U8* tend;
295 New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
a0ed51b3 296 tend = utf16_to_utf8_reversed((U16*)SvPVX(sv), tmps, SvCUR(sv));
dfe13c55 297 sv_usepvn(sv, (char*)tmps, tend - tmps);
a0ed51b3
LW		 298
299 }
300 return count;
301}
a868473f 302
dfe13c55
GS		 303#endif
304
a0d0e21e 305void
8ac85365 306lex_start(SV *line)
79072805 307{
0f15f207 308 dTHR;
8990e307
LW		 309 char *s;
310 STRLEN len;
311
3280af22
NIS		 312 SAVEI32(PL_lex_dojoin);
313 SAVEI32(PL_lex_brackets);
314 SAVEI32(PL_lex_fakebrack);
315 SAVEI32(PL_lex_casemods);
316 SAVEI32(PL_lex_starts);
317 SAVEI32(PL_lex_state);
318 SAVESPTR(PL_lex_inpat);
319 SAVEI32(PL_lex_inwhat);
320 SAVEI16(PL_curcop->cop_line);
321 SAVEPPTR(PL_bufptr);
322 SAVEPPTR(PL_bufend);
323 SAVEPPTR(PL_oldbufptr);
324 SAVEPPTR(PL_oldoldbufptr);
325 SAVEPPTR(PL_linestart);
326 SAVESPTR(PL_linestr);
327 SAVEPPTR(PL_lex_brackstack);
328 SAVEPPTR(PL_lex_casestack);
329 SAVEDESTRUCTOR(restore_rsfp, PL_rsfp);
330 SAVESPTR(PL_lex_stuff);
331 SAVEI32(PL_lex_defer);
332 SAVESPTR(PL_lex_repl);
333 SAVEDESTRUCTOR(restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */
334 SAVEDESTRUCTOR(restore_lex_expect, PL_tokenbuf + PL_expect);
335
336 PL_lex_state = LEX_NORMAL;
337 PL_lex_defer = 0;
338 PL_expect = XSTATE;
339 PL_lex_brackets = 0;
340 PL_lex_fakebrack = 0;
341 New(899, PL_lex_brackstack, 120, char);
342 New(899, PL_lex_casestack, 12, char);
343 SAVEFREEPV(PL_lex_brackstack);
344 SAVEFREEPV(PL_lex_casestack);
345 PL_lex_casemods = 0;
346 *PL_lex_casestack = '\0';
347 PL_lex_dojoin = 0;
348 PL_lex_starts = 0;
349 PL_lex_stuff = Nullsv;
350 PL_lex_repl = Nullsv;
351 PL_lex_inpat = 0;
352 PL_lex_inwhat = 0;
353 PL_linestr = line;
354 if (SvREADONLY(PL_linestr))
355 PL_linestr = sv_2mortal(newSVsv(PL_linestr));
356 s = SvPV(PL_linestr, len);
8990e307 357 if (len && s[len-1] != ';') {
3280af22
NIS		 358 if (!(SvFLAGS(PL_linestr) & SVs_TEMP))
359 PL_linestr = sv_2mortal(newSVsv(PL_linestr));
360 sv_catpvn(PL_linestr, "\n;", 2);
8990e307 361 }
3280af22
NIS		 362 SvTEMP_off(PL_linestr);
363 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
364 PL_bufend = PL_bufptr + SvCUR(PL_linestr);
365 SvREFCNT_dec(PL_rs);
79cb57f6 366 PL_rs = newSVpvn("\n", 1);
3280af22 367 PL_rsfp = 0;
79072805 368}
a687059c 369
463ee0b2 370void
8ac85365 371lex_end(void)
463ee0b2 372{
3280af22 373 PL_doextract = FALSE;
463ee0b2
LW		 374}
375
76e3520e 376STATIC void
8ac85365 377restore_rsfp(void *f)
6d5fb7e3 378{
760ac839 379 PerlIO *fp = (PerlIO*)f;
6d5fb7e3 380
3280af22
NIS		 381 if (PL_rsfp == PerlIO_stdin())
382 PerlIO_clearerr(PL_rsfp);
383 else if (PL_rsfp && (PL_rsfp != fp))
384 PerlIO_close(PL_rsfp);
385 PL_rsfp = fp;
6d5fb7e3
CS		 386}
387
76e3520e 388STATIC void
7fae4e64 389restore_expect(void *e)
49d8d3a1
MB		 390{
391 /* a safe way to store a small integer in a pointer */
3280af22 392 PL_expect = (expectation)((char *)e - PL_tokenbuf);
49d8d3a1
MB		 393}
394
837485b6 395STATIC void
7fae4e64 396restore_lex_expect(void *e)
49d8d3a1
MB		 397{
398 /* a safe way to store a small integer in a pointer */
3280af22 399 PL_lex_expect = (expectation)((char *)e - PL_tokenbuf);
49d8d3a1
MB		 400}
401
837485b6 402STATIC void
8ac85365 403incline(char *s)
463ee0b2 404{
0f15f207 405 dTHR;
463ee0b2
LW		 406 char *t;
407 char *n;
408 char ch;
409 int sawline = 0;
410
3280af22 411 PL_curcop->cop_line++;
463ee0b2
LW		 412 if (*s++ != '#')
413 return;
414 while (*s == ' ' || *s == '\t') s++;
415 if (strnEQ(s, "line ", 5)) {
416 s += 5;
417 sawline = 1;
418 }
419 if (!isDIGIT(*s))
420 return;
421 n = s;
422 while (isDIGIT(*s))
423 s++;
424 while (*s == ' ' || *s == '\t')
425 s++;
426 if (*s == '"' && (t = strchr(s+1, '"')))
427 s++;
428 else {
429 if (!sawline)
430 return; /* false alarm */
431 for (t = s; !isSPACE(*t); t++) ;
432 }
433 ch = *t;
434 *t = '\0';
435 if (t - s > 0)
3280af22 436 PL_curcop->cop_filegv = gv_fetchfile(s);
463ee0b2 437 else
3280af22 438 PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename);
463ee0b2 439 *t = ch;
3280af22 440 PL_curcop->cop_line = atoi(n)-1;
463ee0b2
LW		 441}
442
76e3520e 443STATIC char *
8ac85365 444skipspace(register char *s)
a687059c 445{
11343788 446 dTHR;
3280af22
NIS		 447 if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
448 while (s < PL_bufend && (*s == ' ' || *s == '\t'))
463ee0b2
LW		 449 s++;
450 return s;
451 }
452 for (;;) {
fd049845 453 STRLEN prevlen;
60e6418e
GS		 454 while (s < PL_bufend && isSPACE(*s)) {
455 if (*s++ == '\n' && PL_in_eval && !PL_rsfp)
456 incline(s);
457 }
3280af22
NIS		 458 if (s < PL_bufend && *s == '#') {
459 while (s < PL_bufend && *s != '\n')
463ee0b2 460 s++;
60e6418e 461 if (s < PL_bufend) {
463ee0b2 462 s++;
60e6418e
GS		 463 if (PL_in_eval && !PL_rsfp) {
464 incline(s);
465 continue;
466 }
467 }
463ee0b2 468 }
3280af22 469 if (s < PL_bufend || !PL_rsfp || PL_lex_state != LEX_NORMAL)
463ee0b2 470 return s;
3280af22
NIS		 471 if ((s = filter_gets(PL_linestr, PL_rsfp, (prevlen = SvCUR(PL_linestr)))) == Nullch) {
472 if (PL_minus_n || PL_minus_p) {
473 sv_setpv(PL_linestr,PL_minus_p ?
08e9d68e
DD		 474 ";}continue{print or die qq(-p destination: $!\\n)" :
475 "");
3280af22
NIS		 476 sv_catpv(PL_linestr,";}");
477 PL_minus_n = PL_minus_p = 0;
a0d0e21e
LW		 478 }
479 else
3280af22
NIS		 480 sv_setpv(PL_linestr,";");
481 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
482 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
483 if (PL_preprocess && !PL_in_eval)
484 (void)PerlProc_pclose(PL_rsfp);
485 else if ((PerlIO*)PL_rsfp == PerlIO_stdin())
486 PerlIO_clearerr(PL_rsfp);
8990e307 487 else
3280af22
NIS		 488 (void)PerlIO_close(PL_rsfp);
489 PL_rsfp = Nullfp;
463ee0b2
LW		 490 return s;
491 }
3280af22
NIS		 492 PL_linestart = PL_bufptr = s + prevlen;
493 PL_bufend = s + SvCUR(PL_linestr);
494 s = PL_bufptr;
a0d0e21e 495 incline(s);
3280af22 496 if (PERLDB_LINE && PL_curstash != PL_debstash) {
8990e307
LW		 497 SV *sv = NEWSV(85,0);
498
499 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 500 sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
501 av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
8990e307 502 }
463ee0b2 503 }
a687059c 504}
378cc40b 505
76e3520e 506STATIC void
8ac85365 507check_uni(void) {
2f3197b3
LW		 508 char *s;
509 char ch;
a0d0e21e 510 char *t;
2f3197b3 511
3280af22 512 if (PL_oldoldbufptr != PL_last_uni)
2f3197b3 513 return;
3280af22
NIS		 514 while (isSPACE(*PL_last_uni))
515 PL_last_uni++;
834a4ddd 516 for (s = PL_last_uni; isALNUM_lazy(s) || *s == '-'; s++) ;
3280af22 517 if ((t = strchr(s, '(')) && t < PL_bufptr)
a0d0e21e 518 return;
2f3197b3
LW		 519 ch = *s;
520 *s = '\0';
3280af22 521 warn("Warning: Use of \"%s\" without parens is ambiguous", PL_last_uni);
2f3197b3
LW		 522 *s = ch;
523}
524
ffed7fef
LW		 525#ifdef CRIPPLED_CC
526
527#undef UNI
ffed7fef 528#define UNI(f) return uni(f,s)
ffed7fef 529
76e3520e 530STATIC int
8ac85365 531uni(I32 f, char *s)
ffed7fef
LW		 532{
533 yylval.ival = f;
3280af22
NIS		 534 PL_expect = XTERM;
535 PL_bufptr = s;
8f872242
NIS		 536 PL_last_uni = PL_oldbufptr;
537 PL_last_lop_op = f;
ffed7fef
LW		 538 if (*s == '(')
539 return FUNC1;
540 s = skipspace(s);
541 if (*s == '(')
542 return FUNC1;
543 else
544 return UNIOP;
545}
546
a0d0e21e
LW		 547#endif /* CRIPPLED_CC */
548
549#define LOP(f,x) return lop(f,x,s)
550
76e3520e 551STATIC I32
0fa19009 552lop(I32 f, expectation x, char *s)
ffed7fef 553{
0f15f207 554 dTHR;
79072805 555 yylval.ival = f;
35c8bce7 556 CLINE;
3280af22
NIS		 557 PL_expect = x;
558 PL_bufptr = s;
559 PL_last_lop = PL_oldbufptr;
560 PL_last_lop_op = f;
561 if (PL_nexttoke)
a0d0e21e 562 return LSTOP;
79072805
LW		 563 if (*s == '(')
564 return FUNC;
565 s = skipspace(s);
566 if (*s == '(')
567 return FUNC;
568 else
569 return LSTOP;
570}
571
76e3520e 572STATIC void
8ac85365 573force_next(I32 type)
79072805 574{
3280af22
NIS		 575 PL_nexttype[PL_nexttoke] = type;
576 PL_nexttoke++;
577 if (PL_lex_state != LEX_KNOWNEXT) {
578 PL_lex_defer = PL_lex_state;
579 PL_lex_expect = PL_expect;
580 PL_lex_state = LEX_KNOWNEXT;
79072805
LW		 581 }
582}
583
76e3520e 584STATIC char *
15f0808c 585force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
79072805 586{
463ee0b2
LW		 587 register char *s;
588 STRLEN len;
589
590 start = skipspace(start);
591 s = start;
834a4ddd 592 if (isIDFIRST_lazy(s) ||
a0d0e21e 593 (allow_pack && *s == ':') ||
15f0808c 594 (allow_initial_tick && *s == '\'') )
a0d0e21e 595 {
3280af22
NIS		 596 s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len);
597 if (check_keyword && keyword(PL_tokenbuf, len))
463ee0b2
LW		 598 return start;
599 if (token == METHOD) {
600 s = skipspace(s);
601 if (*s == '(')
3280af22 602 PL_expect = XTERM;
463ee0b2 603 else {
3280af22 604 PL_expect = XOPERATOR;
463ee0b2 605 }
79072805 606 }
3280af22
NIS		 607 PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(PL_tokenbuf,0));
608 PL_nextval[PL_nexttoke].opval->op_private |= OPpCONST_BARE;
79072805
LW		 609 force_next(token);
610 }
611 return s;
612}
613
76e3520e 614STATIC void
8ac85365 615force_ident(register char *s, int kind)
79072805
LW		 616{
617 if (s && *s) {
11343788 618 OP* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
3280af22 619 PL_nextval[PL_nexttoke].opval = o;
79072805 620 force_next(WORD);
748a9306 621 if (kind) {
e858de61 622 dTHR; /* just for in_eval */
11343788 623 o->op_private = OPpCONST_ENTERED;
55497cff 624 /* XXX see note in pp_entereval() for why we forgo typo
625 warnings if the symbol must be introduced in an eval.
626 GSAR 96-10-12 */
3280af22 627 gv_fetchpv(s, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
a0d0e21e
LW		 628 kind == '$' ? SVt_PV :
629 kind == '@' ? SVt_PVAV :
630 kind == '%' ? SVt_PVHV :
631 SVt_PVGV
632 );
748a9306 633 }
79072805
LW		 634 }
635}
636
76e3520e 637STATIC char *
8ac85365 638force_version(char *s)
89bfa8cd 639{
640 OP *version = Nullop;
641
642 s = skipspace(s);
643
644 /* default VERSION number -- GBARR */
645
646 if(isDIGIT(*s)) {
647 char *d;
648 int c;
55497cff 649 for( d=s, c = 1; isDIGIT(*d) || *d == '_' || (*d == '.' && c--); d++);
89bfa8cd 650 if((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') {
651 s = scan_num(s);
652 /* real VERSION number -- GBARR */
653 version = yylval.opval;
654 }
655 }
656
657 /* NOTE: The parser sees the package name and the VERSION swapped */
3280af22 658 PL_nextval[PL_nexttoke].opval = version;
89bfa8cd 659 force_next(WORD);
660
661 return (s);
662}
663
76e3520e
GS		 664STATIC SV *
665tokeq(SV *sv)
79072805
LW		 666{
667 register char *s;
668 register char *send;
669 register char *d;
b3ac6de7
IZ		 670 STRLEN len = 0;
671 SV *pv = sv;
79072805
LW		 672
673 if (!SvLEN(sv))
b3ac6de7 674 goto finish;
79072805 675
a0d0e21e 676 s = SvPV_force(sv, len);
748a9306 677 if (SvIVX(sv) == -1)
b3ac6de7 678 goto finish;
463ee0b2 679 send = s + len;
79072805
LW		 680 while (s < send && *s != '\\')
681 s++;
682 if (s == send)
b3ac6de7 683 goto finish;
79072805 684 d = s;
3280af22 685 if ( PL_hints & HINT_NEW_STRING )
79cb57f6 686 pv = sv_2mortal(newSVpvn(SvPVX(pv), len));
79072805
LW		 687 while (s < send) {
688 if (*s == '\\') {
a0d0e21e 689 if (s + 1 < send && (s[1] == '\\'))
79072805
LW		 690 s++; /* all that, just for this */
691 }
692 *d++ = *s++;
693 }
694 *d = '\0';
463ee0b2 695 SvCUR_set(sv, d - SvPVX(sv));
b3ac6de7 696 finish:
3280af22 697 if ( PL_hints & HINT_NEW_STRING )
b3ac6de7 698 return new_constant(NULL, 0, "q", sv, pv, "q");
79072805
LW		 699 return sv;
700}
701
76e3520e 702STATIC I32
8ac85365 703sublex_start(void)
79072805
LW		 704{
705 register I32 op_type = yylval.ival;
79072805
LW		 706
707 if (op_type == OP_NULL) {
3280af22
NIS		 708 yylval.opval = PL_lex_op;
709 PL_lex_op = Nullop;
79072805
LW		 710 return THING;
711 }
712 if (op_type == OP_CONST || op_type == OP_READLINE) {
3280af22 713 SV *sv = tokeq(PL_lex_stuff);
b3ac6de7
IZ		 714
715 if (SvTYPE(sv) == SVt_PVIV) {
716 /* Overloaded constants, nothing fancy: Convert to SVt_PV: */
717 STRLEN len;
718 char *p;
719 SV *nsv;
720
721 p = SvPV(sv, len);
79cb57f6 722 nsv = newSVpvn(p, len);
b3ac6de7
IZ		 723 SvREFCNT_dec(sv);
724 sv = nsv;
725 }
726 yylval.opval = (OP*)newSVOP(op_type, 0, sv);
3280af22 727 PL_lex_stuff = Nullsv;
79072805
LW		 728 return THING;
729 }
730
3280af22
NIS		 731 PL_sublex_info.super_state = PL_lex_state;
732 PL_sublex_info.sub_inwhat = op_type;
733 PL_sublex_info.sub_op = PL_lex_op;
734 PL_lex_state = LEX_INTERPPUSH;
55497cff 735
3280af22
NIS		 736 PL_expect = XTERM;
737 if (PL_lex_op) {
738 yylval.opval = PL_lex_op;
739 PL_lex_op = Nullop;
55497cff 740 return PMFUNC;
741 }
742 else
743 return FUNC;
744}
745
76e3520e 746STATIC I32
8ac85365 747sublex_push(void)
55497cff 748{
0f15f207 749 dTHR;
f46d017c 750 ENTER;
55497cff 751
3280af22
NIS		 752 PL_lex_state = PL_sublex_info.super_state;
753 SAVEI32(PL_lex_dojoin);
754 SAVEI32(PL_lex_brackets);
755 SAVEI32(PL_lex_fakebrack);
756 SAVEI32(PL_lex_casemods);
757 SAVEI32(PL_lex_starts);
758 SAVEI32(PL_lex_state);
759 SAVESPTR(PL_lex_inpat);
760 SAVEI32(PL_lex_inwhat);
761 SAVEI16(PL_curcop->cop_line);
762 SAVEPPTR(PL_bufptr);
763 SAVEPPTR(PL_oldbufptr);
764 SAVEPPTR(PL_oldoldbufptr);
765 SAVEPPTR(PL_linestart);
766 SAVESPTR(PL_linestr);
767 SAVEPPTR(PL_lex_brackstack);
768 SAVEPPTR(PL_lex_casestack);
769
770 PL_linestr = PL_lex_stuff;
771 PL_lex_stuff = Nullsv;
772
773 PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
774 PL_bufend += SvCUR(PL_linestr);
775 SAVEFREESV(PL_linestr);
776
777 PL_lex_dojoin = FALSE;
778 PL_lex_brackets = 0;
779 PL_lex_fakebrack = 0;
780 New(899, PL_lex_brackstack, 120, char);
781 New(899, PL_lex_casestack, 12, char);
782 SAVEFREEPV(PL_lex_brackstack);
783 SAVEFREEPV(PL_lex_casestack);
784 PL_lex_casemods = 0;
785 *PL_lex_casestack = '\0';
786 PL_lex_starts = 0;
787 PL_lex_state = LEX_INTERPCONCAT;
788 PL_curcop->cop_line = PL_multi_start;
789
790 PL_lex_inwhat = PL_sublex_info.sub_inwhat;
791 if (PL_lex_inwhat == OP_MATCH || PL_lex_inwhat == OP_QR || PL_lex_inwhat == OP_SUBST)
792 PL_lex_inpat = PL_sublex_info.sub_op;
79072805 793 else
3280af22 794 PL_lex_inpat = Nullop;
79072805 795
55497cff 796 return '(';
79072805
LW		 797}
798
76e3520e 799STATIC I32
8ac85365 800sublex_done(void)
79072805 801{
3280af22
NIS		 802 if (!PL_lex_starts++) {
803 PL_expect = XOPERATOR;
79cb57f6 804 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn("",0));
79072805
LW		 805 return THING;
806 }
807
3280af22
NIS		 808 if (PL_lex_casemods) { /* oops, we've got some unbalanced parens */
809 PL_lex_state = LEX_INTERPCASEMOD;
e4bfbdd4 810 return yylex(PERL_YYLEX_PARAM);
79072805
LW		 811 }
812
79072805 813 /* Is there a right-hand side to take care of? */
3280af22
NIS		 814 if (PL_lex_repl && (PL_lex_inwhat == OP_SUBST || PL_lex_inwhat == OP_TRANS)) {
815 PL_linestr = PL_lex_repl;
816 PL_lex_inpat = 0;
817 PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
818 PL_bufend += SvCUR(PL_linestr);
819 SAVEFREESV(PL_linestr);
820 PL_lex_dojoin = FALSE;
821 PL_lex_brackets = 0;
822 PL_lex_fakebrack = 0;
823 PL_lex_casemods = 0;
824 *PL_lex_casestack = '\0';
825 PL_lex_starts = 0;
826 if (SvCOMPILED(PL_lex_repl)) {
827 PL_lex_state = LEX_INTERPNORMAL;
828 PL_lex_starts++;
e9fa98b2
HS		 829 /* we don't clear PL_lex_repl here, so that we can check later
830 whether this is an evalled subst; that means we rely on the
831 logic to ensure sublex_done() is called again only via the
832 branch (in yylex()) that clears PL_lex_repl, else we'll loop */
79072805 833 }
e9fa98b2 834 else {
3280af22 835 PL_lex_state = LEX_INTERPCONCAT;
e9fa98b2
HS		 836 PL_lex_repl = Nullsv;
837 }
79072805 838 return ',';
ffed7fef
LW		 839 }
840 else {
f46d017c 841 LEAVE;
3280af22
NIS		 842 PL_bufend = SvPVX(PL_linestr);
843 PL_bufend += SvCUR(PL_linestr);
844 PL_expect = XOPERATOR;
79072805 845 return ')';
ffed7fef
LW		 846 }
847}
848
02aa26ce
NT		 849/*
850 scan_const
851
852 Extracts a pattern, double-quoted string, or transliteration. This
853 is terrifying code.
854
3280af22
NIS		 855 It looks at lex_inwhat and PL_lex_inpat to find out whether it's
856 processing a pattern (PL_lex_inpat is true), a transliteration
02aa26ce
NT		 857 (lex_inwhat & OP_TRANS is true), or a double-quoted string.
858
9b599b2a
GS		 859 Returns a pointer to the character scanned up to. Iff this is
860 advanced from the start pointer supplied (ie if anything was
861 successfully parsed), will leave an OP for the substring scanned
862 in yylval. Caller must intuit reason for not parsing further
863 by looking at the next characters herself.
864
02aa26ce
NT		 865 In patterns:
866 backslashes:
867 double-quoted style: \r and \n
868 regexp special ones: \D \s
869 constants: \x3
870 backrefs: \1 (deprecated in substitution replacements)
871 case and quoting: \U \Q \E
872 stops on @ and $, but not for $ as tail anchor
873
874 In transliterations:
875 characters are VERY literal, except for - not at the start or end
876 of the string, which indicates a range. scan_const expands the
877 range to the full set of intermediate characters.
878
879 In double-quoted strings:
880 backslashes:
881 double-quoted style: \r and \n
882 constants: \x3
883 backrefs: \1 (deprecated)
884 case and quoting: \U \Q \E
885 stops on @ and $
886
887 scan_const does *not* construct ops to handle interpolated strings.
888 It stops processing as soon as it finds an embedded $ or @ variable
889 and leaves it to the caller to work out what's going on.
890
891 @ in pattern could be: @foo, @{foo}, @$foo, @'foo, @:foo.
892
893 $ in pattern could be $foo or could be tail anchor. Assumption:
894 it's a tail anchor if $ is the last thing in the string, or if it's
895 followed by one of ")| \n\t"
896
897 \1 (backreferences) are turned into $1
898
899 The structure of the code is
900 while (there's a character to process) {
901 handle transliteration ranges
902 skip regexp comments
903 skip # initiated comments in //x patterns
904 check for embedded @foo
905 check for embedded scalars
906 if (backslash) {
907 leave intact backslashes from leave (below)
908 deprecate \1 in strings and sub replacements
909 handle string-changing backslashes \l \U \Q \E, etc.
910 switch (what was escaped) {
911 handle - in a transliteration (becomes a literal -)
912 handle \132 octal characters
913 handle 0x15 hex characters
914 handle \cV (control V)
915 handle printf backslashes (\f, \r, \n, etc)
916 } (end switch)
917 } (end if backslash)
918 } (end while character to read)
919
920*/
921
76e3520e 922STATIC char *
8ac85365 923scan_const(char *start)
79072805 924{
3280af22 925 register char *send = PL_bufend; /* end of the constant */
02aa26ce
NT		 926 SV *sv = NEWSV(93, send - start); /* sv for the constant */
927 register char *s = start; /* start of the constant */
928 register char *d = SvPVX(sv); /* destination for copies */
929 bool dorange = FALSE; /* are we in a translit range? */
930 I32 len; /* ? */
ac2262e3 931 I32 utf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
a0ed51b3
LW		 932 ? (PL_sublex_info.sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
933 : UTF;
ac2262e3 934 I32 thisutf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
a0ed51b3
LW		 935 ? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF))
936 : UTF;
02aa26ce 937
9b599b2a 938 /* leaveit is the set of acceptably-backslashed characters */
72aaf631 939 char *leaveit =
3280af22 940 PL_lex_inpat
a0ed51b3 941 ? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#"
9b599b2a 942 : "";
79072805
LW		 943
944 while (s < send || dorange) {
02aa26ce 945 /* get transliterations out of the way (they're most literal) */
3280af22 946 if (PL_lex_inwhat == OP_TRANS) {
02aa26ce 947 /* expand a range A-Z to the full set of characters. AIE! */
79072805 948 if (dorange) {
02aa26ce 949 I32 i; /* current expanded character */
8ada0baa 950 I32 min; /* first character in range */
02aa26ce
NT		 951 I32 max; /* last character in range */
952
953 i = d - SvPVX(sv); /* remember current offset */
954 SvGROW(sv, SvLEN(sv) + 256); /* expand the sv -- there'll never be more'n 256 chars in a range for it to grow by */
955 d = SvPVX(sv) + i; /* restore d after the grow potentially has changed the ptr */
956 d -= 2; /* eat the first char and the - */
957
8ada0baa
JH		 958 min = (U8)*d; /* first char in range */
959 max = (U8)d[1]; /* last char in range */
960
961#ifndef ASCIIish
962 if ((isLOWER(min) && isLOWER(max)) ||
963 (isUPPER(min) && isUPPER(max))) {
964 if (isLOWER(min)) {
965 for (i = min; i <= max; i++)
966 if (isLOWER(i))
967 *d++ = i;
968 } else {
969 for (i = min; i <= max; i++)
970 if (isUPPER(i))
971 *d++ = i;
972 }
973 }
974 else
975#endif
976 for (i = min; i <= max; i++)
977 *d++ = i;
02aa26ce
NT		 978
979 /* mark the range as done, and continue */
79072805
LW		 980 dorange = FALSE;
981 continue;
982 }
02aa26ce
NT		 983
984 /* range begins (ignore - as first or last char) */
79072805 985 else if (*s == '-' && s+1 < send && s != start) {
a0ed51b3 986 if (utf) {
a176fa2a 987 *d++ = (char)0xff; /* use illegal utf8 byte--see pmtrans */
a0ed51b3
LW		 988 s++;
989 continue;
990 }
79072805
LW		 991 dorange = TRUE;
992 s++;
993 }
994 }
02aa26ce
NT		 995
996 /* if we get here, we're not doing a transliteration */
997
0f5d15d6
IZ		 998 /* skip for regexp comments /(?#comment)/ and code /(?{code})/,
999 except for the last char, which will be done separately. */
3280af22 1000 else if (*s == '(' && PL_lex_inpat && s[1] == '?') {
cc6b7395
IZ		 1001 if (s[2] == '#') {
1002 while (s < send && *s != ')')
1003 *d++ = *s++;
0f5d15d6
IZ		 1004 } else if (s[2] == '{'
1005 || s[2] == 'p' && s[3] == '{') { /* This should march regcomp.c */
cc6b7395 1006 I32 count = 1;
0f5d15d6 1007 char *regparse = s + (s[2] == '{' ? 3 : 4);
cc6b7395
IZ		 1008 char c;
1009
d9f97599
GS		 1010 while (count && (c = *regparse)) {
1011 if (c == '\\' && regparse[1])
1012 regparse++;
cc6b7395
IZ		 1013 else if (c == '{')
1014 count++;
1015 else if (c == '}')
1016 count--;
d9f97599 1017 regparse++;
cc6b7395 1018 }
5bdf89e7
IZ		 1019 if (*regparse != ')') {
1020 regparse--; /* Leave one char for continuation. */
cc6b7395 1021 yyerror("Sequence (?{...}) not terminated or not {}-balanced");
5bdf89e7 1022 }
0f5d15d6 1023 while (s < regparse)
cc6b7395
IZ		 1024 *d++ = *s++;
1025 }
748a9306 1026 }
02aa26ce
NT		 1027
1028 /* likewise skip #-initiated comments in //x patterns */
3280af22
NIS		 1029 else if (*s == '#' && PL_lex_inpat &&
1030 ((PMOP*)PL_lex_inpat)->op_pmflags & PMf_EXTENDED) {
748a9306
LW		 1031 while (s+1 < send && *s != '\n')
1032 *d++ = *s++;
1033 }
02aa26ce
NT		 1034
1035 /* check for embedded arrays (@foo, @:foo, @'foo, @{foo}, @$foo) */
834a4ddd 1036 else if (*s == '@' && s[1] && (isALNUM_lazy(s+1) || strchr(":'{$", s[1])))
79072805 1037 break;
02aa26ce
NT		 1038
1039 /* check for embedded scalars. only stop if we're sure it's a
1040 variable.
1041 */
79072805 1042 else if (*s == '$') {
3280af22 1043 if (!PL_lex_inpat) /* not a regexp, so $ must be var */
79072805 1044 break;
c277df42 1045 if (s + 1 < send && !strchr("()| \n\t", s[1]))
79072805
LW		 1046 break; /* in regexp, $ might be tail anchor */
1047 }
02aa26ce 1048
a0ed51b3
LW		 1049 /* (now in tr/// code again) */
1050
d008e5eb
GS		 1051 if (*s & 0x80 && thisutf) {
1052 dTHR; /* only for ckWARN */
1053 if (ckWARN(WARN_UTF8)) {
dfe13c55 1054 (void)utf8_to_uv((U8*)s, &len); /* could cvt latin-1 to utf8 here... */
d008e5eb
GS		 1055 if (len) {
1056 while (len--)
1057 *d++ = *s++;
1058 continue;
1059 }
a0ed51b3
LW		 1060 }
1061 }
1062
02aa26ce 1063 /* backslashes */
79072805
LW		 1064 if (*s == '\\' && s+1 < send) {
1065 s++;
02aa26ce
NT		 1066
1067 /* some backslashes we leave behind */
c9f97d15 1068 if (*leaveit && *s && strchr(leaveit, *s)) {
79072805
LW		 1069 *d++ = '\\';
1070 *d++ = *s++;
1071 continue;
1072 }
02aa26ce
NT		 1073
1074 /* deprecate \1 in strings and substitution replacements */
3280af22 1075 if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
a0d0e21e 1076 isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
79072805 1077 {
d008e5eb 1078 dTHR; /* only for ckWARN */
599cee73
PM		 1079 if (ckWARN(WARN_SYNTAX))
1080 warner(WARN_SYNTAX, "\\%c better written as $%c", *s, *s);
79072805
LW		 1081 *--s = '$';
1082 break;
1083 }
02aa26ce
NT		 1084
1085 /* string-change backslash escapes */
3280af22 1086 if (PL_lex_inwhat != OP_TRANS && *s && strchr("lLuUEQ", *s)) {
79072805
LW		 1087 --s;
1088 break;
1089 }
02aa26ce
NT		 1090
1091 /* if we get here, it's either a quoted -, or a digit */
79072805 1092 switch (*s) {
02aa26ce
NT		 1093
1094 /* quoted - in transliterations */
79072805 1095 case '-':
3280af22 1096 if (PL_lex_inwhat == OP_TRANS) {
79072805
LW		 1097 *d++ = *s++;
1098 continue;
1099 }
1100 /* FALL THROUGH */
1101 default:
11b8faa4
JH		 1102 {
1103 dTHR;
1104 if (ckWARN(WARN_UNSAFE) && isALPHA(*s))
1105 warner(WARN_UNSAFE,
1106 "Unrecognized escape \\%c passed through",
1107 *s);
1108 /* default action is to copy the quoted character */
1109 *d++ = *s++;
1110 continue;
1111 }
02aa26ce
NT		 1112
1113 /* \132 indicates an octal constant */
79072805
LW		 1114 case '0': case '1': case '2': case '3':
1115 case '4': case '5': case '6': case '7':
1116 *d++ = scan_oct(s, 3, &len);
1117 s += len;
1118 continue;
02aa26ce
NT		 1119
1120 /* \x24 indicates a hex constant */
79072805 1121 case 'x':
a0ed51b3
LW		 1122 ++s;
1123 if (*s == '{') {
1124 char* e = strchr(s, '}');
1125
adaeee49 1126 if (!e) {
a0ed51b3 1127 yyerror("Missing right brace on \\x{}");
adaeee49
GA		 1128 e = s;
1129 }
d008e5eb
GS		 1130 if (!utf) {
1131 dTHR;
1132 if (ckWARN(WARN_UTF8))
1133 warner(WARN_UTF8,
1134 "Use of \\x{} without utf8 declaration");
1135 }
a0ed51b3 1136 /* note: utf always shorter than hex */
dfe13c55
GS		 1137 d = (char*)uv_to_utf8((U8*)d,
1138 scan_hex(s + 1, e - s - 1, &len));
a0ed51b3
LW		 1139 s = e + 1;
1140
1141 }
1142 else {
1143 UV uv = (UV)scan_hex(s, 2, &len);
1144 if (utf && PL_lex_inwhat == OP_TRANS &&
1145 utf != (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
1146 {
dfe13c55 1147 d = (char*)uv_to_utf8((U8*)d, uv); /* doing a CU or UC */
a0ed51b3
LW		 1148 }
1149 else {
d008e5eb
GS		 1150 if (uv >= 127 && UTF) {
1151 dTHR;
1152 if (ckWARN(WARN_UTF8))
1153 warner(WARN_UTF8,
1154 "\\x%.*s will produce malformed UTF-8 character; use \\x{%.*s} for that",
1155 len,s,len,s);
1156 }
a0ed51b3
LW		 1157 *d++ = (char)uv;
1158 }
1159 s += len;
1160 }
79072805 1161 continue;
02aa26ce
NT		 1162
1163 /* \c is a control character */
79072805
LW		 1164 case 'c':
1165 s++;
9d116dd7
JH		 1166#ifdef EBCDIC
1167 *d = *s++;
1168 if (isLOWER(*d))
1169 *d = toUPPER(*d);
1170 *d++ = toCTRL(*d);
1171#else
bbce6d69 1172 len = *s++;
1173 *d++ = toCTRL(len);
9d116dd7 1174#endif
79072805 1175 continue;
02aa26ce
NT		 1176
1177 /* printf-style backslashes, formfeeds, newlines, etc */
79072805
LW		 1178 case 'b':
1179 *d++ = '\b';
1180 break;
1181 case 'n':
1182 *d++ = '\n';
1183 break;
1184 case 'r':
1185 *d++ = '\r';
1186 break;
1187 case 'f':
1188 *d++ = '\f';
1189 break;
1190 case 't':
1191 *d++ = '\t';
1192 break;
1193 case 'e':
1194 *d++ = '\033';
1195 break;
1196 case 'a':
1197 *d++ = '\007';
1198 break;
02aa26ce
NT		 1199 } /* end switch */
1200
79072805
LW		 1201 s++;
1202 continue;
02aa26ce
NT		 1203 } /* end if (backslash) */
1204
79072805 1205 *d++ = *s++;
02aa26ce
NT		 1206 } /* while loop to process each character */
1207
1208 /* terminate the string and set up the sv */
79072805 1209 *d = '\0';
463ee0b2 1210 SvCUR_set(sv, d - SvPVX(sv));
79072805
LW		 1211 SvPOK_on(sv);
1212
02aa26ce 1213 /* shrink the sv if we allocated more than we used */
79072805
LW		 1214 if (SvCUR(sv) + 5 < SvLEN(sv)) {
1215 SvLEN_set(sv, SvCUR(sv) + 1);
463ee0b2 1216 Renew(SvPVX(sv), SvLEN(sv), char);
79072805 1217 }
02aa26ce 1218
9b599b2a 1219 /* return the substring (via yylval) only if we parsed anything */
3280af22
NIS		 1220 if (s > PL_bufptr) {
1221 if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) )
1222 sv = new_constant(start, s - start, (PL_lex_inpat ? "qr" : "q"),
b3ac6de7 1223 sv, Nullsv,
3280af22 1224 ( PL_lex_inwhat == OP_TRANS
b3ac6de7 1225 ? "tr"
3280af22 1226 : ( (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat)
b3ac6de7
IZ		 1227 ? "s"
1228 : "qq")));
79072805 1229 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
b3ac6de7 1230 } else
8990e307 1231 SvREFCNT_dec(sv);
79072805
LW		 1232 return s;
1233}
1234
1235/* This is the one truly awful dwimmer necessary to conflate C and sed. */
76e3520e 1236STATIC int
8ac85365 1237intuit_more(register char *s)
79072805 1238{
3280af22 1239 if (PL_lex_brackets)
79072805
LW		 1240 return TRUE;
1241 if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
1242 return TRUE;
1243 if (*s != '{' && *s != '[')
1244 return FALSE;
3280af22 1245 if (!PL_lex_inpat)
79072805
LW		 1246 return TRUE;
1247
1248 /* In a pattern, so maybe we have {n,m}. */
1249 if (*s == '{') {
1250 s++;
1251 if (!isDIGIT(*s))
1252 return TRUE;
1253 while (isDIGIT(*s))
1254 s++;
1255 if (*s == ',')
1256 s++;
1257 while (isDIGIT(*s))
1258 s++;
1259 if (*s == '}')
1260 return FALSE;
1261 return TRUE;
1262
1263 }
1264
1265 /* On the other hand, maybe we have a character class */
1266
1267 s++;
1268 if (*s == ']' || *s == '^')
1269 return FALSE;
1270 else {
1271 int weight = 2; /* let's weigh the evidence */
1272 char seen[256];
f27ffc4a 1273 unsigned char un_char = 255, last_un_char;
93a17b20 1274 char *send = strchr(s,']');
3280af22 1275 char tmpbuf[sizeof PL_tokenbuf * 4];
79072805
LW		 1276
1277 if (!send) /* has to be an expression */
1278 return TRUE;
1279
1280 Zero(seen,256,char);
1281 if (*s == '$')
1282 weight -= 3;
1283 else if (isDIGIT(*s)) {
1284 if (s[1] != ']') {
1285 if (isDIGIT(s[1]) && s[2] == ']')
1286 weight -= 10;
1287 }
1288 else
1289 weight -= 100;
1290 }
1291 for (; s < send; s++) {
1292 last_un_char = un_char;
1293 un_char = (unsigned char)*s;
1294 switch (*s) {
1295 case '@':
1296 case '&':
1297 case '$':
1298 weight -= seen[un_char] * 10;
834a4ddd 1299 if (isALNUM_lazy(s+1)) {
8903cb82 1300 scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE);
a0d0e21e 1301 if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
79072805
LW		 1302 weight -= 100;
1303 else
1304 weight -= 10;
1305 }
1306 else if (*s == '$' && s[1] &&
93a17b20
LW		 1307 strchr("[#!%*<>()-=",s[1])) {
1308 if (/*{*/ strchr("])} =",s[2]))
79072805
LW		 1309 weight -= 10;
1310 else
1311 weight -= 1;
1312 }
1313 break;
1314 case '\\':
1315 un_char = 254;
1316 if (s[1]) {
93a17b20 1317 if (strchr("wds]",s[1]))
79072805
LW		 1318 weight += 100;
1319 else if (seen['\''] || seen['"'])
1320 weight += 1;
93a17b20 1321 else if (strchr("rnftbxcav",s[1]))
79072805
LW		 1322 weight += 40;
1323 else if (isDIGIT(s[1])) {
1324 weight += 40;
1325 while (s[1] && isDIGIT(s[1]))
1326 s++;
1327 }
1328 }
1329 else
1330 weight += 100;
1331 break;
1332 case '-':
1333 if (s[1] == '\\')
1334 weight += 50;
93a17b20 1335 if (strchr("aA01! ",last_un_char))
79072805 1336 weight += 30;
93a17b20 1337 if (strchr("zZ79~",s[1]))
79072805 1338 weight += 30;
f27ffc4a
GS		 1339 if (last_un_char == 255 && (isDIGIT(s[1]) || s[1] == '$'))
1340 weight -= 5; /* cope with negative subscript */
79072805
LW		 1341 break;
1342 default:
93a17b20 1343 if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
79072805
LW		 1344 isALPHA(*s) && s[1] && isALPHA(s[1])) {
1345 char *d = tmpbuf;
1346 while (isALPHA(*s))
1347 *d++ = *s++;
1348 *d = '\0';
1349 if (keyword(tmpbuf, d - tmpbuf))
1350 weight -= 150;
1351 }
1352 if (un_char == last_un_char + 1)
1353 weight += 5;
1354 weight -= seen[un_char];
1355 break;
1356 }
1357 seen[un_char]++;
1358 }
1359 if (weight >= 0) /* probably a character class */
1360 return FALSE;
1361 }
1362
1363 return TRUE;
1364}
ffed7fef 1365
76e3520e 1366STATIC int
8ac85365 1367intuit_method(char *start, GV *gv)
a0d0e21e
LW		 1368{
1369 char *s = start + (*start == '$');
3280af22 1370 char tmpbuf[sizeof PL_tokenbuf];
a0d0e21e
LW		 1371 STRLEN len;
1372 GV* indirgv;
1373
1374 if (gv) {
b6c543e3 1375 CV *cv;
a0d0e21e
LW		 1376 if (GvIO(gv))
1377 return 0;
b6c543e3
IZ		 1378 if ((cv = GvCVu(gv))) {
1379 char *proto = SvPVX(cv);
1380 if (proto) {
1381 if (*proto == ';')
1382 proto++;
1383 if (*proto == '*')
1384 return 0;
1385 }
1386 } else
a0d0e21e
LW		 1387 gv = 0;
1388 }
8903cb82 1389 s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
a0d0e21e 1390 if (*start == '$') {
3280af22 1391 if (gv || PL_last_lop_op == OP_PRINT || isUPPER(*PL_tokenbuf))
a0d0e21e
LW		 1392 return 0;
1393 s = skipspace(s);
3280af22
NIS		 1394 PL_bufptr = start;
1395 PL_expect = XREF;
a0d0e21e
LW		 1396 return *s == '(' ? FUNCMETH : METHOD;
1397 }
1398 if (!keyword(tmpbuf, len)) {
c3e0f903
GS		 1399 if (len > 2 && tmpbuf[len - 2] == ':' && tmpbuf[len - 1] == ':') {
1400 len -= 2;
1401 tmpbuf[len] = '\0';
1402 goto bare_package;
1403 }
1404 indirgv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
8ebc5c01 1405 if (indirgv && GvCVu(indirgv))
a0d0e21e
LW		 1406 return 0;
1407 /* filehandle or package name makes it a method */
89bfa8cd 1408 if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) {
a0d0e21e 1409 s = skipspace(s);
3280af22 1410 if ((PL_bufend - s) >= 2 && *s == '=' && *(s+1) == '>')
55497cff 1411 return 0; /* no assumptions -- "=>" quotes bearword */
c3e0f903 1412 bare_package:
3280af22 1413 PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0,
79cb57f6 1414 newSVpvn(tmpbuf,len));
3280af22
NIS		 1415 PL_nextval[PL_nexttoke].opval->op_private = OPpCONST_BARE;
1416 PL_expect = XTERM;
a0d0e21e 1417 force_next(WORD);
3280af22 1418 PL_bufptr = s;
a0d0e21e
LW		 1419 return *s == '(' ? FUNCMETH : METHOD;
1420 }
1421 }
1422 return 0;
1423}
1424
76e3520e 1425STATIC char*
8ac85365 1426incl_perldb(void)
a0d0e21e 1427{
3280af22 1428 if (PL_perldb) {
76e3520e 1429 char *pdb = PerlEnv_getenv("PERL5DB");
a0d0e21e
LW		 1430
1431 if (pdb)
1432 return pdb;
61bb5906 1433 SETERRNO(0,SS$_NORMAL);
a0d0e21e
LW		 1434 return "BEGIN { require 'perl5db.pl' }";
1435 }
1436 return "";
1437}
1438
1439
16d20bd9
AD		 1440/* Encoded script support. filter_add() effectively inserts a
1441 * 'pre-processing' function into the current source input stream.
1442 * Note that the filter function only applies to the current source file
1443 * (e.g., it will not affect files 'require'd or 'use'd by this one).
1444 *
1445 * The datasv parameter (which may be NULL) can be used to pass
1446 * private data to this instance of the filter. The filter function
1447 * can recover the SV using the FILTER_DATA macro and use it to
1448 * store private buffers and state information.
1449 *
1450 * The supplied datasv parameter is upgraded to a PVIO type
1451 * and the IoDIRP field is used to store the function pointer.
1452 * Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
1453 * private use must be set using malloc'd pointers.
1454 */
16d20bd9
AD		 1455
1456SV *
8ac85365 1457filter_add(filter_t funcp, SV *datasv)
16d20bd9
AD		 1458{
1459 if (!funcp){ /* temporary handy debugging hack to be deleted */
80252599 1460 PL_filter_debug = atoi((char*)datasv);
16d20bd9
AD		 1461 return NULL;
1462 }
3280af22
NIS		 1463 if (!PL_rsfp_filters)
1464 PL_rsfp_filters = newAV();
16d20bd9 1465 if (!datasv)
8c52afec 1466 datasv = NEWSV(255,0);
16d20bd9
AD		 1467 if (!SvUPGRADE(datasv, SVt_PVIO))
1468 die("Can't upgrade filter_add data to SVt_PVIO");
1469 IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
80252599 1470 if (PL_filter_debug) {
2d8e6c8d
GS		 1471 STRLEN n_a;
1472 warn("filter_add func %p (%s)", funcp, SvPV(datasv, n_a));
1473 }
3280af22
NIS		 1474 av_unshift(PL_rsfp_filters, 1);
1475 av_store(PL_rsfp_filters, 0, datasv) ;
16d20bd9
AD		 1476 return(datasv);
1477}
1478
1479
1480/* Delete most recently added instance of this filter function. */
a0d0e21e 1481void
8ac85365 1482filter_del(filter_t funcp)
16d20bd9 1483{
80252599 1484 if (PL_filter_debug)
ff0cee69 1485 warn("filter_del func %p", funcp);
3280af22 1486 if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
16d20bd9
AD		 1487 return;
1488 /* if filter is on top of stack (usual case) just pop it off */
677ca527 1489 if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){
3280af22 1490 sv_free(av_pop(PL_rsfp_filters));
e50aee73 1491
16d20bd9
AD		 1492 return;
1493 }
1494 /* we need to search for the correct entry and clear it */
1495 die("filter_del can only delete in reverse order (currently)");
1496}
1497
1498
1499/* Invoke the n'th filter function for the current rsfp. */
1500I32
8ac85365
NIS		 1501filter_read(int idx, SV *buf_sv, int maxlen)
1502
1503
1504 /* 0 = read one text line */
a0d0e21e 1505{
16d20bd9
AD		 1506 filter_t funcp;
1507 SV *datasv = NULL;
e50aee73 1508
3280af22 1509 if (!PL_rsfp_filters)
16d20bd9 1510 return -1;
3280af22 1511 if (idx > AvFILLp(PL_rsfp_filters)){ /* Any more filters? */
16d20bd9
AD		 1512 /* Provide a default input filter to make life easy. */
1513 /* Note that we append to the line. This is handy. */
80252599 1514 if (PL_filter_debug)
16d20bd9
AD		 1515 warn("filter_read %d: from rsfp\n", idx);
1516 if (maxlen) {
1517 /* Want a block */
1518 int len ;
1519 int old_len = SvCUR(buf_sv) ;
1520
1521 /* ensure buf_sv is large enough */
1522 SvGROW(buf_sv, old_len + maxlen) ;
3280af22
NIS		 1523 if ((len = PerlIO_read(PL_rsfp, SvPVX(buf_sv) + old_len, maxlen)) <= 0){
1524 if (PerlIO_error(PL_rsfp))
37120919
AD		 1525 return -1; /* error */
1526 else
1527 return 0 ; /* end of file */
1528 }
16d20bd9
AD		 1529 SvCUR_set(buf_sv, old_len + len) ;
1530 } else {
1531 /* Want a line */
3280af22
NIS		 1532 if (sv_gets(buf_sv, PL_rsfp, SvCUR(buf_sv)) == NULL) {
1533 if (PerlIO_error(PL_rsfp))
37120919
AD		 1534 return -1; /* error */
1535 else
1536 return 0 ; /* end of file */
1537 }
16d20bd9
AD		 1538 }
1539 return SvCUR(buf_sv);
1540 }
1541 /* Skip this filter slot if filter has been deleted */
3280af22 1542 if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef){
80252599 1543 if (PL_filter_debug)
16d20bd9
AD		 1544 warn("filter_read %d: skipped (filter deleted)\n", idx);
1545 return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
1546 }
1547 /* Get function pointer hidden within datasv */
1548 funcp = (filter_t)IoDIRP(datasv);
80252599 1549 if (PL_filter_debug) {
2d8e6c8d 1550 STRLEN n_a;
ff0cee69 1551 warn("filter_read %d: via function %p (%s)\n",
2d8e6c8d
GS		 1552 idx, funcp, SvPV(datasv,n_a));
1553 }
16d20bd9
AD		 1554 /* Call function. The function is expected to */
1555 /* call "FILTER_READ(idx+1, buf_sv)" first. */
37120919 1556 /* Return: <0:error, =0:eof, >0:not eof */
1d583055 1557 return (*funcp)(PERL_OBJECT_THIS_ idx, buf_sv, maxlen);
16d20bd9
AD		 1558}
1559
76e3520e
GS		 1560STATIC char *
1561filter_gets(register SV *sv, register PerlIO *fp, STRLEN append)
16d20bd9 1562{
a868473f 1563#ifdef WIN32FILTER
3280af22 1564 if (!PL_rsfp_filters) {
a868473f
NIS		 1565 filter_add(win32_textfilter,NULL);
1566 }
1567#endif
3280af22 1568 if (PL_rsfp_filters) {
16d20bd9 1569
55497cff 1570 if (!append)
1571 SvCUR_set(sv, 0); /* start with empty line */
16d20bd9
AD		 1572 if (FILTER_READ(0, sv, 0) > 0)
1573 return ( SvPVX(sv) ) ;
1574 else
1575 return Nullch ;
1576 }
9d116dd7 1577 else
fd049845 1578 return (sv_gets(sv, fp, append));
a0d0e21e
LW		 1579}
1580
1581
748a9306
LW		 1582#ifdef DEBUGGING
1583 static char* exp_name[] =
a0d0e21e 1584 { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "TERMBLOCK" };
748a9306 1585#endif
463ee0b2 1586
02aa26ce
NT		 1587/*
1588 yylex
1589
1590 Works out what to call the token just pulled out of the input
1591 stream. The yacc parser takes care of taking the ops we return and
1592 stitching them into a tree.
1593
1594 Returns:
1595 PRIVATEREF
1596
1597 Structure:
1598 if read an identifier
1599 if we're in a my declaration
1600 croak if they tried to say my($foo::bar)
1601 build the ops for a my() declaration
1602 if it's an access to a my() variable
1603 are we in a sort block?
1604 croak if my($a); $a <=> $b
1605 build ops for access to a my() variable
1606 if in a dq string, and they've said @foo and we can't find @foo
1607 croak
1608 build ops for a bareword
1609 if we already built the token before, use it.
1610*/
1611
bee8cd07 1612int yylex(PERL_YYLEX_PARAM_DECL)
378cc40b 1613{
11343788 1614 dTHR;
79072805 1615 register char *s;
378cc40b 1616 register char *d;
79072805 1617 register I32 tmp;
463ee0b2 1618 STRLEN len;
161b471a
NIS		 1619 GV *gv = Nullgv;
1620 GV **gvp = 0;
a687059c 1621
a1a0e61e
TD		 1622#ifdef USE_PURE_BISON
1623 yylval_pointer = lvalp;
1624 yychar_pointer = lcharp;
1625#endif
1626
02aa26ce 1627 /* check if there's an identifier for us to look at */
3280af22 1628 if (PL_pending_ident) {
02aa26ce 1629 /* pit holds the identifier we read and pending_ident is reset */
3280af22
NIS		 1630 char pit = PL_pending_ident;
1631 PL_pending_ident = 0;
bbce6d69 1632
02aa26ce
NT		 1633 /* if we're in a my(), we can't allow dynamics here.
1634 $foo'bar has already been turned into $foo::bar, so
1635 just check for colons.
1636
1637 if it's a legal name, the OP is a PADANY.
1638 */
3280af22
NIS		 1639 if (PL_in_my) {
1640 if (strchr(PL_tokenbuf,':'))
dce40276 1641 yyerror(form(PL_no_myglob,PL_tokenbuf));
02aa26ce 1642
bbce6d69 1643 yylval.opval = newOP(OP_PADANY, 0);
3280af22 1644 yylval.opval->op_targ = pad_allocmy(PL_tokenbuf);
bbce6d69 1645 return PRIVATEREF;
1646 }
1647
02aa26ce
NT		 1648 /*
1649 build the ops for accesses to a my() variable.
1650
1651 Deny my($a) or my($b) in a sort block, *if* $a or $b is
1652 then used in a comparison. This catches most, but not
1653 all cases. For instance, it catches
1654 sort { my($a); $a <=> $b }
1655 but not
1656 sort { my($a); $a < $b ? -1 : $a == $b ? 0 : 1; }
1657 (although why you'd do that is anyone's guess).
1658 */
1659
3280af22 1660 if (!strchr(PL_tokenbuf,':')) {
a863c7d1 1661#ifdef USE_THREADS
54b9620d 1662 /* Check for single character per-thread SVs */
3280af22
NIS		 1663 if (PL_tokenbuf[0] == '$' && PL_tokenbuf[2] == '\0'
1664 && !isALPHA(PL_tokenbuf[1]) /* Rule out obvious non-threadsvs */
1665 && (tmp = find_threadsv(&PL_tokenbuf[1])) != NOT_IN_PAD)
554b3eca 1666 {
2faa37cc 1667 yylval.opval = newOP(OP_THREADSV, 0);
a863c7d1
MB		 1668 yylval.opval->op_targ = tmp;
1669 return PRIVATEREF;
1670 }
1671#endif /* USE_THREADS */
3280af22 1672 if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
02aa26ce 1673 /* if it's a sort block and they're naming $a or $b */
3280af22
NIS		 1674 if (PL_last_lop_op == OP_SORT &&
1675 PL_tokenbuf[0] == '$' &&
1676 (PL_tokenbuf[1] == 'a' || PL_tokenbuf[1] == 'b')
1677 && !PL_tokenbuf[2])
bbce6d69 1678 {
3280af22
NIS		 1679 for (d = PL_in_eval ? PL_oldoldbufptr : PL_linestart;
1680 d < PL_bufend && *d != '\n';
a863c7d1
MB		 1681 d++)
1682 {
1683 if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
1684 croak("Can't use \"my %s\" in sort comparison",
3280af22 1685 PL_tokenbuf);
a863c7d1 1686 }
bbce6d69 1687 }
1688 }
bbce6d69 1689
a863c7d1
MB		 1690 yylval.opval = newOP(OP_PADANY, 0);
1691 yylval.opval->op_targ = tmp;
1692 return PRIVATEREF;
1693 }
bbce6d69 1694 }
1695
02aa26ce
NT		 1696 /*
1697 Whine if they've said @foo in a doublequoted string,
1698 and @foo isn't a variable we can find in the symbol
1699 table.
1700 */
3280af22
NIS		 1701 if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
1702 GV *gv = gv_fetchpv(PL_tokenbuf+1, FALSE, SVt_PVAV);
1703 if (!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
46fc3d4c 1704 yyerror(form("In string, %s now must be written as \\%s",
3280af22 1705 PL_tokenbuf, PL_tokenbuf));
bbce6d69 1706 }
1707
02aa26ce 1708 /* build ops for a bareword */
3280af22 1709 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0));
bbce6d69 1710 yylval.opval->op_private = OPpCONST_ENTERED;
3280af22
NIS		 1711 gv_fetchpv(PL_tokenbuf+1, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
1712 ((PL_tokenbuf[0] == '$') ? SVt_PV
1713 : (PL_tokenbuf[0] == '@') ? SVt_PVAV
bbce6d69 1714 : SVt_PVHV));
1715 return WORD;
1716 }
1717
02aa26ce
NT		 1718 /* no identifier pending identification */
1719
3280af22 1720 switch (PL_lex_state) {
79072805
LW		 1721#ifdef COMMENTARY
1722 case LEX_NORMAL: /* Some compilers will produce faster */
1723 case LEX_INTERPNORMAL: /* code if we comment these out. */
1724 break;
1725#endif
1726
02aa26ce 1727 /* when we're already built the next token, just pull it out the queue */
79072805 1728 case LEX_KNOWNEXT:
3280af22
NIS		 1729 PL_nexttoke--;
1730 yylval = PL_nextval[PL_nexttoke];
1731 if (!PL_nexttoke) {
1732 PL_lex_state = PL_lex_defer;
1733 PL_expect = PL_lex_expect;
1734 PL_lex_defer = LEX_NORMAL;
463ee0b2 1735 }
3280af22 1736 return(PL_nexttype[PL_nexttoke]);
79072805 1737
02aa26ce 1738 /* interpolated case modifiers like \L \U, including \Q and \E.
3280af22 1739 when we get here, PL_bufptr is at the \
02aa26ce 1740 */
79072805
LW		 1741 case LEX_INTERPCASEMOD:
1742#ifdef DEBUGGING
3280af22 1743 if (PL_bufptr != PL_bufend && *PL_bufptr != '\\')
463ee0b2 1744 croak("panic: INTERPCASEMOD");
79072805 1745#endif
02aa26ce 1746 /* handle \E or end of string */
3280af22 1747 if (PL_bufptr == PL_bufend || PL_bufptr[1] == 'E') {
a0d0e21e 1748 char oldmod;
02aa26ce
NT		 1749
1750 /* if at a \E */
3280af22
NIS		 1751 if (PL_lex_casemods) {
1752 oldmod = PL_lex_casestack[--PL_lex_casemods];
1753 PL_lex_casestack[PL_lex_casemods] = '\0';
02aa26ce 1754
3280af22
NIS		 1755 if (PL_bufptr != PL_bufend && strchr("LUQ", oldmod)) {
1756 PL_bufptr += 2;
1757 PL_lex_state = LEX_INTERPCONCAT;
a0d0e21e 1758 }
79072805
LW		 1759 return ')';
1760 }
3280af22
NIS		 1761 if (PL_bufptr != PL_bufend)
1762 PL_bufptr += 2;
1763 PL_lex_state = LEX_INTERPCONCAT;
e4bfbdd4 1764 return yylex(PERL_YYLEX_PARAM);
79072805
LW		 1765 }
1766 else {
3280af22 1767 s = PL_bufptr + 1;
79072805
LW		 1768 if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
1769 tmp = *s, *s = s[2], s[2] = tmp; /* misordered... */
a0d0e21e 1770 if (strchr("LU", *s) &&
3280af22 1771 (strchr(PL_lex_casestack, 'L') || strchr(PL_lex_casestack, 'U')))
a0d0e21e 1772 {
3280af22 1773 PL_lex_casestack[--PL_lex_casemods] = '\0';
a0d0e21e
LW		 1774 return ')';
1775 }
3280af22
NIS		 1776 if (PL_lex_casemods > 10) {
1777 char* newlb = Renew(PL_lex_casestack, PL_lex_casemods + 2, char);
1778 if (newlb != PL_lex_casestack) {
a0d0e21e 1779 SAVEFREEPV(newlb);
3280af22 1780 PL_lex_casestack = newlb;
a0d0e21e
LW		 1781 }
1782 }
3280af22
NIS		 1783 PL_lex_casestack[PL_lex_casemods++] = *s;
1784 PL_lex_casestack[PL_lex_casemods] = '\0';
1785 PL_lex_state = LEX_INTERPCONCAT;
1786 PL_nextval[PL_nexttoke].ival = 0;
79072805
LW		 1787 force_next('(');
1788 if (*s == 'l')
3280af22 1789 PL_nextval[PL_nexttoke].ival = OP_LCFIRST;
79072805 1790 else if (*s == 'u')
3280af22 1791 PL_nextval[PL_nexttoke].ival = OP_UCFIRST;
79072805 1792 else if (*s == 'L')
3280af22 1793 PL_nextval[PL_nexttoke].ival = OP_LC;
79072805 1794 else if (*s == 'U')
3280af22 1795 PL_nextval[PL_nexttoke].ival = OP_UC;
a0d0e21e 1796 else if (*s == 'Q')
3280af22 1797 PL_nextval[PL_nexttoke].ival = OP_QUOTEMETA;
79072805 1798 else
463ee0b2 1799 croak("panic: yylex");
3280af22 1800 PL_bufptr = s + 1;
79072805 1801 force_next(FUNC);
3280af22
NIS		 1802 if (PL_lex_starts) {
1803 s = PL_bufptr;
1804 PL_lex_starts = 0;
79072805
LW		 1805 Aop(OP_CONCAT);
1806 }
1807 else
e4bfbdd4 1808 return yylex(PERL_YYLEX_PARAM);
79072805
LW		 1809 }
1810
55497cff 1811 case LEX_INTERPPUSH:
1812 return sublex_push();
1813
79072805 1814 case LEX_INTERPSTART:
3280af22 1815 if (PL_bufptr == PL_bufend)
79072805 1816 return sublex_done();
3280af22
NIS		 1817 PL_expect = XTERM;
1818 PL_lex_dojoin = (*PL_bufptr == '@');
1819 PL_lex_state = LEX_INTERPNORMAL;
1820 if (PL_lex_dojoin) {
1821 PL_nextval[PL_nexttoke].ival = 0;
79072805 1822 force_next(',');
554b3eca 1823#ifdef USE_THREADS
533c011a
NIS		 1824 PL_nextval[PL_nexttoke].opval = newOP(OP_THREADSV, 0);
1825 PL_nextval[PL_nexttoke].opval->op_targ = find_threadsv("\"");
554b3eca
MB		 1826 force_next(PRIVATEREF);
1827#else
a0d0e21e 1828 force_ident("\"", '$');
554b3eca 1829#endif /* USE_THREADS */
3280af22 1830 PL_nextval[PL_nexttoke].ival = 0;
79072805 1831 force_next('$');
3280af22 1832 PL_nextval[PL_nexttoke].ival = 0;
79072805 1833 force_next('(');
3280af22 1834 PL_nextval[PL_nexttoke].ival = OP_JOIN; /* emulate join($", ...) */
79072805
LW		 1835 force_next(FUNC);
1836 }
3280af22
NIS		 1837 if (PL_lex_starts++) {
1838 s = PL_bufptr;
79072805
LW		 1839 Aop(OP_CONCAT);
1840 }
e4bfbdd4 1841 return yylex(PERL_YYLEX_PARAM);
79072805
LW		 1842
1843 case LEX_INTERPENDMAYBE:
3280af22
NIS		 1844 if (intuit_more(PL_bufptr)) {
1845 PL_lex_state = LEX_INTERPNORMAL; /* false alarm, more expr */
79072805
LW		 1846 break;
1847 }
1848 /* FALL THROUGH */
1849
1850 case LEX_INTERPEND:
3280af22
NIS		 1851 if (PL_lex_dojoin) {
1852 PL_lex_dojoin = FALSE;
1853 PL_lex_state = LEX_INTERPCONCAT;
79072805
LW		 1854 return ')';
1855 }
43a16006
HS		 1856 if (PL_lex_inwhat == OP_SUBST && PL_linestr == PL_lex_repl
1857 && SvCOMPILED(PL_lex_repl))
1858 {
e9fa98b2
HS		 1859 if (PL_bufptr != PL_bufend)
1860 croak("Bad evalled substitution pattern");
1861 PL_lex_repl = Nullsv;
1862 }
79072805
LW		 1863 /* FALLTHROUGH */
1864 case LEX_INTERPCONCAT:
1865#ifdef DEBUGGING
3280af22 1866 if (PL_lex_brackets)
463ee0b2 1867 croak("panic: INTERPCONCAT");
79072805 1868#endif
3280af22 1869 if (PL_bufptr == PL_bufend)
79072805
LW		 1870 return sublex_done();
1871
3280af22
NIS		 1872 if (SvIVX(PL_linestr) == '\'') {
1873 SV *sv = newSVsv(PL_linestr);
1874 if (!PL_lex_inpat)
76e3520e 1875 sv = tokeq(sv);
3280af22 1876 else if ( PL_hints & HINT_NEW_RE )
b3ac6de7 1877 sv = new_constant(NULL, 0, "qr", sv, sv, "q");
79072805 1878 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
3280af22 1879 s = PL_bufend;
79072805
LW		 1880 }
1881 else {
3280af22 1882 s = scan_const(PL_bufptr);
79072805 1883 if (*s == '\\')
3280af22 1884 PL_lex_state = LEX_INTERPCASEMOD;
79072805 1885 else
3280af22 1886 PL_lex_state = LEX_INTERPSTART;
79072805
LW		 1887 }
1888
3280af22
NIS		 1889 if (s != PL_bufptr) {
1890 PL_nextval[PL_nexttoke] = yylval;
1891 PL_expect = XTERM;
79072805 1892 force_next(THING);
3280af22 1893 if (PL_lex_starts++)
79072805
LW		 1894 Aop(OP_CONCAT);
1895 else {
3280af22 1896 PL_bufptr = s;
e4bfbdd4 1897 return yylex(PERL_YYLEX_PARAM);
79072805
LW		 1898 }
1899 }
1900
e4bfbdd4 1901 return yylex(PERL_YYLEX_PARAM);
a0d0e21e 1902 case LEX_FORMLINE:
3280af22
NIS		 1903 PL_lex_state = LEX_NORMAL;
1904 s = scan_formline(PL_bufptr);
1905 if (!PL_lex_formbrack)
a0d0e21e
LW		 1906 goto rightbracket;
1907 OPERATOR(';');
79072805
LW		 1908 }
1909
3280af22
NIS		 1910 s = PL_bufptr;
1911 PL_oldoldbufptr = PL_oldbufptr;
1912 PL_oldbufptr = s;
79072805 1913 DEBUG_p( {
3280af22 1914 PerlIO_printf(PerlIO_stderr(), "### Tokener expecting %s at %s\n", exp_name[PL_expect], s);
79072805 1915 } )
463ee0b2
LW		 1916
1917 retry:
378cc40b
LW		 1918 switch (*s) {
1919 default:
834a4ddd
LW		 1920 if (isIDFIRST_lazy(s))
1921 goto keylookup;
a0ed51b3 1922 croak("Unrecognized character \\x%02X", *s & 255);
e929a76b
LW		 1923 case 4:
1924 case 26:
1925 goto fake_eof; /* emulate EOF on ^D or ^Z */
378cc40b 1926 case 0:
3280af22
NIS		 1927 if (!PL_rsfp) {
1928 PL_last_uni = 0;
1929 PL_last_lop = 0;
1930 if (PL_lex_brackets)
d98d5fff 1931 yyerror("Missing right curly or square bracket");
79072805 1932 TOKEN(0);
463ee0b2 1933 }
3280af22 1934 if (s++ < PL_bufend)
a687059c 1935 goto retry; /* ignore stray nulls */
3280af22
NIS		 1936 PL_last_uni = 0;
1937 PL_last_lop = 0;
1938 if (!PL_in_eval && !PL_preambled) {
1939 PL_preambled = TRUE;
1940 sv_setpv(PL_linestr,incl_perldb());
1941 if (SvCUR(PL_linestr))
1942 sv_catpv(PL_linestr,";");
1943 if (PL_preambleav){
1944 while(AvFILLp(PL_preambleav) >= 0) {
1945 SV *tmpsv = av_shift(PL_preambleav);
1946 sv_catsv(PL_linestr, tmpsv);
1947 sv_catpv(PL_linestr, ";");
91b7def8 1948 sv_free(tmpsv);
1949 }
3280af22
NIS		 1950 sv_free((SV*)PL_preambleav);
1951 PL_preambleav = NULL;
91b7def8 1952 }
3280af22
NIS		 1953 if (PL_minus_n || PL_minus_p) {
1954 sv_catpv(PL_linestr, "LINE: while (<>) {");
1955 if (PL_minus_l)
1956 sv_catpv(PL_linestr,"chomp;");
1957 if (PL_minus_a) {
8fd239a7
CS		 1958 GV* gv = gv_fetchpv("::F", TRUE, SVt_PVAV);
1959 if (gv)
1960 GvIMPORTED_AV_on(gv);
3280af22
NIS		 1961 if (PL_minus_F) {
1962 if (strchr("/'\"", *PL_splitstr)
1963 && strchr(PL_splitstr + 1, *PL_splitstr))
1964 sv_catpvf(PL_linestr, "@F=split(%s);", PL_splitstr);
54310121 1965 else {
1966 char delim;
1967 s = "'~#\200\1'"; /* surely one char is unused...*/
3280af22 1968 while (s[1] && strchr(PL_splitstr, *s)) s++;
54310121 1969 delim = *s;
3280af22 1970 sv_catpvf(PL_linestr, "@F=split(%s%c",
46fc3d4c 1971 "q" + (delim == '\''), delim);
3280af22 1972 for (s = PL_splitstr; *s; s++) {
54310121 1973 if (*s == '\\')
3280af22
NIS		 1974 sv_catpvn(PL_linestr, "\\", 1);
1975 sv_catpvn(PL_linestr, s, 1);
54310121 1976 }
3280af22 1977 sv_catpvf(PL_linestr, "%c);", delim);
54310121 1978 }
2304df62
AD		 1979 }
1980 else
3280af22 1981 sv_catpv(PL_linestr,"@F=split(' ');");
2304df62 1982 }
79072805 1983 }
3280af22
NIS		 1984 sv_catpv(PL_linestr, "\n");
1985 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
1986 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
1987 if (PERLDB_LINE && PL_curstash != PL_debstash) {
a0d0e21e
LW		 1988 SV *sv = NEWSV(85,0);
1989
1990 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 1991 sv_setsv(sv,PL_linestr);
1992 av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
a0d0e21e 1993 }
79072805 1994 goto retry;
a687059c 1995 }
e929a76b 1996 do {
3280af22 1997 if ((s = filter_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
e929a76b 1998 fake_eof:
3280af22
NIS		 1999 if (PL_rsfp) {
2000 if (PL_preprocess && !PL_in_eval)
2001 (void)PerlProc_pclose(PL_rsfp);
2002 else if ((PerlIO *)PL_rsfp == PerlIO_stdin())
2003 PerlIO_clearerr(PL_rsfp);
395c3793 2004 else
3280af22
NIS		 2005 (void)PerlIO_close(PL_rsfp);
2006 PL_rsfp = Nullfp;
4a9ae47a 2007 PL_doextract = FALSE;
395c3793 2008 }
3280af22
NIS		 2009 if (!PL_in_eval && (PL_minus_n || PL_minus_p)) {
2010 sv_setpv(PL_linestr,PL_minus_p ? ";}continue{print" : "");
2011 sv_catpv(PL_linestr,";}");
2012 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
2013 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
2014 PL_minus_n = PL_minus_p = 0;
e929a76b
LW		 2015 goto retry;
2016 }
3280af22
NIS		 2017 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
2018 sv_setpv(PL_linestr,"");
79072805 2019 TOKEN(';'); /* not infinite loop because rsfp is NULL now */
378cc40b 2020 }
3280af22 2021 if (PL_doextract) {
a0d0e21e 2022 if (*s == '#' && s[1] == '!' && instr(s,"perl"))
3280af22 2023 PL_doextract = FALSE;
a0d0e21e
LW		 2024
2025 /* Incest with pod. */
2026 if (*s == '=' && strnEQ(s, "=cut", 4)) {
3280af22
NIS		 2027 sv_setpv(PL_linestr, "");
2028 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
2029 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
2030 PL_doextract = FALSE;
a0d0e21e
LW		 2031 }
2032 }
463ee0b2 2033 incline(s);
3280af22
NIS		 2034 } while (PL_doextract);
2035 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
2036 if (PERLDB_LINE && PL_curstash != PL_debstash) {
79072805 2037 SV *sv = NEWSV(85,0);
a687059c 2038
93a17b20 2039 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 2040 sv_setsv(sv,PL_linestr);
2041 av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
a687059c 2042 }
3280af22
NIS		 2043 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
2044 if (PL_curcop->cop_line == 1) {
2045 while (s < PL_bufend && isSPACE(*s))
79072805 2046 s++;
a0d0e21e 2047 if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
79072805 2048 s++;
44a8e56a 2049 d = Nullch;
3280af22 2050 if (!PL_in_eval) {
44a8e56a 2051 if (*s == '#' && *(s+1) == '!')
2052 d = s + 2;
2053#ifdef ALTERNATE_SHEBANG
2054 else {
2055 static char as[] = ALTERNATE_SHEBANG;
2056 if (*s == as[0] && strnEQ(s, as, sizeof(as) - 1))
2057 d = s + (sizeof(as) - 1);
2058 }
2059#endif /* ALTERNATE_SHEBANG */
2060 }
2061 if (d) {
b8378b72 2062 char *ipath;
774d564b 2063 char *ipathend;
b8378b72 2064
774d564b 2065 while (isSPACE(*d))
b8378b72
CS		 2066 d++;
2067 ipath = d;
774d564b 2068 while (*d && !isSPACE(*d))
2069 d++;
2070 ipathend = d;
2071
2072#ifdef ARG_ZERO_IS_SCRIPT
2073 if (ipathend > ipath) {
2074 /*
2075 * HP-UX (at least) sets argv[0] to the script name,
2076 * which makes $^X incorrect. And Digital UNIX and Linux,
2077 * at least, set argv[0] to the basename of the Perl
2078 * interpreter. So, having found "#!", we'll set it right.
2079 */
2080 SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
2081 assert(SvPOK(x) || SvGMAGICAL(x));
6b88bc9c 2082 if (sv_eq(x, GvSV(PL_curcop->cop_filegv))) {
774d564b 2083 sv_setpvn(x, ipath, ipathend - ipath);
9607fc9c 2084 SvSETMAGIC(x);
2085 }
774d564b 2086 TAINT_NOT; /* $^X is always tainted, but that's OK */
8ebc5c01 2087 }
774d564b 2088#endif /* ARG_ZERO_IS_SCRIPT */
b8378b72
CS		 2089
2090 /*
2091 * Look for options.
2092 */
748a9306
LW		 2093 d = instr(s,"perl -");
2094 if (!d)
2095 d = instr(s,"perl");
44a8e56a 2096#ifdef ALTERNATE_SHEBANG
2097 /*
2098 * If the ALTERNATE_SHEBANG on this system starts with a
2099 * character that can be part of a Perl expression, then if
2100 * we see it but not "perl", we're probably looking at the
2101 * start of Perl code, not a request to hand off to some
2102 * other interpreter. Similarly, if "perl" is there, but
2103 * not in the first 'word' of the line, we assume the line
2104 * contains the start of the Perl program.
44a8e56a 2105 */
2106 if (d && *s != '#') {
774d564b 2107 char *c = ipath;
44a8e56a 2108 while (*c && !strchr("; \t\r\n\f\v#", *c))
2109 c++;
2110 if (c < d)
2111 d = Nullch; /* "perl" not in first word; ignore */
2112 else
2113 *s = '#'; /* Don't try to parse shebang line */
2114 }
774d564b 2115#endif /* ALTERNATE_SHEBANG */
748a9306 2116 if (!d &&
44a8e56a 2117 *s == '#' &&
774d564b 2118 ipathend > ipath &&
3280af22 2119 !PL_minus_c &&
748a9306 2120 !instr(s,"indir") &&
3280af22 2121 instr(PL_origargv[0],"perl"))
748a9306 2122 {
9f68db38 2123 char **newargv;
9f68db38 2124
774d564b 2125 *ipathend = '\0';
2126 s = ipathend + 1;
3280af22 2127 while (s < PL_bufend && isSPACE(*s))
9f68db38 2128 s++;
3280af22
NIS		 2129 if (s < PL_bufend) {
2130 Newz(899,newargv,PL_origargc+3,char*);
9f68db38 2131 newargv[1] = s;
3280af22 2132 while (s < PL_bufend && !isSPACE(*s))
9f68db38
LW		 2133 s++;
2134 *s = '\0';
3280af22 2135 Copy(PL_origargv+1, newargv+2, PL_origargc+1, char*);
9f68db38
LW		 2136 }
2137 else
3280af22 2138 newargv = PL_origargv;
774d564b 2139 newargv[0] = ipath;
80252599 2140 PerlProc_execv(ipath, newargv);
774d564b 2141 croak("Can't exec %s", ipath);
9f68db38 2142 }
748a9306 2143 if (d) {
3280af22
NIS		 2144 U32 oldpdb = PL_perldb;
2145 bool oldn = PL_minus_n;
2146 bool oldp = PL_minus_p;
748a9306
LW		 2147
2148 while (*d && !isSPACE(*d)) d++;
89bfa8cd 2149 while (*d == ' ' || *d == '\t') d++;
748a9306
LW		 2150
2151 if (*d++ == '-') {
8cc95fdb 2152 do {
2153 if (*d == 'M' || *d == 'm') {
2154 char *m = d;
2155 while (*d && !isSPACE(*d)) d++;
2156 croak("Too late for \"-%.*s\" option",
2157 (int)(d - m), m);
2158 }
2159 d = moreswitches(d);
2160 } while (d);
84902520 2161 if (PERLDB_LINE && !oldpdb ||
3280af22 2162 ( PL_minus_n || PL_minus_p ) && !(oldn || oldp) )
b084f20b 2163 /* if we have already added "LINE: while (<>) {",
2164 we must not do it again */
748a9306 2165 {
3280af22
NIS		 2166 sv_setpv(PL_linestr, "");
2167 PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
2168 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
2169 PL_preambled = FALSE;
84902520 2170 if (PERLDB_LINE)
3280af22 2171 (void)gv_fetchfile(PL_origfilename);
748a9306
LW		 2172 goto retry;
2173 }
a0d0e21e 2174 }
79072805 2175 }
9f68db38 2176 }
79072805 2177 }
3280af22
NIS		 2178 if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
2179 PL_bufptr = s;
2180 PL_lex_state = LEX_FORMLINE;
e4bfbdd4 2181 return yylex(PERL_YYLEX_PARAM);
ae986130 2182 }
378cc40b 2183 goto retry;
4fdae800 2184 case '\r':
6a27c188 2185#ifdef PERL_STRICT_CR
54310121 2186 warn("Illegal character \\%03o (carriage return)", '\r');
2187 croak(
2188 "(Maybe you didn't strip carriage returns after a network transfer?)\n");
a868473f 2189#endif
4fdae800 2190 case ' ': case '\t': case '\f': case 013:
378cc40b
LW		 2191 s++;
2192 goto retry;
378cc40b 2193 case '#':
e929a76b 2194 case '\n':
3280af22
NIS		 2195 if (PL_lex_state != LEX_NORMAL || (PL_in_eval && !PL_rsfp)) {
2196 d = PL_bufend;
a687059c 2197 while (s < d && *s != '\n')
378cc40b 2198 s++;
0f85fab0 2199 if (s < d)
378cc40b 2200 s++;
463ee0b2 2201 incline(s);
3280af22
NIS		 2202 if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
2203 PL_bufptr = s;
2204 PL_lex_state = LEX_FORMLINE;
e4bfbdd4 2205 return yylex(PERL_YYLEX_PARAM);
a687059c 2206 }
378cc40b 2207 }
a687059c 2208 else {
378cc40b 2209 *s = '\0';
3280af22 2210 PL_bufend = s;
a687059c 2211 }
378cc40b
LW		 2212 goto retry;
2213 case '-':
79072805 2214 if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
378cc40b 2215 s++;
3280af22 2216 PL_bufptr = s;
748a9306
LW		 2217 tmp = *s++;
2218
3280af22 2219 while (s < PL_bufend && (*s == ' ' || *s == '\t'))
748a9306
LW		 2220 s++;
2221
2222 if (strnEQ(s,"=>",2)) {
3280af22 2223 s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
748a9306
LW		 2224 OPERATOR('-'); /* unary minus */
2225 }
3280af22
NIS		 2226 PL_last_uni = PL_oldbufptr;
2227 PL_last_lop_op = OP_FTEREAD; /* good enough */
748a9306 2228 switch (tmp) {
79072805
LW		 2229 case 'r': FTST(OP_FTEREAD);
2230 case 'w': FTST(OP_FTEWRITE);
2231 case 'x': FTST(OP_FTEEXEC);
2232 case 'o': FTST(OP_FTEOWNED);
2233 case 'R': FTST(OP_FTRREAD);
2234 case 'W': FTST(OP_FTRWRITE);
2235 case 'X': FTST(OP_FTREXEC);
2236 case 'O': FTST(OP_FTROWNED);
2237 case 'e': FTST(OP_FTIS);
2238 case 'z': FTST(OP_FTZERO);
2239 case 's': FTST(OP_FTSIZE);
2240 case 'f': FTST(OP_FTFILE);
2241 case 'd': FTST(OP_FTDIR);
2242 case 'l': FTST(OP_FTLINK);
2243 case 'p': FTST(OP_FTPIPE);
2244 case 'S': FTST(OP_FTSOCK);
2245 case 'u': FTST(OP_FTSUID);
2246 case 'g': FTST(OP_FTSGID);
2247 case 'k': FTST(OP_FTSVTX);
2248 case 'b': FTST(OP_FTBLK);
2249 case 'c': FTST(OP_FTCHR);
2250 case 't': FTST(OP_FTTTY);
2251 case 'T': FTST(OP_FTTEXT);
2252 case 'B': FTST(OP_FTBINARY);
85e6fe83
LW		 2253 case 'M': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTMTIME);
2254 case 'A': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTATIME);
2255 case 'C': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTCTIME);
378cc40b 2256 default:
ff0cee69 2257 croak("Unrecognized file test: -%c", (int)tmp);
378cc40b
LW		 2258 break;
2259 }
2260 }
a687059c
LW		 2261 tmp = *s++;
2262 if (*s == tmp) {
2263 s++;
3280af22 2264 if (PL_expect == XOPERATOR)
79072805
LW		 2265 TERM(POSTDEC);
2266 else
2267 OPERATOR(PREDEC);
2268 }
2269 else if (*s == '>') {
2270 s++;
2271 s = skipspace(s);
834a4ddd 2272 if (isIDFIRST_lazy(s)) {
a0d0e21e 2273 s = force_word(s,METHOD,FALSE,TRUE,FALSE);
463ee0b2 2274 TOKEN(ARROW);
79072805 2275 }
748a9306
LW		 2276 else if (*s == '$')
2277 OPERATOR(ARROW);
463ee0b2 2278 else
748a9306 2279 TERM(ARROW);
a687059c 2280 }
3280af22 2281 if (PL_expect == XOPERATOR)
79072805
LW		 2282 Aop(OP_SUBTRACT);
2283 else {
3280af22 2284 if (isSPACE(*s) || !isSPACE(*PL_bufptr))
2f3197b3 2285 check_uni();
79072805 2286 OPERATOR('-'); /* unary minus */
2f3197b3 2287 }
79072805 2288
378cc40b 2289 case '+':
a687059c
LW		 2290 tmp = *s++;
2291 if (*s == tmp) {
378cc40b 2292 s++;
3280af22 2293 if (PL_expect == XOPERATOR)
79072805
LW		 2294 TERM(POSTINC);
2295 else
2296 OPERATOR(PREINC);
378cc40b 2297 }
3280af22 2298 if (PL_expect == XOPERATOR)
79072805
LW		 2299 Aop(OP_ADD);
2300 else {
3280af22 2301 if (isSPACE(*s) || !isSPACE(*PL_bufptr))
2f3197b3 2302 check_uni();
a687059c 2303 OPERATOR('+');
2f3197b3 2304 }
a687059c 2305
378cc40b 2306 case '*':
3280af22
NIS		 2307 if (PL_expect != XOPERATOR) {
2308 s = scan_ident(s, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE);
2309 PL_expect = XOPERATOR;
2310 force_ident(PL_tokenbuf, '*');
2311 if (!*PL_tokenbuf)
a0d0e21e 2312 PREREF('*');
79072805 2313 TERM('*');
a687059c 2314 }
79072805
LW		 2315 s++;
2316 if (*s == '*') {
a687059c 2317 s++;
79072805 2318 PWop(OP_POW);
a687059c 2319 }
79072805
LW		 2320 Mop(OP_MULTIPLY);
2321
378cc40b 2322 case '%':
3280af22 2323 if (PL_expect == XOPERATOR) {
bbce6d69 2324 ++s;
2325 Mop(OP_MODULO);
a687059c 2326 }
3280af22
NIS		 2327 PL_tokenbuf[0] = '%';
2328 s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, TRUE);
2329 if (!PL_tokenbuf[1]) {
2330 if (s == PL_bufend)
bbce6d69 2331 yyerror("Final % should be \\% or %name");
2332 PREREF('%');
a687059c 2333 }
3280af22 2334 PL_pending_ident = '%';
bbce6d69 2335 TERM('%');
a687059c 2336
378cc40b 2337 case '^':
79072805 2338 s++;
a0d0e21e 2339 BOop(OP_BIT_XOR);
79072805 2340 case '[':
3280af22 2341 PL_lex_brackets++;
79072805 2342 /* FALL THROUGH */
378cc40b 2343 case '~':
378cc40b 2344 case ',':
378cc40b
LW		 2345 tmp = *s++;
2346 OPERATOR(tmp);
a0d0e21e
LW		 2347 case ':':
2348 if (s[1] == ':') {
2349 len = 0;
2350 goto just_a_word;
2351 }
2352 s++;
2353 OPERATOR(':');
8990e307
LW		 2354 case '(':
2355 s++;
3280af22
NIS		 2356 if (PL_last_lop == PL_oldoldbufptr || PL_last_uni == PL_oldoldbufptr)
2357 PL_oldbufptr = PL_oldoldbufptr; /* allow print(STDOUT 123) */
a0d0e21e 2358 else
3280af22 2359 PL_expect = XTERM;
a0d0e21e 2360 TOKEN('(');
378cc40b 2361 case ';':
3280af22
NIS		 2362 if (PL_curcop->cop_line < PL_copline)
2363 PL_copline = PL_curcop->cop_line;
378cc40b
LW		 2364 tmp = *s++;
2365 OPERATOR(tmp);
2366 case ')':
378cc40b 2367 tmp = *s++;
16d20bd9
AD		 2368 s = skipspace(s);
2369 if (*s == '{')
2370 PREBLOCK(tmp);
378cc40b 2371 TERM(tmp);
79072805
LW		 2372 case ']':
2373 s++;
3280af22 2374 if (PL_lex_brackets <= 0)
d98d5fff 2375 yyerror("Unmatched right square bracket");
463ee0b2 2376 else
3280af22
NIS		 2377 --PL_lex_brackets;
2378 if (PL_lex_state == LEX_INTERPNORMAL) {
2379 if (PL_lex_brackets == 0) {
a0d0e21e 2380 if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
3280af22 2381 PL_lex_state = LEX_INTERPEND;
79072805
LW		 2382 }
2383 }
4633a7c4 2384 TERM(']');
79072805
LW		 2385 case '{':
2386 leftbracket:
79072805 2387 s++;
3280af22
NIS		 2388 if (PL_lex_brackets > 100) {
2389 char* newlb = Renew(PL_lex_brackstack, PL_lex_brackets + 1, char);
2390 if (newlb != PL_lex_brackstack) {
8990e307 2391 SAVEFREEPV(newlb);
3280af22 2392 PL_lex_brackstack = newlb;
8990e307
LW		 2393 }
2394 }
3280af22 2395 switch (PL_expect) {
a0d0e21e 2396 case XTERM:
3280af22 2397 if (PL_lex_formbrack) {
a0d0e21e
LW		 2398 s--;
2399 PRETERMBLOCK(DO);
2400 }
3280af22
NIS		 2401 if (PL_oldoldbufptr == PL_last_lop)
2402 PL_lex_brackstack[PL_lex_brackets++] = XTERM;
a0d0e21e 2403 else
3280af22 2404 PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
79072805 2405 OPERATOR(HASHBRACK);
a0d0e21e 2406 case XOPERATOR:
3280af22 2407 while (s < PL_bufend && (*s == ' ' || *s == '\t'))
748a9306 2408 s++;
44a8e56a 2409 d = s;
3280af22
NIS		 2410 PL_tokenbuf[0] = '\0';
2411 if (d < PL_bufend && *d == '-') {
2412 PL_tokenbuf[0] = '-';
44a8e56a 2413 d++;
3280af22 2414 while (d < PL_bufend && (*d == ' ' || *d == '\t'))
44a8e56a 2415 d++;
2416 }
834a4ddd 2417 if (d < PL_bufend && isIDFIRST_lazy(d)) {
3280af22 2418 d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
8903cb82 2419 FALSE, &len);
3280af22 2420 while (d < PL_bufend && (*d == ' ' || *d == '\t'))
748a9306
LW		 2421 d++;
2422 if (*d == '}') {
3280af22 2423 char minus = (PL_tokenbuf[0] == '-');
44a8e56a 2424 s = force_word(s + minus, WORD, FALSE, TRUE, FALSE);
2425 if (minus)
2426 force_next('-');
748a9306
LW		 2427 }
2428 }
2429 /* FALL THROUGH */
2430 case XBLOCK:
3280af22
NIS		 2431 PL_lex_brackstack[PL_lex_brackets++] = XSTATE;
2432 PL_expect = XSTATE;
a0d0e21e
LW		 2433 break;
2434 case XTERMBLOCK:
3280af22
NIS		 2435 PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
2436 PL_expect = XSTATE;
a0d0e21e
LW		 2437 break;
2438 default: {
2439 char *t;
3280af22
NIS		 2440 if (PL_oldoldbufptr == PL_last_lop)
2441 PL_lex_brackstack[PL_lex_brackets++] = XTERM;
a0d0e21e 2442 else
3280af22 2443 PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
a0d0e21e 2444 s = skipspace(s);
09ecc4b6 2445 if (*s == '}')
a0d0e21e 2446 OPERATOR(HASHBRACK);
b8a4b1be
GS		 2447 /* This hack serves to disambiguate a pair of curlies
2448 * as being a block or an anon hash. Normally, expectation
2449 * determines that, but in cases where we're not in a
2450 * position to expect anything in particular (like inside
2451 * eval"") we have to resolve the ambiguity. This code
2452 * covers the case where the first term in the curlies is a
2453 * quoted string. Most other cases need to be explicitly
2454 * disambiguated by prepending a `+' before the opening
2455 * curly in order to force resolution as an anon hash.
2456 *
2457 * XXX should probably propagate the outer expectation
2458 * into eval"" to rely less on this hack, but that could
2459 * potentially break current behavior of eval"".
2460 * GSAR 97-07-21
2461 */
2462 t = s;
2463 if (*s == '\'' || *s == '"' || *s == '`') {
2464 /* common case: get past first string, handling escapes */
3280af22 2465 for (t++; t < PL_bufend && *t != *s;)
b8a4b1be
GS		 2466 if (*t++ == '\\' && (*t == '\\' || *t == *s))
2467 t++;
2468 t++;
a0d0e21e 2469 }
b8a4b1be 2470 else if (*s == 'q') {
3280af22 2471 if (++t < PL_bufend
b8a4b1be 2472 && (!isALNUM(*t)
3280af22 2473 || ((*t == 'q' || *t == 'x') && ++t < PL_bufend
b8a4b1be
GS		 2474 && !isALNUM(*t)))) {
2475 char *tmps;
2476 char open, close, term;
2477 I32 brackets = 1;
2478
3280af22 2479 while (t < PL_bufend && isSPACE(*t))
b8a4b1be
GS		 2480 t++;
2481 term = *t;
2482 open = term;
2483 if (term && (tmps = strchr("([{< )]}> )]}>",term)))
2484 term = tmps[5];
2485 close = term;
2486 if (open == close)
3280af22
NIS		 2487 for (t++; t < PL_bufend; t++) {
2488 if (*t == '\\' && t+1 < PL_bufend && open != '\\')
b8a4b1be 2489 t++;
6d07e5e9 2490 else if (*t == open)
b8a4b1be
GS		 2491 break;
2492 }
2493 else
3280af22
NIS		 2494 for (t++; t < PL_bufend; t++) {
2495 if (*t == '\\' && t+1 < PL_bufend)
b8a4b1be 2496 t++;
6d07e5e9 2497 else if (*t == close && --brackets <= 0)
b8a4b1be
GS		 2498 break;
2499 else if (*t == open)
2500 brackets++;
2501 }
2502 }
2503 t++;
a0d0e21e 2504 }
834a4ddd
LW		 2505 else if (isIDFIRST_lazy(s)) {
2506 for (t++; t < PL_bufend && isALNUM_lazy(t); t++) ;
a0d0e21e 2507 }
3280af22 2508 while (t < PL_bufend && isSPACE(*t))
a0d0e21e 2509 t++;
b8a4b1be
GS		 2510 /* if comma follows first term, call it an anon hash */
2511 /* XXX it could be a comma expression with loop modifiers */
3280af22 2512 if (t < PL_bufend && ((*t == ',' && (*s == 'q' || !isLOWER(*s)))
b8a4b1be 2513 || (*t == '=' && t[1] == '>')))
a0d0e21e 2514 OPERATOR(HASHBRACK);
3280af22 2515 if (PL_expect == XREF)
834a4ddd 2516 PL_expect = XSTATE; /* was XTERM, trying XSTATE */
a0d0e21e 2517 else {
3280af22
NIS		 2518 PL_lex_brackstack[PL_lex_brackets-1] = XSTATE;
2519 PL_expect = XSTATE;
a0d0e21e 2520 }
8990e307 2521 }
a0d0e21e 2522 break;
463ee0b2 2523 }
3280af22 2524 yylval.ival = PL_curcop->cop_line;
79072805 2525 if (isSPACE(*s) || *s == '#')
3280af22 2526 PL_copline = NOLINE; /* invalidate current command line number */
79072805 2527 TOKEN('{');
378cc40b 2528 case '}':
79072805
LW		 2529 rightbracket:
2530 s++;
3280af22 2531 if (PL_lex_brackets <= 0)
d98d5fff 2532 yyerror("Unmatched right curly bracket");
463ee0b2 2533 else
3280af22
NIS		 2534 PL_expect = (expectation)PL_lex_brackstack[--PL_lex_brackets];
2535 if (PL_lex_brackets < PL_lex_formbrack)
2536 PL_lex_formbrack = 0;
2537 if (PL_lex_state == LEX_INTERPNORMAL) {
2538 if (PL_lex_brackets == 0) {
2539 if (PL_lex_fakebrack) {
2540 PL_lex_state = LEX_INTERPEND;
2541 PL_bufptr = s;
e4bfbdd4 2542 return yylex(PERL_YYLEX_PARAM); /* ignore fake brackets */
79072805 2543 }
fa83b5b6 2544 if (*s == '-' && s[1] == '>')
3280af22 2545 PL_lex_state = LEX_INTERPENDMAYBE;
fa83b5b6 2546 else if (*s != '[' && *s != '{')
3280af22 2547 PL_lex_state = LEX_INTERPEND;
79072805
LW		 2548 }
2549 }
3280af22
NIS		 2550 if (PL_lex_brackets < PL_lex_fakebrack) {
2551 PL_bufptr = s;
2552 PL_lex_fakebrack = 0;
e4bfbdd4 2553 return yylex(PERL_YYLEX_PARAM); /* ignore fake brackets */
748a9306 2554 }
79072805
LW		 2555 force_next('}');
2556 TOKEN(';');
378cc40b
LW		 2557 case '&':
2558 s++;
2559 tmp = *s++;
2560 if (tmp == '&')
a0d0e21e 2561 AOPERATOR(ANDAND);
378cc40b 2562 s--;
3280af22 2563 if (PL_expect == XOPERATOR) {
834a4ddd 2564 if (ckWARN(WARN_SEMICOLON) && isIDFIRST_lazy(s) && PL_bufptr == PL_linestart) {
3280af22 2565 PL_curcop->cop_line--;
22c35a8c 2566 warner(WARN_SEMICOLON, PL_warn_nosemi);
3280af22 2567 PL_curcop->cop_line++;
463ee0b2 2568 }
79072805 2569 BAop(OP_BIT_AND);
463ee0b2 2570 }
79072805 2571
3280af22
NIS		 2572 s = scan_ident(s - 1, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE);
2573 if (*PL_tokenbuf) {
2574 PL_expect = XOPERATOR;
2575 force_ident(PL_tokenbuf, '&');
463ee0b2 2576 }
79072805
LW		 2577 else
2578 PREREF('&');
c07a80fd 2579 yylval.ival = (OPpENTERSUB_AMPER<<8);
79072805
LW		 2580 TERM('&');
2581
378cc40b
LW		 2582 case '|':
2583 s++;
2584 tmp = *s++;
2585 if (tmp == '|')
a0d0e21e 2586 AOPERATOR(OROR);
378cc40b 2587 s--;
79072805 2588 BOop(OP_BIT_OR);
378cc40b
LW		 2589 case '=':
2590 s++;
2591 tmp = *s++;
2592 if (tmp == '=')
79072805
LW		 2593 Eop(OP_EQ);
2594 if (tmp == '>')
2595 OPERATOR(',');
378cc40b 2596 if (tmp == '~')
79072805 2597 PMop(OP_MATCH);
599cee73
PM		 2598 if (ckWARN(WARN_SYNTAX) && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
2599 warner(WARN_SYNTAX, "Reversed %c= operator",(int)tmp);
378cc40b 2600 s--;
3280af22
NIS		 2601 if (PL_expect == XSTATE && isALPHA(tmp) &&
2602 (s == PL_linestart+1 || s[-2] == '\n') )
748a9306 2603 {
3280af22
NIS		 2604 if (PL_in_eval && !PL_rsfp) {
2605 d = PL_bufend;
a5f75d66
AD		 2606 while (s < d) {
2607 if (*s++ == '\n') {
2608 incline(s);
2609 if (strnEQ(s,"=cut",4)) {
2610 s = strchr(s,'\n');
2611 if (s)
2612 s++;
2613 else
2614 s = d;
2615 incline(s);
2616 goto retry;
2617 }
2618 }
2619 }
2620 goto retry;
2621 }
3280af22
NIS		 2622 s = PL_bufend;
2623 PL_doextract = TRUE;
a0d0e21e
LW		 2624 goto retry;
2625 }
3280af22 2626 if (PL_lex_brackets < PL_lex_formbrack) {
a0d0e21e 2627 char *t;
51882d45 2628#ifdef PERL_STRICT_CR
a0d0e21e 2629 for (t = s; *t == ' ' || *t == '\t'; t++) ;
51882d45
GS		 2630#else
2631 for (t = s; *t == ' ' || *t == '\t' || *t == '\r'; t++) ;
2632#endif
a0d0e21e
LW		 2633 if (*t == '\n' || *t == '#') {
2634 s--;
3280af22 2635 PL_expect = XBLOCK;
a0d0e21e
LW		 2636 goto leftbracket;
2637 }
79072805 2638 }
a0d0e21e
LW		 2639 yylval.ival = 0;
2640 OPERATOR(ASSIGNOP);
378cc40b
LW		 2641 case '!':
2642 s++;
2643 tmp = *s++;
2644 if (tmp == '=')
79072805 2645 Eop(OP_NE);
378cc40b 2646 if (tmp == '~')
79072805 2647 PMop(OP_NOT);
378cc40b
LW		 2648 s--;
2649 OPERATOR('!');
2650 case '<':
3280af22 2651 if (PL_expect != XOPERATOR) {
93a17b20 2652 if (s[1] != '<' && !strchr(s,'>'))
2f3197b3 2653 check_uni();
79072805
LW		 2654 if (s[1] == '<')
2655 s = scan_heredoc(s);
2656 else
2657 s = scan_inputsymbol(s);
2658 TERM(sublex_start());
378cc40b
LW		 2659 }
2660 s++;
2661 tmp = *s++;
2662 if (tmp == '<')
79072805 2663 SHop(OP_LEFT_SHIFT);
395c3793
LW		 2664 if (tmp == '=') {
2665 tmp = *s++;
2666 if (tmp == '>')
79072805 2667 Eop(OP_NCMP);
395c3793 2668 s--;
79072805 2669 Rop(OP_LE);
395c3793 2670 }
378cc40b 2671 s--;
79072805 2672 Rop(OP_LT);
378cc40b
LW		 2673 case '>':
2674 s++;
2675 tmp = *s++;
2676 if (tmp == '>')
79072805 2677 SHop(OP_RIGHT_SHIFT);
378cc40b 2678 if (tmp == '=')
79072805 2679 Rop(OP_GE);
378cc40b 2680 s--;
79072805 2681 Rop(OP_GT);
378cc40b
LW		 2682
2683 case '$':
bbce6d69 2684 CLINE;
2685
3280af22
NIS		 2686 if (PL_expect == XOPERATOR) {
2687 if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
2688 PL_expect = XTERM;
a0d0e21e 2689 depcom();
bbce6d69 2690 return ','; /* grandfather non-comma-format format */
a0d0e21e 2691 }
8990e307 2692 }
a0d0e21e 2693
834a4ddd 2694 if (s[1] == '#' && (isIDFIRST_lazy(s+2) || strchr("{$:+-", s[2]))) {
3280af22
NIS		 2695 if (PL_expect == XOPERATOR)
2696 no_op("Array length", PL_bufptr);
2697 PL_tokenbuf[0] = '@';
2698 s = scan_ident(s + 1, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
8903cb82 2699 FALSE);
3280af22 2700 if (!PL_tokenbuf[1])
a0d0e21e 2701 PREREF(DOLSHARP);
3280af22
NIS		 2702 PL_expect = XOPERATOR;
2703 PL_pending_ident = '#';
463ee0b2 2704 TOKEN(DOLSHARP);
79072805 2705 }
bbce6d69 2706
3280af22
NIS		 2707 if (PL_expect == XOPERATOR)
2708 no_op("Scalar", PL_bufptr);
2709 PL_tokenbuf[0] = '$';
2710 s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
2711 if (!PL_tokenbuf[1]) {
2712 if (s == PL_bufend)
bbce6d69 2713 yyerror("Final $ should be \\$ or $name");
2714 PREREF('$');
8990e307 2715 }
a0d0e21e 2716
bbce6d69 2717 /* This kludge not intended to be bulletproof. */
3280af22 2718 if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) {
bbce6d69 2719 yylval.opval = newSVOP(OP_CONST, 0,
3280af22 2720 newSViv((IV)PL_compiling.cop_arybase));
bbce6d69 2721 yylval.opval->op_private = OPpCONST_ARYBASE;
2722 TERM(THING);
2723 }
2724
ff68c719 2725 d = s;
3280af22 2726 if (PL_lex_state == LEX_NORMAL)
ff68c719 2727 s = skipspace(s);
2728
3280af22 2729 if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
bbce6d69 2730 char *t;
2731 if (*s == '[') {
3280af22 2732 PL_tokenbuf[0] = '@';
599cee73 2733 if (ckWARN(WARN_SYNTAX)) {
bbce6d69 2734 for(t = s + 1;
834a4ddd 2735 isSPACE(*t) || isALNUM_lazy(t) || *t == '$';
bbce6d69 2736 t++) ;
a0d0e21e 2737 if (*t++ == ',') {
3280af22
NIS		 2738 PL_bufptr = skipspace(PL_bufptr);
2739 while (t < PL_bufend && *t != ']')
bbce6d69 2740 t++;
599cee73
PM		 2741 warner(WARN_SYNTAX,
2742 "Multidimensional syntax %.*s not supported",
2743 (t - PL_bufptr) + 1, PL_bufptr);
a0d0e21e
LW		 2744 }
2745 }
bbce6d69 2746 }
2747 else if (*s == '{') {
3280af22 2748 PL_tokenbuf[0] = '%';
599cee73 2749 if (ckWARN(WARN_SYNTAX) && strEQ(PL_tokenbuf+1, "SIG") &&
bbce6d69 2750 (t = strchr(s, '}')) && (t = strchr(t, '=')))
2751 {
3280af22 2752 char tmpbuf[sizeof PL_tokenbuf];
a0d0e21e
LW		 2753 STRLEN len;
2754 for (t++; isSPACE(*t); t++) ;
834a4ddd 2755 if (isIDFIRST_lazy(t)) {
8903cb82 2756 t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
59a6d928
GS		 2757 for (; isSPACE(*t); t++) ;
2758 if (*t == ';' && perl_get_cv(tmpbuf, FALSE))
599cee73
PM		 2759 warner(WARN_SYNTAX,
2760 "You need to quote \"%s\"", tmpbuf);
748a9306 2761 }
93a17b20
LW		 2762 }
2763 }
2f3197b3 2764 }
bbce6d69 2765
3280af22
NIS		 2766 PL_expect = XOPERATOR;
2767 if (PL_lex_state == LEX_NORMAL && isSPACE(*d)) {
2768 bool islop = (PL_last_lop == PL_oldoldbufptr);
2769 if (!islop || PL_last_lop_op == OP_GREPSTART)
2770 PL_expect = XOPERATOR;
bbce6d69 2771 else if (strchr("$@\"'`q", *s))
3280af22 2772 PL_expect = XTERM; /* e.g. print $fh "foo" */
834a4ddd 2773 else if (strchr("&*<%", *s) && isIDFIRST_lazy(s+1))
3280af22 2774 PL_expect = XTERM; /* e.g. print $fh &sub */
834a4ddd 2775 else if (isIDFIRST_lazy(s)) {
3280af22 2776 char tmpbuf[sizeof PL_tokenbuf];
8903cb82 2777 scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
84902520
TB		 2778 if (tmp = keyword(tmpbuf, len)) {
2779 /* binary operators exclude handle interpretations */
2780 switch (tmp) {
2781 case -KEY_x:
2782 case -KEY_eq:
2783 case -KEY_ne:
2784 case -KEY_gt:
2785 case -KEY_lt:
2786 case -KEY_ge:
2787 case -KEY_le:
2788 case -KEY_cmp:
2789 break;
2790 default:
3280af22 2791 PL_expect = XTERM; /* e.g. print $fh length() */
84902520
TB		 2792 break;
2793 }
2794 }
68dc0745 2795 else {
2796 GV *gv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
2797 if (gv && GvCVu(gv))
3280af22 2798 PL_expect = XTERM; /* e.g. print $fh subr() */
93a17b20 2799 }
93a17b20 2800 }
bbce6d69 2801 else if (isDIGIT(*s))
3280af22 2802 PL_expect = XTERM; /* e.g. print $fh 3 */
bbce6d69 2803 else if (*s == '.' && isDIGIT(s[1]))
3280af22 2804 PL_expect = XTERM; /* e.g. print $fh .3 */
e0587a03 2805 else if (strchr("/?-+", *s) && !isSPACE(s[1]) && s[1] != '=')
3280af22 2806 PL_expect = XTERM; /* e.g. print $fh -1 */
e0587a03 2807 else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]) && s[2] != '=')
3280af22 2808 PL_expect = XTERM; /* print $fh <<"EOF" */
bbce6d69 2809 }
3280af22 2810 PL_pending_ident = '$';
79072805 2811 TOKEN('$');
378cc40b
LW		 2812
2813 case '@':
3280af22 2814 if (PL_expect == XOPERATOR)
bbce6d69 2815 no_op("Array", s);
3280af22
NIS		 2816 PL_tokenbuf[0] = '@';
2817 s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
2818 if (!PL_tokenbuf[1]) {
2819 if (s == PL_bufend)
bbce6d69 2820 yyerror("Final @ should be \\@ or @name");
2821 PREREF('@');
2822 }
3280af22 2823 if (PL_lex_state == LEX_NORMAL)
ff68c719 2824 s = skipspace(s);
3280af22 2825 if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
bbce6d69 2826 if (*s == '{')
3280af22 2827 PL_tokenbuf[0] = '%';
a0d0e21e
LW		 2828
2829 /* Warn about @ where they meant $. */
599cee73 2830 if (ckWARN(WARN_SYNTAX)) {
a0d0e21e
LW		 2831 if (*s == '[' || *s == '{') {
2832 char *t = s + 1;
834a4ddd 2833 while (*t && (isALNUM_lazy(t) || strchr(" \t$#+-'\"", *t)))
a0d0e21e
LW		 2834 t++;
2835 if (*t == '}' || *t == ']') {
2836 t++;
3280af22 2837 PL_bufptr = skipspace(PL_bufptr);
599cee73
PM		 2838 warner(WARN_SYNTAX,
2839 "Scalar value %.*s better written as $%.*s",
3280af22 2840 t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1);
a0d0e21e 2841 }
93a17b20
LW		 2842 }
2843 }
463ee0b2 2844 }
3280af22 2845 PL_pending_ident = '@';
79072805 2846 TERM('@');
378cc40b
LW		 2847
2848 case '/': /* may either be division or pattern */
2849 case '?': /* may either be conditional or pattern */
3280af22 2850 if (PL_expect != XOPERATOR) {
c277df42 2851 /* Disable warning on "study /blah/" */
3280af22
NIS		 2852 if (PL_oldoldbufptr == PL_last_uni
2853 && (*PL_last_uni != 's' || s - PL_last_uni < 5
834a4ddd 2854 || memNE(PL_last_uni, "study", 5) || isALNUM_lazy(PL_last_uni+5)))
c277df42 2855 check_uni();
8782bef2 2856 s = scan_pat(s,OP_MATCH);
79072805 2857 TERM(sublex_start());
378cc40b
LW		 2858 }
2859 tmp = *s++;
a687059c 2860 if (tmp == '/')
79072805 2861 Mop(OP_DIVIDE);
378cc40b
LW		 2862 OPERATOR(tmp);
2863
2864 case '.':
51882d45
GS		 2865 if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack
2866#ifdef PERL_STRICT_CR
2867 && s[1] == '\n'
2868#else
2869 && (s[1] == '\n' || (s[1] == '\r' && s[2] == '\n'))
2870#endif
2871 && (s == PL_linestart || s[-1] == '\n') )
2872 {
3280af22
NIS		 2873 PL_lex_formbrack = 0;
2874 PL_expect = XSTATE;
79072805
LW		 2875 goto rightbracket;
2876 }
3280af22 2877 if (PL_expect == XOPERATOR || !isDIGIT(s[1])) {
378cc40b 2878 tmp = *s++;
a687059c
LW		 2879 if (*s == tmp) {
2880 s++;
2f3197b3
LW		 2881 if (*s == tmp) {
2882 s++;
79072805 2883 yylval.ival = OPf_SPECIAL;
2f3197b3
LW		 2884 }
2885 else
79072805 2886 yylval.ival = 0;
378cc40b 2887 OPERATOR(DOTDOT);
a687059c 2888 }
3280af22 2889 if (PL_expect != XOPERATOR)
2f3197b3 2890 check_uni();
79072805 2891 Aop(OP_CONCAT);
378cc40b
LW		 2892 }
2893 /* FALL THROUGH */
2894 case '0': case '1': case '2': case '3': case '4':
2895 case '5': case '6': case '7': case '8': case '9':
79072805 2896 s = scan_num(s);
3280af22 2897 if (PL_expect == XOPERATOR)
8990e307 2898 no_op("Number",s);
79072805
LW		 2899 TERM(THING);
2900
2901 case '\'':
8990e307 2902 s = scan_str(s);
3280af22
NIS		 2903 if (PL_expect == XOPERATOR) {
2904 if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
2905 PL_expect = XTERM;
a0d0e21e
LW		 2906 depcom();
2907 return ','; /* grandfather non-comma-format format */
2908 }
463ee0b2 2909 else
8990e307 2910 no_op("String",s);
463ee0b2 2911 }
79072805 2912 if (!s)
85e6fe83 2913 missingterm((char*)0);
79072805
LW		 2914 yylval.ival = OP_CONST;
2915 TERM(sublex_start());
2916
2917 case '"':
8990e307 2918 s = scan_str(s);
3280af22
NIS		 2919 if (PL_expect == XOPERATOR) {
2920 if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
2921 PL_expect = XTERM;
a0d0e21e
LW		 2922 depcom();
2923 return ','; /* grandfather non-comma-format format */
2924 }
463ee0b2 2925 else
8990e307 2926 no_op("String",s);
463ee0b2 2927 }
79072805 2928 if (!s)
85e6fe83 2929 missingterm((char*)0);
4633a7c4 2930 yylval.ival = OP_CONST;
3280af22 2931 for (d = SvPV(PL_lex_stuff, len); len; len--, d++) {
a0ed51b3 2932 if (*d == '$' || *d == '@' || *d == '\\' || *d & 0x80) {
4633a7c4
LW		 2933 yylval.ival = OP_STRINGIFY;
2934 break;
2935 }
2936 }
79072805
LW		 2937 TERM(sublex_start());
2938
2939 case '`':
2940 s = scan_str(s);
3280af22 2941 if (PL_expect == XOPERATOR)
8990e307 2942 no_op("Backticks",s);
79072805 2943 if (!s)
85e6fe83 2944 missingterm((char*)0);
79072805
LW		 2945 yylval.ival = OP_BACKTICK;
2946 set_csh();
2947 TERM(sublex_start());
2948
2949 case '\\':
2950 s++;
599cee73
PM		 2951 if (ckWARN(WARN_SYNTAX) && PL_lex_inwhat && isDIGIT(*s))
2952 warner(WARN_SYNTAX,"Can't use \\%c to mean $%c in expression",
2953 *s, *s);
3280af22 2954 if (PL_expect == XOPERATOR)
8990e307 2955 no_op("Backslash",s);
79072805
LW		 2956 OPERATOR(REFGEN);
2957
2958 case 'x':
3280af22 2959 if (isDIGIT(s[1]) && PL_expect == XOPERATOR) {
79072805
LW		 2960 s++;
2961 Mop(OP_REPEAT);
2f3197b3 2962 }
79072805
LW		 2963 goto keylookup;
2964
378cc40b 2965 case '_':
79072805
LW		 2966 case 'a': case 'A':
2967 case 'b': case 'B':
2968 case 'c': case 'C':
2969 case 'd': case 'D':
2970 case 'e': case 'E':
2971 case 'f': case 'F':
2972 case 'g': case 'G':
2973 case 'h': case 'H':
2974 case 'i': case 'I':
2975 case 'j': case 'J':
2976 case 'k': case 'K':
2977 case 'l': case 'L':
2978 case 'm': case 'M':
2979 case 'n': case 'N':
2980 case 'o': case 'O':
2981 case 'p': case 'P':
2982 case 'q': case 'Q':
2983 case 'r': case 'R':
2984 case 's': case 'S':
2985 case 't': case 'T':
2986 case 'u': case 'U':
2987 case 'v': case 'V':
2988 case 'w': case 'W':
2989 case 'X':
2990 case 'y': case 'Y':
2991 case 'z': case 'Z':
2992
49dc05e3 2993 keylookup: {
2d8e6c8d 2994 STRLEN n_a;
161b471a
NIS		 2995 gv = Nullgv;
2996 gvp = 0;
49dc05e3 2997
3280af22
NIS		 2998 PL_bufptr = s;
2999 s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
8ebc5c01 3000
3001 /* Some keywords can be followed by any delimiter, including ':' */
3280af22
NIS		 3002 tmp = (len == 1 && strchr("msyq", PL_tokenbuf[0]) ||
3003 len == 2 && ((PL_tokenbuf[0] == 't' && PL_tokenbuf[1] == 'r') ||
3004 (PL_tokenbuf[0] == 'q' &&
3005 strchr("qwxr", PL_tokenbuf[1]))));
8ebc5c01 3006
3007 /* x::* is just a word, unless x is "CORE" */
3280af22 3008 if (!tmp && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE"))
4633a7c4
LW		 3009 goto just_a_word;
3010
3643fb5f 3011 d = s;
3280af22 3012 while (d < PL_bufend && isSPACE(*d))
3643fb5f
CS		 3013 d++; /* no comments skipped here, or s### is misparsed */
3014
3015 /* Is this a label? */
3280af22
NIS		 3016 if (!tmp && PL_expect == XSTATE
3017 && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
8ebc5c01 3018 s = d + 1;
3280af22 3019 yylval.pval = savepv(PL_tokenbuf);
8ebc5c01 3020 CLINE;
3021 TOKEN(LABEL);
3643fb5f
CS		 3022 }
3023
3024 /* Check for keywords */
3280af22 3025 tmp = keyword(PL_tokenbuf, len);
748a9306
LW		 3026
3027 /* Is this a word before a => operator? */
748a9306
LW		 3028 if (strnEQ(d,"=>",2)) {
3029 CLINE;
3280af22 3030 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
748a9306
LW		 3031 yylval.opval->op_private = OPpCONST_BARE;
3032 TERM(WORD);
3033 }
3034
a0d0e21e 3035 if (tmp < 0) { /* second-class keyword? */
56f7f34b
CS		 3036 GV *ogv = Nullgv; /* override (winner) */
3037 GV *hgv = Nullgv; /* hidden (loser) */
3280af22 3038 if (PL_expect != XOPERATOR && (*s != ':' || s[1] != ':')) {
56f7f34b 3039 CV *cv;
3280af22 3040 if ((gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV)) &&
56f7f34b
CS		 3041 (cv = GvCVu(gv)))
3042 {
3043 if (GvIMPORTED_CV(gv))
3044 ogv = gv;
3045 else if (! CvMETHOD(cv))
3046 hgv = gv;
3047 }
3048 if (!ogv &&
3280af22
NIS		 3049 (gvp = (GV**)hv_fetch(PL_globalstash,PL_tokenbuf,len,FALSE)) &&
3050 (gv = *gvp) != (GV*)&PL_sv_undef &&
56f7f34b
CS		 3051 GvCVu(gv) && GvIMPORTED_CV(gv))
3052 {
3053 ogv = gv;
3054 }
3055 }
3056 if (ogv) {
3057 tmp = 0; /* overridden by import or by GLOBAL */
6e7b2336
GS		 3058 }
3059 else if (gv && !gvp
3060 && -tmp==KEY_lock /* XXX generalizable kludge */
3280af22 3061 && !hv_fetch(GvHVn(PL_incgv), "Thread.pm", 9, FALSE))
6e7b2336
GS		 3062 {
3063 tmp = 0; /* any sub overrides "weak" keyword */
a0d0e21e 3064 }
56f7f34b
CS		 3065 else { /* no override */
3066 tmp = -tmp;
3067 gv = Nullgv;
3068 gvp = 0;
4944e2f7
GS		 3069 if (ckWARN(WARN_AMBIGUOUS) && hgv
3070 && tmp != KEY_x && tmp != KEY_CORE) /* never ambiguous */
599cee73
PM		 3071 warner(WARN_AMBIGUOUS,
3072 "Ambiguous call resolved as CORE::%s(), %s",
2f3ca594 3073 GvENAME(hgv), "qualify as such or use &");
49dc05e3 3074 }
a0d0e21e
LW		 3075 }
3076
3077 reserved_word:
3078 switch (tmp) {
79072805
LW		 3079
3080 default: /* not a keyword */
93a17b20 3081 just_a_word: {
96e4d5b1 3082 SV *sv;
3280af22 3083 char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
8990e307
LW		 3084
3085 /* Get the rest if it looks like a package qualifier */
3086
a0d0e21e 3087 if (*s == '\'' || *s == ':' && s[1] == ':') {
c3e0f903 3088 STRLEN morelen;
3280af22 3089 s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len,
c3e0f903
GS		 3090 TRUE, &morelen);
3091 if (!morelen)
3280af22 3092 croak("Bad name after %s%s", PL_tokenbuf,
ec2ab091 3093 *s == '\'' ? "'" : "::");
c3e0f903 3094 len += morelen;
a0d0e21e 3095 }
8990e307 3096
3280af22
NIS		 3097 if (PL_expect == XOPERATOR) {
3098 if (PL_bufptr == PL_linestart) {
3099 PL_curcop->cop_line--;
22c35a8c 3100 warner(WARN_SEMICOLON, PL_warn_nosemi);
3280af22 3101 PL_curcop->cop_line++;
463ee0b2
LW		 3102 }
3103 else
54310121 3104 no_op("Bareword",s);
463ee0b2 3105 }
8990e307 3106
c3e0f903
GS		 3107 /* Look for a subroutine with this name in current package,
3108 unless name is "Foo::", in which case Foo is a bearword
3109 (and a package name). */
3110
3111 if (len > 2 &&
3280af22 3112 PL_tokenbuf[len - 2] == ':' && PL_tokenbuf[len - 1] == ':')
c3e0f903 3113 {
599cee73
PM		 3114 if (ckWARN(WARN_UNSAFE) && ! gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVHV))
3115 warner(WARN_UNSAFE,
3116 "Bareword \"%s\" refers to nonexistent package",
3280af22 3117 PL_tokenbuf);
c3e0f903 3118 len -= 2;
3280af22 3119 PL_tokenbuf[len] = '\0';
c3e0f903
GS		 3120 gv = Nullgv;
3121 gvp = 0;
3122 }
3123 else {
3124 len = 0;
3125 if (!gv)
3280af22 3126 gv = gv_fetchpv(PL_tokenbuf, FALSE, SVt_PVCV);
c3e0f903
GS		 3127 }
3128
3129 /* if we saw a global override before, get the right name */
8990e307 3130
49dc05e3 3131 if (gvp) {
79cb57f6 3132 sv = newSVpvn("CORE::GLOBAL::",14);
3280af22 3133 sv_catpv(sv,PL_tokenbuf);
49dc05e3
GS		 3134 }
3135 else
3280af22 3136 sv = newSVpv(PL_tokenbuf,0);
8990e307 3137
a0d0e21e
LW		 3138 /* Presume this is going to be a bareword of some sort. */
3139
3140 CLINE;
49dc05e3 3141 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
a0d0e21e
LW		 3142 yylval.opval->op_private = OPpCONST_BARE;
3143
c3e0f903
GS		 3144 /* And if "Foo::", then that's what it certainly is. */
3145
3146 if (len)
3147 goto safe_bareword;
3148
8990e307
LW		 3149 /* See if it's the indirect object for a list operator. */
3150
3280af22
NIS		 3151 if (PL_oldoldbufptr &&
3152 PL_oldoldbufptr < PL_bufptr &&
3153 (PL_oldoldbufptr == PL_last_lop || PL_oldoldbufptr == PL_last_uni) &&
a0d0e21e 3154 /* NO SKIPSPACE BEFORE HERE! */
3280af22 3155 (PL_expect == XREF
22c35a8c 3156 || ((PL_opargs[PL_last_lop_op] >> OASHIFT)& 7) == OA_FILEREF
3280af22
NIS		 3157 || (PL_last_lop_op == OP_ENTERSUB
3158 && PL_last_proto
3159 && PL_last_proto[PL_last_proto[0] == ';' ? 1 : 0] == '*')) )
a0d0e21e 3160 {
748a9306
LW		 3161 bool immediate_paren = *s == '(';
3162
a0d0e21e
LW		 3163 /* (Now we can afford to cross potential line boundary.) */
3164 s = skipspace(s);
3165
3166 /* Two barewords in a row may indicate method call. */
3167
834a4ddd 3168 if ((isIDFIRST_lazy(s) || *s == '$') && (tmp=intuit_method(s,gv)))
a0d0e21e
LW		 3169 return tmp;
3170
3171 /* If not a declared subroutine, it's an indirect object. */
3172 /* (But it's an indir obj regardless for sort.) */
3173
3280af22 3174 if ((PL_last_lop_op == OP_SORT ||
8ebc5c01 3175 (!immediate_paren && (!gv || !GvCVu(gv))) ) &&
3280af22
NIS		 3176 (PL_last_lop_op != OP_MAPSTART && PL_last_lop_op != OP_GREPSTART)){
3177 PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
748a9306 3178 goto bareword;
93a17b20
LW		 3179 }
3180 }
8990e307
LW		 3181
3182 /* If followed by a paren, it's certainly a subroutine. */
3183
3280af22 3184 PL_expect = XOPERATOR;
8990e307 3185 s = skipspace(s);
93a17b20 3186 if (*s == '(') {
79072805 3187 CLINE;
96e4d5b1 3188 if (gv && GvCVu(gv)) {
bf848113
GB		 3189 CV *cv;
3190 if ((cv = GvCV(gv)) && SvPOK(cv))
2d8e6c8d 3191 PL_last_proto = SvPV((SV*)cv, n_a);
96e4d5b1 3192 for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
bf848113 3193 if (*d == ')' && (sv = cv_const_sv(cv))) {
96e4d5b1 3194 s = d + 1;
3195 goto its_constant;
3196 }
3197 }
3280af22
NIS		 3198 PL_nextval[PL_nexttoke].opval = yylval.opval;
3199 PL_expect = XOPERATOR;
93a17b20 3200 force_next(WORD);
c07a80fd 3201 yylval.ival = 0;
bf848113 3202 PL_last_lop_op = OP_ENTERSUB;
463ee0b2 3203 TOKEN('&');
79072805 3204 }
93a17b20 3205
a0d0e21e 3206 /* If followed by var or block, call it a method (unless sub) */
8990e307 3207
8ebc5c01 3208 if ((*s == '$' || *s == '{') && (!gv || !GvCVu(gv))) {
3280af22
NIS		 3209 PL_last_lop = PL_oldbufptr;
3210 PL_last_lop_op = OP_METHOD;
93a17b20 3211 PREBLOCK(METHOD);
463ee0b2
LW		 3212 }
3213
8990e307
LW		 3214 /* If followed by a bareword, see if it looks like indir obj. */
3215
834a4ddd 3216 if ((isIDFIRST_lazy(s) || *s == '$') && (tmp = intuit_method(s,gv)))
a0d0e21e 3217 return tmp;
93a17b20 3218
8990e307
LW		 3219 /* Not a method, so call it a subroutine (if defined) */
3220
8ebc5c01 3221 if (gv && GvCVu(gv)) {
46fc3d4c 3222 CV* cv;
748a9306 3223 if (lastchar == '-')
c2960299 3224 warn("Ambiguous use of -%s resolved as -&%s()",
3280af22
NIS		 3225 PL_tokenbuf, PL_tokenbuf);
3226 PL_last_lop = PL_oldbufptr;
3227 PL_last_lop_op = OP_ENTERSUB;
89bfa8cd 3228 /* Check for a constant sub */
46fc3d4c 3229 cv = GvCV(gv);
96e4d5b1 3230 if ((sv = cv_const_sv(cv))) {
3231 its_constant:
3232 SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
3233 ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc(sv);
3234 yylval.opval->op_private = 0;
3235 TOKEN(WORD);
89bfa8cd 3236 }
3237
a5f75d66
AD		 3238 /* Resolve to GV now. */
3239 op_free(yylval.opval);
3240 yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
bf848113 3241 PL_last_lop_op = OP_ENTERSUB;
4633a7c4
LW		 3242 /* Is there a prototype? */
3243 if (SvPOK(cv)) {
3244 STRLEN len;
3280af22 3245 PL_last_proto = SvPV((SV*)cv, len);
4633a7c4
LW		 3246 if (!len)
3247 TERM(FUNC0SUB);
3280af22 3248 if (strEQ(PL_last_proto, "$"))
4633a7c4 3249 OPERATOR(UNIOPSUB);
3280af22
NIS		 3250 if (*PL_last_proto == '&' && *s == '{') {
3251 sv_setpv(PL_subname,"__ANON__");
4633a7c4
LW		 3252 PREBLOCK(LSTOPSUB);
3253 }
2a841d13 3254 } else
3280af22
NIS		 3255 PL_last_proto = NULL;
3256 PL_nextval[PL_nexttoke].opval = yylval.opval;
3257 PL_expect = XTERM;
8990e307
LW		 3258 force_next(WORD);
3259 TOKEN(NOAMP);
3260 }
748a9306 3261
3280af22 3262 if (PL_hints & HINT_STRICT_SUBS &&
748a9306 3263 lastchar != '-' &&
a0d0e21e 3264 strnNE(s,"->",2) &&
3280af22
NIS		 3265 PL_last_lop_op != OP_TRUNCATE && /* S/F prototype in opcode.pl */
3266 PL_last_lop_op != OP_ACCEPT &&
3267 PL_last_lop_op != OP_PIPE_OP &&
bf848113
GB		 3268 PL_last_lop_op != OP_SOCKPAIR &&
3269 !(PL_last_lop_op == OP_ENTERSUB
3270 && PL_last_proto
3271 && PL_last_proto[PL_last_proto[0] == ';' ? 1 : 0] == '*'))
a0d0e21e
LW		 3272 {
3273 warn(
3274 "Bareword \"%s\" not allowed while \"strict subs\" in use",
3280af22
NIS		 3275 PL_tokenbuf);
3276 ++PL_error_count;
85e6fe83 3277 }
8990e307
LW		 3278
3279 /* Call it a bare word */
3280
748a9306 3281 bareword:
599cee73 3282 if (ckWARN(WARN_RESERVED)) {
748a9306 3283 if (lastchar != '-') {
3280af22 3284 for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
748a9306 3285 if (!*d)
22c35a8c 3286 warner(WARN_RESERVED, PL_warn_reserved, PL_tokenbuf);
748a9306
LW		 3287 }
3288 }
c3e0f903
GS		 3289
3290 safe_bareword:
748a9306
LW		 3291 if (lastchar && strchr("*%&", lastchar)) {
3292 warn("Operator or semicolon missing before %c%s",
3280af22 3293 lastchar, PL_tokenbuf);
c2960299 3294 warn("Ambiguous use of %c resolved as operator %c",
748a9306
LW		 3295 lastchar, lastchar);
3296 }
93a17b20 3297 TOKEN(WORD);
79072805 3298 }
79072805 3299
68dc0745 3300 case KEY___FILE__:
46fc3d4c 3301 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3280af22 3302 newSVsv(GvSV(PL_curcop->cop_filegv)));
46fc3d4c 3303 TERM(THING);
3304
79072805 3305 case KEY___LINE__:
46fc3d4c 3306 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3280af22 3307 newSVpvf("%ld", (long)PL_curcop->cop_line));
79072805 3308 TERM(THING);
68dc0745 3309
3310 case KEY___PACKAGE__:
3311 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3280af22
NIS		 3312 (PL_curstash
3313 ? newSVsv(PL_curstname)
3314 : &PL_sv_undef));
79072805 3315 TERM(THING);
79072805 3316
e50aee73 3317 case KEY___DATA__:
79072805
LW		 3318 case KEY___END__: {
3319 GV *gv;
79072805
LW		 3320
3321 /*SUPPRESS 560*/
3280af22 3322 if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D')) {
e50aee73 3323 char *pname = "main";
3280af22
NIS		 3324 if (PL_tokenbuf[2] == 'D')
3325 pname = HvNAME(PL_curstash ? PL_curstash : PL_defstash);
46fc3d4c 3326 gv = gv_fetchpv(form("%s::DATA", pname), TRUE, SVt_PVIO);
a5f75d66 3327 GvMULTI_on(gv);
79072805 3328 if (!GvIO(gv))
a0d0e21e 3329 GvIOp(gv) = newIO();
3280af22 3330 IoIFP(GvIOp(gv)) = PL_rsfp;
a0d0e21e
LW		 3331#if defined(HAS_FCNTL) && defined(F_SETFD)
3332 {
3280af22 3333 int fd = PerlIO_fileno(PL_rsfp);
a0d0e21e
LW		 3334 fcntl(fd,F_SETFD,fd >= 3);
3335 }
79072805 3336#endif
fd049845 3337 /* Mark this internal pseudo-handle as clean */
3338 IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT;
3280af22 3339 if (PL_preprocess)
a0d0e21e 3340 IoTYPE(GvIOp(gv)) = '|';
3280af22 3341 else if ((PerlIO*)PL_rsfp == PerlIO_stdin())
a0d0e21e 3342 IoTYPE(GvIOp(gv)) = '-';
79072805 3343 else
a0d0e21e 3344 IoTYPE(GvIOp(gv)) = '<';
3280af22 3345 PL_rsfp = Nullfp;
79072805
LW		 3346 }
3347 goto fake_eof;
e929a76b 3348 }
de3bb511 3349
8990e307 3350 case KEY_AUTOLOAD:
ed6116ce 3351 case KEY_DESTROY:
79072805
LW		 3352 case KEY_BEGIN:
3353 case KEY_END:
7d07dbc2 3354 case KEY_INIT:
3280af22
NIS		 3355 if (PL_expect == XSTATE) {
3356 s = PL_bufptr;
93a17b20 3357 goto really_sub;
79072805
LW		 3358 }
3359 goto just_a_word;
3360
a0d0e21e
LW		 3361 case KEY_CORE:
3362 if (*s == ':' && s[1] == ':') {
3363 s += 2;
748a9306 3364 d = s;
3280af22
NIS		 3365 s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
3366 tmp = keyword(PL_tokenbuf, len);
a0d0e21e
LW		 3367 if (tmp < 0)
3368 tmp = -tmp;
3369 goto reserved_word;
3370 }
3371 goto just_a_word;
3372
463ee0b2
LW		 3373 case KEY_abs:
3374 UNI(OP_ABS);
3375
79072805
LW		 3376 case KEY_alarm:
3377 UNI(OP_ALARM);
3378
3379 case KEY_accept:
a0d0e21e 3380 LOP(OP_ACCEPT,XTERM);
79072805 3381
463ee0b2
LW		 3382 case KEY_and:
3383 OPERATOR(ANDOP);
3384
79072805 3385 case KEY_atan2:
a0d0e21e 3386 LOP(OP_ATAN2,XTERM);
85e6fe83 3387
79072805 3388 case KEY_bind:
a0d0e21e 3389 LOP(OP_BIND,XTERM);
79072805
LW		 3390
3391 case KEY_binmode:
3392 UNI(OP_BINMODE);
3393
3394 case KEY_bless:
a0d0e21e 3395 LOP(OP_BLESS,XTERM);
79072805
LW		 3396
3397 case KEY_chop:
3398 UNI(OP_CHOP);
3399
3400 case KEY_continue:
3401 PREBLOCK(CONTINUE);
3402
3403 case KEY_chdir:
85e6fe83 3404 (void)gv_fetchpv("ENV",TRUE, SVt_PVHV); /* may use HOME */
79072805
LW		 3405 UNI(OP_CHDIR);
3406
3407 case KEY_close:
3408 UNI(OP_CLOSE);
3409
3410 case KEY_closedir:
3411 UNI(OP_CLOSEDIR);
3412
3413 case KEY_cmp:
3414 Eop(OP_SCMP);
3415
3416 case KEY_caller:
3417 UNI(OP_CALLER);
3418
3419 case KEY_crypt:
3420#ifdef FCRYPT
6b88bc9c 3421 if (!PL_cryptseen++)
de3bb511 3422 init_des();
a687059c 3423#endif
a0d0e21e 3424 LOP(OP_CRYPT,XTERM);
79072805
LW		 3425
3426 case KEY_chmod:
599cee73 3427 if (ckWARN(WARN_OCTAL)) {
3280af22 3428 for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
748a9306
LW		 3429 if (*d != '0' && isDIGIT(*d))
3430 yywarn("chmod: mode argument is missing initial 0");
3431 }
a0d0e21e 3432 LOP(OP_CHMOD,XTERM);
79072805
LW		 3433
3434 case KEY_chown:
a0d0e21e 3435 LOP(OP_CHOWN,XTERM);
79072805
LW		 3436
3437 case KEY_connect:
a0d0e21e 3438 LOP(OP_CONNECT,XTERM);
79072805 3439
463ee0b2
LW		 3440 case KEY_chr:
3441 UNI(OP_CHR);
3442
79072805
LW		 3443 case KEY_cos:
3444 UNI(OP_COS);
3445
3446 case KEY_chroot:
3447 UNI(OP_CHROOT);
3448
3449 case KEY_do:
3450 s = skipspace(s);
3451 if (*s == '{')
a0d0e21e 3452 PRETERMBLOCK(DO);
79072805 3453 if (*s != '\'')
a0d0e21e 3454 s = force_word(s,WORD,FALSE,TRUE,FALSE);
378cc40b 3455 OPERATOR(DO);
79072805
LW		 3456
3457 case KEY_die:
3280af22 3458 PL_hints |= HINT_BLOCK_SCOPE;
a0d0e21e 3459 LOP(OP_DIE,XTERM);
79072805
LW		 3460
3461 case KEY_defined:
3462 UNI(OP_DEFINED);
3463
3464 case KEY_delete:
a0d0e21e 3465 UNI(OP_DELETE);
79072805
LW		 3466
3467 case KEY_dbmopen:
a0d0e21e
LW		 3468 gv_fetchpv("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV);
3469 LOP(OP_DBMOPEN,XTERM);
79072805
LW		 3470
3471 case KEY_dbmclose:
3472 UNI(OP_DBMCLOSE);
3473
3474 case KEY_dump:
a0d0e21e 3475 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3476 LOOPX(OP_DUMP);
3477
3478 case KEY_else:
3479 PREBLOCK(ELSE);
3480
3481 case KEY_elsif:
3280af22 3482 yylval.ival = PL_curcop->cop_line;
79072805
LW		 3483 OPERATOR(ELSIF);
3484
3485 case KEY_eq:
3486 Eop(OP_SEQ);
3487
a0d0e21e
LW		 3488 case KEY_exists:
3489 UNI(OP_EXISTS);
3490
79072805
LW		 3491 case KEY_exit:
3492 UNI(OP_EXIT);
3493
3494 case KEY_eval:
79072805 3495 s = skipspace(s);
3280af22 3496 PL_expect = (*s == '{') ? XTERMBLOCK : XTERM;
463ee0b2 3497 UNIBRACK(OP_ENTEREVAL);
79072805
LW		 3498
3499 case KEY_eof:
3500 UNI(OP_EOF);
3501
3502 case KEY_exp:
3503 UNI(OP_EXP);
3504
3505 case KEY_each:
3506 UNI(OP_EACH);
3507
3508 case KEY_exec:
3509 set_csh();
a0d0e21e 3510 LOP(OP_EXEC,XREF);
79072805
LW		 3511
3512 case KEY_endhostent:
3513 FUN0(OP_EHOSTENT);
3514
3515 case KEY_endnetent:
3516 FUN0(OP_ENETENT);
3517
3518 case KEY_endservent:
3519 FUN0(OP_ESERVENT);
3520
3521 case KEY_endprotoent:
3522 FUN0(OP_EPROTOENT);
3523
3524 case KEY_endpwent:
3525 FUN0(OP_EPWENT);
3526
3527 case KEY_endgrent:
3528 FUN0(OP_EGRENT);
3529
3530 case KEY_for:
3531 case KEY_foreach:
3280af22 3532 yylval.ival = PL_curcop->cop_line;
55497cff 3533 s = skipspace(s);
834a4ddd 3534 if (PL_expect == XSTATE && isIDFIRST_lazy(s)) {
55497cff 3535 char *p = s;
3280af22 3536 if ((PL_bufend - p) >= 3 &&
55497cff 3537 strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
3538 p += 2;
3539 p = skipspace(p);
834a4ddd 3540 if (isIDFIRST_lazy(p))
55497cff 3541 croak("Missing $ on loop variable");
3542 }
79072805
LW		 3543 OPERATOR(FOR);
3544
3545 case KEY_formline:
a0d0e21e 3546 LOP(OP_FORMLINE,XTERM);
79072805
LW		 3547
3548 case KEY_fork:
3549 FUN0(OP_FORK);
3550
3551 case KEY_fcntl:
a0d0e21e 3552 LOP(OP_FCNTL,XTERM);
79072805
LW		 3553
3554 case KEY_fileno:
3555 UNI(OP_FILENO);
3556
3557 case KEY_flock:
a0d0e21e 3558 LOP(OP_FLOCK,XTERM);
79072805
LW		 3559
3560 case KEY_gt:
3561 Rop(OP_SGT);
3562
3563 case KEY_ge:
3564 Rop(OP_SGE);
3565
3566 case KEY_grep:
a0d0e21e 3567 LOP(OP_GREPSTART, *s == '(' ? XTERM : XREF);
79072805
LW		 3568
3569 case KEY_goto:
a0d0e21e 3570 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3571 LOOPX(OP_GOTO);
3572
3573 case KEY_gmtime:
3574 UNI(OP_GMTIME);
3575
3576 case KEY_getc:
3577 UNI(OP_GETC);
3578
3579 case KEY_getppid:
3580 FUN0(OP_GETPPID);
3581
3582 case KEY_getpgrp:
3583 UNI(OP_GETPGRP);
3584
3585 case KEY_getpriority:
a0d0e21e 3586 LOP(OP_GETPRIORITY,XTERM);
79072805
LW		 3587
3588 case KEY_getprotobyname:
3589 UNI(OP_GPBYNAME);
3590
3591 case KEY_getprotobynumber:
a0d0e21e 3592 LOP(OP_GPBYNUMBER,XTERM);
79072805
LW		 3593
3594 case KEY_getprotoent:
3595 FUN0(OP_GPROTOENT);
3596
3597 case KEY_getpwent:
3598 FUN0(OP_GPWENT);
3599
3600 case KEY_getpwnam:
ff68c719 3601 UNI(OP_GPWNAM);
79072805
LW		 3602
3603 case KEY_getpwuid:
ff68c719 3604 UNI(OP_GPWUID);
79072805
LW		 3605
3606 case KEY_getpeername:
3607 UNI(OP_GETPEERNAME);
3608
3609 case KEY_gethostbyname:
3610 UNI(OP_GHBYNAME);
3611
3612 case KEY_gethostbyaddr:
a0d0e21e 3613 LOP(OP_GHBYADDR,XTERM);
79072805
LW		 3614
3615 case KEY_gethostent:
3616 FUN0(OP_GHOSTENT);
3617
3618 case KEY_getnetbyname:
3619 UNI(OP_GNBYNAME);
3620
3621 case KEY_getnetbyaddr:
a0d0e21e 3622 LOP(OP_GNBYADDR,XTERM);
79072805
LW		 3623
3624 case KEY_getnetent:
3625 FUN0(OP_GNETENT);
3626
3627 case KEY_getservbyname:
a0d0e21e 3628 LOP(OP_GSBYNAME,XTERM);
79072805
LW		 3629
3630 case KEY_getservbyport:
a0d0e21e 3631 LOP(OP_GSBYPORT,XTERM);
79072805
LW		 3632
3633 case KEY_getservent:
3634 FUN0(OP_GSERVENT);
3635
3636 case KEY_getsockname:
3637 UNI(OP_GETSOCKNAME);
3638
3639 case KEY_getsockopt:
a0d0e21e 3640 LOP(OP_GSOCKOPT,XTERM);
79072805
LW		 3641
3642 case KEY_getgrent:
3643 FUN0(OP_GGRENT);
3644
3645 case KEY_getgrnam:
ff68c719 3646 UNI(OP_GGRNAM);
79072805
LW		 3647
3648 case KEY_getgrgid:
ff68c719 3649 UNI(OP_GGRGID);
79072805
LW		 3650
3651 case KEY_getlogin:
3652 FUN0(OP_GETLOGIN);
3653
93a17b20 3654 case KEY_glob:
a0d0e21e
LW		 3655 set_csh();
3656 LOP(OP_GLOB,XTERM);
93a17b20 3657
79072805
LW		 3658 case KEY_hex:
3659 UNI(OP_HEX);
3660
3661 case KEY_if:
3280af22 3662 yylval.ival = PL_curcop->cop_line;
79072805
LW		 3663 OPERATOR(IF);
3664
3665 case KEY_index:
a0d0e21e 3666 LOP(OP_INDEX,XTERM);
79072805
LW		 3667
3668 case KEY_int:
3669 UNI(OP_INT);
3670
3671 case KEY_ioctl:
a0d0e21e 3672 LOP(OP_IOCTL,XTERM);
79072805
LW		 3673
3674 case KEY_join:
a0d0e21e 3675 LOP(OP_JOIN,XTERM);
79072805
LW		 3676
3677 case KEY_keys:
3678 UNI(OP_KEYS);
3679
3680 case KEY_kill:
a0d0e21e 3681 LOP(OP_KILL,XTERM);
79072805
LW		 3682
3683 case KEY_last:
a0d0e21e 3684 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805 3685 LOOPX(OP_LAST);
a0d0e21e 3686
79072805
LW		 3687 case KEY_lc:
3688 UNI(OP_LC);
3689
3690 case KEY_lcfirst:
3691 UNI(OP_LCFIRST);
3692
3693 case KEY_local:
3694 OPERATOR(LOCAL);
3695
3696 case KEY_length:
3697 UNI(OP_LENGTH);
3698
3699 case KEY_lt:
3700 Rop(OP_SLT);
3701
3702 case KEY_le:
3703 Rop(OP_SLE);
3704
3705 case KEY_localtime:
3706 UNI(OP_LOCALTIME);
3707
3708 case KEY_log:
3709 UNI(OP_LOG);
3710
3711 case KEY_link:
a0d0e21e 3712 LOP(OP_LINK,XTERM);
79072805
LW		 3713
3714 case KEY_listen:
a0d0e21e 3715 LOP(OP_LISTEN,XTERM);
79072805 3716
c0329465
MB		 3717 case KEY_lock:
3718 UNI(OP_LOCK);
3719
79072805
LW		 3720 case KEY_lstat:
3721 UNI(OP_LSTAT);
3722
3723 case KEY_m:
8782bef2 3724 s = scan_pat(s,OP_MATCH);
79072805
LW		 3725 TERM(sublex_start());
3726
a0d0e21e 3727 case KEY_map:
834a4ddd 3728 LOP(OP_MAPSTART, XREF);
a0d0e21e 3729
79072805 3730 case KEY_mkdir:
a0d0e21e 3731 LOP(OP_MKDIR,XTERM);
79072805
LW		 3732
3733 case KEY_msgctl:
a0d0e21e 3734 LOP(OP_MSGCTL,XTERM);
79072805
LW		 3735
3736 case KEY_msgget:
a0d0e21e 3737 LOP(OP_MSGGET,XTERM);
79072805
LW		 3738
3739 case KEY_msgrcv:
a0d0e21e 3740 LOP(OP_MSGRCV,XTERM);
79072805
LW		 3741
3742 case KEY_msgsnd:
a0d0e21e 3743 LOP(OP_MSGSND,XTERM);
79072805 3744
93a17b20 3745 case KEY_my:
3280af22 3746 PL_in_my = TRUE;
c750a3ec 3747 s = skipspace(s);
834a4ddd 3748 if (isIDFIRST_lazy(s)) {
3280af22
NIS		 3749 s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
3750 PL_in_my_stash = gv_stashpv(PL_tokenbuf, FALSE);
3751 if (!PL_in_my_stash) {
c750a3ec 3752 char tmpbuf[1024];
3280af22
NIS		 3753 PL_bufptr = s;
3754 sprintf(tmpbuf, "No such class %.1000s", PL_tokenbuf);
c750a3ec
MB		 3755 yyerror(tmpbuf);
3756 }
3757 }
55497cff 3758 OPERATOR(MY);
93a17b20 3759
79072805 3760 case KEY_next:
a0d0e21e 3761 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3762 LOOPX(OP_NEXT);
3763
3764 case KEY_ne:
3765 Eop(OP_SNE);
3766
a0d0e21e 3767 case KEY_no:
3280af22 3768 if (PL_expect != XSTATE)
a0d0e21e
LW		 3769 yyerror("\"no\" not allowed in expression");
3770 s = force_word(s,WORD,FALSE,TRUE,FALSE);
89bfa8cd 3771 s = force_version(s);
a0d0e21e
LW		 3772 yylval.ival = 0;
3773 OPERATOR(USE);
3774
3775 case KEY_not:
3776 OPERATOR(NOTOP);
3777
79072805 3778 case KEY_open:
93a17b20 3779 s = skipspace(s);
834a4ddd 3780 if (isIDFIRST_lazy(s)) {
93a17b20 3781 char *t;
834a4ddd 3782 for (d = s; isALNUM_lazy(d); d++) ;
93a17b20
LW		 3783 t = skipspace(d);
3784 if (strchr("|&*+-=!?:.", *t))
3785 warn("Precedence problem: open %.*s should be open(%.*s)",
3786 d-s,s, d-s,s);
3787 }
a0d0e21e 3788 LOP(OP_OPEN,XTERM);
79072805 3789
463ee0b2 3790 case KEY_or:
a0d0e21e 3791 yylval.ival = OP_OR;
463ee0b2
LW		 3792 OPERATOR(OROP);
3793
79072805
LW		 3794 case KEY_ord:
3795 UNI(OP_ORD);
3796
3797 case KEY_oct:
3798 UNI(OP_OCT);
3799
3800 case KEY_opendir:
a0d0e21e 3801 LOP(OP_OPEN_DIR,XTERM);
79072805
LW		 3802
3803 case KEY_print:
3280af22 3804 checkcomma(s,PL_tokenbuf,"filehandle");
a0d0e21e 3805 LOP(OP_PRINT,XREF);
79072805
LW		 3806
3807 case KEY_printf:
3280af22 3808 checkcomma(s,PL_tokenbuf,"filehandle");
a0d0e21e 3809 LOP(OP_PRTF,XREF);
79072805 3810
c07a80fd 3811 case KEY_prototype:
3812 UNI(OP_PROTOTYPE);
3813
79072805 3814 case KEY_push:
a0d0e21e 3815 LOP(OP_PUSH,XTERM);
79072805
LW		 3816
3817 case KEY_pop:
3818 UNI(OP_POP);
3819
a0d0e21e
LW		 3820 case KEY_pos:
3821 UNI(OP_POS);
3822
79072805 3823 case KEY_pack:
a0d0e21e 3824 LOP(OP_PACK,XTERM);
79072805
LW		 3825
3826 case KEY_package:
a0d0e21e 3827 s = force_word(s,WORD,FALSE,TRUE,FALSE);
79072805
LW		 3828 OPERATOR(PACKAGE);
3829
3830 case KEY_pipe:
a0d0e21e 3831 LOP(OP_PIPE_OP,XTERM);
79072805
LW		 3832
3833 case KEY_q:
3834 s = scan_str(s);
3835 if (!s)
85e6fe83 3836 missingterm((char*)0);
79072805
LW		 3837 yylval.ival = OP_CONST;
3838 TERM(sublex_start());
3839
a0d0e21e
LW		 3840 case KEY_quotemeta:
3841 UNI(OP_QUOTEMETA);
3842
8990e307
LW		 3843 case KEY_qw:
3844 s = scan_str(s);
3845 if (!s)
85e6fe83 3846 missingterm((char*)0);
8127e0e3
GS		 3847 force_next(')');
3848 if (SvCUR(PL_lex_stuff)) {
3849 OP *words = Nullop;
3850 int warned = 0;
3280af22 3851 d = SvPV_force(PL_lex_stuff, len);
8127e0e3
GS		 3852 while (len) {
3853 for (; isSPACE(*d) && len; --len, ++d) ;
3854 if (len) {
3855 char *b = d;
3856 if (!warned && ckWARN(WARN_SYNTAX)) {
3857 for (; !isSPACE(*d) && len; --len, ++d) {
3858 if (*d == ',') {
3859 warner(WARN_SYNTAX,
3860 "Possible attempt to separate words with commas");
3861 ++warned;
3862 }
3863 else if (*d == '#') {
3864 warner(WARN_SYNTAX,
3865 "Possible attempt to put comments in qw() list");
3866 ++warned;
3867 }
3868 }
3869 }
3870 else {
3871 for (; !isSPACE(*d) && len; --len, ++d) ;
3872 }
3873 words = append_elem(OP_LIST, words,
3874 newSVOP(OP_CONST, 0, newSVpvn(b, d-b)));
55497cff 3875 }
3876 }
8127e0e3
GS		 3877 if (words) {
3878 PL_nextval[PL_nexttoke].opval = words;
3879 force_next(THING);
3880 }
55497cff 3881 }
8127e0e3
GS		 3882 if (PL_lex_stuff)
3883 SvREFCNT_dec(PL_lex_stuff);
3280af22 3884 PL_lex_stuff = Nullsv;
3280af22 3885 PL_expect = XTERM;
8127e0e3 3886 TOKEN('(');
8990e307 3887
79072805
LW		 3888 case KEY_qq:
3889 s = scan_str(s);
3890 if (!s)
85e6fe83 3891 missingterm((char*)0);
a0d0e21e 3892 yylval.ival = OP_STRINGIFY;
3280af22
NIS		 3893 if (SvIVX(PL_lex_stuff) == '\'')
3894 SvIVX(PL_lex_stuff) = 0; /* qq'$foo' should intepolate */
79072805
LW		 3895 TERM(sublex_start());
3896
8782bef2
GB		 3897 case KEY_qr:
3898 s = scan_pat(s,OP_QR);
3899 TERM(sublex_start());
3900
79072805
LW		 3901 case KEY_qx:
3902 s = scan_str(s);
3903 if (!s)
85e6fe83 3904 missingterm((char*)0);
79072805
LW		 3905 yylval.ival = OP_BACKTICK;
3906 set_csh();
3907 TERM(sublex_start());
3908
3909 case KEY_return:
3910 OLDLOP(OP_RETURN);
3911
3912 case KEY_require:
3280af22 3913 *PL_tokenbuf = '\0';
a0d0e21e 3914 s = force_word(s,WORD,TRUE,TRUE,FALSE);
834a4ddd 3915 if (isIDFIRST_lazy(PL_tokenbuf))
3280af22 3916 gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE);
748a9306 3917 else if (*s == '<')
a0d0e21e 3918 yyerror("<> should be quotes");
463ee0b2 3919 UNI(OP_REQUIRE);
79072805
LW		 3920
3921 case KEY_reset:
3922 UNI(OP_RESET);
3923
3924 case KEY_redo:
a0d0e21e 3925 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3926 LOOPX(OP_REDO);
3927
3928 case KEY_rename:
a0d0e21e 3929 LOP(OP_RENAME,XTERM);
79072805
LW		 3930
3931 case KEY_rand:
3932 UNI(OP_RAND);
3933
3934 case KEY_rmdir:
3935 UNI(OP_RMDIR);
3936
3937 case KEY_rindex:
a0d0e21e 3938 LOP(OP_RINDEX,XTERM);
79072805
LW		 3939
3940 case KEY_read:
a0d0e21e 3941 LOP(OP_READ,XTERM);
79072805
LW		 3942
3943 case KEY_readdir:
3944 UNI(OP_READDIR);
3945
93a17b20
LW		 3946 case KEY_readline:
3947 set_csh();
3948 UNI(OP_READLINE);
3949
3950 case KEY_readpipe:
3951 set_csh();
3952 UNI(OP_BACKTICK);
3953
79072805
LW		 3954 case KEY_rewinddir:
3955 UNI(OP_REWINDDIR);
3956
3957 case KEY_recv:
a0d0e21e 3958 LOP(OP_RECV,XTERM);
79072805
LW		 3959
3960 case KEY_reverse:
a0d0e21e 3961 LOP(OP_REVERSE,XTERM);
79072805
LW		 3962
3963 case KEY_readlink:
3964 UNI(OP_READLINK);
3965
3966 case KEY_ref:
3967 UNI(OP_REF);
3968
3969 case KEY_s:
3970 s = scan_subst(s);
3971 if (yylval.opval)
3972 TERM(sublex_start());
3973 else
3974 TOKEN(1); /* force error */
3975
a0d0e21e
LW		 3976 case KEY_chomp:
3977 UNI(OP_CHOMP);
3978
79072805
LW		 3979 case KEY_scalar:
3980 UNI(OP_SCALAR);
3981
3982 case KEY_select:
a0d0e21e 3983 LOP(OP_SELECT,XTERM);
79072805
LW		 3984
3985 case KEY_seek:
a0d0e21e 3986 LOP(OP_SEEK,XTERM);
79072805
LW		 3987
3988 case KEY_semctl:
a0d0e21e 3989 LOP(OP_SEMCTL,XTERM);
79072805
LW		 3990
3991 case KEY_semget:
a0d0e21e 3992 LOP(OP_SEMGET,XTERM);
79072805
LW		 3993
3994 case KEY_semop:
a0d0e21e 3995 LOP(OP_SEMOP,XTERM);
79072805
LW		 3996
3997 case KEY_send:
a0d0e21e 3998 LOP(OP_SEND,XTERM);
79072805
LW		 3999
4000 case KEY_setpgrp:
a0d0e21e 4001 LOP(OP_SETPGRP,XTERM);
79072805
LW		 4002
4003 case KEY_setpriority:
a0d0e21e 4004 LOP(OP_SETPRIORITY,XTERM);
79072805
LW		 4005
4006 case KEY_sethostent:
ff68c719 4007 UNI(OP_SHOSTENT);
79072805
LW		 4008
4009 case KEY_setnetent:
ff68c719 4010 UNI(OP_SNETENT);
79072805
LW		 4011
4012 case KEY_setservent:
ff68c719 4013 UNI(OP_SSERVENT);
79072805
LW		 4014
4015 case KEY_setprotoent:
ff68c719 4016 UNI(OP_SPROTOENT);
79072805
LW		 4017
4018 case KEY_setpwent:
4019 FUN0(OP_SPWENT);
4020
4021 case KEY_setgrent:
4022 FUN0(OP_SGRENT);
4023
4024 case KEY_seekdir:
a0d0e21e 4025 LOP(OP_SEEKDIR,XTERM);
79072805
LW		 4026
4027 case KEY_setsockopt:
a0d0e21e 4028 LOP(OP_SSOCKOPT,XTERM);
79072805
LW		 4029
4030 case KEY_shift:
4031 UNI(OP_SHIFT);
4032
4033 case KEY_shmctl:
a0d0e21e 4034 LOP(OP_SHMCTL,XTERM);
79072805
LW		 4035
4036 case KEY_shmget:
a0d0e21e 4037 LOP(OP_SHMGET,XTERM);
79072805
LW		 4038
4039 case KEY_shmread:
a0d0e21e 4040 LOP(OP_SHMREAD,XTERM);
79072805
LW		 4041
4042 case KEY_shmwrite:
a0d0e21e 4043 LOP(OP_SHMWRITE,XTERM);
79072805
LW		 4044
4045 case KEY_shutdown:
a0d0e21e 4046 LOP(OP_SHUTDOWN,XTERM);
79072805
LW		 4047
4048 case KEY_sin:
4049 UNI(OP_SIN);
4050
4051 case KEY_sleep:
4052 UNI(OP_SLEEP);
4053
4054 case KEY_socket:
a0d0e21e 4055 LOP(OP_SOCKET,XTERM);
79072805
LW		 4056
4057 case KEY_socketpair:
a0d0e21e 4058 LOP(OP_SOCKPAIR,XTERM);
79072805
LW		 4059
4060 case KEY_sort:
3280af22 4061 checkcomma(s,PL_tokenbuf,"subroutine name");
79072805
LW		 4062 s = skipspace(s);
4063 if (*s == ';' || *s == ')') /* probably a close */
463ee0b2 4064 croak("sort is now a reserved word");
3280af22 4065 PL_expect = XTERM;
15f0808c 4066 s = force_word(s,WORD,TRUE,TRUE,FALSE);
a0d0e21e 4067 LOP(OP_SORT,XREF);
79072805
LW		 4068
4069 case KEY_split:
a0d0e21e 4070 LOP(OP_SPLIT,XTERM);
79072805
LW		 4071
4072 case KEY_sprintf:
a0d0e21e 4073 LOP(OP_SPRINTF,XTERM);
79072805
LW		 4074
4075 case KEY_splice:
a0d0e21e 4076 LOP(OP_SPLICE,XTERM);
79072805
LW		 4077
4078 case KEY_sqrt:
4079 UNI(OP_SQRT);
4080
4081 case KEY_srand:
4082 UNI(OP_SRAND);
4083
4084 case KEY_stat:
4085 UNI(OP_STAT);
4086
4087 case KEY_study:
3280af22 4088 PL_sawstudy++;
79072805
LW		 4089 UNI(OP_STUDY);
4090
4091 case KEY_substr:
a0d0e21e 4092 LOP(OP_SUBSTR,XTERM);
79072805
LW		 4093
4094 case KEY_format:
4095 case KEY_sub:
93a17b20 4096 really_sub:
79072805 4097 s = skipspace(s);
4633a7c4 4098
834a4ddd 4099 if (isIDFIRST_lazy(s) || *s == '\'' || *s == ':') {
3280af22
NIS		 4100 char tmpbuf[sizeof PL_tokenbuf];
4101 PL_expect = XBLOCK;
8903cb82 4102 d = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
463ee0b2 4103 if (strchr(tmpbuf, ':'))
3280af22 4104 sv_setpv(PL_subname, tmpbuf);
463ee0b2 4105 else {
3280af22
NIS		 4106 sv_setsv(PL_subname,PL_curstname);
4107 sv_catpvn(PL_subname,"::",2);
4108 sv_catpvn(PL_subname,tmpbuf,len);
463ee0b2 4109 }
a0d0e21e 4110 s = force_word(s,WORD,FALSE,TRUE,TRUE);
4633a7c4 4111 s = skipspace(s);
79072805 4112 }
4633a7c4 4113 else {
3280af22
NIS		 4114 PL_expect = XTERMBLOCK;
4115 sv_setpv(PL_subname,"?");
4633a7c4
LW		 4116 }
4117
4118 if (tmp == KEY_format) {
4119 s = skipspace(s);
4120 if (*s == '=')
3280af22 4121 PL_lex_formbrack = PL_lex_brackets + 1;
4633a7c4
LW		 4122 OPERATOR(FORMAT);
4123 }
79072805 4124
4633a7c4
LW		 4125 /* Look for a prototype */
4126 if (*s == '(') {
68dc0745 4127 char *p;
4128
4633a7c4
LW		 4129 s = scan_str(s);
4130 if (!s) {
3280af22
NIS		 4131 if (PL_lex_stuff)
4132 SvREFCNT_dec(PL_lex_stuff);
4133 PL_lex_stuff = Nullsv;
4633a7c4
LW		 4134 croak("Prototype not terminated");
4135 }
68dc0745 4136 /* strip spaces */
3280af22 4137 d = SvPVX(PL_lex_stuff);
68dc0745 4138 tmp = 0;
4139 for (p = d; *p; ++p) {
4140 if (!isSPACE(*p))
4141 d[tmp++] = *p;
4142 }
4143 d[tmp] = '\0';
3280af22
NIS		 4144 SvCUR(PL_lex_stuff) = tmp;
4145
4146 PL_nexttoke++;
4147 PL_nextval[1] = PL_nextval[0];
4148 PL_nexttype[1] = PL_nexttype[0];
4149 PL_nextval[0].opval = (OP*)newSVOP(OP_CONST, 0, PL_lex_stuff);
4150 PL_nexttype[0] = THING;
4151 if (PL_nexttoke == 1) {
4152 PL_lex_defer = PL_lex_state;
4153 PL_lex_expect = PL_expect;
4154 PL_lex_state = LEX_KNOWNEXT;
4633a7c4 4155 }
3280af22 4156 PL_lex_stuff = Nullsv;
4633a7c4 4157 }
79072805 4158
2d8e6c8d 4159 if (*SvPV(PL_subname,n_a) == '?') {
3280af22 4160 sv_setpv(PL_subname,"__ANON__");
4633a7c4
LW		 4161 TOKEN(ANONSUB);
4162 }
4163 PREBLOCK(SUB);
79072805
LW		 4164
4165 case KEY_system:
4166 set_csh();
a0d0e21e 4167 LOP(OP_SYSTEM,XREF);
79072805
LW		 4168
4169 case KEY_symlink:
a0d0e21e 4170 LOP(OP_SYMLINK,XTERM);
79072805
LW		 4171
4172 case KEY_syscall:
a0d0e21e 4173 LOP(OP_SYSCALL,XTERM);
79072805 4174
c07a80fd 4175 case KEY_sysopen:
4176 LOP(OP_SYSOPEN,XTERM);
4177
137443ea 4178 case KEY_sysseek:
4179 LOP(OP_SYSSEEK,XTERM);
4180
79072805 4181 case KEY_sysread:
a0d0e21e 4182 LOP(OP_SYSREAD,XTERM);
79072805
LW		 4183
4184 case KEY_syswrite:
a0d0e21e 4185 LOP(OP_SYSWRITE,XTERM);
79072805
LW		 4186
4187 case KEY_tr:
4188 s = scan_trans(s);
4189 TERM(sublex_start());
4190
4191 case KEY_tell:
4192 UNI(OP_TELL);
4193
4194 case KEY_telldir:
4195 UNI(OP_TELLDIR);
4196
463ee0b2 4197 case KEY_tie:
a0d0e21e 4198 LOP(OP_TIE,XTERM);
463ee0b2 4199
c07a80fd 4200 case KEY_tied:
4201 UNI(OP_TIED);
4202
79072805
LW		 4203 case KEY_time:
4204 FUN0(OP_TIME);
4205
4206 case KEY_times:
4207 FUN0(OP_TMS);
4208
4209 case KEY_truncate:
a0d0e21e 4210 LOP(OP_TRUNCATE,XTERM);
79072805
LW		 4211
4212 case KEY_uc:
4213 UNI(OP_UC);
4214
4215 case KEY_ucfirst:
4216 UNI(OP_UCFIRST);
4217
463ee0b2
LW		 4218 case KEY_untie:
4219 UNI(OP_UNTIE);
4220
79072805 4221 case KEY_until:
3280af22 4222 yylval.ival = PL_curcop->cop_line;
79072805
LW		 4223 OPERATOR(UNTIL);
4224
4225 case KEY_unless:
3280af22 4226 yylval.ival = PL_curcop->cop_line;
79072805
LW		 4227 OPERATOR(UNLESS);
4228
4229 case KEY_unlink:
a0d0e21e 4230 LOP(OP_UNLINK,XTERM);
79072805
LW		 4231
4232 case KEY_undef:
4233 UNI(OP_UNDEF);
4234
4235 case KEY_unpack:
a0d0e21e 4236 LOP(OP_UNPACK,XTERM);
79072805
LW		 4237
4238 case KEY_utime:
a0d0e21e 4239 LOP(OP_UTIME,XTERM);
79072805
LW		 4240
4241 case KEY_umask:
599cee73 4242 if (ckWARN(WARN_OCTAL)) {
3280af22 4243 for (d = s; d < PL_bufend && (isSPACE(*d) || *d == '('); d++) ;
748a9306
LW		 4244 if (*d != '0' && isDIGIT(*d))
4245 yywarn("umask: argument is missing initial 0");
4246 }
79072805
LW		 4247 UNI(OP_UMASK);
4248
4249 case KEY_unshift:
a0d0e21e
LW		 4250 LOP(OP_UNSHIFT,XTERM);
4251
4252 case KEY_use:
3280af22 4253 if (PL_expect != XSTATE)
a0d0e21e 4254 yyerror("\"use\" not allowed in expression");
89bfa8cd 4255 s = skipspace(s);
4256 if(isDIGIT(*s)) {
4257 s = force_version(s);
4258 if(*s == ';' || (s = skipspace(s), *s == ';')) {
3280af22 4259 PL_nextval[PL_nexttoke].opval = Nullop;
89bfa8cd 4260 force_next(WORD);
4261 }
4262 }
4263 else {
4264 s = force_word(s,WORD,FALSE,TRUE,FALSE);
4265 s = force_version(s);
4266 }
a0d0e21e
LW		 4267 yylval.ival = 1;
4268 OPERATOR(USE);
79072805
LW		 4269
4270 case KEY_values:
4271 UNI(OP_VALUES);
4272
4273 case KEY_vec:
3280af22 4274 PL_sawvec = TRUE;
a0d0e21e 4275 LOP(OP_VEC,XTERM);
79072805
LW		 4276
4277 case KEY_while:
3280af22 4278 yylval.ival = PL_curcop->cop_line;
79072805
LW		 4279 OPERATOR(WHILE);
4280
4281 case KEY_warn:
3280af22 4282 PL_hints |= HINT_BLOCK_SCOPE;
a0d0e21e 4283 LOP(OP_WARN,XTERM);
79072805
LW		 4284
4285 case KEY_wait:
4286 FUN0(OP_WAIT);
4287
4288 case KEY_waitpid:
a0d0e21e 4289 LOP(OP_WAITPID,XTERM);
79072805
LW		 4290
4291 case KEY_wantarray:
4292 FUN0(OP_WANTARRAY);
4293
4294 case KEY_write:
9d116dd7
JH		 4295#ifdef EBCDIC
4296 {
4297 static char ctl_l[2];
4298
4299 if (ctl_l[0] == '\0')
4300 ctl_l[0] = toCTRL('L');
4301 gv_fetchpv(ctl_l,TRUE, SVt_PV);
4302 }
4303#else
4304 gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */
4305#endif
79072805
LW		 4306 UNI(OP_ENTERWRITE);
4307
4308 case KEY_x:
3280af22 4309 if (PL_expect == XOPERATOR)
79072805
LW		 4310 Mop(OP_REPEAT);
4311 check_uni();
4312 goto just_a_word;
4313
a0d0e21e
LW		 4314 case KEY_xor:
4315 yylval.ival = OP_XOR;
4316 OPERATOR(OROP);
4317
79072805
LW		 4318 case KEY_y:
4319 s = scan_trans(s);
4320 TERM(sublex_start());
4321 }
49dc05e3 4322 }}
79072805
LW		 4323}
4324
4325I32
8ac85365 4326keyword(register char *d, I32 len)
79072805
LW		 4327{
4328 switch (*d) {
4329 case '_':
4330 if (d[1] == '_') {
a0d0e21e 4331 if (strEQ(d,"__FILE__")) return -KEY___FILE__;
68dc0745 4332 if (strEQ(d,"__LINE__")) return -KEY___LINE__;
4333 if (strEQ(d,"__PACKAGE__")) return -KEY___PACKAGE__;
e50aee73 4334 if (strEQ(d,"__DATA__")) return KEY___DATA__;
79072805
LW		 4335 if (strEQ(d,"__END__")) return KEY___END__;
4336 }
4337 break;
8990e307
LW		 4338 case 'A':
4339 if (strEQ(d,"AUTOLOAD")) return KEY_AUTOLOAD;
4340 break;
79072805 4341 case 'a':
463ee0b2
LW		 4342 switch (len) {
4343 case 3:
a0d0e21e
LW		 4344 if (strEQ(d,"and")) return -KEY_and;
4345 if (strEQ(d,"abs")) return -KEY_abs;
85e6fe83 4346 break;
463ee0b2 4347 case 5:
a0d0e21e
LW		 4348 if (strEQ(d,"alarm")) return -KEY_alarm;
4349 if (strEQ(d,"atan2")) return -KEY_atan2;
463ee0b2
LW		 4350 break;
4351 case 6:
a0d0e21e 4352 if (strEQ(d,"accept")) return -KEY_accept;
463ee0b2
LW		 4353 break;
4354 }
79072805
LW		 4355 break;
4356 case 'B':
4357 if (strEQ(d,"BEGIN")) return KEY_BEGIN;
93a17b20 4358 break;
79072805 4359 case 'b':
a0d0e21e
LW		 4360 if (strEQ(d,"bless")) return -KEY_bless;
4361 if (strEQ(d,"bind")) return -KEY_bind;
4362 if (strEQ(d,"binmode")) return -KEY_binmode;
4363 break;
4364 case 'C':
4365 if (strEQ(d,"CORE")) return -KEY_CORE;
79072805
LW		 4366 break;
4367 case 'c':
4368 switch (len) {
4369 case 3:
a0d0e21e
LW		 4370 if (strEQ(d,"cmp")) return -KEY_cmp;
4371 if (strEQ(d,"chr")) return -KEY_chr;
4372 if (strEQ(d,"cos")) return -KEY_cos;
79072805
LW		 4373 break;
4374 case 4:
4375 if (strEQ(d,"chop")) return KEY_chop;
4376 break;
4377 case 5:
a0d0e21e
LW		 4378 if (strEQ(d,"close")) return -KEY_close;
4379 if (strEQ(d,"chdir")) return -KEY_chdir;
4380 if (strEQ(d,"chomp")) return KEY_chomp;
4381 if (strEQ(d,"chmod")) return -KEY_chmod;
4382 if (strEQ(d,"chown")) return -KEY_chown;
4383 if (strEQ(d,"crypt")) return -KEY_crypt;
79072805
LW		 4384 break;
4385 case 6:
a0d0e21e
LW		 4386 if (strEQ(d,"chroot")) return -KEY_chroot;
4387 if (strEQ(d,"caller")) return -KEY_caller;
79072805
LW		 4388 break;
4389 case 7:
a0d0e21e 4390 if (strEQ(d,"connect")) return -KEY_connect;
79072805
LW		 4391 break;
4392 case 8:
a0d0e21e
LW		 4393 if (strEQ(d,"closedir")) return -KEY_closedir;
4394 if (strEQ(d,"continue")) return -KEY_continue;
79072805
LW		 4395 break;
4396 }
4397 break;
ed6116ce
LW		 4398 case 'D':
4399 if (strEQ(d,"DESTROY")) return KEY_DESTROY;
4400 break;
79072805
LW		 4401 case 'd':
4402 switch (len) {
4403 case 2:
4404 if (strEQ(d,"do")) return KEY_do;
4405 break;
4406 case 3:
a0d0e21e 4407 if (strEQ(d,"die")) return -KEY_die;
79072805
LW		 4408 break;
4409 case 4:
a0d0e21e 4410 if (strEQ(d,"dump")) return -KEY_dump;
79072805
LW		 4411 break;
4412 case 6:
4413 if (strEQ(d,"delete")) return KEY_delete;
4414 break;
4415 case 7:
4416 if (strEQ(d,"defined")) return KEY_defined;
a0d0e21e 4417 if (strEQ(d,"dbmopen")) return -KEY_dbmopen;
79072805
LW		 4418 break;
4419 case 8:
a0d0e21e 4420 if (strEQ(d,"dbmclose")) return -KEY_dbmclose;
79072805
LW		 4421 break;
4422 }
4423 break;
4424 case 'E':
a0d0e21e 4425 if (strEQ(d,"EQ")) { deprecate(d); return -KEY_eq;}
79072805
LW		 4426 if (strEQ(d,"END")) return KEY_END;
4427 break;
4428 case 'e':
4429 switch (len) {
4430 case 2:
a0d0e21e 4431 if (strEQ(d,"eq")) return -KEY_eq;
79072805
LW		 4432 break;
4433 case 3:
a0d0e21e
LW		 4434 if (strEQ(d,"eof")) return -KEY_eof;
4435 if (strEQ(d,"exp")) return -KEY_exp;
79072805
LW		 4436 break;
4437 case 4:
4438 if (strEQ(d,"else")) return KEY_else;
a0d0e21e 4439 if (strEQ(d,"exit")) return -KEY_exit;
79072805 4440 if (strEQ(d,"eval")) return KEY_eval;
a0d0e21e 4441 if (strEQ(d,"exec")) return -KEY_exec;
79072805
LW		 4442 if (strEQ(d,"each")) return KEY_each;
4443 break;
4444 case 5:
4445 if (strEQ(d,"elsif")) return KEY_elsif;
4446 break;
a0d0e21e
LW		 4447 case 6:
4448 if (strEQ(d,"exists")) return KEY_exists;
4633a7c4 4449 if (strEQ(d,"elseif")) warn("elseif should be elsif");
a0d0e21e 4450 break;
79072805 4451 case 8:
a0d0e21e
LW		 4452 if (strEQ(d,"endgrent")) return -KEY_endgrent;
4453 if (strEQ(d,"endpwent")) return -KEY_endpwent;
79072805
LW		 4454 break;
4455 case 9:
a0d0e21e 4456 if (strEQ(d,"endnetent")) return -KEY_endnetent;
79072805
LW		 4457 break;
4458 case 10:
a0d0e21e
LW		 4459 if (strEQ(d,"endhostent")) return -KEY_endhostent;
4460 if (strEQ(d,"endservent")) return -KEY_endservent;
79072805
LW		 4461 break;
4462 case 11:
a0d0e21e 4463 if (strEQ(d,"endprotoent")) return -KEY_endprotoent;
79072805 4464 break;
a687059c 4465 }
a687059c 4466 break;
79072805
LW		 4467 case 'f':
4468 switch (len) {
4469 case 3:
4470 if (strEQ(d,"for")) return KEY_for;
4471 break;
4472 case 4:
a0d0e21e 4473 if (strEQ(d,"fork")) return -KEY_fork;
79072805
LW		 4474 break;
4475 case 5:
a0d0e21e
LW		 4476 if (strEQ(d,"fcntl")) return -KEY_fcntl;
4477 if (strEQ(d,"flock")) return -KEY_flock;
79072805
LW		 4478 break;
4479 case 6:
4480 if (strEQ(d,"format")) return KEY_format;
a0d0e21e 4481 if (strEQ(d,"fileno")) return -KEY_fileno;
79072805
LW		 4482 break;
4483 case 7:
4484 if (strEQ(d,"foreach")) return KEY_foreach;
4485 break;
4486 case 8:
a0d0e21e 4487 if (strEQ(d,"formline")) return -KEY_formline;
79072805 4488 break;
378cc40b 4489 }
a687059c 4490 break;
79072805
LW		 4491 case 'G':
4492 if (len == 2) {
a0d0e21e
LW		 4493 if (strEQ(d,"GT")) { deprecate(d); return -KEY_gt;}
4494 if (strEQ(d,"GE")) { deprecate(d); return -KEY_ge;}
9f68db38 4495 }
a687059c 4496 break;
79072805 4497 case 'g':
a687059c
LW		 4498 if (strnEQ(d,"get",3)) {
4499 d += 3;
4500 if (*d == 'p') {
79072805
LW		 4501 switch (len) {
4502 case 7:
a0d0e21e
LW		 4503 if (strEQ(d,"ppid")) return -KEY_getppid;
4504 if (strEQ(d,"pgrp")) return -KEY_getpgrp;
79072805
LW		 4505 break;
4506 case 8:
a0d0e21e
LW		 4507 if (strEQ(d,"pwent")) return -KEY_getpwent;
4508 if (strEQ(d,"pwnam")) return -KEY_getpwnam;
4509 if (strEQ(d,"pwuid")) return -KEY_getpwuid;
79072805
LW		 4510 break;
4511 case 11:
a0d0e21e
LW		 4512 if (strEQ(d,"peername")) return -KEY_getpeername;
4513 if (strEQ(d,"protoent")) return -KEY_getprotoent;
4514 if (strEQ(d,"priority")) return -KEY_getpriority;
79072805
LW		 4515 break;
4516 case 14:
a0d0e21e 4517 if (strEQ(d,"protobyname")) return -KEY_getprotobyname;
79072805
LW		 4518 break;
4519 case 16:
a0d0e21e 4520 if (strEQ(d,"protobynumber"))return -KEY_getprotobynumber;
79072805
LW		 4521 break;
4522 }
a687059c
LW		 4523 }
4524 else if (*d == 'h') {
a0d0e21e
LW		 4525 if (strEQ(d,"hostbyname")) return -KEY_gethostbyname;
4526 if (strEQ(d,"hostbyaddr")) return -KEY_gethostbyaddr;
4527 if (strEQ(d,"hostent")) return -KEY_gethostent;
a687059c
LW		 4528 }
4529 else if (*d == 'n') {
a0d0e21e
LW		 4530 if (strEQ(d,"netbyname")) return -KEY_getnetbyname;
4531 if (strEQ(d,"netbyaddr")) return -KEY_getnetbyaddr;
4532 if (strEQ(d,"netent")) return -KEY_getnetent;
a687059c
LW		 4533 }
4534 else if (*d == 's') {
a0d0e21e
LW		 4535 if (strEQ(d,"servbyname")) return -KEY_getservbyname;
4536 if (strEQ(d,"servbyport")) return -KEY_getservbyport;
4537 if (strEQ(d,"servent")) return -KEY_getservent;
4538 if (strEQ(d,"sockname")) return -KEY_getsockname;
4539 if (strEQ(d,"sockopt")) return -KEY_getsockopt;
a687059c
LW		 4540 }
4541 else if (*d == 'g') {
a0d0e21e
LW		 4542 if (strEQ(d,"grent")) return -KEY_getgrent;
4543 if (strEQ(d,"grnam")) return -KEY_getgrnam;
4544 if (strEQ(d,"grgid")) return -KEY_getgrgid;
a687059c
LW		 4545 }
4546 else if (*d == 'l') {
a0d0e21e 4547 if (strEQ(d,"login")) return -KEY_getlogin;
a687059c 4548 }
a0d0e21e 4549 else if (strEQ(d,"c")) return -KEY_getc;
79072805 4550 break;
a687059c 4551 }
79072805
LW		 4552 switch (len) {
4553 case 2:
a0d0e21e
LW		 4554 if (strEQ(d,"gt")) return -KEY_gt;
4555 if (strEQ(d,"ge")) return -KEY_ge;
79072805
LW		 4556 break;
4557 case 4:
4558 if (strEQ(d,"grep")) return KEY_grep;
4559 if (strEQ(d,"goto")) return KEY_goto;
fb73857a 4560 if (strEQ(d,"glob")) return KEY_glob;
79072805
LW		 4561 break;
4562 case 6:
a0d0e21e 4563 if (strEQ(d,"gmtime")) return -KEY_gmtime;
79072805 4564 break;
378cc40b 4565 }
a687059c 4566 break;
79072805 4567 case 'h':
a0d0e21e 4568 if (strEQ(d,"hex")) return -KEY_hex;
a687059c 4569 break;
7d07dbc2
MB		 4570 case 'I':
4571 if (strEQ(d,"INIT")) return KEY_INIT;
4572 break;
79072805
LW		 4573 case 'i':
4574 switch (len) {
4575 case 2:
4576 if (strEQ(d,"if")) return KEY_if;
4577 break;
4578 case 3:
a0d0e21e 4579 if (strEQ(d,"int")) return -KEY_int;
79072805
LW		 4580 break;
4581 case 5:
a0d0e21e
LW		 4582 if (strEQ(d,"index")) return -KEY_index;
4583 if (strEQ(d,"ioctl")) return -KEY_ioctl;
79072805
LW		 4584 break;
4585 }
a687059c 4586 break;
79072805 4587 case 'j':
a0d0e21e 4588 if (strEQ(d,"join")) return -KEY_join;
a687059c 4589 break;
79072805
LW		 4590 case 'k':
4591 if (len == 4) {
4592 if (strEQ(d,"keys")) return KEY_keys;
a0d0e21e 4593 if (strEQ(d,"kill")) return -KEY_kill;
663a0e37 4594 }
79072805
LW		 4595 break;
4596 case 'L':
4597 if (len == 2) {
a0d0e21e
LW		 4598 if (strEQ(d,"LT")) { deprecate(d); return -KEY_lt;}
4599 if (strEQ(d,"LE")) { deprecate(d); return -KEY_le;}
378cc40b 4600 }
79072805
LW		 4601 break;
4602 case 'l':
4603 switch (len) {
4604 case 2:
a0d0e21e
LW		 4605 if (strEQ(d,"lt")) return -KEY_lt;
4606 if (strEQ(d,"le")) return -KEY_le;
4607 if (strEQ(d,"lc")) return -KEY_lc;
79072805
LW		 4608 break;
4609 case 3:
a0d0e21e 4610 if (strEQ(d,"log")) return -KEY_log;
79072805
LW		 4611 break;
4612 case 4:
4613 if (strEQ(d,"last")) return KEY_last;
a0d0e21e 4614 if (strEQ(d,"link")) return -KEY_link;
c0329465 4615 if (strEQ(d,"lock")) return -KEY_lock;
395c3793 4616 break;
79072805
LW		 4617 case 5:
4618 if (strEQ(d,"local")) return KEY_local;
a0d0e21e 4619 if (strEQ(d,"lstat")) return -KEY_lstat;
79072805
LW		 4620 break;
4621 case 6:
a0d0e21e
LW		 4622 if (strEQ(d,"length")) return -KEY_length;
4623 if (strEQ(d,"listen")) return -KEY_listen;
79072805
LW		 4624 break;
4625 case 7:
a0d0e21e 4626 if (strEQ(d,"lcfirst")) return -KEY_lcfirst;
79072805
LW		 4627 break;
4628 case 9:
a0d0e21e 4629 if (strEQ(d,"localtime")) return -KEY_localtime;
395c3793
LW		 4630 break;
4631 }
a687059c 4632 break;
79072805
LW		 4633 case 'm':
4634 switch (len) {
4635 case 1: return KEY_m;
93a17b20
LW		 4636 case 2:
4637 if (strEQ(d,"my")) return KEY_my;
4638 break;
a0d0e21e
LW		 4639 case 3:
4640 if (strEQ(d,"map")) return KEY_map;
4641 break;
79072805 4642 case 5:
a0d0e21e 4643 if (strEQ(d,"mkdir")) return -KEY_mkdir;
79072805
LW		 4644 break;
4645 case 6:
a0d0e21e
LW		 4646 if (strEQ(d,"msgctl")) return -KEY_msgctl;
4647 if (strEQ(d,"msgget")) return -KEY_msgget;
4648 if (strEQ(d,"msgrcv")) return -KEY_msgrcv;
4649 if (strEQ(d,"msgsnd")) return -KEY_msgsnd;
79072805
LW		 4650 break;
4651 }
a687059c 4652 break;
79072805 4653 case 'N':
a0d0e21e 4654 if (strEQ(d,"NE")) { deprecate(d); return -KEY_ne;}
a687059c 4655 break;
79072805
LW		 4656 case 'n':
4657 if (strEQ(d,"next")) return KEY_next;
a0d0e21e
LW		 4658 if (strEQ(d,"ne")) return -KEY_ne;
4659 if (strEQ(d,"not")) return -KEY_not;
4660 if (strEQ(d,"no")) return KEY_no;
a687059c 4661 break;
79072805
LW		 4662 case 'o':
4663 switch (len) {
463ee0b2 4664 case 2:
a0d0e21e 4665 if (strEQ(d,"or")) return -KEY_or;
463ee0b2 4666 break;
79072805 4667 case 3:
a0d0e21e
LW		 4668 if (strEQ(d,"ord")) return -KEY_ord;
4669 if (strEQ(d,"oct")) return -KEY_oct;
72311751 4670 if (strEQ(d,"our")) { deprecate("reserved word \"our\"");
85b81015 4671 return 0;}
79072805
LW		 4672 break;
4673 case 4:
a0d0e21e 4674 if (strEQ(d,"open")) return -KEY_open;
79072805
LW		 4675 break;
4676 case 7:
a0d0e21e 4677 if (strEQ(d,"opendir")) return -KEY_opendir;
79072805 4678 break;
fe14fcc3 4679 }
a687059c 4680 break;
79072805
LW		 4681 case 'p':
4682 switch (len) {
4683 case 3:
4684 if (strEQ(d,"pop")) return KEY_pop;
a0d0e21e 4685 if (strEQ(d,"pos")) return KEY_pos;
79072805
LW		 4686 break;
4687 case 4:
4688 if (strEQ(d,"push")) return KEY_push;
a0d0e21e
LW		 4689 if (strEQ(d,"pack")) return -KEY_pack;
4690 if (strEQ(d,"pipe")) return -KEY_pipe;
79072805
LW		 4691 break;
4692 case 5:
4693 if (strEQ(d,"print")) return KEY_print;
4694 break;
4695 case 6:
4696 if (strEQ(d,"printf")) return KEY_printf;
4697 break;
4698 case 7:
4699 if (strEQ(d,"package")) return KEY_package;
4700 break;
c07a80fd 4701 case 9:
4702 if (strEQ(d,"prototype")) return KEY_prototype;
663a0e37 4703 }
79072805
LW		 4704 break;
4705 case 'q':
4706 if (len <= 2) {
4707 if (strEQ(d,"q")) return KEY_q;
8782bef2 4708 if (strEQ(d,"qr")) return KEY_qr;
79072805 4709 if (strEQ(d,"qq")) return KEY_qq;
8990e307 4710 if (strEQ(d,"qw")) return KEY_qw;
79072805 4711 if (strEQ(d,"qx")) return KEY_qx;
663a0e37 4712 }
a0d0e21e 4713 else if (strEQ(d,"quotemeta")) return -KEY_quotemeta;
79072805
LW		 4714 break;
4715 case 'r':
4716 switch (len) {
4717 case 3:
a0d0e21e 4718 if (strEQ(d,"ref")) return -KEY_ref;
79072805
LW		 4719 break;
4720 case 4:
a0d0e21e
LW		 4721 if (strEQ(d,"read")) return -KEY_read;
4722 if (strEQ(d,"rand")) return -KEY_rand;
4723 if (strEQ(d,"recv")) return -KEY_recv;
79072805
LW		 4724 if (strEQ(d,"redo")) return KEY_redo;
4725 break;
4726 case 5:
a0d0e21e
LW		 4727 if (strEQ(d,"rmdir")) return -KEY_rmdir;
4728 if (strEQ(d,"reset")) return -KEY_reset;
79072805
LW		 4729 break;
4730 case 6:
4731 if (strEQ(d,"return")) return KEY_return;
a0d0e21e
LW		 4732 if (strEQ(d,"rename")) return -KEY_rename;
4733 if (strEQ(d,"rindex")) return -KEY_rindex;
79072805
LW		 4734 break;
4735 case 7:
a0d0e21e
LW		 4736 if (strEQ(d,"require")) return -KEY_require;
4737 if (strEQ(d,"reverse")) return -KEY_reverse;
4738 if (strEQ(d,"readdir")) return -KEY_readdir;
79072805
LW		 4739 break;
4740 case 8:
a0d0e21e
LW		 4741 if (strEQ(d,"readlink")) return -KEY_readlink;
4742 if (strEQ(d,"readline")) return -KEY_readline;
4743 if (strEQ(d,"readpipe")) return -KEY_readpipe;
79072805
LW		 4744 break;
4745 case 9:
a0d0e21e 4746 if (strEQ(d,"rewinddir")) return -KEY_rewinddir;
79072805 4747 break;
a687059c 4748 }
79072805
LW		 4749 break;
4750 case 's':
a687059c 4751 switch (d[1]) {
79072805 4752 case 0: return KEY_s;
a687059c 4753 case 'c':
79072805 4754 if (strEQ(d,"scalar")) return KEY_scalar;
a687059c
LW		 4755 break;
4756 case 'e':
79072805
LW		 4757 switch (len) {
4758 case 4:
a0d0e21e
LW		 4759 if (strEQ(d,"seek")) return -KEY_seek;
4760 if (strEQ(d,"send")) return -KEY_send;
79072805
LW		 4761 break;
4762 case 5:
a0d0e21e 4763 if (strEQ(d,"semop")) return -KEY_semop;
79072805
LW		 4764 break;
4765 case 6:
a0d0e21e
LW		 4766 if (strEQ(d,"select")) return -KEY_select;
4767 if (strEQ(d,"semctl")) return -KEY_semctl;
4768 if (strEQ(d,"semget")) return -KEY_semget;
79072805
LW		 4769 break;
4770 case 7:
a0d0e21e
LW		 4771 if (strEQ(d,"setpgrp")) return -KEY_setpgrp;
4772 if (strEQ(d,"seekdir")) return -KEY_seekdir;
79072805
LW		 4773 break;
4774 case 8:
a0d0e21e
LW		 4775 if (strEQ(d,"setpwent")) return -KEY_setpwent;
4776 if (strEQ(d,"setgrent")) return -KEY_setgrent;
79072805
LW		 4777 break;
4778 case 9:
a0d0e21e 4779 if (strEQ(d,"setnetent")) return -KEY_setnetent;
79072805
LW		 4780 break;
4781 case 10:
a0d0e21e
LW		 4782 if (strEQ(d,"setsockopt")) return -KEY_setsockopt;
4783 if (strEQ(d,"sethostent")) return -KEY_sethostent;
4784 if (strEQ(d,"setservent")) return -KEY_setservent;
79072805
LW		 4785 break;
4786 case 11:
a0d0e21e
LW		 4787 if (strEQ(d,"setpriority")) return -KEY_setpriority;
4788 if (strEQ(d,"setprotoent")) return -KEY_setprotoent;
79072805
LW		 4789 break;
4790 }
a687059c
LW		 4791 break;
4792 case 'h':
79072805
LW		 4793 switch (len) {
4794 case 5:
4795 if (strEQ(d,"shift")) return KEY_shift;
4796 break;
4797 case 6:
a0d0e21e
LW		 4798 if (strEQ(d,"shmctl")) return -KEY_shmctl;
4799 if (strEQ(d,"shmget")) return -KEY_shmget;
79072805
LW		 4800 break;
4801 case 7:
a0d0e21e 4802 if (strEQ(d,"shmread")) return -KEY_shmread;
79072805
LW		 4803 break;
4804 case 8:
a0d0e21e
LW		 4805 if (strEQ(d,"shmwrite")) return -KEY_shmwrite;
4806 if (strEQ(d,"shutdown")) return -KEY_shutdown;
79072805
LW		 4807 break;
4808 }
a687059c
LW		 4809 break;
4810 case 'i':
a0d0e21e 4811 if (strEQ(d,"sin")) return -KEY_sin;
a687059c
LW		 4812 break;
4813 case 'l':
a0d0e21e 4814 if (strEQ(d,"sleep")) return -KEY_sleep;
a687059c
LW		 4815 break;
4816 case 'o':
79072805 4817 if (strEQ(d,"sort")) return KEY_sort;
a0d0e21e
LW		 4818 if (strEQ(d,"socket")) return -KEY_socket;
4819 if (strEQ(d,"socketpair")) return -KEY_socketpair;
a687059c
LW		 4820 break;
4821 case 'p':
79072805 4822 if (strEQ(d,"split")) return KEY_split;
a0d0e21e 4823 if (strEQ(d,"sprintf")) return -KEY_sprintf;
79072805 4824 if (strEQ(d,"splice")) return KEY_splice;
a687059c
LW		 4825 break;
4826 case 'q':
a0d0e21e 4827 if (strEQ(d,"sqrt")) return -KEY_sqrt;
a687059c
LW		 4828 break;
4829 case 'r':
a0d0e21e 4830 if (strEQ(d,"srand")) return -KEY_srand;
a687059c
LW		 4831 break;
4832 case 't':
a0d0e21e 4833 if (strEQ(d,"stat")) return -KEY_stat;
79072805 4834 if (strEQ(d,"study")) return KEY_study;
a687059c
LW		 4835 break;
4836 case 'u':
a0d0e21e 4837 if (strEQ(d,"substr")) return -KEY_substr;
79072805 4838 if (strEQ(d,"sub")) return KEY_sub;
a687059c
LW		 4839 break;
4840 case 'y':
79072805
LW		 4841 switch (len) {
4842 case 6:
a0d0e21e 4843 if (strEQ(d,"system")) return -KEY_system;
79072805
LW		 4844 break;
4845 case 7:
a0d0e21e
LW		 4846 if (strEQ(d,"symlink")) return -KEY_symlink;
4847 if (strEQ(d,"syscall")) return -KEY_syscall;
137443ea 4848 if (strEQ(d,"sysopen")) return -KEY_sysopen;
4849 if (strEQ(d,"sysread")) return -KEY_sysread;
4850 if (strEQ(d,"sysseek")) return -KEY_sysseek;
79072805
LW		 4851 break;
4852 case 8:
a0d0e21e 4853 if (strEQ(d,"syswrite")) return -KEY_syswrite;
79072805 4854 break;
a687059c 4855 }
a687059c
LW		 4856 break;
4857 }
4858 break;
79072805
LW		 4859 case 't':
4860 switch (len) {
4861 case 2:
4862 if (strEQ(d,"tr")) return KEY_tr;
4863 break;
463ee0b2
LW		 4864 case 3:
4865 if (strEQ(d,"tie")) return KEY_tie;
4866 break;
79072805 4867 case 4:
a0d0e21e 4868 if (strEQ(d,"tell")) return -KEY_tell;
c07a80fd 4869 if (strEQ(d,"tied")) return KEY_tied;
a0d0e21e 4870 if (strEQ(d,"time")) return -KEY_time;
79072805
LW		 4871 break;
4872 case 5:
a0d0e21e 4873 if (strEQ(d,"times")) return -KEY_times;
79072805
LW		 4874 break;
4875 case 7:
a0d0e21e 4876 if (strEQ(d,"telldir")) return -KEY_telldir;
79072805
LW		 4877 break;
4878 case 8:
a0d0e21e 4879 if (strEQ(d,"truncate")) return -KEY_truncate;
79072805 4880 break;
378cc40b 4881 }
a687059c 4882 break;
79072805
LW		 4883 case 'u':
4884 switch (len) {
4885 case 2:
a0d0e21e
LW		 4886 if (strEQ(d,"uc")) return -KEY_uc;
4887 break;
4888 case 3:
4889 if (strEQ(d,"use")) return KEY_use;
79072805
LW		 4890 break;
4891 case 5:
4892 if (strEQ(d,"undef")) return KEY_undef;
4893 if (strEQ(d,"until")) return KEY_until;
463ee0b2 4894 if (strEQ(d,"untie")) return KEY_untie;
a0d0e21e
LW		 4895 if (strEQ(d,"utime")) return -KEY_utime;
4896 if (strEQ(d,"umask")) return -KEY_umask;
79072805
LW		 4897 break;
4898 case 6:
4899 if (strEQ(d,"unless")) return KEY_unless;
a0d0e21e
LW		 4900 if (strEQ(d,"unpack")) return -KEY_unpack;
4901 if (strEQ(d,"unlink")) return -KEY_unlink;
79072805
LW		 4902 break;
4903 case 7:
4904 if (strEQ(d,"unshift")) return KEY_unshift;
a0d0e21e 4905 if (strEQ(d,"ucfirst")) return -KEY_ucfirst;
79072805 4906 break;
a687059c
LW		 4907 }
4908 break;
79072805 4909 case 'v':
a0d0e21e
LW		 4910 if (strEQ(d,"values")) return -KEY_values;
4911 if (strEQ(d,"vec")) return -KEY_vec;
a687059c 4912 break;
79072805
LW		 4913 case 'w':
4914 switch (len) {
4915 case 4:
a0d0e21e
LW		 4916 if (strEQ(d,"warn")) return -KEY_warn;
4917 if (strEQ(d,"wait")) return -KEY_wait;
79072805
LW		 4918 break;
4919 case 5:
4920 if (strEQ(d,"while")) return KEY_while;
a0d0e21e 4921 if (strEQ(d,"write")) return -KEY_write;
79072805
LW		 4922 break;
4923 case 7:
a0d0e21e 4924 if (strEQ(d,"waitpid")) return -KEY_waitpid;
79072805
LW		 4925 break;
4926 case 9:
a0d0e21e 4927 if (strEQ(d,"wantarray")) return -KEY_wantarray;
79072805 4928 break;
2f3197b3 4929 }
a687059c 4930 break;
79072805 4931 case 'x':
a0d0e21e
LW		 4932 if (len == 1) return -KEY_x;
4933 if (strEQ(d,"xor")) return -KEY_xor;
a687059c 4934 break;
79072805
LW		 4935 case 'y':
4936 if (len == 1) return KEY_y;
4937 break;
4938 case 'z':
a687059c
LW		 4939 break;
4940 }
79072805 4941 return 0;
a687059c
LW		 4942}
4943
76e3520e 4944STATIC void
8ac85365 4945checkcomma(register char *s, char *name, char *what)
a687059c 4946{
2f3197b3
LW		 4947 char *w;
4948
d008e5eb
GS		 4949 if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */
4950 dTHR; /* only for ckWARN */
4951 if (ckWARN(WARN_SYNTAX)) {
4952 int level = 1;
4953 for (w = s+2; *w && level; w++) {
4954 if (*w == '(')
4955 ++level;
4956 else if (*w == ')')
4957 --level;
4958 }
4959 if (*w)
4960 for (; *w && isSPACE(*w); w++) ;
4961 if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */
4962 warner(WARN_SYNTAX, "%s (...) interpreted as function",name);
4963 }
2f3197b3 4964 }
3280af22 4965 while (s < PL_bufend && isSPACE(*s))
2f3197b3 4966 s++;
a687059c
LW		 4967 if (*s == '(')
4968 s++;
3280af22 4969 while (s < PL_bufend && isSPACE(*s))
a687059c 4970 s++;
834a4ddd 4971 if (isIDFIRST_lazy(s)) {
2f3197b3 4972 w = s++;
834a4ddd 4973 while (isALNUM_lazy(s))
a687059c 4974 s++;
3280af22 4975 while (s < PL_bufend && isSPACE(*s))
a687059c 4976 s++;
e929a76b 4977 if (*s == ',') {
463ee0b2 4978 int kw;
e929a76b 4979 *s = '\0';
4633a7c4 4980 kw = keyword(w, s - w) || perl_get_cv(w, FALSE) != 0;
e929a76b 4981 *s = ',';
463ee0b2 4982 if (kw)
e929a76b 4983 return;
463ee0b2
LW		 4984 croak("No comma allowed after %s", what);
4985 }
4986 }
4987}
4988
b3ac6de7
IZ		 4989STATIC SV *
4990new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
4991{
b3ac6de7 4992 dSP;
3280af22 4993 HV *table = GvHV(PL_hintgv); /* ^H */
b3ac6de7
IZ		 4994 BINOP myop;
4995 SV *res;
4996 bool oldcatch = CATCH_GET;
4997 SV **cvp;
4998 SV *cv, *typesv;
b3ac6de7
IZ		 4999
5000 if (!table) {
5001 yyerror("%^H is not defined");
5002 return sv;
5003 }
5004 cvp = hv_fetch(table, key, strlen(key), FALSE);
5005 if (!cvp || !SvOK(*cvp)) {
a30ac152 5006 char buf[128];
b3ac6de7
IZ		 5007 sprintf(buf,"$^H{%s} is not defined", key);
5008 yyerror(buf);
5009 return sv;
5010 }
5011 sv_2mortal(sv); /* Parent created it permanently */
5012 cv = *cvp;
5013 if (!pv)
79cb57f6 5014 pv = sv_2mortal(newSVpvn(s, len));
b3ac6de7
IZ		 5015 if (type)
5016 typesv = sv_2mortal(newSVpv(type, 0));
5017 else
3280af22 5018 typesv = &PL_sv_undef;
b3ac6de7
IZ		 5019 CATCH_SET(TRUE);
5020 Zero(&myop, 1, BINOP);
5021 myop.op_last = (OP *) &myop;
5022 myop.op_next = Nullop;
5023 myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
5024
e788e7d3 5025 PUSHSTACKi(PERLSI_OVERLOAD);
b3ac6de7
IZ		 5026 ENTER;
5027 SAVEOP();
533c011a 5028 PL_op = (OP *) &myop;
3280af22 5029 if (PERLDB_SUB && PL_curstash != PL_debstash)
533c011a 5030 PL_op->op_private |= OPpENTERSUB_DB;
b3ac6de7
IZ		 5031 PUTBACK;
5032 pp_pushmark(ARGS);
5033
25eaa213 5034 EXTEND(sp, 4);
b3ac6de7
IZ		 5035 PUSHs(pv);
5036 PUSHs(sv);
5037 PUSHs(typesv);
5038 PUSHs(cv);
5039 PUTBACK;
5040
533c011a 5041 if (PL_op = pp_entersub(ARGS))
b3ac6de7
IZ		 5042 CALLRUNOPS();
5043 LEAVE;
5044 SPAGAIN;
5045
5046 res = POPs;
5047 PUTBACK;
5048 CATCH_SET(oldcatch);
5049 POPSTACK;
5050
5051 if (!SvOK(res)) {
a30ac152 5052 char buf[128];
b3ac6de7
IZ		 5053 sprintf(buf,"Call to &{$^H{%s}} did not return a defined value", key);
5054 yyerror(buf);
5055 }
5056 return SvREFCNT_inc(res);
5057}
5058
76e3520e 5059STATIC char *
8ac85365 5060scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
463ee0b2
LW		 5061{
5062 register char *d = dest;
8903cb82 5063 register char *e = d + destlen - 3; /* two-character token, ending NUL */
463ee0b2 5064 for (;;) {
8903cb82 5065 if (d >= e)
fc36a67e 5066 croak(ident_too_long);
834a4ddd 5067 if (isALNUM(*s)) /* UTF handled below */
463ee0b2 5068 *d++ = *s++;
834a4ddd 5069 else if (*s == '\'' && allow_package && isIDFIRST_lazy(s+1)) {
463ee0b2
LW		 5070 *d++ = ':';
5071 *d++ = ':';
5072 s++;
5073 }
c3e0f903 5074 else if (*s == ':' && s[1] == ':' && allow_package && s[2] != '$') {
463ee0b2
LW		 5075 *d++ = *s++;
5076 *d++ = *s++;
5077 }
834a4ddd 5078 else if (UTF && *(U8*)s >= 0xc0 && isALNUM_utf8((U8*)s)) {
a0ed51b3 5079 char *t = s + UTF8SKIP(s);
dfe13c55 5080 while (*t & 0x80 && is_utf8_mark((U8*)t))
a0ed51b3
LW		 5081 t += UTF8SKIP(t);
5082 if (d + (t - s) > e)
5083 croak(ident_too_long);
5084 Copy(s, d, t - s, char);
5085 d += t - s;
5086 s = t;
5087 }
463ee0b2
LW		 5088 else {
5089 *d = '\0';
5090 *slp = d - dest;
5091 return s;
e929a76b 5092 }
378cc40b
LW		 5093 }
5094}
5095
76e3520e 5096STATIC char *
8ac85365 5097scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni)
378cc40b
LW		 5098{
5099 register char *d;
8903cb82 5100 register char *e;
79072805 5101 char *bracket = 0;
748a9306 5102 char funny = *s++;
378cc40b 5103
3280af22
NIS		 5104 if (PL_lex_brackets == 0)
5105 PL_lex_fakebrack = 0;
a0d0e21e
LW		 5106 if (isSPACE(*s))
5107 s = skipspace(s);
378cc40b 5108 d = dest;
8903cb82 5109 e = d + destlen - 3; /* two-character token, ending NUL */
de3bb511 5110 if (isDIGIT(*s)) {
8903cb82 5111 while (isDIGIT(*s)) {
5112 if (d >= e)
fc36a67e 5113 croak(ident_too_long);
378cc40b 5114 *d++ = *s++;
8903cb82 5115 }
378cc40b
LW		 5116 }
5117 else {
463ee0b2 5118 for (;;) {
8903cb82 5119 if (d >= e)
fc36a67e 5120 croak(ident_too_long);
834a4ddd 5121 if (isALNUM(*s)) /* UTF handled below */
463ee0b2 5122 *d++ = *s++;
834a4ddd 5123 else if (*s == '\'' && isIDFIRST_lazy(s+1)) {
463ee0b2
LW		 5124 *d++ = ':';
5125 *d++ = ':';
5126 s++;
5127 }
a0d0e21e 5128 else if (*s == ':' && s[1] == ':') {
463ee0b2
LW		 5129 *d++ = *s++;
5130 *d++ = *s++;
5131 }
834a4ddd 5132 else if (UTF && *(U8*)s >= 0xc0 && isALNUM_utf8((U8*)s)) {
a0ed51b3 5133 char *t = s + UTF8SKIP(s);
dfe13c55 5134 while (*t & 0x80 && is_utf8_mark((U8*)t))
a0ed51b3
LW		 5135 t += UTF8SKIP(t);
5136 if (d + (t - s) > e)
5137 croak(ident_too_long);
5138 Copy(s, d, t - s, char);
5139 d += t - s;
5140 s = t;
5141 }
463ee0b2
LW		 5142 else
5143 break;
5144 }
378cc40b
LW		 5145 }
5146 *d = '\0';
5147 d = dest;
79072805 5148 if (*d) {
3280af22
NIS		 5149 if (PL_lex_state != LEX_NORMAL)
5150 PL_lex_state = LEX_INTERPENDMAYBE;
79072805 5151 return s;
378cc40b 5152 }
748a9306 5153 if (*s == '$' && s[1] &&
834a4ddd 5154 (isALNUM_lazy(s+1) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
5cd24f17 5155 {
4810e5ec 5156 return s;
5cd24f17 5157 }
79072805
LW		 5158 if (*s == '{') {
5159 bracket = s;
5160 s++;
5161 }
5162 else if (ck_uni)
5163 check_uni();
93a17b20 5164 if (s < send)
79072805
LW		 5165 *d = *s++;
5166 d[1] = '\0';
2b92dfce 5167 if (*d == '^' && *s && isCONTROLVAR(*s)) {
bbce6d69 5168 *d = toCTRL(*s);
5169 s++;
de3bb511 5170 }
79072805 5171 if (bracket) {
748a9306 5172 if (isSPACE(s[-1])) {
fa83b5b6 5173 while (s < send) {
5174 char ch = *s++;
5175 if (ch != ' ' && ch != '\t') {
5176 *d = ch;
5177 break;
5178 }
5179 }
748a9306 5180 }
834a4ddd 5181 if (isIDFIRST_lazy(d)) {
79072805 5182 d++;
a0ed51b3
LW		 5183 if (UTF) {
5184 e = s;
834a4ddd 5185 while (e < send && isALNUM_lazy(e) || *e == ':') {
a0ed51b3 5186 e += UTF8SKIP(e);
dfe13c55 5187 while (e < send && *e & 0x80 && is_utf8_mark((U8*)e))
a0ed51b3
LW		 5188 e += UTF8SKIP(e);
5189 }
5190 Copy(s, d, e - s, char);
5191 d += e - s;
5192 s = e;
5193 }
5194 else {
2b92dfce 5195 while ((isALNUM(*s) || *s == ':') && d < e)
a0ed51b3 5196 *d++ = *s++;
2b92dfce
GS		 5197 if (d >= e)
5198 croak(ident_too_long);
a0ed51b3 5199 }
79072805 5200 *d = '\0';
748a9306 5201 while (s < send && (*s == ' ' || *s == '\t')) s++;
ff68c719 5202 if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
d008e5eb 5203 dTHR; /* only for ckWARN */
599cee73 5204 if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
748a9306 5205 char *brack = *s == '[' ? "[...]" : "{...}";
599cee73
PM		 5206 warner(WARN_AMBIGUOUS,
5207 "Ambiguous use of %c{%s%s} resolved to %c%s%s",
748a9306
LW		 5208 funny, dest, brack, funny, dest, brack);
5209 }
3280af22 5210 PL_lex_fakebrack = PL_lex_brackets+1;
79072805 5211 bracket++;
3280af22 5212 PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
79072805
LW		 5213 return s;
5214 }
2b92dfce
GS		 5215 }
5216 /* Handle extended ${^Foo} variables
5217 * 1999-02-27 mjd-perl-patch@plover.com */
5218 else if (!isALNUM(*d) && !isPRINT(*d) /* isCTRL(d) */
5219 && isALNUM(*s))
5220 {
5221 d++;
5222 while (isALNUM(*s) && d < e) {
5223 *d++ = *s++;
5224 }
5225 if (d >= e)
5226 croak(ident_too_long);
5227 *d = '\0';
79072805
LW		 5228 }
5229 if (*s == '}') {
5230 s++;
3280af22
NIS		 5231 if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets)
5232 PL_lex_state = LEX_INTERPEND;
748a9306
LW		 5233 if (funny == '#')
5234 funny = '@';
d008e5eb
GS		 5235 if (PL_lex_state == LEX_NORMAL) {
5236 dTHR; /* only for ckWARN */
5237 if (ckWARN(WARN_AMBIGUOUS) &&
5238 (keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
5239 {
5240 warner(WARN_AMBIGUOUS,
5241 "Ambiguous use of %c{%s} resolved to %c%s",
5242 funny, dest, funny, dest);
5243 }
5244 }
79072805
LW		 5245 }
5246 else {
5247 s = bracket; /* let the parser handle it */
93a17b20 5248 *dest = '\0';
79072805
LW		 5249 }
5250 }
3280af22
NIS		 5251 else if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets && !intuit_more(s))
5252 PL_lex_state = LEX_INTERPEND;
378cc40b
LW		 5253 return s;
5254}
5255
8ac85365 5256void pmflag(U16 *pmfl, int ch)
a0d0e21e 5257{
bbce6d69 5258 if (ch == 'i')
a0d0e21e 5259 *pmfl |= PMf_FOLD;
a0d0e21e
LW		 5260 else if (ch == 'g')
5261 *pmfl |= PMf_GLOBAL;
c90c0ff4 5262 else if (ch == 'c')
5263 *pmfl |= PMf_CONTINUE;
a0d0e21e
LW		 5264 else if (ch == 'o')
5265 *pmfl |= PMf_KEEP;
5266 else if (ch == 'm')
5267 *pmfl |= PMf_MULTILINE;
5268 else if (ch == 's')
5269 *pmfl |= PMf_SINGLELINE;
5270 else if (ch == 'x')
5271 *pmfl |= PMf_EXTENDED;
5272}
378cc40b 5273
76e3520e 5274STATIC char *
8782bef2 5275scan_pat(char *start, I32 type)
378cc40b 5276{
79072805
LW		 5277 PMOP *pm;
5278 char *s;
378cc40b 5279
79072805
LW		 5280 s = scan_str(start);
5281 if (!s) {
3280af22
NIS		 5282 if (PL_lex_stuff)
5283 SvREFCNT_dec(PL_lex_stuff);
5284 PL_lex_stuff = Nullsv;
463ee0b2 5285 croak("Search pattern not terminated");
378cc40b 5286 }
bbce6d69 5287
8782bef2 5288 pm = (PMOP*)newPMOP(type, 0);
3280af22 5289 if (PL_multi_open == '?')
79072805 5290 pm->op_pmflags |= PMf_ONCE;
8782bef2
GB		 5291 if(type == OP_QR) {
5292 while (*s && strchr("iomsx", *s))
5293 pmflag(&pm->op_pmflags,*s++);
5294 }
5295 else {
5296 while (*s && strchr("iogcmsx", *s))
5297 pmflag(&pm->op_pmflags,*s++);
5298 }
4633a7c4 5299 pm->op_pmpermflags = pm->op_pmflags;
bbce6d69 5300
3280af22 5301 PL_lex_op = (OP*)pm;
79072805 5302 yylval.ival = OP_MATCH;
378cc40b
LW		 5303 return s;
5304}
5305
76e3520e 5306STATIC char *
8ac85365 5307scan_subst(char *start)
79072805 5308{
a0d0e21e 5309 register char *s;
79072805 5310 register PMOP *pm;
4fdae800 5311 I32 first_start;
79072805
LW		 5312 I32 es = 0;
5313
79072805
LW		 5314 yylval.ival = OP_NULL;
5315
a0d0e21e 5316 s = scan_str(start);
79072805
LW		 5317
5318 if (!s) {
3280af22
NIS		 5319 if (PL_lex_stuff)
5320 SvREFCNT_dec(PL_lex_stuff);
5321 PL_lex_stuff = Nullsv;
463ee0b2 5322 croak("Substitution pattern not terminated");
a687059c 5323 }
79072805 5324
3280af22 5325 if (s[-1] == PL_multi_open)
79072805
LW		 5326 s--;
5327
3280af22 5328 first_start = PL_multi_start;
79072805
LW		 5329 s = scan_str(s);
5330 if (!s) {
3280af22
NIS		 5331 if (PL_lex_stuff)
5332 SvREFCNT_dec(PL_lex_stuff);
5333 PL_lex_stuff = Nullsv;
5334 if (PL_lex_repl)
5335 SvREFCNT_dec(PL_lex_repl);
5336 PL_lex_repl = Nullsv;
463ee0b2 5337 croak("Substitution replacement not terminated");
a687059c 5338 }
3280af22 5339 PL_multi_start = first_start; /* so whole substitution is taken together */
2f3197b3 5340
79072805 5341 pm = (PMOP*)newPMOP(OP_SUBST, 0);
48c036b1 5342 while (*s) {
a687059c
LW		 5343 if (*s == 'e') {
5344 s++;
2f3197b3 5345 es++;
a687059c 5346 }
b3eb6a9b 5347 else if (strchr("iogcmsx", *s))
a0d0e21e 5348 pmflag(&pm->op_pmflags,*s++);
48c036b1
GS		 5349 else
5350 break;
378cc40b 5351 }
79072805
LW		 5352
5353 if (es) {
5354 SV *repl;
0244c3a4
GS		 5355 PL_sublex_info.super_bufptr = s;
5356 PL_sublex_info.super_bufend = PL_bufend;
5357 PL_multi_end = 0;
79072805 5358 pm->op_pmflags |= PMf_EVAL;
79cb57f6 5359 repl = newSVpvn("",0);
463ee0b2 5360 while (es-- > 0)
a0d0e21e 5361 sv_catpv(repl, es ? "eval " : "do ");
79072805 5362 sv_catpvn(repl, "{ ", 2);
3280af22 5363 sv_catsv(repl, PL_lex_repl);
79072805
LW		 5364 sv_catpvn(repl, " };", 2);
5365 SvCOMPILED_on(repl);
3280af22
NIS		 5366 SvREFCNT_dec(PL_lex_repl);
5367 PL_lex_repl = repl;
378cc40b 5368 }
79072805 5369
4633a7c4 5370 pm->op_pmpermflags = pm->op_pmflags;
3280af22 5371 PL_lex_op = (OP*)pm;
79072805 5372 yylval.ival = OP_SUBST;
378cc40b
LW		 5373 return s;
5374}
5375
76e3520e 5376STATIC char *
8ac85365 5377scan_trans(char *start)
378cc40b 5378{
a0d0e21e 5379 register char* s;
11343788 5380 OP *o;
79072805
LW		 5381 short *tbl;
5382 I32 squash;
a0ed51b3 5383 I32 del;
79072805 5384 I32 complement;
a0ed51b3
LW		 5385 I32 utf8;
5386 I32 count = 0;
79072805
LW		 5387
5388 yylval.ival = OP_NULL;
5389
a0d0e21e 5390 s = scan_str(start);
79072805 5391 if (!s) {
3280af22
NIS		 5392 if (PL_lex_stuff)
5393 SvREFCNT_dec(PL_lex_stuff);
5394 PL_lex_stuff = Nullsv;
2c268ad5 5395 croak("Transliteration pattern not terminated");
a687059c 5396 }
3280af22 5397 if (s[-1] == PL_multi_open)
2f3197b3
LW		 5398 s--;
5399
93a17b20 5400 s = scan_str(s);
79072805 5401 if (!s) {
3280af22
NIS		 5402 if (PL_lex_stuff)
5403 SvREFCNT_dec(PL_lex_stuff);
5404 PL_lex_stuff = Nullsv;
5405 if (PL_lex_repl)
5406 SvREFCNT_dec(PL_lex_repl);
5407 PL_lex_repl = Nullsv;
2c268ad5 5408 croak("Transliteration replacement not terminated");
a687059c 5409 }
79072805 5410
a0ed51b3
LW		 5411 if (UTF) {
5412 o = newSVOP(OP_TRANS, 0, 0);
5413 utf8 = OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF;
5414 }
5415 else {
5416 New(803,tbl,256,short);
5417 o = newPVOP(OP_TRANS, 0, (char*)tbl);
5418 utf8 = 0;
5419 }
2f3197b3 5420
a0ed51b3
LW		 5421 complement = del = squash = 0;
5422 while (strchr("cdsCU", *s)) {
395c3793 5423 if (*s == 'c')
79072805 5424 complement = OPpTRANS_COMPLEMENT;
395c3793 5425 else if (*s == 'd')
a0ed51b3
LW		 5426 del = OPpTRANS_DELETE;
5427 else if (*s == 's')
79072805 5428 squash = OPpTRANS_SQUASH;
a0ed51b3
LW		 5429 else {
5430 switch (count++) {
5431 case 0:
5432 if (*s == 'C')
5433 utf8 &= ~OPpTRANS_FROM_UTF;
5434 else
5435 utf8 |= OPpTRANS_FROM_UTF;
5436 break;
5437 case 1:
5438 if (*s == 'C')
5439 utf8 &= ~OPpTRANS_TO_UTF;
5440 else
5441 utf8 |= OPpTRANS_TO_UTF;
5442 break;
5443 default:
5444 croak("Too many /C and /U options");
5445 }
5446 }
395c3793
LW		 5447 s++;
5448 }
a0ed51b3 5449 o->op_private = del|squash|complement|utf8;
79072805 5450
3280af22 5451 PL_lex_op = o;
79072805
LW		 5452 yylval.ival = OP_TRANS;
5453 return s;
5454}
5455
76e3520e 5456STATIC char *
8ac85365 5457scan_heredoc(register char *s)
79072805 5458{
11343788 5459 dTHR;
79072805
LW		 5460 SV *herewas;
5461 I32 op_type = OP_SCALAR;
5462 I32 len;
5463 SV *tmpstr;
5464 char term;
5465 register char *d;
fc36a67e 5466 register char *e;
4633a7c4 5467 char *peek;
3280af22 5468 int outer = (PL_rsfp && !(PL_lex_inwhat == OP_SCALAR));
79072805
LW		 5469
5470 s += 2;
3280af22
NIS		 5471 d = PL_tokenbuf;
5472 e = PL_tokenbuf + sizeof PL_tokenbuf - 1;
fd2d0953 5473 if (!outer)
79072805 5474 *d++ = '\n';
4633a7c4
LW		 5475 for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
5476 if (*peek && strchr("`'\"",*peek)) {
5477 s = peek;
79072805 5478 term = *s++;
3280af22 5479 s = delimcpy(d, e, s, PL_bufend, term, &len);
fc36a67e 5480 d += len;
3280af22 5481 if (s < PL_bufend)
79072805 5482 s++;
79072805
LW		 5483 }
5484 else {
5485 if (*s == '\\')
5486 s++, term = '\'';
5487 else
5488 term = '"';
834a4ddd 5489 if (!isALNUM_lazy(s))
4633a7c4 5490 deprecate("bare << to mean <<\"\"");
834a4ddd 5491 for (; isALNUM_lazy(s); s++) {
fc36a67e 5492 if (d < e)
5493 *d++ = *s;
5494 }
5495 }
3280af22 5496 if (d >= PL_tokenbuf + sizeof PL_tokenbuf - 1)
fc36a67e 5497 croak("Delimiter for here document is too long");
79072805
LW		 5498 *d++ = '\n';
5499 *d = '\0';
3280af22 5500 len = d - PL_tokenbuf;
6a27c188 5501#ifndef PERL_STRICT_CR
f63a84b2
LW		 5502 d = strchr(s, '\r');
5503 if (d) {
5504 char *olds = s;
5505 s = d;
3280af22 5506 while (s < PL_bufend) {
f63a84b2
LW		 5507 if (*s == '\r') {
5508 *d++ = '\n';
5509 if (*++s == '\n')
5510 s++;
5511 }
5512 else if (*s == '\n' && s[1] == '\r') { /* \015\013 on a mac? */
5513 *d++ = *s++;
5514 s++;
5515 }
5516 else
5517 *d++ = *s++;
5518 }
5519 *d = '\0';
3280af22
NIS		 5520 PL_bufend = d;
5521 SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr));
f63a84b2
LW		 5522 s = olds;
5523 }
5524#endif
79072805 5525 d = "\n";
3280af22 5526 if (outer || !(d=ninstr(s,PL_bufend,d,d+1)))
79cb57f6 5527 herewas = newSVpvn(s,PL_bufend-s);
79072805 5528 else
79cb57f6 5529 s--, herewas = newSVpvn(s,d-s);
79072805 5530 s += SvCUR(herewas);
748a9306 5531
8d6dde3e 5532 tmpstr = NEWSV(87,79);
748a9306
LW		 5533 sv_upgrade(tmpstr, SVt_PVIV);
5534 if (term == '\'') {
79072805 5535 op_type = OP_CONST;
748a9306
LW		 5536 SvIVX(tmpstr) = -1;
5537 }
5538 else if (term == '`') {
79072805 5539 op_type = OP_BACKTICK;
748a9306
LW		 5540 SvIVX(tmpstr) = '\\';
5541 }
79072805
LW		 5542
5543 CLINE;
3280af22
NIS		 5544 PL_multi_start = PL_curcop->cop_line;
5545 PL_multi_open = PL_multi_close = '<';
5546 term = *PL_tokenbuf;
0244c3a4
GS		 5547 if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
5548 char *bufptr = PL_sublex_info.super_bufptr;
5549 char *bufend = PL_sublex_info.super_bufend;
5550 char *olds = s - SvCUR(herewas);
5551 s = strchr(bufptr, '\n');
5552 if (!s)
5553 s = bufend;
5554 d = s;
5555 while (s < bufend &&
5556 (*s != term || memNE(s,PL_tokenbuf,len)) ) {
5557 if (*s++ == '\n')
5558 PL_curcop->cop_line++;
5559 }
5560 if (s >= bufend) {
5561 PL_curcop->cop_line = PL_multi_start;
5562 missingterm(PL_tokenbuf);
5563 }
5564 sv_setpvn(herewas,bufptr,d-bufptr+1);
5565 sv_setpvn(tmpstr,d+1,s-d);
5566 s += len - 1;
5567 sv_catpvn(herewas,s,bufend-s);
5568 (void)strcpy(bufptr,SvPVX(herewas));
5569
5570 s = olds;
5571 goto retval;
5572 }
5573 else if (!outer) {
79072805 5574 d = s;
3280af22
NIS		 5575 while (s < PL_bufend &&
5576 (*s != term || memNE(s,PL_tokenbuf,len)) ) {
79072805 5577 if (*s++ == '\n')
3280af22 5578 PL_curcop->cop_line++;
79072805 5579 }
3280af22
NIS		 5580 if (s >= PL_bufend) {
5581 PL_curcop->cop_line = PL_multi_start;
5582 missingterm(PL_tokenbuf);
79072805
LW		 5583 }
5584 sv_setpvn(tmpstr,d+1,s-d);
5585 s += len - 1;
3280af22 5586 PL_curcop->cop_line++; /* the preceding stmt passes a newline */
49d8d3a1 5587
3280af22
NIS		 5588 sv_catpvn(herewas,s,PL_bufend-s);
5589 sv_setsv(PL_linestr,herewas);
5590 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
5591 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
79072805
LW		 5592 }
5593 else
5594 sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */
3280af22 5595 while (s >= PL_bufend) { /* multiple line string? */
fd2d0953 5596 if (!outer ||
3280af22
NIS		 5597 !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
5598 PL_curcop->cop_line = PL_multi_start;
5599 missingterm(PL_tokenbuf);
79072805 5600 }
3280af22
NIS		 5601 PL_curcop->cop_line++;
5602 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
6a27c188 5603#ifndef PERL_STRICT_CR
3280af22 5604 if (PL_bufend - PL_linestart >= 2) {
a1529941
NIS		 5605 if ((PL_bufend[-2] == '\r' && PL_bufend[-1] == '\n') ||
5606 (PL_bufend[-2] == '\n' && PL_bufend[-1] == '\r'))
c6f14548 5607 {
3280af22
NIS		 5608 PL_bufend[-2] = '\n';
5609 PL_bufend--;
5610 SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr));
f63a84b2 5611 }
3280af22
NIS		 5612 else if (PL_bufend[-1] == '\r')
5613 PL_bufend[-1] = '\n';
f63a84b2 5614 }
3280af22
NIS		 5615 else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
5616 PL_bufend[-1] = '\n';
f63a84b2 5617#endif
3280af22 5618 if (PERLDB_LINE && PL_curstash != PL_debstash) {
79072805
LW		 5619 SV *sv = NEWSV(88,0);
5620
93a17b20 5621 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 5622 sv_setsv(sv,PL_linestr);
5623 av_store(GvAV(PL_curcop->cop_filegv),
5624 (I32)PL_curcop->cop_line,sv);
79072805 5625 }
3280af22
NIS		 5626 if (*s == term && memEQ(s,PL_tokenbuf,len)) {
5627 s = PL_bufend - 1;
79072805 5628 *s = ' ';
3280af22
NIS		 5629 sv_catsv(PL_linestr,herewas);
5630 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
79072805
LW		 5631 }
5632 else {
3280af22
NIS		 5633 s = PL_bufend;
5634 sv_catsv(tmpstr,PL_linestr);
395c3793
LW		 5635 }
5636 }
79072805 5637 s++;
0244c3a4
GS		 5638retval:
5639 PL_multi_end = PL_curcop->cop_line;
79072805
LW		 5640 if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
5641 SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
463ee0b2 5642 Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
79072805 5643 }
8990e307 5644 SvREFCNT_dec(herewas);
3280af22 5645 PL_lex_stuff = tmpstr;
79072805
LW		 5646 yylval.ival = op_type;
5647 return s;
5648}
5649
02aa26ce
NT		 5650/* scan_inputsymbol
5651 takes: current position in input buffer
5652 returns: new position in input buffer
5653 side-effects: yylval and lex_op are set.
5654
5655 This code handles:
5656
5657 <> read from ARGV
5658 <FH> read from filehandle
5659 <pkg::FH> read from package qualified filehandle
5660 <pkg'FH> read from package qualified filehandle
5661 <$fh> read from filehandle in $fh
5662 <*.h> filename glob
5663
5664*/
5665
76e3520e 5666STATIC char *
8ac85365 5667scan_inputsymbol(char *start)
79072805 5668{
02aa26ce 5669 register char *s = start; /* current position in buffer */
79072805 5670 register char *d;
fc36a67e 5671 register char *e;
79072805
LW		 5672 I32 len;
5673
3280af22
NIS		 5674 d = PL_tokenbuf; /* start of temp holding space */
5675 e = PL_tokenbuf + sizeof PL_tokenbuf; /* end of temp holding space */
5676 s = delimcpy(d, e, s + 1, PL_bufend, '>', &len); /* extract until > */
02aa26ce
NT		 5677
5678 /* die if we didn't have space for the contents of the <>,
5679 or if it didn't end
5680 */
5681
3280af22 5682 if (len >= sizeof PL_tokenbuf)
fc36a67e 5683 croak("Excessively long <> operator");
3280af22 5684 if (s >= PL_bufend)
463ee0b2 5685 croak("Unterminated <> operator");
02aa26ce 5686
fc36a67e 5687 s++;
02aa26ce
NT		 5688
5689 /* check for <$fh>
5690 Remember, only scalar variables are interpreted as filehandles by
5691 this code. Anything more complex (e.g., <$fh{$num}>) will be
5692 treated as a glob() call.
5693 This code makes use of the fact that except for the $ at the front,
5694 a scalar variable and a filehandle look the same.
5695 */
4633a7c4 5696 if (*d == '$' && d[1]) d++;
02aa26ce
NT		 5697
5698 /* allow <Pkg'VALUE> or <Pkg::VALUE> */
834a4ddd 5699 while (*d && (isALNUM_lazy(d) || *d == '\'' || *d == ':'))
79072805 5700 d++;
02aa26ce
NT		 5701
5702 /* If we've tried to read what we allow filehandles to look like, and
5703 there's still text left, then it must be a glob() and not a getline.
5704 Use scan_str to pull out the stuff between the <> and treat it
5705 as nothing more than a string.
5706 */
5707
3280af22 5708 if (d - PL_tokenbuf != len) {
79072805
LW		 5709 yylval.ival = OP_GLOB;
5710 set_csh();
5711 s = scan_str(start);
5712 if (!s)
02aa26ce 5713 croak("Glob not terminated");
79072805
LW		 5714 return s;
5715 }
395c3793 5716 else {
02aa26ce 5717 /* we're in a filehandle read situation */
3280af22 5718 d = PL_tokenbuf;
02aa26ce
NT		 5719
5720 /* turn <> into <ARGV> */
79072805
LW		 5721 if (!len)
5722 (void)strcpy(d,"ARGV");
02aa26ce
NT		 5723
5724 /* if <$fh>, create the ops to turn the variable into a
5725 filehandle
5726 */
79072805 5727 if (*d == '$') {
a0d0e21e 5728 I32 tmp;
02aa26ce
NT		 5729
5730 /* try to find it in the pad for this block, otherwise find
5731 add symbol table ops
5732 */
11343788
MB		 5733 if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
5734 OP *o = newOP(OP_PADSV, 0);
5735 o->op_targ = tmp;
f5284f61 5736 PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, o);
a0d0e21e
LW		 5737 }
5738 else {
5739 GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
3280af22 5740 PL_lex_op = (OP*)newUNOP(OP_READLINE, 0,
a0d0e21e 5741 newUNOP(OP_RV2SV, 0,
f5284f61 5742 newGVOP(OP_GV, 0, gv)));
a0d0e21e 5743 }
f5284f61
IZ		 5744 PL_lex_op->op_flags |= OPf_SPECIAL;
5745 /* we created the ops in PL_lex_op, so make yylval.ival a null op */
79072805
LW		 5746 yylval.ival = OP_NULL;
5747 }
02aa26ce
NT		 5748
5749 /* If it's none of the above, it must be a literal filehandle
5750 (<Foo::BAR> or <FOO>) so build a simple readline OP */
79072805 5751 else {
85e6fe83 5752 GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO);
3280af22 5753 PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
79072805
LW		 5754 yylval.ival = OP_NULL;
5755 }
5756 }
02aa26ce 5757
79072805
LW		 5758 return s;
5759}
5760
02aa26ce
NT		 5761
5762/* scan_str
5763 takes: start position in buffer
5764 returns: position to continue reading from buffer
5765 side-effects: multi_start, multi_close, lex_repl or lex_stuff, and
5766 updates the read buffer.
5767
5768 This subroutine pulls a string out of the input. It is called for:
5769 q single quotes q(literal text)
5770 ' single quotes 'literal text'
5771 qq double quotes qq(interpolate $here please)
5772 " double quotes "interpolate $here please"
5773 qx backticks qx(/bin/ls -l)
5774 ` backticks `/bin/ls -l`
5775 qw quote words @EXPORT_OK = qw( func() $spam )
5776 m// regexp match m/this/
5777 s/// regexp substitute s/this/that/
5778 tr/// string transliterate tr/this/that/
5779 y/// string transliterate y/this/that/
5780 ($*@) sub prototypes sub foo ($)
5781 <> readline or globs <FOO>, <>, <$fh>, or <*.c>
5782
5783 In most of these cases (all but <>, patterns and transliterate)
5784 yylex() calls scan_str(). m// makes yylex() call scan_pat() which
5785 calls scan_str(). s/// makes yylex() call scan_subst() which calls
5786 scan_str(). tr/// and y/// make yylex() call scan_trans() which
5787 calls scan_str().
5788
5789 It skips whitespace before the string starts, and treats the first
5790 character as the delimiter. If the delimiter is one of ([{< then
5791 the corresponding "close" character )]}> is used as the closing
5792 delimiter. It allows quoting of delimiters, and if the string has
5793 balanced delimiters ([{<>}]) it allows nesting.
5794
5795 The lexer always reads these strings into lex_stuff, except in the
5796 case of the operators which take *two* arguments (s/// and tr///)
5797 when it checks to see if lex_stuff is full (presumably with the 1st
5798 arg to s or tr) and if so puts the string into lex_repl.
5799
5800*/
5801
76e3520e 5802STATIC char *
8ac85365 5803scan_str(char *start)
79072805 5804{
11343788 5805 dTHR;
02aa26ce
NT		 5806 SV *sv; /* scalar value: string */
5807 char *tmps; /* temp string, used for delimiter matching */
5808 register char *s = start; /* current position in the buffer */
5809 register char term; /* terminating character */
5810 register char *to; /* current position in the sv's data */
5811 I32 brackets = 1; /* bracket nesting level */
5812
5813 /* skip space before the delimiter */
fb73857a 5814 if (isSPACE(*s))
5815 s = skipspace(s);
02aa26ce
NT		 5816
5817 /* mark where we are, in case we need to report errors */
79072805 5818 CLINE;
02aa26ce
NT		 5819
5820 /* after skipping whitespace, the next character is the terminator */
a0d0e21e 5821 term = *s;
02aa26ce 5822 /* mark where we are */
3280af22
NIS		 5823 PL_multi_start = PL_curcop->cop_line;
5824 PL_multi_open = term;
02aa26ce
NT		 5825
5826 /* find corresponding closing delimiter */
93a17b20 5827 if (term && (tmps = strchr("([{< )]}> )]}>",term)))
79072805 5828 term = tmps[5];
3280af22 5829 PL_multi_close = term;
79072805 5830
02aa26ce 5831 /* create a new SV to hold the contents. 87 is leak category, I'm
8d6dde3e
IZ		 5832 assuming. 79 is the SV's initial length. What a random number. */
5833 sv = NEWSV(87,79);
ed6116ce
LW		 5834 sv_upgrade(sv, SVt_PVIV);
5835 SvIVX(sv) = term;
a0d0e21e 5836 (void)SvPOK_only(sv); /* validate pointer */
02aa26ce
NT		 5837
5838 /* move past delimiter and try to read a complete string */
93a17b20
LW		 5839 s++;
5840 for (;;) {
02aa26ce 5841 /* extend sv if need be */
3280af22 5842 SvGROW(sv, SvCUR(sv) + (PL_bufend - s) + 1);
02aa26ce 5843 /* set 'to' to the next character in the sv's string */
463ee0b2 5844 to = SvPVX(sv)+SvCUR(sv);
02aa26ce
NT		 5845
5846 /* if open delimiter is the close delimiter read unbridle */
3280af22
NIS		 5847 if (PL_multi_open == PL_multi_close) {
5848 for (; s < PL_bufend; s++,to++) {
02aa26ce 5849 /* embedded newlines increment the current line number */
3280af22
NIS		 5850 if (*s == '\n' && !PL_rsfp)
5851 PL_curcop->cop_line++;
02aa26ce 5852 /* handle quoted delimiters */
3280af22 5853 if (*s == '\\' && s+1 < PL_bufend && term != '\\') {
a0d0e21e
LW		 5854 if (s[1] == term)
5855 s++;
02aa26ce 5856 /* any other quotes are simply copied straight through */
a0d0e21e
LW		 5857 else
5858 *to++ = *s++;
5859 }
02aa26ce
NT		 5860 /* terminate when run out of buffer (the for() condition), or
5861 have found the terminator */
93a17b20
LW		 5862 else if (*s == term)
5863 break;
5864 *to = *s;
5865 }
5866 }
02aa26ce
NT		 5867
5868 /* if the terminator isn't the same as the start character (e.g.,
5869 matched brackets), we have to allow more in the quoting, and
5870 be prepared for nested brackets.
5871 */
93a17b20 5872 else {
02aa26ce 5873 /* read until we run out of string, or we find the terminator */
3280af22 5874 for (; s < PL_bufend; s++,to++) {
02aa26ce 5875 /* embedded newlines increment the line count */
3280af22
NIS		 5876 if (*s == '\n' && !PL_rsfp)
5877 PL_curcop->cop_line++;
02aa26ce 5878 /* backslashes can escape the open or closing characters */
3280af22
NIS		 5879 if (*s == '\\' && s+1 < PL_bufend) {
5880 if ((s[1] == PL_multi_open) || (s[1] == PL_multi_close))
a0d0e21e
LW		 5881 s++;
5882 else
5883 *to++ = *s++;
5884 }
02aa26ce 5885 /* allow nested opens and closes */
3280af22 5886 else if (*s == PL_multi_close && --brackets <= 0)
93a17b20 5887 break;
3280af22 5888 else if (*s == PL_multi_open)
93a17b20
LW		 5889 brackets++;
5890 *to = *s;
5891 }
5892 }
02aa26ce 5893 /* terminate the copied string and update the sv's end-of-string */
93a17b20 5894 *to = '\0';
463ee0b2 5895 SvCUR_set(sv, to - SvPVX(sv));
93a17b20 5896
02aa26ce
NT		 5897 /*
5898 * this next chunk reads more into the buffer if we're not done yet
5899 */
5900
3280af22 5901 if (s < PL_bufend) break; /* handle case where we are done yet :-) */
79072805 5902
6a27c188 5903#ifndef PERL_STRICT_CR
f63a84b2 5904 if (to - SvPVX(sv) >= 2) {
c6f14548
GS		 5905 if ((to[-2] == '\r' && to[-1] == '\n') ||
5906 (to[-2] == '\n' && to[-1] == '\r'))
5907 {
f63a84b2
LW		 5908 to[-2] = '\n';
5909 to--;
5910 SvCUR_set(sv, to - SvPVX(sv));
5911 }
5912 else if (to[-1] == '\r')
5913 to[-1] = '\n';
5914 }
5915 else if (to - SvPVX(sv) == 1 && to[-1] == '\r')
5916 to[-1] = '\n';
5917#endif
5918
02aa26ce
NT		 5919 /* if we're out of file, or a read fails, bail and reset the current
5920 line marker so we can report where the unterminated string began
5921 */
3280af22
NIS		 5922 if (!PL_rsfp ||
5923 !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) {
c07a80fd 5924 sv_free(sv);
3280af22 5925 PL_curcop->cop_line = PL_multi_start;
79072805
LW		 5926 return Nullch;
5927 }
02aa26ce 5928 /* we read a line, so increment our line counter */
3280af22 5929 PL_curcop->cop_line++;
a0ed51b3 5930
02aa26ce 5931 /* update debugger info */
3280af22 5932 if (PERLDB_LINE && PL_curstash != PL_debstash) {
79072805
LW		 5933 SV *sv = NEWSV(88,0);
5934
93a17b20 5935 sv_upgrade(sv, SVt_PVMG);
3280af22
NIS		 5936 sv_setsv(sv,PL_linestr);
5937 av_store(GvAV(PL_curcop->cop_filegv),
5938 (I32)PL_curcop->cop_line, sv);
395c3793 5939 }
a0ed51b3 5940
3280af22
NIS		 5941 /* having changed the buffer, we must update PL_bufend */
5942 PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
378cc40b 5943 }
02aa26ce
NT		 5944
5945 /* at this point, we have successfully read the delimited string */
5946
3280af22 5947 PL_multi_end = PL_curcop->cop_line;
79072805 5948 s++;
02aa26ce
NT		 5949
5950 /* if we allocated too much space, give some back */
93a17b20
LW		 5951 if (SvCUR(sv) + 5 < SvLEN(sv)) {
5952 SvLEN_set(sv, SvCUR(sv) + 1);
463ee0b2 5953 Renew(SvPVX(sv), SvLEN(sv), char);
79072805 5954 }
02aa26ce
NT		 5955
5956 /* decide whether this is the first or second quoted string we've read
5957 for this op
5958 */
5959
3280af22
NIS		 5960 if (PL_lex_stuff)
5961 PL_lex_repl = sv;
79072805 5962 else
3280af22 5963 PL_lex_stuff = sv;
378cc40b
LW		 5964 return s;
5965}
5966
02aa26ce
NT		 5967/*
5968 scan_num
5969 takes: pointer to position in buffer
5970 returns: pointer to new position in buffer
5971 side-effects: builds ops for the constant in yylval.op
5972
5973 Read a number in any of the formats that Perl accepts:
5974
4f19785b 5975 0(x[0-7A-F]+)|([0-7]+)|(b[01])
02aa26ce
NT		 5976 [\d_]+(\.[\d_]*)?[Ee](\d+)
5977
5978 Underbars (_) are allowed in decimal numbers. If -w is on,
5979 underbars before a decimal point must be at three digit intervals.
5980
3280af22 5981 Like most scan_ routines, it uses the PL_tokenbuf buffer to hold the
02aa26ce
NT		 5982 thing it reads.
5983
5984 If it reads a number without a decimal point or an exponent, it will
5985 try converting the number to an integer and see if it can do so
5986 without loss of precision.
5987*/
5988
378cc40b 5989char *
8ac85365 5990scan_num(char *start)
378cc40b 5991{
02aa26ce
NT		 5992 register char *s = start; /* current position in buffer */
5993 register char *d; /* destination in temp buffer */
5994 register char *e; /* end of temp buffer */
5995 I32 tryiv; /* used to see if it can be an int */
5996 double value; /* number read, as a double */
5997 SV *sv; /* place to put the converted number */
5998 I32 floatit; /* boolean: int or float? */
5999 char *lastub = 0; /* position of last underbar */
fc36a67e 6000 static char number_too_long[] = "Number too long";
378cc40b 6001
02aa26ce
NT		 6002 /* We use the first character to decide what type of number this is */
6003
378cc40b 6004 switch (*s) {
79072805 6005 default:
02aa26ce
NT		 6006 croak("panic: scan_num");
6007
6008 /* if it starts with a 0, it could be an octal number, a decimal in
4f19785b 6009 0.13 disguise, or a hexadecimal number, or a binary number.
02aa26ce 6010 */
378cc40b
LW		 6011 case '0':
6012 {
02aa26ce
NT		 6013 /* variables:
6014 u holds the "number so far"
4f19785b
WSI		 6015 shift the power of 2 of the base
6016 (hex == 4, octal == 3, binary == 1)
02aa26ce
NT		 6017 overflowed was the number more than we can hold?
6018
6019 Shift is used when we add a digit. It also serves as an "are
4f19785b
WSI		 6020 we in octal/hex/binary?" indicator to disallow hex characters
6021 when in octal mode.
02aa26ce 6022 */
55497cff 6023 UV u;
79072805 6024 I32 shift;
55497cff 6025 bool overflowed = FALSE;
378cc40b 6026
02aa26ce 6027 /* check for hex */
378cc40b
LW		 6028 if (s[1] == 'x') {
6029 shift = 4;
6030 s += 2;
4f19785b
WSI		 6031 } else if (s[1] == 'b') {
6032 shift = 1;
6033 s += 2;
378cc40b 6034 }
02aa26ce 6035 /* check for a decimal in disguise */
378cc40b
LW		 6036 else if (s[1] == '.')
6037 goto decimal;
02aa26ce 6038 /* so it must be octal */
378cc40b
LW		 6039 else
6040 shift = 3;
55497cff 6041 u = 0;
02aa26ce 6042
4f19785b 6043 /* read the rest of the number */
378cc40b 6044 for (;;) {
02aa26ce 6045 UV n, b; /* n is used in the overflow test, b is the digit we're adding on */
55497cff 6046
378cc40b 6047 switch (*s) {
02aa26ce
NT		 6048
6049 /* if we don't mention it, we're done */
378cc40b
LW		 6050 default:
6051 goto out;
02aa26ce
NT		 6052
6053 /* _ are ignored */
de3bb511
LW		 6054 case '_':
6055 s++;
6056 break;
02aa26ce
NT		 6057
6058 /* 8 and 9 are not octal */
378cc40b 6059 case '8': case '9':
4f19785b 6060 if (shift == 3)
399388f4 6061 yyerror(form("Illegal octal digit '%c'", *s));
4f19785b
WSI		 6062 else
6063 if (shift == 1)
399388f4 6064 yyerror(form("Illegal binary digit '%c'", *s));
378cc40b 6065 /* FALL THROUGH */
02aa26ce
NT		 6066
6067 /* octal digits */
4f19785b 6068 case '2': case '3': case '4':
378cc40b 6069 case '5': case '6': case '7':
4f19785b 6070 if (shift == 1)
399388f4 6071 yyerror(form("Illegal binary digit '%c'", *s));
4f19785b
WSI		 6072 /* FALL THROUGH */
6073
6074 case '0': case '1':
02aa26ce 6075 b = *s++ & 15; /* ASCII digit -> value of digit */
55497cff 6076 goto digit;
02aa26ce
NT		 6077
6078 /* hex digits */
378cc40b
LW		 6079 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
6080 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
02aa26ce 6081 /* make sure they said 0x */
378cc40b
LW		 6082 if (shift != 4)
6083 goto out;
55497cff 6084 b = (*s++ & 7) + 9;
02aa26ce
NT		 6085
6086 /* Prepare to put the digit we have onto the end
6087 of the number so far. We check for overflows.
6088 */
6089
55497cff 6090 digit:
02aa26ce 6091 n = u << shift; /* make room for the digit */
b3ac6de7 6092 if (!overflowed && (n >> shift) != u
3280af22 6093 && !(PL_hints & HINT_NEW_BINARY)) {
55497cff 6094 warn("Integer overflow in %s number",
4f19785b
WSI		 6095 (shift == 4) ? "hex"
6096 : ((shift == 3) ? "octal" : "binary"));
55497cff 6097 overflowed = TRUE;
6098 }
02aa26ce 6099 u = n | b; /* add the digit to the end */
378cc40b
LW		 6100 break;
6101 }
6102 }
02aa26ce
NT		 6103
6104 /* if we get here, we had success: make a scalar value from
6105 the number.
6106 */
378cc40b 6107 out:
79072805 6108 sv = NEWSV(92,0);
55497cff 6109 sv_setuv(sv, u);
3280af22 6110 if ( PL_hints & HINT_NEW_BINARY)
b3ac6de7 6111 sv = new_constant(start, s - start, "binary", sv, Nullsv, NULL);
378cc40b
LW		 6112 }
6113 break;
02aa26ce
NT		 6114
6115 /*
6116 handle decimal numbers.
6117 we're also sent here when we read a 0 as the first digit
6118 */
378cc40b
LW		 6119 case '1': case '2': case '3': case '4': case '5':
6120 case '6': case '7': case '8': case '9': case '.':
6121 decimal:
3280af22
NIS		 6122 d = PL_tokenbuf;
6123 e = PL_tokenbuf + sizeof PL_tokenbuf - 6; /* room for various punctuation */
79072805 6124 floatit = FALSE;
02aa26ce
NT		 6125
6126 /* read next group of digits and _ and copy into d */
de3bb511 6127 while (isDIGIT(*s) || *s == '_') {
02aa26ce
NT		 6128 /* skip underscores, checking for misplaced ones
6129 if -w is on
6130 */
93a17b20 6131 if (*s == '_') {
d008e5eb 6132 dTHR; /* only for ckWARN */
599cee73
PM		 6133 if (ckWARN(WARN_SYNTAX) && lastub && s - lastub != 3)
6134 warner(WARN_SYNTAX, "Misplaced _ in number");
93a17b20
LW		 6135 lastub = ++s;
6136 }
fc36a67e 6137 else {
02aa26ce 6138 /* check for end of fixed-length buffer */
fc36a67e 6139 if (d >= e)
6140 croak(number_too_long);
02aa26ce 6141 /* if we're ok, copy the character */
378cc40b 6142 *d++ = *s++;
fc36a67e 6143 }
378cc40b 6144 }
02aa26ce
NT		 6145
6146 /* final misplaced underbar check */
d008e5eb
GS		 6147 if (lastub && s - lastub != 3) {
6148 dTHR;
6149 if (ckWARN(WARN_SYNTAX))
6150 warner(WARN_SYNTAX, "Misplaced _ in number");
6151 }
02aa26ce
NT		 6152
6153 /* read a decimal portion if there is one. avoid
6154 3..5 being interpreted as the number 3. followed
6155 by .5
6156 */
2f3197b3 6157 if (*s == '.' && s[1] != '.') {
79072805 6158 floatit = TRUE;
378cc40b 6159 *d++ = *s++;
02aa26ce
NT		 6160
6161 /* copy, ignoring underbars, until we run out of
6162 digits. Note: no misplaced underbar checks!
6163 */
fc36a67e 6164 for (; isDIGIT(*s) || *s == '_'; s++) {
02aa26ce 6165 /* fixed length buffer check */
fc36a67e 6166 if (d >= e)
6167 croak(number_too_long);
6168 if (*s != '_')
6169 *d++ = *s;
378cc40b
LW		 6170 }
6171 }
02aa26ce
NT		 6172
6173 /* read exponent part, if present */
93a17b20 6174 if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
79072805
LW		 6175 floatit = TRUE;
6176 s++;
02aa26ce
NT		 6177
6178 /* regardless of whether user said 3E5 or 3e5, use lower 'e' */
79072805 6179 *d++ = 'e'; /* At least some Mach atof()s don't grok 'E' */
02aa26ce
NT		 6180
6181 /* allow positive or negative exponent */
378cc40b
LW		 6182 if (*s == '+' || *s == '-')
6183 *d++ = *s++;
02aa26ce
NT		 6184
6185 /* read digits of exponent (no underbars :-) */
fc36a67e 6186 while (isDIGIT(*s)) {
6187 if (d >= e)
6188 croak(number_too_long);
378cc40b 6189 *d++ = *s++;
fc36a67e 6190 }
378cc40b 6191 }
02aa26ce
NT		 6192
6193 /* terminate the string */
378cc40b 6194 *d = '\0';
02aa26ce
NT		 6195
6196 /* make an sv from the string */
79072805 6197 sv = NEWSV(92,0);
02aa26ce 6198 /* reset numeric locale in case we were earlier left in Swaziland */
36477c24 6199 SET_NUMERIC_STANDARD();
3280af22 6200 value = atof(PL_tokenbuf);
02aa26ce
NT		 6201
6202 /*
6203 See if we can make do with an integer value without loss of
6204 precision. We use I_V to cast to an int, because some
6205 compilers have issues. Then we try casting it back and see
6206 if it was the same. We only do this if we know we
6207 specifically read an integer.
6208
6209 Note: if floatit is true, then we don't need to do the
6210 conversion at all.
6211 */
1e422769 6212 tryiv = I_V(value);
6213 if (!floatit && (double)tryiv == value)
6214 sv_setiv(sv, tryiv);
2f3197b3 6215 else
1e422769 6216 sv_setnv(sv, value);
3280af22
NIS		 6217 if ( floatit ? (PL_hints & HINT_NEW_FLOAT) : (PL_hints & HINT_NEW_INTEGER) )
6218 sv = new_constant(PL_tokenbuf, d - PL_tokenbuf,
b3ac6de7 6219 (floatit ? "float" : "integer"), sv, Nullsv, NULL);
378cc40b 6220 break;
79072805 6221 }
a687059c 6222
02aa26ce
NT		 6223 /* make the op for the constant and return */
6224
79072805 6225 yylval.opval = newSVOP(OP_CONST, 0, sv);
a687059c 6226
378cc40b
LW		 6227 return s;
6228}
6229
76e3520e 6230STATIC char *
8ac85365 6231scan_formline(register char *s)
378cc40b 6232{
11343788 6233 dTHR;
79072805 6234 register char *eol;
378cc40b 6235 register char *t;
79cb57f6 6236 SV *stuff = newSVpvn("",0);
79072805 6237 bool needargs = FALSE;
378cc40b 6238
79072805 6239 while (!needargs) {
85e6fe83 6240 if (*s == '.' || *s == '}') {
79072805 6241 /*SUPPRESS 530*/
51882d45
GS		 6242#ifdef PERL_STRICT_CR
6243 for (t = s+1;*t == ' ' || *t == '\t'; t++) ;
6244#else
6245 for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ;
6246#endif
6a65c6a0 6247 if (*t == '\n' || t == PL_bufend)
79072805
LW		 6248 break;
6249 }
3280af22 6250 if (PL_in_eval && !PL_rsfp) {
93a17b20 6251 eol = strchr(s,'\n');
0f85fab0 6252 if (!eol++)
3280af22 6253 eol = PL_bufend;
0f85fab0
LW		 6254 }
6255 else
3280af22 6256 eol = PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
79072805 6257 if (*s != '#') {
a0d0e21e
LW		 6258 for (t = s; t < eol; t++) {
6259 if (*t == '~' && t[1] == '~' && SvCUR(stuff)) {
6260 needargs = FALSE;
6261 goto enough; /* ~~ must be first line in formline */
378cc40b 6262 }
a0d0e21e
LW		 6263 if (*t == '@' || *t == '^')
6264 needargs = TRUE;
378cc40b 6265 }
a0d0e21e 6266 sv_catpvn(stuff, s, eol-s);
79072805
LW		 6267 }
6268 s = eol;
3280af22
NIS		 6269 if (PL_rsfp) {
6270 s = filter_gets(PL_linestr, PL_rsfp, 0);
6271 PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
6272 PL_bufend = PL_bufptr + SvCUR(PL_linestr);
79072805 6273 if (!s) {
3280af22 6274 s = PL_bufptr;
79072805 6275 yyerror("Format not terminated");
378cc40b
LW		 6276 break;
6277 }
378cc40b 6278 }
463ee0b2 6279 incline(s);
79072805 6280 }
a0d0e21e
LW		 6281 enough:
6282 if (SvCUR(stuff)) {
3280af22 6283 PL_expect = XTERM;
79072805 6284 if (needargs) {
3280af22
NIS		 6285 PL_lex_state = LEX_NORMAL;
6286 PL_nextval[PL_nexttoke].ival = 0;
79072805
LW		 6287 force_next(',');
6288 }
a0d0e21e 6289 else
3280af22
NIS		 6290 PL_lex_state = LEX_FORMLINE;
6291 PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
79072805 6292 force_next(THING);
3280af22 6293 PL_nextval[PL_nexttoke].ival = OP_FORMLINE;
79072805 6294 force_next(LSTOP);
378cc40b 6295 }
79072805 6296 else {
8990e307 6297 SvREFCNT_dec(stuff);
3280af22
NIS		 6298 PL_lex_formbrack = 0;
6299 PL_bufptr = s;
79072805
LW		 6300 }
6301 return s;
378cc40b 6302}
a687059c 6303
76e3520e 6304STATIC void
8ac85365 6305set_csh(void)
a687059c 6306{
ae986130 6307#ifdef CSH
3280af22
NIS		 6308 if (!PL_cshlen)
6309 PL_cshlen = strlen(PL_cshname);
ae986130 6310#endif
a687059c 6311}
463ee0b2 6312
ba6d6ac9 6313I32
8ac85365 6314start_subparse(I32 is_format, U32 flags)
8990e307 6315{
11343788 6316 dTHR;
3280af22
NIS		 6317 I32 oldsavestack_ix = PL_savestack_ix;
6318 CV* outsidecv = PL_compcv;
748a9306 6319 AV* comppadlist;
8990e307 6320
3280af22
NIS		 6321 if (PL_compcv) {
6322 assert(SvTYPE(PL_compcv) == SVt_PVCV);
e9a444f0 6323 }
3280af22
NIS		 6324 save_I32(&PL_subline);
6325 save_item(PL_subname);
6326 SAVEI32(PL_padix);
6327 SAVESPTR(PL_curpad);
6328 SAVESPTR(PL_comppad);
6329 SAVESPTR(PL_comppad_name);
6330 SAVESPTR(PL_compcv);
6331 SAVEI32(PL_comppad_name_fill);
6332 SAVEI32(PL_min_intro_pending);
6333 SAVEI32(PL_max_intro_pending);
6334 SAVEI32(PL_pad_reset_pending);
6335
6336 PL_compcv = (CV*)NEWSV(1104,0);
6337 sv_upgrade((SV *)PL_compcv, is_format ? SVt_PVFM : SVt_PVCV);
6338 CvFLAGS(PL_compcv) |= flags;
6339
6340 PL_comppad = newAV();
6341 av_push(PL_comppad, Nullsv);
6342 PL_curpad = AvARRAY(PL_comppad);
6343 PL_comppad_name = newAV();
6344 PL_comppad_name_fill = 0;
6345 PL_min_intro_pending = 0;
6346 PL_padix = 0;
6347 PL_subline = PL_curcop->cop_line;
6d4ff0d2 6348#ifdef USE_THREADS
79cb57f6 6349 av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
533c011a
NIS		 6350 PL_curpad[0] = (SV*)newAV();
6351 SvPADMY_on(PL_curpad[0]); /* XXX Needed? */
6d4ff0d2 6352#endif /* USE_THREADS */
748a9306
LW		 6353
6354 comppadlist = newAV();
6355 AvREAL_off(comppadlist);
3280af22
NIS		 6356 av_store(comppadlist, 0, (SV*)PL_comppad_name);
6357 av_store(comppadlist, 1, (SV*)PL_comppad);
748a9306 6358
3280af22
NIS		 6359 CvPADLIST(PL_compcv) = comppadlist;
6360 CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv);
11343788 6361#ifdef USE_THREADS
533c011a
NIS		 6362 CvOWNER(PL_compcv) = 0;
6363 New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
6364 MUTEX_INIT(CvMUTEXP(PL_compcv));
11343788 6365#endif /* USE_THREADS */
748a9306 6366
8990e307
LW		 6367 return oldsavestack_ix;
6368}
6369
6370int
8ac85365 6371yywarn(char *s)
8990e307 6372{
11343788 6373 dTHR;
3280af22
NIS		 6374 --PL_error_count;
6375 PL_in_eval |= 2;
748a9306 6376 yyerror(s);
3280af22 6377 PL_in_eval &= ~2;
748a9306 6378 return 0;
8990e307
LW		 6379}
6380
6381int
8ac85365 6382yyerror(char *s)
463ee0b2 6383{
11343788 6384 dTHR;
68dc0745 6385 char *where = NULL;
6386 char *context = NULL;
6387 int contlen = -1;
46fc3d4c 6388 SV *msg;
463ee0b2 6389
3280af22 6390 if (!yychar || (yychar == ';' && !PL_rsfp))
54310121 6391 where = "at EOF";
3280af22
NIS		 6392 else if (PL_bufptr > PL_oldoldbufptr && PL_bufptr - PL_oldoldbufptr < 200 &&
6393 PL_oldoldbufptr != PL_oldbufptr && PL_oldbufptr != PL_bufptr) {
6394 while (isSPACE(*PL_oldoldbufptr))
6395 PL_oldoldbufptr++;
6396 context = PL_oldoldbufptr;
6397 contlen = PL_bufptr - PL_oldoldbufptr;
463ee0b2 6398 }
3280af22
NIS		 6399 else if (PL_bufptr > PL_oldbufptr && PL_bufptr - PL_oldbufptr < 200 &&
6400 PL_oldbufptr != PL_bufptr) {
6401 while (isSPACE(*PL_oldbufptr))
6402 PL_oldbufptr++;
6403 context = PL_oldbufptr;
6404 contlen = PL_bufptr - PL_oldbufptr;
463ee0b2
LW		 6405 }
6406 else if (yychar > 255)
68dc0745 6407 where = "next token ???";
463ee0b2 6408 else if ((yychar & 127) == 127) {
3280af22
NIS		 6409 if (PL_lex_state == LEX_NORMAL ||
6410 (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL))
68dc0745 6411 where = "at end of line";
3280af22 6412 else if (PL_lex_inpat)
68dc0745 6413 where = "within pattern";
463ee0b2 6414 else
68dc0745 6415 where = "within string";
463ee0b2 6416 }
46fc3d4c 6417 else {
79cb57f6 6418 SV *where_sv = sv_2mortal(newSVpvn("next char ", 10));
46fc3d4c 6419 if (yychar < 32)
6420 sv_catpvf(where_sv, "^%c", toCTRL(yychar));
6421 else if (isPRINT_LC(yychar))
6422 sv_catpvf(where_sv, "%c", yychar);
463ee0b2 6423 else
46fc3d4c 6424 sv_catpvf(where_sv, "\\%03o", yychar & 255);
6425 where = SvPVX(where_sv);
463ee0b2 6426 }
46fc3d4c 6427 msg = sv_2mortal(newSVpv(s, 0));
fc36a67e 6428 sv_catpvf(msg, " at %_ line %ld, ",
3280af22 6429 GvSV(PL_curcop->cop_filegv), (long)PL_curcop->cop_line);
68dc0745 6430 if (context)
46fc3d4c 6431 sv_catpvf(msg, "near \"%.*s\"\n", contlen, context);
463ee0b2 6432 else
46fc3d4c 6433 sv_catpvf(msg, "%s\n", where);
3280af22 6434 if (PL_multi_start < PL_multi_end && (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) {
46fc3d4c 6435 sv_catpvf(msg,
4fdae800 6436 " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
3280af22
NIS		 6437 (int)PL_multi_open,(int)PL_multi_close,(long)PL_multi_start);
6438 PL_multi_end = 0;
a0d0e21e 6439 }
3280af22 6440 if (PL_in_eval & 2)
fc36a67e 6441 warn("%_", msg);
3280af22 6442 else if (PL_in_eval)
38a03e6e 6443 sv_catsv(ERRSV, msg);
463ee0b2 6444 else
46fc3d4c 6445 PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
3280af22
NIS		 6446 if (++PL_error_count >= 10)
6447 croak("%_ has too many errors.\n", GvSV(PL_curcop->cop_filegv));
6448 PL_in_my = 0;
6449 PL_in_my_stash = Nullhv;
463ee0b2
LW		 6450 return 0;
6451}
4e35701f 6452
161b471a 6453
Unnamed repository; edit this file 'description' to name the repository.