if (!len) {
parser->linestr = newSVpvs("\n;");
- } else if (SvREADONLY(line) || s[len-1] != ';') {
- parser->linestr = newSVsv(line);
+ } else if (SvREADONLY(line) || s[len-1] != ';' || !SvPOK(line)) {
+ /* avoid tie/overload weirdness */
+ parser->linestr = newSVpvn_flags(s, len, SvUTF8(line));
if (s[len-1] != ';')
sv_catpvs(parser->linestr, "\n;");
} else {
curmad('X', newSVpvn(s,d-s));
}
#endif
- if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
+ if (*d == ';' || isSPACE(*d) || *d == '{' || *d == '}' || !*d) {
SV *ver;
#ifdef USE_LOCALE_NUMERIC
char *loc = setlocale(LC_NUMERIC, "C");
s = (char *)scan_version(s, ver, 0);
version = newSVOP(OP_CONST, 0, ver);
}
- else if ( (*s != ';' && *s != '}' ) && (s = SKIPSPACE1(s), (*s != ';' && *s !='}' ))) {
+ else if ( (*s != ';' && *s != '{' && *s != '}' ) &&
+ (s = SKIPSPACE1(s), (*s != ';' && *s != '{' && *s != '}' )))
+ {
PL_bufptr = s;
if (errstr)
yyerror(errstr); /* version required */
s++;
- /* deprecate \1 in strings and substitution replacements */
+ /* warn on \1 - \9 in substitution replacements, but note that \11
+ * is an octal; and \19 is \1 followed by '9' */
if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
{
goto default_action;
}
- /* eg. \132 indicates the octal constant 0x132 */
+ /* eg. \132 indicates the octal constant 0132 */
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
{
}
goto NUM_ESCAPE_INSERT;
+ /* eg. \o{24} indicates the octal constant \024 */
+ case 'o':
+ {
+ STRLEN len;
+ const char* error;
+
+ bool valid = grok_bslash_o(s, &uv, &len, &error, 1);
+ s += len;
+ if (! valid) {
+ yyerror(error);
+ continue;
+ }
+ goto NUM_ESCAPE_INSERT;
+ }
+
/* eg. \x24 indicates the hex constant 0x24 */
case 'x':
++s;
* should the trailing NUL be missing that this
* print won't run off the end of the string */
Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
- "Deprecated character in \\N{...}; marked by <-- HERE in \\N{%.*s<-- HERE %.*s", i - s + 1, s, e - i, i + 1);
+ "Deprecated character in \\N{...}; marked by <-- HERE in \\N{%.*s<-- HERE %.*s",
+ (int)(i - s + 1), s, (int)(e - i), i + 1);
}
}
} /* End \N{NAME} */
/* if filter is on top of stack (usual case) just pop it off */
datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters));
if (IoANY(datasv) == FPTR2DPTR(void *, funcp)) {
- IoFLAGS(datasv) &= ~IOf_FAKE_DIRP;
- IoANY(datasv) = (void *)NULL;
sv_free(av_pop(PL_rsfp_filters));
return;
}
}
- if (s[1] == '#' && (isIDFIRST_lazy_if(s+2,UTF) || strchr("{$:+-", s[2]))) {
+ if (s[1] == '#' && (isIDFIRST_lazy_if(s+2,UTF) || strchr("{$:+-@", s[2]))) {
PL_tokenbuf[0] = '@';
s = scan_ident(s + 1, PL_bufend, PL_tokenbuf + 1,
sizeof PL_tokenbuf - 1, FALSE);
gvp = 0;
if (hgv && tmp != KEY_x && tmp != KEY_CORE) /* never ambiguous */
Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
- "Ambiguous call resolved as CORE::%s(), %s",
- GvENAME(hgv), "qualify as such or use &");
+ "Ambiguous call resolved as CORE::%s(), "
+ "qualify as such or use &",
+ GvENAME(hgv));
}
}
const char *proto = SvPV_const(MUTABLE_SV(cv), protolen);
if (!protolen)
TERM(FUNC0SUB);
- if ((*proto == '$' || *proto == '_') && proto[1] == '\0')
- OPERATOR(UNIOPSUB);
while (*proto == ';')
proto++;
+ if (
+ (
+ (
+ *proto == '$' || *proto == '_'
+ || *proto == '*'
+ )
+ && proto[1] == '\0'
+ )
+ || (
+ *proto == '\\' && proto[1] && proto[2] == '\0'
+ )
+ )
+ OPERATOR(UNIOPSUB);
+ if (*proto == '\\' && proto[1] == '[') {
+ const char *p = proto + 2;
+ while(*p && *p != ']')
+ ++p;
+ if(*p == ']' && !p[1]) OPERATOR(UNIOPSUB);
+ }
if (*proto == '&' && *s == '{') {
if (PL_curstash)
sv_setpvs(PL_subname, "__ANON__");
s = force_word(s,WORD,FALSE,TRUE,FALSE);
s = SKIPSPACE1(s);
s = force_strict_version(s);
+ PL_lex_expect = XBLOCK;
OPERATOR(PACKAGE);
case KEY_pipe:
pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn(PL_tokenbuf + 1,
tokenbuf_len - 1));
pl_yylval.opval->op_private = OPpCONST_ENTERED;
- gv_fetchpvn_flags(
- PL_tokenbuf + 1, tokenbuf_len - 1,
- /* If the identifier refers to a stash, don't autovivify it.
- * Change 24660 had the side effect of causing symbol table
- * hashes to always be defined, even if they were freshly
- * created and the only reference in the entire program was
- * the single statement with the defined %foo::bar:: test.
- * It appears that all code in the wild doing this actually
- * wants to know whether sub-packages have been loaded, so
- * by avoiding auto-vivifying symbol tables, we ensure that
- * defined %foo::bar:: continues to be false, and the existing
- * tests still give the expected answers, even though what
- * they're actually testing has now changed subtly.
- */
- (*PL_tokenbuf == '%'
- && *(d = PL_tokenbuf + tokenbuf_len - 1) == ':'
- && d[-1] == ':'
- ? 0
- : PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD),
- ((PL_tokenbuf[0] == '$') ? SVt_PV
- : (PL_tokenbuf[0] == '@') ? SVt_PVAV
- : SVt_PVHV));
+ gv_fetchpvn_flags(PL_tokenbuf+1, tokenbuf_len - 1,
+ PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD,
+ ((PL_tokenbuf[0] == '$') ? SVt_PV
+ : (PL_tokenbuf[0] == '@') ? SVt_PVAV
+ : SVt_PVHV));
return WORD;
}
if (name[1] == 'i' &&
name[2] == 'e')
{ /* tie */
- return KEY_tie;
+ return -KEY_tie;
}
goto unknown;
case 'e':
if (name[3] == 'd')
{ /* tied */
- return KEY_tied;
+ return -KEY_tied;
}
goto unknown;
{
case 'e':
{ /* untie */
- return KEY_untie;
+ return -KEY_untie;
}
case 'l':
S_pmflag(U32 pmfl, const char ch) {
switch (ch) {
CASE_STD_PMMOD_FLAGS_PARSE_SET(&pmfl);
- case GLOBAL_PAT_MOD: pmfl |= PMf_GLOBAL; break;
- case CONTINUE_PAT_MOD: pmfl |= PMf_CONTINUE; break;
- case ONCE_PAT_MOD: pmfl |= PMf_KEEP; break;
- case KEEPCOPY_PAT_MOD: pmfl |= PMf_KEEPCOPY; break;
+ case GLOBAL_PAT_MOD: pmfl |= PMf_GLOBAL; break;
+ case CONTINUE_PAT_MOD: pmfl |= PMf_CONTINUE; break;
+ case ONCE_PAT_MOD: pmfl |= PMf_KEEP; break;
+ case KEEPCOPY_PAT_MOD: pmfl |= PMf_KEEPCOPY; break;
+ case NONDESTRUCT_PAT_MOD: pmfl |= PMf_NONDESTRUCT; break;
}
return pmfl;
}
#endif
while (*s && strchr(valid_flags, *s))
pm->op_pmflags = S_pmflag(pm->op_pmflags, *s++);
+
+ if (isALNUM(*s)) {
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX),
+ "Having no space between pattern and following word is deprecated");
+
+ }
#ifdef PERL_MAD
if (PL_madskills && modstart != s) {
SV* tmptoken = newSVpvn(modstart, s - modstart);
}
else if (strchr(S_PAT_MODS, *s))
pm->op_pmflags = S_pmflag(pm->op_pmflags, *s++);
- else
+ else {
+ if (isALNUM(*s)) {
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX),
+ "Having no space between pattern and following word is deprecated");
+
+ }
break;
+ }
}
#ifdef PERL_MAD
const char *base, *Base, *max;
/* check for hex */
- if (s[1] == 'x') {
+ if (s[1] == 'x' || s[1] == 'X') {
shift = 4;
s += 2;
just_zero = FALSE;
- } else if (s[1] == 'b') {
+ } else if (s[1] == 'b' || s[1] == 'B') {
shift = 1;
s += 2;
just_zero = FALSE;
Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number");
}
- /* Dot here is historically concat, not a radix point.
- Deprecate that; it's confusing, and gets in the way of
- hex(ish) fractions... but '..' is OK. */
- if (s[0] == '.' &&
- s[1] != '.') {
- Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
- "Dot after %s literal is concatenation", base);
- }
-
- sv = newSV(0);
if (overflowed) {
if (n > 4294967295.0)
Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
"%s number > %s non-portable",
Base, max);
- sv_setnv(sv, n);
+ sv = newSVnv(n);
}
else {
#if UVSIZE > 4
"%s number > %s non-portable",
Base, max);
#endif
- sv_setuv(sv, u);
+ sv = newSVuv(u);
}
if (just_zero && (PL_hints & HINT_NEW_INTEGER))
sv = new_constant(start, s - start, "integer",
}
- /* make an sv from the string */
- sv = newSV(0);
-
/*
We try to do an integer conversion first if no characters
indicating "float" have been found.
if (flags == IS_NUMBER_IN_UV) {
if (uv <= IV_MAX)
- sv_setiv(sv, uv); /* Prefer IVs over UVs. */
+ sv = newSViv(uv); /* Prefer IVs over UVs. */
else
- sv_setuv(sv, uv);
+ sv = newSVuv(uv);
} else if (flags == (IS_NUMBER_IN_UV | IS_NUMBER_NEG)) {
if (uv <= (UV) IV_MIN)
- sv_setiv(sv, -(IV)uv);
+ sv = newSViv(-(IV)uv);
else
floatit = TRUE;
} else
/* terminate the string */
*d = '\0';
nv = Atof(PL_tokenbuf);
- sv_setnv(sv, nv);
+ sv = newSVnv(nv);
}
if ( floatit
const bool reverse = cBOOL(IoLINES(filter));
I32 retval;
+ PERL_ARGS_ASSERT_UTF16_TEXTFILTER;
+
/* As we're automatically added, at the lowest level, and hence only called
from this file, we can be sure that we're not called in block mode. Hence
don't bother writing code to deal with block mode. */
{
SV *filter = filter_add(S_utf16_textfilter, NULL);
+ PERL_ARGS_ASSERT_ADD_UTF16_TEXTFILTER;
+
IoTOP_GV(filter) = MUTABLE_GV(newSVpvn((char *)s, PL_bufend - (char*)s));
sv_setpvs(filter, "");
IoLINES(filter) = reversed;