pkgsrc-Changes archive
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index][Old Index]
CVS commit: pkgsrc/devel/ocamlmod
Module Name: pkgsrc
Committed By: jaapb
Date: Wed Jan 10 16:19:01 UTC 2018
Modified Files:
pkgsrc/devel/ocamlmod: Makefile buildlink3.mk distinfo
Added Files:
pkgsrc/devel/ocamlmod/patches: patch-__tags patch-myocamlbuild.ml
patch-setup.ml
Log Message:
Revision bump for package devel/ocamlmod.
No upstream changes, but the OASIS setup.ml file had to be regenerated
due to it no longer working with OCaml 4.06.
To generate a diff of this commit:
cvs rdiff -u -r1.9 -r1.10 pkgsrc/devel/ocamlmod/Makefile
cvs rdiff -u -r1.4 -r1.5 pkgsrc/devel/ocamlmod/buildlink3.mk
cvs rdiff -u -r1.3 -r1.4 pkgsrc/devel/ocamlmod/distinfo
cvs rdiff -u -r0 -r1.1 pkgsrc/devel/ocamlmod/patches/patch-__tags \
pkgsrc/devel/ocamlmod/patches/patch-myocamlbuild.ml \
pkgsrc/devel/ocamlmod/patches/patch-setup.ml
Please note that diffs are not public domain; they are subject to the
copyright notices on the relevant files.
Modified files:
Index: pkgsrc/devel/ocamlmod/Makefile
diff -u pkgsrc/devel/ocamlmod/Makefile:1.9 pkgsrc/devel/ocamlmod/Makefile:1.10
--- pkgsrc/devel/ocamlmod/Makefile:1.9 Fri Sep 8 09:51:23 2017
+++ pkgsrc/devel/ocamlmod/Makefile Wed Jan 10 16:19:00 2018
@@ -1,7 +1,7 @@
-# $NetBSD: Makefile,v 1.9 2017/09/08 09:51:23 jaapb Exp $
+# $NetBSD: Makefile,v 1.10 2018/01/10 16:19:00 jaapb Exp $
DISTNAME= ocamlmod-0.0.8
-PKGREVISION= 1
+PKGREVISION= 2
CATEGORIES= devel
MASTER_SITES= http://forge.ocamlcore.org/frs/download.php/1544/
Index: pkgsrc/devel/ocamlmod/buildlink3.mk
diff -u pkgsrc/devel/ocamlmod/buildlink3.mk:1.4 pkgsrc/devel/ocamlmod/buildlink3.mk:1.5
--- pkgsrc/devel/ocamlmod/buildlink3.mk:1.4 Sun Jan 7 13:04:09 2018
+++ pkgsrc/devel/ocamlmod/buildlink3.mk Wed Jan 10 16:19:00 2018
@@ -1,4 +1,4 @@
-# $NetBSD: buildlink3.mk,v 1.4 2018/01/07 13:04:09 rillig Exp $
+# $NetBSD: buildlink3.mk,v 1.5 2018/01/10 16:19:00 jaapb Exp $
BUILDLINK_TREE+= ocamlmod
@@ -6,8 +6,8 @@ BUILDLINK_TREE+= ocamlmod
OCAMLMOD_BUILDLINK3_MK:=
BUILDLINK_API_DEPENDS.ocamlmod+= ocamlmod>=0.0.7nb1
-BUILDLINK_ABI_DEPENDS.ocamlmod+= ocamlmod>=0.0.8
-BUILDLINK_PKGSRCDIR.ocamlmod?= ../../devel/ocamlmod
+BUILDLINK_ABI_DEPENDS.ocamlmod+= ocamlmod>=0.0.8nb2
+BUILDLINK_PKGSRCDIR.ocamlmod?= ../../devel/ocamlmod
.endif # OCAMLMOD_BUILDLINK3_MK
BUILDLINK_TREE+= -ocamlmod
Index: pkgsrc/devel/ocamlmod/distinfo
diff -u pkgsrc/devel/ocamlmod/distinfo:1.3 pkgsrc/devel/ocamlmod/distinfo:1.4
--- pkgsrc/devel/ocamlmod/distinfo:1.3 Tue Jul 11 14:11:14 2017
+++ pkgsrc/devel/ocamlmod/distinfo Wed Jan 10 16:19:00 2018
@@ -1,6 +1,9 @@
-$NetBSD: distinfo,v 1.3 2017/07/11 14:11:14 jaapb Exp $
+$NetBSD: distinfo,v 1.4 2018/01/10 16:19:00 jaapb Exp $
SHA1 (ocamlmod-0.0.8.tar.gz) = 5c3d20f493ab9ae6d6f498f73fbe7a7135dbdc83
RMD160 (ocamlmod-0.0.8.tar.gz) = 0ac0def38a0e271e3759e2c6b41d47cff9a95db4
SHA512 (ocamlmod-0.0.8.tar.gz) = beb64c109c241965f33a60b4868f5215e6c112742a3be214d3b7a0503b9d29494c0453fa5f2551bbc1975cd4b123d0b917116aeeba968d2a7d2c6fb9651a64f4
Size (ocamlmod-0.0.8.tar.gz) = 48985 bytes
+SHA1 (patch-__tags) = a92d60485688357270ee6fe562bd63d4c46f003d
+SHA1 (patch-myocamlbuild.ml) = 8dd1340cf9cc40f9478d24063285b5a2c534a6f2
+SHA1 (patch-setup.ml) = 9f28eaaddc123b5bc649eb7820cfe80fefc1447e
Added files:
Index: pkgsrc/devel/ocamlmod/patches/patch-__tags
diff -u /dev/null pkgsrc/devel/ocamlmod/patches/patch-__tags:1.1
--- /dev/null Wed Jan 10 16:19:01 2018
+++ pkgsrc/devel/ocamlmod/patches/patch-__tags Wed Jan 10 16:19:01 2018
@@ -0,0 +1,30 @@
+$NetBSD: patch-__tags,v 1.1 2018/01/10 16:19:01 jaapb Exp $
+
+Regenerated Oasis files (don't compile with 4.06)
+--- _tags.orig 2015-09-02 21:53:11.000000000 +0000
++++ _tags
+@@ -1,8 +1,9 @@
+ # OASIS_START
+-# DO NOT EDIT (digest: 624081c4aa54babe89f7a49402b5f68d)
++# DO NOT EDIT (digest: 7bfc612a7f85fad7a10e2cc4e4d0a0cc)
+ # Ignore VCS directories, you can use the same kind of rule outside
+ # OASIS_START/STOP if you want to exclude directories that contains
+ # useless stuff for the build process
++true: annot, bin_annot
+ <**/.svn>: -traverse
+ <**/.svn>: not_hygienic
+ ".bzr": -traverse
+@@ -15,10 +16,10 @@
+ "_darcs": not_hygienic
+ # Executable ocamlmod
+ "src/ocamlmod.byte": pkg_str
+-<src/*.ml{,i}>: pkg_str
++<src/*.ml{,i,y}>: pkg_str
+ # Executable test
+ "test/test.byte": pkg_oUnit
+ "test/test.byte": pkg_str
+-<test/*.ml{,i}>: pkg_oUnit
+-<test/*.ml{,i}>: pkg_str
++<test/*.ml{,i,y}>: pkg_oUnit
++<test/*.ml{,i,y}>: pkg_str
+ # OASIS_STOP
Index: pkgsrc/devel/ocamlmod/patches/patch-myocamlbuild.ml
diff -u /dev/null pkgsrc/devel/ocamlmod/patches/patch-myocamlbuild.ml:1.1
--- /dev/null Wed Jan 10 16:19:01 2018
+++ pkgsrc/devel/ocamlmod/patches/patch-myocamlbuild.ml Wed Jan 10 16:19:01 2018
@@ -0,0 +1,915 @@
+$NetBSD: patch-myocamlbuild.ml,v 1.1 2018/01/10 16:19:01 jaapb Exp $
+
+Regenerated Oasis files (don't compile with 4.06)
+--- myocamlbuild.ml.orig 2015-09-02 21:53:11.000000000 +0000
++++ myocamlbuild.ml
+@@ -1,19 +1,12 @@
+ (* OASIS_START *)
+-(* DO NOT EDIT (digest: 5a9a2168dcb86db37476d58b8c0e25b3) *)
++(* DO NOT EDIT (digest: 9bd78b75e5e0b109a1abb54bf043b292) *)
+ module OASISGettext = struct
+ (* # 22 "src/oasis/OASISGettext.ml" *)
+
+
+- let ns_ str =
+- str
+-
+-
+- let s_ str =
+- str
+-
+-
+- let f_ (str: ('a, 'b, 'c, 'd) format4) =
+- str
++ let ns_ str = str
++ let s_ str = str
++ let f_ (str: ('a, 'b, 'c, 'd) format4) = str
+
+
+ let fn_ fmt1 fmt2 n =
+@@ -23,25 +16,338 @@ module OASISGettext = struct
+ fmt2^^""
+
+
+- let init =
+- []
++ let init = []
++end
+
++module OASISString = struct
++(* # 22 "src/oasis/OASISString.ml" *)
+
+-end
+
+-module OASISExpr = struct
+-(* # 22 "src/oasis/OASISExpr.ml" *)
++ (** Various string utilities.
+
++ Mostly inspired by extlib and batteries ExtString and BatString libraries.
+
++ @author Sylvain Le Gall
++ *)
+
+
++ let nsplitf str f =
++ if str = "" then
++ []
++ else
++ let buf = Buffer.create 13 in
++ let lst = ref [] in
++ let push () =
++ lst := Buffer.contents buf :: !lst;
++ Buffer.clear buf
++ in
++ let str_len = String.length str in
++ for i = 0 to str_len - 1 do
++ if f str.[i] then
++ push ()
++ else
++ Buffer.add_char buf str.[i]
++ done;
++ push ();
++ List.rev !lst
++
++
++ (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
++ separator.
++ *)
++ let nsplit str c =
++ nsplitf str ((=) c)
++
++
++ let find ~what ?(offset=0) str =
++ let what_idx = ref 0 in
++ let str_idx = ref offset in
++ while !str_idx < String.length str &&
++ !what_idx < String.length what do
++ if str.[!str_idx] = what.[!what_idx] then
++ incr what_idx
++ else
++ what_idx := 0;
++ incr str_idx
++ done;
++ if !what_idx <> String.length what then
++ raise Not_found
++ else
++ !str_idx - !what_idx
++
++
++ let sub_start str len =
++ let str_len = String.length str in
++ if len >= str_len then
++ ""
++ else
++ String.sub str len (str_len - len)
++
++
++ let sub_end ?(offset=0) str len =
++ let str_len = String.length str in
++ if len >= str_len then
++ ""
++ else
++ String.sub str 0 (str_len - len)
++
++
++ let starts_with ~what ?(offset=0) str =
++ let what_idx = ref 0 in
++ let str_idx = ref offset in
++ let ok = ref true in
++ while !ok &&
++ !str_idx < String.length str &&
++ !what_idx < String.length what do
++ if str.[!str_idx] = what.[!what_idx] then
++ incr what_idx
++ else
++ ok := false;
++ incr str_idx
++ done;
++ !what_idx = String.length what
++
++
++ let strip_starts_with ~what str =
++ if starts_with ~what str then
++ sub_start str (String.length what)
++ else
++ raise Not_found
++
++
++ let ends_with ~what ?(offset=0) str =
++ let what_idx = ref ((String.length what) - 1) in
++ let str_idx = ref ((String.length str) - 1) in
++ let ok = ref true in
++ while !ok &&
++ offset <= !str_idx &&
++ 0 <= !what_idx do
++ if str.[!str_idx] = what.[!what_idx] then
++ decr what_idx
++ else
++ ok := false;
++ decr str_idx
++ done;
++ !what_idx = -1
++
++
++ let strip_ends_with ~what str =
++ if ends_with ~what str then
++ sub_end str (String.length what)
++ else
++ raise Not_found
++
++
++ let replace_chars f s =
++ let buf = Buffer.create (String.length s) in
++ String.iter (fun c -> Buffer.add_char buf (f c)) s;
++ Buffer.contents buf
++
++ let lowercase_ascii =
++ replace_chars
++ (fun c ->
++ if (c >= 'A' && c <= 'Z') then
++ Char.chr (Char.code c + 32)
++ else
++ c)
++
++ let uncapitalize_ascii s =
++ if s <> "" then
++ (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
++ else
++ s
++
++ let uppercase_ascii =
++ replace_chars
++ (fun c ->
++ if (c >= 'a' && c <= 'z') then
++ Char.chr (Char.code c - 32)
++ else
++ c)
++
++ let capitalize_ascii s =
++ if s <> "" then
++ (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
++ else
++ s
++
++end
++
++module OASISUtils = struct
++(* # 22 "src/oasis/OASISUtils.ml" *)
++
+
+ open OASISGettext
+
+
+- type test = string
++ module MapExt =
++ struct
++ module type S =
++ sig
++ include Map.S
++ val add_list: 'a t -> (key * 'a) list -> 'a t
++ val of_list: (key * 'a) list -> 'a t
++ val to_list: 'a t -> (key * 'a) list
++ end
+
++ module Make (Ord: Map.OrderedType) =
++ struct
++ include Map.Make(Ord)
+
++ let rec add_list t =
++ function
++ | (k, v) :: tl -> add_list (add k v t) tl
++ | [] -> t
++
++ let of_list lst = add_list empty lst
++
++ let to_list t = fold (fun k v acc -> (k, v) :: acc) t []
++ end
++ end
++
++
++ module MapString = MapExt.Make(String)
++
++
++ module SetExt =
++ struct
++ module type S =
++ sig
++ include Set.S
++ val add_list: t -> elt list -> t
++ val of_list: elt list -> t
++ val to_list: t -> elt list
++ end
++
++ module Make (Ord: Set.OrderedType) =
++ struct
++ include Set.Make(Ord)
++
++ let rec add_list t =
++ function
++ | e :: tl -> add_list (add e t) tl
++ | [] -> t
++
++ let of_list lst = add_list empty lst
++
++ let to_list = elements
++ end
++ end
++
++
++ module SetString = SetExt.Make(String)
++
++
++ let compare_csl s1 s2 =
++ String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)
++
++
++ module HashStringCsl =
++ Hashtbl.Make
++ (struct
++ type t = string
++ let equal s1 s2 = (compare_csl s1 s2) = 0
++ let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)
++ end)
++
++ module SetStringCsl =
++ SetExt.Make
++ (struct
++ type t = string
++ let compare = compare_csl
++ end)
++
++
++ let varname_of_string ?(hyphen='_') s =
++ if String.length s = 0 then
++ begin
++ invalid_arg "varname_of_string"
++ end
++ else
++ begin
++ let buf =
++ OASISString.replace_chars
++ (fun c ->
++ if ('a' <= c && c <= 'z')
++ ||
++ ('A' <= c && c <= 'Z')
++ ||
++ ('0' <= c && c <= '9') then
++ c
++ else
++ hyphen)
++ s;
++ in
++ let buf =
++ (* Start with a _ if digit *)
++ if '0' <= s.[0] && s.[0] <= '9' then
++ "_"^buf
++ else
++ buf
++ in
++ OASISString.lowercase_ascii buf
++ end
++
++
++ let varname_concat ?(hyphen='_') p s =
++ let what = String.make 1 hyphen in
++ let p =
++ try
++ OASISString.strip_ends_with ~what p
++ with Not_found ->
++ p
++ in
++ let s =
++ try
++ OASISString.strip_starts_with ~what s
++ with Not_found ->
++ s
++ in
++ p^what^s
++
++
++ let is_varname str =
++ str = varname_of_string str
++
++
++ let failwithf fmt = Printf.ksprintf failwith fmt
++
++
++ let rec file_location ?pos1 ?pos2 ?lexbuf () =
++ match pos1, pos2, lexbuf with
++ | Some p, None, _ | None, Some p, _ ->
++ file_location ~pos1:p ~pos2:p ?lexbuf ()
++ | Some p1, Some p2, _ ->
++ let open Lexing in
++ let fn, lineno = p1.pos_fname, p1.pos_lnum in
++ let c1 = p1.pos_cnum - p1.pos_bol in
++ let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in
++ Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2
++ | _, _, Some lexbuf ->
++ file_location
++ ~pos1:(Lexing.lexeme_start_p lexbuf)
++ ~pos2:(Lexing.lexeme_end_p lexbuf)
++ ()
++ | None, None, None ->
++ s_ "<position undefined>"
++
++
++ let failwithpf ?pos1 ?pos2 ?lexbuf fmt =
++ let loc = file_location ?pos1 ?pos2 ?lexbuf () in
++ Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt
++
++
++end
++
++module OASISExpr = struct
++(* # 22 "src/oasis/OASISExpr.ml" *)
++
++
++ open OASISGettext
++ open OASISUtils
++
++
++ type test = string
+ type flag = string
+
+
+@@ -54,7 +360,6 @@ module OASISExpr = struct
+ | ETest of test * string
+
+
+-
+ type 'a choices = (t * 'a) list
+
+
+@@ -129,7 +434,7 @@ module OASISExpr = struct
+ end
+
+
+-# 132 "myocamlbuild.ml"
++# 437 "myocamlbuild.ml"
+ module BaseEnvLight = struct
+ (* # 22 "src/base/BaseEnvLight.ml" *)
+
+@@ -140,129 +445,103 @@ module BaseEnvLight = struct
+ type t = string MapString.t
+
+
+- let default_filename =
+- Filename.concat
+- (Sys.getcwd ())
+- "setup.data"
++ let default_filename = Filename.concat (Sys.getcwd ()) "setup.data"
+
+
+- let load ?(allow_empty=false) ?(filename=default_filename) () =
+- if Sys.file_exists filename then
+- begin
+- let chn =
+- open_in_bin filename
+- in
+- let st =
+- Stream.of_channel chn
+- in
+- let line =
+- ref 1
+- in
+- let st_line =
+- Stream.from
+- (fun _ ->
+- try
+- match Stream.next st with
+- | '\n' -> incr line; Some '\n'
+- | c -> Some c
+- with Stream.Failure -> None)
+- in
+- let lexer =
+- Genlex.make_lexer ["="] st_line
+- in
+- let rec read_file mp =
+- match Stream.npeek 3 lexer with
+- | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
+- Stream.junk lexer;
+- Stream.junk lexer;
+- Stream.junk lexer;
+- read_file (MapString.add nm value mp)
+- | [] ->
+- mp
+- | _ ->
+- failwith
+- (Printf.sprintf
+- "Malformed data file '%s' line %d"
+- filename !line)
+- in
+- let mp =
+- read_file MapString.empty
+- in
+- close_in chn;
+- mp
+- end
+- else if allow_empty then
+- begin
++ let load ?(allow_empty=false) ?(filename=default_filename) ?stream () =
++ let line = ref 1 in
++ let lexer st =
++ let st_line =
++ Stream.from
++ (fun _ ->
++ try
++ match Stream.next st with
++ | '\n' -> incr line; Some '\n'
++ | c -> Some c
++ with Stream.Failure -> None)
++ in
++ Genlex.make_lexer ["="] st_line
++ in
++ let rec read_file lxr mp =
++ match Stream.npeek 3 lxr with
++ | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
++ Stream.junk lxr; Stream.junk lxr; Stream.junk lxr;
++ read_file lxr (MapString.add nm value mp)
++ | [] -> mp
++ | _ ->
++ failwith
++ (Printf.sprintf "Malformed data file '%s' line %d" filename !line)
++ in
++ match stream with
++ | Some st -> read_file (lexer st) MapString.empty
++ | None ->
++ if Sys.file_exists filename then begin
++ let chn = open_in_bin filename in
++ let st = Stream.of_channel chn in
++ try
++ let mp = read_file (lexer st) MapString.empty in
++ close_in chn; mp
++ with e ->
++ close_in chn; raise e
++ end else if allow_empty then begin
+ MapString.empty
+- end
+- else
+- begin
++ end else begin
+ failwith
+ (Printf.sprintf
+ "Unable to load environment, the file '%s' doesn't exist."
+ filename)
+ end
+
+-
+ let rec var_expand str env =
+- let buff =
+- Buffer.create ((String.length str) * 2)
+- in
+- Buffer.add_substitute
+- buff
+- (fun var ->
+- try
+- var_expand (MapString.find var env) env
+- with Not_found ->
+- failwith
+- (Printf.sprintf
+- "No variable %s defined when trying to expand %S."
+- var
+- str))
+- str;
+- Buffer.contents buff
+-
+-
+- let var_get name env =
+- var_expand (MapString.find name env) env
+-
+-
+- let var_choose lst env =
+- OASISExpr.choose
+- (fun nm -> var_get nm env)
+- lst
++ let buff = Buffer.create ((String.length str) * 2) in
++ Buffer.add_substitute
++ buff
++ (fun var ->
++ try
++ var_expand (MapString.find var env) env
++ with Not_found ->
++ failwith
++ (Printf.sprintf
++ "No variable %s defined when trying to expand %S."
++ var
++ str))
++ str;
++ Buffer.contents buff
++
++
++ let var_get name env = var_expand (MapString.find name env) env
++ let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst
+ end
+
+
+-# 237 "myocamlbuild.ml"
++# 517 "myocamlbuild.ml"
+ module MyOCamlbuildFindlib = struct
+ (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
+
+
+ (** OCamlbuild extension, copied from
+- * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
++ * https://ocaml.org/learn/tutorials/ocamlbuild/Using_ocamlfind_with_ocamlbuild.html
+ * by N. Pouillard and others
+ *
+- * Updated on 2009/02/28
++ * Updated on 2016-06-02
+ *
+ * Modified by Sylvain Le Gall
+- *)
++ *)
+ open Ocamlbuild_plugin
+
+
+- (* these functions are not really officially exported *)
+- let run_and_read =
+- Ocamlbuild_pack.My_unix.run_and_read
++ type conf = {no_automatic_syntax: bool}
++
+
++ let run_and_read = Ocamlbuild_pack.My_unix.run_and_read
+
+- let blank_sep_strings =
+- Ocamlbuild_pack.Lexers.blank_sep_strings
++
++ let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings
+
+
+ let exec_from_conf exec =
+ let exec =
+- let env_filename = Pathname.basename BaseEnvLight.default_filename in
+- let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in
++ let env = BaseEnvLight.load ~allow_empty:true () in
+ try
+ BaseEnvLight.var_get exec env
+ with Not_found ->
+@@ -273,7 +552,7 @@ module MyOCamlbuildFindlib = struct
+ if Sys.os_type = "Win32" then begin
+ let buff = Buffer.create (String.length str) in
+ (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'.
+- *)
++ *)
+ String.iter
+ (fun c -> Buffer.add_char buff (if c = '\\' then '/' else c))
+ str;
+@@ -282,7 +561,8 @@ module MyOCamlbuildFindlib = struct
+ str
+ end
+ in
+- fix_win32 exec
++ fix_win32 exec
++
+
+ let split s ch =
+ let buf = Buffer.create 13 in
+@@ -291,15 +571,15 @@ module MyOCamlbuildFindlib = struct
+ x := (Buffer.contents buf) :: !x;
+ Buffer.clear buf
+ in
+- String.iter
+- (fun c ->
+- if c = ch then
+- flush ()
+- else
+- Buffer.add_char buf c)
+- s;
+- flush ();
+- List.rev !x
++ String.iter
++ (fun c ->
++ if c = ch then
++ flush ()
++ else
++ Buffer.add_char buf c)
++ s;
++ flush ();
++ List.rev !x
+
+
+ let split_nl s = split s '\n'
+@@ -315,7 +595,7 @@ module MyOCamlbuildFindlib = struct
+
+ (* This lists all supported packages. *)
+ let find_packages () =
+- List.map before_space (split_nl & run_and_read "ocamlfind list")
++ List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list"))
+
+
+ (* Mock to list available syntaxes. *)
+@@ -338,80 +618,92 @@ module MyOCamlbuildFindlib = struct
+ ]
+
+
+- let dispatch =
++ let dispatch conf =
+ function
+ | After_options ->
+- (* By using Before_options one let command line options have an higher
+- * priority on the contrary using After_options will guarantee to have
+- * the higher priority override default commands by ocamlfind ones *)
+- Options.ocamlc := ocamlfind & A"ocamlc";
+- Options.ocamlopt := ocamlfind & A"ocamlopt";
+- Options.ocamldep := ocamlfind & A"ocamldep";
+- Options.ocamldoc := ocamlfind & A"ocamldoc";
+- Options.ocamlmktop := ocamlfind & A"ocamlmktop";
+- Options.ocamlmklib := ocamlfind & A"ocamlmklib"
++ (* By using Before_options one let command line options have an higher
++ * priority on the contrary using After_options will guarantee to have
++ * the higher priority override default commands by ocamlfind ones *)
++ Options.ocamlc := ocamlfind & A"ocamlc";
++ Options.ocamlopt := ocamlfind & A"ocamlopt";
++ Options.ocamldep := ocamlfind & A"ocamldep";
++ Options.ocamldoc := ocamlfind & A"ocamldoc";
++ Options.ocamlmktop := ocamlfind & A"ocamlmktop";
++ Options.ocamlmklib := ocamlfind & A"ocamlmklib"
+
+ | After_rules ->
+
+- (* When one link an OCaml library/binary/package, one should use
+- * -linkpkg *)
+- flag ["ocaml"; "link"; "program"] & A"-linkpkg";
+-
+- (* For each ocamlfind package one inject the -package option when
+- * compiling, computing dependencies, generating documentation and
+- * linking. *)
+- List.iter
+- begin fun pkg ->
+- let base_args = [A"-package"; A pkg] in
+- (* TODO: consider how to really choose camlp4o or camlp4r. *)
+- let syn_args = [A"-syntax"; A "camlp4o"] in
+- let args =
++ (* Avoid warnings for unused tag *)
++ flag ["tests"] N;
++
++ (* When one link an OCaml library/binary/package, one should use
++ * -linkpkg *)
++ flag ["ocaml"; "link"; "program"] & A"-linkpkg";
++
++ (* For each ocamlfind package one inject the -package option when
++ * compiling, computing dependencies, generating documentation and
++ * linking. *)
++ List.iter
++ begin fun pkg ->
++ let base_args = [A"-package"; A pkg] in
++ (* TODO: consider how to really choose camlp4o or camlp4r. *)
++ let syn_args = [A"-syntax"; A "camlp4o"] in
++ let (args, pargs) =
+ (* Heuristic to identify syntax extensions: whether they end in
+ ".syntax"; some might not.
+- *)
+- if Filename.check_suffix pkg "syntax" ||
+- List.mem pkg well_known_syntax then
+- syn_args @ base_args
+- else
+- base_args
+- in
+- flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
+- flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
+- flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
+- flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
+- flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
+- end
+- (find_packages ());
+-
+- (* Like -package but for extensions syntax. Morover -syntax is useless
+- * when linking. *)
+- List.iter begin fun syntax ->
++ *)
++ if not (conf.no_automatic_syntax) &&
++ (Filename.check_suffix pkg "syntax" ||
++ List.mem pkg well_known_syntax) then
++ (syn_args @ base_args, syn_args)
++ else
++ (base_args, [])
++ in
++ flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
++ flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
++ flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
++ flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
++ flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
++
++ (* TODO: Check if this is allowed for OCaml < 3.12.1 *)
++ flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs;
++ flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs;
++ flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs;
++ flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs;
++ end
++ (find_packages ());
++
++ (* Like -package but for extensions syntax. Morover -syntax is useless
++ * when linking. *)
++ List.iter begin fun syntax ->
+ flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
+ flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
+ flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
+ flag ["ocaml"; "infer_interface"; "syntax_"^syntax] &
+- S[A"-syntax"; A syntax];
+- end (find_syntaxes ());
++ S[A"-syntax"; A syntax];
++ end (find_syntaxes ());
+
+- (* The default "thread" tag is not compatible with ocamlfind.
+- * Indeed, the default rules add the "threads.cma" or "threads.cmxa"
+- * options when using this tag. When using the "-linkpkg" option with
+- * ocamlfind, this module will then be added twice on the command line.
+- *
+- * To solve this, one approach is to add the "-thread" option when using
+- * the "threads" package using the previous plugin.
+- *)
+- flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
+- flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
+- flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
+- flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
+- flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
+- flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
+- flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
+- flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
++ (* The default "thread" tag is not compatible with ocamlfind.
++ * Indeed, the default rules add the "threads.cma" or "threads.cmxa"
++ * options when using this tag. When using the "-linkpkg" option with
++ * ocamlfind, this module will then be added twice on the command line.
++ *
++ * To solve this, one approach is to add the "-thread" option when using
++ * the "threads" package using the previous plugin.
++ *)
++ flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
++ flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
++ flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
++ flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
++ flag ["c"; "pkg_threads"; "compile"] (S[A "-thread"]);
++ flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
++ flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
++ flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
++ flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
++ flag ["c"; "package(threads)"; "compile"] (S[A "-thread"]);
+
+ | _ ->
+- ()
++ ()
+ end
+
+ module MyOCamlbuildBase = struct
+@@ -423,9 +715,6 @@ module MyOCamlbuildBase = struct
+ *)
+
+
+-
+-
+-
+ open Ocamlbuild_plugin
+ module OC = Ocamlbuild_pack.Ocaml_compiler
+
+@@ -436,9 +725,6 @@ module MyOCamlbuildBase = struct
+ type tag = string
+
+
+-(* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
+-
+-
+ type t =
+ {
+ lib_ocaml: (name * dir list * string list) list;
+@@ -451,9 +737,10 @@ module MyOCamlbuildBase = struct
+ }
+
+
+- let env_filename =
+- Pathname.basename
+- BaseEnvLight.default_filename
++(* # 110 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
++
++
++ let env_filename = Pathname.basename BaseEnvLight.default_filename
+
+
+ let dispatch_combine lst =
+@@ -472,12 +759,7 @@ module MyOCamlbuildBase = struct
+
+
+ let dispatch t e =
+- let env =
+- BaseEnvLight.load
+- ~filename:env_filename
+- ~allow_empty:true
+- ()
+- in
++ let env = BaseEnvLight.load ~allow_empty:true () in
+ match e with
+ | Before_options ->
+ let no_trailing_dot s =
+@@ -505,7 +787,7 @@ module MyOCamlbuildBase = struct
+ | nm, [], intf_modules ->
+ ocaml_lib nm;
+ let cmis =
+- List.map (fun m -> (String.uncapitalize m) ^ ".cmi")
++ List.map (fun m -> (OASISString.uncapitalize_ascii m) ^ ".cmi")
+ intf_modules in
+ dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis
+ | nm, dir :: tl, intf_modules ->
+@@ -518,7 +800,7 @@ module MyOCamlbuildBase = struct
+ ["compile"; "infer_interface"; "doc"])
+ tl;
+ let cmis =
+- List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi")
++ List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi")
+ intf_modules in
+ dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"]
+ cmis)
+@@ -541,16 +823,18 @@ module MyOCamlbuildBase = struct
+ flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib]
+ (S[A"-cclib"; A("-l"^(nm_libstubs lib))]);
+
+- flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
+- (S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
++ if bool_of_string (BaseEnvLight.var_get "native_dynlink" env) then
++ flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
++ (S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
+
+ (* When ocaml link something that use the C library, then one
+ need that file to be up to date.
++ This holds both for programs and for libraries.
+ *)
+- dep ["link"; "ocaml"; "program"; tag_libstubs lib]
++ dep ["link"; "ocaml"; tag_libstubs lib]
+ [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
+
+- dep ["compile"; "ocaml"; "program"; tag_libstubs lib]
++ dep ["compile"; "ocaml"; tag_libstubs lib]
+ [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
+
+ (* TODO: be more specific about what depends on headers *)
+@@ -580,25 +864,27 @@ module MyOCamlbuildBase = struct
+ ()
+
+
+- let dispatch_default t =
++ let dispatch_default conf t =
+ dispatch_combine
+ [
+ dispatch t;
+- MyOCamlbuildFindlib.dispatch;
++ MyOCamlbuildFindlib.dispatch conf;
+ ]
+
+
+ end
+
+
+-# 594 "myocamlbuild.ml"
++# 878 "myocamlbuild.ml"
+ open Ocamlbuild_plugin;;
+ let package_default =
+ {MyOCamlbuildBase.lib_ocaml = []; lib_c = []; flags = []; includes = []}
+ ;;
+
+-let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
++let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
++
++let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
+
+-# 603 "myocamlbuild.ml"
++# 889 "myocamlbuild.ml"
+ (* OASIS_STOP *)
+ Ocamlbuild_plugin.dispatch dispatch_default;;
Index: pkgsrc/devel/ocamlmod/patches/patch-setup.ml
diff -u /dev/null pkgsrc/devel/ocamlmod/patches/patch-setup.ml:1.1
--- /dev/null Wed Jan 10 16:19:01 2018
+++ pkgsrc/devel/ocamlmod/patches/patch-setup.ml Wed Jan 10 16:19:01 2018
@@ -0,0 +1,8913 @@
+$NetBSD: patch-setup.ml,v 1.1 2018/01/10 16:19:01 jaapb Exp $
+
+Regenerated Oasis files (don't compile with 4.06)
+--- setup.ml.orig 2015-09-02 21:53:11.000000000 +0000
++++ setup.ml
+@@ -22,9 +22,9 @@
+ (* setup.ml generated for the first time by OASIS v0.2.0 *)
+
+ (* OASIS_START *)
+-(* DO NOT EDIT (digest: 8698f2327aaed46d52935d2928c5d881) *)
++(* DO NOT EDIT (digest: bfc058e9e1cbe8c726b0b3bc56fbf834) *)
+ (*
+- Regenerated by OASIS v0.4.4
++ Regenerated by OASIS v0.4.10
+ Visit http://oasis.forge.ocamlcore.org for more information and
+ documentation about functions used in this file.
+ *)
+@@ -32,16 +32,9 @@ module OASISGettext = struct
+ (* # 22 "src/oasis/OASISGettext.ml" *)
+
+
+- let ns_ str =
+- str
+-
+-
+- let s_ str =
+- str
+-
+-
+- let f_ (str: ('a, 'b, 'c, 'd) format4) =
+- str
++ let ns_ str = str
++ let s_ str = str
++ let f_ (str: ('a, 'b, 'c, 'd) format4) = str
+
+
+ let fn_ fmt1 fmt2 n =
+@@ -51,90 +44,7 @@ module OASISGettext = struct
+ fmt2^^""
+
+
+- let init =
+- []
+-
+-
+-end
+-
+-module OASISContext = struct
+-(* # 22 "src/oasis/OASISContext.ml" *)
+-
+-
+- open OASISGettext
+-
+-
+- type level =
+- [ `Debug
+- | `Info
+- | `Warning
+- | `Error]
+-
+-
+- type t =
+- {
+- (* TODO: replace this by a proplist. *)
+- quiet: bool;
+- info: bool;
+- debug: bool;
+- ignore_plugins: bool;
+- ignore_unknown_fields: bool;
+- printf: level -> string -> unit;
+- }
+-
+-
+- let printf lvl str =
+- let beg =
+- match lvl with
+- | `Error -> s_ "E: "
+- | `Warning -> s_ "W: "
+- | `Info -> s_ "I: "
+- | `Debug -> s_ "D: "
+- in
+- prerr_endline (beg^str)
+-
+-
+- let default =
+- ref
+- {
+- quiet = false;
+- info = false;
+- debug = false;
+- ignore_plugins = false;
+- ignore_unknown_fields = false;
+- printf = printf;
+- }
+-
+-
+- let quiet =
+- {!default with quiet = true}
+-
+-
+- let fspecs () =
+- (* TODO: don't act on default. *)
+- let ignore_plugins = ref false in
+- ["-quiet",
+- Arg.Unit (fun () -> default := {!default with quiet = true}),
+- s_ " Run quietly";
+-
+- "-info",
+- Arg.Unit (fun () -> default := {!default with info = true}),
+- s_ " Display information message";
+-
+-
+- "-debug",
+- Arg.Unit (fun () -> default := {!default with debug = true}),
+- s_ " Output debug message";
+-
+- "-ignore-plugins",
+- Arg.Set ignore_plugins,
+- s_ " Ignore plugin's field.";
+-
+- "-C",
+- (* TODO: remove this chdir. *)
+- Arg.String (fun str -> Sys.chdir str),
+- s_ "dir Change directory before running."],
+- fun () -> {!default with ignore_plugins = !ignore_plugins}
++ let init = []
+ end
+
+ module OASISString = struct
+@@ -146,7 +56,7 @@ module OASISString = struct
+ Mostly inspired by extlib and batteries ExtString and BatString libraries.
+
+ @author Sylvain Le Gall
+- *)
++ *)
+
+
+ let nsplitf str f =
+@@ -160,19 +70,19 @@ module OASISString = struct
+ Buffer.clear buf
+ in
+ let str_len = String.length str in
+- for i = 0 to str_len - 1 do
+- if f str.[i] then
+- push ()
+- else
+- Buffer.add_char buf str.[i]
+- done;
+- push ();
+- List.rev !lst
++ for i = 0 to str_len - 1 do
++ if f str.[i] then
++ push ()
++ else
++ Buffer.add_char buf str.[i]
++ done;
++ push ();
++ List.rev !lst
+
+
+ (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
+ separator.
+- *)
++ *)
+ let nsplit str c =
+ nsplitf str ((=) c)
+
+@@ -180,18 +90,18 @@ module OASISString = struct
+ let find ~what ?(offset=0) str =
+ let what_idx = ref 0 in
+ let str_idx = ref offset in
+- while !str_idx < String.length str &&
+- !what_idx < String.length what do
+- if str.[!str_idx] = what.[!what_idx] then
+- incr what_idx
+- else
+- what_idx := 0;
+- incr str_idx
+- done;
+- if !what_idx <> String.length what then
+- raise Not_found
++ while !str_idx < String.length str &&
++ !what_idx < String.length what do
++ if str.[!str_idx] = what.[!what_idx] then
++ incr what_idx
+ else
+- !str_idx - !what_idx
++ what_idx := 0;
++ incr str_idx
++ done;
++ if !what_idx <> String.length what then
++ raise Not_found
++ else
++ !str_idx - !what_idx
+
+
+ let sub_start str len =
+@@ -214,19 +124,16 @@ module OASISString = struct
+ let what_idx = ref 0 in
+ let str_idx = ref offset in
+ let ok = ref true in
+- while !ok &&
+- !str_idx < String.length str &&
+- !what_idx < String.length what do
+- if str.[!str_idx] = what.[!what_idx] then
+- incr what_idx
+- else
+- ok := false;
+- incr str_idx
+- done;
+- if !what_idx = String.length what then
+- true
++ while !ok &&
++ !str_idx < String.length str &&
++ !what_idx < String.length what do
++ if str.[!str_idx] = what.[!what_idx] then
++ incr what_idx
+ else
+- false
++ ok := false;
++ incr str_idx
++ done;
++ !what_idx = String.length what
+
+
+ let strip_starts_with ~what str =
+@@ -240,19 +147,16 @@ module OASISString = struct
+ let what_idx = ref ((String.length what) - 1) in
+ let str_idx = ref ((String.length str) - 1) in
+ let ok = ref true in
+- while !ok &&
+- offset <= !str_idx &&
+- 0 <= !what_idx do
+- if str.[!str_idx] = what.[!what_idx] then
+- decr what_idx
+- else
+- ok := false;
+- decr str_idx
+- done;
+- if !what_idx = -1 then
+- true
++ while !ok &&
++ offset <= !str_idx &&
++ 0 <= !what_idx do
++ if str.[!str_idx] = what.[!what_idx] then
++ decr what_idx
+ else
+- false
++ ok := false;
++ decr str_idx
++ done;
++ !what_idx = -1
+
+
+ let strip_ends_with ~what str =
+@@ -263,12 +167,37 @@ module OASISString = struct
+
+
+ let replace_chars f s =
+- let buf = String.make (String.length s) 'X' in
+- for i = 0 to String.length s - 1 do
+- buf.[i] <- f s.[i]
+- done;
+- buf
++ let buf = Buffer.create (String.length s) in
++ String.iter (fun c -> Buffer.add_char buf (f c)) s;
++ Buffer.contents buf
++
++ let lowercase_ascii =
++ replace_chars
++ (fun c ->
++ if (c >= 'A' && c <= 'Z') then
++ Char.chr (Char.code c + 32)
++ else
++ c)
++
++ let uncapitalize_ascii s =
++ if s <> "" then
++ (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
++ else
++ s
+
++ let uppercase_ascii =
++ replace_chars
++ (fun c ->
++ if (c >= 'a' && c <= 'z') then
++ Char.chr (Char.code c - 32)
++ else
++ c)
++
++ let capitalize_ascii s =
++ if s <> "" then
++ (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
++ else
++ s
+
+ end
+
+@@ -338,19 +267,15 @@ module OASISUtils = struct
+
+
+ let compare_csl s1 s2 =
+- String.compare (String.lowercase s1) (String.lowercase s2)
++ String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)
+
+
+ module HashStringCsl =
+ Hashtbl.Make
+ (struct
+ type t = string
+-
+- let equal s1 s2 =
+- (String.lowercase s1) = (String.lowercase s2)
+-
+- let hash s =
+- Hashtbl.hash (String.lowercase s)
++ let equal s1 s2 = (compare_csl s1 s2) = 0
++ let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)
+ end)
+
+ module SetStringCsl =
+@@ -388,7 +313,7 @@ module OASISUtils = struct
+ else
+ buf
+ in
+- String.lowercase buf
++ OASISString.lowercase_ascii buf
+ end
+
+
+@@ -416,6 +341,398 @@ module OASISUtils = struct
+ let failwithf fmt = Printf.ksprintf failwith fmt
+
+
++ let rec file_location ?pos1 ?pos2 ?lexbuf () =
++ match pos1, pos2, lexbuf with
++ | Some p, None, _ | None, Some p, _ ->
++ file_location ~pos1:p ~pos2:p ?lexbuf ()
++ | Some p1, Some p2, _ ->
++ let open Lexing in
++ let fn, lineno = p1.pos_fname, p1.pos_lnum in
++ let c1 = p1.pos_cnum - p1.pos_bol in
++ let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in
++ Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2
++ | _, _, Some lexbuf ->
++ file_location
++ ~pos1:(Lexing.lexeme_start_p lexbuf)
++ ~pos2:(Lexing.lexeme_end_p lexbuf)
++ ()
++ | None, None, None ->
++ s_ "<position undefined>"
++
++
++ let failwithpf ?pos1 ?pos2 ?lexbuf fmt =
++ let loc = file_location ?pos1 ?pos2 ?lexbuf () in
++ Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt
++
++
++end
++
++module OASISUnixPath = struct
++(* # 22 "src/oasis/OASISUnixPath.ml" *)
++
++
++ type unix_filename = string
++ type unix_dirname = string
++
++
++ type host_filename = string
++ type host_dirname = string
++
++
++ let current_dir_name = "."
++
++
++ let parent_dir_name = ".."
++
++
++ let is_current_dir fn =
++ fn = current_dir_name || fn = ""
++
++
++ let concat f1 f2 =
++ if is_current_dir f1 then
++ f2
++ else
++ let f1' =
++ try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1
++ in
++ f1'^"/"^f2
++
++
++ let make =
++ function
++ | hd :: tl ->
++ List.fold_left
++ (fun f p -> concat f p)
++ hd
++ tl
++ | [] ->
++ invalid_arg "OASISUnixPath.make"
++
++
++ let dirname f =
++ try
++ String.sub f 0 (String.rindex f '/')
++ with Not_found ->
++ current_dir_name
++
++
++ let basename f =
++ try
++ let pos_start =
++ (String.rindex f '/') + 1
++ in
++ String.sub f pos_start ((String.length f) - pos_start)
++ with Not_found ->
++ f
++
++
++ let chop_extension f =
++ try
++ let last_dot =
++ String.rindex f '.'
++ in
++ let sub =
++ String.sub f 0 last_dot
++ in
++ try
++ let last_slash =
++ String.rindex f '/'
++ in
++ if last_slash < last_dot then
++ sub
++ else
++ f
++ with Not_found ->
++ sub
++
++ with Not_found ->
++ f
++
++
++ let capitalize_file f =
++ let dir = dirname f in
++ let base = basename f in
++ concat dir (OASISString.capitalize_ascii base)
++
++
++ let uncapitalize_file f =
++ let dir = dirname f in
++ let base = basename f in
++ concat dir (OASISString.uncapitalize_ascii base)
++
++
++end
++
++module OASISHostPath = struct
++(* # 22 "src/oasis/OASISHostPath.ml" *)
++
++
++ open Filename
++ open OASISGettext
++
++
++ module Unix = OASISUnixPath
++
++
++ let make =
++ function
++ | [] ->
++ invalid_arg "OASISHostPath.make"
++ | hd :: tl ->
++ List.fold_left Filename.concat hd tl
++
++
++ let of_unix ufn =
++ match Sys.os_type with
++ | "Unix" | "Cygwin" -> ufn
++ | "Win32" ->
++ make
++ (List.map
++ (fun p ->
++ if p = Unix.current_dir_name then
++ current_dir_name
++ else if p = Unix.parent_dir_name then
++ parent_dir_name
++ else
++ p)
++ (OASISString.nsplit ufn '/'))
++ | os_type ->
++ OASISUtils.failwithf
++ (f_ "Don't know the path format of os_type %S when translating unix \
++ filename. %S")
++ os_type ufn
++
++
++end
++
++module OASISFileSystem = struct
++(* # 22 "src/oasis/OASISFileSystem.ml" *)
++
++ (** File System functions
++
++ @author Sylvain Le Gall
++ *)
++
++ type 'a filename = string
++
++ class type closer =
++ object
++ method close: unit
++ end
++
++ class type reader =
++ object
++ inherit closer
++ method input: Buffer.t -> int -> unit
++ end
++
++ class type writer =
++ object
++ inherit closer
++ method output: Buffer.t -> unit
++ end
++
++ class type ['a] fs =
++ object
++ method string_of_filename: 'a filename -> string
++ method open_out: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> writer
++ method open_in: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> reader
++ method file_exists: 'a filename -> bool
++ method remove: 'a filename -> unit
++ end
++
++
++ module Mode =
++ struct
++ let default_in = [Open_rdonly]
++ let default_out = [Open_wronly; Open_creat; Open_trunc]
++
++ let text_in = Open_text :: default_in
++ let text_out = Open_text :: default_out
++
++ let binary_in = Open_binary :: default_in
++ let binary_out = Open_binary :: default_out
++ end
++
++ let std_length = 4096 (* Standard buffer/read length. *)
++ let binary_out = Mode.binary_out
++ let binary_in = Mode.binary_in
++
++ let of_unix_filename ufn = (ufn: 'a filename)
++ let to_unix_filename fn = (fn: string)
++
++
++ let defer_close o f =
++ try
++ let r = f o in o#close; r
++ with e ->
++ o#close; raise e
++
++
++ let stream_of_reader rdr =
++ let buf = Buffer.create std_length in
++ let pos = ref 0 in
++ let eof = ref false in
++ let rec next idx =
++ let bpos = idx - !pos in
++ if !eof then begin
++ None
++ end else if bpos < Buffer.length buf then begin
++ Some (Buffer.nth buf bpos)
++ end else begin
++ pos := !pos + Buffer.length buf;
++ Buffer.clear buf;
++ begin
++ try
++ rdr#input buf std_length;
++ with End_of_file ->
++ if Buffer.length buf = 0 then
++ eof := true
++ end;
++ next idx
++ end
++ in
++ Stream.from next
++
++
++ let read_all buf rdr =
++ try
++ while true do
++ rdr#input buf std_length
++ done
++ with End_of_file ->
++ ()
++
++ class ['a] host_fs rootdir : ['a] fs =
++ object (self)
++ method private host_filename fn = Filename.concat rootdir fn
++ method string_of_filename = self#host_filename
++
++ method open_out ?(mode=Mode.text_out) ?(perm=0o666) fn =
++ let chn = open_out_gen mode perm (self#host_filename fn) in
++ object
++ method close = close_out chn
++ method output buf = Buffer.output_buffer chn buf
++ end
++
++ method open_in ?(mode=Mode.text_in) ?(perm=0o666) fn =
++ (* TODO: use Buffer.add_channel when minimal version of OCaml will
++ * be >= 4.03.0 (previous version was discarding last chars).
++ *)
++ let chn = open_in_gen mode perm (self#host_filename fn) in
++ let strm = Stream.of_channel chn in
++ object
++ method close = close_in chn
++ method input buf len =
++ let read = ref 0 in
++ try
++ for _i = 0 to len do
++ Buffer.add_char buf (Stream.next strm);
++ incr read
++ done
++ with Stream.Failure ->
++ if !read = 0 then
++ raise End_of_file
++ end
++
++ method file_exists fn = Sys.file_exists (self#host_filename fn)
++ method remove fn = Sys.remove (self#host_filename fn)
++ end
++
++end
++
++module OASISContext = struct
++(* # 22 "src/oasis/OASISContext.ml" *)
++
++
++ open OASISGettext
++
++
++ type level =
++ [ `Debug
++ | `Info
++ | `Warning
++ | `Error]
++
++
++ type source
++ type source_filename = source OASISFileSystem.filename
++
++
++ let in_srcdir ufn = OASISFileSystem.of_unix_filename ufn
++
++
++ type t =
++ {
++ (* TODO: replace this by a proplist. *)
++ quiet: bool;
++ info: bool;
++ debug: bool;
++ ignore_plugins: bool;
++ ignore_unknown_fields: bool;
++ printf: level -> string -> unit;
++ srcfs: source OASISFileSystem.fs;
++ load_oasis_plugin: string -> bool;
++ }
++
++
++ let printf lvl str =
++ let beg =
++ match lvl with
++ | `Error -> s_ "E: "
++ | `Warning -> s_ "W: "
++ | `Info -> s_ "I: "
++ | `Debug -> s_ "D: "
++ in
++ prerr_endline (beg^str)
++
++
++ let default =
++ ref
++ {
++ quiet = false;
++ info = false;
++ debug = false;
++ ignore_plugins = false;
++ ignore_unknown_fields = false;
++ printf = printf;
++ srcfs = new OASISFileSystem.host_fs(Sys.getcwd ());
++ load_oasis_plugin = (fun _ -> false);
++ }
++
++
++ let quiet =
++ {!default with quiet = true}
++
++
++ let fspecs () =
++ (* TODO: don't act on default. *)
++ let ignore_plugins = ref false in
++ ["-quiet",
++ Arg.Unit (fun () -> default := {!default with quiet = true}),
++ s_ " Run quietly";
++
++ "-info",
++ Arg.Unit (fun () -> default := {!default with info = true}),
++ s_ " Display information message";
++
++
++ "-debug",
++ Arg.Unit (fun () -> default := {!default with debug = true}),
++ s_ " Output debug message";
++
++ "-ignore-plugins",
++ Arg.Set ignore_plugins,
++ s_ " Ignore plugin's field.";
++
++ "-C",
++ Arg.String
++ (fun str ->
++ Sys.chdir str;
++ default := {!default with srcfs = new OASISFileSystem.host_fs str}),
++ s_ "dir Change directory before running (affects setup.{data,log})."],
++ fun () -> {!default with ignore_plugins = !ignore_plugins}
+ end
+
+ module PropList = struct
+@@ -436,27 +753,27 @@ module PropList = struct
+ let () =
+ Printexc.register_printer
+ (function
+- | Not_set (nm, Some rsn) ->
+- Some
+- (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn)
+- | Not_set (nm, None) ->
+- Some
+- (Printf.sprintf (f_ "Field '%s' is not set") nm)
+- | No_printer nm ->
+- Some
+- (Printf.sprintf (f_ "No default printer for value %s") nm)
+- | Unknown_field (nm, schm) ->
+- Some
+- (Printf.sprintf
+- (f_ "Field %s is not defined in schema %s") nm schm)
+- | _ ->
+- None)
++ | Not_set (nm, Some rsn) ->
++ Some
++ (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn)
++ | Not_set (nm, None) ->
++ Some
++ (Printf.sprintf (f_ "Field '%s' is not set") nm)
++ | No_printer nm ->
++ Some
++ (Printf.sprintf (f_ "No default printer for value %s") nm)
++ | Unknown_field (nm, schm) ->
++ Some
++ (Printf.sprintf
++ (f_ "Field %s is not defined in schema %s") nm schm)
++ | _ ->
++ None)
+
+
+ module Data =
+ struct
+ type t =
+- (name, unit -> unit) Hashtbl.t
++ (name, unit -> unit) Hashtbl.t
+
+ let create () =
+ Hashtbl.create 13
+@@ -465,27 +782,27 @@ module PropList = struct
+ Hashtbl.clear t
+
+
+-(* # 78 "src/oasis/PropList.ml" *)
++(* # 77 "src/oasis/PropList.ml" *)
+ end
+
+
+ module Schema =
+ struct
+ type ('ctxt, 'extra) value =
+- {
+- get: Data.t -> string;
+- set: Data.t -> ?context:'ctxt -> string -> unit;
+- help: (unit -> string) option;
+- extra: 'extra;
+- }
++ {
++ get: Data.t -> string;
++ set: Data.t -> ?context:'ctxt -> string -> unit;
++ help: (unit -> string) option;
++ extra: 'extra;
++ }
+
+ type ('ctxt, 'extra) t =
+- {
+- name: name;
+- fields: (name, ('ctxt, 'extra) value) Hashtbl.t;
+- order: name Queue.t;
+- name_norm: string -> string;
+- }
++ {
++ name: name;
++ fields: (name, ('ctxt, 'extra) value) Hashtbl.t;
++ order: name Queue.t;
++ name_norm: string -> string;
++ }
+
+ let create ?(case_insensitive=false) nm =
+ {
+@@ -494,7 +811,7 @@ module PropList = struct
+ order = Queue.create ();
+ name_norm =
+ (if case_insensitive then
+- String.lowercase
++ OASISString.lowercase_ascii
+ else
+ fun s -> s);
+ }
+@@ -504,21 +821,21 @@ module PropList = struct
+ t.name_norm nm
+ in
+
+- if Hashtbl.mem t.fields key then
+- failwith
+- (Printf.sprintf
+- (f_ "Field '%s' is already defined in schema '%s'")
+- nm t.name);
+- Hashtbl.add
+- t.fields
+- key
+- {
+- set = set;
+- get = get;
+- help = help;
+- extra = extra;
+- };
+- Queue.add nm t.order
++ if Hashtbl.mem t.fields key then
++ failwith
++ (Printf.sprintf
++ (f_ "Field '%s' is already defined in schema '%s'")
++ nm t.name);
++ Hashtbl.add
++ t.fields
++ key
++ {
++ set = set;
++ get = get;
++ help = help;
++ extra = extra;
++ };
++ Queue.add nm t.order
+
+ let mem t nm =
+ Hashtbl.mem t.fields nm
+@@ -544,7 +861,7 @@ module PropList = struct
+ let v =
+ find t k
+ in
+- f acc k v.extra v.help)
++ f acc k v.extra v.help)
+ acc
+ t.order
+
+@@ -562,20 +879,20 @@ module PropList = struct
+ module Field =
+ struct
+ type ('ctxt, 'value, 'extra) t =
+- {
+- set: Data.t -> ?context:'ctxt -> 'value -> unit;
+- get: Data.t -> 'value;
+- sets: Data.t -> ?context:'ctxt -> string -> unit;
+- gets: Data.t -> string;
+- help: (unit -> string) option;
+- extra: 'extra;
+- }
++ {
++ set: Data.t -> ?context:'ctxt -> 'value -> unit;
++ get: Data.t -> 'value;
++ sets: Data.t -> ?context:'ctxt -> string -> unit;
++ gets: Data.t -> string;
++ help: (unit -> string) option;
++ extra: 'extra;
++ }
+
+ let new_id =
+ let last_id =
+ ref 0
+ in
+- fun () -> incr last_id; !last_id
++ fun () -> incr last_id; !last_id
+
+ let create ?schema ?name ?parse ?print ?default ?update ?help extra =
+ (* Default value container *)
+@@ -614,33 +931,33 @@ module PropList = struct
+ let x =
+ match update with
+ | Some f ->
+- begin
+- try
+- f ?context (get data) x
+- with Not_set _ ->
+- x
+- end
++ begin
++ try
++ f ?context (get data) x
++ with Not_set _ ->
++ x
++ end
+ | None ->
+- x
++ x
+ in
+- Hashtbl.replace
+- data
+- nm
+- (fun () -> v := Some x)
++ Hashtbl.replace
++ data
++ nm
++ (fun () -> v := Some x)
+ in
+
+ (* Parse string value, if possible *)
+ let parse =
+ match parse with
+ | Some f ->
+- f
++ f
+ | None ->
+- fun ?context s ->
+- failwith
+- (Printf.sprintf
+- (f_ "Cannot parse field '%s' when setting value %S")
+- nm
+- s)
++ fun ?context s ->
++ failwith
++ (Printf.sprintf
++ (f_ "Cannot parse field '%s' when setting value %S")
++ nm
++ s)
+ in
+
+ (* Set data, from string *)
+@@ -652,9 +969,9 @@ module PropList = struct
+ let print =
+ match print with
+ | Some f ->
+- f
++ f
+ | None ->
+- fun _ -> raise (No_printer nm)
++ fun _ -> raise (No_printer nm)
+ in
+
+ (* Get data, as a string *)
+@@ -662,22 +979,22 @@ module PropList = struct
+ print (get data)
+ in
+
+- begin
+- match schema with
+- | Some t ->
+- Schema.add t nm sets gets extra help
+- | None ->
+- ()
+- end;
++ begin
++ match schema with
++ | Some t ->
++ Schema.add t nm sets gets extra help
++ | None ->
++ ()
++ end;
+
+- {
+- set = set;
+- get = get;
+- sets = sets;
+- gets = gets;
+- help = help;
+- extra = extra;
+- }
++ {
++ set = set;
++ get = get;
++ sets = sets;
++ gets = gets;
++ help = help;
++ extra = extra;
++ }
+
+ let fset data t ?context x =
+ t.set data ?context x
+@@ -699,7 +1016,7 @@ module PropList = struct
+ let fld =
+ Field.create ?schema ?name ?parse ?print ?default ?update ?help extra
+ in
+- fun data -> Field.fget data fld
++ fun data -> Field.fget data fld
+ end
+ end
+
+@@ -721,13 +1038,13 @@ module OASISMessage = struct
+ | `Info -> ctxt.info
+ | _ -> true
+ in
+- Printf.ksprintf
+- (fun str ->
+- if cond then
+- begin
+- ctxt.printf lvl str
+- end)
+- fmt
++ Printf.ksprintf
++ (fun str ->
++ if cond then
++ begin
++ ctxt.printf lvl str
++ end)
++ fmt
+
+
+ let debug ~ctxt fmt =
+@@ -754,12 +1071,6 @@ module OASISVersion = struct
+ open OASISGettext
+
+
+-
+-
+-
+- type s = string
+-
+-
+ type t = string
+
+
+@@ -773,20 +1084,10 @@ module OASISVersion = struct
+ | VAnd of comparator * comparator
+
+
+-
+ (* Range of allowed characters *)
+- let is_digit c =
+- '0' <= c && c <= '9'
+-
+-
+- let is_alpha c =
+- ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
+-
+-
+- let is_special =
+- function
+- | '.' | '+' | '-' | '~' -> true
+- | _ -> false
++ let is_digit c = '0' <= c && c <= '9'
++ let is_alpha c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
++ let is_special = function | '.' | '+' | '-' | '~' -> true | _ -> false
+
+
+ let rec version_compare v1 v2 =
+@@ -794,7 +1095,7 @@ module OASISVersion = struct
+ begin
+ (* Compare ascii string, using special meaning for version
+ * related char
+- *)
++ *)
+ let val_ascii c =
+ if c = '~' then -1
+ else if is_digit c then 0
+@@ -829,45 +1130,44 @@ module OASISVersion = struct
+ let compare_digit () =
+ let extract_int v p =
+ let start_p = !p in
+- while !p < String.length v && is_digit v.[!p] do
+- incr p
+- done;
+- let substr =
+- String.sub v !p ((String.length v) - !p)
+- in
+- let res =
+- match String.sub v start_p (!p - start_p) with
+- | "" -> 0
+- | s -> int_of_string s
+- in
+- res, substr
++ while !p < String.length v && is_digit v.[!p] do
++ incr p
++ done;
++ let substr =
++ String.sub v !p ((String.length v) - !p)
++ in
++ let res =
++ match String.sub v start_p (!p - start_p) with
++ | "" -> 0
++ | s -> int_of_string s
++ in
++ res, substr
+ in
+ let i1, tl1 = extract_int v1 (ref !p) in
+ let i2, tl2 = extract_int v2 (ref !p) in
+- i1 - i2, tl1, tl2
++ i1 - i2, tl1, tl2
+ in
+
+- match compare_vascii () with
+- | 0 ->
+- begin
+- match compare_digit () with
+- | 0, tl1, tl2 ->
+- if tl1 <> "" && is_digit tl1.[0] then
+- 1
+- else if tl2 <> "" && is_digit tl2.[0] then
+- -1
+- else
+- version_compare tl1 tl2
+- | n, _, _ ->
+- n
+- end
+- | n ->
+- n
+- end
+- else
+- begin
+- 0
++ match compare_vascii () with
++ | 0 ->
++ begin
++ match compare_digit () with
++ | 0, tl1, tl2 ->
++ if tl1 <> "" && is_digit tl1.[0] then
++ 1
++ else if tl2 <> "" && is_digit tl2.[0] then
++ -1
++ else
++ version_compare tl1 tl2
++ | n, _, _ ->
++ n
++ end
++ | n ->
++ n
+ end
++ else begin
++ 0
++ end
+
+
+ let version_of_string str = str
+@@ -876,16 +1176,12 @@ module OASISVersion = struct
+ let string_of_version t = t
+
+
+- let version_compare_string s1 s2 =
+- version_compare (version_of_string s1) (version_of_string s2)
+-
+-
+ let chop t =
+ try
+ let pos =
+ String.rindex t '.'
+ in
+- String.sub t 0 pos
++ String.sub t 0 pos
+ with Not_found ->
+ t
+
+@@ -893,19 +1189,19 @@ module OASISVersion = struct
+ let rec comparator_apply v op =
+ match op with
+ | VGreater cv ->
+- (version_compare v cv) > 0
++ (version_compare v cv) > 0
+ | VGreaterEqual cv ->
+- (version_compare v cv) >= 0
++ (version_compare v cv) >= 0
+ | VLesser cv ->
+- (version_compare v cv) < 0
++ (version_compare v cv) < 0
+ | VLesserEqual cv ->
+- (version_compare v cv) <= 0
++ (version_compare v cv) <= 0
+ | VEqual cv ->
+- (version_compare v cv) = 0
++ (version_compare v cv) = 0
+ | VOr (op1, op2) ->
+- (comparator_apply v op1) || (comparator_apply v op2)
++ (comparator_apply v op1) || (comparator_apply v op2)
+ | VAnd (op1, op2) ->
+- (comparator_apply v op1) && (comparator_apply v op2)
++ (comparator_apply v op1) && (comparator_apply v op2)
+
+
+ let rec string_of_comparator =
+@@ -916,9 +1212,9 @@ module OASISVersion = struct
+ | VGreaterEqual v -> ">= "^(string_of_version v)
+ | VLesserEqual v -> "<= "^(string_of_version v)
+ | VOr (c1, c2) ->
+- (string_of_comparator c1)^" || "^(string_of_comparator c2)
++ (string_of_comparator c1)^" || "^(string_of_comparator c2)
+ | VAnd (c1, c2) ->
+- (string_of_comparator c1)^" && "^(string_of_comparator c2)
++ (string_of_comparator c1)^" && "^(string_of_comparator c2)
+
+
+ let rec varname_of_comparator =
+@@ -928,28 +1224,16 @@ module OASISVersion = struct
+ (OASISUtils.varname_of_string
+ (string_of_version v))
+ in
+- function
+- | VGreater v -> concat "gt" v
+- | VLesser v -> concat "lt" v
+- | VEqual v -> concat "eq" v
+- | VGreaterEqual v -> concat "ge" v
+- | VLesserEqual v -> concat "le" v
+- | VOr (c1, c2) ->
+- (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)
+- | VAnd (c1, c2) ->
+- (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
+-
+-
+- let rec comparator_ge v' =
+- let cmp v = version_compare v v' >= 0 in
+ function
+- | VEqual v
+- | VGreaterEqual v
+- | VGreater v -> cmp v
+- | VLesserEqual _
+- | VLesser _ -> false
+- | VOr (c1, c2) -> comparator_ge v' c1 || comparator_ge v' c2
+- | VAnd (c1, c2) -> comparator_ge v' c1 && comparator_ge v' c2
++ | VGreater v -> concat "gt" v
++ | VLesser v -> concat "lt" v
++ | VEqual v -> concat "eq" v
++ | VGreaterEqual v -> concat "ge" v
++ | VLesserEqual v -> concat "le" v
++ | VOr (c1, c2) ->
++ (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)
++ | VAnd (c1, c2) ->
++ (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
+
+
+ end
+@@ -960,15 +1244,10 @@ module OASISLicense = struct
+
+ (** License for _oasis fields
+ @author Sylvain Le Gall
+- *)
+-
+-
+-
++ *)
+
+
+ type license = string
+-
+-
+ type license_exception = string
+
+
+@@ -978,7 +1257,6 @@ module OASISLicense = struct
+ | NoVersion
+
+
+-
+ type license_dep_5_unit =
+ {
+ license: license;
+@@ -987,7 +1265,6 @@ module OASISLicense = struct
+ }
+
+
+-
+ type license_dep_5 =
+ | DEP5Unit of license_dep_5_unit
+ | DEP5Or of license_dep_5 list
+@@ -999,22 +1276,17 @@ module OASISLicense = struct
+ | OtherLicense of string (* URL *)
+
+
+-
+ end
+
+ module OASISExpr = struct
+ (* # 22 "src/oasis/OASISExpr.ml" *)
+
+
+-
+-
+-
+ open OASISGettext
++ open OASISUtils
+
+
+ type test = string
+-
+-
+ type flag = string
+
+
+@@ -1027,7 +1299,6 @@ module OASISExpr = struct
+ | ETest of test * string
+
+
+-
+ type 'a choices = (t * 'a) list
+
+
+@@ -1099,20 +1370,148 @@ module OASISExpr = struct
+ choose_aux (List.rev lst)
+
+
+-end
++end
++
++module OASISText = struct
++(* # 22 "src/oasis/OASISText.ml" *)
++
++ type elt =
++ | Para of string
++ | Verbatim of string
++ | BlankLine
++
++ type t = elt list
++
++end
++
++module OASISSourcePatterns = struct
++(* # 22 "src/oasis/OASISSourcePatterns.ml" *)
++
++ open OASISUtils
++ open OASISGettext
++
++ module Templater =
++ struct
++ (* TODO: use this module in BaseEnv.var_expand and BaseFileAB, at least. *)
++ type t =
++ {
++ atoms: atom list;
++ origin: string
++ }
++ and atom =
++ | Text of string
++ | Expr of expr
++ and expr =
++ | Ident of string
++ | String of string
++ | Call of string * expr
++
++
++ type env =
++ {
++ variables: string MapString.t;
++ functions: (string -> string) MapString.t;
++ }
++
++
++ let eval env t =
++ let rec eval_expr env =
++ function
++ | String str -> str
++ | Ident nm ->
++ begin
++ try
++ MapString.find nm env.variables
++ with Not_found ->
++ (* TODO: add error location within the string. *)
++ failwithf
++ (f_ "Unable to find variable %S in source pattern %S")
++ nm t.origin
++ end
++
++ | Call (fn, expr) ->
++ begin
++ try
++ (MapString.find fn env.functions) (eval_expr env expr)
++ with Not_found ->
++ (* TODO: add error location within the string. *)
++ failwithf
++ (f_ "Unable to find function %S in source pattern %S")
++ fn t.origin
++ end
++ in
++ String.concat ""
++ (List.map
++ (function
++ | Text str -> str
++ | Expr expr -> eval_expr env expr)
++ t.atoms)
++
++
++ let parse env s =
++ let lxr = Genlex.make_lexer [] in
++ let parse_expr s =
++ let st = lxr (Stream.of_string s) in
++ match Stream.npeek 3 st with
++ | [Genlex.Ident fn; Genlex.Ident nm] -> Call(fn, Ident nm)
++ | [Genlex.Ident fn; Genlex.String str] -> Call(fn, String str)
++ | [Genlex.String str] -> String str
++ | [Genlex.Ident nm] -> Ident nm
++ (* TODO: add error location within the string. *)
++ | _ -> failwithf (f_ "Unable to parse expression %S") s
++ in
++ let parse s =
++ let lst_exprs = ref [] in
++ let ss =
++ let buff = Buffer.create (String.length s) in
++ Buffer.add_substitute
++ buff
++ (fun s -> lst_exprs := (parse_expr s) :: !lst_exprs; "\000")
++ s;
++ Buffer.contents buff
++ in
++ let rec join =
++ function
++ | hd1 :: tl1, hd2 :: tl2 -> Text hd1 :: Expr hd2 :: join (tl1, tl2)
++ | [], tl -> List.map (fun e -> Expr e) tl
++ | tl, [] -> List.map (fun e -> Text e) tl
++ in
++ join (OASISString.nsplit ss '\000', List.rev (!lst_exprs))
++ in
++ let t = {atoms = parse s; origin = s} in
++ (* We rely on a simple evaluation for checking variables/functions.
++ It works because there is no if/loop statement.
++ *)
++ let _s : string = eval env t in
++ t
++
++(* # 144 "src/oasis/OASISSourcePatterns.ml" *)
++ end
++
+
+-module OASISText = struct
+-(* # 22 "src/oasis/OASISText.ml" *)
++ type t = Templater.t
+
+
++ let env ~modul () =
++ {
++ Templater.
++ variables = MapString.of_list ["module", modul];
++ functions = MapString.of_list
++ [
++ "capitalize_file", OASISUnixPath.capitalize_file;
++ "uncapitalize_file", OASISUnixPath.uncapitalize_file;
++ ];
++ }
+
+- type elt =
+- | Para of string
+- | Verbatim of string
+- | BlankLine
++ let all_possible_files lst ~path ~modul =
++ let eval = Templater.eval (env ~modul ()) in
++ List.fold_left
++ (fun acc pat -> OASISUnixPath.concat path (eval pat) :: acc)
++ [] lst
+
+
+- type t = elt list
++ let to_string t = t.Templater.origin
++
+
+ end
+
+@@ -1120,16 +1519,13 @@ module OASISTypes = struct
+ (* # 22 "src/oasis/OASISTypes.ml" *)
+
+
+-
+-
+-
+ type name = string
+ type package_name = string
+ type url = string
+ type unix_dirname = string
+- type unix_filename = string
+- type host_dirname = string
+- type host_filename = string
++ type unix_filename = string (* TODO: replace everywhere. *)
++ type host_dirname = string (* TODO: replace everywhere. *)
++ type host_filename = string (* TODO: replace everywhere. *)
+ type prog = string
+ type arg = string
+ type args = string list
+@@ -1146,19 +1542,16 @@ module OASISTypes = struct
+ | Best
+
+
+-
+ type dependency =
+ | FindlibPackage of findlib_full * OASISVersion.comparator option
+ | InternalLibrary of name
+
+
+-
+ type tool =
+ | ExternalTool of name
+ | InternalExecutable of name
+
+
+-
+ type vcs =
+ | Darcs
+ | Git
+@@ -1171,30 +1564,29 @@ module OASISTypes = struct
+ | OtherVCS of url
+
+
+-
+ type plugin_kind =
+- [ `Configure
+- | `Build
+- | `Doc
+- | `Test
+- | `Install
+- | `Extra
+- ]
++ [ `Configure
++ | `Build
++ | `Doc
++ | `Test
++ | `Install
++ | `Extra
++ ]
+
+
+ type plugin_data_purpose =
+- [ `Configure
+- | `Build
+- | `Install
+- | `Clean
+- | `Distclean
+- | `Install
+- | `Uninstall
+- | `Test
+- | `Doc
+- | `Extra
+- | `Other of string
+- ]
++ [ `Configure
++ | `Build
++ | `Install
++ | `Clean
++ | `Distclean
++ | `Install
++ | `Uninstall
++ | `Test
++ | `Doc
++ | `Extra
++ | `Other of string
++ ]
+
+
+ type 'a plugin = 'a * name * OASISVersion.t option
+@@ -1206,129 +1598,128 @@ module OASISTypes = struct
+ type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
+
+
+-(* # 115 "src/oasis/OASISTypes.ml" *)
+-
+-
+ type 'a conditional = 'a OASISExpr.choices
+
+
+ type custom =
+- {
+- pre_command: (command_line option) conditional;
+- post_command: (command_line option) conditional;
+- }
+-
++ {
++ pre_command: (command_line option) conditional;
++ post_command: (command_line option) conditional;
++ }
+
+
+ type common_section =
+- {
+- cs_name: name;
+- cs_data: PropList.Data.t;
+- cs_plugin_data: plugin_data;
+- }
+-
++ {
++ cs_name: name;
++ cs_data: PropList.Data.t;
++ cs_plugin_data: plugin_data;
++ }
+
+
+ type build_section =
+- {
+- bs_build: bool conditional;
+- bs_install: bool conditional;
+- bs_path: unix_dirname;
+- bs_compiled_object: compiled_object;
+- bs_build_depends: dependency list;
+- bs_build_tools: tool list;
+- bs_c_sources: unix_filename list;
+- bs_data_files: (unix_filename * unix_filename option) list;
+- bs_ccopt: args conditional;
+- bs_cclib: args conditional;
+- bs_dlllib: args conditional;
+- bs_dllpath: args conditional;
+- bs_byteopt: args conditional;
+- bs_nativeopt: args conditional;
+- }
+-
++ {
++ bs_build: bool conditional;
++ bs_install: bool conditional;
++ bs_path: unix_dirname;
++ bs_compiled_object: compiled_object;
++ bs_build_depends: dependency list;
++ bs_build_tools: tool list;
++ bs_interface_patterns: OASISSourcePatterns.t list;
++ bs_implementation_patterns: OASISSourcePatterns.t list;
++ bs_c_sources: unix_filename list;
++ bs_data_files: (unix_filename * unix_filename option) list;
++ bs_findlib_extra_files: unix_filename list;
++ bs_ccopt: args conditional;
++ bs_cclib: args conditional;
++ bs_dlllib: args conditional;
++ bs_dllpath: args conditional;
++ bs_byteopt: args conditional;
++ bs_nativeopt: args conditional;
++ }
+
+
+ type library =
+- {
+- lib_modules: string list;
+- lib_pack: bool;
+- lib_internal_modules: string list;
+- lib_findlib_parent: findlib_name option;
+- lib_findlib_name: findlib_name option;
+- lib_findlib_containers: findlib_name list;
+- }
++ {
++ lib_modules: string list;
++ lib_pack: bool;
++ lib_internal_modules: string list;
++ lib_findlib_parent: findlib_name option;
++ lib_findlib_name: findlib_name option;
++ lib_findlib_directory: unix_dirname option;
++ lib_findlib_containers: findlib_name list;
++ }
+
+
+ type object_ =
+- {
+- obj_modules: string list;
+- obj_findlib_fullname: findlib_name list option;
+- }
++ {
++ obj_modules: string list;
++ obj_findlib_fullname: findlib_name list option;
++ obj_findlib_directory: unix_dirname option;
++ }
+
+
+ type executable =
+- {
+- exec_custom: bool;
+- exec_main_is: unix_filename;
+- }
++ {
++ exec_custom: bool;
++ exec_main_is: unix_filename;
++ }
+
+
+ type flag =
+- {
+- flag_description: string option;
+- flag_default: bool conditional;
+- }
++ {
++ flag_description: string option;
++ flag_default: bool conditional;
++ }
+
+
+ type source_repository =
+- {
+- src_repo_type: vcs;
+- src_repo_location: url;
+- src_repo_browser: url option;
+- src_repo_module: string option;
+- src_repo_branch: string option;
+- src_repo_tag: string option;
+- src_repo_subdir: unix_filename option;
+- }
++ {
++ src_repo_type: vcs;
++ src_repo_location: url;
++ src_repo_browser: url option;
++ src_repo_module: string option;
++ src_repo_branch: string option;
++ src_repo_tag: string option;
++ src_repo_subdir: unix_filename option;
++ }
+
+
+ type test =
+- {
+- test_type: [`Test] plugin;
+- test_command: command_line conditional;
+- test_custom: custom;
+- test_working_directory: unix_filename option;
+- test_run: bool conditional;
+- test_tools: tool list;
+- }
++ {
++ test_type: [`Test] plugin;
++ test_command: command_line conditional;
++ test_custom: custom;
++ test_working_directory: unix_filename option;
++ test_run: bool conditional;
++ test_tools: tool list;
++ }
+
+
+ type doc_format =
+- | HTML of unix_filename
++ | HTML of unix_filename (* TODO: source filename. *)
+ | DocText
+ | PDF
+ | PostScript
+- | Info of unix_filename
++ | Info of unix_filename (* TODO: source filename. *)
+ | DVI
+ | OtherDoc
+
+
+-
+ type doc =
+- {
+- doc_type: [`Doc] plugin;
+- doc_custom: custom;
+- doc_build: bool conditional;
+- doc_install: bool conditional;
+- doc_install_dir: unix_filename;
+- doc_title: string;
+- doc_authors: string list;
+- doc_abstract: string option;
+- doc_format: doc_format;
+- doc_data_files: (unix_filename * unix_filename option) list;
+- doc_build_tools: tool list;
+- }
++ {
++ doc_type: [`Doc] plugin;
++ doc_custom: custom;
++ doc_build: bool conditional;
++ doc_install: bool conditional;
++ doc_install_dir: unix_filename; (* TODO: dest filename ?. *)
++ doc_title: string;
++ doc_authors: string list;
++ doc_abstract: string option;
++ doc_format: doc_format;
++ (* TODO: src filename. *)
++ doc_data_files: (unix_filename * unix_filename option) list;
++ doc_build_tools: tool list;
++ }
+
+
+ type section =
+@@ -1341,50 +1732,51 @@ module OASISTypes = struct
+ | Doc of common_section * doc
+
+
+-
+ type section_kind =
+- [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
++ [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
+
+
+ type package =
+- {
+- oasis_version: OASISVersion.t;
+- ocaml_version: OASISVersion.comparator option;
+- findlib_version: OASISVersion.comparator option;
+- alpha_features: string list;
+- beta_features: string list;
+- name: package_name;
+- version: OASISVersion.t;
+- license: OASISLicense.t;
+- license_file: unix_filename option;
+- copyrights: string list;
+- maintainers: string list;
+- authors: string list;
+- homepage: url option;
+- synopsis: string;
+- description: OASISText.t option;
+- categories: url list;
+-
+- conf_type: [`Configure] plugin;
+- conf_custom: custom;
+-
+- build_type: [`Build] plugin;
+- build_custom: custom;
+-
+- install_type: [`Install] plugin;
+- install_custom: custom;
+- uninstall_custom: custom;
+-
+- clean_custom: custom;
+- distclean_custom: custom;
+-
+- files_ab: unix_filename list;
+- sections: section list;
+- plugins: [`Extra] plugin list;
+- disable_oasis_section: unix_filename list;
+- schema_data: PropList.Data.t;
+- plugin_data: plugin_data;
+- }
++ {
++ oasis_version: OASISVersion.t;
++ ocaml_version: OASISVersion.comparator option;
++ findlib_version: OASISVersion.comparator option;
++ alpha_features: string list;
++ beta_features: string list;
++ name: package_name;
++ version: OASISVersion.t;
++ license: OASISLicense.t;
++ license_file: unix_filename option; (* TODO: source filename. *)
++ copyrights: string list;
++ maintainers: string list;
++ authors: string list;
++ homepage: url option;
++ bugreports: url option;
++ synopsis: string;
++ description: OASISText.t option;
++ tags: string list;
++ categories: url list;
++
++ conf_type: [`Configure] plugin;
++ conf_custom: custom;
++
++ build_type: [`Build] plugin;
++ build_custom: custom;
++
++ install_type: [`Install] plugin;
++ install_custom: custom;
++ uninstall_custom: custom;
++
++ clean_custom: custom;
++ distclean_custom: custom;
++
++ files_ab: unix_filename list; (* TODO: source filename. *)
++ sections: section list;
++ plugins: [`Extra] plugin list;
++ disable_oasis_section: unix_filename list; (* TODO: source filename. *)
++ schema_data: PropList.Data.t;
++ plugin_data: plugin_data;
++ }
+
+
+ end
+@@ -1400,19 +1792,19 @@ module OASISFeatures = struct
+ module MapPlugin =
+ Map.Make
+ (struct
+- type t = plugin_kind * name
+- let compare = Pervasives.compare
+- end)
++ type t = plugin_kind * name
++ let compare = Pervasives.compare
++ end)
+
+ module Data =
+ struct
+ type t =
+- {
+- oasis_version: OASISVersion.t;
+- plugin_versions: OASISVersion.t option MapPlugin.t;
+- alpha_features: string list;
+- beta_features: string list;
+- }
++ {
++ oasis_version: OASISVersion.t;
++ plugin_versions: OASISVersion.t option MapPlugin.t;
++ alpha_features: string list;
++ beta_features: string list;
++ }
+
+ let create oasis_version alpha_features beta_features =
+ {
+@@ -1430,10 +1822,10 @@ module OASISFeatures = struct
+
+ let add_plugin (plugin_kind, plugin_name, plugin_version) t =
+ {t with
+- plugin_versions = MapPlugin.add
+- (plugin_kind, plugin_name)
+- plugin_version
+- t.plugin_versions}
++ plugin_versions = MapPlugin.add
++ (plugin_kind, plugin_name)
++ plugin_version
++ t.plugin_versions}
+
+ let plugin_version plugin_kind plugin_name t =
+ MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions
+@@ -1442,17 +1834,17 @@ module OASISFeatures = struct
+ Printf.sprintf
+ "oasis_version: %s; alpha_features: %s; beta_features: %s; \
+ plugins_version: %s"
+- (OASISVersion.string_of_version t.oasis_version)
++ (OASISVersion.string_of_version (t:t).oasis_version)
+ (String.concat ", " t.alpha_features)
+ (String.concat ", " t.beta_features)
+ (String.concat ", "
+ (MapPlugin.fold
+ (fun (_, plg) ver_opt acc ->
+ (plg^
+- (match ver_opt with
+- | Some v ->
+- " "^(OASISVersion.string_of_version v)
+- | None -> ""))
++ (match ver_opt with
++ | Some v ->
++ " "^(OASISVersion.string_of_version v)
++ | None -> ""))
+ :: acc)
+ t.plugin_versions []))
+ end
+@@ -1467,24 +1859,24 @@ module OASISFeatures = struct
+
+ let string_of_stage =
+ function
+- | Alpha -> "alpha"
+- | Beta -> "beta"
++ | Alpha -> "alpha"
++ | Beta -> "beta"
+
+
+ let field_of_stage =
+ function
+- | Alpha -> "AlphaFeatures"
+- | Beta -> "BetaFeatures"
++ | Alpha -> "AlphaFeatures"
++ | Beta -> "BetaFeatures"
+
+ type publication = InDev of stage | SinceVersion of OASISVersion.t
+
+ type t =
+- {
+- name: string;
+- plugin: all_plugin option;
+- publication: publication;
+- description: unit -> string;
+- }
++ {
++ name: string;
++ plugin: all_plugin option;
++ publication: publication;
++ description: unit -> string;
++ }
+
+ (* TODO: mutex protect this. *)
+ let all_features = Hashtbl.create 13
+@@ -1498,35 +1890,35 @@ module OASISFeatures = struct
+ let to_string t =
+ Printf.sprintf
+ "feature: %s; plugin: %s; publication: %s"
+- t.name
++ (t:t).name
+ (match t.plugin with
+- | None -> "<none>"
+- | Some (_, nm, _) -> nm)
++ | None -> "<none>"
++ | Some (_, nm, _) -> nm)
+ (match t.publication with
+- | InDev stage -> string_of_stage stage
+- | SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver))
++ | InDev stage -> string_of_stage stage
++ | SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver))
+
+ let data_check t data origin =
+ let no_message = "no message" in
+
+ let check_feature features stage =
+- let has_feature = List.mem t.name features in
++ let has_feature = List.mem (t:t).name features in
+ if not has_feature then
+- match origin with
+- | Field (fld, where) ->
+- Some
+- (Printf.sprintf
+- (f_ "Field %s in %s is only available when feature %s \
+- is in field %s.")
+- fld where t.name (field_of_stage stage))
+- | Section sct ->
+- Some
+- (Printf.sprintf
+- (f_ "Section %s is only available when features %s \
+- is in field %s.")
+- sct t.name (field_of_stage stage))
+- | NoOrigin ->
+- Some no_message
++ match (origin:origin) with
++ | Field (fld, where) ->
++ Some
++ (Printf.sprintf
++ (f_ "Field %s in %s is only available when feature %s \
++ is in field %s.")
++ fld where t.name (field_of_stage stage))
++ | Section sct ->
++ Some
++ (Printf.sprintf
++ (f_ "Section %s is only available when features %s \
++ is in field %s.")
++ sct t.name (field_of_stage stage))
++ | NoOrigin ->
++ Some no_message
+ else
+ None
+ in
+@@ -1536,132 +1928,128 @@ module OASISFeatures = struct
+ OASISVersion.comparator_apply
+ version (OASISVersion.VGreaterEqual min_version)
+ in
+- Printf.ksprintf
+- (fun str ->
+- if version_is_good then
+- None
+- else
+- Some str)
+- fmt
++ Printf.ksprintf
++ (fun str -> if version_is_good then None else Some str)
++ fmt
+ in
+
+ match origin, t.plugin, t.publication with
+- | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha
+- | _, _, InDev Beta -> check_feature data.Data.beta_features Beta
+- | Field(fld, where), None, SinceVersion min_version ->
+- version_is_good ~min_version data.Data.oasis_version
+- (f_ "Field %s in %s is only valid since OASIS v%s, update \
+- OASISFormat field from '%s' to '%s' after checking \
+- OASIS changelog.")
+- fld where (string_of_version min_version)
+- (string_of_version data.Data.oasis_version)
+- (string_of_version min_version)
++ | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha
++ | _, _, InDev Beta -> check_feature data.Data.beta_features Beta
++ | Field(fld, where), None, SinceVersion min_version ->
++ version_is_good ~min_version data.Data.oasis_version
++ (f_ "Field %s in %s is only valid since OASIS v%s, update \
++ OASISFormat field from '%s' to '%s' after checking \
++ OASIS changelog.")
++ fld where (string_of_version min_version)
++ (string_of_version data.Data.oasis_version)
++ (string_of_version min_version)
+
+- | Field(fld, where), Some(plugin_knd, plugin_name, _),
+- SinceVersion min_version ->
+- begin
++ | Field(fld, where), Some(plugin_knd, plugin_name, _),
++ SinceVersion min_version ->
++ begin
++ try
++ let plugin_version_current =
+ try
+- let plugin_version_current =
+- try
+- match Data.plugin_version plugin_knd plugin_name data with
+- | Some ver -> ver
+- | None ->
+- failwithf
+- (f_ "Field %s in %s is only valid for the OASIS \
+- plugin %s since v%s, but no plugin version is \
+- defined in the _oasis file, change '%s' to \
+- '%s (%s)' in your _oasis file.")
+- fld where plugin_name (string_of_version min_version)
+- plugin_name
+- plugin_name (string_of_version min_version)
+- with Not_found ->
+- failwithf
+- (f_ "Field %s in %s is only valid when the OASIS plugin %s \
+- is defined.")
+- fld where plugin_name
+- in
+- version_is_good ~min_version plugin_version_current
+- (f_ "Field %s in %s is only valid for the OASIS plugin %s \
+- since v%s, update your plugin from '%s (%s)' to \
+- '%s (%s)' after checking the plugin's changelog.")
+- fld where plugin_name (string_of_version min_version)
+- plugin_name (string_of_version plugin_version_current)
+- plugin_name (string_of_version min_version)
+- with Failure msg ->
+- Some msg
+- end
++ match Data.plugin_version plugin_knd plugin_name data with
++ | Some ver -> ver
++ | None ->
++ failwithf
++ (f_ "Field %s in %s is only valid for the OASIS \
++ plugin %s since v%s, but no plugin version is \
++ defined in the _oasis file, change '%s' to \
++ '%s (%s)' in your _oasis file.")
++ fld where plugin_name (string_of_version min_version)
++ plugin_name
++ plugin_name (string_of_version min_version)
++ with Not_found ->
++ failwithf
++ (f_ "Field %s in %s is only valid when the OASIS plugin %s \
++ is defined.")
++ fld where plugin_name
++ in
++ version_is_good ~min_version plugin_version_current
++ (f_ "Field %s in %s is only valid for the OASIS plugin %s \
++ since v%s, update your plugin from '%s (%s)' to \
++ '%s (%s)' after checking the plugin's changelog.")
++ fld where plugin_name (string_of_version min_version)
++ plugin_name (string_of_version plugin_version_current)
++ plugin_name (string_of_version min_version)
++ with Failure msg ->
++ Some msg
++ end
+
+- | Section sct, None, SinceVersion min_version ->
+- version_is_good ~min_version data.Data.oasis_version
+- (f_ "Section %s is only valid for since OASIS v%s, update \
+- OASISFormat field from '%s' to '%s' after checking OASIS \
+- changelog.")
+- sct (string_of_version min_version)
+- (string_of_version data.Data.oasis_version)
+- (string_of_version min_version)
++ | Section sct, None, SinceVersion min_version ->
++ version_is_good ~min_version data.Data.oasis_version
++ (f_ "Section %s is only valid for since OASIS v%s, update \
++ OASISFormat field from '%s' to '%s' after checking OASIS \
++ changelog.")
++ sct (string_of_version min_version)
++ (string_of_version data.Data.oasis_version)
++ (string_of_version min_version)
+
+- | Section sct, Some(plugin_knd, plugin_name, _),
+- SinceVersion min_version ->
+- begin
++ | Section sct, Some(plugin_knd, plugin_name, _),
++ SinceVersion min_version ->
++ begin
++ try
++ let plugin_version_current =
+ try
+- let plugin_version_current =
+- try
+- match Data.plugin_version plugin_knd plugin_name data with
+- | Some ver -> ver
+- | None ->
+- failwithf
+- (f_ "Section %s is only valid for the OASIS \
+- plugin %s since v%s, but no plugin version is \
+- defined in the _oasis file, change '%s' to \
+- '%s (%s)' in your _oasis file.")
+- sct plugin_name (string_of_version min_version)
+- plugin_name
+- plugin_name (string_of_version min_version)
+- with Not_found ->
+- failwithf
+- (f_ "Section %s is only valid when the OASIS plugin %s \
+- is defined.")
+- sct plugin_name
+- in
+- version_is_good ~min_version plugin_version_current
+- (f_ "Section %s is only valid for the OASIS plugin %s \
+- since v%s, update your plugin from '%s (%s)' to \
+- '%s (%s)' after checking the plugin's changelog.")
+- sct plugin_name (string_of_version min_version)
+- plugin_name (string_of_version plugin_version_current)
+- plugin_name (string_of_version min_version)
+- with Failure msg ->
+- Some msg
+- end
++ match Data.plugin_version plugin_knd plugin_name data with
++ | Some ver -> ver
++ | None ->
++ failwithf
++ (f_ "Section %s is only valid for the OASIS \
++ plugin %s since v%s, but no plugin version is \
++ defined in the _oasis file, change '%s' to \
++ '%s (%s)' in your _oasis file.")
++ sct plugin_name (string_of_version min_version)
++ plugin_name
++ plugin_name (string_of_version min_version)
++ with Not_found ->
++ failwithf
++ (f_ "Section %s is only valid when the OASIS plugin %s \
++ is defined.")
++ sct plugin_name
++ in
++ version_is_good ~min_version plugin_version_current
++ (f_ "Section %s is only valid for the OASIS plugin %s \
++ since v%s, update your plugin from '%s (%s)' to \
++ '%s (%s)' after checking the plugin's changelog.")
++ sct plugin_name (string_of_version min_version)
++ plugin_name (string_of_version plugin_version_current)
++ plugin_name (string_of_version min_version)
++ with Failure msg ->
++ Some msg
++ end
+
+- | NoOrigin, None, SinceVersion min_version ->
+- version_is_good ~min_version data.Data.oasis_version "%s" no_message
++ | NoOrigin, None, SinceVersion min_version ->
++ version_is_good ~min_version data.Data.oasis_version "%s" no_message
+
+- | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version ->
+- begin
+- try
+- let plugin_version_current =
+- match Data.plugin_version plugin_knd plugin_name data with
+- | Some ver -> ver
+- | None -> raise Not_found
+- in
+- version_is_good ~min_version plugin_version_current
+- "%s" no_message
+- with Not_found ->
+- Some no_message
+- end
++ | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version ->
++ begin
++ try
++ let plugin_version_current =
++ match Data.plugin_version plugin_knd plugin_name data with
++ | Some ver -> ver
++ | None -> raise Not_found
++ in
++ version_is_good ~min_version plugin_version_current
++ "%s" no_message
++ with Not_found ->
++ Some no_message
++ end
+
+
+ let data_assert t data origin =
+ match data_check t data origin with
+- | None -> ()
+- | Some str -> failwith str
++ | None -> ()
++ | Some str -> failwith str
+
+
+ let data_test t data =
+ match data_check t data NoOrigin with
+- | None -> true
+- | Some str -> false
++ | None -> true
++ | Some _ -> false
+
+
+ let package_test t pkg =
+@@ -1681,8 +2069,8 @@ module OASISFeatures = struct
+ description = description;
+ }
+ in
+- Hashtbl.add all_features name t;
+- t
++ Hashtbl.add all_features name t;
++ t
+
+
+ let get_stage name =
+@@ -1711,14 +2099,14 @@ module OASISFeatures = struct
+ create "flag_docs"
+ (since_version "0.3")
+ (fun () ->
+- s_ "Building docs require '-docs' flag at configure.")
++ s_ "Make building docs require '-docs' flag at configure.")
+
+
+ let flag_tests =
+ create "flag_tests"
+ (since_version "0.3")
+ (fun () ->
+- s_ "Running tests require '-tests' flag at configure.")
++ s_ "Make running tests require '-tests' flag at configure.")
+
+
+ let pack =
+@@ -1743,146 +2131,36 @@ module OASISFeatures = struct
+ let compiled_setup_ml =
+ create "compiled_setup_ml" alpha
+ (fun () ->
+- s_ "It compiles the setup.ml and speed-up actions done with it.")
++ s_ "Compile the setup.ml and speed-up actions done with it.")
+
+ let disable_oasis_section =
+ create "disable_oasis_section" alpha
+ (fun () ->
+- s_ "Allows the OASIS section comments and digest to be omitted in \
+- generated files.")
+-end
+-
+-module OASISUnixPath = struct
+-(* # 22 "src/oasis/OASISUnixPath.ml" *)
+-
+-
+- type unix_filename = string
+- type unix_dirname = string
+-
+-
+- type host_filename = string
+- type host_dirname = string
+-
+-
+- let current_dir_name = "."
+-
+-
+- let parent_dir_name = ".."
+-
+-
+- let is_current_dir fn =
+- fn = current_dir_name || fn = ""
+-
+-
+- let concat f1 f2 =
+- if is_current_dir f1 then
+- f2
+- else
+- let f1' =
+- try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1
+- in
+- f1'^"/"^f2
+-
+-
+- let make =
+- function
+- | hd :: tl ->
+- List.fold_left
+- (fun f p -> concat f p)
+- hd
+- tl
+- | [] ->
+- invalid_arg "OASISUnixPath.make"
+-
+-
+- let dirname f =
+- try
+- String.sub f 0 (String.rindex f '/')
+- with Not_found ->
+- current_dir_name
+-
+-
+- let basename f =
+- try
+- let pos_start =
+- (String.rindex f '/') + 1
+- in
+- String.sub f pos_start ((String.length f) - pos_start)
+- with Not_found ->
+- f
+-
+-
+- let chop_extension f =
+- try
+- let last_dot =
+- String.rindex f '.'
+- in
+- let sub =
+- String.sub f 0 last_dot
+- in
+- try
+- let last_slash =
+- String.rindex f '/'
+- in
+- if last_slash < last_dot then
+- sub
+- else
+- f
+- with Not_found ->
+- sub
+-
+- with Not_found ->
+- f
+-
+-
+- let capitalize_file f =
+- let dir = dirname f in
+- let base = basename f in
+- concat dir (String.capitalize base)
+-
+-
+- let uncapitalize_file f =
+- let dir = dirname f in
+- let base = basename f in
+- concat dir (String.uncapitalize base)
+-
+-
+-end
+-
+-module OASISHostPath = struct
+-(* # 22 "src/oasis/OASISHostPath.ml" *)
+-
+-
+- open Filename
+-
+-
+- module Unix = OASISUnixPath
+-
+-
+- let make =
+- function
+- | [] ->
+- invalid_arg "OASISHostPath.make"
+- | hd :: tl ->
+- List.fold_left Filename.concat hd tl
++ s_ "Allow the OASIS section comments and digests to be omitted in \
++ generated files.")
+
++ let no_automatic_syntax =
++ create "no_automatic_syntax" alpha
++ (fun () ->
++ s_ "Disable the automatic inclusion of -syntax camlp4o for packages \
++ that matches the internal heuristic (if a dependency ends with \
++ a .syntax or is a well known syntax).")
+
+- let of_unix ufn =
+- if Sys.os_type = "Unix" then
+- ufn
+- else
+- make
+- (List.map
+- (fun p ->
+- if p = Unix.current_dir_name then
+- current_dir_name
+- else if p = Unix.parent_dir_name then
+- parent_dir_name
+- else
+- p)
+- (OASISString.nsplit ufn '/'))
++ let findlib_directory =
++ create "findlib_directory" beta
++ (fun () ->
++ s_ "Allow to install findlib libraries in sub-directories of the target \
++ findlib directory.")
+
++ let findlib_extra_files =
++ create "findlib_extra_files" beta
++ (fun () ->
++ s_ "Allow to install extra files for findlib libraries.")
+
++ let source_patterns =
++ create "source_patterns" alpha
++ (fun () ->
++ s_ "Customize mapping between module name and source file.")
+ end
+
+ module OASISSection = struct
+@@ -1895,19 +2173,19 @@ module OASISSection = struct
+ let section_kind_common =
+ function
+ | Library (cs, _, _) ->
+- `Library, cs
++ `Library, cs
+ | Object (cs, _, _) ->
+- `Object, cs
++ `Object, cs
+ | Executable (cs, _, _) ->
+- `Executable, cs
++ `Executable, cs
+ | Flag (cs, _) ->
+- `Flag, cs
++ `Flag, cs
+ | SrcRepo (cs, _) ->
+- `SrcRepo, cs
++ `SrcRepo, cs
+ | Test (cs, _) ->
+- `Test, cs
++ `Test, cs
+ | Doc (cs, _) ->
+- `Doc, cs
++ `Doc, cs
+
+
+ let section_common sct =
+@@ -1926,27 +2204,28 @@ module OASISSection = struct
+
+
+ (** Key used to identify section
+- *)
++ *)
+ let section_id sct =
+ let k, cs =
+ section_kind_common sct
+ in
+- k, cs.cs_name
++ k, cs.cs_name
++
++
++ let string_of_section_kind =
++ function
++ | `Library -> "library"
++ | `Object -> "object"
++ | `Executable -> "executable"
++ | `Flag -> "flag"
++ | `SrcRepo -> "src repository"
++ | `Test -> "test"
++ | `Doc -> "doc"
+
+
+ let string_of_section sct =
+- let k, nm =
+- section_id sct
+- in
+- (match k with
+- | `Library -> "library"
+- | `Object -> "object"
+- | `Executable -> "executable"
+- | `Flag -> "flag"
+- | `SrcRepo -> "src repository"
+- | `Test -> "test"
+- | `Doc -> "doc")
+- ^" "^nm
++ let k, nm = section_id sct in
++ (string_of_section_kind k)^" "^nm
+
+
+ let section_find id scts =
+@@ -1981,6 +2260,32 @@ end
+ module OASISBuildSection = struct
+ (* # 22 "src/oasis/OASISBuildSection.ml" *)
+
++ open OASISTypes
++
++ (* Look for a module file, considering capitalization or not. *)
++ let find_module source_file_exists bs modul =
++ let possible_lst =
++ OASISSourcePatterns.all_possible_files
++ (bs.bs_interface_patterns @ bs.bs_implementation_patterns)
++ ~path:bs.bs_path
++ ~modul
++ in
++ match List.filter source_file_exists possible_lst with
++ | (fn :: _) as fn_lst -> `Sources (OASISUnixPath.chop_extension fn, fn_lst)
++ | [] ->
++ let open OASISUtils in
++ let _, rev_lst =
++ List.fold_left
++ (fun (set, acc) fn ->
++ let base_fn = OASISUnixPath.chop_extension fn in
++ if SetString.mem base_fn set then
++ set, acc
++ else
++ SetString.add base_fn set, base_fn :: acc)
++ (SetString.empty, []) possible_lst
++ in
++ `No_sources (List.rev rev_lst)
++
+
+ end
+
+@@ -2004,16 +2309,16 @@ module OASISExecutable = struct
+ | Byte -> false
+ in
+
+- OASISUnixPath.concat
+- dir
+- (cs.cs_name^(suffix_program ())),
+-
+- if not is_native_exec &&
+- not exec.exec_custom &&
+- bs.bs_c_sources <> [] then
+- Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ()))
+- else
+- None
++ OASISUnixPath.concat
++ dir
++ (cs.cs_name^(suffix_program ())),
++
++ if not is_native_exec &&
++ not exec.exec_custom &&
++ bs.bs_c_sources <> [] then
++ Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ()))
++ else
++ None
+
+
+ end
+@@ -2023,144 +2328,109 @@ module OASISLibrary = struct
+
+
+ open OASISTypes
+- open OASISUtils
+ open OASISGettext
+- open OASISSection
+-
+-
+- (* Look for a module file, considering capitalization or not. *)
+- let find_module source_file_exists bs modul =
+- let possible_base_fn =
+- List.map
+- (OASISUnixPath.concat bs.bs_path)
+- [modul;
+- OASISUnixPath.uncapitalize_file modul;
+- OASISUnixPath.capitalize_file modul]
+- in
+- (* TODO: we should be able to be able to determine the source for every
+- * files. Hence we should introduce a Module(source: fn) for the fields
+- * Modules and InternalModules
+- *)
+- List.fold_left
+- (fun acc base_fn ->
+- match acc with
+- | `No_sources _ ->
+- begin
+- let file_found =
+- List.fold_left
+- (fun acc ext ->
+- if source_file_exists (base_fn^ext) then
+- (base_fn^ext) :: acc
+- else
+- acc)
+- []
+- [".ml"; ".mli"; ".mll"; ".mly"]
+- in
+- match file_found with
+- | [] ->
+- acc
+- | lst ->
+- `Sources (base_fn, lst)
+- end
+- | `Sources _ ->
+- acc)
+- (`No_sources possible_base_fn)
+- possible_base_fn
+
++ let find_module ~ctxt source_file_exists cs bs modul =
++ match OASISBuildSection.find_module source_file_exists bs modul with
++ | `Sources _ as res -> res
++ | `No_sources _ as res ->
++ OASISMessage.warning
++ ~ctxt
++ (f_ "Cannot find source file matching module '%s' in library %s.")
++ modul cs.cs_name;
++ OASISMessage.warning
++ ~ctxt
++ (f_ "Use InterfacePatterns or ImplementationPatterns to define \
++ this file with feature %S.")
++ (OASISFeatures.source_patterns.OASISFeatures.name);
++ res
+
+ let source_unix_files ~ctxt (cs, bs, lib) source_file_exists =
+ List.fold_left
+ (fun acc modul ->
+- match find_module source_file_exists bs modul with
+- | `Sources (base_fn, lst) ->
+- (base_fn, lst) :: acc
+- | `No_sources _ ->
+- OASISMessage.warning
+- ~ctxt
+- (f_ "Cannot find source file matching \
+- module '%s' in library %s")
+- modul cs.cs_name;
+- acc)
++ match find_module ~ctxt source_file_exists cs bs modul with
++ | `Sources (base_fn, lst) -> (base_fn, lst) :: acc
++ | `No_sources _ -> acc)
+ []
+ (lib.lib_modules @ lib.lib_internal_modules)
+
+
+ let generated_unix_files
+- ~ctxt
+- ~is_native
+- ~has_native_dynlink
+- ~ext_lib
+- ~ext_dll
+- ~source_file_exists
+- (cs, bs, lib) =
++ ~ctxt
++ ~is_native
++ ~has_native_dynlink
++ ~ext_lib
++ ~ext_dll
++ ~source_file_exists
++ (cs, bs, lib) =
+
+ let find_modules lst ext =
+ let find_module modul =
+- match find_module source_file_exists bs modul with
+- | `Sources (base_fn, [fn]) when ext <> "cmi"
+- && Filename.check_suffix fn ".mli" ->
+- None (* No implementation files for pure interface. *)
+- | `Sources (base_fn, _) ->
+- Some [base_fn]
+- | `No_sources lst ->
+- OASISMessage.warning
+- ~ctxt
+- (f_ "Cannot find source file matching \
+- module '%s' in library %s")
+- modul cs.cs_name;
+- Some lst
++ match find_module ~ctxt source_file_exists cs bs modul with
++ | `Sources (_, [fn]) when ext <> "cmi"
++ && Filename.check_suffix fn ".mli" ->
++ None (* No implementation files for pure interface. *)
++ | `Sources (base_fn, _) -> Some [base_fn]
++ | `No_sources lst -> Some lst
+ in
+ List.fold_left
+ (fun acc nm ->
+- match find_module nm with
+- | None -> acc
+- | Some base_fns ->
+- List.map (fun base_fn -> base_fn ^"."^ext) base_fns :: acc)
++ match find_module nm with
++ | None -> acc
++ | Some base_fns ->
++ List.map (fun base_fn -> base_fn ^"."^ext) base_fns :: acc)
+ []
+ lst
+ in
+
+- (* The headers that should be compiled along *)
+- let headers =
+- if lib.lib_pack then
+- []
+- else
+- find_modules
+- lib.lib_modules
+- "cmi"
+- in
+-
+ (* The .cmx that be compiled along *)
+ let cmxs =
+ let should_be_built =
+ match bs.bs_compiled_object with
+- | Native -> true
+- | Best -> is_native
+- | Byte -> false
+- in
+- if should_be_built then
+- if lib.lib_pack then
+- find_modules
+- [cs.cs_name]
+- "cmx"
+- else
+- find_modules
+- (lib.lib_modules @ lib.lib_internal_modules)
+- "cmx"
++ | Native -> true
++ | Best -> is_native
++ | Byte -> false
++ in
++ if should_be_built then
++ if lib.lib_pack then
++ find_modules
++ [cs.cs_name]
++ "cmx"
+ else
+- []
++ find_modules
++ (lib.lib_modules @ lib.lib_internal_modules)
++ "cmx"
++ else
++ []
+ in
+
+ let acc_nopath =
+ []
+ in
+
++ (* The headers and annot/cmt files that should be compiled along *)
++ let headers =
++ let sufx =
++ if lib.lib_pack
++ then [".cmti"; ".cmt"; ".annot"]
++ else [".cmi"; ".cmti"; ".cmt"; ".annot"]
++ in
++ List.map
++ (List.fold_left
++ (fun accu s ->
++ let dot = String.rindex s '.' in
++ let base = String.sub s 0 dot in
++ List.map ((^) base) sufx @ accu)
++ [])
++ (find_modules lib.lib_modules "cmi")
++ in
++
+ (* Compute what libraries should be built *)
+ let acc_nopath =
+ (* Add the packed header file if required *)
+ let add_pack_header acc =
+ if lib.lib_pack then
+- [cs.cs_name^".cmi"] :: acc
++ [cs.cs_name^".cmi"; cs.cs_name^".cmti"; cs.cs_name^".cmt"] :: acc
+ else
+ acc
+ in
+@@ -2174,38 +2444,35 @@ module OASISLibrary = struct
+ [cs.cs_name^".cmxs"] :: acc
+ else acc)
+ in
+- [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc
++ [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc
+ in
+- match bs.bs_compiled_object with
+- | Native ->
+- byte (native acc_nopath)
+- | Best when is_native ->
+- byte (native acc_nopath)
+- | Byte | Best ->
+- byte acc_nopath
++ match bs.bs_compiled_object with
++ | Native -> byte (native acc_nopath)
++ | Best when is_native -> byte (native acc_nopath)
++ | Byte | Best -> byte acc_nopath
+ in
+
+ (* Add C library to be built *)
+ let acc_nopath =
+- if bs.bs_c_sources <> [] then
+- begin
+- ["lib"^cs.cs_name^"_stubs"^ext_lib]
+- ::
+- ["dll"^cs.cs_name^"_stubs"^ext_dll]
+- ::
++ if bs.bs_c_sources <> [] then begin
++ ["lib"^cs.cs_name^"_stubs"^ext_lib]
++ ::
++ if has_native_dynlink then
++ ["dll"^cs.cs_name^"_stubs"^ext_dll] :: acc_nopath
++ else
+ acc_nopath
+- end
+- else
++ end else begin
+ acc_nopath
++ end
+ in
+
+- (* All the files generated *)
+- List.rev_append
+- (List.rev_map
+- (List.rev_map
+- (OASISUnixPath.concat bs.bs_path))
+- acc_nopath)
+- (headers @ cmxs)
++ (* All the files generated *)
++ List.rev_append
++ (List.rev_map
++ (List.rev_map
++ (OASISUnixPath.concat bs.bs_path))
++ acc_nopath)
++ (headers @ cmxs)
+
+
+ end
+@@ -2218,62 +2485,64 @@ module OASISObject = struct
+ open OASISGettext
+
+
++ let find_module ~ctxt source_file_exists cs bs modul =
++ match OASISBuildSection.find_module source_file_exists bs modul with
++ | `Sources _ as res -> res
++ | `No_sources _ as res ->
++ OASISMessage.warning
++ ~ctxt
++ (f_ "Cannot find source file matching module '%s' in object %s.")
++ modul cs.cs_name;
++ OASISMessage.warning
++ ~ctxt
++ (f_ "Use InterfacePatterns or ImplementationPatterns to define \
++ this file with feature %S.")
++ (OASISFeatures.source_patterns.OASISFeatures.name);
++ res
++
+ let source_unix_files ~ctxt (cs, bs, obj) source_file_exists =
+ List.fold_left
+ (fun acc modul ->
+- match OASISLibrary.find_module source_file_exists bs modul with
+- | `Sources (base_fn, lst) ->
+- (base_fn, lst) :: acc
+- | `No_sources _ ->
+- OASISMessage.warning
+- ~ctxt
+- (f_ "Cannot find source file matching \
+- module '%s' in object %s")
+- modul cs.cs_name;
+- acc)
++ match find_module ~ctxt source_file_exists cs bs modul with
++ | `Sources (base_fn, lst) -> (base_fn, lst) :: acc
++ | `No_sources _ -> acc)
+ []
+ obj.obj_modules
+
+
+ let generated_unix_files
+- ~ctxt
+- ~is_native
+- ~source_file_exists
+- (cs, bs, obj) =
++ ~ctxt
++ ~is_native
++ ~source_file_exists
++ (cs, bs, obj) =
+
+ let find_module ext modul =
+- match OASISLibrary.find_module source_file_exists bs modul with
+- | `Sources (base_fn, _) -> [base_fn ^ ext]
+- | `No_sources lst ->
+- OASISMessage.warning
+- ~ctxt
+- (f_ "Cannot find source file matching \
+- module '%s' in object %s")
+- modul cs.cs_name ;
+- lst
++ match find_module ~ctxt source_file_exists cs bs modul with
++ | `Sources (base_fn, _) -> [base_fn ^ ext]
++ | `No_sources lst -> lst
+ in
+
+ let header, byte, native, c_object, f =
+ match obj.obj_modules with
+ | [ m ] -> (find_module ".cmi" m,
+- find_module ".cmo" m,
+- find_module ".cmx" m,
+- find_module ".o" m,
+- fun x -> x)
++ find_module ".cmo" m,
++ find_module ".cmx" m,
++ find_module ".o" m,
++ fun x -> x)
+ | _ -> ([cs.cs_name ^ ".cmi"],
+- [cs.cs_name ^ ".cmo"],
+- [cs.cs_name ^ ".cmx"],
+- [cs.cs_name ^ ".o"],
+- OASISUnixPath.concat bs.bs_path)
++ [cs.cs_name ^ ".cmo"],
++ [cs.cs_name ^ ".cmx"],
++ [cs.cs_name ^ ".o"],
++ OASISUnixPath.concat bs.bs_path)
+ in
+- List.map (List.map f) (
+- match bs.bs_compiled_object with
+- | Native ->
+- native :: c_object :: byte :: header :: []
+- | Best when is_native ->
+- native :: c_object :: byte :: header :: []
+- | Byte | Best ->
+- byte :: header :: [])
++ List.map (List.map f) (
++ match bs.bs_compiled_object with
++ | Native ->
++ native :: c_object :: byte :: header :: []
++ | Best when is_native ->
++ native :: c_object :: byte :: header :: []
++ | Byte | Best ->
++ byte :: header :: [])
+
+
+ end
+@@ -2285,7 +2554,6 @@ module OASISFindlib = struct
+ open OASISTypes
+ open OASISUtils
+ open OASISGettext
+- open OASISSection
+
+
+ type library_name = name
+@@ -2303,12 +2571,13 @@ module OASISFindlib = struct
+ common_section *
+ build_section *
+ [`Library of library | `Object of object_] *
++ unix_dirname option *
+ group_t list)
+
+
+ type data = common_section *
+- build_section *
+- [`Library of library | `Object of object_]
++ build_section *
++ [`Library of library | `Object of object_]
+ type tree =
+ | Node of (data option) * (tree MapString.t)
+ | Leaf of data
+@@ -2326,53 +2595,53 @@ module OASISFindlib = struct
+ let name =
+ String.concat "." (lib.lib_findlib_containers @ [name])
+ in
+- name
++ name
+ in
+- List.fold_left
+- (fun mp ->
+- function
+- | Library (cs, _, lib) ->
+- begin
+- let lib_name = cs.cs_name in
+- let fndlb_parts = fndlb_parts cs lib in
+- if MapString.mem lib_name mp then
+- failwithf
+- (f_ "The library name '%s' is used more than once.")
+- lib_name;
+- match lib.lib_findlib_parent with
+- | Some lib_name_parent ->
+- MapString.add
+- lib_name
+- (`Unsolved (lib_name_parent, fndlb_parts))
+- mp
+- | None ->
+- MapString.add
+- lib_name
+- (`Solved fndlb_parts)
+- mp
+- end
+-
+- | Object (cs, _, obj) ->
+- begin
+- let obj_name = cs.cs_name in
+- if MapString.mem obj_name mp then
+- failwithf
+- (f_ "The object name '%s' is used more than once.")
+- obj_name;
+- let findlib_full_name = match obj.obj_findlib_fullname with
+- | Some ns -> String.concat "." ns
+- | None -> obj_name
+- in
++ List.fold_left
++ (fun mp ->
++ function
++ | Library (cs, _, lib) ->
++ begin
++ let lib_name = cs.cs_name in
++ let fndlb_parts = fndlb_parts cs lib in
++ if MapString.mem lib_name mp then
++ failwithf
++ (f_ "The library name '%s' is used more than once.")
++ lib_name;
++ match lib.lib_findlib_parent with
++ | Some lib_name_parent ->
++ MapString.add
++ lib_name
++ (`Unsolved (lib_name_parent, fndlb_parts))
++ mp
++ | None ->
+ MapString.add
+- obj_name
+- (`Solved findlib_full_name)
++ lib_name
++ (`Solved fndlb_parts)
+ mp
+- end
++ end
+
+- | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ ->
+- mp)
+- MapString.empty
+- pkg.sections
++ | Object (cs, _, obj) ->
++ begin
++ let obj_name = cs.cs_name in
++ if MapString.mem obj_name mp then
++ failwithf
++ (f_ "The object name '%s' is used more than once.")
++ obj_name;
++ let findlib_full_name = match obj.obj_findlib_fullname with
++ | Some ns -> String.concat "." ns
++ | None -> obj_name
++ in
++ MapString.add
++ obj_name
++ (`Solved findlib_full_name)
++ mp
++ end
++
++ | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ ->
++ mp)
++ MapString.empty
++ pkg.sections
+ in
+
+ (* Solve the above graph to be only library name to full findlib name. *)
+@@ -2384,40 +2653,40 @@ module OASISFindlib = struct
+ with regard to findlib naming.")
+ lib_name;
+ let visited = SetString.add lib_name visited in
+- try
+- match MapString.find lib_name mp with
+- | `Solved fndlb_nm ->
+- fndlb_nm, mp
+- | `Unsolved (lib_nm_parent, post_fndlb_nm) ->
+- let pre_fndlb_nm, mp =
+- solve visited mp lib_nm_parent lib_name
+- in
+- let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in
+- fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp
+- with Not_found ->
+- failwithf
+- (f_ "Library '%s', which is defined as the findlib parent of \
+- library '%s', doesn't exist.")
+- lib_name lib_name_child
++ try
++ match MapString.find lib_name mp with
++ | `Solved fndlb_nm ->
++ fndlb_nm, mp
++ | `Unsolved (lib_nm_parent, post_fndlb_nm) ->
++ let pre_fndlb_nm, mp =
++ solve visited mp lib_nm_parent lib_name
++ in
++ let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in
++ fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp
++ with Not_found ->
++ failwithf
++ (f_ "Library '%s', which is defined as the findlib parent of \
++ library '%s', doesn't exist.")
++ lib_name lib_name_child
+ in
+ let mp =
+ MapString.fold
+ (fun lib_name status mp ->
+ match status with
+ | `Solved _ ->
+- (* Solved initialy, no need to go further *)
+- mp
++ (* Solved initialy, no need to go further *)
++ mp
+ | `Unsolved _ ->
+- let _, mp = solve SetString.empty mp lib_name "<none>" in
+- mp)
++ let _, mp = solve SetString.empty mp lib_name "<none>" in
++ mp)
+ fndlb_parts_of_lib_name
+ fndlb_parts_of_lib_name
+ in
+- MapString.map
+- (function
+- | `Solved fndlb_nm -> fndlb_nm
+- | `Unsolved _ -> assert false)
+- mp
++ MapString.map
++ (function
++ | `Solved fndlb_nm -> fndlb_nm
++ | `Unsolved _ -> assert false)
++ mp
+ in
+
+ (* Convert an internal library name to a findlib name. *)
+@@ -2429,75 +2698,89 @@ module OASISFindlib = struct
+ in
+
+ (* Add a library to the tree.
+- *)
++ *)
+ let add sct mp =
+ let fndlb_fullname =
+ let cs, _, _ = sct in
+ let lib_name = cs.cs_name in
+- findlib_name_of_library_name lib_name
++ findlib_name_of_library_name lib_name
+ in
+ let rec add_children nm_lst (children: tree MapString.t) =
+ match nm_lst with
+ | (hd :: tl) ->
+- begin
+- let node =
+- try
+- add_node tl (MapString.find hd children)
+- with Not_found ->
+- (* New node *)
+- new_node tl
+- in
+- MapString.add hd node children
+- end
++ begin
++ let node =
++ try
++ add_node tl (MapString.find hd children)
++ with Not_found ->
++ (* New node *)
++ new_node tl
++ in
++ MapString.add hd node children
++ end
+ | [] ->
+- (* Should not have a nameless library. *)
+- assert false
++ (* Should not have a nameless library. *)
++ assert false
+ and add_node tl node =
+ if tl = [] then
+ begin
+ match node with
+ | Node (None, children) ->
+- Node (Some sct, children)
++ Node (Some sct, children)
+ | Leaf (cs', _, _) | Node (Some (cs', _, _), _) ->
+- (* TODO: allow to merge Package, i.e.
+- * archive(byte) = "foo.cma foo_init.cmo"
+- *)
+- let cs, _, _ = sct in
+- failwithf
+- (f_ "Library '%s' and '%s' have the same findlib name '%s'")
+- cs.cs_name cs'.cs_name fndlb_fullname
++ (* TODO: allow to merge Package, i.e.
++ * archive(byte) = "foo.cma foo_init.cmo"
++ *)
++ let cs, _, _ = sct in
++ failwithf
++ (f_ "Library '%s' and '%s' have the same findlib name '%s'")
++ cs.cs_name cs'.cs_name fndlb_fullname
+ end
+ else
+ begin
+ match node with
+ | Leaf data ->
+- Node (Some data, add_children tl MapString.empty)
++ Node (Some data, add_children tl MapString.empty)
+ | Node (data_opt, children) ->
+- Node (data_opt, add_children tl children)
++ Node (data_opt, add_children tl children)
+ end
+ and new_node =
+ function
+ | [] ->
+- Leaf sct
++ Leaf sct
+ | hd :: tl ->
+- Node (None, MapString.add hd (new_node tl) MapString.empty)
++ Node (None, MapString.add hd (new_node tl) MapString.empty)
++ in
++ add_children (OASISString.nsplit fndlb_fullname '.') mp
++ in
++
++ let unix_directory dn lib =
++ let directory =
++ match lib with
++ | `Library lib -> lib.lib_findlib_directory
++ | `Object obj -> obj.obj_findlib_directory
+ in
+- add_children (OASISString.nsplit fndlb_fullname '.') mp
++ match dn, directory with
++ | None, None -> None
++ | None, Some dn | Some dn, None -> Some dn
++ | Some dn1, Some dn2 -> Some (OASISUnixPath.concat dn1 dn2)
+ in
+
+- let rec group_of_tree mp =
++ let rec group_of_tree dn mp =
+ MapString.fold
+ (fun nm node acc ->
+ let cur =
+ match node with
+- | Node (Some (cs, bs, lib), children) ->
+- Package (nm, cs, bs, lib, group_of_tree children)
+- | Node (None, children) ->
+- Container (nm, group_of_tree children)
+- | Leaf (cs, bs, lib) ->
+- Package (nm, cs, bs, lib, [])
++ | Node (Some (cs, bs, lib), children) ->
++ let current_dn = unix_directory dn lib in
++ Package (nm, cs, bs, lib, current_dn, group_of_tree current_dn children)
++ | Node (None, children) ->
++ Container (nm, group_of_tree dn children)
++ | Leaf (cs, bs, lib) ->
++ let current_dn = unix_directory dn lib in
++ Package (nm, cs, bs, lib, current_dn, [])
+ in
+- cur :: acc)
++ cur :: acc)
+ mp []
+ in
+
+@@ -2506,27 +2789,25 @@ module OASISFindlib = struct
+ (fun mp ->
+ function
+ | Library (cs, bs, lib) ->
+- add (cs, bs, `Library lib) mp
++ add (cs, bs, `Library lib) mp
+ | Object (cs, bs, obj) ->
+- add (cs, bs, `Object obj) mp
++ add (cs, bs, `Object obj) mp
+ | _ ->
+- mp)
++ mp)
+ MapString.empty
+ pkg.sections
+ in
+
+- let groups =
+- group_of_tree group_mp
+- in
++ let groups = group_of_tree None group_mp in
+
+ let library_name_of_findlib_name =
+- Lazy.lazy_from_fun
+- (fun () ->
+- (* Revert findlib_name_of_library_name. *)
+- MapString.fold
+- (fun k v mp -> MapString.add v k mp)
+- fndlb_name_of_lib_name
+- MapString.empty)
++ lazy begin
++ (* Revert findlib_name_of_library_name. *)
++ MapString.fold
++ (fun k v mp -> MapString.add v k mp)
++ fndlb_name_of_lib_name
++ MapString.empty
++ end
+ in
+ let library_name_of_findlib_name fndlb_nm =
+ try
+@@ -2535,15 +2816,15 @@ module OASISFindlib = struct
+ raise (FindlibPackageNotFound fndlb_nm)
+ in
+
+- groups,
+- findlib_name_of_library_name,
+- library_name_of_findlib_name
++ groups,
++ findlib_name_of_library_name,
++ library_name_of_findlib_name
+
+
+ let findlib_of_group =
+ function
+ | Container (fndlb_nm, _)
+- | Package (fndlb_nm, _, _, _, _) -> fndlb_nm
++ | Package (fndlb_nm, _, _, _, _, _) -> fndlb_nm
+
+
+ let root_of_group grp =
+@@ -2551,24 +2832,24 @@ module OASISFindlib = struct
+ (* We do a DFS in the group. *)
+ function
+ | Container (_, children) ->
+- List.fold_left
+- (fun res grp ->
+- if res = None then
+- root_lib_aux grp
+- else
+- res)
+- None
+- children
+- | Package (_, cs, bs, lib, _) ->
+- Some (cs, bs, lib)
+- in
+- match root_lib_aux grp with
+- | Some res ->
+- res
+- | None ->
+- failwithf
+- (f_ "Unable to determine root library of findlib library '%s'")
+- (findlib_of_group grp)
++ List.fold_left
++ (fun res grp ->
++ if res = None then
++ root_lib_aux grp
++ else
++ res)
++ None
++ children
++ | Package (_, cs, bs, lib, _, _) ->
++ Some (cs, bs, lib)
++ in
++ match root_lib_aux grp with
++ | Some res ->
++ res
++ | None ->
++ failwithf
++ (f_ "Unable to determine root library of findlib library '%s'")
++ (findlib_of_group grp)
+
+
+ end
+@@ -2614,7 +2895,7 @@ module OASISExec = struct
+
+ (* TODO: I don't like this quote, it is there because $(rm) foo expands to
+ * 'rm -f' foo...
+- *)
++ *)
+ let run ~ctxt ?f_exit_code ?(quote=true) cmd args =
+ let cmd =
+ if quote then
+@@ -2632,57 +2913,57 @@ module OASISExec = struct
+ let cmdline =
+ String.concat " " (cmd :: args)
+ in
+- info ~ctxt (f_ "Running command '%s'") cmdline;
+- match f_exit_code, Sys.command cmdline with
+- | None, 0 -> ()
+- | None, i ->
+- failwithf
+- (f_ "Command '%s' terminated with error code %d")
+- cmdline i
+- | Some f, i ->
+- f i
++ info ~ctxt (f_ "Running command '%s'") cmdline;
++ match f_exit_code, Sys.command cmdline with
++ | None, 0 -> ()
++ | None, i ->
++ failwithf
++ (f_ "Command '%s' terminated with error code %d")
++ cmdline i
++ | Some f, i ->
++ f i
+
+
+ let run_read_output ~ctxt ?f_exit_code cmd args =
+ let fn =
+ Filename.temp_file "oasis-" ".txt"
+ in
+- try
++ try
++ begin
++ let () =
++ run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn])
++ in
++ let chn =
++ open_in fn
++ in
++ let routput =
++ ref []
++ in
+ begin
+- let () =
+- run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn])
+- in
+- let chn =
+- open_in fn
+- in
+- let routput =
+- ref []
+- in
+- begin
+- try
+- while true do
+- routput := (input_line chn) :: !routput
+- done
+- with End_of_file ->
+- ()
+- end;
+- close_in chn;
+- Sys.remove fn;
+- List.rev !routput
+- end
+- with e ->
+- (try Sys.remove fn with _ -> ());
+- raise e
++ try
++ while true do
++ routput := (input_line chn) :: !routput
++ done
++ with End_of_file ->
++ ()
++ end;
++ close_in chn;
++ Sys.remove fn;
++ List.rev !routput
++ end
++ with e ->
++ (try Sys.remove fn with _ -> ());
++ raise e
+
+
+ let run_read_one_line ~ctxt ?f_exit_code cmd args =
+ match run_read_output ~ctxt ?f_exit_code cmd args with
+ | [fst] ->
+- fst
++ fst
+ | lst ->
+- failwithf
+- (f_ "Command return unexpected output %S")
+- (String.concat "\n" lst)
++ failwithf
++ (f_ "Command return unexpected output %S")
++ (String.concat "\n" lst)
+ end
+
+ module OASISFileUtil = struct
+@@ -2695,15 +2976,15 @@ module OASISFileUtil = struct
+ let file_exists_case fn =
+ let dirname = Filename.dirname fn in
+ let basename = Filename.basename fn in
+- if Sys.file_exists dirname then
+- if basename = Filename.current_dir_name then
+- true
+- else
+- List.mem
+- basename
+- (Array.to_list (Sys.readdir dirname))
++ if Sys.file_exists dirname then
++ if basename = Filename.current_dir_name then
++ true
+ else
+- false
++ List.mem
++ basename
++ (Array.to_list (Sys.readdir dirname))
++ else
++ false
+
+
+ let find_file ?(case_sensitive=true) paths exts =
+@@ -2722,16 +3003,16 @@ module OASISFileUtil = struct
+ let rec combined_paths lst =
+ match lst with
+ | p1 :: p2 :: tl ->
+- let acc =
+- (List.map
+- (fun (a, b) -> Filename.concat a b)
+- (p1 * p2))
+- in
+- combined_paths (acc :: tl)
++ let acc =
++ (List.map
++ (fun (a, b) -> Filename.concat a b)
++ (p1 * p2))
++ in
++ combined_paths (acc :: tl)
+ | [e] ->
+- e
++ e
+ | [] ->
+- []
++ []
+ in
+
+ let alternatives =
+@@ -2743,46 +3024,46 @@ module OASISFileUtil = struct
+ p ^ e)
+ ((combined_paths paths) * exts)
+ in
+- List.find (fun file ->
+- (if case_sensitive then
+- file_exists_case file
+- else
+- Sys.file_exists file)
+- && not (Sys.is_directory file)
+- ) alternatives
++ List.find (fun file ->
++ (if case_sensitive then
++ file_exists_case file
++ else
++ Sys.file_exists file)
++ && not (Sys.is_directory file)
++ ) alternatives
+
+
+ let which ~ctxt prg =
+ let path_sep =
+ match Sys.os_type with
+ | "Win32" ->
+- ';'
++ ';'
+ | _ ->
+- ':'
++ ':'
+ in
+ let path_lst = OASISString.nsplit (Sys.getenv "PATH") path_sep in
+ let exec_ext =
+ match Sys.os_type with
+ | "Win32" ->
+- "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep)
++ "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep)
+ | _ ->
+- [""]
++ [""]
+ in
+- find_file ~case_sensitive:false [path_lst; [prg]] exec_ext
++ find_file ~case_sensitive:false [path_lst; [prg]] exec_ext
+
+
+ (**/**)
+ let rec fix_dir dn =
+ (* Windows hack because Sys.file_exists "src\\" = false when
+ * Sys.file_exists "src" = true
+- *)
++ *)
+ let ln =
+ String.length dn
+ in
+- if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then
+- fix_dir (String.sub dn 0 (ln - 1))
+- else
+- dn
++ if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then
++ fix_dir (String.sub dn 0 (ln - 1))
++ else
++ dn
+
+
+ let q = Filename.quote
+@@ -2793,24 +3074,24 @@ module OASISFileUtil = struct
+ if recurse then
+ match Sys.os_type with
+ | "Win32" ->
+- OASISExec.run ~ctxt
+- "xcopy" [q src; q tgt; "/E"]
++ OASISExec.run ~ctxt
++ "xcopy" [q src; q tgt; "/E"]
+ | _ ->
+- OASISExec.run ~ctxt
+- "cp" ["-r"; q src; q tgt]
++ OASISExec.run ~ctxt
++ "cp" ["-r"; q src; q tgt]
+ else
+ OASISExec.run ~ctxt
+ (match Sys.os_type with
+- | "Win32" -> "copy"
+- | _ -> "cp")
++ | "Win32" -> "copy"
++ | _ -> "cp")
+ [q src; q tgt]
+
+
+ let mkdir ~ctxt tgt =
+ OASISExec.run ~ctxt
+ (match Sys.os_type with
+- | "Win32" -> "md"
+- | _ -> "mkdir")
++ | "Win32" -> "md"
++ | _ -> "mkdir")
+ [q tgt]
+
+
+@@ -2818,32 +3099,32 @@ module OASISFileUtil = struct
+ let tgt =
+ fix_dir tgt
+ in
+- if Sys.file_exists tgt then
+- begin
+- if not (Sys.is_directory tgt) then
+- OASISUtils.failwithf
+- (f_ "Cannot create directory '%s', a file of the same name already \
+- exists")
+- tgt
+- end
+- else
+- begin
+- mkdir_parent ~ctxt f (Filename.dirname tgt);
+- if not (Sys.file_exists tgt) then
+- begin
+- f tgt;
+- mkdir ~ctxt tgt
+- end
+- end
++ if Sys.file_exists tgt then
++ begin
++ if not (Sys.is_directory tgt) then
++ OASISUtils.failwithf
++ (f_ "Cannot create directory '%s', a file of the same name already \
++ exists")
++ tgt
++ end
++ else
++ begin
++ mkdir_parent ~ctxt f (Filename.dirname tgt);
++ if not (Sys.file_exists tgt) then
++ begin
++ f tgt;
++ mkdir ~ctxt tgt
++ end
++ end
+
+
+ let rmdir ~ctxt tgt =
+ if Sys.readdir tgt = [||] then begin
+ match Sys.os_type with
+ | "Win32" ->
+- OASISExec.run ~ctxt "rd" [q tgt]
++ OASISExec.run ~ctxt "rd" [q tgt]
+ | _ ->
+- OASISExec.run ~ctxt "rm" ["-r"; q tgt]
++ OASISExec.run ~ctxt "rm" ["-r"; q tgt]
+ end else begin
+ OASISMessage.error ~ctxt
+ (f_ "Cannot remove directory '%s': not empty.")
+@@ -2852,51 +3133,51 @@ module OASISFileUtil = struct
+
+
+ let glob ~ctxt fn =
+- let basename =
+- Filename.basename fn
+- in
+- if String.length basename >= 2 &&
+- basename.[0] = '*' &&
+- basename.[1] = '.' then
+- begin
+- let ext_len =
+- (String.length basename) - 2
+- in
+- let ext =
+- String.sub basename 2 ext_len
+- in
+- let dirname =
+- Filename.dirname fn
+- in
+- Array.fold_left
+- (fun acc fn ->
+- try
+- let fn_ext =
+- String.sub
+- fn
+- ((String.length fn) - ext_len)
+- ext_len
+- in
+- if fn_ext = ext then
+- (Filename.concat dirname fn) :: acc
+- else
+- acc
+- with Invalid_argument _ ->
+- acc)
+- []
+- (Sys.readdir dirname)
+- end
+- else
+- begin
+- if file_exists_case fn then
+- [fn]
+- else
+- []
+- end
++ let basename =
++ Filename.basename fn
++ in
++ if String.length basename >= 2 &&
++ basename.[0] = '*' &&
++ basename.[1] = '.' then
++ begin
++ let ext_len =
++ (String.length basename) - 2
++ in
++ let ext =
++ String.sub basename 2 ext_len
++ in
++ let dirname =
++ Filename.dirname fn
++ in
++ Array.fold_left
++ (fun acc fn ->
++ try
++ let fn_ext =
++ String.sub
++ fn
++ ((String.length fn) - ext_len)
++ ext_len
++ in
++ if fn_ext = ext then
++ (Filename.concat dirname fn) :: acc
++ else
++ acc
++ with Invalid_argument _ ->
++ acc)
++ []
++ (Sys.readdir dirname)
++ end
++ else
++ begin
++ if file_exists_case fn then
++ [fn]
++ else
++ []
++ end
+ end
+
+
+-# 2878 "setup.ml"
++# 3159 "setup.ml"
+ module BaseEnvLight = struct
+ (* # 22 "src/base/BaseEnvLight.ml" *)
+
+@@ -2907,101 +3188,76 @@ module BaseEnvLight = struct
+ type t = string MapString.t
+
+
+- let default_filename =
+- Filename.concat
+- (Sys.getcwd ())
+- "setup.data"
++ let default_filename = Filename.concat (Sys.getcwd ()) "setup.data"
+
+
+- let load ?(allow_empty=false) ?(filename=default_filename) () =
+- if Sys.file_exists filename then
+- begin
+- let chn =
+- open_in_bin filename
+- in
+- let st =
+- Stream.of_channel chn
+- in
+- let line =
+- ref 1
+- in
+- let st_line =
+- Stream.from
+- (fun _ ->
+- try
+- match Stream.next st with
+- | '\n' -> incr line; Some '\n'
+- | c -> Some c
+- with Stream.Failure -> None)
+- in
+- let lexer =
+- Genlex.make_lexer ["="] st_line
+- in
+- let rec read_file mp =
+- match Stream.npeek 3 lexer with
+- | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
+- Stream.junk lexer;
+- Stream.junk lexer;
+- Stream.junk lexer;
+- read_file (MapString.add nm value mp)
+- | [] ->
+- mp
+- | _ ->
+- failwith
+- (Printf.sprintf
+- "Malformed data file '%s' line %d"
+- filename !line)
+- in
+- let mp =
+- read_file MapString.empty
+- in
+- close_in chn;
+- mp
+- end
+- else if allow_empty then
+- begin
++ let load ?(allow_empty=false) ?(filename=default_filename) ?stream () =
++ let line = ref 1 in
++ let lexer st =
++ let st_line =
++ Stream.from
++ (fun _ ->
++ try
++ match Stream.next st with
++ | '\n' -> incr line; Some '\n'
++ | c -> Some c
++ with Stream.Failure -> None)
++ in
++ Genlex.make_lexer ["="] st_line
++ in
++ let rec read_file lxr mp =
++ match Stream.npeek 3 lxr with
++ | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
++ Stream.junk lxr; Stream.junk lxr; Stream.junk lxr;
++ read_file lxr (MapString.add nm value mp)
++ | [] -> mp
++ | _ ->
++ failwith
++ (Printf.sprintf "Malformed data file '%s' line %d" filename !line)
++ in
++ match stream with
++ | Some st -> read_file (lexer st) MapString.empty
++ | None ->
++ if Sys.file_exists filename then begin
++ let chn = open_in_bin filename in
++ let st = Stream.of_channel chn in
++ try
++ let mp = read_file (lexer st) MapString.empty in
++ close_in chn; mp
++ with e ->
++ close_in chn; raise e
++ end else if allow_empty then begin
+ MapString.empty
+- end
+- else
+- begin
++ end else begin
+ failwith
+ (Printf.sprintf
+ "Unable to load environment, the file '%s' doesn't exist."
+ filename)
+ end
+
+-
+ let rec var_expand str env =
+- let buff =
+- Buffer.create ((String.length str) * 2)
+- in
+- Buffer.add_substitute
+- buff
+- (fun var ->
+- try
+- var_expand (MapString.find var env) env
+- with Not_found ->
+- failwith
+- (Printf.sprintf
+- "No variable %s defined when trying to expand %S."
+- var
+- str))
+- str;
+- Buffer.contents buff
+-
+-
+- let var_get name env =
+- var_expand (MapString.find name env) env
++ let buff = Buffer.create ((String.length str) * 2) in
++ Buffer.add_substitute
++ buff
++ (fun var ->
++ try
++ var_expand (MapString.find var env) env
++ with Not_found ->
++ failwith
++ (Printf.sprintf
++ "No variable %s defined when trying to expand %S."
++ var
++ str))
++ str;
++ Buffer.contents buff
+
+
+- let var_choose lst env =
+- OASISExpr.choose
+- (fun nm -> var_get nm env)
+- lst
++ let var_get name env = var_expand (MapString.find name env) env
++ let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst
+ end
+
+
+-# 2983 "setup.ml"
++# 3239 "setup.ml"
+ module BaseContext = struct
+ (* # 22 "src/base/BaseContext.ml" *)
+
+@@ -3022,7 +3278,7 @@ module BaseMessage = struct
+
+ (** Message to user, overrid for Base
+ @author Sylvain Le Gall
+- *)
++ *)
+ open OASISMessage
+ open BaseContext
+
+@@ -3045,6 +3301,7 @@ module BaseEnv = struct
+
+ open OASISGettext
+ open OASISUtils
++ open OASISContext
+ open PropList
+
+
+@@ -3067,83 +3324,79 @@ module BaseEnv = struct
+
+
+ type definition_t =
+- {
+- hide: bool;
+- dump: bool;
+- cli: cli_handle_t;
+- arg_help: string option;
+- group: string option;
+- }
++ {
++ hide: bool;
++ dump: bool;
++ cli: cli_handle_t;
++ arg_help: string option;
++ group: string option;
++ }
+
+
+- let schema =
+- Schema.create "environment"
++ let schema = Schema.create "environment"
+
+
+ (* Environment data *)
+- let env =
+- Data.create ()
++ let env = Data.create ()
+
+
+ (* Environment data from file *)
+- let env_from_file =
+- ref MapString.empty
++ let env_from_file = ref MapString.empty
+
+
+ (* Lexer for var *)
+- let var_lxr =
+- Genlex.make_lexer []
++ let var_lxr = Genlex.make_lexer []
+
+
+ let rec var_expand str =
+ let buff =
+- Buffer.create ((String.length str) * 2)
+- in
+- Buffer.add_substitute
+- buff
+- (fun var ->
+- try
+- (* TODO: this is a quick hack to allow calling Test.Command
+- * without defining executable name really. I.e. if there is
+- * an exec Executable toto, then $(toto) should be replace
+- * by its real name. It is however useful to have this function
+- * for other variable that depend on the host and should be
+- * written better than that.
+- *)
+- let st =
+- var_lxr (Stream.of_string var)
+- in
+- match Stream.npeek 3 st with
+- | [Genlex.Ident "utoh"; Genlex.Ident nm] ->
+- OASISHostPath.of_unix (var_get nm)
+- | [Genlex.Ident "utoh"; Genlex.String s] ->
+- OASISHostPath.of_unix s
+- | [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] ->
+- String.escaped (var_get nm)
+- | [Genlex.Ident "ocaml_escaped"; Genlex.String s] ->
+- String.escaped s
+- | [Genlex.Ident nm] ->
+- var_get nm
+- | _ ->
+- failwithf
+- (f_ "Unknown expression '%s' in variable expansion of %s.")
+- var
+- str
+- with
+- | Unknown_field (_, _) ->
+- failwithf
+- (f_ "No variable %s defined when trying to expand %S.")
+- var
+- str
+- | Stream.Error e ->
+- failwithf
+- (f_ "Syntax error when parsing '%s' when trying to \
+- expand %S: %s")
+- var
+- str
+- e)
+- str;
+- Buffer.contents buff
++ Buffer.create ((String.length str) * 2)
++ in
++ Buffer.add_substitute
++ buff
++ (fun var ->
++ try
++ (* TODO: this is a quick hack to allow calling Test.Command
++ * without defining executable name really. I.e. if there is
++ * an exec Executable toto, then $(toto) should be replace
++ * by its real name. It is however useful to have this function
++ * for other variable that depend on the host and should be
++ * written better than that.
++ *)
++ let st =
++ var_lxr (Stream.of_string var)
++ in
++ match Stream.npeek 3 st with
++ | [Genlex.Ident "utoh"; Genlex.Ident nm] ->
++ OASISHostPath.of_unix (var_get nm)
++ | [Genlex.Ident "utoh"; Genlex.String s] ->
++ OASISHostPath.of_unix s
++ | [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] ->
++ String.escaped (var_get nm)
++ | [Genlex.Ident "ocaml_escaped"; Genlex.String s] ->
++ String.escaped s
++ | [Genlex.Ident nm] ->
++ var_get nm
++ | _ ->
++ failwithf
++ (f_ "Unknown expression '%s' in variable expansion of %s.")
++ var
++ str
++ with
++ | Unknown_field (_, _) ->
++ failwithf
++ (f_ "No variable %s defined when trying to expand %S.")
++ var
++ str
++ | Stream.Error e ->
++ failwithf
++ (f_ "Syntax error when parsing '%s' when trying to \
++ expand %S: %s")
++ var
++ str
++ e)
++ str;
++ Buffer.contents buff
+
+
+ and var_get name =
+@@ -3158,7 +3411,7 @@ module BaseEnv = struct
+ raise e
+ end
+ in
+- var_expand vl
++ var_expand vl
+
+
+ let var_choose ?printer ?name lst =
+@@ -3173,24 +3426,24 @@ module BaseEnv = struct
+ let buff =
+ Buffer.create (String.length vl)
+ in
+- String.iter
+- (function
+- | '$' -> Buffer.add_string buff "\\$"
+- | c -> Buffer.add_char buff c)
+- vl;
+- Buffer.contents buff
++ String.iter
++ (function
++ | '$' -> Buffer.add_string buff "\\$"
++ | c -> Buffer.add_char buff c)
++ vl;
++ Buffer.contents buff
+
+
+ let var_define
+- ?(hide=false)
+- ?(dump=true)
+- ?short_desc
+- ?(cli=CLINone)
+- ?arg_help
+- ?group
+- name (* TODO: type constraint on the fact that name must be a valid OCaml
+- id *)
+- dflt =
++ ?(hide=false)
++ ?(dump=true)
++ ?short_desc
++ ?(cli=CLINone)
++ ?arg_help
++ ?group
++ name (* TODO: type constraint on the fact that name must be a valid OCaml
++ id *)
++ dflt =
+
+ let default =
+ [
+@@ -3211,22 +3464,22 @@ module BaseEnv = struct
+ in
+
+ (* Try to find a value that can be defined
+- *)
++ *)
+ let var_get_low lst =
+ let errors, res =
+ List.fold_left
+- (fun (errors, res) (o, v) ->
++ (fun (errors, res) (_, v) ->
+ if res = None then
+ begin
+ try
+ errors, Some (v ())
+ with
+ | Not_found ->
+- errors, res
++ errors, res
+ | Failure rsn ->
+- (rsn :: errors), res
++ (rsn :: errors), res
+ | e ->
+- (Printexc.to_string e) :: errors, res
++ (Printexc.to_string e) :: errors, res
+ end
+ else
+ errors, res)
+@@ -3236,13 +3489,13 @@ module BaseEnv = struct
+ Pervasives.compare o2 o1)
+ lst)
+ in
+- match res, errors with
+- | Some v, _ ->
+- v
+- | None, [] ->
+- raise (Not_set (name, None))
+- | None, lst ->
+- raise (Not_set (name, Some (String.concat (s_ ", ") lst)))
++ match res, errors with
++ | Some v, _ ->
++ v
++ | None, [] ->
++ raise (Not_set (name, None))
++ | None, lst ->
++ raise (Not_set (name, Some (String.concat (s_ ", ") lst)))
+ in
+
+ let help =
+@@ -3258,24 +3511,24 @@ module BaseEnv = struct
+ ~parse:(fun ?(context=ODefault) s -> [context, fun () -> s])
+ ~print:var_get_low
+ ~default
+- ~update:(fun ?context x old_x -> x @ old_x)
++ ~update:(fun ?context:_ x old_x -> x @ old_x)
+ ?help
+ extra
+ in
+
+- fun () ->
+- var_expand (var_get_low (var_get_lst env))
++ fun () ->
++ var_expand (var_get_low (var_get_lst env))
+
+
+ let var_redefine
+- ?hide
+- ?dump
+- ?short_desc
+- ?cli
+- ?arg_help
+- ?group
+- name
+- dflt =
++ ?hide
++ ?dump
++ ?short_desc
++ ?cli
++ ?arg_help
++ ?group
++ name
++ dflt =
+ if Schema.mem schema name then
+ begin
+ (* TODO: look suspsicious, we want to memorize dflt not dflt () *)
+@@ -3296,7 +3549,7 @@ module BaseEnv = struct
+ end
+
+
+- let var_ignore (e: unit -> string) = ()
++ let var_ignore (_: unit -> string) = ()
+
+
+ let print_hidden =
+@@ -3321,12 +3574,34 @@ module BaseEnv = struct
+ schema)
+
+
+- let default_filename =
+- BaseEnvLight.default_filename
++ let default_filename = in_srcdir "setup.data"
+
+
+- let load ?allow_empty ?filename () =
+- env_from_file := BaseEnvLight.load ?allow_empty ?filename ()
++ let load ~ctxt ?(allow_empty=false) ?(filename=default_filename) () =
++ let open OASISFileSystem in
++ env_from_file :=
++ let repr_filename = ctxt.srcfs#string_of_filename filename in
++ if ctxt.srcfs#file_exists filename then begin
++ let buf = Buffer.create 13 in
++ defer_close
++ (ctxt.srcfs#open_in ~mode:binary_in filename)
++ (read_all buf);
++ defer_close
++ (ctxt.srcfs#open_in ~mode:binary_in filename)
++ (fun rdr ->
++ OASISMessage.info ~ctxt "Loading environment from %S." repr_filename;
++ BaseEnvLight.load ~allow_empty
++ ~filename:(repr_filename)
++ ~stream:(stream_of_reader rdr)
++ ())
++ end else if allow_empty then begin
++ BaseEnvLight.MapString.empty
++ end else begin
++ failwith
++ (Printf.sprintf
++ (f_ "Unable to load environment, the file '%s' doesn't exist.")
++ repr_filename)
++ end
+
+
+ let unload () =
+@@ -3334,40 +3609,32 @@ module BaseEnv = struct
+ Data.clear env
+
+
+- let dump ?(filename=default_filename) () =
+- let chn =
+- open_out_bin filename
+- in
+- let output nm value =
+- Printf.fprintf chn "%s=%S\n" nm value
+- in
+- let mp_todo =
+- (* Dump data from schema *)
+- Schema.fold
+- (fun mp_todo nm def _ ->
+- if def.dump then
+- begin
+- try
+- let value =
+- Schema.get
+- schema
+- env
+- nm
+- in
+- output nm value
+- with Not_set _ ->
+- ()
+- end;
+- MapString.remove nm mp_todo)
+- !env_from_file
+- schema
+- in
+- (* Dump data defined outside of schema *)
+- MapString.iter output mp_todo;
+-
+- (* End of the dump *)
+- close_out chn
+-
++ let dump ~ctxt ?(filename=default_filename) () =
++ let open OASISFileSystem in
++ defer_close
++ (ctxt.OASISContext.srcfs#open_out ~mode:binary_out filename)
++ (fun wrtr ->
++ let buf = Buffer.create 63 in
++ let output nm value =
++ Buffer.add_string buf (Printf.sprintf "%s=%S\n" nm value)
++ in
++ let mp_todo =
++ (* Dump data from schema *)
++ Schema.fold
++ (fun mp_todo nm def _ ->
++ if def.dump then begin
++ try
++ output nm (Schema.get schema env nm)
++ with Not_set _ ->
++ ()
++ end;
++ MapString.remove nm mp_todo)
++ !env_from_file
++ schema
++ in
++ (* Dump data defined outside of schema *)
++ MapString.iter output mp_todo;
++ wrtr#output buf)
+
+ let print () =
+ let printable_vars =
+@@ -3376,20 +3643,15 @@ module BaseEnv = struct
+ if not def.hide || bool_of_string (print_hidden ()) then
+ begin
+ try
+- let value =
+- Schema.get
+- schema
+- env
+- nm
+- in
++ let value = Schema.get schema env nm in
+ let txt =
+ match short_descr_opt with
+ | Some s -> s ()
+ | None -> nm
+ in
+- (txt, value) :: acc
++ (txt, value) :: acc
+ with Not_set _ ->
+- acc
++ acc
+ end
+ else
+ acc)
+@@ -3401,123 +3663,122 @@ module BaseEnv = struct
+ (List.rev_map String.length
+ (List.rev_map fst printable_vars))
+ in
+- let dot_pad str =
+- String.make ((max_length - (String.length str)) + 3) '.'
+- in
+-
+- Printf.printf "\nConfiguration: \n";
++ let dot_pad str = String.make ((max_length - (String.length str)) + 3) '.' in
++ Printf.printf "\nConfiguration:\n";
+ List.iter
+ (fun (name, value) ->
+- Printf.printf "%s: %s %s\n" name (dot_pad name) value)
++ Printf.printf "%s: %s" name (dot_pad name);
++ if value = "" then
++ Printf.printf "\n"
++ else
++ Printf.printf " %s\n" value)
+ (List.rev printable_vars);
+ Printf.printf "\n%!"
+
+
+ let args () =
+- let arg_concat =
+- OASISUtils.varname_concat ~hyphen:'-'
+- in
+- [
+- "--override",
+- Arg.Tuple
+- (
+- let rvr = ref ""
+- in
+- let rvl = ref ""
+- in
+- [
+- Arg.Set_string rvr;
+- Arg.Set_string rvl;
+- Arg.Unit
+- (fun () ->
+- Schema.set
+- schema
+- env
+- ~context:OCommandLine
+- !rvr
+- !rvl)
+- ]
+- ),
+- "var+val Override any configuration variable.";
++ let arg_concat = OASISUtils.varname_concat ~hyphen:'-' in
++ [
++ "--override",
++ Arg.Tuple
++ (
++ let rvr = ref ""
++ in
++ let rvl = ref ""
++ in
++ [
++ Arg.Set_string rvr;
++ Arg.Set_string rvl;
++ Arg.Unit
++ (fun () ->
++ Schema.set
++ schema
++ env
++ ~context:OCommandLine
++ !rvr
++ !rvl)
++ ]
++ ),
++ "var+val Override any configuration variable.";
+
+- ]
+- @
++ ]
++ @
+ List.flatten
+ (Schema.fold
+- (fun acc name def short_descr_opt ->
+- let var_set s =
+- Schema.set
+- schema
+- env
+- ~context:OCommandLine
+- name
+- s
+- in
++ (fun acc name def short_descr_opt ->
++ let var_set s =
++ Schema.set
++ schema
++ env
++ ~context:OCommandLine
++ name
++ s
++ in
+
+- let arg_name =
+- OASISUtils.varname_of_string ~hyphen:'-' name
+- in
++ let arg_name =
++ OASISUtils.varname_of_string ~hyphen:'-' name
++ in
+
+- let hlp =
+- match short_descr_opt with
+- | Some txt -> txt ()
+- | None -> ""
+- in
++ let hlp =
++ match short_descr_opt with
++ | Some txt -> txt ()
++ | None -> ""
++ in
+
+- let arg_hlp =
+- match def.arg_help with
+- | Some s -> s
+- | None -> "str"
+- in
++ let arg_hlp =
++ match def.arg_help with
++ | Some s -> s
++ | None -> "str"
++ in
+
+- let default_value =
+- try
+- Printf.sprintf
+- (f_ " [%s]")
+- (Schema.get
+- schema
+- env
+- name)
+- with Not_set _ ->
+- ""
+- in
++ let default_value =
++ try
++ Printf.sprintf
++ (f_ " [%s]")
++ (Schema.get
++ schema
++ env
++ name)
++ with Not_set _ ->
++ ""
++ in
+
+- let args =
+- match def.cli with
+- | CLINone ->
+- []
+- | CLIAuto ->
+- [
+- arg_concat "--" arg_name,
+- Arg.String var_set,
+- Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
+- ]
+- | CLIWith ->
+- [
+- arg_concat "--with-" arg_name,
+- Arg.String var_set,
+- Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
+- ]
+- | CLIEnable ->
+- let dflt =
+- if default_value = " [true]" then
+- s_ " [default: enabled]"
+- else
+- s_ " [default: disabled]"
+- in
+- [
+- arg_concat "--enable-" arg_name,
+- Arg.Unit (fun () -> var_set "true"),
+- Printf.sprintf (f_ " %s%s") hlp dflt;
+-
+- arg_concat "--disable-" arg_name,
+- Arg.Unit (fun () -> var_set "false"),
+- Printf.sprintf (f_ " %s%s") hlp dflt
+- ]
+- | CLIUser lst ->
+- lst
+- in
+- args :: acc)
++ let args =
++ match def.cli with
++ | CLINone ->
++ []
++ | CLIAuto ->
++ [
++ arg_concat "--" arg_name,
++ Arg.String var_set,
++ Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
++ ]
++ | CLIWith ->
++ [
++ arg_concat "--with-" arg_name,
++ Arg.String var_set,
++ Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
++ ]
++ | CLIEnable ->
++ let dflt =
++ if default_value = " [true]" then
++ s_ " [default: enabled]"
++ else
++ s_ " [default: disabled]"
++ in
++ [
++ arg_concat "--enable-" arg_name,
++ Arg.Unit (fun () -> var_set "true"),
++ Printf.sprintf (f_ " %s%s") hlp dflt;
++
++ arg_concat "--disable-" arg_name,
++ Arg.Unit (fun () -> var_set "false"),
++ Printf.sprintf (f_ " %s%s") hlp dflt
++ ]
++ | CLIUser lst ->
++ lst
++ in
++ args :: acc)
+ []
+ schema)
+ end
+@@ -3531,25 +3792,25 @@ module BaseArgExt = struct
+
+
+ let parse argv args =
+- (* Simulate command line for Arg *)
+- let current =
+- ref 0
+- in
++ (* Simulate command line for Arg *)
++ let current =
++ ref 0
++ in
+
+- try
+- Arg.parse_argv
+- ~current:current
+- (Array.concat [[|"none"|]; argv])
+- (Arg.align args)
+- (failwithf (f_ "Don't know what to do with arguments: '%s'"))
+- (s_ "configure options:")
+- with
+- | Arg.Help txt ->
+- print_endline txt;
+- exit 0
+- | Arg.Bad txt ->
+- prerr_endline txt;
+- exit 1
++ try
++ Arg.parse_argv
++ ~current:current
++ (Array.concat [[|"none"|]; argv])
++ (Arg.align args)
++ (failwithf (f_ "Don't know what to do with arguments: '%s'"))
++ (s_ "configure options:")
++ with
++ | Arg.Help txt ->
++ print_endline txt;
++ exit 0
++ | Arg.Bad txt ->
++ prerr_endline txt;
++ exit 1
+ end
+
+ module BaseCheck = struct
+@@ -3571,18 +3832,18 @@ module BaseCheck = struct
+ (fun res e ->
+ match res with
+ | Some _ ->
+- res
++ res
+ | None ->
+- try
+- Some (OASISFileUtil.which ~ctxt:!BaseContext.default e)
+- with Not_found ->
+- None)
++ try
++ Some (OASISFileUtil.which ~ctxt:!BaseContext.default e)
++ with Not_found ->
++ None)
+ None
+ prg_lst
+ in
+- match alternate with
+- | Some prg -> prg
+- | None -> raise Not_found)
++ match alternate with
++ | Some prg -> prg
++ | None -> raise Not_found)
+
+
+ let prog prg =
+@@ -3598,45 +3859,45 @@ module BaseCheck = struct
+
+
+ let version
+- var_prefix
+- cmp
+- fversion
+- () =
++ var_prefix
++ cmp
++ fversion
++ () =
+ (* Really compare version provided *)
+ let var =
+ var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp)
+ in
+- var_redefine
+- ~hide:true
+- var
+- (fun () ->
+- let version_str =
+- match fversion () with
+- | "[Distributed with OCaml]" ->
+- begin
+- try
+- (var_get "ocaml_version")
+- with Not_found ->
+- warning
+- (f_ "Variable ocaml_version not defined, fallback \
+- to default");
+- Sys.ocaml_version
+- end
+- | res ->
+- res
+- in
+- let version =
+- OASISVersion.version_of_string version_str
+- in
+- if OASISVersion.comparator_apply version cmp then
+- version_str
+- else
+- failwithf
+- (f_ "Cannot satisfy version constraint on %s: %s (version: %s)")
+- var_prefix
+- (OASISVersion.string_of_comparator cmp)
+- version_str)
+- ()
++ var_redefine
++ ~hide:true
++ var
++ (fun () ->
++ let version_str =
++ match fversion () with
++ | "[Distributed with OCaml]" ->
++ begin
++ try
++ (var_get "ocaml_version")
++ with Not_found ->
++ warning
++ (f_ "Variable ocaml_version not defined, fallback \
++ to default");
++ Sys.ocaml_version
++ end
++ | res ->
++ res
++ in
++ let version =
++ OASISVersion.version_of_string version_str
++ in
++ if OASISVersion.comparator_apply version cmp then
++ version_str
++ else
++ failwithf
++ (f_ "Cannot satisfy version constraint on %s: %s (version: %s)")
++ var_prefix
++ (OASISVersion.string_of_comparator cmp)
++ version_str)
++ ()
+
+
+ let package_version pkg =
+@@ -3657,13 +3918,13 @@ module BaseCheck = struct
+ (ocamlfind ())
+ ["query"; "-format"; "%d"; pkg]
+ in
+- if Sys.file_exists dir && Sys.is_directory dir then
+- dir
+- else
+- failwithf
+- (f_ "When looking for findlib package %s, \
+- directory %s return doesn't exist")
+- pkg dir
++ if Sys.file_exists dir && Sys.is_directory dir then
++ dir
++ else
++ failwithf
++ (f_ "When looking for findlib package %s, \
++ directory %s return doesn't exist")
++ pkg dir
+ in
+ let vl =
+ var_redefine
+@@ -3671,19 +3932,19 @@ module BaseCheck = struct
+ (fun () -> findlib_dir pkg)
+ ()
+ in
+- (
+- match version_comparator with
+- | Some ver_cmp ->
+- ignore
+- (version
+- var
+- ver_cmp
+- (fun _ -> package_version pkg)
+- ())
+- | None ->
+- ()
+- );
+- vl
++ (
++ match version_comparator with
++ | Some ver_cmp ->
++ ignore
++ (version
++ var
++ ver_cmp
++ (fun _ -> package_version pkg)
++ ())
++ | None ->
++ ()
++ );
++ vl
+ end
+
+ module BaseOCamlcConfig = struct
+@@ -3705,46 +3966,46 @@ module BaseOCamlcConfig = struct
+ let ocamlc_config_map =
+ (* Map name to value for ocamlc -config output
+ (name ^": "^value)
+- *)
++ *)
+ let rec split_field mp lst =
+ match lst with
+ | line :: tl ->
+- let mp =
+- try
+- let pos_semicolon =
+- String.index line ':'
+- in
+- if pos_semicolon > 1 then
+- (
+- let name =
+- String.sub line 0 pos_semicolon
+- in
+- let linelen =
+- String.length line
+- in
+- let value =
+- if linelen > pos_semicolon + 2 then
+- String.sub
+- line
+- (pos_semicolon + 2)
+- (linelen - pos_semicolon - 2)
+- else
+- ""
+- in
+- SMap.add name value mp
+- )
+- else
+- (
+- mp
+- )
+- with Not_found ->
++ let mp =
++ try
++ let pos_semicolon =
++ String.index line ':'
++ in
++ if pos_semicolon > 1 then
++ (
++ let name =
++ String.sub line 0 pos_semicolon
++ in
++ let linelen =
++ String.length line
++ in
++ let value =
++ if linelen > pos_semicolon + 2 then
++ String.sub
++ line
++ (pos_semicolon + 2)
++ (linelen - pos_semicolon - 2)
++ else
++ ""
++ in
++ SMap.add name value mp
++ )
++ else
+ (
+ mp
+ )
+- in
+- split_field mp tl
++ with Not_found ->
++ (
++ mp
++ )
++ in
++ split_field mp tl
+ | [] ->
+- mp
++ mp
+ in
+
+ let cache =
+@@ -3758,13 +4019,13 @@ module BaseOCamlcConfig = struct
+ (ocamlc ()) ["-config"]))
+ []))
+ in
+- var_redefine
+- "ocamlc_config_map"
+- ~hide:true
+- ~dump:false
+- (fun () ->
+- (* TODO: update if ocamlc change !!! *)
+- Lazy.force cache)
++ var_redefine
++ "ocamlc_config_map"
++ ~hide:true
++ ~dump:false
++ (fun () ->
++ (* TODO: update if ocamlc change !!! *)
++ Lazy.force cache)
+
+
+ let var_define nm =
+@@ -3779,30 +4040,30 @@ module BaseOCamlcConfig = struct
+ String.sub s 0 (String.index s '+')
+ with _ ->
+ s
+- in
++ in
+
+ let nm_config, value_config =
+ match nm with
+ | "ocaml_version" ->
+- "version", chop_version_suffix
++ "version", chop_version_suffix
+ | _ -> nm, (fun x -> x)
+ in
+- var_redefine
+- nm
+- (fun () ->
+- try
+- let map =
+- avlbl_config_get ()
+- in
+- let value =
+- SMap.find nm_config map
+- in
+- value_config value
+- with Not_found ->
+- failwithf
+- (f_ "Cannot find field '%s' in '%s -config' output")
+- nm
+- (ocamlc ()))
++ var_redefine
++ nm
++ (fun () ->
++ try
++ let map =
++ avlbl_config_get ()
++ in
++ let value =
++ SMap.find nm_config map
++ in
++ value_config value
++ with Not_found ->
++ failwithf
++ (f_ "Cannot find field '%s' in '%s -config' output")
++ nm
++ (ocamlc ()))
+
+ end
+
+@@ -3812,7 +4073,6 @@ module BaseStandardVar = struct
+
+ open OASISGettext
+ open OASISTypes
+- open OASISExpr
+ open BaseCheck
+ open BaseEnv
+
+@@ -3842,11 +4102,11 @@ module BaseStandardVar = struct
+ let since_version =
+ OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version)
+ in
+- var_cond :=
++ var_cond :=
+ (fun ver ->
+ if OASISVersion.comparator_apply ver since_version then
+ holder := f ()) :: !var_cond;
+- fun () -> !holder ()
++ fun () -> !holder ()
+
+
+ (**/**)
+@@ -3907,11 +4167,11 @@ module BaseStandardVar = struct
+ OASISExec.run_read_output ~ctxt:!BaseContext.default
+ (flexlink ()) ["-help"]
+ in
+- match lst with
+- | line :: _ ->
+- Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver)
+- | [] ->
+- raise Not_found)
++ match lst with
++ | line :: _ ->
++ Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver)
++ | [] ->
++ raise Not_found)
+
+
+ (**/**)
+@@ -3927,7 +4187,7 @@ module BaseStandardVar = struct
+ let (/) a b =
+ if os_type () = Sys.os_type then
+ Filename.concat a b
+- else if os_type () = "Unix" then
++ else if os_type () = "Unix" || os_type () = "Cygwin" then
+ OASISUnixPath.concat a b
+ else
+ OASISUtils.failwithf (f_ "Cannot handle os_type %s filename concat")
+@@ -3941,12 +4201,12 @@ module BaseStandardVar = struct
+ (fun () ->
+ match os_type () with
+ | "Win32" ->
+- let program_files =
+- Sys.getenv "PROGRAMFILES"
+- in
+- program_files/(pkg_name ())
++ let program_files =
++ Sys.getenv "PROGRAMFILES"
++ in
++ program_files/(pkg_name ())
+ | _ ->
+- "/usr/local")
++ "/usr/local")
+
+
+ let exec_prefix =
+@@ -4082,12 +4342,12 @@ module BaseStandardVar = struct
+ let _s: string =
+ ocamlopt ()
+ in
+- "true"
++ "true"
+ with PropList.Not_set _ ->
+ let _s: string =
+ ocamlc ()
+ in
+- "false")
++ "false")
+
+
+ let ext_program =
+@@ -4140,7 +4400,7 @@ module BaseStandardVar = struct
+ (fun () ->
+ var_define
+ ~short_desc:(fun () ->
+- s_ "Compile tests executable and library and run them")
++ s_ "Compile tests executable and library and run them")
+ ~cli:CLIEnable
+ "tests"
+ (fun () -> "false"))
+@@ -4179,35 +4439,35 @@ module BaseStandardVar = struct
+ in
+ let has_native_dynlink =
+ let ocamlfind = ocamlfind () in
+- try
+- let fn =
+- OASISExec.run_read_one_line
+- ~ctxt:!BaseContext.default
+- ocamlfind
+- ["query"; "-predicates"; "native"; "dynlink";
+- "-format"; "%d/%a"]
+- in
+- Sys.file_exists fn
+- with _ ->
+- false
+- in
+- if not has_native_dynlink then
++ try
++ let fn =
++ OASISExec.run_read_one_line
++ ~ctxt:!BaseContext.default
++ ocamlfind
++ ["query"; "-predicates"; "native"; "dynlink";
++ "-format"; "%d/%a"]
++ in
++ Sys.file_exists fn
++ with _ ->
+ false
+- else if ocaml_lt_312 () then
++ in
++ if not has_native_dynlink then
++ false
++ else if ocaml_lt_312 () then
++ false
++ else if (os_type () = "Win32" || os_type () = "Cygwin")
++ && flexdll_lt_030 () then
++ begin
++ BaseMessage.warning
++ (f_ ".cmxs generation disabled because FlexDLL needs to be \
++ at least 0.30. Please upgrade FlexDLL from %s to 0.30.")
++ (flexdll_version ());
+ false
+- else if (os_type () = "Win32" || os_type () = "Cygwin")
+- && flexdll_lt_030 () then
+- begin
+- BaseMessage.warning
+- (f_ ".cmxs generation disabled because FlexDLL needs to be \
+- at least 0.30. Please upgrade FlexDLL from %s to 0.30.")
+- (flexdll_version ());
+- false
+- end
+- else
+- true
++ end
++ else
++ true
+ in
+- string_of_bool res)
++ string_of_bool res)
+
+
+ let init pkg =
+@@ -4223,48 +4483,29 @@ module BaseFileAB = struct
+ open BaseEnv
+ open OASISGettext
+ open BaseMessage
++ open OASISContext
+
+
+ let to_filename fn =
+- let fn =
+- OASISHostPath.of_unix fn
+- in
+- if not (Filename.check_suffix fn ".ab") then
+- warning
+- (f_ "File '%s' doesn't have '.ab' extension")
+- fn;
+- Filename.chop_extension fn
++ if not (Filename.check_suffix fn ".ab") then
++ warning (f_ "File '%s' doesn't have '.ab' extension") fn;
++ OASISFileSystem.of_unix_filename (Filename.chop_extension fn)
+
+
+- let replace fn_lst =
+- let buff =
+- Buffer.create 13
+- in
+- List.iter
+- (fun fn ->
+- let fn =
+- OASISHostPath.of_unix fn
+- in
+- let chn_in =
+- open_in fn
+- in
+- let chn_out =
+- open_out (to_filename fn)
+- in
+- (
+- try
+- while true do
+- Buffer.add_string buff (var_expand (input_line chn_in));
+- Buffer.add_char buff '\n'
+- done
+- with End_of_file ->
+- ()
+- );
+- Buffer.output_buffer chn_out buff;
+- Buffer.clear buff;
+- close_in chn_in;
+- close_out chn_out)
+- fn_lst
++ let replace ~ctxt fn_lst =
++ let open OASISFileSystem in
++ let ibuf, obuf = Buffer.create 13, Buffer.create 13 in
++ List.iter
++ (fun fn ->
++ Buffer.clear ibuf; Buffer.clear obuf;
++ defer_close
++ (ctxt.srcfs#open_in (of_unix_filename fn))
++ (read_all ibuf);
++ Buffer.add_string obuf (var_expand (Buffer.contents ibuf));
++ defer_close
++ (ctxt.srcfs#open_out (to_filename fn))
++ (fun wrtr -> wrtr#output obuf))
++ fn_lst
+ end
+
+ module BaseLog = struct
+@@ -4272,126 +4513,92 @@ module BaseLog = struct
+
+
+ open OASISUtils
++ open OASISContext
++ open OASISGettext
++ open OASISFileSystem
+
+
+- let default_filename =
+- Filename.concat
+- (Filename.dirname BaseEnv.default_filename)
+- "setup.log"
+-
+-
+- module SetTupleString =
+- Set.Make
+- (struct
+- type t = string * string
+- let compare (s11, s12) (s21, s22) =
+- match String.compare s11 s21 with
+- | 0 -> String.compare s12 s22
+- | n -> n
+- end)
++ let default_filename = in_srcdir "setup.log"
+
+
+- let load () =
+- if Sys.file_exists default_filename then
+- begin
+- let chn =
+- open_in default_filename
+- in
+- let scbuf =
+- Scanf.Scanning.from_file default_filename
+- in
+- let rec read_aux (st, lst) =
+- if not (Scanf.Scanning.end_of_input scbuf) then
+- begin
+- let acc =
+- try
+- Scanf.bscanf scbuf "%S %S\n"
+- (fun e d ->
+- let t =
+- e, d
+- in
+- if SetTupleString.mem t st then
+- st, lst
+- else
+- SetTupleString.add t st,
+- t :: lst)
+- with Scanf.Scan_failure _ ->
+- failwith
+- (Scanf.bscanf scbuf
+- "%l"
+- (fun line ->
+- Printf.sprintf
+- "Malformed log file '%s' at line %d"
+- default_filename
+- line))
+- in
+- read_aux acc
+- end
+- else
+- begin
+- close_in chn;
+- List.rev lst
+- end
+- in
+- read_aux (SetTupleString.empty, [])
+- end
+- else
+- begin
+- []
+- end
++ let load ~ctxt () =
++ let module SetTupleString =
++ Set.Make
++ (struct
++ type t = string * string
++ let compare (s11, s12) (s21, s22) =
++ match String.compare s11 s21 with
++ | 0 -> String.compare s12 s22
++ | n -> n
++ end)
++ in
++ if ctxt.srcfs#file_exists default_filename then begin
++ defer_close
++ (ctxt.srcfs#open_in default_filename)
++ (fun rdr ->
++ let line = ref 1 in
++ let lxr = Genlex.make_lexer [] (stream_of_reader rdr) in
++ let rec read_aux (st, lst) =
++ match Stream.npeek 2 lxr with
++ | [Genlex.String e; Genlex.String d] ->
++ let t = e, d in
++ Stream.junk lxr; Stream.junk lxr;
++ if SetTupleString.mem t st then
++ read_aux (st, lst)
++ else
++ read_aux (SetTupleString.add t st, t :: lst)
++ | [] -> List.rev lst
++ | _ ->
++ failwithf
++ (f_ "Malformed log file '%s' at line %d")
++ (ctxt.srcfs#string_of_filename default_filename)
++ !line
++ in
++ read_aux (SetTupleString.empty, []))
++ end else begin
++ []
++ end
+
+
+- let register event data =
+- let chn_out =
+- open_out_gen [Open_append; Open_creat; Open_text] 0o644 default_filename
+- in
+- Printf.fprintf chn_out "%S %S\n" event data;
+- close_out chn_out
++ let register ~ctxt event data =
++ defer_close
++ (ctxt.srcfs#open_out
++ ~mode:[Open_append; Open_creat; Open_text]
++ ~perm:0o644
++ default_filename)
++ (fun wrtr ->
++ let buf = Buffer.create 13 in
++ Printf.bprintf buf "%S %S\n" event data;
++ wrtr#output buf)
+
+
+- let unregister event data =
+- if Sys.file_exists default_filename then
+- begin
+- let lst =
+- load ()
+- in
+- let chn_out =
+- open_out default_filename
+- in
+- let write_something =
+- ref false
+- in
+- List.iter
+- (fun (e, d) ->
+- if e <> event || d <> data then
+- begin
+- write_something := true;
+- Printf.fprintf chn_out "%S %S\n" e d
+- end)
+- lst;
+- close_out chn_out;
+- if not !write_something then
+- Sys.remove default_filename
+- end
++ let unregister ~ctxt event data =
++ let lst = load ~ctxt () in
++ let buf = Buffer.create 13 in
++ List.iter
++ (fun (e, d) ->
++ if e <> event || d <> data then
++ Printf.bprintf buf "%S %S\n" e d)
++ lst;
++ if Buffer.length buf > 0 then
++ defer_close
++ (ctxt.srcfs#open_out default_filename)
++ (fun wrtr -> wrtr#output buf)
++ else
++ ctxt.srcfs#remove default_filename
+
+
+- let filter events =
+- let st_events =
+- List.fold_left
+- (fun st e ->
+- SetString.add e st)
+- SetString.empty
+- events
+- in
+- List.filter
+- (fun (e, _) -> SetString.mem e st_events)
+- (load ())
++ let filter ~ctxt events =
++ let st_events = SetString.of_list events in
++ List.filter
++ (fun (e, _) -> SetString.mem e st_events)
++ (load ~ctxt ())
+
+
+- let exists event data =
++ let exists ~ctxt event data =
+ List.exists
+ (fun v -> (event, data) = v)
+- (load ())
++ (load ~ctxt ())
+ end
+
+ module BaseBuilt = struct
+@@ -4414,100 +4621,81 @@ module BaseBuilt = struct
+
+ let to_log_event_file t nm =
+ "built_"^
+- (match t with
+- | BExec -> "exec"
+- | BExecLib -> "exec_lib"
+- | BLib -> "lib"
+- | BObj -> "obj"
+- | BDoc -> "doc")^
+- "_"^nm
++ (match t with
++ | BExec -> "exec"
++ | BExecLib -> "exec_lib"
++ | BLib -> "lib"
++ | BObj -> "obj"
++ | BDoc -> "doc")^
++ "_"^nm
+
+
+ let to_log_event_done t nm =
+ "is_"^(to_log_event_file t nm)
+
+
+- let register t nm lst =
+- BaseLog.register
+- (to_log_event_done t nm)
+- "true";
++ let register ~ctxt t nm lst =
++ BaseLog.register ~ctxt (to_log_event_done t nm) "true";
+ List.iter
+ (fun alt ->
+ let registered =
+ List.fold_left
+ (fun registered fn ->
+- if OASISFileUtil.file_exists_case fn then
+- begin
+- BaseLog.register
+- (to_log_event_file t nm)
+- (if Filename.is_relative fn then
+- Filename.concat (Sys.getcwd ()) fn
+- else
+- fn);
+- true
+- end
+- else
+- registered)
++ if OASISFileUtil.file_exists_case fn then begin
++ BaseLog.register ~ctxt
++ (to_log_event_file t nm)
++ (if Filename.is_relative fn then
++ Filename.concat (Sys.getcwd ()) fn
++ else
++ fn);
++ true
++ end else begin
++ registered
++ end)
+ false
+ alt
+ in
+- if not registered then
+- warning
+- (f_ "Cannot find an existing alternative files among: %s")
+- (String.concat (s_ ", ") alt))
++ if not registered then
++ warning
++ (f_ "Cannot find an existing alternative files among: %s")
++ (String.concat (s_ ", ") alt))
+ lst
+
+
+- let unregister t nm =
++ let unregister ~ctxt t nm =
+ List.iter
+- (fun (e, d) ->
+- BaseLog.unregister e d)
+- (BaseLog.filter
+- [to_log_event_file t nm;
+- to_log_event_done t nm])
++ (fun (e, d) -> BaseLog.unregister ~ctxt e d)
++ (BaseLog.filter ~ctxt [to_log_event_file t nm; to_log_event_done t nm])
+
+
+- let fold t nm f acc =
++ let fold ~ctxt t nm f acc =
+ List.fold_left
+ (fun acc (_, fn) ->
+- if OASISFileUtil.file_exists_case fn then
+- begin
+- f acc fn
+- end
+- else
+- begin
+- warning
+- (f_ "File '%s' has been marked as built \
++ if OASISFileUtil.file_exists_case fn then begin
++ f acc fn
++ end else begin
++ warning
++ (f_ "File '%s' has been marked as built \
+ for %s but doesn't exist")
+- fn
+- (Printf.sprintf
+- (match t with
+- | BExec | BExecLib ->
+- (f_ "executable %s")
+- | BLib ->
+- (f_ "library %s")
+- | BObj ->
+- (f_ "object %s")
+- | BDoc ->
+- (f_ "documentation %s"))
+- nm);
+- acc
+- end)
++ fn
++ (Printf.sprintf
++ (match t with
++ | BExec | BExecLib -> (f_ "executable %s")
++ | BLib -> (f_ "library %s")
++ | BObj -> (f_ "object %s")
++ | BDoc -> (f_ "documentation %s"))
++ nm);
++ acc
++ end)
+ acc
+- (BaseLog.filter
+- [to_log_event_file t nm])
++ (BaseLog.filter ~ctxt [to_log_event_file t nm])
+
+
+- let is_built t nm =
++ let is_built ~ctxt t nm =
+ List.fold_left
+- (fun is_built (_, d) ->
+- (try
+- bool_of_string d
+- with _ ->
+- false))
++ (fun _ (_, d) -> try bool_of_string d with _ -> false)
+ false
+- (BaseLog.filter
+- [to_log_event_done t nm])
++ (BaseLog.filter ~ctxt [to_log_event_done t nm])
+
+
+ let of_executable ffn (cs, bs, exec) =
+@@ -4523,15 +4711,15 @@ module BaseBuilt = struct
+ let evs =
+ (BExec, cs.cs_name, [[ffn unix_exec_is]])
+ ::
+- (match unix_dll_opt with
+- | Some fn ->
+- [BExecLib, cs.cs_name, [[ffn fn]]]
+- | None ->
+- [])
+- in
+- evs,
+- unix_exec_is,
+- unix_dll_opt
++ (match unix_dll_opt with
++ | Some fn ->
++ [BExecLib, cs.cs_name, [[ffn fn]]]
++ | None ->
++ [])
++ in
++ evs,
++ unix_exec_is,
++ unix_dll_opt
+
+
+ let of_library ffn (cs, bs, lib) =
+@@ -4539,7 +4727,7 @@ module BaseBuilt = struct
+ OASISLibrary.generated_unix_files
+ ~ctxt:!BaseContext.default
+ ~source_file_exists:(fun fn ->
+- OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
++ OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
+ ~is_native:(bool_of_string (is_native ()))
+ ~has_native_dynlink:(bool_of_string (native_dynlink ()))
+ ~ext_lib:(ext_lib ())
+@@ -4551,7 +4739,7 @@ module BaseBuilt = struct
+ cs.cs_name,
+ List.map (List.map ffn) unix_lst]
+ in
+- evs, unix_lst
++ evs, unix_lst
+
+
+ let of_object ffn (cs, bs, obj) =
+@@ -4559,7 +4747,7 @@ module BaseBuilt = struct
+ OASISObject.generated_unix_files
+ ~ctxt:!BaseContext.default
+ ~source_file_exists:(fun fn ->
+- OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
++ OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
+ ~is_native:(bool_of_string (is_native ()))
+ (cs, bs, obj)
+ in
+@@ -4568,7 +4756,7 @@ module BaseBuilt = struct
+ cs.cs_name,
+ List.map (List.map ffn) unix_lst]
+ in
+- evs, unix_lst
++ evs, unix_lst
+
+ end
+
+@@ -4597,32 +4785,32 @@ module BaseCustom = struct
+ | Some (cmd, args) -> String.concat " " (cmd :: args)
+ | None -> s_ "No command"
+ in
+- match
+- var_choose
+- ~name:(s_ "Pre/Post Command")
+- ~printer
+- lst with
+- | Some (cmd, args) ->
+- begin
+- try
+- run cmd args [||]
+- with e when failsafe ->
+- warning
+- (f_ "Command '%s' fail with error: %s")
+- (String.concat " " (cmd :: args))
+- (match e with
+- | Failure msg -> msg
+- | e -> Printexc.to_string e)
+- end
+- | None ->
+- ()
++ match
++ var_choose
++ ~name:(s_ "Pre/Post Command")
++ ~printer
++ lst with
++ | Some (cmd, args) ->
++ begin
++ try
++ run cmd args [||]
++ with e when failsafe ->
++ warning
++ (f_ "Command '%s' fail with error: %s")
++ (String.concat " " (cmd :: args))
++ (match e with
++ | Failure msg -> msg
++ | e -> Printexc.to_string e)
++ end
++ | None ->
++ ()
+ in
+ let res =
+ optional_command cstm.pre_command;
+ f e
+ in
+- optional_command cstm.post_command;
+- res
++ optional_command cstm.post_command;
++ res
+ end
+
+ module BaseDynVar = struct
+@@ -4635,41 +4823,38 @@ module BaseDynVar = struct
+ open BaseBuilt
+
+
+- let init pkg =
++ let init ~ctxt pkg =
+ (* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *)
+ (* TODO: provide compile option for library libary_byte_args_VARNAME... *)
+ List.iter
+ (function
+- | Executable (cs, bs, exec) ->
+- if var_choose bs.bs_build then
+- var_ignore
+- (var_redefine
+- (* We don't save this variable *)
+- ~dump:false
+- ~short_desc:(fun () ->
+- Printf.sprintf
+- (f_ "Filename of executable '%s'")
+- cs.cs_name)
+- (OASISUtils.varname_of_string cs.cs_name)
+- (fun () ->
+- let fn_opt =
+- fold
+- BExec cs.cs_name
+- (fun _ fn -> Some fn)
+- None
+- in
+- match fn_opt with
+- | Some fn -> fn
+- | None ->
+- raise
+- (PropList.Not_set
+- (cs.cs_name,
+- Some (Printf.sprintf
+- (f_ "Executable '%s' not yet built.")
+- cs.cs_name)))))
++ | Executable (cs, bs, _) ->
++ if var_choose bs.bs_build then
++ var_ignore
++ (var_redefine
++ (* We don't save this variable *)
++ ~dump:false
++ ~short_desc:(fun () ->
++ Printf.sprintf
++ (f_ "Filename of executable '%s'")
++ cs.cs_name)
++ (OASISUtils.varname_of_string cs.cs_name)
++ (fun () ->
++ let fn_opt =
++ fold ~ctxt BExec cs.cs_name (fun _ fn -> Some fn) None
++ in
++ match fn_opt with
++ | Some fn -> fn
++ | None ->
++ raise
++ (PropList.Not_set
++ (cs.cs_name,
++ Some (Printf.sprintf
++ (f_ "Executable '%s' not yet built.")
++ cs.cs_name)))))
+
+- | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
+- ())
++ | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
++ ())
+ pkg.sections
+ end
+
+@@ -4680,89 +4865,74 @@ module BaseTest = struct
+ open BaseEnv
+ open BaseMessage
+ open OASISTypes
+- open OASISExpr
+ open OASISGettext
+
+
+- let test lst pkg extra_args =
++ let test ~ctxt lst pkg extra_args =
+
+ let one_test (failure, n) (test_plugin, cs, test) =
+ if var_choose
+- ~name:(Printf.sprintf
+- (f_ "test %s run")
+- cs.cs_name)
+- ~printer:string_of_bool
+- test.test_run then
++ ~name:(Printf.sprintf
++ (f_ "test %s run")
++ cs.cs_name)
++ ~printer:string_of_bool
++ test.test_run then
+ begin
+- let () =
+- info (f_ "Running test '%s'") cs.cs_name
+- in
++ let () = info (f_ "Running test '%s'") cs.cs_name in
+ let back_cwd =
+ match test.test_working_directory with
+ | Some dir ->
+- let cwd =
+- Sys.getcwd ()
+- in
+- let chdir d =
+- info (f_ "Changing directory to '%s'") d;
+- Sys.chdir d
+- in
+- chdir dir;
+- fun () -> chdir cwd
++ let cwd = Sys.getcwd () in
++ let chdir d =
++ info (f_ "Changing directory to '%s'") d;
++ Sys.chdir d
++ in
++ chdir dir;
++ fun () -> chdir cwd
+
+ | None ->
+- fun () -> ()
++ fun () -> ()
+ in
+- try
+- let failure_percent =
+- BaseCustom.hook
+- test.test_custom
+- (test_plugin pkg (cs, test))
+- extra_args
+- in
+- back_cwd ();
+- (failure_percent +. failure, n + 1)
+- with e ->
+- begin
+- back_cwd ();
+- raise e
+- end
++ try
++ let failure_percent =
++ BaseCustom.hook
++ test.test_custom
++ (test_plugin ~ctxt pkg (cs, test))
++ extra_args
++ in
++ back_cwd ();
++ (failure_percent +. failure, n + 1)
++ with e ->
++ begin
++ back_cwd ();
++ raise e
++ end
+ end
+ else
+ begin
+ info (f_ "Skipping test '%s'") cs.cs_name;
+- (failure, n)
+- end
+- in
+- let failed, n =
+- List.fold_left
+- one_test
+- (0.0, 0)
+- lst
+- in
+- let failure_percent =
+- if n = 0 then
+- 0.0
+- else
+- failed /. (float_of_int n)
++ (failure, n)
++ end
+ in
++ let failed, n = List.fold_left one_test (0.0, 0) lst in
++ let failure_percent = if n = 0 then 0.0 else failed /. (float_of_int n) in
+ let msg =
+ Printf.sprintf
+ (f_ "Tests had a %.2f%% failure rate")
+ (100. *. failure_percent)
+ in
+- if failure_percent > 0.0 then
+- failwith msg
+- else
+- info "%s" msg;
++ if failure_percent > 0.0 then
++ failwith msg
++ else
++ info "%s" msg;
+
+- (* Possible explanation why the tests where not run. *)
+- if OASISFeatures.package_test OASISFeatures.flag_tests pkg &&
+- not (bool_of_string (BaseStandardVar.tests ())) &&
+- lst <> [] then
+- BaseMessage.warning
+- "Tests are turned off, consider enabling with \
+- 'ocaml setup.ml -configure --enable-tests'"
++ (* Possible explanation why the tests where not run. *)
++ if OASISFeatures.package_test OASISFeatures.flag_tests pkg &&
++ not (bool_of_string (BaseStandardVar.tests ())) &&
++ lst <> [] then
++ BaseMessage.warning
++ "Tests are turned off, consider enabling with \
++ 'ocaml setup.ml -configure --enable-tests'"
+ end
+
+ module BaseDoc = struct
+@@ -4775,74 +4945,79 @@ module BaseDoc = struct
+ open OASISGettext
+
+
+- let doc lst pkg extra_args =
++ let doc ~ctxt lst pkg extra_args =
+
+ let one_doc (doc_plugin, cs, doc) =
+ if var_choose
+- ~name:(Printf.sprintf
+- (f_ "documentation %s build")
+- cs.cs_name)
+- ~printer:string_of_bool
+- doc.doc_build then
++ ~name:(Printf.sprintf
++ (f_ "documentation %s build")
++ cs.cs_name)
++ ~printer:string_of_bool
++ doc.doc_build then
+ begin
+ info (f_ "Building documentation '%s'") cs.cs_name;
+ BaseCustom.hook
+ doc.doc_custom
+- (doc_plugin pkg (cs, doc))
++ (doc_plugin ~ctxt pkg (cs, doc))
+ extra_args
+ end
+ in
+- List.iter one_doc lst;
++ List.iter one_doc lst;
+
+- if OASISFeatures.package_test OASISFeatures.flag_docs pkg &&
+- not (bool_of_string (BaseStandardVar.docs ())) &&
+- lst <> [] then
+- BaseMessage.warning
+- "Docs are turned off, consider enabling with \
+- 'ocaml setup.ml -configure --enable-docs'"
++ if OASISFeatures.package_test OASISFeatures.flag_docs pkg &&
++ not (bool_of_string (BaseStandardVar.docs ())) &&
++ lst <> [] then
++ BaseMessage.warning
++ "Docs are turned off, consider enabling with \
++ 'ocaml setup.ml -configure --enable-docs'"
+ end
+
+ module BaseSetup = struct
+ (* # 22 "src/base/BaseSetup.ml" *)
+
++ open OASISContext
+ open BaseEnv
+ open BaseMessage
+ open OASISTypes
+- open OASISSection
+ open OASISGettext
+ open OASISUtils
+
+
+ type std_args_fun =
+- package -> string array -> unit
++ ctxt:OASISContext.t -> package -> string array -> unit
+
+
+ type ('a, 'b) section_args_fun =
+- name * (package -> (common_section * 'a) -> string array -> 'b)
++ name *
++ (ctxt:OASISContext.t ->
++ package ->
++ (common_section * 'a) ->
++ string array ->
++ 'b)
+
+
+ type t =
+- {
+- configure: std_args_fun;
+- build: std_args_fun;
+- doc: ((doc, unit) section_args_fun) list;
+- test: ((test, float) section_args_fun) list;
+- install: std_args_fun;
+- uninstall: std_args_fun;
+- clean: std_args_fun list;
+- clean_doc: (doc, unit) section_args_fun list;
+- clean_test: (test, unit) section_args_fun list;
+- distclean: std_args_fun list;
+- distclean_doc: (doc, unit) section_args_fun list;
+- distclean_test: (test, unit) section_args_fun list;
+- package: package;
+- oasis_fn: string option;
+- oasis_version: string;
+- oasis_digest: Digest.t option;
+- oasis_exec: string option;
+- oasis_setup_args: string list;
+- setup_update: bool;
+- }
++ {
++ configure: std_args_fun;
++ build: std_args_fun;
++ doc: ((doc, unit) section_args_fun) list;
++ test: ((test, float) section_args_fun) list;
++ install: std_args_fun;
++ uninstall: std_args_fun;
++ clean: std_args_fun list;
++ clean_doc: (doc, unit) section_args_fun list;
++ clean_test: (test, unit) section_args_fun list;
++ distclean: std_args_fun list;
++ distclean_doc: (doc, unit) section_args_fun list;
++ distclean_test: (test, unit) section_args_fun list;
++ package: package;
++ oasis_fn: string option;
++ oasis_version: string;
++ oasis_digest: Digest.t option;
++ oasis_exec: string option;
++ oasis_setup_args: string list;
++ setup_update: bool;
++ }
+
+
+ (* Associate a plugin function with data from package *)
+@@ -4852,9 +5027,9 @@ module BaseSetup = struct
+ (fun acc sct ->
+ match filter_map sct with
+ | Some e ->
+- e :: acc
++ e :: acc
+ | None ->
+- acc)
++ acc)
+ []
+ lst)
+
+@@ -4871,7 +5046,7 @@ module BaseSetup = struct
+ action
+
+
+- let configure t args =
++ let configure ~ctxt t args =
+ (* Run configure *)
+ BaseCustom.hook
+ t.package.conf_custom
+@@ -4880,154 +5055,137 @@ module BaseSetup = struct
+ begin
+ try
+ unload ();
+- load ();
++ load ~ctxt ();
+ with _ ->
+ ()
+ end;
+
+ (* Run plugin's configure *)
+- t.configure t.package args;
++ t.configure ~ctxt t.package args;
+
+ (* Dump to allow postconf to change it *)
+- dump ())
++ dump ~ctxt ())
+ ();
+
+ (* Reload environment *)
+ unload ();
+- load ();
++ load ~ctxt ();
+
+ (* Save environment *)
+ print ();
+
+ (* Replace data in file *)
+- BaseFileAB.replace t.package.files_ab
++ BaseFileAB.replace ~ctxt t.package.files_ab
+
+
+- let build t args =
++ let build ~ctxt t args =
+ BaseCustom.hook
+ t.package.build_custom
+- (t.build t.package)
++ (t.build ~ctxt t.package)
+ args
+
+
+- let doc t args =
++ let doc ~ctxt t args =
+ BaseDoc.doc
++ ~ctxt
+ (join_plugin_sections
+ (function
+- | Doc (cs, e) ->
+- Some
+- (lookup_plugin_section
+- "documentation"
+- (s_ "build")
+- cs.cs_name
+- t.doc,
+- cs,
+- e)
+- | _ ->
+- None)
++ | Doc (cs, e) ->
++ Some
++ (lookup_plugin_section
++ "documentation"
++ (s_ "build")
++ cs.cs_name
++ t.doc,
++ cs,
++ e)
++ | _ ->
++ None)
+ t.package.sections)
+ t.package
+ args
+
+
+- let test t args =
++ let test ~ctxt t args =
+ BaseTest.test
++ ~ctxt
+ (join_plugin_sections
+ (function
+- | Test (cs, e) ->
+- Some
+- (lookup_plugin_section
+- "test"
+- (s_ "run")
+- cs.cs_name
+- t.test,
+- cs,
+- e)
+- | _ ->
+- None)
++ | Test (cs, e) ->
++ Some
++ (lookup_plugin_section
++ "test"
++ (s_ "run")
++ cs.cs_name
++ t.test,
++ cs,
++ e)
++ | _ ->
++ None)
+ t.package.sections)
+ t.package
+ args
+
+
+- let all t args =
+- let rno_doc =
+- ref false
+- in
+- let rno_test =
+- ref false
+- in
+- let arg_rest =
+- ref []
+- in
+- Arg.parse_argv
+- ~current:(ref 0)
+- (Array.of_list
+- ((Sys.executable_name^" all") ::
++ let all ~ctxt t args =
++ let rno_doc = ref false in
++ let rno_test = ref false in
++ let arg_rest = ref [] in
++ Arg.parse_argv
++ ~current:(ref 0)
++ (Array.of_list
++ ((Sys.executable_name^" all") ::
+ (Array.to_list args)))
+- [
+- "-no-doc",
+- Arg.Set rno_doc,
+- s_ "Don't run doc target";
+-
+- "-no-test",
+- Arg.Set rno_test,
+- s_ "Don't run test target";
+-
+- "--",
+- Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest),
+- s_ "All arguments for configure.";
+- ]
+- (failwithf (f_ "Don't know what to do with '%s'"))
+- "";
+-
+- info "Running configure step";
+- configure t (Array.of_list (List.rev !arg_rest));
++ [
++ "-no-doc",
++ Arg.Set rno_doc,
++ s_ "Don't run doc target";
++
++ "-no-test",
++ Arg.Set rno_test,
++ s_ "Don't run test target";
++
++ "--",
++ Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest),
++ s_ "All arguments for configure.";
++ ]
++ (failwithf (f_ "Don't know what to do with '%s'"))
++ "";
+
+- info "Running build step";
+- build t [||];
++ info "Running configure step";
++ configure ~ctxt t (Array.of_list (List.rev !arg_rest));
+
+- (* Load setup.log dynamic variables *)
+- BaseDynVar.init t.package;
++ info "Running build step";
++ build ~ctxt t [||];
+
+- if not !rno_doc then
+- begin
+- info "Running doc step";
+- doc t [||];
+- end
+- else
+- begin
+- info "Skipping doc step"
+- end;
++ (* Load setup.log dynamic variables *)
++ BaseDynVar.init ~ctxt t.package;
+
+- if not !rno_test then
+- begin
+- info "Running test step";
+- test t [||]
+- end
+- else
+- begin
+- info "Skipping test step"
+- end
++ if not !rno_doc then begin
++ info "Running doc step";
++ doc ~ctxt t [||]
++ end else begin
++ info "Skipping doc step"
++ end;
++ if not !rno_test then begin
++ info "Running test step";
++ test ~ctxt t [||]
++ end else begin
++ info "Skipping test step"
++ end
+
+
+- let install t args =
+- BaseCustom.hook
+- t.package.install_custom
+- (t.install t.package)
+- args
++ let install ~ctxt t args =
++ BaseCustom.hook t.package.install_custom (t.install ~ctxt t.package) args
+
+
+- let uninstall t args =
+- BaseCustom.hook
+- t.package.uninstall_custom
+- (t.uninstall t.package)
+- args
++ let uninstall ~ctxt t args =
++ BaseCustom.hook t.package.uninstall_custom (t.uninstall ~ctxt t.package) args
+
+
+- let reinstall t args =
+- uninstall t args;
+- install t args
++ let reinstall ~ctxt t args =
++ uninstall ~ctxt t args;
++ install ~ctxt t args
+
+
+ let clean, distclean =
+@@ -5038,11 +5196,11 @@ module BaseSetup = struct
+ warning
+ (f_ "Action fail with error: %s")
+ (match e with
+- | Failure msg -> msg
+- | e -> Printexc.to_string e)
++ | Failure msg -> msg
++ | e -> Printexc.to_string e)
+ in
+
+- let generic_clean t cstm mains docs tests args =
++ let generic_clean ~ctxt t cstm mains docs tests args =
+ BaseCustom.hook
+ ~failsafe:true
+ cstm
+@@ -5050,45 +5208,32 @@ module BaseSetup = struct
+ (* Clean section *)
+ List.iter
+ (function
+- | Test (cs, test) ->
+- let f =
+- try
+- List.assoc cs.cs_name tests
+- with Not_found ->
+- fun _ _ _ -> ()
+- in
+- failsafe
+- (f t.package (cs, test))
+- args
+- | Doc (cs, doc) ->
+- let f =
+- try
+- List.assoc cs.cs_name docs
+- with Not_found ->
+- fun _ _ _ -> ()
+- in
+- failsafe
+- (f t.package (cs, doc))
+- args
+- | Library _
+- | Object _
+- | Executable _
+- | Flag _
+- | SrcRepo _ ->
+- ())
++ | Test (cs, test) ->
++ let f =
++ try
++ List.assoc cs.cs_name tests
++ with Not_found ->
++ fun ~ctxt:_ _ _ _ -> ()
++ in
++ failsafe (f ~ctxt t.package (cs, test)) args
++ | Doc (cs, doc) ->
++ let f =
++ try
++ List.assoc cs.cs_name docs
++ with Not_found ->
++ fun ~ctxt:_ _ _ _ -> ()
++ in
++ failsafe (f ~ctxt t.package (cs, doc)) args
++ | Library _ | Object _ | Executable _ | Flag _ | SrcRepo _ -> ())
+ t.package.sections;
+ (* Clean whole package *)
+- List.iter
+- (fun f ->
+- failsafe
+- (f t.package)
+- args)
+- mains)
++ List.iter (fun f -> failsafe (f ~ctxt t.package) args) mains)
+ ()
+ in
+
+- let clean t args =
++ let clean ~ctxt t args =
+ generic_clean
++ ~ctxt
+ t
+ t.package.clean_custom
+ t.clean
+@@ -5097,12 +5242,13 @@ module BaseSetup = struct
+ args
+ in
+
+- let distclean t args =
++ let distclean ~ctxt t args =
+ (* Call clean *)
+- clean t args;
++ clean ~ctxt t args;
+
+ (* Call distclean code *)
+ generic_clean
++ ~ctxt
+ t
+ t.package.distclean_custom
+ t.distclean
+@@ -5110,36 +5256,31 @@ module BaseSetup = struct
+ t.distclean_test
+ args;
+
+- (* Remove generated file *)
++ (* Remove generated source files. *)
+ List.iter
+ (fun fn ->
+- if Sys.file_exists fn then
+- begin
+- info (f_ "Remove '%s'") fn;
+- Sys.remove fn
+- end)
+- (BaseEnv.default_filename
+- ::
+- BaseLog.default_filename
+- ::
+- (List.rev_map BaseFileAB.to_filename t.package.files_ab))
++ if ctxt.srcfs#file_exists fn then begin
++ info (f_ "Remove '%s'") (ctxt.srcfs#string_of_filename fn);
++ ctxt.srcfs#remove fn
++ end)
++ ([BaseEnv.default_filename; BaseLog.default_filename]
++ @ (List.rev_map BaseFileAB.to_filename t.package.files_ab))
+ in
+
+- clean, distclean
++ clean, distclean
+
+
+- let version t _ =
+- print_endline t.oasis_version
++ let version ~ctxt:_ (t: t) _ = print_endline t.oasis_version
+
+
+ let update_setup_ml, no_update_setup_ml_cli =
+ let b = ref true in
+- b,
+- ("-no-update-setup-ml",
+- Arg.Clear b,
+- s_ " Don't try to update setup.ml, even if _oasis has changed.")
+-
++ b,
++ ("-no-update-setup-ml",
++ Arg.Clear b,
++ s_ " Don't try to update setup.ml, even if _oasis has changed.")
+
++ (* TODO: srcfs *)
+ let default_oasis_fn = "_oasis"
+
+
+@@ -5160,16 +5301,16 @@ module BaseSetup = struct
+ let setup_ml, args =
+ match Array.to_list Sys.argv with
+ | setup_ml :: args ->
+- setup_ml, args
++ setup_ml, args
+ | [] ->
+- failwith
+- (s_ "Expecting non-empty command line arguments.")
++ failwith
++ (s_ "Expecting non-empty command line arguments.")
+ in
+ let ocaml, setup_ml =
+ if Sys.executable_name = Sys.argv.(0) then
+ (* We are not running in standard mode, probably the script
+ * is precompiled.
+- *)
++ *)
+ "ocaml", "setup.ml"
+ else
+ ocaml, setup_ml
+@@ -5180,64 +5321,62 @@ module BaseSetup = struct
+ OASISExec.run_read_one_line
+ ~ctxt:!BaseContext.default
+ ~f_exit_code:
+- (function
+- | 0 ->
+- ()
+- | 1 ->
+- failwithf
+- (f_ "Executable '%s' is probably an old version \
+- of oasis (< 0.3.0), please update to version \
+- v%s.")
+- oasis_exec t.oasis_version
+- | 127 ->
+- failwithf
+- (f_ "Cannot find executable '%s', please install \
+- oasis v%s.")
+- oasis_exec t.oasis_version
+- | n ->
+- failwithf
+- (f_ "Command '%s version' exited with code %d.")
+- oasis_exec n)
++ (function
++ | 0 ->
++ ()
++ | 1 ->
++ failwithf
++ (f_ "Executable '%s' is probably an old version \
++ of oasis (< 0.3.0), please update to version \
++ v%s.")
++ oasis_exec t.oasis_version
++ | 127 ->
++ failwithf
++ (f_ "Cannot find executable '%s', please install \
++ oasis v%s.")
++ oasis_exec t.oasis_version
++ | n ->
++ failwithf
++ (f_ "Command '%s version' exited with code %d.")
++ oasis_exec n)
+ oasis_exec ["version"]
+ in
+- if OASISVersion.comparator_apply
+- (OASISVersion.version_of_string oasis_exec_version)
+- (OASISVersion.VGreaterEqual
+- (OASISVersion.version_of_string t.oasis_version)) then
+- begin
+- (* We have a version >= for the executable oasis, proceed with
+- * update.
+- *)
+- (* TODO: delegate this check to 'oasis setup'. *)
+- if Sys.os_type = "Win32" then
+- failwithf
+- (f_ "It is not possible to update the running script \
+- setup.ml on Windows. Please update setup.ml by \
+- running '%s'.")
+- (String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args))
+- else
+- begin
+- OASISExec.run
+- ~ctxt:!BaseContext.default
+- ~f_exit_code:
+- (function
+- | 0 ->
+- ()
+- | n ->
+- failwithf
+- (f_ "Unable to update setup.ml using '%s', \
+- please fix the problem and retry.")
+- oasis_exec)
+- oasis_exec ("setup" :: t.oasis_setup_args);
+- OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args)
+- end
+- end
+- else
+- failwithf
+- (f_ "The version of '%s' (v%s) doesn't match the version of \
+- oasis used to generate the %s file. Please install at \
+- least oasis v%s.")
+- oasis_exec oasis_exec_version setup_ml t.oasis_version
++ if OASISVersion.comparator_apply
++ (OASISVersion.version_of_string oasis_exec_version)
++ (OASISVersion.VGreaterEqual
++ (OASISVersion.version_of_string t.oasis_version)) then
++ begin
++ (* We have a version >= for the executable oasis, proceed with
++ * update.
++ *)
++ (* TODO: delegate this check to 'oasis setup'. *)
++ if Sys.os_type = "Win32" then
++ failwithf
++ (f_ "It is not possible to update the running script \
++ setup.ml on Windows. Please update setup.ml by \
++ running '%s'.")
++ (String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args))
++ else
++ begin
++ OASISExec.run
++ ~ctxt:!BaseContext.default
++ ~f_exit_code:
++ (fun n ->
++ if n <> 0 then
++ failwithf
++ (f_ "Unable to update setup.ml using '%s', \
++ please fix the problem and retry.")
++ oasis_exec)
++ oasis_exec ("setup" :: t.oasis_setup_args);
++ OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args)
++ end
++ end
++ else
++ failwithf
++ (f_ "The version of '%s' (v%s) doesn't match the version of \
++ oasis used to generate the %s file. Please install at \
++ least oasis v%s.")
++ oasis_exec oasis_exec_version setup_ml t.oasis_version
+ in
+
+ if !update_setup_ml then
+@@ -5254,7 +5393,7 @@ module BaseSetup = struct
+ else
+ false
+ | None ->
+- false
++ false
+ with e ->
+ error
+ (f_ "Error when updating setup.ml. If you want to avoid this error, \
+@@ -5268,158 +5407,287 @@ module BaseSetup = struct
+
+
+ let setup t =
+- let catch_exn =
+- ref true
+- in
+- try
+- let act_ref =
+- ref (fun _ ->
+- failwithf
+- (f_ "No action defined, run '%s %s -help'")
+- Sys.executable_name
+- Sys.argv.(0))
+-
+- in
+- let extra_args_ref =
+- ref []
+- in
+- let allow_empty_env_ref =
+- ref false
+- in
+- let arg_handle ?(allow_empty_env=false) act =
+- Arg.Tuple
+- [
+- Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref);
+-
+- Arg.Unit
+- (fun () ->
+- allow_empty_env_ref := allow_empty_env;
+- act_ref := act);
+- ]
+- in
++ let catch_exn = ref true in
++ let act_ref =
++ ref (fun ~ctxt:_ _ ->
++ failwithf
++ (f_ "No action defined, run '%s %s -help'")
++ Sys.executable_name
++ Sys.argv.(0))
+
+- Arg.parse
+- (Arg.align
+- ([
+- "-configure",
+- arg_handle ~allow_empty_env:true configure,
+- s_ "[options*] Configure the whole build process.";
+-
+- "-build",
+- arg_handle build,
+- s_ "[options*] Build executables and libraries.";
+-
+- "-doc",
+- arg_handle doc,
+- s_ "[options*] Build documents.";
+-
+- "-test",
+- arg_handle test,
+- s_ "[options*] Run tests.";
+-
+- "-all",
+- arg_handle ~allow_empty_env:true all,
+- s_ "[options*] Run configure, build, doc and test targets.";
+-
+- "-install",
+- arg_handle install,
+- s_ "[options*] Install libraries, data, executables \
+- and documents.";
+-
+- "-uninstall",
+- arg_handle uninstall,
+- s_ "[options*] Uninstall libraries, data, executables \
+- and documents.";
+-
+- "-reinstall",
+- arg_handle reinstall,
+- s_ "[options*] Uninstall and install libraries, data, \
+- executables and documents.";
+-
+- "-clean",
+- arg_handle ~allow_empty_env:true clean,
+- s_ "[options*] Clean files generated by a build.";
+-
+- "-distclean",
+- arg_handle ~allow_empty_env:true distclean,
+- s_ "[options*] Clean files generated by a build and configure.";
+-
+- "-version",
+- arg_handle ~allow_empty_env:true version,
+- s_ " Display version of OASIS used to generate this setup.ml.";
+-
+- "-no-catch-exn",
+- Arg.Clear catch_exn,
+- s_ " Don't catch exception, useful for debugging.";
+- ]
+- @
++ in
++ let extra_args_ref = ref [] in
++ let allow_empty_env_ref = ref false in
++ let arg_handle ?(allow_empty_env=false) act =
++ Arg.Tuple
++ [
++ Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref);
++ Arg.Unit
++ (fun () ->
++ allow_empty_env_ref := allow_empty_env;
++ act_ref := act);
++ ]
++ in
++ try
++ let () =
++ Arg.parse
++ (Arg.align
++ ([
++ "-configure",
++ arg_handle ~allow_empty_env:true configure,
++ s_ "[options*] Configure the whole build process.";
++
++ "-build",
++ arg_handle build,
++ s_ "[options*] Build executables and libraries.";
++
++ "-doc",
++ arg_handle doc,
++ s_ "[options*] Build documents.";
++
++ "-test",
++ arg_handle test,
++ s_ "[options*] Run tests.";
++
++ "-all",
++ arg_handle ~allow_empty_env:true all,
++ s_ "[options*] Run configure, build, doc and test targets.";
++
++ "-install",
++ arg_handle install,
++ s_ "[options*] Install libraries, data, executables \
++ and documents.";
++
++ "-uninstall",
++ arg_handle uninstall,
++ s_ "[options*] Uninstall libraries, data, executables \
++ and documents.";
++
++ "-reinstall",
++ arg_handle reinstall,
++ s_ "[options*] Uninstall and install libraries, data, \
++ executables and documents.";
++
++ "-clean",
++ arg_handle ~allow_empty_env:true clean,
++ s_ "[options*] Clean files generated by a build.";
++
++ "-distclean",
++ arg_handle ~allow_empty_env:true distclean,
++ s_ "[options*] Clean files generated by a build and configure.";
++
++ "-version",
++ arg_handle ~allow_empty_env:true version,
++ s_ " Display version of OASIS used to generate this setup.ml.";
++
++ "-no-catch-exn",
++ Arg.Clear catch_exn,
++ s_ " Don't catch exception, useful for debugging.";
++ ]
++ @
+ (if t.setup_update then
+ [no_update_setup_ml_cli]
+ else
+ [])
+- @ (BaseContext.args ())))
+- (failwithf (f_ "Don't know what to do with '%s'"))
+- (s_ "Setup and run build process current package\n");
++ @ (BaseContext.args ())))
++ (failwithf (f_ "Don't know what to do with '%s'"))
++ (s_ "Setup and run build process current package\n")
++ in
+
+- (* Build initial environment *)
+- load ~allow_empty:!allow_empty_env_ref ();
++ (* Instantiate the context. *)
++ let ctxt = !BaseContext.default in
+
+- (** Initialize flags *)
+- List.iter
+- (function
+- | Flag (cs, {flag_description = hlp;
+- flag_default = choices}) ->
+- begin
+- let apply ?short_desc () =
+- var_ignore
+- (var_define
+- ~cli:CLIEnable
+- ?short_desc
+- (OASISUtils.varname_of_string cs.cs_name)
+- (fun () ->
+- string_of_bool
+- (var_choose
+- ~name:(Printf.sprintf
+- (f_ "default value of flag %s")
+- cs.cs_name)
+- ~printer:string_of_bool
+- choices)))
+- in
+- match hlp with
+- | Some hlp ->
+- apply ~short_desc:(fun () -> hlp) ()
+- | None ->
+- apply ()
+- end
+- | _ ->
+- ())
+- t.package.sections;
++ (* Build initial environment *)
++ load ~ctxt ~allow_empty:!allow_empty_env_ref ();
++
++ (** Initialize flags *)
++ List.iter
++ (function
++ | Flag (cs, {flag_description = hlp;
++ flag_default = choices}) ->
++ begin
++ let apply ?short_desc () =
++ var_ignore
++ (var_define
++ ~cli:CLIEnable
++ ?short_desc
++ (OASISUtils.varname_of_string cs.cs_name)
++ (fun () ->
++ string_of_bool
++ (var_choose
++ ~name:(Printf.sprintf
++ (f_ "default value of flag %s")
++ cs.cs_name)
++ ~printer:string_of_bool
++ choices)))
++ in
++ match hlp with
++ | Some hlp -> apply ~short_desc:(fun () -> hlp) ()
++ | None -> apply ()
++ end
++ | _ ->
++ ())
++ t.package.sections;
+
+- BaseStandardVar.init t.package;
++ BaseStandardVar.init t.package;
+
+- BaseDynVar.init t.package;
++ BaseDynVar.init ~ctxt t.package;
+
+- if t.setup_update && update_setup_ml t then
+- ()
+- else
+- !act_ref t (Array.of_list (List.rev !extra_args_ref))
++ if not (t.setup_update && update_setup_ml t) then
++ !act_ref ~ctxt t (Array.of_list (List.rev !extra_args_ref))
++
++ with e when !catch_exn ->
++ error "%s" (Printexc.to_string e);
++ exit 1
++
++
++end
++
++module BaseCompat = struct
++(* # 22 "src/base/BaseCompat.ml" *)
++
++ (** Compatibility layer to provide a stable API inside setup.ml.
++ This layer allows OASIS to change in between minor versions
++ (e.g. 0.4.6 -> 0.4.7) but still provides a stable API inside setup.ml. This
++ enables to write functions that manipulate setup_t inside setup.ml. See
++ deps.ml for an example.
++
++ The module opened by default will depend on the version of the _oasis. E.g.
++ if we have "OASISFormat: 0.3", the module Compat_0_3 will be opened and
++ the function Compat_0_3 will be called. If setup.ml is generated with the
++ -nocompat, no module will be opened.
++
++ @author Sylvain Le Gall
++ *)
++
++ module Compat_0_4 =
++ struct
++ let rctxt = ref !BaseContext.default
++
++ module BaseSetup =
++ struct
++ module Original = BaseSetup
++
++ open OASISTypes
++
++ type std_args_fun = package -> string array -> unit
++ type ('a, 'b) section_args_fun =
++ name * (package -> (common_section * 'a) -> string array -> 'b)
++ type t =
++ {
++ configure: std_args_fun;
++ build: std_args_fun;
++ doc: ((doc, unit) section_args_fun) list;
++ test: ((test, float) section_args_fun) list;
++ install: std_args_fun;
++ uninstall: std_args_fun;
++ clean: std_args_fun list;
++ clean_doc: (doc, unit) section_args_fun list;
++ clean_test: (test, unit) section_args_fun list;
++ distclean: std_args_fun list;
++ distclean_doc: (doc, unit) section_args_fun list;
++ distclean_test: (test, unit) section_args_fun list;
++ package: package;
++ oasis_fn: string option;
++ oasis_version: string;
++ oasis_digest: Digest.t option;
++ oasis_exec: string option;
++ oasis_setup_args: string list;
++ setup_update: bool;
++ }
++
++ let setup t =
++ let mk_std_args_fun f =
++ fun ~ctxt pkg args -> rctxt := ctxt; f pkg args
++ in
++ let mk_section_args_fun l =
++ List.map
++ (fun (nm, f) ->
++ nm,
++ (fun ~ctxt pkg sct args ->
++ rctxt := ctxt;
++ f pkg sct args))
++ l
++ in
++ let t' =
++ {
++ Original.
++ configure = mk_std_args_fun t.configure;
++ build = mk_std_args_fun t.build;
++ doc = mk_section_args_fun t.doc;
++ test = mk_section_args_fun t.test;
++ install = mk_std_args_fun t.install;
++ uninstall = mk_std_args_fun t.uninstall;
++ clean = List.map mk_std_args_fun t.clean;
++ clean_doc = mk_section_args_fun t.clean_doc;
++ clean_test = mk_section_args_fun t.clean_test;
++ distclean = List.map mk_std_args_fun t.distclean;
++ distclean_doc = mk_section_args_fun t.distclean_doc;
++ distclean_test = mk_section_args_fun t.distclean_test;
++
++ package = t.package;
++ oasis_fn = t.oasis_fn;
++ oasis_version = t.oasis_version;
++ oasis_digest = t.oasis_digest;
++ oasis_exec = t.oasis_exec;
++ oasis_setup_args = t.oasis_setup_args;
++ setup_update = t.setup_update;
++ }
++ in
++ Original.setup t'
++
++ end
++
++ let adapt_setup_t setup_t =
++ let module O = BaseSetup.Original in
++ let mk_std_args_fun f = fun pkg args -> f ~ctxt:!rctxt pkg args in
++ let mk_section_args_fun l =
++ List.map
++ (fun (nm, f) -> nm, (fun pkg sct args -> f ~ctxt:!rctxt pkg sct args))
++ l
++ in
++ {
++ BaseSetup.
++ configure = mk_std_args_fun setup_t.O.configure;
++ build = mk_std_args_fun setup_t.O.build;
++ doc = mk_section_args_fun setup_t.O.doc;
++ test = mk_section_args_fun setup_t.O.test;
++ install = mk_std_args_fun setup_t.O.install;
++ uninstall = mk_std_args_fun setup_t.O.uninstall;
++ clean = List.map mk_std_args_fun setup_t.O.clean;
++ clean_doc = mk_section_args_fun setup_t.O.clean_doc;
++ clean_test = mk_section_args_fun setup_t.O.clean_test;
++ distclean = List.map mk_std_args_fun setup_t.O.distclean;
++ distclean_doc = mk_section_args_fun setup_t.O.distclean_doc;
++ distclean_test = mk_section_args_fun setup_t.O.distclean_test;
++
++ package = setup_t.O.package;
++ oasis_fn = setup_t.O.oasis_fn;
++ oasis_version = setup_t.O.oasis_version;
++ oasis_digest = setup_t.O.oasis_digest;
++ oasis_exec = setup_t.O.oasis_exec;
++ oasis_setup_args = setup_t.O.oasis_setup_args;
++ setup_update = setup_t.O.setup_update;
++ }
++ end
+
+- with e when !catch_exn ->
+- error "%s" (Printexc.to_string e);
+- exit 1
+
++ module Compat_0_3 =
++ struct
++ include Compat_0_4
++ end
+
+ end
+
+
+-# 5394 "setup.ml"
++# 5662 "setup.ml"
+ module InternalConfigurePlugin = struct
+ (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *)
+
+
+ (** Configure using internal scheme
+ @author Sylvain Le Gall
+- *)
++ *)
+
+
+ open BaseEnv
+@@ -5430,9 +5698,9 @@ module InternalConfigurePlugin = struct
+
+
+ (** Configure build using provided series of check to be done
+- * and then output corresponding file.
+- *)
+- let configure pkg argv =
++ and then output corresponding file.
++ *)
++ let configure ~ctxt:_ pkg argv =
+ let var_ignore_eval var = let _s: string = var () in () in
+ let errors = ref SetString.empty in
+ let buff = Buffer.create 13 in
+@@ -5454,29 +5722,29 @@ module InternalConfigurePlugin = struct
+ let check_tools lst =
+ List.iter
+ (function
+- | ExternalTool tool ->
+- begin
+- try
+- var_ignore_eval (BaseCheck.prog tool)
+- with e ->
+- warn_exception e;
+- add_errors (f_ "Cannot find external tool '%s'") tool
+- end
+- | InternalExecutable nm1 ->
+- (* Check that matching tool is built *)
+- List.iter
+- (function
+- | Executable ({cs_name = nm2},
+- {bs_build = build},
+- _) when nm1 = nm2 ->
+- if not (var_choose build) then
+- add_errors
+- (f_ "Cannot find buildable internal executable \
+- '%s' when checking build depends")
+- nm1
+- | _ ->
+- ())
+- pkg.sections)
++ | ExternalTool tool ->
++ begin
++ try
++ var_ignore_eval (BaseCheck.prog tool)
++ with e ->
++ warn_exception e;
++ add_errors (f_ "Cannot find external tool '%s'") tool
++ end
++ | InternalExecutable nm1 ->
++ (* Check that matching tool is built *)
++ List.iter
++ (function
++ | Executable ({cs_name = nm2; _},
++ {bs_build = build; _},
++ _) when nm1 = nm2 ->
++ if not (var_choose build) then
++ add_errors
++ (f_ "Cannot find buildable internal executable \
++ '%s' when checking build depends")
++ nm1
++ | _ ->
++ ())
++ pkg.sections)
+ lst
+ in
+
+@@ -5500,39 +5768,39 @@ module InternalConfigurePlugin = struct
+ (* Check depends *)
+ List.iter
+ (function
+- | FindlibPackage (findlib_pkg, version_comparator) ->
+- begin
+- try
+- var_ignore_eval
+- (BaseCheck.package ?version_comparator findlib_pkg)
+- with e ->
+- warn_exception e;
+- match version_comparator with
+- | None ->
+- add_errors
+- (f_ "Cannot find findlib package %s")
+- findlib_pkg
+- | Some ver_cmp ->
+- add_errors
+- (f_ "Cannot find findlib package %s (%s)")
+- findlib_pkg
+- (OASISVersion.string_of_comparator ver_cmp)
+- end
+- | InternalLibrary nm1 ->
+- (* Check that matching library is built *)
+- List.iter
+- (function
+- | Library ({cs_name = nm2},
+- {bs_build = build},
+- _) when nm1 = nm2 ->
+- if not (var_choose build) then
+- add_errors
+- (f_ "Cannot find buildable internal library \
+- '%s' when checking build depends")
+- nm1
+- | _ ->
+- ())
+- pkg.sections)
++ | FindlibPackage (findlib_pkg, version_comparator) ->
++ begin
++ try
++ var_ignore_eval
++ (BaseCheck.package ?version_comparator findlib_pkg)
++ with e ->
++ warn_exception e;
++ match version_comparator with
++ | None ->
++ add_errors
++ (f_ "Cannot find findlib package %s")
++ findlib_pkg
++ | Some ver_cmp ->
++ add_errors
++ (f_ "Cannot find findlib package %s (%s)")
++ findlib_pkg
++ (OASISVersion.string_of_comparator ver_cmp)
++ end
++ | InternalLibrary nm1 ->
++ (* Check that matching library is built *)
++ List.iter
++ (function
++ | Library ({cs_name = nm2; _},
++ {bs_build = build; _},
++ _) when nm1 = nm2 ->
++ if not (var_choose build) then
++ add_errors
++ (f_ "Cannot find buildable internal library \
++ '%s' when checking build depends")
++ nm1
++ | _ ->
++ ())
++ pkg.sections)
+ bs.bs_build_depends
+ end
+ in
+@@ -5544,50 +5812,50 @@ module InternalConfigurePlugin = struct
+ begin
+ match pkg.ocaml_version with
+ | Some ver_cmp ->
+- begin
+- try
+- var_ignore_eval
+- (BaseCheck.version
+- "ocaml"
+- ver_cmp
+- BaseStandardVar.ocaml_version)
+- with e ->
+- warn_exception e;
+- add_errors
+- (f_ "OCaml version %s doesn't match version constraint %s")
+- (BaseStandardVar.ocaml_version ())
+- (OASISVersion.string_of_comparator ver_cmp)
+- end
++ begin
++ try
++ var_ignore_eval
++ (BaseCheck.version
++ "ocaml"
++ ver_cmp
++ BaseStandardVar.ocaml_version)
++ with e ->
++ warn_exception e;
++ add_errors
++ (f_ "OCaml version %s doesn't match version constraint %s")
++ (BaseStandardVar.ocaml_version ())
++ (OASISVersion.string_of_comparator ver_cmp)
++ end
+ | None ->
+- ()
++ ()
+ end;
+
+ (* Findlib version *)
+ begin
+ match pkg.findlib_version with
+ | Some ver_cmp ->
+- begin
+- try
+- var_ignore_eval
+- (BaseCheck.version
+- "findlib"
+- ver_cmp
+- BaseStandardVar.findlib_version)
+- with e ->
+- warn_exception e;
+- add_errors
+- (f_ "Findlib version %s doesn't match version constraint %s")
+- (BaseStandardVar.findlib_version ())
+- (OASISVersion.string_of_comparator ver_cmp)
+- end
++ begin
++ try
++ var_ignore_eval
++ (BaseCheck.version
++ "findlib"
++ ver_cmp
++ BaseStandardVar.findlib_version)
++ with e ->
++ warn_exception e;
++ add_errors
++ (f_ "Findlib version %s doesn't match version constraint %s")
++ (BaseStandardVar.findlib_version ())
++ (OASISVersion.string_of_comparator ver_cmp)
++ end
+ | None ->
+- ()
++ ()
+ end;
+ (* Make sure the findlib version is fine for the OCaml compiler. *)
+ begin
+ let ocaml_ge4 =
+ OASISVersion.version_compare
+- (OASISVersion.version_of_string (BaseStandardVar.ocaml_version()))
++ (OASISVersion.version_of_string (BaseStandardVar.ocaml_version ()))
+ (OASISVersion.version_of_string "4.0.0") >= 0 in
+ if ocaml_ge4 then
+ let findlib_lt132 =
+@@ -5612,37 +5880,37 @@ module InternalConfigurePlugin = struct
+ (* Check build depends *)
+ List.iter
+ (function
+- | Executable (_, bs, _)
+- | Library (_, bs, _) as sct ->
+- build_checks sct bs
+- | Doc (_, doc) ->
+- if var_choose doc.doc_build then
+- check_tools doc.doc_build_tools
+- | Test (_, test) ->
+- if var_choose test.test_run then
+- check_tools test.test_tools
+- | _ ->
+- ())
++ | Executable (_, bs, _)
++ | Library (_, bs, _) as sct ->
++ build_checks sct bs
++ | Doc (_, doc) ->
++ if var_choose doc.doc_build then
++ check_tools doc.doc_build_tools
++ | Test (_, test) ->
++ if var_choose test.test_run then
++ check_tools test.test_tools
++ | _ ->
++ ())
+ pkg.sections;
+
+ (* Check if we need native dynlink (presence of libraries that compile to
+- * native)
+- *)
++ native)
++ *)
+ begin
+ let has_cmxa =
+ List.exists
+ (function
+- | Library (_, bs, _) ->
+- var_choose bs.bs_build &&
+- (bs.bs_compiled_object = Native ||
+- (bs.bs_compiled_object = Best &&
+- bool_of_string (BaseStandardVar.is_native ())))
+- | _ ->
+- false)
++ | Library (_, bs, _) ->
++ var_choose bs.bs_build &&
++ (bs.bs_compiled_object = Native ||
++ (bs.bs_compiled_object = Best &&
++ bool_of_string (BaseStandardVar.is_native ())))
++ | _ ->
++ false)
+ pkg.sections
+ in
+- if has_cmxa then
+- var_ignore_eval BaseStandardVar.native_dynlink
++ if has_cmxa then
++ var_ignore_eval BaseStandardVar.native_dynlink
+ end;
+
+ (* Check errors *)
+@@ -5671,6 +5939,8 @@ module InternalInstallPlugin = struct
+ *)
+
+
++ (* TODO: rewrite this module with OASISFileSystem. *)
++
+ open BaseEnv
+ open BaseStandardVar
+ open BaseMessage
+@@ -5680,34 +5950,17 @@ module InternalInstallPlugin = struct
+ open OASISUtils
+
+
+- let exec_hook =
+- ref (fun (cs, bs, exec) -> cs, bs, exec)
+-
+-
+- let lib_hook =
+- ref (fun (cs, bs, lib) -> cs, bs, lib, [])
+-
+-
+- let obj_hook =
+- ref (fun (cs, bs, obj) -> cs, bs, obj, [])
+-
+-
+- let doc_hook =
+- ref (fun (cs, doc) -> cs, doc)
+-
+-
+- let install_file_ev =
+- "install-file"
+-
++ let exec_hook = ref (fun (cs, bs, exec) -> cs, bs, exec)
++ let lib_hook = ref (fun (cs, bs, dn, lib) -> cs, bs, dn, lib, [])
++ let obj_hook = ref (fun (cs, bs, dn, obj) -> cs, bs, dn, obj, [])
++ let doc_hook = ref (fun (cs, doc) -> cs, doc)
+
+- let install_dir_ev =
+- "install-dir"
+-
+-
+- let install_findlib_ev =
+- "install-findlib"
++ let install_file_ev = "install-file"
++ let install_dir_ev = "install-dir"
++ let install_findlib_ev = "install-findlib"
+
+
++ (* TODO: this can be more generic and used elsewhere. *)
+ let win32_max_command_line_length = 8000
+
+
+@@ -5776,24 +6029,21 @@ module InternalInstallPlugin = struct
+ ["install" :: findlib_name :: meta :: files]
+
+
+- let install pkg argv =
++ let install =
+
+- let in_destdir =
++ let in_destdir fn =
+ try
+- let destdir =
+- destdir ()
+- in
+- (* Practically speaking destdir is prepended
+- * at the beginning of the target filename
+- *)
+- fun fn -> destdir^fn
++ (* Practically speaking destdir is prepended at the beginning of the
++ target filename
++ *)
++ (destdir ())^fn
+ with PropList.Not_set _ ->
+- fun fn -> fn
++ fn
+ in
+
+- let install_file ?tgt_fn src_file envdir =
++ let install_file ~ctxt ?(prepend_destdir=true) ?tgt_fn src_file envdir =
+ let tgt_dir =
+- in_destdir (envdir ())
++ if prepend_destdir then in_destdir (envdir ()) else envdir ()
+ in
+ let tgt_file =
+ Filename.concat
+@@ -5806,20 +6056,48 @@ module InternalInstallPlugin = struct
+ in
+ (* Create target directory if needed *)
+ OASISFileUtil.mkdir_parent
+- ~ctxt:!BaseContext.default
++ ~ctxt
+ (fun dn ->
+ info (f_ "Creating directory '%s'") dn;
+- BaseLog.register install_dir_ev dn)
+- tgt_dir;
++ BaseLog.register ~ctxt install_dir_ev dn)
++ (Filename.dirname tgt_file);
+
+ (* Really install files *)
+ info (f_ "Copying file '%s' to '%s'") src_file tgt_file;
+- OASISFileUtil.cp ~ctxt:!BaseContext.default src_file tgt_file;
+- BaseLog.register install_file_ev tgt_file
++ OASISFileUtil.cp ~ctxt src_file tgt_file;
++ BaseLog.register ~ctxt install_file_ev tgt_file
++ in
++
++ (* Install the files for a library. *)
++
++ let install_lib_files ~ctxt findlib_name files =
++ let findlib_dir =
++ let dn =
++ let findlib_destdir =
++ OASISExec.run_read_one_line ~ctxt (ocamlfind ())
++ ["printconf" ; "destdir"]
++ in
++ Filename.concat findlib_destdir findlib_name
++ in
++ fun () -> dn
++ in
++ let () =
++ if not (OASISFileUtil.file_exists_case (findlib_dir ())) then
++ failwithf
++ (f_ "Directory '%s' doesn't exist for findlib library %s")
++ (findlib_dir ()) findlib_name
++ in
++ let f dir file =
++ let basename = Filename.basename file in
++ let tgt_fn = Filename.concat dir basename in
++ (* Destdir is already include in printconf. *)
++ install_file ~ctxt ~prepend_destdir:false ~tgt_fn file findlib_dir
++ in
++ List.iter (fun (dir, files) -> List.iter (f dir) files) files ;
+ in
+
+ (* Install data into defined directory *)
+- let install_data srcdir lst tgtdir =
++ let install_data ~ctxt srcdir lst tgtdir =
+ let tgtdir =
+ OASISHostPath.of_unix (var_expand tgtdir)
+ in
+@@ -5836,7 +6114,7 @@ module InternalInstallPlugin = struct
+ src;
+ List.iter
+ (fun fn ->
+- install_file
++ install_file ~ctxt
+ fn
+ (fun () ->
+ match tgt_opt with
+@@ -5848,146 +6126,158 @@ module InternalInstallPlugin = struct
+ lst
+ in
+
+- (** Install all libraries *)
+- let install_libs pkg =
++ let make_fnames modul sufx =
++ List.fold_right
++ begin fun sufx accu ->
++ (OASISString.capitalize_ascii modul ^ sufx) ::
++ (OASISString.uncapitalize_ascii modul ^ sufx) ::
++ accu
++ end
++ sufx
++ []
++ in
+
+- let files_of_library (f_data, acc) data_lib =
+- let cs, bs, lib, lib_extra =
+- !lib_hook data_lib
+- in
+- if var_choose bs.bs_install &&
+- BaseBuilt.is_built BaseBuilt.BLib cs.cs_name then
+- begin
+- let acc =
+- (* Start with acc + lib_extra *)
+- List.rev_append lib_extra acc
+- in
+- let acc =
+- (* Add uncompiled header from the source tree *)
+- let path =
+- OASISHostPath.of_unix bs.bs_path
+- in
+- List.fold_left
+- (fun acc modul ->
+- try
+- List.find
+- OASISFileUtil.file_exists_case
+- (List.map
+- (Filename.concat path)
+- [modul^".mli";
+- modul^".ml";
+- String.uncapitalize modul^".mli";
+- String.capitalize modul^".mli";
+- String.uncapitalize modul^".ml";
+- String.capitalize modul^".ml"])
+- :: acc
+- with Not_found ->
+- begin
+- warning
+- (f_ "Cannot find source header for module %s \
+- in library %s")
+- modul cs.cs_name;
+- acc
+- end)
+- acc
+- lib.lib_modules
+- in
++ (** Install all libraries *)
++ let install_libs ~ctxt pkg =
+
+- let acc =
+- (* Get generated files *)
+- BaseBuilt.fold
+- BaseBuilt.BLib
+- cs.cs_name
+- (fun acc fn -> fn :: acc)
+- acc
+- in
++ let find_first_existing_files_in_path bs lst =
++ let path = OASISHostPath.of_unix bs.bs_path in
++ List.find
++ OASISFileUtil.file_exists_case
++ (List.map (Filename.concat path) lst)
++ in
+
+- let f_data () =
+- (* Install data associated with the library *)
+- install_data
+- bs.bs_path
+- bs.bs_data_files
+- (Filename.concat
+- (datarootdir ())
+- pkg.name);
+- f_data ()
+- in
++ let files_of_modules new_files typ cs bs modules =
++ List.fold_left
++ (fun acc modul ->
++ begin
++ try
++ (* Add uncompiled header from the source tree *)
++ [find_first_existing_files_in_path
++ bs (make_fnames modul [".mli"; ".ml"])]
++ with Not_found ->
++ warning
++ (f_ "Cannot find source header for module %s \
++ in %s %s")
++ typ modul cs.cs_name;
++ []
++ end
++ @
++ List.fold_left
++ (fun acc fn ->
++ try
++ find_first_existing_files_in_path bs [fn] :: acc
++ with Not_found ->
++ acc)
++ acc (make_fnames modul [".annot";".cmti";".cmt"]))
++ new_files
++ modules
++ in
+
+- (f_data, acc)
+- end
+- else
+- begin
+- (f_data, acc)
+- end
+- and files_of_object (f_data, acc) data_obj =
+- let cs, bs, obj, obj_extra =
+- !obj_hook data_obj
++ let files_of_build_section (f_data, new_files) typ cs bs =
++ let extra_files =
++ List.map
++ (fun fn ->
++ try
++ find_first_existing_files_in_path bs [fn]
++ with Not_found ->
++ failwithf
++ (f_ "Cannot find extra findlib file %S in %s %s ")
++ fn
++ typ
++ cs.cs_name)
++ bs.bs_findlib_extra_files
++ in
++ let f_data () =
++ (* Install data associated with the library *)
++ install_data
++ ~ctxt
++ bs.bs_path
++ bs.bs_data_files
++ (Filename.concat
++ (datarootdir ())
++ pkg.name);
++ f_data ()
+ in
+- if var_choose bs.bs_install &&
+- BaseBuilt.is_built BaseBuilt.BObj cs.cs_name then
+- begin
+- let acc =
+- (* Start with acc + obj_extra *)
+- List.rev_append obj_extra acc
+- in
+- let acc =
+- (* Add uncompiled header from the source tree *)
+- let path =
+- OASISHostPath.of_unix bs.bs_path
+- in
+- List.fold_left
+- (fun acc modul ->
+- try
+- List.find
+- OASISFileUtil.file_exists_case
+- (List.map
+- (Filename.concat path)
+- [modul^".mli";
+- modul^".ml";
+- String.uncapitalize modul^".mli";
+- String.capitalize modul^".mli";
+- String.uncapitalize modul^".ml";
+- String.capitalize modul^".ml"])
+- :: acc
+- with Not_found ->
+- begin
+- warning
+- (f_ "Cannot find source header for module %s \
+- in object %s")
+- modul cs.cs_name;
+- acc
+- end)
+- acc
+- obj.obj_modules
+- in
++ f_data, new_files @ extra_files
++ in
+
+- let acc =
+- (* Get generated files *)
+- BaseBuilt.fold
+- BaseBuilt.BObj
+- cs.cs_name
+- (fun acc fn -> fn :: acc)
+- acc
+- in
++ let files_of_library (f_data, acc) data_lib =
++ let cs, bs, lib, dn, lib_extra = !lib_hook data_lib in
++ if var_choose bs.bs_install &&
++ BaseBuilt.is_built ~ctxt BaseBuilt.BLib cs.cs_name then begin
++ (* Start with lib_extra *)
++ let new_files = lib_extra in
++ let new_files =
++ files_of_modules new_files "library" cs bs lib.lib_modules
++ in
++ let f_data, new_files =
++ files_of_build_section (f_data, new_files) "library" cs bs
++ in
++ let new_files =
++ (* Get generated files *)
++ BaseBuilt.fold
++ ~ctxt
++ BaseBuilt.BLib
++ cs.cs_name
++ (fun acc fn -> fn :: acc)
++ new_files
++ in
++ let acc = (dn, new_files) :: acc in
+
+- let f_data () =
+- (* Install data associated with the object *)
+- install_data
+- bs.bs_path
+- bs.bs_data_files
+- (Filename.concat
+- (datarootdir ())
+- pkg.name);
+- f_data ()
+- in
++ let f_data () =
++ (* Install data associated with the library *)
++ install_data
++ ~ctxt
++ bs.bs_path
++ bs.bs_data_files
++ (Filename.concat
++ (datarootdir ())
++ pkg.name);
++ f_data ()
++ in
+
+- (f_data, acc)
+- end
+- else
+- begin
+- (f_data, acc)
+- end
++ (f_data, acc)
++ end else begin
++ (f_data, acc)
++ end
++ and files_of_object (f_data, acc) data_obj =
++ let cs, bs, obj, dn, obj_extra = !obj_hook data_obj in
++ if var_choose bs.bs_install &&
++ BaseBuilt.is_built ~ctxt BaseBuilt.BObj cs.cs_name then begin
++ (* Start with obj_extra *)
++ let new_files = obj_extra in
++ let new_files =
++ files_of_modules new_files "object" cs bs obj.obj_modules
++ in
++ let f_data, new_files =
++ files_of_build_section (f_data, new_files) "object" cs bs
++ in
++
++ let new_files =
++ (* Get generated files *)
++ BaseBuilt.fold
++ ~ctxt
++ BaseBuilt.BObj
++ cs.cs_name
++ (fun acc fn -> fn :: acc)
++ new_files
++ in
++ let acc = (dn, new_files) :: acc in
+
++ let f_data () =
++ (* Install data associated with the object *)
++ install_data
++ ~ctxt
++ bs.bs_path
++ bs.bs_data_files
++ (Filename.concat (datarootdir ()) pkg.name);
++ f_data ()
++ in
++ (f_data, acc)
++ end else begin
++ (f_data, acc)
++ end
+ in
+
+ (* Install one group of library *)
+@@ -5998,10 +6288,10 @@ module InternalInstallPlugin = struct
+ match grp with
+ | Container (_, children) ->
+ data_and_files, children
+- | Package (_, cs, bs, `Library lib, children) ->
+- files_of_library data_and_files (cs, bs, lib), children
+- | Package (_, cs, bs, `Object obj, children) ->
+- files_of_object data_and_files (cs, bs, obj), children
++ | Package (_, cs, bs, `Library lib, dn, children) ->
++ files_of_library data_and_files (cs, bs, lib, dn), children
++ | Package (_, cs, bs, `Object obj, dn, children) ->
++ files_of_object data_and_files (cs, bs, obj, dn), children
+ in
+ List.fold_left
+ install_group_lib_aux
+@@ -6010,264 +6300,196 @@ module InternalInstallPlugin = struct
+ in
+
+ (* Findlib name of the root library *)
+- let findlib_name =
+- findlib_of_group grp
+- in
++ let findlib_name = findlib_of_group grp in
+
+ (* Determine root library *)
+- let root_lib =
+- root_of_group grp
+- in
++ let root_lib = root_of_group grp in
+
+ (* All files to install for this library *)
+- let f_data, files =
+- install_group_lib_aux (ignore, []) grp
+- in
++ let f_data, files = install_group_lib_aux (ignore, []) grp in
+
+ (* Really install, if there is something to install *)
+- if files = [] then
+- begin
+- warning
+- (f_ "Nothing to install for findlib library '%s'")
+- findlib_name
+- end
+- else
+- begin
+- let meta =
+- (* Search META file *)
+- let _, bs, _ =
+- root_lib
+- in
+- let res =
+- Filename.concat bs.bs_path "META"
+- in
+- if not (OASISFileUtil.file_exists_case res) then
+- failwithf
+- (f_ "Cannot find file '%s' for findlib library %s")
+- res
+- findlib_name;
+- res
+- in
+- let files =
+- (* Make filename shorter to avoid hitting command max line length
+- * too early, esp. on Windows.
+- *)
+- let remove_prefix p n =
+- let plen = String.length p in
+- let nlen = String.length n in
+- if plen <= nlen && String.sub n 0 plen = p then
+- begin
+- let fn_sep =
+- if Sys.os_type = "Win32" then
+- '\\'
+- else
+- '/'
+- in
+- let cutpoint = plen +
+- (if plen < nlen && n.[plen] = fn_sep then
+- 1
+- else
+- 0)
+- in
+- String.sub n cutpoint (nlen - cutpoint)
+- end
+- else
+- n
+- in
+- List.map (remove_prefix (Sys.getcwd ())) files
+- in
+- info
+- (f_ "Installing findlib library '%s'")
+- findlib_name;
+- let ocamlfind = ocamlfind () in
+- let commands =
+- split_install_command
+- ocamlfind
+- findlib_name
+- meta
+- files
++ if files = [] then begin
++ warning
++ (f_ "Nothing to install for findlib library '%s'") findlib_name
++ end else begin
++ let meta =
++ (* Search META file *)
++ let _, bs, _ = root_lib in
++ let res = Filename.concat bs.bs_path "META" in
++ if not (OASISFileUtil.file_exists_case res) then
++ failwithf
++ (f_ "Cannot find file '%s' for findlib library %s")
++ res
++ findlib_name;
++ res
++ in
++ let files =
++ (* Make filename shorter to avoid hitting command max line length
++ * too early, esp. on Windows.
++ *)
++ (* TODO: move to OASISHostPath as make_relative. *)
++ let remove_prefix p n =
++ let plen = String.length p in
++ let nlen = String.length n in
++ if plen <= nlen && String.sub n 0 plen = p then begin
++ let fn_sep = if Sys.os_type = "Win32" then '\\' else '/' in
++ let cutpoint =
++ plen +
++ (if plen < nlen && n.[plen] = fn_sep then 1 else 0)
+ in
+- List.iter
+- (OASISExec.run ~ctxt:!BaseContext.default ocamlfind)
+- commands;
+- BaseLog.register install_findlib_ev findlib_name
+- end;
+-
+- (* Install data files *)
+- f_data ();
++ String.sub n cutpoint (nlen - cutpoint)
++ end else begin
++ n
++ end
++ in
++ List.map
++ (fun (dir, fn) ->
++ (dir, List.map (remove_prefix (Sys.getcwd ())) fn))
++ files
++ in
++ let ocamlfind = ocamlfind () in
++ let nodir_files, dir_files =
++ List.fold_left
++ (fun (nodir, dir) (dn, lst) ->
++ match dn with
++ | Some dn -> nodir, (dn, lst) :: dir
++ | None -> lst @ nodir, dir)
++ ([], [])
++ (List.rev files)
++ in
++ info (f_ "Installing findlib library '%s'") findlib_name;
++ List.iter
++ (OASISExec.run ~ctxt ocamlfind)
++ (split_install_command ocamlfind findlib_name meta nodir_files);
++ install_lib_files ~ctxt findlib_name dir_files;
++ BaseLog.register ~ctxt install_findlib_ev findlib_name
++ end;
+
++ (* Install data files *)
++ f_data ();
+ in
+
+- let group_libs, _, _ =
+- findlib_mapping pkg
+- in
++ let group_libs, _, _ = findlib_mapping pkg in
+
+ (* We install libraries in groups *)
+ List.iter install_group_lib group_libs
+ in
+
+- let install_execs pkg =
++ let install_execs ~ctxt pkg =
+ let install_exec data_exec =
+- let cs, bs, exec =
+- !exec_hook data_exec
+- in
+- if var_choose bs.bs_install &&
+- BaseBuilt.is_built BaseBuilt.BExec cs.cs_name then
+- begin
+- let exec_libdir () =
+- Filename.concat
+- (libdir ())
+- pkg.name
+- in
+- BaseBuilt.fold
+- BaseBuilt.BExec
+- cs.cs_name
+- (fun () fn ->
+- install_file
+- ~tgt_fn:(cs.cs_name ^ ext_program ())
+- fn
+- bindir)
+- ();
+- BaseBuilt.fold
+- BaseBuilt.BExecLib
+- cs.cs_name
+- (fun () fn ->
+- install_file
+- fn
+- exec_libdir)
+- ();
+- install_data
+- bs.bs_path
+- bs.bs_data_files
+- (Filename.concat
+- (datarootdir ())
+- pkg.name)
+- end
++ let cs, bs, _ = !exec_hook data_exec in
++ if var_choose bs.bs_install &&
++ BaseBuilt.is_built ~ctxt BaseBuilt.BExec cs.cs_name then begin
++ let exec_libdir () = Filename.concat (libdir ()) pkg.name in
++ BaseBuilt.fold
++ ~ctxt
++ BaseBuilt.BExec
++ cs.cs_name
++ (fun () fn ->
++ install_file ~ctxt
++ ~tgt_fn:(cs.cs_name ^ ext_program ())
++ fn
++ bindir)
++ ();
++ BaseBuilt.fold
++ ~ctxt
++ BaseBuilt.BExecLib
++ cs.cs_name
++ (fun () fn -> install_file ~ctxt fn exec_libdir)
++ ();
++ install_data ~ctxt
++ bs.bs_path
++ bs.bs_data_files
++ (Filename.concat (datarootdir ()) pkg.name)
++ end
+ in
+- List.iter
+- (function
+- | Executable (cs, bs, exec)->
+- install_exec (cs, bs, exec)
+- | _ ->
+- ())
++ List.iter
++ (function
++ | Executable (cs, bs, exec)-> install_exec (cs, bs, exec)
++ | _ -> ())
+ pkg.sections
+ in
+
+- let install_docs pkg =
++ let install_docs ~ctxt pkg =
+ let install_doc data =
+- let cs, doc =
+- !doc_hook data
+- in
+- if var_choose doc.doc_install &&
+- BaseBuilt.is_built BaseBuilt.BDoc cs.cs_name then
+- begin
+- let tgt_dir =
+- OASISHostPath.of_unix (var_expand doc.doc_install_dir)
+- in
+- BaseBuilt.fold
+- BaseBuilt.BDoc
+- cs.cs_name
+- (fun () fn ->
+- install_file
+- fn
+- (fun () -> tgt_dir))
+- ();
+- install_data
+- Filename.current_dir_name
+- doc.doc_data_files
+- doc.doc_install_dir
+- end
++ let cs, doc = !doc_hook data in
++ if var_choose doc.doc_install &&
++ BaseBuilt.is_built ~ctxt BaseBuilt.BDoc cs.cs_name then begin
++ let tgt_dir = OASISHostPath.of_unix (var_expand doc.doc_install_dir) in
++ BaseBuilt.fold
++ ~ctxt
++ BaseBuilt.BDoc
++ cs.cs_name
++ (fun () fn -> install_file ~ctxt fn (fun () -> tgt_dir))
++ ();
++ install_data ~ctxt
++ Filename.current_dir_name
++ doc.doc_data_files
++ doc.doc_install_dir
++ end
+ in
+- List.iter
+- (function
+- | Doc (cs, doc) ->
+- install_doc (cs, doc)
+- | _ ->
+- ())
+- pkg.sections
++ List.iter
++ (function
++ | Doc (cs, doc) -> install_doc (cs, doc)
++ | _ -> ())
++ pkg.sections
+ in
+-
+- install_libs pkg;
+- install_execs pkg;
+- install_docs pkg
++ fun ~ctxt pkg _ ->
++ install_libs ~ctxt pkg;
++ install_execs ~ctxt pkg;
++ install_docs ~ctxt pkg
+
+
+ (* Uninstall already installed data *)
+- let uninstall _ argv =
+- List.iter
+- (fun (ev, data) ->
+- if ev = install_file_ev then
+- begin
+- if OASISFileUtil.file_exists_case data then
+- begin
+- info
+- (f_ "Removing file '%s'")
+- data;
+- Sys.remove data
+- end
+- else
+- begin
+- warning
+- (f_ "File '%s' doesn't exist anymore")
+- data
+- end
+- end
+- else if ev = install_dir_ev then
+- begin
+- if Sys.file_exists data && Sys.is_directory data then
+- begin
+- if Sys.readdir data = [||] then
+- begin
+- info
+- (f_ "Removing directory '%s'")
+- data;
+- OASISFileUtil.rmdir ~ctxt:!BaseContext.default data
+- end
+- else
+- begin
+- warning
+- (f_ "Directory '%s' is not empty (%s)")
+- data
+- (String.concat
+- ", "
+- (Array.to_list
+- (Sys.readdir data)))
+- end
+- end
+- else
+- begin
+- warning
+- (f_ "Directory '%s' doesn't exist anymore")
+- data
+- end
+- end
+- else if ev = install_findlib_ev then
+- begin
+- info (f_ "Removing findlib library '%s'") data;
+- OASISExec.run ~ctxt:!BaseContext.default
+- (ocamlfind ()) ["remove"; data]
+- end
+- else
+- failwithf (f_ "Unknown log event '%s'") ev;
+- BaseLog.unregister ev data)
+- (* We process event in reverse order *)
++ let uninstall ~ctxt _ _ =
++ let uninstall_aux (ev, data) =
++ if ev = install_file_ev then begin
++ if OASISFileUtil.file_exists_case data then begin
++ info (f_ "Removing file '%s'") data;
++ Sys.remove data
++ end else begin
++ warning (f_ "File '%s' doesn't exist anymore") data
++ end
++ end else if ev = install_dir_ev then begin
++ if Sys.file_exists data && Sys.is_directory data then begin
++ if Sys.readdir data = [||] then begin
++ info (f_ "Removing directory '%s'") data;
++ OASISFileUtil.rmdir ~ctxt data
++ end else begin
++ warning
++ (f_ "Directory '%s' is not empty (%s)")
++ data
++ (String.concat ", " (Array.to_list (Sys.readdir data)))
++ end
++ end else begin
++ warning (f_ "Directory '%s' doesn't exist anymore") data
++ end
++ end else if ev = install_findlib_ev then begin
++ info (f_ "Removing findlib library '%s'") data;
++ OASISExec.run ~ctxt (ocamlfind ()) ["remove"; data]
++ end else begin
++ failwithf (f_ "Unknown log event '%s'") ev;
++ end;
++ BaseLog.unregister ~ctxt ev data
++ in
++ (* We process event in reverse order *)
++ List.iter uninstall_aux
+ (List.rev
+- (BaseLog.filter
+- [install_file_ev;
+- install_dir_ev;
+- install_findlib_ev]))
+-
++ (BaseLog.filter ~ctxt [install_file_ev; install_dir_ev]));
++ List.iter uninstall_aux
++ (List.rev (BaseLog.filter ~ctxt [install_findlib_ev]))
+
+ end
+
+
+-# 6243 "setup.ml"
++# 6465 "setup.ml"
+ module OCamlbuildCommon = struct
+ (* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
+
+
+ (** Functions common to OCamlbuild build and doc plugin
+- *)
++ *)
+
+
+ open OASISGettext
+@@ -6276,8 +6498,6 @@ module OCamlbuildCommon = struct
+ open OASISTypes
+
+
+-
+-
+ type extra_args = string list
+
+
+@@ -6300,6 +6520,14 @@ module OCamlbuildCommon = struct
+ "-classic-display";
+ "-no-log";
+ "-no-links";
++ ]
++ else
++ [];
++
++ if OASISVersion.comparator_apply
++ (OASISVersion.version_of_string (ocaml_version ()))
++ (OASISVersion.VLesser (OASISVersion.version_of_string "3.11.1")) then
++ [
+ "-install-lib-dir";
+ (Filename.concat (standard_library ()) "ocamlbuild")
+ ]
+@@ -6319,6 +6547,11 @@ module OCamlbuildCommon = struct
+ else
+ [];
+
++ if bool_of_string (tests ()) then
++ ["-tag"; "tests"]
++ else
++ [];
++
+ if bool_of_string (profile ()) then
+ ["-tag"; "profile"]
+ else
+@@ -6331,35 +6564,32 @@ module OCamlbuildCommon = struct
+
+
+ (** Run 'ocamlbuild -clean' if not already done *)
+- let run_clean extra_argv =
++ let run_clean ~ctxt extra_argv =
+ let extra_cli =
+ String.concat " " (Array.to_list extra_argv)
+ in
+- (* Run if never called with these args *)
+- if not (BaseLog.exists ocamlbuild_clean_ev extra_cli) then
+- begin
+- OASISExec.run ~ctxt:!BaseContext.default
+- (ocamlbuild ()) (fix_args ["-clean"] extra_argv);
+- BaseLog.register ocamlbuild_clean_ev extra_cli;
+- at_exit
+- (fun () ->
+- try
+- BaseLog.unregister ocamlbuild_clean_ev extra_cli
+- with _ ->
+- ())
+- end
++ (* Run if never called with these args *)
++ if not (BaseLog.exists ~ctxt ocamlbuild_clean_ev extra_cli) then
++ begin
++ OASISExec.run ~ctxt (ocamlbuild ()) (fix_args ["-clean"] extra_argv);
++ BaseLog.register ~ctxt ocamlbuild_clean_ev extra_cli;
++ at_exit
++ (fun () ->
++ try
++ BaseLog.unregister ~ctxt ocamlbuild_clean_ev extra_cli
++ with _ -> ())
++ end
+
+
+ (** Run ocamlbuild, unregister all clean events *)
+- let run_ocamlbuild args extra_argv =
++ let run_ocamlbuild ~ctxt args extra_argv =
+ (* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html
+- *)
+- OASISExec.run ~ctxt:!BaseContext.default
+- (ocamlbuild ()) (fix_args args extra_argv);
++ *)
++ OASISExec.run ~ctxt (ocamlbuild ()) (fix_args args extra_argv);
+ (* Remove any clean event, we must run it again *)
+ List.iter
+- (fun (e, d) -> BaseLog.unregister e d)
+- (BaseLog.filter [ocamlbuild_clean_ev])
++ (fun (e, d) -> BaseLog.unregister ~ctxt e d)
++ (BaseLog.filter ~ctxt [ocamlbuild_clean_ev])
+
+
+ (** Determine real build directory *)
+@@ -6367,13 +6597,13 @@ module OCamlbuildCommon = struct
+ let rec search_args dir =
+ function
+ | "-build-dir" :: dir :: tl ->
+- search_args dir tl
++ search_args dir tl
+ | _ :: tl ->
+- search_args dir tl
++ search_args dir tl
+ | [] ->
+- dir
++ dir
+ in
+- search_args "_build" (fix_args [] extra_argv)
++ search_args "_build" (fix_args [] extra_argv)
+
+
+ end
+@@ -6394,17 +6624,12 @@ module OCamlbuildPlugin = struct
+ open BaseEnv
+ open OCamlbuildCommon
+ open BaseStandardVar
+- open BaseMessage
+-
+-
+-
+
+
+- let cond_targets_hook =
+- ref (fun lst -> lst)
++ let cond_targets_hook = ref (fun lst -> lst)
+
+
+- let build extra_args pkg argv =
++ let build ~ctxt extra_args pkg argv =
+ (* Return the filename in build directory *)
+ let in_build_dir fn =
+ Filename.concat
+@@ -6468,8 +6693,8 @@ module OCamlbuildPlugin = struct
+ (List.map
+ (List.filter
+ (fun fn ->
+- ends_with ".cmo" fn
+- || ends_with ".cmx" fn))
++ ends_with ~what:".cmo" fn
++ || ends_with ~what:".cmx" fn))
+ unix_files))
+ in
+
+@@ -6484,10 +6709,8 @@ module OCamlbuildPlugin = struct
+
+ | Executable (cs, bs, exec) when var_choose bs.bs_build ->
+ begin
+- let evs, unix_exec_is, unix_dll_opt =
+- BaseBuilt.of_executable
+- in_build_dir_of_unix
+- (cs, bs, exec)
++ let evs, _, _ =
++ BaseBuilt.of_executable in_build_dir_of_unix (cs, bs, exec)
+ in
+
+ let target ext =
+@@ -6501,7 +6724,7 @@ module OCamlbuildPlugin = struct
+ (* Fix evs, we want to use the unix_tgt, without copying *)
+ List.map
+ (function
+- | BaseBuilt.BExec, nm, lst when nm = cs.cs_name ->
++ | BaseBuilt.BExec, nm, _ when nm = cs.cs_name ->
+ BaseBuilt.BExec, nm,
+ [[in_build_dir_of_unix unix_tgt]]
+ | ev ->
+@@ -6545,27 +6768,30 @@ module OCamlbuildPlugin = struct
+ (List.length fns))
+ (String.concat (s_ " or ") (List.map (Printf.sprintf "'%s'") fns)))
+ lst;
+- (BaseBuilt.register bt bnm lst)
++ (BaseBuilt.register ~ctxt bt bnm lst)
+ in
+
+ (* Run the hook *)
+ let cond_targets = !cond_targets_hook cond_targets in
+
+ (* Run a list of target... *)
+- run_ocamlbuild (List.flatten (List.map snd cond_targets) @ extra_args) argv;
++ run_ocamlbuild
++ ~ctxt
++ (List.flatten (List.map snd cond_targets) @ extra_args)
++ argv;
+ (* ... and register events *)
+ List.iter check_and_register (List.flatten (List.map fst cond_targets))
+
+
+- let clean pkg extra_args =
+- run_clean extra_args;
++ let clean ~ctxt pkg extra_args =
++ run_clean ~ctxt extra_args;
+ List.iter
+ (function
+ | Library (cs, _, _) ->
+- BaseBuilt.unregister BaseBuilt.BLib cs.cs_name
++ BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name
+ | Executable (cs, _, _) ->
+- BaseBuilt.unregister BaseBuilt.BExec cs.cs_name;
+- BaseBuilt.unregister BaseBuilt.BExecLib cs.cs_name
++ BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name;
++ BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name
+ | _ ->
+ ())
+ pkg.sections
+@@ -6579,16 +6805,12 @@ module OCamlbuildDocPlugin = struct
+
+ (* Create documentation using ocamlbuild .odocl files
+ @author Sylvain Le Gall
+- *)
++ *)
+
+
+ open OASISTypes
+ open OASISGettext
+- open OASISMessage
+ open OCamlbuildCommon
+- open BaseStandardVar
+-
+-
+
+
+ type run_t =
+@@ -6598,7 +6820,7 @@ module OCamlbuildDocPlugin = struct
+ }
+
+
+- let doc_build run pkg (cs, doc) argv =
++ let doc_build ~ctxt run _ (cs, _) argv =
+ let index_html =
+ OASISUnixPath.make
+ [
+@@ -6615,139 +6837,125 @@ module OCamlbuildDocPlugin = struct
+ cs.cs_name^".docdir";
+ ]
+ in
+- run_ocamlbuild (index_html :: run.extra_args) argv;
+- List.iter
+- (fun glb ->
+- BaseBuilt.register
+- BaseBuilt.BDoc
+- cs.cs_name
+- [OASISFileUtil.glob ~ctxt:!BaseContext.default
+- (Filename.concat tgt_dir glb)])
+- ["*.html"; "*.css"]
++ run_ocamlbuild ~ctxt (index_html :: run.extra_args) argv;
++ List.iter
++ (fun glb ->
++ match OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb) with
++ | (_ :: _) as filenames ->
++ BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name [filenames]
++ | [] -> ())
++ ["*.html"; "*.css"]
+
+
+- let doc_clean run pkg (cs, doc) argv =
+- run_clean argv;
+- BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name
++ let doc_clean ~ctxt _ _ (cs, _) argv =
++ run_clean ~ctxt argv;
++ BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name
+
+
+ end
+
+
+-# 6616 "setup.ml"
++# 6837 "setup.ml"
+ module CustomPlugin = struct
+ (* # 22 "src/plugins/custom/CustomPlugin.ml" *)
+
+
+ (** Generate custom configure/build/doc/test/install system
+ @author
+- *)
++ *)
+
+
+ open BaseEnv
+ open OASISGettext
+ open OASISTypes
+
+-
+-
+-
+-
+ type t =
+- {
+- cmd_main: command_line conditional;
+- cmd_clean: (command_line option) conditional;
+- cmd_distclean: (command_line option) conditional;
+- }
++ {
++ cmd_main: command_line conditional;
++ cmd_clean: (command_line option) conditional;
++ cmd_distclean: (command_line option) conditional;
++ }
+
+
+ let run = BaseCustom.run
+
+
+- let main t _ extra_args =
+- let cmd, args =
+- var_choose
+- ~name:(s_ "main command")
+- t.cmd_main
+- in
+- run cmd args extra_args
++ let main ~ctxt:_ t _ extra_args =
++ let cmd, args = var_choose ~name:(s_ "main command") t.cmd_main in
++ run cmd args extra_args
+
+
+- let clean t pkg extra_args =
++ let clean ~ctxt:_ t _ extra_args =
+ match var_choose t.cmd_clean with
+- | Some (cmd, args) ->
+- run cmd args extra_args
+- | _ ->
+- ()
++ | Some (cmd, args) -> run cmd args extra_args
++ | _ -> ()
+
+
+- let distclean t pkg extra_args =
++ let distclean ~ctxt:_ t _ extra_args =
+ match var_choose t.cmd_distclean with
+- | Some (cmd, args) ->
+- run cmd args extra_args
+- | _ ->
+- ()
++ | Some (cmd, args) -> run cmd args extra_args
++ | _ -> ()
+
+
+ module Build =
+ struct
+- let main t pkg extra_args =
+- main t pkg extra_args;
++ let main ~ctxt t pkg extra_args =
++ main ~ctxt t pkg extra_args;
+ List.iter
+ (fun sct ->
+ let evs =
+ match sct with
+ | Library (cs, bs, lib) when var_choose bs.bs_build ->
+- begin
+- let evs, _ =
+- BaseBuilt.of_library
+- OASISHostPath.of_unix
+- (cs, bs, lib)
+- in
+- evs
+- end
++ begin
++ let evs, _ =
++ BaseBuilt.of_library
++ OASISHostPath.of_unix
++ (cs, bs, lib)
++ in
++ evs
++ end
+ | Executable (cs, bs, exec) when var_choose bs.bs_build ->
+- begin
+- let evs, _, _ =
+- BaseBuilt.of_executable
+- OASISHostPath.of_unix
+- (cs, bs, exec)
+- in
+- evs
+- end
++ begin
++ let evs, _, _ =
++ BaseBuilt.of_executable
++ OASISHostPath.of_unix
++ (cs, bs, exec)
++ in
++ evs
++ end
+ | _ ->
+- []
++ []
+ in
+- List.iter
+- (fun (bt, bnm, lst) -> BaseBuilt.register bt bnm lst)
+- evs)
++ List.iter
++ (fun (bt, bnm, lst) -> BaseBuilt.register ~ctxt bt bnm lst)
++ evs)
+ pkg.sections
+
+- let clean t pkg extra_args =
+- clean t pkg extra_args;
++ let clean ~ctxt t pkg extra_args =
++ clean ~ctxt t pkg extra_args;
+ (* TODO: this seems to be pretty generic (at least wrt to ocamlbuild
+ * considering moving this to BaseSetup?
+ *)
+ List.iter
+ (function
+- | Library (cs, _, _) ->
+- BaseBuilt.unregister BaseBuilt.BLib cs.cs_name
+- | Executable (cs, _, _) ->
+- BaseBuilt.unregister BaseBuilt.BExec cs.cs_name;
+- BaseBuilt.unregister BaseBuilt.BExecLib cs.cs_name
+- | _ ->
+- ())
++ | Library (cs, _, _) ->
++ BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name
++ | Executable (cs, _, _) ->
++ BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name;
++ BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name
++ | _ ->
++ ())
+ pkg.sections
+
+- let distclean t pkg extra_args =
+- distclean t pkg extra_args
++ let distclean ~ctxt t pkg extra_args = distclean ~ctxt t pkg extra_args
+ end
+
+
+ module Test =
+ struct
+- let main t pkg (cs, test) extra_args =
++ let main ~ctxt t pkg (cs, _) extra_args =
+ try
+- main t pkg extra_args;
++ main ~ctxt t pkg extra_args;
+ 0.0
+ with Failure s ->
+ BaseMessage.warning
+@@ -6756,33 +6964,30 @@ module CustomPlugin = struct
+ s;
+ 1.0
+
+- let clean t pkg (cs, test) extra_args =
+- clean t pkg extra_args
++ let clean ~ctxt t pkg _ extra_args = clean ~ctxt t pkg extra_args
+
+- let distclean t pkg (cs, test) extra_args =
+- distclean t pkg extra_args
++ let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args
+ end
+
+
+ module Doc =
+ struct
+- let main t pkg (cs, _) extra_args =
+- main t pkg extra_args;
+- BaseBuilt.register BaseBuilt.BDoc cs.cs_name []
+-
+- let clean t pkg (cs, _) extra_args =
+- clean t pkg extra_args;
+- BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name
++ let main ~ctxt t pkg (cs, _) extra_args =
++ main ~ctxt t pkg extra_args;
++ BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name []
++
++ let clean ~ctxt t pkg (cs, _) extra_args =
++ clean ~ctxt t pkg extra_args;
++ BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name
+
+- let distclean t pkg (cs, _) extra_args =
+- distclean t pkg extra_args
++ let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args
+ end
+
+
+ end
+
+
+-# 6764 "setup.ml"
++# 6969 "setup.ml"
+ open OASISTypes;;
+
+ let setup_t =
+@@ -6833,10 +7038,6 @@ let setup_t =
+ {
+ oasis_version = "0.3";
+ ocaml_version = None;
+- findlib_version = None;
+- alpha_features = [];
+- beta_features = [];
+- name = "ocamlmod";
+ version = "0.0.8";
+ license =
+ OASISLicense.DEP5License
+@@ -6846,47 +7047,20 @@ let setup_t =
+ excption = Some "OCaml linking";
+ version = OASISLicense.Version "2.1"
+ });
++ findlib_version = None;
++ alpha_features = [];
++ beta_features = [];
++ name = "ocamlmod";
+ license_file = None;
+ copyrights = [];
+ maintainers = [];
+ authors = ["Sylvain Le Gall"];
+ homepage = None;
++ bugreports = None;
+ synopsis = "Generate OCaml modules from source files";
+ description = None;
++ tags = [];
+ categories = [];
+- conf_type = (`Configure, "internal", Some "0.4");
+- conf_custom =
+- {
+- pre_command = [(OASISExpr.EBool true, None)];
+- post_command = [(OASISExpr.EBool true, None)]
+- };
+- build_type = (`Build, "ocamlbuild", Some "0.4");
+- build_custom =
+- {
+- pre_command = [(OASISExpr.EBool true, None)];
+- post_command = [(OASISExpr.EBool true, None)]
+- };
+- install_type = (`Install, "internal", Some "0.4");
+- install_custom =
+- {
+- pre_command = [(OASISExpr.EBool true, None)];
+- post_command = [(OASISExpr.EBool true, None)]
+- };
+- uninstall_custom =
+- {
+- pre_command = [(OASISExpr.EBool true, None)];
+- post_command = [(OASISExpr.EBool true, None)]
+- };
+- clean_custom =
+- {
+- pre_command = [(OASISExpr.EBool true, None)];
+- post_command = [(OASISExpr.EBool true, None)]
+- };
+- distclean_custom =
+- {
+- pre_command = [(OASISExpr.EBool true, None)];
+- post_command = [(OASISExpr.EBool true, None)]
+- };
+ files_ab = ["src/ocamlmodConf.ml.ab"];
+ sections =
+ [
+@@ -6903,8 +7077,119 @@ let setup_t =
+ bs_compiled_object = Byte;
+ bs_build_depends = [FindlibPackage ("str", None)];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
++ bs_interface_patterns =
++ [
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("capitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".mli"
++ ];
++ origin = "${capitalize_file module}.mli"
++ };
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("uncapitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".mli"
++ ];
++ origin = "${uncapitalize_file module}.mli"
++ }
++ ];
++ bs_implementation_patterns =
++ [
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("capitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".ml"
++ ];
++ origin = "${capitalize_file module}.ml"
++ };
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("uncapitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".ml"
++ ];
++ origin = "${uncapitalize_file module}.ml"
++ };
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("capitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".mll"
++ ];
++ origin = "${capitalize_file module}.mll"
++ };
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("uncapitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".mll"
++ ];
++ origin = "${uncapitalize_file module}.mll"
++ };
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("capitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".mly"
++ ];
++ origin = "${capitalize_file module}.mly"
++ };
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("uncapitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".mly"
++ ];
++ origin = "${uncapitalize_file module}.mly"
++ }
++ ];
+ bs_c_sources = [];
+ bs_data_files = [];
++ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+@@ -6936,8 +7221,119 @@ let setup_t =
+ FindlibPackage ("str", None)
+ ];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
++ bs_interface_patterns =
++ [
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("capitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".mli"
++ ];
++ origin = "${capitalize_file module}.mli"
++ };
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("uncapitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".mli"
++ ];
++ origin = "${uncapitalize_file module}.mli"
++ }
++ ];
++ bs_implementation_patterns =
++ [
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("capitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".ml"
++ ];
++ origin = "${capitalize_file module}.ml"
++ };
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("uncapitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".ml"
++ ];
++ origin = "${uncapitalize_file module}.ml"
++ };
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("capitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".mll"
++ ];
++ origin = "${capitalize_file module}.mll"
++ };
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("uncapitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".mll"
++ ];
++ origin = "${uncapitalize_file module}.mll"
++ };
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("capitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".mly"
++ ];
++ origin = "${capitalize_file module}.mly"
++ };
++ {
++ OASISSourcePatterns.Templater.atoms =
++ [
++ OASISSourcePatterns.Templater.Text "";
++ OASISSourcePatterns.Templater.Expr
++ (OASISSourcePatterns.Templater.Call
++ ("uncapitalize_file",
++ OASISSourcePatterns.Templater.Ident
++ "module"));
++ OASISSourcePatterns.Templater.Text ".mly"
++ ];
++ origin = "${uncapitalize_file module}.mly"
++ }
++ ];
+ bs_c_sources = [];
+ bs_data_files = [];
++ bs_findlib_extra_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+@@ -6969,18 +7365,51 @@ let setup_t =
+ test_tools = [ExternalTool "ocamlbuild"]
+ })
+ ];
++ disable_oasis_section = [];
++ conf_type = (`Configure, "internal", Some "0.4");
++ conf_custom =
++ {
++ pre_command = [(OASISExpr.EBool true, None)];
++ post_command = [(OASISExpr.EBool true, None)]
++ };
++ build_type = (`Build, "ocamlbuild", Some "0.4");
++ build_custom =
++ {
++ pre_command = [(OASISExpr.EBool true, None)];
++ post_command = [(OASISExpr.EBool true, None)]
++ };
++ install_type = (`Install, "internal", Some "0.4");
++ install_custom =
++ {
++ pre_command = [(OASISExpr.EBool true, None)];
++ post_command = [(OASISExpr.EBool true, None)]
++ };
++ uninstall_custom =
++ {
++ pre_command = [(OASISExpr.EBool true, None)];
++ post_command = [(OASISExpr.EBool true, None)]
++ };
++ clean_custom =
++ {
++ pre_command = [(OASISExpr.EBool true, None)];
++ post_command = [(OASISExpr.EBool true, None)]
++ };
++ distclean_custom =
++ {
++ pre_command = [(OASISExpr.EBool true, None)];
++ post_command = [(OASISExpr.EBool true, None)]
++ };
+ plugins =
+ [
+ (`Extra, "DevFiles", Some "0.2");
+ (`Extra, "META", Some "0.2");
+ (`Extra, "StdFiles", Some "0.2")
+ ];
+- disable_oasis_section = [];
+ schema_data = PropList.Data.create ();
+ plugin_data = []
+ };
+ oasis_fn = Some "_oasis";
+- oasis_version = "0.4.4";
++ oasis_version = "0.4.10";
+ oasis_digest =
+ Some "\182\130\027\155\220\031\026\154c\227c\243\029(D\015";
+ oasis_exec = None;
+@@ -6990,6 +7419,8 @@ let setup_t =
+
+ let setup () = BaseSetup.setup setup_t;;
+
+-# 6973 "setup.ml"
++# 7402 "setup.ml"
++let setup_t = BaseCompat.Compat_0_3.adapt_setup_t setup_t
++open BaseCompat.Compat_0_3
+ (* OASIS_STOP *)
+ let () = setup ();;
Home |
Main Index |
Thread Index |
Old Index