In perl.git, the branch maint-5.24 has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/2f530c475e4ce18290dd29b16212b698f17e469f?hp=07f0edfcb5a97def4aa61ab608716c584c73fa21>
- Log -----------------------------------------------------------------
commit 2f530c475e4ce18290dd29b16212b698f17e469f
Author: David Mitchell <da...@iabyn.com>
Date: Mon Sep 5 15:49:28 2016 +0100
toke.c: fix mswin32 builds
9bde56224 added this as part of macro:
- PL_last_lop_op = f; \
+ PL_last_lop_op = f < 0 ? -f : f; \
which broke win32 builds due to this
UNIBRACK(-OP_ENTEREVAL)
expanding to
PL_last_lop_op = -345 < 0 ? --345 : -345
and the -- being seen as a pre-dec op.
Diagnosed by Dagfinn Ilmari Mannsåker.
(cherry picked from commit 0af40c757f083cc12988effb46da5313cd042f00)
M toke.c
commit 095f65cc07205b414e0f85aed41f85a06b20e225
Author: Craig A. Berry <craigbe...@mac.com>
Date: Tue Nov 1 19:06:06 2016 -0500
Treat VSI C the same as DEC/Compaq/HP C.
(cherry picked from commit f6a154ae766a3404d83b81448ca6a356d30198e1)
M configure.com
commit a2784d3f594d6b9c2ee4dac18ecb065f5695b0f2
Author: Daniel Dragan <bul...@hotmail.com>
Date: Sun Aug 14 11:01:00 2016 -0400
silence MSVC warnings for NATIVE_UTF8_TO_I8/I8_TO_NATIVE_UTF8
The result of I8_TO_NATIVE_UTF8 has to be U8 casted for the MSVC specific
PERL_SMALL_MACRO_BUFFER option just like it is for newer CCs that dont
have a small CPP buffer. Commit 1a3756de64/#127426 did add U8 casts to
NATIVE_TO_LATIN1/LATIN1_TO_NATIVE but missed
NATIVE_UTF8_TO_I8/I8_TO_NATIVE_UTF8. This commit fixes that.
One example of the C4244 warning is VC6 thinks 0xFF & (0xFE << 6) in
UTF_START_MARK could be bigger than 0xff (a char), fixes
..\inline.h(247) : warning C4244: '=' : conversion from 'long ' to
'unsigned char ', possible loss of data
Also fixes
..\utf8.c(146) : warning C4244: '=' : conversion from 'UV' to 'U8',
possible loss of data
and alot more warnings in utf8.c
(cherry picked from commit 1d4ea287e9a924ad1eaef98145b6d6c3b6219e80)
M utf8.h
commit 7342343e9f6e76fe5253bef1d02568f3f4cae64e
Author: Karl Williamson <k...@cpan.org>
Date: Wed Jul 6 11:52:01 2016 -0600
Fix -Dr output regression
Several commits in the 5.23 series improved the display of the compiled
ANYOF regnodes, but introduced two bugs. One of them is in \p{Any} and
similar things that match the entire range 0-255. That range is omitted,
so it looks like \p{Any} only matches code points above 255. Note that
this is only what gets displayed under -Dr. What actually gets compiled
has been and still is fine.
The other is that when displaying a pattern that still has unresolved
user-defined properties that are complemented, it doesn't show properly
that the whole thing is complemented. That is, the output looks like it
doesn't obey De Morgan's laws.
The fixes to these are quite intertwined, and so I didn't try to
separate them.
(cherry picked from commit 753b2c6a60a81dacbe59e2041e30e8302484dc2d)
M embed.fnc
M embed.h
M proto.h
M regcomp.c
commit 6f34b500869fa334cfcdc9479e763a3acc869590
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Sep 4 20:24:19 2016 -0700
[perl #129196] Crash/bad read with âevalbytes Sâ
5dc13276 added some code to toke.c that did not take into account
that the opnum (âfâ) argument to UNI* could be a negated op number.
PL_last_lop_op must never be negative, since it is used as an offset
into a struct.
Tests for the crash will come in the next commit.
(cherry picked from commit 9bde56224e82f20e7a65b3469b1ffb6b9f6d4df8)
M toke.c
commit b222778b1f1ee2394ece4122fe55be70a909b09b
Author: Father Chrysostomos <spr...@cpan.org>
Date: Wed Aug 9 08:08:53 2017 +0100
[perl #128951] Fix ASan error with @{\327
By \327 I mean character number 327 in octal.
Without memory tools like ASan, it produces garbled output. The added
test fails like this:
Dave Mitchellââ¬â¢s explanation from the RT ticket:
> The src code contains the bytes:
>
> @ { \327 \n
>
> after seeing "@{" the lexer calls scan_ident(), which sees the \327 as an
> ident, then calls S_skipspace_flags() to skip the spaces following the
> ident. This moves the current cursor position to the \n, and since that's
> a line boundary, its updates PL_linestart and PL_bufptr to point to \n
> too.
>
> When it finds that the next char isn't a '}', it does this:
>
> /* Didn't find the closing } at the point we expected, so
restore
> state such that the next thing to process is the opening {
and */
> s = SvPVX(PL_linestr) + bracket; /* let the parser handle it */
>
> i.e. it moves s back to the "{\317" then continues.
>
> However, PL_linestart doesn't get reset, so later when the parser
> encounters the \327 and tries to croak with "Unrecognized character %s
...",
> when it prints out the section of src code in error, since s < PL_linestr,
> negative string lengths and ASAN errors ensue.
This commit fixes it by passing the LEX_NO_INCLINE flag (added by
21791330a), which specifies that we are not trying to read past the
newline but simply peek ahead. In that case lex_read_space does not
reset PL_linestart.
But that does cause problems with code like:
${;
}
because we end up jumping ahead via skipspace without updating the
line number. So we need to do a skipspace_flags(..., LEX_NO_INCLINE)
first (i.e., peek ahead), and then when we know we donââ¬â¢t need to go
back again we can skipspace(...) for real.
(cherry picked from commit bf8a9a15ea4a7b7ebcde5ba48aafe397c549eff2)
M t/op/lex.t
M toke.c
commit d4ce23c96991e7cb28ce30121443c100a6a2da9b
Author: Steve Hay <steve.m....@googlemail.com>
Date: Wed Aug 9 08:07:42 2017 +0100
Version bump for previous cherry-pick
M ext/POSIX/lib/POSIX.pm
commit 1e4664452bf1ced069acb30c63584c14438f2535
Author: Jarkko Hietaniemi <j...@iki.fi>
Date: Thu Jul 28 09:55:07 2016 -0700
[perl #128763] Fix POSIX.xs longdbl assertion
(cherry picked from commit d80a6052a64d2df61ee61888853ef5f3872c0e34)
M ext/POSIX/POSIX.xs
commit e38784fd0407f657ecbd5cba8d4b8dafd34deb56
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Jul 11 14:49:17 2016 -0700
[perl #128597] Crash from gp_free/ckWARN_d
See the explanation in the test added and in the RT ticket.
The solution is to make the warn macros check that PL_curcop
is non-null.
(cherry picked from commit a2637ca0a3fec01b80d7ea5ba62802354fd5e6f3)
M regen/warnings.pl
M t/op/gv.t
M warnings.h
-----------------------------------------------------------------------
Summary of changes:
configure.com | 9 ++++--
embed.fnc | 3 +-
embed.h | 2 +-
ext/POSIX/POSIX.xs | 2 +-
ext/POSIX/lib/POSIX.pm | 2 +-
proto.h | 2 +-
regcomp.c | 83 +++++++++++++++++++++++++++++++++++---------------
regen/warnings.pl | 6 ++--
t/op/gv.t | 18 ++++++++++-
t/op/lex.t | 11 +++++--
toke.c | 18 ++++++++---
utf8.h | 4 +--
warnings.h | 6 ++--
13 files changed, 119 insertions(+), 47 deletions(-)
diff --git a/configure.com b/configure.com
index ffcbc223b9..30280f420f 100644
--- a/configure.com
+++ b/configure.com
@@ -1354,7 +1354,8 @@ $ vms_cc_available = vms_cc_available + "cc/decc "
$ ENDIF
$ ELSE
$ IF
(F$LOCATE("DEC",line).NE.F$LENGTH(line)).or.(F$LOCATE("Compaq",line).NE.F$LENGTH(line))
-
- .or.(F$LOCATE("HP",F$EDIT(line,"UPCASE")).NE.F$LENGTH(line))
+ .or.(F$LOCATE("HP",F$EDIT(line,"UPCASE")).NE.F$LENGTH(line)) -
+ .or.(F$LOCATE("VSI",F$EDIT(line,"UPCASE")).NE.F$LENGTH(line))
$ THEN
$ vms_cc_dflt = "/decc"
$ vms_cc_available = vms_cc_available + "cc/decc "
@@ -1491,7 +1492,8 @@ $ THEN
$ ans = F$EDIT(ans,"TRIM, COMPRESS, LOWERCASE")
$ Mcc = ans
$ IF
(F$LOCATE("dec",ans).NE.F$LENGTH(ans)).or.(F$LOCATE("compaq",ans).NE.F$LENGTH(ans))
-
- .or.(F$LOCATE("hp",ans).NE.F$LENGTH(ans))
+ .or.(F$LOCATE("hp",ans).NE.F$LENGTH(ans)) -
+ .or.(F$LOCATE("vsi",ans).NE.F$LENGTH(ans))
$ THEN
$ Mcc = "cc/decc"
$! CPQ ?
@@ -1508,7 +1510,8 @@ $ ELSE ! Not_cxx
$ IF Mcc.NES.dflt
$ THEN
$ IF F$LOCATE("dec",dflt) .NE. F$LENGTH(dflt) .or. -
- F$LOCATE("compaq",dflt) .NE. F$LENGTH(dflt)
+ F$LOCATE("compaq",dflt) .NE. F$LENGTH(dflt) -
+ .or.(F$LOCATE("vsi",dflt).NE.F$LENGTH(dflt))
$ THEN
$ C_COMPILER_Replace = "CC=cc=''Mcc'"
$ ELSE
diff --git a/embed.fnc b/embed.fnc
index ab63e44e58..05f943cac8 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2282,7 +2282,8 @@ Es |bool |put_charclass_bitmap_innards|NN SV* sv
\
|NN char* bitmap \
|NULLOK SV* nonbitmap_invlist \
|NULLOK SV* only_utf8_locale_invlist\
- |NULLOK const regnode * const node
+ |NULLOK const regnode * const node \
+ |const bool force_as_is_display
Es |SV* |put_charclass_bitmap_innards_common \
|NN SV* invlist \
|NULLOK SV* posixes \
diff --git a/embed.h b/embed.h
index 5b2998d79e..01dff42dec 100644
--- a/embed.h
+++ b/embed.h
@@ -964,7 +964,7 @@
#define dump_trie_interim_list(a,b,c,d,e) S_dump_trie_interim_list(aTHX_
a,b,c,d,e)
#define dump_trie_interim_table(a,b,c,d,e) S_dump_trie_interim_table(aTHX_
a,b,c,d,e)
#define dumpuntil(a,b,c,d,e,f,g,h) S_dumpuntil(aTHX_ a,b,c,d,e,f,g,h)
-#define put_charclass_bitmap_innards(a,b,c,d,e)
S_put_charclass_bitmap_innards(aTHX_ a,b,c,d,e)
+#define put_charclass_bitmap_innards(a,b,c,d,e,f)
S_put_charclass_bitmap_innards(aTHX_ a,b,c,d,e,f)
#define put_charclass_bitmap_innards_common(a,b,c,d,e,f)
S_put_charclass_bitmap_innards_common(aTHX_ a,b,c,d,e,f)
#define put_charclass_bitmap_innards_invlist(a,b)
S_put_charclass_bitmap_innards_invlist(aTHX_ a,b)
#define put_code_point(a,b) S_put_code_point(aTHX_ a,b)
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 281bea8bae..5a82b8182c 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -1153,7 +1153,7 @@ static NV my_trunc(NV x)
# define NV_PAYLOAD_TYPE NV
#endif
-#ifdef LONGDOUBLE_DOUBLEDOUBLE
+#if defined(USE_LONG_DOUBLE) && defined(LONGDOUBLE_DOUBLEDOUBLE)
# define NV_PAYLOAD_SIZEOF_ASSERT(a) assert(sizeof(a) == NVSIZE / 2)
#else
# define NV_PAYLOAD_SIZEOF_ASSERT(a) assert(sizeof(a) == NVSIZE)
diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm
index 05bdbbe7e6..9731dc9a1a 100644
--- a/ext/POSIX/lib/POSIX.pm
+++ b/ext/POSIX/lib/POSIX.pm
@@ -4,7 +4,7 @@ use warnings;
our ($AUTOLOAD, %SIGRT);
-our $VERSION = '1.65';
+our $VERSION = '1.65_01';
require XSLoader;
diff --git a/proto.h b/proto.h
index 1494077ed5..cd99404f1e 100644
--- a/proto.h
+++ b/proto.h
@@ -3842,7 +3842,7 @@ STATIC void S_dump_trie_interim_table(pTHX_ const
struct _reg_trie_data *trie, H
STATIC const regnode* S_dumpuntil(pTHX_ const regexp *r, const regnode
*start, const regnode *node, const regnode *last, const regnode *plast, SV* sv,
I32 indent, U32 depth);
#define PERL_ARGS_ASSERT_DUMPUNTIL \
assert(r); assert(start); assert(node); assert(sv)
-STATIC bool S_put_charclass_bitmap_innards(pTHX_ SV* sv, char* bitmap, SV*
nonbitmap_invlist, SV* only_utf8_locale_invlist, const regnode * const node);
+STATIC bool S_put_charclass_bitmap_innards(pTHX_ SV* sv, char* bitmap, SV*
nonbitmap_invlist, SV* only_utf8_locale_invlist, const regnode * const node,
const bool force_as_is_display);
#define PERL_ARGS_ASSERT_PUT_CHARCLASS_BITMAP_INNARDS \
assert(sv); assert(bitmap)
STATIC SV* S_put_charclass_bitmap_innards_common(pTHX_ SV* invlist, SV*
posixes, SV* only_utf8, SV* not_utf8, SV* only_utf8_locale, const bool invert);
diff --git a/regcomp.c b/regcomp.c
index ba571c23e3..43841198aa 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -18757,7 +18757,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const
regnode *o, const regmatch_
: TRIE_BITMAP(trie)),
NULL,
NULL,
- NULL
+ NULL,
+ FALSE
);
sv_catpvs(sv, "]");
}
@@ -18856,6 +18857,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const
regnode *o, const regmatch_
/* And things that aren't in the bitmap, but are small enough to be */
SV* bitmap_range_not_in_bitmap = NULL;
+ const bool inverted = flags & ANYOF_INVERT;
+
if (OP(o) == ANYOFL) {
if (ANYOFL_UTF8_LOCALE_REQD(flags)) {
sv_catpvs(sv, "{utf8-locale-reqd}");
@@ -18900,21 +18903,37 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const
regnode *o, const regmatch_
ANYOF_BITMAP(o),
bitmap_range_not_in_bitmap,
only_utf8_locale_invlist,
- o);
+ o,
+
+ /* Can't try inverting for a
+ * better display if there are
+ * things that haven't been
+ * resolved */
+ unresolved != NULL);
SvREFCNT_dec(bitmap_range_not_in_bitmap);
/* If there are user-defined properties which haven't been defined yet,
- * output them, in a separate [] from the bitmap range stuff */
+ * output them. If the result is not to be inverted, it is clearest to
+ * output them in a separate [] from the bitmap range stuff. If the
+ * result is to be complemented, we have to show everything in one [],
+ * as the inversion applies to the whole thing. Use {braces} to
+ * separate them from anything in the bitmap and anything above the
+ * bitmap. */
if (unresolved) {
- if (do_sep) {
- Perl_sv_catpvf(aTHX_ sv,"%s][%s",PL_colors[1],PL_colors[0]);
+ if (inverted) {
+ if (! do_sep) { /* If didn't output anything in the bitmap */
+ sv_catpvs(sv, "^");
+ }
+ sv_catpvs(sv, "{");
}
- if (flags & ANYOF_INVERT) {
- sv_catpvs(sv, "^");
+ else if (do_sep) {
+ Perl_sv_catpvf(aTHX_ sv,"%s][%s",PL_colors[1],PL_colors[0]);
}
sv_catsv(sv, unresolved);
- do_sep = TRUE;
- SvREFCNT_dec_NN(unresolved);
+ if (inverted) {
+ sv_catpvs(sv, "}");
+ }
+ do_sep = ! inverted;
}
/* And, finally, add the above-the-bitmap stuff */
@@ -18931,9 +18950,11 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const
regnode *o, const regmatch_
Perl_sv_catpvf(aTHX_ sv,"%s][%s",PL_colors[1],PL_colors[0]);
}
- /* And, for easy of understanding, it is always output not-shown as
- * complemented */
- if (flags & ANYOF_INVERT) {
+ /* And, for easy of understanding, it is shown in the
+ * uncomplemented form if possible. The one exception being if
+ * there are unresolved items, where the inversion has to be
+ * delayed until runtime */
+ if (inverted && ! unresolved) {
_invlist_invert(nonbitmap_invlist);
_invlist_subtract(nonbitmap_invlist, PL_InBitmap,
&nonbitmap_invlist);
}
@@ -18970,6 +18991,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const
regnode *o, const regmatch_
/* And finally the matching, closing ']' */
Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]);
+
+ SvREFCNT_dec(unresolved);
}
else if (k == POSIXD || k == NPOSIXD) {
U8 index = FLAGS(o) * 2;
@@ -19894,7 +19917,9 @@ S_put_charclass_bitmap_innards_common(pTHX_
)
{
/* Create and return an SV containing a displayable version of the bitmap
- * and associated information determined by the input parameters. */
+ * and associated information determined by the input parameters. If the
+ * output would have been only the inversion indicator '^', NULL is instead
+ * returned. */
SV * output;
@@ -19953,9 +19978,8 @@ S_put_charclass_bitmap_innards_common(pTHX_
}
}
- /* If the only thing we output is the '^', clear it */
if (invert && SvCUR(output) == 1) {
- SvCUR_set(output, 0);
+ return NULL;
}
return output;
@@ -19966,7 +19990,8 @@ S_put_charclass_bitmap_innards(pTHX_ SV *sv,
char *bitmap,
SV *nonbitmap_invlist,
SV *only_utf8_locale_invlist,
- const regnode * const node)
+ const regnode * const node,
+ const bool force_as_is_display)
{
/* Appends to 'sv' a displayable version of the innards of the bracketed
* character class defined by the other arguments:
@@ -19982,13 +20007,16 @@ S_put_charclass_bitmap_innards(pTHX_ SV *sv,
* 'node' is the regex pattern node. It is needed only when the above two
* parameters are not null, and is passed so that this routine can
* tease apart the various reasons for them.
+ * 'force_as_is_display' is TRUE if this routine should definitely NOT try
+ * to invert things to see if that leads to a cleaner display. If
+ * FALSE, this routine is free to use its judgment about doing this.
*
* It returns TRUE if there was actually something output. (It may be that
* the bitmap, etc is empty.)
*
* When called for outputting the bitmap of a non-ANYOF node, just pass the
- * bitmap, with the succeeding parameters set to NULL.
- *
+ * bitmap, with the succeeding parameters set to NULL, and the final one to
+ * FALSE.
*/
/* In general, it tries to display the 'cleanest' representation of the
@@ -19996,7 +20024,7 @@ S_put_charclass_bitmap_innards(pTHX_ SV *sv,
* whether the class itself is to be inverted. However, there are some
* cases where it can't try inverting, as what actually matches isn't known
* until runtime, and hence the inversion isn't either. */
- bool inverting_allowed = TRUE;
+ bool inverting_allowed = ! force_as_is_display;
int i;
STRLEN orig_sv_cur = SvCUR(sv);
@@ -20125,7 +20153,10 @@ S_put_charclass_bitmap_innards(pTHX_ SV *sv,
/* If have to take the output as-is, just do that */
if (! inverting_allowed) {
- sv_catsv(sv, as_is_display);
+ if (as_is_display) {
+ sv_catsv(sv, as_is_display);
+ SvREFCNT_dec_NN(as_is_display);
+ }
}
else { /* But otherwise, create the output again on the inverted input, and
use whichever version is shorter */
@@ -20183,17 +20214,19 @@ S_put_charclass_bitmap_innards(pTHX_ SV *sv,
/* Use the shortest representation, taking into account our bias
* against showing it inverted */
- if (SvCUR(inverted_display) + inverted_bias
- < SvCUR(as_is_display) + as_is_bias)
+ if ( inverted_display
+ && ( ! as_is_display
+ || ( SvCUR(inverted_display) + inverted_bias
+ < SvCUR(as_is_display) + as_is_bias)))
{
sv_catsv(sv, inverted_display);
}
- else {
+ else if (as_is_display) {
sv_catsv(sv, as_is_display);
}
- SvREFCNT_dec_NN(as_is_display);
- SvREFCNT_dec_NN(inverted_display);
+ SvREFCNT_dec(as_is_display);
+ SvREFCNT_dec(inverted_display);
}
SvREFCNT_dec_NN(invlist);
diff --git a/regen/warnings.pl b/regen/warnings.pl
index 22c9c1531f..dae0cf1a30 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -358,8 +358,10 @@ EOM
print $warn <<'EOM';
-#define isLEXWARN_on cBOOL(PL_curcop->cop_warnings != pWARN_STD)
-#define isLEXWARN_off cBOOL(PL_curcop->cop_warnings == pWARN_STD)
+#define isLEXWARN_on \
+ cBOOL(PL_curcop && PL_curcop->cop_warnings != pWARN_STD)
+#define isLEXWARN_off \
+ cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD)
#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
#define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
#define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1))
diff --git a/t/op/gv.t b/t/op/gv.t
index d71fd0a54d..03ae46e46b 100644
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
use warnings;
-plan(tests => 276 );
+plan(tests => 277 );
# type coercion on assignment
$foo = 'foo';
@@ -1153,6 +1153,22 @@ pass "No crash due to CvGV pointing to glob copy in the
stash";
is($c_125840, 1, 'RT #125840: $c=$d');
}
+# [perl #128597] Crash when gp_free calls ckWARN_d
+# I am not sure this test even belongs in this file, as the crash was the
+# result of various features interacting. But a call to ckWARN_d from
+# gv.c:gp_free triggered the crash, so this seems as good a place as any.
+# âdieâ (or any abnormal scope exit) can cause the current cop to be freed,
+# if the subroutine containing the âdieâ gets freed as a result. That
+# causes PL_curcop to be set to NULL. If a writable handle gets freed
+# while PL_curcop is NULL, then gp_free will call ckWARN_d while that con-
+# dition still holds, so ckWARN_d needs to know about PL_curcop possibly
+# being NULL.
+SKIP: {
+ skip_if_miniperl("No PerlIO::scalar on miniperl", 1);
+ runperl(prog => 'open my $fh, q|>|, \$buf;'
+ .'my $sub = eval q|sub {exit 0}|; $sub->()');
+ is ($? & 127, 0,"[perl #128597] No crash when gp_free calls ckWARN_d");
+}
__END__
Perl
diff --git a/t/op/lex.t b/t/op/lex.t
index c515449b48..269909e345 100644
--- a/t/op/lex.t
+++ b/t/op/lex.t
@@ -7,7 +7,7 @@ use warnings;
BEGIN { chdir 't' if -d 't'; require './test.pl'; }
-plan(tests => 25);
+plan(tests => 26);
{
no warnings 'deprecated';
@@ -129,7 +129,7 @@ fresh_perl_is(
'* <null> ident'
);
SKIP: {
- skip "Different output on EBCDIC (presumably)", 2 if $::IS_EBCDIC;
+ skip "Different output on EBCDIC (presumably)", 3 if $::IS_EBCDIC;
fresh_perl_is(
qq'"ab}"ax;&\0z\x8Ao}\x82x;', <<gibberish,
Bareword found where operator expected at - line 1, near ""ab}"ax"
@@ -150,6 +150,13 @@ gibberish
{ stderr => 1 },
'gibberish containing &{+z} - used to crash [perl #123753]'
);
+ fresh_perl_is(
+ "\@{\327\n", <<\gibberisi,
+Unrecognized character \xD7; marked by <-- HERE after @{<-- HERE near column 3
at - line 1.
+gibberisi
+ { stderr => 1 },
+ '@ { \327 \n - used to garble output (or fail asan) [perl #128951]'
+ );
}
fresh_perl_is(
diff --git a/toke.c b/toke.c
index 35d587dff0..f5f7fc3537 100644
--- a/toke.c
+++ b/toke.c
@@ -244,7 +244,7 @@ static const char* const lex_state_names[] = {
if (have_x) PL_expect = x; \
PL_bufptr = s; \
PL_last_uni = PL_oldbufptr; \
- PL_last_lop_op = f; \
+ PL_last_lop_op = (f) < 0 ? -(f) : (f); \
if (*s == '(') \
return REPORT( (int)FUNC1 ); \
s = skipspace(s); \
@@ -9024,6 +9024,8 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen,
I32 ck_uni)
else if (ck_uni && bracket == -1)
check_uni();
if (bracket != -1) {
+ bool skip;
+ char *s2;
/* If we were processing {...} notation then... */
if (isIDFIRST_lazy_if(d,is_utf8)) {
/* if it starts as a valid identifier, assume that it is one.
@@ -9072,13 +9074,19 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen,
I32 ck_uni)
if ( !tmp_copline )
tmp_copline = CopLINE(PL_curcop);
- if (s < PL_bufend && isSPACE(*s)) {
- s = skipspace(s);
- }
+ if ((skip = s < PL_bufend && isSPACE(*s)))
+ /* Avoid incrementing line numbers or resetting PL_linestart,
+ in case we have to back up. */
+ s2 = skipspace_flags(s, LEX_NO_INCLINE);
+ else
+ s2 = s;
/* Expect to find a closing } after consuming any trailing whitespace.
*/
- if (*s == '}') {
+ if (*s2 == '}') {
+ /* Now increment line numbers if applicable. */
+ if (skip)
+ s = skipspace(s);
s++;
if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
PL_lex_state = LEX_INTERPEND;
diff --git a/utf8.h b/utf8.h
index c954b42ff5..23a4007224 100644
--- a/utf8.h
+++ b/utf8.h
@@ -156,8 +156,8 @@ END_EXTERN_C
* rarely do we need to distinguish them. The term "NATIVE_UTF8" applies to
* whichever one is applicable on the current platform */
#ifdef PERL_SMALL_MACRO_BUFFER
-#define NATIVE_UTF8_TO_I8(ch) (ch)
-#define I8_TO_NATIVE_UTF8(ch) (ch)
+#define NATIVE_UTF8_TO_I8(ch) ((U8) (ch))
+#define I8_TO_NATIVE_UTF8(ch) ((U8) (ch))
#else
#define NATIVE_UTF8_TO_I8(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) ((U8) (ch)))
#define I8_TO_NATIVE_UTF8(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) ((U8) (ch)))
diff --git a/warnings.h b/warnings.h
index 337bef374c..4d137320bb 100644
--- a/warnings.h
+++ b/warnings.h
@@ -115,8 +115,10 @@
#define WARN_ALLstring
"\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125"
#define WARN_NONEstring
"\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
-#define isLEXWARN_on cBOOL(PL_curcop->cop_warnings != pWARN_STD)
-#define isLEXWARN_off cBOOL(PL_curcop->cop_warnings == pWARN_STD)
+#define isLEXWARN_on \
+ cBOOL(PL_curcop && PL_curcop->cop_warnings != pWARN_STD)
+#define isLEXWARN_off \
+ cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD)
#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
#define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
#define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1))
--
Perl5 Master Repository
