add "unused variable" detection

4 files changed, 55 insertions, 30 deletions

diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml
index 07e138e..19aaa5f 100644
--- a/perl_checker.src/common.ml
+++ b/perl_checker.src/common.ml
@@ -390,9 +390,6 @@ let map_assoc_val f l = map (fun (k,v) -> k, f v) l
 let assoc_or_fail e l =
   try assoc e l with Not_found -> failwith "assoc failed"
 
-let assoc_has_key e l =
-  try let _ = assoc e l in true with Not_found -> false  
-
 let assoc_by is_same e l = 
   find_some (fun (a,b) -> if is_same e a then Some b else None) l
 
diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli
index ee2bb01..89e6d19 100644
--- a/perl_checker.src/common.mli
+++ b/perl_checker.src/common.mli
@@ -111,7 +111,6 @@ val split_last : 'a list -> 'a list * 'a
 val iter_assoc_val : ('a -> unit) -> ('b * 'a) list -> unit
 val map_assoc_val : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
 val assoc_or_fail : 'a -> ('a * 'b) list -> 'b
-val assoc_has_key : 'a -> ('a * 'b) list -> bool
 val assoc_by : ('a -> 'b -> bool) -> 'a -> ('b * 'c) list -> 'c
 val update_assoc_by :
   ('a -> 'b -> bool) -> ('c -> 'c) -> 'a -> ('b * 'c) list -> ('b * 'c) list
diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly
index 364ab5a..12e6f93 100644
--- a/perl_checker.src/parser.mly
+++ b/perl_checker.src/parser.mly
@@ -224,8 +224,8 @@ term:
 | term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); check_unneeded_var_dollar_s  ($1); to_Call_op_(P_expr, "s///", sndfst $1 :: from_PATTERN_SUBST $3) (sp_pos_range $1 $3)}
 | term PATTERN_MATCH_NOT PATTERN_SUBST {die_with_rawpos (sndsnd $2) "use =~ instead of !~ and negate the return value"}
 
-| term PATTERN_MATCH     scalar { (P_expr, Too_complex), sp_pos_range $1 $3}
-| term PATTERN_MATCH_NOT scalar { (P_expr, Too_complex), sp_pos_range $1 $3}
+| term PATTERN_MATCH     scalar { (P_expr, Call(Too_complex, [sndfst $1 ; fst $3 ])), sp_pos_range $1 $3}
+| term PATTERN_MATCH_NOT scalar { (P_expr, Call(Too_complex, [sndfst $1 ; fst $3 ])), sp_pos_range $1 $3}
 
 | term PATTERN_MATCH     RAW_STRING {die_with_rawpos (sndsnd $3) "use a regexp, not a string"}
 | term PATTERN_MATCH_NOT RAW_STRING {die_with_rawpos (sndsnd $3) "use a regexp, not a string"}
@@ -311,7 +311,7 @@ term:
 | PRINT_TO_STAR           { to_Call_op_(P_call_no_paren, fstfst $1, Deref(I_star, Ident(None, sndfst $1, get_pos $1)) :: [ var_dollar_ ]) (snd $1)}
 | PRINT_TO_STAR argexpr   { to_Call_op_(P_call_no_paren, fstfst $1, Deref(I_star, Ident(None, sndfst $1, get_pos $1)) :: sndfst $2) (sp_pos_range $1 $2)}
 
-| hash PKG_SCOPE {sp_0($2); (P_tok, Too_complex), sp_pos_range $1 $2} /* %main:: */
+| hash PKG_SCOPE {sp_0($2); (P_tok, Call(Too_complex, [fst $1])), sp_pos_range $1 $2} /* %main:: */
 
 | terminal {$1}
 
@@ -323,7 +323,7 @@ terminal:
 | REVISION {(P_tok, to_Raw_string $1), snd $1}
 | COMMAND_STRING {to_Call_op_(P_expr, "``", [to_String false $1]) (snd $1)}
 | QUOTEWORDS {to_Call_op_(P_tok, "qw", [to_Raw_string $1]) (snd $1)}
-| HERE_DOC {(P_tok, String([], raw_pos2pos (sndfst $1))), snd $1}
+| HERE_DOC {(P_tok, to_String false (fstfst $1, snd $1)), snd $1}
 | RAW_HERE_DOC {(P_tok, Raw_string(fstfst $1, raw_pos2pos (sndfst $1))), snd $1}
 | PATTERN {to_Call_op_(P_expr, "m//", var_dollar_ :: from_PATTERN $1) (snd $1)}
 | PATTERN_SUBST {to_Call_op_(P_expr, "s///", var_dollar_ :: from_PATTERN_SUBST $1) (snd $1)}
@@ -334,7 +334,7 @@ diamond:
 | LT term GT {sp_0($2); sp_0($3); to_Call_op("<>", [sndfst $2]) (sp_pos_range $1 $3)}
 
 subscripted: /* Some kind of subscripted expression */
-| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); Too_complex, sp_pos_range $1 $3} /* $foo::{something} */
+| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); Call(Too_complex, [fst $3]), sp_pos_range $1 $3} /* $foo::{something} */
 | scalar bracket_subscript             {sp_0($2); to_Deref_with(I_hash , I_scalar, from_scalar $1, fst      $2), sp_pos_range $1 $2} /* $foo{bar} */
 | scalar arrayref                      {sp_0($2); to_Deref_with(I_array, I_scalar, from_scalar $1, only_one $2), sp_pos_range $1 $2} /* $array[$element] */
 | term ARROW bracket_subscript         {sp_0($2); sp_0($3); check_arrow_needed $1 $2; to_Deref_with(I_hash , I_scalar, sndfst $1, fst      $3), sp_pos_range $1 $3} /* somehref->{bar} */
@@ -345,7 +345,7 @@ subscripted: /* Some kind of subscripted expression */
 | subscripted parenthesized            {sp_0($2); to_Deref_with(I_func , I_scalar, fst $1, List(sndfst $2)), sp_pos_range $1 $2} /* $foo->{bar}(@args) */
 
 restricted_subscripted: /* Some kind of subscripted expression */
-| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); Too_complex, sp_pos_range $1 $3} /* $foo::{something} */
+| variable PKG_SCOPE bracket_subscript {sp_0($2); sp_0($3); Call(Too_complex, [fst $3]), sp_pos_range $1 $3} /* $foo::{something} */
 | scalar bracket_subscript             {sp_0($2); to_Deref_with(I_hash , I_scalar, from_scalar $1, fst      $2), sp_pos_range $1 $2} /* $foo{bar} */
 | scalar arrayref                      {sp_0($2); to_Deref_with(I_array, I_scalar, from_scalar $1, only_one $2), sp_pos_range $1 $2} /* $array[$element] */
 | restricted_subscripted bracket_subscript        {sp_0($2); to_Deref_with(I_hash , I_scalar, fst $1, fst      $2), sp_pos_range $1 $2} /* $foo->[bar]{baz} */
diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml
index 3145215..ee1a4ce 100644
--- a/perl_checker.src/tree.ml
+++ b/perl_checker.src/tree.ml
@@ -31,8 +31,8 @@ type state = {
   }
 
 type vars = { 
-    my_vars : (context * string) list list ;
-    our_vars : (context * string) list list ;
+    my_vars : ((context * string) * (pos * bool ref)) list list ;
+    our_vars : ((context * string) * (pos * bool ref)) list list ;
     locally_imported : ((context * string) * string) list ;
     required_vars : (context * string * string) list ;
     current_package : per_package ;
@@ -251,23 +251,26 @@ let rec fold_tree f env e =
   | Anonymous_sub(e')
   | Ref(_, e')
   | Deref(_, e')
-      -> fold_tree f env e'
+    -> fold_tree f env e'
 
   | Diamond(e')
-       -> fold_tree_option f env e'
+    -> fold_tree_option f env e'
+
+  | String(l, _)
+    -> List.fold_left (fun env (_, e) -> fold_tree f env e) env l
 
   | Sub_declaration(e1, _, e2)
   | Deref_with(_, _, e1, e2)
-       -> 
-	 let env = fold_tree f env e1 in
-	 let env = fold_tree f env e2 in
-	 env
+    -> 
+      let env = fold_tree f env e1 in
+      let env = fold_tree f env e2 in
+      env
 
   | Use(_, l)
   | List l
   | Block l
   | Call_op(_, l, _)
-      -> List.fold_left (fold_tree f) env l
+    -> List.fold_left (fold_tree f) env l
 
   | Call(e', l)
     -> 
@@ -306,6 +309,10 @@ let get_global_info_from_package t =
 	| Call(Deref(I_func, Ident (None, "require", pos)), [Ident _ as pkg]) ->
 	    let package = string_of_Ident pkg in
 	    if uses_external_package package then None else Some((package, pos) :: l)
+	| Call(Deref(I_func, Ident (None, "require", pos)), [Raw_string(pkg, _)])
+	    when not (String.contains pkg '/') && Filename.check_suffix pkg ".pm" ->
+	    let package = Filename.chop_suffix pkg ".pm" in
+	    if uses_external_package package then None else Some((package, pos) :: l)
 	| _ -> None)
       ) required_packages t in
     { 
@@ -320,8 +327,14 @@ let get_global_info_from_package t =
     }, required_packages
   ) [] current_packages
 
-let is_my_declared vars t = List.exists (List.exists ((=) t)) vars.my_vars
-let is_our_declared vars t = List.exists (List.exists ((=) t)) vars.our_vars
+let is_my_declared vars t = 
+  List.exists (fun l ->
+    List.mem_assoc t l && (snd (List.assoc t l) := true ; true)
+  ) vars.my_vars
+let is_our_declared vars t = 
+  List.exists (fun l ->
+    List.mem_assoc t l && (snd (List.assoc t l) := true ; true)
+  ) vars.our_vars
 let is_var_declared vars (context, name) = 
   List.mem_assoc (context, name) vars.locally_imported ||
   List.mem_assoc (context, name) (get_imports vars.state vars.current_package) ||
@@ -403,18 +416,18 @@ let declare_My vars (mys, pos) =
   ) mys in
   let l_pre = List.hd vars.my_vars in
   List.iter (fun v ->
-    if List.exists ((=) v) l_pre then warn_with_pos pos (sprintf "redeclared variable %s" (variable2s v))
+    if List.mem_assoc v l_pre then warn_with_pos pos (sprintf "redeclared variable %s" (variable2s v))
   ) l_new ;
-  { vars with my_vars = (l_new @ l_pre) :: List.tl vars.my_vars }
+  { vars with my_vars = (List.map (fun v -> v, (pos, ref false)) l_new @ l_pre) :: List.tl vars.my_vars }
 
 let declare_Our vars (ours, pos) =
   match vars.our_vars with
   | [] -> vars (* we're at the toplevel, already declared in vars_declared *)
   | l_pre :: other ->
       List.iter (fun v ->
-	if List.exists ((=) v) l_pre then warn_with_pos pos (sprintf "redeclared variable %s" (variable2s v))
+	if List.mem_assoc v l_pre then warn_with_pos pos (sprintf "redeclared variable %s" (variable2s v))
       ) ours ;
-      { vars with our_vars = (ours @ l_pre) :: other }
+      { vars with our_vars = (List.map (fun v -> v, (pos, ref false)) ours @ l_pre) :: other }
 
 let declare_My_our vars (my_or_our, l, pos) =
   match my_or_our with
@@ -423,18 +436,26 @@ let declare_My_our vars (my_or_our, l, pos) =
   | "our" -> declare_Our vars (l, pos)
   | _ -> internal_error "declare_My_our"
 
+let check_unused_local_variables vars =
+  List.iter (fun ((_, s as v), (pos, used)) ->
+    if not !used && s.[0] != '_' then warn_with_pos pos (sprintf "unused variable %s" (variable2s v))
+  ) (List.hd vars.my_vars)
+  
+
 
 let check_variables vars t = 
   let rec check_variables_ vars t = fold_tree check vars t
   and check vars = function
     | Block l ->
 	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in
-	let _vars' = List.fold_left check_variables_ vars' l in
+	let vars' = List.fold_left check_variables_ vars' l in
+	check_unused_local_variables vars' ;
 	Some vars
-    | Call(Deref(I_func, Ident(None, "sort", _)), (Anonymous_sub(Block f) :: l)) ->
+    | Call(Deref(I_func, Ident(None, "sort", pos)), (Anonymous_sub(Block f) :: l)) ->
 	let vars = List.fold_left check_variables_ vars l in
-	let vars' = { vars with my_vars = [ I_scalar, "a" ; I_scalar, "b" ] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in
-	let _vars' = List.fold_left check_variables_ vars' f in
+	let vars' = { vars with my_vars = [ (I_scalar, "a"), (pos, ref true) ; (I_scalar, "b"), (pos, ref true) ] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in
+	let vars' = List.fold_left check_variables_ vars' f in
+	check_unused_local_variables vars' ;
 	Some vars
 
     | Call_op("foreach my", [my; expr; Block block], _) ->
@@ -444,10 +465,18 @@ let check_variables vars t =
     | Call_op(op, cond :: Block first_bl :: other, _) when op = "if" || op = "while" || op = "unless" || op = "until" ->
 	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in
 	let vars' = check_variables_ vars' cond in
-	let _vars' = List.fold_left check_variables_ vars' first_bl in
+	let vars' = List.fold_left check_variables_ vars' first_bl in
+	check_unused_local_variables vars' ;
 	let vars = List.fold_left check_variables_ vars other in
 	Some vars
 
+    | Sub_declaration(Ident(None, "AUTOLOAD", pos) as ident, _proto, Block l) ->
+	let vars = declare_Our vars ([ I_func, string_of_Ident ident ], pos) in
+	let vars' = { vars with my_vars = [ (I_scalar, "AUTOLOAD"), (pos, ref true) ] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in
+	let vars' = List.fold_left check_variables_ vars' l in
+	check_unused_local_variables vars' ;
+	Some vars
+
     | Sub_declaration(Ident(_, _, pos) as ident, _proto, body) ->
 	let vars = declare_Our vars ([ I_func, string_of_Ident ident ], pos) in
 	let vars = check_variables_ vars body in