replace the information "a variable is accessed" with the more precise

  Access_none | Access_write_only | Access_various
so that we can say either "variable unused" or "variable assigned but not read"

4 files changed, 41 insertions, 31 deletions

diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml
index 92a0332..b489f6e 100644
--- a/perl_checker.src/global_checks.ml
+++ b/perl_checker.src/global_checks.ml
@@ -8,15 +8,15 @@ open Tree
 type state = {
     per_files : (string, per_file) Hashtbl.t ;
     per_packages : (string, per_package) Hashtbl.t ;
-    methods : (string, (pos * bool ref * prototype option) list) Hashtbl.t ;
+    methods : (string, (pos * variable_used ref * prototype option) list) Hashtbl.t ;
     global_vars_used : ((context * string * string) * pos) list ref ;
     packages_being_classes : (string, unit) Hashtbl.t ;
   }
 
 type vars = { 
-    my_vars : ((context * string) * (pos * bool ref * prototype option)) list list ;
-    our_vars : ((context * string) * (pos * bool ref * prototype option)) list list ;
-    locally_imported : ((context * string) * (string * bool ref * prototype option)) list ;
+    my_vars : ((context * string) * (pos * variable_used ref * prototype option)) list list ;
+    our_vars : ((context * string) * (pos * variable_used ref * prototype option)) list list ;
+    locally_imported : ((context * string) * (string * variable_used ref * prototype option)) list ;
     required_vars : (context * string * string) list ;
     current_package : per_package ;
     is_toplevel : bool ;
@@ -37,7 +37,7 @@ let rec get_imported state current_package (package_name, (imports, pos)) =
 	    sndter3 (List.assoc var (get_imports state package_used))
 	  with Not_found ->
 	    warn_with_pos pos (sprintf "name %s is not defined in package %s" (variable2s var) package_name) ;
-	    ref true, None
+	    ref Access_various, None
       in
       var, (package_name, b, prototype)
     in
@@ -104,13 +104,17 @@ let check_para_comply_with_prototype para proto =
 
 let is_anonymous_variable_name s = String.length s > 1 && s.[0] = '_'
 
+let variable_used write_only used =
+  if !used != Access_various then
+    used := if write_only then Access_write_only else Access_various
+
 let is_my_declared vars t = 
   List.exists (fun l ->
-    List.mem_assoc t l && (if not vars.write_only then snd3 (List.assoc t l) := true ; true)
+    List.mem_assoc t l && (variable_used vars.write_only (snd3 (List.assoc t l)) ; true)
   ) vars.my_vars
 let is_our_declared vars t = 
   List.exists (fun l ->
-    List.mem_assoc t l && (if not vars.write_only then snd3 (List.assoc t l) := true ; true)
+    List.mem_assoc t l && (variable_used vars.write_only (snd3 (List.assoc t l)) ; true)
   ) vars.our_vars
 
 let is_var_declared_raw write_only state package var para =
@@ -126,7 +130,7 @@ let is_var_declared_raw write_only state package var para =
   with 
   | Some (used, proto) ->
       check_para_comply_with_prototype para proto ;
-      if not write_only then used := true ; 
+      variable_used write_only used ; 
       true
   | None ->
       false
@@ -213,7 +217,7 @@ let declare_My vars (mys, pos) =
   List.iter (fun 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 = (List.map (fun v -> v, (pos, ref false, None)) l_new @ l_pre) :: List.tl vars.my_vars }
+  { vars with my_vars = (List.map (fun v -> v, (pos, ref Access_none, None)) l_new @ l_pre) :: List.tl vars.my_vars }
 
 let declare_Our vars (ours, pos) =
   match vars.our_vars with
@@ -222,7 +226,7 @@ let declare_Our vars (ours, pos) =
       List.iter (fun v ->
 	if List.mem_assoc v l_pre && v <> (I_scalar, "_") then warn_with_pos pos (sprintf "redeclared variable %s" (variable2s v))
       ) ours ;
-      { vars with our_vars = (List.map (fun v -> v, (pos, ref false, None)) ours @ l_pre) :: other }
+      { vars with our_vars = (List.map (fun v -> v, (pos, ref Access_none, None)) ours @ l_pre) :: other }
 
 let declare_My_our vars (my_or_our, l, pos) =
   match my_or_our with
@@ -237,13 +241,15 @@ let un_parenthesize_one_elt_List = function
 
 let check_unused_local_variables vars =
   List.iter (fun ((context, s as v), (pos, used, _proto)) ->
-    if not !used then
+    if !used != Access_various then
       match s with
       | "BEGIN" | "END" | "DESTROY" -> ()
       | "_" when context = I_array ->
 	  warn_with_pos pos "if the function doesn't take any parameters, please use the empty prototype.\nexample \"sub foo() { ... }\""
       | _ ->
-	  if s.[0] != '_' || s = "_" then warn_with_pos pos (sprintf "unused variable %s" (variable2s v))
+	  if s.[0] != '_' || s = "_" then
+	    let msg = if !used = Access_write_only then sprintf "variable %s assigned, but not read" else sprintf "unused variable %s" in
+	    warn_with_pos pos (msg (variable2s v))
   ) (List.hd vars.my_vars)
 
 let check_variables vars t = 
@@ -256,7 +262,7 @@ let check_variables vars t =
 	Some vars
     | Call(Deref(I_func, Ident(None, "sort", _)), (Anonymous_sub(_, Block f, pos) :: l)) ->
 	let vars = List.fold_left check_variables_ vars l in
-	let vars' = { vars with my_vars = [ (I_scalar, "a"), (pos, ref true, None) ; (I_scalar, "b"), (pos, ref true, None) ] :: vars.my_vars ; our_vars = [] :: vars.our_vars } in
+	let vars' = { vars with my_vars = [ (I_scalar, "a"), (pos, ref Access_various, None) ; (I_scalar, "b"), (pos, ref Access_various, None) ] :: 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
@@ -264,7 +270,7 @@ let check_variables vars t =
     | Call(Deref(I_func, Ident(None, func, func_pos)), Anonymous_sub(_, Block f, pos) :: l) 
       when List.mem func [ "grep" ; "map" ; "substInFile" ; "map_index" ; "each_index" ; "partition" ; "find_index" ; "grep_index" ; "find" ; "any" ; "every" ] ->
 	let vars = List.fold_left check_variables_ vars l in
-	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref true, None)] :: vars.our_vars } in
+	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref Access_various, None)] :: vars.our_vars } in
 	let vars' = List.fold_left check_variables_ vars' f in
 	check_unused_local_variables vars' ;
 	check_variable (I_func, Ident(None, func, func_pos)) vars None ;
@@ -299,7 +305,7 @@ let check_variables vars t =
     | Call_op("while infix", [ expr ; (List [ Call_op("<>", _, _) ] as l) ], pos)
     | Call_op("for infix", [ expr ; l ], pos) ->
 	let vars = check_variables_ vars l in
-	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref true, None)] :: vars.our_vars } in
+	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref Access_various, None)] :: vars.our_vars } in
 	let vars' = check_variables_ vars' expr in
 	if List.hd(vars'.my_vars) <> [] then warn_with_pos pos "you can't declare variables in foreach infix";
 	Some vars
@@ -327,11 +333,11 @@ let check_variables vars t =
 		fq = None && List.mem name ["DESTROY"] ||
 		Hashtbl.mem vars.state.packages_being_classes (some_or fq vars.current_package.package_name)
 	      in
-	      [(I_array, "_"), (pos, ref dont_check_use, None)], body
+	      [(I_array, "_"), (pos, ref (if dont_check_use then Access_various else Access_none), None)], body
 	in
 	let local_vars = 
 	  if fq = None && name = "AUTOLOAD" 
-	  then [ (I_scalar, "AUTOLOAD"), (pos, ref true, None) ]
+	  then [ (I_scalar, "AUTOLOAD"), (pos, ref Access_various, None) ]
 	  else [] in
 
 	let vars' = { vars with my_vars = my_vars :: vars.my_vars ; our_vars = local_vars :: vars.our_vars ; is_toplevel = false } in
@@ -340,14 +346,14 @@ let check_variables vars t =
 	Some vars
 
     | Anonymous_sub(_, Block l, pos) ->
-	let vars' = { vars with my_vars = [(I_array, "_"), (pos, ref true, None)] :: vars.my_vars ; is_toplevel = false } in
+	let vars' = { vars with my_vars = [(I_array, "_"), (pos, ref Access_various, None)] :: vars.my_vars ; is_toplevel = false } in
 	let vars' = List.fold_left check_variables_ vars' l in
 	check_unused_local_variables vars' ;
 	Some vars
 
     | Call_op("foreach", [ expr ; Block l ], pos) ->
 	let vars = check_variables_ vars expr in
-	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref true, None)] :: vars.our_vars } in
+	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref Access_various, None)] :: vars.our_vars } in
 	let vars' = List.fold_left check_variables_ vars' l in
 	check_unused_local_variables vars' ;
 	Some vars
@@ -442,7 +448,7 @@ let check_variables vars t =
 		l_and
 	    | l -> l
 	  in
-	  List.iter (fun (used, _) -> used := true) l_and
+	  List.iter (fun (used, _) -> used := Access_various) l_and
 	with Not_found -> 
 	  if not (List.mem method_ [ "isa"; "can" ]) then
 	    warn_with_pos pos ("unknown method " ^ method_)) ;
@@ -493,7 +499,7 @@ let add_file_to_files per_files file =
 
 let check_unused_vars package =
   Hashtbl.iter (fun (context, name) (pos, is_used, _proto) ->
-    if not (!is_used || List.mem name ["BEGIN"; "END"; "DESTROY"; "ISA"; "AUTOLOAD"; "EXPORT"; "EXPORT_OK"; "EXPORT_TAGS"]) then
+    if not (!is_used != Access_various || List.mem name ["BEGIN"; "END"; "DESTROY"; "ISA"; "AUTOLOAD"; "EXPORT"; "EXPORT_OK"; "EXPORT_TAGS"]) then
       warn_with_pos pos (sprintf "unused %s%s::%s" (if context = I_func then "function " else "variable " ^ context2s context) package.package_name name)
   ) package.vars_declared
 
@@ -520,7 +526,7 @@ let arrange_global_vars_declared global_vars_declared state =
 	package
     in
     if not (Hashtbl.mem package.vars_declared (context, name)) then
-      Hashtbl.add package.vars_declared (context, name) (pos, ref false, proto)
+      Hashtbl.add package.vars_declared (context, name) (pos, ref Access_none, proto)
 	(* otherwise dropping this second declaration *)
   ) global_vars_declared ;
   state
diff --git a/perl_checker.src/global_checks.mli b/perl_checker.src/global_checks.mli
index 2fe13a1..2e60613 100644
--- a/perl_checker.src/global_checks.mli
+++ b/perl_checker.src/global_checks.mli
@@ -4,7 +4,7 @@ open Tree
 type state = {
     per_files : (string, per_file) Hashtbl.t ;
     per_packages : (string, per_package) Hashtbl.t ;
-    methods : (string, (pos * bool ref * prototype option) list) Hashtbl.t ;
+    methods : (string, (pos * variable_used ref * prototype option) list) Hashtbl.t ;
     global_vars_used : ((context * string * string) * pos) list ref ;
     packages_being_classes : (string, unit) Hashtbl.t ;
   }
diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml
index 23f1467..f452971 100644
--- a/perl_checker.src/tree.ml
+++ b/perl_checker.src/tree.ml
@@ -20,10 +20,12 @@ type prototype = {
     proto_nb_max : int option ;
   }
 
+type variable_used = Access_none | Access_write_only | Access_various
+
 type per_package = {
     package_name : string ; has_package_name : bool ;
-    vars_declared : (context * string, pos * bool ref * prototype option) Hashtbl.t;
-    imported : ((context * string) * (string * bool ref * prototype option)) list option ref;
+    vars_declared : (context * string, pos * variable_used ref * prototype option) Hashtbl.t;
+    imported : ((context * string) * (string * variable_used ref * prototype option)) list option ref;
     exports : exports ;
     uses : uses ;
     required_packages : (string * pos) list ;
@@ -218,7 +220,7 @@ let read_xs_extension_from_c global_vars_declared file_name package pos =
 	  let end_ = String.index_from s offset '"' in
 	  let ident = String.sub s offset (end_ - offset) in
 	  match split_name_or_fq_name ident with
-	  | None, ident -> Hashtbl.replace package.vars_declared (I_func, ident) (pos, ref false, None)
+	  | None, ident -> Hashtbl.replace package.vars_declared (I_func, ident) (pos, ref Access_none, None)
 	  | Some fq, ident -> 
 	      let fq = package.package_name ^ "::" ^ fq in
 	      Hashtbl.replace global_vars_declared (I_func, fq, ident) (pos, None)
@@ -292,7 +294,7 @@ let get_proto perl_proto body =
 let get_vars_declaration global_vars_declared file_name package = 
   List.iter (function
     | Sub_declaration(Ident(None, name, pos), perl_proto, body, _) ->
-	Hashtbl.replace package.vars_declared (I_func, name) (pos, ref false, get_proto perl_proto body)
+	Hashtbl.replace package.vars_declared (I_func, name) (pos, ref Access_none, get_proto perl_proto body)
     | Sub_declaration(Ident(Some fq, name, pos), perl_proto, body, _) ->
 	Hashtbl.replace global_vars_declared (I_func, fq, name) (pos, get_proto perl_proto body)
 
@@ -300,11 +302,11 @@ let get_vars_declaration global_vars_declared file_name package =
     | List [ Call_op("=", [My_our("local", ([ I_scalar, "_" ] as ours), pos); _], _) ]
     | List [ My_our("our", ours, pos) ]
     | My_our("our", ours, pos) ->
-	List.iter (fun (context, name) -> Hashtbl.replace package.vars_declared (context, name) (pos, ref false, None)) ours
+	List.iter (fun (context, name) -> Hashtbl.replace package.vars_declared (context, name) (pos, ref Access_none, None)) ours
 
     | Use(Ident(Some "MDK::Common", "Globals", pos), [ String _ ; ours ])
     | Use(Ident(None, "vars", pos), [ours]) -> 
-	List.iter (fun (context, name) -> Hashtbl.replace package.vars_declared (context, name) (pos, ref false, None)) (from_qw ours)
+	List.iter (fun (context, name) -> Hashtbl.replace package.vars_declared (context, name) (pos, ref Access_none, None)) (from_qw ours)
     | Use(Ident(None, "vars", pos), _) -> 
 	die_with_pos pos "usage: use vars qw($var func)"
 
diff --git a/perl_checker.src/tree.mli b/perl_checker.src/tree.mli
index b8615f5..60edc37 100644
--- a/perl_checker.src/tree.mli
+++ b/perl_checker.src/tree.mli
@@ -17,10 +17,12 @@ type prototype = {
     proto_nb_max : int option ;
   }
 
+type variable_used = Access_none | Access_write_only | Access_various
+
 type per_package = {
     package_name : string ; has_package_name : bool ;
-    vars_declared : (context * string, pos * bool ref * prototype option) Hashtbl.t;
-    imported : ((context * string) * (string * bool ref * prototype option)) list option ref;
+    vars_declared : (context * string, pos * variable_used ref * prototype option) Hashtbl.t;
+    imported : ((context * string) * (string * variable_used ref * prototype option)) list option ref;
     exports : exports ;
     uses : uses ;
     required_packages : (string * pos) list ;