@ -92,7 +92,6 @@ type file_entry =
| Singleton of DB . source_file
| Duplicate of ( string * DB . source_file ) list
(* Open the source file and search for the package declaration.
Only the case where the package is declared in a single line is supported * )
let read_package_declaration source_file =
@ -146,7 +145,7 @@ let add_source_file path map =
StringMap . add basename entry map
let load_ sources_and_classes () =
let load_ from_verbose_output () =
let file_in = open_in Config . javac_verbose_out in
let class_filename_re =
Str . regexp
@ -188,6 +187,94 @@ let load_sources_and_classes () =
loop [] [] StringMap . empty JBasics . ClassSet . empty
let classname_of_class_filename class_filename =
let parts = Str . split ( Str . regexp " / " ) class_filename in
let classname_str =
if IList . length parts > 1 then
IList . fold_left ( fun s p -> s ^ " . " ^ p ) ( IList . hd parts ) ( IList . tl parts )
else
IList . hd parts in
JBasics . make_cn classname_str
let extract_classnames classnames jar_filename =
let file_in = Zip . open_in jar_filename in
let collect classes entry =
let class_filename = entry . Zip . filename in
try
let () = ignore ( Str . search_forward ( Str . regexp " class " ) class_filename 0 ) in
( classname_of_class_filename ( Filename . chop_extension class_filename ) :: classes )
with Not_found -> classes in
let classnames_after = IList . fold_left collect classnames ( Zip . entries file_in ) in
Zip . close_in file_in ;
classnames_after
let collect_classnames start_classmap jar_filename =
let classpath = Javalib . class_path jar_filename in
let classmap =
IList . fold_left
( fun map cn -> JBasics . ClassSet . add cn map )
start_classmap
( extract_classnames [] jar_filename ) in
Javalib . close_class_path classpath ;
classmap
let search_classes path =
let add_class roots classes class_filename =
let cn , root_dir =
Javalib . extract_class_name_from_file class_filename in
let updated_roots =
if IList . exists ( fun p -> p = root_dir ) roots then roots
else root_dir :: roots in
( updated_roots , JBasics . ClassSet . add cn classes ) in
directory_fold
( fun accu p ->
let paths , classes = accu in
if Filename . check_suffix p " class " then
add_class paths classes p
else if Filename . check_suffix p " jar " then
( p :: paths , collect_classnames classes p )
else accu )
( [] , JBasics . ClassSet . empty )
path
let search_sources () =
let initial_map =
IList . fold_left
( fun map path -> add_source_file path map )
StringMap . empty
Config . sources in
match Config . sourcepath with
| None -> initial_map
| Some sourcepath ->
directory_fold
( fun map p ->
if Filename . check_suffix p " java "
then add_source_file p map
else map )
initial_map
sourcepath
let load_from_arguments classes_out_path =
let roots , classes = search_classes classes_out_path in
let sources = search_sources () in
let split cp_option =
Option . map_default split_classpath [] cp_option in
let paths =
( split Config . bootclasspath ) @ roots @ ( split Config . classpath ) in
let classpath = IList . fold_left append_path " " paths in
( classpath , sources , classes )
let load_sources_and_classes () =
match Config . generated_classes with
| None -> load_from_verbose_output ()
| Some path -> load_from_arguments path
type classmap = JCode . jcode Javalib . interface_or_class JBasics . ClassMap . t
@ -230,29 +317,6 @@ let lookup_node cn program =
| Invalid_argument _ -> None
let classname_of_class_filename class_filename =
let parts = Str . split ( Str . regexp " / " ) class_filename in
let classname_str =
if IList . length parts > 1 then
IList . fold_left ( fun s p -> s ^ " . " ^ p ) ( IList . hd parts ) ( IList . tl parts )
else
IList . hd parts in
JBasics . make_cn classname_str
let extract_classnames classnames jar_filename =
let file_in = Zip . open_in jar_filename in
let collect classes entry =
let class_filename = entry . Zip . filename in
try
let () = ignore ( Str . search_forward ( Str . regexp " class " ) class_filename 0 ) in
( classname_of_class_filename ( Filename . chop_extension class_filename ) :: classes )
with Not_found -> classes in
let classnames_after = IList . fold_left collect classnames ( Zip . entries file_in ) in
Zip . close_in file_in ;
classnames_after
let collect_classes start_classmap jar_filename =
let classpath = Javalib . class_path jar_filename in
let collect classmap cn =