From 31a9cb9dbe9eb562576f69b77676e880781ed332 Mon Sep 17 00:00:00 2001 From: Moritz Bunkus Date: Mon, 18 Apr 2011 11:03:20 +0200 Subject: [PATCH] =?utf8?q?Testscript=20zum=20Auffinden=20h=C3=A4ufiger=20F?= =?utf8?q?ehler=20(z.B.=20"my=20@foo=20=3D=20shift"=20oder=20"%bar->someth?= =?utf8?q?ing()")?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- t/structure/common_errors.t | 71 +++++++++++++++++++++++++++++++++++++ 1 file changed, 71 insertions(+) create mode 100644 t/structure/common_errors.t diff --git a/t/structure/common_errors.t b/t/structure/common_errors.t new file mode 100644 index 000000000..6e73070b1 --- /dev/null +++ b/t/structure/common_errors.t @@ -0,0 +1,71 @@ +#!/usr/bin/perl + +use strict; +use lib 't'; +use Support::Files; + +my ($testcount); + +BEGIN { + $testcount = scalar @Support::Files::testitems; +} + +use Test::More tests => $testcount; + +# Capture the TESTOUT from Test::More or Test::Builder for printing errors. +# This will handle verbosity for us automatically. +my $fh; +{ + local $^W = 0; # Don't complain about non-existent filehandles + if (-e \*Test::More::TESTOUT) { + $fh = \*Test::More::TESTOUT; + } elsif (-e \*Test::Builder::TESTOUT) { + $fh = \*Test::Builder::TESTOUT; + } else { + $fh = \*STDOUT; + } +} + +my @testitems = @Support::Files::testitems; + +# at last, here we actually run the test... + +my @common_errors = ([ '^\s*my\s+%[a-z0-9_]+\s*=\s*shift' ], + [ '^\s*my\s+\(.*\)\s*=\s*shift' ], + [ '^\s*my\s+\$.*\s*=\s*@_' ], + [ '@[a-z0-9_]+->' ], + [ 'uft8' ], + [ '\$slef' ], + ); + +foreach my $file (@testitems) { + $file =~ s/\s.*$//; # nuke everything after the first space (#comment) + next if (!$file); # skip null entries + + if (open (FILE, $file)) { # open the file for reading + $_->[1] = [] foreach @common_errors; + + my $line_number = 0; + while (my $file_line = ) { + $line_number++; + + foreach my $re (@common_errors) { + push @{ $re->[1] }, $line_number if $file_line =~ /$re->[0]/i; + } + } + + close (FILE); + + my $errors = join(' ', map { $_->[0] . ' (' . join(' ', @{ $_->[1] }) . ')' } grep { scalar @{ $_->[1] } } @common_errors); + if ($errors) { + ok(0,"$file: found common errors: $errors"); + } else { + ok(1,"$file does not contain common errors"); + } + } else { + ok(0,"could not open $file for common errors check --WARNING"); + } +} + +exit 0; + -- 2.20.1