ソースを参照

ensure that two paths can always be compared depending on OS

Nicolas Cannasse 13 年 前
コミット
e78b0dad9c
6 ファイル変更12 行追加9 行削除
  1. 4 0
      common.ml
  2. 1 2
      interp.ml
  3. 3 3
      main.ml
  4. 1 1
      parser.ml
  5. 1 1
      typecore.ml
  6. 2 2
      typeload.ml

+ 4 - 0
common.ml

@@ -233,6 +233,10 @@ let find_file ctx f =
 
 let get_full_path f = try Extc.get_full_path f with _ -> f
 
+let unique_full_path =
+	if Sys.os_type <> "Win32" && Sys.os_type <> "Cygwin" then get_full_path else
+	(fun f -> String.lowercase (String.concat "/" (ExtString.String.nsplit (get_full_path f) "\\")))
+
 (* ------------------------- TIMERS ----------------------------- *)
 
 type timer_infos = {

+ 1 - 2
interp.ml

@@ -1827,8 +1827,7 @@ let macro_lib =
 				try
 					Hashtbl.find hfiles f
 				with Not_found ->
-					let ff = Common.get_full_path f in
-					let ff = String.concat "/" (ExtString.String.nsplit ff "\\") in
+					let ff = Common.unique_full_path f in
 					Hashtbl.add hfiles f ff;
 					ff
 			in

+ 3 - 3
main.ml

@@ -392,7 +392,7 @@ and wait_loop boot_com host port =
 	global_cache := Some cache;
 	Typeload.parse_hook := (fun com2 file p ->
 		let sign = get_signature com2 in
-		let ffile = Common.get_full_path file in
+		let ffile = Common.unique_full_path file in
 		let ftime = file_time ffile in
 		let fkey = ffile ^ "!" ^ sign in
 		try
@@ -424,7 +424,7 @@ and wait_loop boot_com host port =
 		) m.m_types
 	in
 	let check_module_path com m p =
-		m.m_extra.m_file = Common.get_full_path (Typeload.resolve_module_file com m.m_path (ref[]) p)
+		m.m_extra.m_file = Common.unique_full_path (Typeload.resolve_module_file com m.m_path (ref[]) p)
 	in
 	let compilation_step = ref 0 in
 	let compilation_mark = ref 0 in
@@ -797,7 +797,7 @@ try
 				Common.define com "display";
 				Parser.use_doc := true;
 				Parser.resume_display := {
-					Ast.pfile = Common.get_full_path file;
+					Ast.pfile = Common.unique_full_path file;
 					Ast.pmin = pos;
 					Ast.pmax = pos;
 				};

+ 1 - 1
parser.ml

@@ -75,7 +75,7 @@ let display e = raise (Display e)
 
 let is_resuming p =
 	let p2 = !resume_display in
-	p.pmax = p2.pmin && String.lowercase (Common.get_full_path p.pfile) = String.lowercase p2.pfile
+	p.pmax = p2.pmin && Common.unique_full_path p.pfile = p2.pfile
 
 let precedence op =
 	let left = true and right = false in

+ 1 - 1
typecore.ml

@@ -213,7 +213,7 @@ let mk_field name t p = {
 
 let fake_modules = Hashtbl.create 0
 let create_fake_module ctx file =
-	let file = Extc.get_full_path file in
+	let file = Common.unique_full_path file in
 	let mdep = (try Hashtbl.find fake_modules file with Not_found ->
 		let mdep = {
 			m_id = alloc_mid();

+ 2 - 2
typeload.ml

@@ -805,7 +805,7 @@ let init_class ctx c p herits fields =
 
 	(* ----------------------- COMPLETION ----------------------------- *)
 
-	let display_file = if ctx.com.display then String.lowercase (Common.get_full_path p.pfile) = String.lowercase (!Parser.resume_display).pfile else false in
+	let display_file = if ctx.com.display then Common.unique_full_path p.pfile = (!Parser.resume_display).pfile else false in
 
 	let fields = if not display_file || Common.defined ctx.com "no-copt" then fields else Optimizer.optimize_completion c fields in
 
@@ -1183,7 +1183,7 @@ let type_module ctx m file tdecls loadp =
 		m_id = alloc_mid();
 		m_path = m;
 		m_types = [];
-		m_extra = module_extra (Common.get_full_path file) (Common.get_signature ctx.com) (file_time file) (if ctx.in_macro then MMacro else MCode);
+		m_extra = module_extra (Common.unique_full_path file) (Common.get_signature ctx.com) (file_time file) (if ctx.in_macro then MMacro else MCode);
 	} in
 	List.iter (fun (d,p) ->
 		match d with