From f6c604b5f96ef34b200d969a3474569e9299e04a Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 3 Apr 2018 11:10:17 +0200 Subject: [PATCH 1/3] update oasis (0.4.10) --- Makefile | 11 +- _oasis | 4 +- _tags | 11 +- configure | 4 +- myocamlbuild.ml | 866 ++++-- setup.ml | 7750 ++++++++++++++++++++++++++++------------------- 6 files changed, 5292 insertions(+), 3354 deletions(-) diff --git a/Makefile b/Makefile index 516d264..afa0c6a 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: bc1e05bfc8b39b664f29dae8dbd3ebbb) +# DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954) SETUP = ocaml setup.ml @@ -12,7 +12,7 @@ doc: setup.data build test: setup.data build $(SETUP) -test $(TESTFLAGS) -all: +all: $(SETUP) -all $(ALLFLAGS) install: setup.data @@ -24,15 +24,18 @@ uninstall: setup.data reinstall: setup.data $(SETUP) -reinstall $(REINSTALLFLAGS) -clean: +clean: $(SETUP) -clean $(CLEANFLAGS) -distclean: +distclean: $(SETUP) -distclean $(DISTCLEANFLAGS) setup.data: $(SETUP) -configure $(CONFIGUREFLAGS) +configure: + $(SETUP) -configure $(CONFIGUREFLAGS) + .PHONY: build doc test all install uninstall reinstall clean distclean configure # OASIS_STOP diff --git a/_oasis b/_oasis index 07368dc..143f54b 100644 --- a/_oasis +++ b/_oasis @@ -1,10 +1,10 @@ -OASISFormat: 0.1 +OASISFormat: 0.4 Name: snappy Version: 0.1.0 Synopsis: Bindings to snappy compression library Authors: ygrek Copyrights: (C) 2011 ygrek -License: BSD3 +License: BSD-3-clause Plugins: DevFiles (0.3), META (0.3) BuildTools: ocamlbuild Homepage: http://snappy.forge.ocamlcore.org/ diff --git a/_tags b/_tags index 38019e9..662738c 100644 --- a/_tags +++ b/_tags @@ -1,8 +1,9 @@ # OASIS_START -# DO NOT EDIT (digest: 8ed89b3b80ed4061878819aed0d91040) -# Ignore VCS directories, you can use the same kind of rule outside -# OASIS_START/STOP if you want to exclude directories that contains +# DO NOT EDIT (digest: da1b639a772265e69ef81d5fe0bb44ea) +# 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,7 +16,7 @@ "_darcs": not_hygienic # Library snappy "src/snappy.cmxs": use_snappy -: oasis_library_snappy_ccopt +: oasis_library_snappy_ccopt "src/snappy_stubs.c": oasis_library_snappy_ccopt : oasis_library_snappy_cclib "src/libsnappy_stubs.lib": oasis_library_snappy_cclib @@ -25,6 +26,6 @@ : use_libsnappy_stubs # Executable test : use_snappy -<*.ml{,i}>: use_snappy +<*.ml{,i,y}>: use_snappy : custom # OASIS_STOP diff --git a/configure b/configure index 97ed012..6acfaeb 100755 --- a/configure +++ b/configure @@ -1,11 +1,11 @@ #!/bin/sh # OASIS_START -# DO NOT EDIT (digest: 425187ed8bfdbdd207fd76392dd243a7) +# DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499) set -e FST=true -for i in "$@"; do +for i in "$@"; do if $FST; then set -- FST=false diff --git a/myocamlbuild.ml b/myocamlbuild.ml index 35c0bbc..29f0e81 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -1,16 +1,13 @@ (* OASIS_START *) -(* DO NOT EDIT (digest: b7d9573ca8f7fdf041745318c1f46715) *) +(* DO NOT EDIT (digest: 9838350462e7f67e7d67ed8297e9d756) *) module OASISGettext = struct -(* # 21 "src/oasis/OASISGettext.ml" *) +(* # 22 "src/oasis/OASISGettext.ml" *) - let ns_ str = - str - let s_ str = - str + let ns_ str = str + let s_ str = str + let f_ (str: ('a, 'b, 'c, 'd) format4) = str - let f_ (str : ('a, 'b, 'c, 'd) format4) = - str let fn_ fmt1 fmt2 n = if n = 1 then @@ -18,21 +15,341 @@ module OASISGettext = struct else fmt2^^"" - let init = - [] + let init = [] end -module OASISExpr = struct -(* # 21 "src/oasis/OASISExpr.ml" *) +module OASISString = struct +(* # 22 "src/oasis/OASISString.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 + + + 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_ "" + + + 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 + type test = string + type flag = string + type t = | EBool of bool @@ -41,9 +358,10 @@ module OASISExpr = struct | EOr of t * t | EFlag of flag | ETest of test * string - - type 'a choices = (t * 'a) list + + type 'a choices = (t * 'a) list + let eval var_get t = let rec eval' = @@ -75,6 +393,7 @@ module OASISExpr = struct in eval' t + let choose ?printer ?name var_get lst = let rec choose_aux = function @@ -111,271 +430,337 @@ module OASISExpr = struct in choose_aux (List.rev lst) + end -# 117 "myocamlbuild.ml" +# 437 "myocamlbuild.ml" module BaseEnvLight = struct -(* # 21 "src/base/BaseEnvLight.ml" *) +(* # 22 "src/base/BaseEnvLight.ml" *) + module MapString = Map.Make(String) + type t = string MapString.t - 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 default_filename = Filename.concat (Sys.getcwd ()) "setup.data" + + + 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 var_get name env = - let rec var_expand str = - let buff = - Buffer.create ((String.length str) * 2) - in - Buffer.add_substitute - buff - (fun var -> - try - var_expand (MapString.find var env) - with Not_found -> - failwith - (Printf.sprintf - "No variable %s defined when trying to expand %S." - var - str)) - str; - Buffer.contents buff - in - var_expand (MapString.find name env) - - let var_choose lst env = - OASISExpr.choose - (fun nm -> var_get nm env) - lst + 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 end -# 215 "myocamlbuild.ml" +# 517 "myocamlbuild.ml" module MyOCamlbuildFindlib = struct -(* # 21 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) +(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) - (** OCamlbuild extension, copied from - * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild + + (** OCamlbuild extension, copied from + * 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 - *) + * 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 - let blank_sep_strings = - Ocamlbuild_pack.Lexers.blank_sep_strings + type conf = {no_automatic_syntax: bool} - let split s ch = - let x = - ref [] + + let run_and_read = Ocamlbuild_pack.My_unix.run_and_read + + + let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings + + + let exec_from_conf exec = + let exec = + let env = BaseEnvLight.load ~allow_empty:true () in + try + BaseEnvLight.var_get exec env + with Not_found -> + Printf.eprintf "W: Cannot get variable %s\n" exec; + exec in - let rec go s = - let pos = - String.index s ch - in - x := (String.before s pos)::!x; - go (String.after s (pos + 1)) + let fix_win32 str = + 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; + Buffer.contents buff + end else begin + str + end in - try - go s - with Not_found -> !x + fix_win32 exec + + + let split s ch = + let buf = Buffer.create 13 in + let x = ref [] in + let flush () = + 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 + let split_nl s = split s '\n' + let before_space s = try String.before s (String.index s ' ') with Not_found -> s - (* this lists all supported packages *) + (* ocamlfind command *) + let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x] + + (* 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")) + - (* this is supposed to list available syntaxes, but I don't know how to do it. *) + (* Mock to list available syntaxes. *) let find_syntaxes () = ["camlp4o"; "camlp4r"] - (* ocamlfind command *) - let ocamlfind x = S[A"ocamlfind"; x] - let dispatch = + let well_known_syntax = [ + "camlp4.quotations.o"; + "camlp4.quotations.r"; + "camlp4.exceptiontracer"; + "camlp4.extend"; + "camlp4.foldgenerator"; + "camlp4.listcomprehension"; + "camlp4.locationstripper"; + "camlp4.macro"; + "camlp4.mapgenerator"; + "camlp4.metagenerator"; + "camlp4.profiler"; + "camlp4.tracer" + ] + + + let dispatch conf = function - | Before_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" - + | 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" + | 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 -> - flag ["ocaml"; "compile"; "pkg_"^pkg] & S[A"-package"; A pkg]; - flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S[A"-package"; A pkg]; - flag ["ocaml"; "doc"; "pkg_"^pkg] & S[A"-package"; A pkg]; - flag ["ocaml"; "link"; "pkg_"^pkg] & S[A"-package"; A pkg]; - flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S[A"-package"; A pkg]; - end - (find_packages ()); - - (* Like -package but for extensions syntax. Morover -syntax is useless - * when linking. *) - List.iter begin fun syntax -> + + (* 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 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 ()); - - (* 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"; "infer_interface"; "syntax_"^syntax] & + 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 ["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 -(* # 21 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) +(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) + (** Base functions for writing myocamlbuild.ml @author Sylvain Le Gall *) - open Ocamlbuild_plugin module OC = Ocamlbuild_pack.Ocaml_compiler - type dir = string - type file = string - type name = string - type tag = string -(* # 56 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) + type dir = string + type file = string + type name = string + type tag = string + type t = { - lib_ocaml: (name * dir list) list; - lib_c: (name * dir * file list) list; + lib_ocaml: (name * dir list * string list) list; + lib_c: (name * dir * file list) list; flags: (tag list * (spec OASISExpr.choices)) list; (* Replace the 'dir: include' from _tags by a precise interdepends in * directory. *) - includes: (dir * dir list) list; - } + includes: (dir * dir list) list; + } + + +(* # 110 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) + + + let env_filename = Pathname.basename BaseEnvLight.default_filename - let env_filename = - Pathname.basename - BaseEnvLight.default_filename let dispatch_combine lst = fun e -> - List.iter + List.iter (fun dispatch -> dispatch e) - lst + lst + let tag_libstubs nm = "use_lib"^nm^"_stubs" + let nm_libstubs nm = nm^"_stubs" - let dispatch t e = - let env = - BaseEnvLight.load - ~filename:env_filename - ~allow_empty:true - () - in - match e with + + let dispatch t e = + let env = BaseEnvLight.load ~allow_empty:true () in + match e with | Before_options -> let no_trailing_dot s = if String.length s >= 1 && s.[0] = '.' then @@ -385,35 +770,44 @@ module MyOCamlbuildBase = struct in List.iter (fun (opt, var) -> - try + try opt := no_trailing_dot (BaseEnvLight.var_get var env) with Not_found -> - Printf.eprintf "W: Cannot get variable %s" var) + Printf.eprintf "W: Cannot get variable %s\n" var) [ Options.ext_obj, "ext_obj"; Options.ext_lib, "ext_lib"; Options.ext_dll, "ext_dll"; ] - | After_rules -> + | After_rules -> (* Declare OCaml libraries *) - List.iter + List.iter (function - | nm, [] -> - ocaml_lib nm - | nm, dir :: tl -> + | nm, [], intf_modules -> + ocaml_lib nm; + let cmis = + 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 -> ocaml_lib ~dir:dir (dir^"/"^nm); - List.iter - (fun dir -> + List.iter + (fun dir -> List.iter (fun str -> flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir])) ["compile"; "infer_interface"; "doc"]) - tl) + tl; + let cmis = + List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi") + intf_modules in + dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"] + cmis) t.lib_ocaml; (* Declare directories dependencies, replace "include" in _tags. *) - List.iter + List.iter (fun (dir, include_dirs) -> Pathname.define_context dir include_dirs) t.includes; @@ -428,26 +822,28 @@ 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 *) (* Depends on .h files *) - dep ["compile"; "c"] + dep ["compile"; "c"] headers; (* Setup search path for lib *) - flag ["link"; "ocaml"; "use_"^lib] + flag ["link"; "ocaml"; "use_"^lib] (S[A"-I"; P(dir)]); ) t.lib_c; @@ -455,29 +851,35 @@ module MyOCamlbuildBase = struct (* Add flags *) List.iter (fun (tags, cond_specs) -> - let spec = - BaseEnvLight.var_choose cond_specs env + let spec = BaseEnvLight.var_choose cond_specs env in + let rec eval_specs = + function + | S lst -> S (List.map eval_specs lst) + | A str -> A (BaseEnvLight.var_expand str env) + | spec -> spec in - flag tags & spec) + flag tags & (eval_specs spec)) t.flags - | _ -> + | _ -> () - let dispatch_default t = - dispatch_combine + + let dispatch_default conf t = + dispatch_combine [ dispatch t; - MyOCamlbuildFindlib.dispatch; + MyOCamlbuildFindlib.dispatch conf; ] + end -# 476 "myocamlbuild.ml" +# 878 "myocamlbuild.ml" open Ocamlbuild_plugin;; let package_default = { - MyOCamlbuildBase.lib_ocaml = [("snappy", ["src"])]; + MyOCamlbuildBase.lib_ocaml = [("snappy", ["src"], [])]; lib_c = [("snappy", "src", [])]; flags = [ @@ -494,12 +896,14 @@ let package_default = (["oasis_library_snappy_cclib"; "ocamlmklib"; "c"], [(OASISExpr.EBool true, S [A "-lstdc++"; A "-lsnappy"])]) ]; - includes = [("", ["src"])]; - } + includes = [("", ["src"])] + } ;; -let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;; +let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} + +let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; -# 504 "myocamlbuild.ml" +# 908 "myocamlbuild.ml" (* OASIS_STOP *) Ocamlbuild_plugin.dispatch dispatch_default;; diff --git a/setup.ml b/setup.ml index 92e3ec8..22174df 100644 --- a/setup.ml +++ b/setup.ml @@ -1,23 +1,20 @@ (* setup.ml generated for the first time by OASIS v0.2.0 *) (* OASIS_START *) -(* DO NOT EDIT (digest: eeec4c93a398c076973f100c1422fee7) *) +(* DO NOT EDIT (digest: 869e58b5b319e62fdc860b478cf615ec) *) (* - Regenerated by OASIS v0.3.0 + Regenerated by OASIS v0.4.10 Visit http://oasis.forge.ocamlcore.org for more information and documentation about functions used in this file. *) module OASISGettext = struct -(* # 21 "src/oasis/OASISGettext.ml" *) +(* # 22 "src/oasis/OASISGettext.ml" *) - let ns_ str = - str - let s_ str = - str + let ns_ str = str + let s_ str = str + let f_ (str: ('a, 'b, 'c, 'd) format4) = str - let f_ (str : ('a, 'b, 'c, 'd) format4) = - str let fn_ fmt1 fmt2 n = if n = 1 then @@ -25,83 +22,21 @@ module OASISGettext = struct else fmt2^^"" - let init = - [] -end - -module OASISContext = struct -(* # 21 "src/oasis/OASISContext.ml" *) - - open OASISGettext - - type level = - [ `Debug - | `Info - | `Warning - | `Error] - - type t = - { - 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 args () = - ["-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")] + let init = [] end module OASISString = struct -(* # 1 "src/oasis/OASISString.ml" *) - +(* # 22 "src/oasis/OASISString.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 @@ -114,44 +49,48 @@ 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) + 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 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 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 @@ -159,23 +98,22 @@ module OASISString = struct 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; - if !what_idx = String.length what then - true - else - false + 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 @@ -183,23 +121,22 @@ module OASISString = struct 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; - if !what_idx = -1 then - true - else - false + 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 @@ -207,56 +144,127 @@ module OASISString = struct else raise Not_found + 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 module OASISUtils = struct -(* # 21 "src/oasis/OASISUtils.ml" *) +(* # 22 "src/oasis/OASISUtils.ml" *) + open OASISGettext - module MapString = Map.Make(String) - let map_string_of_assoc assoc = - List.fold_left - (fun acc (k, v) -> MapString.add k v acc) - MapString.empty - assoc + 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 - module SetString = Set.Make(String) + let of_list lst = add_list empty lst - let set_string_add_list st lst = - List.fold_left - (fun acc e -> SetString.add e acc) - st - 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 - let set_string_of_list = - set_string_add_list - SetString.empty + + module SetString = SetExt.Make(String) 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 = (compare_csl s1 s2) = 0 + let hash s = Hashtbl.hash (OASISString.lowercase_ascii s) + end) - let equal s1 s2 = - (String.lowercase s1) = (String.lowercase s2) - - let hash s = - Hashtbl.hash (String.lowercase s) + 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 @@ -284,9 +292,10 @@ module OASISUtils = struct else buf in - String.lowercase buf + OASISString.lowercase_ascii buf end + let varname_concat ?(hyphen='_') p s = let what = String.make 1 hyphen in let p = @@ -307,171 +316,571 @@ module OASISUtils = struct let is_varname str = str = varname_of_string str + let failwithf fmt = Printf.ksprintf failwith fmt -end -module PropList = struct -(* # 21 "src/oasis/PropList.ml" *) + 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_ "" - open OASISGettext - type name = string + 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 - exception Not_set of name * string option - exception No_printer of name - exception Unknown_field of name * name - 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) +end - module Data = - struct +module OASISUnixPath = struct +(* # 22 "src/oasis/OASISUnixPath.ml" *) - type t = - (name, unit -> unit) Hashtbl.t - let create () = - Hashtbl.create 13 + type unix_filename = string + type unix_dirname = string - let clear t = - Hashtbl.clear t -(* # 71 "src/oasis/PropList.ml" *) - end + type host_filename = string + type host_dirname = string - module Schema = - struct - type ('ctxt, 'extra) value = - { - get: Data.t -> string; - set: Data.t -> ?context:'ctxt -> string -> unit; - help: (unit -> string) option; - extra: 'extra; - } + let current_dir_name = "." - type ('ctxt, 'extra) t = - { - name: name; - fields: (name, ('ctxt, 'extra) value) Hashtbl.t; - order: name Queue.t; - name_norm: string -> string; - } - let create ?(case_insensitive=false) nm = - { - name = nm; - fields = Hashtbl.create 13; - order = Queue.create (); - name_norm = - (if case_insensitive then - String.lowercase - else - fun s -> s); - } + let parent_dir_name = ".." - let add t nm set get extra help = - let key = - 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 + let is_current_dir fn = + fn = current_dir_name || fn = "" - let mem t nm = - Hashtbl.mem t.fields nm - let find t nm = - try - Hashtbl.find t.fields (t.name_norm nm) - with Not_found -> - raise (Unknown_field (nm, t.name)) + 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 get t data nm = - (find t nm).get data - let set t data nm ?context x = - (find t nm).set - data - ?context - x + let make = + function + | hd :: tl -> + List.fold_left + (fun f p -> concat f p) + hd + tl + | [] -> + invalid_arg "OASISUnixPath.make" - let fold f acc t = - Queue.fold - (fun acc k -> - let v = - find t k - in - f acc k v.extra v.help) - acc - t.order - let iter f t = - fold - (fun () -> f) - () - t + let dirname f = + try + String.sub f 0 (String.rindex f '/') + with Not_found -> + current_dir_name - let name t = - t.name - end - module Field = - struct + 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 - 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; - } - let new_id = - let last_id = - ref 0 + let chop_extension f = + try + let last_dot = + String.rindex f '.' in - fun () -> incr last_id; !last_id - - let create ?schema ?name ?parse ?print ?default ?update ?help extra = - (* Default value container *) - let v = - ref None + let sub = + String.sub f 0 last_dot in - - (* If name is not given, create unique one *) - let nm = + 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 +(* # 22 "src/oasis/PropList.ml" *) + + + open OASISGettext + + + type name = string + + + exception Not_set of name * string option + exception No_printer of name + exception Unknown_field of name * name + + + 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) + + + module Data = + struct + type t = + (name, unit -> unit) Hashtbl.t + + let create () = + Hashtbl.create 13 + + let clear t = + Hashtbl.clear t + + +(* # 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; + } + + type ('ctxt, 'extra) t = + { + name: name; + fields: (name, ('ctxt, 'extra) value) Hashtbl.t; + order: name Queue.t; + name_norm: string -> string; + } + + let create ?(case_insensitive=false) nm = + { + name = nm; + fields = Hashtbl.create 13; + order = Queue.create (); + name_norm = + (if case_insensitive then + OASISString.lowercase_ascii + else + fun s -> s); + } + + let add t nm set get extra help = + let key = + 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 + + let mem t nm = + Hashtbl.mem t.fields nm + + let find t nm = + try + Hashtbl.find t.fields (t.name_norm nm) + with Not_found -> + raise (Unknown_field (nm, t.name)) + + let get t data nm = + (find t nm).get data + + let set t data nm ?context x = + (find t nm).set + data + ?context + x + + let fold f acc t = + Queue.fold + (fun acc k -> + let v = + find t k + in + f acc k v.extra v.help) + acc + t.order + + let iter f t = + fold + (fun () -> f) + () + t + + let name t = + t.name + end + + + 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; + } + + let new_id = + let last_id = + ref 0 + in + fun () -> incr last_id; !last_id + + let create ?schema ?name ?parse ?print ?default ?update ?help extra = + (* Default value container *) + let v = + ref None + in + + (* If name is not given, create unique one *) + let nm = match name with | Some s -> s | None -> Printf.sprintf "_anon_%d" (new_id ()) @@ -501,33 +910,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 *) @@ -539,9 +948,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 *) @@ -549,22 +958,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 @@ -577,28 +986,27 @@ module PropList = struct let fgets data t = t.gets data - end + module FieldRO = struct - let create ?schema ?name ?parse ?print ?default ?update ?help extra = 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 module OASISMessage = struct -(* # 21 "src/oasis/OASISMessage.ml" *) +(* # 22 "src/oasis/OASISMessage.ml" *) open OASISGettext open OASISContext + let generic_message ~ctxt lvl fmt = let cond = if ctxt.quiet then @@ -609,38 +1017,41 @@ 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 = generic_message ~ctxt `Debug fmt + let info ~ctxt fmt = generic_message ~ctxt `Info fmt + let warning ~ctxt fmt = generic_message ~ctxt `Warning fmt + let error ~ctxt fmt = generic_message ~ctxt `Error fmt end module OASISVersion = struct -(* # 21 "src/oasis/OASISVersion.ml" *) +(* # 22 "src/oasis/OASISVersion.ml" *) - open OASISGettext + open OASISGettext - type s = string + type t = string - type t = string type comparator = | VGreater of t @@ -650,26 +1061,20 @@ module OASISVersion = struct | VLesserEqual of t | VOr of comparator * comparator | 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') + (* 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_special = - function - | '.' | '+' | '-' | '~' -> true - | _ -> false let rec version_compare v1 v2 = if v1 <> "" || v2 <> "" then 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 @@ -704,76 +1109,79 @@ 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 + let string_of_version t = t + let chop t = try let pos = String.rindex t '.' in - String.sub t 0 pos + String.sub t 0 pos with Not_found -> t + 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 = function @@ -783,9 +1191,10 @@ 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 = let concat p v = @@ -794,40 +1203,38 @@ 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 version_0_3_or_after t = - comparator_apply t (VGreaterEqual (string_of_version "0.3")) + 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) + end module OASISLicense = struct -(* # 21 "src/oasis/OASISLicense.ml" *) +(* # 22 "src/oasis/OASISLicense.ml" *) + (** License for _oasis fields @author Sylvain Le Gall - *) - + *) - type license = string + type license = string + type license_exception = string - type license_exception = string type license_version = | Version of OASISVersion.t | VersionOrLater of OASISVersion.t | NoVersion - + type license_dep_5_unit = { @@ -835,31 +1242,32 @@ module OASISLicense = struct excption: license_exception option; version: license_version; } - + type license_dep_5 = | DEP5Unit of license_dep_5_unit | DEP5Or of license_dep_5 list | DEP5And of license_dep_5 list - + type t = | DEP5License of license_dep_5 | OtherLicense of string (* URL *) - + end module OASISExpr = struct -(* # 21 "src/oasis/OASISExpr.ml" *) - +(* # 22 "src/oasis/OASISExpr.ml" *) open OASISGettext + open OASISUtils + - type test = string + type test = string + type flag = string - type flag = string type t = | EBool of bool @@ -868,9 +1276,10 @@ module OASISExpr = struct | EOr of t * t | EFlag of flag | ETest of test * string - - type 'a choices = (t * 'a) list + + type 'a choices = (t * 'a) list + let eval var_get t = let rec eval' = @@ -902,80 +1311,225 @@ module OASISExpr = struct in eval' t - let choose ?printer ?name var_get lst = - let rec choose_aux = - function - | (cond, vl) :: tl -> - if eval var_get cond then - vl - else - choose_aux tl - | [] -> - let str_lst = - if lst = [] then - s_ "" - else - String.concat - (s_ ", ") - (List.map - (fun (cond, vl) -> - match printer with - | Some p -> p vl - | None -> s_ "") - lst) - in - match name with - | Some nm -> - failwith - (Printf.sprintf - (f_ "No result for the choice list '%s': %s") - nm str_lst) - | None -> - failwith - (Printf.sprintf - (f_ "No result for a choice list: %s") - str_lst) - in - choose_aux (List.rev lst) + + let choose ?printer ?name var_get lst = + let rec choose_aux = + function + | (cond, vl) :: tl -> + if eval var_get cond then + vl + else + choose_aux tl + | [] -> + let str_lst = + if lst = [] then + s_ "" + else + String.concat + (s_ ", ") + (List.map + (fun (cond, vl) -> + match printer with + | Some p -> p vl + | None -> s_ "") + lst) + in + match name with + | Some nm -> + failwith + (Printf.sprintf + (f_ "No result for the choice list '%s': %s") + nm str_lst) + | None -> + failwith + (Printf.sprintf + (f_ "No result for a choice list: %s") + str_lst) + in + choose_aux (List.rev lst) + + +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 + + + 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; + ]; + } + + 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 + + + let to_string t = t.Templater.origin + end module OASISTypes = struct -(* # 21 "src/oasis/OASISTypes.ml" *) +(* # 22 "src/oasis/OASISTypes.ml" *) + type name = string + type package_name = string + type url = string + type unix_dirname = 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 + type command_line = (prog * arg list) - 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 prog = string - type arg = string - type args = string list - type command_line = (prog * arg list) + type findlib_name = string + type findlib_full = string - type findlib_name = string - type findlib_full = string type compiled_object = | Byte | Native | Best - + type dependency = | FindlibPackage of findlib_full * OASISVersion.comparator option | InternalLibrary of name - + type tool = | ExternalTool of name | InternalExecutable of name - + type vcs = | Darcs @@ -987,378 +1541,687 @@ module OASISTypes = struct | Arch | Monotone | 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 - type 'a plugin = 'a * name * OASISVersion.t option type all_plugin = plugin_kind plugin + type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list -(* # 102 "src/oasis/OASISTypes.ml" *) - type 'a conditional = 'a OASISExpr.choices + 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_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 = | Library of common_section * build_section * library + | Object of common_section * build_section * object_ | Executable of common_section * build_section * executable | Flag of common_section * flag | SrcRepo of common_section * source_repository | Test of common_section * test | Doc of common_section * doc - + type section_kind = - [ `Library | `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; (* 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; + } - type package = - { - oasis_version: OASISVersion.t; - ocaml_version: OASISVersion.comparator option; - findlib_version: OASISVersion.comparator option; - 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: string 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; - schema_data: PropList.Data.t; - plugin_data: plugin_data; - } end -module OASISUnixPath = struct -(* # 21 "src/oasis/OASISUnixPath.ml" *) +module OASISFeatures = struct +(* # 22 "src/oasis/OASISFeatures.ml" *) - type unix_filename = string - type unix_dirname = string + open OASISTypes + open OASISUtils + open OASISGettext + open OASISVersion - type host_filename = string - type host_dirname = string + module MapPlugin = + Map.Make + (struct + type t = plugin_kind * name + let compare = Pervasives.compare + end) - let current_dir_name = "." + module Data = + struct + type t = + { + oasis_version: OASISVersion.t; + plugin_versions: OASISVersion.t option MapPlugin.t; + alpha_features: string list; + beta_features: string list; + } - let parent_dir_name = ".." + let create oasis_version alpha_features beta_features = + { + oasis_version = oasis_version; + plugin_versions = MapPlugin.empty; + alpha_features = alpha_features; + beta_features = beta_features + } - let is_current_dir fn = - fn = current_dir_name || fn = "" + let of_package pkg = + create + pkg.OASISTypes.oasis_version + pkg.OASISTypes.alpha_features + pkg.OASISTypes.beta_features - 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 add_plugin (plugin_kind, plugin_name, plugin_version) t = + {t with + plugin_versions = MapPlugin.add + (plugin_kind, plugin_name) + plugin_version + t.plugin_versions} - let make = + let plugin_version plugin_kind plugin_name t = + MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions + + let to_string t = + Printf.sprintf + "oasis_version: %s; alpha_features: %s; beta_features: %s; \ + plugins_version: %s" + (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 -> "")) + :: acc) + t.plugin_versions [])) + end + + type origin = + | Field of string * string + | Section of string + | NoOrigin + + type stage = Alpha | Beta + + + let string_of_stage = function - | hd :: tl -> - List.fold_left - (fun f p -> concat f p) - hd - tl - | [] -> - invalid_arg "OASISUnixPath.make" + | Alpha -> "alpha" + | Beta -> "beta" - 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 field_of_stage = + function + | Alpha -> "AlphaFeatures" + | Beta -> "BetaFeatures" - let chop_extension f = - try - let last_dot = - String.rindex f '.' - in - let sub = - String.sub f 0 last_dot + type publication = InDev of stage | SinceVersion of OASISVersion.t + + type t = + { + name: string; + plugin: all_plugin option; + publication: publication; + description: unit -> string; + } + + (* TODO: mutex protect this. *) + let all_features = Hashtbl.create 13 + + + let since_version ver_str = SinceVersion (version_of_string ver_str) + let alpha = InDev Alpha + let beta = InDev Beta + + + let to_string t = + Printf.sprintf + "feature: %s; plugin: %s; publication: %s" + (t:t).name + (match t.plugin with + | None -> "" + | Some (_, nm, _) -> nm) + (match t.publication with + | 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:t).name features in + if not has_feature then + 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 + + let version_is_good ~min_version version fmt = + let version_is_good = + OASISVersion.comparator_apply + version (OASISVersion.VGreaterEqual min_version) in + 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) + + | Field(fld, where), Some(plugin_knd, plugin_name, _), + SinceVersion min_version -> + begin try - let last_slash = - String.rindex f '/' + 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 - if last_slash < last_dot then - sub - else - f + 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, Some(plugin_knd, plugin_name, _), + SinceVersion min_version -> + begin + 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 + + | 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 -> - sub + Some no_message + end + + + let data_assert t data origin = + match data_check t data origin with + | None -> () + | Some str -> failwith str + + + let data_test t data = + match data_check t data NoOrigin with + | None -> true + | Some _ -> false + + + let package_test t pkg = + data_test t (Data.of_package pkg) + + + let create ?plugin name publication description = + let () = + if Hashtbl.mem all_features name then + failwithf "Feature '%s' is already declared." name + in + let t = + { + name = name; + plugin = plugin; + publication = publication; + description = description; + } + in + Hashtbl.add all_features name t; + t + + let get_stage name = + try + (Hashtbl.find all_features name).publication with Not_found -> - f + failwithf (f_ "Feature %s doesn't exist.") name - 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) + let list () = + Hashtbl.fold (fun _ v acc -> v :: acc) all_features [] -end + (* + * Real flags. + *) -module OASISHostPath = struct -(* # 21 "src/oasis/OASISHostPath.ml" *) + let features = + create "features_fields" + (since_version "0.4") + (fun () -> + s_ "Enable to experiment not yet official features.") - open Filename - module Unix = OASISUnixPath + let flag_docs = + create "flag_docs" + (since_version "0.3") + (fun () -> + s_ "Make building docs require '-docs' flag at configure.") - let make = - function - | [] -> - invalid_arg "OASISHostPath.make" - | hd :: tl -> - List.fold_left Filename.concat hd tl - 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 flag_tests = + create "flag_tests" + (since_version "0.3") + (fun () -> + s_ "Make running tests require '-tests' flag at configure.") + + + let pack = + create "pack" + (since_version "0.3") + (fun () -> + s_ "Allow to create packed library.") + + + let section_object = + create "section_object" beta + (fun () -> + s_ "Implement an object section.") + + + let dynrun_for_release = + create "dynrun_for_release" alpha + (fun () -> + s_ "Make '-setup-update dynamic' suitable for releasing project.") + + + let compiled_setup_ml = + create "compiled_setup_ml" alpha + (fun () -> + s_ "Compile the setup.ml and speed-up actions done with it.") + + let disable_oasis_section = + create "disable_oasis_section" alpha + (fun () -> + 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 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 -(* # 21 "src/oasis/OASISSection.ml" *) +(* # 22 "src/oasis/OASISSection.ml" *) + open OASISTypes - let section_kind_common = + + let section_kind_common = function - | Library (cs, _, _) -> - `Library, cs + | Library (cs, _, _) -> + `Library, 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 = snd (section_kind_common sct) + let section_common_set cs = function | Library (_, bs, lib) -> Library (cs, bs, lib) + | Object (_, bs, obj) -> Object (cs, bs, obj) | Executable (_, bs, exec) -> Executable (cs, bs, exec) | Flag (_, flg) -> Flag (cs, flg) | SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo) | Test (_, tst) -> Test (cs, tst) | Doc (_, doc) -> Doc (cs, doc) + (** Key used to identify section - *) - let section_id sct = - let k, cs = + *) + 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" - | `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 = List.find (fun sct -> id = section_id sct) scts + module CSection = struct type t = section let id = section_id - let compare t1 t2 = + let compare t1 t2 = compare (id t1) (id t2) - + let equal t1 t2 = (id t1) = (id t2) @@ -1366,192 +2229,187 @@ module OASISSection = struct Hashtbl.hash (id t) end + module MapSection = Map.Make(CSection) module SetSection = Set.Make(CSection) + end module OASISBuildSection = struct -(* # 21 "src/oasis/OASISBuildSection.ml" *) +(* # 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 module OASISExecutable = struct -(* # 21 "src/oasis/OASISExecutable.ml" *) +(* # 22 "src/oasis/OASISExecutable.ml" *) + open OASISTypes - let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program = - let dir = + + let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program = + let dir = OASISUnixPath.concat bs.bs_path (OASISUnixPath.dirname exec.exec_main_is) in - let is_native_exec = + let is_native_exec = match bs.bs_compiled_object with | Native -> true | Best -> is_native () | Byte -> false in - OASISUnixPath.concat - dir - (cs.cs_name^(suffix_program ())), + 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 - 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 module OASISLibrary = struct -(* # 21 "src/oasis/OASISLibrary.ml" *) +(* # 22 "src/oasis/OASISLibrary.ml" *) + open OASISTypes - open OASISUtils open OASISGettext - open OASISSection - - type library_name = name - type findlib_part_name = name - type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t - exception InternalLibraryNotFound of library_name - exception FindlibPackageNotFound of findlib_name - - type group_t = - | Container of findlib_name * group_t list - | Package of (findlib_name * - common_section * - build_section * - library * - group_t list) - - (* Look for a module file, considering capitalization or not. *) - let find_module source_file_exists (cs, bs, lib) 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 (cs, bs, lib) 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) = - - let find_modules lst ext = + ~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 (cs, bs, lib) modul with - | `Sources (base_fn, _) -> - [base_fn] - | `No_sources lst -> - OASISMessage.warning - ~ctxt - (f_ "Cannot find source file matching \ - module '%s' in library %s") - modul cs.cs_name; - 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.map - (fun nm -> - List.map - (fun base_fn -> base_fn ^"."^ext) - (find_module nm)) - lst - in - - (* The headers that should be compiled along *) - let headers = - if lib.lib_pack then + 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) [] - else - find_modules - lib.lib_modules - "cmi" + lst in (* The .cmx that be compiled along *) let cmxs = let should_be_built = - (not lib.lib_pack) && (* Do not install .cmx packed submodules *) match bs.bs_compiled_object with - | Native -> true - | Best -> is_native - | Byte -> false + | Native -> true + | Best -> is_native + | Byte -> false in - if should_be_built then + if should_be_built then + if lib.lib_pack then find_modules - (lib.lib_modules @ lib.lib_internal_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 @@ -1559,50 +2417,151 @@ module OASISLibrary = struct add_pack_header ([cs.cs_name^".cma"] :: acc) in let native acc = - let acc = + let acc = add_pack_header (if has_native_dynlink then [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) + + +end + +module OASISObject = struct +(* # 22 "src/oasis/OASISObject.ml" *) + + + open OASISTypes + 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 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) = + + let find_module ext modul = + 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) + | _ -> ([cs.cs_name ^ ".cmi"], + [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 :: []) - (* All the files generated *) - List.rev_append - (List.rev_map - (List.rev_map - (OASISUnixPath.concat bs.bs_path)) - acc_nopath) - (headers @ cmxs) - type data = common_section * build_section * library +end + +module OASISFindlib = struct +(* # 22 "src/oasis/OASISFindlib.ml" *) + + + open OASISTypes + open OASISUtils + open OASISGettext + + + type library_name = name + type findlib_part_name = name + type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t + + + exception InternalLibraryNotFound of library_name + exception FindlibPackageNotFound of findlib_name + + + type group_t = + | Container of findlib_name * group_t list + | Package of (findlib_name * + 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_] type tree = | Node of (data option) * (tree MapString.t) | Leaf of data + let findlib_mapping pkg = (* Map from library name to either full findlib name or parts + parent. *) let fndlb_parts_of_lib_name = @@ -1615,36 +2574,53 @@ module OASISLibrary = 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 - - | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ -> - mp) - MapString.empty - pkg.sections + 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 + 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. *) @@ -1656,40 +2632,40 @@ module OASISLibrary = 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 "" in - mp) + let _, mp = solve SetString.empty mp lib_name "" 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. *) @@ -1701,75 +2677,89 @@ module OASISLibrary = 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) = + 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 + add_children (OASISString.nsplit fndlb_fullname '.') mp in - let rec group_of_tree mp = + let unix_directory dn lib = + let directory = + match lib with + | `Library lib -> lib.lib_findlib_directory + | `Object obj -> obj.obj_findlib_directory + in + 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 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 @@ -1778,25 +2768,25 @@ module OASISLibrary = struct (fun mp -> function | Library (cs, bs, lib) -> - add (cs, bs, lib) mp + add (cs, bs, `Library lib) mp + | Object (cs, bs, obj) -> + 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 @@ -1805,76 +2795,86 @@ module OASISLibrary = 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 = let rec root_lib_aux = (* 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) + 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) + 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 module OASISFlag = struct -(* # 21 "src/oasis/OASISFlag.ml" *) +(* # 22 "src/oasis/OASISFlag.ml" *) + end module OASISPackage = struct -(* # 21 "src/oasis/OASISPackage.ml" *) +(* # 22 "src/oasis/OASISPackage.ml" *) + end module OASISSourceRepository = struct -(* # 21 "src/oasis/OASISSourceRepository.ml" *) +(* # 22 "src/oasis/OASISSourceRepository.ml" *) + end module OASISTest = struct -(* # 21 "src/oasis/OASISTest.ml" *) +(* # 22 "src/oasis/OASISTest.ml" *) + end module OASISDocument = struct -(* # 21 "src/oasis/OASISDocument.ml" *) +(* # 22 "src/oasis/OASISDocument.ml" *) + end module OASISExec = struct -(* # 21 "src/oasis/OASISExec.ml" *) +(* # 22 "src/oasis/OASISExec.ml" *) + open OASISGettext open OASISUtils open OASISMessage + (* 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 @@ -1892,74 +2892,79 @@ 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 -(* # 21 "src/oasis/OASISFileUtil.ml" *) +(* # 22 "src/oasis/OASISFileUtil.ml" *) + open OASISGettext + 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 = @@ -1969,7 +2974,7 @@ module OASISFileUtil = struct (List.map (fun a -> List.map - (fun b -> a,b) + (fun b -> a, b) lst2) lst1) in @@ -1977,312 +2982,318 @@ 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 = List.map - (fun (p,e) -> + (fun (p, e) -> if String.length e > 0 && e.[0] <> '.' then p ^ "." ^ e else p ^ e) ((combined_paths paths) * exts) in - List.find - (if case_sensitive then - file_exists_case - else - Sys.file_exists) - 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 (**/**) + let cp ~ctxt ?(recurse=false) src tgt = 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] + let rec mkdir_parent ~ctxt f tgt = 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 - - let rmdir ~ctxt tgt = - if Sys.readdir tgt = [||] then + if Sys.file_exists tgt then begin - match Sys.os_type with - | "Win32" -> - OASISExec.run ~ctxt "rd" [q tgt] - | _ -> - OASISExec.run ~ctxt "rm" ["-r"; q tgt] + 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 "rm" ["-r"; q tgt] + end else begin + OASISMessage.error ~ctxt + (f_ "Cannot remove directory '%s': not empty.") + tgt + end + + 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 -# 2142 "setup.ml" +# 3159 "setup.ml" module BaseEnvLight = struct -(* # 21 "src/base/BaseEnvLight.ml" *) +(* # 22 "src/base/BaseEnvLight.ml" *) + module MapString = Map.Make(String) + type t = string MapString.t - 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 default_filename = Filename.concat (Sys.getcwd ()) "setup.data" + + + 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 var_get name env = - let rec var_expand str = - let buff = - Buffer.create ((String.length str) * 2) - in - Buffer.add_substitute - buff - (fun var -> - try - var_expand (MapString.find var env) - with Not_found -> - failwith - (Printf.sprintf - "No variable %s defined when trying to expand %S." - var - str)) - str; - Buffer.contents buff - in - var_expand (MapString.find name env) - - let var_choose lst env = - OASISExpr.choose - (fun nm -> var_get nm env) - lst + 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 end -# 2240 "setup.ml" +# 3239 "setup.ml" module BaseContext = struct -(* # 21 "src/base/BaseContext.ml" *) +(* # 22 "src/base/BaseContext.ml" *) + (* TODO: get rid of this module. *) open OASISContext - let args = args + + let args () = fst (fspecs ()) + let default = default end module BaseMessage = struct -(* # 21 "src/base/BaseMessage.ml" *) +(* # 22 "src/base/BaseMessage.ml" *) + (** Message to user, overrid for Base @author Sylvain Le Gall - *) + *) open OASISMessage open BaseContext + let debug fmt = debug ~ctxt:!default fmt + let info fmt = info ~ctxt:!default fmt + let warning fmt = warning ~ctxt:!default fmt + let error fmt = error ~ctxt:!default fmt end module BaseEnv = struct -(* # 21 "src/base/BaseEnv.ml" *) +(* # 22 "src/base/BaseEnv.ml" *) open OASISGettext open OASISUtils + open OASISContext open PropList + module MapString = BaseEnvLight.MapString + type origin_t = | ODefault | OGetEnv | OFileLoad | OCommandLine + type cli_handle_t = | CLINone | CLIAuto @@ -2290,79 +3301,82 @@ module BaseEnv = struct | CLIEnable | CLIUser of (Arg.key * Arg.spec * Arg.doc) list + 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.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 = let vl = @@ -2376,7 +3390,8 @@ module BaseEnv = struct raise e end in - var_expand vl + var_expand vl + let var_choose ?printer ?name lst = OASISExpr.choose @@ -2385,27 +3400,29 @@ module BaseEnv = struct var_get lst + let var_protect vl = 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 = [ @@ -2426,22 +3443,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) @@ -2451,13 +3468,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 = @@ -2473,23 +3490,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 () *) @@ -2509,8 +3527,9 @@ module BaseEnv = struct dflt end - let var_ignore (e : unit -> string) = - () + + let var_ignore (_: unit -> string) = () + let print_hidden = var_define @@ -2521,6 +3540,7 @@ module BaseEnv = struct "print_hidden" (fun () -> "false") + let var_all () = List.rev (Schema.fold @@ -2532,49 +3552,68 @@ module BaseEnv = struct [] schema) - let default_filename = - BaseEnvLight.default_filename - let load ?allow_empty ?filename () = - env_from_file := BaseEnvLight.load ?allow_empty ?filename () + let default_filename = in_srcdir "setup.data" + + + 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 () = env_from_file := MapString.empty; 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 = @@ -2583,20 +3622,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) @@ -2608,162 +3642,166 @@ 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) + (fun (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 module BaseArgExt = struct -(* # 21 "src/base/BaseArgExt.ml" *) +(* # 22 "src/base/BaseArgExt.ml" *) + open OASISUtils open OASISGettext + 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 -(* # 21 "src/base/BaseCheck.ml" *) +(* # 22 "src/base/BaseCheck.ml" *) + open BaseEnv open BaseMessage open OASISUtils open OASISGettext + let prog_best prg prg_lst = var_redefine prg @@ -2773,74 +3811,80 @@ 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 = prog_best prg [prg] + let prog_opt prg = prog_best prg [prg^".opt"; prg] + let ocamlfind = prog "ocamlfind" + 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 = OASISExec.run_read_one_line ~ctxt:!BaseContext.default (ocamlfind ()) ["query"; "-format"; "%v"; pkg] + let package ?version_comparator pkg () = let var = OASISUtils.varname_concat @@ -2853,13 +3897,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 @@ -2867,80 +3911,83 @@ 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 -(* # 21 "src/base/BaseOCamlcConfig.ml" *) +(* # 22 "src/base/BaseOCamlcConfig.ml" *) open BaseEnv open OASISUtils open OASISGettext + module SMap = Map.Make(String) + let ocamlc = BaseCheck.prog_opt "ocamlc" + 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 -> + 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 ) - in - split_field mp tl + with Not_found -> + ( + mp + ) + in + split_field mp tl | [] -> - mp + mp in - let cache = + let cache = lazy (var_protect (Marshal.to_string @@ -2951,13 +3998,14 @@ 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 = (* Extract data from ocamlc -config *) @@ -2967,47 +4015,47 @@ module BaseOCamlcConfig = struct 0 in let chop_version_suffix s = - try + try String.sub s 0 (String.index s '+') - with _ -> + with _ -> s - in + in let nm_config, value_config = match nm with - | "ocaml_version" -> - "version", chop_version_suffix + | "ocaml_version" -> + "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 module BaseStandardVar = struct -(* # 21 "src/base/BaseStandardVar.ml" *) +(* # 22 "src/base/BaseStandardVar.ml" *) open OASISGettext open OASISTypes - open OASISExpr open BaseCheck open BaseEnv + let ocamlfind = BaseCheck.ocamlfind let ocamlc = BaseOCamlcConfig.ocamlc let ocamlopt = prog_opt "ocamlopt" @@ -3018,32 +4066,38 @@ module BaseStandardVar = struct let rpkg = ref None + let pkg_get () = match !rpkg with | Some pkg -> pkg | None -> failwith (s_ "OASIS Package is not set") + let var_cond = ref [] + let var_define_cond ~since_version f dflt = let holder = ref (fun () -> dflt) in 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 () + (**/**) + let pkg_name = var_define ~short_desc:(fun () -> s_ "Package name") "pkg_name" (fun () -> (pkg_get ()).name) + let pkg_version = var_define ~short_desc:(fun () -> s_ "Package version") @@ -3051,16 +4105,20 @@ module BaseStandardVar = struct (fun () -> (OASISVersion.string_of_version (pkg_get ()).version)) + let c = BaseOCamlcConfig.var_define + let os_type = c "os_type" let system = c "system" let architecture = c "architecture" let ccomp_type = c "ccomp_type" let ocaml_version = c "ocaml_version" + (* TODO: Check standard variable presence at runtime *) + let standard_library_default = c "standard_library_default" let standard_library = c "standard_library" let standard_runtime = c "standard_runtime" @@ -3074,23 +4132,26 @@ module BaseStandardVar = struct let default_executable_name = c "default_executable_name" let systhread_supported = c "systhread_supported" - let flexlink = + + let flexlink = BaseCheck.prog "flexlink" + let flexdll_version = var_define ~short_desc:(fun () -> "FlexDLL version (Win32)") "flexdll_version" (fun () -> - let lst = + let lst = 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) + (**/**) let p name hlp dflt = @@ -3101,119 +4162,140 @@ module BaseStandardVar = struct name dflt + 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") (os_type ()) (**/**) + let prefix = p "prefix" (fun () -> s_ "Install architecture-independent files dir") (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 = p "exec_prefix" (fun () -> s_ "Install architecture-dependent files in dir") (fun () -> "$prefix") + let bindir = p "bindir" (fun () -> s_ "User executables") (fun () -> "$exec_prefix"/"bin") + let sbindir = p "sbindir" (fun () -> s_ "System admin executables") (fun () -> "$exec_prefix"/"sbin") + let libexecdir = p "libexecdir" (fun () -> s_ "Program executables") (fun () -> "$exec_prefix"/"libexec") + let sysconfdir = p "sysconfdir" (fun () -> s_ "Read-only single-machine data") (fun () -> "$prefix"/"etc") + let sharedstatedir = p "sharedstatedir" (fun () -> s_ "Modifiable architecture-independent data") (fun () -> "$prefix"/"com") + let localstatedir = p "localstatedir" (fun () -> s_ "Modifiable single-machine data") (fun () -> "$prefix"/"var") + let libdir = p "libdir" (fun () -> s_ "Object code libraries") (fun () -> "$exec_prefix"/"lib") + let datarootdir = p "datarootdir" (fun () -> s_ "Read-only arch-independent data root") (fun () -> "$prefix"/"share") + let datadir = p "datadir" (fun () -> s_ "Read-only architecture-independent data") (fun () -> "$datarootdir") + let infodir = p "infodir" (fun () -> s_ "Info documentation") (fun () -> "$datarootdir"/"info") + let localedir = p "localedir" (fun () -> s_ "Locale-dependent data") (fun () -> "$datarootdir"/"locale") + let mandir = p "mandir" (fun () -> s_ "Man documentation") (fun () -> "$datarootdir"/"man") + let docdir = p "docdir" (fun () -> s_ "Documentation root") (fun () -> "$datarootdir"/"doc"/"$pkg_name") + let htmldir = p "htmldir" (fun () -> s_ "HTML documentation") (fun () -> "$docdir") + let dvidir = p "dvidir" (fun () -> s_ "DVI documentation") (fun () -> "$docdir") + let pdfdir = p "pdfdir" (fun () -> s_ "PDF documentation") (fun () -> "$docdir") + let psdir = p "psdir" (fun () -> s_ "PS documentation") (fun () -> "$docdir") + let destdir = p "destdir" (fun () -> s_ "Prepend a path when installing package") @@ -3223,35 +4305,39 @@ module BaseStandardVar = struct ("destdir", Some (s_ "undefined by construct")))) + let findlib_version = var_define "findlib_version" (fun () -> BaseCheck.package_version "findlib") + let is_native = var_define "is_native" (fun () -> try - let _s : string = + let _s: string = ocamlopt () in - "true" + "true" with PropList.Not_set _ -> - let _s : string = + let _s: string = ocamlc () in - "false") + "false") + let ext_program = var_define "suffix_program" (fun () -> match os_type () with - | "Win32" -> ".exe" + | "Win32" | "Cygwin" -> ".exe" | _ -> "") + let rm = var_define ~short_desc:(fun () -> s_ "Remove a file.") @@ -3261,6 +4347,7 @@ module BaseStandardVar = struct | "Win32" -> "del" | _ -> "rm -f") + let rmdir = var_define ~short_desc:(fun () -> s_ "Remove a directory.") @@ -3270,6 +4357,7 @@ module BaseStandardVar = struct | "Win32" -> "rd" | _ -> "rm -rf") + let debug = var_define ~short_desc:(fun () -> s_ "Turn ocaml debug flag on") @@ -3277,6 +4365,7 @@ module BaseStandardVar = struct "debug" (fun () -> "true") + let profile = var_define ~short_desc:(fun () -> s_ "Turn ocaml profile flag on") @@ -3284,17 +4373,19 @@ module BaseStandardVar = struct "profile" (fun () -> "false") + let tests = var_define_cond ~since_version:"0.3" (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")) "true" + let docs = var_define_cond ~since_version:"0.3" (fun () -> @@ -3305,6 +4396,7 @@ module BaseStandardVar = struct (fun () -> "true")) "true" + let native_dynlink = var_define ~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.") @@ -3312,7 +4404,7 @@ module BaseStandardVar = struct "native_dynlink" (fun () -> let res = - let ocaml_lt_312 () = + let ocaml_lt_312 () = OASISVersion.comparator_apply (OASISVersion.version_of_string (ocaml_version ())) (OASISVersion.VLesser @@ -3324,37 +4416,38 @@ module BaseStandardVar = struct (OASISVersion.VLesser (OASISVersion.version_of_string "0.30")) in - let has_native_dynlink = + 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 = rpkg := Some pkg; @@ -3363,274 +4456,226 @@ module BaseStandardVar = struct end module BaseFileAB = struct -(* # 21 "src/base/BaseFileAB.ml" *) +(* # 22 "src/base/BaseFileAB.ml" *) + 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 -(* # 21 "src/base/BaseLog.ml" *) +(* # 22 "src/base/BaseLog.ml" *) + 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 register event data = - let chn_out = - open_out_gen [Open_append; Open_creat; Open_text] 0o644 default_filename + 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 - Printf.fprintf chn_out "%S %S\n" event data; - close_out chn_out + 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 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 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 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 ~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 exists event data = + 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 ~ctxt event data = List.exists (fun v -> (event, data) = v) - (load ()) + (load ~ctxt ()) end module BaseBuilt = struct -(* # 21 "src/base/BaseBuilt.ml" *) +(* # 22 "src/base/BaseBuilt.ml" *) + open OASISTypes open OASISGettext open BaseStandardVar open BaseMessage + type t = | BExec (* Executable *) | BExecLib (* Library coming with executable *) | BLib (* Library *) + | BObj (* Library *) | BDoc (* Document *) + let to_log_event_file t nm = "built_"^ - (match t with - | BExec -> "exec" - | BExecLib -> "exec_lib" - | BLib -> "lib" - | 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") - | 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) = let unix_exec_is, unix_dll_opt = @@ -3645,22 +4690,23 @@ 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 -> - []) + (match unix_dll_opt with + | Some fn -> + [BExecLib, cs.cs_name, [[ffn fn]]] + | None -> + []) in - evs, - unix_exec_is, - unix_dll_opt + evs, + unix_exec_is, + unix_dll_opt + let of_library ffn (cs, bs, lib) = let unix_lst = 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 ()) @@ -3672,18 +4718,37 @@ 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) = + let unix_lst = + OASISObject.generated_unix_files + ~ctxt:!BaseContext.default + ~source_file_exists:(fun fn -> + OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn)) + ~is_native:(bool_of_string (is_native ())) + (cs, bs, obj) + in + let evs = + [BObj, + cs.cs_name, + List.map (List.map ffn) unix_lst] + in + evs, unix_lst end module BaseCustom = struct -(* # 21 "src/base/BaseCustom.ml" *) +(* # 22 "src/base/BaseCustom.ml" *) + open BaseEnv open BaseMessage open OASISTypes open OASISGettext + let run cmd args extra_args = OASISExec.run ~ctxt:!BaseContext.default ~quote:false (var_expand cmd) @@ -3691,6 +4756,7 @@ module BaseCustom = struct var_expand (args @ (Array.to_list extra_args))) + let hook ?(failsafe=false) cstm f e = let optional_command lst = let printer = @@ -3698,36 +4764,36 @@ 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 -(* # 21 "src/base/BaseDynVar.ml" *) +(* # 22 "src/base/BaseDynVar.ml" *) open OASISTypes @@ -3735,96 +4801,91 @@ module BaseDynVar = struct open BaseEnv 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))))) - - | Library _ | Flag _ | Test _ | SrcRepo _ | Doc _ -> - ()) + | 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 _ -> + ()) pkg.sections end module BaseTest = struct -(* # 21 "src/base/BaseTest.ml" *) +(* # 22 "src/base/BaseTest.ml" *) + 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 @@ -3832,110 +4893,111 @@ module BaseTest = struct (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 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; - - (* Possible explanation why the tests where not run. *) - if OASISVersion.version_0_3_or_after pkg.oasis_version && - not (bool_of_string (BaseStandardVar.tests ())) && - lst <> [] then - BaseMessage.warning - "Tests are turned off, consider enabling with \ - 'ocaml setup.ml -configure --enable-tests'" + 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'" end module BaseDoc = struct -(* # 21 "src/base/BaseDoc.ml" *) +(* # 22 "src/base/BaseDoc.ml" *) + open BaseEnv open BaseMessage open OASISTypes 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; - - if OASISVersion.version_0_3_or_after pkg.oasis_version && - not (bool_of_string (BaseStandardVar.docs ())) && - lst <> [] then - BaseMessage.warning - "Docs are turned off, consider enabling with \ - 'ocaml setup.ml -configure --enable-docs'" + 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'" end module BaseSetup = struct -(* # 21 "src/base/BaseSetup.ml" *) +(* # 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 *) let join_plugin_sections filter_map lst = @@ -3944,12 +5006,13 @@ module BaseSetup = struct (fun acc sct -> match filter_map sct with | Some e -> - e :: acc + e :: acc | None -> - acc) + acc) [] lst) + (* Search for plugin data associated with a section name *) let lookup_plugin_section plugin action nm lst = try @@ -3961,149 +5024,148 @@ module BaseSetup = struct nm action - let configure t args = + + let configure ~ctxt t args = (* Run configure *) BaseCustom.hook t.package.conf_custom - (fun () -> + (fun () -> (* Reload if preconf has changed it *) 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 - 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-doc", + Arg.Set rno_doc, + s_ "Don't run doc target"; - "-no-test", - Arg.Set rno_test, - s_ "Don't run test target"; - ] - (failwithf (f_ "Don't know what to do with '%s'")) - ""; + "-no-test", + Arg.Set rno_test, + s_ "Don't run test target"; - info "Running configure step"; - configure t [||]; + "--", + 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 uninstall t args = - BaseCustom.hook - t.package.uninstall_custom - (t.uninstall t.package) - args + let install ~ctxt t args = + BaseCustom.hook t.package.install_custom (t.install ~ctxt t.package) args + + + let uninstall ~ctxt t args = + BaseCustom.hook t.package.uninstall_custom (t.uninstall ~ctxt t.package) args + + + let reinstall ~ctxt t args = + uninstall ~ctxt t args; + install ~ctxt t args - let reinstall t args = - uninstall t args; - install t args let clean, distclean = let failsafe f a = @@ -4113,11 +5175,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 @@ -4125,44 +5187,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 _ - | 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 @@ -4171,12 +5221,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 @@ -4184,38 +5235,39 @@ 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 ~ctxt:_ (t: t) _ = print_endline t.oasis_version - let version 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" + let update_setup_ml t = let oasis_fn = match t.oasis_fn with | Some fn -> fn - | None -> "_oasis" + | None -> default_oasis_fn in let oasis_exec = match t.oasis_exec with @@ -4228,16 +5280,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 @@ -4248,64 +5300,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 @@ -4313,7 +5363,8 @@ module BaseSetup = struct try match t.oasis_digest with | Some dgst -> - if Sys.file_exists oasis_fn && dgst <> Digest.file "_oasis" then + if Sys.file_exists oasis_fn && + dgst <> Digest.file default_oasis_fn then begin do_update (); true @@ -4321,7 +5372,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, \ @@ -4333,157 +5384,290 @@ module BaseSetup = struct else false - 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 setup t = + 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 + 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 + + + module Compat_0_3 = + struct + include Compat_0_4 + end end -# 4480 "setup.ml" +# 5662 "setup.ml" module InternalConfigurePlugin = struct -(* # 21 "src/plugins/internal/InternalConfigurePlugin.ml" *) +(* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *) + (** Configure using internal scheme @author Sylvain Le Gall - *) + *) + open BaseEnv open OASISTypes @@ -4491,24 +5675,14 @@ module InternalConfigurePlugin = struct open OASISGettext open BaseMessage - (** Configure build using provided series of check to be done - * and then output corresponding file. - *) - let configure 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 + (** Configure build using provided series of check to be done + 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 let add_errors fmt = Printf.kbprintf @@ -4527,29 +5701,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 @@ -4573,39 +5747,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 @@ -4617,44 +5791,58 @@ 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 "4.0.0") >= 0 in + if ocaml_ge4 then + let findlib_lt132 = + OASISVersion.version_compare + (OASISVersion.version_of_string (BaseStandardVar.findlib_version())) + (OASISVersion.version_of_string "1.3.2") < 0 in + if findlib_lt132 then + add_errors "OCaml >= 4.0.0 requires Findlib version >= 1.3.2" end; (* FlexDLL *) @@ -4671,37 +5859,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 *) @@ -4718,43 +5906,43 @@ module InternalConfigurePlugin = struct (SetString.cardinal !errors) end + end module InternalInstallPlugin = struct -(* # 21 "src/plugins/internal/InternalInstallPlugin.ml" *) +(* # 22 "src/plugins/internal/InternalInstallPlugin.ml" *) + (** Install using internal scheme @author Sylvain Le Gall *) + + (* TODO: rewrite this module with OASISFileSystem. *) + open BaseEnv open BaseStandardVar open BaseMessage open OASISTypes - open OASISLibrary + open OASISFindlib open OASISGettext 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 doc_hook = - ref (fun (cs, doc) -> cs, doc) + 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_file_ev = - "install-file" + let install_file_ev = "install-file" + let install_dir_ev = "install-dir" + let install_findlib_ev = "install-findlib" - 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 + let split_install_command ocamlfind findlib_name meta files = if Sys.os_type = "Win32" then (* Arguments for the first command: *) @@ -4794,20 +5982,21 @@ module InternalInstallPlugin = struct | (firsts, others) -> let cmd = args @ firsts in (* Use -add for remaining commands: *) - let () = + let () = let findlib_ge_132 = OASISVersion.comparator_apply - (OASISVersion.version_of_string + (OASISVersion.version_of_string (BaseStandardVar.findlib_version ())) - (OASISVersion.VGreaterEqual + (OASISVersion.VGreaterEqual (OASISVersion.version_of_string "1.3.2")) in if not findlib_ge_132 then failwithf - (f_ "Installing the library %s require to use the flag \ - '-add' of ocamlfind because the command line is too \ - long. This flag is only available for findlib 1.3.2. \ - Please upgrade findlib from %s to 1.3.2") + (f_ "Installing the library %s require to use the \ + flag '-add' of ocamlfind because the command \ + line is too long. This flag is only available \ + for findlib 1.3.2. Please upgrade findlib from \ + %s to 1.3.2") findlib_name (BaseStandardVar.findlib_version ()) in let cmds = split other_args others in @@ -4818,24 +6007,22 @@ module InternalInstallPlugin = struct else ["install" :: findlib_name :: meta :: files] - let install pkg argv = - let in_destdir = + let install = + + 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 @@ -4848,20 +6035,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 @@ -4878,7 +6093,7 @@ module InternalInstallPlugin = struct src; List.iter (fun fn -> - install_file + install_file ~ctxt fn (fun () -> match tgt_opt with @@ -4890,77 +6105,158 @@ module InternalInstallPlugin = struct lst in + 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 + (** Install all libraries *) - let install_libs pkg = + let install_libs ~ctxt pkg = - let files_of_library (f_data, acc) data_lib = - let cs, bs, lib, lib_extra = - !lib_hook data_lib + 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 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 + + 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 - 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 + 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, new_files @ extra_files + in - let acc = - (* Get generated files *) - BaseBuilt.fold - BaseBuilt.BLib - 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 library *) + install_data + ~ctxt + 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 - 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 + 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 - (f_data, acc) - end - else - begin - (f_data, acc) - end + 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 *) @@ -4971,8 +6267,10 @@ module InternalInstallPlugin = struct match grp with | Container (_, children) -> data_and_files, children - | Package (_, cs, bs, lib, children) -> - files_of_library data_and_files (cs, bs, lib), 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 @@ -4981,268 +6279,209 @@ 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 + fun ~ctxt pkg _ -> + install_libs ~ctxt pkg; + install_execs ~ctxt pkg; + install_docs ~ctxt pkg - install_libs pkg; - install_execs pkg; - install_docs 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 -# 5233 "setup.ml" +# 6465 "setup.ml" module OCamlbuildCommon = struct -(* # 21 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *) +(* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *) + (** Functions common to OCamlbuild build and doc plugin - *) + *) + open OASISGettext open BaseEnv open BaseStandardVar + open OASISTypes + + + type extra_args = string list + + + let ocamlbuild_clean_ev = "ocamlbuild-clean" - let ocamlbuild_clean_ev = - "ocamlbuild-clean" let ocamlbuildflags = var_define @@ -5250,6 +6489,7 @@ module OCamlbuildCommon = struct "ocamlbuildflags" (fun () -> "") + (** Fix special arguments depending on environment *) let fix_args args extra_argv = List.flatten @@ -5259,6 +6499,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") ] @@ -5278,6 +6526,11 @@ module OCamlbuildCommon = struct else []; + if bool_of_string (tests ()) then + ["-tag"; "tests"] + else + []; + if bool_of_string (profile ()) then ["-tag"; "profile"] else @@ -5288,71 +6541,74 @@ module OCamlbuildCommon = struct Array.to_list extra_argv; ] + (** 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 *) let build_dir extra_argv = 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 module OCamlbuildPlugin = struct -(* # 21 "src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *) +(* # 22 "src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *) + (** Build using ocamlbuild @author Sylvain Le Gall *) + open OASISTypes open OASISGettext open OASISUtils + open OASISString open BaseEnv open OCamlbuildCommon open BaseStandardVar - open BaseMessage - let cond_targets_hook = - ref (fun lst -> lst) - let build pkg argv = + let cond_targets_hook = ref (fun lst -> lst) + + let build ~ctxt extra_args pkg argv = (* Return the filename in build directory *) let in_build_dir fn = Filename.concat @@ -5377,16 +6633,36 @@ module OCamlbuildPlugin = struct (cs, bs, lib) in - let ends_with nd fn = - let nd_len = - String.length nd - in - (String.length fn >= nd_len) - && - (String.sub - fn - (String.length fn - nd_len) - nd_len) = nd + let tgts = + List.flatten + (List.filter + (fun l -> l <> []) + (List.map + (List.filter + (fun fn -> + ends_with ~what:".cma" fn + || ends_with ~what:".cmxs" fn + || ends_with ~what:".cmxa" fn + || ends_with ~what:(ext_lib ()) fn + || ends_with ~what:(ext_dll ()) fn)) + unix_files)) + in + + match tgts with + | _ :: _ -> + (evs, tgts) :: acc + | [] -> + failwithf + (f_ "No possible ocamlbuild targets for library %s") + cs.cs_name + end + + | Object (cs, bs, obj) when var_choose bs.bs_build -> + begin + let evs, unix_files = + BaseBuilt.of_object + in_build_dir_of_unix + (cs, bs, obj) in let tgts = @@ -5396,11 +6672,8 @@ module OCamlbuildPlugin = struct (List.map (List.filter (fun fn -> - ends_with ".cma" fn - || ends_with ".cmxs" fn - || ends_with ".cmxa" fn - || ends_with (ext_lib ()) fn - || ends_with (ext_dll ()) fn)) + ends_with ~what:".cmo" fn + || ends_with ~what:".cmx" fn)) unix_files)) in @@ -5409,16 +6682,14 @@ module OCamlbuildPlugin = struct (evs, tgts) :: acc | [] -> failwithf - (f_ "No possible ocamlbuild targets for library %s") + (f_ "No possible ocamlbuild targets for object %s") cs.cs_name end | 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 = @@ -5428,12 +6699,13 @@ module OCamlbuildPlugin = struct (OASISUnixPath.chop_extension exec.exec_main_is))^ext in - let evs = + let evs = (* 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, [[in_build_dir_of_unix unix_tgt]] + | BaseBuilt.BExec, nm, _ when nm = cs.cs_name -> + BaseBuilt.BExec, nm, + [[in_build_dir_of_unix unix_tgt]] | ev -> ev) evs @@ -5455,7 +6727,7 @@ module OCamlbuildPlugin = struct acc end - | Library _ | Executable _ | Test _ + | Library _ | Object _ | Executable _ | Test _ | SrcRepo _ | Flag _ | Doc _ -> acc) [] @@ -5469,63 +6741,69 @@ module OCamlbuildPlugin = struct (fun fns -> if not (List.exists OASISFileUtil.file_exists_case fns) then failwithf - (f_ "No one of expected built files %s exists") - (String.concat (s_ ", ") (List.map (Printf.sprintf "'%s'") fns))) + (fn_ + "Expected built file %s doesn't exist." + "None of expected built files %s exists." + (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 - let cond_targets = - (* Run the hook *) - !cond_targets_hook cond_targets - 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)) - argv; - (* ... and register events *) - List.iter - check_and_register - (List.flatten (List.map fst cond_targets)) + (* Run a list of target... *) + 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 + end module OCamlbuildDocPlugin = struct -(* # 21 "src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *) +(* # 22 "src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *) + (* Create documentation using ocamlbuild .odocl files @author Sylvain Le Gall - *) + *) + open OASISTypes open OASISGettext - open OASISMessage open OCamlbuildCommon - open BaseStandardVar + type run_t = + { + extra_args: string list; + run_path: unix_filename; + } + - let doc_build path pkg (cs, doc) argv = + let doc_build ~ctxt run _ (cs, _) argv = let index_html = OASISUnixPath.make [ - path; + run.run_path; cs.cs_name^".docdir"; "index.html"; ] @@ -5534,170 +6812,167 @@ module OCamlbuildDocPlugin = struct OASISHostPath.make [ build_dir argv; - OASISHostPath.of_unix path; + OASISHostPath.of_unix run.run_path; cs.cs_name^".docdir"; ] in - run_ocamlbuild [index_html] argv; - List.iter - (fun glb -> - BaseBuilt.register - BaseBuilt.BDoc - cs.cs_name - [OASISFileUtil.glob ~ctxt:!BaseContext.default - (Filename.concat tgt_dir glb)]) - ["*.html"; "*.css"] - - let doc_clean t pkg (cs, doc) argv = - run_clean argv; - BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name + 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 ~ctxt _ _ (cs, _) argv = + run_clean ~ctxt argv; + BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name + end -# 5558 "setup.ml" +# 6837 "setup.ml" module CustomPlugin = struct -(* # 21 "src/plugins/custom/CustomPlugin.ml" *) +(* # 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; + } - type t = - { - 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 run = BaseCustom.run - let clean t pkg 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 ~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; + struct + let main ~ctxt t pkg extra_args = + main ~ctxt t pkg extra_args; List.iter (fun sct -> let evs = - match sct with + 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 + BaseMessage.warning (f_ "Test '%s' fails: %s") cs.cs_name 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 main ~ctxt t pkg (cs, _) extra_args = + main ~ctxt t pkg extra_args; + BaseBuilt.register ~ctxt 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 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 -# 5694 "setup.ml" +# 6969 "setup.ml" open OASISTypes;; let setup_t = { BaseSetup.configure = InternalConfigurePlugin.configure; - build = OCamlbuildPlugin.build; + build = OCamlbuildPlugin.build []; test = [ ("test", @@ -5706,10 +6981,15 @@ let setup_t = CustomPlugin.cmd_main = [(OASISExpr.EBool true, ("$test", []))]; cmd_clean = [(OASISExpr.EBool true, None)]; - cmd_distclean = [(OASISExpr.EBool true, None)]; - }) + cmd_distclean = [(OASISExpr.EBool true, None)] + }) + ]; + doc = + [ + ("api", + OCamlbuildDocPlugin.doc_build + {OCamlbuildDocPlugin.extra_args = []; run_path = "src/"}) ]; - doc = [("api", OCamlbuildDocPlugin.doc_build "src/")]; install = InternalInstallPlugin.install; uninstall = InternalInstallPlugin.uninstall; clean = [OCamlbuildPlugin.clean]; @@ -5721,10 +7001,15 @@ let setup_t = CustomPlugin.cmd_main = [(OASISExpr.EBool true, ("$test", []))]; cmd_clean = [(OASISExpr.EBool true, None)]; - cmd_distclean = [(OASISExpr.EBool true, None)]; - }) + cmd_distclean = [(OASISExpr.EBool true, None)] + }) + ]; + clean_doc = + [ + ("api", + OCamlbuildDocPlugin.doc_clean + {OCamlbuildDocPlugin.extra_args = []; run_path = "src/"}) ]; - clean_doc = [("api", OCamlbuildDocPlugin.doc_clean "src/")]; distclean = []; distclean_test = [ @@ -5734,68 +7019,46 @@ let setup_t = CustomPlugin.cmd_main = [(OASISExpr.EBool true, ("$test", []))]; cmd_clean = [(OASISExpr.EBool true, None)]; - cmd_distclean = [(OASISExpr.EBool true, None)]; - }) + cmd_distclean = [(OASISExpr.EBool true, None)] + }) ]; distclean_doc = []; package = { - oasis_version = "0.1"; + oasis_version = "0.4"; ocaml_version = None; - findlib_version = None; - name = "snappy"; version = "0.1.0"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit { - OASISLicense.license = "BSD3"; + OASISLicense.license = "BSD-3-clause"; excption = None; - version = OASISLicense.NoVersion; - }); + version = OASISLicense.NoVersion + }); + findlib_version = None; + alpha_features = []; + beta_features = []; + name = "snappy"; license_file = None; copyrights = ["(C) 2011 ygrek"]; maintainers = []; authors = ["ygrek"]; homepage = Some "http://snappy.forge.ocamlcore.org/"; + bugreports = None; synopsis = "Bindings to snappy compression library"; description = Some - "Snappy is a compression/decompression library. It does not aim for\nmaximum compression, or compatibility with any other compression library;\ninstead, it aims for very high speeds and reasonable compression. For instance,\ncompared to the fastest mode of zlib, Snappy is an order of magnitude faster\nfor most inputs, but the resulting compressed files are anywhere from 20% to\n100% bigger. On a single core of a Core i7 processor in 64-bit mode, Snappy\ncompresses at about 250 MB/sec or more and decompresses at about 500 MB/sec\nor more.\n\nSnappy is written in C++, this library implements OCaml bindings.\n\nSee http://code.google.com/p/snappy/ for more info"; + [ + OASISText.Para + "Snappy is a compression/decompression library. It does not aim for maximum compression, or compatibility with any other compression library; instead, it aims for very high speeds and reasonable compression. For instance, compared to the fastest mode of zlib, Snappy is an order of magnitude faster for most inputs, but the resulting compressed files are anywhere from 20% to 100% bigger. On a single core of a Core i7 processor in 64-bit mode, Snappy compresses at about 250 MB/sec or more and decompresses at about 500 MB/sec or more."; + OASISText.Para + "Snappy is written in C++, this library implements OCaml bindings."; + OASISText.Para + "See http://code.google.com/p/snappy/ for more info" + ]; + tags = []; categories = []; - conf_type = (`Configure, "internal", Some "0.3"); - conf_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)]; - }; - build_type = (`Build, "ocamlbuild", Some "0.3"); - build_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)]; - }; - install_type = (`Install, "internal", Some "0.3"); - 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 = []; sections = [ @@ -5803,8 +7066,8 @@ let setup_t = ({ cs_name = "snappy"; cs_data = PropList.Data.create (); - cs_plugin_data = []; - }, + cs_plugin_data = [] + }, { bs_build = [(OASISExpr.EBool true, true)]; bs_install = [(OASISExpr.EBool true, true)]; @@ -5812,30 +7075,142 @@ let setup_t = bs_compiled_object = Best; bs_build_depends = []; 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 = ["snappy_stubs.c"]; bs_data_files = []; + bs_findlib_extra_files = []; bs_ccopt = [(OASISExpr.EBool true, ["-x"; "c++"])]; bs_cclib = [(OASISExpr.EBool true, ["-lstdc++"; "-lsnappy"])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; - bs_nativeopt = [(OASISExpr.EBool true, [])]; - }, + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, { lib_modules = ["Snappy"]; lib_pack = false; lib_internal_modules = []; lib_findlib_parent = None; lib_findlib_name = None; - lib_findlib_containers = []; - }); + lib_findlib_directory = None; + lib_findlib_containers = [] + }); Executable ({ cs_name = "test"; cs_data = PropList.Data.create (); - cs_plugin_data = []; - }, + cs_plugin_data = [] + }, { bs_build = [(OASISExpr.EBool true, true)]; bs_install = [(OASISExpr.EBool true, false)]; @@ -5843,48 +7218,167 @@ let setup_t = bs_compiled_object = Best; bs_build_depends = [InternalLibrary "snappy"]; 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, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; - bs_nativeopt = [(OASISExpr.EBool true, [])]; - }, - {exec_custom = true; exec_main_is = "test.ml"; }); + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, + {exec_custom = true; exec_main_is = "test.ml"}); Test ({ cs_name = "test"; cs_data = PropList.Data.create (); - cs_plugin_data = []; - }, + cs_plugin_data = [] + }, { - test_type = (`Test, "custom", Some "0.3"); + test_type = (`Test, "custom", Some "0.4"); test_command = [(OASISExpr.EBool true, ("$test", []))]; test_custom = { pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)]; - }; + post_command = [(OASISExpr.EBool true, None)] + }; test_working_directory = None; - test_run = [(OASISExpr.EBool true, true)]; - test_tools = [ExternalTool "ocamlbuild"]; - }); + test_run = + [ + (OASISExpr.ENot (OASISExpr.EFlag "tests"), false); + (OASISExpr.EFlag "tests", true) + ]; + test_tools = [ExternalTool "ocamlbuild"] + }); Doc ({ cs_name = "api"; cs_data = PropList.Data.create (); - cs_plugin_data = []; - }, + cs_plugin_data = [] + }, { doc_type = (`Doc, "ocamlbuild", Some "0.3"); doc_custom = { pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)]; - }; - doc_build = [(OASISExpr.EBool true, true)]; + post_command = [(OASISExpr.EBool true, None)] + }; + doc_build = + [ + (OASISExpr.ENot (OASISExpr.EFlag "docs"), false); + (OASISExpr.EFlag "docs", true) + ]; doc_install = [(OASISExpr.EBool true, true)]; doc_install_dir = "$htmldir"; doc_title = "API reference"; @@ -5893,14 +7387,14 @@ let setup_t = doc_format = HTML "index.html"; doc_data_files = []; doc_build_tools = - [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; - }); + [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"] + }); SrcRepo ({ cs_name = "main"; cs_data = PropList.Data.create (); - cs_plugin_data = []; - }, + cs_plugin_data = [] + }, { src_repo_type = Git; src_repo_location = @@ -5911,24 +7405,60 @@ let setup_t = src_repo_module = None; src_repo_branch = None; src_repo_tag = None; - src_repo_subdir = None; - }) + src_repo_subdir = None + }) ]; + 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.3"); (`Extra, "META", Some "0.3")]; schema_data = PropList.Data.create (); - plugin_data = []; - }; + plugin_data = [] + }; oasis_fn = Some "_oasis"; - oasis_version = "0.3.0"; - oasis_digest = Some "\219\1859%LK\136\192y\nw\028G\236\006L"; + oasis_version = "0.4.10"; + oasis_digest = Some "~\189\243f\153\248N\209\005=V\192J\186<\178"; oasis_exec = None; oasis_setup_args = []; - setup_update = false; - };; + setup_update = false + };; let setup () = BaseSetup.setup setup_t;; -# 5933 "setup.ml" +# 7461 "setup.ml" +let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t +open BaseCompat.Compat_0_4 (* OASIS_STOP *) let () = setup ();; From 71115eae4e12eb2bcf3d6472712452f3c6398b78 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 3 Apr 2018 11:12:58 +0200 Subject: [PATCH 2/3] bump version number to 0.1.1 --- _oasis | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/_oasis b/_oasis index 143f54b..df2e36c 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.4 Name: snappy -Version: 0.1.0 +Version: 0.1.1 Synopsis: Bindings to snappy compression library Authors: ygrek Copyrights: (C) 2011 ygrek From 3191359372a4c49b17ef6be58a36a13814a937ad Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Tue, 3 Apr 2018 11:13:12 +0200 Subject: [PATCH 3/3] fix build with safe-string (String.init, requires OCaml >= 4.02) --- test.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/test.ml b/test.ml index 70228dd..c834cb6 100644 --- a/test.ml +++ b/test.ml @@ -2,8 +2,7 @@ let () = Random.self_init (); let check n = - let s = String.create n in - for i = 0 to pred n do s.[i] <- Char.chr (Random.int 256) done; + let s = String.init n (fun _i -> Char.chr (Random.int 256)) in let c = Snappy.compress s in assert (true = Snappy.is_valid c); assert (false = Snappy.is_valid s);