Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

5147 lines (4517 sloc) 134.937 kb
(* setup.ml generated for the first time by OASIS v0.2.1~alpha1 *)
(* OASIS_START *)
(* DO NOT EDIT (digest: c71e2eddb378b7981dee1db1c10233ea) *)
(*
Regenerated by OASIS v0.2.0
Visit http://oasis.forge.ocamlcore.org for more information and
documentation about functions used in this file.
*)
module OASISGettext = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISGettext.ml"
let ns_ str =
str
let s_ str =
str
let f_ (str : ('a, 'b, 'c, 'd) format4) =
str
let fn_ fmt1 fmt2 n =
if n = 1 then
fmt1^^""
else
fmt2^^""
let init =
[]
end
module OASISContext = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISContext.ml"
open OASISGettext
type level =
[ `Debug
| `Info
| `Warning
| `Error]
type t =
{
verbose: bool;
debug: bool;
ignore_plugins: 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
match lvl with
| `Error ->
prerr_endline (beg^str)
| _ ->
print_endline (beg^str)
let default =
ref
{
verbose = true;
debug = false;
ignore_plugins = false;
printf = printf;
}
let quiet =
{!default with
verbose = false;
debug = false;
}
let args () =
["-quiet",
Arg.Unit (fun () -> default := {!default with verbose = false}),
(s_ " Run quietly");
"-debug",
Arg.Unit (fun () -> default := {!default with debug = true}),
(s_ " Output debug message")]
end
module OASISUtils = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISUtils.ml"
module MapString = Map.Make(String)
let map_string_of_assoc assoc =
List.fold_left
(fun acc (k, v) -> MapString.add k v acc)
MapString.empty
assoc
module SetString = Set.Make(String)
let set_string_add_list st lst =
List.fold_left
(fun acc e -> SetString.add e acc)
st
lst
let set_string_of_list =
set_string_add_list
SetString.empty
let compare_csl s1 s2 =
String.compare (String.lowercase s1) (String.lowercase 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)
end)
let split sep str =
let str_len =
String.length str
in
let rec split_aux acc pos =
if pos < str_len then
(
let pos_sep =
try
String.index_from str pos sep
with Not_found ->
str_len
in
let part =
String.sub str pos (pos_sep - pos)
in
let acc =
part :: acc
in
if pos_sep >= str_len then
(
(* Nothing more in the string *)
List.rev acc
)
else if pos_sep = (str_len - 1) then
(
(* String end with a separator *)
List.rev ("" :: acc)
)
else
(
split_aux acc (pos_sep + 1)
)
)
else
(
List.rev acc
)
in
split_aux [] 0
let varname_of_string ?(hyphen='_') s =
if String.length s = 0 then
begin
invalid_arg "varname_of_string"
end
else
begin
let buff =
Buffer.create (String.length s)
in
(* Start with a _ if digit *)
if '0' <= s.[0] && s.[0] <= '9' then
Buffer.add_char buff hyphen;
String.iter
(fun c ->
if ('a' <= c && c <= 'z')
||
('A' <= c && c <= 'Z')
||
('0' <= c && c <= '9') then
Buffer.add_char buff c
else
Buffer.add_char buff hyphen)
s;
String.lowercase (Buffer.contents buff)
end
let varname_concat ?(hyphen='_') p s =
let p =
let p_len =
String.length p
in
if p_len > 0 && p.[p_len - 1] = hyphen then
String.sub p 0 (p_len - 1)
else
p
in
let s =
let s_len =
String.length s
in
if s_len > 0 && s.[0] = hyphen then
String.sub s 1 (s_len - 1)
else
s
in
Printf.sprintf "%s%c%s" p hyphen s
let is_varname str =
str = varname_of_string str
let failwithf1 fmt a =
failwith (Printf.sprintf fmt a)
let failwithf2 fmt a b =
failwith (Printf.sprintf fmt a b)
let failwithf3 fmt a b c =
failwith (Printf.sprintf fmt a b c)
let failwithf4 fmt a b c d =
failwith (Printf.sprintf fmt a b c d)
let failwithf5 fmt a b c d e =
failwith (Printf.sprintf fmt a b c d e)
end
module PropList = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/PropList.ml"
open OASISGettext
type name = string
exception Not_set of name * string option
exception No_printer of name
exception Unknown_field of name * name
let string_of_exception =
function
| Not_set (nm, Some rsn) ->
Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn
| Not_set (nm, None) ->
Printf.sprintf (f_ "Field '%s' is not set") nm
| No_printer nm ->
Printf.sprintf (f_ "No default printer for value %s") nm
| Unknown_field (nm, schm) ->
Printf.sprintf (f_ "Field %s is not defined in schema %s") nm schm
| e ->
raise e
module Data =
struct
type t =
(name, unit -> unit) Hashtbl.t
let create () =
Hashtbl.create 13
let clear t =
Hashtbl.clear t
# 59 "/tmp/buildd/oasis-0.2.0/src/oasis/PropList.ml"
end
module Schema =
struct
type ('ctxt, 'extra) value =
{
get: Data.t -> string;
set: Data.t -> ?context:'ctxt -> string -> unit;
help: (unit -> string) option;
extra: 'extra;
}
type ('ctxt, 'extra) t =
{
name: name;
fields: (name, ('ctxt, 'extra) value) Hashtbl.t;
order: name Queue.t;
name_norm: string -> string;
}
let create ?(case_insensitive=false) nm =
{
name = nm;
fields = Hashtbl.create 13;
order = Queue.create ();
name_norm =
(if case_insensitive then
String.lowercase
else
fun s -> s);
}
let add t nm set get extra help =
let key =
t.name_norm nm
in
if Hashtbl.mem t.fields key then
failwith
(Printf.sprintf
(f_ "Field '%s' is already defined in schema '%s'")
nm t.name);
Hashtbl.add
t.fields
key
{
set = set;
get = get;
help = help;
extra = extra;
};
Queue.add nm t.order
let mem t nm =
Hashtbl.mem t.fields nm
let find t nm =
try
Hashtbl.find t.fields (t.name_norm nm)
with Not_found ->
raise (Unknown_field (nm, t.name))
let get t data nm =
(find t nm).get data
let set t data nm ?context x =
(find t nm).set
data
?context
x
let fold f acc t =
Queue.fold
(fun acc k ->
let v =
find t k
in
f acc k v.extra v.help)
acc
t.order
let iter f t =
fold
(fun () -> f)
()
t
let name t =
t.name
end
module Field =
struct
type ('ctxt, 'value, 'extra) t =
{
set: Data.t -> ?context:'ctxt -> 'value -> unit;
get: Data.t -> 'value;
sets: Data.t -> ?context:'ctxt -> string -> unit;
gets: Data.t -> string;
help: (unit -> string) option;
extra: 'extra;
}
let new_id =
let last_id =
ref 0
in
fun () -> incr last_id; !last_id
let create ?schema ?name ?parse ?print ?default ?update ?help extra =
(* Default value container *)
let v =
ref None
in
(* If name is not given, create unique one *)
let nm =
match name with
| Some s -> s
| None -> Printf.sprintf "_anon_%d" (new_id ())
in
(* Last chance to get a value: the default *)
let default () =
match default with
| Some d -> d
| None -> raise (Not_set (nm, Some (s_ "no default value")))
in
(* Get data *)
let get data =
(* Get value *)
try
(Hashtbl.find data nm) ();
match !v with
| Some x -> x
| None -> default ()
with Not_found ->
default ()
in
(* Set data *)
let set data ?context x =
let x =
match update with
| Some f ->
begin
try
f ?context (get data) x
with Not_set _ ->
x
end
| None ->
x
in
Hashtbl.replace
data
nm
(fun () -> v := Some x)
in
(* Parse string value, if possible *)
let parse =
match parse with
| Some f ->
f
| None ->
fun ?context s ->
failwith
(Printf.sprintf
(f_ "Cannot parse field '%s' when setting value %S")
nm
s)
in
(* Set data, from string *)
let sets data ?context s =
set ?context data (parse ?context s)
in
(* Output value as string, if possible *)
let print =
match print with
| Some f ->
f
| None ->
fun _ -> raise (No_printer nm)
in
(* Get data, as a string *)
let gets data =
print (get data)
in
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;
}
let fset data t ?context x =
t.set data ?context x
let fget data t =
t.get data
let fsets data t ?context s =
t.sets data ?context s
let fgets data t =
t.gets data
end
module FieldRO =
struct
let create ?schema ?name ?parse ?print ?default ?update ?help extra =
let fld =
Field.create ?schema ?name ?parse ?print ?default ?update ?help extra
in
fun data -> Field.fget data fld
end
end
module OASISMessage = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISMessage.ml"
open OASISGettext
open OASISContext
let generic_message ~ctxt lvl fmt =
let cond =
match lvl with
| `Debug -> ctxt.debug
| _ -> ctxt.verbose
in
Printf.ksprintf
(fun str ->
if cond then
begin
ctxt.printf lvl str
end)
fmt
let debug ~ctxt fmt =
generic_message ~ctxt `Debug fmt
let info ~ctxt fmt =
generic_message ~ctxt `Info fmt
let warning ~ctxt fmt =
generic_message ~ctxt `Warning fmt
let error ~ctxt fmt =
generic_message ~ctxt `Error fmt
let string_of_exception e =
try
PropList.string_of_exception e
with
| Failure s ->
s
| e ->
Printexc.to_string e
(* TODO
let register_exn_printer f =
*)
end
module OASISVersion = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISVersion.ml"
open OASISGettext
type s = string
type t = string
type comparator =
| VGreater of t
| VGreaterEqual of t
| VEqual of t
| VLesser of t
| VLesserEqual of t
| VOr of comparator * comparator
| VAnd of comparator * comparator
(* Range of allowed characters *)
let is_digit c =
'0' <= c && c <= '9'
let is_alpha c =
('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
let is_special =
function
| '.' | '+' | '-' | '~' -> true
| _ -> false
let rec version_compare v1 v2 =
if v1 <> "" || v2 <> "" then
begin
(* Compare ascii string, using special meaning for version
* related char
*)
let val_ascii c =
if c = '~' then -1
else if is_digit c then 0
else if c = '\000' then 0
else if is_alpha c then Char.code c
else (Char.code c) + 256
in
let len1 = String.length v1 in
let len2 = String.length v2 in
let p = ref 0 in
(** Compare ascii part *)
let compare_vascii () =
let cmp = ref 0 in
while !cmp = 0 &&
!p < len1 && !p < len2 &&
not (is_digit v1.[!p] && is_digit v2.[!p]) do
cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);
incr p
done;
if !cmp = 0 && !p < len1 && !p = len2 then
val_ascii v1.[!p]
else if !cmp = 0 && !p = len1 && !p < len2 then
- (val_ascii v2.[!p])
else
!cmp
in
(** Compare digit part *)
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;
match String.sub v start_p (!p - start_p) with
| "" -> 0,
v
| s -> int_of_string s,
String.sub v !p ((String.length v) - !p)
in
let i1, tl1 = extract_int v1 (ref !p) in
let i2, tl2 = extract_int v2 (ref !p) in
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
end
let version_of_string str =
String.iter
(fun c ->
if is_alpha c || is_digit c || is_special c then
()
else
failwith
(Printf.sprintf
(f_ "Char %C is not allowed in version '%s'")
c str))
str;
str
let string_of_version t =
t
let chop t =
try
let pos =
String.rindex t '.'
in
String.sub t 0 pos
with Not_found ->
t
let rec comparator_apply v op =
match op with
| VGreater cv ->
(version_compare v cv) > 0
| VGreaterEqual cv ->
(version_compare v cv) >= 0
| VLesser cv ->
(version_compare v cv) < 0
| VLesserEqual cv ->
(version_compare v cv) <= 0
| VEqual cv ->
(version_compare v cv) = 0
| VOr (op1, op2) ->
(comparator_apply v op1) || (comparator_apply v op2)
| VAnd (op1, op2) ->
(comparator_apply v op1) && (comparator_apply v op2)
let rec string_of_comparator =
function
| VGreater v -> "> "^(string_of_version v)
| VEqual v -> "= "^(string_of_version v)
| VLesser v -> "< "^(string_of_version v)
| VGreaterEqual v -> ">= "^(string_of_version v)
| VLesserEqual v -> "<= "^(string_of_version v)
| VOr (c1, c2) ->
(string_of_comparator c1)^" || "^(string_of_comparator c2)
| VAnd (c1, c2) ->
(string_of_comparator c1)^" && "^(string_of_comparator c2)
let rec varname_of_comparator =
let concat p v =
OASISUtils.varname_concat
p
(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)
end
module OASISLicense = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISLicense.ml"
(** License for _oasis fields
@author Sylvain Le Gall
*)
type license = string
type license_exception = string
type license_version =
| Version of OASISVersion.t
| VersionOrLater of OASISVersion.t
| NoVersion
type license_dep_5 =
{
license: license;
exceptions: license_exception list;
version: license_version;
}
type t =
| DEP5License of license_dep_5
| OtherLicense of string (* URL *)
end
module OASISExpr = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISExpr.ml"
open OASISGettext
type test = string
type flag = string
type t =
| EBool of bool
| ENot of t
| EAnd of t * t
| EOr of t * t
| EFlag of flag
| ETest of test * string
type 'a choices = (t * 'a) list
let eval var_get t =
let rec eval' =
function
| EBool b ->
b
| ENot e ->
not (eval' e)
| EAnd (e1, e2) ->
(eval' e1) && (eval' e2)
| EOr (e1, e2) ->
(eval' e1) || (eval' e2)
| EFlag nm ->
let v =
var_get nm
in
assert(v = "true" || v = "false");
(v = "true")
| ETest (nm, vl) ->
let v =
var_get nm
in
(v = vl)
in
eval' t
let choose ?printer ?name var_get lst =
let rec choose_aux =
function
| (cond, vl) :: tl ->
if eval var_get cond then
vl
else
choose_aux tl
| [] ->
let str_lst =
if lst = [] then
s_ "<empty>"
else
String.concat
(s_ ", ")
(List.map
(fun (cond, vl) ->
match printer with
| Some p -> p vl
| None -> s_ "<no printer>")
lst)
in
match name with
| Some nm ->
failwith
(Printf.sprintf
(f_ "No result for the choice list '%s': %s")
nm str_lst)
| None ->
failwith
(Printf.sprintf
(f_ "No result for a choice list: %s")
str_lst)
in
choose_aux (List.rev lst)
end
module OASISTypes = struct
# 21 "/tmp/buildd/oasis-0.2.0/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 prog = string
type arg = string
type args = string list
type command_line = (prog * arg list)
type findlib_name = string
type findlib_full = string
type compiled_object =
| Byte
| Native
| Best
type dependency =
| FindlibPackage of findlib_full * OASISVersion.comparator option
| InternalLibrary of name
type tool =
| ExternalTool of name
| InternalExecutable of name
type vcs =
| Darcs
| Git
| Svn
| Cvs
| Hg
| Bzr
| Arch
| Monotone
| OtherVCS of url
type plugin_kind =
[ `Configure
| `Build
| `Doc
| `Test
| `Install
| `Extra
]
type plugin_data_purpose =
[ `Configure
| `Build
| `Install
| `Clean
| `Distclean
| `Install
| `Uninstall
| `Test
| `Doc
| `Extra
| `Other of string
]
type 'a plugin = 'a * name * OASISVersion.t option
type all_plugin = plugin_kind plugin
type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
# 102 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISTypes.ml"
type 'a conditional = 'a OASISExpr.choices
type custom =
{
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;
}
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;
}
type library =
{
lib_modules: string list;
lib_internal_modules: string list;
lib_findlib_parent: findlib_name option;
lib_findlib_name: findlib_name option;
lib_findlib_containers: findlib_name list;
}
type executable =
{
exec_custom: bool;
exec_main_is: unix_filename;
}
type flag =
{
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;
}
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;
}
type doc_format =
| HTML of unix_filename
| DocText
| PDF
| PostScript
| Info of unix_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;
}
type section =
| Library of common_section * build_section * library
| Executable of common_section * build_section * executable
| Flag of common_section * flag
| SrcRepo of common_section * source_repository
| Test of common_section * test
| Doc of common_section * doc
type package =
{
oasis_version: OASISVersion.t;
ocaml_version: OASISVersion.comparator option;
findlib_version: OASISVersion.comparator option;
name: package_name;
version: OASISVersion.t;
license: OASISLicense.t;
license_file: unix_filename option;
copyrights: string list;
maintainers: string list;
authors: string list;
homepage: url option;
synopsis: string;
description: string option;
categories: url list;
conf_type: [`Configure] plugin;
conf_custom: custom;
build_type: [`Build] plugin;
build_custom: custom;
install_type: [`Install] plugin;
install_custom: custom;
uninstall_custom: custom;
clean_custom: custom;
distclean_custom: custom;
files_ab: unix_filename list;
sections: section list;
plugins: [`Extra] plugin list;
schema_data: PropList.Data.t;
plugin_data: plugin_data;
}
end
module OASISUnixPath = struct
# 21 "/tmp/buildd/oasis-0.2.0/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 concat f1 f2 =
if f1 = current_dir_name then
f2
else if f2 = current_dir_name then
f1
else
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
end
module OASISSection = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISSection.ml"
(** Manipulate section
@author Sylvain Le Gall
*)
open OASISTypes
type section_kind =
| KLibrary
| KExecutable
| KFlag
| KSrcRepo
| KTest
| KDoc
(** Extract generic information
*)
let section_kind_common =
function
| Library (cs, _, _) ->
KLibrary, cs
| Executable (cs, _, _) ->
KExecutable, cs
| Flag (cs, _) ->
KFlag, cs
| SrcRepo (cs, _) ->
KSrcRepo, cs
| Test (cs, _) ->
KTest, cs
| Doc (cs, _) ->
KDoc, cs
(** Common section of a section
*)
let section_common sct =
snd (section_kind_common sct)
(** Key used to identify section
*)
let section_id sct =
let k, cs =
section_kind_common sct
in
k, cs.cs_name
let string_of_section sct =
let k, nm =
section_id sct
in
(match k with
| KLibrary -> "library"
| KExecutable -> "executable"
| KFlag -> "flag"
| KSrcRepo -> "src repository"
| KTest -> "test"
| KDoc -> "doc")
^" "^nm
end
module OASISBuildSection = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISBuildSection.ml"
end
module OASISExecutable = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISExecutable.ml"
open OASISTypes
let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program =
let dir =
OASISUnixPath.concat
bs.bs_path
(OASISUnixPath.dirname exec.exec_main_is)
in
let is_native_exec =
match bs.bs_compiled_object with
| Native -> true
| Best -> is_native ()
| 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^(ext_dll ()))
else
None
end
module OASISLibrary = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISLibrary.ml"
open OASISTypes
open OASISUtils
open OASISGettext
type library_name = name
let generated_unix_files ~ctxt (cs, bs, lib)
source_file_exists is_native ext_lib ext_dll =
(* The headers that should be compiled along *)
let headers =
List.fold_left
(fun hdrs modul ->
try
let base_fn =
List.find
(fun fn ->
source_file_exists (fn^".ml") ||
source_file_exists (fn^".mli") ||
source_file_exists (fn^".mll") ||
source_file_exists (fn^".mly"))
(List.map
(OASISUnixPath.concat bs.bs_path)
[modul;
String.uncapitalize modul;
String.capitalize modul])
in
[base_fn^".cmi"] :: hdrs
with Not_found ->
OASISMessage.warning
~ctxt
(f_ "Cannot find source file matching \
module '%s' in library %s")
modul cs.cs_name;
(List.map (OASISUnixPath.concat bs.bs_path)
[modul^".cmi";
String.uncapitalize modul ^ ".cmi";
String.capitalize modul ^ ".cmi"])
:: hdrs)
[]
lib.lib_modules
in
let acc_nopath =
[]
in
(* Compute what libraries should be built *)
let acc_nopath =
let byte acc =
[cs.cs_name^".cma"] :: acc
in
let native 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
in
(* Add C library to be built *)
let acc_nopath =
if bs.bs_c_sources <> [] then
begin
["lib"^cs.cs_name^(ext_lib ())]
::
["dll"^cs.cs_name^(ext_dll ())]
::
acc_nopath
end
else
acc_nopath
in
(* All the files generated *)
List.rev_append
(List.rev_map
(List.rev_map
(OASISUnixPath.concat bs.bs_path))
acc_nopath)
headers
type group_t =
| Container of findlib_name * (group_t list)
| Package of (findlib_name *
common_section *
build_section *
library *
(group_t list))
let group_libs pkg =
(** Associate a name with its children *)
let children =
List.fold_left
(fun mp ->
function
| Library (cs, bs, lib) ->
begin
match lib.lib_findlib_parent with
| Some p_nm ->
begin
let children =
try
MapString.find p_nm mp
with Not_found ->
[]
in
MapString.add p_nm ((cs, bs, lib) :: children) mp
end
| None ->
mp
end
| _ ->
mp)
MapString.empty
pkg.sections
in
(* Compute findlib name of a single node *)
let findlib_name (cs, _, lib) =
match lib.lib_findlib_name with
| Some nm -> nm
| None -> cs.cs_name
in
(** Build a package tree *)
let rec tree_of_library containers ((cs, bs, lib) as acc) =
match containers with
| hd :: tl ->
Container (hd, [tree_of_library tl acc])
| [] ->
(* TODO: allow merging containers with the same
* name
*)
Package
(findlib_name acc, cs, bs, lib,
(try
List.rev_map
(fun ((_, _, child_lib) as child_acc) ->
tree_of_library
child_lib.lib_findlib_containers
child_acc)
(MapString.find cs.cs_name children)
with Not_found ->
[]))
in
(* TODO: check that libraries are unique *)
List.fold_left
(fun acc ->
function
| Library (cs, bs, lib) when lib.lib_findlib_parent = None ->
(tree_of_library lib.lib_findlib_containers (cs, bs, lib)) :: acc
| _ ->
acc)
[]
pkg.sections
(** Compute internal to findlib library matchings, including subpackage
and return a map of it.
*)
let findlib_name_map pkg =
(* Compute names in a tree *)
let rec findlib_names_aux path mp grp =
let fndlb_nm, children, mp =
match grp with
| Container (fndlb_nm, children) ->
fndlb_nm, children, mp
| Package (fndlb_nm, {cs_name = nm}, _, _, children) ->
fndlb_nm, children, (MapString.add nm (path, fndlb_nm) mp)
in
let fndlb_nm_full =
(match path with
| Some pth -> pth^"."
| None -> "")^
fndlb_nm
in
List.fold_left
(findlib_names_aux (Some fndlb_nm_full))
mp
children
in
List.fold_left
(findlib_names_aux None)
MapString.empty
(group_libs pkg)
let findlib_of_name ?(recurse=false) map nm =
try
let (path, fndlb_nm) =
MapString.find nm map
in
match path with
| Some pth when recurse -> pth^"."^fndlb_nm
| _ -> fndlb_nm
with Not_found ->
failwithf1
(f_ "Unable to translate internal library '%s' to findlib name")
nm
let name_findlib_map pkg =
let mp =
findlib_name_map pkg
in
MapString.fold
(fun nm _ acc ->
let fndlb_nm_full =
findlib_of_name
~recurse:true
mp
nm
in
MapString.add fndlb_nm_full nm acc)
mp
MapString.empty
let findlib_of_group =
function
| Container (fndlb_nm, _)
| Package (fndlb_nm, _, _, _, _) -> fndlb_nm
let root_of_group grp =
let rec root_lib_aux =
function
| Container (_, children) ->
root_lib_lst children
| Package (_, cs, bs, lib, children) ->
if lib.lib_findlib_parent = None then
cs, bs, lib
else
root_lib_lst children
and root_lib_lst =
function
| [] ->
raise Not_found
| hd :: tl ->
try
root_lib_aux hd
with Not_found ->
root_lib_lst tl
in
try
root_lib_aux grp
with Not_found ->
failwithf1
(f_ "Unable to determine root library of findlib library '%s'")
(findlib_of_group grp)
end
module OASISFlag = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISFlag.ml"
end
module OASISPackage = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISPackage.ml"
end
module OASISSourceRepository = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISSourceRepository.ml"
end
module OASISTest = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISTest.ml"
end
module OASISDocument = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISDocument.ml"
end
module BaseEnvLight = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseEnvLight.ml"
module MapString = Map.Make(String)
type t = string MapString.t
let default_filename =
Filename.concat
(Sys.getcwd ())
"setup.data"
let load ?(allow_empty=false) ?(filename=default_filename) () =
if Sys.file_exists filename then
begin
let chn =
open_in_bin filename
in
let st =
Stream.of_channel chn
in
let line =
ref 1
in
let st_line =
Stream.from
(fun _ ->
try
match Stream.next st with
| '\n' -> incr line; Some '\n'
| c -> Some c
with Stream.Failure -> None)
in
let lexer =
Genlex.make_lexer ["="] st_line
in
let rec read_file mp =
match Stream.npeek 3 lexer with
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
Stream.junk lexer;
Stream.junk lexer;
Stream.junk lexer;
read_file (MapString.add nm value mp)
| [] ->
mp
| _ ->
failwith
(Printf.sprintf
"Malformed data file '%s' line %d"
filename !line)
in
let mp =
read_file MapString.empty
in
close_in chn;
mp
end
else if allow_empty then
begin
MapString.empty
end
else
begin
failwith
(Printf.sprintf
"Unable to load environment, the file '%s' doesn't exist."
filename)
end
let var_get name env =
let rec var_expand str =
let buff =
Buffer.create ((String.length str) * 2)
in
Buffer.add_substitute
buff
(fun var ->
try
var_expand (MapString.find var env)
with Not_found ->
failwith
(Printf.sprintf
"No variable %s defined when trying to expand %S."
var
str))
str;
Buffer.contents buff
in
var_expand (MapString.find name env)
let var_choose lst env =
OASISExpr.choose
(fun nm -> var_get nm env)
lst
end
module BaseContext = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseContext.ml"
open OASISContext
let args = args
let default = default
end
module BaseMessage = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseMessage.ml"
(** Message to user, overrid for Base
@author Sylvain Le Gall
*)
open OASISMessage
open BaseContext
let debug fmt = debug ~ctxt:!default fmt
let info fmt = info ~ctxt:!default fmt
let warning fmt = warning ~ctxt:!default fmt
let error fmt = error ~ctxt:!default fmt
let string_of_exception = string_of_exception
end
module BaseFilePath = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseFilePath.ml"
open Filename
module Unix = OASISUnixPath
let make =
function
| [] ->
invalid_arg "BaseFilename.make"
| hd :: tl ->
List.fold_left Filename.concat hd tl
let of_unix ufn =
if Sys.os_type = "Unix" then
ufn
else
make
(List.map
(fun p ->
if p = Unix.current_dir_name then
current_dir_name
else if p = Unix.parent_dir_name then
parent_dir_name
else
p)
(OASISUtils.split '/' ufn))
end
module BaseEnv = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseEnv.ml"
open OASISTypes
open OASISGettext
open OASISUtils
open PropList
module MapString = BaseEnvLight.MapString
type origin_t =
| ODefault
| OGetEnv
| OFileLoad
| OCommandLine
type cli_handle_t =
| CLINone
| CLIAuto
| CLIWith
| CLIEnable
| CLIUser of (Arg.key * Arg.spec * Arg.doc) list
type definition_t =
{
hide: bool;
dump: bool;
cli: cli_handle_t;
arg_help: string option;
group: string option;
}
let schema =
Schema.create "environment"
(* Environment data *)
let env =
Data.create ()
(* Environment data from file *)
let env_from_file =
ref MapString.empty
(* Lexer for var *)
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] ->
BaseFilePath.of_unix (var_get nm)
| [Genlex.Ident "utoh"; Genlex.String s] ->
BaseFilePath.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
| _ ->
failwithf2
(f_ "Unknown expression '%s' in variable expansion of %s.")
var
str
with
| Unknown_field (_, _) ->
failwithf2
(f_ "No variable %s defined when trying to expand %S.")
var
str
| Stream.Error e ->
failwithf3
(f_ "Syntax error when parsing '%s' when trying to \
expand %S: %s")
var
str
e)
str;
Buffer.contents buff
and var_get name =
let vl =
try
Schema.get schema env name
with Unknown_field _ as e ->
begin
try
MapString.find name !env_from_file
with Not_found ->
raise e
end
in
var_expand vl
let var_choose ?printer ?name lst =
OASISExpr.choose
?printer
?name
var_get
lst
let var_protect vl =
let buff =
Buffer.create (String.length vl)
in
String.iter
(function
| '$' -> Buffer.add_string buff "\\$"
| c -> Buffer.add_char buff c)
vl;
Buffer.contents buff
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 =
let default =
[
OFileLoad, lazy (MapString.find name !env_from_file);
ODefault, dflt;
OGetEnv, lazy (Sys.getenv name);
]
in
let extra =
{
hide = hide;
dump = dump;
cli = cli;
arg_help = arg_help;
group = group;
}
in
(* Try to find a value that can be defined
*)
let var_get_low lst =
let errors, res =
List.fold_left
(fun (errors, res) (_, v) ->
if res = None then
begin
try
errors, Some (Lazy.force v)
with
| Not_found ->
errors, res
| Failure rsn ->
(rsn :: errors), res
| e ->
(Printexc.to_string e) :: errors, res
end
else
errors, res)
([], None)
(List.sort
(fun (o1, _) (o2, _) ->
if o1 < o2 then
1
else if o1 = o2 then
0
else
-1)
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)))
in
let help =
match short_desc with
| Some fs -> Some fs
| None -> None
in
let var_get_lst =
FieldRO.create
~schema
~name
~parse:(fun ?(context=ODefault) s -> [context, lazy s])
~print:var_get_low
~default
~update:(fun ?context x old_x -> x @ old_x)
?help
extra
in
fun () ->
var_expand (var_get_low (var_get_lst env))
let var_redefine
?hide
?dump
?short_desc
?cli
?arg_help
?group
name
dflt =
if Schema.mem schema name then
begin
Schema.set schema env ~context:ODefault name (Lazy.force dflt);
fun () -> var_get name
end
else
begin
var_define
?hide
?dump
?short_desc
?cli
?arg_help
?group
name
dflt
end
let var_ignore (e : unit -> string) =
()
let print_hidden =
var_define
~hide:true
~dump:false
~cli:CLIAuto
~arg_help:"Print even non-printable variable. (debug)"
"print_hidden"
(lazy "false")
let var_all () =
List.rev
(Schema.fold
(fun acc nm def _ ->
if not def.hide || bool_of_string (print_hidden ()) then
nm :: acc
else
acc)
[]
schema)
let default_filename =
BaseEnvLight.default_filename
let load ?allow_empty ?filename () =
env_from_file := BaseEnvLight.load ?allow_empty ?filename ()
let unload () =
(* TODO: reset lazy values *)
env_from_file := MapString.empty;
Data.clear env
let dump ?(filename=default_filename) () =
let chn =
open_out_bin filename
in
Schema.iter
(fun nm def _ ->
if def.dump then
begin
try
let value =
Schema.get
schema
env
nm
in
Printf.fprintf chn "%s = %S\n" nm value
with Not_set _ ->
()
end)
schema;
close_out chn
let print () =
let printable_vars =
Schema.fold
(fun acc nm def short_descr_opt ->
if not def.hide || bool_of_string (print_hidden ()) then
begin
try
let value =
Schema.get
schema
env
nm
in
let txt =
match short_descr_opt with
| Some s -> s ()
| None -> nm
in
(txt, value) :: acc
with Not_set _ ->
acc
end
else
acc)
[]
schema
in
let max_length =
List.fold_left max 0
(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
print_newline ();
print_endline "Configuration: ";
print_newline ();
List.iter
(fun (name,value) ->
Printf.printf "%s: %s %s\n" name (dot_pad name) value)
printable_vars;
Printf.printf "%!";
print_newline ()
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.";
]
@
List.flatten
(Schema.fold
(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 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 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 ->
[
arg_concat "--enable-" arg_name,
Arg.Unit (fun () -> var_set "true"),
Printf.sprintf (f_ " %s%s") hlp
(if default_value = " [true]" then
(s_ " [default]")
else
"");
arg_concat "--disable-" arg_name,
Arg.Unit (fun () -> var_set "false"),
Printf.sprintf (f_ " %s%s") hlp
(if default_value = " [false]" then
(s_ " [default]")
else
"");
]
| CLIUser lst ->
lst
in
args :: acc)
[]
schema)
end
module BaseExec = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseExec.ml"
open OASISGettext
open OASISUtils
open BaseMessage
let run ?f_exit_code cmd args =
let cmdline =
String.concat " " (cmd :: args)
in
info (f_ "Running command '%s'") cmdline;
match f_exit_code, Sys.command cmdline with
| None, 0 -> ()
| None, i ->
failwithf2
(f_ "Command '%s' terminated with error code %d")
cmdline i
| Some f, i ->
f i
let run_read_output cmd args =
let fn =
Filename.temp_file "oasis-" ".txt"
in
let () =
try
run cmd (args @ [">"; Filename.quote fn])
with e ->
Sys.remove fn;
raise e
in
let chn =
open_in fn
in
let routput =
ref []
in
(
try
while true do
routput := (input_line chn) :: !routput
done
with End_of_file ->
()
);
close_in chn;
Sys.remove fn;
List.rev !routput
let run_read_one_line cmd args =
match run_read_output cmd args with
| [fst] ->
fst
| lst ->
failwithf1
(f_ "Command return unexpected output %S")
(String.concat "\n" lst)
end
module BaseFileUtil = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseFileUtil.ml"
open OASISGettext
let find_file paths exts =
(* Cardinal product of two list *)
let ( * ) lst1 lst2 =
List.flatten
(List.map
(fun a ->
List.map
(fun b -> a,b)
lst2)
lst1)
in
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)
| [e] ->
e
| [] ->
[]
in
let alternatives =
List.map
(fun (p,e) ->
if String.length e > 0 && e.[0] <> '.' then
p ^ "." ^ e
else
p ^ e)
((combined_paths paths) * exts)
in
List.find
Sys.file_exists
alternatives
let which prg =
let path_sep =
match Sys.os_type with
| "Win32" ->
';'
| _ ->
':'
in
let path_lst =
OASISUtils.split
path_sep
(Sys.getenv "PATH")
in
let exec_ext =
match Sys.os_type with
| "Win32" ->
""
::
(OASISUtils.split
path_sep
(Sys.getenv "PATHEXT"))
| _ ->
[""]
in
find_file [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
let q = Filename.quote
(**/**)
let cp src tgt =
BaseExec.run
(match Sys.os_type with
| "Win32" -> "copy"
| _ -> "cp")
[q src; q tgt]
let mkdir tgt =
BaseExec.run
(match Sys.os_type with
| "Win32" -> "md"
| _ -> "mkdir")
[q tgt]
let rec mkdir_parent f tgt =
let tgt =
fix_dir tgt
in
if Sys.file_exists tgt then
begin
if not (Sys.is_directory tgt) then
OASISUtils.failwithf1
(f_ "Cannot create directory '%s', a file of the same name already \
exists")
tgt
end
else
begin
mkdir_parent f (Filename.dirname tgt);
if not (Sys.file_exists tgt) then
begin
f tgt;
mkdir tgt
end
end
let rmdir tgt =
if Sys.readdir tgt = [||] then
begin
match Sys.os_type with
| "Win32" ->
BaseExec.run "rd" [q tgt]
| _ ->
BaseExec.run "rm" ["-r"; q tgt]
end
let glob 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 Sys.file_exists fn then
[fn]
else
[]
end
end
module BaseArgExt = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseArgExt.ml"
open OASISUtils
open OASISGettext
let parse argv args =
(* Simulate command line for Arg *)
let current =
ref 0
in
try
Arg.parse_argv
~current:current
(Array.concat [[|"none"|]; argv])
(Arg.align args)
(failwithf1 (f_ "Don't know what to do with arguments: '%s'"))
(s_ "configure options:")
with
| Arg.Help txt ->
print_endline txt;
exit 0
| Arg.Bad txt ->
prerr_endline txt;
exit 1
end
module BaseCheck = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseCheck.ml"
open BaseEnv
open BaseMessage
open OASISUtils
open OASISGettext
let prog_best prg prg_lst =
var_redefine
prg
(lazy
(let alternate =
List.fold_left
(fun res e ->
match res with
| Some _ ->
res
| None ->
try
Some (BaseFileUtil.which e)
with Not_found ->
None)
None
prg_lst
in
match alternate with
| Some prg -> prg
| None -> raise Not_found))
let prog prg =
prog_best prg [prg]
let prog_opt prg =
prog_best prg [prg^".opt"; prg]
let ocamlfind =
prog "ocamlfind"
let version
var_prefix
cmp
fversion
() =
(* Really compare version provided *)
let var =
var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp)
in
var_redefine
~hide:true
var
(lazy
(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
failwithf3
(f_ "Cannot satisfy version constraint on %s: %s (version: %s)")
var_prefix
(OASISVersion.string_of_comparator cmp)
version_str))
()
let package_version pkg =
BaseExec.run_read_one_line
(ocamlfind ())
["query"; "-format"; "%v"; pkg]
let package ?version_comparator pkg () =
let var =
OASISUtils.varname_concat
"pkg_"
(OASISUtils.varname_of_string pkg)
in
let findlib_dir pkg =
let dir =
BaseExec.run_read_one_line
(ocamlfind ())
["query"; "-format"; "%d"; pkg]
in
if Sys.file_exists dir && Sys.is_directory dir then
dir
else
failwithf2
(f_ "When looking for findlib package %s, \
directory %s return doesn't exist")
pkg dir
in
let vl =
var_redefine
var
(lazy (findlib_dir pkg))
()
in
(
match version_comparator with
| Some ver_cmp ->
ignore
(version
var
ver_cmp
(fun _ -> package_version pkg)
())
| None ->
()
);
vl
end
module BaseOCamlcConfig = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseOCamlcConfig.ml"
open BaseEnv
open OASISUtils
open OASISGettext
module SMap = Map.Make(String)
let ocamlc =
BaseCheck.prog_opt "ocamlc"
let ocamlc_config_map =
(* Map name to value for ocamlc -config output
(name ^": "^value)
*)
let rec split_field mp lst =
match lst with
| line :: tl ->
let mp =
try
let pos_semicolon =
String.index line ':'
in
if pos_semicolon > 1 then
(
let name =
String.sub line 0 pos_semicolon
in
let linelen =
String.length line
in
let value =
if linelen > pos_semicolon + 2 then
String.sub
line
(pos_semicolon + 2)
(linelen - pos_semicolon - 2)
else
""
in
SMap.add name value mp
)
else
(
mp
)
with Not_found ->
(
mp
)
in
split_field mp tl
| [] ->
mp
in
var_redefine
"ocamlc_config_map"
~hide:true
~dump:false
(lazy
(var_protect
(Marshal.to_string
(split_field
SMap.empty
(BaseExec.run_read_output
(ocamlc ()) ["-config"]))
[])))
let var_define nm =
(* Extract data from ocamlc -config *)
let avlbl_config_get () =
Marshal.from_string
(ocamlc_config_map ())
0
in
let nm_config =
match nm with
| "ocaml_version" -> "version"
| _ -> nm
in
var_redefine
nm
(lazy
(try
let map =
avlbl_config_get ()
in
let value =
SMap.find nm_config map
in
value
with Not_found ->
failwithf2
(f_ "Cannot find field '%s' in '%s -config' output")
nm
(ocamlc ())))
end
module BaseStandardVar = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseStandardVar.ml"
open OASISGettext
open OASISTypes
open OASISExpr
open BaseCheck
open BaseEnv
let ocamlfind = BaseCheck.ocamlfind
let ocamlc = BaseOCamlcConfig.ocamlc
let ocamlopt = prog_opt "ocamlopt"
let ocamlbuild = prog "ocamlbuild"
(**/**)
let rpkg =
ref None
let pkg_get () =
match !rpkg with
| Some pkg -> pkg
| None -> failwith (s_ "OASIS Package is not set")
(**/**)
let pkg_name =
var_define
~short_desc:(fun () -> s_ "Package name")
"pkg_name"
(lazy (pkg_get ()).name)
let pkg_version =
var_define
~short_desc:(fun () -> s_ "Package version")
"pkg_version"
(lazy
(OASISVersion.string_of_version (pkg_get ()).version))
let c = BaseOCamlcConfig.var_define
let os_type = c "os_type"
let system = c "system"
let architecture = c "architecture"
let ccomp_type = c "ccomp_type"
let ocaml_version = c "ocaml_version"
(* TODO: Check standard variable presence at runtime *)
let standard_library_default = c "standard_library_default"
let standard_library = c "standard_library"
let standard_runtime = c "standard_runtime"
let bytecomp_c_compiler = c "bytecomp_c_compiler"
let native_c_compiler = c "native_c_compiler"
let model = c "model"
let ext_obj = c "ext_obj"
let ext_asm = c "ext_asm"
let ext_lib = c "ext_lib"
let ext_dll = c "ext_dll"
let default_executable_name = c "default_executable_name"
let systhread_supported = c "systhread_supported"
(**/**)
let p name hlp dflt =
var_define
~short_desc:hlp
~cli:CLIAuto
~arg_help:"dir"
name
dflt
let (/) a b =
if os_type () = Sys.os_type then
Filename.concat a b
else if os_type () = "Unix" then
BaseFilePath.Unix.concat a b
else
OASISUtils.failwithf1
(f_ "Cannot handle os_type %s filename concat")
(os_type ())
(**/**)
let prefix =
p "prefix"
(fun () -> s_ "Install architecture-independent files dir")
(lazy
(match os_type () with
| "Win32" ->
let program_files =
Sys.getenv "PROGRAMFILES"
in
program_files/(pkg_name ())
| _ ->
"/usr/local"))
let exec_prefix =
p "exec_prefix"
(fun () -> s_ "Install architecture-dependent files in dir")
(lazy "$prefix")
let bindir =
p "bindir"
(fun () -> s_ "User executables")
(lazy ("$exec_prefix"/"bin"))
let sbindir =
p "sbindir"
(fun () -> s_ "System admin executables")
(lazy ("$exec_prefix"/"sbin"))
let libexecdir =
p "libexecdir"
(fun () -> s_ "Program executables")
(lazy ("$exec_prefix"/"libexec"))
let sysconfdir =
p "sysconfdir"
(fun () -> s_ "Read-only single-machine data")
(lazy ("$prefix"/"etc"))
let sharedstatedir =
p "sharedstatedir"
(fun () -> s_ "Modifiable architecture-independent data")
(lazy ("$prefix"/"com"))
let localstatedir =
p "localstatedir"
(fun () -> s_ "Modifiable single-machine data")
(lazy ("$prefix"/"var"))
let libdir =
p "libdir"
(fun () -> s_ "Object code libraries")
(lazy ("$exec_prefix"/"lib"))
let datarootdir =
p "datarootdir"
(fun () -> s_ "Read-only arch-independent data root")
(lazy ("$prefix"/"share"))
let datadir =
p "datadir"
(fun () -> s_ "Read-only architecture-independent data")
(lazy ("$datarootdir"))
let infodir =
p "infodir"
(fun () -> s_ "Info documentation")
(lazy ("$datarootdir"/"info"))
let localedir =
p "localedir"
(fun () -> s_ "Locale-dependent data")
(lazy ("$datarootdir"/"locale"))
let mandir =
p "mandir"
(fun () -> s_ "Man documentation")
(lazy ("$datarootdir"/"man"))
let docdir =
p "docdir"
(fun () -> s_ "Documentation root")
(lazy ("$datarootdir"/"doc"/"$pkg_name"))
let htmldir =
p "htmldir"
(fun () -> s_ "HTML documentation")
(lazy ("$docdir"))
let dvidir =
p "dvidir"
(fun () -> s_ "DVI documentation")
(lazy ("$docdir"))
let pdfdir =
p "pdfdir"
(fun () -> s_ "PDF documentation")
(lazy ("$docdir"))
let psdir =
p "psdir"
(fun () -> s_ "PS documentation")
(lazy ("$docdir"))
let destdir =
p "destdir"
(fun () -> s_ "Prepend a path when installing package")
(lazy
(raise
(PropList.Not_set
("destdir",
Some (s_ "undefined by construct")))))
let findlib_version =
var_define
"findlib_version"
(lazy
(BaseCheck.package_version "findlib"))
let is_native =
var_define
"is_native"
(lazy
(try
let _s : string =
ocamlopt ()
in
"true"
with PropList.Not_set _ ->
let _s : string =
ocamlc ()
in
"false"))
let ext_program =
var_define
"suffix_program"
(lazy
(match os_type () with
| "Win32" -> ".exe"
| _ -> ""
))
let rm =
var_define
~short_desc:(fun () -> s_ "Remove a file.")
"rm"
(lazy
(match os_type () with
| "Win32" -> "del"
| _ -> "rm -f"))
let rmdir =
var_define
~short_desc:(fun () -> s_ "Remove a directory.")
"rmdir"
(lazy
(match os_type () with
| "Win32" -> "rd"
| _ -> "rm -rf"))
let debug =
var_define
~short_desc:(fun () -> s_ "Compile with ocaml debug flag on.")
"debug"
(lazy "true")
let profile =
var_define
~short_desc:(fun () -> s_ "Compile with ocaml profile flag on.")
"profile"
(lazy "false")
let init pkg =
rpkg := Some pkg
end
module BaseFileAB = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseFileAB.ml"
open BaseEnv
open OASISGettext
open BaseMessage
let to_filename fn =
let fn =
BaseFilePath.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
let replace fn_lst =
let buff =
Buffer.create 13
in
List.iter
(fun fn ->
let fn =
BaseFilePath.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
end
module BaseLog = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseLog.ml"
open OASISUtils
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 load () =
if Sys.file_exists default_filename then
begin
let chn =
open_in default_filename
in
let scbuf =
Scanf.Scanning.from_file default_filename
in
let rec read_aux (st, lst) =
if not (Scanf.Scanning.end_of_input scbuf) then
begin
let acc =
try
Scanf.bscanf scbuf "%S %S@\n"
(fun e d ->
let t =
e, d
in
if SetTupleString.mem t st then
st, lst
else
SetTupleString.add t st,
t :: lst)
with Scanf.Scan_failure _ ->
failwith
(Scanf.bscanf scbuf
"%l"
(fun line ->
Printf.sprintf
"Malformed log file '%s' at line %d"
default_filename
line))
in
read_aux acc
end
else
begin
close_in chn;
List.rev lst
end
in
read_aux (SetTupleString.empty, [])
end
else
begin
[]
end
let register event data =
let chn_out =
open_out_gen [Open_append; Open_creat; Open_text] 0o644 default_filename
in
Printf.fprintf chn_out "%S %S\n" event data;
close_out chn_out
let unregister event data =
if Sys.file_exists default_filename then
begin
let lst =
load ()
in
let chn_out =
open_out default_filename
in
let write_something =
ref false
in
List.iter
(fun (e, d) ->
if e <> event || d <> data then
begin
write_something := true;
Printf.fprintf chn_out "%S %S\n" e d
end)
lst;
close_out chn_out;
if not !write_something then
Sys.remove default_filename
end
let filter events =
let st_events =
List.fold_left
(fun st e ->
SetString.add e st)
SetString.empty
events
in
List.filter
(fun (e, _) -> SetString.mem e st_events)
(load ())
let exists event data =
List.exists
(fun v -> (event, data) = v)
(load ())
end
module BaseBuilt = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseBuilt.ml"
open OASISTypes
open OASISGettext
open BaseStandardVar
open BaseMessage
type t =
| BExec (* Executable *)
| BExecLib (* Library coming with executable *)
| BLib (* Library *)
| BDoc (* Document *)
let to_log_event_file t nm =
"built_"^
(match t with
| BExec -> "exec"
| BExecLib -> "exec_lib"
| BLib -> "lib"
| 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";
List.iter
(fun alt ->
let registered =
List.fold_left
(fun registered fn ->
if Sys.file_exists 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)
false
alt
in
if not registered then
warning
(f_ "Cannot find an existing alternative files among: %s")
(String.concat (s_ ", ") alt))
lst
let unregister 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])
let fold t nm f acc =
List.fold_left
(fun acc (_, fn) ->
if Sys.file_exists fn then
begin
f acc fn
end
else
begin
warning
(f_ "File '%s' has been marked as built \
for %s but doesn't exist")
fn
(Printf.sprintf
(match t with
| BExec | BExecLib ->
(f_ "executable %s")
| BLib ->
(f_ "library %s")
| BDoc ->
(f_ "documentation %s"))
nm);
acc
end)
acc
(BaseLog.filter
[to_log_event_file t nm])
let is_built t nm =
List.fold_left
(fun is_built (_, d) ->
(try
bool_of_string d
with _ ->
false))
false
(BaseLog.filter
[to_log_event_done t nm])
let of_executable ffn (cs, bs, exec) =
let unix_exec_is, unix_dll_opt =
OASISExecutable.unix_exec_is
(cs, bs, exec)
(fun () ->
bool_of_string
(is_native ()))
ext_dll
ext_program
in
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
let of_library ffn (cs, bs, lib) =
let unix_lst =
OASISLibrary.generated_unix_files
~ctxt:!BaseContext.default
(cs, bs, lib)
(fun fn ->
Sys.file_exists (BaseFilePath.of_unix fn))
(fun () ->
bool_of_string (is_native ()))
ext_lib
ext_dll
in
let evs =
[BLib,
cs.cs_name,
List.map (List.map ffn) unix_lst]
in
evs, unix_lst
end
module BaseCustom = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseCustom.ml"
open BaseEnv
open BaseMessage
open OASISTypes
open OASISGettext
let run cmd args extra_args =
BaseExec.run
(var_expand cmd)
(List.map
var_expand
(args @ (Array.to_list extra_args)))
let hook ?(failsafe=false) cstm f e =
let optional_command lst =
let printer =
function
| 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 ->
()
in
let res =
optional_command cstm.pre_command;
f e
in
optional_command cstm.post_command;
res
end
module BaseDynVar = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseDynVar.ml"
open OASISTypes
open OASISGettext
open BaseEnv
open BaseBuilt
let init pkg =
List.iter
(function
| Executable (cs, bs, exec) ->
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)
cs.cs_name
(lazy
(let fn_opt =
fold
BExec cs.cs_name
(fun _ fn -> Some fn)
None
in
match fn_opt with
| Some fn -> fn
| None ->
raise
(PropList.Not_set
(cs.cs_name,
Some (Printf.sprintf
(f_ "Executable '%s' not yet built.")
cs.cs_name))))))
| Library _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
())
pkg.sections
end
module BaseTest = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseTest.ml"
open BaseEnv
open BaseMessage
open OASISTypes
open OASISExpr
open OASISGettext
let test 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
begin
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
| None ->
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
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)
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
end
module BaseDoc = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseDoc.ml"
open BaseEnv
open BaseMessage
open OASISTypes
open OASISGettext
let doc 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
begin
info (f_ "Building documentation '%s'") cs.cs_name;
BaseCustom.hook
doc.doc_custom
(doc_plugin pkg (cs, doc))
extra_args
end
in
List.iter
one_doc
lst
end
module BaseSetup = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseSetup.ml"
open BaseEnv
open BaseMessage
open OASISTypes
open OASISSection
open OASISGettext
open OASISUtils
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;
version: string;
}
(* Associate a plugin function with data from package *)
let join_plugin_sections filter_map lst =
List.rev
(List.fold_left
(fun acc sct ->
match filter_map sct with
| Some e ->
e :: acc
| None ->
acc)
[]
lst)
(* Search for plugin data associated with a section name *)
let lookup_plugin_section plugin action nm lst =
try
List.assoc nm lst
with Not_found ->
failwithf3
(f_ "Cannot find plugin %s matching section %s for %s action")
plugin
nm
action
let configure t args =
(* Run configure *)
BaseCustom.hook
t.package.conf_custom
(t.configure t.package)
args;
(* Reload environment *)
unload ();
load ();
(* Replace data in file *)
BaseFileAB.replace t.package.files_ab
let build t args =
BaseCustom.hook
t.package.build_custom
(t.build t.package)
args
let doc t args =
BaseDoc.doc
(join_plugin_sections
(function
| 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 =
BaseTest.test
(join_plugin_sections
(function
| Test (cs, e) ->
Some
(lookup_plugin_section
"test"
(s_ "run")
cs.cs_name
t.test,
cs,
e)
| _ ->
None)
t.package.sections)
t.package
args
let all t args =
let rno_doc =
ref false
in
let rno_test =
ref false
in
Arg.parse_argv
~current:(ref 0)
(Array.of_list
((Sys.executable_name^" all") ::
(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";
]
(failwithf1 (f_ "Don't know what to do with '%s'"))
"";
info "Running configure step";
configure t [||];
info "Running build step";
build t [||];
(* Load setup.log dynamic variables *)
BaseDynVar.init t.package;
if not !rno_doc then
begin
info "Running doc step";
doc t [||];
end
else
begin
info "Skipping doc step"
end;
if not !rno_test then
begin
info "Running test step";
test t [||]
end
else
begin
info "Skipping test step"
end
let install t args =
BaseCustom.hook
t.package.install_custom
(t.install t.package)
args
let uninstall t args =
BaseCustom.hook
t.package.uninstall_custom
(t.uninstall t.package)
args
let reinstall t args =
uninstall t args;
install t args
let clean, distclean =
let failsafe f a =
try
f a
with e ->
warning
(f_ "Action fail with error: %s")
(match e with
| Failure msg -> msg
| e -> Printexc.to_string e)
in
let generic_clean t cstm mains docs tests args =
BaseCustom.hook
~failsafe:true
cstm
(fun () ->
(* Clean section *)
List.iter
(function
| Test (cs, test) ->
let f =
try
List.assoc cs.cs_name tests
with Not_found ->
fun _ _ _ -> ()
in
failsafe
(f t.package (cs, test))
args
| Doc (cs, doc) ->
let f =
try
List.assoc cs.cs_name docs
with Not_found ->
fun _ _ _ -> ()
in
failsafe
(f t.package (cs, doc))
args
| Library _
| Executable _
| Flag _
| SrcRepo _ ->
())
t.package.sections;
(* Clean whole package *)
List.iter
(fun f ->
failsafe
(f t.package)
args)
mains)
()
in
let clean t args =
generic_clean
t
t.package.clean_custom
t.clean
t.clean_doc
t.clean_test
args
in
let distclean t args =
(* Call clean *)
clean t args;
(* Remove generated file *)
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));
(* Call distclean code *)
generic_clean
t
t.package.distclean_custom
t.distclean
t.distclean_doc
t.distclean_test
args
in
clean, distclean
let version t _ =
print_endline t.version
let setup t =
let catch_exn =
ref true
in
try
let act_ref =
ref (fun _ ->
failwithf2
(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
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.";
]
@ (BaseContext.args ()))
(failwithf1 (f_ "Don't know what to do with '%s'"))
(s_ "Setup and run build process current package\n");
(* Build initial environment *)
load ~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)
(lazy (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;
BaseDynVar.init t.package;
!act_ref t (Array.of_list (List.rev !extra_args_ref))
with e when !catch_exn ->
error "%s" (string_of_exception e);
exit 1
end
module BaseDev = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/base/BaseDev.ml"
open OASISGettext
open BaseMessage
type t =
{
oasis_cmd: string;
}
let update_and_run t =
(* Command line to run setup-dev *)
let oasis_args =
"setup-dev" :: "-run" ::
Sys.executable_name ::
(Array.to_list Sys.argv)
in
let exit_on_child_error =
function
| 0 -> ()
| 2 ->
(* Bad CLI arguments *)
error
(f_ "The command '%s %s' exit with code 2. It often means that we \
don't use the right command-line arguments, rerun \
'oasis setup-dev'.")
t.oasis_cmd
(String.concat " " oasis_args)
| 127 ->
(* Cannot find OASIS *)
error
(f_ "Cannot find executable '%s', check where 'oasis' is located \
and rerun 'oasis setup-dev'")
t.oasis_cmd
| i ->
exit i
in
let () =
(* Run OASIS to generate a temporary setup.ml
*)
BaseExec.run
~f_exit_code:exit_on_child_error
t.oasis_cmd
oasis_args
in
()
end
module InternalConfigurePlugin = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/plugins/internal/InternalConfigurePlugin.ml"
(** Configure using internal scheme
@author Sylvain Le Gall
*)
open BaseEnv
open OASISTypes
open OASISUtils
open OASISGettext
open BaseMessage
(** Configure build using provided series of check to be done
* and then output corresponding file.
*)
let configure pkg argv =
let var_ignore_eval var =
let _s : string =
var ()
in
()
in
let errors =
ref SetString.empty
in
let buff =
Buffer.create 13
in
let add_errors fmt =
Printf.kbprintf
(fun b ->
errors := SetString.add (Buffer.contents b) !errors;
Buffer.clear b)
buff
fmt
in
let warn_exception e =
warning "%s" (string_of_exception e)
in
(* Check tools *)
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)
lst
in
let build_checks sct bs =
if var_choose bs.bs_build then
begin
if bs.bs_compiled_object = Native then
begin
try
var_ignore_eval BaseStandardVar.ocamlopt
with e ->
warn_exception e;
add_errors
(f_ "Section %s requires native compilation")
(OASISSection.string_of_section sct)
end;
(* Check tools *)
check_tools bs.bs_build_tools;
(* 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)
bs.bs_build_depends
end
in
(* Parse command line *)
BaseArgExt.parse argv (BaseEnv.args ());
(* OCaml version *)
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
| 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
| None ->
()
end;
(* 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
| _ ->
())
pkg.sections;
(* Save and print environment *)
if SetString.empty = !errors then
begin
dump ();
print ()
end
else
begin
List.iter
(fun e -> error "%s" e)
(SetString.elements !errors);
failwithf1
(fn_
"%d configuration error"
"%d configuration errors"
(SetString.cardinal !errors))
(SetString.cardinal !errors)
end
end
module InternalInstallPlugin = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/plugins/internal/InternalInstallPlugin.ml"
(** Install using internal scheme
@author Sylvain Le Gall
*)
open BaseEnv
open BaseStandardVar
open BaseMessage
open OASISTypes
open OASISLibrary
open OASISGettext
open OASISUtils
let exec_hook =
ref (fun (cs, bs, exec) -> cs, bs, exec)
let lib_hook =
ref (fun (cs, bs, lib) -> cs, bs, lib, [])
let doc_hook =
ref (fun (cs, doc) -> cs, doc)
let install_file_ev =
"install-file"
let install_dir_ev =
"install-dir"
let install_findlib_ev =
"install-findlib"
let install pkg argv =
let in_destdir =
try
let destdir =
destdir ()
in
(* Practically speaking destdir is prepended
* at the beginning of the target filename
*)
fun fn -> destdir^fn
with PropList.Not_set _ ->
fun fn -> fn
in
let install_file src_file envdir =
let tgt_dir =
in_destdir (envdir ())
in
let tgt_file =
Filename.concat
tgt_dir
(Filename.basename src_file)
in
(* Create target directory if needed *)
BaseFileUtil.mkdir_parent
(fun dn ->
info (f_ "Creating directory '%s'") dn;
BaseLog.register install_dir_ev dn)