Portage Cygwin

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

4 files changed, 188 insertions, 167 deletions

diff --git a/stdlib/Makefile b/stdlib/Makefile
index 83a41085b..6c4cdd084 100644
--- a/stdlib/Makefile
+++ b/stdlib/Makefile
@@ -72,8 +72,9 @@ camlheader camlheader_ur: header.c ../config/Makefile
           echo '#!$(BINDIR)/ocamlrun' > camlheader && \
           echo '#!' | tr -d '\012' > camlheader_ur; \
         else \
-	  $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) -DRUNTIME_NAME='"$(BINDIR)/ocamlrun"' header.c -o camlheader && \
-          strip camlheader && \
+	  $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) -DRUNTIME_NAME='"$(BINDIR)/ocamlrun"' header.c -o tmpheader$(EXE) && \
+          strip tmpheader$(EXE) && \
+	  mv tmpheader$(EXE) camlheader && \
           cp camlheader camlheader_ur; \
         fi
 
diff --git a/stdlib/filename.ml b/stdlib/filename.ml
index e80389c2e..1547d4ace 100644
--- a/stdlib/filename.ml
+++ b/stdlib/filename.ml
@@ -12,181 +12,145 @@
 
 (* $Id$ *)
 
-let (current_dir_name, parent_dir_name) =
-  match Sys.os_type with
-  | "Unix" -> (".", "..")
-  | "Win32" -> (".", "..")
-  | "MacOS" -> (":", "::")
-  | _ -> assert false
-;;
-
-let unix_concat dirname filename =
-  let l = String.length dirname in
-  if l = 0 or dirname.[l-1] = '/'
-  then dirname ^ filename
-  else dirname ^ "/" ^ filename
-
-let wnt_concat dirname filename =
-  let l = String.length dirname in
-  if l = 0 or (let c = dirname.[l-1] in c = '/' or c = '\\' or c = ':')
-  then dirname ^ filename
-  else dirname ^ "\\" ^ filename
-
-let mac_concat dirname filename =
-  let l = String.length dirname in
-  if l = 0 or dirname.[l-1] = ':'
-  then dirname ^ filename
-  else dirname ^ ":" ^ filename
-
-let concat =
-  match Sys.os_type with
-  | "Unix" -> unix_concat
-  | "Win32" -> wnt_concat
-  | "MacOS" -> mac_concat
-  | _ -> assert false
-
-let unix_is_relative n = String.length n < 1 || n.[0] <> '/';;
-
-let unix_is_implicit n =
-  unix_is_relative n
-  && (String.length n < 2 || String.sub n 0 2 <> "./")
-  && (String.length n < 3 || String.sub n 0 3 <> "../")
-;;
-
-let wnt_is_relative n =
-  (String.length n < 1 || n.[0] <> '/')
-  && (String.length n < 1 || n.[0] <> '\\')
-  && (String.length n < 2 || n.[1] <> ':')
-;;
-
-let wnt_is_implicit n =
-  wnt_is_relative n
-  && (String.length n < 2 || String.sub n 0 2 <> "./")
-  && (String.length n < 2 || String.sub n 0 2 <> ".\\")
-  && (String.length n < 3 || String.sub n 0 3 <> "../")
-  && (String.length n < 3 || String.sub n 0 3 <> "..\\")
-;;
-
-let contains_colon n = String.contains n ':' ;;
-
-let mac_is_relative n =
-  (String.length n >= 1 && n.[0] = ':')
-  || not (contains_colon n)
-;;
-
-let mac_is_implicit n = not (contains_colon n);;
-
-let (is_relative, is_implicit) =
-  match Sys.os_type with
-  | "Unix" -> (unix_is_relative, unix_is_implicit)
-  | "Win32" -> (wnt_is_relative, wnt_is_implicit)
-  | "MacOS" -> (mac_is_relative, mac_is_implicit)
-  | _ -> assert false
-
-let unix_check_suffix name suff =
- String.length name >= String.length suff &&
- String.sub name (String.length name - String.length suff) (String.length suff)
-    = suff
-
-let wnt_check_suffix name suff =
- String.length name >= String.length suff &&
- (let s = String.sub name (String.length name - String.length suff)
-                          (String.length suff) in
-  String.lowercase s = String.lowercase suff)
-
-let mac_check_suffix = unix_check_suffix
-
-let check_suffix =
+module Unix = struct
+  let current_dir_name = "."
+  let parent_dir_name = ".."
+  let concat dirname filename =
+    let l = String.length dirname in
+    if l = 0 or dirname.[l-1] = '/'
+    then dirname ^ filename
+    else dirname ^ "/" ^ filename
+  let is_relative n = String.length n < 1 || n.[0] <> '/';;
+  let is_implicit n =
+    is_relative n
+    && (String.length n < 2 || String.sub n 0 2 <> "./")
+    && (String.length n < 3 || String.sub n 0 3 <> "../")
+  let check_suffix name suff =
+    String.length name >= String.length suff &&
+    String.sub name (String.length name - String.length suff)
+                    (String.length suff) = suff
+  let basename name =
+    try
+      let p = String.rindex name '/' + 1 in
+      String.sub name p (String.length name - p)
+    with Not_found ->
+      name
+  let dirname name =
+    try
+      match String.rindex name '/' with
+        0 -> "/"
+      | n -> String.sub name 0 n
+    with Not_found ->
+      "."
+  let temporary_directory =
+    try Sys.getenv "TMPDIR" with Not_found -> "/tmp"
+end
+
+module Win32 = struct
+  let current_dir_name = "."
+  let parent_dir_name = ".."
+  let concat dirname filename =
+    let l = String.length dirname in
+    if l = 0 or (let c = dirname.[l-1] in c = '/' or c = '\\' or c = ':')
+    then dirname ^ filename
+    else dirname ^ "\\" ^ filename
+  let is_relative n =
+    (String.length n < 1 || n.[0] <> '/')
+    && (String.length n < 1 || n.[0] <> '\\')
+    && (String.length n < 2 || n.[1] <> ':')
+  let is_implicit n =
+    is_relative n
+    && (String.length n < 2 || String.sub n 0 2 <> "./")
+    && (String.length n < 2 || String.sub n 0 2 <> ".\\")
+    && (String.length n < 3 || String.sub n 0 3 <> "../")
+    && (String.length n < 3 || String.sub n 0 3 <> "..\\")
+  let check_suffix name suff =
+   String.length name >= String.length suff &&
+   (let s = String.sub name (String.length name - String.length suff)
+                            (String.length suff) in
+    String.lowercase s = String.lowercase suff)
+  let rindexsep s =
+    let rec pos i =
+      if i < 0 then raise Not_found
+      else if (let c = s.[i] in c = '/' || c = '\\' || c = ':') then i
+      else pos (i - 1)
+    in pos (String.length s - 1)
+  let basename name =
+    try
+      let p = rindexsep name + 1 in
+      String.sub name p (String.length name - p)
+    with Not_found ->
+      name
+  let dirname name =
+    try
+      match rindexsep name with
+        0 -> "\\"
+      | n ->
+          let n =
+            if name.[n] = ':' || (n > 0 && name.[n-1] = ':')
+            then n+1 else n in
+          String.sub name 0 n
+    with Not_found ->
+      "."
+  let temporary_directory =
+    try Sys.getenv "TEMP" with Not_found -> "C:\\temp"
+end
+
+module MacOS = struct
+  let current_dir_name = "."
+  let parent_dir_name = ".."
+  let concat dirname filename =
+    let l = String.length dirname in
+    if l = 0 or dirname.[l-1] = ':'
+    then dirname ^ filename
+    else dirname ^ ":" ^ filename
+  let contains_colon n = String.contains n ':'
+  let is_relative n =
+    (String.length n >= 1 && n.[0] = ':')
+    || not (contains_colon n)
+  let is_implicit n = not (contains_colon n)
+  let check_suffix = Unix.check_suffix
+  let basename name =
+    try
+      let p = String.rindex name ':' + 1 in
+      String.sub name p (String.length name - p)
+    with Not_found -> name
+  let dirname name =
+    try match String.rindex name ':' with
+        | 0 -> ":"
+        | n -> String.sub name 0 n
+    with Not_found -> ":"
+  let temporary_directory =
+    try Sys.getenv "TempFolder" with Not_found -> ":"
+end
+
+let (current_dir_name, parent_dir_name, concat, is_relative, is_implicit,
+     check_suffix, basename, dirname, temporary_directory) =
   match Sys.os_type with
-  | "Unix" -> unix_check_suffix
-  | "Win32" -> wnt_check_suffix
-  | "MacOS" -> mac_check_suffix
+    "Unix" | "Cygwin" ->
+      (Unix.current_dir_name, Unix.parent_dir_name, Unix.concat,
+       Unix.is_relative, Unix.is_implicit, Unix.check_suffix,
+       Unix.basename, Unix.dirname, Unix.temporary_directory)
+  | "Win32" ->
+      (Win32.current_dir_name, Win32.parent_dir_name, Win32.concat,
+       Win32.is_relative, Win32.is_implicit, Win32.check_suffix,
+       Win32.basename, Win32.dirname, Win32.temporary_directory)
+  | "MacOS" ->
+      (MacOS.current_dir_name, MacOS.parent_dir_name, MacOS.concat,
+       MacOS.is_relative, MacOS.is_implicit, MacOS.check_suffix,
+       MacOS.basename, MacOS.dirname, MacOS.temporary_directory)
   | _ -> assert false
 
 let chop_suffix name suff =
   let n = String.length name - String.length suff in
   if n < 0 then invalid_arg "Filename.chop_suffix" else String.sub name 0 n
 
-let wnt_rindexsep s =
-  let rec pos i =
-    if i < 0 then raise Not_found
-    else if (let c = s.[i] in c = '/' || c = '\\' || c = ':') then i
-    else pos (i - 1)
-  in pos (String.length s - 1)
-
 let chop_extension name =
   try
     String.sub name 0 (String.rindex name '.')
   with Not_found ->
     invalid_arg "Filename.chop_extension"
 
-let unix_basename name =
-  try
-    let p = String.rindex name '/' + 1 in
-    String.sub name p (String.length name - p)
-  with Not_found ->
-    name
-
-let unix_dirname name =
-  try
-    match String.rindex name '/' with
-      0 -> "/"
-    | n -> String.sub name 0 n
-  with Not_found ->
-    "."
-
-let wnt_basename name =
-  try
-    let p = wnt_rindexsep name + 1 in
-    String.sub name p (String.length name - p)
-  with Not_found ->
-    name
-
-let wnt_dirname name =
-  try
-    match wnt_rindexsep name with
-      0 -> "\\"
-    | n ->
-        let n =
-          if name.[n] = ':' || (n > 0 && name.[n-1] = ':')
-          then n+1 else n in
-        String.sub name 0 n
-  with Not_found ->
-    "."
-
-let mac_basename name =
-  try
-    let p = String.rindex name ':' + 1 in
-    String.sub name p (String.length name - p)
-  with Not_found -> name
-
-let mac_dirname name =
-  try match String.rindex name ':' with
-      | 0 -> ":"
-      | n -> String.sub name 0 n
-  with Not_found -> ":"
-
-let basename =
-  match Sys.os_type with
-  | "Unix" -> unix_basename
-  | "Win32" -> wnt_basename
-  | "MacOS" -> mac_basename
-  | _ -> assert false
-
-let dirname =
-  match Sys.os_type with
-  | "Unix" -> unix_dirname
-  | "Win32" -> wnt_dirname
-  | "MacOS" -> mac_dirname
-  | _ -> assert false
-
-let temporary_directory =
-  match Sys.os_type with
-  | "Unix" -> (try Sys.getenv "TMPDIR" with Not_found -> "/tmp")
-  | "Win32" -> (try Sys.getenv "TEMP" with Not_found -> "C:\\temp")
-  | "MacOS" -> (try Sys.getenv "TempFolder" with Not_found -> ":")
-  | _ -> assert false
-
 external open_desc: string -> open_flag list -> int -> int = "sys_open"
 external close_desc: int -> unit = "sys_close"
 
@@ -206,7 +170,8 @@ let temp_file prefix suffix =
   in try_name 0
 
 let quote s =
-  let quotequote = match Sys.os_type with "MacOS" -> "'\182''" | _ -> "'\\''" in
+  let quotequote =
+    match Sys.os_type with "MacOS" -> "'\182''" | _ -> "'\\''" in
   let l = String.length s in
   let b = Buffer.create (l + 20) in
   Buffer.add_char b '\'';
@@ -217,4 +182,3 @@ let quote s =
   done;
   Buffer.add_char b '\'';
   Buffer.contents b
-;;
diff --git a/stdlib/header.c b/stdlib/header.c
index d1a3bffac..1fb0bfbf3 100644
--- a/stdlib/header.c
+++ b/stdlib/header.c
@@ -29,7 +29,9 @@
 
 char * default_runtime_path = RUNTIME_NAME;
 
+#ifndef MAXPATHLEN
 #define MAXPATHLEN 1024
+#endif
 
 #ifndef S_ISREG
 #define S_ISREG(mode) (((mode) & S_IFMT) == S_IFREG)
@@ -39,6 +41,10 @@ char * default_runtime_path = RUNTIME_NAME;
 #define SEEK_END 2
 #endif
 
+#ifndef __CYGWIN32__
+
+/* Normal Unix search path function */
+
 static char * searchpath(char * name)
 {
   static char fullname[MAXPATHLEN + 1];
@@ -67,6 +73,55 @@ static char * searchpath(char * name)
   return fullname;
 }
 
+#else
+
+/* Special version for Cygwin32: takes care of the ".exe" implicit suffix */
+
+static int file_ok(char * name)
+{
+  int fd;
+  /* Cannot use stat() here because it adds ".exe" implicitly */
+  fd = open(name, O_RDONLY);
+  if (fd == -1) return 0;
+  close(fd);
+  return 1;
+}
+
+static char * searchpath(char * name)
+{
+  char * path, * fullname, * p;
+
+  path = getenv("PATH");
+  fullname = malloc(strlen(name) + (path == NULL ? 0 : strlen(path)) + 6);
+  /* 6 = "/" plus ".exe" plus final "\0" */
+  if (fullname == NULL) return name;
+  /* Check for absolute path name */
+  for (p = name; *p != 0; p++) {
+    if (*p == '/' || *p == '\\') {
+      if (file_ok(name)) return name;
+      strcpy(fullname, name);
+      strcat(fullname, ".exe");
+      if (file_ok(fullname)) return fullname;
+      return name;
+    }
+  }
+  /* Search in path */
+  if (path == NULL) return name;
+  while(1) {
+    for (p = fullname; *path != 0 && *path != ':'; p++, path++) *p = *path;
+    if (p != fullname) *p++ = '/';
+    strcpy(p, name);
+    if (file_ok(fullname)) return fullname;
+    strcat(fullname, ".exe");
+    if (file_ok(fullname)) return fullname;
+    if (*path == 0) break;
+    path++;
+  }
+  return name;
+}
+
+#endif  
+
 static unsigned long read_size(char * ptr)
 {
   unsigned char * p = (unsigned char *) ptr;
@@ -122,6 +177,7 @@ int main(int argc, char ** argv)
     errwrite(" not found or is not a bytecode executable file\n");
     return 2;
   }
+  argv[0] = truename;
   execv(runtime_path, argv);
   errwrite("Cannot exec ");
   errwrite(runtime_path);
diff --git a/stdlib/sys.mli b/stdlib/sys.mli
index ad10484d6..cb493f77f 100644
--- a/stdlib/sys.mli
+++ b/stdlib/sys.mli
@@ -44,7 +44,7 @@ val interactive: bool ref
            the interactive toplevel system [ocaml]. *)
 val os_type: string
         (* Operating system currently executing the Caml program.
-           One of ["Unix"], ["Win32"], or ["MacOS"]. *)
+           One of ["Unix"], ["Win32"], ["Cygwin"] or ["MacOS"]. *)
 val word_size: int
         (* Size of one word on the machine currently executing the Caml
            program, in bits: 32 or 64. *)