This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
porting/diag.t: Allow nested =item's
[perl5.git] / t / porting / diag.t
index cfda017..b892dfa 100644 (file)
@@ -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
@@ -17,9 +23,10 @@ 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';
+require './regen/embed_lib.pl';
 
 # Look for functions that look like they could be diagnostic ones.
 my @functions;
@@ -32,15 +39,17 @@ foreach (@{(setup_embed())[0]}) {
   push @functions, 'Perl_' . $_->[2] if $_->[0] =~ /p/;
   push @functions, 'S_' . $_->[2] if $_->[0] =~ /s/;
 };
+push @functions, 'Perl_mess';
 
-my $regcomp_re = "(?<routine>(?:ckWARN(?:\\d+)?reg\\w*|vWARN\\d+))";
-my $function_re = join '|', @functions;
 my $regcomp_fail_re = '\b(?:(?:Simple_)?v)?FAIL[2-4]?(?:utf8f)?\b';
+my $regcomp_re =
+   "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_fail_re)";
+my $function_re = join '|', @functions;
 my $source_msg_re =
-   "(?<routine>\\bDIE\\b|$function_re|$regcomp_fail_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};
@@ -67,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;
 
@@ -77,11 +99,15 @@ 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/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}) {
@@ -128,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}
@@ -165,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
@@ -176,6 +208,10 @@ 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;
@@ -230,12 +266,28 @@ sub check_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/\);$/) {
+    if (m/(?!^)\b(?:$source_msg_re(?:_nocontext)?|$regcomp_re)\s*\(/) {
+      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
@@ -271,6 +323,11 @@ 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!"
+      }
     }
     elsif (/$bad_version_re/) {
       ($name, $category) = ($+{'text'}, undef);
@@ -460,12 +517,15 @@ __DATA__
 Malformed UTF-8 character (unexpected non-continuation byte 0x%x, immediately after start byte 0x%x)
 
 Cannot apply "%s" in non-PerlIO perl
+Cannot set timer
+Can't find DLL name for the module `%s' by the handle %d, rc=%u=%x
 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 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
 Can't spawn "%s": %s
 Can't %s script `%s' with ARGV[0] being `%s'
@@ -477,23 +537,68 @@ chown not implemented!
 clear %s
 Code missing after '/' in pack
 Code missing after '/' in unpack
+Could not find version 1.1 of winsock dll
+Could not find version 2.0 of winsock dll
 '%c' outside of string in pack
 Debug leaking scalars child failed%s with errno %d: %s
+detach of a thread which could not start
+detach on an already detached thread
+detach on a thread with a waiter
 '/' does not take a repeat count in %s
 -Dp not implemented on this platform
+Empty array reference given to mod2fname
+endhostent not implemented!
+endnetent not implemented!
+endprotoent not implemented!
+endservent not implemented!
+Error loading module '%s': %s
 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
+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
+Function "endnetent" not implemented in this version of perl.
+Function "endprotoent" not implemented in this version of perl.
+Function "endservent" not implemented in this version of perl.
+Function "getnetbyaddr" not implemented in this version of perl.
+Function "getnetbyname" not implemented in this version of perl.
+Function "getnetent" not implemented in this version of perl.
+Function "getprotobyname" not implemented in this version of perl.
+Function "getprotobynumber" not implemented in this version of perl.
+Function "getprotoent" not implemented in this version of perl.
+Function "getservbyport" not implemented in this version of perl.
+Function "getservent" not implemented in this version of perl.
+Function "getsockopt" not implemented in this version of perl.
+Function "recvmsg" not implemented in this version of perl.
+Function "sendmsg" not implemented in this version of perl.
+Function "sethostent" not implemented in this version of perl.
+Function "setnetent" not implemented in this version of perl.
+Function "setprotoent" not implemented in this version of perl.
+Function "setservent"  not implemented in this version of perl.
+Function "setsockopt" not implemented in this version of perl.
+Function "tcdrain" not implemented in this version of perl.
+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!
+getprotoent not implemented!
 getpwnam returned invalid UIC %o for user "%s"
+getservent not implemented!
 glob failed (can't start child: %s)
 glob failed (child exited with status %d%s)
+Got an error from DosAllocMem: %i
 Goto undefined subroutine
 Goto undefined subroutine &%s
 Got signal %d
@@ -502,6 +607,7 @@ Illegal binary digit '%c' ignored
 Illegal character %sin prototype for %s : %s
 Illegal hexadecimal digit '%c' ignored
 Illegal octal digit '%c' ignored
+INSTALL_PREFIX too long: `%s'
 Invalid argument to sv_cat_decode
 Invalid range "%c-%c" in transliteration operator
 Invalid separator character %c%c%c in PerlIO layer specification %s
@@ -510,69 +616,84 @@ Invalid type '%c' in pack
 Invalid type '%c' in %s
 Invalid type '%c' in unpack
 Invalid type ',' in %s
+ioctl implemented only on sockets
 ioctlsocket not implemented!
+join with a thread with a waiter
 killpg not implemented!
 List form of pipe open not implemented
+Looks like we have no PM; will not load DLL %s without $ENV{PERL_ASIF_PM}
 Malformed integer in [] in %s
+Malformed %s
 Malformed UTF-8 character (fatal)
 Missing (suid) fd script name
 More than one argument to open
 More than one argument to open(,':%s')
-\N{} in character class restricted to one character in regex; marked by <-- HERE in m/%s/
+No message queue
 No %s allowed while running setgid
 No %s allowed with (suid) fdscript
 Not an XSUB reference
+Not a reference given to mod2fname
+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 ?)
-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/
+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'
 %s(%f) failed
 %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/
+%s: Error stripping dirs from EXE/DLL/INSTALLDIR name
+sethostent not implemented!
+setnetent not implemented!
+setprotoent not implemented!
 set %s %p %p %p
+setservent not implemented!
 %s free() ignored (RMAGIC, PERL_CORE)
 %s has too many errors.
 SIG%s handler "%s" not defined.
 %s in %s
 Size magic not implemented
+%s: name `%s' too long
+%s not implemented!
 %s number > %s non-portable
 %srealloc() %signored
 %s in regex m/%s/
 %s on %s %s
 socketpair not implemented!
+%s: %s
 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
 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
 The telldir() function is not implemented on NetWare
+This perl was compiled without taint support. Cowardly refusing to run with -t or -T flags
+This version of OS/2 does not support %s.%s
 Too deeply nested ()-groups in %s
 Too many args on %s line of "%s"
 U0 mode on a byte string
 unable to find VMSPIPE.COM for i/o piping
+Unable to locate winsock library!
+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)
@@ -584,27 +705,27 @@ 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
 Wide character
 Wide character in $/
+win32_get_osfhandle() TBD on this platform
+win32_open_osfhandle() TBD on this platform
 Within []-length '*' not allowed in %s
 Within []-length '%c' not allowed in %s
+Wrong size of loadOrdinals array: expected %d, actual %d
 Wrong syntax (suid) fd script name "%s"
 'X' outside of string in %s
 'X' outside of string in unpack
-Zero length \N{} in regex; marked by <-- HERE in m/%s/
 
 __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/