From 81cfc29b31fc0964a62c137e5fd0345674a84182 Mon Sep 17 00:00:00 2001
From: Nicolas Pouillard <np@nicolaspouillard.fr>
Date: Fri, 23 Feb 2007 13:44:51 +0000
Subject: [PATCH] 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   |  6 +++---
 bytecomp/bytepackager.ml |  4 ++--
 typing/typemod.ml        |  2 +-
 utils/misc.ml            | 11 +++++++++++
 utils/misc.mli           |  7 +++++++
 5 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml
index 29a9c0176..d1fb441ee 100644
--- a/asmcomp/asmpackager.ml
+++ b/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;
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
index 4b1d9620e..bb3a80aa6 100644
--- a/bytecomp/bytepackager.ml
+++ b/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
diff --git a/typing/typemod.ml b/typing/typemod.ml
index a27657639..91b8c80ba 100644
--- a/typing/typemod.ml
+++ b/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" &&
diff --git a/utils/misc.ml b/utils/misc.ml
index 3c66443f5..68ca8e3da 100644
--- a/utils/misc.ml
+++ b/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
diff --git a/utils/misc.mli b/utils/misc.mli
index faaa109a8..9ce5e846d 100644
--- a/utils/misc.mli
+++ b/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