Rename folder to match history.

This is a Synthesized commit to combine perl-MDK-Common and perl_checker repository
history.

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();