This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add support for TODO diag tests -- a list in DATA of error messages that are allowed...
authorJames Mastros <theorb@desert-island.me.uk>
Mon, 22 Jun 2009 15:09:18 +0000 (16:09 +0100)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Sat, 27 Jun 2009 14:41:00 +0000 (16:41 +0200)
t/pod/diag.t

index ee562b2..5ecbe1e 100644 (file)
@@ -4,29 +4,39 @@ use strict;
 use Test::More 'no_plan';
 $|=1;
 
-open my $diagfh, "<:raw", "pod/perldiag.pod"
-  or die "Can't open pod/perldiag.pod: $!";
+my $make_exceptions_list = $ARGV[0]||'' eq '--make-exceptions-list';
+
+open my $diagfh, "<:raw", "../pod/perldiag.pod"
+  or die "Can't open ../pod/perldiag.pod: $!";
 
 my %entries;
+while (<DATA>) {
+  chomp;
+  $entries{$_}{todo}=1;
+}
+
 my $cur_entry;
 while (<$diagfh>) {
   if (m/^=item (.*)/) {
     $cur_entry = $1;
   } elsif (m/^\((.)(?: ([a-z]+?))?\)/ and !$entries{$cur_entry}{severity}) {
+    # Make sure to init this here, so an actual entry in perldiag overwrites
+    # one in DATA.
+    $entries{$cur_entry}{todo} = 0;
     $entries{$cur_entry}{severity} = $1;
     $entries{$cur_entry}{category} = $2;
   }
 }
 
-my @todo = ('.');
+my @todo = ('..');
 while (@todo) {
   my $todo = shift @todo;
-  next if $todo ~~ ['./t', './lib', './ext'];
+  next if $todo ~~ ['../t', '../lib', '../ext'];
   # opmini.c is just a copy of op.c, so there's no need to check again.
-  next if $todo eq './opmini.c';
+  next if $todo eq '../opmini.c';
   if (-d $todo) {
     push @todo, glob "$todo/*";
-  } elsif ($todo =~ m/\.(c|h)$/) {
+  } elsif ($todo =~ m/\.[ch]$/) {
     check_file($todo);
   }
 }
@@ -117,42 +127,257 @@ sub check_file {
         $name =~ s/%\.(\d+|\*)s/\%s/g;
         $name =~ s/\\"/"/g;
         $name =~ s/\\t/\t/g;
-        $name =~ s/\\n/\n/g;
-        $name =~ s/\n$//;
+        $name =~ s/\\n/ /g;
+        $name =~ s/\s+$//;
       }
 
-      # Extra explanitory info on an already-listed error, doesn't need it's own listing.
+      # Extra explanatory info on an already-listed error, doesn't
+      # need it's own listing.
       next if $name =~ m/^\t/;
 
       # Happens fairly often with PL_no_modify.
       next if $name eq '%s';
 
-      # Special syntax for magic comment, allows ignoring the fact that it isn't listed.
-      # Only use in very special circumstances, like this script failing to notice that
-      # the Perl_croak call is inside an #if 0 block.
+      # Special syntax for magic comment, allows ignoring the fact
+      # that it isn't listed.  Only use in very special circumstances,
+      # like this script failing to notice that the Perl_croak call is
+      # inside an #if 0 block.
       next if $name eq 'SKIPME';
 
-      if (!exists $entries{$name}) {
-        if ($name =~ m/^panic: /) {
-          # Just too many panic:s, they are hard to diagnose, and there is a generic "panic: %s" entry.
-          # Leave these for another pass.
-          ok("Presence of '$name' from $codefn line $., covered by panic: %s entry");
+      if (exists $entries{$name}) {
+        if ($entries{$name}{todo}) {
+        TODO: {
+            local $TODO = 'in DATA';
+            fail("Presence of '$name' from $codefn line $.");
+          }
         } else {
-          fail("Presence of '$name' from $codefn line $.");
+          ok("Presence of '$name' from $codefn line $.");
         }
+        # Later, should start checking that the severity is correct, too.
+      } elsif ($name =~ m/^panic: /) {
+        # Just too many panic:s, they are hard to diagnose, and there
+        # is a generic "panic: %s" entry.  Leave these for another
+        # pass.
+        ok("Presence of '$name' from $codefn line $., covered by panic: %s entry");
       } else {
-        ok("Presence of '$name' from $codefn line $.");
-        # Commented: "substr outside of string" has is either a warning
-        # or an error, depending how much was outside.
-        # Also, plenty of failures without forcing further hardship...
-#         if ($entries{$name} and !($entries{$name}{severity} ~~ $severity)) {
-#           fail("Severity for '$name' from $codefn line $.: got $entries{$name}{severity}, expected $severity");
-#         } else {
-#           ok("Severity for '$name' from $codefn line $.: got $entries{$name}{severity}, expected $severity");
-#         }
+        if ($make_exceptions_list) {
+          print STDERR "$name\n";
+        } else {
+          fail("Presence of '$name' from $codefn line $.");
+        }
       }
 
       die if $name =~ /%$/;
     }
   }
 }
+# Lists all missing things as of the inaguation of this script, so we
+# don't have to go from "meh" to perfect all at once.
+__DATA__
+Ambiguous call resolved as CORE::%s(), %s
+Ambiguous use of %c resolved as operator %c
+Ambiguous use of %c{%s} resolved to %c%s
+Ambiguous use of %c{%s%s} resolved to %c%s%s
+Ambiguous use of -%s resolved as -&%s()
+Argument "%s" isn't numeric
+Argument "%s" isn't numeric in %s
+Assertion: marks beyond string end
+Assertion: string is shorter than advertised
+Attempt to clear deleted array
+Attempt to free non-arena SV: 0x%x
+Attempt to free non-existent shared string '%s'%s
+Attempt to free temp prematurely: SV 0x%x
+Attempt to free unreferenced scalar: SV 0x%x
+Attempt to reload %s aborted. Compilation failed in require
+av_reify called on tied array
+Bad name after %s%s
+Bad symbol for scalar
+bad top format reference
+Bizarre copy of %s
+Bizarre SvTYPE [%d]
+Cannot copy to %s
+Can't call method "%s" %s
+Can't coerce readonly %s to string
+Can't coerce readonly %s to string in %s
+Can't fix broken locale name "%s"
+Can't get short module name from a handle
+Can't goto subroutine from an eval-block
+Can't goto subroutine from an eval-string
+Can't locate object method "%s" via package "%s" (perhaps you forgot to load "%s"?)
+Can't modify non-existent substring
+Can't open
+Can't open perl script "%s": %s
+Can't open %s
+Can't reset \%ENV on this system
+Can't return array to lvalue scalar context
+Can't return a %s from lvalue subroutine
+Can't return hash to lvalue scalar context
+Can't spawn "%s": %s
+Can't %s script `%s' with ARGV[0] being `%s'
+Can't %s "%s": %s
+Can't %s %s%s%s
+Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)
+Can't take %s of %f
+Can't use '%c' after -mname
+Can't use \\%c to mean $%c in expression
+Can't use when() outside a topicalizer
+\\%c better written as $%c
+Character(s) in '%c' format wrapped in %s
+$%c is no longer supported
+Cloning substitution context is unimplemented
+Code missing after '/' in pack
+Code missing after '/' in unpack
+Compilation failed in require
+Corrupted regexp opcode %d > %d
+'%c' outside of string in pack
+Debug leaking scalars child failed%s%s with errno %d: %s
+Deep recursion on anonymous subroutine
+defined(\%hash) is deprecated
+Don't know how to handle magic of type \\%o
+-Dp not implemented on this platform
+entering effective gid failed
+entering effective uid failed
+Error reading "%s": %s
+Exiting %s via %s
+Filehandle opened only for %sput
+Filehandle %s opened only for %sput
+Filehandle STD%s reopened as %s only for input
+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!
+Format STDOUT redefined
+Free to wrong pool %p not %p
+get %s %p %p %p
+glob failed (can't start child: %s)
+glob failed (child exited with status %d%s)
+Goto undefined subroutine
+Goto undefined subroutine &%s
+Hash \%%s missing the \% in argument %d of %s()
+Illegal character \\%03o (carriage return)
+Illegal character %sin prototype for %s : %s
+Integer overflow in decimal number
+Integer overflow in version %d
+internal \%<num>p might conflict with future printf extensions
+invalid control request: '\\%03o'
+Invalid module name %s with -%c option: contains single ':'
+invalid option -D%c, use -D'' to see choices
+Invalid range "%c-%c" in transliteration operator
+Invalid separator character %c%c%c in PerlIO layer specification %s
+Invalid TOKEN object ignored
+Invalid type '%c' in pack
+Invalid type '%c' in %s
+Invalid type '%c' in unpack
+Invalid type ',' in %s
+Invalid version format (alpha without decimal)
+Invalid version format (misplaced _ in number)
+Invalid version object
+'j' not supported on this platform
+'J' not supported on this platform
+Layer does not match this perl
+leaving effective gid failed
+leaving effective uid failed
+List form of piped open not implemented
+Lost precision when decrementing %f by 1
+Lost precision when incrementing %f by 1
+%lx
+Malformed UTF-16 surrogate
+Malformed UTF-8 character (fatal)
+'\%' may not be used in pack
+Missing (suid) fd script name
+More than one argument to open
+More than one argument to open(,':%s')
+mprotect for %p %d failed with %d
+mprotect RW for %p %d failed with %d
+No code specified for -%c
+No directory specified for -I
+No such class field "%s"
+Not an XSUB reference
+Not %s reference
+Offset outside string
+Opening dirhandle %s also as a file
+Opening filehandle %s also as a directory
+Operator or semicolon missing before %c%s
+Overloaded dereference did not return a reference
+Perl bug: predicted utf8 length not available
+PERL_SIGNALS illegal: "%s"
+Perl %s required (did you mean %s?)--this is only %s, stopped
+Perl %s required--this is only %s, stopped
+Perls since %s too modern--this is %s, stopped
+Possible unintended interpolation of $\\ in regex
+ptr wrong %p != %p fl=%08
+Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)
+Recursive call to Perl_load_module in PerlIO_find_layer
+refcnt_dec: fd %d < 0
+refcnt_dec: fd %d: %d <= 0
+refcnt_dec: fd %d >= refcnt_size %d
+refcnt_inc: fd %d < 0
+refcnt_inc: fd %d: %d <= 0
+Reversed %c= operator
+Runaway prototype
+%s(%.0f) failed
+%s(%.0f) too large
+Scalar value %s better written as $%s
+%sCompilation failed in regexp
+%sCompilation failed in require
+set %s %p %p %p
+%s free() ignored (RMAGIC, PERL_CORE)
+%s has too many errors.
+SIG%s handler "%s" not defined.
+%s: illegal mapping '%s'
+%s in %s
+Size magic not implemented
+%s limit (%d) exceeded
+%s method "%s" overloading "%s" in package "%s"
+%s number > %s non-portable
+%s object version %s does not match %s%s%s%s %s
+%srealloc() %signored
+%s returned from lvalue subroutine in scalar context
+%s%s has too many errors.
+%s%s on %s %s
+%s%s on %s %s %s
+Starting Full Screen process with flag=%d, mytype=%d
+Starting PM process with flag=%d, mytype=%d
+strxfrm() gets absurd
+SWASHNEW didn't return an HV ref
+-T and -B not implemented on filehandles
+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 stat preceding lstat() wasn't an lstat
+The telldir() function is not implemented on NetWare
+Too deeply nested ()-groups in %s
+Too late to run CHECK block
+Too late to run INIT block
+Too many args on %s line of "%s"
+U0 mode on a byte string
+Unbalanced string table refcount: (%d) for "%s"
+Undefined top format called
+Unexpected constant lvalue entersub entry via type/targ %d:%d
+Unicode character 0x%04
+Unknown PerlIO layer "scalar"
+Unknown Unicode option letter '%c'
+unrecognised control character '%c'
+Unstable directory path, current directory changed unexpectedly
+Unsupported script encoding UTF16-BE
+Unsupported script encoding UTF16-LE
+Unsupported script encoding UTF32-BE
+Unsupported script encoding UTF32-LE
+Unterminated compressed integer in unpack
+Usage: CODE(0x%x)(%s)
+Usage: %s(%s)
+Usage: %s::%s(%s)
+Usage: VMS::Filespec::unixrealpath(spec)
+Usage: VMS::Filespec::vmsrealpath(spec)
+Use of inherited AUTOLOAD for non-method %s::%s() is deprecated
+UTF-16 surrogate 0x%04
+utf8 "\\x%02X" does not map to Unicode
+Value of logical "%s" too long. Truncating to %i bytes
+value of node is %d in Offset macro
+Value of %s%s can be "0"; test with defined()
+Variable "%c%s" is not imported
+vector argument not supported with alpha versions
+Wide character
+Wide character in $/
+Wide character in print
+Wide character in %s
+Within []-length '%c' not allowed in %s
+Wrong syntax (suid) fd script name "%s"
+'X' outside of string in unpack