Commits

camlspotter committed 1062e93

Mingw path fixes

  • Participants
  • Parent commits 114b713
  • Branches 4.01.0.2.2.0+win

Comments (0)

Files changed (10)

             else find fps
       in
       find (match Filename.split_extension base with
-      | body, (".cmi" | ".cmti" | ".spit") -> [ FP.(^/) dir (body ^ ".cmti") ]
-      | body, (".cmo" | ".cmx" | ".cmt" | ".spot") -> [ FP.(^/) dir (body ^ ".cmt") ]
+      | body, (".cmi" | ".cmti" | ".spit") -> [ FP.(^/) dir (FP.of_string (body ^ ".cmti")) ]
+      | body, (".cmo" | ".cmx" | ".cmt" | ".spot") -> [ FP.(^/) dir (FP.of_string (body ^ ".cmt")) ]
       | body, ".mli" -> 
-          [ FP.(^/) (Compdir.comp_dir dir ) (body ^ ".cmti");
-            FP.(^/) dir (body ^ ".cmti"); ]
+          [ FP.(^/) (Compdir.comp_dir dir ) (FP.of_string (body ^ ".cmti"));
+            FP.(^/) dir (FP.of_string (body ^ ".cmti")); ]
       | body, _ (* .ml, mll, mly, or eliom *) -> 
-          [ FP.(^/) (Compdir.comp_dir dir ) (body ^ ".cmt");
-            FP.(^/) dir (body ^ ".cmt") ])
+          [ FP.(^/) (Compdir.comp_dir dir ) (FP.of_string (body ^ ".cmt"));
+            FP.(^/) dir (FP.of_string (body ^ ".cmt")) ])
 
 (* CR jfuruse: this is a dirty workaround. It should be nice if we could know cmt is created by opt or byte *)          
 let is_opt cmt = 
 let rec find_dot_ocamlspot fp = 
   let open FP in
   match
-    if Unix.is_dir (FP.to_string (fp ^/ "_build")) then Some (fp, "_build")
+    if Unix.is_dir (FP.to_string (fp ^/ FP.of_string "_build")) then Some (fp, "_build")
     else
-      let dot_ocamlspot = fp ^/ ".ocamlspot" in
+      let dot_ocamlspot = fp ^/ FP.of_string ".ocamlspot" in
       if Sys.file_exists (FP.to_string dot_ocamlspot) then
         match (Dotfile.load (FP.to_string dot_ocamlspot)).Dotfile.build_dir with
         | Some dir -> Some (fp, dir)
     match find_dot_ocamlspot fp0 with
     | None -> fp0
     | Some (dir, mv) ->
-        match FP.contains_abs dir fp0 with
+        match FP.is_prefix dir fp0 with
         | None -> fp0
         | Some postfixes ->
-            match FP.contains_abs (FP.(^/) dir mv) fp0 with
+            match FP.is_prefix (FP.(^/) dir (FP.of_string mv)) fp0 with
             | Some _ -> fp0 (* already in the comp dir *)
             | None -> 
                 (* CR jfuruse: inefficient *)
-                FP.of_string (Filename.concats (FP.to_string dir :: mv :: postfixes))
+                FP.of_string (Filename.concats (FP.to_string dir :: mv :: FP.to_list postfixes))
 
 let comp_dir x =
   let y = comp_dir x in
-  if not (FP.equal x y) then
+  if x <> y then
     Format.eprintf "comp_dir: %s => %s@." (FP.to_string x) (FP.to_string y);
   y
 
     match find_dot_ocamlspot fp0 with
     | None -> fp0
     | Some (dir, mv) ->
-        match FP.contains_abs (FP.(^/) dir mv) fp0 with
+        match FP.is_prefix (FP.(^/) dir (FP.of_string mv)) fp0 with
         | None -> fp0
-        | Some postfixes -> 
-            (* CR jfuruse: inefficient *)
-            FP.of_string (Filename.concats (FP.to_string dir :: postfixes))
+        | Some postfixes -> FP.(^/) dir postfixes
 
 let src_file x =
   let y = src_file x in
-  if not (FP.equal x y) then
+  if x <> y then
     Format.eprintf "src_file: %s => %s@." (FP.to_string x) (FP.to_string y);
   y
 
 let name = ".ocamlspot"
 
 let rec find absdir =
+prerr_endline absdir;
   let path = absdir ^/ name in
   if Sys.file_exists path then Some (absdir, path)
   else if absdir = "/" then None
 
 open Utils
 
-module F = Filename
+open Filename
 
-let get_component : string -> string = 
-  Hashtbl.memoize (Hashtbl.create 1023) (fun x -> x)
+let get_component : string -> string = Hashtbl.memoize (Hashtbl.create 1023) (fun x -> x)
 
-let dotdot = get_component ".."
+let dotdot = get_component (parent_dir_name)
 
-let rec split st path = 
-  let dir  = F.dirname  path in
-  let base = F.basename path in
-  let st = 
-    let base = 
-      if base = ""
-      || base = F.current_dir_name 
-      || base = F.dir_sep || base = "/" then ""
-      else base
-    in
-    get_component base :: st
-  in
-  if dir = F.current_dir_name then false, st
-  else if dir = F.dir_sep || dir = "/" then true, st
-  else split st dir
+let root_normalize = 
+  match Sys.os_type with
+  | "Win32" ->
+      (* "c:/" => "C:\\" *)
+      (fun s -> 
+        let s = String.uppercase s in
+        String.iteri (fun p -> function
+          | '/' -> String.unsafe_set s p '\\'
+          | _ -> ()) s;
+        s)
+  | "Cygwin" ->
+      (* "C:\\" => "c:/" *)
+      (fun s ->
+        let s = String.lowercase s in
+        String.iteri (fun p -> function
+          | '\\' -> String.unsafe_set s p '/'
+          | _ -> ()) s;
+        s)
+  | _ -> (fun s -> s)
+
+let rec split st s =
+  let d = dirname s in
+  if d = s then get_component (root_normalize s) :: st
+  else 
+    let b = basename s in
+    split (get_component b :: st) d
 
 let split = split []
-      
-let () = 
-  match Sys.os_type with
-  | "Unix" -> 
-      assert (split ""       = (false, [""]));
-      assert (split "."      = (false, [""]));
-      assert (split "/"      = (true, [""]));
-      assert (split "/."     = (true, [""]));
-      assert (split "./"     = (false, [""]));
-      assert (split ".."     = (false, [".."]));
-      assert (split "/.."    = (true, [".."]));
-      assert (split "/.."    = (true, [".."]));
-      assert (split "//"     = (true, [""]));
-      assert (split "///"    = (true, [""]));
-      assert (split "a/"     = (false, ["a"]));
-      assert (split "a/."    = (false, ["a"; ""]));
-      assert (split "a/b"    = (false, ["a"; "b"]));
-      assert (split "a/b/"   = (false, ["a"; "b"]));
-      assert (split "a/b/."  = (false, ["a"; "b"; ""]));
-      assert (split "a//b/." = (false, ["a"; "b"; ""]))
-  | _ -> ()
 
-let rec rev_normalize rev abs = function
-  | [] -> rev
-  | x::xs ->
-      if x = F.dir_sep || x = F.current_dir_name then assert false;
-      if x = F.parent_dir_name then
-        match rev with
-        | [] -> rev_normalize (if abs then [] else [F.parent_dir_name]) abs xs
-        | r::_ when r = F.parent_dir_name -> rev_normalize (x::rev) abs xs
-        | _::rs -> rev_normalize rs abs xs
-      else if x = "" then rev_normalize rev abs xs
-      else rev_normalize (x::rev) abs xs
-      
+let rec concats = function
+  | [] -> current_dir_name
+  | x::xs when not (is_relative x) -> x ^ concats xs
+  | xs -> String.concat dir_sep xs
+
+let test s = 
+  let ss = split s in
+  (* Format.eprintf "%s => %s@." s (concats ss); *)
+  ss
+
+let () =
+  assert (test "" = ["."]);
+  assert (test "." = ["."]);
+  assert (test "a/b/c" = ["."; "a"; "b"; "c"]);
+  assert (test "/a/b/c" = ["/"; "a"; "b"; "c"]);
+  assert (test "//a//b//c" = ["/"; "a"; "b"; "c"]);
+  assert (test "/a/./b/./c/" = ["/"; "a"; "."; "b"; "."; "c"]);
+  
+  if Sys.os_type = "Win32" then begin
+    assert (test "\\a\\b\\c" = ["\\"; "a"; "b"; "c"]);
+    assert (test "c:\\a\\b\\c" = ["C:\\"; "a"; "b"; "c"]);
+    assert (test "c:/a/b/c" = ["C:\\"; "a"; "b"; "c"]);
+  end
+
 let hashcons_list = 
   let cache = Hashtbl.create 1023 in
   let rec f xs = Hashtbl.memoize cache (function
   in
   f
 
-let rev_normalize rev abs xs = hashcons_list (rev_normalize rev abs xs)
+let rec normalize' rev = function
+  | [] -> hashcons_list (List.rev rev)
+  | x::xs when x = current_dir_name -> normalize' rev xs
+  | x::xs when x = parent_dir_name -> 
+      begin match rev with
+      | r::_ when not (is_relative r) -> normalize' rev xs
+      | r::_ when r = parent_dir_name || r = current_dir_name -> normalize' (x::rev) xs
+      | _::rev -> normalize' rev xs
+      | [] -> normalize' [x] xs
+      end
+  | x::xs -> normalize' (x::rev) xs
+          
+let normalize = normalize' []
 
-let () = 
-  assert (rev_normalize [] false [] = []);
-  assert (rev_normalize [] false [""] = []);
-  assert (rev_normalize [] false [""; ""] = []);
-  assert (rev_normalize [] false ["a"; ""] = ["a"]);
-  assert (rev_normalize [] false [""; "a"] = ["a"]);
-  assert (rev_normalize [] false ["a"; ""] == rev_normalize [] false [""; "a"]);
-  assert (rev_normalize [] false ["a"; ".."] = []);
-  assert (rev_normalize [] false ["a"; ".."; "b"] = ["b"]);
-  assert (rev_normalize [] false [".."; "a"] = ["a"; ".."]);
-  assert (rev_normalize [] false [".."; "a"; ".."] = [".."]);
-  assert (rev_normalize [] false [".."; "a"; "b"; ".."; ".."; "c"] = ["c"; ".."]);
-  assert (rev_normalize [] false [".."; "a"; ".."; ".."; "c"] = ["c"; ".."; ".."]);
-  assert (rev_normalize [] true  [".."; "a"] = ["a"]);
-  assert (rev_normalize [] true  [".."; "a"; ".."] = []);
-  assert (rev_normalize [] true  [".."; "a"; "b"; ".."; ".."; "c"] = ["c"]);
-  assert (rev_normalize [] true  [".."; "a"; ".."; ".."; "c"] = ["c"]);
+let () =
+  let test s = 
+    let ss = split s in
+    let nss = normalize ss in
+    Format.eprintf "%s => %s => %s@." s (concats ss) (concats nss);
+    nss
+  in
 
-type t = bool * string list
+  assert (test "a/b/c" = ["a"; "b"; "c"]);
+  assert (test "/a/b/c" = ["/"; "a"; "b"; "c"]);
+  assert (test "//a//b//c" = ["/"; "a"; "b"; "c"]);
+  assert (test "/a/./b/./c/" = ["/"; "a"; "b"; "c"]);
+  assert (test "/a/../b/../c/" = ["/"; "c"]);
+  assert (test "../../a/../b" = [".."; ".."; "b"]);
+    
+      assert (test ""       = []);
+      assert (test "."      = []);
+      assert (test "/"      = ["/"]);
+      assert (test "/."     = ["/"]);
+      assert (test "./"     = [""]);
+      assert (test ".."     = [".."]);
+      assert (test "/.."    = ["/"]);
+      assert (test "//"     = ["/"]);
+      assert (test "///"    = ["/"]);
+      assert (test "a/"     = ["a"]);
+      assert (test "a/."    = ["a"]);
+      assert (test "a/b"    = ["a"; "b"]);
+      assert (test "a/b/"   = ["a"; "b"]);
+      assert (test "a/b/."  = ["a"; "b"]);
+      assert (test "a//b/." = ["a"; "b"]);
 
-let equal (b1,xs1) (b2,xs2) = b1 = b2 && xs1 == xs2
+  if Sys.os_type = "Win32" then begin
+    assert (test "\\a\\b\\c" = ["\\"; "a"; "b"; "c"]);
+    assert (test "c:\\a\\b\\c" = ["c:\\"; "a"; "b"; "c"]);
+    assert (test "c:/a/b/c" = ["c:/"; "a"; "b"; "c"]);
+    assert (test "\\a\\..\\\\b\\\\..\\c\\" = ["\\"; "c"]);
+    assert (test "c:a/../b" = ["c:."; "b"]);
+  end
 
-let compare t1 t2 = if equal t1 t2 then 0 else compare t1 t2
+type t = string list
 
-let contains_abs (b1,dir) (b2,f) =
-  assert (b1 && b2);
-  let dir = List.rev dir in
-  let f = List.rev f in
-  let rec loop dir f = match dir, f with
-    | [], fs -> Some fs
-    | d::ds, f::fs when d = f -> loop ds fs
-    | _::_, _ -> None
-  in
-  loop dir f
+let rec is_prefix xs ys =
+  match xs, ys with
+  | [], ys -> Some ys
+  | x::xs, y::ys when x = y -> is_prefix xs ys
+  | _ -> None
 
-let () = 
-  assert (contains_abs (true, ["c"; "b"; "a"]) (true, ["e"; "d"; "c"; "b"; "a"]) =
-      Some ["d"; "e"])
+let () = assert (is_prefix ["a"; "b"; "c"] ["a"; "b"; "c"; "d"; "e"] = Some ["d"; "e"])
 
-let of_string path = 
-  let abs, xs = split path in
-  abs, rev_normalize [] abs xs
+let of_string path = normalize (split path)
 
-let to_string (abs, rev) =
-  let xs = List.rev rev in
-  let xs = if abs then "" :: xs else xs in
-  if xs = [] then "." else String.concat (F.dir_sep) xs
+let to_string = concats
 
-let is_absolute (abs, _) = abs
-let is_relative (abs, _) = not abs
+let is_absolute = function
+  | [] -> false
+  | x::_ -> not (is_relative x)
 
-let root = (true, [])
-let is_root = function 
-  | (true, []) -> true
+let is_relative xs = not (is_absolute xs)
+
+let is_root = function
+  | ([_] as xs) -> is_absolute xs
   | _ -> false
 
-let dirbase (abs, xs) = match xs with
-  | [] | ".." :: _ -> (abs, xs), None
-  | x::xs -> (abs, xs), Some x
+let dirbase = function
+  | [] -> [], None
+  | xs ->
+      let rec dirbase rev = function
+        | [] -> assert false
+        | [x] -> List.rev rev, Some x
+        | x::xs -> dirbase (x::rev) xs
+      in
+      dirbase [] xs
 
-let (^/) (abs, xs) s = 
-  let abs', ys = split s in
-  assert (not abs');
-  abs, rev_normalize xs abs ys
+let (^/) xs ys = 
+  assert (is_relative ys);
+  normalize' (List.rev xs) ys
 
 let parent = function
-  | (false, (".."::_ | [] as xs)) -> (false, dotdot :: xs)
-  | (true, []) -> (true, [])
-  | (abs, (_::xs)) -> (abs, xs)
+  | [] -> [parent_dir_name]
+  | [x] when is_absolute [x] -> [x]
+  | [x] when dirname x = x -> [x; dotdot]
+  | xs ->
+      let rec parent rev = function
+        | [] -> assert false
+        | [x] when x = parent_dir_name -> List.rev (parent_dir_name :: x :: rev)
+        | [_] -> List.rev rev
+        | x::xs -> parent (x::rev) xs
+      in
+      parent [] xs
 
 let wrap f s = to_string (f (of_string s))
+
+let to_list xs = xs

File filepath.mli

 
 type t
 
-val compare : t -> t -> int
-val equal : t -> t -> bool
-
-val contains_abs : t -> t -> string list option
+val is_prefix : t -> t -> t option
 (** contains_abs /a/b/c /a/b/c/d/e = Some ["d"; "e"] 
-    Only works for absolute paths
 *)
 
 val of_string : string -> t
 val to_string : t -> string
+
 val is_absolute : t -> bool
 val is_relative : t -> bool
-val root : t
+(* val root : t *)
 val is_root : t -> bool
 val dirbase : t -> t * string option
-val (^/) : t -> string -> t
+val (^/) : t -> t -> t
 val parent : t -> t
 val wrap : (t -> t) -> string -> string
+
+val to_list : t -> string list

File ocamlspot.sh

File contents unchanged.

File tests/Makefile

 ##########################
 OCAMLC   = ocamlc -annot -bin-annot
 OCAMLOPT = ocamlopt -annot -bin-annot
-OCAMLDEP = ocamldep
+OCAMLDEP = ocamldep -slash
 OCAMLLEX = ocamllex
 OCAMLYACC= ocamlyacc
-OCAMLLIB = $(LIBDIR)
-OCAMLBIN = $(BINDIR)
 
 # Compilation
 #############

File tests/ocamlspot.sh

File contents unchanged.
 
 include Lazy.Open
 
+module String = struct
+  include String
+
+  (* split a string according to char_sep predicate *)
+  let split char_sep str =
+    let len = String.length str in
+    if len = 0 then [] else
+      let rec skip_sep cur =
+        if cur >= len then cur
+        else if char_sep str.[cur] then skip_sep (succ cur)
+        else cur  in
+      let rec split beg cur =
+        if cur >= len then 
+  	if beg = cur then []
+  	else [String.sub str beg (len - beg)]
+        else if char_sep str.[cur] 
+  	   then 
+  	     let nextw = skip_sep cur in
+  	      (String.sub str beg (cur - beg))
+  		::(split nextw nextw)
+  	   else split beg (succ cur) in
+      let wstart = skip_sep 0 in
+      split wstart wstart
+end
+
 module Filename = struct
   include Filename
       
     with
     | Invalid_argument _ -> s, ""
 
-  let concats xs = String.concat dir_sep xs
+  let concats = String.concat dir_sep
 
   module Open = struct
     let (^/) p1 p2 =
       if Filename.is_relative p2 then Filename.concat p1 p2 else p2
   end
+
 end
 
 include Filename.Open
 end
 include module type of Lazy.Open
 
+module String : sig
+  include module type of String
+  val split : (char -> bool) -> string -> string list
+end
+
 module Filename : sig
   include module type of Filename
   val split_extension : string -> string * string
-  val concats : string list -> string
+
+    val concats : string list -> string
+
   module Open : sig
     val (^/) : string -> string -> string
   end