diff options
| -rw-r--r-- | Makefile | 1 | ||||
| -rw-r--r-- | perl_checker.src/test/.cvsignore | 2 | ||||
| -rw-r--r-- | perl_checker.src/test/Makefile | 3 | ||||
| -rw-r--r-- | perl_checker.src/test/context.t | 15 | ||||
| -rw-r--r-- | perl_checker.src/test/force_layout.t | 14 | ||||
| -rw-r--r-- | perl_checker.src/test/method.t | 11 | ||||
| -rw-r--r-- | perl_checker.src/test/prototype.t | 23 | ||||
| -rw-r--r-- | perl_checker.src/test/read_t.pm | 27 | ||||
| -rw-r--r-- | perl_checker.src/test/return_value.t | 16 | ||||
| -rw-r--r-- | perl_checker.src/test/suggest_better.t | 79 | ||||
| -rw-r--r-- | perl_checker.src/test/syntax_restrictions.t | 52 | ||||
| -rwxr-xr-x | perl_checker.src/test/test_it | 95 | ||||
| -rw-r--r-- | perl_checker.src/test/various_errors.t | 42 |
13 files changed, 380 insertions, 0 deletions
@@ -25,6 +25,7 @@ perl_checker.src/perl_checker: test: perl_checker.src/perl_checker perl_checker.src/perl_checker MDK/Common/*.pm + $(MAKE) -C perl_checker.src/test clean: rm -f $(GENERATED) diff --git a/perl_checker.src/test/.cvsignore b/perl_checker.src/test/.cvsignore new file mode 100644 index 0000000..9f6633c --- /dev/null +++ b/perl_checker.src/test/.cvsignore @@ -0,0 +1,2 @@ +.pl +.perl_checker.cache diff --git a/perl_checker.src/test/Makefile b/perl_checker.src/test/Makefile new file mode 100644 index 0000000..abe816c --- /dev/null +++ b/perl_checker.src/test/Makefile @@ -0,0 +1,3 @@ + +test: + for i in *.t; do ./test_it $$i || exit 1; done diff --git a/perl_checker.src/test/context.t b/perl_checker.src/test/context.t new file mode 100644 index 0000000..5fd7809 --- /dev/null +++ b/perl_checker.src/test/context.t @@ -0,0 +1,15 @@ +foreach (%h) {} foreach with a hash is usually an error + +map { 'xxx' } %h a hash is not a valid parameter to function map + +$xxx = ('yyy', 'zzz') context tuple(string, string) is not compatible with context scalar + +@l ||= 'xxx' "||=" is only useful with a scalar + +length @l never use "length @l", it returns the length of the string int(@l) + +%h . 'yyy' context hash is not compatible with context string + +'xxx' > 'yyy' you should use a string operator, not the number operator ">" + +1 cmp 2 you should use a number operator, not the string operator "cmp" (or replace the number with a string) diff --git a/perl_checker.src/test/force_layout.t b/perl_checker.src/test/force_layout.t new file mode 100644 index 0000000..96b3d71 --- /dev/null +++ b/perl_checker.src/test/force_layout.t @@ -0,0 +1,14 @@ +sub xxx you should not have a carriage-return (\n) here +{} + +xxx you should not have a carriage-return (\n) here + ($xxx); + +xxx( $xxx) you should not have a space here + +$xxx ++ you should not have a space here + +my($_xxx, $_yyy) you should have a space here + +xxx ($xxx) you should not have a space here + diff --git a/perl_checker.src/test/method.t b/perl_checker.src/test/method.t new file mode 100644 index 0000000..e59e858 --- /dev/null +++ b/perl_checker.src/test/method.t @@ -0,0 +1,11 @@ +bad->yyy unknown package bad + +pkg->bad unknown method bad starting in package pkg + +$xxx->bad unknown method bad + +$xxx->m1 not enough parameters + +$xxx->m0('zzz') too many parameters + +$xxx->m0_or_2('zzz') not enough or too many parameters diff --git a/perl_checker.src/test/prototype.t b/perl_checker.src/test/prototype.t new file mode 100644 index 0000000..6e56aae --- /dev/null +++ b/perl_checker.src/test/prototype.t @@ -0,0 +1,23 @@ + +sub xxx { 'yyy' } if the function doesn't take any parameters, please use the empty prototype. + example "sub foo() { ... }" + +sub xxx { an non-optional argument must not follow an optional argument + my ($o_xxx, $yyy) = @_; + ($o_xxx, $yyy); +} + +sub xxx { an array must be the last variable in a prototype + my (@xxx, $yyy) = @_; + @xxx, $yyy; +} + +bad() unknown function bad + +sub f0() {} too many parameters +f0('yyy') + +sub f2 { my ($x, $_y) = @_; $x } not enough parameters +f2('yyy') + +N("xxx %s yyy") not enough parameters diff --git a/perl_checker.src/test/read_t.pm b/perl_checker.src/test/read_t.pm new file mode 100644 index 0000000..d7d9b9c --- /dev/null +++ b/perl_checker.src/test/read_t.pm @@ -0,0 +1,27 @@ +package read_t; + +use lib '../..'; +use MDK::Common; + +sub read_t { + my ($file) = @_; + + my @tests; + my ($column_width, $line_number, @lines, @logs); + foreach (cat_($file), "\n") { + if (/^$/) { + push @tests, { line_number => $line_number, lines => [ @lines ], logs => [ @logs ] } if @lines; + @lines = @logs = (); + } else { + $column_width ||= length(first(/(.{20}\s+)/)); + my ($line, $log) = $column_width > 25 && /(.{$column_width})(.*)/ ? (chomp_($1) . "\n", $2) : ($_, ''); + push @lines, $line; + push @logs, $log; + } + $line_number++; + } + @tests; +} + +1; + diff --git a/perl_checker.src/test/return_value.t b/perl_checker.src/test/return_value.t new file mode 100644 index 0000000..e826c08 --- /dev/null +++ b/perl_checker.src/test/return_value.t @@ -0,0 +1,16 @@ +if ($xxx or $yyy) {} value should be dropped + context () is not compatible with context scalar + +if ($xxx and $yyy) {} value should be dropped + context () is not compatible with context scalar + +$xxx && yyy(); value is dropped + +`xxx`; value is dropped + +/(.*)/; value is dropped + +map { xxx($_) } @l; if you don't use the return value, use "foreach" instead of "map" + +$xxx = chomp; () context not accepted here + context () is not compatible with context scalar diff --git a/perl_checker.src/test/suggest_better.t b/perl_checker.src/test/suggest_better.t new file mode 100644 index 0000000..aa413cb --- /dev/null +++ b/perl_checker.src/test/suggest_better.t @@ -0,0 +1,79 @@ +@{$xxx} @{$xxx} can be written @$xxx + +$h{"yyy"} {"yyy"} can be written {yyy} + +"$xxx" $xxx is better written without the double quotes + +$xxx->{yyy}->{zzz} the arrow "->" is unneeded + +"xxx\$xxx" you can replace "xxx\$xxx" with 'xxx$xxx', that way you don't need to escape <$> + +"xxx\$xxx" you can replace "xxx\$xxx" with 'xxx$xxx', that way you don't need to escape <$> + +"xxx\"$xxx" you can replace "xxx\"xxx" with qq(xxx"xxx), that way you don't need to escape <"> + +/xxx\'xxx/ you can replace \' with ' + +/xxx\;xxx/ you can replace \; with ; + +/\// change the delimit character / to get rid of this escape + +{ nop(); } spurious ";" before closing block + ++1 don't use unary + + +return ($xxx) unneeded parentheses + +if (($xxx eq $yyy) || $zzz) {} unneeded parentheses + +if (($xxx =~ /yyy/) || $zzz) {} unneeded parentheses + +nop() foreach ($xxx, $yyy); unneeded parentheses + +($xxx) ||= 'xxx' remove the parentheses + +$o->m0() remove these unneeded parentheses + +$o = xxx() if !$o; "$foo = ... if !$foo" can be written "$foo ||= ..." + +$_ =~ s/xxx/yyy/ "$_ =~ s/regexp/.../" can be written "s/regexp/.../" + +$xxx =~ /^yyy$/ "... =~ /^yyy$/" is better written "... eq 'yyy'" + +/xxx.*/ you can remove ".*" at the end of your regexp + +/xxx.*$/ you can remove ".*$" at the end of your regexp + +/[^\s]/ you can replace [^\s] with \S + +/[^\w]/ you can replace [^\w] with \W + +$xxx ? $xxx : $yyy you can replace "$foo ? $foo : $bar" with "$foo || $bar" + +my @l = (); no need to initialize variables, it's done by default + +$l[$#l] you can replace $#l with -1 + +xxx(@_) replace xxx(@_) with &xxx + +member($xxx, keys %h) you can replace "member($xxx, keys %yyy)" with "exists $yyy{$xxx}" + +!($xxx =~ /.../) !($var =~ /.../) is better written $var !~ /.../ + +foreach (@l) { use "push @l2, grep { ... } ..." instead of "foreach (...) { push @l2, $_ if ... }" + push @l2, $_ if yyy($_); or sometimes "@l2 = grep { ... } ..." +} + +foreach (@l) { use "push @l2, map { ... } ..." instead of "foreach (...) { push @l2, ... }" + push @l2, yyy($_); or sometimes "@l2 = map { ... } ..." +} + +foreach (@l) { use "push @l2, map { ... ? ... : () } ..." instead of "foreach (...) { push @l2, ... if ... }" + push @l2, yyy($_) if zzz($_); or sometimes "@l2 = map { ... ? ... : () } ..." +} or sometimes "@l2 = map { if_(..., ...) } ..." + +if (grep { xxx() } @l) {} in scalar context, use "any" instead of "grep" + +$xxx ? $yyy : () you may use if_() here + beware that the short-circuit semantic of ?: is not kept + if you want to keep the short-circuit behaviour, replace () with @{[]} and there will be no warning anymore diff --git a/perl_checker.src/test/syntax_restrictions.t b/perl_checker.src/test/syntax_restrictions.t new file mode 100644 index 0000000..6c336be --- /dev/null +++ b/perl_checker.src/test/syntax_restrictions.t @@ -0,0 +1,52 @@ +$xxx <<= 2 don't use "<<=", use the expanded version instead + +m@xxx@ don't use m@...@, replace @ with / ! , or | + +qx(xxx) don't use qx{...}, use `...` instead + +not $xxx don't use "not", use "!" instead + +$1 =~ /xxx/ do not use the result of a match (eg: $1) to match another pattern + +$xxx =~ "yyy" use a regexp, not a string + +xxx() =~ s/xxx/yyy/ you can only use s/// on a variable + +$1 =~ /xxx/ do not use the result of a match (eg: $1) to match another pattern + +grep /xxx/, @l always use "grep" with a block (eg: grep { ... } @list) + +for (@l) {} write "foreach" instead of "for" + +foreach ($xxx = 0; $xxx < 9; $xxx++) {} write "for" instead of "foreach" + +foreach $xxx (@l) {} don't use for without "my"ing the iteration variable + +foreach ($xxx) {} you are using the special fpons trick to locally set $_ with a value, for this please use "for" instead of "foreach" + +unless ($xxx) {} else {} don't use "else" with "unless" (replace "unless" with "if") + +unless ($xxx) {} elsif ($yyy) {} don't use "elsif" with "unless" (replace "unless" with "if") + +zzz() unless $xxx || $yyy; don't use "unless" when the condition is complex, use "if" instead + +$$xxx{yyy} for complex dereferencing, use "->" + +wantarray please use wantarray() instead of wantarray + +eval please use "eval $_" instead of "eval" + +$xxx !~ s/xxx/yyy/ use =~ instead of !~ and negate the return value + +pkg::nop $xxx; use parentheses around argument (otherwise it might cause syntax errors if the package is "require"d and not "use"d + +new foo $xxx you must parenthesize parameters: "new Class(...)" instead of "new Class ..." + +*xxx = *yyy "*xxx = *yyy" is better written "*xxx = \&yyy" + +$_xxx = 1 variable $_xxx must not be used + (variable with name _XXX are reserved for unused variables) + +sub f2 { my ($x, $_y) = @_; $x } not enough parameters +f2(@l); # ok +f2(xxx()); # bad diff --git a/perl_checker.src/test/test_it b/perl_checker.src/test/test_it new file mode 100755 index 0000000..06ab059 --- /dev/null +++ b/perl_checker.src/test/test_it @@ -0,0 +1,95 @@ +#!/usr/bin/perl + +use lib '../..'; +use MDK::Common; +use read_t; + +my ($file) = @ARGV; +my @tests = read_t::read_t($file); + +output('pkg3.pm', <<'EOF'); +package pkg3; +our @ISA = qw(Exporter); +our %EXPORT_TAGS = ( + missing_fs => [ qw(f f0) ], +); +our @EXPORT_OK = qw(f); +EOF + +my $header = <<'EOF'; +package pkg; +sub new {} +sub m0 { my ($_o) = @_; 0 } +sub m1 { my ($_o, $a) = @_; $a } +sub m2 { my ($_o, $_a, $b) = @_; $b } +sub m0_or_2 { my ($_o, $_a, $b) = @_; $b } +package pkg2; +sub new {} +sub m0_or_2 { my ($_o) = @_; 0 } + +package my_pkg; +sub nop {} +sub xxx { @_ } +sub yyy { @_ } +sub zzz { @_ } +sub pkg::nop {} +sub N { $_[0] } +sub N_ { $_[0] } +my ($xxx, $yyy, $zzz, $o, @l, @l2, %h); +xxx($xxx, $yyy, $zzz, $o, @l, @l2, %h); +use MDK::Common; + +EOF + +my $oo_header = <<'EOF'; +EOF + +my $local = <<'EOF'; +{ + local $_; +EOF + +my $local_trailer = <<'EOF'; + + xxx($xxx, $yyy, $zzz, $o, @l, @l2, %h); +} +EOF + +my $new; +foreach my $test (@tests) { + my @l = @{$test->{lines}}; + + pop @l while $l[-1] =~ /^\s*$/; + if (@l == 1) { + if ($l[-1] !~ /(;|[\s{]\})\s+$/) { + $l[-1] =~ s/^(.*?)(\s+$)/xxx($1);$2/; + } else { + $l[-1] =~ s/(\s+$)/; nop();$1/; + } + } + if (! any { /^(sub|use) / } @l) { + @l = ($local, @l, $local_trailer); + } + if (any { /->\w/ } @l) { + @l = ($oo_header, $header, @l); + } else { + @l = ($header, @l); + } + output('.pl', @l); + my @log = grep { !/^File .*, line / } `perl_checker .pl`; + die "@log in .pl ($file):\n" . join('', @{$test->{lines}}) if any { /^syntax error$/ } @log; + foreach my $i (0 .. max(int @{$test->{lines}}, int @log) - 1) { + my $s = $test->{lines}[$i]; + $s =~ s/\s+$//; + $new .= sprintf "%-40s %s", $s, $log[$i] || "\n"; + } + $new .= "\n"; +} +output("$file.new", $new); +if (system('diff', '-buB', $file, "$file.new") == 0) { + unlink "$file.new", '.pl', 'pkg3.pm'; + exit 0; +} else { + warn "*" x 80, "\nnot same\n"; + exit 1; +} diff --git a/perl_checker.src/test/various_errors.t b/perl_checker.src/test/various_errors.t new file mode 100644 index 0000000..4ad9976 --- /dev/null +++ b/perl_checker.src/test/various_errors.t @@ -0,0 +1,42 @@ +local $xxx ||= $yyy applying ||= on a new initialized variable is wrong + +$1 =~ s/xxx/yyy/ do not modify the result of a match (eg: $1) + +$xxx[1, 2] you must give only one argument + +$xxx[] you must give one argument + +'' || 'xxx' <constant> || ... is the same as ... + +if ($xxx = '') {} are you sure you did not mean "==" instead of "="? + +N("xxx$yyy") don't use interpolated translated string, use %s or %d instead + +1 + 2 >> 3 missing parentheses (needed for clarity) + +$xxx ? $yyy = 1 : $zzz = 2; missing parentheses (needed for clarity) + +N_("xxx") . 'yyy' N_("xxx") . "yyy" is dumb since the string "xxx" will never get translated + +my (@l2, $xxx) = @l; @l2 takes all the arguments, $xxx is undef in any case + +$bad undeclared variable $bad + +{ my $a } unused variable $a + +my $xxx; yyy($xxx); my $xxx; redeclared variable $xxx + +{ my $xxx; $xxx = 1 } variable $xxx assigned, but not read + +$a undeclared variable $a + +use bad; can't find package bad + +use pkg3 ':bad'; package pkg3 doesn't export tag :bad +bad(); unknown function bad + +use pkg3 ':missing_fs'; name &f is not defined in package pkg3 +f(); name &f0 is not defined in package pkg3 + +use pkg3 'f'; name &f is not defined in package pkg3 +f(); |