From 623e2fbc005eec3bc79bbd81b8cff39ad5458f32 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Thu, 4 May 1995 12:48:07 +0000 Subject: [PATCH] Ajout de Sys.file_exists git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 --- bytecomp/linker.ml | 4 ++-- byterun/sys.c | 12 +++++------- driver/compile.ml | 2 +- stdlib/.depend | 3 +-- stdlib/Makefile | 3 --- stdlib/pervasives.ml | 7 ++++++- stdlib/pervasives.mli | 10 ++++++++-- stdlib/sys.ml | 8 +------- stdlib/sys.mli | 8 +------- toplevel/expunge.ml | 4 ++-- utils/misc.ml | 12 +++--------- utils/misc.mli | 2 -- 12 files changed, 30 insertions(+), 45 deletions(-) diff --git a/bytecomp/linker.ml b/bytecomp/linker.ml index 0ac4f2fa1..677dc4a37 100644 --- a/bytecomp/linker.ml +++ b/bytecomp/linker.ml @@ -149,7 +149,7 @@ let link_bytecode objfiles exec_name copy_header = let tolink = List.fold_left scan_file [] (List.rev objfiles) in let outchan = - open_out_gen [Sys.Open_wronly; Sys.Open_trunc; Sys.Open_creat; Sys.Open_binary] 0o777 exec_name in + open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary] 0o777 exec_name in try (* Copy the header *) if copy_header then begin @@ -212,7 +212,7 @@ let link objfiles = or Sys.command ("strip " ^ !Clflags.exec_name) <> 0 then raise(Error Custom_runtime); let oc = - open_out_gen [Sys.Open_wronly; Sys.Open_append; Sys.Open_binary] 0 !Clflags.exec_name in + open_out_gen [Open_wronly; Open_append; Open_binary] 0 !Clflags.exec_name in let ic = open_in_bin bytecode_name in copy_file ic oc; close_in ic; diff --git a/byterun/sys.c b/byterun/sys.c index 10f05e256..61f1cad05 100644 --- a/byterun/sys.c +++ b/byterun/sys.c @@ -3,6 +3,7 @@ #include #include #include +#include #include #include #include "config.h" @@ -88,11 +89,10 @@ value sys_open(path, flags, perm) /* ML */ return Val_long(ret); } -value sys_close(fd) /* ML */ - value fd; +value sys_file_exists(name) /* ML */ + value name; { - if (close(Int_val(fd)) != 0) sys_error(NULL); - return Atom(0); + return Val_bool(access(String_val(name), F_OK) == 0); } value sys_remove(name) /* ML */ @@ -119,8 +119,6 @@ value sys_chdir(dirname) /* ML */ return Atom(0); } -extern char * getenv(); - value sys_getenv(var) /* ML */ value var; { @@ -179,7 +177,7 @@ char * searchpath(name) *p++ = *q++; } *p = 0; - if (access(fullname, 1) == 0) return fullname; + if (access(fullname, F_OK) == 0) return fullname; if (*path == 0) return 0; path++; } diff --git a/driver/compile.ml b/driver/compile.ml index 91ff7e9e2..54c7591c5 100644 --- a/driver/compile.ml +++ b/driver/compile.ml @@ -66,7 +66,7 @@ let implementation sourcefile = Typemod.type_structure (initial_env()) (Parse.implementation lb) in if !Clflags.print_types then (Printtyp.signature sg; print_flush()); let (coercion, crc) = - if file_exists (prefixname ^ ".mli") then begin + if Sys.file_exists (prefixname ^ ".mli") then begin let (dclsig, crc) = Env.read_signature modulename (prefixname ^ ".cmi") in (Includemod.signatures Env.initial sg dclsig, crc) diff --git a/stdlib/.depend b/stdlib/.depend index f988c3da9..4bab0d09a 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -3,7 +3,6 @@ format.cmi: list.cmi gc.cmi: lexing.cmi: obj.cmi parsing.cmi: lexing.cmi obj.cmi -pervasives.cmi: sys.cmi printexc.cmi: arg.cmo: arg.cmi sys.cmi string.cmi list.cmi array.cmi printf.cmi array.cmo: array.cmi list.cmi array.cmi @@ -17,7 +16,7 @@ lexing.cmo: lexing.cmi string.cmi obj.cmi list.cmo: list.cmi list.cmi obj.cmo: obj.cmi parsing.cmo: parsing.cmi array.cmi lexing.cmi obj.cmi -pervasives.cmo: pervasives.cmi sys.cmi +pervasives.cmo: pervasives.cmi printexc.cmo: printexc.cmi obj.cmi printf.cmo: printf.cmi string.cmi obj.cmi queue.cmo: queue.cmi diff --git a/stdlib/Makefile b/stdlib/Makefile index fe2f3687c..e450ab52e 100644 --- a/stdlib/Makefile +++ b/stdlib/Makefile @@ -29,9 +29,6 @@ pervasives.cmi: pervasives.mli pervasives.cmo: pervasives.ml $(CAMLC) -nopervasives -c pervasives.ml -sys.cmi: sys.mli - $(CAMLC) -nopervasives -c sys.mli - .SUFFIXES: .mli .ml .cmi .cmo .mli.cmi: diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml index bc1014158..e406db952 100644 --- a/stdlib/pervasives.ml +++ b/stdlib/pervasives.ml @@ -134,7 +134,12 @@ let stderr = open_descriptor_out 2 (* General output functions *) -open Sys +type open_flag = + Open_rdonly | Open_wronly | Open_rdwr + | Open_append | Open_creat | Open_trunc | Open_excl + | Open_binary | Open_text + +external open_desc: string -> open_flag list -> int -> int = "sys_open" let open_out_gen mode perm name = open_descriptor_out(open_desc name mode perm) diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli index ff40c49d1..02b01c118 100644 --- a/stdlib/pervasives.mli +++ b/stdlib/pervasives.mli @@ -146,9 +146,15 @@ val read_int : unit -> int val read_float : unit -> float (* General output functions *) + +type open_flag = + Open_rdonly | Open_wronly | Open_rdwr + | Open_append | Open_creat | Open_trunc | Open_excl + | Open_binary | Open_text + val open_out : string -> out_channel val open_out_bin : string -> out_channel -val open_out_gen : Sys.open_flag list -> int -> string -> out_channel +val open_out_gen : open_flag list -> int -> string -> out_channel val flush : out_channel -> unit = "flush" val output_char : out_channel -> char -> unit = "output_char" val output_string : out_channel -> string -> unit @@ -165,7 +171,7 @@ val close_out : out_channel -> unit = "close_out" (* General input functions *) val open_in : string -> in_channel val open_in_bin : string -> in_channel -val open_in_gen : Sys.open_flag list -> int -> string -> in_channel +val open_in_gen : open_flag list -> int -> string -> in_channel val input_char : in_channel -> char = "input_char" val input_line : in_channel -> string val input : in_channel -> string -> int -> int -> int diff --git a/stdlib/sys.ml b/stdlib/sys.ml index b6172e418..79a40d9b3 100644 --- a/stdlib/sys.ml +++ b/stdlib/sys.ml @@ -1,18 +1,12 @@ (* System interface *) -type open_flag = - Open_rdonly | Open_wronly | Open_rdwr - | Open_append | Open_creat | Open_trunc | Open_excl - | Open_binary | Open_text - external get_argv: unit -> string array = "sys_get_argv" let argv = get_argv() +external file_exists: string -> bool = "sys_file_exists" external remove: string -> unit = "sys_remove" external getenv: string -> string = "sys_getenv" -external open_desc: string -> open_flag list -> int -> int = "sys_open" -external close_desc: int -> unit = "sys_close" external command: string -> int = "sys_system_command" external chdir: string -> unit = "sys_chdir" diff --git a/stdlib/sys.mli b/stdlib/sys.mli index b6332a14a..99c5e9375 100644 --- a/stdlib/sys.mli +++ b/stdlib/sys.mli @@ -1,15 +1,9 @@ (* System interface *) -type open_flag = - Open_rdonly | Open_wronly | Open_rdwr - | Open_append | Open_creat | Open_trunc | Open_excl - | Open_binary | Open_text - val argv: string array +val file_exists: string -> bool = "sys_file_exists" val remove: string -> unit = "sys_remove" val getenv: string -> string = "sys_getenv" -val open_desc: string -> open_flag list -> int -> int = "sys_open" -val close_desc: int -> unit = "sys_close" val command: string -> int = "sys_system_command" val chdir: string -> unit = "sys_chdir" diff --git a/toplevel/expunge.ml b/toplevel/expunge.ml index 5139aa339..3bf3778eb 100644 --- a/toplevel/expunge.ml +++ b/toplevel/expunge.ml @@ -31,10 +31,10 @@ let main () = let header = String.create(String.length Config.exec_magic_number) in really_input ic header 0 (String.length Config.exec_magic_number); if header <> Config.exec_magic_number then begin - prerr_endline "Wrong Obj.magic number"; exit 2 + prerr_endline "Wrong magic number"; exit 2 end; let oc = - open_out_gen [Sys.Open_wronly; Sys.Open_creat; Sys.Open_trunc; Sys.Open_binary] 0o777 output_name in + open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o777 output_name in (* Copy the file up to the symbol section as is *) seek_in ic 0; copy_file_chunk ic oc (pos_trailer - symbol_size - debug_size); diff --git a/utils/misc.ml b/utils/misc.ml index 0d1a90942..f2b507340 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -22,21 +22,15 @@ let rec for_all2 pred l1 l2 = (* File functions *) -let file_exists filename = - try - Sys.close_desc(Sys.open_desc filename [Sys.Open_rdonly] 0); true - with Sys_error msg -> - false - let find_in_path path name = if Filename.is_absolute name then - if file_exists name then name else raise Not_found + if Sys.file_exists name then name else raise Not_found else begin let rec try_dir = function [] -> raise Not_found | dir::rem -> let fullname = Filename.concat dir name in - if file_exists fullname then fullname else try_dir rem + if Sys.file_exists fullname then fullname else try_dir rem in try_dir path end @@ -49,7 +43,7 @@ let remove_file filename = let temp_file base suffix = let rec try_name counter = let name = "/tmp/" ^ base ^ string_of_int counter ^ suffix in - if file_exists name then try_name (counter + 1) else name + if Sys.file_exists name then try_name (counter + 1) else name in try_name 0 (* Hashtable functions *) diff --git a/utils/misc.mli b/utils/misc.mli index a8411f335..44354914e 100644 --- a/utils/misc.mli +++ b/utils/misc.mli @@ -8,8 +8,6 @@ exception Fatal_error val map_end: ('a -> 'b) -> 'a list -> 'b list -> 'b list val for_all2: ('a -> 'b -> bool) -> 'a list -> 'b list -> bool -val file_exists: string -> bool - (* Check if the given file name List.exists. *) val find_in_path: string list -> string -> string (* Search a file in a list of directories. *) val remove_file: string -> unit