[utils] Add CTypes binding of fts and implement remove_directory_tree

Summary:
This diff adds a dependency on ctypes.foreign and uses the example
binding of fts to implement remove_directory_tree.

Reviewed By: yunxing

Differential Revision: D4115569

fbshipit-source-id: 3509955
master
Josh Berdine 8 years ago committed by Facebook Github Bot
parent 8d427cfda6
commit 34739522c0

@ -26,6 +26,7 @@ OCAMLBUILD_OPTIONS = \
-r \
-use-menhir -menhir 'menhir --explain --strict'\
-use-ocamlfind \
-lflags -cclib,-lffi \
-cflags -g -lflags -g \
-cflags -short-paths \
-cflags -safe-string \
@ -35,7 +36,7 @@ OCAMLBUILD_OPTIONS = \
-cflags -w,$(OCAML_FATAL_WARNINGS)-4-9-40-41-42-45-48 \
-tag-line "<*{clang/clang_ast_*,backend/jsonbug_*,checkers/stacktree_*}>: warn(-27-32-35-39)" \
-tag thread \
-pkgs atdgen,core,extlib,oUnit,str,unix,yojson,zip
-pkgs atdgen,core,ctypes.foreign,extlib,oUnit,str,unix,yojson,zip
ifeq ($(ENABLE_OCAML_ANNOT),yes)
OCAMLBUILD_OPTIONS += -cflags -annot
@ -133,7 +134,7 @@ else
EXTRA_DEPS = opensource
endif
DEPENDENCIES = IR backend base checkers eradicate harness integration quandary $(EXTRA_DEPS)
DEPENDENCIES = IR backend base checkers eradicate harness integration tp/fts quandary $(EXTRA_DEPS)
# ocamlbuild command with options common to all build targets
OCAMLBUILD_BASE = rebuild $(OCAMLBUILD_OPTIONS) -j $(NCPU) $(addprefix -I , $(DEPENDENCIES))

@ -582,6 +582,16 @@ let directory_iter f path =
else
f path
let remove_directory_tree path =
Stream.from (fun _ -> Fts.fts_read (Fts.fts_open ?compar:None ~path_argv:[path] ~options:[]))
|> Stream.iter (fun ent ->
match Fts.FTSENT.info ent with
| FTS_D | FTS_DOT -> ()
| _ -> Core.Std.Unix.remove (Fts.FTSENT.name ent)
)
let string_crc_hex32 s = Digest.to_hex (Digest.string s)
let string_append_crc_cutoff ?(cutoff=100) ?(key="") name =

@ -278,6 +278,9 @@ val directory_fold : ('a -> string -> 'a) -> 'a -> string -> 'a
(** Functional iter function over all the file of a directory *)
val directory_iter : (string -> unit) -> string -> unit
(** Remove a directory and its contents *)
val remove_directory_tree : string -> unit
val read_optional_json_file : string -> (Yojson.Basic.json, string) result
val with_file : string -> f:(out_channel -> 'a) -> 'a

@ -0,0 +1,19 @@
Copyright (c) 2013 Jeremy Yallop
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.

@ -0,0 +1,247 @@
(*
* Copyright (c) 2013 Jeremy Yallop.
*
* This file is distributed under the terms of the MIT License.
* See the file LICENSE for details.
*)
open Ctypes
type fts_info =
FTS_D
| FTS_DC
| FTS_DEFAULT
| FTS_DNR
| FTS_DOT
| FTS_DP
| FTS_ERR
| FTS_F
| FTS_NS
| FTS_NSOK
| FTS_SL
| FTS_SLNONE
let fts_info_of_int = function
| 1 -> FTS_D
| 2 -> FTS_DC
| 3 -> FTS_DEFAULT
| 4 -> FTS_DNR
| 5 -> FTS_DOT
| 6 -> FTS_DP
| 7 -> FTS_ERR
| 8 -> FTS_F
(* | 9 -> FTS_INIT *)
| 10 -> FTS_NS
| 11 -> FTS_NSOK
| 12 -> FTS_SL
| 13 -> FTS_SLNONE
| _ -> invalid_arg "fts_info"
type fts_open_option =
FTS_COMFOLLOW
| FTS_LOGICAL
| FTS_NOCHDIR
| FTS_NOSTAT
| FTS_PHYSICAL
| FTS_SEEDOT
| FTS_XDEV
let fts_children_option_of_bool = function
| false -> 0
| true -> 0x0100
let fts_open_option_value = function
| FTS_COMFOLLOW -> 0x0001
| FTS_LOGICAL -> 0x0002
| FTS_NOCHDIR -> 0x0004
| FTS_NOSTAT -> 0x0008
| FTS_PHYSICAL -> 0x0010
| FTS_SEEDOT -> 0x0020
| FTS_XDEV -> 0x0040
type fts_set_option =
FTS_AGAIN
| FTS_FOLLOW
| FTS_SKIP
let fts_set_option_value = function
| FTS_AGAIN -> 1
| FTS_FOLLOW -> 2
| FTS_SKIP -> 4
let castp typ p = from_voidp typ (to_voidp p)
module FTSENT =
struct
open PosixTypes
open Unsigned
type ftsent
let ftsent : ftsent structure typ = structure "ftsent"
let ( -: ) ty label = field ftsent label ty
let fts_cycle = ptr ftsent -: "fts_cycle"
let fts_parent = ptr ftsent -: "fts_parent"
let fts_link = ptr ftsent -: "fts_link"
let fts_number = int -: "fts_number"
let fts_pointer = ptr void -: "fts_pointer"
let fts_accpath = string -: "fts_accpath"
let fts_path = string -: "fts_path"
let fts_errno = int -: "fts_errno"
let _fts_symfd = int -: "fts_symfd"
let _fts_pathlen = ushort -: "fts_pathlen"
let _fts_namelen = ushort -: "fts_namelen"
let _fts_ino = ino_t -: "fts_ino"
let _fts_dev = dev_t -: "fts_dev"
let _fts_nlink = nlink_t -: "fts_nlink"
let fts_level = short -: "fts_level"
let fts_info = ushort -: "fts_info"
let _fts_flags = ushort -: "fts_flags"
let _fts_instr = ushort -: "fts_instr"
let _fts_statp = ptr void -: "fts_statp" (* really a struct stat * *)
let fts_name = char -: "fts_name"
let () = seal ftsent
type t = ftsent structure ptr
let t = ptr ftsent
let info : t -> fts_info
= fun t -> fts_info_of_int (UShort.to_int (getf !@t fts_info))
let accpath : t -> string
= fun t -> getf !@t fts_accpath
let path : t -> string
= fun t -> getf !@t fts_path
let name : t -> string
= fun t -> Ctypes.coerce (ptr char) string (t |-> fts_name)
let level : t -> int
= fun t -> getf !@t fts_level
let errno : t -> int
= fun t -> getf !@t fts_errno
let number : t -> int
= fun t -> getf !@t fts_number
let set_number : t -> int -> unit
= fun t -> setf !@t fts_number
let pointer : t -> unit ptr
= fun t -> getf !@t fts_pointer
let set_pointer : t -> unit ptr -> unit
= fun t -> setf !@t fts_pointer
let parent : t -> t
= fun t -> getf !@t fts_parent
let link : t -> t
= fun t -> getf !@t fts_link
let cycle : t -> t
= fun t -> getf !@t fts_cycle
end
module FTS =
struct
open PosixTypes
open FTSENT
type fts
let fts : fts structure typ = structure "fts"
let ( -: ) ty label = field fts label ty
let fts_cur = ptr ftsent -: "fts_cur"
let fts_child = ptr ftsent -: "fts_child"
let fts_array = ptr (ptr ftsent) -: "fts_array"
let fts_dev = dev_t -: "fts_dev"
let fts_path = string -: "fts_path"
let fts_rfd = int -: "fts_rfd"
let _fts_pathlen = int -: "fts_pathlen"
let fts_nitems = int -: "fts_nitems"
let _fts_compar = Foreign.funptr (ptr FTSENT.t @-> ptr FTSENT.t @-> returning int)
-: "fts_compar"
(* fts_options would work well as a view *)
let _fts_options = int -: "fts_options"
let () = seal fts
type t = { ptr : fts structure ptr;
(* The compar field ties the lifetime of the comparison function
to the lifetime of the fts object to prevent untimely
collection. *)
compar: (FTSENT.t ptr -> FTSENT.t ptr -> int) option }
let cur : t -> FTSENT.t
= fun { ptr } -> getf !@ptr fts_cur
let child : t -> FTSENT.t
= fun { ptr } -> getf !@ptr fts_child
let array : t -> FTSENT.t list
= fun { ptr } ->
CArray.(to_list (from_ptr (getf !@ptr fts_array) (getf !@ptr fts_nitems)))
let dev : t -> dev_t
= fun { ptr } -> getf !@ptr fts_dev
let path : t -> string
= fun { ptr } -> getf !@ptr fts_path
let rfd : t -> int
= fun { ptr } -> getf !@ptr fts_rfd
end
open FTSENT
open FTS
(* FTS *fts_open(char * const *path_argv, int options,
int ( *compar)(const FTSENT **, const FTSENT ** ));
*)
let compar_type = ptr FTSENT.t @-> ptr FTSENT.t @-> returning int
let _fts_open = Foreign.foreign "fts_open"
(ptr string @-> int @-> Foreign.funptr_opt compar_type @-> returning (ptr fts))
(* FTSENT *fts_read(FTS *ftsp); *)
let _fts_read = Foreign.foreign "fts_read" ~check_errno:true
(ptr fts @-> returning (ptr ftsent))
(* FTSENT *fts_children(FTS *ftsp, int options); *)
let _fts_children = Foreign.foreign "fts_children"
(ptr fts @-> int @-> returning (ptr ftsent))
(* int fts_set(FTS *ftsp, FTSENT *f, int options); *)
let _fts_set = Foreign.foreign "fts_set" ~check_errno:true
(ptr fts @-> ptr (ftsent) @-> int @-> returning int)
(* int fts_close(FTS *ftsp); *)
let _fts_close = Foreign.foreign "fts_close" ~check_errno:true
(ptr fts @-> returning int)
let crush_options f : 'a list -> int = List.fold_left (fun i o -> i lor (f o)) 0
let fts_read fts =
let p = _fts_read fts.ptr in
if to_voidp p = null then None
else Some p
let fts_close ftsp =
ignore (_fts_close ftsp.ptr)
let fts_set ~ftsp ~f ~options =
ignore (_fts_set ftsp.ptr f (crush_options fts_set_option_value options))
let fts_children ~ftsp ~name_only =
_fts_children ftsp.ptr (fts_children_option_of_bool name_only)
let null_terminated_array_of_ptr_list typ list =
let nitems = List.length list in
let arr = CArray.make typ (1 + nitems) in
List.iteri (CArray.set arr) list;
(castp (ptr void) (CArray.start arr +@ nitems)) <-@ null;
arr
let fts_open ~path_argv ?compar ~options =
let paths = null_terminated_array_of_ptr_list string path_argv in
let options = crush_options fts_open_option_value options in
{ ptr = _fts_open (CArray.start paths) options compar; compar }

@ -0,0 +1,315 @@
(*
* Copyright (c) 2013 Jeremy Yallop.
*
* This file is distributed under the terms of the MIT License.
* See the file LICENSE for details.
*)
open Ctypes
(* The fts functions are provided for traversing file hierarchies. A simple
overview is that the fts_open() function returns a "handle" on a file
hierarchy, which is then supplied to the other fts functions. The function
fts_read() returns a pointer to a structure describing one of the files in the
file hierarchy. The function fts_children() returns a pointer to a linked
list of structures, each of which describes one of the files contained in a
directory in the hierarchy. In general, directories are visited two
distinguishable times; in preorder (before any of their descendants are
visited) and in postorder (after all of their descendants have been visited).
Files are visited once. It is possible to walk the hierarchy "logically"
(ignoring symbolic links) or physically (visiting symbolic links), order the
walk of the hierarchy or prune and/or revisit portions of the hierarchy. *)
type fts_info =
(* A directory being visited in preorder. *)
FTS_D
(* A directory that causes a cycle in the tree. (The fts_cycle field of
the FTSENT structure will be filled in as well.) *)
| FTS_DC
(* Any FTSENT structure that represents a file type not explicitly
described by one of the other fts_info values. *)
| FTS_DEFAULT
(* A directory which cannot be read. This is an error return, and the
fts_errno field will be set to indicate what caused the error. *)
| FTS_DNR
(* A file named "." or ".." which was not specified as a filename to
fts_open() (see FTS_SEEDOT). *)
| FTS_DOT
(* A directory being visited in postorder. The contents of the FTSENT
structure will be unchanged from when it was returned in preorder, that
is, with the fts_info field set to FTS_D. *)
| FTS_DP
(* This is an error return, and the fts_errno field will be set to
indicate what caused the error. *)
| FTS_ERR
(* A regular file. *)
| FTS_F
(* A file for which no stat(2) information was available. The contents of
the fts_statp field are undefined. This is an error return, and the
fts_errno field will be set to indicate what caused the error. *)
| FTS_NS
(* A file for which no stat(2) information was requested. The contents of
the fts_statp field are undefined. *)
| FTS_NSOK
(* A symbolic link. *)
| FTS_SL
(* A symbolic link with a nonexistent target. The contents of the
fts_statp field reference the file characteristic information for the
symbolic link itself. *)
| FTS_SLNONE
module FTSENT :
sig
type t
(* flags for FTSENT structure *)
val info : t -> fts_info
(* A path for accessing the file from the current directory. *)
val accpath : t -> string
(* The path for the file relative to the root of the traversal. This path
contains the path specified to fts_open() as a prefix. *)
val path : t -> string
(* The name of the file. *)
val name : t -> string
(* The depth of the traversal, numbered from -1 to N, where this file was
found. The FTSENT structure representing the parent of the starting point
(or root) of the traversal is numbered -1, and the FTSENT structure for
the root itself is numbered 0. *)
val level : t -> int
(* Upon return of a FTSENT structure from the fts_children() or fts_read()
functions, with its fts_info field set to FTS_DNR, FTS_ERR or FTS_NS,
the fts_errno field contains the value of the external variable errno
specifying the cause of the error. Otherwise, the contents of the
fts_errno field are undefined. *)
val errno : t -> int
(* This field is provided for the use of the application program and is
not modified by the fts functions. It is initialized to 0. *)
val number : t -> int
val set_number : t -> int -> unit
(* This field is provided for the use of the application program and is
not modified by the fts functions. It is initialized to NULL. *)
val pointer : t -> unit ptr
val set_pointer : t -> unit ptr -> unit
(* A pointer to the FTSENT structure referencing the file in the hierarchy
immediately above the current file, that is, the directory of which
this file is a member. A parent structure for the initial entry point
is provided as well, however, only the fts_level, fts_number and
fts_pointer fields are guaranteed to be initialized. *)
val parent : t -> t
(* Upon return from the fts_children() function, the fts_link field points
to the next structure in the NULL-terminated linked list of directory
members. Otherwise, the contents of the fts_link field are undefined. *)
val link : t -> t
(* If a directory causes a cycle in the hierarchy (see FTS_DC), either
because of a hard link between two directories, or a symbolic link
pointing to a directory, the fts_cycle field of the structure will
point to the FTSENT structure in the hierarchy that references the same
file as the current FTSENT structure. Otherwise, the contents of the
fts_cycle field are undefined. *)
val cycle : t -> t
(* A pointer to stat(2) information for the file. *)
(* val statp : t -> stat *)
end
module FTS :
sig
type t
val cur : t -> FTSENT.t
val child : t -> FTSENT.t
val array : t -> FTSENT.t list
val dev : t -> PosixTypes.dev_t
val path : t -> string
val rfd : t -> int
end
type fts_open_option =
(* This option causes any symbolic link specified as a root path to be
followed immediately whether or not FTS_LOGICAL is also specified. *)
FTS_COMFOLLOW
(* This option causes the fts routines to return FTSENT structures for the
targets of symbolic links instead of the symbolic links themselves. If
this option is set, the only symbolic links for which FTSENT structures
are returned to the application are those referencing nonexistent
files. Either FTS_LOGICAL or FTS_PHYSICAL must be provided to the
fts_open() function. *)
| FTS_LOGICAL
(* As a performance optimization, the fts functions change directories as
they walk the file hierarchy. This has the side-effect that an
application cannot rely on being in any particular directory during the
traversal. The FTS_NOCHDIR option turns off this optimization, and the
fts functions will not change the current directory. Note that
applications should not themselves change their current directory and
try to access files unless FTS_NOCHDIR is specified and absolute
pathnames were provided as arguments to fts_open(). *)
| FTS_NOCHDIR
(* By default, returned FTSENT structures reference file characteristic
information (the statp field) for each file visited. This option
relaxes that requirement as a performance optimization, allowing the
fts functions to set the fts_info field to FTS_NSOK and leave the
contents of the statp field undefined. *)
| FTS_NOSTAT
(* This option causes the fts routines to return FTSENT structures for
symbolic links themselves instead of the target files they point to. If
this option is set, FTSENT structures for all symbolic links in the
hierarchy are returned to the application. Either FTS_LOGICAL or
FTS_PHYSICAL must be provided to the fts_open() function. *)
| FTS_PHYSICAL
(* By default, unless they are specified as path arguments to fts_open(),
any files named "." or ".." encountered in the file hierarchy are
ignored. This option causes the fts routines to return FTSENT structures
for them. *)
| FTS_SEEDOT
(* This option prevents fts from descending into directories that have a
different device number than the file from which the descent began. *)
| FTS_XDEV
(* The fts_open() function takes a list of strings naming one or more
paths which make up a logical file hierarchy to be traversed.
There are a number of options, at least one of which (either FTS_LOGICAL
or FTS_PHYSICAL) must be specified.
The argument compar() specifies a user-defined function which may be used
to order the traversal of the hierarchy. It takes two pointers to
pointers to FTSENT structures as arguments and should return a negative
value, zero, or a positive value to indicate if the file referenced by
its first argument comes before, in any order with respect to, or after,
the file referenced by its second argument. The fts_accpath, fts_path
and fts_pathlen fields of the FTSENT structures may never be used in this
comparison. If the fts_info field is set to FTS_NS or FTS_NSOK, the
fts_statp field may not either. If the compar() argument is NULL, the
directory traversal order is in the order listed in path_argv for the
root paths, and in the order listed in the directory for everything
else. *)
val fts_open :
path_argv:string list ->
?compar:(FTSENT.t ptr -> FTSENT.t ptr -> int) ->
options:fts_open_option list ->
FTS.t
(* The fts_children() function returns a pointer to an FTSENT structure
describing the first entry in a NULL-terminated linked list of the
files in the directory represented by the FTSENT structure most
recently returned by fts_read(). The list is linked through the
fts_link field of the FTSENT structure, and is ordered by the
user-specified comparison function, if any. Repeated calls to
fts_children() will recreate this linked list.
As a special case, if fts_read() has not yet been called for a hierarchy,
fts_children() will return a pointer to the files in the logical
directory specified to fts_open(), that is, the arguments specified to
fts_open(). Otherwise, if the FTSENT structure most recently returned by
fts_read() is not a directory being visited in preorder, or the directory
does not contain any files, fts_children() returns NULL and sets errno to
zero. If an error occurs, fts_children() returns NULL and sets errno
appropriately.
The FTSENT structures returned by fts_children() may be overwritten after
a call to fts_children(), fts_close() or fts_read() on the same file
hierarchy stream.
The name_only option indicates that only the names of the files are
needed. The contents of all the fields in the returned linked list of
structures are undefined with the exception of the fts_name and
fts_namelen fields.
*)
val fts_children :
ftsp:FTS.t ->
name_only:bool ->
FTSENT.t
(* The fts_read() function returns a pointer to an FTSENT structure
describing a file in the hierarchy. Directories (that are readable and do
not cause cycles) are visited at least twice, once in preorder and once in
postorder. All other files are visited at least once. (Hard links between
directories that do not cause cycles or symbolic links to symbolic links may
cause files to be visited more than once, or directories more than twice.)
The FTSENT structures returned by fts_read() may be overwritten after a
call to fts_close() on the same file hierarchy stream, or, after a call to
fts_read() on the same file hierarchy stream unless they represent a file of
type directory, in which case they will not be overwritten until after a
call to fts_read() after the FTSENT structure has been returned by the
function fts_read() in postorder. *)
val fts_read : FTS.t -> FTSENT.t option
type fts_set_option =
(* Re-visit the file; any file type may be revisited. The next call to
fts_read() will return the referenced file. The fts_stat and
fts_info fields of the structure will be reinitialized at that time,
but no other fields will have been changed. This option is
meaningful only for the most recently returned file from fts_read().
Normal use is for postorder directory visits, where it causes the
directory to be revisited (in both preorder and postorder) as well as
all of its descendants. *)
FTS_AGAIN
(* The referenced file must be a symbolic link. If the referenced file
is the one most recently returned by fts_read(), the next call to
fts_read() returns the file with the fts_info and fts_statp fields
reinitialized to reflect the target of the symbolic link instead of
the symbolic link itself. If the file is one of those most
recently returned by fts_children(), the fts_info and fts_statp
fields of the structure, when returned by fts_read(), will reflect
the target of the symbolic link instead of the symbolic link
itself. In either case, if the target of the symbolic link does
not exist the fields of the returned structure will be unchanged
and the fts_info field will be set to FTS_SLNONE.
If the target of the link is a directory, the preorder return, followed
by the return of all of its descendants, followed by a postorder return,
is done. *)
| FTS_FOLLOW
(* No descendants of this file are visited. The file may be one of
those most recently returned by either fts_children() or
fts_read(). *)
| FTS_SKIP
(* The function fts_set() allows the user application to determine
further processing for the file f of the stream ftsp. *)
val fts_set :
ftsp:FTS.t ->
f:FTSENT.t ->
options:fts_set_option list ->
unit
(* The fts_close() function closes a file hierarchy stream ftsp and
restores the current directory to the directory from which fts_open()
was called to open ftsp. *)
val fts_close : FTS.t -> unit

@ -1,7 +1,7 @@
#!/bin/sh
# install - install a program, script, or datafile
scriptversion=2011-11-20.07; # UTC
scriptversion=2013-12-25.23; # UTC
# This originates from X11R5 (mit/util/scripts/install.sh), which was
# later released in X11R6 (xc/config/util/install.sh) with the
@ -41,19 +41,15 @@ scriptversion=2011-11-20.07; # UTC
# This script is compatible with the BSD install script, but was written
# from scratch.
tab=' '
nl='
'
IFS=" "" $nl"
IFS=" $tab$nl"
# set DOITPROG to echo to test this script
# Set DOITPROG to "echo" to test this script.
# Don't use :- since 4.3BSD and earlier shells don't like it.
doit=${DOITPROG-}
if test -z "$doit"; then
doit_exec=exec
else
doit_exec=$doit
fi
doit_exec=${doit:-exec}
# Put in absolute file names if you don't have them in your path;
# or use environment vars.
@ -68,17 +64,6 @@ mvprog=${MVPROG-mv}
rmprog=${RMPROG-rm}
stripprog=${STRIPPROG-strip}
posix_glob='?'
initialize_posix_glob='
test "$posix_glob" != "?" || {
if (set -f) 2>/dev/null; then
posix_glob=
else
posix_glob=:
fi
}
'
posix_mkdir=
# Desired mode of installed file.
@ -97,7 +82,7 @@ dir_arg=
dst_arg=
copy_on_change=false
no_target_directory=
is_target_a_directory=possibly
usage="\
Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
@ -143,8 +128,7 @@ while test $# -ne 0; do
-m) mode=$2
case $mode in
*' '* | *' '* | *'
'* | *'*'* | *'?'* | *'['*)
*' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*)
echo "$0: invalid mode: $mode" >&2
exit 1;;
esac
@ -155,14 +139,16 @@ while test $# -ne 0; do
-s) stripcmd=$stripprog;;
-t) dst_arg=$2
-t)
is_target_a_directory=always
dst_arg=$2
# Protect names problematic for 'test' and other utilities.
case $dst_arg in
-* | [=\(\)!]) dst_arg=./$dst_arg;;
esac
shift;;
-T) no_target_directory=true;;
-T) is_target_a_directory=never;;
--version) echo "$0 $scriptversion"; exit $?;;
@ -177,6 +163,16 @@ while test $# -ne 0; do
shift
done
# We allow the use of options -d and -T together, by making -d
# take the precedence; this is for compatibility with GNU install.
if test -n "$dir_arg"; then
if test -n "$dst_arg"; then
echo "$0: target directory not allowed when installing a directory." >&2
exit 1
fi
fi
if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
# When -d is used, all remaining arguments are directories to create.
# When -t is used, the destination is already specified.
@ -207,6 +203,15 @@ if test $# -eq 0; then
exit 0
fi
if test -z "$dir_arg"; then
if test $# -gt 1 || test "$is_target_a_directory" = always; then
if test ! -d "$dst_arg"; then
echo "$0: $dst_arg: Is not a directory." >&2
exit 1
fi
fi
fi
if test -z "$dir_arg"; then
do_exit='(exit $ret); exit $ret'
trap "ret=129; $do_exit" 1
@ -269,7 +274,7 @@ do
# If destination is a directory, append the input filename; won't work
# if double slashes aren't ignored.
if test -d "$dst"; then
if test -n "$no_target_directory"; then
if test "$is_target_a_directory" = never; then
echo "$0: $dst_arg: Is a directory" >&2
exit 1
fi
@ -277,33 +282,7 @@ do
dst=$dstdir/`basename "$src"`
dstdir_status=0
else
# Prefer dirname, but fall back on a substitute if dirname fails.
dstdir=`
(dirname "$dst") 2>/dev/null ||
expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$dst" : 'X\(//\)[^/]' \| \
X"$dst" : 'X\(//\)$' \| \
X"$dst" : 'X\(/\)' \| . 2>/dev/null ||
echo X"$dst" |
sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
s//\1/
q
}
/^X\(\/\/\)[^/].*/{
s//\1/
q
}
/^X\(\/\/\)$/{
s//\1/
q
}
/^X\(\/\).*/{
s//\1/
q
}
s/.*/./; q'
`
dstdir=`dirname "$dst"`
test -d "$dstdir"
dstdir_status=$?
fi
@ -396,14 +375,12 @@ do
*) prefix='';;
esac
eval "$initialize_posix_glob"
oIFS=$IFS
IFS=/
$posix_glob set -f
set -f
set fnord $dstdir
shift
$posix_glob set +f
set +f
IFS=$oIFS
prefixes=
@ -474,13 +451,10 @@ do
if $copy_on_change &&
old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` &&
new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` &&
eval "$initialize_posix_glob" &&
$posix_glob set -f &&
set -f &&
set X $old && old=:$2:$4:$5:$6 &&
set X $new && new=:$2:$4:$5:$6 &&
$posix_glob set +f &&
set +f &&
test "$old" = "$new" &&
$cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
then

@ -29,6 +29,8 @@ depends: [
"atdgen" {>="1.6.0"}
"core" {>="113.33.03"}
"conf-autoconf"
"ctypes" {>="0.9.2"}
"ctypes-foreign" {>="0.4.0"}
"extlib-compat" {>="1.5.4"}
"javalib" {>="2.3.3"}
"ocamlfind" {build}

@ -13,6 +13,8 @@
"dependencies": {
"@opam-alpha/ocamlfind": "*",
"@opam-alpha/core": "113.33.3",
"@opam-alpha/ctypes": "0.9.2",
"@opam-alpha/ctypes-foreign": "0.4.0",
"@opam-alpha/ocaml": "4.2.3",
"@opam-alpha/sawja": "^ 1.5.2",
"@opam-alpha/atdgen": "^ 1.10.0",

@ -2,6 +2,8 @@
#use "topfind";;
#thread;;
#require "core";;
#require "ctypes";;
#require "ctypes.foreign";;
#require "sawja";;
#require "atdgen";;
#require "extlib";;

@ -84,6 +84,12 @@
dependencies:
conf-ncurses-actual "git://github.com/npm-opam/conf-ncurses.git#1.0.0"
"@opam-alpha/conf-pkg-config@*":
version "1.0.0"
resolved conf-pkg-config-1.0.0.tgz#938404a87215fdea094d5b16ccc44715c4dbac28
dependencies:
conf-pkg-config-actual "git://github.com/npm-opam/conf-pkg-config.git#1.0.0"
"@opam-alpha/conf-which@*":
version "1.0.0"
resolved conf-which-1.0.0.tgz#45b4dc34e3c256b8027fc47d672eca0d1c25f541
@ -108,6 +114,18 @@
dependencies:
cppo-actual "git://github.com/npm-opam/cppo.git#1.4.0"
"@opam-alpha/ctypes-foreign@*", "@opam-alpha/ctypes-foreign@0.4.0":
version "0.4.0"
resolved ctypes-foreign-0.4.0.tgz#deb81969266b6436ca6b84699541a3e28b909ad1
dependencies:
ctypes-foreign-actual "git://github.com/npm-opam/ctypes-foreign.git#0.4.0"
"@opam-alpha/ctypes@0.9.2":
version "0.9.2"
resolved ctypes-0.9.2.tgz#b3eac49546bbd7e263643014a1f4993a4352cfee
dependencies:
ctypes-actual "git://github.com/npm-opam/ctypes.git#0.9.2"
"@opam-alpha/easy-format@*", "@opam-alpha/easy-format@^ 1.2.0":
version "1.2.0"
resolved easy-format-1.2.0.tgz#08d53c49a8227ae7d0dec0aa0f236d8fc913cd6b
@ -568,6 +586,16 @@
opam-installer-bin "https://github.com/yunxing/opam-installer-bin.git"
substs "https://github.com/yunxing/substs.git"
"conf-pkg-config-actual@git://github.com/npm-opam/conf-pkg-config.git#1.0.0":
version "1.0.0"
resolved conf-pkg-config.git-b1306dce3be035308f7d8aabf8d579921e0ff821#11761f7a13f854172308800e9b110d6d4415814f
dependencies:
dependency-env "https://github.com/npm-ml/dependency-env.git"
nopam "https://github.com/yunxing/nopam.git"
opam-installer-bin "https://github.com/yunxing/opam-installer-bin.git"
substs "https://github.com/yunxing/substs.git"
yarn-pkg-config "*"
"conf-which-actual@git://github.com/npm-opam/conf-which.git#1.0.0":
version "1.0.0"
resolved conf-which.git-fdb919d8ed608aa090d0b95bbde5f3717192c068#03ef24339d749f817c328e42b8a992f92322d543
@ -636,7 +664,31 @@
opam-installer-bin "https://github.com/yunxing/opam-installer-bin.git"
substs "https://github.com/yunxing/substs.git"
"dependency-env@git+https://github.com/reasonml/dependency-env.git", "dependency-env@https://github.com/npm-ml/dependency-env.git", "dependencyEnv@git+https://github.com/reasonml/dependency-env.git":
"ctypes-actual@git://github.com/npm-opam/ctypes.git#0.9.2":
version "0.9.2"
resolved ctypes.git-c926f6199de1b5989189fb620f26cbd7892fe4f4#1d5be5cd1e2fe987d4431ee165115c15a81d78d0
dependencies:
"@opam-alpha/conf-pkg-config" "*"
"@opam-alpha/ctypes-foreign" "*"
"@opam-alpha/lwt" "*"
"@opam-alpha/ocamlfind" "*"
"@opam-alpha/ounit" "*"
dependency-env "https://github.com/npm-ml/dependency-env.git"
nopam "https://github.com/yunxing/nopam.git"
opam-installer-bin "https://github.com/yunxing/opam-installer-bin.git"
substs "https://github.com/yunxing/substs.git"
"ctypes-foreign-actual@git://github.com/npm-opam/ctypes-foreign.git#0.4.0":
version "0.4.0"
resolved ctypes-foreign.git-8f223221a7309520a5679f472eecd950b4647e11#591be30c209cf0f440d24b7262e88bbf559d1e6f
dependencies:
dependency-env "https://github.com/npm-ml/dependency-env.git"
libffi "*"
nopam "https://github.com/yunxing/nopam.git"
opam-installer-bin "https://github.com/yunxing/opam-installer-bin.git"
substs "https://github.com/yunxing/substs.git"
"dependency-env@git+https://github.com/npm-ml/dependency-env.git", "dependency-env@git+https://github.com/reasonml/dependency-env.git", "dependency-env@https://github.com/npm-ml/dependency-env.git", "dependencyEnv@git+https://github.com/reasonml/dependency-env.git":
version "0.0.0"
resolved dependency-env.git-20ccabcf9f4854fdcda3f965ce410487515d7dc7#fb1a38d19682e7f754e6154d276ce6fdfbade9f7
dependencies:
@ -713,6 +765,13 @@
opam-installer-bin "https://github.com/yunxing/opam-installer-bin.git"
substs "https://github.com/yunxing/substs.git"
libffi@*:
version "3.2.11"
resolved libffi-3.2.11.tgz#4d1d94dacae6c511c434ea50cc5d62ddcc97461e
dependencies:
dependency-env "https://github.com/npm-ml/dependency-env.git"
nopam "https://github.com/yunxing/nopam.git"
"lwt-actual@git://github.com/npm-opam/lwt.git#2.5.2":
version "2.5.2"
resolved lwt.git-6c677df6c9d6f34d6fc2d28680bbab7e95da23e4#a7c043ebfd0ae650a259191c60c583714cfa8ea2
@ -763,7 +822,7 @@
opam-installer-bin "https://github.com/yunxing/opam-installer-bin.git"
substs "https://github.com/yunxing/substs.git"
"nopam@git+https://github.com/reasonml/nopam.git", "nopam@https://github.com/yunxing/nopam.git":
"nopam@git+https://github.com/reasonml/nopam.git", "nopam@git+https://github.com/yunxing/nopam.git", "nopam@https://github.com/yunxing/nopam.git":
version "0.0.1"
resolved nopam.git-8584695c8e2615857d4f58a0dec7bae3a9059a54#49cd1b4ccc32d588cdd3a671d4cc6d773803396b
@ -1372,6 +1431,13 @@ resolve@^1.1.7:
opam-installer-bin "https://github.com/yunxing/opam-installer-bin.git"
substs "https://github.com/yunxing/substs.git"
yarn-pkg-config@*:
version "0.29.3"
resolved yarn-pkg-config-0.29.3.tgz#d71f04aabc743be557d5f2fa80e9e13049723107
dependencies:
dependency-env "https://github.com/npm-ml/dependency-env.git"
nopam "https://github.com/yunxing/nopam.git"
"yojson-actual@git://github.com/npm-opam/yojson.git#1.3.2":
version "1.3.2"
resolved yojson.git-dd81adbf47ff9d54f7614716c26bc97dffb7bcb1#6e4b7241179fbb7512bf15a82bd2731f195db48b

Loading…
Cancel
Save