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