Teach diag.t about Perl_mess

[perl5.git] / t / porting / diag.t

diff --git a/t/porting/diag.t b/t/porting/diag.t
index b71c94d..e94922b 100644 (file)
--- 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" );
+}
+
 plan('no_plan');
 
 # --make-exceptions-list outputs the list of strings that don't have
@@ -17,7 +23,8 @@ plan('no_plan');
 # initially so as to not create new test failures upon the initial
 # creation of this test file.  You probably shouldn't do it again.
 # Just add the documentation instead.
-my $make_exceptions_list = ($ARGV[0]||'') eq '--make-exceptions-list';
+my $make_exceptions_list = ($ARGV[0]||'') eq '--make-exceptions-list'
+  and shift;
 
 require 'regen/embed_lib.pl';
 
@@ -32,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 =
@@ -78,11 +86,12 @@ while (<$diagfh>) {
         last;
       }
 
-      $cur_entry .= $_;
+      $cur_entry =~ s/ ?\z/ $_/;
     }
 
     $cur_entry =~ s/\n/ /gs; # Fix multi-line headers if they have \n's
     $cur_entry =~ s/\s+\z//;
+    $cur_entry =~ s/[BCIFS](?:<<< (.*?) >>>|<< (.*?) >>|<(.*?)>)/$+/g;
 
     if (exists $entries{$cur_entry} &&  $entries{$cur_entry}{todo}
                                     && !$entries{$cur_entry}{cattodo}) {
@@ -177,13 +186,17 @@ my $specialformats =
  join '|', sort { length $b cmp length $a } keys %specialformats;
 my $specialformats_re = qr/%$format_modifiers"\s*($specialformats)(\s*")?/;
 
+if (@ARGV) {
+  check_file($_) for @ARGV;
+  exit;
+}
 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)/!
+    next if $file =~ m!\A(?:ext|dist|cpan|lib|t|os2/OS2|x2p)/!
             && $file !~ m!\Aext/DynaLoader/!;
     check_file($file);
 }
@@ -235,7 +248,7 @@ sub check_file {
 
     my $multiline = 0;
     # Loop to accumulate the message text all on one line.
-    if (m/\b(?:$source_msg_re(?:_nocontext)?|$regcomp_re)\s*\(/) {
+    if (m/(?!^)\b(?:$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;
@@ -499,7 +512,7 @@ endhostent not implemented!
 endnetent not implemented!
 endprotoent not implemented!
 endservent not implemented!
-Error loading module '%s': %s'
+Error loading module '%s': %s
 Error reading "%s": %s
 execl not implemented!
 EVAL without pos change exceeded limit in regex
@@ -509,6 +522,7 @@ Filehandle STD%s reopened as %s only for input
 file_type not implemented on DOS
 filter_del can only delete in reverse order (currently)
 fork() not available
+fork() not implemented!
 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!
 free %s
 Free to wrong pool %p not %p
@@ -536,6 +550,7 @@ Function "tcflow" not implemented in this version of perl.
 Function "tcflush" not implemented in this version of perl.
 Function "tcsendbreak" not implemented in this version of perl.
 get %s %p %p %p
+gethostent not implemented!
 getnetbyaddr not implemented!
 getnetbyname not implemented!
 getnetent not implemented!
@@ -583,11 +598,13 @@ 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
 QUITing...
 Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)
+recursion detected in %s
 Regexp *+ operand could be empty in regex; marked by <-- HERE in m/%s/
 Reversed %c= operator
 %s: Can't parse EXE/DLL name: '%s'
@@ -618,7 +635,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
@@ -636,7 +652,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)
@@ -664,13 +682,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/