From: James Mastros Date: Mon, 22 Jun 2009 15:09:18 +0000 (+0100) Subject: Add support for TODO diag tests -- a list in DATA of error messages that are allowed... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=87a63fff814bea4d594840ceb735b2807e76f5f9;p=p5sagit%2Fp5-mst-13.2.git Add support for TODO diag tests -- a list in DATA of error messages that are allowed to not be in perldiag.pod without it being a 'not ok', just a 'ok # TODO', and populate the DATA section with the current ones. --- diff --git a/t/pod/diag.t b/t/pod/diag.t index ee562b2..5ecbe1e 100644 --- a/t/pod/diag.t +++ b/t/pod/diag.t @@ -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 () { + 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 \%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