From 9603460eea0588817cde04334d963124ecfa6ca9 Mon Sep 17 00:00:00 2001
From: xthirioux <xthirioux@041b043f-8d7c-46b2-b46e-ef0dd855326e>
Date: Tue, 2 Sep 2014 15:46:37 +0000
Subject: [PATCH] - corrected bug with destination directory (-d option) -
corrected several bugs in inlining - STILL, BUGS REMAINING in inlined code
!!??!!
git-svn-id: https://cavale.enseeiht.fr/svn/lustrec/lustre_compiler/trunk@328 041b043f-8d7c-46b2-b46e-ef0dd855326e
---
Makefile | 11 +-
configure | 4 +-
myocamlbuild.ml | 342 +++++--
setup.ml | 1921 +++++++++++++++++++++++++++--------
src/corelang.ml | 18 +-
src/inliner.ml | 9 +-
src/lusic.ml | 11 +-
src/main_lustre_compiler.ml | 41 +-
src/modules.ml | 9 +-
src/options.ml | 2 +-
test/test-compile.sh | 64 +-
test/tests_ok.list | 5 +
12 files changed, 1830 insertions(+), 607 deletions(-)
diff --git a/Makefile b/Makefile
index 68f2e0e9..3639f14a 100755
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
# OASIS_START
-# DO NOT EDIT (digest: bc1e05bfc8b39b664f29dae8dbd3ebbb)
+# DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954)
SETUP = ocaml setup.ml
@@ -12,7 +12,7 @@ doc: setup.data build
test: setup.data build
$(SETUP) -test $(TESTFLAGS)
-all:
+all:
$(SETUP) -all $(ALLFLAGS)
install: setup.data
@@ -24,15 +24,18 @@ uninstall: setup.data
reinstall: setup.data
$(SETUP) -reinstall $(REINSTALLFLAGS)
-clean:
+clean:
$(SETUP) -clean $(CLEANFLAGS)
-distclean:
+distclean:
$(SETUP) -distclean $(DISTCLEANFLAGS)
setup.data:
$(SETUP) -configure $(CONFIGUREFLAGS)
+configure:
+ $(SETUP) -configure $(CONFIGUREFLAGS)
+
.PHONY: build doc test all install uninstall reinstall clean distclean configure
# OASIS_STOP
diff --git a/configure b/configure
index 97ed012e..6acfaeb9 100755
--- a/configure
+++ b/configure
@@ -1,11 +1,11 @@
#!/bin/sh
# OASIS_START
-# DO NOT EDIT (digest: 425187ed8bfdbdd207fd76392dd243a7)
+# DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499)
set -e
FST=true
-for i in "$@"; do
+for i in "$@"; do
if $FST; then
set --
FST=false
diff --git a/myocamlbuild.ml b/myocamlbuild.ml
index fed8e1f8..2c4086ca 100644
--- a/myocamlbuild.ml
+++ b/myocamlbuild.ml
@@ -1,38 +1,49 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: 00359f2e15a7ed8f31f1d7ce086345f9) *)
+(* DO NOT EDIT (digest: 5a9a2168dcb86db37476d58b8c0e25b3) *)
module OASISGettext = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISGettext.ml" *)
+(* # 22 "src/oasis/OASISGettext.ml" *)
+
let ns_ str =
str
+
let s_ str =
str
- let f_ (str : ('a, 'b, 'c, 'd) format4) =
+
+ 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 OASISExpr = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISExpr.ml" *)
+(* # 22 "src/oasis/OASISExpr.ml" *)
+
+
open OASISGettext
- type test = string
- type flag = string
+ type test = string
+
+
+ type flag = string
+
type t =
| EBool of bool
@@ -41,9 +52,11 @@ module OASISExpr = struct
| EOr of t * t
| EFlag of flag
| ETest of test * string
-
- type 'a choices = (t * 'a) list
+
+
+ type 'a choices = (t * 'a) list
+
let eval var_get t =
let rec eval' =
@@ -75,6 +88,7 @@ module OASISExpr = struct
in
eval' t
+
let choose ?printer ?name var_get lst =
let rec choose_aux =
function
@@ -111,22 +125,27 @@ module OASISExpr = struct
in
choose_aux (List.rev lst)
+
end
-# 117 "myocamlbuild.ml"
+# 132 "myocamlbuild.ml"
module BaseEnvLight = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseEnvLight.ml" *)
+(* # 22 "src/base/BaseEnvLight.ml" *)
+
module MapString = Map.Make(String)
+
type t = string MapString.t
+
let default_filename =
Filename.concat
(Sys.getcwd ())
"setup.data"
+
let load ?(allow_empty=false) ?(filename=default_filename) () =
if Sys.file_exists filename then
begin
@@ -184,26 +203,29 @@ module BaseEnvLight = struct
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
+
+ let rec var_expand str env =
+ let buff =
+ Buffer.create ((String.length str) * 2)
in
- var_expand (MapString.find name env)
+ Buffer.add_substitute
+ buff
+ (fun var ->
+ try
+ var_expand (MapString.find var env) env
+ with Not_found ->
+ failwith
+ (Printf.sprintf
+ "No variable %s defined when trying to expand %S."
+ var
+ str))
+ str;
+ Buffer.contents buff
+
+
+ let var_get name env =
+ var_expand (MapString.find name env) env
+
let var_choose lst env =
OASISExpr.choose
@@ -212,87 +234,153 @@ module BaseEnvLight = struct
end
-# 215 "myocamlbuild.ml"
+# 237 "myocamlbuild.ml"
module MyOCamlbuildFindlib = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
+(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
+
- (** OCamlbuild extension, copied from
+ (** OCamlbuild extension, copied from
* http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
* by N. Pouillard and others
*
* Updated on 2009/02/28
*
- * Modified by Sylvain Le Gall
+ * Modified by Sylvain Le Gall
*)
open Ocamlbuild_plugin
+
(* these functions are not really officially exported *)
- let run_and_read =
+ let run_and_read =
Ocamlbuild_pack.My_unix.run_and_read
- let blank_sep_strings =
+
+ let blank_sep_strings =
Ocamlbuild_pack.Lexers.blank_sep_strings
- let split s ch =
- let x =
- ref []
+
+ let exec_from_conf exec =
+ let exec =
+ let env_filename = Pathname.basename BaseEnvLight.default_filename in
+ let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in
+ try
+ BaseEnvLight.var_get exec env
+ with Not_found ->
+ Printf.eprintf "W: Cannot get variable %s\n" exec;
+ exec
+ in
+ let fix_win32 str =
+ if Sys.os_type = "Win32" then begin
+ let buff = Buffer.create (String.length str) in
+ (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'.
+ *)
+ String.iter
+ (fun c -> Buffer.add_char buff (if c = '\\' then '/' else c))
+ str;
+ Buffer.contents buff
+ end else begin
+ str
+ end
in
- let rec go s =
- let pos =
- String.index s ch
- in
- x := (String.before s pos)::!x;
- go (String.after s (pos + 1))
+ fix_win32 exec
+
+ let split s ch =
+ let buf = Buffer.create 13 in
+ let x = ref [] in
+ let flush () =
+ x := (Buffer.contents buf) :: !x;
+ Buffer.clear buf
in
- try
- go s
- with Not_found -> !x
+ String.iter
+ (fun c ->
+ if c = ch then
+ flush ()
+ else
+ Buffer.add_char buf c)
+ s;
+ flush ();
+ List.rev !x
+
let split_nl s = split s '\n'
+
let before_space s =
try
String.before s (String.index s ' ')
with Not_found -> s
- (* this lists all supported packages *)
+ (* ocamlfind command *)
+ let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x]
+
+ (* This lists all supported packages. *)
let find_packages () =
List.map before_space (split_nl & run_and_read "ocamlfind list")
- (* this is supposed to list available syntaxes, but I don't know how to do it. *)
+
+ (* Mock to list available syntaxes. *)
let find_syntaxes () = ["camlp4o"; "camlp4r"]
- (* ocamlfind command *)
- let ocamlfind x = S[A"ocamlfind"; x]
+
+ let well_known_syntax = [
+ "camlp4.quotations.o";
+ "camlp4.quotations.r";
+ "camlp4.exceptiontracer";
+ "camlp4.extend";
+ "camlp4.foldgenerator";
+ "camlp4.listcomprehension";
+ "camlp4.locationstripper";
+ "camlp4.macro";
+ "camlp4.mapgenerator";
+ "camlp4.metagenerator";
+ "camlp4.profiler";
+ "camlp4.tracer"
+ ]
+
let dispatch =
function
- | Before_options ->
- (* by using Before_options one let command line options have an higher priority *)
- (* on the contrary using After_options will guarantee to have the higher priority *)
- (* override default commands by ocamlfind ones *)
+ | After_options ->
+ (* By using Before_options one let command line options have an higher
+ * priority on the contrary using After_options will guarantee to have
+ * the higher priority override default commands by ocamlfind ones *)
Options.ocamlc := ocamlfind & A"ocamlc";
Options.ocamlopt := ocamlfind & A"ocamlopt";
Options.ocamldep := ocamlfind & A"ocamldep";
Options.ocamldoc := ocamlfind & A"ocamldoc";
- Options.ocamlmktop := ocamlfind & A"ocamlmktop"
-
+ Options.ocamlmktop := ocamlfind & A"ocamlmktop";
+ Options.ocamlmklib := ocamlfind & A"ocamlmklib"
+
| After_rules ->
-
- (* When one link an OCaml library/binary/package, one should use -linkpkg *)
+
+ (* When one link an OCaml library/binary/package, one should use
+ * -linkpkg *)
flag ["ocaml"; "link"; "program"] & A"-linkpkg";
-
+
(* For each ocamlfind package one inject the -package option when
* compiling, computing dependencies, generating documentation and
* linking. *)
- List.iter
+ List.iter
begin fun pkg ->
- flag ["ocaml"; "compile"; "pkg_"^pkg] & S[A"-package"; A pkg];
- flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S[A"-package"; A pkg];
- flag ["ocaml"; "doc"; "pkg_"^pkg] & S[A"-package"; A pkg];
- flag ["ocaml"; "link"; "pkg_"^pkg] & S[A"-package"; A pkg];
- flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S[A"-package"; A pkg];
- end
+ let base_args = [A"-package"; A pkg] in
+ (* TODO: consider how to really choose camlp4o or camlp4r. *)
+ let syn_args = [A"-syntax"; A "camlp4o"] in
+ let args =
+ (* Heuristic to identify syntax extensions: whether they end in
+ ".syntax"; some might not.
+ *)
+ if Filename.check_suffix pkg "syntax" ||
+ List.mem pkg well_known_syntax then
+ syn_args @ base_args
+ else
+ base_args
+ in
+ flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
+ flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
+ flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
+ flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
+ flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
+ end
(find_packages ());
(* Like -package but for extensions syntax. Morover -syntax is useless
@@ -301,29 +389,34 @@ module MyOCamlbuildFindlib = struct
flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
- flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
+ flag ["ocaml"; "infer_interface"; "syntax_"^syntax] &
+ S[A"-syntax"; A syntax];
end (find_syntaxes ());
(* The default "thread" tag is not compatible with ocamlfind.
* Indeed, the default rules add the "threads.cma" or "threads.cmxa"
* options when using this tag. When using the "-linkpkg" option with
* ocamlfind, this module will then be added twice on the command line.
- *
+ *
* To solve this, one approach is to add the "-thread" option when using
* the "threads" package using the previous plugin.
*)
flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
- flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"])
+ flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
+ flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
+ flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
+ flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
+ flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
- | _ ->
+ | _ ->
()
-
end
module MyOCamlbuildBase = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
+(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
+
(** Base functions for writing myocamlbuild.ml
@author Sylvain Le Gall
@@ -331,51 +424,61 @@ module MyOCamlbuildBase = struct
+
+
open Ocamlbuild_plugin
module OC = Ocamlbuild_pack.Ocaml_compiler
- type dir = string
- type file = string
- type name = string
- type tag = string
-(* # 56 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
+ type dir = string
+ type file = string
+ type name = string
+ type tag = string
+
+
+(* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
+
type t =
{
- lib_ocaml: (name * dir list) list;
- lib_c: (name * dir * file list) list;
+ lib_ocaml: (name * dir list * string list) list;
+ lib_c: (name * dir * file list) list;
flags: (tag list * (spec OASISExpr.choices)) list;
(* Replace the 'dir: include' from _tags by a precise interdepends in
* directory.
*)
- includes: (dir * dir list) list;
- }
+ includes: (dir * dir list) list;
+ }
+
let env_filename =
- Pathname.basename
+ Pathname.basename
BaseEnvLight.default_filename
+
let dispatch_combine lst =
fun e ->
- List.iter
+ List.iter
(fun dispatch -> dispatch e)
- lst
+ lst
+
let tag_libstubs nm =
"use_lib"^nm^"_stubs"
+
let nm_libstubs nm =
nm^"_stubs"
- let dispatch t e =
- let env =
- BaseEnvLight.load
- ~filename:env_filename
+
+ let dispatch t e =
+ let env =
+ BaseEnvLight.load
+ ~filename:env_filename
~allow_empty:true
()
in
- match e with
+ match e with
| Before_options ->
let no_trailing_dot s =
if String.length s >= 1 && s.[0] = '.' then
@@ -385,35 +488,44 @@ module MyOCamlbuildBase = struct
in
List.iter
(fun (opt, var) ->
- try
+ try
opt := no_trailing_dot (BaseEnvLight.var_get var env)
with Not_found ->
- Printf.eprintf "W: Cannot get variable %s" var)
+ Printf.eprintf "W: Cannot get variable %s\n" var)
[
Options.ext_obj, "ext_obj";
Options.ext_lib, "ext_lib";
Options.ext_dll, "ext_dll";
]
- | After_rules ->
+ | After_rules ->
(* Declare OCaml libraries *)
- List.iter
+ List.iter
(function
- | nm, [] ->
- ocaml_lib nm
- | nm, dir :: tl ->
+ | nm, [], intf_modules ->
+ ocaml_lib nm;
+ let cmis =
+ List.map (fun m -> (String.uncapitalize m) ^ ".cmi")
+ intf_modules in
+ dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis
+ | nm, dir :: tl, intf_modules ->
ocaml_lib ~dir:dir (dir^"/"^nm);
- List.iter
- (fun dir ->
+ List.iter
+ (fun dir ->
List.iter
(fun str ->
flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir]))
["compile"; "infer_interface"; "doc"])
- tl)
+ tl;
+ let cmis =
+ List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi")
+ intf_modules in
+ dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"]
+ cmis)
t.lib_ocaml;
(* Declare directories dependencies, replace "include" in _tags. *)
- List.iter
+ List.iter
(fun (dir, include_dirs) ->
Pathname.define_context dir include_dirs)
t.includes;
@@ -428,7 +540,7 @@ module MyOCamlbuildBase = struct
flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib]
(S[A"-cclib"; A("-l"^(nm_libstubs lib))]);
-
+
flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
(S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
@@ -443,11 +555,11 @@ module MyOCamlbuildBase = struct
(* TODO: be more specific about what depends on headers *)
(* Depends on .h files *)
- dep ["compile"; "c"]
+ dep ["compile"; "c"]
headers;
(* Setup search path for lib *)
- flag ["link"; "ocaml"; "use_"^lib]
+ flag ["link"; "ocaml"; "use_"^lib]
(S[A"-I"; P(dir)]);
)
t.lib_c;
@@ -455,32 +567,38 @@ module MyOCamlbuildBase = struct
(* Add flags *)
List.iter
(fun (tags, cond_specs) ->
- let spec =
- BaseEnvLight.var_choose cond_specs env
+ let spec = BaseEnvLight.var_choose cond_specs env in
+ let rec eval_specs =
+ function
+ | S lst -> S (List.map eval_specs lst)
+ | A str -> A (BaseEnvLight.var_expand str env)
+ | spec -> spec
in
- flag tags & spec)
+ flag tags & (eval_specs spec))
t.flags
- | _ ->
+ | _ ->
()
+
let dispatch_default t =
- dispatch_combine
+ dispatch_combine
[
dispatch t;
MyOCamlbuildFindlib.dispatch;
]
+
end
-# 476 "myocamlbuild.ml"
+# 594 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
- {MyOCamlbuildBase.lib_ocaml = []; lib_c = []; flags = []; includes = []; }
+ {MyOCamlbuildBase.lib_ocaml = []; lib_c = []; flags = []; includes = []}
;;
let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
-# 485 "myocamlbuild.ml"
+# 603 "myocamlbuild.ml"
(* OASIS_STOP *)
Ocamlbuild_plugin.dispatch dispatch_default;;
diff --git a/setup.ml b/setup.ml
index 6ea34cbd..22ac1953 100644
--- a/setup.ml
+++ b/setup.ml
@@ -1,48 +1,58 @@
(* setup.ml generated for the first time by OASIS v0.2.0 *)
(* OASIS_START *)
-(* DO NOT EDIT (digest: 243f7ef4ca5fa7182acbe98e77d9c7f4) *)
+(* DO NOT EDIT (digest: d0957d7fdd9eb6ce163190fb18a724b8) *)
(*
- Regenerated by OASIS v0.3.0
+ Regenerated by OASIS v0.4.4
Visit http://oasis.forge.ocamlcore.org for more information and
documentation about functions used in this file.
*)
module OASISGettext = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISGettext.ml" *)
+(* # 22 "src/oasis/OASISGettext.ml" *)
+
let ns_ str =
str
+
let s_ str =
str
- let f_ (str : ('a, 'b, 'c, 'd) format4) =
+
+ 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 "/build/buildd/oasis-0.3.0/src/oasis/OASISContext.ml" *)
+(* # 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;
@@ -51,6 +61,7 @@ module OASISContext = struct
printf: level -> string -> unit;
}
+
let printf lvl str =
let beg =
match lvl with
@@ -61,6 +72,7 @@ module OASISContext = struct
in
prerr_endline (beg^str)
+
let default =
ref
{
@@ -72,37 +84,50 @@ module OASISContext = struct
printf = printf;
}
+
let quiet =
{!default with quiet = true}
- let args () =
+ 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");
+ s_ " Run quietly";
"-info",
Arg.Unit (fun () -> default := {!default with info = true}),
- (s_ " Display information message");
+ s_ " Display information message";
"-debug",
Arg.Unit (fun () -> default := {!default with debug = true}),
- (s_ " Output debug message")]
+ 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}
end
module OASISString = struct
-(* # 1 "/build/buildd/oasis-0.3.0/src/oasis/OASISString.ml" *)
-
+(* # 22 "src/oasis/OASISString.ml" *)
(** Various string utilities.
-
+
Mostly inspired by extlib and batteries ExtString and BatString libraries.
@author Sylvain Le Gall
*)
+
let nsplitf str f =
if str = "" then
[]
@@ -123,16 +148,18 @@ module OASISString = struct
push ();
List.rev !lst
+
(** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
separator.
*)
let nsplit str c =
nsplitf str ((=) c)
+
let find ~what ?(offset=0) str =
let what_idx = ref 0 in
- let str_idx = ref offset in
- while !str_idx < String.length str &&
+ 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
@@ -142,16 +169,18 @@ module OASISString = struct
done;
if !what_idx <> String.length what then
raise Not_found
- else
+ else
!str_idx - !what_idx
- let sub_start str len =
+
+ let sub_start str len =
let str_len = String.length str in
if len >= str_len then
""
else
String.sub str len (str_len - len)
+
let sub_end ?(offset=0) str len =
let str_len = String.length str in
if len >= str_len then
@@ -159,12 +188,13 @@ module OASISString = struct
else
String.sub str 0 (str_len - len)
+
let starts_with ~what ?(offset=0) str =
let what_idx = ref 0 in
let str_idx = ref offset in
let ok = ref true in
while !ok &&
- !str_idx < String.length str &&
+ !str_idx < String.length str &&
!what_idx < String.length what do
if str.[!str_idx] = what.[!what_idx] then
incr what_idx
@@ -174,21 +204,23 @@ module OASISString = struct
done;
if !what_idx = String.length what then
true
- else
+ else
false
+
let strip_starts_with ~what str =
if starts_with ~what str then
sub_start str (String.length what)
else
raise Not_found
+
let ends_with ~what ?(offset=0) str =
let what_idx = ref ((String.length what) - 1) in
let str_idx = ref ((String.length str) - 1) in
let ok = ref true in
while !ok &&
- offset <= !str_idx &&
+ offset <= !str_idx &&
0 <= !what_idx do
if str.[!str_idx] = what.[!what_idx] then
decr what_idx
@@ -198,15 +230,17 @@ module OASISString = struct
done;
if !what_idx = -1 then
true
- else
+ else
false
+
let strip_ends_with ~what str =
if ends_with ~what str then
sub_end str (String.length what)
else
raise Not_found
+
let replace_chars f s =
let buf = String.make (String.length s) 'X' in
for i = 0 to String.length s - 1 do
@@ -214,37 +248,78 @@ module OASISString = struct
done;
buf
+
end
module OASISUtils = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISUtils.ml" *)
+(* # 22 "src/oasis/OASISUtils.ml" *)
+
open OASISGettext
- module MapString = Map.Make(String)
- let map_string_of_assoc assoc =
- List.fold_left
- (fun acc (k, v) -> MapString.add k v acc)
- MapString.empty
- assoc
+ module MapExt =
+ struct
+ module type S =
+ sig
+ include Map.S
+ val add_list: 'a t -> (key * 'a) list -> 'a t
+ val of_list: (key * 'a) list -> 'a t
+ val to_list: 'a t -> (key * 'a) list
+ end
+
+ module Make (Ord: Map.OrderedType) =
+ struct
+ include Map.Make(Ord)
+
+ let rec add_list t =
+ function
+ | (k, v) :: tl -> add_list (add k v t) tl
+ | [] -> t
- module SetString = Set.Make(String)
+ let of_list lst = add_list empty lst
- let set_string_add_list st lst =
- List.fold_left
- (fun acc e -> SetString.add e acc)
- st
- lst
+ let to_list t = fold (fun k v acc -> (k, v) :: acc) t []
+ end
+ end
+
+
+ module MapString = MapExt.Make(String)
+
+
+ module SetExt =
+ struct
+ module type S =
+ sig
+ include Set.S
+ val add_list: t -> elt list -> t
+ val of_list: elt list -> t
+ val to_list: t -> elt list
+ end
+
+ module Make (Ord: Set.OrderedType) =
+ struct
+ include Set.Make(Ord)
+
+ let rec add_list t =
+ function
+ | e :: tl -> add_list (add e t) tl
+ | [] -> t
- let set_string_of_list =
- set_string_add_list
- SetString.empty
+ let of_list lst = add_list empty lst
+
+ let to_list = elements
+ end
+ end
+
+
+ module SetString = SetExt.Make(String)
let compare_csl s1 s2 =
String.compare (String.lowercase s1) (String.lowercase s2)
+
module HashStringCsl =
Hashtbl.Make
(struct
@@ -257,6 +332,14 @@ module OASISUtils = struct
Hashtbl.hash (String.lowercase s)
end)
+ module SetStringCsl =
+ SetExt.Make
+ (struct
+ type t = string
+ let compare = compare_csl
+ end)
+
+
let varname_of_string ?(hyphen='_') s =
if String.length s = 0 then
begin
@@ -287,6 +370,7 @@ module OASISUtils = struct
String.lowercase buf
end
+
let varname_concat ?(hyphen='_') p s =
let what = String.make 1 hyphen in
let p =
@@ -307,42 +391,49 @@ module OASISUtils = struct
let is_varname str =
str = varname_of_string str
+
let failwithf fmt = Printf.ksprintf failwith fmt
+
end
module PropList = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/PropList.ml" *)
+(* # 22 "src/oasis/PropList.ml" *)
+
open OASISGettext
+
type name = string
+
exception Not_set of name * string option
exception No_printer of name
exception Unknown_field of name * name
+
let () =
Printexc.register_printer
(function
| Not_set (nm, Some rsn) ->
- Some
+ Some
(Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn)
| Not_set (nm, None) ->
- Some
+ 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)
+ 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
@@ -352,12 +443,13 @@ module PropList = struct
let clear t =
Hashtbl.clear t
-(* # 71 "/build/buildd/oasis-0.3.0/src/oasis/PropList.ml" *)
+
+(* # 78 "src/oasis/PropList.ml" *)
end
+
module Schema =
struct
-
type ('ctxt, 'extra) value =
{
get: Data.t -> string;
@@ -445,9 +537,9 @@ module PropList = struct
t.name
end
+
module Field =
struct
-
type ('ctxt, 'value, 'extra) t =
{
set: Data.t -> ?context:'ctxt -> 'value -> unit;
@@ -577,28 +669,27 @@ module PropList = struct
let fgets data t =
t.gets data
-
end
+
module FieldRO =
struct
-
let create ?schema ?name ?parse ?print ?default ?update ?help extra =
let fld =
Field.create ?schema ?name ?parse ?print ?default ?update ?help extra
in
fun data -> Field.fget data fld
-
end
end
module OASISMessage = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISMessage.ml" *)
+(* # 22 "src/oasis/OASISMessage.ml" *)
open OASISGettext
open OASISContext
+
let generic_message ~ctxt lvl fmt =
let cond =
if ctxt.quiet then
@@ -617,30 +708,39 @@ module OASISMessage = struct
end)
fmt
+
let debug ~ctxt fmt =
generic_message ~ctxt `Debug fmt
+
let info ~ctxt fmt =
generic_message ~ctxt `Info fmt
+
let warning ~ctxt fmt =
generic_message ~ctxt `Warning fmt
+
let error ~ctxt fmt =
generic_message ~ctxt `Error fmt
end
module OASISVersion = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISVersion.ml" *)
+(* # 22 "src/oasis/OASISVersion.ml" *)
+
open OASISGettext
+
+
type s = string
- type t = string
+
+ type t = string
+
type comparator =
| VGreater of t
@@ -650,20 +750,24 @@ module OASISVersion = struct
| VLesserEqual of t
| VOr of comparator * comparator
| VAnd of comparator * comparator
-
+
+
(* Range of allowed characters *)
let is_digit c =
'0' <= c && c <= '9'
+
let is_alpha c =
('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
+
let is_special =
function
| '.' | '+' | '-' | '~' -> true
| _ -> false
+
let rec version_compare v1 v2 =
if v1 <> "" || v2 <> "" then
begin
@@ -707,11 +811,11 @@ module OASISVersion = struct
while !p < String.length v && is_digit v.[!p] do
incr p
done;
- let substr =
+ let substr =
String.sub v !p ((String.length v) - !p)
- in
- let res =
- match String.sub v start_p (!p - start_p) with
+ in
+ let res =
+ match String.sub v start_p (!p - start_p) with
| "" -> 0
| s -> int_of_string s
in
@@ -747,8 +851,14 @@ module OASISVersion = struct
let version_of_string str = str
+
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 =
@@ -758,6 +868,7 @@ module OASISVersion = struct
with Not_found ->
t
+
let rec comparator_apply v op =
match op with
| VGreater cv ->
@@ -775,6 +886,7 @@ module OASISVersion = struct
| VAnd (op1, op2) ->
(comparator_apply v op1) && (comparator_apply v op2)
+
let rec string_of_comparator =
function
| VGreater v -> "> "^(string_of_version v)
@@ -787,6 +899,7 @@ module OASISVersion = struct
| VAnd (c1, c2) ->
(string_of_comparator c1)^" && "^(string_of_comparator c2)
+
let rec varname_of_comparator =
let concat p v =
OASISUtils.varname_concat
@@ -805,13 +918,24 @@ module OASISVersion = struct
| VAnd (c1, c2) ->
(varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
- let version_0_3_or_after t =
- comparator_apply t (VGreaterEqual (string_of_version "0.3"))
+
+ 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
+
end
module OASISLicense = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISLicense.ml" *)
+(* # 22 "src/oasis/OASISLicense.ml" *)
+
(** License for _oasis fields
@author Sylvain Le Gall
@@ -819,15 +943,20 @@ module OASISLicense = struct
- type license = string
- type license_exception = string
+
+ type license = string
+
+
+ type license_exception = string
+
type license_version =
| Version of OASISVersion.t
| VersionOrLater of OASISVersion.t
| NoVersion
-
+
+
type license_dep_5_unit =
{
@@ -835,31 +964,38 @@ module OASISLicense = struct
excption: license_exception option;
version: license_version;
}
-
+
+
type license_dep_5 =
| DEP5Unit of license_dep_5_unit
| DEP5Or of license_dep_5 list
| DEP5And of license_dep_5 list
-
+
type t =
| DEP5License of license_dep_5
| OtherLicense of string (* URL *)
-
+
+
end
module OASISExpr = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISExpr.ml" *)
+(* # 22 "src/oasis/OASISExpr.ml" *)
+
+
open OASISGettext
- type test = string
- type flag = string
+ type test = string
+
+
+ type flag = string
+
type t =
| EBool of bool
@@ -868,9 +1004,11 @@ module OASISExpr = struct
| EOr of t * t
| EFlag of flag
| ETest of test * string
-
- type 'a choices = (t * 'a) list
+
+
+ type 'a choices = (t * 'a) list
+
let eval var_get t =
let rec eval' =
@@ -902,6 +1040,7 @@ module OASISExpr = struct
in
eval' t
+
let choose ?printer ?name var_get lst =
let rec choose_aux =
function
@@ -938,44 +1077,66 @@ module OASISExpr = struct
in
choose_aux (List.rev lst)
+
+end
+
+module OASISText = struct
+(* # 22 "src/oasis/OASISText.ml" *)
+
+
+
+ type elt =
+ | Para of string
+ | Verbatim of string
+ | BlankLine
+
+
+ type t = elt list
+
end
module OASISTypes = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISTypes.ml" *)
+(* # 22 "src/oasis/OASISTypes.ml" *)
+
+
+
+ type name = string
+ type package_name = string
+ type url = string
+ type unix_dirname = string
+ type unix_filename = string
+ 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 name = string
- type package_name = string
- type url = string
- type unix_dirname = string
- type unix_filename = string
- type host_dirname = string
- type host_filename = string
- type prog = string
- type arg = string
- type args = string list
- type command_line = (prog * arg list)
+ type findlib_name = string
+ type findlib_full = string
- type findlib_name = string
- type findlib_full = string
type compiled_object =
| Byte
| Native
| Best
-
+
+
type dependency =
| FindlibPackage of findlib_full * OASISVersion.comparator option
| InternalLibrary of name
-
+
+
type tool =
| ExternalTool of name
| InternalExecutable of name
-
+
+
type vcs =
| Darcs
@@ -987,7 +1148,8 @@ module OASISTypes = struct
| Arch
| Monotone
| OtherVCS of url
-
+
+
type plugin_kind =
[ `Configure
@@ -998,6 +1160,7 @@ module OASISTypes = struct
| `Extra
]
+
type plugin_data_purpose =
[ `Configure
| `Build
@@ -1012,22 +1175,29 @@ module OASISTypes = struct
| `Other of string
]
- type 'a plugin = 'a * name * OASISVersion.t option
+
+ type 'a plugin = 'a * name * OASISVersion.t option
+
type all_plugin = plugin_kind plugin
+
type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
-(* # 102 "/build/buildd/oasis-0.3.0/src/oasis/OASISTypes.ml" *)
- type 'a conditional = 'a OASISExpr.choices
+(* # 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;
}
-
+
+
type common_section =
{
@@ -1035,7 +1205,8 @@ module OASISTypes = struct
cs_data: PropList.Data.t;
cs_plugin_data: plugin_data;
}
-
+
+
type build_section =
{
@@ -1054,7 +1225,8 @@ module OASISTypes = struct
bs_byteopt: args conditional;
bs_nativeopt: args conditional;
}
-
+
+
type library =
{
@@ -1064,19 +1236,29 @@ module OASISTypes = struct
lib_findlib_parent: findlib_name option;
lib_findlib_name: findlib_name option;
lib_findlib_containers: findlib_name list;
- }
+ }
+
+
+ type object_ =
+ {
+ obj_modules: string list;
+ obj_findlib_fullname: findlib_name list option;
+ }
+
type executable =
{
exec_custom: bool;
exec_main_is: unix_filename;
- }
+ }
+
type flag =
{
flag_description: string option;
flag_default: bool conditional;
- }
+ }
+
type source_repository =
{
@@ -1087,7 +1269,8 @@ module OASISTypes = struct
src_repo_branch: string option;
src_repo_tag: string option;
src_repo_subdir: unix_filename option;
- }
+ }
+
type test =
{
@@ -1097,7 +1280,8 @@ module OASISTypes = struct
test_working_directory: unix_filename option;
test_run: bool conditional;
test_tools: tool list;
- }
+ }
+
type doc_format =
| HTML of unix_filename
@@ -1107,7 +1291,8 @@ module OASISTypes = struct
| Info of unix_filename
| DVI
| OtherDoc
-
+
+
type doc =
{
@@ -1122,75 +1307,452 @@ module OASISTypes = struct
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
+ | Object of common_section * build_section * object_
+ | Executable of common_section * build_section * executable
+ | Flag of common_section * flag
+ | SrcRepo of common_section * source_repository
+ | Test of common_section * test
+ | Doc of common_section * doc
+
+
+
+ type section_kind =
+ [ `Library | `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;
+ }
+
+
+end
+
+module OASISFeatures = struct
+(* # 22 "src/oasis/OASISFeatures.ml" *)
+
+ open OASISTypes
+ open OASISUtils
+ open OASISGettext
+ open OASISVersion
+
+ module MapPlugin =
+ Map.Make
+ (struct
+ 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;
+ }
+
+ let create oasis_version alpha_features beta_features =
+ {
+ oasis_version = oasis_version;
+ plugin_versions = MapPlugin.empty;
+ alpha_features = alpha_features;
+ beta_features = beta_features
+ }
+
+ let of_package pkg =
+ create
+ pkg.OASISTypes.oasis_version
+ pkg.OASISTypes.alpha_features
+ pkg.OASISTypes.beta_features
+
+ let add_plugin (plugin_kind, plugin_name, plugin_version) t =
+ {t with
+ plugin_versions = MapPlugin.add
+ (plugin_kind, plugin_name)
+ plugin_version
+ t.plugin_versions}
+
+ let plugin_version plugin_kind plugin_name t =
+ MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions
+
+ let to_string t =
+ Printf.sprintf
+ "oasis_version: %s; alpha_features: %s; beta_features: %s; \
+ plugins_version: %s"
+ (OASISVersion.string_of_version t.oasis_version)
+ (String.concat ", " t.alpha_features)
+ (String.concat ", " t.beta_features)
+ (String.concat ", "
+ (MapPlugin.fold
+ (fun (_, plg) ver_opt acc ->
+ (plg^
+ (match ver_opt with
+ | Some v ->
+ " "^(OASISVersion.string_of_version v)
+ | None -> ""))
+ :: acc)
+ t.plugin_versions []))
+ end
+
+ type origin =
+ | Field of string * string
+ | Section of string
+ | NoOrigin
+
+ type stage = Alpha | Beta
+
+
+ let string_of_stage =
+ function
+ | Alpha -> "alpha"
+ | Beta -> "beta"
+
+
+ let field_of_stage =
+ function
+ | 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;
+ }
+
+ (* TODO: mutex protect this. *)
+ let all_features = Hashtbl.create 13
+
+
+ let since_version ver_str = SinceVersion (version_of_string ver_str)
+ let alpha = InDev Alpha
+ let beta = InDev Beta
+
+
+ let to_string t =
+ Printf.sprintf
+ "feature: %s; plugin: %s; publication: %s"
+ t.name
+ (match t.plugin with
+ | None -> "<none>"
+ | Some (_, nm, _) -> nm)
+ (match t.publication with
+ | InDev stage -> string_of_stage stage
+ | SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver))
+
+ let data_check t data origin =
+ let no_message = "no message" in
+
+ let check_feature features stage =
+ let has_feature = List.mem t.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
+ else
+ None
+ in
+
+ let version_is_good ~min_version version fmt =
+ let version_is_good =
+ OASISVersion.comparator_apply
+ version (OASISVersion.VGreaterEqual min_version)
+ in
+ Printf.ksprintf
+ (fun str ->
+ if version_is_good then
+ None
+ else
+ Some str)
+ fmt
+ in
+
+ match origin, t.plugin, t.publication with
+ | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha
+ | _, _, InDev Beta -> check_feature data.Data.beta_features Beta
+ | Field(fld, where), None, SinceVersion min_version ->
+ version_is_good ~min_version data.Data.oasis_version
+ (f_ "Field %s in %s is only valid since OASIS v%s, update \
+ OASISFormat field from '%s' to '%s' after checking \
+ OASIS changelog.")
+ fld where (string_of_version min_version)
+ (string_of_version data.Data.oasis_version)
+ (string_of_version min_version)
+
+ | Field(fld, where), Some(plugin_knd, plugin_name, _),
+ SinceVersion min_version ->
+ begin
+ try
+ let 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
+
+ | Section sct, None, SinceVersion min_version ->
+ version_is_good ~min_version data.Data.oasis_version
+ (f_ "Section %s is only valid for since OASIS v%s, update \
+ OASISFormat field from '%s' to '%s' after checking OASIS \
+ changelog.")
+ sct (string_of_version min_version)
+ (string_of_version data.Data.oasis_version)
+ (string_of_version min_version)
+
+ | Section sct, Some(plugin_knd, plugin_name, _),
+ SinceVersion min_version ->
+ begin
+ try
+ let plugin_version_current =
+ try
+ match Data.plugin_version plugin_knd plugin_name data with
+ | Some ver -> ver
+ | None ->
+ failwithf
+ (f_ "Section %s is only valid for the OASIS \
+ plugin %s since v%s, but no plugin version is \
+ defined in the _oasis file, change '%s' to \
+ '%s (%s)' in your _oasis file.")
+ sct plugin_name (string_of_version min_version)
+ plugin_name
+ plugin_name (string_of_version min_version)
+ with Not_found ->
+ failwithf
+ (f_ "Section %s is only valid when the OASIS plugin %s \
+ is defined.")
+ sct plugin_name
+ in
+ version_is_good ~min_version plugin_version_current
+ (f_ "Section %s is only valid for the OASIS plugin %s \
+ since v%s, update your plugin from '%s (%s)' to \
+ '%s (%s)' after checking the plugin's changelog.")
+ sct plugin_name (string_of_version min_version)
+ plugin_name (string_of_version plugin_version_current)
+ plugin_name (string_of_version min_version)
+ with Failure msg ->
+ Some msg
+ end
+
+ | NoOrigin, None, SinceVersion min_version ->
+ version_is_good ~min_version data.Data.oasis_version "%s" no_message
+
+ | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version ->
+ begin
+ try
+ let plugin_version_current =
+ match Data.plugin_version plugin_knd plugin_name data with
+ | Some ver -> ver
+ | None -> raise Not_found
+ in
+ version_is_good ~min_version plugin_version_current
+ "%s" no_message
+ with Not_found ->
+ Some no_message
+ end
+
+
+ let data_assert t data origin =
+ match data_check t data origin with
+ | None -> ()
+ | Some str -> failwith str
+
+
+ let data_test t data =
+ match data_check t data NoOrigin with
+ | None -> true
+ | Some str -> false
+
+
+ let package_test t pkg =
+ data_test t (Data.of_package pkg)
+
+
+ let create ?plugin name publication description =
+ let () =
+ if Hashtbl.mem all_features name then
+ failwithf "Feature '%s' is already declared." name
+ in
+ let t =
+ {
+ name = name;
+ plugin = plugin;
+ publication = publication;
+ description = description;
+ }
+ in
+ Hashtbl.add all_features name t;
+ t
+
+
+ let get_stage name =
+ try
+ (Hashtbl.find all_features name).publication
+ with Not_found ->
+ failwithf (f_ "Feature %s doesn't exist.") name
+
+
+ let list () =
+ Hashtbl.fold (fun _ v acc -> v :: acc) all_features []
+
+ (*
+ * Real flags.
+ *)
+
+
+ let features =
+ create "features_fields"
+ (since_version "0.4")
+ (fun () ->
+ s_ "Enable to experiment not yet official features.")
+
+
+ let flag_docs =
+ create "flag_docs"
+ (since_version "0.3")
+ (fun () ->
+ s_ "Building docs require '-docs' flag at configure.")
- 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 section_kind =
- [ `Library | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
+ let flag_tests =
+ create "flag_tests"
+ (since_version "0.3")
+ (fun () ->
+ s_ "Running tests require '-tests' flag at configure.")
+
+
+ let pack =
+ create "pack"
+ (since_version "0.3")
+ (fun () ->
+ s_ "Allow to create packed library.")
+
+
+ let section_object =
+ create "section_object" beta
+ (fun () ->
+ s_ "Implement an object section.")
- 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;
- }
+ let dynrun_for_release =
+ create "dynrun_for_release" alpha
+ (fun () ->
+ s_ "Make '-setup-update dynamic' suitable for releasing project.")
+
+
+ let compiled_setup_ml =
+ create "compiled_setup_ml" alpha
+ (fun () ->
+ s_ "It compiles 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
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISUnixPath.ml" *)
+(* # 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
@@ -1200,6 +1762,7 @@ module OASISUnixPath = struct
in
f1'^"/"^f2
+
let make =
function
| hd :: tl ->
@@ -1210,12 +1773,14 @@ module OASISUnixPath = struct
| [] ->
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 =
@@ -1225,6 +1790,7 @@ module OASISUnixPath = struct
with Not_found ->
f
+
let chop_extension f =
try
let last_dot =
@@ -1247,26 +1813,31 @@ module OASISUnixPath = struct
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
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISHostPath.ml" *)
+(* # 22 "src/oasis/OASISHostPath.ml" *)
open Filename
+
module Unix = OASISUnixPath
+
let make =
function
| [] ->
@@ -1274,6 +1845,7 @@ module OASISHostPath = struct
| hd :: tl ->
List.fold_left Filename.concat hd tl
+
let of_unix ufn =
if Sys.os_type = "Unix" then
ufn
@@ -1293,14 +1865,18 @@ module OASISHostPath = struct
end
module OASISSection = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISSection.ml" *)
+(* # 22 "src/oasis/OASISSection.ml" *)
+
open OASISTypes
- let section_kind_common =
+
+ let section_kind_common =
function
- | Library (cs, _, _) ->
+ | Library (cs, _, _) ->
`Library, cs
+ | Object (cs, _, _) ->
+ `Object, cs
| Executable (cs, _, _) ->
`Executable, cs
| Flag (cs, _) ->
@@ -1312,32 +1888,38 @@ module OASISSection = struct
| Doc (cs, _) ->
`Doc, cs
+
let section_common sct =
snd (section_kind_common sct)
+
let section_common_set cs =
function
| Library (_, bs, lib) -> Library (cs, bs, lib)
+ | Object (_, bs, obj) -> Object (cs, bs, obj)
| Executable (_, bs, exec) -> Executable (cs, bs, exec)
| Flag (_, flg) -> Flag (cs, flg)
| SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo)
| Test (_, tst) -> Test (cs, tst)
| Doc (_, doc) -> Doc (cs, doc)
+
(** Key used to identify section
*)
- let section_id sct =
- let k, cs =
+ let section_id sct =
+ let k, cs =
section_kind_common sct
in
k, cs.cs_name
+
let string_of_section sct =
let k, nm =
section_id sct
in
(match k with
- | `Library -> "library"
+ | `Library -> "library"
+ | `Object -> "object"
| `Executable -> "executable"
| `Flag -> "flag"
| `SrcRepo -> "src repository"
@@ -1345,20 +1927,22 @@ module OASISSection = struct
| `Doc -> "doc")
^" "^nm
+
let section_find id scts =
List.find
(fun sct -> id = section_id sct)
scts
+
module CSection =
struct
type t = section
let id = section_id
- let compare t1 t2 =
+ let compare t1 t2 =
compare (id t1) (id t2)
-
+
let equal t1 t2 =
(id t1) = (id t2)
@@ -1366,28 +1950,33 @@ module OASISSection = struct
Hashtbl.hash (id t)
end
+
module MapSection = Map.Make(CSection)
module SetSection = Set.Make(CSection)
+
end
module OASISBuildSection = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISBuildSection.ml" *)
+(* # 22 "src/oasis/OASISBuildSection.ml" *)
+
end
module OASISExecutable = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISExecutable.ml" *)
+(* # 22 "src/oasis/OASISExecutable.ml" *)
+
open OASISTypes
- let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program =
- let dir =
+
+ let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program =
+ let dir =
OASISUnixPath.concat
bs.bs_path
(OASISUnixPath.dirname exec.exec_main_is)
in
- let is_native_exec =
+ let is_native_exec =
match bs.bs_compiled_object with
| Native -> true
| Best -> is_native ()
@@ -1398,40 +1987,28 @@ module OASISExecutable = struct
dir
(cs.cs_name^(suffix_program ())),
- if not is_native_exec &&
- not exec.exec_custom &&
+ if not is_native_exec &&
+ not exec.exec_custom &&
bs.bs_c_sources <> [] then
Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ()))
else
None
+
end
module OASISLibrary = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISLibrary.ml" *)
+(* # 22 "src/oasis/OASISLibrary.ml" *)
+
open OASISTypes
open OASISUtils
open OASISGettext
open OASISSection
- type library_name = name
- type findlib_part_name = name
- type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t
-
- exception InternalLibraryNotFound of library_name
- exception FindlibPackageNotFound of findlib_name
-
- type group_t =
- | Container of findlib_name * group_t list
- | Package of (findlib_name *
- common_section *
- build_section *
- library *
- group_t list)
(* Look for a module file, considering capitalization or not. *)
- let find_module source_file_exists (cs, bs, lib) modul =
+ let find_module source_file_exists bs modul =
let possible_base_fn =
List.map
(OASISUnixPath.concat bs.bs_path)
@@ -1469,10 +2046,11 @@ module OASISLibrary = struct
(`No_sources possible_base_fn)
possible_base_fn
+
let source_unix_files ~ctxt (cs, bs, lib) source_file_exists =
List.fold_left
(fun acc modul ->
- match find_module source_file_exists (cs, bs, lib) modul with
+ match find_module source_file_exists bs modul with
| `Sources (base_fn, lst) ->
(base_fn, lst) :: acc
| `No_sources _ ->
@@ -1485,6 +2063,7 @@ module OASISLibrary = struct
[]
(lib.lib_modules @ lib.lib_internal_modules)
+
let generated_unix_files
~ctxt
~is_native
@@ -1494,24 +2073,29 @@ module OASISLibrary = struct
~source_file_exists
(cs, bs, lib) =
- let find_modules lst ext =
+ let find_modules lst ext =
let find_module modul =
- match find_module source_file_exists (cs, bs, lib) modul with
+ 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, _) ->
- [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;
- lst
+ Some lst
in
- List.map
- (fun nm ->
- List.map
- (fun base_fn -> base_fn ^"."^ext)
- (find_module nm))
+ 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)
+ []
lst
in
@@ -1528,16 +2112,20 @@ module OASISLibrary = struct
(* The .cmx that be compiled along *)
let cmxs =
let should_be_built =
- (not lib.lib_pack) && (* Do not install .cmx packed submodules *)
match bs.bs_compiled_object with
| Native -> true
| Best -> is_native
| Byte -> false
in
if should_be_built then
- find_modules
- (lib.lib_modules @ lib.lib_internal_modules)
- "cmx"
+ if lib.lib_pack then
+ find_modules
+ [cs.cs_name]
+ "cmx"
+ else
+ find_modules
+ (lib.lib_modules @ lib.lib_internal_modules)
+ "cmx"
else
[]
in
@@ -1559,7 +2147,7 @@ module OASISLibrary = struct
add_pack_header ([cs.cs_name^".cma"] :: acc)
in
let native acc =
- let acc =
+ let acc =
add_pack_header
(if has_native_dynlink then
[cs.cs_name^".cmxs"] :: acc
@@ -1598,11 +2186,113 @@ module OASISLibrary = struct
acc_nopath)
(headers @ cmxs)
- type data = common_section * build_section * library
+
+end
+
+module OASISObject = struct
+(* # 22 "src/oasis/OASISObject.ml" *)
+
+
+ open OASISTypes
+ open OASISGettext
+
+
+ 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)
+ []
+ obj.obj_modules
+
+
+ let generated_unix_files
+ ~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
+ in
+
+ let header, byte, native, c_object, f =
+ match obj.obj_modules with
+ | [ m ] -> (find_module ".cmi" m,
+ find_module ".cmo" m,
+ find_module ".cmx" m,
+ find_module ".o" m,
+ fun x -> x)
+ | _ -> ([cs.cs_name ^ ".cmi"],
+ [cs.cs_name ^ ".cmo"],
+ [cs.cs_name ^ ".cmx"],
+ [cs.cs_name ^ ".o"],
+ OASISUnixPath.concat bs.bs_path)
+ in
+ List.map (List.map f) (
+ match bs.bs_compiled_object with
+ | Native ->
+ native :: c_object :: byte :: header :: []
+ | Best when is_native ->
+ native :: c_object :: byte :: header :: []
+ | Byte | Best ->
+ byte :: header :: [])
+
+
+end
+
+module OASISFindlib = struct
+(* # 22 "src/oasis/OASISFindlib.ml" *)
+
+
+ open OASISTypes
+ open OASISUtils
+ open OASISGettext
+ open OASISSection
+
+
+ type library_name = name
+ type findlib_part_name = name
+ type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t
+
+
+ exception InternalLibraryNotFound of library_name
+ exception FindlibPackageNotFound of findlib_name
+
+
+ type group_t =
+ | Container of findlib_name * group_t list
+ | Package of (findlib_name *
+ common_section *
+ build_section *
+ [`Library of library | `Object of object_] *
+ group_t list)
+
+
+ type data = common_section *
+ build_section *
+ [`Library of library | `Object of object_]
type tree =
| Node of (data option) * (tree MapString.t)
| Leaf of data
+
let findlib_mapping pkg =
(* Map from library name to either full findlib name or parts + parent. *)
let fndlb_parts_of_lib_name =
@@ -1641,6 +2331,23 @@ module OASISLibrary = struct
mp
end
+ | Object (cs, _, obj) ->
+ begin
+ let obj_name = cs.cs_name in
+ if MapString.mem obj_name mp then
+ failwithf
+ (f_ "The object name '%s' is used more than once.")
+ obj_name;
+ let findlib_full_name = match obj.obj_findlib_fullname with
+ | Some ns -> String.concat "." ns
+ | None -> obj_name
+ in
+ MapString.add
+ obj_name
+ (`Solved findlib_full_name)
+ mp
+ end
+
| Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ ->
mp)
MapString.empty
@@ -1708,7 +2415,7 @@ module OASISLibrary = struct
let lib_name = cs.cs_name in
findlib_name_of_library_name lib_name
in
- let rec add_children nm_lst (children : tree MapString.t) =
+ let rec add_children nm_lst (children: tree MapString.t) =
match nm_lst with
| (hd :: tl) ->
begin
@@ -1778,7 +2485,9 @@ module OASISLibrary = struct
(fun mp ->
function
| Library (cs, bs, lib) ->
- add (cs, bs, lib) mp
+ add (cs, bs, `Library lib) mp
+ | Object (cs, bs, obj) ->
+ add (cs, bs, `Object obj) mp
| _ ->
mp)
MapString.empty
@@ -1809,11 +2518,13 @@ module OASISLibrary = struct
findlib_name_of_library_name,
library_name_of_findlib_name
+
let findlib_of_group =
function
| Container (fndlb_nm, _)
| Package (fndlb_nm, _, _, _, _) -> fndlb_nm
+
let root_of_group grp =
let rec root_lib_aux =
(* We do a DFS in the group. *)
@@ -1838,40 +2549,48 @@ module OASISLibrary = struct
(f_ "Unable to determine root library of findlib library '%s'")
(findlib_of_group grp)
+
end
module OASISFlag = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISFlag.ml" *)
+(* # 22 "src/oasis/OASISFlag.ml" *)
+
end
module OASISPackage = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISPackage.ml" *)
+(* # 22 "src/oasis/OASISPackage.ml" *)
+
end
module OASISSourceRepository = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISSourceRepository.ml" *)
+(* # 22 "src/oasis/OASISSourceRepository.ml" *)
+
end
module OASISTest = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISTest.ml" *)
+(* # 22 "src/oasis/OASISTest.ml" *)
+
end
module OASISDocument = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISDocument.ml" *)
+(* # 22 "src/oasis/OASISDocument.ml" *)
+
end
module OASISExec = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISExec.ml" *)
+(* # 22 "src/oasis/OASISExec.ml" *)
+
open OASISGettext
open OASISUtils
open OASISMessage
+
(* TODO: I don't like this quote, it is there because $(rm) foo expands to
* 'rm -f' foo...
*)
@@ -1902,6 +2621,7 @@ module OASISExec = struct
| Some f, i ->
f i
+
let run_read_output ~ctxt ?f_exit_code cmd args =
let fn =
Filename.temp_file "oasis-" ".txt"
@@ -1933,6 +2653,7 @@ module OASISExec = struct
(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] ->
@@ -1944,10 +2665,12 @@ module OASISExec = struct
end
module OASISFileUtil = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISFileUtil.ml" *)
+(* # 22 "src/oasis/OASISFileUtil.ml" *)
+
open OASISGettext
+
let file_exists_case fn =
let dirname = Filename.dirname fn in
let basename = Filename.basename fn in
@@ -1961,6 +2684,7 @@ module OASISFileUtil = struct
else
false
+
let find_file ?(case_sensitive=true) paths exts =
(* Cardinal product of two list *)
@@ -1969,7 +2693,7 @@ module OASISFileUtil = struct
(List.map
(fun a ->
List.map
- (fun b -> a,b)
+ (fun b -> a, b)
lst2)
lst1)
in
@@ -1979,7 +2703,7 @@ module OASISFileUtil = struct
| p1 :: p2 :: tl ->
let acc =
(List.map
- (fun (a,b) -> Filename.concat a b)
+ (fun (a, b) -> Filename.concat a b)
(p1 * p2))
in
combined_paths (acc :: tl)
@@ -1991,19 +2715,21 @@ module OASISFileUtil = struct
let alternatives =
List.map
- (fun (p,e) ->
+ (fun (p, e) ->
if String.length e > 0 && e.[0] <> '.' then
p ^ "." ^ e
else
p ^ e)
((combined_paths paths) * exts)
in
- List.find
+ List.find (fun file ->
(if case_sensitive then
- file_exists_case
+ file_exists_case file
else
- Sys.file_exists)
- alternatives
+ Sys.file_exists file)
+ && not (Sys.is_directory file)
+ ) alternatives
+
let which ~ctxt prg =
let path_sep =
@@ -2023,6 +2749,7 @@ module OASISFileUtil = struct
in
find_file ~case_sensitive:false [path_lst; [prg]] exec_ext
+
(**/**)
let rec fix_dir dn =
(* Windows hack because Sys.file_exists "src\\" = false when
@@ -2036,9 +2763,11 @@ module OASISFileUtil = struct
else
dn
+
let q = Filename.quote
(**/**)
+
let cp ~ctxt ?(recurse=false) src tgt =
if recurse then
match Sys.os_type with
@@ -2055,6 +2784,7 @@ module OASISFileUtil = struct
| _ -> "cp")
[q src; q tgt]
+
let mkdir ~ctxt tgt =
OASISExec.run ~ctxt
(match Sys.os_type with
@@ -2062,6 +2792,7 @@ module OASISFileUtil = struct
| _ -> "mkdir")
[q tgt]
+
let rec mkdir_parent ~ctxt f tgt =
let tgt =
fix_dir tgt
@@ -2084,15 +2815,20 @@ module OASISFileUtil = struct
end
end
+
let rmdir ~ctxt tgt =
- if Sys.readdir tgt = [||] then
- begin
- match Sys.os_type with
- | "Win32" ->
- OASISExec.run ~ctxt "rd" [q tgt]
- | _ ->
- OASISExec.run ~ctxt "rm" ["-r"; q tgt]
- end
+ if Sys.readdir tgt = [||] then begin
+ match Sys.os_type with
+ | "Win32" ->
+ OASISExec.run ~ctxt "rd" [q tgt]
+ | _ ->
+ OASISExec.run ~ctxt "rm" ["-r"; q tgt]
+ end else begin
+ OASISMessage.error ~ctxt
+ (f_ "Cannot remove directory '%s': not empty.")
+ tgt
+ end
+
let glob ~ctxt fn =
let basename =
@@ -2139,19 +2875,23 @@ module OASISFileUtil = struct
end
-# 2142 "setup.ml"
+# 2878 "setup.ml"
module BaseEnvLight = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseEnvLight.ml" *)
+(* # 22 "src/base/BaseEnvLight.ml" *)
+
module MapString = Map.Make(String)
+
type t = string MapString.t
+
let default_filename =
Filename.concat
(Sys.getcwd ())
"setup.data"
+
let load ?(allow_empty=false) ?(filename=default_filename) () =
if Sys.file_exists filename then
begin
@@ -2209,26 +2949,29 @@ module BaseEnvLight = struct
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
+
+ let rec var_expand str env =
+ let buff =
+ Buffer.create ((String.length str) * 2)
in
- var_expand (MapString.find name env)
+ Buffer.add_substitute
+ buff
+ (fun var ->
+ try
+ var_expand (MapString.find var env) env
+ with Not_found ->
+ failwith
+ (Printf.sprintf
+ "No variable %s defined when trying to expand %S."
+ var
+ str))
+ str;
+ Buffer.contents buff
+
+
+ let var_get name env =
+ var_expand (MapString.find name env) env
+
let var_choose lst env =
OASISExpr.choose
@@ -2237,20 +2980,24 @@ module BaseEnvLight = struct
end
-# 2240 "setup.ml"
+# 2983 "setup.ml"
module BaseContext = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseContext.ml" *)
+(* # 22 "src/base/BaseContext.ml" *)
+ (* TODO: get rid of this module. *)
open OASISContext
- let args = args
+
+ let args () = fst (fspecs ())
+
let default = default
end
module BaseMessage = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseMessage.ml" *)
+(* # 22 "src/base/BaseMessage.ml" *)
+
(** Message to user, overrid for Base
@author Sylvain Le Gall
@@ -2258,31 +3005,38 @@ module BaseMessage = struct
open OASISMessage
open BaseContext
+
let debug fmt = debug ~ctxt:!default fmt
+
let info fmt = info ~ctxt:!default fmt
+
let warning fmt = warning ~ctxt:!default fmt
+
let error fmt = error ~ctxt:!default fmt
end
module BaseEnv = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseEnv.ml" *)
+(* # 22 "src/base/BaseEnv.ml" *)
open OASISGettext
open OASISUtils
open PropList
+
module MapString = BaseEnvLight.MapString
+
type origin_t =
| ODefault
| OGetEnv
| OFileLoad
| OCommandLine
+
type cli_handle_t =
| CLINone
| CLIAuto
@@ -2290,6 +3044,7 @@ module BaseEnv = struct
| CLIEnable
| CLIUser of (Arg.key * Arg.spec * Arg.doc) list
+
type definition_t =
{
hide: bool;
@@ -2299,21 +3054,26 @@ module BaseEnv = struct
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)
@@ -2364,6 +3124,7 @@ module BaseEnv = struct
str;
Buffer.contents buff
+
and var_get name =
let vl =
try
@@ -2378,6 +3139,7 @@ module BaseEnv = struct
in
var_expand vl
+
let var_choose ?printer ?name lst =
OASISExpr.choose
?printer
@@ -2385,6 +3147,7 @@ module BaseEnv = struct
var_get
lst
+
let var_protect vl =
let buff =
Buffer.create (String.length vl)
@@ -2396,6 +3159,7 @@ module BaseEnv = struct
vl;
Buffer.contents buff
+
let var_define
?(hide=false)
?(dump=true)
@@ -2481,6 +3245,7 @@ module BaseEnv = struct
fun () ->
var_expand (var_get_low (var_get_lst env))
+
let var_redefine
?hide
?dump
@@ -2509,8 +3274,9 @@ module BaseEnv = struct
dflt
end
- let var_ignore (e : unit -> string) =
- ()
+
+ let var_ignore (e: unit -> string) = ()
+
let print_hidden =
var_define
@@ -2521,6 +3287,7 @@ module BaseEnv = struct
"print_hidden"
(fun () -> "false")
+
let var_all () =
List.rev
(Schema.fold
@@ -2532,24 +3299,28 @@ module BaseEnv = struct
[]
schema)
+
let default_filename =
BaseEnvLight.default_filename
+
let load ?allow_empty ?filename () =
env_from_file := BaseEnvLight.load ?allow_empty ?filename ()
+
let unload () =
env_from_file := MapString.empty;
Data.clear env
+
let dump ?(filename=default_filename) () =
let chn =
open_out_bin filename
in
- let output nm value =
+ let output nm value =
Printf.fprintf chn "%s=%S\n" nm value
in
- let mp_todo =
+ let mp_todo =
(* Dump data from schema *)
Schema.fold
(fun mp_todo nm def _ ->
@@ -2576,6 +3347,7 @@ module BaseEnv = struct
(* End of the dump *)
close_out chn
+
let print () =
let printable_vars =
Schema.fold
@@ -2614,11 +3386,12 @@ module BaseEnv = struct
Printf.printf "\nConfiguration: \n";
List.iter
- (fun (name,value) ->
+ (fun (name, value) ->
Printf.printf "%s: %s %s\n" name (dot_pad name) value)
(List.rev printable_vars);
Printf.printf "\n%!"
+
let args () =
let arg_concat =
OASISUtils.varname_concat ~hyphen:'-'
@@ -2729,11 +3502,13 @@ module BaseEnv = struct
end
module BaseArgExt = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseArgExt.ml" *)
+(* # 22 "src/base/BaseArgExt.ml" *)
+
open OASISUtils
open OASISGettext
+
let parse argv args =
(* Simulate command line for Arg *)
let current =
@@ -2757,13 +3532,15 @@ module BaseArgExt = struct
end
module BaseCheck = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseCheck.ml" *)
+(* # 22 "src/base/BaseCheck.ml" *)
+
open BaseEnv
open BaseMessage
open OASISUtils
open OASISGettext
+
let prog_best prg prg_lst =
var_redefine
prg
@@ -2786,15 +3563,19 @@ module BaseCheck = struct
| 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
@@ -2836,11 +3617,13 @@ module BaseCheck = struct
version_str)
()
+
let package_version pkg =
OASISExec.run_read_one_line ~ctxt:!BaseContext.default
(ocamlfind ())
["query"; "-format"; "%v"; pkg]
+
let package ?version_comparator pkg () =
let var =
OASISUtils.varname_concat
@@ -2883,18 +3666,21 @@ module BaseCheck = struct
end
module BaseOCamlcConfig = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseOCamlcConfig.ml" *)
+(* # 22 "src/base/BaseOCamlcConfig.ml" *)
open BaseEnv
open OASISUtils
open OASISGettext
+
module SMap = Map.Make(String)
+
let ocamlc =
BaseCheck.prog_opt "ocamlc"
+
let ocamlc_config_map =
(* Map name to value for ocamlc -config output
(name ^": "^value)
@@ -2940,7 +3726,7 @@ module BaseOCamlcConfig = struct
mp
in
- let cache =
+ let cache =
lazy
(var_protect
(Marshal.to_string
@@ -2959,6 +3745,7 @@ module BaseOCamlcConfig = struct
(* TODO: update if ocamlc change !!! *)
Lazy.force cache)
+
let var_define nm =
(* Extract data from ocamlc -config *)
let avlbl_config_get () =
@@ -2967,15 +3754,15 @@ module BaseOCamlcConfig = struct
0
in
let chop_version_suffix s =
- try
+ try
String.sub s 0 (String.index s '+')
- with _ ->
+ with _ ->
s
in
let nm_config, value_config =
match nm with
- | "ocaml_version" ->
+ | "ocaml_version" ->
"version", chop_version_suffix
| _ -> nm, (fun x -> x)
in
@@ -2999,7 +3786,7 @@ module BaseOCamlcConfig = struct
end
module BaseStandardVar = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseStandardVar.ml" *)
+(* # 22 "src/base/BaseStandardVar.ml" *)
open OASISGettext
@@ -3008,6 +3795,7 @@ module BaseStandardVar = struct
open BaseCheck
open BaseEnv
+
let ocamlfind = BaseCheck.ocamlfind
let ocamlc = BaseOCamlcConfig.ocamlc
let ocamlopt = prog_opt "ocamlopt"
@@ -3018,13 +3806,16 @@ module BaseStandardVar = struct
let rpkg =
ref None
+
let pkg_get () =
match !rpkg with
| Some pkg -> pkg
| None -> failwith (s_ "OASIS Package is not set")
+
let var_cond = ref []
+
let var_define_cond ~since_version f dflt =
let holder = ref (fun () -> dflt) in
let since_version =
@@ -3036,14 +3827,17 @@ module BaseStandardVar = struct
holder := f ()) :: !var_cond;
fun () -> !holder ()
+
(**/**)
+
let pkg_name =
var_define
~short_desc:(fun () -> s_ "Package name")
"pkg_name"
(fun () -> (pkg_get ()).name)
+
let pkg_version =
var_define
~short_desc:(fun () -> s_ "Package version")
@@ -3051,16 +3845,20 @@ module BaseStandardVar = struct
(fun () ->
(OASISVersion.string_of_version (pkg_get ()).version))
+
let c = BaseOCamlcConfig.var_define
+
let os_type = c "os_type"
let system = c "system"
let architecture = c "architecture"
let ccomp_type = c "ccomp_type"
let ocaml_version = c "ocaml_version"
+
(* TODO: Check standard variable presence at runtime *)
+
let standard_library_default = c "standard_library_default"
let standard_library = c "standard_library"
let standard_runtime = c "standard_runtime"
@@ -3074,24 +3872,27 @@ module BaseStandardVar = struct
let default_executable_name = c "default_executable_name"
let systhread_supported = c "systhread_supported"
- let flexlink =
+
+ let flexlink =
BaseCheck.prog "flexlink"
+
let flexdll_version =
var_define
~short_desc:(fun () -> "FlexDLL version (Win32)")
"flexdll_version"
(fun () ->
- let lst =
+ let lst =
OASISExec.run_read_output ~ctxt:!BaseContext.default
(flexlink ()) ["-help"]
in
- match lst with
+ match lst with
| line :: _ ->
Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver)
| [] ->
raise Not_found)
+
(**/**)
let p name hlp dflt =
var_define
@@ -3101,6 +3902,7 @@ module BaseStandardVar = struct
name
dflt
+
let (/) a b =
if os_type () = Sys.os_type then
Filename.concat a b
@@ -3111,6 +3913,7 @@ module BaseStandardVar = struct
(os_type ())
(**/**)
+
let prefix =
p "prefix"
(fun () -> s_ "Install architecture-independent files dir")
@@ -3124,96 +3927,115 @@ module BaseStandardVar = struct
| _ ->
"/usr/local")
+
let exec_prefix =
p "exec_prefix"
(fun () -> s_ "Install architecture-dependent files in dir")
(fun () -> "$prefix")
+
let bindir =
p "bindir"
(fun () -> s_ "User executables")
(fun () -> "$exec_prefix"/"bin")
+
let sbindir =
p "sbindir"
(fun () -> s_ "System admin executables")
(fun () -> "$exec_prefix"/"sbin")
+
let libexecdir =
p "libexecdir"
(fun () -> s_ "Program executables")
(fun () -> "$exec_prefix"/"libexec")
+
let sysconfdir =
p "sysconfdir"
(fun () -> s_ "Read-only single-machine data")
(fun () -> "$prefix"/"etc")
+
let sharedstatedir =
p "sharedstatedir"
(fun () -> s_ "Modifiable architecture-independent data")
(fun () -> "$prefix"/"com")
+
let localstatedir =
p "localstatedir"
(fun () -> s_ "Modifiable single-machine data")
(fun () -> "$prefix"/"var")
+
let libdir =
p "libdir"
(fun () -> s_ "Object code libraries")
(fun () -> "$exec_prefix"/"lib")
+
let datarootdir =
p "datarootdir"
(fun () -> s_ "Read-only arch-independent data root")
(fun () -> "$prefix"/"share")
+
let datadir =
p "datadir"
(fun () -> s_ "Read-only architecture-independent data")
(fun () -> "$datarootdir")
+
let infodir =
p "infodir"
(fun () -> s_ "Info documentation")
(fun () -> "$datarootdir"/"info")
+
let localedir =
p "localedir"
(fun () -> s_ "Locale-dependent data")
(fun () -> "$datarootdir"/"locale")
+
let mandir =
p "mandir"
(fun () -> s_ "Man documentation")
(fun () -> "$datarootdir"/"man")
+
let docdir =
p "docdir"
(fun () -> s_ "Documentation root")
(fun () -> "$datarootdir"/"doc"/"$pkg_name")
+
let htmldir =
p "htmldir"
(fun () -> s_ "HTML documentation")
(fun () -> "$docdir")
+
let dvidir =
p "dvidir"
(fun () -> s_ "DVI documentation")
(fun () -> "$docdir")
+
let pdfdir =
p "pdfdir"
(fun () -> s_ "PDF documentation")
(fun () -> "$docdir")
+
let psdir =
p "psdir"
(fun () -> s_ "PS documentation")
(fun () -> "$docdir")
+
let destdir =
p "destdir"
(fun () -> s_ "Prepend a path when installing package")
@@ -3223,35 +4045,39 @@ module BaseStandardVar = struct
("destdir",
Some (s_ "undefined by construct"))))
+
let findlib_version =
var_define
"findlib_version"
(fun () ->
BaseCheck.package_version "findlib")
+
let is_native =
var_define
"is_native"
(fun () ->
try
- let _s : string =
+ let _s: string =
ocamlopt ()
in
"true"
with PropList.Not_set _ ->
- let _s : string =
+ let _s: string =
ocamlc ()
in
"false")
+
let ext_program =
var_define
"suffix_program"
(fun () ->
match os_type () with
- | "Win32" -> ".exe"
+ | "Win32" | "Cygwin" -> ".exe"
| _ -> "")
+
let rm =
var_define
~short_desc:(fun () -> s_ "Remove a file.")
@@ -3261,6 +4087,7 @@ module BaseStandardVar = struct
| "Win32" -> "del"
| _ -> "rm -f")
+
let rmdir =
var_define
~short_desc:(fun () -> s_ "Remove a directory.")
@@ -3270,6 +4097,7 @@ module BaseStandardVar = struct
| "Win32" -> "rd"
| _ -> "rm -rf")
+
let debug =
var_define
~short_desc:(fun () -> s_ "Turn ocaml debug flag on")
@@ -3277,6 +4105,7 @@ module BaseStandardVar = struct
"debug"
(fun () -> "true")
+
let profile =
var_define
~short_desc:(fun () -> s_ "Turn ocaml profile flag on")
@@ -3284,6 +4113,7 @@ module BaseStandardVar = struct
"profile"
(fun () -> "false")
+
let tests =
var_define_cond ~since_version:"0.3"
(fun () ->
@@ -3295,6 +4125,7 @@ module BaseStandardVar = struct
(fun () -> "false"))
"true"
+
let docs =
var_define_cond ~since_version:"0.3"
(fun () ->
@@ -3305,6 +4136,7 @@ module BaseStandardVar = struct
(fun () -> "true"))
"true"
+
let native_dynlink =
var_define
~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.")
@@ -3312,7 +4144,7 @@ module BaseStandardVar = struct
"native_dynlink"
(fun () ->
let res =
- let ocaml_lt_312 () =
+ let ocaml_lt_312 () =
OASISVersion.comparator_apply
(OASISVersion.version_of_string (ocaml_version ()))
(OASISVersion.VLesser
@@ -3324,7 +4156,7 @@ module BaseStandardVar = struct
(OASISVersion.VLesser
(OASISVersion.version_of_string "0.30"))
in
- let has_native_dynlink =
+ let has_native_dynlink =
let ocamlfind = ocamlfind () in
try
let fn =
@@ -3342,10 +4174,10 @@ module BaseStandardVar = struct
false
else if ocaml_lt_312 () then
false
- else if (os_type () = "Win32" || os_type () = "Cygwin")
+ else if (os_type () = "Win32" || os_type () = "Cygwin")
&& flexdll_lt_030 () then
begin
- BaseMessage.warning
+ 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 ());
@@ -3356,6 +4188,7 @@ module BaseStandardVar = struct
in
string_of_bool res)
+
let init pkg =
rpkg := Some pkg;
List.iter (fun f -> f pkg.oasis_version) !var_cond
@@ -3363,12 +4196,14 @@ module BaseStandardVar = struct
end
module BaseFileAB = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseFileAB.ml" *)
+(* # 22 "src/base/BaseFileAB.ml" *)
+
open BaseEnv
open OASISGettext
open BaseMessage
+
let to_filename fn =
let fn =
OASISHostPath.of_unix fn
@@ -3379,6 +4214,7 @@ module BaseFileAB = struct
fn;
Filename.chop_extension fn
+
let replace fn_lst =
let buff =
Buffer.create 13
@@ -3411,15 +4247,18 @@ module BaseFileAB = struct
end
module BaseLog = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseLog.ml" *)
+(* # 22 "src/base/BaseLog.ml" *)
+
open OASISUtils
+
let default_filename =
Filename.concat
(Filename.dirname BaseEnv.default_filename)
"setup.log"
+
module SetTupleString =
Set.Make
(struct
@@ -3430,6 +4269,7 @@ module BaseLog = struct
| n -> n
end)
+
let load () =
if Sys.file_exists default_filename then
begin
@@ -3479,6 +4319,7 @@ module BaseLog = struct
[]
end
+
let register event data =
let chn_out =
open_out_gen [Open_append; Open_creat; Open_text] 0o644 default_filename
@@ -3486,6 +4327,7 @@ module BaseLog = struct
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
@@ -3511,6 +4353,7 @@ module BaseLog = struct
Sys.remove default_filename
end
+
let filter events =
let st_events =
List.fold_left
@@ -3523,6 +4366,7 @@ module BaseLog = struct
(fun (e, _) -> SetString.mem e st_events)
(load ())
+
let exists event data =
List.exists
(fun v -> (event, data) = v)
@@ -3530,31 +4374,38 @@ module BaseLog = struct
end
module BaseBuilt = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseBuilt.ml" *)
+(* # 22 "src/base/BaseBuilt.ml" *)
+
open OASISTypes
open OASISGettext
open BaseStandardVar
open BaseMessage
+
type t =
| BExec (* Executable *)
| BExecLib (* Library coming with executable *)
| BLib (* Library *)
+ | BObj (* Library *)
| BDoc (* Document *)
+
let to_log_event_file t nm =
"built_"^
(match t with
| BExec -> "exec"
| BExecLib -> "exec_lib"
| BLib -> "lib"
+ | 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)
@@ -3585,6 +4436,7 @@ module BaseBuilt = struct
(String.concat (s_ ", ") alt))
lst
+
let unregister t nm =
List.iter
(fun (e, d) ->
@@ -3593,6 +4445,7 @@ module BaseBuilt = struct
[to_log_event_file t nm;
to_log_event_done t nm])
+
let fold t nm f acc =
List.fold_left
(fun acc (_, fn) ->
@@ -3612,6 +4465,8 @@ module BaseBuilt = struct
(f_ "executable %s")
| BLib ->
(f_ "library %s")
+ | BObj ->
+ (f_ "object %s")
| BDoc ->
(f_ "documentation %s"))
nm);
@@ -3621,6 +4476,7 @@ module BaseBuilt = struct
(BaseLog.filter
[to_log_event_file t nm])
+
let is_built t nm =
List.fold_left
(fun is_built (_, d) ->
@@ -3632,6 +4488,7 @@ module BaseBuilt = struct
(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
@@ -3655,6 +4512,7 @@ module BaseBuilt = struct
unix_exec_is,
unix_dll_opt
+
let of_library ffn (cs, bs, lib) =
let unix_lst =
OASISLibrary.generated_unix_files
@@ -3674,16 +4532,35 @@ module BaseBuilt = struct
in
evs, unix_lst
+
+ let of_object ffn (cs, bs, obj) =
+ let unix_lst =
+ OASISObject.generated_unix_files
+ ~ctxt:!BaseContext.default
+ ~source_file_exists:(fun fn ->
+ OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
+ ~is_native:(bool_of_string (is_native ()))
+ (cs, bs, obj)
+ in
+ let evs =
+ [BObj,
+ cs.cs_name,
+ List.map (List.map ffn) unix_lst]
+ in
+ evs, unix_lst
+
end
module BaseCustom = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseCustom.ml" *)
+(* # 22 "src/base/BaseCustom.ml" *)
+
open BaseEnv
open BaseMessage
open OASISTypes
open OASISGettext
+
let run cmd args extra_args =
OASISExec.run ~ctxt:!BaseContext.default ~quote:false
(var_expand cmd)
@@ -3691,6 +4568,7 @@ module BaseCustom = struct
var_expand
(args @ (Array.to_list extra_args)))
+
let hook ?(failsafe=false) cstm f e =
let optional_command lst =
let printer =
@@ -3727,7 +4605,7 @@ module BaseCustom = struct
end
module BaseDynVar = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseDynVar.ml" *)
+(* # 22 "src/base/BaseDynVar.ml" *)
open OASISTypes
@@ -3735,6 +4613,7 @@ module BaseDynVar = struct
open BaseEnv
open BaseBuilt
+
let init pkg =
(* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *)
(* TODO: provide compile option for library libary_byte_args_VARNAME... *)
@@ -3768,13 +4647,14 @@ module BaseDynVar = struct
(f_ "Executable '%s' not yet built.")
cs.cs_name)))))
- | Library _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
+ | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
())
pkg.sections
end
module BaseTest = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseTest.ml" *)
+(* # 22 "src/base/BaseTest.ml" *)
+
open BaseEnv
open BaseMessage
@@ -3782,6 +4662,7 @@ module BaseTest = struct
open OASISExpr
open OASISGettext
+
let test lst pkg extra_args =
let one_test (failure, n) (test_plugin, cs, test) =
@@ -3832,7 +4713,7 @@ module BaseTest = struct
(failure, n)
end
in
- let (failed, n) =
+ let failed, n =
List.fold_left
one_test
(0.0, 0)
@@ -3855,7 +4736,7 @@ module BaseTest = struct
info "%s" msg;
(* Possible explanation why the tests where not run. *)
- if OASISVersion.version_0_3_or_after pkg.oasis_version &&
+ if OASISFeatures.package_test OASISFeatures.flag_tests pkg &&
not (bool_of_string (BaseStandardVar.tests ())) &&
lst <> [] then
BaseMessage.warning
@@ -3864,13 +4745,15 @@ module BaseTest = struct
end
module BaseDoc = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseDoc.ml" *)
+(* # 22 "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) =
@@ -3890,7 +4773,7 @@ module BaseDoc = struct
in
List.iter one_doc lst;
- if OASISVersion.version_0_3_or_after pkg.oasis_version &&
+ if OASISFeatures.package_test OASISFeatures.flag_docs pkg &&
not (bool_of_string (BaseStandardVar.docs ())) &&
lst <> [] then
BaseMessage.warning
@@ -3899,7 +4782,7 @@ module BaseDoc = struct
end
module BaseSetup = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseSetup.ml" *)
+(* # 22 "src/base/BaseSetup.ml" *)
open BaseEnv
open BaseMessage
@@ -3908,12 +4791,15 @@ module BaseSetup = struct
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;
@@ -3937,6 +4823,7 @@ module BaseSetup = struct
setup_update: bool;
}
+
(* Associate a plugin function with data from package *)
let join_plugin_sections filter_map lst =
List.rev
@@ -3950,6 +4837,7 @@ module BaseSetup = struct
[]
lst)
+
(* Search for plugin data associated with a section name *)
let lookup_plugin_section plugin action nm lst =
try
@@ -3961,11 +4849,12 @@ module BaseSetup = struct
nm
action
+
let configure t args =
(* Run configure *)
BaseCustom.hook
t.package.conf_custom
- (fun () ->
+ (fun () ->
(* Reload if preconf has changed it *)
begin
try
@@ -3992,12 +4881,14 @@ module BaseSetup = struct
(* 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
@@ -4017,6 +4908,7 @@ module BaseSetup = struct
t.package
args
+
let test t args =
BaseTest.test
(join_plugin_sections
@@ -4036,12 +4928,16 @@ module BaseSetup = struct
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)
@@ -4056,12 +4952,16 @@ module BaseSetup = struct
"-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 [||];
+ configure t (Array.of_list (List.rev !arg_rest));
info "Running build step";
build t [||];
@@ -4089,22 +4989,26 @@ module BaseSetup = struct
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
@@ -4146,6 +5050,7 @@ module BaseSetup = struct
(f t.package (cs, doc))
args
| Library _
+ | Object _
| Executable _
| Flag _
| SrcRepo _ ->
@@ -4201,9 +5106,11 @@ module BaseSetup = struct
clean, distclean
+
let version t _ =
print_endline t.oasis_version
+
let update_setup_ml, no_update_setup_ml_cli =
let b = ref true in
b,
@@ -4211,11 +5118,15 @@ module BaseSetup = struct
Arg.Clear b,
s_ " Don't try to update setup.ml, even if _oasis has changed.")
+
+ let default_oasis_fn = "_oasis"
+
+
let update_setup_ml t =
let oasis_fn =
match t.oasis_fn with
| Some fn -> fn
- | None -> "_oasis"
+ | None -> default_oasis_fn
in
let oasis_exec =
match t.oasis_exec with
@@ -4313,7 +5224,8 @@ module BaseSetup = struct
try
match t.oasis_digest with
| Some dgst ->
- if Sys.file_exists oasis_fn && dgst <> Digest.file "_oasis" then
+ if Sys.file_exists oasis_fn &&
+ dgst <> Digest.file default_oasis_fn then
begin
do_update ();
true
@@ -4333,6 +5245,7 @@ module BaseSetup = struct
else
false
+
let setup t =
let catch_exn =
ref true
@@ -4474,41 +5387,34 @@ module BaseSetup = struct
error "%s" (Printexc.to_string e);
exit 1
+
end
-# 4480 "setup.ml"
+# 5394 "setup.ml"
module InternalConfigurePlugin = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/internal/InternalConfigurePlugin.ml" *)
+(* # 22 "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 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
@@ -4656,6 +5562,20 @@ module InternalConfigurePlugin = struct
| None ->
()
end;
+ (* Make sure the findlib version is fine for the OCaml compiler. *)
+ begin
+ let ocaml_ge4 =
+ OASISVersion.version_compare
+ (OASISVersion.version_of_string (BaseStandardVar.ocaml_version()))
+ (OASISVersion.version_of_string "4.0.0") >= 0 in
+ if ocaml_ge4 then
+ let findlib_lt132 =
+ OASISVersion.version_compare
+ (OASISVersion.version_of_string (BaseStandardVar.findlib_version()))
+ (OASISVersion.version_of_string "1.3.2") < 0 in
+ if findlib_lt132 then
+ add_errors "OCaml >= 4.0.0 requires Findlib version >= 1.3.2"
+ end;
(* FlexDLL *)
if BaseStandardVar.os_type () = "Win32" ||
@@ -4718,43 +5638,58 @@ module InternalConfigurePlugin = struct
(SetString.cardinal !errors)
end
+
end
module InternalInstallPlugin = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/internal/InternalInstallPlugin.ml" *)
+(* # 22 "src/plugins/internal/InternalInstallPlugin.ml" *)
+
(** Install using internal scheme
@author Sylvain Le Gall
*)
+
open BaseEnv
open BaseStandardVar
open BaseMessage
open OASISTypes
- open OASISLibrary
+ open OASISFindlib
open OASISGettext
open OASISUtils
+
let exec_hook =
ref (fun (cs, bs, exec) -> cs, bs, exec)
+
let lib_hook =
ref (fun (cs, bs, lib) -> cs, bs, lib, [])
+
+ let 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 install_dir_ev =
"install-dir"
+
let install_findlib_ev =
"install-findlib"
+
let win32_max_command_line_length = 8000
+
let split_install_command ocamlfind findlib_name meta files =
if Sys.os_type = "Win32" then
(* Arguments for the first command: *)
@@ -4794,20 +5729,21 @@ module InternalInstallPlugin = struct
| (firsts, others) ->
let cmd = args @ firsts in
(* Use -add for remaining commands: *)
- let () =
+ let () =
let findlib_ge_132 =
OASISVersion.comparator_apply
- (OASISVersion.version_of_string
+ (OASISVersion.version_of_string
(BaseStandardVar.findlib_version ()))
- (OASISVersion.VGreaterEqual
+ (OASISVersion.VGreaterEqual
(OASISVersion.version_of_string "1.3.2"))
in
if not findlib_ge_132 then
failwithf
- (f_ "Installing the library %s require to use the flag \
- '-add' of ocamlfind because the command line is too \
- long. This flag is only available for findlib 1.3.2. \
- Please upgrade findlib from %s to 1.3.2")
+ (f_ "Installing the library %s require to use the \
+ flag '-add' of ocamlfind because the command \
+ line is too long. This flag is only available \
+ for findlib 1.3.2. Please upgrade findlib from \
+ %s to 1.3.2")
findlib_name (BaseStandardVar.findlib_version ())
in
let cmds = split other_args others in
@@ -4818,6 +5754,7 @@ module InternalInstallPlugin = struct
else
["install" :: findlib_name :: meta :: files]
+
let install pkg argv =
let in_destdir =
@@ -4961,6 +5898,75 @@ module InternalInstallPlugin = struct
begin
(f_data, acc)
end
+ and files_of_object (f_data, acc) data_obj =
+ let cs, bs, obj, obj_extra =
+ !obj_hook data_obj
+ 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
+
+ let acc =
+ (* Get generated files *)
+ BaseBuilt.fold
+ BaseBuilt.BObj
+ cs.cs_name
+ (fun acc fn -> fn :: acc)
+ 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
+
+ (f_data, acc)
+ end
+ else
+ begin
+ (f_data, acc)
+ end
+
in
(* Install one group of library *)
@@ -4971,8 +5977,10 @@ module InternalInstallPlugin = struct
match grp with
| Container (_, children) ->
data_and_files, children
- | Package (_, cs, bs, lib, 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
in
List.fold_left
install_group_lib_aux
@@ -5006,7 +6014,7 @@ module InternalInstallPlugin = struct
begin
let meta =
(* Search META file *)
- let (_, bs, _) =
+ let _, bs, _ =
root_lib
in
let res =
@@ -5019,7 +6027,7 @@ module InternalInstallPlugin = struct
findlib_name;
res
in
- let files =
+ let files =
(* Make filename shorter to avoid hitting command max line length
* too early, esp. on Windows.
*)
@@ -5028,24 +6036,24 @@ module InternalInstallPlugin = struct
let nlen = String.length n in
if plen <= nlen && String.sub n 0 plen = p then
begin
- let fn_sep =
+ let fn_sep =
if Sys.os_type = "Win32" then
'\\'
else
'/'
in
let cutpoint = plen +
- (if plen < nlen && n.[plen] = fn_sep then
+ (if plen < nlen && n.[plen] = fn_sep then
1
- else
+ else
0)
in
String.sub n cutpoint (nlen - cutpoint)
end
- else
+ else
n
in
- List.map (remove_prefix (Sys.getcwd ())) files
+ List.map (remove_prefix (Sys.getcwd ())) files
in
info
(f_ "Installing findlib library '%s'")
@@ -5079,7 +6087,7 @@ module InternalInstallPlugin = struct
let install_execs pkg =
let install_exec data_exec =
- let (cs, bs, exec) =
+ let cs, bs, exec =
!exec_hook data_exec
in
if var_choose bs.bs_install &&
@@ -5126,7 +6134,7 @@ module InternalInstallPlugin = struct
let install_docs pkg =
let install_doc data =
- let (cs, doc) =
+ let cs, doc =
!doc_hook data
in
if var_choose doc.doc_install &&
@@ -5162,6 +6170,7 @@ module InternalInstallPlugin = struct
install_execs pkg;
install_docs pkg
+
(* Uninstall already installed data *)
let uninstall _ argv =
List.iter
@@ -5225,24 +6234,34 @@ module InternalInstallPlugin = struct
(BaseLog.filter
[install_file_ev;
install_dir_ev;
- install_findlib_ev;]))
+ install_findlib_ev]))
+
end
-# 5233 "setup.ml"
+# 6243 "setup.ml"
module OCamlbuildCommon = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
+(* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
+
(** Functions common to OCamlbuild build and doc plugin
*)
+
open OASISGettext
open BaseEnv
open BaseStandardVar
+ open OASISTypes
+
+
+
+
+ type extra_args = string list
+
+
+ let ocamlbuild_clean_ev = "ocamlbuild-clean"
- let ocamlbuild_clean_ev =
- "ocamlbuild-clean"
let ocamlbuildflags =
var_define
@@ -5250,6 +6269,7 @@ module OCamlbuildCommon = struct
"ocamlbuildflags"
(fun () -> "")
+
(** Fix special arguments depending on environment *)
let fix_args args extra_argv =
List.flatten
@@ -5288,6 +6308,7 @@ module OCamlbuildCommon = struct
Array.to_list extra_argv;
]
+
(** Run 'ocamlbuild -clean' if not already done *)
let run_clean extra_argv =
let extra_cli =
@@ -5307,6 +6328,7 @@ module OCamlbuildCommon = struct
())
end
+
(** Run ocamlbuild, unregister all clean events *)
let run_ocamlbuild args extra_argv =
(* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html
@@ -5318,6 +6340,7 @@ module OCamlbuildCommon = struct
(fun (e, d) -> BaseLog.unregister e d)
(BaseLog.filter [ocamlbuild_clean_ev])
+
(** Determine real build directory *)
let build_dir extra_argv =
let rec search_args dir =
@@ -5331,28 +6354,36 @@ module OCamlbuildCommon = struct
in
search_args "_build" (fix_args [] extra_argv)
+
end
module OCamlbuildPlugin = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *)
+(* # 22 "src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *)
+
(** Build using ocamlbuild
@author Sylvain Le Gall
*)
+
open OASISTypes
open OASISGettext
open OASISUtils
+ open OASISString
open BaseEnv
open OCamlbuildCommon
open BaseStandardVar
open BaseMessage
+
+
+
+
let cond_targets_hook =
ref (fun lst -> lst)
- let build pkg argv =
+ let build extra_args pkg argv =
(* Return the filename in build directory *)
let in_build_dir fn =
Filename.concat
@@ -5377,16 +6408,36 @@ module OCamlbuildPlugin = struct
(cs, bs, lib)
in
- let ends_with nd fn =
- let nd_len =
- String.length nd
- in
- (String.length fn >= nd_len)
- &&
- (String.sub
- fn
- (String.length fn - nd_len)
- nd_len) = nd
+ let tgts =
+ List.flatten
+ (List.filter
+ (fun l -> l <> [])
+ (List.map
+ (List.filter
+ (fun fn ->
+ ends_with ~what:".cma" fn
+ || ends_with ~what:".cmxs" fn
+ || ends_with ~what:".cmxa" fn
+ || ends_with ~what:(ext_lib ()) fn
+ || ends_with ~what:(ext_dll ()) fn))
+ unix_files))
+ in
+
+ match tgts with
+ | _ :: _ ->
+ (evs, tgts) :: acc
+ | [] ->
+ failwithf
+ (f_ "No possible ocamlbuild targets for library %s")
+ cs.cs_name
+ end
+
+ | Object (cs, bs, obj) when var_choose bs.bs_build ->
+ begin
+ let evs, unix_files =
+ BaseBuilt.of_object
+ in_build_dir_of_unix
+ (cs, bs, obj)
in
let tgts =
@@ -5396,11 +6447,8 @@ module OCamlbuildPlugin = struct
(List.map
(List.filter
(fun fn ->
- ends_with ".cma" fn
- || ends_with ".cmxs" fn
- || ends_with ".cmxa" fn
- || ends_with (ext_lib ()) fn
- || ends_with (ext_dll ()) fn))
+ ends_with ".cmo" fn
+ || ends_with ".cmx" fn))
unix_files))
in
@@ -5409,7 +6457,7 @@ module OCamlbuildPlugin = struct
(evs, tgts) :: acc
| [] ->
failwithf
- (f_ "No possible ocamlbuild targets for library %s")
+ (f_ "No possible ocamlbuild targets for object %s")
cs.cs_name
end
@@ -5428,12 +6476,13 @@ module OCamlbuildPlugin = struct
(OASISUnixPath.chop_extension
exec.exec_main_is))^ext
in
- let evs =
+ let evs =
(* Fix evs, we want to use the unix_tgt, without copying *)
List.map
(function
| BaseBuilt.BExec, nm, lst when nm = cs.cs_name ->
- BaseBuilt.BExec, nm, [[in_build_dir_of_unix unix_tgt]]
+ BaseBuilt.BExec, nm,
+ [[in_build_dir_of_unix unix_tgt]]
| ev ->
ev)
evs
@@ -5455,7 +6504,7 @@ module OCamlbuildPlugin = struct
acc
end
- | Library _ | Executable _ | Test _
+ | Library _ | Object _ | Executable _ | Test _
| SrcRepo _ | Flag _ | Doc _ ->
acc)
[]
@@ -5469,26 +6518,22 @@ module OCamlbuildPlugin = struct
(fun fns ->
if not (List.exists OASISFileUtil.file_exists_case fns) then
failwithf
- (f_ "No one of expected built files %s exists")
- (String.concat (s_ ", ") (List.map (Printf.sprintf "'%s'") fns)))
+ (fn_
+ "Expected built file %s doesn't exist."
+ "None of expected built files %s exists."
+ (List.length fns))
+ (String.concat (s_ " or ") (List.map (Printf.sprintf "'%s'") fns)))
lst;
(BaseBuilt.register bt bnm lst)
in
- let cond_targets =
- (* Run the hook *)
- !cond_targets_hook cond_targets
- in
+ (* Run the hook *)
+ let cond_targets = !cond_targets_hook cond_targets in
- (* Run a list of target... *)
- run_ocamlbuild
- (List.flatten
- (List.map snd cond_targets))
- argv;
- (* ... and register events *)
- List.iter
- check_and_register
- (List.flatten (List.map fst cond_targets))
+ (* Run a list of target... *)
+ run_ocamlbuild (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 =
@@ -5504,15 +6549,18 @@ module OCamlbuildPlugin = struct
())
pkg.sections
+
end
module OCamlbuildDocPlugin = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *)
+(* # 22 "src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *)
+
(* Create documentation using ocamlbuild .odocl files
@author Sylvain Le Gall
*)
+
open OASISTypes
open OASISGettext
open OASISMessage
@@ -5521,11 +6569,19 @@ module OCamlbuildDocPlugin = struct
- let doc_build path pkg (cs, doc) argv =
+
+ type run_t =
+ {
+ extra_args: string list;
+ run_path: unix_filename;
+ }
+
+
+ let doc_build run pkg (cs, doc) argv =
let index_html =
OASISUnixPath.make
[
- path;
+ run.run_path;
cs.cs_name^".docdir";
"index.html";
]
@@ -5534,11 +6590,11 @@ module OCamlbuildDocPlugin = struct
OASISHostPath.make
[
build_dir argv;
- OASISHostPath.of_unix path;
+ OASISHostPath.of_unix run.run_path;
cs.cs_name^".docdir";
]
in
- run_ocamlbuild [index_html] argv;
+ run_ocamlbuild (index_html :: run.extra_args) argv;
List.iter
(fun glb ->
BaseBuilt.register
@@ -5548,43 +6604,52 @@ module OCamlbuildDocPlugin = struct
(Filename.concat tgt_dir glb)])
["*.html"; "*.css"]
- let doc_clean t pkg (cs, doc) argv =
+
+ let doc_clean run pkg (cs, doc) argv =
run_clean argv;
BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name
+
end
-# 5558 "setup.ml"
+# 6616 "setup.ml"
module CustomPlugin = struct
-(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/custom/CustomPlugin.ml" *)
+(* # 22 "src/plugins/custom/CustomPlugin.ml" *)
+
(** Generate custom configure/build/doc/test/install system
@author
*)
+
open BaseEnv
open OASISGettext
open OASISTypes
+
+
type t =
{
cmd_main: command_line conditional;
cmd_clean: (command_line option) conditional;
cmd_distclean: (command_line option) conditional;
- }
+ }
+
+
+ let run = BaseCustom.run
- let run = BaseCustom.run
let main t _ extra_args =
let cmd, args =
- var_choose
- ~name:(s_ "main command")
+ var_choose
+ ~name:(s_ "main command")
t.cmd_main
in
- run cmd args extra_args
+ run cmd args extra_args
+
let clean t pkg extra_args =
match var_choose t.cmd_clean with
@@ -5593,6 +6658,7 @@ module CustomPlugin = struct
| _ ->
()
+
let distclean t pkg extra_args =
match var_choose t.cmd_distclean with
| Some (cmd, args) ->
@@ -5600,20 +6666,21 @@ module CustomPlugin = struct
| _ ->
()
+
module Build =
- struct
+ struct
let main t pkg extra_args =
main t pkg extra_args;
List.iter
(fun sct ->
let evs =
- match sct with
+ match sct with
| Library (cs, bs, lib) when var_choose bs.bs_build ->
begin
- let evs, _ =
- BaseBuilt.of_library
+ let evs, _ =
+ BaseBuilt.of_library
OASISHostPath.of_unix
- (cs, bs, lib)
+ (cs, bs, lib)
in
evs
end
@@ -5654,6 +6721,7 @@ module CustomPlugin = struct
distclean t pkg extra_args
end
+
module Test =
struct
let main t pkg (cs, test) extra_args =
@@ -5661,7 +6729,7 @@ module CustomPlugin = struct
main t pkg extra_args;
0.0
with Failure s ->
- BaseMessage.warning
+ BaseMessage.warning
(f_ "Test '%s' fails: %s")
cs.cs_name
s;
@@ -5671,9 +6739,10 @@ module CustomPlugin = struct
clean t pkg extra_args
let distclean t pkg (cs, test) extra_args =
- distclean t pkg extra_args
+ distclean t pkg extra_args
end
+
module Doc =
struct
let main t pkg (cs, _) extra_args =
@@ -5688,16 +6757,17 @@ module CustomPlugin = struct
distclean t pkg extra_args
end
+
end
-# 5694 "setup.ml"
+# 6764 "setup.ml"
open OASISTypes;;
let setup_t =
{
BaseSetup.configure = InternalConfigurePlugin.configure;
- build = OCamlbuildPlugin.build;
+ build = OCamlbuildPlugin.build [];
test =
[
("nonregression",
@@ -5706,8 +6776,8 @@ let setup_t =
CustomPlugin.cmd_main =
[(OASISExpr.EBool true, ("make", ["test-compile"]))];
cmd_clean = [(OASISExpr.EBool true, None)];
- cmd_distclean = [(OASISExpr.EBool true, None)];
- })
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ })
];
doc = [];
install = InternalInstallPlugin.install;
@@ -5721,8 +6791,8 @@ let setup_t =
CustomPlugin.cmd_main =
[(OASISExpr.EBool true, ("make", ["test-compile"]))];
cmd_clean = [(OASISExpr.EBool true, None)];
- cmd_distclean = [(OASISExpr.EBool true, None)];
- })
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ })
];
clean_doc = [];
distclean = [];
@@ -5734,8 +6804,8 @@ let setup_t =
CustomPlugin.cmd_main =
[(OASISExpr.EBool true, ("make", ["test-compile"]))];
cmd_clean = [(OASISExpr.EBool true, None)];
- cmd_distclean = [(OASISExpr.EBool true, None)];
- })
+ cmd_distclean = [(OASISExpr.EBool true, None)]
+ })
];
distclean_doc = [];
package =
@@ -5743,6 +6813,8 @@ let setup_t =
oasis_version = "0.2";
ocaml_version = None;
findlib_version = None;
+ alpha_features = [];
+ beta_features = [];
name = "Lustre Compiler";
version = "1.2";
license =
@@ -5751,8 +6823,8 @@ let setup_t =
{
OASISLicense.license = "LGPL";
excption = None;
- version = OASISLicense.Version "2.1";
- });
+ version = OASISLicense.Version "2.1"
+ });
license_file = None;
copyrights = [];
maintainers = [];
@@ -5761,13 +6833,13 @@ let setup_t =
synopsis = "Lustre compiler C and Java backends";
description = None;
categories = [];
- conf_type = (`Configure, "internal", Some "0.3");
+ 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.3");
+ post_command = [(OASISExpr.EBool true, None)]
+ };
+ build_type = (`Build, "ocamlbuild", Some "0.4");
build_custom =
{
pre_command =
@@ -5775,9 +6847,9 @@ let setup_t =
(OASISExpr.EBool true,
Some (("./svn_version.sh", ["$(prefix)"])))
];
- post_command = [(OASISExpr.EBool true, None)];
- };
- install_type = (`Install, "internal", Some "0.3");
+ post_command = [(OASISExpr.EBool true, None)]
+ };
+ install_type = (`Install, "internal", Some "0.4");
install_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
@@ -5794,23 +6866,23 @@ let setup_t =
"include/*";
"$(prefix)/include/lustrec"
])))
- ];
- };
+ ]
+ };
uninstall_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
- post_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)];
- };
+ post_command = [(OASISExpr.EBool true, None)]
+ };
distclean_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
- post_command = [(OASISExpr.EBool true, None)];
- };
+ post_command = [(OASISExpr.EBool true, None)]
+ };
files_ab = [];
sections =
[
@@ -5818,8 +6890,8 @@ let setup_t =
({
cs_name = "lustrec";
cs_data = PropList.Data.create ();
- cs_plugin_data = [];
- },
+ cs_plugin_data = []
+ },
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
@@ -5839,18 +6911,18 @@ let setup_t =
bs_dlllib = [(OASISExpr.EBool true, [])];
bs_dllpath = [(OASISExpr.EBool true, [])];
bs_byteopt = [(OASISExpr.EBool true, [])];
- bs_nativeopt = [(OASISExpr.EBool true, [])];
- },
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
{
exec_custom = false;
- exec_main_is = "main_lustre_compiler.ml";
- });
+ exec_main_is = "main_lustre_compiler.ml"
+ });
Test
({
cs_name = "nonregression";
cs_data = PropList.Data.create ();
- cs_plugin_data = [];
- },
+ cs_plugin_data = []
+ },
{
test_type = (`Test, "custom", None);
test_command =
@@ -5858,27 +6930,28 @@ let setup_t =
test_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
- post_command = [(OASISExpr.EBool true, None)];
- };
+ post_command = [(OASISExpr.EBool true, None)]
+ };
test_working_directory = Some "test";
test_run = [(OASISExpr.EBool true, true)];
- test_tools = [];
- })
+ test_tools = []
+ })
];
plugins = [(`Extra, "DevFiles", Some "0.2")];
+ disable_oasis_section = [];
schema_data = PropList.Data.create ();
- plugin_data = [];
- };
+ plugin_data = []
+ };
oasis_fn = Some "_oasis";
- oasis_version = "0.3.0";
+ oasis_version = "0.4.4";
oasis_digest = Some "wX\249B\007\151\134\1970p\217\138\017\214\244\241";
oasis_exec = None;
oasis_setup_args = [];
- setup_update = false;
- };;
+ setup_update = false
+ };;
let setup () = BaseSetup.setup setup_t;;
-# 5883 "setup.ml"
+# 6956 "setup.ml"
(* OASIS_STOP *)
let () = setup ();;
diff --git a/src/corelang.ml b/src/corelang.ml
index 16f4e340..3ff58c05 100755
--- a/src/corelang.ml
+++ b/src/corelang.ml
@@ -663,21 +663,27 @@ let rename_node f_node f_var f_const nd =
let rename_const f_const c =
{ c with const_id = f_const c.const_id }
-
+
+let rename_typedef f_var t =
+ match t.tydef_desc with
+ | Tydec_enum tags -> { t with tydef_desc = Tydec_enum (List.map f_var tags) }
+ | _ -> t
+
let rename_prog f_node f_var f_const prog =
List.rev (
List.fold_left (fun accu top ->
(match top.top_decl_desc with
| Node nd ->
- { top with top_decl_desc = Node (rename_node f_node f_var f_const nd) }
+ { top with top_decl_desc = Node (rename_node f_node f_var f_const nd) }
| Const c ->
- { top with top_decl_desc = Const (rename_const f_const c) }
+ { top with top_decl_desc = Const (rename_const f_const c) }
+ | TypeDef tdef ->
+ { top with top_decl_desc = TypeDef (rename_typedef f_var tdef) }
| ImportedNode _
- | Open _
- | TypeDef _ -> top)
+ | Open _ -> top)
::accu
) [] prog
- )
+ )
(**********************************************************************)
(* Pretty printers *)
diff --git a/src/inliner.ml b/src/inliner.ml
index 08640119..eb9fa16e 100644
--- a/src/inliner.ml
+++ b/src/inliner.ml
@@ -40,10 +40,11 @@ TODO: deal with reset
let inline_call orig_expr args reset locals node =
let loc = orig_expr.expr_loc in
let uid = orig_expr.expr_tag in
- let rename v =
- Format.fprintf Format.str_formatter "%s_%i_%s"
+ let rename v =
+ if v = tag_true || v = tag_false then v else
+ (Format.fprintf Format.str_formatter "%s_%i_%s"
node.node_id uid v;
- Format.flush_str_formatter ()
+ Format.flush_str_formatter ())
in
let eqs' = List.map (rename_eq rename) node.node_eqs
in
@@ -247,7 +248,7 @@ let witness filename main_name orig inlined type_env clock_env =
node_clock = Clocks.new_var true;
node_inputs = main_orig_node.node_inputs;
node_outputs = [ok_output];
- node_locals = [];
+ node_locals = ok_i;
node_gencalls = [];
node_checks = [];
node_asserts = [];
diff --git a/src/lusic.ml b/src/lusic.ml
index 951081ad..324faf59 100644
--- a/src/lusic.ml
+++ b/src/lusic.ml
@@ -41,8 +41,7 @@ let extract_header own prog =
(* encode and write a header in a file *)
let write_lusic lusi (header : top_decl list) basename extension =
- let basename' = !Options.dest_dir ^ "/" ^ basename in
- let target_name = basename' ^ extension in
+ let target_name = basename ^ extension in
let outchan = open_out_bin target_name in
begin
Marshal.to_channel outchan {from_lusi = lusi; contents = header} [];
@@ -51,8 +50,7 @@ let write_lusic lusi (header : top_decl list) basename extension =
(* read and decode a header from a file *)
let read_lusic basename extension =
- let basename' = !Options.dest_dir ^ "/" ^ basename in
- let source_name = basename' ^ extension in
+ let source_name = basename ^ extension in
let inchan = open_in_bin source_name in
let lusic = (Marshal.from_channel inchan : lusic) in
begin
@@ -61,15 +59,14 @@ let read_lusic basename extension =
end
let print_lusic_to_h basename extension =
- let basename' = !Options.dest_dir ^ "/" ^ basename in
let lusic = read_lusic basename extension in
- let header_name = basename' ^ ".h" in
+ let header_name = basename ^ ".h" in
let h_out = open_out header_name in
let h_fmt = formatter_of_out_channel h_out in
begin
Typing.uneval_prog_generics lusic.contents;
Clock_calculus.uneval_prog_generics lusic.contents;
- Header.print_header_from_header h_fmt basename lusic.contents;
+ Header.print_header_from_header h_fmt (Filename.basename basename) lusic.contents;
close_out h_out
end
diff --git a/src/main_lustre_compiler.ml b/src/main_lustre_compiler.ml
index 9e18d620..728a0ef4 100644
--- a/src/main_lustre_compiler.ml
+++ b/src/main_lustre_compiler.ml
@@ -32,40 +32,41 @@ let print_lusi prog basename extension =
(* compile a .lusi header file *)
let compile_header basename extension =
- let header_name = basename ^ extension in
- let lusic_ext = extension ^ "c" in
- begin
- Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v>");
- let header = parse_header true header_name in
- ignore (check_top_decls header);
- create_dest_dir ();
- Log.report ~level:1 (fun fmt -> fprintf fmt ".. generating compiled header file %sc@," header_name);
- Lusic.write_lusic true header basename lusic_ext;
- Lusic.print_lusic_to_h basename lusic_ext;
- Log.report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@.")
- end
+ let destname = !Options.dest_dir ^ "/" ^ basename in
+ let header_name = basename ^ extension in
+ let lusic_ext = extension ^ "c" in
+ begin
+ Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v>");
+ let header = parse_header true header_name in
+ ignore (check_top_decls header);
+ create_dest_dir ();
+ Log.report ~level:1 (fun fmt -> fprintf fmt ".. generating compiled header file %sc@," header_name);
+ Lusic.write_lusic true header destname lusic_ext;
+ Lusic.print_lusic_to_h destname lusic_ext;
+ Log.report ~level:1 (fun fmt -> fprintf fmt ".. done !@ @]@.")
+ end
(* check whether a source file has a compiled header,
if not, generate the compiled header *)
let compile_source_to_header prog computed_types_env computed_clocks_env basename extension =
- let basename' = !Options.dest_dir ^ "/" ^ basename in
+ let destname = !Options.dest_dir ^ "/" ^ basename in
let lusic_ext = extension ^ "c" in
- let header_name = basename' ^ lusic_ext in
+ let header_name = destname ^ lusic_ext in
begin
if not (Sys.file_exists header_name) then
begin
Log.report ~level:1 (fun fmt -> fprintf fmt ".. generating compiled header file %s@," header_name);
- Lusic.write_lusic false (Lusic.extract_header basename prog) basename lusic_ext;
- Lusic.print_lusic_to_h basename lusic_ext
+ Lusic.write_lusic false (Lusic.extract_header basename prog) destname lusic_ext;
+ Lusic.print_lusic_to_h destname lusic_ext
end
else
- let lusic = Lusic.read_lusic basename lusic_ext in
+ let lusic = Lusic.read_lusic destname lusic_ext in
if not lusic.Lusic.from_lusi then
begin
Log.report ~level:1 (fun fmt -> fprintf fmt ".. generating compiled header file %s@," header_name);
- Lusic.write_lusic false (Lusic.extract_header basename prog) basename lusic_ext;
+ Lusic.write_lusic false (Lusic.extract_header basename prog) destname lusic_ext;
(*List.iter (fun top_decl -> Format.eprintf "lusic: %a@." Printers.pp_decl top_decl) lusic.Lusic.contents;*)
- Lusic.print_lusic_to_h basename lusic_ext
+ Lusic.print_lusic_to_h destname lusic_ext
end
else
begin
@@ -290,7 +291,7 @@ let compile basename extension =
let anonymous filename =
let ok_ext, ext = List.fold_left (fun (ok, ext) ext' -> if not ok && Filename.check_suffix filename ext' then true, ext' else ok, ext) (false, "") extensions in
if ok_ext then
- let basename = Filename.chop_suffix filename ext in
+ let basename = Filename.chop_suffix (Filename.basename filename) ext in
compile basename ext
else
raise (Arg.Bad ("Can only compile *.lusi, *.lus or *.ec files"))
diff --git a/src/modules.ml b/src/modules.ml
index 7bfbc61d..288f4c1a 100644
--- a/src/modules.ml
+++ b/src/modules.ml
@@ -114,7 +114,7 @@ let add_const itf name value =
with Not_found -> Hashtbl.add consts_table name value
let name_dependency (local, dep) =
- (if local then "" else Version.prefix ^ "/include/lustrec/") ^ dep
+ (if local then !Options.dest_dir ^ "/" else Version.prefix ^ "/include/lustrec/") ^ dep
let import_dependency loc (local, dep) =
let basename = name_dependency (local, dep) in
@@ -122,13 +122,10 @@ let import_dependency loc (local, dep) =
try
Lusic.read_lusic basename extension
with Sys_error msg ->
- raise (Error (loc, Unknown_library basename))
-(*
begin
- Format.eprintf "Failure: impossible to load library %s.@.%s@." basename msg;
- exit 1
+ (*Format.eprintf "Error: %s@." msg;*)
+ raise (Error (loc, Unknown_library basename))
end
-*)
let rec load_header imported header =
List.fold_left (fun imp decl ->
diff --git a/src/options.ml b/src/options.ml
index f895abce..2a4d438d 100755
--- a/src/options.ml
+++ b/src/options.ml
@@ -33,7 +33,7 @@ let horn_queries = ref false
let options =
[ "-d", Arg.Set_string dest_dir,
- "produces code in the specified directory (default: .)";
+ "uses the specified directory as root for generated/imported object and C files (default: .)";
"-node", Arg.Set_string main_node, "specifies the main node";
"-init", Arg.Set delay_calculus, "performs an initialisation analysis for Lustre nodes <default: no analysis>";
"-dynamic", Arg.Clear static_mem, "specifies a dynamic allocation scheme for main Lustre node <default: static>";
diff --git a/test/test-compile.sh b/test/test-compile.sh
index fae1b022..f420c1dc 100755
--- a/test/test-compile.sh
+++ b/test/test-compile.sh
@@ -13,50 +13,63 @@ report=`pwd`/report-$NOW
LUSTREC=lustrec
mkdir -p build
build=`pwd`"/build"
-
+
base_compile() {
while IFS=, read -r file main opts
do
name=`basename "$file" .lus`
- dir=${SRC_PREFIX}/`dirname "$file"`
+ ext=".lus"
+ if [ `dirname "$file"`/"$name" = "$file" ]; then
+ name=`basename "$file" .lusi`
+ ext=".lusi"
+ fi
+ dir=${SRC_PREFIX}/`dirname "$file"`
pushd $dir > /dev/null
if [ "$main" != "" ]; then
- $LUSTREC -d $build -verbose 0 $opts -node $main "$name".lus;
+ $LUSTREC -d $build -verbose 0 $opts -node $main "$name""$ext";
if [ $? -ne 0 ]; then
rlustrec1="INVALID";
else
rlustrec1="VALID"
fi
pushd $build > /dev/null
- gcc -c -Wall -Wno-unused-but-set-variable -I ../../include/ "$name".c > /dev/null
+ if [ $ext = ".lus" ]; then
+ gcc -c -Wall -Wno-unused-but-set-variable -I ../../include/ "$name".c > /dev/null
+ if [ $? -ne 0 ]; then
+ rgcc1="INVALID";
+ else
+ rgcc1="VALID"
+ fi
+ else
+ rgcc1="NONE"
+ fi
popd > /dev/null
- if [ $? -ne 0 ]; then
- rgcc1="INVALID";
- else
- rgcc1="VALID"
- fi
else
- $LUSTREC -d $build -verbose 0 $opts "$name".lus;
+ $LUSTREC -d $build -verbose 0 $opts "$name""$ext";
if [ $? -ne 0 ]; then
rlustrec1="INVALID";
else
rlustrec1="VALID"
fi
pushd $build > /dev/null
- gcc -c -Wall -Wno-unused-but-set-variable -I ../../include/ "$name".c > /dev/null
+ if [ $ext = ".lus" ]; then
+ gcc -c -Wall -Wno-unused-but-set-variable -I ../../include/ "$name".c > /dev/null
+ if [ $? -ne 0 ]; then
+ rgcc1="INVALID";
+ else
+ rgcc1="VALID"
+ fi
+ else
+ rgcc1="NONE"
+ fi
popd > /dev/null
- if [ $? -ne 0 ]; then
- rgcc1="INVALID";
- else
- rgcc1="VALID"
- fi
fi
popd > /dev/null
if [ $verbose -gt 0 ]; then
- echo "lustrec ($rlustrec1), gcc($rgcc1), $dir, ${name}.lus, node $main" | column -t -s',' | tee -a $report;
+ echo "lustrec ($rlustrec1), gcc($rgcc1), $dir, ${name}${ext}, node $main" | column -t -s',' | tee -a $report;
else
- echo "lustrec ($rlustrec1), gcc($rgcc1), $dir, ${name}.lus, node $main" | column -t -s',' | tee -a $report | grep "INVALID\|ERROR\|UNKNOWN"
+ echo "lustrec ($rlustrec1), gcc($rgcc1), $dir, ${name}${ext}, node $main" | column -t -s',' | tee -a $report | grep "INVALID\|ERROR\|UNKNOWN"
fi;
done < $file_list
}
@@ -65,6 +78,9 @@ inline_compile () {
while IFS=, read -r file main opts
do
name=`basename "$file" .lus`
+ if [ `dirname "$file"`/"$name" = "$file" ]; then
+ return 0
+ fi
dir=${SRC_PREFIX}/`dirname "$file"`
pushd $dir > /dev/null
@@ -78,12 +94,12 @@ inline_compile () {
fi
pushd $build > /dev/null
gcc -c -Wall -Wno-unused-but-set-variable -I ../../include/ "$name".c > /dev/null
- popd > /dev/null
if [ $? -ne 0 ]; then
rgcc2="INVALID";
else
rgcc2="VALID"
- fi
+ fi
+ popd > /dev/null
if [ $verbose -gt 0 ]; then
echo "lustrec inlined ($rlustrec2), gcc ($rgcc2), $dir, ${name}.lus, node $main" | column -t -s',' | tee -a $report;
else
@@ -98,6 +114,9 @@ inline_compile_with_check () {
while IFS=, read -r file main opts
do
name=`basename "$file" .lus`
+ if [ "$name" = "$file" ]; then
+ return 0
+ fi
dir=${SRC_PREFIX}/`dirname "$file"`
pushd $dir > /dev/null
$LUSTREC -d $build -verbose 0 $opts -inline -witnesses -node $main "$name".lus;
@@ -108,12 +127,12 @@ inline_compile_with_check () {
fi
pushd $build > /dev/null
gcc -c -Wall -Wno-unused-but-set-variable -I ../../include/ "$name".c > /dev/null
- popd > /dev/null
if [ $? -ne 0 ]; then
rgcc2="INVALID";
else
rgcc2="VALID"
fi
+ popd > /dev/null
# Cheching witness
pushd $build > /dev/null
$LUSTREC -verbose 0 -horn -d $build/${name}_witnesses -node check $build/${name}_witnesses/inliner_witness.lus
@@ -142,6 +161,9 @@ check_prop () {
while IFS=, read -r file main opts
do
name=`basename "$file" .lus`
+ if [ "$name" = "$file" ]; then
+ return 0
+ fi
dir=${SRC_PREFIX}/`dirname "$file"`
pushd $dir > /dev/null
diff --git a/test/tests_ok.list b/test/tests_ok.list
index 951b9bf6..422f358a 100644
--- a/test/tests_ok.list
+++ b/test/tests_ok.list
@@ -894,6 +894,7 @@
./tests/kind_fmcad08/large/ccp20.lus,top
./tests/kind_fmcad08/large/ccp11.lus,top
./tests/kind_fmcad08/large/cruise_controller_21.lus,top
+./tests/arrays_arnaud/dummy_lib.lusi
./tests/arrays_arnaud/arrays.lus,,-check-access
./tests/arrays_arnaud/RelOpMatrix.lus
./tests/arrays_arnaud/access1.lus,,-check-access
@@ -903,6 +904,10 @@
./tests/clocks/clocks1.lus
./tests/clocks/clocks2.lus
./tests/clocks/oversampling0.lus
+./tests/lusic/test2.lusi
+./tests/lusic/test1.lusi
+./tests/lusic/test1.lus,as_soon_as
+./tests/lusic/test2.lus
./tests/linear_ctl/ex8sat.lus,top
./tests/linear_ctl/ex2reset.lus,top
./tests/linear_ctl/lp_iir_9600_2.lus,top
--
GitLab