summaryrefslogtreecommitdiffstats
path: root/src/test
diff options
context:
space:
mode:
authorMageia SVN-Git Migration <svn-git-migration@mageia.org>2007-04-25 15:16:21 +0000
committerMageia SVN-Git Migration <svn-git-migration@mageia.org>2007-04-25 15:16:21 +0000
commitbe4fff49f0164e606d4b2f76f64d4d108895f236 (patch)
treea46bc8c23de0b885f8a2962a9069930b48836fd9 /src/test
parent4746e8e79a5b3cdf3f72400a5a5d6742f6a76a8c (diff)
downloadperl_checker-be4fff49f0164e606d4b2f76f64d4d108895f236.tar
perl_checker-be4fff49f0164e606d4b2f76f64d4d108895f236.tar.gz
perl_checker-be4fff49f0164e606d4b2f76f64d4d108895f236.tar.bz2
perl_checker-be4fff49f0164e606d4b2f76f64d4d108895f236.tar.xz
perl_checker-be4fff49f0164e606d4b2f76f64d4d108895f236.zip
Rename folder to match history.
This is a Synthesized commit to combine perl-MDK-Common and perl_checker repository history.
Diffstat (limited to 'src/test')
-rw-r--r--src/test/.cvsignore2
-rw-r--r--src/test/Makefile3
-rw-r--r--src/test/context.t41
-rw-r--r--src/test/force_layout.t23
-rw-r--r--src/test/method.t11
-rw-r--r--src/test/prototype.t23
-rw-r--r--src/test/read_t.pm28
-rw-r--r--src/test/return_value.t23
-rw-r--r--src/test/suggest_better.t112
-rw-r--r--src/test/syntax_restrictions.t70
-rwxr-xr-xsrc/test/test_it113
-rw-r--r--src/test/various_errors.t61
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();