Commits

camlspotter committed 0e46901 Merge

merge with default

  • Participants
  • Parent commits 84f5a56, bf8a634
  • Branches 2.2.0

Comments (0)

Files changed (7)

 spotlib_test$
 lib/temporal_lexer\.ml$
 setup\.ml\.ba.*$
-
+lib/inline_tests\.log$
+lib/ounittest_spotlib$
+lib/ounittest_spotlib\.ml$
-2.2.0 (Not yet)
+2.2.0
 ------------
 
 - Added Unix.shell_command'
 - Added (*>)
 - Unix.{file, mkdtemp, with_dtemp} added
 - Unix.mkdir is overridden
+* Renamed Unix.find to Added Unix.Find.find with poly record interface
 
 2.1.2
 ------------
 let try_ignore' f = try f () with _ -> ()
 let try_default' ~default f = try f () with _ -> default ();;
 let try_bool' f = try ignore (f ()); true with _ -> false
+
+(* Printexc 
+
+   Printexc has a very bad name. Printexc for exn ?
+*)
+let to_string        = Printexc.to_string
+let format ppf t     = Format.pp_print_string ppf (Printexc.to_string t)
+let print_backtrace  = Printexc.print_backtrace
+let get_backtrace    = Printexc.get_backtrace
+let register_printer = Printexc.register_printer
 val try_default' : default: (unit -> 'a) -> (unit -> 'a) -> 'a
 val try_bool'    : (unit -> unit) -> bool (* success/fail *)
 (** [true] at success *)
+
+(* Printexc + alpha *)
+
+val to_string : exn -> string
+val format : Format.formatter -> exn -> unit
+val print_backtrace : out_channel -> unit
+val get_backtrace : unit -> string
+val register_printer : (exn -> string option) -> unit

File lib/xstring.mli

+val contains : ?from:int -> needle:string -> string -> bool
+
 val is_prefix : ?from:int -> string -> string -> bool
 val is_postfix : string -> string -> bool
 

File lib/xunix.ml

     in
     loop init)
     ~finally:(fun _ -> closedir dh)
-;;
+
 
 module Inodes = Set.Make(struct
   type t = int * int
   let compare : t -> t -> int = compare
 end)
-;;
 
-type path = 
-    { dir : string;
-      base : string;
-      path : string; (* dir / name *)
-      stat : [ `Ok of stats | `Error of exn ];
-      depth : int;
-    }
+module Find = struct
 
-let path ~depth ~dir base =
-  let path = match Filename.concat dir base with
-    | "./." -> "."
-    | s -> s
-  in
-  { dir = dir;
-    base = base;
-    path = path;
-    depth = depth; 
-    stat = try `Ok (stat path) with e -> `Error e;
-  }
-;;
+  exception Prune
 
-let kind path =
-  match path.stat with
-  | `Error _exn -> None
-  | `Ok stat -> Some stat.st_kind
-;;
+  class type path = object
+    method base : string
+    method depth : int
+    method dev_inode : (int * int, exn) Result.t
+    method dir : string
+    method is_dir : bool
+    method is_ldir : bool
+    method is_reg : bool
+    method kind : (Unix.file_kind, exn) Result.t
+    method lkind : (Unix.file_kind, exn) Result.t
+    method path : string
+    method stat : (Unix.stats, exn) Result.t
+    method lstat : (Unix.stats, exn) Result.t
+  end
 
-let is_dir path = kind path = Some S_DIR
+  class path_ ~dir ~base ~depth = 
+    let path = match Filename.concat dir base with
+      | "./." -> "."
+      | s -> s
+    in
+    object (self)
+      method dir = dir
+      method base = base
+      method path = path
+      method depth : int = depth
+      method stat : (_,_) Result.t = try `Ok (stat path) with e -> `Error e
+      method lstat : (_,_) Result.t = try `Ok (lstat path) with e -> `Error e
+      method kind : (_,_) Result.t = match self#stat with
+        | `Error _exn -> `Error _exn
+        | `Ok stat -> `Ok stat.st_kind
+      method lkind : (_,_) Result.t = match self#lstat with
+        | `Error _exn -> `Error _exn
+        | `Ok stat -> `Ok stat.st_kind
+      method is_dir = self#kind = `Ok S_DIR
+      method is_ldir = self#lkind = `Ok S_DIR
+      method is_reg = self#kind = `Ok S_REG
+      method dev_inode : (_,_) Result.t = match self#stat with
+      | `Ok stat -> `Ok (stat.st_dev, stat.st_ino)
+      | `Error e -> `Error e
+    end
 
-let dev_inode path =
-  match path.stat with
-  | `Ok stat -> Some (stat.st_dev, stat.st_ino)
-  | `Error _ -> None
-
-exception Prune
-
-let prune () = raise Prune
-
-let find ~f fnames =
-
-  (* visited cache *)
-  let visited = ref Inodes.empty in
-  let if_not_visited_then path ~f = match dev_inode path with
-    | None -> ()
-    | Some inode ->
-        if Inodes.mem inode !visited then ()
-        else begin
-          visited := Inodes.add inode !visited;
-          f path
-        end
-  in
-
-  let rec find_dir pth =
-    try 
-      f pth;
-      let subdirs =
-        folddir pth.path ~init:[] ~f:(fun dirs -> function
-          | "." | ".." -> dirs
-          | name -> 
-      	let pth = path ~depth:(pth.depth + 1) ~dir:pth.path name in
-      	if try is_dir pth with _ -> false then pth::dirs
-      	else begin find_non_dir pth; dirs end)
+  let prune () = raise Prune
+  
+  let find ?(follow_symlink=false) ~f fnames =
+  
+    (* visited cache *)
+    let visited = ref Inodes.empty in
+    let if_not_visited_then path ~f = match path#dev_inode with
+      | `Error _ -> ()
+      | `Ok inode ->
+          if Inodes.mem inode !visited then ()
+          else begin
+            visited := Inodes.add inode !visited;
+            f path
+          end
+    in
+  
+    let rec find_dir pth =
+      try 
+        f pth;
+        let subdirs =
+          folddir pth#path ~init:[] ~f:(fun dirs -> function
+            | "." | ".." -> dirs
+            | name -> 
+        	let pth = new path_ ~depth:(pth#depth + 1) ~dir:pth#path ~base:name in
+        	if try if follow_symlink then pth#is_dir else pth#is_ldir with _ -> false then pth::dirs
+        	else begin find_non_dir pth; dirs end)
+        in
+        List.iter (if_not_visited_then ~f:find_dir) subdirs
+      with
+      | Prune -> ()
+  
+    and find_non_dir path = try f path with Prune -> ()
+      (* Even if path is a dangling symlink, f path is called *)
+    in
+  
+    List.iter (fun fname ->
+      let path = 
+        new path_ ~depth: 0 ~dir:(Filename.dirname fname) ~base:(Filename.basename fname)
       in
-      List.iter (if_not_visited_then ~f:find_dir) subdirs
-    with
-    | Prune -> ()
-
-  and find_non_dir path = try f path with Prune -> ()
-    (* Even if path is a dangling symlink, f path is called *)
-  in
-
-  List.iter (fun fname ->
-    let path = 
-      path ~depth: 0 ~dir:(Filename.dirname fname) (Filename.basename fname)
-    in
-    if is_dir path then find_dir path
-    else find_non_dir path) fnames
-;;
+      if path#is_dir then find_dir path
+      else find_non_dir path) fnames
+  
+end
 
 let try_set_close_on_exec fd =
   try set_close_on_exec fd; true with Invalid_argument _ -> false
-;;
+
     
 module Process_status = struct
 
       begin try execvp cmd cmdargs with _ -> exit 127
       end (* never return *)
   | id -> id
-;;
+
 
 let open_process_full cmdargs =
   let (in_read, in_write) = pipe() in
   close in_write;
   close err_write;
   pid, (in_read, out_write, err_read)
-;;
+
     
 let open_shell_process_full cmd = open_process_full [ "/bin/sh"; "-c"; cmd ]
-;;
+
 
 let buf_flush_limit = 100000
-;;
+
     
 let command_aux readers stat =
   let read_buflen = 4096 in
     end
   in
   loop readers stat
-;;
+
 
 let rec waitpid_non_intr pid =
   try 
     waitpid [] pid 
   with Unix_error (EINTR, _, _) -> waitpid_non_intr pid
-;;
+
     
 let command_wrapper (pid, (out, in_, err)) f ~init:stat =
   try
       kill pid 9;
       ignore (waitpid_non_intr pid);
       raise e
-;;
+
 
 let print_all = function
   | `Err, `Read s -> prerr_endline & Xstring.chop_newline s
   | `TRUE st -> `Already_exists st (* CR jfuruse: perm check ? *)
   | `FALSE st -> `Not_a_directory st
   | `Error e -> `Error e
-;;
+
 
 let mkdtemp template =
   match Xstring.is_postfix' "XXXXXX" template with

File lib/xunix.mli

 open Unix
 
-type path = 
-    { dir : string;
-      base : string;
-      path : string; (* dir / name *)
-      stat : [ `Ok of stats | `Error of exn ];
-      depth : int;
-    }
+module Find : sig
 
-val prune : unit -> 'exn
-(** for [find] *)
+  class type path = object
+    method base : string
+    method depth : int
+    method dev_inode : (int * int, exn) Result.t
+    method dir : string
+    method is_dir : bool
+    method is_ldir : bool
+    method is_reg : bool
+    method kind : (Unix.file_kind, exn) Result.t
+    method lkind : (Unix.file_kind, exn) Result.t
+    method path : string
+    method stat : (Unix.stats, exn) Result.t
+    method lstat : (Unix.stats, exn) Result.t
+  end
 
-val find : f:(path -> unit) -> string list -> unit
+  val prune : unit -> 'a
+  val find : ?follow_symlink:bool -> f:(path -> unit) -> string list -> unit
+
+end
 
 module Process_status : sig