X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/31b4070eb5c607dc93529ab7e817e7995e96fce8..b2a155af1156a8966d25d80509a542f2ca3b6dc2:/t/porting/diag.t diff --git a/t/porting/diag.t b/t/porting/diag.t index 00a317d..b892dfa 100644 --- a/t/porting/diag.t +++ b/t/porting/diag.t @@ -7,8 +7,14 @@ use TestInit qw(T); # T is chdir to the top level use warnings; use strict; +use Config; + +require './t/test.pl'; + +if ( $Config{usecrosscompile} ) { + skip_all( "Not all files are available during cross-compilation" ); +} -require 't/test.pl'; plan('no_plan'); # --make-exceptions-list outputs the list of strings that don't have @@ -20,7 +26,7 @@ plan('no_plan'); my $make_exceptions_list = ($ARGV[0]||'') eq '--make-exceptions-list' and shift; -require 'regen/embed_lib.pl'; +require './regen/embed_lib.pl'; # Look for functions that look like they could be diagnostic ones. my @functions; @@ -33,6 +39,7 @@ foreach (@{(setup_embed())[0]}) { push @functions, 'Perl_' . $_->[2] if $_->[0] =~ /p/; push @functions, 'S_' . $_->[2] if $_->[0] =~ /s/; }; +push @functions, 'Perl_mess'; my $regcomp_fail_re = '\b(?:(?:Simple_)?v)?FAIL[2-4]?(?:utf8f)?\b'; my $regcomp_re = @@ -42,7 +49,7 @@ my $source_msg_re = "(?\\bDIE\\b|$function_re)"; my $text_re = '"(?(?:\\\\"|[^"]|"\s*[A-Z_]+\s*")*)"'; my $source_msg_call_re = qr/$source_msg_re(?:_nocontext)? \s* - \((?:aTHX_)? \s* + \( (?: \s* Perl_form \( )? (?:aTHX_)? \s* (?:packWARN\d*\((?.*?)\),)? \s* $text_re /x; my $bad_version_re = qr{BADVERSION\([^"]*$text_re}; @@ -69,7 +76,20 @@ 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; +my $depth = 0; while (<$diagfh>) { + if (m/^=over/) { + $depth++; + next; + } + if (m/^=back/) { + $depth--; + next; + } + + # Stuff deeper than main level is ignored + next if $depth != 1; + if (m/^=item (.*)/) { $cur_entry = $1; @@ -84,6 +104,10 @@ while (<$diagfh>) { $cur_entry =~ s/\n/ /gs; # Fix multi-line headers if they have \n's $cur_entry =~ s/\s+\z//; + $cur_entry =~ s/E//>/g; + $cur_entry =~ s,E,/,g; + $cur_entry =~ s/[BCIFS](?:<<< (.*?) >>>|<< (.*?) >>|<(.*?)>)/$+/g; if (exists $entries{$cur_entry} && $entries{$cur_entry}{todo} && !$entries{$cur_entry}{cattodo}) { @@ -130,6 +154,11 @@ while (<$diagfh>) { } } +if ($depth != 0) { + diag ("Unbalance =over/=back. Fix before proceeding; over - back = " . $depth); + exit(1); +} + foreach my $cur_entry ( keys %entries) { next if $entries{$cur_entry}{todo}; # If in this file, won't have a severity if (! exists $entries{$cur_entry}{severity} @@ -167,7 +196,8 @@ my %specialformats = (IVdf => 'd', UTF8f=> 's', SVf256=>'s', SVf32=> 's', - SVf => 's'); + SVf => 's', + PNf => 's'); my $format_modifiers = qr/ [#0\ +-]* # optional flags (?: [1-9][0-9]* | \* )? # optional field width (?: \. \d* )? # optional precision @@ -188,7 +218,7 @@ while (my $file = <$fh>) { $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|x2p)/! + next if $file =~ m!\A(?:ext|dist|cpan|lib|t|os2/OS2)/! && $file !~ m!\Aext/DynaLoader/!; check_file($file); } @@ -236,12 +266,28 @@ sub check_file { $listed_as = $1; $listed_as_line = $.+1; } + elsif (m) { + $listed_as = $1; + my $finished; + while (<$codefh>) { + if (m<\*/>) { + $listed_as .= $` =~ s/^\s*/ /r =~ s/\s+\z//r; + $listed_as_line = $.+1; + $finished = 1; + last; + } + else { + $listed_as .= s/^\s*/ /r =~ s/\s+\z//r; + } + } + if (!$finished) { $listed_as = undef } + } next if /^#/; my $multiline = 0; # Loop to accumulate the message text all on one line. if (m/(?!^)\b(?:$source_msg_re(?:_nocontext)?|$regcomp_re)\s*\(/) { - while (not m/\);$/) { + while (not m/\);\s*$/) { my $nextline = <$codefh>; # Means we fell off the end of the file. Not terribly surprising; # this code tries to merge a lot of things that aren't regular C @@ -277,6 +323,8 @@ sub check_file { # Sometimes the regexp will pick up too much for the category # e.g., WARN_UNINITIALIZED), PL_warn_uninit_sv ... up to the next ) $category && $category =~ s/\).*//s; + # Special-case yywarn + /yywarn/ and $category = 'syntax'; if (/win32_croak_not_implemented\(/) { $name .= " not implemented!" } @@ -476,7 +524,6 @@ Can't fix broken locale name "%s" Can't get short module name from a handle Can't load DLL `%s', possible problematic module `%s' Can't locate %s: %s -Can't locate object method "%s" via package "%s" (perhaps you forgot to load "%s"?) Can't pipe "%s": %s Can't set type on DOS Can't spawn: %s @@ -590,6 +637,7 @@ Not array reference given to mod2fname Operator or semicolon missing before %c%s Out of memory during list extend panic queryaddr +Parse error 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 @@ -626,7 +674,6 @@ sv_2iv assumed (U_V(fabs((double)SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%f U_V 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 @@ -644,7 +691,9 @@ Unexpected program mode %d when morphing back from PM Unrecognized character %s; marked by <-- HERE after %s<-- HERE near column %d Unstable directory path, current directory changed unexpectedly Unterminated compressed integer in unpack +Usage: %s(%s) Usage: %s::%s(%s) +Usage: CODE(0x%x)(%s) Usage: File::Copy::rmscopy(from,to[,date_flag]) Usage: VMS::Filespec::candelete(spec) Usage: VMS::Filespec::fileify(spec) @@ -656,7 +705,6 @@ 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 waitpid: process %x is not a child of process %x @@ -672,13 +720,12 @@ Wrong syntax (suid) fd script name "%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 + +# This is a warning, but is currently followed immediately by a croak (toke.c) Illegal character \%o (carriage return) + +# Because uses WARN_MISSING as a synonym for WARN_UNINITIALIZED (sv.c) 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 + +# This message can be both fatal and non- False [] range "%s" in regex; marked by <-- HERE in m/%s/