Better handling of multiple extensions (foo.d.cmo, foo.p.cmx...)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7909 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

asmcomp/asmpackager.ml

@@ -43,7 +43,7 @@ type pack_member =
 
 let read_member_info pack_path file =
   let name =
-    String.capitalize(Filename.basename(chop_extension_if_any file)) in
+    String.capitalize(Filename.basename(chop_extensions file)) in
   let kind =
     if Filename.check_suffix file ".cmx" then begin
       let (info, crc) = Compilenv.read_unit_info file in
@@ -169,9 +169,9 @@ let package_files ppf files targetcmx =
         try find_in_path !Config.load_path f
         with Not_found -> raise(Error(File_not_found f)))
       files in
-  let prefix = chop_extension_if_any targetcmx in
+  let prefix = chop_extensions targetcmx in
   let targetcmi = prefix ^ ".cmi" in
-  let targetobj = prefix ^ Config.ext_obj in
+  let targetobj = chop_extension_if_any targetcmx ^ Config.ext_obj in
   let targetname = String.capitalize(Filename.basename prefix) in
   (* Set the name of the current "input" *)
   Location.input_name := targetcmx;

bytecomp/bytepackager.ml

@@ -81,7 +81,7 @@ type pack_member =
 
 let read_member_info file =
   let name =
-    String.capitalize(Filename.basename(chop_extension_if_any file)) in
+    String.capitalize(Filename.basename(chop_extensions file)) in
   let kind =
     if Filename.check_suffix file ".cmo" then begin
     let ic = open_in_bin file in
@@ -224,7 +224,7 @@ let package_files files targetfile =
         try find_in_path !Config.load_path f
         with Not_found -> raise(Error(File_not_found f)))
       files in
-  let prefix = chop_extension_if_any targetfile in
+  let prefix = chop_extensions targetfile in
   let targetcmi = prefix ^ ".cmi" in
   let targetname = String.capitalize(Filename.basename prefix) in
   try

typing/typemod.ml

@@ -831,7 +831,7 @@ let package_units objfiles cmifile modulename =
   let units =
     List.map
       (fun f ->
-         let pref = chop_extension_if_any f in
+         let pref = chop_extensions f in
          let modname = String.capitalize(Filename.basename pref) in
          let sg = Env.read_signature modname (pref ^ ".cmi") in
          if Filename.check_suffix f ".cmi" &&

utils/misc.ml

@@ -162,6 +162,17 @@ let no_overflow_lsl a = min_int asr 1 <= a && a <= max_int asr 1
 let chop_extension_if_any fname =
   try Filename.chop_extension fname with Invalid_argument _ -> fname
 
+let chop_extensions file =
+  let dirname = Filename.dirname file and basename = Filename.basename file in
+  try
+    let pos = String.index basename '.' in
+    let basename = String.sub basename 0 pos in
+    if Filename.is_implicit file && dirname = Filename.current_dir_name then
+      basename
+    else
+      Filename.concat dirname basename
+  with Not_found -> file
+
 let search_substring pat str start =
   let rec search i j =
     if j >= String.length pat then i

utils/misc.mli

@@ -86,6 +86,13 @@ val chop_extension_if_any: string -> string
         (* Like Filename.chop_extension but returns the initial file
            name if it has no extension *)
 
+val chop_extensions: string -> string
+        (* Return the given file name without its extensions. The extensions
+           is the longest suffix starting with a period and not including
+           a directory separator, [.xyz.uvw] for instance.
+
+           Return the given name if it does not contain an extension. *)
+
 val search_substring: string -> string -> int -> int
         (* [search_substring pat str start] returns the position of the first
            occurrence of string [pat] in string [str].  Search starts