This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldiag: Correct ‘Perl %s required’
[perl5.git] / t / porting / diag.t
index 3b0521a..5022094 100644 (file)
@@ -53,7 +53,8 @@ my %entries;
 my $reading_categorical_exceptions;
 while (<DATA>) {
   chomp;
-  $entries{$_}{$reading_categorical_exceptions ? 'cattodo' : 'todo'}=1;
+  $entries{$_}{todo} = 1;
+  $reading_categorical_exceptions and $entries{$_}{cattodo}=1;
   /__CATEGORIES__/ and ++$reading_categorical_exceptions;
 }
 
@@ -82,7 +83,8 @@ while (<$diagfh>) {
     $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}) {
+    if (exists $entries{$cur_entry} &&  $entries{$cur_entry}{todo}
+                                    && !$entries{$cur_entry}{cattodo}) {
         TODO: {
             local $::TODO = "Remove the TODO entry \"$cur_entry\" from DATA as it is already in $pod near line $.";
             ok($cur_entry);
@@ -160,6 +162,7 @@ my %specialformats = (IVdf => 'd',
                      NVgf => 'f',
                      HEKf256=>'s',
                      HEKf => 's',
+                     UTF8f=> 's',
                      SVf256=>'s',
                      SVf32=> 's',
                      SVf  => 's');
@@ -243,8 +246,8 @@ sub check_file {
         $nextline =~ s/^\s+//;
         $_ =~ s/\\$//;
         # Note that we only want to do this where *both* are true.
-        if ($_ =~ m/"$/ and $nextline =~ m/^"/) {
-          $_ =~ s/"$//;
+        if ($_ =~ m/"\s*$/ and $nextline =~ m/^"/) {
+          $_ =~ s/"\s*$//;
           $nextline =~ s/^"//;
         }
         $_ .= $nextline;
@@ -365,7 +368,10 @@ sub check_message {
     # Kill precision
     $key =~ s/\%\.(\d+|\*)/%/g;
 
-    if (exists $entries{$key}) {
+    if (exists $entries{$key} and
+          # todo + cattodo means it is not found and it is not in the
+          # regular todo list, either
+          !$entries{$key}{todo} || !$entries{$key}{cattodo}) {
       $ret = 1;
       if ( $entries{$key}{seen}++ ) {
         # no need to repeat entries we've tested
@@ -403,7 +409,6 @@ sub check_message {
            ($categories ? "categories are [$categories]" : "no category")
              . " for $key");
       }
-      # Later, should start checking that the severity is correct, too.
     } elsif ($partial) {
       # noop
     } else {
@@ -453,14 +458,7 @@ sub check_message {
 __DATA__
 Malformed UTF-8 character (unexpected non-continuation byte 0x%x, immediately after start byte 0x%x)
 
-'%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
@@ -481,8 +479,6 @@ Code missing after '/' in unpack
 '%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!
@@ -492,11 +488,8 @@ 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)
@@ -508,8 +501,6 @@ Illegal binary digit '%c' ignored
 Illegal character %sin prototype for %s : %s
 Illegal hexadecimal digit '%c' ignored
 Illegal octal digit '%c' ignored
-Infinite recursion in regex
-internal %<num>p might conflict with future printf extensions
 Invalid argument to sv_cat_decode
 Invalid range "%c-%c" in transliteration operator
 Invalid separator character %c%c%c in PerlIO layer specification %s
@@ -520,24 +511,17 @@ Invalid type '%c' in unpack
 Invalid type ',' in %s
 ioctlsocket not implemented!
 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
+\N{} in character class restricted to one character in regex; marked by <-- HERE in m/%s/
 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
@@ -589,8 +573,6 @@ 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
-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)
@@ -614,6 +596,7 @@ 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
+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
@@ -626,6 +609,3 @@ 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/