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
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;
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 =
"(?<routine>\\bDIE\\b|$function_re)";
my $text_re = '"(?<text>(?:\\\\"|[^"]|"\s*[A-Z_]+\s*")*)"';
my $source_msg_call_re = qr/$source_msg_re(?:_nocontext)? \s*
- \((?:aTHX_)? \s*
+ \( (?: \s* Perl_form \( )? (?:aTHX_)? \s*
(?:packWARN\d*\((?<category>.*?)\),)? \s*
$text_re /x;
my $bad_version_re = qr{BADVERSION\([^"]*$text_re};
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;
$cur_entry =~ s/\n/ /gs; # Fix multi-line headers if they have \n's
$cur_entry =~ s/\s+\z//;
+ $cur_entry =~ s/E<lt>/</g;
+ $cur_entry =~ s/E<gt>/>/g;
+ $cur_entry =~ s,E<sol>,/,g;
+ $cur_entry =~ s/[BCIFS](?:<<< (.*?) >>>|<< (.*?) >>|<(.*?)>)/$+/g;
if (exists $entries{$cur_entry} && $entries{$cur_entry}{todo}
&& !$entries{$cur_entry}{cattodo}) {
}
}
+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}
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
$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);
}
$listed_as = $1;
$listed_as_line = $.+1;
}
+ elsif (m</\*\s*diag_listed_as: (.*?)\s*\z>) {
+ $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
# 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!"
}
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
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
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
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)
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
'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/