In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/714f94d1f69f6267a390f59f2cf64240cf49a484?hp=9f9332db9d7efbba5be5556810f700da32ad6dee>
- Log -----------------------------------------------------------------
commit 714f94d1f69f6267a390f59f2cf64240cf49a484
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 21 14:52:47 2017 -0700
sort perldiag
M pod/perldiag.pod
commit 283151b7c3d8e1552496c93cd5f20529bbc9b7b2
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 21 14:47:37 2017 -0700
perldiag: Correct diag names
to get diag.t passing.
M pod/perldiag.pod
commit 8d9d049853b4f4c782ea0c573ad6bd24ec24979d
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 21 14:43:16 2017 -0700
Sprinkle diag_listed_as; perldiag tweaks
Trying to get tests passing after making diag.t smarter....
M op.c
M pod/perldiag.pod
M toke.c
commit 77b7eccc0a02a2c5b734eaeb598fbdf30d00cb5e
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 21 14:33:14 2017 -0700
diag.t needs to know that yywarn implies WARN_SYNTAX
because yywarn calls yyerror with PL_in_eval containing the EVAL_WARNONLY
flag, and yyerror calls Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX),...)
when that flag is set.
M t/porting/diag.t
commit 3f673807c860bf6e752b19518730bb1ea96c297c
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 21 14:22:29 2017 -0700
perldiag: Tweaks
Rewrap for better splain output, and tweak the wording in places.
M pod/perldiag.pod
commit 9eb2b0d3ff3723751f3e80d6215a4aaae50d4178
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 21 13:53:42 2017 -0700
Teach diag.t about Perl_form
Some of the error-producing functions are called with Perl_form(...) as
the first argument. diag.t did not know about this, and was missing
many cases.
M t/porting/diag.t
commit 0b6630937e7851e40c44607edcdd1473f6fa5ede
Author: Father Chrysostomos <spr...@cpan.org>
Date: Mon Aug 21 13:52:35 2017 -0700
Move illegalproto warnings to t/lib/warning/toke
The code that produces the warnings is in toke.c, after all.
M t/lib/warnings/op
M t/lib/warnings/toke
commit afe59f35c2b4b2af5b2ebc50a90e2e559b1eaf87
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Aug 6 11:38:28 2017 -0700
Add SORTf_UNSTABLE flag
This will allow a future commit to make mergesort unstable when
the user specifies âno sort stableâ, since it has been decided
that mergesort should remain stable by default.
This bit is not yet used, but is quite harmless.
M lib/B/Op_private.pm
M lib/sort.pm
M op.c
M opcode.h
M perl.h
M pp_sort.c
M regen/op_private
-----------------------------------------------------------------------
Summary of changes:
lib/B/Op_private.pm | 5 +-
lib/sort.pm | 5 +-
op.c | 3 +
opcode.h | 138 +++++++++++++++++++++---------------------
perl.h | 3 +-
pod/perldiag.pod | 168 ++++++++++++++++++++++++++--------------------------
pp_sort.c | 3 +
regen/op_private | 1 +
t/lib/warnings/op | 59 ------------------
t/lib/warnings/toke | 60 ++++++++++++++++++-
t/porting/diag.t | 4 +-
toke.c | 13 ++++
12 files changed, 244 insertions(+), 218 deletions(-)
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index 19d1333e4a..b7dfd39767 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -537,7 +537,7 @@ $bits{sin}{0} = $bf[0];
$bits{snetent}{0} = $bf[0];
@{$bits{socket}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{sockpair}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
-@{$bits{sort}}{6,5,4,3,2,1,0} = ('OPpSORT_STABLE', 'OPpSORT_QSORT',
'OPpSORT_DESCEND', 'OPpSORT_INPLACE', 'OPpSORT_REVERSE', 'OPpSORT_INTEGER',
'OPpSORT_NUMERIC');
+@{$bits{sort}}{7,6,5,4,3,2,1,0} = ('OPpSORT_UNSTABLE', 'OPpSORT_STABLE',
'OPpSORT_QSORT', 'OPpSORT_DESCEND', 'OPpSORT_INPLACE', 'OPpSORT_REVERSE',
'OPpSORT_INTEGER', 'OPpSORT_NUMERIC');
@{$bits{splice}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{split}}{4,3,2} = ('OPpSPLIT_ASSIGN', 'OPpSPLIT_LEX',
'OPpSPLIT_IMPLIM');
@{$bits{sprintf}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@@ -676,6 +676,7 @@ our %defines = (
OPpSORT_QSORT => 32,
OPpSORT_REVERSE => 4,
OPpSORT_STABLE => 64,
+ OPpSORT_UNSTABLE => 128,
OPpSPLIT_ASSIGN => 16,
OPpSPLIT_IMPLIM => 4,
OPpSPLIT_LEX => 8,
@@ -775,6 +776,7 @@ our %labels = (
OPpSORT_QSORT => 'QSORT',
OPpSORT_REVERSE => 'REV',
OPpSORT_STABLE => 'STABLE',
+ OPpSORT_UNSTABLE => 'UNSTABLE',
OPpSPLIT_ASSIGN => 'ASSIGN',
OPpSPLIT_IMPLIM => 'IMPLIM',
OPpSPLIT_LEX => 'LEX',
@@ -872,6 +874,7 @@ $ops_using{OPpSORT_NUMERIC} = $ops_using{OPpSORT_DESCEND};
$ops_using{OPpSORT_QSORT} = $ops_using{OPpSORT_DESCEND};
$ops_using{OPpSORT_REVERSE} = $ops_using{OPpSORT_DESCEND};
$ops_using{OPpSORT_STABLE} = $ops_using{OPpSORT_DESCEND};
+$ops_using{OPpSORT_UNSTABLE} = $ops_using{OPpSORT_DESCEND};
$ops_using{OPpSPLIT_IMPLIM} = $ops_using{OPpSPLIT_ASSIGN};
$ops_using{OPpSPLIT_LEX} = $ops_using{OPpSPLIT_ASSIGN};
$ops_using{OPpTRANS_DELETE} = $ops_using{OPpTRANS_COMPLEMENT};
diff --git a/lib/sort.pm b/lib/sort.pm
index 7c8e50db57..99d9f0b04c 100644
--- a/lib/sort.pm
+++ b/lib/sort.pm
@@ -1,6 +1,6 @@
package sort;
-our $VERSION = '2.02';
+our $VERSION = '2.03';
# The hints for pp_sort are now stored in $^H{sort}; older versions
# of perl used the global variable $sort::hints. -- rjh 2005-12-19
@@ -9,6 +9,7 @@ $sort::quicksort_bit = 0x00000001;
$sort::mergesort_bit = 0x00000002;
$sort::sort_bits = 0x000000FF; # allow 256 different ones
$sort::stable_bit = 0x00000100;
+$sort::unstable_bit = 0x00000200;
use strict;
@@ -29,6 +30,7 @@ sub import {
$^H{sort} |= $sort::mergesort_bit;
} elsif ($_ eq 'stable') {
$^H{sort} |= $sort::stable_bit;
+ $^H{sort} &= ~$sort::unstable_bit;
} elsif ($_ eq 'defaults') {
$^H{sort} = 0;
} else {
@@ -53,6 +55,7 @@ sub unimport {
$^H{sort} &= ~$sort::sort_bits;
} elsif ($_ eq 'stable') {
$^H{sort} &= ~$sort::stable_bit;
+ $^H{sort} |= $sort::unstable_bit;
} else {
require Carp;
Carp::croak("sort: unknown subpragma '$_'");
diff --git a/op.c b/op.c
index e8fbb1eeb0..f37da2c164 100644
--- a/op.c
+++ b/op.c
@@ -662,6 +662,7 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN
len, const U32 flags)
if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
&& isASCII(name[1])
&& (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1]))) {
+ /* diag_listed_as: Can't use global %s in "%s" */
yyerror(Perl_form(aTHX_ "Can't use global %c^%c%.*s in \"%s\"",
name[0], toCTRL(name[1]), (int)(len - 2), name +
2,
PL_parser->in_my == KEY_state ? "state" : "my"));
@@ -11166,6 +11167,8 @@ Perl_ck_sort(pTHX_ OP *o)
o->op_private |= OPpSORT_QSORT;
if ((sorthints & HINT_SORT_STABLE) != 0)
o->op_private |= OPpSORT_STABLE;
+ if ((sorthints & HINT_SORT_UNSTABLE) != 0)
+ o->op_private |= OPpSORT_UNSTABLE;
}
}
diff --git a/opcode.h b/opcode.h
index bd8de366e5..943daa5939 100644
--- a/opcode.h
+++ b/opcode.h
@@ -2299,6 +2299,7 @@ END_EXTERN_C
#define OPpOFFBYONE 0x80
#define OPpOPEN_OUT_CRLF 0x80
#define OPpPV_IS_UTF8 0x80
+#define OPpSORT_UNSTABLE 0x80
#define OPpTRANS_DELETE 0x80
START_EXTERN_C
@@ -2412,6 +2413,7 @@ EXTCONST char PL_op_private_labels[] = {
'T','A','R','G','\0',
'T','A','R','G','M','Y','\0',
'U','N','I','\0',
+ 'U','N','S','T','A','B','L','E','\0',
'U','T','F','\0',
'k','e','y','\0',
'o','f','f','s','e','t','\0',
@@ -2434,11 +2436,11 @@ EXTCONST char PL_op_private_labels[] = {
EXTCONST I16 PL_op_private_bitfields[] = {
0, 8, -1,
0, 8, -1,
- 0, 556, -1,
+ 0, 565, -1,
0, 8, -1,
0, 8, -1,
- 0, 563, -1,
- 0, 552, -1,
+ 0, 572, -1,
+ 0, 561, -1,
1, -1, 0, 529, 1, 33, 2, 283, -1,
4, -1, 1, 164, 2, 171, 3, 178, -1,
4, -1, 0, 529, 1, 33, 2, 283, 3, 110, -1,
@@ -2617,49 +2619,49 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* shift */
84, /* unshift */
143, /* sort */
- 150, /* reverse */
+ 151, /* reverse */
0, /* grepstart */
- 152, /* grepwhile */
+ 153, /* grepwhile */
0, /* mapstart */
0, /* mapwhile */
0, /* range */
- 154, /* flip */
- 154, /* flop */
+ 155, /* flip */
+ 155, /* flop */
0, /* and */
0, /* or */
12, /* xor */
0, /* dor */
- 156, /* cond_expr */
+ 157, /* cond_expr */
0, /* andassign */
0, /* orassign */
0, /* dorassign */
- 158, /* entersub */
- 165, /* leavesub */
- 165, /* leavesublv */
+ 159, /* entersub */
+ 166, /* leavesub */
+ 166, /* leavesublv */
0, /* argcheck */
- 167, /* argelem */
+ 168, /* argelem */
0, /* argdefelem */
- 169, /* caller */
+ 170, /* caller */
52, /* warn */
52, /* die */
52, /* reset */
-1, /* lineseq */
- 171, /* nextstate */
- 171, /* dbstate */
+ 172, /* nextstate */
+ 172, /* dbstate */
-1, /* unstack */
-1, /* enter */
- 172, /* leave */
+ 173, /* leave */
-1, /* scope */
- 174, /* enteriter */
- 178, /* iter */
+ 175, /* enteriter */
+ 179, /* iter */
-1, /* enterloop */
- 179, /* leaveloop */
+ 180, /* leaveloop */
-1, /* return */
- 181, /* last */
- 181, /* next */
- 181, /* redo */
- 181, /* dump */
- 181, /* goto */
+ 182, /* last */
+ 182, /* next */
+ 182, /* redo */
+ 182, /* dump */
+ 182, /* goto */
52, /* exit */
0, /* method */
0, /* method_named */
@@ -2672,7 +2674,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* leavewhen */
-1, /* break */
-1, /* continue */
- 183, /* open */
+ 184, /* open */
52, /* close */
52, /* pipe_op */
52, /* fileno */
@@ -2688,7 +2690,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
52, /* getc */
52, /* read */
52, /* enterwrite */
- 165, /* leavewrite */
+ 166, /* leavewrite */
-1, /* prtf */
-1, /* print */
-1, /* say */
@@ -2718,33 +2720,33 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* getpeername */
0, /* lstat */
0, /* stat */
- 188, /* ftrread */
- 188, /* ftrwrite */
- 188, /* ftrexec */
- 188, /* fteread */
- 188, /* ftewrite */
- 188, /* fteexec */
- 193, /* ftis */
- 193, /* ftsize */
- 193, /* ftmtime */
- 193, /* ftatime */
- 193, /* ftctime */
- 193, /* ftrowned */
- 193, /* fteowned */
- 193, /* ftzero */
- 193, /* ftsock */
- 193, /* ftchr */
- 193, /* ftblk */
- 193, /* ftfile */
- 193, /* ftdir */
- 193, /* ftpipe */
- 193, /* ftsuid */
- 193, /* ftsgid */
- 193, /* ftsvtx */
- 193, /* ftlink */
- 193, /* fttty */
- 193, /* fttext */
- 193, /* ftbinary */
+ 189, /* ftrread */
+ 189, /* ftrwrite */
+ 189, /* ftrexec */
+ 189, /* fteread */
+ 189, /* ftewrite */
+ 189, /* fteexec */
+ 194, /* ftis */
+ 194, /* ftsize */
+ 194, /* ftmtime */
+ 194, /* ftatime */
+ 194, /* ftctime */
+ 194, /* ftrowned */
+ 194, /* fteowned */
+ 194, /* ftzero */
+ 194, /* ftsock */
+ 194, /* ftchr */
+ 194, /* ftblk */
+ 194, /* ftfile */
+ 194, /* ftdir */
+ 194, /* ftpipe */
+ 194, /* ftsuid */
+ 194, /* ftsgid */
+ 194, /* ftsvtx */
+ 194, /* ftlink */
+ 194, /* fttty */
+ 194, /* fttext */
+ 194, /* ftbinary */
84, /* chdir */
84, /* chown */
75, /* chroot */
@@ -2764,17 +2766,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* rewinddir */
0, /* closedir */
-1, /* fork */
- 197, /* wait */
+ 198, /* wait */
84, /* waitpid */
84, /* system */
84, /* exec */
84, /* kill */
- 197, /* getppid */
+ 198, /* getppid */
84, /* getpgrp */
84, /* setpgrp */
84, /* getpriority */
84, /* setpriority */
- 197, /* time */
+ 198, /* time */
-1, /* tms */
0, /* localtime */
52, /* gmtime */
@@ -2794,8 +2796,8 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* require */
0, /* dofile */
-1, /* hintseval */
- 198, /* entereval */
- 165, /* leaveeval */
+ 199, /* entereval */
+ 166, /* leaveeval */
0, /* entertry */
-1, /* leavetry */
0, /* ghbyname */
@@ -2833,18 +2835,18 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* lock */
0, /* once */
-1, /* custom */
- 204, /* coreargs */
- 208, /* avhvswitch */
+ 205, /* coreargs */
+ 209, /* avhvswitch */
3, /* runcv */
0, /* fc */
-1, /* padcv */
-1, /* introcv */
-1, /* clonecv */
- 210, /* padrange */
- 212, /* refassign */
- 218, /* lvref */
- 224, /* lvrefslice */
- 225, /* lvavref */
+ 211, /* padrange */
+ 213, /* refassign */
+ 219, /* lvref */
+ 225, /* lvrefslice */
+ 226, /* lvavref */
0, /* anonconst */
};
@@ -2905,7 +2907,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x2e5c, 0x2d58, 0x1074, 0x19d0, 0x2f4c, 0x40c4, 0x0003, /* multideref */
0x2e5c, 0x33f8, 0x0350, 0x2b6c, 0x2489, /* split */
0x2e5c, 0x20f9, /* list */
- 0x3f38, 0x3694, 0x1310, 0x27ac, 0x39e8, 0x28a4, 0x3361, /* sort */
+ 0x449c, 0x3f38, 0x3694, 0x1310, 0x27ac, 0x39e8, 0x28a4, 0x3361, /* sort */
0x27ac, 0x0003, /* reverse */
0x0614, 0x0003, /* grepwhile */
0x2bf8, 0x0003, /* flip, flop */
@@ -2919,7 +2921,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x2e5c, 0x33f8, 0x0f6c, 0x3a65, /* enteriter */
0x3a65, /* iter */
0x2cfc, 0x0067, /* leaveloop */
- 0x449c, 0x0003, /* last, next, redo, dump, goto */
+ 0x45bc, 0x0003, /* last, next, redo, dump, goto */
0x35dc, 0x34f8, 0x2714, 0x2650, 0x018f, /* open */
0x1c70, 0x1ecc, 0x1d88, 0x1b44, 0x0003, /* ftrread, ftrwrite, ftrexec,
fteread, ftewrite, fteexec */
0x1c70, 0x1ecc, 0x1d88, 0x0003, /* ftis, ftsize, ftmtime, ftatime,
ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir,
ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ... [12 chars truncated]
@@ -3106,7 +3108,7 @@ EXTCONST U8 PL_op_private_valid[] = {
/* POP */ (OPpARG1_MASK),
/* SHIFT */ (OPpARG1_MASK),
/* UNSHIFT */ (OPpARG4_MASK|OPpTARGET_MY),
- /* SORT */
(OPpSORT_NUMERIC|OPpSORT_INTEGER|OPpSORT_REVERSE|OPpSORT_INPLACE|OPpSORT_DESCEND|OPpSORT_QSORT|OPpSORT_STABLE),
+ /* SORT */
(OPpSORT_NUMERIC|OPpSORT_INTEGER|OPpSORT_REVERSE|OPpSORT_INPLACE|OPpSORT_DESCEND|OPpSORT_QSORT|OPpSORT_STABLE|OPpSORT_UNSTABLE),
/* REVERSE */ (OPpARG1_MASK|OPpREVERSE_INPLACE),
/* GREPSTART */ (OPpARG1_MASK),
/* GREPWHILE */ (OPpARG1_MASK|OPpTRUEBOOL),
diff --git a/perl.h b/perl.h
index f9d7dd0492..6f488203dd 100644
--- a/perl.h
+++ b/perl.h
@@ -5408,7 +5408,8 @@ typedef enum {
#define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */
#define HINT_SORT_QUICKSORT 0x00000001
#define HINT_SORT_MERGESORT 0x00000002
-#define HINT_SORT_STABLE 0x00000100 /* sort styles (currently one) */
+#define HINT_SORT_STABLE 0x00000100 /* sort styles */
+#define HINT_SORT_UNSTABLE 0x00000200
/* flags for PL_sawampersand */
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 7e8d827216..c05d00a531 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -690,6 +690,20 @@ be directly assigned to.
(S io) You tried to apply an encoding that did not exist to a filehandle,
either with open() or binmode().
+=item Cannot open %s as a dirhandle: it is already open as a filehandle
+
+(F) You tried to use opendir() to associate a dirhandle to a symbol (glob
+or scalar) that already holds a filehandle. Since this idiom might render
+your code confusing, it was deprecated in Perl 5.10. As of Perl 5.28, it
+is a fatal error.
+
+=item Cannot open %s as a filehandle: it is already open as a dirhandle
+
+(F) You tried to use open() to associate a filehandle to a symbol (glob
+or scalar) that already holds a dirhandle. Since this idiom might render
+your code confusing, it was deprecated in Perl 5.10. As of Perl 5.28, it
+is a fatal error.
+
=item Cannot pack %f with '%c'
(F) You tried converting an infinity or not-a-number to an integer,
@@ -1166,6 +1180,8 @@ a NULL.
=item Can't modify non-lvalue subroutine call of &%s
+=item Can't modify non-lvalue subroutine call of &%s in %s
+
(F) Subroutines meant to be used in lvalue context should be declared as
such. See L<perlsub/"Lvalue subroutines">.
@@ -1619,7 +1635,8 @@ uses the character values modulus 256 instead, as if you
had provided:
unpack("s", "\x{f3}b")
-=item charnames alias definitions may not contain a sequence of multiple spaces
+=item charnames alias definitions may not contain a sequence of multiple
+spaces; marked by S<<-- HERE> in %s
(F) You defined a character name which had multiple space characters
in a row. Change them to single spaces. Usually these names are
@@ -1627,7 +1644,8 @@ defined in the C<:alias> import argument to C<use
charnames>, but they
could be defined by a translator installed into C<$^H{charnames}>. See
L<charnames/CUSTOM ALIASES>.
-=item charnames alias definitions may not contain trailing white-space
+=item charnames alias definitions may not contain trailing white-space;
+marked by S<<-- HERE> in %s
(F) You defined a character name which ended in a space
character. Remove the trailing space(s). Usually these names are
@@ -2592,7 +2610,7 @@ zero-length sequence. When such an escape is used in a
character
class its behavior is not well defined. Check that the correct
escape has been used, and the correct charname handler is in scope.
-=item Illegal binary digit %s
+=item Illegal binary digit '%c'
(F) You used a digit other than 0 or 1 in a binary number.
@@ -2672,7 +2690,7 @@ numbers don't take to this kindly.
(F) The number of bits in vec() (the third argument) must be a power of
two from 1 to 32 (or 64, if your platform supports that).
-=item Illegal octal digit %s
+=item Illegal octal digit '%c'
(F) You used an 8 or 9 in an octal number.
@@ -2774,6 +2792,13 @@ not match 8 spaces.
text. You should check the pattern to ensure that recursive patterns
either consume text or fail.
+=item Infinite recursion via empty pattern
+
+(F) You tried to use the empty pattern inside of a regex code block,
+for instance C</(?{ s!!! })/>, which resulted in re-executing
+the same pattern, which is an infinite loop which is broken by
+throwing an exception.
+
=item Initialization of state variables in list context currently forbidden
(F) C<state> only permits initializing a single scalar variable, in scalar
@@ -3131,9 +3156,8 @@ syswrite() or send() to read or send bytes from/to :utf8
handles.
(W regexp) (only under C<S<use re 'strict'>> or within C<(?[...])>)
-You specified a character that has the given plainer way of writing it,
-and which is also portable to platforms running with different character
-sets.
+You specified a character that has the given plainer way of writing it, and
+which is also portable to platforms running with different character sets.
=item $* is no longer supported. Its use will be fatal in Perl 5.30
@@ -3393,13 +3417,12 @@ platform (overflows). Details as to the exact
malformation are given in
the variable, C<%s>, part of the message.
One possible cause is that you set the UTF8 flag yourself for data that
-you thought to be in UTF-8 but it wasn't (it was for example legacy
-8-bit data). To guard against this, you can use C<Encode::decode('UTF-8',
...)>.
+you thought to be in UTF-8 but it wasn't (it was for example legacy 8-bit
+data). To guard against this, you can use C<Encode::decode('UTF-8', ...)>.
If you use the C<:encoding(UTF-8)> PerlIO layer for input, invalid byte
-sequences are handled gracefully, but if you use C<:utf8>, the flag is
-set without validating the data, possibly resulting in this error
-message.
+sequences are handled gracefully, but if you use C<:utf8>, the flag is set
+without validating the data, possibly resulting in this error message.
See also L<Encode/"Handling Malformed Data">.
@@ -3407,6 +3430,19 @@ See also L<Encode/"Handling Malformed Data">.
(F) The charnames handler returned malformed UTF-8.
+=item Malformed UTF-8 string in "%s"
+
+(F) This message indicates a bug either in the Perl core or in XS
+code. Such code was trying to find out if a character, allegedly
+stored internally encoded as UTF-8, was of a given type, such as
+being punctuation or a digit. But the character was not encoded
+in legal UTF-8. The C<%s> is replaced by a string that can be used
+by knowledgeable people to determine what the type being checked
+against was.
+
+Passing malformed strings was deprecated in Perl 5.18, and
+became fatal in Perl 5.26.
+
=item Malformed UTF-8 string in '%c' format in unpack
(F) You tried to unpack something that didn't comply with UTF-8 encoding
@@ -3422,19 +3458,6 @@ rules and perl was unable to guess how to make more
progress.
(F) You tried to unpack something that didn't comply with UTF-8 encoding
rules and perl was unable to guess how to make more progress.
-=item Malformed UTF-8 string in "%s"
-
-(F) This message indicates a bug either in the Perl core or in XS
-code. Such code was trying to find out if a character, allegedly
-stored internally encoded as UTF-8, was of a given type, such as
-being punctuation or a digit. But the character was not encoded
-in legal UTF-8. The C<%s> is replaced by a string that can be used
-by knowledgeable people to determine what the type being checked
-against was.
-
-Passing malformed strings was deprecated in Perl 5.18, and
-became fatal in Perl 5.26.
-
=item Malformed UTF-16 surrogate
(F) Perl thought it was reading UTF-16 encoded character data but while
@@ -4046,11 +4069,13 @@ doesn't know where you wanted to redirect stdout.
redirection, and found a '>' or a '>>' on the command line, but can't
find the name of the file to which to write data destined for stdout.
+=item No package name allowed for subroutine %s in "our"
+
=item No package name allowed for variable %s in "our"
-(F) Fully qualified variable names are not allowed in "our"
-declarations, because that doesn't make much sense under existing
-rules. Such syntax is reserved for future extensions.
+(F) Fully qualified subroutine and variable names are not allowed in "our"
+declarations, because that doesn't make much sense under existing rules.
+Such syntax is reserved for future extensions.
=item No Perl script found in input
@@ -4281,22 +4306,6 @@ that isn't open. Check your control flow. See also
L<perlfunc/-X>.
(S internal) An internal warning that the grammar is screwed up.
-=item Cannot open %s as a filehandle: it is already open as a dirhandle
-
-(F) You tried to use open() to associate a filehandle to
-a symbol (glob or scalar) that already holds a dirhandle.
-This idiom might render your code confusing
-and this was deprecated in Perl 5.10. As of Perl 5.28, this
-is a fatal error.
-
-=item Cannot open %s as a dirhandle: it is already open as a filehandle
-
-(F) You tried to use opendir() to associate a dirhandle to
-a symbol (glob or scalar) that already holds a filehandle.
-This idiom might render your code confusing
-and this was deprecated in Perl 5.10. As of Perl 5.28, this
-is a fatal error.
-
=item Operand with no preceding operator in regex; marked by S<<-- HERE> in
m/%s/
@@ -5558,19 +5567,18 @@ L<perlfunc/setsockopt>.
=item Setting $/ to a reference to %s is forbidden
-(F) You assigned a reference to a scalar to C<$/> where the
-referenced item is not a positive integer. In older perls this B<appeared>
-to work the same as setting it to C<undef> but was in fact internally
-different, less efficient and with very bad luck could have resulted in
-your file being split by a stringified form of the reference.
+(F) You assigned a reference to a scalar to C<$/> where the referenced item is
+not a positive integer. In older perls this B<appeared> to work the same as
+setting it to C<undef> but was in fact internally different, less efficient
+and with very bad luck could have resulted in your file being split by a
+stringified form of the reference.
In Perl 5.20.0 this was changed so that it would be B<exactly> the same as
-setting C<$/> to undef, with the exception that this warning would be
-thrown.
+setting C<$/> to undef, with the exception that this warning would be thrown.
-You are recommended to change your code to set C<$/> to C<undef> explicitly
-if you wish to slurp the file. As of Perl 5.28 assigning C<$/> to a
-reference to an integer which isn't positive is a fatal error.
+You are recommended to change your code to set C<$/> to C<undef> explicitly if
+you wish to slurp the file. As of Perl 5.28 assigning C<$/> to a reference
+to an integer which isn't positive is a fatal error.
=item Setting $/ to %s reference is forbidden
@@ -5640,11 +5648,6 @@ Perl. Particularly, its current behavior is noticed for
being
unnecessarily complex and unintuitive, and is very likely to be
overhauled.
-=item sort is now a reserved word
-
-(F) An ancient error message that almost nobody ever runs into anymore.
-But before sort was a keyword, people sometimes used it as a filehandle.
-
=item Sorry, hash keys must be smaller than 2**31 bytes
(F) You tried to create a hash containing a very large key, where "very
@@ -5652,6 +5655,11 @@ large" means that it needs at least 2 gigabytes to
store. Unfortunately,
Perl doesn't yet handle such large hash keys. You should
reconsider your design to avoid hashing such a long string directly.
+=item sort is now a reserved word
+
+(F) An ancient error message that almost nobody ever runs into anymore.
+But before sort was a keyword, people sometimes used it as a filehandle.
+
=item Source filters apply only to byte streams
(F) You tried to activate a source filter (usually by loading a
@@ -6088,13 +6096,12 @@ system call to call, silly dilly.
=item Too few arguments for subroutine '%s'
-(F) A subroutine using a signature received too few arguments than
-required by the signature. The caller of the subroutine is presumably
-at fault.
+(F) A subroutine using a signature fewer arguments than required by the
+signature. The caller of the subroutine is presumably at fault.
-The message attempts to include the name of the called subroutine. If the
-subroutine has been aliased, the subroutine's original name will be shown,
-regardless of what name the caller used.
+The message attempts to include the name of the called subroutine. If
+the subroutine has been aliased, the subroutine's original name will be
+shown, regardless of what name the caller used.
=item Too late for "-%s" option
@@ -6128,9 +6135,8 @@ BEGIN block.
=item Too many arguments for subroutine '%s'
-(F) A subroutine using a signature received too many arguments than
-required by the signature. The caller of the subroutine is presumably
-at fault.
+(F) A subroutine using a signature received more arguments than permitted
+by the signature. The caller of the subroutine is presumably at fault.
The message attempts to include the name of the called subroutine. If the
subroutine has been aliased, the subroutine's original name will be shown,
@@ -6517,7 +6523,7 @@ iterating over it, and someone else stuck a message in
the stream of
data Perl expected. Someone's very confused, or perhaps trying to
subvert Perl's population of %ENV for nefarious purposes.
-=item Unknown regex modifier "%s"
+=item Unknown regexp modifier "/%s"
(F) Alphanumerics immediately following the closing delimiter
of a regular expression pattern are interpreted by Perl as modifier
@@ -6932,12 +6938,11 @@ is deprecated. See L<perlvar/"$[">.
=item Use of bare << to mean <<"" is forbidden
-(F) You are now required to use the explicitly quoted
-form if you wish to use an empty line as the terminator of the
-here-document.
+(F) You are now required to use the explicitly quoted form if you wish
+to use an empty line as the terminator of the here-document.
-Use of a bare terminator was deprecated in Perl 5.000, and
-is a fatal error as of Perl 5.28.
+Use of a bare terminator was deprecated in Perl 5.000, and is a fatal
+error as of Perl 5.28.
=item Use of /c modifier is meaningless in s///
@@ -6972,13 +6977,6 @@ became a fatal error in Perl 5.28.
it may skip items, or visit items more than once. Consider using
C<keys()> instead of C<each()>.
-=item Infinite recursion via empty pattern
-
-(F) You tried to use the empty pattern inside of a regex code block,
-for instance C</(?{ s!!! })/>, which resulted in re-executing
-the same pattern, which is an infinite loop which is broken by
-throwing an exception.
-
=item Use of := for an empty attribute list is not allowed
(F) The construction C<my $x := 42> used to parse as equivalent to
@@ -7063,10 +7061,10 @@ See the explanation under L<perlvar/$_>.
=item Use of strings with code points over 0xFF as arguments to %s
operator is not allowed
-(F) You tried to use one of the string bitwise operators
-(C<&> or C<|> or C<^> or C<~>) on a string containing a code point over
-0xFF. The string bitwise operators treat their operands as strings of
-bytes, and values beyond 0xFF are nonsensical in this context.
+(F) You tried to use one of the string bitwise operators (C<&> or C<|> or C<^>
or
+C<~>) on a string containing a code point over 0xFF. The string bitwise
+operators treat their operands as strings of bytes, and values beyond
+0xFF are nonsensical in this context.
This became fatal in Perl 5.28.
diff --git a/pp_sort.c b/pp_sort.c
index a54768a022..ee1dc5dd98 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -46,6 +46,7 @@
#define SORTf_DESC 1
#define SORTf_STABLE 2
#define SORTf_QSORT 4
+#define SORTf_UNSTABLE 8
/*
* The mergesort implementation is by Peter M. Mcilroy <pmcil...@lucent.com>.
@@ -1494,6 +1495,8 @@ PP(pp_sort)
sort_flags |= SORTf_QSORT;
if ((priv & OPpSORT_STABLE) != 0)
sort_flags |= SORTf_STABLE;
+ if ((priv & OPpSORT_UNSTABLE) != 0)
+ sort_flags |= SORTf_UNSTABLE;
if (gimme != G_ARRAY) {
SP = MARK;
diff --git a/regen/op_private b/regen/op_private
index 753a0bd323..94e0009425 100644
--- a/regen/op_private
+++ b/regen/op_private
@@ -672,6 +672,7 @@ addbits('sort',
4 => qw(OPpSORT_DESCEND DESC ), # Descending sort
5 => qw(OPpSORT_QSORT QSORT ), # Use quicksort (not mergesort)
6 => qw(OPpSORT_STABLE STABLE ), # Use a stable algorithm
+ 7 => qw(OPpSORT_UNSTABLE UNSTABLE),# Use an unstable algorithm
);
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index b128eec29b..d9116fa9d7 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -1128,65 +1128,6 @@ Prototype mismatch: sub main::frèd () vs ($) at - line
5.
use utf8;
use open qw( :utf8 :std );
use warnings;
-eval "sub fòò (@\$\0) {}";
-EXPECT
-Prototype after '@' for main::fòò : @$\0 at (eval 1) line 1.
-Illegal character in prototype for main::fòò : @$\0 at (eval 1) line 1.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-eval "sub foo (@\0) {}";
-EXPECT
-Prototype after '@' for main::foo : @\0 at (eval 1) line 1.
-Illegal character in prototype for main::foo : @\0 at (eval 1) line 1.
-########
-# op.c
-BEGIN {
- if (ord('A') == 193) {
- print "SKIPPED\n# Different results on EBCDIC";
- exit 0;
- }
-}
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-BEGIN { $::{"foo"} = "\@\$\0L\351on" }
-BEGIN { eval "sub foo (@\$\0L\x{c3}\x{a9}on) {}"; }
-EXPECT
-Prototype after '@' for main::foo : @$\x{0}L... at (eval 1) line 1.
-Illegal character in prototype for main::foo : @$\x{0}L... at (eval 1) line 1.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-BEGIN { eval "sub foo (@\0) {}"; }
-EXPECT
-Prototype after '@' for main::foo : @\0 at (eval 1) line 1.
-Illegal character in prototype for main::foo : @\0 at (eval 1) line 1.
-########
-# op.c
-use warnings;
-eval "sub foo (@\xAB) {}";
-EXPECT
-Prototype after '@' for main::foo : @\x{ab} at (eval 1) line 1.
-Illegal character in prototype for main::foo : @\x{ab} at (eval 1) line 1.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-BEGIN { eval "sub foo (@\x{30cb}) {}"; }
-EXPECT
-Prototype after '@' for main::foo : @\x{30cb} at (eval 1) line 1.
-Illegal character in prototype for main::foo : @\x{30cb} at (eval 1) line 1.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
BEGIN { $::{"foo"} = "\x{30cb}" }
BEGIN { eval "sub foo {}"; }
EXPECT
diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index b9c01c90f5..0833a0ff7b 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -2,8 +2,11 @@ toke.c AOK
we seem to have lost a few ambiguous warnings!!
-
- $a = <<;
+ Prototype after '@' for main::foo
+ sub foo (@$)
+
+ Illegal character in prototype for main::foo
+ sub foo (x)
\1 better written as $1
use warnings 'syntax' ;
@@ -123,6 +126,59 @@ toke.c AOK
*foo *foo
__END__
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+eval "sub fòò (@\$\0) {}";
+EXPECT
+Prototype after '@' for main::fòò : @$\0 at (eval 1) line 1.
+Illegal character in prototype for main::fòò : @$\0 at (eval 1) line 1.
+########
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+eval "sub foo (@\0) {}";
+EXPECT
+Prototype after '@' for main::foo : @\0 at (eval 1) line 1.
+Illegal character in prototype for main::foo : @\0 at (eval 1) line 1.
+########
+BEGIN {
+ if (ord('A') == 193) {
+ print "SKIPPED\n# Different results on EBCDIC";
+ exit 0;
+ }
+}
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+BEGIN { $::{"foo"} = "\@\$\0L\351on" }
+BEGIN { eval "sub foo (@\$\0L\x{c3}\x{a9}on) {}"; }
+EXPECT
+Prototype after '@' for main::foo : @$\x{0}L... at (eval 1) line 1.
+Illegal character in prototype for main::foo : @$\x{0}L... at (eval 1) line 1.
+########
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+BEGIN { eval "sub foo (@\0) {}"; }
+EXPECT
+Prototype after '@' for main::foo : @\0 at (eval 1) line 1.
+Illegal character in prototype for main::foo : @\0 at (eval 1) line 1.
+########
+use warnings;
+eval "sub foo (@\xAB) {}";
+EXPECT
+Prototype after '@' for main::foo : @\x{ab} at (eval 1) line 1.
+Illegal character in prototype for main::foo : @\x{ab} at (eval 1) line 1.
+########
+use utf8;
+use open qw( :utf8 :std );
+use warnings;
+BEGIN { eval "sub foo (@\x{30cb}) {}"; }
+EXPECT
+Prototype after '@' for main::foo : @\x{30cb} at (eval 1) line 1.
+Illegal character in prototype for main::foo : @\x{30cb} at (eval 1) line 1.
+########
# toke.c
$a =~ m/$foo/eq;
$a =~ s/$foo/fool/seq;
diff --git a/t/porting/diag.t b/t/porting/diag.t
index 86c5f087bf..22cde90a9c 100644
--- a/t/porting/diag.t
+++ b/t/porting/diag.t
@@ -49,7 +49,7 @@ my $source_msg_re =
"(?<routine>\\bDIE\\b|$function_re)";
my $text_re = '"(?<text>(?:\\\\"|[^"]|"\s*[A-Z_]+\s*")*)"';
my $source_msg_call_re = qr/$source_msg_re(?:_nocontext)? \s*
- \((?:aTHX_)? \s*
+ \( (?: \s* Perl_form \( )? (?:aTHX_)? \s*
(?:packWARN\d*\((?<category>.*?)\),)? \s*
$text_re /x;
my $bad_version_re = qr{BADVERSION\([^"]*$text_re};
@@ -305,6 +305,8 @@ sub check_file {
# Sometimes the regexp will pick up too much for the category
# e.g., WARN_UNINITIALIZED), PL_warn_uninit_sv ... up to the next )
$category && $category =~ s/\).*//s;
+ # Special-case yywarn
+ /yywarn/ and $category = 'syntax';
if (/win32_croak_not_implemented\(/) {
$name .= " not implemented!"
}
diff --git a/toke.c b/toke.c
index 3899b729af..99b737ba0e 100644
--- a/toke.c
+++ b/toke.c
@@ -2702,6 +2702,9 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s,
const char* const e)
}
}
if (*(s-1) == ' ') {
+ /* diag_listed_as: charnames alias definitions may not contain
+ trailing white-space; marked by <-- HERE in %s
+ */
yyerror_pv(
Perl_form(aTHX_
"charnames alias definitions may not contain trailing "
@@ -2724,6 +2727,8 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s,
const char* const e)
(U8 *) PL_parser->bufend,
0,
0 /* 0 means don't die */ );
+ /* diag_listed_as: Malformed UTF-8 returned by \N{%s}
+ immediately after '%s' */
yyerror_pv(
Perl_form(aTHX_
"Malformed UTF-8 returned by %.*s immediately after '%.*s'",
@@ -2741,6 +2746,8 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s,
const char* const e)
/* The final %.*s makes sure that should the trailing NUL be missing
* that this print won't run off the end of the string */
+ /* diag_listed_as: Invalid character in \N{...}; marked by <-- HERE
+ in \N{%s} */
yyerror_pv(
Perl_form(aTHX_
"Invalid character in \\N{...}; marked by <-- HERE in %.*s<-- HERE
%.*s",
@@ -2752,6 +2759,9 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s,
const char* const e)
}
multi_spaces:
+ /* diag_listed_as: charnames alias definitions may not contain a
+ sequence of multiple spaces; marked by <-- HERE
+ in %s */
yyerror_pv(
Perl_form(aTHX_
"charnames alias definitions may not contain a sequence of "
@@ -4613,6 +4623,7 @@ S_tokenize_use(pTHX_ int is_use, char *s) {
PERL_ARGS_ASSERT_TOKENIZE_USE;
if (PL_expect != XSTATE)
+ /* diag_listed_as: "use" not allowed in expression */
yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression",
is_use ? "use" : "no"));
PL_expect = XTERM;
@@ -8858,6 +8869,8 @@ S_pending_ident(pTHX)
if (PL_in_my) {
if (PL_in_my == KEY_our) { /* "our" is merely analogous to "my" */
if (has_colon)
+ /* diag_listed_as: No package name allowed for variable %s
+ in "our" */
yyerror_pv(Perl_form(aTHX_ "No package name allowed for "
"%se %s in \"our\"",
*PL_tokenbuf=='&' ?"subroutin":"variabl",
--
Perl5 Master Repository
