In perl.git, the branch smoke-me/jkeenan/test-file-find-serially has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/00a2500f69c870f70012350d6b3ff3c623c0979a?hp=35ad0133df9b65a4e32f2f07a2a05b387bd79591> - Log ----------------------------------------------------------------- commit 00a2500f69c870f70012350d6b3ff3c623c0979a Author: James E Keenan <[email protected]> Date: Wed Jan 9 12:51:38 2019 -0500 Do not test ext/File-Find/t/*.t files in parallel. Smoke test reports suggest that files and directories being created temporarily for testing in taint.t are being seen by finddepth() during find.t. ----------------------------------------------------------------------- Summary of changes: dist/IO/t/io_dir.t | 98 ++++++++++++++++++++++++++++++------------------- pod/perldelta.pod | 7 +++- pod/perldeprecation.pod | 97 ++++++++++++++++++++++++------------------------ t/harness | 2 +- utf8.c | 4 +- 5 files changed, 119 insertions(+), 89 deletions(-) diff --git a/dist/IO/t/io_dir.t b/dist/IO/t/io_dir.t index 762c452ec8..6c30143395 100644 --- a/dist/IO/t/io_dir.t +++ b/dist/IO/t/io_dir.t @@ -9,57 +9,79 @@ BEGIN { } use strict; +use File::Temp qw( tempdir ); +use Cwd; -my $DIR = $^O eq 'MacOS' ? ":" : "."; +my $cwd = cwd(); -my $CLASS = "IO::Dir"; -my $dot = $CLASS->new($DIR); -ok(defined($dot)); +{ + my $DIR = tempdir( CLEANUP => 1 ); + chdir $DIR or die "Unable to chdir to $DIR"; + my @IO_files = + ( 'ChangeLog', 'IO.pm', 'IO.xs', 'Makefile.PL', 'poll.c', 'poll.h', 'README' ); + my @IO_subdirs = ( qw| hints lib t | ); -my @a = sort <*>; -my $first; -do { $first = $dot->read } while defined($first) && $first =~ /^\./; -ok(+(grep { $_ eq $first } @a)); + for my $f (@IO_files) { + open my $OUT, '>', $f or die "Unable to open '$DIR/$f' for writing"; + close $OUT or die "Unable to close '$DIR/$f' after writing"; + } + for my $d (@IO_subdirs) { mkdir $d or die "Unable to mkdir '$DIR/$d'"; } -my @b = sort($first, (grep {/^[^.]/} $dot->read)); -ok(+(join("\0", @a) eq join("\0", @b))); + my $CLASS = "IO::Dir"; + my $dot = $CLASS->new($DIR); + ok(defined($dot), "Able to create IO::Dir object for $DIR"); -ok($dot->rewind,'rewind'); -my @c = sort grep {/^[^.]/} $dot->read; -ok(+(join("\0", @b) eq join("\0", @c))); + my @a = sort <*>; + my $first; + do { $first = $dot->read } while defined($first) && $first =~ /^\./; + ok(+(grep { $_ eq $first } @a), "directory entry found"); -ok($dot->close,'close'); -{ local $^W; # avoid warnings on invalid dirhandle -ok(!$dot->rewind, "rewind on closed"); -ok(!defined($dot->read)); -} + my @b = sort($first, (grep {/^[^.]/} $dot->read)); + ok(+(join("\0", @a) eq join("\0", @b)), "two lists of directory entries match (Case 1)"); + + ok($dot->rewind,'rewind'); + my @c = sort grep {/^[^.]/} $dot->read; + ok(+(join("\0", @b) eq join("\0", @c)), "two lists of directory entries match (Case 2)"); + + ok($dot->close,'close'); + { + local $^W; # avoid warnings on invalid dirhandle + ok(!$dot->rewind, "rewind on closed"); + ok(!defined($dot->read), "Directory handle closed; 'read' returns undef"); + } -open(FH,'>','X') || die "Can't create x"; -print FH "X"; -close(FH) or die "Can't close: $!"; + open(FH,'>','X') || die "Can't create x"; + print FH "X"; + close(FH) or die "Can't close: $!"; -my %dir; -tie %dir, $CLASS, $DIR; -my @files = keys %dir; + my %dir; + tie %dir, $CLASS, $DIR; + my @files = keys %dir; -# I hope we do not have an empty dir :-) -ok(scalar @files); + # I hope we do not have an empty dir :-) + ok(scalar @files, "Tied hash interface finds directory entries"); -my $stat = $dir{'X'}; -isa_ok($stat,'File::stat'); -ok(defined($stat) && $stat->size == 1); + my $stat = $dir{'X'}; + isa_ok($stat,'File::stat'); + ok(defined($stat) && $stat->size == 1, + "Confirm that we wrote a file of size 1 byte"); -delete $dir{'X'}; + delete $dir{'X'}; -ok(-f 'X'); + ok(-f 'X', "File still exists after tied hash entry deleted"); -my %dirx; -tie %dirx, $CLASS, $DIR, DIR_UNLINK; + my %dirx; + tie %dirx, $CLASS, $DIR, DIR_UNLINK; -my $statx = $dirx{'X'}; -isa_ok($statx,'File::stat'); -ok(defined($statx) && $statx->size == 1); + my $statx = $dirx{'X'}; + isa_ok($statx,'File::stat'); + ok(defined($statx) && $statx->size == 1, + "Confirm that we still have the 1-byte file"); -delete $dirx{'X'}; + delete $dirx{'X'}; + + ok(!(-f 'X'), "Using DIR_UNLINK deletes tied hash element and directory entry"); + + chdir $cwd or die "Unable to chdir back to $cwd"; +} -ok(!(-f 'X')); diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 80525a5f2b..dd8d6682ab 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -47,7 +47,12 @@ XXX For a release on a stable branch, this section aspires to be: =head1 Deprecations -XXX Any deprecated features, syntax, modules etc. should be listed here. +=head2 In XS code, use of various macros dealing with UTF-8. + +This deprecation was scheduled to become fatal in 5.30, but has been +delayed to 5.32 due to problems that showed up with some CPAN modules. +For details of what's affected, see L<perldeprecation| +perldeprecation/In XS code, use of various macros dealing with UTF-8.> =head2 Module removals diff --git a/pod/perldeprecation.pod b/pod/perldeprecation.pod index f3b530881e..5213eca229 100644 --- a/pod/perldeprecation.pod +++ b/pod/perldeprecation.pod @@ -111,6 +111,56 @@ C<{> got a deprecation warning. Some cases started warning in Perl 5.26, and were made fatal in Perl 5.30. Other cases started in Perl 5.28, and will be made fatal in 5.32. +=head3 In XS code, use of various macros dealing with UTF-8. + +These macros will require an extra parameter in Perl 5.32: +C<isALPHANUMERIC_utf8>, +C<isASCII_utf8>, +C<isBLANK_utf8>, +C<isCNTRL_utf8>, +C<isDIGIT_utf8>, +C<isIDFIRST_utf8>, +C<isPSXSPC_utf8>, +C<isSPACE_utf8>, +C<isVERTWS_utf8>, +C<isWORDCHAR_utf8>, +C<isXDIGIT_utf8>, +C<isALPHANUMERIC_LC_utf8>, +C<isALPHA_LC_utf8>, +C<isASCII_LC_utf8>, +C<isBLANK_LC_utf8>, +C<isCNTRL_LC_utf8>, +C<isDIGIT_LC_utf8>, +C<isGRAPH_LC_utf8>, +C<isIDCONT_LC_utf8>, +C<isIDFIRST_LC_utf8>, +C<isLOWER_LC_utf8>, +C<isPRINT_LC_utf8>, +C<isPSXSPC_LC_utf8>, +C<isPUNCT_LC_utf8>, +C<isSPACE_LC_utf8>, +C<isUPPER_LC_utf8>, +C<isWORDCHAR_LC_utf8>, +C<isXDIGIT_LC_utf8>, +C<toFOLD_utf8>, +C<toLOWER_utf8>, +C<toTITLE_utf8>, +and +C<toUPPER_utf8>. + +There is now a macro that corresponds to each one of these, simply by +appending C<_safe> to the name. It takes the extra parameter. +For example, C<isDIGIT_utf8_safe> corresponds to C<isDIGIT_utf8>, but +takes the extra parameter, and its use doesn't generate a deprecation +warning. All are documented in L<perlapi/Character case changing> and +L<perlapi/Character classification>. + +You can change to use these versions at any time, or, if you can live +with the deprecation messages, wait until 5.32 and add the parameter to +the existing calls, without changing the names. + +This change was originally scheduled for 5.30, but was delayed. + =head2 Perl 5.30 =head3 C<< $* >> is no longer supported @@ -248,53 +298,6 @@ points|perlunicode/Noncharacter code points>, nor L<code points that are above the legal Unicode maximum|perlunicode/Beyond Unicode code points>, those can be delimiters. -=head3 In XS code, use of various macros dealing with UTF-8. - -These macros will require an extra parameter in Perl 5.30: -C<isALPHANUMERIC_utf8>, -C<isASCII_utf8>, -C<isBLANK_utf8>, -C<isCNTRL_utf8>, -C<isDIGIT_utf8>, -C<isIDFIRST_utf8>, -C<isPSXSPC_utf8>, -C<isSPACE_utf8>, -C<isVERTWS_utf8>, -C<isWORDCHAR_utf8>, -C<isXDIGIT_utf8>, -C<isALPHANUMERIC_LC_utf8>, -C<isALPHA_LC_utf8>, -C<isASCII_LC_utf8>, -C<isBLANK_LC_utf8>, -C<isCNTRL_LC_utf8>, -C<isDIGIT_LC_utf8>, -C<isGRAPH_LC_utf8>, -C<isIDCONT_LC_utf8>, -C<isIDFIRST_LC_utf8>, -C<isLOWER_LC_utf8>, -C<isPRINT_LC_utf8>, -C<isPSXSPC_LC_utf8>, -C<isPUNCT_LC_utf8>, -C<isSPACE_LC_utf8>, -C<isUPPER_LC_utf8>, -C<isWORDCHAR_LC_utf8>, -C<isXDIGIT_LC_utf8>, -C<toFOLD_utf8>, -C<toLOWER_utf8>, -C<toTITLE_utf8>, -and -C<toUPPER_utf8>. - -There is now a macro that corresponds to each one of these, simply by -appending C<_safe> to the name. It takes the extra parameter. -For example, C<isDIGIT_utf8_safe> corresponds to C<isDIGIT_utf8>, but -takes the extra parameter, and its use doesn't generate a deprecation -warning. All are documented in L<perlapi/Character case changing> and -L<perlapi/Character classification>. - -You can change to use these versions at any time, or, if you can live -with the deprecation messages, wait until 5.30 and add the parameter to -the existing calls, without changing the names. =head2 Perl 5.28 diff --git a/t/harness b/t/harness index caa2a318b8..b9857fa022 100644 --- a/t/harness +++ b/t/harness @@ -189,7 +189,7 @@ if (@ARGV) { # directory containing such files should be tested in serial order. # # Add exceptions to the above rule - for (qw(ext/Pod-Html/t cpan/IO-Zlib/t)) { + for (qw(ext/Pod-Html/t cpan/IO-Zlib/t ext/File-Find/t)) { $serials{$_} = 1; } diff --git a/utf8.c b/utf8.c index 760fb780b2..fc4a0c1dce 100644 --- a/utf8.c +++ b/utf8.c @@ -3184,14 +3184,14 @@ S_warn_on_first_deprecated_use(pTHX_ const char * const name, if (instr(file, "mathoms.c")) { Perl_warner(aTHX_ WARN_DEPRECATED, - "In %s, line %d, starting in Perl v5.30, %s()" + "In %s, line %d, starting in Perl v5.32, %s()" " will be removed. Avoid this message by" " converting to use %s().\n", file, line, name, alternative); } else { Perl_warner(aTHX_ WARN_DEPRECATED, - "In %s, line %d, starting in Perl v5.30, %s() will" + "In %s, line %d, starting in Perl v5.32, %s() will" " require an additional parameter. Avoid this" " message by converting to use %s().\n", file, line, name, alternative); -- Perl5 Master Repository
