#define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
#endif
-/* In variables name $^X, these are the legal values for X.
+/* In variables named $^X, these are the legal values for X.
* 1999-02-27 mjd-perl-patch@plover.com */
#define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
/* grandfather return to old style */
#define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
+#ifdef DEBUGGING
+
STATIC void
S_tokereport(pTHX_ char *thing, char* s, I32 rv)
{
sv_catpv(report, PL_tokenbuf);
}
PerlIO_printf(Perl_debug_log, "### %s\n", SvPV_nolen(report));
- })
+ });
}
+#endif
+
/*
* S_ao
*
char *e = d++;
while (e-- > c)
*(e + 1) = *e;
- *c = UTF_TO_NATIVE(0xff);
+ *c = (char)UTF_TO_NATIVE(0xff);
/* mark the range as done, and continue */
dorange = FALSE;
didrange = TRUE;
Perl_croak(aTHX_ "Ambiguous range in transliteration operator");
}
if (has_utf8) {
- *d++ = UTF_TO_NATIVE(0xff); /* use illegal utf8 byte--see pmtrans */
+ *d++ = (char)UTF_TO_NATIVE(0xff); /* use illegal utf8 byte--see pmtrans */
s++;
continue;
}
else if (*s == '$') {
if (!PL_lex_inpat) /* not a regexp, so $ must be var */
break;
- if (s + 1 < send && !strchr("()| \n\t", s[1]))
+ if (s + 1 < send && !strchr("()| \r\n\t", s[1]))
break; /* in regexp, $ might be tail anchor */
}
PL_pending_ident = 0;
DEBUG_T({ PerlIO_printf(Perl_debug_log,
- "### Tokener saw identifier '%s'\n", PL_tokenbuf); })
+ "### Tokener saw identifier '%s'\n", PL_tokenbuf); });
/* if we're in a my(), we can't allow dynamics here.
$foo'bar has already been turned into $foo::bar, so
}
DEBUG_T({ PerlIO_printf(Perl_debug_log,
"### Next token after '%s' was known, type %"IVdf"\n", PL_bufptr,
- (IV)PL_nexttype[PL_nexttoke]); })
+ (IV)PL_nexttype[PL_nexttoke]); });
return(PL_nexttype[PL_nexttoke]);
}
else {
DEBUG_T({ PerlIO_printf(Perl_debug_log,
- "### Saw case modifier at '%s'\n", PL_bufptr); })
+ "### Saw case modifier at '%s'\n", PL_bufptr); });
s = PL_bufptr + 1;
if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
tmp = *s, *s = s[2], s[2] = tmp; /* misordered... */
if (PL_bufptr == PL_bufend)
return sublex_done();
DEBUG_T({ PerlIO_printf(Perl_debug_log,
- "### Interpolated variable at '%s'\n", PL_bufptr); })
+ "### Interpolated variable at '%s'\n", PL_bufptr); });
PL_expect = XTERM;
PL_lex_dojoin = (*PL_bufptr == '@');
PL_lex_state = LEX_INTERPNORMAL;
DEBUG_T( {
PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at %s\n",
exp_name[PL_expect], s);
- } )
+ } );
retry:
switch (*s) {
yyerror("Missing right curly or square bracket");
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Tokener got EOF\n");
- } )
+ } );
TOKEN(0);
}
if (s++ < PL_bufend)
s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Saw unary minus before =>, forcing word '%s'\n", s);
- } )
+ } );
OPERATOR('-'); /* unary minus */
}
PL_last_uni = PL_oldbufptr;
PL_last_lop_op = ftst;
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Saw file test %c\n", (int)ftst);
- } )
+ } );
FTST(ftst);
}
else {
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### %c looked like a file test but was not\n",
(int)ftst);
- } )
+ } );
s -= 2;
}
}
else if (!PL_in_my && len == 6 && strnEQ(s, "method", len))
CvMETHOD_on(PL_compcv);
#ifdef USE_ITHREADS
- else if (PL_in_my == KEY_our && len == 6 && strnEQ(s, "shared", len))
- GvSHARED_on(cGVOPx_gv(yylval.opval));
+ else if (PL_in_my == KEY_our && len == 6 && strnEQ(s, "unique", len))
+ GvUNIQUE_on(cGVOPx_gv(yylval.opval));
#endif
/* After we've set the flags, it could be argued that
we don't need to do the attributes.pm-based setting
s = scan_num(s, &yylval);
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Saw number in '%s'\n", s);
- } )
+ } );
if (PL_expect == XOPERATOR)
no_op("Number",s);
TERM(THING);
s = scan_str(s,FALSE,FALSE);
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Saw string before '%s'\n", s);
- } )
+ } );
if (PL_expect == XOPERATOR) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
s = scan_str(s,FALSE,FALSE);
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Saw string before '%s'\n", s);
- } )
+ } );
if (PL_expect == XOPERATOR) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
s = scan_str(s,FALSE,FALSE);
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Saw backtick string before '%s'\n", s);
- } )
+ } );
if (PL_expect == XOPERATOR)
no_op("Backticks",s);
if (!s)
CLINE;
yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
yylval.opval->op_private = OPpCONST_BARE;
- if (UTF && !IN_BYTE && is_utf8_string((U8*)PL_tokenbuf, len))
+ if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
SvUTF8_on(((SVOP*)yylval.opval)->op_sv);
TERM(WORD);
}
default: /* not a keyword */
just_a_word: {
SV *sv;
+ int pkgname = 0;
char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
/* Get the rest if it looks like a package qualifier */
Perl_croak(aTHX_ "Bad name after %s%s", PL_tokenbuf,
*s == '\'' ? "'" : "::");
len += morelen;
+ pkgname = 1;
}
if (PL_expect == XOPERATOR) {
}
}
-
PL_expect = XOPERATOR;
s = skipspace(s);
/* Is this a word before a => operator? */
- if (*s == '=' && s[1] == '>') {
+ if (*s == '=' && s[1] == '>' && !pkgname) {
CLINE;
sv_setpv(((SVOP*)yylval.opval)->op_sv, PL_tokenbuf);
- if (UTF && !IN_BYTE && is_utf8_string((U8*)PL_tokenbuf, len))
+ if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
SvUTF8_on(((SVOP*)yylval.opval)->op_sv);
TERM(WORD);
}
loc = PerlIO_tell(PL_rsfp);
(void)PerlIO_seek(PL_rsfp, 0L, 0);
}
+#ifdef NETWARE
+ if (PerlLIO_setmode(PL_rsfp, O_TEXT) != -1) {
+#else
if (PerlLIO_setmode(PerlIO_fileno(PL_rsfp), O_TEXT) != -1) {
+#endif /* NETWARE */
#ifdef PERLIO_IS_STDIO /* really? */
# if defined(__BORLANDC__)
/* XXX see note in do_binmode() */
}
#endif
#ifdef PERLIO_LAYERS
- if (UTF && !IN_BYTE)
+ if (UTF && !IN_BYTES)
PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, ":utf8");
#endif
PL_rsfp = Nullfp;
Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
}
SvREFCNT_dec(herewas);
- if (UTF && !IN_BYTE && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr)))
+ if (UTF && !IN_BYTES && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr)))
SvUTF8_on(tmpstr);
PL_lex_stuff = tmpstr;
yylval.ival = op_type;
projects / p5sagit/p5-mst-13.2.git / blobdiff