diff options
Diffstat (limited to 'src/test')
| -rw-r--r-- | src/test/.cvsignore | 2 | ||||
| -rw-r--r-- | src/test/Makefile | 3 | ||||
| -rw-r--r-- | src/test/context.t | 41 | ||||
| -rw-r--r-- | src/test/force_layout.t | 23 | ||||
| -rw-r--r-- | src/test/method.t | 11 | ||||
| -rw-r--r-- | src/test/prototype.t | 23 | ||||
| -rw-r--r-- | src/test/read_t.pm | 28 | ||||
| -rw-r--r-- | src/test/return_value.t | 23 | ||||
| -rw-r--r-- | src/test/suggest_better.t | 112 | ||||
| -rw-r--r-- | src/test/syntax_restrictions.t | 70 | ||||
| -rwxr-xr-x | src/test/test_it | 113 | ||||
| -rw-r--r-- | src/test/various_errors.t | 61 |
12 files changed, 510 insertions, 0 deletions
diff --git a/src/test/.cvsignore b/src/test/.cvsignore new file mode 100644 index 0000000..9f6633c --- /dev/null +++ b/src/test/.cvsignore @@ -0,0 +1,2 @@ +.pl +.perl_checker.cache diff --git a/src/test/Makefile b/src/test/Makefile new file mode 100644 index 0000000..abe816c --- /dev/null +++ b/src/test/Makefile @@ -0,0 +1,3 @@ + +test: + for i in *.t; do ./test_it $$i || exit 1; done diff --git a/src/test/context.t b/src/test/context.t new file mode 100644 index 0000000..081abcc --- /dev/null +++ b/src/test/context.t @@ -0,0 +1,41 @@ +foreach (%h) {} context hash is not compatible with context list + 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' context string is not compatible with context float + context string is not compatible with context float + + +1 cmp 2 you should use a number operator, not the string operator "cmp" (or replace the number with a string) + +$xxx == undef context undef is not compatible with context float + +my ($xxx) = 1 context int is not compatible with context tuple(scalar) + +($xxx, $yyy) = 1 context int is not compatible with context tuple(scalar, scalar) + +($xxx, $yyy) = (1, 2, 3) context tuple(int, int, int) is not compatible with context tuple(scalar, scalar) + +@l eq '3' context array is not compatible with context string + +qw(a b) > 2 context tuple(string, string) is not compatible with context float + +%h > 0 context hash is not compatible with context float + +%h eq 0 context hash is not compatible with context string + you should use a number operator, not the string operator "eq" (or replace the number with a string) + +@l == () + +$xxx = { xxx() }->{xxx}; + +$xxx = { xxx() }->{$xxx}; diff --git a/src/test/force_layout.t b/src/test/force_layout.t new file mode 100644 index 0000000..bb5494e --- /dev/null +++ b/src/test/force_layout.t @@ -0,0 +1,23 @@ +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 + +'foo'.'bar' you should have a space here + +if ($xxx) { missing ";" + xxx() +} + +if ($xxx) { unneeded ";" + xxx(); +}; diff --git a/src/test/method.t b/src/test/method.t new file mode 100644 index 0000000..e59e858 --- /dev/null +++ b/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/src/test/prototype.t b/src/test/prototype.t new file mode 100644 index 0000000..6e56aae --- /dev/null +++ b/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/src/test/read_t.pm b/src/test/read_t.pm new file mode 100644 index 0000000..a07c041 --- /dev/null +++ b/src/test/read_t.pm @@ -0,0 +1,28 @@ +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) : ($_, ''); + $line =~ s/[ \t]*$//; + push @lines, $line; + push @logs, $log; + } + $line_number++; + } + @tests; +} + +1; + diff --git a/src/test/return_value.t b/src/test/return_value.t new file mode 100644 index 0000000..b4786f5 --- /dev/null +++ b/src/test/return_value.t @@ -0,0 +1,23 @@ +if ($xxx or $yyy) {} value should be dropped + context () is not compatible with context bool + +if ($xxx and $yyy) {} value should be dropped + context () is not compatible with context bool + +$xxx && yyy(); value is dropped + +`xxx`; value is dropped + +/(.*)/; value is dropped + +'xxx'; value is dropped + +'xxx' if $xxx; 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 + +$xxx = push @l, 1 () context not accepted here + context () is not compatible with context scalar diff --git a/src/test/suggest_better.t b/src/test/suggest_better.t new file mode 100644 index 0000000..d76abeb --- /dev/null +++ b/src/test/suggest_better.t @@ -0,0 +1,112 @@ +@{$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 ||= ..." + +$o = xxx() unless $o; "$foo = ... unless $foo" can be written "$foo ||= ..." + +$o or $o = xxx(); "$foo or $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 + +$#l == 0 $#x == 0 is better written @x == 1 + +$#l == -1 $#x == -1 is better written @x == 0 + +$#l < 0 change your expression to use @xxx instead of $#xxx + +$l[@l] = 1 "$a[@a] = ..." is better written "push @a, ..." + +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 !~ /.../ + +!($xxx == 1) !($foo == $bar) is better written $foo != $bar + +!($xxx eq 'foo') !($foo eq $bar) is better written $foo ne $bar + +grep { !member($_, qw(a b c)) } @l you can replace "grep { !member($_, ...) } @l" with "difference2([ @l ], [ ... ])" + +any { $_ eq 'foo' } @l you can replace "any { $_ eq ... } @l" with "member(..., @l)" + +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_(..., ...) } ..." + +foreach (@l) { use "$xxx = find { ... } ..." + if (xxx($_)) { + $xxx = $_; + last; + } +} + +if (grep { xxx() } @l) {} in boolean context, use "any" instead of "grep" + +$xxx = grep { xxx() } @l; you may use "find" 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 + +system(qq(foo "$xxx")) instead of quoting parameters you should give a list of arguments + +system("mkdir", $xxx) you can replace system("mkdir ...") with mkdir(...) diff --git a/src/test/syntax_restrictions.t b/src/test/syntax_restrictions.t new file mode 100644 index 0000000..de7bf77 --- /dev/null +++ b/src/test/syntax_restrictions.t @@ -0,0 +1,70 @@ +$xxx <<= 2 don't use "<<=", use the expanded version instead + +m@xxx@ don't use m@...@, replace @ with / ! , or | + +s:xxx:yyy: don't use s:...:, replace : with / ! , or | + +qw/a b c/ don't use qw/.../, use qw(...) instead + +qw{a b c} don't use qw{...}, use qw(...) instead + +q{xxx} don't use q{...}, use q(...) instead + +qq{xxx} don't use qq{...}, use qq(...) instead + +qx(xxx) don't use qx(...), use `...` instead + +-xxx don't use -xxx, use '-xxx' 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 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" + +local *F; open F, "foo"; use a scalar instead of a bareword (eg: occurrences of F with $F) + +$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 + +$xxx = <<"EOF"; Don't use <<"MARK", use <<MARK instead +foo +EOF diff --git a/src/test/test_it b/src/test/test_it new file mode 100755 index 0000000..a89c2c5 --- /dev/null +++ b/src/test/test_it @@ -0,0 +1,113 @@ +#!/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; +use lib "../.."; +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 { + # no comma for: + # - prefix for/foreach/... + # - already a comma + # - a block { ... } + my $no_comma = $l[-1] =~ /(^\s*(for|foreach|if|unless|while|sub)\s)|(;\s+$)|(^{.*}\s*$)/; + my $opt_comma = $no_comma ? '' : ';'; + $l[-1] =~ s/(\s+$)/$opt_comma 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 @raw_log = `../perl_checker .pl`; + die "@raw_log in .pl ($file):\n" . join('', @{$test->{lines}}) if any { /^syntax error$/ } @raw_log; + + my $f; + my @log = grep { + if (/^File "(.*)", line /) { + $f = $1; + 0; + } else { + $f eq '.pl'; + } + } @raw_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/src/test/various_errors.t b/src/test/various_errors.t new file mode 100644 index 0000000..48a8ece --- /dev/null +++ b/src/test/various_errors.t @@ -0,0 +1,61 @@ +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 + +my $_x = 'xxx' if $xxx; replace "my $foo = ... if <cond>" with "my $foo = <cond> && ..." + +$xxx or my $_x = 'xxx'; replace "<cond> or my $foo = ..." with "my $foo = !<cond> && ..." + +'' || '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 + +if ($xxx && $yyy = xxx()) {} invalid lvalue + +1 + 2 >> 3 missing parentheses (needed for clarity) + +$xxx ? $yyy = 1 : $zzz = 2; missing parentheses (needed for clarity) + invalid lvalue + +N_("xxx") . 'yyy' N_("xxx") . "yyy" is dumb since the string "xxx" will never get translated + +join(@l) first argument of join() must be a scalar + +join(',', 'foo') join('...', $foo) is the same as $foo + +if_($xxx) not enough parameters + +push @l you must give some arguments to push + +push $xxx, 1 push is expecting an array + +pop $xxx pop is expecting an array and nothing else + +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(); |