In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/7e30e49f7461aeda1a5ab4539abfbe54f0f50e67?hp=1b51016637278b8990d8aadc7f8cbf4ba92406d6>
- Log -----------------------------------------------------------------
commit 7e30e49f7461aeda1a5ab4539abfbe54f0f50e67
Author: Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>
Date: Tue Jan 17 17:37:56 2017 +0000
Eliminate remaining uses of PL_statbuf
Give Perl_nextargv its own statbuf and pass a pointer to it into
Perl_do_open_raw and thence S_openn_cleanup when needed.
Also reduce the scope of the existing statbuf in Perl_nextargv to make
it clear it's distinct from the one populated by do_open_raw.
Fix perldelta entry for PL_statbuf removal
M doio.c
M embed.fnc
M embed.h
M embedvar.h
M intrpvar.h
M pod/perldelta.pod
M pp_sys.c
M proto.h
M sv.c
commit 6b57559b3d5389dc65364f9910d81b3e8b08e144
Author: Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>
Date: Sun Mar 26 15:26:22 2017 +0200
Improve error message for bogus -MO=⦠arguments
Commit 7a9b44b9 expanded the scope of the string eval that loads the
B::* backend module, but didn't move the $@ check and croak to outside
it. Restore it and further improve the error message.
Before:
$ perl -MO=Concise=-debug -e1
syntax error at (eval 2) line 18, near "="
BEGIN failed--compilation aborted.
After:
$ ./perl -Ilib -MO=Concise=-debug -e1
Loading compiler backend 'B::Concise=-debug' failed: syntax error at
(eval 2) line 18, near "="
at -e line 0.
BEGIN failed--compilation aborted.
M ext/B/B/Concise.pm
M ext/B/O.pm
commit 85cd139f4d2f28f6c63b74dbfc66ce47c6f8a324
Author: Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>
Date: Wed May 31 17:05:22 2017 +0100
Note removal of deprecated attributes in perldelta and perlexperiment
M pod/perldelta.pod
M pod/perlexperiment.pod
commit 01cb645528690d8065b86c3a0db2738055e142de
Author: Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>
Date: Mon Jan 18 12:52:29 2016 +0000
Remove deprecated no-op :locked attribute
It's been a no-op since 5.10 and deprecated since 5.12.
M dist/Attribute-Handlers/lib/Attribute/Handlers.pm
M ext/attributes/attributes.pm
M lib/B/Deparse.pm
M pod/perldiag.pod
M t/lib/warnings/toke
M t/op/attrs.t
M toke.c
commit cfdc35fc22e32a4383f59856f093e3f386a646b7
Author: Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>
Date: Mon Jan 18 12:42:55 2016 +0000
Remove deprecated no-op :unique attribute
It's been deprecated and a no-op since 5.10.
Move :unique test into it own file so it can be skipped separately
Merely parsing an unknown attribute fails, so the skip has to happen
at BEGIN time.
M dist/Attribute-Handlers/lib/Attribute/Handlers.pm
M dist/threads/t/problems.t
A dist/threads/t/unique.t
M ext/attributes/attributes.pm
M pod/perldiag.pod
M t/lib/warnings/toke
M t/op/attrs.t
M toke.c
commit c7321345b8729a0b98040be0b0b96e41f6a13ba8
Author: Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>
Date: Sat Nov 12 17:08:18 2016 +0100
Remove deprecated comma-less format variable lists
This has been issuing a deprecation warning since perl 5.000.
M embed.fnc
M embed.h
M pod/perldelta.pod
M proto.h
M t/lib/warnings/toke
M t/op/write.t
M toke.c
commit c6709bf9918ed61b4a7a0ad24887085bdf1732c9
Author: H.Merijn Brand <h.m.br...@xs4all.nl>
Date: Thu May 11 16:47:45 2017 +0200
Disable readdir_r and readdir64_r on glibc >= 2.24
DESCRIPTION
This function is deprecated; use readdir(3) instead.
The readdir_r() function was invented as a reentrant version of
read-
dir(3). It reads the next directory entry from the directory
stream
dirp, and returns it in the caller-allocated buffer pointed to
by
entry. For details of the dirent structure, see readdir(3).
A pointer to the returned buffer is placed in *result; if the end
of
the directory stream was encountered, then NULL is instead returned
in
*result.
It is recommended that applications use readdir(3) instead of
read-
dir_r(). Furthermore, since version 2.24, glibc deprecates
read-
dir_r(). The reasons are as follows:
* On systems where NAME_MAX is undefined, calling readdir_r() may
be
unsafe because the interface does not allow the caller to
specify
the length of the buffer used for the returned directory entry.
* On some systems, readdir_r() can't read directory entries with
very
long names. When the glibc implementation encounters such a
name,
readdir_r() fails with the error ENAMETOOLONG after the final
direc-
tory entry has been read. On some other systems, readdir_r()
may
return a success status, but the returned d_name field may not
be
null terminated or may be truncated.
* In the current POSIX.1 specification (POSIX.1-2008), readdir(3)
is
not required to be thread-safe. However, in modern
implementations
(including the glibc implementation), concurrent calls to
readdir(3)
that specify different directory streams are thread-safe.
There-
fore, the use of readdir_r() is generally unnecessary in
multi-
threaded programs. In cases where multiple threads must read
from
the same directory stream, using readdir(3) with external
synchro-
nization is still preferable to the use of readdir_r(), for the
rea-
sons given in the points above.
* It is expected that a future version of POSIX.1 will make
read-
dir_r() obsolete, and require that readdir(3) be thread-safe
when
concurrently employed on different directory streams.
M reentr.h
M regen/reentr.pl
commit 0a31ee11c8f69d509334d0813d833cddacf9dacb
Author: Lukas Mai <l....@web.de>
Date: Fri May 26 20:15:12 2017 +0200
add X<s> to s/// in perlop (RT #131371)
This should make 'perldoc -f s' work.
M pod/perlop.pod
commit db2469b300177a4f81d7cf6078ac0ac85f2e1a8b
Author: Yves Orton <demer...@gmail.com>
Date: Mon May 8 15:01:08 2017 +0200
fixup typo (squash candidate) in globbing code comments
This fixes up a typo from 444c4cd5e784ec836ff4a81a582bcb0df9f1e277,
if possible before merging to blead squash this commit with that.
M ext/File-Glob/bsd_glob.c
commit 0db967b2e6a4093a6a5f649190159767e5d005e0
Author: Yves Orton <demer...@gmail.com>
Date: Tue Apr 25 15:17:06 2017 +0200
[perl #131211] fixup File::Glob degenerate matching
The old code would go quadratic with recursion and backtracking
when doing patterns like "a*a*a*a*a*a*a*x" on a file like
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa".
This patch changes the code to not recurse, and to not backtrack,
as per this article from Russ Cox: https://research.swtch.com/glob
It also adds a micro-optimisation for M_ONE and M_SET under the new code.
Thanks to Avar and Russ Cox for helping with this patch, along with
Jilles Tjoelker and the rest of the FreeBSD community.
M MANIFEST
M ext/File-Glob/bsd_glob.c
A ext/File-Glob/t/rt131211.t
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 1 +
dist/Attribute-Handlers/lib/Attribute/Handlers.pm | 8 +-
dist/threads/t/problems.t | 52 +------------
dist/threads/t/unique.t | 81 +++++++++++++++++++
doio.c | 51 ++++++------
embed.fnc | 6 +-
embed.h | 5 +-
embedvar.h | 1 -
ext/B/B/Concise.pm | 4 +-
ext/B/O.pm | 10 +--
ext/File-Glob/bsd_glob.c | 64 +++++++++++----
ext/File-Glob/t/rt131211.t | 94 +++++++++++++++++++++++
ext/attributes/attributes.pm | 19 +----
intrpvar.h | 1 -
lib/B/Deparse.pm | 3 +-
pod/perldelta.pod | 12 ++-
pod/perldiag.pod | 14 ----
pod/perlexperiment.pod | 17 ++--
pod/perlop.pod | 2 +-
pp_sys.c | 2 +-
proto.h | 5 +-
reentr.h | 5 ++
regen/reentr.pl | 5 ++
sv.c | 1 -
t/lib/warnings/toke | 37 ---------
t/op/attrs.t | 7 +-
t/op/write.t | 14 +---
toke.c | 39 +---------
28 files changed, 312 insertions(+), 248 deletions(-)
create mode 100644 dist/threads/t/unique.t
create mode 100644 ext/File-Glob/t/rt131211.t
diff --git a/MANIFEST b/MANIFEST
index b7b6e740df..af0da6c7fc 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3948,6 +3948,7 @@ ext/File-Glob/t/basic.t See if File::Glob works
ext/File-Glob/t/case.t See if File::Glob works
ext/File-Glob/t/global.t See if File::Glob works
ext/File-Glob/t/rt114984.t See if File::Glob works
+ext/File-Glob/t/rt131211.t See if File::Glob works
ext/File-Glob/t/taint.t See if File::Glob works
ext/File-Glob/t/threads.t See if File::Glob + threads works
ext/File-Glob/TODO File::Glob extension todo list
diff --git a/dist/Attribute-Handlers/lib/Attribute/Handlers.pm
b/dist/Attribute-Handlers/lib/Attribute/Handlers.pm
index 7c049d48e6..67e4dc74ac 100644
--- a/dist/Attribute-Handlers/lib/Attribute/Handlers.pm
+++ b/dist/Attribute-Handlers/lib/Attribute/Handlers.pm
@@ -4,7 +4,7 @@ use Carp;
use warnings;
use strict;
use vars qw($VERSION $AUTOLOAD);
-$VERSION = '0.99'; # remember to update version in POD!
+$VERSION = '1.00'; # remember to update version in POD!
# $DB::single=1;
my %symcache;
@@ -139,7 +139,9 @@ sub AUTOLOAD {
croak "Attribute handler '$2' doesn't handle $1 attributes";
}
-my $builtin = qr/lvalue|method|locked|unique|shared/;
+my $builtin = $] ge '5.027000'
+ ? qr/lvalue|method|shared/
+ : qr/lvalue|method|locked|shared|unique/;
sub _gen_handler_AH_() {
return sub {
@@ -270,7 +272,7 @@ Attribute::Handlers - Simpler definition of attribute
handlers
=head1 VERSION
-This document describes version 0.99 of Attribute::Handlers.
+This document describes version 1.00 of Attribute::Handlers.
=head1 SYNOPSIS
diff --git a/dist/threads/t/problems.t b/dist/threads/t/problems.t
index 3f28c0f3b5..3657d3403e 100644
--- a/dist/threads/t/problems.t
+++ b/dist/threads/t/problems.t
@@ -21,18 +21,14 @@ BEGIN {
$| = 1;
if ($] == 5.008) {
- print("1..11\n"); ### Number of tests that will be run ###
+ print("1..6\n"); ### Number of tests that will be run ###
} else {
- print("1..15\n"); ### Number of tests that will be run ###
+ print("1..10\n"); ### Number of tests that will be run ###
}
};
print("ok 1 - Loaded\n");
-### Start of Testing ###
-
-no warnings 'deprecated'; # Suppress warnings related to :unique
-
use Hash::Util 'lock_keys';
my $test :shared = 2;
@@ -93,50 +89,6 @@ if ($] != 5.008)
}
-# bugid 24383 - :unique hashes weren't being made readonly on interpreter
-# clone; check that they are.
-
-our $unique_scalar : unique;
-our @unique_array : unique;
-our %unique_hash : unique;
-threads->create(sub {
- lock($test);
- my $TODO = ":unique needs to be re-implemented in a non-broken way";
- eval { $unique_scalar = 1 };
- print $@ =~ /read-only/
- ? '' : 'not ', "ok $test # TODO $TODO - unique_scalar\n";
- $test++;
- eval { $unique_array[0] = 1 };
- print $@ =~ /read-only/
- ? '' : 'not ', "ok $test # TODO $TODO - unique_array\n";
- $test++;
- if ($] >= 5.008003 && $^O ne 'MSWin32') {
- eval { $unique_hash{abc} = 1 };
- print $@ =~ /disallowed/
- ? '' : 'not ', "ok $test # TODO $TODO - unique_hash\n";
- } else {
- print("ok $test # SKIP $TODO - unique_hash\n");
- }
- $test++;
- })->join;
-
-# bugid #24940 :unique should fail on my and sub declarations
-
-for my $decl ('my $x : unique', 'sub foo : unique') {
- {
- lock($test);
- if ($] >= 5.008005) {
- eval $decl;
- print $@ =~ /^The 'unique' attribute may only be applied to 'our'
variables/
- ? '' : 'not ', "ok $test - $decl\n";
- } else {
- print("ok $test # SKIP $decl\n");
- }
- $test++;
- }
-}
-
-
# Returning a closure from a thread caused problems. If the last index in
# the anon sub's pad wasn't for a lexical, then a core dump could occur.
# Otherwise, there might be leaked scalars.
diff --git a/dist/threads/t/unique.t b/dist/threads/t/unique.t
new file mode 100644
index 0000000000..a9cfdbbcd2
--- /dev/null
+++ b/dist/threads/t/unique.t
@@ -0,0 +1,81 @@
+use strict;
+use warnings;
+
+BEGIN {
+ use Config;
+ if (! $Config{'useithreads'}) {
+ print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
+ exit(0);
+ }
+ if ($] >= 5.027000) {
+ print("1..0 # SKIP 'unique' attribute no longer exists\n");
+ exit(0);
+ }
+}
+
+use ExtUtils::testlib;
+
+use threads;
+
+BEGIN {
+ if (! eval 'use threads::shared; 1') {
+ print("1..0 # SKIP threads::shared not available\n");
+ exit(0);
+ }
+
+ $| = 1;
+ print("1..6\n") ; ### Number of tests that will be run ###
+}
+
+print("ok 1 - Loaded\n");
+
+### Start of Testing ###
+
+no warnings 'deprecated'; # Suppress warnings related to :unique
+
+my $test :shared = 2;
+
+# bugid 24383 - :unique hashes weren't being made readonly on interpreter
+# clone; check that they are.
+
+our $unique_scalar : unique;
+our @unique_array : unique;
+our %unique_hash : unique;
+threads->create(sub {
+ lock($test);
+ my $TODO = ":unique needs to be re-implemented in a non-broken way";
+ eval { $unique_scalar = 1 };
+ print $@ =~ /read-only/
+ ? '' : 'not ', "ok $test # TODO $TODO - unique_scalar\n";
+ $test++;
+ eval { $unique_array[0] = 1 };
+ print $@ =~ /read-only/
+ ? '' : 'not ', "ok $test # TODO $TODO - unique_array\n";
+ $test++;
+ if ($] >= 5.008003 && $^O ne 'MSWin32') {
+ eval { $unique_hash{abc} = 1 };
+ print $@ =~ /disallowed/
+ ? '' : 'not ', "ok $test # TODO $TODO - unique_hash\n";
+ } else {
+ print("ok $test # SKIP $TODO - unique_hash\n");
+ }
+ $test++;
+ })->join;
+
+# bugid #24940 :unique should fail on my and sub declarations
+
+for my $decl ('my $x : unique', 'sub foo : unique') {
+ {
+ lock($test);
+ if ($] >= 5.008005) {
+ eval $decl;
+ print $@ =~ /^The 'unique' attribute may only be applied to 'our'
variables/
+ ? '' : 'not ', "ok $test - $decl\n";
+ } else {
+ print("ok $test # SKIP $decl\n");
+ }
+ $test++;
+ }
+}
+
+
diff --git a/doio.c b/doio.c
index becb19b080..6f4cd84f8c 100644
--- a/doio.c
+++ b/doio.c
@@ -136,14 +136,14 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len,
int as_raw,
Perl_croak(aTHX_ "panic: sysopen with multiple args, num_svs=%ld",
(long) num_svs);
}
- return do_open_raw(gv, oname, len, rawmode, rawperm);
+ return do_open_raw(gv, oname, len, rawmode, rawperm, NULL);
}
return do_open6(gv, oname, len, supplied_fp, svp, num_svs);
}
bool
Perl_do_open_raw(pTHX_ GV *gv, const char *oname, STRLEN len,
- int rawmode, int rawperm)
+ int rawmode, int rawperm, Stat_t *statbufp)
{
PerlIO *saveifp;
PerlIO *saveofp;
@@ -207,7 +207,7 @@ Perl_do_open_raw(pTHX_ GV *gv, const char *oname, STRLEN
len,
fp = PerlIO_openn(aTHX_ NULL, mode, -1, rawmode, rawperm, NULL, 1,
&namesv);
}
return openn_cleanup(gv, io, fp, mode, oname, saveifp, saveofp, savefd,
- savetype, writing, 0, NULL);
+ savetype, writing, 0, NULL, statbufp);
}
bool
@@ -606,7 +606,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
say_false:
return openn_cleanup(gv, io, fp, mode, oname, saveifp, saveofp, savefd,
- savetype, writing, was_fdopen, type);
+ savetype, writing, was_fdopen, type, NULL);
}
/* Yes, this is ugly, but it's private, and I don't see a cleaner way to
@@ -614,9 +614,10 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
static bool
S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char
*oname,
PerlIO *saveifp, PerlIO *saveofp, int savefd, char savetype,
- int writing, bool was_fdopen, const char *type)
+ int writing, bool was_fdopen, const char *type, Stat_t
*statbufp)
{
int fd;
+ Stat_t statbuf;
PERL_ARGS_ASSERT_OPENN_CLEANUP;
@@ -656,17 +657,17 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char
*mode, const char *oname,
* otherwise unless we "know" the type probe for socket-ness.
*/
if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD &&
fd >= 0) {
- if (PerlLIO_fstat(fd,&PL_statbuf) < 0) {
+ if (PerlLIO_fstat(fd,&statbuf) < 0) {
/* If PerlIO claims to have fd we had better be able to fstat() it.
*/
(void) PerlIO_close(fp);
goto say_false;
}
#ifndef PERL_MICRO
- if (S_ISSOCK(PL_statbuf.st_mode))
+ if (S_ISSOCK(statbuf.st_mode))
IoTYPE(io) = IoTYPE_SOCKET; /* in case a socket was passed in to us
*/
#ifdef HAS_SOCKET
else if (
- !(PL_statbuf.st_mode & S_IFMT)
+ !(statbuf.st_mode & S_IFMT)
&& IoTYPE(io) != IoTYPE_WRONLY /* Dups of STD* filehandles already
have */
&& IoTYPE(io) != IoTYPE_RDONLY /* type so they aren't marked as
sockets */
) { /* on OS's that return 0 on
fstat()ed pipe */
@@ -787,7 +788,7 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char
*mode, const char *oname,
IoFLAGS(io) &= ~IOf_NOLINE;
if (writing) {
if (IoTYPE(io) == IoTYPE_SOCKET
- || (IoTYPE(io) == IoTYPE_WRONLY && fd >= 0 &&
S_ISCHR(PL_statbuf.st_mode)) ) {
+ || (IoTYPE(io) == IoTYPE_WRONLY && fd >= 0 &&
S_ISCHR(statbuf.st_mode)) ) {
char *s = mode;
if (*s == IoTYPE_IMPLICIT || *s == IoTYPE_NUMERIC)
s++;
@@ -800,6 +801,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char
*mode, const char *oname,
else
IoOFP(io) = fp;
}
+ if (statbufp)
+ *statbufp = statbuf;
+
return TRUE;
say_false:
@@ -844,7 +848,6 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
if (!GvAV(gv))
return NULL;
while (av_tindex(GvAV(gv)) >= 0) {
- Stat_t statbuf;
STRLEN oldlen;
SV *const sv = av_shift(GvAV(gv));
SAVEFREESV(sv);
@@ -861,6 +864,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
}
}
else {
+ Stat_t statbuf;
{
IO * const io = GvIOp(PL_argvoutgv);
if (io && IoIFP(io) && old_out_name && !io_close(io,
PL_argvoutgv, FALSE, FALSE)) {
@@ -872,7 +876,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
Both this block and the block above fall through on open
failure to the warning code, and then the while loop above tries
the next entry. */
- if (do_open_raw(gv, PL_oldname, oldlen, O_RDONLY, 0)) {
+ if (do_open_raw(gv, PL_oldname, oldlen, O_RDONLY, 0, &statbuf)) {
#ifndef FLEXFILENAMES
int filedev;
int fileino;
@@ -887,12 +891,12 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
return IoIFP(GvIOp(gv));
}
#ifndef FLEXFILENAMES
- filedev = PL_statbuf.st_dev;
- fileino = PL_statbuf.st_ino;
+ filedev = statbuf.st_dev;
+ fileino = statbuf.st_ino;
#endif
- PL_filemode = PL_statbuf.st_mode;
- fileuid = PL_statbuf.st_uid;
- filegid = PL_statbuf.st_gid;
+ PL_filemode = statbuf.st_mode;
+ fileuid = statbuf.st_uid;
+ filegid = statbuf.st_gid;
if (!S_ISREG(PL_filemode)) {
Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
"Can't do inplace edit: %s is not a
regular file",
@@ -917,9 +921,9 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
sv_catpv(sv,PL_inplace);
}
#ifndef FLEXFILENAMES
- if ((PerlLIO_stat(SvPVX_const(sv),&PL_statbuf) >= 0
- && PL_statbuf.st_dev == filedev
- && PL_statbuf.st_ino == fileino)
+ if ((PerlLIO_stat(SvPVX_const(sv),&statbuf) >= 0
+ && statbuf.st_dev == filedev
+ && statbuf.st_ino == fileino)
#ifdef DJGPP
|| ((_djstat_fail_bits & _STFAIL_TRUENAME)!=0)
#endif
@@ -948,7 +952,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
do_close(gv,FALSE);
(void)PerlLIO_unlink(SvPVX_const(sv));
(void)PerlLIO_rename(PL_oldname,SvPVX_const(sv));
- do_open_raw(gv, SvPVX_const(sv), SvCUR(sv), O_RDONLY, 0);
+ do_open_raw(gv, SvPVX_const(sv), SvCUR(sv), O_RDONLY, 0,
NULL);
#endif /* DOSISH */
#else
(void)UNLINK(SvPVX_const(sv));
@@ -983,11 +987,11 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
if (!Perl_do_open_raw(aTHX_ PL_argvoutgv, SvPVX_const(sv),
SvCUR(sv),
#ifdef VMS
- O_WRONLY|O_CREAT|O_TRUNC, 0
+ O_WRONLY|O_CREAT|O_TRUNC, 0,
#else
- O_WRONLY|O_CREAT|OPEN_EXCL, 0600
+ O_WRONLY|O_CREAT|OPEN_EXCL, 0600,
#endif
- )) {
+ NULL)) {
Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), "Can't do
inplace edit on %s: %s",
PL_oldname, Strerror(errno) );
do_close(gv,FALSE);
@@ -1019,6 +1023,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
if (ckWARN_d(WARN_INPLACE)) {
const int eno = errno;
+ Stat_t statbuf;
if (PerlLIO_stat(PL_oldname, &statbuf) >= 0
&& !S_ISREG(statbuf.st_mode)) {
Perl_warner(aTHX_ packWARN(WARN_INPLACE),
diff --git a/embed.fnc b/embed.fnc
index 654dad9998..d0c9953273 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -466,14 +466,15 @@ s |bool |openn_cleanup |NN GV *gv|NN IO *io|NULLOK
PerlIO *fp \
|NN char *mode|NN const char *oname \
|NULLOK PerlIO *saveifp|NULLOK PerlIO *saveofp
\
|int savefd|char savetype|int writing \
- |bool was_fdopen|NULLOK const char *type
+ |bool was_fdopen|NULLOK const char *type \
+ |NULLOK Stat_t *statbufp
#endif
Ap |bool |do_openn |NN GV *gv|NN const char *oname|I32 len \
|int as_raw|int rawmode|int rawperm \
|NULLOK PerlIO *supplied_fp|NULLOK SV **svp \
|I32 num
Mp |bool |do_open_raw |NN GV *gv|NN const char *oname|STRLEN len \
- |int rawmode|int rawperm
+ |int rawmode|int rawperm|NULLOK Stat_t *statbufp
Mp |bool |do_open6 |NN GV *gv|NN const char *oname|STRLEN len \
|NULLOK PerlIO *supplied_fp|NULLOK SV **svp \
|U32 num
@@ -2683,7 +2684,6 @@ so |SV* |new_constant |NULLOK const char
*s|STRLEN len \
|NN const char *key|STRLEN keylen|NN SV *sv \
|NULLOK SV *pv|NULLOK const char *type \
|STRLEN typelen
-s |int |deprecate_commaless_var_list
s |int |ao |int toketype
s |void|parse_ident|NN char **s|NN char **d \
|NN char * const e|int allow_package \
diff --git a/embed.h b/embed.h
index 5352f536f8..2fa77c6fda 100644
--- a/embed.h
+++ b/embed.h
@@ -1246,7 +1246,7 @@
#define do_execfree() Perl_do_execfree(aTHX)
#define do_ncmp(a,b) Perl_do_ncmp(aTHX_ a,b)
#define do_open6(a,b,c,d,e,f) Perl_do_open6(aTHX_ a,b,c,d,e,f)
-#define do_open_raw(a,b,c,d,e) Perl_do_open_raw(aTHX_ a,b,c,d,e)
+#define do_open_raw(a,b,c,d,e,f) Perl_do_open_raw(aTHX_ a,b,c,d,e,f)
#define do_print(a,b) Perl_do_print(aTHX_ a,b)
#define do_readline() Perl_do_readline(aTHX)
#define do_seek(a,b,c) Perl_do_seek(aTHX_ a,b,c)
@@ -1542,7 +1542,7 @@
# if defined(PERL_IN_DOIO_C)
#define exec_failed(a,b,c) S_exec_failed(aTHX_ a,b,c)
#define ingroup(a,b) S_ingroup(aTHX_ a,b)
-#define openn_cleanup(a,b,c,d,e,f,g,h,i,j,k,l) S_openn_cleanup(aTHX_
a,b,c,d,e,f,g,h,i,j,k,l)
+#define openn_cleanup(a,b,c,d,e,f,g,h,i,j,k,l,m) S_openn_cleanup(aTHX_
a,b,c,d,e,f,g,h,i,j,k,l,m)
#define openn_setup(a,b,c,d,e,f) S_openn_setup(aTHX_ a,b,c,d,e,f)
# endif
# if defined(PERL_IN_DOOP_C)
@@ -1796,7 +1796,6 @@
#define ao(a) S_ao(aTHX_ a)
#define check_uni() S_check_uni(aTHX)
#define checkcomma(a,b,c) S_checkcomma(aTHX_ a,b,c)
-#define deprecate_commaless_var_list() S_deprecate_commaless_var_list(aTHX)
#define filter_gets(a,b) S_filter_gets(aTHX_ a,b)
#define find_in_my_stash(a,b) S_find_in_my_stash(aTHX_ a,b)
#define force_ident(a,b) S_force_ident(aTHX_ a,b)
diff --git a/embedvar.h b/embedvar.h
index a33f213efc..e8cab91e6f 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -299,7 +299,6 @@
#define PL_stashpad (vTHX->Istashpad)
#define PL_stashpadix (vTHX->Istashpadix)
#define PL_stashpadmax (vTHX->Istashpadmax)
-#define PL_statbuf (vTHX->Istatbuf)
#define PL_statcache (vTHX->Istatcache)
#define PL_statgv (vTHX->Istatgv)
#define PL_statname (vTHX->Istatname)
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 315e00a4b6..e5f1066281 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp
use Exporter (); # use #5
-our $VERSION = "0.999";
+our $VERSION = "1.000";
our @ISA = qw(Exporter);
our @EXPORT_OK = qw( set_style set_style_standard add_callback
concise_subref concise_cv concise_main
@@ -1103,7 +1103,7 @@ sub tree {
# to update the corresponding magic number in the next line.
# Remember, this needs to stay the last things in the module.
-my $cop_seq_mnum = 16;
+my $cop_seq_mnum = 12;
$cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum;
1;
diff --git a/ext/B/O.pm b/ext/B/O.pm
index 2976a89420..94ee754293 100644
--- a/ext/B/O.pm
+++ b/ext/B/O.pm
@@ -1,6 +1,6 @@
package O;
-our $VERSION = '1.01';
+our $VERSION = '1.02';
use B qw(minus_c save_BEGINs);
use Carp;
@@ -37,10 +37,6 @@ sub import {
# "fragile kludge") so that its output still looks
# nice. Thanks. --smcc
use B::].$backend.q[ ();
- if ($@) {
- croak "use of backend $backend failed: $@";
- }
-
my $compilesub = &{"B::${backend}::compile"}(@options);
if (ref($compilesub) ne "CODE") {
@@ -54,7 +50,9 @@ sub import {
close STDERR if $veryquiet;
}
];
- die $@ if $@;
+ if ($@) {
+ croak "Loading compiler backend 'B::$backend' failed: $@";
+ }
}
1;
diff --git a/ext/File-Glob/bsd_glob.c b/ext/File-Glob/bsd_glob.c
index 821ef200ad..86faa8e1aa 100644
--- a/ext/File-Glob/bsd_glob.c
+++ b/ext/File-Glob/bsd_glob.c
@@ -563,8 +563,12 @@ glob0(const Char *pattern, glob_t *pglob)
break;
case BG_STAR:
pglob->gl_flags |= GLOB_MAGCHAR;
- /* collapse adjacent stars to one,
- * to avoid exponential behavior
+ /* Collapse adjacent stars to one.
+ * This is required to ensure that a pattern like
+ * "a**" matches a name like "a", as without this
+ * check when the first star matched everything it
would
+ * cause the second star to return a match fail.
+ * As long ** is folded here this does not happen.
*/
if (bufnext == patbuf || bufnext[-1] != M_ALL)
*bufnext++ = M_ALL;
@@ -909,35 +913,56 @@ globextend(const Char *path, glob_t *pglob, size_t
*limitp)
/*
- * pattern matching function for filenames. Each occurrence of the *
- * pattern causes a recursion level.
+ * pattern matching function for filenames using state machine to avoid
+ * recursion. We maintain a "nextp" and "nextn" to allow us to backtrack
+ * without additional callframes, and to do cleanly prune the backtracking
+ * state when multiple '*' (start) matches are included in the pattern.
+ *
+ * Thanks to Russ Cox for the improved state machine logic to avoid quadratic
+ * matching on failure.
+ *
+ * https://research.swtch.com/glob
+ *
+ * An example would be a pattern
+ * ("a*" x 100) . "y"
+ * against a file name like
+ * ("a" x 100) . "x"
+ *
*/
static int
match(Char *name, Char *pat, Char *patend, int nocase)
{
int ok, negate_range;
Char c, k;
+ Char *nextp = NULL;
+ Char *nextn = NULL;
+ loop:
while (pat < patend) {
c = *pat++;
switch (c & M_MASK) {
case M_ALL:
if (pat == patend)
return(1);
- do
- if (match(name, pat, patend, nocase))
- return(1);
- while (*name++ != BG_EOS)
- ;
- return(0);
+ if (*name == BG_EOS)
+ return 0;
+ nextn = name + 1;
+ nextp = pat - 1;
+ break;
case M_ONE:
+ /* since * matches leftmost-shortest first *
+ * if we encounter the EOS then backtracking *
+ * will not help, so we can exit early here. */
if (*name++ == BG_EOS)
- return(0);
+ return 0;
break;
case M_SET:
ok = 0;
+ /* since * matches leftmost-shortest first *
+ * if we encounter the EOS then backtracking *
+ * will not help, so we can exit early here. */
if ((k = *name++) == BG_EOS)
- return(0);
+ return 0;
if ((negate_range = ((*pat & M_MASK) == M_NOT)) !=
BG_EOS)
++pat;
while (((c = *pat++) & M_MASK) != M_END)
@@ -953,16 +978,25 @@ match(Char *name, Char *pat, Char *patend, int nocase)
} else if (nocase ? (tolower(c) == tolower(k))
: (c == k))
ok = 1;
if (ok == negate_range)
- return(0);
+ goto fail;
break;
default:
k = *name++;
if (nocase ? (tolower(k) != tolower(c)) : (k != c))
- return(0);
+ goto fail;
break;
}
}
- return(*name == BG_EOS);
+ if (*name == BG_EOS)
+ return 1;
+
+ fail:
+ if (nextn) {
+ pat = nextp;
+ name = nextn;
+ goto loop;
+ }
+ return 0;
}
/* Free allocated data belonging to a glob_t structure. */
diff --git a/ext/File-Glob/t/rt131211.t b/ext/File-Glob/t/rt131211.t
new file mode 100644
index 0000000000..c1bcbe04e8
--- /dev/null
+++ b/ext/File-Glob/t/rt131211.t
@@ -0,0 +1,94 @@
+use strict;
+use warnings;
+use v5.16.0;
+use File::Temp 'tempdir';
+use File::Spec::Functions;
+use Test::More;
+use Time::HiRes qw(time);
+
+plan tests => 13;
+
+my $path = tempdir uc cleanup => 1;
+my @files= (
+ "x".("a" x 50)."b", # 0
+ "abbbbbbbbbbbbc", # 1
+ "abbbbbbbbbbbbd", # 2
+ "aaabaaaabaaaabc", # 3
+ "pq", # 4
+ "r", # 5
+ "rttiiiiiii", # 6
+ "wewewewewewe", # 7
+ "weeeweeeweee", # 8
+ "weewweewweew", # 9
+ "wewewewewewewewewewewewewewewewewq", # 10
+ "wtttttttetttttttwr", # 11
+);
+
+
+foreach (@files) {
+ open(my $f, ">", catfile $path, $_);
+}
+
+my $elapsed_fail= 0;
+my $elapsed_match= 0;
+my @got_files;
+my @no_files;
+my $count = 0;
+
+while (++$count < 10) {
+ $elapsed_match -= time;
+ @got_files= glob catfile $path, "x".("a*" x $count) . "b";
+ $elapsed_match += time;
+
+ $elapsed_fail -= time;
+ @no_files= glob catfile $path, "x".("a*" x $count) . "c";
+ $elapsed_fail += time;
+ last if $elapsed_fail > $elapsed_match * 100;
+}
+
+is $count,10,
+ "tried all the patterns without bailing out";
+
+cmp_ok $elapsed_fail/$elapsed_match,"<",2,
+ "time to fail less than twice the time to match";
+is "@got_files", catfile($path, $files[0]),
+ "only got the expected file for xa*..b";
+is "@no_files", "", "shouldnt have files for xa*..c";
+
+
+@got_files= glob catfile $path, "a*b*b*b*bc";
+is "@got_files", catfile($path, $files[1]),
+ "only got the expected file for a*b*b*b*bc";
+
+@got_files= sort glob catfile $path, "a*b*b*bc";
+is "@got_files", catfile($path, $files[3])." ".catfile($path,$files[1]),
+ "got the expected two files for a*b*b*bc";
+
+@got_files= sort glob catfile $path, "p*";
+is "@got_files", catfile($path, $files[4]),
+ "p* matches pq";
+
+@got_files= sort glob catfile $path, "r*???????";
+is "@got_files", catfile($path, $files[6]),
+ "r*??????? works as expected";
+
+@got_files= sort glob catfile $path, "w*e*w??e";
+is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8)),
+ "w*e*w??e works as expected";
+
+@got_files= sort glob catfile $path, "w*e*we??";
+is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8,9,10)),
+ "w*e*we?? works as expected";
+
+@got_files= sort glob catfile $path, "w**e**w";
+is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (9)),
+ "w**e**w works as expected";
+
+@got_files= sort glob catfile $path, "*wee*";
+is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (8,9)),
+ "*wee* works as expected";
+
+@got_files= sort glob catfile $path, "we*";
+is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8,9,10)),
+ "we* works as expected";
+
diff --git a/ext/attributes/attributes.pm b/ext/attributes/attributes.pm
index 7eb8e30ed8..3a3a43ea5b 100644
--- a/ext/attributes/attributes.pm
+++ b/ext/attributes/attributes.pm
@@ -1,6 +1,6 @@
package attributes;
-our $VERSION = 0.29;
+our $VERSION = 0.30;
@EXPORT_OK = qw(get reftype);
@EXPORT = ();
@@ -19,9 +19,6 @@ sub carp {
}
my %deprecated;
-$deprecated{CODE} = qr/\A-?(locked)\z/;
-$deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR}
- = qr/\A-?(unique)\z/;
my %msg = (
lvalue => 'lvalue attribute applied to already-defined subroutine',
@@ -256,12 +253,6 @@ C<sub foo($$) : prototype(@) {}> is indistinguishable from
C<sub foo(@){}>.
If illegalproto warnings are enabled, the prototype declared inside this
attribute will be sanity checked at compile time.
-=item locked
-
-The "locked" attribute is deprecated, and has no effect in 5.10.0 and later.
-It was used as part of the now-removed "Perl 5.005 threads". It will
-disappear in Perl 5.28, after which its use will be fatal.
-
=item const
This experimental attribute, introduced in Perl 5.22, only applies to
@@ -280,14 +271,6 @@ The following are the built-in attributes for variables:
Indicates that the referenced variable can be shared across different threads
when used in conjunction with the L<threads> and L<threads::shared> modules.
-=item unique
-
-The "unique" attribute is deprecated, and has no effect in 5.10.0 and later.
-It used to indicate that a single copy of an C<our> variable was to be used by
-all interpreters should the program happen to be running in a
-multi-interpreter environment. It will disappear in 5.28, after which its
-use will be fatal.
-
=back
=head2 Available Subroutines
diff --git a/intrpvar.h b/intrpvar.h
index d203855314..c6070eab43 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -188,7 +188,6 @@ PERLVAR(I, na, STRLEN) /* for use in
SvPV when length is
Not Applicable */
/* stat stuff */
-PERLVAR(I, statbuf, Stat_t)
PERLVAR(I, statcache, Stat_t) /* _ */
PERLVAR(I, statgv, GV *)
PERLVARI(I, statname, SV *, NULL)
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 3166415b54..6c35a7275e 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -47,7 +47,7 @@ use B qw(class main_root main_start main_cv svref_2object
opnumber perlstring
MDEREF_SHIFT
);
-$VERSION = '1.40';
+$VERSION = '1.41';
use strict;
use vars qw/$AUTOLOAD/;
use warnings ();
@@ -1334,7 +1334,6 @@ Carp::confess("SPECIAL in deparse_sub") if
$cv->isa("B::SPECIAL");
}
if ($cv->CvFLAGS & (CVf_METHOD|CVf_LOCKED|CVf_LVALUE|CVf_ANONCONST)) {
push @attrs, "lvalue" if $cv->CvFLAGS & CVf_LVALUE;
- push @attrs, "locked" if $cv->CvFLAGS & CVf_LOCKED;
push @attrs, "method" if $cv->CvFLAGS & CVf_METHOD;
push @attrs, "const" if $cv->CvFLAGS & CVf_ANONCONST;
}
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 022c1a92cc..13b9cdcd18 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -45,6 +45,16 @@ XXX For a release on a stable branch, this section aspires
to be:
[ List each incompatible change as a =head2 entry ]
+=head2 Comma-less variable lists in formats are no longer allowed
+
+Omitting the commas between variables passed to formats is no longer
+allowed. This has been deprecated since perl 5.000.
+
+=head2 The C<:locked> and C<:unique> attributes have been removed
+
+These have been no-ops and deprecated since perl 5.12 and 5.10,
+respectively.
+
=head1 Deprecations
XXX Any deprecated features, syntax, modules etc. should be listed here.
@@ -323,7 +333,7 @@ well.
=item *
-XXX
+The C<PL_statbuf> interpreter variable has been removed.
=back
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 730010a882..5652b10b6b 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -418,26 +418,12 @@ assigning through that reference. For example
used as an lvalue, which is pretty strange. Perhaps you forgot to
dereference it first. See L<perlfunc/substr>.
-=item Attribute "locked" is deprecated, and will disappear in Perl 5.28
-
-(D deprecated) You have used the attributes pragma to modify the
-"locked" attribute on a code reference. The :locked attribute is
-obsolete, has had no effect since 5005 threads were removed, and
-will be removed in a Perl 5.28.
-
=item Attribute prototype(%s) discards earlier prototype attribute in same sub
(W misc) A sub was declared as sub foo : prototype(A) : prototype(B) {}, for
example. Since each sub can only have one prototype, the earlier
declaration(s) are discarded while the last one is applied.
-=item Attribute "unique" is deprecated, and will disappear in Perl 5.28
-
-(D deprecated) You have used the attributes pragma to modify
-the "unique" attribute on an array, hash or scalar reference.
-The :unique attribute has had no effect since Perl 5.8.8, and
-will be removed in a Perl 5.28.
-
=item av_reify called on tied array
(S debugging) This indicates that something went wrong and Perl got I<very>
diff --git a/pod/perlexperiment.pod b/pod/perlexperiment.pod
index 5e734b63c8..cf0bab3b99 100644
--- a/pod/perlexperiment.pod
+++ b/pod/perlexperiment.pod
@@ -16,15 +16,6 @@ their inception, versions, etc. There's a lot of speculation
here.
=over 8
-=item C<our> can now have an experimental optional attribute C<unique>
-
-Introduced in Perl 5.8.0
-
-Deprecated in Perl 5.10.0
-
-The ticket for this feature is
-L<[perl #119313]|https://rt.perl.org/rt3/Ticket/Display.html?id=119313>.
-
=item Smart match (C<~~>)
Introduced in Perl 5.10.0
@@ -329,6 +320,14 @@ Introduced in Perl 5.14.0
Removed in Perl 5.24.0
+=item C<our> can have an experimental optional attribute C<unique>
+
+Introduced in Perl 5.8.0
+
+Deprecated in Perl 5.10.0
+
+Removed in Perl 5.28.0
+
=back
=head1 SEE ALSO
diff --git a/pod/perlop.pod b/pod/perlop.pod
index 26196c8a07..6c754ca477 100644
--- a/pod/perlop.pod
+++ b/pod/perlop.pod
@@ -2064,7 +2064,7 @@ syntax error. If you encounter this construct in older
code, you can just add
C<m>.
=item C<s/I<PATTERN>/I<REPLACEMENT>/msixpodualngcer>
-X<substitute> X<substitution> X<replace> X<regexp, replace>
+X<s> X<substitute> X<substitution> X<replace> X<regexp, replace>
X<regexp, substitute> X</m> X</s> X</i> X</x> X</p> X</o> X</g> X</c> X</e>
X</r>
Searches a string for a pattern, and if found, replaces that pattern
diff --git a/pp_sys.c b/pp_sys.c
index 7a5703515c..98f36453b2 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1659,7 +1659,7 @@ PP(pp_sysopen)
/* Need TIEHANDLE method ? */
const char * const tmps = SvPV_const(sv, len);
- if (do_open_raw(gv, tmps, len, mode, perm)) {
+ if (do_open_raw(gv, tmps, len, mode, perm, NULL)) {
IoLINES(GvIOp(gv)) = 0;
PUSHs(&PL_sv_yes);
}
diff --git a/proto.h b/proto.h
index f1d6181b4b..8307c6d6a9 100644
--- a/proto.h
+++ b/proto.h
@@ -773,7 +773,7 @@ PERL_CALLCONV bool Perl_do_open6(pTHX_ GV *gv, const char
*oname, STRLEN len, Pe
PERL_CALLCONV bool Perl_do_open9(pTHX_ GV *gv, const char *name, I32 len,
int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num);
#define PERL_ARGS_ASSERT_DO_OPEN9 \
assert(gv); assert(name); assert(svs)
-PERL_CALLCONV bool Perl_do_open_raw(pTHX_ GV *gv, const char *oname,
STRLEN len, int rawmode, int rawperm);
+PERL_CALLCONV bool Perl_do_open_raw(pTHX_ GV *gv, const char *oname,
STRLEN len, int rawmode, int rawperm, Stat_t *statbufp);
#define PERL_ARGS_ASSERT_DO_OPEN_RAW \
assert(gv); assert(oname)
PERL_CALLCONV bool Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len,
int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, I32 num);
@@ -4436,7 +4436,7 @@ STATIC void S_exec_failed(pTHX_ const char *cmd,
int fd, int do_report);
STATIC bool S_ingroup(pTHX_ Gid_t testgid, bool effective)
__attribute__warn_unused_result__;
-STATIC bool S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode,
const char *oname, PerlIO *saveifp, PerlIO *saveofp, int savefd, char savetype,
int writing, bool was_fdopen, const char *typ ... [3 chars truncated]
+STATIC bool S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode,
const char *oname, PerlIO *saveifp, PerlIO *saveofp, int savefd, char savetype,
int writing, bool was_fdopen, const char *typ ... [21 chars truncated]
#define PERL_ARGS_ASSERT_OPENN_CLEANUP \
assert(gv); assert(io); assert(mode); assert(oname)
STATIC IO * S_openn_setup(pTHX_ GV *gv, char *mode, PerlIO **saveifp,
PerlIO **saveofp, int *savefd, char *savetype);
@@ -5651,7 +5651,6 @@ STATIC void S_check_uni(pTHX);
STATIC void S_checkcomma(pTHX_ const char *s, const char *name, const char
*what);
#define PERL_ARGS_ASSERT_CHECKCOMMA \
assert(s); assert(name); assert(what)
-STATIC int S_deprecate_commaless_var_list(pTHX);
STATIC char * S_filter_gets(pTHX_ SV *sv, STRLEN append)
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_FILTER_GETS \
diff --git a/reentr.h b/reentr.h
index c268851922..b1f3c80615 100644
--- a/reentr.h
+++ b/reentr.h
@@ -56,6 +56,11 @@
# define NETDB_R_OBSOLETE
#endif
+#if defined(__GLIBC__) && (__GLIBC__ > 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__
>= 24))
+# undef HAS_READDIR_R
+# undef HAS_READDIR64_R
+#endif
+
/*
* As of OpenBSD 3.7, reentrant functions are now working, they just are
* incompatible with everyone else. To make OpenBSD happy, we have to
diff --git a/regen/reentr.pl b/regen/reentr.pl
index f8f78a5152..b73193ce56 100644
--- a/regen/reentr.pl
+++ b/regen/reentr.pl
@@ -106,6 +106,11 @@ print $h <<EOF;
# define NETDB_R_OBSOLETE
#endif
+#if defined(__GLIBC__) && (__GLIBC__ > 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__
>= 24))
+# undef HAS_READDIR_R
+# undef HAS_READDIR64_R
+#endif
+
/*
* As of OpenBSD 3.7, reentrant functions are now working, they just are
* incompatible with everyone else. To make OpenBSD happy, we have to
diff --git a/sv.c b/sv.c
index eb99a294a4..19bd2543fe 100644
--- a/sv.c
+++ b/sv.c
@@ -15080,7 +15080,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
PL_Xpv = (XPV*)NULL;
my_perl->Ina = proto_perl->Ina;
- PL_statbuf = proto_perl->Istatbuf;
PL_statcache = proto_perl->Istatcache;
#ifndef NO_TAINT_SUPPORT
diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index fc51d9f09f..49fa97ea8e 100644
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -4,8 +4,6 @@ toke.c AOK
$a = <<;
- Use of comma-less variable list is deprecated. Its use will be
fatal in Perl 5.28
- (called 3 times via depcom)
\1 better written as $1
use warnings 'syntax' ;
@@ -125,21 +123,6 @@ toke.c AOK
*foo *foo
__END__
-# toke.c
-format STDOUT =
-@<<< @||| @>>> @>>>
-$a $b "abc" 'def'
-.
-no warnings 'deprecated' ;
-format STDOUT =
-@<<< @||| @>>> @>>>
-$a $b "abc" 'def'
-.
-EXPECT
-Use of comma-less variable list is deprecated. Its use will be fatal in Perl
5.28 at - line 4.
-Use of comma-less variable list is deprecated. Its use will be fatal in Perl
5.28 at - line 4.
-Use of comma-less variable list is deprecated. Its use will be fatal in Perl
5.28 at - line 4.
-########
# toke.c
$a = <<;
@@ -1267,26 +1250,6 @@ EXPECT
!=~ should be !~ at - line 9.
########
# toke.c
-our $foo :unique;
-sub pam :locked;
-sub glipp :locked {
-}
-sub whack_eth ($) : locked {
-}
-no warnings 'deprecated';
-our $bar :unique;
-sub zapeth :locked;
-sub ker_plop :locked {
-}
-sub swa_a_p ($) : locked {
-}
-EXPECT
-Attribute "unique" is deprecated, and will disappear in Perl 5.28 at - line 2.
-Attribute "locked" is deprecated, and will disappear in Perl 5.28 at - line 3.
-Attribute "locked" is deprecated, and will disappear in Perl 5.28 at - line 4.
-Attribute "locked" is deprecated, and will disappear in Perl 5.28 at - line 6.
-########
-# toke.c
use warnings "syntax";
sub proto_after_array(@$);
sub proto_after_arref(\@$);
diff --git a/t/op/attrs.t b/t/op/attrs.t
index c3cf439f1f..2514270eda 100644
--- a/t/op/attrs.t
+++ b/t/op/attrs.t
@@ -160,20 +160,19 @@ like $@, qr/Can't declare scalar dereference in "my"/;
my @code = qw(lvalue method);
my @other = qw(shared);
-my @deprecated = qw(locked unique);
+my @deprecated = qw();
+my @invalid = qw(unique locked);
my %valid;
$valid{CODE} = {map {$_ => 1} @code};
$valid{SCALAR} = {map {$_ => 1} @other};
$valid{ARRAY} = $valid{HASH} = $valid{SCALAR};
my %deprecated;
-$deprecated{CODE} = { locked => 1 };
-$deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR} = { unique => 1 };
our ($scalar, @array, %hash);
foreach my $value (\&foo, \$scalar, \@array, \%hash) {
my $type = ref $value;
foreach my $negate ('', '-') {
- foreach my $attr (@code, @other, @deprecated) {
+ foreach my $attr (@code, @other, @deprecated, @invalid) {
my $attribute = $negate . $attr;
eval "use attributes __PACKAGE__, \$value, '$attribute'";
if ($deprecated{$type}{$attr}) {
diff --git a/t/op/write.t b/t/op/write.t
index d528a8e3f1..645bf699f5 100644
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -98,7 +98,7 @@ for my $tref ( @NumTests ){
my $bas_tests = 21;
# number of tests in section 3
-my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 6 + 2 + 3 + 96 + 11 + 15;
+my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 6 + 2 + 3 + 96 + 11 + 14;
# number of tests in section 4
my $hmb_tests = 37;
@@ -2018,18 +2018,6 @@ a x
EXPECT
{ stderr => 1 }, '#123538 crash in FF_MORE');
-# this used to assert fail
-fresh_perl_like(<<'EOP',
-format STDOUT =
-@
-0"$x"
-.
-print "got here\n";
-EOP
- qr/Use of comma-less variable list is deprecated.*got here/s,
- { stderr => 1 },
- '#128255 Assert fail in S_sublex_done');
-
{
$^A = "";
my $a = *globcopy;
diff --git a/toke.c b/toke.c
index ee18153e34..ce6fe22162 100644
--- a/toke.c
+++ b/toke.c
@@ -464,13 +464,6 @@ S_printbuf(pTHX_ const char *const fmt, const char *const
s)
#endif
-static int
-S_deprecate_commaless_var_list(pTHX) {
- PL_expect = XTERM;
- deprecate_fatal_in("5.28", "Use of comma-less variable list is
deprecated");
- return REPORT(','); /* grandfather non-comma-format format */
-}
-
/*
* S_ao
*
@@ -5897,27 +5890,12 @@ Perl_yylex(pTHX)
PL_lex_stuff = NULL;
}
else {
- if (len == 6 && strnEQ(SvPVX(sv), "unique", len)) {
- sv_free(sv);
- if (PL_in_my == KEY_our) {
- deprecate_disappears_in("5.28",
- "Attribute \"unique\" is deprecated");
- }
- else
- Perl_croak(aTHX_ "The 'unique' attribute may only
be applied to 'our' variables");
- }
-
/* NOTE: any CV attrs applied here need to be part of
the CVf_BUILTIN_ATTRS define in cv.h! */
- else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv),
"lvalue", len)) {
+ if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "lvalue",
len)) {
sv_free(sv);
CvLVALUE_on(PL_compcv);
}
- else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv),
"locked", len)) {
- sv_free(sv);
- deprecate_disappears_in("5.28",
- "Attribute \"locked\" is deprecated");
- }
else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv),
"method", len)) {
sv_free(sv);
CvMETHOD_on(PL_compcv);
@@ -6563,12 +6541,7 @@ Perl_yylex(pTHX)
case '$':
CLINE;
- if (PL_expect == XOPERATOR) {
- if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
- return deprecate_commaless_var_list();
- }
- }
- else if (PL_expect == XPOSTDEREF) {
+ if (PL_expect == XPOSTDEREF) {
if (s[1] == '#') {
s++;
POSTDEREF(DOLSHARP);
@@ -6858,10 +6831,6 @@ Perl_yylex(pTHX)
TERM(THING);
case '\'':
- if ( PL_expect == XOPERATOR
- && (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack))
- return deprecate_commaless_var_list();
-
s = scan_str(s,FALSE,FALSE,FALSE,NULL);
if (!s)
missingterm(NULL);
@@ -6874,10 +6843,6 @@ Perl_yylex(pTHX)
TERM(sublex_start());
case '"':
- if ( PL_expect == XOPERATOR
- && (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack))
- return deprecate_commaless_var_list();
-
s = scan_str(s,FALSE,FALSE,FALSE,NULL);
DEBUG_T( {
if (s)
--
Perl5 Master Repository
