summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2005-11-25 13:09:03 +0000
committerPascal Rigaux <pixel@mandriva.com>2005-11-25 13:09:03 +0000
commitdcfc8c7302059b30fc97aee62a5d29a3d690d7f5 (patch)
tree33431f9530adb5dc25a632766dccc7f830a77d51
parent4725c4acb3512a8c41a54ac1855106f37e7b3c11 (diff)
downloadperl-MDK-Common-dcfc8c7302059b30fc97aee62a5d29a3d690d7f5.tar
perl-MDK-Common-dcfc8c7302059b30fc97aee62a5d29a3d690d7f5.tar.gz
perl-MDK-Common-dcfc8c7302059b30fc97aee62a5d29a3d690d7f5.tar.bz2
perl-MDK-Common-dcfc8c7302059b30fc97aee62a5d29a3d690d7f5.tar.xz
perl-MDK-Common-dcfc8c7302059b30fc97aee62a5d29a3d690d7f5.zip
generate graph dependencies (with "maybe" dependencies from methods)
-rw-r--r--perl_checker.src/global_checks.ml30
-rw-r--r--perl_checker.src/global_checks.mli3
-rw-r--r--perl_checker.src/perl_checker.ml2
3 files changed, 25 insertions, 10 deletions
diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml
index be9ff51..a63e652 100644
--- a/perl_checker.src/global_checks.ml
+++ b/perl_checker.src/global_checks.ml
@@ -12,6 +12,7 @@ type state = {
global_vars_used : ((context * string * string) * pos) list ref ;
packages_being_classes : (string, unit) Hashtbl.t ;
packages_dependencies : (string * string, unit) Hashtbl.t ;
+ packages_dependencies_maybe : (string * string * string, unit) Hashtbl.t ;
}
type vars = {
@@ -111,6 +112,11 @@ let add_to_packages_really_used state current_package used_name =
(*List.iter (fun (p1, p2) -> prerr_endline (Printf.sprintf "%s -> %s" p1 p2)) (hashtbl_keys state.packages_dependencies);*)
()
+let add_to_packages_maybe_used state current_package used_name method_name =
+ Hashtbl.replace state.packages_dependencies_maybe (current_package.package_name, used_name, method_name) () ;
+ (*List.iter (fun (p1, p2) -> prerr_endline (Printf.sprintf "%s -> %s" p1 p2)) (hashtbl_keys state.packages_dependencies_maybe);*)
+ ()
+
let variable_used write_only used =
if !used != Access_various then
used := if write_only then Access_write_only else Access_various
@@ -447,7 +453,7 @@ let check_variables vars t =
(try
let l = Hashtbl.find vars.state.methods method_ in
let l_and = List.map (fun (pkg_name, used, proto) -> pkg_name, used, do_para_comply_with_prototype [ List (o :: un_parenthesize_one_elt_List para) ] proto) l in
- let l_and =
+ let l_and' =
match List.filter (fun (_, _, n) -> n = 0) l_and with
| [] ->
(match uniq (List.map ter3 l_and) with
@@ -457,8 +463,8 @@ let check_variables vars t =
l_and
| l -> l
in
- List.iter (fun (pkg_name, _, _) -> add_to_packages_really_used vars.state vars.current_package pkg_name) l_and ;
- List.iter (fun (_, used, _) -> used := Access_various) l_and
+ List.iter (fun (pkg_name, _, _) -> add_to_packages_maybe_used vars.state vars.current_package pkg_name method_) 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 [Warn_names] pos ("unknown method " ^ method_)) ;
@@ -573,7 +579,8 @@ let default_state per_files = {
methods = Hashtbl.create 256;
global_vars_used = ref [];
packages_being_classes = Hashtbl.create 16;
- packages_dependencies = Hashtbl.create 16
+ packages_dependencies = Hashtbl.create 16;
+ packages_dependencies_maybe = Hashtbl.create 16
}
let cache_cache = Hashtbl.create 16
@@ -617,9 +624,16 @@ let write_packages_cache per_files dir =
if !Flags.verbose then print_endline_flush (sprintf "saving cached files\n%sin %s" (pkgs2s " " l) file)
with Sys_error _ -> ()
-let generate_package_dependencies_graph packages_dependencies file =
+let generate_package_dependencies_graph state file =
let fh = open_out file in
- output_string fh "digraph pgks {\n" ;
- Hashtbl.iter (fun (p1, p2) _ -> output_string fh ("\"" ^ p1 ^ "\" -> \"" ^ p2 ^ "\"\n")) packages_dependencies ;
- output_string fh "}\n" ;
+
+ List.iter (fun (p1, p2) ->
+ output_string fh (p1 ^ " -> " ^ p2 ^ "\n")
+ ) (List.sort compare (hashtbl_keys state.packages_dependencies)) ;
+
+ let l = Hashtbl.fold (fun (p1, p2, method_) _ l -> ((p1, method_), p2) :: l) state.packages_dependencies_maybe [] in
+ List.iter (fun ((p1, method_), l) ->
+ output_string fh (p1 ^ " ?-> " ^ String.concat " " l ^ " (" ^ method_ ^ ")\n")
+ ) (List.sort compare (prepare_want_all_assoc l));
+
close_out fh
diff --git a/perl_checker.src/global_checks.mli b/perl_checker.src/global_checks.mli
index ae36b2b..9edacbf 100644
--- a/perl_checker.src/global_checks.mli
+++ b/perl_checker.src/global_checks.mli
@@ -8,6 +8,7 @@ type state = {
global_vars_used : ((context * string * string) * pos) list ref ;
packages_being_classes : (string, unit) Hashtbl.t ;
packages_dependencies : (string * string, unit) Hashtbl.t ;
+ packages_dependencies_maybe : (string * string * string, unit) Hashtbl.t ;
}
val default_per_files : unit -> (string, per_file) Hashtbl.t
@@ -22,4 +23,4 @@ val get_methods_available : state -> state
val read_packages_from_cache : (string, per_file) Hashtbl.t -> string -> unit
val write_packages_cache : (string, per_file) Hashtbl.t -> string -> unit
-val generate_package_dependencies_graph : (string * string, unit) Hashtbl.t -> string -> unit
+val generate_package_dependencies_graph : state -> string -> unit
diff --git a/perl_checker.src/perl_checker.ml b/perl_checker.src/perl_checker.ml
index aa8c1f8..4459e30 100644
--- a/perl_checker.src/perl_checker.ml
+++ b/perl_checker.src/perl_checker.ml
@@ -178,6 +178,6 @@ let parse_options =
if !Flags.check_unused_global_vars then List.iter Global_checks.check_unused_vars l;
- if !package_dependencies_graph_file <> "" then generate_package_dependencies_graph state.packages_dependencies !package_dependencies_graph_file
+ if !package_dependencies_graph_file <> "" then generate_package_dependencies_graph state !package_dependencies_graph_file
)