diff options
Diffstat (limited to 'gnu/usr.bin/perl/t/porting')
-rwxr-xr-x | gnu/usr.bin/perl/t/porting/args_assert.t | 2 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/porting/authors.t | 2 | ||||
-rwxr-xr-x | gnu/usr.bin/perl/t/porting/checkcase.t | 49 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/porting/cmp_version.t | 3 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/porting/customized.dat | 25 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/porting/customized.t | 14 | ||||
-rwxr-xr-x | gnu/usr.bin/perl/t/porting/diag.t | 275 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/porting/exec-bit.t | 16 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/porting/extrefs.t | 128 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/porting/filenames.t | 68 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/porting/globvar.t | 15 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/porting/known_pod_issues.dat | 82 | ||||
-rwxr-xr-x | gnu/usr.bin/perl/t/porting/maintainers.t | 4 | ||||
-rwxr-xr-x | gnu/usr.bin/perl/t/porting/manifest.t | 2 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/porting/pending-author.t | 6 | ||||
-rwxr-xr-x | gnu/usr.bin/perl/t/porting/podcheck.t | 143 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/porting/regen.t | 10 | ||||
-rwxr-xr-x | gnu/usr.bin/perl/t/porting/test_bootstrap.t | 17 | ||||
-rw-r--r-- | gnu/usr.bin/perl/t/porting/utils.t | 1 |
19 files changed, 620 insertions, 242 deletions
diff --git a/gnu/usr.bin/perl/t/porting/args_assert.t b/gnu/usr.bin/perl/t/porting/args_assert.t index e1a2fa5d8e5..27e9bf27fd9 100755 --- a/gnu/usr.bin/perl/t/porting/args_assert.t +++ b/gnu/usr.bin/perl/t/porting/args_assert.t @@ -39,6 +39,8 @@ if (!@ARGV) { # *.c or */*.c push @ARGV, $prefix . $1 if m!^((?:[^/]+/)?[^/]+\.c)\t!; } + push @ARGV, $prefix . 'inline.h'; # Special case this '.h' which acts like + # a '.c' } while (<>) { diff --git a/gnu/usr.bin/perl/t/porting/authors.t b/gnu/usr.bin/perl/t/porting/authors.t index 9b9ba7c80d1..bc69e3a2a15 100644 --- a/gnu/usr.bin/perl/t/porting/authors.t +++ b/gnu/usr.bin/perl/t/porting/authors.t @@ -4,7 +4,7 @@ BEGIN { @INC = '..' if -f '../TestInit.pm'; } -use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute +use TestInit qw(T); # T is chdir to the top level use strict; require 't/test.pl'; diff --git a/gnu/usr.bin/perl/t/porting/checkcase.t b/gnu/usr.bin/perl/t/porting/checkcase.t index 4ae44ca0ee1..3c05e22760f 100755 --- a/gnu/usr.bin/perl/t/porting/checkcase.t +++ b/gnu/usr.bin/perl/t/porting/checkcase.t @@ -1,6 +1,11 @@ #!/usr/bin/perl -# Finds the files that have the same name, case insensitively, -# in the current directory and its subdirectories +# Finds the files that have the same name, case insensitively in the build tree + +BEGIN { + @INC = '..' if -f '../TestInit.pm'; + require './test.pl'; +} +use TestInit qw(T); # T is chdir to the top level use warnings; use strict; @@ -9,29 +14,31 @@ use File::Find; my %files; my $test_count = 0; -find(sub { - # We only care about directories to the extent they - # result in an actual file collision, so skip dirs - return if -d $File::Find::name; +find({no_chdir => 1, wanted => sub { + my $name = $File::Find::name; + # Assumes that the path separator is exactly one character. + $name =~ s/^\..//; - my $name = $File::Find::name; - # Assumes that the path separator is exactly one character. - $name =~ s/^\.\..//; + # Special exemption for Makefile, makefile + return if $name =~ m!\A(?:x2p/)?[Mm]akefile\z!; - # Special exemption for Makefile, makefile - return if $name =~ m!\A(?:x2p/)?[Mm]akefile\z!; + if ($name eq '.git') { + # Don't scan the .git directory, as its contents are outside + # our control. In particular, as fetch doesn't default to + # --prune, # someone pushing a branch upstream with a name + # which case-conflicts with a previously deleted branch will + # cause action-at-a-distance failures, because locally + # .git/logs/refs/remotes will contain both. + ++$File::Find::prune; + return; + } - push @{$files{lc $name}}, $name; - }, '..'); + push @{$files{lc $name}}, $name; + }}, '.'); foreach (sort values %files) { - if (@$_ > 1) { - print "not ok ".++$test_count. " - ". join(", ", @$_), "\n"; - print STDERR "# $_\n" foreach @$_; - } else { - print "ok ".++$test_count. " - ". join(", ", @$_), "\n"; - } + is( @$_, 1, join(", ", @$_) ) or + do{ note($_) foreach @$_; }; } -print "1..".$test_count."\n"; -# vim: ts=4 sts=4 sw=4 et: +done_testing(); diff --git a/gnu/usr.bin/perl/t/porting/cmp_version.t b/gnu/usr.bin/perl/t/porting/cmp_version.t index 6204c576120..e7627e4b3d7 100644 --- a/gnu/usr.bin/perl/t/porting/cmp_version.t +++ b/gnu/usr.bin/perl/t/porting/cmp_version.t @@ -12,6 +12,7 @@ use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute use strict; require 't/test.pl'; -find_git_or_skip('all'); +my $source = find_git_or_skip('all'); +chdir $source or die "Can't chdir to $source: $!"; system "$^X Porting/cmpVERSION.pl --exclude --tap"; diff --git a/gnu/usr.bin/perl/t/porting/customized.dat b/gnu/usr.bin/perl/t/porting/customized.dat index f9620442ee4..bdb8eb21306 100644 --- a/gnu/usr.bin/perl/t/porting/customized.dat +++ b/gnu/usr.bin/perl/t/porting/customized.dat @@ -1,13 +1,16 @@ +Text::Balanced cpan/Text-Balanced/t/01_compile.t 1598cf491a48fa546260a2ec41142abe84da533d +Text::Balanced cpan/Text-Balanced/t/02_extbrk.t 6ba1b64a4604e822dc2260b8ffcea6b406339ee8 +Text::Balanced cpan/Text-Balanced/t/03_extcbk.t 3307c980af28963414cab799c427b359ef3b8657 +Text::Balanced cpan/Text-Balanced/t/04_extdel.t be993c5c295b125b4be0ed55f866a249599f5835 +Text::Balanced cpan/Text-Balanced/t/05_extmul.t 4d1bc60add35ac203873f5371d8c6fcc9c8b6d80 +Text::Balanced cpan/Text-Balanced/t/06_extqlk.t 81a5804d392013393a338325b197cea52c4c44e0 +Text::Balanced cpan/Text-Balanced/t/07_exttag.t 5a209ed156387d4614d3003292e5fc412b8541e5 +Text::Balanced cpan/Text-Balanced/t/08_extvar.t 0776ef2cbdad5b1fbefb300541d079212cc24d92 +Text::Balanced cpan/Text-Balanced/t/09_gentag.t 42361b5dfb3bb728bce20f4fb0d92ccfb27c2ba7 Module::Build cpan/Module-Build/lib/Module/Build/ConfigData.pm 2f3f07fd889077ebd51791ad6e195d9164b4baf3 -Test::Harness cpan/Test-Harness/t/source.t 61738913dac9ba6c4504756d355c23c25c47d31e -Test::Harness cpan/Test-Harness/t/testargs.t 79c91b2ea73f7cbfb9bae45dec4a62db74cb8dbf -Module::Pluggable cpan/Module-Pluggable/Makefile.PL 72062c1a01ed7c62d16c55122c163b2d89f0d739 -autodie cpan/autodie/t/open.t cb493da4305f591ca0344d09e8a840a3147c5579 -libnet cpan/libnet/Makefile.PL 5554b71464b45f5cc002e55f2464f7ff4abd05b6 -podlators cpan/podlators/scripts/pod2man.PL 8fb484dc560adb00889f504760ca0a4defa9dc40 -podlators cpan/podlators/scripts/pod2text.PL 53ccba9264368c3f9acd2a36d1d354797d2a88f6 -podlators pod/perlpodstyle.pod 4f1ba65eddc5576267954b948556e16a9686c411 +Test::Harness cpan/Test-Harness/t/source.t 884890970fb850874213159df263ba483bac62e9 CPANPLUS cpan/CPANPLUS/Makefile.PL 5d533f6722af6aae73204755beb8d6c008fc0d4a -Text-Tabs+Wrap cpan/Text-Tabs/t/fill.t a960d2c4f66b7e30557b5479e0da2da1bf7a7f45 -Text-Tabs+Wrap cpan/Text-Tabs/t/tabs.t 63a67b3a319c858d7e66306b8a653de1951153dc -Sys::Syslog cpan/Sys-Syslog/t/syslog.t 647571fc90918883b871ff7e005ed7ab8a223784 +libnet cpan/libnet/Makefile.PL 5554b71464b45f5cc002e55f2464f7ff4abd05b6 +podlators cpan/podlators/scripts/pod2man.PL f81acf53f3ff46cdcc5ebdd661c5d13eb35d20d6 +podlators cpan/podlators/scripts/pod2text.PL b4693fcfe4a0a1b38a215cfb8985a65d5d025d69 +Module::Pluggable cpan/Module-Pluggable/Makefile.PL 72062c1a01ed7c62d16c55122c163b2d89f0d739 diff --git a/gnu/usr.bin/perl/t/porting/customized.t b/gnu/usr.bin/perl/t/porting/customized.t index 76053bcc07d..631c1bcfb82 100644 --- a/gnu/usr.bin/perl/t/porting/customized.t +++ b/gnu/usr.bin/perl/t/porting/customized.t @@ -10,7 +10,8 @@ BEGIN { # XXX that should be fixed chdir '..' unless -d 't'; - @INC = qw(lib Porting); + @INC = qw(lib Porting t); + require 'test.pl'; } use strict; @@ -99,21 +100,16 @@ foreach my $module ( keys %Modules ) { next; } my $should_be = $customised{ $module }->{ $file }; - if ( $id ne $should_be ) { - print "not ok ".++$TestCounter." - SHA for $file does not match stashed SHA\n"; - } - else { - print "ok ".++$TestCounter." - SHA for $file matched\n"; - } + is( $id, $should_be, "SHA for $file matches stashed SHA" ); } } if ( $regen ) { - print "ok ".++$TestCounter." - regenerated data file\n"; + pass( "regenerated data file" ); close $data_fh; } -print "1..".$TestCounter."\n"; +done_testing(); =pod diff --git a/gnu/usr.bin/perl/t/porting/diag.t b/gnu/usr.bin/perl/t/porting/diag.t index 58bed957a65..bcf853e5c98 100755 --- a/gnu/usr.bin/perl/t/porting/diag.t +++ b/gnu/usr.bin/perl/t/porting/diag.t @@ -2,8 +2,10 @@ use warnings; use strict; -chdir 't'; -require './test.pl'; +BEGIN { + chdir 't'; + require './test.pl'; +} plan('no_plan'); @@ -49,21 +51,28 @@ while (<$func_fh>) { close $func_fh; +my $regcomp_re = "(?<routine>(?:ckWARN(?:\\d+)?reg\\w*|vWARN\\d+))"; my $function_re = join '|', @functions; -my $source_msg_re = '(?<routine>\bDIE\b|$function_re)'; +my $regcomp_fail_re = '\b(?:(?:Simple_)?v)?FAIL[2-4]?\b'; +my $source_msg_re = + "(?<routine>\\bDIE\\b|$function_re|$regcomp_fail_re)"; my $text_re = '"(?<text>(?:\\\\"|[^"]|"\s*[A-Z_]+\s*")*)"'; my $source_msg_call_re = qr/$source_msg_re(?:_nocontext)? \s* \(aTHX_ \s* (?:packWARN\d*\((?<category>.*?)\),)? \s* $text_re /x; my $bad_version_re = qr{BADVERSION\([^"]*$text_re}; + $regcomp_fail_re = qr/$regcomp_fail_re\([^"]*$text_re/; +my $regcomp_call_re = qr/$regcomp_re.*?$text_re/; my %entries; # Get the ignores that are compiled into this file +my $reading_categorical_exceptions; while (<DATA>) { chomp; - $entries{$_}{todo}=1; + $entries{$_}{$reading_categorical_exceptions ? 'cattodo' : 'todo'}=1; + /__CATEGORIES__/ and ++$reading_categorical_exceptions; } my $pod = "pod/perldiag.pod"; @@ -71,14 +80,27 @@ my $cur_entry; open my $diagfh, "<", $pod or die "Can't open $pod: $!"; -my $category_re = qr/ [a-z0-9_]+?/; # Note: requires an initial space +my $category_re = qr/ [a-z0-9_:]+?/; # Note: requires an initial space my $severity_re = qr/ . (?: \| . )* /x; # A severity is a single char, but can # be of the form 'S|P|W' +my @same_descr; while (<$diagfh>) { if (m/^=item (.*)/) { $cur_entry = $1; - if (exists $entries{$cur_entry}) { + # Allow multi-line headers + while (<$diagfh>) { + if (/^\s*$/) { + last; + } + + $cur_entry .= $_; + } + + $cur_entry =~ s/\n/ /gs; # Fix multi-line headers if they have \n's + $cur_entry =~ s/\s+\z//; + + if (exists $entries{$cur_entry} && $entries{$cur_entry}{todo}) { TODO: { local $::TODO = "Remove the TODO entry \"$cur_entry\" from DATA as it is already in $pod near line $."; ok($cur_entry); @@ -88,7 +110,6 @@ while (<$diagfh>) { # overwrites one in DATA. $entries{$cur_entry}{todo} = 0; $entries{$cur_entry}{line_number} = $.; - next; } next if ! defined $cur_entry; @@ -97,10 +118,16 @@ while (<$diagfh>) { if (/^ \( ( $severity_re ) # Can have multiple categories separated by commas - (?: ( $category_re ) (?: , $category_re)* )? \) /x) + ( $category_re (?: , $category_re)* )? \) /x) { $entries{$cur_entry}{severity} = $1; - $entries{$cur_entry}{category} = $2; + $entries{$cur_entry}{category} = + $2 && join ", ", sort split " ", $2 =~ y/,//dr; + + # Record it also for other messages sharing the same description + @$_{qw<severity category>} = + @{$entries{$cur_entry}}{qw<severity category>} + for @same_descr; } elsif (! $entries{$cur_entry}{first_line} && $_ =~ /\S/) { @@ -108,6 +135,12 @@ while (<$diagfh>) { # that can later examine it to determine if that is ok or not $entries{$cur_entry}{first_line} = $_; } + if (/\S/) { + @same_descr = (); + } + else { + push @same_descr, $entries{$cur_entry}; + } } } @@ -158,19 +191,17 @@ my $specialformats = join '|', sort { length $b cmp length $a } keys %specialformats; my $specialformats_re = qr/%$format_modifiers"\s*($specialformats)(\s*")?/; -# Recursively descend looking for source files. -my @todo = sort <*>; -while (@todo) { - my $todo = shift @todo; - next if $todo ~~ ['t', 'lib', 'ext', 'dist', 'cpan']; - # opmini.c is just a copy of op.c, so there's no need to check again. - next if $todo eq 'opmini.c'; - if (-d $todo) { - unshift @todo, sort glob "$todo/*"; - } elsif ($todo =~ m/\.[ch]$/) { - check_file($todo); - } +open my $fh, '<', 'MANIFEST' or die "Can't open MANIFEST: $!"; +while (my $file = <$fh>) { + chomp $file; + $file =~ s/\s+.*//; + next unless $file =~ /\.(?:c|cpp|h|xs|y)\z/ or $file =~ /^perly\./; + # OS/2 extensions have never been migrated to ext/, hence the special case: + next if $file =~ m!\A(?:ext|dist|cpan|lib|t|os2/OS2)/! + && $file !~ m!\Aext/DynaLoader/!; + check_file($file); } +close $fh or die $!; # Standardize messages with variants into the form that appears # in perldiag.pod -- useful for things without a diag_listed_as annotation @@ -210,16 +241,15 @@ sub check_file { $sub = $_; } next if $sub =~ m/^XS/; - if (m</\* diag_listed_as: (.*) \*/>) { + if (m</\*\s*diag_listed_as: (.*?)\s*\*/>) { $listed_as = $1; $listed_as_line = $.+1; } next if /^#/; - next if /^ +/; my $multiline = 0; # Loop to accumulate the message text all on one line. - if (m/$source_msg_re(?:_nocontext)?\s*\(/) { + if (m/(?:$source_msg_re(?:_nocontext)?|$regcomp_re)\s*\(/) { while (not m/\);$/) { my $nextline = <$codefh>; # Means we fell off the end of the file. Not terribly surprising; @@ -250,24 +280,55 @@ sub check_file { # The %"foo" thing needs to happen *before* this regex. # diag($_); # DIE is just return Perl_die - my ($name, $category); + my ($name, $category, $routine); if (/$source_msg_call_re/) { - ($name, $category) = ($+{'text'}, $+{'category'}); + ($name, $category, $routine) = ($+{'text'}, $+{'category'}, $+{'routine'}); + # 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; } elsif (/$bad_version_re/) { ($name, $category) = ($+{'text'}, undef); } + elsif (/$regcomp_fail_re/) { + # FAIL("foo") -> "foo in regex m/%s/" + # vFAIL("foo") -> "foo in regex; marked by <-- HERE in m/%s/" + ($name, $category) = ($+{'text'}, undef); + $name .= + " in regex" . ("; marked by <-- HERE in" x /vFAIL/) . " m/%s/"; + } + elsif (/$regcomp_call_re/) { + # vWARN/ckWARNreg("foo") -> "foo in regex; marked by <-- HERE in m/%s/ + ($name, $category, $routine) = ($+{'text'}, undef, $+{'routine'}); + $name .= " in regex; marked by <-- HERE in m/%s/"; + $category = 'WARN_REGEXP'; + if ($routine =~ /dep/) { + $category .= ',WARN_DEPRECATED'; + } + } else { next; } - my $severity = {croak => [qw/P F/], - die => [qw/P F/], - warn => [qw/W D S/], - }->{$+{'routine'}||'die'}; - my @categories; + # Try to guess what the severity should be. In the case of + # Perl_ck_warner and other _ck_ functions, we can tell whether it is + # a severe/default warning or no by the _d suffix. In the case of + # other warn functions we cannot tell, because Perl_warner may be pre- + # ceded by if(ckWARN) or if(ckWARN_d). + my $severity = !$routine ? '[PFX]' + : $routine =~ /warn.*_d\z/ ? '[DS]' + : $routine =~ /ck_warn/ ? 'W' + : $routine =~ /warn/ ? '[WDS]' + : $routine =~ /ckWARN.*dep/ ? 'D' + : $routine =~ /ckWARN\d*reg/ ? 'W' + : $routine =~ /vWARN\d/ ? '[WDS]' + : '[PFX]'; + my $categories; if (defined $category) { - @categories = map {s/^WARN_//; lc $_} split /\s*[|,]\s*/, $category; + $category =~ s/__/::/g; + $categories = + join ", ", + sort map {s/^WARN_//; lc $_} split /\s*[|,]\s*/, $category; } if ($listed_as and $listed_as_line == $. - $multiline) { $name = $listed_as; @@ -298,25 +359,39 @@ sub check_file { # inside an #if 0 block. next if $name eq 'SKIPME'; - check_message(standardize($name),$codefn); + next if $name=~/\[TESTING\]/; # ignore these as they are works in progress + + check_message(standardize($name),$codefn,$severity,$categories); } } sub check_message { - my($name,$codefn,$partial) = @_; + my($name,$codefn,$severity,$categories,$partial) = @_; my $key = $name =~ y/\n/ /r; my $ret; + # Try to reduce printf() formats to simplest forms + # Really this should be matching %s, etc like diagnostics.pm does + + # Kill flags + $key =~ s/%[#0\-+]/%/g; + + # Kill width + $key =~ s/\%(\d+|\*)/%/g; + + # Kill precision + $key =~ s/\%\.(\d+|\*)/%/g; + if (exists $entries{$key}) { $ret = 1; if ( $entries{$key}{seen}++ ) { # no need to repeat entries we've tested - } elsif ($entries{$name}{todo}) { + } elsif ($entries{$key}{todo}) { TODO: { no warnings 'once'; local $::TODO = 'in DATA'; # There is no listing, but it is in the list of exceptions. TODO FAIL. - fail($name); + fail($key); diag( " Message '$name'\n from $codefn line $. is not listed in $pod\n". " (but it wasn't documented in 5.10 either, so marking it TODO)." @@ -325,6 +400,25 @@ sub check_message { } else { # We found an actual valid entry in perldiag.pod for this error. pass($key); + + # Now check the category and severity + + # Cache our severity qr thingies + use 5.01; + state %qrs; + my $qr = $qrs{$severity} ||= qr/$severity/; + + return $ret + if $entries{$key}{cattodo}; + + like $entries{$key}{severity}, $qr, + $severity =~ /\[/ + ? "severity is one of $severity for $key" + : "severity is $severity for $key"; + + is $entries{$key}{category}, $categories, + ($categories ? "categories are [$categories]" : "no category") + . " for $key"; } # Later, should start checking that the severity is correct, too. } elsif ($partial) { @@ -333,7 +427,8 @@ sub check_message { my $ok; if ($name =~ /\n/) { $ok = 1; - check_message($_,$codefn,1) or $ok = 0, last for split /\n/, $name; + check_message($_,$codefn,$severity,$categories,1) or $ok = 0, last + for split /\n/, $name; } if ($ok) { # noop @@ -364,19 +459,28 @@ sub check_message { # PLEASE DO NOT ADD TO THIS LIST. Instead, write an entry in # pod/perldiag.pod for your new (warning|error). +# Entries after __CATEGORIES__ are those that are in perldiag but fail the +# severity/category test. + # Also FIXME this test, as the first entry in TODO *is* covered by the # description: Malformed UTF-8 character (%s) __DATA__ Malformed UTF-8 character (unexpected non-continuation byte 0x%x, immediately after start byte 0x%x) -%s (%d) does not match %s (%d), -%s (%d) smaller than %s (%d), +'%c' allowed only after types %s in %s bad top format reference +Cannot apply "%s" in non-PerlIO perl +Can't %s big-endian %ss on this +Can't call mro_isa_changed_in() on anonymous symbol table +Can't call mro_method_changed_in() on anonymous symbol table Can't coerce readonly %s to string Can't coerce readonly %s to string in %s +Can't find string terminator %c%s%c anywhere before EOF Can't fix broken locale name "%s" Can't get short module name from a handle Can't locate object method "%s" via package "%s" (perhaps you forgot to load "%s"?) +Can't pipe "%s": %s +Can't spawn: %s Can't spawn "%s": %s Can't %s script `%s' with ARGV[0] being `%s' Can't %s "%s": %s @@ -384,28 +488,43 @@ Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found) Can't use string ("%s"%s) as a subroutine ref while "strict refs" in use \%c better written as $%c Character(s) in '%c' format wrapped in %s +chown not implemented! +clear %s Code missing after '/' in pack Code missing after '/' in unpack -Corrupted regexp opcode %d > %d '%c' outside of string in pack Debug leaking scalars child failed%s with errno %d: %s +'/' does not take a repeat count in %s +Don't know how to get file name Don't know how to handle magic of type \%o -Dp not implemented on this platform Error reading "%s": %s +execl not implemented! +EVAL without pos change exceeded limit in regex Filehandle opened only for %sput Filehandle %s opened only for %sput Filehandle STD%s reopened as %s only for input +filter_del can only delete in reverse order (currently) YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET! FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP! +fork() not implemented! +free %s Free to wrong pool %p not %p get %s %p %p %p +gethostent not implemented! +getpwnam returned invalid UIC %o for user "%s" glob failed (can't start child: %s) glob failed (child exited with status %d%s) Goto undefined subroutine Goto undefined subroutine &%s +Got signal %d +()-group starts with a count in %s +Illegal binary digit '%c' ignored Illegal character %sin prototype for %s : %s -Integer overflow in version %d +Illegal hexadecimal digit '%c' ignored +Illegal octal digit '%c' ignored +Infinite recursion in regex internal %<num>p might conflict with future printf extensions -invalid control request: '\%o' +Invalid argument to sv_cat_decode Invalid range "%c-%c" in transliteration operator Invalid separator character %c%c%c in PerlIO layer specification %s Invalid TOKEN object ignored @@ -413,24 +532,46 @@ Invalid type '%c' in pack Invalid type '%c' in %s Invalid type '%c' in unpack Invalid type ',' in %s +ioctlsocket not implemented! 'j' not supported on this platform 'J' not supported on this platform +killpg not implemented! +length() used on %s (did you mean "scalar(%s)"?) +length() used on %hash (did you mean "scalar(keys %hash)"?) +length() used on @array (did you mean "scalar(@array)"?) +List form of pipe open not implemented +Malformed integer in [] in %s Malformed UTF-8 character (fatal) Missing (suid) fd script name More than one argument to open More than one argument to open(,':%s') mprotect for %p %u failed with %d mprotect RW for %p %u failed with %d +No %s allowed while running setgid +No %s allowed with (suid) fdscript +No such class field "%s" Not an XSUB reference Operator or semicolon missing before %c%s +Pattern subroutine nesting without pos change exceeded limit in regex Perl %s required--this is only %s, stopped +PerlApp::TextQuery: no arguments, please +POSIX syntax [%c %c] is reserved for future extensions in regex; marked by <-- HERE in m/%s/ ptr wrong %p != %p fl=%x nl=%p e=%p for %d Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?) +Regexp modifier "%c" may appear a maximum of twice in regex; marked by <-- HERE in m/%s/ +Regexp modifier "%c" may not appear twice in regex; marked by <-- HERE in m/%s/ +Regexp modifiers "%c" and "%c" are mutually exclusive in regex; marked by <-- HERE in m/%s/ +Regexp *+ operand could be empty in regex; marked by <-- HERE in m/%s/ +Repeated format line will never terminate (~~ and @#) Reversed %c= operator -Runaway prototype %s(%f) failed -%sCompilation failed in regexp %sCompilation failed in require +Sequence (?%c...) not implemented in regex; marked by <-- HERE in m/%s/ +Sequence (%s...) not recognized in regex; marked by <-- HERE in m/%s/ +Sequence %s... not terminated in regex; marked by <-- HERE in m/%s/ +Sequence (?%c... not terminated in regex; marked by <-- HERE in m/%s/ +Sequence (?(%c... not terminated in regex; marked by <-- HERE in m/%s/ +Sequence (?R) not terminated in regex m/%s/ set %s %p %p %p %s free() ignored (RMAGIC, PERL_CORE) %s has too many errors. @@ -438,15 +579,20 @@ SIG%s handler "%s" not defined. %s in %s Size magic not implemented %s number > %s non-portable -%s object version %s does not match %s %s %srealloc() %signored -%s has too many errors. +%s in regex m/%s/ %s on %s %s -%s on %s %s %s +socketpair not implemented! Starting Full Screen process with flag=%d, mytype=%d Starting PM process with flag=%d, mytype=%d +sv_2iv assumed (U_V(fabs((double)SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%f U_V is 0x%x, IV_MAX is 0x%x SWASHNEW didn't return an HV ref +switching effective gid is not implemented +switching effective uid is not implemented +System V IPC is not implemented on this machine -T and -B not implemented on filehandles +Terminating on signal SIG%s(%d) +The crypt() function is not implemented on NetWare The flock() function is not implemented on NetWare The rewinddir() function is not implemented on NetWare The seekdir() function is not implemented on NetWare @@ -454,22 +600,49 @@ The telldir() function is not implemented on NetWare Too deeply nested ()-groups in %s Too many args on %s line of "%s" U0 mode on a byte string -Undefined top format called +unable to find VMSPIPE.COM for i/o piping +Unknown Unicode option value %d +Unrecognized character %s; marked by <-- HERE after %s<-- HERE near column %d Unstable directory path, current directory changed unexpectedly Unterminated compressed integer in unpack +Unterminated \g... pattern in regex; marked by <-- HERE in m/%s/ Usage: CODE(0x%x)(%s) Usage: %s(%s) Usage: %s::%s(%s) +Usage: File::Copy::rmscopy(from,to[,date_flag]) +Usage: VMS::Filespec::candelete(spec) +Usage: VMS::Filespec::fileify(spec) +Usage: VMS::Filespec::pathify(spec) +Usage: VMS::Filespec::rmsexpand(spec[,defspec]) +Usage: VMS::Filespec::unixify(spec) +Usage: VMS::Filespec::unixpath(spec) Usage: VMS::Filespec::unixrealpath(spec) +Usage: VMS::Filespec::vmsify(spec) +Usage: VMS::Filespec::vmspath(spec) Usage: VMS::Filespec::vmsrealpath(spec) Use of inherited AUTOLOAD for non-method %s::%s() is deprecated utf8 "\x%X" does not map to Unicode Value of logical "%s" too long. Truncating to %i bytes -value of node is %d in Offset macro -Variable "%c%s" is not imported +waitpid: process %x is not a child of process %x Wide character Wide character in $/ -Wide character in print +Within []-length '*' not allowed in %s Within []-length '%c' not allowed in %s Wrong syntax (suid) fd script name "%s" +'X' outside of string in %s 'X' outside of string in unpack + +__CATEGORIES__ +Code point 0x%X is not Unicode, all \p{} matches fail; all \P{} matches succeed +Code point 0x%X is not Unicode, may not be portable +Illegal character \%o (carriage return) +Missing argument in %s +Unicode non-character U+%X is illegal for open interchange +Operation "%s" returns its argument for non-Unicode code point 0x%X +Operation "%s" returns its argument for UTF-16 surrogate U+%X +Unicode surrogate U+%X is illegal in UTF-8 +UTF-16 surrogate U+%X +False [] range "%s" in regex; marked by <-- HERE in m/%s/ +\N{} in character class restricted to one character in regex; marked by <-- HERE in m/%s/ +Zero length \N{} in regex; marked by <-- HERE in m/%s/ +Expecting '(?flags:(?[...' in regex; marked by <-- HERE in m/%s/ diff --git a/gnu/usr.bin/perl/t/porting/exec-bit.t b/gnu/usr.bin/perl/t/porting/exec-bit.t index 718c81dabcf..1deb376c379 100644 --- a/gnu/usr.bin/perl/t/porting/exec-bit.t +++ b/gnu/usr.bin/perl/t/porting/exec-bit.t @@ -5,6 +5,16 @@ use strict; # This test checks that anything with an executable bit is # identified in Porting/exec-bit.txt to makerel will set # the exe bit in the release tarball +# and that anything with an executable bit also has a shebang + +sub has_shebang { + my $fname = shift; + open my $fh, '<', $fname or die "Can't open '$fname': $!"; + my $line = <$fh>; + close $fh; + + return $line =~ /^\#!\s*([A-Za-z0-9_\-\/\.])+\s?/ ? 1 : 0; +} require './test.pl'; if ( $^O eq "MSWin32" ) { @@ -22,9 +32,6 @@ if ( $^O eq "vos" ) { plan('no_plan'); use ExtUtils::Manifest qw(maniread); -use File::Basename; -use File::Find; -use File::Spec::Functions; # Copied from Porting/makerel - these will get +x in the tarball # XXX refactor? -- dagolden, 2010-07-23 @@ -43,6 +50,8 @@ my @manifest = sort keys %{ maniread("../MANIFEST") }; for my $f ( map { "../$_" } @manifest ) { next unless -x $f; + ok( has_shebang($f), "File $f has shebang" ); + ok( $exe_list{$f}, "tarball will chmod +x $f" ) or diag( "Remove the exec bit or add '$f' to Porting/exec-bit.txt" ); @@ -51,4 +60,3 @@ for my $f ( map { "../$_" } @manifest ) { ok( ! %exe_list, "Everything in Porting/exec-bit.txt has +x in repo" ) or diag( "Files missing exec bit:\n " . join("\n ", sort keys %exe_list) . "\n"); - diff --git a/gnu/usr.bin/perl/t/porting/extrefs.t b/gnu/usr.bin/perl/t/porting/extrefs.t new file mode 100644 index 00000000000..9d4a1d3d143 --- /dev/null +++ b/gnu/usr.bin/perl/t/porting/extrefs.t @@ -0,0 +1,128 @@ +#!./perl -w + +# What does this test? +# Test that changes to perl header files don't cause external +# references by simplying #including them. This breaks library probe +# code on CPAN, and can break cflags.SH. +# +# Why do we test this? +# See https://rt.perl.org/rt3/Ticket/Display.html?id=116989 +# +# It's broken - how do I fix it? +# You added an initializer or static function to a header file that +# references some symbol you didn't define, you need to remove it. + +BEGIN { + require "./test.pl"; + unshift @INC, ".." if -f "../TestInit.pm"; +} + +use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute +use strict; +use warnings; +use Config; +use File::Path 'rmtree'; +use Cwd; + +plan(tests => 1); + +my $VERBOSE = grep {$_ eq '-v'} @ARGV; + +ok(try_compile_and_link(<<'CODE')); +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +int main(int argc, char **argv) { + return 0; +} +CODE + + +# from Time::HiRes's Makefile.PL with minor modifications +sub try_compile_and_link { + my ($c, %args) = @_; + + my $ld_exeext = ($^O eq 'cygwin' || $^O eq 'MSWin32' || + $^O eq 'os2' && $Config{ldflags} =~ /-Zexe\b/) ? '.exe' : + (($^O eq 'vos') ? $Config{exe_ext} : ''); + + my ($ok) = 0; + my $tempdir = tempfile(); + my $cwd = getcwd(); + mkdir $tempdir; + chdir $tempdir; + my ($tmp) = "temp"; + + my $obj_ext = $Config{obj_ext} || ".o"; + + if (open(my $tmpc, ">$tmp.c")) { + print $tmpc $c; + unless (close($tmpc)) { + chdir($cwd); + rmtree($tempdir); + warn "Failing closing code file: $!\n" if $VERBOSE; + return 0; + } + + my $COREincdir = File::Spec->catdir(File::Spec->updir); + + my $ccflags = $Config{'ccflags'} . ' ' . "-I$COREincdir" + . ' -DPERL_NO_INLINE_FUNCTIONS'; + + if ($^O eq "MSWin32") { + $ccflags .= " -I../win32 -I../win32/include"; + } + + my $libs = ''; + + # Include libs to be sure of linking against bufferoverflowU.lib for + # the SDK2003 compiler on Windows. See win32/Makefile for more details. + if ($^O eq "MSWin32" && $Config{cc} =~ /\bcl\b/i) { + $libs = " /link $Config{'libs'}"; + } + + my $null = File::Spec->devnull; + + my $errornull = $VERBOSE ? '' : ">$null 2>$null"; + + # Darwin g++ 4.2.1 is fussy and demands a space. + # FreeBSD g++ 4.2.1 does not. + # We do not know the reaction of either to the presence of brown M&Ms. + my $out_opt = "-o "; + if ($^O eq "MSWin32" && $Config{cc} =~ /\bcl\b/i) { + $out_opt = "/Fe"; + } + + my $tmp_exe = "$tmp$ld_exeext"; + + my $cccmd = "$Config{'cc'} $out_opt$tmp_exe $ccflags $tmp.c $libs $errornull"; + + if ($^O eq 'VMS') { + $cccmd = "$Config{'cc'} /include=($COREincdir) $tmp.c"; + } + + if ($^O eq 'VMS') { + open( my $cmdfile, ">$tmp.com" ); + print $cmdfile "\$ SET MESSAGE/NOFACILITY/NOSEVERITY/NOIDENT/NOTEXT\n"; + print $cmdfile "\$ $cccmd\n"; + print $cmdfile "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n"; # escalate + close $cmdfile; + system("\@ $tmp.com"); + $ok = $?==0; + chdir($cwd); + rmtree($tempdir); + } + else + { + printf "cccmd = $cccmd\n" if $VERBOSE; + my $res = system($cccmd); + $ok = defined($res) && $res == 0 && -s $tmp_exe && -x _; + + chdir($cwd); + rmtree($tempdir); + } + } + + return $ok; +} diff --git a/gnu/usr.bin/perl/t/porting/filenames.t b/gnu/usr.bin/perl/t/porting/filenames.t index 268dd1c8c51..b65ab8e2c9e 100644 --- a/gnu/usr.bin/perl/t/porting/filenames.t +++ b/gnu/usr.bin/perl/t/porting/filenames.t @@ -27,12 +27,11 @@ BEGIN { } use strict; -use File::Spec; use File::Basename; require './test.pl'; -my $manifest = File::Spec->catfile(File::Spec->updir(), 'MANIFEST'); +my $manifest = '../MANIFEST'; open my $m, '<', $manifest or die "Can't open '$manifest': $!"; my @files; @@ -46,59 +45,38 @@ close $m or die $!; plan(scalar @files); -for my $file (@files) { - validate_file_name($file); -} -exit 0; - - -sub validate_file_name { - my $path = shift; - my $filename = basename $path; - - note("testing $path"); - - my @path_components = split('/',$path); - pop @path_components; # throw away the filename +PATHNAME: for my $pathname (@files) { + my @path_components = split('/',$pathname); + my $filename = pop @path_components; for my $component (@path_components) { - if ($component =~ /\./) { - fail("no directory components containing '.'"); - return; - } - if (length $component > 32) { - fail("no directory with a name over 32 characters (VOS requirement)"); - return; - } + if ($component =~ /\./) { + fail("$pathname has directory components containing '.'"); + next PATHNAME; + } + if (length $component > 32) { + fail("$pathname has a name over 32 characters (VOS requirement)"); + next PATHNAME; + } } if ($filename =~ /^\-/) { - fail("filename does not start with -"); - return; + fail("$pathname starts with -"); + next PATHNAME; } my($before, $after) = split /\./, $filename; if (length $before > 39) { - fail("filename has 39 or fewer characters before the dot"); - return; - } - if ($after) { - if (length $after > 39) { - fail("filename has 39 or fewer characters after the dot"); - return; - } - } - - if ($filename =~ /^(?:CON|PRN|AUX|NUL|COM[1-9]|LPT[1-9])\./i) { - fail("filename has a reserved name"); - return; - } - - if ($filename =~ /\s|\(|\&/) { - fail("filename has a reserved character"); - return; + fail("$pathname has more than 39 characters before the dot"); + } elsif ($after && length $after > 39) { + fail("$pathname has more than 39 characters after the dot"); + } elsif ($filename =~ /^(?:CON|PRN|AUX|NUL|COM[1-9]|LPT[1-9])\./i) { + fail("$pathname has a reserved name"); + } elsif ($filename =~ /\s|\(|\&/) { + fail("$pathname has a reserved character"); + } else { + pass("$pathname ok"); } - pass("filename ok"); } # EOF diff --git a/gnu/usr.bin/perl/t/porting/globvar.t b/gnu/usr.bin/perl/t/porting/globvar.t index 795673b49a7..fd169c74420 100644 --- a/gnu/usr.bin/perl/t/porting/globvar.t +++ b/gnu/usr.bin/perl/t/porting/globvar.t @@ -18,6 +18,9 @@ my %skip = map { ("PL_$_", 1) } watchaddr watchok warn_uninit_sv ); +$skip{PL_hash_rand_bits}= $skip{PL_hash_rand_bits_enabled}= 1; # we can be compiled without these, so skip testing them + + my $trial = "nm globals$Config{_o} 2>&1"; my $yes = `$trial`; @@ -57,13 +60,17 @@ foreach my $file (map {$_ . $Config{_o}} qw(globals regcomp)) { close $fh or die "Problem running nm $file"; } -fail("Attempting to export '$_' which is never defined") - foreach sort keys %exported; +foreach (sort keys %exported) { + SKIP: { + skip("We dont't export '$_' (Perl not built with this enabled?)",1) if $skip{$_}; + fail("Attempting to export '$_' which is never defined"); + } +} foreach (sort keys %unexported) { SKIP: { - skip("We don't export $_", 1) if $skip{$_}; - fail("$_ is defined, but we do not export it"); + skip("We don't export '$_'", 1) if $skip{$_}; + fail("'$_' is defined, but we do not export it"); } } diff --git a/gnu/usr.bin/perl/t/porting/known_pod_issues.dat b/gnu/usr.bin/perl/t/porting/known_pod_issues.dat index d08d202fd71..53e5797210c 100644 --- a/gnu/usr.bin/perl/t/porting/known_pod_issues.dat +++ b/gnu/usr.bin/perl/t/porting/known_pod_issues.dat @@ -18,10 +18,14 @@ Apache::MP3 Array::Base Attribute::Constant basename(1) +Benchmark::Perl::Formance ByteLoader bzip2(1) +Carp::Always Carp::Assert +Carp::Clan chcp(1) +Class::Accessor Class::C3 Class::ISA Class::PseudoHash @@ -36,7 +40,9 @@ Date::Pcalc DateTime DB_File(3) DBIx::Profile +Devel::Callsite Devel::DProf +Devel::DTrace::Provider Devel::NYTProf Devel::PPPort Devel::SawAmpersand @@ -57,6 +63,7 @@ getpriority(2) HTTP::Lite inetd(8) IPC::Run +IPC::Signal kill(3) langinfo(3) Lingua::KO::Hangul::Util @@ -76,17 +83,21 @@ Module::CPANTS::Analyse Module::Find Module::Info Module::Starter +Moo +Moose MRO::Compat nl_langinfo(3) Number::Format +Object::InsideOut +Object::Tiny open(2) OS2::Proc OS2::WinObject PadWalker passwd(1) perl(1) -Perl::Unsafe::Signals Perl4::CoreLibs +Perl::Unsafe::Signals perlbug(1) PerlIO::locale PerlIO::Util @@ -94,6 +105,8 @@ PerlIO::via::Base64 PerlIO::via::StripHTML perllexwarn(1) perlthanks +pod/perldiag.pod Verbatim line length including indents exceeds 79 by 1 +pod/perlrun.pod Verbatim line length including indents exceeds 79 by 3 POD2::FR POD2::IT pod2ipf(1) @@ -108,7 +121,9 @@ pstruct ptar(1) ptargrep(1) pwd_mkdb(8) +Readonly recvmsg(3) +Role::Tiny s2p Scalar::Readonly Semi::Semicolons @@ -143,6 +158,7 @@ Unicode::Regex::Set Unicode::Semantics Unicode::Unihan unzip(1) +Version::Requirements wait(2) waitpid(3) wget(1) @@ -150,29 +166,19 @@ Win32::Locale YAML YAML::Syck YAML::Tiny -dist/bignum/lib/bigint.pm Apparent broken link 1 -dist/bignum/lib/bignum.pm Apparent broken link 1 -dist/bignum/lib/bigrat.pm Apparent broken link 1 -dist/carp/lib/carp.pm Apparent broken link 2 -dist/constant/lib/constant.pm Apparent broken link 2 dist/cwd/lib/file/spec/vms.pm Verbatim line length including indents exceeds 79 by 1 dist/cwd/lib/file/spec/win32.pm Verbatim line length including indents exceeds 79 by 1 dist/data-dumper/dumper.pm ? Should you be using L<...> instead of 1 dist/extutils-parsexs/lib/perlxs.pod Verbatim line length including indents exceeds 79 by 1 dist/extutils-parsexs/lib/perlxstut.pod Verbatim line length including indents exceeds 79 by 10 dist/filter-simple/lib/filter/simple.pm Verbatim paragraph in NAME section 1 -dist/locale-maketext/lib/locale/maketext.pod No items in =over / =back list 1 dist/locale-maketext/lib/locale/maketext/tpj13.pod No items in =over / =back list 3 -dist/math-bigint/lib/math/bigfloat.pm Apparent broken link 1 -dist/math-bigint/lib/math/bigint.pm Apparent broken link 1 dist/math-bigint/lib/math/bigint.pm Verbatim line length including indents exceeds 79 by 77 -dist/math-bigint/lib/math/bigint/calcemu.pm Apparent broken link 1 dist/math-bigint/lib/math/bigint/calcemu.pm empty section in previous paragraph 3 -dist/math-bigrat/lib/math/bigrat.pm Apparent broken link 3 -dist/math-bigrat/lib/math/bigrat.pm Apparent internal link is missing its forward slash 1 dist/math-bigrat/lib/math/bigrat.pm Verbatim line length including indents exceeds 79 by 7 -dist/module-corelist/blib/script/corelist Verbatim line length including indents exceeds 79 by 1 +dist/math-bigrat/lib/math/bigrat.pm unresolved internal link 1 dist/module-corelist/lib/module/corelist.pod Verbatim line length including indents exceeds 79 by 4 +dist/module-corelist/lib/module/corelist/utils.pm Verbatim line length including indents exceeds 79 by 2 dist/net-ping/lib/net/ping.pm Verbatim line length including indents exceeds 79 by 2 dist/safe/safe.pm Verbatim line length including indents exceeds 79 by 1 dist/safe/safe.pm empty section in previous paragraph 1 @@ -181,7 +187,6 @@ dist/storable/storable.pm Verbatim line length including indents exceeds 79 by 4 dist/thread-queue/lib/thread/queue.pm Verbatim line length including indents exceeds 79 by 4 dist/threads/lib/threads.pm Verbatim line length including indents exceeds 79 by 3 dist/tie-file/lib/tie/file.pm Verbatim line length including indents exceeds 79 by 3 -dist/tie-file/lib/tie/file.pm unresolved internal link 1 ext/b/b/concise.pm Verbatim line length including indents exceeds 79 by 1 ext/devel-peek/peek.pm ? Should you be using L<...> instead of 2 ext/devel-peek/peek.pm Verbatim line length including indents exceeds 79 by 2 @@ -189,28 +194,24 @@ ext/dynaloader/dynaloader.pm Verbatim line length including indents exceeds 79 b ext/file-glob/glob.pm Verbatim line length including indents exceeds 79 by 15 ext/hash-util-fieldhash/lib/hash/util/fieldhash.pm Verbatim line length including indents exceeds 79 by 2 ext/i18n-langinfo/langinfo.pm Verbatim line length including indents exceeds 79 by 1 -ext/opcode/opcode.pm Verbatim line length including indents exceeds 79 by 10 ext/pod-html/bin/pod2html Pod NAME already used 1 ext/pod-html/testdir/perlpodspec-copy.pod Verbatim line length including indents exceeds 79 by 8 ext/pod-html/testdir/perlvar-copy.pod ? Should you be using L<...> instead of 3 -ext/pod-html/testdir/perlvar-copy.pod Apparent broken link 2 ext/pod-html/testdir/perlvar-copy.pod Verbatim line length including indents exceeds 79 by 6 -ext/posix/lib/posix.pod Verbatim line length including indents exceeds 79 by 29 -ext/re/re.pm Verbatim line length including indents exceeds 79 by 6 +ext/posix/lib/posix.pod Verbatim line length including indents exceeds 79 by 13 ext/vms-dclsym/dclsym.pm ? Should you be using L<...> instead of 1 ext/vms-dclsym/dclsym.pm Verbatim line length including indents exceeds 79 by 1 ext/vms-stdio/stdio.pm Verbatim line length including indents exceeds 79 by 1 ext/xs-apitest/apitest.pm Verbatim line length including indents exceeds 79 by 1 install ? Should you be using F<...> or maybe L<...> instead of 1 -install Verbatim line length including indents exceeds 79 by 11 installhtml Verbatim line length including indents exceeds 79 by 3 os2/os2/os2-extattr/extattr.pm ? Should you be using F<...> or maybe L<...> instead of 1 os2/os2/os2-process/process.pm Verbatim line length including indents exceeds 79 by 27 os2/os2/os2-rexx/dll/dll.pm Verbatim line length including indents exceeds 79 by 2 os2/os2/os2-rexx/rexx.pm Verbatim line length including indents exceeds 79 by 1 -pod/perl.pod Verbatim line length including indents exceeds 79 by 9 +pod/perl.pod Verbatim line length including indents exceeds 79 by 8 pod/perlaix.pod Verbatim line length including indents exceeds 79 by 11 -pod/perlapi.pod ? Should you be using L<...> instead of 85 +pod/perlapi.pod ? Should you be using L<...> instead of 76 pod/perlapi.pod Verbatim line length including indents exceeds 79 by 6 pod/perlapi.pod unresolved internal link 3 pod/perlapio.pod Verbatim line length including indents exceeds 79 by 5 @@ -220,48 +221,38 @@ pod/perlce.pod Verbatim line length including indents exceeds 79 by 2 pod/perlclib.pod Verbatim line length including indents exceeds 79 by 3 pod/perlcygwin.pod Verbatim line length including indents exceeds 79 by 25 pod/perldbmfilter.pod Verbatim line length including indents exceeds 79 by 1 -pod/perldebguts.pod Verbatim line length including indents exceeds 79 by 68 +pod/perldebguts.pod Verbatim line length including indents exceeds 79 by 34 pod/perldebtut.pod Verbatim line length including indents exceeds 79 by 22 pod/perldebug.pod Verbatim line length including indents exceeds 79 by 3 pod/perldiag.pod =item type mismatch 1 -pod/perldiag.pod Apparent broken link 1 +pod/perldiag.pod Verbatim line length including indents exceeds 79 by 1 pod/perldsc.pod Verbatim line length including indents exceeds 79 by 4 -pod/perldtrace.pod Verbatim line length including indents exceeds 79 by 22 -pod/perlebcdic.pod Verbatim line length including indents exceeds 79 by 273 +pod/perldtrace.pod Verbatim line length including indents exceeds 79 by 26 +pod/perlebcdic.pod Verbatim line length including indents exceeds 79 by 13 pod/perlembed.pod Verbatim line length including indents exceeds 79 by 27 pod/perlfunc.pod There is more than one target 1 -pod/perlfunc.pod Verbatim line length including indents exceeds 79 by 167 -pod/perlgit.pod Verbatim line length including indents exceeds 79 by 11 +pod/perlgit.pod Verbatim line length including indents exceeds 79 by 12 pod/perlgpl.pod Verbatim line length including indents exceeds 79 by 50 pod/perlguts.pod ? Should you be using F<...> or maybe L<...> instead of 2 pod/perlguts.pod ? Should you be using L<...> instead of 1 pod/perlhack.pod ? Should you be using L<...> instead of 1 -pod/perlhack.pod Verbatim line length including indents exceeds 79 by 1 -pod/perlhacktips.pod Verbatim line length including indents exceeds 79 by 1 -pod/perlhist.pod Verbatim line length including indents exceeds 79 by 2 -pod/perlhpux.pod Verbatim line length including indents exceeds 79 by 3 +pod/perlhist.pod Verbatim line length including indents exceeds 79 by 1 +pod/perlhpux.pod Verbatim line length including indents exceeds 79 by 5 pod/perlhurd.pod Verbatim line length including indents exceeds 79 by 2 pod/perlintern.pod ? Should you be using L<...> instead of 5 pod/perlinterp.pod ? Should you be using L<...> instead of 1 -pod/perlinterp.pod Verbatim line length including indents exceeds 79 by 1 -pod/perlintro.pod Verbatim line length including indents exceeds 79 by 11 pod/perliol.pod Verbatim line length including indents exceeds 79 by 8 -pod/perlipc.pod Apparent broken link 1 pod/perlipc.pod Verbatim line length including indents exceeds 79 by 19 pod/perlirix.pod Verbatim line length including indents exceeds 79 by 4 pod/perllol.pod Verbatim line length including indents exceeds 79 by 4 -pod/perlmacosx.pod Verbatim line length including indents exceeds 79 by 3 +pod/perlmacosx.pod Verbatim line length including indents exceeds 79 by 4 pod/perlmod.pod Verbatim line length including indents exceeds 79 by 2 pod/perlmodlib.pod Verbatim line length including indents exceeds 79 by 3 pod/perlmodstyle.pod Verbatim line length including indents exceeds 79 by 2 -pod/perlmpeix.pod Verbatim line length including indents exceeds 79 by 2 pod/perlmroapi.pod ? Should you be using L<...> instead of 1 pod/perlnetware.pod Verbatim line length including indents exceeds 79 by 4 pod/perlnewmod.pod Verbatim line length including indents exceeds 79 by 1 -pod/perlobj.pod Apparent broken link 1 pod/perlootut.pod ? Should you be using F<...> or maybe L<...> instead of 1 -pod/perlootut.pod Apparent internal link is missing its forward slash 16 -pod/perlop.pod Verbatim line length including indents exceeds 79 by 29 pod/perlos2.pod ? Should you be using L<...> instead of 2 pod/perlos2.pod Verbatim line length including indents exceeds 79 by 22 pod/perlos390.pod Verbatim line length including indents exceeds 79 by 11 @@ -269,14 +260,10 @@ pod/perlpacktut.pod Verbatim line length including indents exceeds 79 by 6 pod/perlperf.pod Verbatim line length including indents exceeds 79 by 154 pod/perlpodspec.pod Verbatim line length including indents exceeds 79 by 9 pod/perlpodstyle.pod Verbatim line length including indents exceeds 79 by 1 -pod/perlreapi.pod Verbatim line length including indents exceeds 79 by 17 -pod/perlrebackslash.pod Verbatim line length including indents exceeds 79 by 1 pod/perlref.pod Verbatim line length including indents exceeds 79 by 1 -pod/perlreguts.pod Verbatim line length including indents exceeds 79 by 17 pod/perlrequick.pod Verbatim line length including indents exceeds 79 by 3 pod/perlretut.pod Verbatim line length including indents exceeds 79 by 13 -pod/perlrun.pod Verbatim line length including indents exceeds 79 by 2 -pod/perlsec.pod Verbatim line length including indents exceeds 79 by 1 +pod/perlrun.pod Verbatim line length including indents exceeds 79 by 3 pod/perlsolaris.pod Verbatim line length including indents exceeds 79 by 14 pod/perlsource.pod ? Should you be using F<...> or maybe L<...> instead of 1 pod/perlsub.pod ? Should you be using F<...> or maybe L<...> instead of 3 @@ -285,7 +272,6 @@ pod/perlsymbian.pod Verbatim line length including indents exceeds 79 by 20 pod/perlthrtut.pod Verbatim line length including indents exceeds 79 by 5 pod/perltie.pod Verbatim line length including indents exceeds 79 by 13 pod/perltrap.pod ? Should you be using F<...> or maybe L<...> instead of 1 -pod/perltrap.pod Verbatim line length including indents exceeds 79 by 15 pod/perltru64.pod ? Should you be using F<...> or maybe L<...> instead of 1 pod/perltru64.pod Verbatim line length including indents exceeds 79 by 4 pod/perlunifaq.pod empty section in previous paragraph 1 @@ -300,11 +286,9 @@ porting/how_to_write_a_perldelta.pod Verbatim line length including indents exce porting/pumpkin.pod Verbatim line length including indents exceeds 79 by 9 porting/release_managers_guide.pod Verbatim line length including indents exceeds 79 by 7 porting/release_schedule.pod There is no NAME 1 -porting/todo.pod Apparent broken link 1 porting/todo.pod Verbatim line length including indents exceeds 79 by 7 symbian/perlutil.pod Verbatim line length including indents exceeds 79 by 4 utils/c2ph Verbatim line length including indents exceeds 79 by 44 -utils/libnetcfg Apparent broken link 1 utils/pod2html Pod NAME already used 1 vms/ext/filespec.pm Verbatim line length including indents exceeds 79 by 1 x2p/a2p.pod empty section in previous paragraph 2 @@ -312,9 +296,6 @@ lib/benchmark.pm Verbatim line length including indents exceeds 79 by 4 lib/class/struct.pm Verbatim line length including indents exceeds 79 by 7 lib/config.pod ? Should you be using L<...> instead of -1 lib/config.pod nested commands F<...F<...>...> 3 -lib/cpan/debug.pm There is no NAME 1 -lib/cpan/handleconfig.pm =head2 without preceding higher level 1 -lib/cpan/handleconfig.pm There is no NAME 1 lib/db.pm Verbatim line length including indents exceeds 79 by 2 lib/dbm_filter.pm Verbatim line length including indents exceeds 79 by 1 lib/dbm_filter/compress.pm Verbatim line length including indents exceeds 79 by 1 @@ -324,7 +305,6 @@ lib/dbm_filter/null.pm Verbatim line length including indents exceeds 79 by 1 lib/dbm_filter/utf8.pm Verbatim line length including indents exceeds 79 by 1 lib/deprecate.pm Verbatim line length including indents exceeds 79 by 2 lib/english.pm Verbatim line length including indents exceeds 79 by 1 -lib/exporter.pm Verbatim line length including indents exceeds 79 by 2 lib/extutils/embed.pm Verbatim line length including indents exceeds 79 by 2 lib/extutils/xssymset.pm Verbatim line length including indents exceeds 79 by 1 lib/file/basename.pm Verbatim line length including indents exceeds 79 by 2 diff --git a/gnu/usr.bin/perl/t/porting/maintainers.t b/gnu/usr.bin/perl/t/porting/maintainers.t index f5edaa86938..3744081cd93 100755 --- a/gnu/usr.bin/perl/t/porting/maintainers.t +++ b/gnu/usr.bin/perl/t/porting/maintainers.t @@ -11,6 +11,7 @@ BEGIN { chdir '..' unless -d 't'; @INC = qw(lib Porting); + require './t/test.pl'; } use strict; @@ -18,8 +19,7 @@ use warnings; use Maintainers qw(show_results process_options finish_tap_output); if ($^O eq 'VMS') { - print "1..0 # Skip: home-grown glob doesn't handle fancy patterns\n"; - exit 0; + skip_all "home-grown glob doesn't handle fancy patterns"; } { diff --git a/gnu/usr.bin/perl/t/porting/manifest.t b/gnu/usr.bin/perl/t/porting/manifest.t index 068540c983c..ea4fe832d79 100755 --- a/gnu/usr.bin/perl/t/porting/manifest.t +++ b/gnu/usr.bin/perl/t/porting/manifest.t @@ -5,7 +5,7 @@ BEGIN { @INC = '..' if -f '../TestInit.pm'; } -use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute +use TestInit qw(T); # T is chdir to the top level require 't/test.pl'; diff --git a/gnu/usr.bin/perl/t/porting/pending-author.t b/gnu/usr.bin/perl/t/porting/pending-author.t index 6bc392b35c6..0cb40545294 100644 --- a/gnu/usr.bin/perl/t/porting/pending-author.t +++ b/gnu/usr.bin/perl/t/porting/pending-author.t @@ -23,7 +23,7 @@ BEGIN { @INC = '..' if -f '../TestInit.pm'; } -use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute +use TestInit qw(T); # T is chdir to the top level use strict; require 't/test.pl'; @@ -43,9 +43,7 @@ sub get { my $key = shift; my $value = `git config --get user.$key`; unless (defined $value && $value =~ /\S/) { - plan(1); - like($value, qr/\S/, "git config --get user.$key returned a value"); - exit 1; + skip_all("git config --get user.$key returned nought"); } chomp $value; return $value; diff --git a/gnu/usr.bin/perl/t/porting/podcheck.t b/gnu/usr.bin/perl/t/porting/podcheck.t index def6615338a..9864af621c3 100755 --- a/gnu/usr.bin/perl/t/porting/podcheck.t +++ b/gnu/usr.bin/perl/t/porting/podcheck.t @@ -399,6 +399,8 @@ my $non_pods = qr/ (?: \. | $lib_ext # object libraries | $lib_so # shared libraries | $dl_ext # dynamic libraries + | gif # GIF images (example files from CGI.pm) + | eg # examples from libnet ) $ ) | ~$ | \ \(Autosaved\)\.txt$ # Other editor droppings @@ -456,7 +458,8 @@ sub suppressed { sub plan { my %plan = @_; - $planned = $plan{tests}; + $planned = $plan{tests} + 1; # +1 for final test that files haven't + # been removed print "1..$planned\n"; return; } @@ -470,7 +473,7 @@ sub suppressed { $current_test++; print "not " unless $success; print "ok $current_test - $message\n"; - return; + return $success; } sub skip { @@ -1034,6 +1037,27 @@ package My::Pod::Checker { # Extend Pod::Checker delete $problems{$self->get_filename}; return; } + + sub parse_from_file { + # This overrides the super class method so that if an open fails on a + # transitory file, it doesn't croak. It returns 1 if it did find the + # file, 0 if it didn't + + my $self = shift; + my $filename = shift; + # ignores 2nd param, which is output file. Always uses undef + + if (open my $in_fh, '<:bytes', $filename) { + $self->SUPER::parse_from_filehandle($in_fh, undef); + close $in_fh; + return 1; + } + + # If couldn't open file, perhaps it was transitory, and hence not an error + return 0 unless -e $filename; + + die "Can't open '$filename': $!\n"; + } } package Tie_Array_to_FH { # So printing actually goes to an array @@ -1227,7 +1251,8 @@ sub my_safer_print { # print, with error checking for outputting to db } } -sub extract_pod { # Extracts just the pod from a file +sub extract_pod { # Extracts just the pod from a file; returns undef if file + # doesn't exist my $filename = shift; my @pod; @@ -1235,30 +1260,33 @@ sub extract_pod { # Extracts just the pod from a file # Arrange for the output of Pod::Parser to be collected in an array we can # look at instead of being printed tie *ALREADY_FH, 'Tie_Array_to_FH', \@pod; - open my $in_fh, '<:bytes', $filename + if (open my $in_fh, '<:bytes', $filename) { + my $parser = Pod::Parser->new(); + $parser->parse_from_filehandle($in_fh, *ALREADY_FH); + close $in_fh; - # The file should already have been opened once to get here, so if - # fails, just die. It's possible that a transitory file containing a - # pod would get here, but not bothering to add code for that very - # unlikely event. - or die "Can't open '$filename': $!\n"; - - my $parser = Pod::Parser->new(); - $parser->parse_from_filehandle($in_fh, *ALREADY_FH); - close $in_fh; + return join "", @pod + } - return join "", @pod + # The file should already have been opened once to get here, so if that + # fails, something is wrong. It's possible that a transitory file + # containing a pod would get here, so if the file no longer exists just + # return undef. + return unless -e $filename; + die "Can't open '$filename': $!\n"; } my $digest = Digest->new($digest_type); +# This is used as a callback from File::Find::find(), which always constructs +# pathnames using Unix separators sub is_pod_file { # If $_ is a pod file, add it to the lists and do other prep work. if (-d) { # Don't look at files in directories that are for tests, nor those # beginning with a dot - if ($_ eq 't' || $_ =~ /^\../) { + if (m!/t\z! || m!/\.!) { $File::Find::prune = 1; } return; @@ -1268,8 +1296,9 @@ sub is_pod_file { # check if 0 length return unless -f || -l; # Weird file types won't be pods - if ($_ =~ /^\./ # No hidden Unix files - || $_ =~ $non_pods) { + my ($leaf) = m!([^/]+)\z!; + if (m!/\.! # No hidden Unix files + || $leaf =~ $non_pods) { note("Not considering $_") if DEBUG; return; } @@ -1277,8 +1306,7 @@ sub is_pod_file { my $filename = $File::Find::name; # $filename is relative, like './path'. Strip that initial part away. - # Assumes that the path separator is exactly one character. - $filename =~ s/^\..//; + $filename =~ s!^\./!! or die 'Unexpected pathname "$filename"'; return if $excluded_files{canonicalize($filename)}; @@ -1393,7 +1421,7 @@ else { # No input files -- go find all the possibilities. chdir File::Spec->updir; # And look in this directory and all its subdirectories - find( \&is_pod_file, '.'); + find( {wanted => \&is_pod_file, no_chdir => 1}, '.'); # Add ourselves to the test push @files, "t/porting/podcheck.t"; @@ -1448,6 +1476,7 @@ plan (tests => scalar @files) if ! $regen; @files; # Now go through all the files and parse them +FILE: foreach my $filename (@files) { my $parsed = 0; note("parsing $filename") if DEBUG; @@ -1464,8 +1493,12 @@ foreach my $filename (@files) { # We have set the name in the checker object if there is a possibility # that no further parsing is necessary, but otherwise do the parsing now. if (! $checker->name) { + if (! $checker->parse_from_file($filename, undef)) { + $checker->set_skip("$filename is transitory"); + next FILE; + } $parsed = 1; - $checker->parse_from_file($filename, undef); + } if ($checker->num_errors() < 0) { # Returns negative if not a pod @@ -1484,7 +1517,12 @@ foreach my $filename (@files) { } else { my $digest = Digest->new($digest_type); - $digest->add(extract_pod($filename)); + my $contents = extract_pod($filename); + + # If the return is undef, it means that $filename was a transitory + # file; skip it. + next FILE unless defined $contents; + $digest->add($contents); $id = $digest->digest; } @@ -1510,7 +1548,28 @@ foreach my $filename (@files) { # reason, but the pods they contain are identical. Extract the # pods and do the comparisons on just those. if (! $same && $name) { - $same = extract_pod($prior_filename) eq extract_pod($filename); + my $contents = extract_pod($filename); + + # If return is <undef>, it means that $filename no longer + # exists. This means it was a transitory file, and should not + # be tested. + next FILE unless defined $contents; + + my $prior_contents = extract_pod($prior_filename); + + # If return is <undef>, it means that $prior_filename no + # longer exists. This means it was a transitory file, and + # should not have been tested, but we already did process it. + # What we should do now is to back-out its records, and + # process $filename in its stead. But backing out is not so + # simple, and so I'm (khw) skipping that unless and until + # experience shows that it is needed. We do go process + # $filename, and there are potential false positive conflicts + # with the transitory $prior_contents, and rerunning the test + # should cause it to succeed. + goto process_this_pod unless defined $prior_contents; + + $same = $prior_contents eq $contents; } if ($same) { @@ -1544,9 +1603,11 @@ foreach my $filename (@files) { # In any event, don't process this pod that has the same name as # another. - next; + next FILE; } + process_this_pod: + # A unique pod. $id_to_checker{$id} = $checker; @@ -1557,8 +1618,10 @@ foreach my $filename (@files) { if ($filename =~ /^cpan/) { $checker->set_skip("CPAN is upstream for $filename"); } - elsif ($filename =~ /perl\d+delta/ && ! $do_deltas) { - $checker->set_skip("$filename is a stable perldelta"); + elsif ($filename =~ /perl\d+delta/) { + if (! $do_deltas) { + $checker->set_skip("$filename is a stable perldelta"); + } } elsif ($filename =~ /perltoc/) { $checker->set_skip("$filename dependent on component pods"); @@ -1578,7 +1641,7 @@ foreach my $filename (@files) { $checker->poderror( { -msg => $no_name, -line => '???' }); - next; + next FILE; } # For skipped files, just get its NAME @@ -1587,14 +1650,17 @@ foreach my $filename (@files) { { $checker->node($name) if $name; } - else { - $checker->parse_from_file($filename, undef) if ! $parsed; + elsif (! $parsed) { + if (! $checker->parse_from_file($filename, undef)) { + $checker->set_skip("$filename is transitory"); + next FILE; + } } # Go through everything in the file that could be an anchor that # could be a link target. Count how many there are of the same name. foreach my $node ($checker->linkable_nodes) { - next if ! $node; # Can be empty is like '=item *' + next FILE if ! $node; # Can be empty is like '=item *' if (exists $nodes{$name}{$node}) { $nodes{$name}{$node}++; } @@ -1738,9 +1804,10 @@ foreach my $filename (@files) { # subtract back this number we previously added in. $total_known -= $problem_count; - $diagnostic .= $indent . $message; + $diagnostic .= $indent . qq{"$message"}; if ($problem_count > 2) { - $diagnostic .= " ($problem_count occurrences)"; + $diagnostic .= " ($problem_count occurrences," + . " expected $known_problems{$canonical}{$message})"; } foreach my $problem (@{$problems{$filename}{$message}}) { $diagnostic .= " " if $problem_count == 1; @@ -1776,9 +1843,21 @@ foreach my $filename (@files) { note(join "", @diagnostics, "See end of this test output for your options on silencing this"); } + + delete $known_problems{$canonical}; } } +if (! $regen + && ! ok (keys %known_problems == 0, "The known problems data base includes no references to non-existent files")) +{ + note("The following files were not found: " + . join ", ", keys %known_problems); + note("They will automatically be removed from the db the next time"); + note(" cd t; ./perl -I../lib porting/podcheck.t --regen"); + note("is run"); +} + my $how_to = <<EOF; run this test script by hand, using the following formula (on Un*x-like machines): diff --git a/gnu/usr.bin/perl/t/porting/regen.t b/gnu/usr.bin/perl/t/porting/regen.t index 8595fb05f2f..e127eb0d460 100644 --- a/gnu/usr.bin/perl/t/porting/regen.t +++ b/gnu/usr.bin/perl/t/porting/regen.t @@ -16,11 +16,11 @@ if ( $^O eq "VMS" ) { skip_all( "- regen.pl needs porting." ); } -my $in_regen_pl = 22; # I can't see a clean way to calculate this automatically. +my $in_regen_pl = 23; # I can't see a clean way to calculate this automatically. my @files = qw(perly.act perly.h perly.tab keywords.c keywords.h uconfig.h); -my @progs = qw(Porting/makemeta regen/regcharclass.pl regen/mk_PL_charclass.pl); +my @progs = qw(regen/regcharclass.pl regen/mk_PL_charclass.pl); -plan (tests => $in_regen_pl + @files + @progs); +plan (tests => $in_regen_pl + @files + @progs + 2); OUTER: foreach my $file (@files) { open my $fh, '<', $file or die "Can't open $file: $!"; @@ -47,3 +47,7 @@ OUTER: foreach my $file (@files) { foreach (@progs, 'regen.pl') { system "$^X $_ --tap"; } + +foreach ( '-y', '-j' ) { + system "$^X Porting/makemeta --tap $_"; +} diff --git a/gnu/usr.bin/perl/t/porting/test_bootstrap.t b/gnu/usr.bin/perl/t/porting/test_bootstrap.t index d07e659dad6..654eaac9990 100755 --- a/gnu/usr.bin/perl/t/porting/test_bootstrap.t +++ b/gnu/usr.bin/perl/t/porting/test_bootstrap.t @@ -7,7 +7,10 @@ use strict; # This regression tests ensures that the rules aren't accidentally overlooked. -require './test.pl'; +BEGIN { + chdir 't'; + require './test.pl'; +} plan('no_plan'); @@ -46,7 +49,17 @@ while (my $file = <$fh>) { unless $file eq 'comp/require.t' } -# There are regression tests using test.pl that don't want PL_sawampersand set +# There are regression tests using test.pl that don't want PL_sawampersand +# set. Or at least that was the case until PL_sawampersand was disabled +# and replaced with copy-on-write. + +# We still allow PL_sawampersand to be enabled with +# -Accflags=-DPERL_SAWAMPERSAND, so when that is defined we can still run +# these tests. When it is not enabled, PL_sawampersand makes no observable +# difference so the tests fail. + +require Config; +exit unless "@{[Config::bincompat_options()]}" =~ /\bPERL_SAWAMPERSAND\b/; # This very much relies on a bug in the regexp implementation, but for now it's # the best way to work out whether PL_sawampersand is true. diff --git a/gnu/usr.bin/perl/t/porting/utils.t b/gnu/usr.bin/perl/t/porting/utils.t index 30c02b78930..13a164950b9 100644 --- a/gnu/usr.bin/perl/t/porting/utils.t +++ b/gnu/usr.bin/perl/t/porting/utils.t @@ -51,6 +51,7 @@ my @victims = (qw(installman installperl regen_perly.pl)); my %excuses = ( 'Porting/git-deltatool' => 'Git::Wrapper', 'Porting/podtidy' => 'Pod::Tidy', + 'Porting/leakfinder.pl' => 'XS::APItest', ); foreach (@maybe) { |