diff options
Diffstat (limited to 'perl_checker.src/test')
| -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 | 41 | ||||
| -rw-r--r-- | perl_checker.src/test/force_layout.t | 23 | ||||
| -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 | 28 | ||||
| -rw-r--r-- | perl_checker.src/test/return_value.t | 23 | ||||
| -rw-r--r-- | perl_checker.src/test/suggest_better.t | 112 | ||||
| -rw-r--r-- | perl_checker.src/test/syntax_restrictions.t | 70 | ||||
| -rwxr-xr-x | perl_checker.src/test/test_it | 113 | ||||
| -rw-r--r-- | perl_checker.src/test/various_errors.t | 61 |
12 files changed, 0 insertions, 510 deletions
diff --git a/perl_checker.src/test/.cvsignore b/perl_checker.src/test/.cvsignore deleted file mode 100644 index 9f6633c..0000000 --- a/perl_checker.src/test/.cvsignore +++ /dev/null @@ -1,2 +0,0 @@ -.pl -.perl_checker.cache diff --git a/perl_checker.src/test/Makefile b/perl_checker.src/test/Makefile deleted file mode 100644 index abe816c..0000000 --- a/perl_checker.src/test/Makefile +++ /dev/null @@ -1,3 +0,0 @@ - -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 deleted file mode 100644 index 081abcc..0000000 --- a/perl_checker.src/test/context.t +++ /dev/null @@ -1,41 +0,0 @@ -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/perl_checker.src/test/force_layout.t b/perl_checker.src/test/force_layout.t deleted file mode 100644 index bb5494e..0000000 --- a/perl_checker.src/test/force_layout.t +++ /dev/null @@ -1,23 +0,0 @@ -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/perl_checker.src/test/method.t b/perl_checker.src/test/method.t deleted file mode 100644 index e59e858..0000000 --- a/perl_checker.src/test/method.t +++ /dev/null @@ -1,11 +0,0 @@ -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 deleted file mode 100644 index 6e56aae..0000000 --- a/perl_checker.src/test/prototype.t +++ /dev/null @@ -1,23 +0,0 @@ - -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 deleted file mode 100644 index a07c041..0000000 --- a/perl_checker.src/test/read_t.pm +++ /dev/null @@ -1,28 +0,0 @@ -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/perl_checker.src/test/return_value.t b/perl_checker.src/test/return_value.t deleted file mode 100644 index b4786f5..0000000 --- a/perl_checker.src/test/return_value.t +++ /dev/null @@ -1,23 +0,0 @@ -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/perl_checker.src/test/suggest_better.t b/perl_checker.src/test/suggest_better.t deleted file mode 100644 index d76abeb..0000000 --- a/perl_checker.src/test/suggest_better.t +++ /dev/null @@ -1,112 +0,0 @@ -@{$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/perl_checker.src/test/syntax_restrictions.t b/perl_checker.src/test/syntax_restrictions.t deleted file mode 100644 index de7bf77..0000000 --- a/perl_checker.src/test/syntax_restrictions.t +++ /dev/null @@ -1,70 +0,0 @@ -$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/perl_checker.src/test/test_it b/perl_checker.src/test/test_it deleted file mode 100755 index a89c2c5..0000000 --- a/perl_checker.src/test/test_it +++ /dev/null @@ -1,113 +0,0 @@ -#!/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/perl_checker.src/test/various_errors.t b/perl_checker.src/test/various_errors.t deleted file mode 100644 index 48a8ece..0000000 --- a/perl_checker.src/test/various_errors.t +++ /dev/null @@ -1,61 +0,0 @@ -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(); |