├── .gitignore ├── src ├── quickcheck.mllib ├── META ├── quickCheck_util.mli ├── quickCheck_util.ml ├── quickCheck_gen.ml ├── quickCheck_gen.mli ├── quickCheck.mli └── quickCheck.ml ├── AUTHORS.txt ├── README.txt ├── configure ├── Makefile ├── _oasis ├── INSTALL.txt ├── tests └── test.ml ├── _tags ├── LICENSE ├── README.md ├── myocamlbuild.ml └── setup.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | setup.data 3 | setup.log 4 | *.native 5 | *.byte 6 | src/config.* 7 | *.ba* 8 | gen.hs 9 | QuickCheck-2.4.0.1 10 | test.native 11 | -------------------------------------------------------------------------------- /src/quickcheck.mllib: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: 4991e3091c5041304d77ff94a59892c2) 3 | QuickCheck 4 | QuickCheck_gen 5 | QuickCheck_util 6 | # OASIS_STOP 7 | -------------------------------------------------------------------------------- /AUTHORS.txt: -------------------------------------------------------------------------------- 1 | (* OASIS_START *) 2 | (* DO NOT EDIT (digest: a0387e1469838d052cf96fcddde92be7) *) 3 | Authors of ocaml-quickcheck 4 | Alan Falloon 5 | Roma Sokolov 6 | (* OASIS_STOP *) 7 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | (* OASIS_START *) 2 | (* DO NOT EDIT (digest: b291207cad5e1569bf210ef8cb07eb48) *) 3 | This is the README file for the ocaml-quickcheck distribution. 4 | 5 | Ocaml port of haskell QuickCheck -- probabilistic testing 6 | 7 | See the files INSTALL.txt for building and installation instructions. See the 8 | file LICENSE for copying conditions. 9 | 10 | 11 | (* OASIS_STOP *) 12 | 13 | SEE README.md 14 | -------------------------------------------------------------------------------- /src/META: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: ba3cc544513bd4bc13b4678fa4cbb20d) 3 | version = "0.0.3" 4 | description = "Ocaml port of haskell QuickCheck -- probabilistic testing" 5 | requires = "optcomp" 6 | archive(byte) = "quickcheck.cma" 7 | archive(byte, plugin) = "quickcheck.cma" 8 | archive(native) = "quickcheck.cmxa" 9 | archive(native, plugin) = "quickcheck.cmxs" 10 | exists_if = "quickcheck.cma" 11 | # OASIS_STOP 12 | 13 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # OASIS_START 4 | # DO NOT EDIT (digest: 425187ed8bfdbdd207fd76392dd243a7) 5 | set -e 6 | 7 | FST=true 8 | for i in "$@"; do 9 | if $FST; then 10 | set -- 11 | FST=false 12 | fi 13 | 14 | case $i in 15 | --*=*) 16 | ARG=${i%%=*} 17 | VAL=${i##*=} 18 | set -- "$@" "$ARG" "$VAL" 19 | ;; 20 | *) 21 | set -- "$@" "$i" 22 | ;; 23 | esac 24 | done 25 | 26 | ocaml setup.ml -configure "$@" 27 | # OASIS_STOP 28 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: bc1e05bfc8b39b664f29dae8dbd3ebbb) 3 | 4 | SETUP = ocaml setup.ml 5 | 6 | build: setup.data 7 | $(SETUP) -build $(BUILDFLAGS) 8 | 9 | doc: setup.data build 10 | $(SETUP) -doc $(DOCFLAGS) 11 | 12 | test: setup.data build 13 | $(SETUP) -test $(TESTFLAGS) 14 | 15 | all: 16 | $(SETUP) -all $(ALLFLAGS) 17 | 18 | install: setup.data 19 | $(SETUP) -install $(INSTALLFLAGS) 20 | 21 | uninstall: setup.data 22 | $(SETUP) -uninstall $(UNINSTALLFLAGS) 23 | 24 | reinstall: setup.data 25 | $(SETUP) -reinstall $(REINSTALLFLAGS) 26 | 27 | clean: 28 | $(SETUP) -clean $(CLEANFLAGS) 29 | 30 | distclean: 31 | $(SETUP) -distclean $(DISTCLEANFLAGS) 32 | 33 | setup.data: 34 | $(SETUP) -configure $(CONFIGUREFLAGS) 35 | 36 | .PHONY: build doc test all install uninstall reinstall clean distclean configure 37 | 38 | # OASIS_STOP 39 | -------------------------------------------------------------------------------- /_oasis: -------------------------------------------------------------------------------- 1 | OASISFormat: 0.2 2 | Name: ocaml-quickcheck 3 | Version: 0.0.3 4 | Synopsis: Ocaml port of haskell QuickCheck -- probabilistic testing 5 | Authors: Alan Falloon, Roma Sokolov 6 | License: MIT 7 | LicenseFile: LICENSE 8 | Plugins: DevFiles (0.2), META (0.2), StdFiles (0.2) 9 | BuildTools: ocamlbuild 10 | BuildDepends: optcomp 11 | 12 | Library quickcheck 13 | Path: src 14 | Modules: QuickCheck, 15 | QuickCheck_gen, 16 | QuickCheck_util 17 | NativeOpt: -w @a -g 18 | ByteOpt: -w @a -g 19 | 20 | Executable test 21 | Path: tests/ 22 | Install: false 23 | CompiledObject: best 24 | MainIs: test.ml 25 | BuildDepends: quickcheck 26 | 27 | SourceRepository github 28 | Type: git 29 | Location: git://github.com/camlunity/ocaml-quickcheck.git 30 | Browser: https://github.com/camlunity/ocaml-quickcheck 31 | -------------------------------------------------------------------------------- /INSTALL.txt: -------------------------------------------------------------------------------- 1 | (* OASIS_START *) 2 | (* DO NOT EDIT (digest: 4b04f484898700f03681a1650a794471) *) 3 | This is the INSTALL file for the ocaml-quickcheck distribution. 4 | 5 | This package uses OASIS to generate its build system. See section OASIS for 6 | full information. 7 | 8 | Dependencies 9 | ============ 10 | 11 | In order to compile this package, you will need: 12 | * ocaml 13 | * findlib 14 | * optcomp 15 | 16 | Installing 17 | ========== 18 | 19 | 1. Uncompress the source archive and go to the root of the package 20 | 2. Run 'ocaml setup.ml -configure' 21 | 3. Run 'ocaml setup.ml -build' 22 | 4. Run 'ocaml setup.ml -install' 23 | 24 | Uninstalling 25 | ============ 26 | 27 | 1. Go to the root of the package 28 | 2. Run 'ocaml setup.ml -uninstall' 29 | 30 | OASIS 31 | ===== 32 | 33 | OASIS is a program that generates a setup.ml file using a simple '_oasis' 34 | configuration file. The generated setup only depends on the standard OCaml 35 | installation: no additional library is required. 36 | 37 | (* OASIS_STOP *) 38 | -------------------------------------------------------------------------------- /tests/test.ml: -------------------------------------------------------------------------------- 1 | 2 | open QuickCheck 3 | 4 | let prop_revrev xs = 5 | List.rev (List.rev xs) = xs 6 | 7 | let prop_mem xs = match xs with 8 | | [] -> true 9 | | (x::_) -> List.mem x xs 10 | 11 | let prop_str_copy s = s = (String.copy s) 12 | 13 | (* for generating random int lists *) 14 | let al = arbitrary_list arbitrary_int 15 | 16 | (* for printing out int lists *) 17 | let sl = show_list show_int 18 | 19 | (* for being able to test (int list -> bool) *) 20 | let testable_list_to_bool = testable_fun al sl testable_bool 21 | 22 | let cl = quickCheck testable_list_to_bool 23 | 24 | let testable_str_to_bool = testable_fun arbitrary_string show_string testable_bool 25 | let cs = quickCheck testable_str_to_bool 26 | 27 | let void f = fun a -> let _ = f a in () 28 | 29 | let () = 30 | (void cl) prop_revrev; 31 | (void cl) prop_mem; 32 | (void cs) prop_str_copy; 33 | 34 | match cl prop_revrev with 35 | | Success -> () 36 | | Failure _ -> failwith "No failure expected" 37 | | Exhausted _ -> failwith "No exhaustion expected" 38 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: f316d6cce54855308353f94918c30649) 3 | # Ignore VCS directories, you can use the same kind of rule outside 4 | # OASIS_START/STOP if you want to exclude directories that contains 5 | # useless stuff for the build process 6 | <**/.svn>: -traverse 7 | <**/.svn>: not_hygienic 8 | ".bzr": -traverse 9 | ".bzr": not_hygienic 10 | ".hg": -traverse 11 | ".hg": not_hygienic 12 | ".git": -traverse 13 | ".git": not_hygienic 14 | "_darcs": -traverse 15 | "_darcs": not_hygienic 16 | # Library quickcheck 17 | "src/quickcheck.cmxs": use_quickcheck 18 | : oasis_library_quickcheck_byte 19 | : oasis_library_quickcheck_byte 20 | : oasis_library_quickcheck_native 21 | : oasis_library_quickcheck_native 22 | : pkg_optcomp 23 | # Executable test 24 | : use_quickcheck 25 | : pkg_optcomp 26 | : use_quickcheck 27 | : pkg_optcomp 28 | # OASIS_STOP 29 | 30 | : syntax_camlp4o 31 | -------------------------------------------------------------------------------- /src/quickCheck_util.mli: -------------------------------------------------------------------------------- 1 | 2 | module Random : sig 3 | 4 | include module type of Random 5 | 6 | val char : char -> char 7 | 8 | val int_range : int * int -> int 9 | 10 | val int32_range : Int32.t * Int32.t -> Int32.t 11 | 12 | val int64_range : Int64.t * Int64.t -> Int64.t 13 | 14 | val nativeint_range : Nativeint.t * Nativeint.t -> Nativeint.t 15 | 16 | val float_range : float * float -> float 17 | 18 | val char_range : char * char -> char 19 | 20 | end 21 | 22 | 23 | module List : sig 24 | 25 | include module type of List 26 | 27 | val span : ('a -> bool) -> 'a list -> 'a list * 'a list 28 | 29 | val group_by : ('a -> 'a -> bool) -> 'a list -> 'a list list 30 | 31 | val group : 'a list -> 'a list list 32 | 33 | end 34 | 35 | val charlist_to_string : char list -> string 36 | 37 | val join_string_list : string list -> string -> string 38 | 39 | val sum_int : int list -> int 40 | 41 | #if ocaml_version < (4, 01) 42 | val ( |> ) : 'a -> ('a -> 'b) -> 'b 43 | #endif 44 | val ( <| ) : ('a -> 'b) -> 'a -> 'b 45 | 46 | val ( % ) : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b 47 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (C) 2011 by Roman Sokolov 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Ocaml-QuickCheck -- Translation of QuickCheck to OCaml 2 | ====================================================== 3 | 4 | This is translation of 5 | [QuickCheck](http://www.cs.chalmers.se/~rjmh/QuickCheck/) from 6 | [Haskell](http://www.haskell.org/) into 7 | [Ocaml](http://caml.inria.fr/). 8 | 9 | Forked from [Alan Falloon's ocaml-quickcheck](http://github.com/alanfalloon/ocaml-quickcheck), 10 | but uses regular high-order-functions, and doesn't try to mimic haskell 11 | [type-classes](http://www.haskell.org/tutorial/classes.html) with 12 | OCamls [modules](http://caml.inria.fr/pub/docs/manual-ocaml/manual004.html). 13 | Maybe, it's not all that pretty, but it works! 14 | For some examples see [tests/test.ml](https://github.com/camlunity/ocaml-quickcheck/blob/master/tests/test.ml). 15 | More docs and examples coming soon. 16 | 17 | If you are interested in original implementation 18 | you can go to Alan Falloon's blog to hear more about 19 | [how he converted the code and the differences that were introduced](http://brierwoodapps.com/ocaml-quickcheck-translating-quickcheck-from-haskell-type-classes-to-ocaml-modules/). 20 | 21 | Btw, with OCaml 3.12 you can somehow simplify original code 22 | with first-class modules. You can check branch "first-class-modules" 23 | in this repo to see some work in this field. However, HOFs still simplier 24 | than modules and functors. 25 | -------------------------------------------------------------------------------- /src/quickCheck_util.ml: -------------------------------------------------------------------------------- 1 | 2 | module Random = struct 3 | 4 | include Random 5 | let int n = int (max n 1) 6 | let char lim = 7 | let l = Char.code lim in 8 | let i = int l in 9 | Char.chr i 10 | let int_range (lo, hi) = 11 | lo + int (hi-lo) 12 | let int32_range (lo, hi) = 13 | Int32.add lo (int32 (Int32.sub hi lo)) 14 | let int64_range (lo, hi) = 15 | Int64.add lo (int64 (Int64.sub hi lo)) 16 | let nativeint_range (lo, hi) = 17 | Nativeint.add lo (nativeint (Nativeint.sub hi lo)) 18 | let float_range (lo, hi) = 19 | lo +. float (hi -. lo) 20 | let char_range (lo, hi) = 21 | let lo' = Char.code lo and hi' = Char.code hi in 22 | let i = int_range (lo', hi') in 23 | Char.chr i 24 | 25 | end 26 | 27 | 28 | module List = struct 29 | include List 30 | 31 | let rec span p l = match l with 32 | | [] -> [],[] 33 | | x::xs when p x -> 34 | let ys,zs = span p xs in 35 | (x::ys,zs) 36 | | xs -> [],xs 37 | 38 | let rec group_by p l = match l with 39 | | [] -> [] 40 | | x::xs -> 41 | let ys,zs = span (p x) xs in 42 | (x::ys) :: group_by p zs 43 | 44 | let group xs = group_by (=) xs 45 | 46 | end 47 | 48 | let charlist_to_string l = 49 | let len = List.length l in 50 | let s = String.create len in 51 | let i = ref 0 in 52 | List.iter (fun c -> s.[!i] <- c; incr i) l; s 53 | 54 | let join_string_list lst sep = 55 | let open Printf in 56 | let rec to_string l acc = 57 | match l with 58 | | a::b::[] -> sprintf "%s%s%s %s" acc sep a b 59 | | a::b::t -> to_string t (sprintf "%s%s%s %s%s " acc a sep b sep) 60 | | a::[] -> sprintf "%s%s" acc a 61 | | [] -> acc 62 | in to_string lst "" 63 | 64 | let sum_int = List.fold_left (+) 0;; 65 | 66 | #if ocaml_version < (4, 01) 67 | let ( |> ) x f = f x 68 | #endif 69 | let ( <| ) f x = f x 70 | 71 | let ( % ) f g = fun x -> f (g x) 72 | -------------------------------------------------------------------------------- /src/quickCheck_gen.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * QuickCheck_gen - different generators 3 | *) 4 | 5 | (** 6 | 7 | Generator combinator and types. 8 | 9 | **) 10 | 11 | open QuickCheck_util 12 | 13 | type 'a gen = Gen of (int -> 'a) 14 | 15 | 16 | let sized f = Gen (fun n -> 17 | let Gen m = f n in 18 | m n) 19 | 20 | let resize n (Gen m) = Gen (fun _ -> m n) 21 | 22 | let promote f = 23 | Gen (fun n -> 24 | fun a -> 25 | let Gen m = f a in 26 | m n) 27 | 28 | let variant _v (Gen m) = Gen (fun n -> m n) 29 | 30 | let generate n (Gen m) = 31 | let size = Random.int n in 32 | m size 33 | 34 | let map_gen f (Gen m) = 35 | Gen (fun n -> 36 | let v = m n in 37 | f v) 38 | 39 | let ret_gen a = Gen (fun _n -> a) 40 | 41 | let (>>=) (Gen m) k = 42 | Gen (fun n -> 43 | let v = m n in 44 | let Gen m' = k v in 45 | m' n) 46 | 47 | let lift_gen f a = Gen (fun _ -> f a) 48 | 49 | let choose_int = lift_gen Random.int_range 50 | let choose_int32 = lift_gen Random.int32_range 51 | let choose_int0 = lift_gen Random.int 52 | let choose_char = lift_gen Random.char_range 53 | let choose_float = lift_gen Random.float_range 54 | 55 | let elements xs = map_gen (List.nth xs) (choose_int0 (List.length xs)) 56 | 57 | let vector (Gen gelt) l = 58 | Gen (fun n -> 59 | let rec gen acc = function 60 | | 0 -> acc 61 | | l -> gen (gelt n :: acc) (l-1) 62 | in gen [] l) 63 | 64 | let oneof gens = elements gens >>= fun x -> x 65 | 66 | let such_that_opt p gen = 67 | let rec try_ k n = match n with 68 | | 0 -> ret_gen None 69 | | n -> resize (2 * k + n) gen >>= 70 | (fun x -> if p x then ret_gen (Some x) else try_ (k+1) (n-1)) 71 | in sized (try_ 0 % max 1) 72 | 73 | let rec such_that p gen = 74 | such_that_opt p gen >>= (function 75 | | Some x -> ret_gen x 76 | | None -> sized (fun n -> resize (n+1) (such_that p gen))) 77 | 78 | let frequency w_gens = 79 | let total = sum_int <| List.map fst w_gens in 80 | let rec pick n lst = match lst with 81 | | (k, x)::_tail when n <= k -> x 82 | | (k, _)::tail -> pick (n - k) tail 83 | | _ -> failwith "pick used with empty list" 84 | in choose_int (1, total) >>= (fun n -> 85 | pick n w_gens) 86 | 87 | let list gen = sized (fun n -> choose_int0 n >>= vector gen) 88 | 89 | let list1 gen = sized (fun n -> choose_int (1, max 1 n) >>= vector gen) 90 | 91 | let listN n gen = resize n (sized (fun n -> vector gen n)) 92 | -------------------------------------------------------------------------------- /src/quickCheck_gen.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * QuickCheck_gen - different generators 3 | *) 4 | 5 | (** 6 | 7 | Generator combinator and types. 8 | **) 9 | 10 | type 'a gen = Gen of (int -> 'a) 11 | (** Generator is just a function of random integer seed to value 12 | *) 13 | 14 | val sized : (int -> 'a gen) -> 'a gen 15 | (** Used to construct generators that depend on the size parameter. 16 | *) 17 | 18 | val resize : int -> 'a gen -> 'a gen 19 | (** Overrides the size parameter. Returns a generator which uses 20 | the given size instead of the runtime-size parameter. 21 | *) 22 | 23 | val promote : ('a -> 'b gen) -> ('a -> 'b) gen 24 | (** Promote generator to a generator of generators 25 | *) 26 | 27 | val variant : int -> 'a gen -> 'a gen 28 | (** nodoc *) 29 | 30 | val generate : int -> 'a gen -> 'a 31 | (** Run generator to compute a value 32 | *) 33 | 34 | val map_gen : ('a -> 'b) -> 'a gen -> 'b gen 35 | (** Applies function in context of generator 36 | *) 37 | 38 | val ret_gen : 'a -> 'a gen 39 | (** Creates generator from function 40 | *) 41 | 42 | val (>>=) : 'a gen -> ('a -> 'b gen) -> 'b gen 43 | (** Generators bind 44 | *) 45 | 46 | val lift_gen : ('a -> 'b) -> 'a -> 'b gen 47 | (** Lifts function to generator 48 | *) 49 | 50 | val choose_int : int * int -> int gen 51 | (** Chooses integer value from given range 52 | *) 53 | 54 | val choose_int32 : int32 * int32 -> int32 gen 55 | (** Chooses integer 32bit value from given range 56 | *) 57 | 58 | val choose_int0 : int -> int gen 59 | (** Chooses integer value from 0 to given high mark 60 | *) 61 | 62 | val choose_char : char * char -> char gen 63 | (** Choose char from given given range 64 | *) 65 | 66 | val choose_float : float * float -> float gen 67 | (** Choose float value from given range 68 | *) 69 | 70 | val elements : 'a list -> 'a gen 71 | (** Generates one of the given values 72 | *) 73 | 74 | val vector : 'a gen -> int -> 'a list gen 75 | (** Generates a list of given length 76 | *) 77 | 78 | val oneof : 'a gen list -> 'a gen 79 | (** Randomly uses one of the given generators 80 | *) 81 | 82 | val such_that : ('a -> bool) -> 'a gen -> 'a gen 83 | (** Generates a value, that satisfies a predicate 84 | *) 85 | 86 | val frequency : (int * 'a gen) list -> 'a gen 87 | (** Chooses one of the given generators, with a weighted random 88 | distribution. The input list must be non-empty. 89 | *) 90 | 91 | val list : 'a gen -> 'a list gen 92 | (** Generates a list of random length. 93 | The maximum length depends on the size parameter. 94 | *) 95 | 96 | val list1 : 'a gen -> 'a list gen 97 | (** Generates a non-empty list of random length. 98 | The maximum length depends on the size parameter. 99 | *) 100 | 101 | val listN : int -> 'a gen -> 'a list gen 102 | (** Generate list of arbitrary elements with given length 103 | *) 104 | -------------------------------------------------------------------------------- /src/quickCheck.mli: -------------------------------------------------------------------------------- 1 | 2 | type 'a show = 'a -> string 3 | 4 | val show_bool : bool show 5 | 6 | val show_char : char show 7 | 8 | val show_string : string show 9 | 10 | val show_int : int show 11 | 12 | val show_int32 : int32 show 13 | 14 | val show_int64 : int64 show 15 | 16 | val show_float : float show 17 | 18 | val show_pair : 'a show -> 'b show -> 'a * 'b -> string 19 | 20 | val show_triple : 'a show -> 'b show -> 'c show -> 'a * 'b * 'c -> string 21 | 22 | val show_list : 'a show -> 'a list -> string 23 | 24 | type 'a arbitrary = 'a QuickCheck_gen.gen 25 | 26 | val arbitrary_unit : unit QuickCheck_gen.gen 27 | 28 | val arbitrary_bool : bool QuickCheck_gen.gen 29 | 30 | val arbitrary_char : char QuickCheck_gen.gen 31 | 32 | val arbitrary_byte : char QuickCheck_gen.gen 33 | 34 | val arbitrary_string : string QuickCheck_gen.gen 35 | 36 | val arbitrary_bytesequence : string QuickCheck_gen.gen 37 | 38 | val arbitrary_stringN : int -> string QuickCheck_gen.gen 39 | 40 | val arbitrary_bytesequenceN : int -> string QuickCheck_gen.gen 41 | 42 | val arbitrary_int : int QuickCheck_gen.gen 43 | 44 | val arbitrary_int32 : int32 QuickCheck_gen.gen 45 | 46 | val arbitrary_int64 : int64 QuickCheck_gen.gen 47 | 48 | val arbitrary_float : float QuickCheck_gen.gen 49 | 50 | val arbitrary_pair : 'a arbitrary -> 51 | 'b arbitrary -> 52 | ('a * 'b) QuickCheck_gen.gen 53 | 54 | val arbitrary_triple : 'a arbitrary -> 55 | 'b arbitrary -> 56 | 'c arbitrary -> 57 | ('a * 'b *'c) QuickCheck_gen.gen 58 | 59 | val arbitrary_list : 'a arbitrary -> 'a list QuickCheck_gen.gen 60 | 61 | val arbitrary_listN : int -> 'a QuickCheck_gen.gen -> 'a list QuickCheck_gen.gen 62 | 63 | type result = { 64 | ok : bool option; 65 | stamp : string list; 66 | arguments : string list; 67 | } 68 | 69 | type property = Prop of result QuickCheck_gen.gen 70 | 71 | type 'a testable = 'a -> property 72 | 73 | val nothing : result 74 | 75 | val result : result -> property 76 | 77 | val testable_unit : unit testable 78 | 79 | val testable_bool : bool testable 80 | 81 | val testable_tesult : result testable 82 | 83 | val testable_property : property testable 84 | 85 | val evaluate : 'a testable -> 'a -> result QuickCheck_gen.gen 86 | 87 | val for_all : 'a show -> 'b testable -> 'a QuickCheck_gen.gen -> ('a -> 'b) -> property 88 | 89 | val testable_fun : 'a arbitrary -> 'a show -> 'b testable -> ('a -> 'b) testable 90 | 91 | val implies : 'a testable -> bool -> 'a testable 92 | 93 | val label : 'a testable -> string -> 'a testable 94 | 95 | val classify : 'a testable -> bool -> string -> 'a testable 96 | 97 | val trivial : 'a testable -> bool -> 'a testable 98 | 99 | val collect : 'a show -> 'b testable -> 'a -> 'b -> property 100 | (* 'b property *) 101 | 102 | type config = { 103 | maxTest : int; 104 | maxFail : int; 105 | size : int -> int; 106 | every : Format.formatter -> int * string list -> unit; 107 | } 108 | 109 | type testresult = Success 110 | | Failure of int 111 | | Exhausted of int 112 | 113 | val quick : config 114 | val verbose : config 115 | val done_ : string -> int -> string list list -> unit 116 | val tests : config -> 117 | result QuickCheck_gen.gen -> 118 | int -> 119 | int -> 120 | string list list -> 121 | testresult 122 | 123 | val check : 'a testable -> config -> 'a -> testresult 124 | val quickCheck : 'a testable -> 'a -> testresult 125 | val verboseCheck : 'a testable -> 'a -> testresult 126 | 127 | -------------------------------------------------------------------------------- /src/quickCheck.ml: -------------------------------------------------------------------------------- 1 | 2 | open QuickCheck_util 3 | open QuickCheck_gen 4 | 5 | 6 | type 'a show = 'a -> string 7 | 8 | let show_bool = Printf.sprintf "%B" 9 | 10 | let show_char = Printf.sprintf "%C" 11 | 12 | let show_string x = Printf.sprintf "\"%s\"" (String.escaped x) 13 | 14 | let show_int = string_of_int 15 | 16 | let show_int32 = Printf.sprintf "%ldl" 17 | 18 | let show_int64 = Printf.sprintf "%LdL" 19 | 20 | let show_float = string_of_float 21 | 22 | let show_pair show_fst show_snd (fst, snd) = 23 | let (sfst, ssnd) = (show_fst fst, show_snd snd) in 24 | Printf.sprintf "(%s, %s)" sfst ssnd 25 | 26 | let show_triple show_fst show_snd show_trd (fst, snd, trd) = 27 | let (sf, ss, st) = (show_fst fst, show_snd snd, show_trd trd) in 28 | Printf.sprintf "(%s, %s, %s)" sf ss st 29 | 30 | let show_list show_elt lst = 31 | Printf.sprintf "[%s]" (join_string_list (List.map show_elt lst) ";") 32 | 33 | type 'a arbitrary = 'a gen 34 | 35 | let arbitrary_unit = ret_gen () 36 | 37 | let arbitrary_bool = elements [true; false] 38 | 39 | let arbitrary_char = choose_int (32,255) >>= fun c -> ret_gen (Char.chr c) 40 | 41 | let arbitrary_byte = choose_int (0,255) >>= fun c -> ret_gen (Char.chr c) 42 | 43 | let arbitrary_string = list arbitrary_char >>= (fun cl -> 44 | ret_gen (charlist_to_string cl)) 45 | 46 | let arbitrary_bytesequence = list arbitrary_byte >>= (fun cl -> 47 | ret_gen (charlist_to_string cl)) 48 | 49 | let arbitrary_stringN n = (listN n arbitrary_char) >>= (fun cl -> 50 | ret_gen (charlist_to_string cl)) 51 | 52 | let arbitrary_bytesequenceN n = (listN n arbitrary_byte) >>= (fun cl -> 53 | ret_gen (charlist_to_string cl)) 54 | 55 | let arbitrary_int = sized (fun n -> choose_int (-n, n)) 56 | 57 | let arbitrary_int32 = arbitrary_int >>= fun a -> arbitrary_int >>= fun b-> 58 | ret_gen Int32.(add (of_int a) (of_int b)) 59 | 60 | let arbitrary_int64 = arbitrary_int32 >>= fun a -> arbitrary_int32 >>= fun b-> 61 | ret_gen Int64.(add (of_int32 a) (of_int32 b)) 62 | 63 | let arbitrary_float = arbitrary_int >>= fun a -> arbitrary_int >>= fun b -> 64 | sized choose_int0 >>= fun c -> ret_gen 65 | (float a +. (float b /. (float c +. 1.))) 66 | 67 | let arbitrary_pair arbitrary_fst arbitrary_snd = 68 | arbitrary_fst >>= fun v1 -> arbitrary_snd >>= fun v2 -> ret_gen (v1,v2) 69 | 70 | let arbitrary_triple arbitrary_fst arbitrary_snd arbitrary_trd = 71 | arbitrary_fst >>= fun v1 -> 72 | arbitrary_snd >>= fun v2 -> 73 | arbitrary_trd >>= fun v3 -> 74 | ret_gen (v1,v2,v3) 75 | 76 | let arbitrary_list arbitrary_elt = list arbitrary_elt 77 | 78 | let arbitrary_listN n arbitrary_elt = listN n arbitrary_elt 79 | 80 | type result = { 81 | ok : bool option; 82 | stamp : string list; 83 | arguments : string list; 84 | } 85 | 86 | type property = Prop of result gen 87 | 88 | type 'a testable = 'a -> property 89 | 90 | let nothing : result = {ok=None; stamp=[]; arguments=[]} 91 | 92 | let result : result -> property = 93 | fun res -> Prop (ret_gen res) 94 | 95 | 96 | let testable_unit () = result nothing 97 | 98 | let testable_bool b = result {nothing with ok=Some b} 99 | 100 | let testable_tesult r = result r 101 | 102 | let testable_property p = p 103 | 104 | let evaluate testable arg = 105 | let Prop gen = testable arg in 106 | gen 107 | 108 | let for_all show testable gen body = 109 | let eval = evaluate testable in 110 | let argument a res = 111 | {res with arguments = (show a)::res.arguments } 112 | in 113 | Prop (gen >>= (fun a -> 114 | eval (body a) >>= (fun res -> 115 | ret_gen (argument a res))) 116 | ) 117 | 118 | let testable_fun arbitrary show testable f = 119 | for_all show testable arbitrary f 120 | 121 | let implies testable b a = 122 | if b then testable a 123 | else testable_unit () 124 | (* ==> *) 125 | 126 | let label testable s a = 127 | let eval = evaluate testable in 128 | let add r = {r with stamp = s :: r.stamp } in 129 | let a' = eval a in 130 | Prop (map_gen add a') 131 | 132 | let classify testable b = 133 | let lbl = label testable in 134 | if b then lbl 135 | else (fun _ -> testable) 136 | 137 | let trivial testable b = 138 | classify testable b "trivial" 139 | 140 | let collect show testable sv tv = 141 | (label testable) (show sv) tv 142 | 143 | type config = { 144 | maxTest : int; 145 | maxFail : int; 146 | size : int -> int; 147 | every : Format.formatter -> int * string list -> unit; 148 | } 149 | 150 | let quick = { 151 | maxTest = 100; 152 | maxFail = 1000; 153 | size = (fun n -> 3 + n / 2); 154 | every = (fun _ (_, _) -> ()) 155 | } 156 | 157 | let verbose = { 158 | quick with 159 | every = begin fun f (n, args) -> 160 | let pargs fmt l = 161 | List.iter (fun a -> Format.fprintf fmt "@ %s" a) l 162 | in 163 | Format.fprintf f "@[%d:@[%a@]@]@." n pargs args 164 | end 165 | } 166 | 167 | let done_ mesg ntest stamps = 168 | let percentage n m = 169 | Format.sprintf "%2d%%" ((100 * n) / m) 170 | in 171 | let entry (n, xs) = 172 | Format.sprintf "%s %s" (percentage n ntest) (String.concat ", " xs) 173 | in 174 | let pairLength l = match l with 175 | | (xs::_) as xss -> (List.length xss, xs) 176 | | [] -> assert false 177 | in 178 | let display l = match l with 179 | | [] -> ".\n" 180 | | [x] -> Format.sprintf " (%s).\n" x 181 | | xs -> 182 | String.concat "\n" ("." :: List.map (Format.sprintf "%s.") xs) 183 | in 184 | let not_null = function [] -> false | _ -> true in 185 | let table = 186 | List.filter not_null stamps |> List.sort compare |> 187 | List.group |> List.map pairLength |> List.sort compare |> 188 | List.rev |> List.map entry |> display 189 | in 190 | Format.printf "%s %d tests%s" mesg ntest table 191 | 192 | type testresult = Success 193 | | Failure of int 194 | | Exhausted of int 195 | 196 | let rec tests config gen ntest nfail stamps = 197 | let () = Random.self_init () in 198 | if ntest = config.maxTest 199 | then 200 | let () = done_ "OK, passed" ntest stamps in 201 | Success 202 | else if nfail = config.maxFail 203 | then 204 | let () = done_ "Arguments exhausted after" nfail stamps in 205 | Exhausted nfail 206 | else begin 207 | let result = generate (config.size ntest) gen in 208 | let () = 209 | Format.printf "@[%a@]@?" config.every (ntest, result.arguments) 210 | in 211 | match result.ok with 212 | | None -> 213 | tests config gen ntest (nfail+1) stamps 214 | | Some true -> 215 | tests config gen (ntest+1) nfail (result.stamp :: stamps) 216 | | Some false -> 217 | Format.printf "@[<2>Falsifiable, after %d tests:\n %s." 218 | ntest (join_string_list result.arguments "\n"); 219 | Failure ntest 220 | end 221 | 222 | let check testable cfg a = 223 | let eval = evaluate testable in 224 | tests cfg (eval a) 0 0 [] 225 | 226 | let quickCheck testable = check testable quick 227 | let verboseCheck testable = check testable verbose 228 | 229 | -------------------------------------------------------------------------------- /myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | (* OASIS_START *) 2 | (* DO NOT EDIT (digest: 451463d086dd42414e7526f53b169728) *) 3 | module OASISGettext = struct 4 | (* # 21 "src/oasis/OASISGettext.ml" *) 5 | 6 | let ns_ str = 7 | str 8 | 9 | let s_ str = 10 | str 11 | 12 | let f_ (str : ('a, 'b, 'c, 'd) format4) = 13 | str 14 | 15 | let fn_ fmt1 fmt2 n = 16 | if n = 1 then 17 | fmt1^^"" 18 | else 19 | fmt2^^"" 20 | 21 | let init = 22 | [] 23 | 24 | end 25 | 26 | module OASISExpr = struct 27 | (* # 21 "src/oasis/OASISExpr.ml" *) 28 | 29 | 30 | 31 | open OASISGettext 32 | 33 | type test = string 34 | 35 | type flag = string 36 | 37 | type t = 38 | | EBool of bool 39 | | ENot of t 40 | | EAnd of t * t 41 | | EOr of t * t 42 | | EFlag of flag 43 | | ETest of test * string 44 | 45 | 46 | type 'a choices = (t * 'a) list 47 | 48 | let eval var_get t = 49 | let rec eval' = 50 | function 51 | | EBool b -> 52 | b 53 | 54 | | ENot e -> 55 | not (eval' e) 56 | 57 | | EAnd (e1, e2) -> 58 | (eval' e1) && (eval' e2) 59 | 60 | | EOr (e1, e2) -> 61 | (eval' e1) || (eval' e2) 62 | 63 | | EFlag nm -> 64 | let v = 65 | var_get nm 66 | in 67 | assert(v = "true" || v = "false"); 68 | (v = "true") 69 | 70 | | ETest (nm, vl) -> 71 | let v = 72 | var_get nm 73 | in 74 | (v = vl) 75 | in 76 | eval' t 77 | 78 | let choose ?printer ?name var_get lst = 79 | let rec choose_aux = 80 | function 81 | | (cond, vl) :: tl -> 82 | if eval var_get cond then 83 | vl 84 | else 85 | choose_aux tl 86 | | [] -> 87 | let str_lst = 88 | if lst = [] then 89 | s_ "" 90 | else 91 | String.concat 92 | (s_ ", ") 93 | (List.map 94 | (fun (cond, vl) -> 95 | match printer with 96 | | Some p -> p vl 97 | | None -> s_ "") 98 | lst) 99 | in 100 | match name with 101 | | Some nm -> 102 | failwith 103 | (Printf.sprintf 104 | (f_ "No result for the choice list '%s': %s") 105 | nm str_lst) 106 | | None -> 107 | failwith 108 | (Printf.sprintf 109 | (f_ "No result for a choice list: %s") 110 | str_lst) 111 | in 112 | choose_aux (List.rev lst) 113 | 114 | end 115 | 116 | 117 | # 117 "myocamlbuild.ml" 118 | module BaseEnvLight = struct 119 | (* # 21 "src/base/BaseEnvLight.ml" *) 120 | 121 | module MapString = Map.Make(String) 122 | 123 | type t = string MapString.t 124 | 125 | let default_filename = 126 | Filename.concat 127 | (Sys.getcwd ()) 128 | "setup.data" 129 | 130 | let load ?(allow_empty=false) ?(filename=default_filename) () = 131 | if Sys.file_exists filename then 132 | begin 133 | let chn = 134 | open_in_bin filename 135 | in 136 | let st = 137 | Stream.of_channel chn 138 | in 139 | let line = 140 | ref 1 141 | in 142 | let st_line = 143 | Stream.from 144 | (fun _ -> 145 | try 146 | match Stream.next st with 147 | | '\n' -> incr line; Some '\n' 148 | | c -> Some c 149 | with Stream.Failure -> None) 150 | in 151 | let lexer = 152 | Genlex.make_lexer ["="] st_line 153 | in 154 | let rec read_file mp = 155 | match Stream.npeek 3 lexer with 156 | | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> 157 | Stream.junk lexer; 158 | Stream.junk lexer; 159 | Stream.junk lexer; 160 | read_file (MapString.add nm value mp) 161 | | [] -> 162 | mp 163 | | _ -> 164 | failwith 165 | (Printf.sprintf 166 | "Malformed data file '%s' line %d" 167 | filename !line) 168 | in 169 | let mp = 170 | read_file MapString.empty 171 | in 172 | close_in chn; 173 | mp 174 | end 175 | else if allow_empty then 176 | begin 177 | MapString.empty 178 | end 179 | else 180 | begin 181 | failwith 182 | (Printf.sprintf 183 | "Unable to load environment, the file '%s' doesn't exist." 184 | filename) 185 | end 186 | 187 | let var_get name env = 188 | let rec var_expand str = 189 | let buff = 190 | Buffer.create ((String.length str) * 2) 191 | in 192 | Buffer.add_substitute 193 | buff 194 | (fun var -> 195 | try 196 | var_expand (MapString.find var env) 197 | with Not_found -> 198 | failwith 199 | (Printf.sprintf 200 | "No variable %s defined when trying to expand %S." 201 | var 202 | str)) 203 | str; 204 | Buffer.contents buff 205 | in 206 | var_expand (MapString.find name env) 207 | 208 | let var_choose lst env = 209 | OASISExpr.choose 210 | (fun nm -> var_get nm env) 211 | lst 212 | end 213 | 214 | 215 | # 215 "myocamlbuild.ml" 216 | module MyOCamlbuildFindlib = struct 217 | (* # 21 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) 218 | 219 | (** OCamlbuild extension, copied from 220 | * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild 221 | * by N. Pouillard and others 222 | * 223 | * Updated on 2009/02/28 224 | * 225 | * Modified by Sylvain Le Gall 226 | *) 227 | open Ocamlbuild_plugin 228 | 229 | (* these functions are not really officially exported *) 230 | let run_and_read = 231 | Ocamlbuild_pack.My_unix.run_and_read 232 | 233 | let blank_sep_strings = 234 | Ocamlbuild_pack.Lexers.blank_sep_strings 235 | 236 | let split s ch = 237 | let x = 238 | ref [] 239 | in 240 | let rec go s = 241 | let pos = 242 | String.index s ch 243 | in 244 | x := (String.before s pos)::!x; 245 | go (String.after s (pos + 1)) 246 | in 247 | try 248 | go s 249 | with Not_found -> !x 250 | 251 | let split_nl s = split s '\n' 252 | 253 | let before_space s = 254 | try 255 | String.before s (String.index s ' ') 256 | with Not_found -> s 257 | 258 | (* this lists all supported packages *) 259 | let find_packages () = 260 | List.map before_space (split_nl & run_and_read "ocamlfind list") 261 | 262 | (* this is supposed to list available syntaxes, but I don't know how to do it. *) 263 | let find_syntaxes () = ["camlp4o"; "camlp4r"] 264 | 265 | (* ocamlfind command *) 266 | let ocamlfind x = S[A"ocamlfind"; x] 267 | 268 | let dispatch = 269 | function 270 | | Before_options -> 271 | (* by using Before_options one let command line options have an higher priority *) 272 | (* on the contrary using After_options will guarantee to have the higher priority *) 273 | (* override default commands by ocamlfind ones *) 274 | Options.ocamlc := ocamlfind & A"ocamlc"; 275 | Options.ocamlopt := ocamlfind & A"ocamlopt"; 276 | Options.ocamldep := ocamlfind & A"ocamldep"; 277 | Options.ocamldoc := ocamlfind & A"ocamldoc"; 278 | Options.ocamlmktop := ocamlfind & A"ocamlmktop" 279 | 280 | | After_rules -> 281 | 282 | (* When one link an OCaml library/binary/package, one should use -linkpkg *) 283 | flag ["ocaml"; "link"; "program"] & A"-linkpkg"; 284 | 285 | (* For each ocamlfind package one inject the -package option when 286 | * compiling, computing dependencies, generating documentation and 287 | * linking. *) 288 | List.iter 289 | begin fun pkg -> 290 | flag ["ocaml"; "compile"; "pkg_"^pkg] & S[A"-package"; A pkg]; 291 | flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S[A"-package"; A pkg]; 292 | flag ["ocaml"; "doc"; "pkg_"^pkg] & S[A"-package"; A pkg]; 293 | flag ["ocaml"; "link"; "pkg_"^pkg] & S[A"-package"; A pkg]; 294 | flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S[A"-package"; A pkg]; 295 | end 296 | (find_packages ()); 297 | 298 | (* Like -package but for extensions syntax. Morover -syntax is useless 299 | * when linking. *) 300 | List.iter begin fun syntax -> 301 | flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 302 | flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 303 | flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 304 | flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 305 | end (find_syntaxes ()); 306 | 307 | (* The default "thread" tag is not compatible with ocamlfind. 308 | * Indeed, the default rules add the "threads.cma" or "threads.cmxa" 309 | * options when using this tag. When using the "-linkpkg" option with 310 | * ocamlfind, this module will then be added twice on the command line. 311 | * 312 | * To solve this, one approach is to add the "-thread" option when using 313 | * the "threads" package using the previous plugin. 314 | *) 315 | flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]); 316 | flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]); 317 | flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]); 318 | flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]) 319 | 320 | | _ -> 321 | () 322 | 323 | end 324 | 325 | module MyOCamlbuildBase = struct 326 | (* # 21 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) 327 | 328 | (** Base functions for writing myocamlbuild.ml 329 | @author Sylvain Le Gall 330 | *) 331 | 332 | 333 | 334 | open Ocamlbuild_plugin 335 | module OC = Ocamlbuild_pack.Ocaml_compiler 336 | 337 | type dir = string 338 | type file = string 339 | type name = string 340 | type tag = string 341 | 342 | (* # 56 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) 343 | 344 | type t = 345 | { 346 | lib_ocaml: (name * dir list) list; 347 | lib_c: (name * dir * file list) list; 348 | flags: (tag list * (spec OASISExpr.choices)) list; 349 | (* Replace the 'dir: include' from _tags by a precise interdepends in 350 | * directory. 351 | *) 352 | includes: (dir * dir list) list; 353 | } 354 | 355 | let env_filename = 356 | Pathname.basename 357 | BaseEnvLight.default_filename 358 | 359 | let dispatch_combine lst = 360 | fun e -> 361 | List.iter 362 | (fun dispatch -> dispatch e) 363 | lst 364 | 365 | let tag_libstubs nm = 366 | "use_lib"^nm^"_stubs" 367 | 368 | let nm_libstubs nm = 369 | nm^"_stubs" 370 | 371 | let dispatch t e = 372 | let env = 373 | BaseEnvLight.load 374 | ~filename:env_filename 375 | ~allow_empty:true 376 | () 377 | in 378 | match e with 379 | | Before_options -> 380 | let no_trailing_dot s = 381 | if String.length s >= 1 && s.[0] = '.' then 382 | String.sub s 1 ((String.length s) - 1) 383 | else 384 | s 385 | in 386 | List.iter 387 | (fun (opt, var) -> 388 | try 389 | opt := no_trailing_dot (BaseEnvLight.var_get var env) 390 | with Not_found -> 391 | Printf.eprintf "W: Cannot get variable %s" var) 392 | [ 393 | Options.ext_obj, "ext_obj"; 394 | Options.ext_lib, "ext_lib"; 395 | Options.ext_dll, "ext_dll"; 396 | ] 397 | 398 | | After_rules -> 399 | (* Declare OCaml libraries *) 400 | List.iter 401 | (function 402 | | nm, [] -> 403 | ocaml_lib nm 404 | | nm, dir :: tl -> 405 | ocaml_lib ~dir:dir (dir^"/"^nm); 406 | List.iter 407 | (fun dir -> 408 | List.iter 409 | (fun str -> 410 | flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir])) 411 | ["compile"; "infer_interface"; "doc"]) 412 | tl) 413 | t.lib_ocaml; 414 | 415 | (* Declare directories dependencies, replace "include" in _tags. *) 416 | List.iter 417 | (fun (dir, include_dirs) -> 418 | Pathname.define_context dir include_dirs) 419 | t.includes; 420 | 421 | (* Declare C libraries *) 422 | List.iter 423 | (fun (lib, dir, headers) -> 424 | (* Handle C part of library *) 425 | flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib] 426 | (S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib"; 427 | A("-l"^(nm_libstubs lib))]); 428 | 429 | flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib] 430 | (S[A"-cclib"; A("-l"^(nm_libstubs lib))]); 431 | 432 | flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib] 433 | (S[A"-dllib"; A("dll"^(nm_libstubs lib))]); 434 | 435 | (* When ocaml link something that use the C library, then one 436 | need that file to be up to date. 437 | *) 438 | dep ["link"; "ocaml"; "program"; tag_libstubs lib] 439 | [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; 440 | 441 | dep ["compile"; "ocaml"; "program"; tag_libstubs lib] 442 | [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; 443 | 444 | (* TODO: be more specific about what depends on headers *) 445 | (* Depends on .h files *) 446 | dep ["compile"; "c"] 447 | headers; 448 | 449 | (* Setup search path for lib *) 450 | flag ["link"; "ocaml"; "use_"^lib] 451 | (S[A"-I"; P(dir)]); 452 | ) 453 | t.lib_c; 454 | 455 | (* Add flags *) 456 | List.iter 457 | (fun (tags, cond_specs) -> 458 | let spec = 459 | BaseEnvLight.var_choose cond_specs env 460 | in 461 | flag tags & spec) 462 | t.flags 463 | | _ -> 464 | () 465 | 466 | let dispatch_default t = 467 | dispatch_combine 468 | [ 469 | dispatch t; 470 | MyOCamlbuildFindlib.dispatch; 471 | ] 472 | 473 | end 474 | 475 | 476 | # 476 "myocamlbuild.ml" 477 | open Ocamlbuild_plugin;; 478 | let package_default = 479 | { 480 | MyOCamlbuildBase.lib_ocaml = [("quickcheck", ["src"])]; 481 | lib_c = []; 482 | flags = 483 | [ 484 | (["oasis_library_quickcheck_byte"; "ocaml"; "link"; "byte"], 485 | [(OASISExpr.EBool true, S [A "-w"; A "@a"; A "-g"])]); 486 | (["oasis_library_quickcheck_native"; "ocaml"; "link"; "native"], 487 | [(OASISExpr.EBool true, S [A "-w"; A "@a"; A "-g"])]); 488 | (["oasis_library_quickcheck_byte"; "ocaml"; "ocamldep"; "byte"], 489 | [(OASISExpr.EBool true, S [A "-w"; A "@a"; A "-g"])]); 490 | (["oasis_library_quickcheck_native"; "ocaml"; "ocamldep"; "native"], 491 | [(OASISExpr.EBool true, S [A "-w"; A "@a"; A "-g"])]); 492 | (["oasis_library_quickcheck_byte"; "ocaml"; "compile"; "byte"], 493 | [(OASISExpr.EBool true, S [A "-w"; A "@a"; A "-g"])]); 494 | (["oasis_library_quickcheck_native"; "ocaml"; "compile"; "native"], 495 | [(OASISExpr.EBool true, S [A "-w"; A "@a"; A "-g"])]) 496 | ]; 497 | includes = [("tests", ["src"])]; 498 | } 499 | ;; 500 | 501 | let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;; 502 | 503 | # 504 "myocamlbuild.ml" 504 | (* OASIS_STOP *) 505 | Ocamlbuild_plugin.dispatch dispatch_default;; 506 | -------------------------------------------------------------------------------- /setup.ml: -------------------------------------------------------------------------------- 1 | (* setup.ml generated for the first time by OASIS v0.2.0 *) 2 | 3 | (* OASIS_START *) 4 | (* DO NOT EDIT (digest: b54235c06762d2b348d9443ff48e8cde) *) 5 | (* 6 | Regenerated by OASIS v0.3.0 7 | Visit http://oasis.forge.ocamlcore.org for more information and 8 | documentation about functions used in this file. 9 | *) 10 | module OASISGettext = struct 11 | (* # 21 "src/oasis/OASISGettext.ml" *) 12 | 13 | let ns_ str = 14 | str 15 | 16 | let s_ str = 17 | str 18 | 19 | let f_ (str : ('a, 'b, 'c, 'd) format4) = 20 | str 21 | 22 | let fn_ fmt1 fmt2 n = 23 | if n = 1 then 24 | fmt1^^"" 25 | else 26 | fmt2^^"" 27 | 28 | let init = 29 | [] 30 | 31 | end 32 | 33 | module OASISContext = struct 34 | (* # 21 "src/oasis/OASISContext.ml" *) 35 | 36 | open OASISGettext 37 | 38 | type level = 39 | [ `Debug 40 | | `Info 41 | | `Warning 42 | | `Error] 43 | 44 | type t = 45 | { 46 | quiet: bool; 47 | info: bool; 48 | debug: bool; 49 | ignore_plugins: bool; 50 | ignore_unknown_fields: bool; 51 | printf: level -> string -> unit; 52 | } 53 | 54 | let printf lvl str = 55 | let beg = 56 | match lvl with 57 | | `Error -> s_ "E: " 58 | | `Warning -> s_ "W: " 59 | | `Info -> s_ "I: " 60 | | `Debug -> s_ "D: " 61 | in 62 | prerr_endline (beg^str) 63 | 64 | let default = 65 | ref 66 | { 67 | quiet = false; 68 | info = false; 69 | debug = false; 70 | ignore_plugins = false; 71 | ignore_unknown_fields = false; 72 | printf = printf; 73 | } 74 | 75 | let quiet = 76 | {!default with quiet = true} 77 | 78 | 79 | let args () = 80 | ["-quiet", 81 | Arg.Unit (fun () -> default := {!default with quiet = true}), 82 | (s_ " Run quietly"); 83 | 84 | "-info", 85 | Arg.Unit (fun () -> default := {!default with info = true}), 86 | (s_ " Display information message"); 87 | 88 | 89 | "-debug", 90 | Arg.Unit (fun () -> default := {!default with debug = true}), 91 | (s_ " Output debug message")] 92 | end 93 | 94 | module OASISString = struct 95 | (* # 1 "src/oasis/OASISString.ml" *) 96 | 97 | 98 | 99 | (** Various string utilities. 100 | 101 | Mostly inspired by extlib and batteries ExtString and BatString libraries. 102 | 103 | @author Sylvain Le Gall 104 | *) 105 | 106 | let nsplitf str f = 107 | if str = "" then 108 | [] 109 | else 110 | let buf = Buffer.create 13 in 111 | let lst = ref [] in 112 | let push () = 113 | lst := Buffer.contents buf :: !lst; 114 | Buffer.clear buf 115 | in 116 | let str_len = String.length str in 117 | for i = 0 to str_len - 1 do 118 | if f str.[i] then 119 | push () 120 | else 121 | Buffer.add_char buf str.[i] 122 | done; 123 | push (); 124 | List.rev !lst 125 | 126 | (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the 127 | separator. 128 | *) 129 | let nsplit str c = 130 | nsplitf str ((=) c) 131 | 132 | let find ~what ?(offset=0) str = 133 | let what_idx = ref 0 in 134 | let str_idx = ref offset in 135 | while !str_idx < String.length str && 136 | !what_idx < String.length what do 137 | if str.[!str_idx] = what.[!what_idx] then 138 | incr what_idx 139 | else 140 | what_idx := 0; 141 | incr str_idx 142 | done; 143 | if !what_idx <> String.length what then 144 | raise Not_found 145 | else 146 | !str_idx - !what_idx 147 | 148 | let sub_start str len = 149 | let str_len = String.length str in 150 | if len >= str_len then 151 | "" 152 | else 153 | String.sub str len (str_len - len) 154 | 155 | let sub_end ?(offset=0) str len = 156 | let str_len = String.length str in 157 | if len >= str_len then 158 | "" 159 | else 160 | String.sub str 0 (str_len - len) 161 | 162 | let starts_with ~what ?(offset=0) str = 163 | let what_idx = ref 0 in 164 | let str_idx = ref offset in 165 | let ok = ref true in 166 | while !ok && 167 | !str_idx < String.length str && 168 | !what_idx < String.length what do 169 | if str.[!str_idx] = what.[!what_idx] then 170 | incr what_idx 171 | else 172 | ok := false; 173 | incr str_idx 174 | done; 175 | if !what_idx = String.length what then 176 | true 177 | else 178 | false 179 | 180 | let strip_starts_with ~what str = 181 | if starts_with ~what str then 182 | sub_start str (String.length what) 183 | else 184 | raise Not_found 185 | 186 | let ends_with ~what ?(offset=0) str = 187 | let what_idx = ref ((String.length what) - 1) in 188 | let str_idx = ref ((String.length str) - 1) in 189 | let ok = ref true in 190 | while !ok && 191 | offset <= !str_idx && 192 | 0 <= !what_idx do 193 | if str.[!str_idx] = what.[!what_idx] then 194 | decr what_idx 195 | else 196 | ok := false; 197 | decr str_idx 198 | done; 199 | if !what_idx = -1 then 200 | true 201 | else 202 | false 203 | 204 | let strip_ends_with ~what str = 205 | if ends_with ~what str then 206 | sub_end str (String.length what) 207 | else 208 | raise Not_found 209 | 210 | let replace_chars f s = 211 | let buf = String.make (String.length s) 'X' in 212 | for i = 0 to String.length s - 1 do 213 | buf.[i] <- f s.[i] 214 | done; 215 | buf 216 | 217 | end 218 | 219 | module OASISUtils = struct 220 | (* # 21 "src/oasis/OASISUtils.ml" *) 221 | 222 | open OASISGettext 223 | 224 | module MapString = Map.Make(String) 225 | 226 | let map_string_of_assoc assoc = 227 | List.fold_left 228 | (fun acc (k, v) -> MapString.add k v acc) 229 | MapString.empty 230 | assoc 231 | 232 | module SetString = Set.Make(String) 233 | 234 | let set_string_add_list st lst = 235 | List.fold_left 236 | (fun acc e -> SetString.add e acc) 237 | st 238 | lst 239 | 240 | let set_string_of_list = 241 | set_string_add_list 242 | SetString.empty 243 | 244 | 245 | let compare_csl s1 s2 = 246 | String.compare (String.lowercase s1) (String.lowercase s2) 247 | 248 | module HashStringCsl = 249 | Hashtbl.Make 250 | (struct 251 | type t = string 252 | 253 | let equal s1 s2 = 254 | (String.lowercase s1) = (String.lowercase s2) 255 | 256 | let hash s = 257 | Hashtbl.hash (String.lowercase s) 258 | end) 259 | 260 | let varname_of_string ?(hyphen='_') s = 261 | if String.length s = 0 then 262 | begin 263 | invalid_arg "varname_of_string" 264 | end 265 | else 266 | begin 267 | let buf = 268 | OASISString.replace_chars 269 | (fun c -> 270 | if ('a' <= c && c <= 'z') 271 | || 272 | ('A' <= c && c <= 'Z') 273 | || 274 | ('0' <= c && c <= '9') then 275 | c 276 | else 277 | hyphen) 278 | s; 279 | in 280 | let buf = 281 | (* Start with a _ if digit *) 282 | if '0' <= s.[0] && s.[0] <= '9' then 283 | "_"^buf 284 | else 285 | buf 286 | in 287 | String.lowercase buf 288 | end 289 | 290 | let varname_concat ?(hyphen='_') p s = 291 | let what = String.make 1 hyphen in 292 | let p = 293 | try 294 | OASISString.strip_ends_with ~what p 295 | with Not_found -> 296 | p 297 | in 298 | let s = 299 | try 300 | OASISString.strip_starts_with ~what s 301 | with Not_found -> 302 | s 303 | in 304 | p^what^s 305 | 306 | 307 | let is_varname str = 308 | str = varname_of_string str 309 | 310 | let failwithf fmt = Printf.ksprintf failwith fmt 311 | 312 | end 313 | 314 | module PropList = struct 315 | (* # 21 "src/oasis/PropList.ml" *) 316 | 317 | open OASISGettext 318 | 319 | type name = string 320 | 321 | exception Not_set of name * string option 322 | exception No_printer of name 323 | exception Unknown_field of name * name 324 | 325 | let () = 326 | Printexc.register_printer 327 | (function 328 | | Not_set (nm, Some rsn) -> 329 | Some 330 | (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn) 331 | | Not_set (nm, None) -> 332 | Some 333 | (Printf.sprintf (f_ "Field '%s' is not set") nm) 334 | | No_printer nm -> 335 | Some 336 | (Printf.sprintf (f_ "No default printer for value %s") nm) 337 | | Unknown_field (nm, schm) -> 338 | Some 339 | (Printf.sprintf (f_ "Field %s is not defined in schema %s") nm schm) 340 | | _ -> 341 | None) 342 | 343 | module Data = 344 | struct 345 | 346 | type t = 347 | (name, unit -> unit) Hashtbl.t 348 | 349 | let create () = 350 | Hashtbl.create 13 351 | 352 | let clear t = 353 | Hashtbl.clear t 354 | 355 | (* # 71 "src/oasis/PropList.ml" *) 356 | end 357 | 358 | module Schema = 359 | struct 360 | 361 | type ('ctxt, 'extra) value = 362 | { 363 | get: Data.t -> string; 364 | set: Data.t -> ?context:'ctxt -> string -> unit; 365 | help: (unit -> string) option; 366 | extra: 'extra; 367 | } 368 | 369 | type ('ctxt, 'extra) t = 370 | { 371 | name: name; 372 | fields: (name, ('ctxt, 'extra) value) Hashtbl.t; 373 | order: name Queue.t; 374 | name_norm: string -> string; 375 | } 376 | 377 | let create ?(case_insensitive=false) nm = 378 | { 379 | name = nm; 380 | fields = Hashtbl.create 13; 381 | order = Queue.create (); 382 | name_norm = 383 | (if case_insensitive then 384 | String.lowercase 385 | else 386 | fun s -> s); 387 | } 388 | 389 | let add t nm set get extra help = 390 | let key = 391 | t.name_norm nm 392 | in 393 | 394 | if Hashtbl.mem t.fields key then 395 | failwith 396 | (Printf.sprintf 397 | (f_ "Field '%s' is already defined in schema '%s'") 398 | nm t.name); 399 | Hashtbl.add 400 | t.fields 401 | key 402 | { 403 | set = set; 404 | get = get; 405 | help = help; 406 | extra = extra; 407 | }; 408 | Queue.add nm t.order 409 | 410 | let mem t nm = 411 | Hashtbl.mem t.fields nm 412 | 413 | let find t nm = 414 | try 415 | Hashtbl.find t.fields (t.name_norm nm) 416 | with Not_found -> 417 | raise (Unknown_field (nm, t.name)) 418 | 419 | let get t data nm = 420 | (find t nm).get data 421 | 422 | let set t data nm ?context x = 423 | (find t nm).set 424 | data 425 | ?context 426 | x 427 | 428 | let fold f acc t = 429 | Queue.fold 430 | (fun acc k -> 431 | let v = 432 | find t k 433 | in 434 | f acc k v.extra v.help) 435 | acc 436 | t.order 437 | 438 | let iter f t = 439 | fold 440 | (fun () -> f) 441 | () 442 | t 443 | 444 | let name t = 445 | t.name 446 | end 447 | 448 | module Field = 449 | struct 450 | 451 | type ('ctxt, 'value, 'extra) t = 452 | { 453 | set: Data.t -> ?context:'ctxt -> 'value -> unit; 454 | get: Data.t -> 'value; 455 | sets: Data.t -> ?context:'ctxt -> string -> unit; 456 | gets: Data.t -> string; 457 | help: (unit -> string) option; 458 | extra: 'extra; 459 | } 460 | 461 | let new_id = 462 | let last_id = 463 | ref 0 464 | in 465 | fun () -> incr last_id; !last_id 466 | 467 | let create ?schema ?name ?parse ?print ?default ?update ?help extra = 468 | (* Default value container *) 469 | let v = 470 | ref None 471 | in 472 | 473 | (* If name is not given, create unique one *) 474 | let nm = 475 | match name with 476 | | Some s -> s 477 | | None -> Printf.sprintf "_anon_%d" (new_id ()) 478 | in 479 | 480 | (* Last chance to get a value: the default *) 481 | let default () = 482 | match default with 483 | | Some d -> d 484 | | None -> raise (Not_set (nm, Some (s_ "no default value"))) 485 | in 486 | 487 | (* Get data *) 488 | let get data = 489 | (* Get value *) 490 | try 491 | (Hashtbl.find data nm) (); 492 | match !v with 493 | | Some x -> x 494 | | None -> default () 495 | with Not_found -> 496 | default () 497 | in 498 | 499 | (* Set data *) 500 | let set data ?context x = 501 | let x = 502 | match update with 503 | | Some f -> 504 | begin 505 | try 506 | f ?context (get data) x 507 | with Not_set _ -> 508 | x 509 | end 510 | | None -> 511 | x 512 | in 513 | Hashtbl.replace 514 | data 515 | nm 516 | (fun () -> v := Some x) 517 | in 518 | 519 | (* Parse string value, if possible *) 520 | let parse = 521 | match parse with 522 | | Some f -> 523 | f 524 | | None -> 525 | fun ?context s -> 526 | failwith 527 | (Printf.sprintf 528 | (f_ "Cannot parse field '%s' when setting value %S") 529 | nm 530 | s) 531 | in 532 | 533 | (* Set data, from string *) 534 | let sets data ?context s = 535 | set ?context data (parse ?context s) 536 | in 537 | 538 | (* Output value as string, if possible *) 539 | let print = 540 | match print with 541 | | Some f -> 542 | f 543 | | None -> 544 | fun _ -> raise (No_printer nm) 545 | in 546 | 547 | (* Get data, as a string *) 548 | let gets data = 549 | print (get data) 550 | in 551 | 552 | begin 553 | match schema with 554 | | Some t -> 555 | Schema.add t nm sets gets extra help 556 | | None -> 557 | () 558 | end; 559 | 560 | { 561 | set = set; 562 | get = get; 563 | sets = sets; 564 | gets = gets; 565 | help = help; 566 | extra = extra; 567 | } 568 | 569 | let fset data t ?context x = 570 | t.set data ?context x 571 | 572 | let fget data t = 573 | t.get data 574 | 575 | let fsets data t ?context s = 576 | t.sets data ?context s 577 | 578 | let fgets data t = 579 | t.gets data 580 | 581 | end 582 | 583 | module FieldRO = 584 | struct 585 | 586 | let create ?schema ?name ?parse ?print ?default ?update ?help extra = 587 | let fld = 588 | Field.create ?schema ?name ?parse ?print ?default ?update ?help extra 589 | in 590 | fun data -> Field.fget data fld 591 | 592 | end 593 | end 594 | 595 | module OASISMessage = struct 596 | (* # 21 "src/oasis/OASISMessage.ml" *) 597 | 598 | 599 | open OASISGettext 600 | open OASISContext 601 | 602 | let generic_message ~ctxt lvl fmt = 603 | let cond = 604 | if ctxt.quiet then 605 | false 606 | else 607 | match lvl with 608 | | `Debug -> ctxt.debug 609 | | `Info -> ctxt.info 610 | | _ -> true 611 | in 612 | Printf.ksprintf 613 | (fun str -> 614 | if cond then 615 | begin 616 | ctxt.printf lvl str 617 | end) 618 | fmt 619 | 620 | let debug ~ctxt fmt = 621 | generic_message ~ctxt `Debug fmt 622 | 623 | let info ~ctxt fmt = 624 | generic_message ~ctxt `Info fmt 625 | 626 | let warning ~ctxt fmt = 627 | generic_message ~ctxt `Warning fmt 628 | 629 | let error ~ctxt fmt = 630 | generic_message ~ctxt `Error fmt 631 | 632 | end 633 | 634 | module OASISVersion = struct 635 | (* # 21 "src/oasis/OASISVersion.ml" *) 636 | 637 | open OASISGettext 638 | 639 | 640 | 641 | type s = string 642 | 643 | type t = string 644 | 645 | type comparator = 646 | | VGreater of t 647 | | VGreaterEqual of t 648 | | VEqual of t 649 | | VLesser of t 650 | | VLesserEqual of t 651 | | VOr of comparator * comparator 652 | | VAnd of comparator * comparator 653 | 654 | 655 | (* Range of allowed characters *) 656 | let is_digit c = 657 | '0' <= c && c <= '9' 658 | 659 | let is_alpha c = 660 | ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') 661 | 662 | let is_special = 663 | function 664 | | '.' | '+' | '-' | '~' -> true 665 | | _ -> false 666 | 667 | let rec version_compare v1 v2 = 668 | if v1 <> "" || v2 <> "" then 669 | begin 670 | (* Compare ascii string, using special meaning for version 671 | * related char 672 | *) 673 | let val_ascii c = 674 | if c = '~' then -1 675 | else if is_digit c then 0 676 | else if c = '\000' then 0 677 | else if is_alpha c then Char.code c 678 | else (Char.code c) + 256 679 | in 680 | 681 | let len1 = String.length v1 in 682 | let len2 = String.length v2 in 683 | 684 | let p = ref 0 in 685 | 686 | (** Compare ascii part *) 687 | let compare_vascii () = 688 | let cmp = ref 0 in 689 | while !cmp = 0 && 690 | !p < len1 && !p < len2 && 691 | not (is_digit v1.[!p] && is_digit v2.[!p]) do 692 | cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]); 693 | incr p 694 | done; 695 | if !cmp = 0 && !p < len1 && !p = len2 then 696 | val_ascii v1.[!p] 697 | else if !cmp = 0 && !p = len1 && !p < len2 then 698 | - (val_ascii v2.[!p]) 699 | else 700 | !cmp 701 | in 702 | 703 | (** Compare digit part *) 704 | let compare_digit () = 705 | let extract_int v p = 706 | let start_p = !p in 707 | while !p < String.length v && is_digit v.[!p] do 708 | incr p 709 | done; 710 | let substr = 711 | String.sub v !p ((String.length v) - !p) 712 | in 713 | let res = 714 | match String.sub v start_p (!p - start_p) with 715 | | "" -> 0 716 | | s -> int_of_string s 717 | in 718 | res, substr 719 | in 720 | let i1, tl1 = extract_int v1 (ref !p) in 721 | let i2, tl2 = extract_int v2 (ref !p) in 722 | i1 - i2, tl1, tl2 723 | in 724 | 725 | match compare_vascii () with 726 | | 0 -> 727 | begin 728 | match compare_digit () with 729 | | 0, tl1, tl2 -> 730 | if tl1 <> "" && is_digit tl1.[0] then 731 | 1 732 | else if tl2 <> "" && is_digit tl2.[0] then 733 | -1 734 | else 735 | version_compare tl1 tl2 736 | | n, _, _ -> 737 | n 738 | end 739 | | n -> 740 | n 741 | end 742 | else 743 | begin 744 | 0 745 | end 746 | 747 | 748 | let version_of_string str = str 749 | 750 | let string_of_version t = t 751 | 752 | let chop t = 753 | try 754 | let pos = 755 | String.rindex t '.' 756 | in 757 | String.sub t 0 pos 758 | with Not_found -> 759 | t 760 | 761 | let rec comparator_apply v op = 762 | match op with 763 | | VGreater cv -> 764 | (version_compare v cv) > 0 765 | | VGreaterEqual cv -> 766 | (version_compare v cv) >= 0 767 | | VLesser cv -> 768 | (version_compare v cv) < 0 769 | | VLesserEqual cv -> 770 | (version_compare v cv) <= 0 771 | | VEqual cv -> 772 | (version_compare v cv) = 0 773 | | VOr (op1, op2) -> 774 | (comparator_apply v op1) || (comparator_apply v op2) 775 | | VAnd (op1, op2) -> 776 | (comparator_apply v op1) && (comparator_apply v op2) 777 | 778 | let rec string_of_comparator = 779 | function 780 | | VGreater v -> "> "^(string_of_version v) 781 | | VEqual v -> "= "^(string_of_version v) 782 | | VLesser v -> "< "^(string_of_version v) 783 | | VGreaterEqual v -> ">= "^(string_of_version v) 784 | | VLesserEqual v -> "<= "^(string_of_version v) 785 | | VOr (c1, c2) -> 786 | (string_of_comparator c1)^" || "^(string_of_comparator c2) 787 | | VAnd (c1, c2) -> 788 | (string_of_comparator c1)^" && "^(string_of_comparator c2) 789 | 790 | let rec varname_of_comparator = 791 | let concat p v = 792 | OASISUtils.varname_concat 793 | p 794 | (OASISUtils.varname_of_string 795 | (string_of_version v)) 796 | in 797 | function 798 | | VGreater v -> concat "gt" v 799 | | VLesser v -> concat "lt" v 800 | | VEqual v -> concat "eq" v 801 | | VGreaterEqual v -> concat "ge" v 802 | | VLesserEqual v -> concat "le" v 803 | | VOr (c1, c2) -> 804 | (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2) 805 | | VAnd (c1, c2) -> 806 | (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2) 807 | 808 | let version_0_3_or_after t = 809 | comparator_apply t (VGreaterEqual (string_of_version "0.3")) 810 | 811 | end 812 | 813 | module OASISLicense = struct 814 | (* # 21 "src/oasis/OASISLicense.ml" *) 815 | 816 | (** License for _oasis fields 817 | @author Sylvain Le Gall 818 | *) 819 | 820 | 821 | 822 | type license = string 823 | 824 | type license_exception = string 825 | 826 | type license_version = 827 | | Version of OASISVersion.t 828 | | VersionOrLater of OASISVersion.t 829 | | NoVersion 830 | 831 | 832 | type license_dep_5_unit = 833 | { 834 | license: license; 835 | excption: license_exception option; 836 | version: license_version; 837 | } 838 | 839 | 840 | type license_dep_5 = 841 | | DEP5Unit of license_dep_5_unit 842 | | DEP5Or of license_dep_5 list 843 | | DEP5And of license_dep_5 list 844 | 845 | 846 | type t = 847 | | DEP5License of license_dep_5 848 | | OtherLicense of string (* URL *) 849 | 850 | 851 | end 852 | 853 | module OASISExpr = struct 854 | (* # 21 "src/oasis/OASISExpr.ml" *) 855 | 856 | 857 | 858 | open OASISGettext 859 | 860 | type test = string 861 | 862 | type flag = string 863 | 864 | type t = 865 | | EBool of bool 866 | | ENot of t 867 | | EAnd of t * t 868 | | EOr of t * t 869 | | EFlag of flag 870 | | ETest of test * string 871 | 872 | 873 | type 'a choices = (t * 'a) list 874 | 875 | let eval var_get t = 876 | let rec eval' = 877 | function 878 | | EBool b -> 879 | b 880 | 881 | | ENot e -> 882 | not (eval' e) 883 | 884 | | EAnd (e1, e2) -> 885 | (eval' e1) && (eval' e2) 886 | 887 | | EOr (e1, e2) -> 888 | (eval' e1) || (eval' e2) 889 | 890 | | EFlag nm -> 891 | let v = 892 | var_get nm 893 | in 894 | assert(v = "true" || v = "false"); 895 | (v = "true") 896 | 897 | | ETest (nm, vl) -> 898 | let v = 899 | var_get nm 900 | in 901 | (v = vl) 902 | in 903 | eval' t 904 | 905 | let choose ?printer ?name var_get lst = 906 | let rec choose_aux = 907 | function 908 | | (cond, vl) :: tl -> 909 | if eval var_get cond then 910 | vl 911 | else 912 | choose_aux tl 913 | | [] -> 914 | let str_lst = 915 | if lst = [] then 916 | s_ "" 917 | else 918 | String.concat 919 | (s_ ", ") 920 | (List.map 921 | (fun (cond, vl) -> 922 | match printer with 923 | | Some p -> p vl 924 | | None -> s_ "") 925 | lst) 926 | in 927 | match name with 928 | | Some nm -> 929 | failwith 930 | (Printf.sprintf 931 | (f_ "No result for the choice list '%s': %s") 932 | nm str_lst) 933 | | None -> 934 | failwith 935 | (Printf.sprintf 936 | (f_ "No result for a choice list: %s") 937 | str_lst) 938 | in 939 | choose_aux (List.rev lst) 940 | 941 | end 942 | 943 | module OASISTypes = struct 944 | (* # 21 "src/oasis/OASISTypes.ml" *) 945 | 946 | 947 | 948 | 949 | type name = string 950 | type package_name = string 951 | type url = string 952 | type unix_dirname = string 953 | type unix_filename = string 954 | type host_dirname = string 955 | type host_filename = string 956 | type prog = string 957 | type arg = string 958 | type args = string list 959 | type command_line = (prog * arg list) 960 | 961 | type findlib_name = string 962 | type findlib_full = string 963 | 964 | type compiled_object = 965 | | Byte 966 | | Native 967 | | Best 968 | 969 | 970 | type dependency = 971 | | FindlibPackage of findlib_full * OASISVersion.comparator option 972 | | InternalLibrary of name 973 | 974 | 975 | type tool = 976 | | ExternalTool of name 977 | | InternalExecutable of name 978 | 979 | 980 | type vcs = 981 | | Darcs 982 | | Git 983 | | Svn 984 | | Cvs 985 | | Hg 986 | | Bzr 987 | | Arch 988 | | Monotone 989 | | OtherVCS of url 990 | 991 | 992 | type plugin_kind = 993 | [ `Configure 994 | | `Build 995 | | `Doc 996 | | `Test 997 | | `Install 998 | | `Extra 999 | ] 1000 | 1001 | type plugin_data_purpose = 1002 | [ `Configure 1003 | | `Build 1004 | | `Install 1005 | | `Clean 1006 | | `Distclean 1007 | | `Install 1008 | | `Uninstall 1009 | | `Test 1010 | | `Doc 1011 | | `Extra 1012 | | `Other of string 1013 | ] 1014 | 1015 | type 'a plugin = 'a * name * OASISVersion.t option 1016 | 1017 | type all_plugin = plugin_kind plugin 1018 | 1019 | type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list 1020 | 1021 | (* # 102 "src/oasis/OASISTypes.ml" *) 1022 | 1023 | type 'a conditional = 'a OASISExpr.choices 1024 | 1025 | type custom = 1026 | { 1027 | pre_command: (command_line option) conditional; 1028 | post_command: (command_line option) conditional; 1029 | } 1030 | 1031 | 1032 | type common_section = 1033 | { 1034 | cs_name: name; 1035 | cs_data: PropList.Data.t; 1036 | cs_plugin_data: plugin_data; 1037 | } 1038 | 1039 | 1040 | type build_section = 1041 | { 1042 | bs_build: bool conditional; 1043 | bs_install: bool conditional; 1044 | bs_path: unix_dirname; 1045 | bs_compiled_object: compiled_object; 1046 | bs_build_depends: dependency list; 1047 | bs_build_tools: tool list; 1048 | bs_c_sources: unix_filename list; 1049 | bs_data_files: (unix_filename * unix_filename option) list; 1050 | bs_ccopt: args conditional; 1051 | bs_cclib: args conditional; 1052 | bs_dlllib: args conditional; 1053 | bs_dllpath: args conditional; 1054 | bs_byteopt: args conditional; 1055 | bs_nativeopt: args conditional; 1056 | } 1057 | 1058 | 1059 | type library = 1060 | { 1061 | lib_modules: string list; 1062 | lib_pack: bool; 1063 | lib_internal_modules: string list; 1064 | lib_findlib_parent: findlib_name option; 1065 | lib_findlib_name: findlib_name option; 1066 | lib_findlib_containers: findlib_name list; 1067 | } 1068 | 1069 | type executable = 1070 | { 1071 | exec_custom: bool; 1072 | exec_main_is: unix_filename; 1073 | } 1074 | 1075 | type flag = 1076 | { 1077 | flag_description: string option; 1078 | flag_default: bool conditional; 1079 | } 1080 | 1081 | type source_repository = 1082 | { 1083 | src_repo_type: vcs; 1084 | src_repo_location: url; 1085 | src_repo_browser: url option; 1086 | src_repo_module: string option; 1087 | src_repo_branch: string option; 1088 | src_repo_tag: string option; 1089 | src_repo_subdir: unix_filename option; 1090 | } 1091 | 1092 | type test = 1093 | { 1094 | test_type: [`Test] plugin; 1095 | test_command: command_line conditional; 1096 | test_custom: custom; 1097 | test_working_directory: unix_filename option; 1098 | test_run: bool conditional; 1099 | test_tools: tool list; 1100 | } 1101 | 1102 | type doc_format = 1103 | | HTML of unix_filename 1104 | | DocText 1105 | | PDF 1106 | | PostScript 1107 | | Info of unix_filename 1108 | | DVI 1109 | | OtherDoc 1110 | 1111 | 1112 | type doc = 1113 | { 1114 | doc_type: [`Doc] plugin; 1115 | doc_custom: custom; 1116 | doc_build: bool conditional; 1117 | doc_install: bool conditional; 1118 | doc_install_dir: unix_filename; 1119 | doc_title: string; 1120 | doc_authors: string list; 1121 | doc_abstract: string option; 1122 | doc_format: doc_format; 1123 | doc_data_files: (unix_filename * unix_filename option) list; 1124 | doc_build_tools: tool list; 1125 | } 1126 | 1127 | type section = 1128 | | Library of common_section * build_section * library 1129 | | Executable of common_section * build_section * executable 1130 | | Flag of common_section * flag 1131 | | SrcRepo of common_section * source_repository 1132 | | Test of common_section * test 1133 | | Doc of common_section * doc 1134 | 1135 | 1136 | type section_kind = 1137 | [ `Library | `Executable | `Flag | `SrcRepo | `Test | `Doc ] 1138 | 1139 | type package = 1140 | { 1141 | oasis_version: OASISVersion.t; 1142 | ocaml_version: OASISVersion.comparator option; 1143 | findlib_version: OASISVersion.comparator option; 1144 | name: package_name; 1145 | version: OASISVersion.t; 1146 | license: OASISLicense.t; 1147 | license_file: unix_filename option; 1148 | copyrights: string list; 1149 | maintainers: string list; 1150 | authors: string list; 1151 | homepage: url option; 1152 | synopsis: string; 1153 | description: string option; 1154 | categories: url list; 1155 | 1156 | conf_type: [`Configure] plugin; 1157 | conf_custom: custom; 1158 | 1159 | build_type: [`Build] plugin; 1160 | build_custom: custom; 1161 | 1162 | install_type: [`Install] plugin; 1163 | install_custom: custom; 1164 | uninstall_custom: custom; 1165 | 1166 | clean_custom: custom; 1167 | distclean_custom: custom; 1168 | 1169 | files_ab: unix_filename list; 1170 | sections: section list; 1171 | plugins: [`Extra] plugin list; 1172 | schema_data: PropList.Data.t; 1173 | plugin_data: plugin_data; 1174 | } 1175 | 1176 | end 1177 | 1178 | module OASISUnixPath = struct 1179 | (* # 21 "src/oasis/OASISUnixPath.ml" *) 1180 | 1181 | type unix_filename = string 1182 | type unix_dirname = string 1183 | 1184 | type host_filename = string 1185 | type host_dirname = string 1186 | 1187 | let current_dir_name = "." 1188 | 1189 | let parent_dir_name = ".." 1190 | 1191 | let is_current_dir fn = 1192 | fn = current_dir_name || fn = "" 1193 | 1194 | let concat f1 f2 = 1195 | if is_current_dir f1 then 1196 | f2 1197 | else 1198 | let f1' = 1199 | try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1 1200 | in 1201 | f1'^"/"^f2 1202 | 1203 | let make = 1204 | function 1205 | | hd :: tl -> 1206 | List.fold_left 1207 | (fun f p -> concat f p) 1208 | hd 1209 | tl 1210 | | [] -> 1211 | invalid_arg "OASISUnixPath.make" 1212 | 1213 | let dirname f = 1214 | try 1215 | String.sub f 0 (String.rindex f '/') 1216 | with Not_found -> 1217 | current_dir_name 1218 | 1219 | let basename f = 1220 | try 1221 | let pos_start = 1222 | (String.rindex f '/') + 1 1223 | in 1224 | String.sub f pos_start ((String.length f) - pos_start) 1225 | with Not_found -> 1226 | f 1227 | 1228 | let chop_extension f = 1229 | try 1230 | let last_dot = 1231 | String.rindex f '.' 1232 | in 1233 | let sub = 1234 | String.sub f 0 last_dot 1235 | in 1236 | try 1237 | let last_slash = 1238 | String.rindex f '/' 1239 | in 1240 | if last_slash < last_dot then 1241 | sub 1242 | else 1243 | f 1244 | with Not_found -> 1245 | sub 1246 | 1247 | with Not_found -> 1248 | f 1249 | 1250 | let capitalize_file f = 1251 | let dir = dirname f in 1252 | let base = basename f in 1253 | concat dir (String.capitalize base) 1254 | 1255 | let uncapitalize_file f = 1256 | let dir = dirname f in 1257 | let base = basename f in 1258 | concat dir (String.uncapitalize base) 1259 | 1260 | end 1261 | 1262 | module OASISHostPath = struct 1263 | (* # 21 "src/oasis/OASISHostPath.ml" *) 1264 | 1265 | 1266 | open Filename 1267 | 1268 | module Unix = OASISUnixPath 1269 | 1270 | let make = 1271 | function 1272 | | [] -> 1273 | invalid_arg "OASISHostPath.make" 1274 | | hd :: tl -> 1275 | List.fold_left Filename.concat hd tl 1276 | 1277 | let of_unix ufn = 1278 | if Sys.os_type = "Unix" then 1279 | ufn 1280 | else 1281 | make 1282 | (List.map 1283 | (fun p -> 1284 | if p = Unix.current_dir_name then 1285 | current_dir_name 1286 | else if p = Unix.parent_dir_name then 1287 | parent_dir_name 1288 | else 1289 | p) 1290 | (OASISString.nsplit ufn '/')) 1291 | 1292 | 1293 | end 1294 | 1295 | module OASISSection = struct 1296 | (* # 21 "src/oasis/OASISSection.ml" *) 1297 | 1298 | open OASISTypes 1299 | 1300 | let section_kind_common = 1301 | function 1302 | | Library (cs, _, _) -> 1303 | `Library, cs 1304 | | Executable (cs, _, _) -> 1305 | `Executable, cs 1306 | | Flag (cs, _) -> 1307 | `Flag, cs 1308 | | SrcRepo (cs, _) -> 1309 | `SrcRepo, cs 1310 | | Test (cs, _) -> 1311 | `Test, cs 1312 | | Doc (cs, _) -> 1313 | `Doc, cs 1314 | 1315 | let section_common sct = 1316 | snd (section_kind_common sct) 1317 | 1318 | let section_common_set cs = 1319 | function 1320 | | Library (_, bs, lib) -> Library (cs, bs, lib) 1321 | | Executable (_, bs, exec) -> Executable (cs, bs, exec) 1322 | | Flag (_, flg) -> Flag (cs, flg) 1323 | | SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo) 1324 | | Test (_, tst) -> Test (cs, tst) 1325 | | Doc (_, doc) -> Doc (cs, doc) 1326 | 1327 | (** Key used to identify section 1328 | *) 1329 | let section_id sct = 1330 | let k, cs = 1331 | section_kind_common sct 1332 | in 1333 | k, cs.cs_name 1334 | 1335 | let string_of_section sct = 1336 | let k, nm = 1337 | section_id sct 1338 | in 1339 | (match k with 1340 | | `Library -> "library" 1341 | | `Executable -> "executable" 1342 | | `Flag -> "flag" 1343 | | `SrcRepo -> "src repository" 1344 | | `Test -> "test" 1345 | | `Doc -> "doc") 1346 | ^" "^nm 1347 | 1348 | let section_find id scts = 1349 | List.find 1350 | (fun sct -> id = section_id sct) 1351 | scts 1352 | 1353 | module CSection = 1354 | struct 1355 | type t = section 1356 | 1357 | let id = section_id 1358 | 1359 | let compare t1 t2 = 1360 | compare (id t1) (id t2) 1361 | 1362 | let equal t1 t2 = 1363 | (id t1) = (id t2) 1364 | 1365 | let hash t = 1366 | Hashtbl.hash (id t) 1367 | end 1368 | 1369 | module MapSection = Map.Make(CSection) 1370 | module SetSection = Set.Make(CSection) 1371 | 1372 | end 1373 | 1374 | module OASISBuildSection = struct 1375 | (* # 21 "src/oasis/OASISBuildSection.ml" *) 1376 | 1377 | end 1378 | 1379 | module OASISExecutable = struct 1380 | (* # 21 "src/oasis/OASISExecutable.ml" *) 1381 | 1382 | open OASISTypes 1383 | 1384 | let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program = 1385 | let dir = 1386 | OASISUnixPath.concat 1387 | bs.bs_path 1388 | (OASISUnixPath.dirname exec.exec_main_is) 1389 | in 1390 | let is_native_exec = 1391 | match bs.bs_compiled_object with 1392 | | Native -> true 1393 | | Best -> is_native () 1394 | | Byte -> false 1395 | in 1396 | 1397 | OASISUnixPath.concat 1398 | dir 1399 | (cs.cs_name^(suffix_program ())), 1400 | 1401 | if not is_native_exec && 1402 | not exec.exec_custom && 1403 | bs.bs_c_sources <> [] then 1404 | Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ())) 1405 | else 1406 | None 1407 | 1408 | end 1409 | 1410 | module OASISLibrary = struct 1411 | (* # 21 "src/oasis/OASISLibrary.ml" *) 1412 | 1413 | open OASISTypes 1414 | open OASISUtils 1415 | open OASISGettext 1416 | open OASISSection 1417 | 1418 | type library_name = name 1419 | type findlib_part_name = name 1420 | type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t 1421 | 1422 | exception InternalLibraryNotFound of library_name 1423 | exception FindlibPackageNotFound of findlib_name 1424 | 1425 | type group_t = 1426 | | Container of findlib_name * group_t list 1427 | | Package of (findlib_name * 1428 | common_section * 1429 | build_section * 1430 | library * 1431 | group_t list) 1432 | 1433 | (* Look for a module file, considering capitalization or not. *) 1434 | let find_module source_file_exists (cs, bs, lib) modul = 1435 | let possible_base_fn = 1436 | List.map 1437 | (OASISUnixPath.concat bs.bs_path) 1438 | [modul; 1439 | OASISUnixPath.uncapitalize_file modul; 1440 | OASISUnixPath.capitalize_file modul] 1441 | in 1442 | (* TODO: we should be able to be able to determine the source for every 1443 | * files. Hence we should introduce a Module(source: fn) for the fields 1444 | * Modules and InternalModules 1445 | *) 1446 | List.fold_left 1447 | (fun acc base_fn -> 1448 | match acc with 1449 | | `No_sources _ -> 1450 | begin 1451 | let file_found = 1452 | List.fold_left 1453 | (fun acc ext -> 1454 | if source_file_exists (base_fn^ext) then 1455 | (base_fn^ext) :: acc 1456 | else 1457 | acc) 1458 | [] 1459 | [".ml"; ".mli"; ".mll"; ".mly"] 1460 | in 1461 | match file_found with 1462 | | [] -> 1463 | acc 1464 | | lst -> 1465 | `Sources (base_fn, lst) 1466 | end 1467 | | `Sources _ -> 1468 | acc) 1469 | (`No_sources possible_base_fn) 1470 | possible_base_fn 1471 | 1472 | let source_unix_files ~ctxt (cs, bs, lib) source_file_exists = 1473 | List.fold_left 1474 | (fun acc modul -> 1475 | match find_module source_file_exists (cs, bs, lib) modul with 1476 | | `Sources (base_fn, lst) -> 1477 | (base_fn, lst) :: acc 1478 | | `No_sources _ -> 1479 | OASISMessage.warning 1480 | ~ctxt 1481 | (f_ "Cannot find source file matching \ 1482 | module '%s' in library %s") 1483 | modul cs.cs_name; 1484 | acc) 1485 | [] 1486 | (lib.lib_modules @ lib.lib_internal_modules) 1487 | 1488 | let generated_unix_files 1489 | ~ctxt 1490 | ~is_native 1491 | ~has_native_dynlink 1492 | ~ext_lib 1493 | ~ext_dll 1494 | ~source_file_exists 1495 | (cs, bs, lib) = 1496 | 1497 | let find_modules lst ext = 1498 | let find_module modul = 1499 | match find_module source_file_exists (cs, bs, lib) modul with 1500 | | `Sources (base_fn, _) -> 1501 | [base_fn] 1502 | | `No_sources lst -> 1503 | OASISMessage.warning 1504 | ~ctxt 1505 | (f_ "Cannot find source file matching \ 1506 | module '%s' in library %s") 1507 | modul cs.cs_name; 1508 | lst 1509 | in 1510 | List.map 1511 | (fun nm -> 1512 | List.map 1513 | (fun base_fn -> base_fn ^"."^ext) 1514 | (find_module nm)) 1515 | lst 1516 | in 1517 | 1518 | (* The headers that should be compiled along *) 1519 | let headers = 1520 | if lib.lib_pack then 1521 | [] 1522 | else 1523 | find_modules 1524 | lib.lib_modules 1525 | "cmi" 1526 | in 1527 | 1528 | (* The .cmx that be compiled along *) 1529 | let cmxs = 1530 | let should_be_built = 1531 | (not lib.lib_pack) && (* Do not install .cmx packed submodules *) 1532 | match bs.bs_compiled_object with 1533 | | Native -> true 1534 | | Best -> is_native 1535 | | Byte -> false 1536 | in 1537 | if should_be_built then 1538 | find_modules 1539 | (lib.lib_modules @ lib.lib_internal_modules) 1540 | "cmx" 1541 | else 1542 | [] 1543 | in 1544 | 1545 | let acc_nopath = 1546 | [] 1547 | in 1548 | 1549 | (* Compute what libraries should be built *) 1550 | let acc_nopath = 1551 | (* Add the packed header file if required *) 1552 | let add_pack_header acc = 1553 | if lib.lib_pack then 1554 | [cs.cs_name^".cmi"] :: acc 1555 | else 1556 | acc 1557 | in 1558 | let byte acc = 1559 | add_pack_header ([cs.cs_name^".cma"] :: acc) 1560 | in 1561 | let native acc = 1562 | let acc = 1563 | add_pack_header 1564 | (if has_native_dynlink then 1565 | [cs.cs_name^".cmxs"] :: acc 1566 | else acc) 1567 | in 1568 | [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc 1569 | in 1570 | match bs.bs_compiled_object with 1571 | | Native -> 1572 | byte (native acc_nopath) 1573 | | Best when is_native -> 1574 | byte (native acc_nopath) 1575 | | Byte | Best -> 1576 | byte acc_nopath 1577 | in 1578 | 1579 | (* Add C library to be built *) 1580 | let acc_nopath = 1581 | if bs.bs_c_sources <> [] then 1582 | begin 1583 | ["lib"^cs.cs_name^"_stubs"^ext_lib] 1584 | :: 1585 | ["dll"^cs.cs_name^"_stubs"^ext_dll] 1586 | :: 1587 | acc_nopath 1588 | end 1589 | else 1590 | acc_nopath 1591 | in 1592 | 1593 | (* All the files generated *) 1594 | List.rev_append 1595 | (List.rev_map 1596 | (List.rev_map 1597 | (OASISUnixPath.concat bs.bs_path)) 1598 | acc_nopath) 1599 | (headers @ cmxs) 1600 | 1601 | type data = common_section * build_section * library 1602 | type tree = 1603 | | Node of (data option) * (tree MapString.t) 1604 | | Leaf of data 1605 | 1606 | let findlib_mapping pkg = 1607 | (* Map from library name to either full findlib name or parts + parent. *) 1608 | let fndlb_parts_of_lib_name = 1609 | let fndlb_parts cs lib = 1610 | let name = 1611 | match lib.lib_findlib_name with 1612 | | Some nm -> nm 1613 | | None -> cs.cs_name 1614 | in 1615 | let name = 1616 | String.concat "." (lib.lib_findlib_containers @ [name]) 1617 | in 1618 | name 1619 | in 1620 | List.fold_left 1621 | (fun mp -> 1622 | function 1623 | | Library (cs, _, lib) -> 1624 | begin 1625 | let lib_name = cs.cs_name in 1626 | let fndlb_parts = fndlb_parts cs lib in 1627 | if MapString.mem lib_name mp then 1628 | failwithf 1629 | (f_ "The library name '%s' is used more than once.") 1630 | lib_name; 1631 | match lib.lib_findlib_parent with 1632 | | Some lib_name_parent -> 1633 | MapString.add 1634 | lib_name 1635 | (`Unsolved (lib_name_parent, fndlb_parts)) 1636 | mp 1637 | | None -> 1638 | MapString.add 1639 | lib_name 1640 | (`Solved fndlb_parts) 1641 | mp 1642 | end 1643 | 1644 | | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ -> 1645 | mp) 1646 | MapString.empty 1647 | pkg.sections 1648 | in 1649 | 1650 | (* Solve the above graph to be only library name to full findlib name. *) 1651 | let fndlb_name_of_lib_name = 1652 | let rec solve visited mp lib_name lib_name_child = 1653 | if SetString.mem lib_name visited then 1654 | failwithf 1655 | (f_ "Library '%s' is involved in a cycle \ 1656 | with regard to findlib naming.") 1657 | lib_name; 1658 | let visited = SetString.add lib_name visited in 1659 | try 1660 | match MapString.find lib_name mp with 1661 | | `Solved fndlb_nm -> 1662 | fndlb_nm, mp 1663 | | `Unsolved (lib_nm_parent, post_fndlb_nm) -> 1664 | let pre_fndlb_nm, mp = 1665 | solve visited mp lib_nm_parent lib_name 1666 | in 1667 | let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in 1668 | fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp 1669 | with Not_found -> 1670 | failwithf 1671 | (f_ "Library '%s', which is defined as the findlib parent of \ 1672 | library '%s', doesn't exist.") 1673 | lib_name lib_name_child 1674 | in 1675 | let mp = 1676 | MapString.fold 1677 | (fun lib_name status mp -> 1678 | match status with 1679 | | `Solved _ -> 1680 | (* Solved initialy, no need to go further *) 1681 | mp 1682 | | `Unsolved _ -> 1683 | let _, mp = solve SetString.empty mp lib_name "" in 1684 | mp) 1685 | fndlb_parts_of_lib_name 1686 | fndlb_parts_of_lib_name 1687 | in 1688 | MapString.map 1689 | (function 1690 | | `Solved fndlb_nm -> fndlb_nm 1691 | | `Unsolved _ -> assert false) 1692 | mp 1693 | in 1694 | 1695 | (* Convert an internal library name to a findlib name. *) 1696 | let findlib_name_of_library_name lib_nm = 1697 | try 1698 | MapString.find lib_nm fndlb_name_of_lib_name 1699 | with Not_found -> 1700 | raise (InternalLibraryNotFound lib_nm) 1701 | in 1702 | 1703 | (* Add a library to the tree. 1704 | *) 1705 | let add sct mp = 1706 | let fndlb_fullname = 1707 | let cs, _, _ = sct in 1708 | let lib_name = cs.cs_name in 1709 | findlib_name_of_library_name lib_name 1710 | in 1711 | let rec add_children nm_lst (children : tree MapString.t) = 1712 | match nm_lst with 1713 | | (hd :: tl) -> 1714 | begin 1715 | let node = 1716 | try 1717 | add_node tl (MapString.find hd children) 1718 | with Not_found -> 1719 | (* New node *) 1720 | new_node tl 1721 | in 1722 | MapString.add hd node children 1723 | end 1724 | | [] -> 1725 | (* Should not have a nameless library. *) 1726 | assert false 1727 | and add_node tl node = 1728 | if tl = [] then 1729 | begin 1730 | match node with 1731 | | Node (None, children) -> 1732 | Node (Some sct, children) 1733 | | Leaf (cs', _, _) | Node (Some (cs', _, _), _) -> 1734 | (* TODO: allow to merge Package, i.e. 1735 | * archive(byte) = "foo.cma foo_init.cmo" 1736 | *) 1737 | let cs, _, _ = sct in 1738 | failwithf 1739 | (f_ "Library '%s' and '%s' have the same findlib name '%s'") 1740 | cs.cs_name cs'.cs_name fndlb_fullname 1741 | end 1742 | else 1743 | begin 1744 | match node with 1745 | | Leaf data -> 1746 | Node (Some data, add_children tl MapString.empty) 1747 | | Node (data_opt, children) -> 1748 | Node (data_opt, add_children tl children) 1749 | end 1750 | and new_node = 1751 | function 1752 | | [] -> 1753 | Leaf sct 1754 | | hd :: tl -> 1755 | Node (None, MapString.add hd (new_node tl) MapString.empty) 1756 | in 1757 | add_children (OASISString.nsplit fndlb_fullname '.') mp 1758 | in 1759 | 1760 | let rec group_of_tree mp = 1761 | MapString.fold 1762 | (fun nm node acc -> 1763 | let cur = 1764 | match node with 1765 | | Node (Some (cs, bs, lib), children) -> 1766 | Package (nm, cs, bs, lib, group_of_tree children) 1767 | | Node (None, children) -> 1768 | Container (nm, group_of_tree children) 1769 | | Leaf (cs, bs, lib) -> 1770 | Package (nm, cs, bs, lib, []) 1771 | in 1772 | cur :: acc) 1773 | mp [] 1774 | in 1775 | 1776 | let group_mp = 1777 | List.fold_left 1778 | (fun mp -> 1779 | function 1780 | | Library (cs, bs, lib) -> 1781 | add (cs, bs, lib) mp 1782 | | _ -> 1783 | mp) 1784 | MapString.empty 1785 | pkg.sections 1786 | in 1787 | 1788 | let groups = 1789 | group_of_tree group_mp 1790 | in 1791 | 1792 | let library_name_of_findlib_name = 1793 | Lazy.lazy_from_fun 1794 | (fun () -> 1795 | (* Revert findlib_name_of_library_name. *) 1796 | MapString.fold 1797 | (fun k v mp -> MapString.add v k mp) 1798 | fndlb_name_of_lib_name 1799 | MapString.empty) 1800 | in 1801 | let library_name_of_findlib_name fndlb_nm = 1802 | try 1803 | MapString.find fndlb_nm (Lazy.force library_name_of_findlib_name) 1804 | with Not_found -> 1805 | raise (FindlibPackageNotFound fndlb_nm) 1806 | in 1807 | 1808 | groups, 1809 | findlib_name_of_library_name, 1810 | library_name_of_findlib_name 1811 | 1812 | let findlib_of_group = 1813 | function 1814 | | Container (fndlb_nm, _) 1815 | | Package (fndlb_nm, _, _, _, _) -> fndlb_nm 1816 | 1817 | let root_of_group grp = 1818 | let rec root_lib_aux = 1819 | (* We do a DFS in the group. *) 1820 | function 1821 | | Container (_, children) -> 1822 | List.fold_left 1823 | (fun res grp -> 1824 | if res = None then 1825 | root_lib_aux grp 1826 | else 1827 | res) 1828 | None 1829 | children 1830 | | Package (_, cs, bs, lib, _) -> 1831 | Some (cs, bs, lib) 1832 | in 1833 | match root_lib_aux grp with 1834 | | Some res -> 1835 | res 1836 | | None -> 1837 | failwithf 1838 | (f_ "Unable to determine root library of findlib library '%s'") 1839 | (findlib_of_group grp) 1840 | 1841 | end 1842 | 1843 | module OASISFlag = struct 1844 | (* # 21 "src/oasis/OASISFlag.ml" *) 1845 | 1846 | end 1847 | 1848 | module OASISPackage = struct 1849 | (* # 21 "src/oasis/OASISPackage.ml" *) 1850 | 1851 | end 1852 | 1853 | module OASISSourceRepository = struct 1854 | (* # 21 "src/oasis/OASISSourceRepository.ml" *) 1855 | 1856 | end 1857 | 1858 | module OASISTest = struct 1859 | (* # 21 "src/oasis/OASISTest.ml" *) 1860 | 1861 | end 1862 | 1863 | module OASISDocument = struct 1864 | (* # 21 "src/oasis/OASISDocument.ml" *) 1865 | 1866 | end 1867 | 1868 | module OASISExec = struct 1869 | (* # 21 "src/oasis/OASISExec.ml" *) 1870 | 1871 | open OASISGettext 1872 | open OASISUtils 1873 | open OASISMessage 1874 | 1875 | (* TODO: I don't like this quote, it is there because $(rm) foo expands to 1876 | * 'rm -f' foo... 1877 | *) 1878 | let run ~ctxt ?f_exit_code ?(quote=true) cmd args = 1879 | let cmd = 1880 | if quote then 1881 | if Sys.os_type = "Win32" then 1882 | if String.contains cmd ' ' then 1883 | (* Double the 1st double quote... win32... sigh *) 1884 | "\""^(Filename.quote cmd) 1885 | else 1886 | cmd 1887 | else 1888 | Filename.quote cmd 1889 | else 1890 | cmd 1891 | in 1892 | let cmdline = 1893 | String.concat " " (cmd :: args) 1894 | in 1895 | info ~ctxt (f_ "Running command '%s'") cmdline; 1896 | match f_exit_code, Sys.command cmdline with 1897 | | None, 0 -> () 1898 | | None, i -> 1899 | failwithf 1900 | (f_ "Command '%s' terminated with error code %d") 1901 | cmdline i 1902 | | Some f, i -> 1903 | f i 1904 | 1905 | let run_read_output ~ctxt ?f_exit_code cmd args = 1906 | let fn = 1907 | Filename.temp_file "oasis-" ".txt" 1908 | in 1909 | try 1910 | begin 1911 | let () = 1912 | run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn]) 1913 | in 1914 | let chn = 1915 | open_in fn 1916 | in 1917 | let routput = 1918 | ref [] 1919 | in 1920 | begin 1921 | try 1922 | while true do 1923 | routput := (input_line chn) :: !routput 1924 | done 1925 | with End_of_file -> 1926 | () 1927 | end; 1928 | close_in chn; 1929 | Sys.remove fn; 1930 | List.rev !routput 1931 | end 1932 | with e -> 1933 | (try Sys.remove fn with _ -> ()); 1934 | raise e 1935 | 1936 | let run_read_one_line ~ctxt ?f_exit_code cmd args = 1937 | match run_read_output ~ctxt ?f_exit_code cmd args with 1938 | | [fst] -> 1939 | fst 1940 | | lst -> 1941 | failwithf 1942 | (f_ "Command return unexpected output %S") 1943 | (String.concat "\n" lst) 1944 | end 1945 | 1946 | module OASISFileUtil = struct 1947 | (* # 21 "src/oasis/OASISFileUtil.ml" *) 1948 | 1949 | open OASISGettext 1950 | 1951 | let file_exists_case fn = 1952 | let dirname = Filename.dirname fn in 1953 | let basename = Filename.basename fn in 1954 | if Sys.file_exists dirname then 1955 | if basename = Filename.current_dir_name then 1956 | true 1957 | else 1958 | List.mem 1959 | basename 1960 | (Array.to_list (Sys.readdir dirname)) 1961 | else 1962 | false 1963 | 1964 | let find_file ?(case_sensitive=true) paths exts = 1965 | 1966 | (* Cardinal product of two list *) 1967 | let ( * ) lst1 lst2 = 1968 | List.flatten 1969 | (List.map 1970 | (fun a -> 1971 | List.map 1972 | (fun b -> a,b) 1973 | lst2) 1974 | lst1) 1975 | in 1976 | 1977 | let rec combined_paths lst = 1978 | match lst with 1979 | | p1 :: p2 :: tl -> 1980 | let acc = 1981 | (List.map 1982 | (fun (a,b) -> Filename.concat a b) 1983 | (p1 * p2)) 1984 | in 1985 | combined_paths (acc :: tl) 1986 | | [e] -> 1987 | e 1988 | | [] -> 1989 | [] 1990 | in 1991 | 1992 | let alternatives = 1993 | List.map 1994 | (fun (p,e) -> 1995 | if String.length e > 0 && e.[0] <> '.' then 1996 | p ^ "." ^ e 1997 | else 1998 | p ^ e) 1999 | ((combined_paths paths) * exts) 2000 | in 2001 | List.find 2002 | (if case_sensitive then 2003 | file_exists_case 2004 | else 2005 | Sys.file_exists) 2006 | alternatives 2007 | 2008 | let which ~ctxt prg = 2009 | let path_sep = 2010 | match Sys.os_type with 2011 | | "Win32" -> 2012 | ';' 2013 | | _ -> 2014 | ':' 2015 | in 2016 | let path_lst = OASISString.nsplit (Sys.getenv "PATH") path_sep in 2017 | let exec_ext = 2018 | match Sys.os_type with 2019 | | "Win32" -> 2020 | "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep) 2021 | | _ -> 2022 | [""] 2023 | in 2024 | find_file ~case_sensitive:false [path_lst; [prg]] exec_ext 2025 | 2026 | (**/**) 2027 | let rec fix_dir dn = 2028 | (* Windows hack because Sys.file_exists "src\\" = false when 2029 | * Sys.file_exists "src" = true 2030 | *) 2031 | let ln = 2032 | String.length dn 2033 | in 2034 | if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then 2035 | fix_dir (String.sub dn 0 (ln - 1)) 2036 | else 2037 | dn 2038 | 2039 | let q = Filename.quote 2040 | (**/**) 2041 | 2042 | let cp ~ctxt ?(recurse=false) src tgt = 2043 | if recurse then 2044 | match Sys.os_type with 2045 | | "Win32" -> 2046 | OASISExec.run ~ctxt 2047 | "xcopy" [q src; q tgt; "/E"] 2048 | | _ -> 2049 | OASISExec.run ~ctxt 2050 | "cp" ["-r"; q src; q tgt] 2051 | else 2052 | OASISExec.run ~ctxt 2053 | (match Sys.os_type with 2054 | | "Win32" -> "copy" 2055 | | _ -> "cp") 2056 | [q src; q tgt] 2057 | 2058 | let mkdir ~ctxt tgt = 2059 | OASISExec.run ~ctxt 2060 | (match Sys.os_type with 2061 | | "Win32" -> "md" 2062 | | _ -> "mkdir") 2063 | [q tgt] 2064 | 2065 | let rec mkdir_parent ~ctxt f tgt = 2066 | let tgt = 2067 | fix_dir tgt 2068 | in 2069 | if Sys.file_exists tgt then 2070 | begin 2071 | if not (Sys.is_directory tgt) then 2072 | OASISUtils.failwithf 2073 | (f_ "Cannot create directory '%s', a file of the same name already \ 2074 | exists") 2075 | tgt 2076 | end 2077 | else 2078 | begin 2079 | mkdir_parent ~ctxt f (Filename.dirname tgt); 2080 | if not (Sys.file_exists tgt) then 2081 | begin 2082 | f tgt; 2083 | mkdir ~ctxt tgt 2084 | end 2085 | end 2086 | 2087 | let rmdir ~ctxt tgt = 2088 | if Sys.readdir tgt = [||] then 2089 | begin 2090 | match Sys.os_type with 2091 | | "Win32" -> 2092 | OASISExec.run ~ctxt "rd" [q tgt] 2093 | | _ -> 2094 | OASISExec.run ~ctxt "rm" ["-r"; q tgt] 2095 | end 2096 | 2097 | let glob ~ctxt fn = 2098 | let basename = 2099 | Filename.basename fn 2100 | in 2101 | if String.length basename >= 2 && 2102 | basename.[0] = '*' && 2103 | basename.[1] = '.' then 2104 | begin 2105 | let ext_len = 2106 | (String.length basename) - 2 2107 | in 2108 | let ext = 2109 | String.sub basename 2 ext_len 2110 | in 2111 | let dirname = 2112 | Filename.dirname fn 2113 | in 2114 | Array.fold_left 2115 | (fun acc fn -> 2116 | try 2117 | let fn_ext = 2118 | String.sub 2119 | fn 2120 | ((String.length fn) - ext_len) 2121 | ext_len 2122 | in 2123 | if fn_ext = ext then 2124 | (Filename.concat dirname fn) :: acc 2125 | else 2126 | acc 2127 | with Invalid_argument _ -> 2128 | acc) 2129 | [] 2130 | (Sys.readdir dirname) 2131 | end 2132 | else 2133 | begin 2134 | if file_exists_case fn then 2135 | [fn] 2136 | else 2137 | [] 2138 | end 2139 | end 2140 | 2141 | 2142 | # 2142 "setup.ml" 2143 | module BaseEnvLight = struct 2144 | (* # 21 "src/base/BaseEnvLight.ml" *) 2145 | 2146 | module MapString = Map.Make(String) 2147 | 2148 | type t = string MapString.t 2149 | 2150 | let default_filename = 2151 | Filename.concat 2152 | (Sys.getcwd ()) 2153 | "setup.data" 2154 | 2155 | let load ?(allow_empty=false) ?(filename=default_filename) () = 2156 | if Sys.file_exists filename then 2157 | begin 2158 | let chn = 2159 | open_in_bin filename 2160 | in 2161 | let st = 2162 | Stream.of_channel chn 2163 | in 2164 | let line = 2165 | ref 1 2166 | in 2167 | let st_line = 2168 | Stream.from 2169 | (fun _ -> 2170 | try 2171 | match Stream.next st with 2172 | | '\n' -> incr line; Some '\n' 2173 | | c -> Some c 2174 | with Stream.Failure -> None) 2175 | in 2176 | let lexer = 2177 | Genlex.make_lexer ["="] st_line 2178 | in 2179 | let rec read_file mp = 2180 | match Stream.npeek 3 lexer with 2181 | | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> 2182 | Stream.junk lexer; 2183 | Stream.junk lexer; 2184 | Stream.junk lexer; 2185 | read_file (MapString.add nm value mp) 2186 | | [] -> 2187 | mp 2188 | | _ -> 2189 | failwith 2190 | (Printf.sprintf 2191 | "Malformed data file '%s' line %d" 2192 | filename !line) 2193 | in 2194 | let mp = 2195 | read_file MapString.empty 2196 | in 2197 | close_in chn; 2198 | mp 2199 | end 2200 | else if allow_empty then 2201 | begin 2202 | MapString.empty 2203 | end 2204 | else 2205 | begin 2206 | failwith 2207 | (Printf.sprintf 2208 | "Unable to load environment, the file '%s' doesn't exist." 2209 | filename) 2210 | end 2211 | 2212 | let var_get name env = 2213 | let rec var_expand str = 2214 | let buff = 2215 | Buffer.create ((String.length str) * 2) 2216 | in 2217 | Buffer.add_substitute 2218 | buff 2219 | (fun var -> 2220 | try 2221 | var_expand (MapString.find var env) 2222 | with Not_found -> 2223 | failwith 2224 | (Printf.sprintf 2225 | "No variable %s defined when trying to expand %S." 2226 | var 2227 | str)) 2228 | str; 2229 | Buffer.contents buff 2230 | in 2231 | var_expand (MapString.find name env) 2232 | 2233 | let var_choose lst env = 2234 | OASISExpr.choose 2235 | (fun nm -> var_get nm env) 2236 | lst 2237 | end 2238 | 2239 | 2240 | # 2240 "setup.ml" 2241 | module BaseContext = struct 2242 | (* # 21 "src/base/BaseContext.ml" *) 2243 | 2244 | open OASISContext 2245 | 2246 | let args = args 2247 | 2248 | let default = default 2249 | 2250 | end 2251 | 2252 | module BaseMessage = struct 2253 | (* # 21 "src/base/BaseMessage.ml" *) 2254 | 2255 | (** Message to user, overrid for Base 2256 | @author Sylvain Le Gall 2257 | *) 2258 | open OASISMessage 2259 | open BaseContext 2260 | 2261 | let debug fmt = debug ~ctxt:!default fmt 2262 | 2263 | let info fmt = info ~ctxt:!default fmt 2264 | 2265 | let warning fmt = warning ~ctxt:!default fmt 2266 | 2267 | let error fmt = error ~ctxt:!default fmt 2268 | 2269 | end 2270 | 2271 | module BaseEnv = struct 2272 | (* # 21 "src/base/BaseEnv.ml" *) 2273 | 2274 | open OASISGettext 2275 | open OASISUtils 2276 | open PropList 2277 | 2278 | module MapString = BaseEnvLight.MapString 2279 | 2280 | type origin_t = 2281 | | ODefault 2282 | | OGetEnv 2283 | | OFileLoad 2284 | | OCommandLine 2285 | 2286 | type cli_handle_t = 2287 | | CLINone 2288 | | CLIAuto 2289 | | CLIWith 2290 | | CLIEnable 2291 | | CLIUser of (Arg.key * Arg.spec * Arg.doc) list 2292 | 2293 | type definition_t = 2294 | { 2295 | hide: bool; 2296 | dump: bool; 2297 | cli: cli_handle_t; 2298 | arg_help: string option; 2299 | group: string option; 2300 | } 2301 | 2302 | let schema = 2303 | Schema.create "environment" 2304 | 2305 | (* Environment data *) 2306 | let env = 2307 | Data.create () 2308 | 2309 | (* Environment data from file *) 2310 | let env_from_file = 2311 | ref MapString.empty 2312 | 2313 | (* Lexer for var *) 2314 | let var_lxr = 2315 | Genlex.make_lexer [] 2316 | 2317 | let rec var_expand str = 2318 | let buff = 2319 | Buffer.create ((String.length str) * 2) 2320 | in 2321 | Buffer.add_substitute 2322 | buff 2323 | (fun var -> 2324 | try 2325 | (* TODO: this is a quick hack to allow calling Test.Command 2326 | * without defining executable name really. I.e. if there is 2327 | * an exec Executable toto, then $(toto) should be replace 2328 | * by its real name. It is however useful to have this function 2329 | * for other variable that depend on the host and should be 2330 | * written better than that. 2331 | *) 2332 | let st = 2333 | var_lxr (Stream.of_string var) 2334 | in 2335 | match Stream.npeek 3 st with 2336 | | [Genlex.Ident "utoh"; Genlex.Ident nm] -> 2337 | OASISHostPath.of_unix (var_get nm) 2338 | | [Genlex.Ident "utoh"; Genlex.String s] -> 2339 | OASISHostPath.of_unix s 2340 | | [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] -> 2341 | String.escaped (var_get nm) 2342 | | [Genlex.Ident "ocaml_escaped"; Genlex.String s] -> 2343 | String.escaped s 2344 | | [Genlex.Ident nm] -> 2345 | var_get nm 2346 | | _ -> 2347 | failwithf 2348 | (f_ "Unknown expression '%s' in variable expansion of %s.") 2349 | var 2350 | str 2351 | with 2352 | | Unknown_field (_, _) -> 2353 | failwithf 2354 | (f_ "No variable %s defined when trying to expand %S.") 2355 | var 2356 | str 2357 | | Stream.Error e -> 2358 | failwithf 2359 | (f_ "Syntax error when parsing '%s' when trying to \ 2360 | expand %S: %s") 2361 | var 2362 | str 2363 | e) 2364 | str; 2365 | Buffer.contents buff 2366 | 2367 | and var_get name = 2368 | let vl = 2369 | try 2370 | Schema.get schema env name 2371 | with Unknown_field _ as e -> 2372 | begin 2373 | try 2374 | MapString.find name !env_from_file 2375 | with Not_found -> 2376 | raise e 2377 | end 2378 | in 2379 | var_expand vl 2380 | 2381 | let var_choose ?printer ?name lst = 2382 | OASISExpr.choose 2383 | ?printer 2384 | ?name 2385 | var_get 2386 | lst 2387 | 2388 | let var_protect vl = 2389 | let buff = 2390 | Buffer.create (String.length vl) 2391 | in 2392 | String.iter 2393 | (function 2394 | | '$' -> Buffer.add_string buff "\\$" 2395 | | c -> Buffer.add_char buff c) 2396 | vl; 2397 | Buffer.contents buff 2398 | 2399 | let var_define 2400 | ?(hide=false) 2401 | ?(dump=true) 2402 | ?short_desc 2403 | ?(cli=CLINone) 2404 | ?arg_help 2405 | ?group 2406 | name (* TODO: type constraint on the fact that name must be a valid OCaml 2407 | id *) 2408 | dflt = 2409 | 2410 | let default = 2411 | [ 2412 | OFileLoad, (fun () -> MapString.find name !env_from_file); 2413 | ODefault, dflt; 2414 | OGetEnv, (fun () -> Sys.getenv name); 2415 | ] 2416 | in 2417 | 2418 | let extra = 2419 | { 2420 | hide = hide; 2421 | dump = dump; 2422 | cli = cli; 2423 | arg_help = arg_help; 2424 | group = group; 2425 | } 2426 | in 2427 | 2428 | (* Try to find a value that can be defined 2429 | *) 2430 | let var_get_low lst = 2431 | let errors, res = 2432 | List.fold_left 2433 | (fun (errors, res) (o, v) -> 2434 | if res = None then 2435 | begin 2436 | try 2437 | errors, Some (v ()) 2438 | with 2439 | | Not_found -> 2440 | errors, res 2441 | | Failure rsn -> 2442 | (rsn :: errors), res 2443 | | e -> 2444 | (Printexc.to_string e) :: errors, res 2445 | end 2446 | else 2447 | errors, res) 2448 | ([], None) 2449 | (List.sort 2450 | (fun (o1, _) (o2, _) -> 2451 | Pervasives.compare o2 o1) 2452 | lst) 2453 | in 2454 | match res, errors with 2455 | | Some v, _ -> 2456 | v 2457 | | None, [] -> 2458 | raise (Not_set (name, None)) 2459 | | None, lst -> 2460 | raise (Not_set (name, Some (String.concat (s_ ", ") lst))) 2461 | in 2462 | 2463 | let help = 2464 | match short_desc with 2465 | | Some fs -> Some fs 2466 | | None -> None 2467 | in 2468 | 2469 | let var_get_lst = 2470 | FieldRO.create 2471 | ~schema 2472 | ~name 2473 | ~parse:(fun ?(context=ODefault) s -> [context, fun () -> s]) 2474 | ~print:var_get_low 2475 | ~default 2476 | ~update:(fun ?context x old_x -> x @ old_x) 2477 | ?help 2478 | extra 2479 | in 2480 | 2481 | fun () -> 2482 | var_expand (var_get_low (var_get_lst env)) 2483 | 2484 | let var_redefine 2485 | ?hide 2486 | ?dump 2487 | ?short_desc 2488 | ?cli 2489 | ?arg_help 2490 | ?group 2491 | name 2492 | dflt = 2493 | if Schema.mem schema name then 2494 | begin 2495 | (* TODO: look suspsicious, we want to memorize dflt not dflt () *) 2496 | Schema.set schema env ~context:ODefault name (dflt ()); 2497 | fun () -> var_get name 2498 | end 2499 | else 2500 | begin 2501 | var_define 2502 | ?hide 2503 | ?dump 2504 | ?short_desc 2505 | ?cli 2506 | ?arg_help 2507 | ?group 2508 | name 2509 | dflt 2510 | end 2511 | 2512 | let var_ignore (e : unit -> string) = 2513 | () 2514 | 2515 | let print_hidden = 2516 | var_define 2517 | ~hide:true 2518 | ~dump:false 2519 | ~cli:CLIAuto 2520 | ~arg_help:"Print even non-printable variable. (debug)" 2521 | "print_hidden" 2522 | (fun () -> "false") 2523 | 2524 | let var_all () = 2525 | List.rev 2526 | (Schema.fold 2527 | (fun acc nm def _ -> 2528 | if not def.hide || bool_of_string (print_hidden ()) then 2529 | nm :: acc 2530 | else 2531 | acc) 2532 | [] 2533 | schema) 2534 | 2535 | let default_filename = 2536 | BaseEnvLight.default_filename 2537 | 2538 | let load ?allow_empty ?filename () = 2539 | env_from_file := BaseEnvLight.load ?allow_empty ?filename () 2540 | 2541 | let unload () = 2542 | env_from_file := MapString.empty; 2543 | Data.clear env 2544 | 2545 | let dump ?(filename=default_filename) () = 2546 | let chn = 2547 | open_out_bin filename 2548 | in 2549 | let output nm value = 2550 | Printf.fprintf chn "%s=%S\n" nm value 2551 | in 2552 | let mp_todo = 2553 | (* Dump data from schema *) 2554 | Schema.fold 2555 | (fun mp_todo nm def _ -> 2556 | if def.dump then 2557 | begin 2558 | try 2559 | let value = 2560 | Schema.get 2561 | schema 2562 | env 2563 | nm 2564 | in 2565 | output nm value 2566 | with Not_set _ -> 2567 | () 2568 | end; 2569 | MapString.remove nm mp_todo) 2570 | !env_from_file 2571 | schema 2572 | in 2573 | (* Dump data defined outside of schema *) 2574 | MapString.iter output mp_todo; 2575 | 2576 | (* End of the dump *) 2577 | close_out chn 2578 | 2579 | let print () = 2580 | let printable_vars = 2581 | Schema.fold 2582 | (fun acc nm def short_descr_opt -> 2583 | if not def.hide || bool_of_string (print_hidden ()) then 2584 | begin 2585 | try 2586 | let value = 2587 | Schema.get 2588 | schema 2589 | env 2590 | nm 2591 | in 2592 | let txt = 2593 | match short_descr_opt with 2594 | | Some s -> s () 2595 | | None -> nm 2596 | in 2597 | (txt, value) :: acc 2598 | with Not_set _ -> 2599 | acc 2600 | end 2601 | else 2602 | acc) 2603 | [] 2604 | schema 2605 | in 2606 | let max_length = 2607 | List.fold_left max 0 2608 | (List.rev_map String.length 2609 | (List.rev_map fst printable_vars)) 2610 | in 2611 | let dot_pad str = 2612 | String.make ((max_length - (String.length str)) + 3) '.' 2613 | in 2614 | 2615 | Printf.printf "\nConfiguration: \n"; 2616 | List.iter 2617 | (fun (name,value) -> 2618 | Printf.printf "%s: %s %s\n" name (dot_pad name) value) 2619 | (List.rev printable_vars); 2620 | Printf.printf "\n%!" 2621 | 2622 | let args () = 2623 | let arg_concat = 2624 | OASISUtils.varname_concat ~hyphen:'-' 2625 | in 2626 | [ 2627 | "--override", 2628 | Arg.Tuple 2629 | ( 2630 | let rvr = ref "" 2631 | in 2632 | let rvl = ref "" 2633 | in 2634 | [ 2635 | Arg.Set_string rvr; 2636 | Arg.Set_string rvl; 2637 | Arg.Unit 2638 | (fun () -> 2639 | Schema.set 2640 | schema 2641 | env 2642 | ~context:OCommandLine 2643 | !rvr 2644 | !rvl) 2645 | ] 2646 | ), 2647 | "var+val Override any configuration variable."; 2648 | 2649 | ] 2650 | @ 2651 | List.flatten 2652 | (Schema.fold 2653 | (fun acc name def short_descr_opt -> 2654 | let var_set s = 2655 | Schema.set 2656 | schema 2657 | env 2658 | ~context:OCommandLine 2659 | name 2660 | s 2661 | in 2662 | 2663 | let arg_name = 2664 | OASISUtils.varname_of_string ~hyphen:'-' name 2665 | in 2666 | 2667 | let hlp = 2668 | match short_descr_opt with 2669 | | Some txt -> txt () 2670 | | None -> "" 2671 | in 2672 | 2673 | let arg_hlp = 2674 | match def.arg_help with 2675 | | Some s -> s 2676 | | None -> "str" 2677 | in 2678 | 2679 | let default_value = 2680 | try 2681 | Printf.sprintf 2682 | (f_ " [%s]") 2683 | (Schema.get 2684 | schema 2685 | env 2686 | name) 2687 | with Not_set _ -> 2688 | "" 2689 | in 2690 | 2691 | let args = 2692 | match def.cli with 2693 | | CLINone -> 2694 | [] 2695 | | CLIAuto -> 2696 | [ 2697 | arg_concat "--" arg_name, 2698 | Arg.String var_set, 2699 | Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value 2700 | ] 2701 | | CLIWith -> 2702 | [ 2703 | arg_concat "--with-" arg_name, 2704 | Arg.String var_set, 2705 | Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value 2706 | ] 2707 | | CLIEnable -> 2708 | let dflt = 2709 | if default_value = " [true]" then 2710 | s_ " [default: enabled]" 2711 | else 2712 | s_ " [default: disabled]" 2713 | in 2714 | [ 2715 | arg_concat "--enable-" arg_name, 2716 | Arg.Unit (fun () -> var_set "true"), 2717 | Printf.sprintf (f_ " %s%s") hlp dflt; 2718 | 2719 | arg_concat "--disable-" arg_name, 2720 | Arg.Unit (fun () -> var_set "false"), 2721 | Printf.sprintf (f_ " %s%s") hlp dflt 2722 | ] 2723 | | CLIUser lst -> 2724 | lst 2725 | in 2726 | args :: acc) 2727 | [] 2728 | schema) 2729 | end 2730 | 2731 | module BaseArgExt = struct 2732 | (* # 21 "src/base/BaseArgExt.ml" *) 2733 | 2734 | open OASISUtils 2735 | open OASISGettext 2736 | 2737 | let parse argv args = 2738 | (* Simulate command line for Arg *) 2739 | let current = 2740 | ref 0 2741 | in 2742 | 2743 | try 2744 | Arg.parse_argv 2745 | ~current:current 2746 | (Array.concat [[|"none"|]; argv]) 2747 | (Arg.align args) 2748 | (failwithf (f_ "Don't know what to do with arguments: '%s'")) 2749 | (s_ "configure options:") 2750 | with 2751 | | Arg.Help txt -> 2752 | print_endline txt; 2753 | exit 0 2754 | | Arg.Bad txt -> 2755 | prerr_endline txt; 2756 | exit 1 2757 | end 2758 | 2759 | module BaseCheck = struct 2760 | (* # 21 "src/base/BaseCheck.ml" *) 2761 | 2762 | open BaseEnv 2763 | open BaseMessage 2764 | open OASISUtils 2765 | open OASISGettext 2766 | 2767 | let prog_best prg prg_lst = 2768 | var_redefine 2769 | prg 2770 | (fun () -> 2771 | let alternate = 2772 | List.fold_left 2773 | (fun res e -> 2774 | match res with 2775 | | Some _ -> 2776 | res 2777 | | None -> 2778 | try 2779 | Some (OASISFileUtil.which ~ctxt:!BaseContext.default e) 2780 | with Not_found -> 2781 | None) 2782 | None 2783 | prg_lst 2784 | in 2785 | match alternate with 2786 | | Some prg -> prg 2787 | | None -> raise Not_found) 2788 | 2789 | let prog prg = 2790 | prog_best prg [prg] 2791 | 2792 | let prog_opt prg = 2793 | prog_best prg [prg^".opt"; prg] 2794 | 2795 | let ocamlfind = 2796 | prog "ocamlfind" 2797 | 2798 | let version 2799 | var_prefix 2800 | cmp 2801 | fversion 2802 | () = 2803 | (* Really compare version provided *) 2804 | let var = 2805 | var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp) 2806 | in 2807 | var_redefine 2808 | ~hide:true 2809 | var 2810 | (fun () -> 2811 | let version_str = 2812 | match fversion () with 2813 | | "[Distributed with OCaml]" -> 2814 | begin 2815 | try 2816 | (var_get "ocaml_version") 2817 | with Not_found -> 2818 | warning 2819 | (f_ "Variable ocaml_version not defined, fallback \ 2820 | to default"); 2821 | Sys.ocaml_version 2822 | end 2823 | | res -> 2824 | res 2825 | in 2826 | let version = 2827 | OASISVersion.version_of_string version_str 2828 | in 2829 | if OASISVersion.comparator_apply version cmp then 2830 | version_str 2831 | else 2832 | failwithf 2833 | (f_ "Cannot satisfy version constraint on %s: %s (version: %s)") 2834 | var_prefix 2835 | (OASISVersion.string_of_comparator cmp) 2836 | version_str) 2837 | () 2838 | 2839 | let package_version pkg = 2840 | OASISExec.run_read_one_line ~ctxt:!BaseContext.default 2841 | (ocamlfind ()) 2842 | ["query"; "-format"; "%v"; pkg] 2843 | 2844 | let package ?version_comparator pkg () = 2845 | let var = 2846 | OASISUtils.varname_concat 2847 | "pkg_" 2848 | (OASISUtils.varname_of_string pkg) 2849 | in 2850 | let findlib_dir pkg = 2851 | let dir = 2852 | OASISExec.run_read_one_line ~ctxt:!BaseContext.default 2853 | (ocamlfind ()) 2854 | ["query"; "-format"; "%d"; pkg] 2855 | in 2856 | if Sys.file_exists dir && Sys.is_directory dir then 2857 | dir 2858 | else 2859 | failwithf 2860 | (f_ "When looking for findlib package %s, \ 2861 | directory %s return doesn't exist") 2862 | pkg dir 2863 | in 2864 | let vl = 2865 | var_redefine 2866 | var 2867 | (fun () -> findlib_dir pkg) 2868 | () 2869 | in 2870 | ( 2871 | match version_comparator with 2872 | | Some ver_cmp -> 2873 | ignore 2874 | (version 2875 | var 2876 | ver_cmp 2877 | (fun _ -> package_version pkg) 2878 | ()) 2879 | | None -> 2880 | () 2881 | ); 2882 | vl 2883 | end 2884 | 2885 | module BaseOCamlcConfig = struct 2886 | (* # 21 "src/base/BaseOCamlcConfig.ml" *) 2887 | 2888 | 2889 | open BaseEnv 2890 | open OASISUtils 2891 | open OASISGettext 2892 | 2893 | module SMap = Map.Make(String) 2894 | 2895 | let ocamlc = 2896 | BaseCheck.prog_opt "ocamlc" 2897 | 2898 | let ocamlc_config_map = 2899 | (* Map name to value for ocamlc -config output 2900 | (name ^": "^value) 2901 | *) 2902 | let rec split_field mp lst = 2903 | match lst with 2904 | | line :: tl -> 2905 | let mp = 2906 | try 2907 | let pos_semicolon = 2908 | String.index line ':' 2909 | in 2910 | if pos_semicolon > 1 then 2911 | ( 2912 | let name = 2913 | String.sub line 0 pos_semicolon 2914 | in 2915 | let linelen = 2916 | String.length line 2917 | in 2918 | let value = 2919 | if linelen > pos_semicolon + 2 then 2920 | String.sub 2921 | line 2922 | (pos_semicolon + 2) 2923 | (linelen - pos_semicolon - 2) 2924 | else 2925 | "" 2926 | in 2927 | SMap.add name value mp 2928 | ) 2929 | else 2930 | ( 2931 | mp 2932 | ) 2933 | with Not_found -> 2934 | ( 2935 | mp 2936 | ) 2937 | in 2938 | split_field mp tl 2939 | | [] -> 2940 | mp 2941 | in 2942 | 2943 | let cache = 2944 | lazy 2945 | (var_protect 2946 | (Marshal.to_string 2947 | (split_field 2948 | SMap.empty 2949 | (OASISExec.run_read_output 2950 | ~ctxt:!BaseContext.default 2951 | (ocamlc ()) ["-config"])) 2952 | [])) 2953 | in 2954 | var_redefine 2955 | "ocamlc_config_map" 2956 | ~hide:true 2957 | ~dump:false 2958 | (fun () -> 2959 | (* TODO: update if ocamlc change !!! *) 2960 | Lazy.force cache) 2961 | 2962 | let var_define nm = 2963 | (* Extract data from ocamlc -config *) 2964 | let avlbl_config_get () = 2965 | Marshal.from_string 2966 | (ocamlc_config_map ()) 2967 | 0 2968 | in 2969 | let chop_version_suffix s = 2970 | try 2971 | String.sub s 0 (String.index s '+') 2972 | with _ -> 2973 | s 2974 | in 2975 | 2976 | let nm_config, value_config = 2977 | match nm with 2978 | | "ocaml_version" -> 2979 | "version", chop_version_suffix 2980 | | _ -> nm, (fun x -> x) 2981 | in 2982 | var_redefine 2983 | nm 2984 | (fun () -> 2985 | try 2986 | let map = 2987 | avlbl_config_get () 2988 | in 2989 | let value = 2990 | SMap.find nm_config map 2991 | in 2992 | value_config value 2993 | with Not_found -> 2994 | failwithf 2995 | (f_ "Cannot find field '%s' in '%s -config' output") 2996 | nm 2997 | (ocamlc ())) 2998 | 2999 | end 3000 | 3001 | module BaseStandardVar = struct 3002 | (* # 21 "src/base/BaseStandardVar.ml" *) 3003 | 3004 | 3005 | open OASISGettext 3006 | open OASISTypes 3007 | open OASISExpr 3008 | open BaseCheck 3009 | open BaseEnv 3010 | 3011 | let ocamlfind = BaseCheck.ocamlfind 3012 | let ocamlc = BaseOCamlcConfig.ocamlc 3013 | let ocamlopt = prog_opt "ocamlopt" 3014 | let ocamlbuild = prog "ocamlbuild" 3015 | 3016 | 3017 | (**/**) 3018 | let rpkg = 3019 | ref None 3020 | 3021 | let pkg_get () = 3022 | match !rpkg with 3023 | | Some pkg -> pkg 3024 | | None -> failwith (s_ "OASIS Package is not set") 3025 | 3026 | let var_cond = ref [] 3027 | 3028 | let var_define_cond ~since_version f dflt = 3029 | let holder = ref (fun () -> dflt) in 3030 | let since_version = 3031 | OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version) 3032 | in 3033 | var_cond := 3034 | (fun ver -> 3035 | if OASISVersion.comparator_apply ver since_version then 3036 | holder := f ()) :: !var_cond; 3037 | fun () -> !holder () 3038 | 3039 | (**/**) 3040 | 3041 | let pkg_name = 3042 | var_define 3043 | ~short_desc:(fun () -> s_ "Package name") 3044 | "pkg_name" 3045 | (fun () -> (pkg_get ()).name) 3046 | 3047 | let pkg_version = 3048 | var_define 3049 | ~short_desc:(fun () -> s_ "Package version") 3050 | "pkg_version" 3051 | (fun () -> 3052 | (OASISVersion.string_of_version (pkg_get ()).version)) 3053 | 3054 | let c = BaseOCamlcConfig.var_define 3055 | 3056 | let os_type = c "os_type" 3057 | let system = c "system" 3058 | let architecture = c "architecture" 3059 | let ccomp_type = c "ccomp_type" 3060 | let ocaml_version = c "ocaml_version" 3061 | 3062 | (* TODO: Check standard variable presence at runtime *) 3063 | 3064 | let standard_library_default = c "standard_library_default" 3065 | let standard_library = c "standard_library" 3066 | let standard_runtime = c "standard_runtime" 3067 | let bytecomp_c_compiler = c "bytecomp_c_compiler" 3068 | let native_c_compiler = c "native_c_compiler" 3069 | let model = c "model" 3070 | let ext_obj = c "ext_obj" 3071 | let ext_asm = c "ext_asm" 3072 | let ext_lib = c "ext_lib" 3073 | let ext_dll = c "ext_dll" 3074 | let default_executable_name = c "default_executable_name" 3075 | let systhread_supported = c "systhread_supported" 3076 | 3077 | let flexlink = 3078 | BaseCheck.prog "flexlink" 3079 | 3080 | let flexdll_version = 3081 | var_define 3082 | ~short_desc:(fun () -> "FlexDLL version (Win32)") 3083 | "flexdll_version" 3084 | (fun () -> 3085 | let lst = 3086 | OASISExec.run_read_output ~ctxt:!BaseContext.default 3087 | (flexlink ()) ["-help"] 3088 | in 3089 | match lst with 3090 | | line :: _ -> 3091 | Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver) 3092 | | [] -> 3093 | raise Not_found) 3094 | 3095 | (**/**) 3096 | let p name hlp dflt = 3097 | var_define 3098 | ~short_desc:hlp 3099 | ~cli:CLIAuto 3100 | ~arg_help:"dir" 3101 | name 3102 | dflt 3103 | 3104 | let (/) a b = 3105 | if os_type () = Sys.os_type then 3106 | Filename.concat a b 3107 | else if os_type () = "Unix" then 3108 | OASISUnixPath.concat a b 3109 | else 3110 | OASISUtils.failwithf (f_ "Cannot handle os_type %s filename concat") 3111 | (os_type ()) 3112 | (**/**) 3113 | 3114 | let prefix = 3115 | p "prefix" 3116 | (fun () -> s_ "Install architecture-independent files dir") 3117 | (fun () -> 3118 | match os_type () with 3119 | | "Win32" -> 3120 | let program_files = 3121 | Sys.getenv "PROGRAMFILES" 3122 | in 3123 | program_files/(pkg_name ()) 3124 | | _ -> 3125 | "/usr/local") 3126 | 3127 | let exec_prefix = 3128 | p "exec_prefix" 3129 | (fun () -> s_ "Install architecture-dependent files in dir") 3130 | (fun () -> "$prefix") 3131 | 3132 | let bindir = 3133 | p "bindir" 3134 | (fun () -> s_ "User executables") 3135 | (fun () -> "$exec_prefix"/"bin") 3136 | 3137 | let sbindir = 3138 | p "sbindir" 3139 | (fun () -> s_ "System admin executables") 3140 | (fun () -> "$exec_prefix"/"sbin") 3141 | 3142 | let libexecdir = 3143 | p "libexecdir" 3144 | (fun () -> s_ "Program executables") 3145 | (fun () -> "$exec_prefix"/"libexec") 3146 | 3147 | let sysconfdir = 3148 | p "sysconfdir" 3149 | (fun () -> s_ "Read-only single-machine data") 3150 | (fun () -> "$prefix"/"etc") 3151 | 3152 | let sharedstatedir = 3153 | p "sharedstatedir" 3154 | (fun () -> s_ "Modifiable architecture-independent data") 3155 | (fun () -> "$prefix"/"com") 3156 | 3157 | let localstatedir = 3158 | p "localstatedir" 3159 | (fun () -> s_ "Modifiable single-machine data") 3160 | (fun () -> "$prefix"/"var") 3161 | 3162 | let libdir = 3163 | p "libdir" 3164 | (fun () -> s_ "Object code libraries") 3165 | (fun () -> "$exec_prefix"/"lib") 3166 | 3167 | let datarootdir = 3168 | p "datarootdir" 3169 | (fun () -> s_ "Read-only arch-independent data root") 3170 | (fun () -> "$prefix"/"share") 3171 | 3172 | let datadir = 3173 | p "datadir" 3174 | (fun () -> s_ "Read-only architecture-independent data") 3175 | (fun () -> "$datarootdir") 3176 | 3177 | let infodir = 3178 | p "infodir" 3179 | (fun () -> s_ "Info documentation") 3180 | (fun () -> "$datarootdir"/"info") 3181 | 3182 | let localedir = 3183 | p "localedir" 3184 | (fun () -> s_ "Locale-dependent data") 3185 | (fun () -> "$datarootdir"/"locale") 3186 | 3187 | let mandir = 3188 | p "mandir" 3189 | (fun () -> s_ "Man documentation") 3190 | (fun () -> "$datarootdir"/"man") 3191 | 3192 | let docdir = 3193 | p "docdir" 3194 | (fun () -> s_ "Documentation root") 3195 | (fun () -> "$datarootdir"/"doc"/"$pkg_name") 3196 | 3197 | let htmldir = 3198 | p "htmldir" 3199 | (fun () -> s_ "HTML documentation") 3200 | (fun () -> "$docdir") 3201 | 3202 | let dvidir = 3203 | p "dvidir" 3204 | (fun () -> s_ "DVI documentation") 3205 | (fun () -> "$docdir") 3206 | 3207 | let pdfdir = 3208 | p "pdfdir" 3209 | (fun () -> s_ "PDF documentation") 3210 | (fun () -> "$docdir") 3211 | 3212 | let psdir = 3213 | p "psdir" 3214 | (fun () -> s_ "PS documentation") 3215 | (fun () -> "$docdir") 3216 | 3217 | let destdir = 3218 | p "destdir" 3219 | (fun () -> s_ "Prepend a path when installing package") 3220 | (fun () -> 3221 | raise 3222 | (PropList.Not_set 3223 | ("destdir", 3224 | Some (s_ "undefined by construct")))) 3225 | 3226 | let findlib_version = 3227 | var_define 3228 | "findlib_version" 3229 | (fun () -> 3230 | BaseCheck.package_version "findlib") 3231 | 3232 | let is_native = 3233 | var_define 3234 | "is_native" 3235 | (fun () -> 3236 | try 3237 | let _s : string = 3238 | ocamlopt () 3239 | in 3240 | "true" 3241 | with PropList.Not_set _ -> 3242 | let _s : string = 3243 | ocamlc () 3244 | in 3245 | "false") 3246 | 3247 | let ext_program = 3248 | var_define 3249 | "suffix_program" 3250 | (fun () -> 3251 | match os_type () with 3252 | | "Win32" -> ".exe" 3253 | | _ -> "") 3254 | 3255 | let rm = 3256 | var_define 3257 | ~short_desc:(fun () -> s_ "Remove a file.") 3258 | "rm" 3259 | (fun () -> 3260 | match os_type () with 3261 | | "Win32" -> "del" 3262 | | _ -> "rm -f") 3263 | 3264 | let rmdir = 3265 | var_define 3266 | ~short_desc:(fun () -> s_ "Remove a directory.") 3267 | "rmdir" 3268 | (fun () -> 3269 | match os_type () with 3270 | | "Win32" -> "rd" 3271 | | _ -> "rm -rf") 3272 | 3273 | let debug = 3274 | var_define 3275 | ~short_desc:(fun () -> s_ "Turn ocaml debug flag on") 3276 | ~cli:CLIEnable 3277 | "debug" 3278 | (fun () -> "true") 3279 | 3280 | let profile = 3281 | var_define 3282 | ~short_desc:(fun () -> s_ "Turn ocaml profile flag on") 3283 | ~cli:CLIEnable 3284 | "profile" 3285 | (fun () -> "false") 3286 | 3287 | let tests = 3288 | var_define_cond ~since_version:"0.3" 3289 | (fun () -> 3290 | var_define 3291 | ~short_desc:(fun () -> 3292 | s_ "Compile tests executable and library and run them") 3293 | ~cli:CLIEnable 3294 | "tests" 3295 | (fun () -> "false")) 3296 | "true" 3297 | 3298 | let docs = 3299 | var_define_cond ~since_version:"0.3" 3300 | (fun () -> 3301 | var_define 3302 | ~short_desc:(fun () -> s_ "Create documentations") 3303 | ~cli:CLIEnable 3304 | "docs" 3305 | (fun () -> "true")) 3306 | "true" 3307 | 3308 | let native_dynlink = 3309 | var_define 3310 | ~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.") 3311 | ~cli:CLINone 3312 | "native_dynlink" 3313 | (fun () -> 3314 | let res = 3315 | let ocaml_lt_312 () = 3316 | OASISVersion.comparator_apply 3317 | (OASISVersion.version_of_string (ocaml_version ())) 3318 | (OASISVersion.VLesser 3319 | (OASISVersion.version_of_string "3.12.0")) 3320 | in 3321 | let flexdll_lt_030 () = 3322 | OASISVersion.comparator_apply 3323 | (OASISVersion.version_of_string (flexdll_version ())) 3324 | (OASISVersion.VLesser 3325 | (OASISVersion.version_of_string "0.30")) 3326 | in 3327 | let has_native_dynlink = 3328 | let ocamlfind = ocamlfind () in 3329 | try 3330 | let fn = 3331 | OASISExec.run_read_one_line 3332 | ~ctxt:!BaseContext.default 3333 | ocamlfind 3334 | ["query"; "-predicates"; "native"; "dynlink"; 3335 | "-format"; "%d/%a"] 3336 | in 3337 | Sys.file_exists fn 3338 | with _ -> 3339 | false 3340 | in 3341 | if not has_native_dynlink then 3342 | false 3343 | else if ocaml_lt_312 () then 3344 | false 3345 | else if (os_type () = "Win32" || os_type () = "Cygwin") 3346 | && flexdll_lt_030 () then 3347 | begin 3348 | BaseMessage.warning 3349 | (f_ ".cmxs generation disabled because FlexDLL needs to be \ 3350 | at least 0.30. Please upgrade FlexDLL from %s to 0.30.") 3351 | (flexdll_version ()); 3352 | false 3353 | end 3354 | else 3355 | true 3356 | in 3357 | string_of_bool res) 3358 | 3359 | let init pkg = 3360 | rpkg := Some pkg; 3361 | List.iter (fun f -> f pkg.oasis_version) !var_cond 3362 | 3363 | end 3364 | 3365 | module BaseFileAB = struct 3366 | (* # 21 "src/base/BaseFileAB.ml" *) 3367 | 3368 | open BaseEnv 3369 | open OASISGettext 3370 | open BaseMessage 3371 | 3372 | let to_filename fn = 3373 | let fn = 3374 | OASISHostPath.of_unix fn 3375 | in 3376 | if not (Filename.check_suffix fn ".ab") then 3377 | warning 3378 | (f_ "File '%s' doesn't have '.ab' extension") 3379 | fn; 3380 | Filename.chop_extension fn 3381 | 3382 | let replace fn_lst = 3383 | let buff = 3384 | Buffer.create 13 3385 | in 3386 | List.iter 3387 | (fun fn -> 3388 | let fn = 3389 | OASISHostPath.of_unix fn 3390 | in 3391 | let chn_in = 3392 | open_in fn 3393 | in 3394 | let chn_out = 3395 | open_out (to_filename fn) 3396 | in 3397 | ( 3398 | try 3399 | while true do 3400 | Buffer.add_string buff (var_expand (input_line chn_in)); 3401 | Buffer.add_char buff '\n' 3402 | done 3403 | with End_of_file -> 3404 | () 3405 | ); 3406 | Buffer.output_buffer chn_out buff; 3407 | Buffer.clear buff; 3408 | close_in chn_in; 3409 | close_out chn_out) 3410 | fn_lst 3411 | end 3412 | 3413 | module BaseLog = struct 3414 | (* # 21 "src/base/BaseLog.ml" *) 3415 | 3416 | open OASISUtils 3417 | 3418 | let default_filename = 3419 | Filename.concat 3420 | (Filename.dirname BaseEnv.default_filename) 3421 | "setup.log" 3422 | 3423 | module SetTupleString = 3424 | Set.Make 3425 | (struct 3426 | type t = string * string 3427 | let compare (s11, s12) (s21, s22) = 3428 | match String.compare s11 s21 with 3429 | | 0 -> String.compare s12 s22 3430 | | n -> n 3431 | end) 3432 | 3433 | let load () = 3434 | if Sys.file_exists default_filename then 3435 | begin 3436 | let chn = 3437 | open_in default_filename 3438 | in 3439 | let scbuf = 3440 | Scanf.Scanning.from_file default_filename 3441 | in 3442 | let rec read_aux (st, lst) = 3443 | if not (Scanf.Scanning.end_of_input scbuf) then 3444 | begin 3445 | let acc = 3446 | try 3447 | Scanf.bscanf scbuf "%S %S\n" 3448 | (fun e d -> 3449 | let t = 3450 | e, d 3451 | in 3452 | if SetTupleString.mem t st then 3453 | st, lst 3454 | else 3455 | SetTupleString.add t st, 3456 | t :: lst) 3457 | with Scanf.Scan_failure _ -> 3458 | failwith 3459 | (Scanf.bscanf scbuf 3460 | "%l" 3461 | (fun line -> 3462 | Printf.sprintf 3463 | "Malformed log file '%s' at line %d" 3464 | default_filename 3465 | line)) 3466 | in 3467 | read_aux acc 3468 | end 3469 | else 3470 | begin 3471 | close_in chn; 3472 | List.rev lst 3473 | end 3474 | in 3475 | read_aux (SetTupleString.empty, []) 3476 | end 3477 | else 3478 | begin 3479 | [] 3480 | end 3481 | 3482 | let register event data = 3483 | let chn_out = 3484 | open_out_gen [Open_append; Open_creat; Open_text] 0o644 default_filename 3485 | in 3486 | Printf.fprintf chn_out "%S %S\n" event data; 3487 | close_out chn_out 3488 | 3489 | let unregister event data = 3490 | if Sys.file_exists default_filename then 3491 | begin 3492 | let lst = 3493 | load () 3494 | in 3495 | let chn_out = 3496 | open_out default_filename 3497 | in 3498 | let write_something = 3499 | ref false 3500 | in 3501 | List.iter 3502 | (fun (e, d) -> 3503 | if e <> event || d <> data then 3504 | begin 3505 | write_something := true; 3506 | Printf.fprintf chn_out "%S %S\n" e d 3507 | end) 3508 | lst; 3509 | close_out chn_out; 3510 | if not !write_something then 3511 | Sys.remove default_filename 3512 | end 3513 | 3514 | let filter events = 3515 | let st_events = 3516 | List.fold_left 3517 | (fun st e -> 3518 | SetString.add e st) 3519 | SetString.empty 3520 | events 3521 | in 3522 | List.filter 3523 | (fun (e, _) -> SetString.mem e st_events) 3524 | (load ()) 3525 | 3526 | let exists event data = 3527 | List.exists 3528 | (fun v -> (event, data) = v) 3529 | (load ()) 3530 | end 3531 | 3532 | module BaseBuilt = struct 3533 | (* # 21 "src/base/BaseBuilt.ml" *) 3534 | 3535 | open OASISTypes 3536 | open OASISGettext 3537 | open BaseStandardVar 3538 | open BaseMessage 3539 | 3540 | type t = 3541 | | BExec (* Executable *) 3542 | | BExecLib (* Library coming with executable *) 3543 | | BLib (* Library *) 3544 | | BDoc (* Document *) 3545 | 3546 | let to_log_event_file t nm = 3547 | "built_"^ 3548 | (match t with 3549 | | BExec -> "exec" 3550 | | BExecLib -> "exec_lib" 3551 | | BLib -> "lib" 3552 | | BDoc -> "doc")^ 3553 | "_"^nm 3554 | 3555 | let to_log_event_done t nm = 3556 | "is_"^(to_log_event_file t nm) 3557 | 3558 | let register t nm lst = 3559 | BaseLog.register 3560 | (to_log_event_done t nm) 3561 | "true"; 3562 | List.iter 3563 | (fun alt -> 3564 | let registered = 3565 | List.fold_left 3566 | (fun registered fn -> 3567 | if OASISFileUtil.file_exists_case fn then 3568 | begin 3569 | BaseLog.register 3570 | (to_log_event_file t nm) 3571 | (if Filename.is_relative fn then 3572 | Filename.concat (Sys.getcwd ()) fn 3573 | else 3574 | fn); 3575 | true 3576 | end 3577 | else 3578 | registered) 3579 | false 3580 | alt 3581 | in 3582 | if not registered then 3583 | warning 3584 | (f_ "Cannot find an existing alternative files among: %s") 3585 | (String.concat (s_ ", ") alt)) 3586 | lst 3587 | 3588 | let unregister t nm = 3589 | List.iter 3590 | (fun (e, d) -> 3591 | BaseLog.unregister e d) 3592 | (BaseLog.filter 3593 | [to_log_event_file t nm; 3594 | to_log_event_done t nm]) 3595 | 3596 | let fold t nm f acc = 3597 | List.fold_left 3598 | (fun acc (_, fn) -> 3599 | if OASISFileUtil.file_exists_case fn then 3600 | begin 3601 | f acc fn 3602 | end 3603 | else 3604 | begin 3605 | warning 3606 | (f_ "File '%s' has been marked as built \ 3607 | for %s but doesn't exist") 3608 | fn 3609 | (Printf.sprintf 3610 | (match t with 3611 | | BExec | BExecLib -> 3612 | (f_ "executable %s") 3613 | | BLib -> 3614 | (f_ "library %s") 3615 | | BDoc -> 3616 | (f_ "documentation %s")) 3617 | nm); 3618 | acc 3619 | end) 3620 | acc 3621 | (BaseLog.filter 3622 | [to_log_event_file t nm]) 3623 | 3624 | let is_built t nm = 3625 | List.fold_left 3626 | (fun is_built (_, d) -> 3627 | (try 3628 | bool_of_string d 3629 | with _ -> 3630 | false)) 3631 | false 3632 | (BaseLog.filter 3633 | [to_log_event_done t nm]) 3634 | 3635 | let of_executable ffn (cs, bs, exec) = 3636 | let unix_exec_is, unix_dll_opt = 3637 | OASISExecutable.unix_exec_is 3638 | (cs, bs, exec) 3639 | (fun () -> 3640 | bool_of_string 3641 | (is_native ())) 3642 | ext_dll 3643 | ext_program 3644 | in 3645 | let evs = 3646 | (BExec, cs.cs_name, [[ffn unix_exec_is]]) 3647 | :: 3648 | (match unix_dll_opt with 3649 | | Some fn -> 3650 | [BExecLib, cs.cs_name, [[ffn fn]]] 3651 | | None -> 3652 | []) 3653 | in 3654 | evs, 3655 | unix_exec_is, 3656 | unix_dll_opt 3657 | 3658 | let of_library ffn (cs, bs, lib) = 3659 | let unix_lst = 3660 | OASISLibrary.generated_unix_files 3661 | ~ctxt:!BaseContext.default 3662 | ~source_file_exists:(fun fn -> 3663 | OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn)) 3664 | ~is_native:(bool_of_string (is_native ())) 3665 | ~has_native_dynlink:(bool_of_string (native_dynlink ())) 3666 | ~ext_lib:(ext_lib ()) 3667 | ~ext_dll:(ext_dll ()) 3668 | (cs, bs, lib) 3669 | in 3670 | let evs = 3671 | [BLib, 3672 | cs.cs_name, 3673 | List.map (List.map ffn) unix_lst] 3674 | in 3675 | evs, unix_lst 3676 | 3677 | end 3678 | 3679 | module BaseCustom = struct 3680 | (* # 21 "src/base/BaseCustom.ml" *) 3681 | 3682 | open BaseEnv 3683 | open BaseMessage 3684 | open OASISTypes 3685 | open OASISGettext 3686 | 3687 | let run cmd args extra_args = 3688 | OASISExec.run ~ctxt:!BaseContext.default ~quote:false 3689 | (var_expand cmd) 3690 | (List.map 3691 | var_expand 3692 | (args @ (Array.to_list extra_args))) 3693 | 3694 | let hook ?(failsafe=false) cstm f e = 3695 | let optional_command lst = 3696 | let printer = 3697 | function 3698 | | Some (cmd, args) -> String.concat " " (cmd :: args) 3699 | | None -> s_ "No command" 3700 | in 3701 | match 3702 | var_choose 3703 | ~name:(s_ "Pre/Post Command") 3704 | ~printer 3705 | lst with 3706 | | Some (cmd, args) -> 3707 | begin 3708 | try 3709 | run cmd args [||] 3710 | with e when failsafe -> 3711 | warning 3712 | (f_ "Command '%s' fail with error: %s") 3713 | (String.concat " " (cmd :: args)) 3714 | (match e with 3715 | | Failure msg -> msg 3716 | | e -> Printexc.to_string e) 3717 | end 3718 | | None -> 3719 | () 3720 | in 3721 | let res = 3722 | optional_command cstm.pre_command; 3723 | f e 3724 | in 3725 | optional_command cstm.post_command; 3726 | res 3727 | end 3728 | 3729 | module BaseDynVar = struct 3730 | (* # 21 "src/base/BaseDynVar.ml" *) 3731 | 3732 | 3733 | open OASISTypes 3734 | open OASISGettext 3735 | open BaseEnv 3736 | open BaseBuilt 3737 | 3738 | let init pkg = 3739 | (* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *) 3740 | (* TODO: provide compile option for library libary_byte_args_VARNAME... *) 3741 | List.iter 3742 | (function 3743 | | Executable (cs, bs, exec) -> 3744 | if var_choose bs.bs_build then 3745 | var_ignore 3746 | (var_redefine 3747 | (* We don't save this variable *) 3748 | ~dump:false 3749 | ~short_desc:(fun () -> 3750 | Printf.sprintf 3751 | (f_ "Filename of executable '%s'") 3752 | cs.cs_name) 3753 | (OASISUtils.varname_of_string cs.cs_name) 3754 | (fun () -> 3755 | let fn_opt = 3756 | fold 3757 | BExec cs.cs_name 3758 | (fun _ fn -> Some fn) 3759 | None 3760 | in 3761 | match fn_opt with 3762 | | Some fn -> fn 3763 | | None -> 3764 | raise 3765 | (PropList.Not_set 3766 | (cs.cs_name, 3767 | Some (Printf.sprintf 3768 | (f_ "Executable '%s' not yet built.") 3769 | cs.cs_name))))) 3770 | 3771 | | Library _ | Flag _ | Test _ | SrcRepo _ | Doc _ -> 3772 | ()) 3773 | pkg.sections 3774 | end 3775 | 3776 | module BaseTest = struct 3777 | (* # 21 "src/base/BaseTest.ml" *) 3778 | 3779 | open BaseEnv 3780 | open BaseMessage 3781 | open OASISTypes 3782 | open OASISExpr 3783 | open OASISGettext 3784 | 3785 | let test lst pkg extra_args = 3786 | 3787 | let one_test (failure, n) (test_plugin, cs, test) = 3788 | if var_choose 3789 | ~name:(Printf.sprintf 3790 | (f_ "test %s run") 3791 | cs.cs_name) 3792 | ~printer:string_of_bool 3793 | test.test_run then 3794 | begin 3795 | let () = 3796 | info (f_ "Running test '%s'") cs.cs_name 3797 | in 3798 | let back_cwd = 3799 | match test.test_working_directory with 3800 | | Some dir -> 3801 | let cwd = 3802 | Sys.getcwd () 3803 | in 3804 | let chdir d = 3805 | info (f_ "Changing directory to '%s'") d; 3806 | Sys.chdir d 3807 | in 3808 | chdir dir; 3809 | fun () -> chdir cwd 3810 | 3811 | | None -> 3812 | fun () -> () 3813 | in 3814 | try 3815 | let failure_percent = 3816 | BaseCustom.hook 3817 | test.test_custom 3818 | (test_plugin pkg (cs, test)) 3819 | extra_args 3820 | in 3821 | back_cwd (); 3822 | (failure_percent +. failure, n + 1) 3823 | with e -> 3824 | begin 3825 | back_cwd (); 3826 | raise e 3827 | end 3828 | end 3829 | else 3830 | begin 3831 | info (f_ "Skipping test '%s'") cs.cs_name; 3832 | (failure, n) 3833 | end 3834 | in 3835 | let (failed, n) = 3836 | List.fold_left 3837 | one_test 3838 | (0.0, 0) 3839 | lst 3840 | in 3841 | let failure_percent = 3842 | if n = 0 then 3843 | 0.0 3844 | else 3845 | failed /. (float_of_int n) 3846 | in 3847 | let msg = 3848 | Printf.sprintf 3849 | (f_ "Tests had a %.2f%% failure rate") 3850 | (100. *. failure_percent) 3851 | in 3852 | if failure_percent > 0.0 then 3853 | failwith msg 3854 | else 3855 | info "%s" msg; 3856 | 3857 | (* Possible explanation why the tests where not run. *) 3858 | if OASISVersion.version_0_3_or_after pkg.oasis_version && 3859 | not (bool_of_string (BaseStandardVar.tests ())) && 3860 | lst <> [] then 3861 | BaseMessage.warning 3862 | "Tests are turned off, consider enabling with \ 3863 | 'ocaml setup.ml -configure --enable-tests'" 3864 | end 3865 | 3866 | module BaseDoc = struct 3867 | (* # 21 "src/base/BaseDoc.ml" *) 3868 | 3869 | open BaseEnv 3870 | open BaseMessage 3871 | open OASISTypes 3872 | open OASISGettext 3873 | 3874 | let doc lst pkg extra_args = 3875 | 3876 | let one_doc (doc_plugin, cs, doc) = 3877 | if var_choose 3878 | ~name:(Printf.sprintf 3879 | (f_ "documentation %s build") 3880 | cs.cs_name) 3881 | ~printer:string_of_bool 3882 | doc.doc_build then 3883 | begin 3884 | info (f_ "Building documentation '%s'") cs.cs_name; 3885 | BaseCustom.hook 3886 | doc.doc_custom 3887 | (doc_plugin pkg (cs, doc)) 3888 | extra_args 3889 | end 3890 | in 3891 | List.iter one_doc lst; 3892 | 3893 | if OASISVersion.version_0_3_or_after pkg.oasis_version && 3894 | not (bool_of_string (BaseStandardVar.docs ())) && 3895 | lst <> [] then 3896 | BaseMessage.warning 3897 | "Docs are turned off, consider enabling with \ 3898 | 'ocaml setup.ml -configure --enable-docs'" 3899 | end 3900 | 3901 | module BaseSetup = struct 3902 | (* # 21 "src/base/BaseSetup.ml" *) 3903 | 3904 | open BaseEnv 3905 | open BaseMessage 3906 | open OASISTypes 3907 | open OASISSection 3908 | open OASISGettext 3909 | open OASISUtils 3910 | 3911 | type std_args_fun = 3912 | package -> string array -> unit 3913 | 3914 | type ('a, 'b) section_args_fun = 3915 | name * (package -> (common_section * 'a) -> string array -> 'b) 3916 | 3917 | type t = 3918 | { 3919 | configure: std_args_fun; 3920 | build: std_args_fun; 3921 | doc: ((doc, unit) section_args_fun) list; 3922 | test: ((test, float) section_args_fun) list; 3923 | install: std_args_fun; 3924 | uninstall: std_args_fun; 3925 | clean: std_args_fun list; 3926 | clean_doc: (doc, unit) section_args_fun list; 3927 | clean_test: (test, unit) section_args_fun list; 3928 | distclean: std_args_fun list; 3929 | distclean_doc: (doc, unit) section_args_fun list; 3930 | distclean_test: (test, unit) section_args_fun list; 3931 | package: package; 3932 | oasis_fn: string option; 3933 | oasis_version: string; 3934 | oasis_digest: Digest.t option; 3935 | oasis_exec: string option; 3936 | oasis_setup_args: string list; 3937 | setup_update: bool; 3938 | } 3939 | 3940 | (* Associate a plugin function with data from package *) 3941 | let join_plugin_sections filter_map lst = 3942 | List.rev 3943 | (List.fold_left 3944 | (fun acc sct -> 3945 | match filter_map sct with 3946 | | Some e -> 3947 | e :: acc 3948 | | None -> 3949 | acc) 3950 | [] 3951 | lst) 3952 | 3953 | (* Search for plugin data associated with a section name *) 3954 | let lookup_plugin_section plugin action nm lst = 3955 | try 3956 | List.assoc nm lst 3957 | with Not_found -> 3958 | failwithf 3959 | (f_ "Cannot find plugin %s matching section %s for %s action") 3960 | plugin 3961 | nm 3962 | action 3963 | 3964 | let configure t args = 3965 | (* Run configure *) 3966 | BaseCustom.hook 3967 | t.package.conf_custom 3968 | (fun () -> 3969 | (* Reload if preconf has changed it *) 3970 | begin 3971 | try 3972 | unload (); 3973 | load (); 3974 | with _ -> 3975 | () 3976 | end; 3977 | 3978 | (* Run plugin's configure *) 3979 | t.configure t.package args; 3980 | 3981 | (* Dump to allow postconf to change it *) 3982 | dump ()) 3983 | (); 3984 | 3985 | (* Reload environment *) 3986 | unload (); 3987 | load (); 3988 | 3989 | (* Save environment *) 3990 | print (); 3991 | 3992 | (* Replace data in file *) 3993 | BaseFileAB.replace t.package.files_ab 3994 | 3995 | let build t args = 3996 | BaseCustom.hook 3997 | t.package.build_custom 3998 | (t.build t.package) 3999 | args 4000 | 4001 | let doc t args = 4002 | BaseDoc.doc 4003 | (join_plugin_sections 4004 | (function 4005 | | Doc (cs, e) -> 4006 | Some 4007 | (lookup_plugin_section 4008 | "documentation" 4009 | (s_ "build") 4010 | cs.cs_name 4011 | t.doc, 4012 | cs, 4013 | e) 4014 | | _ -> 4015 | None) 4016 | t.package.sections) 4017 | t.package 4018 | args 4019 | 4020 | let test t args = 4021 | BaseTest.test 4022 | (join_plugin_sections 4023 | (function 4024 | | Test (cs, e) -> 4025 | Some 4026 | (lookup_plugin_section 4027 | "test" 4028 | (s_ "run") 4029 | cs.cs_name 4030 | t.test, 4031 | cs, 4032 | e) 4033 | | _ -> 4034 | None) 4035 | t.package.sections) 4036 | t.package 4037 | args 4038 | 4039 | let all t args = 4040 | let rno_doc = 4041 | ref false 4042 | in 4043 | let rno_test = 4044 | ref false 4045 | in 4046 | Arg.parse_argv 4047 | ~current:(ref 0) 4048 | (Array.of_list 4049 | ((Sys.executable_name^" all") :: 4050 | (Array.to_list args))) 4051 | [ 4052 | "-no-doc", 4053 | Arg.Set rno_doc, 4054 | s_ "Don't run doc target"; 4055 | 4056 | "-no-test", 4057 | Arg.Set rno_test, 4058 | s_ "Don't run test target"; 4059 | ] 4060 | (failwithf (f_ "Don't know what to do with '%s'")) 4061 | ""; 4062 | 4063 | info "Running configure step"; 4064 | configure t [||]; 4065 | 4066 | info "Running build step"; 4067 | build t [||]; 4068 | 4069 | (* Load setup.log dynamic variables *) 4070 | BaseDynVar.init t.package; 4071 | 4072 | if not !rno_doc then 4073 | begin 4074 | info "Running doc step"; 4075 | doc t [||]; 4076 | end 4077 | else 4078 | begin 4079 | info "Skipping doc step" 4080 | end; 4081 | 4082 | if not !rno_test then 4083 | begin 4084 | info "Running test step"; 4085 | test t [||] 4086 | end 4087 | else 4088 | begin 4089 | info "Skipping test step" 4090 | end 4091 | 4092 | let install t args = 4093 | BaseCustom.hook 4094 | t.package.install_custom 4095 | (t.install t.package) 4096 | args 4097 | 4098 | let uninstall t args = 4099 | BaseCustom.hook 4100 | t.package.uninstall_custom 4101 | (t.uninstall t.package) 4102 | args 4103 | 4104 | let reinstall t args = 4105 | uninstall t args; 4106 | install t args 4107 | 4108 | let clean, distclean = 4109 | let failsafe f a = 4110 | try 4111 | f a 4112 | with e -> 4113 | warning 4114 | (f_ "Action fail with error: %s") 4115 | (match e with 4116 | | Failure msg -> msg 4117 | | e -> Printexc.to_string e) 4118 | in 4119 | 4120 | let generic_clean t cstm mains docs tests args = 4121 | BaseCustom.hook 4122 | ~failsafe:true 4123 | cstm 4124 | (fun () -> 4125 | (* Clean section *) 4126 | List.iter 4127 | (function 4128 | | Test (cs, test) -> 4129 | let f = 4130 | try 4131 | List.assoc cs.cs_name tests 4132 | with Not_found -> 4133 | fun _ _ _ -> () 4134 | in 4135 | failsafe 4136 | (f t.package (cs, test)) 4137 | args 4138 | | Doc (cs, doc) -> 4139 | let f = 4140 | try 4141 | List.assoc cs.cs_name docs 4142 | with Not_found -> 4143 | fun _ _ _ -> () 4144 | in 4145 | failsafe 4146 | (f t.package (cs, doc)) 4147 | args 4148 | | Library _ 4149 | | Executable _ 4150 | | Flag _ 4151 | | SrcRepo _ -> 4152 | ()) 4153 | t.package.sections; 4154 | (* Clean whole package *) 4155 | List.iter 4156 | (fun f -> 4157 | failsafe 4158 | (f t.package) 4159 | args) 4160 | mains) 4161 | () 4162 | in 4163 | 4164 | let clean t args = 4165 | generic_clean 4166 | t 4167 | t.package.clean_custom 4168 | t.clean 4169 | t.clean_doc 4170 | t.clean_test 4171 | args 4172 | in 4173 | 4174 | let distclean t args = 4175 | (* Call clean *) 4176 | clean t args; 4177 | 4178 | (* Call distclean code *) 4179 | generic_clean 4180 | t 4181 | t.package.distclean_custom 4182 | t.distclean 4183 | t.distclean_doc 4184 | t.distclean_test 4185 | args; 4186 | 4187 | (* Remove generated file *) 4188 | List.iter 4189 | (fun fn -> 4190 | if Sys.file_exists fn then 4191 | begin 4192 | info (f_ "Remove '%s'") fn; 4193 | Sys.remove fn 4194 | end) 4195 | (BaseEnv.default_filename 4196 | :: 4197 | BaseLog.default_filename 4198 | :: 4199 | (List.rev_map BaseFileAB.to_filename t.package.files_ab)) 4200 | in 4201 | 4202 | clean, distclean 4203 | 4204 | let version t _ = 4205 | print_endline t.oasis_version 4206 | 4207 | let update_setup_ml, no_update_setup_ml_cli = 4208 | let b = ref true in 4209 | b, 4210 | ("-no-update-setup-ml", 4211 | Arg.Clear b, 4212 | s_ " Don't try to update setup.ml, even if _oasis has changed.") 4213 | 4214 | let update_setup_ml t = 4215 | let oasis_fn = 4216 | match t.oasis_fn with 4217 | | Some fn -> fn 4218 | | None -> "_oasis" 4219 | in 4220 | let oasis_exec = 4221 | match t.oasis_exec with 4222 | | Some fn -> fn 4223 | | None -> "oasis" 4224 | in 4225 | let ocaml = 4226 | Sys.executable_name 4227 | in 4228 | let setup_ml, args = 4229 | match Array.to_list Sys.argv with 4230 | | setup_ml :: args -> 4231 | setup_ml, args 4232 | | [] -> 4233 | failwith 4234 | (s_ "Expecting non-empty command line arguments.") 4235 | in 4236 | let ocaml, setup_ml = 4237 | if Sys.executable_name = Sys.argv.(0) then 4238 | (* We are not running in standard mode, probably the script 4239 | * is precompiled. 4240 | *) 4241 | "ocaml", "setup.ml" 4242 | else 4243 | ocaml, setup_ml 4244 | in 4245 | let no_update_setup_ml_cli, _, _ = no_update_setup_ml_cli in 4246 | let do_update () = 4247 | let oasis_exec_version = 4248 | OASISExec.run_read_one_line 4249 | ~ctxt:!BaseContext.default 4250 | ~f_exit_code: 4251 | (function 4252 | | 0 -> 4253 | () 4254 | | 1 -> 4255 | failwithf 4256 | (f_ "Executable '%s' is probably an old version \ 4257 | of oasis (< 0.3.0), please update to version \ 4258 | v%s.") 4259 | oasis_exec t.oasis_version 4260 | | 127 -> 4261 | failwithf 4262 | (f_ "Cannot find executable '%s', please install \ 4263 | oasis v%s.") 4264 | oasis_exec t.oasis_version 4265 | | n -> 4266 | failwithf 4267 | (f_ "Command '%s version' exited with code %d.") 4268 | oasis_exec n) 4269 | oasis_exec ["version"] 4270 | in 4271 | if OASISVersion.comparator_apply 4272 | (OASISVersion.version_of_string oasis_exec_version) 4273 | (OASISVersion.VGreaterEqual 4274 | (OASISVersion.version_of_string t.oasis_version)) then 4275 | begin 4276 | (* We have a version >= for the executable oasis, proceed with 4277 | * update. 4278 | *) 4279 | (* TODO: delegate this check to 'oasis setup'. *) 4280 | if Sys.os_type = "Win32" then 4281 | failwithf 4282 | (f_ "It is not possible to update the running script \ 4283 | setup.ml on Windows. Please update setup.ml by \ 4284 | running '%s'.") 4285 | (String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args)) 4286 | else 4287 | begin 4288 | OASISExec.run 4289 | ~ctxt:!BaseContext.default 4290 | ~f_exit_code: 4291 | (function 4292 | | 0 -> 4293 | () 4294 | | n -> 4295 | failwithf 4296 | (f_ "Unable to update setup.ml using '%s', \ 4297 | please fix the problem and retry.") 4298 | oasis_exec) 4299 | oasis_exec ("setup" :: t.oasis_setup_args); 4300 | OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args) 4301 | end 4302 | end 4303 | else 4304 | failwithf 4305 | (f_ "The version of '%s' (v%s) doesn't match the version of \ 4306 | oasis used to generate the %s file. Please install at \ 4307 | least oasis v%s.") 4308 | oasis_exec oasis_exec_version setup_ml t.oasis_version 4309 | in 4310 | 4311 | if !update_setup_ml then 4312 | begin 4313 | try 4314 | match t.oasis_digest with 4315 | | Some dgst -> 4316 | if Sys.file_exists oasis_fn && dgst <> Digest.file "_oasis" then 4317 | begin 4318 | do_update (); 4319 | true 4320 | end 4321 | else 4322 | false 4323 | | None -> 4324 | false 4325 | with e -> 4326 | error 4327 | (f_ "Error when updating setup.ml. If you want to avoid this error, \ 4328 | you can bypass the update of %s by running '%s %s %s %s'") 4329 | setup_ml ocaml setup_ml no_update_setup_ml_cli 4330 | (String.concat " " args); 4331 | raise e 4332 | end 4333 | else 4334 | false 4335 | 4336 | let setup t = 4337 | let catch_exn = 4338 | ref true 4339 | in 4340 | try 4341 | let act_ref = 4342 | ref (fun _ -> 4343 | failwithf 4344 | (f_ "No action defined, run '%s %s -help'") 4345 | Sys.executable_name 4346 | Sys.argv.(0)) 4347 | 4348 | in 4349 | let extra_args_ref = 4350 | ref [] 4351 | in 4352 | let allow_empty_env_ref = 4353 | ref false 4354 | in 4355 | let arg_handle ?(allow_empty_env=false) act = 4356 | Arg.Tuple 4357 | [ 4358 | Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref); 4359 | 4360 | Arg.Unit 4361 | (fun () -> 4362 | allow_empty_env_ref := allow_empty_env; 4363 | act_ref := act); 4364 | ] 4365 | in 4366 | 4367 | Arg.parse 4368 | (Arg.align 4369 | ([ 4370 | "-configure", 4371 | arg_handle ~allow_empty_env:true configure, 4372 | s_ "[options*] Configure the whole build process."; 4373 | 4374 | "-build", 4375 | arg_handle build, 4376 | s_ "[options*] Build executables and libraries."; 4377 | 4378 | "-doc", 4379 | arg_handle doc, 4380 | s_ "[options*] Build documents."; 4381 | 4382 | "-test", 4383 | arg_handle test, 4384 | s_ "[options*] Run tests."; 4385 | 4386 | "-all", 4387 | arg_handle ~allow_empty_env:true all, 4388 | s_ "[options*] Run configure, build, doc and test targets."; 4389 | 4390 | "-install", 4391 | arg_handle install, 4392 | s_ "[options*] Install libraries, data, executables \ 4393 | and documents."; 4394 | 4395 | "-uninstall", 4396 | arg_handle uninstall, 4397 | s_ "[options*] Uninstall libraries, data, executables \ 4398 | and documents."; 4399 | 4400 | "-reinstall", 4401 | arg_handle reinstall, 4402 | s_ "[options*] Uninstall and install libraries, data, \ 4403 | executables and documents."; 4404 | 4405 | "-clean", 4406 | arg_handle ~allow_empty_env:true clean, 4407 | s_ "[options*] Clean files generated by a build."; 4408 | 4409 | "-distclean", 4410 | arg_handle ~allow_empty_env:true distclean, 4411 | s_ "[options*] Clean files generated by a build and configure."; 4412 | 4413 | "-version", 4414 | arg_handle ~allow_empty_env:true version, 4415 | s_ " Display version of OASIS used to generate this setup.ml."; 4416 | 4417 | "-no-catch-exn", 4418 | Arg.Clear catch_exn, 4419 | s_ " Don't catch exception, useful for debugging."; 4420 | ] 4421 | @ 4422 | (if t.setup_update then 4423 | [no_update_setup_ml_cli] 4424 | else 4425 | []) 4426 | @ (BaseContext.args ()))) 4427 | (failwithf (f_ "Don't know what to do with '%s'")) 4428 | (s_ "Setup and run build process current package\n"); 4429 | 4430 | (* Build initial environment *) 4431 | load ~allow_empty:!allow_empty_env_ref (); 4432 | 4433 | (** Initialize flags *) 4434 | List.iter 4435 | (function 4436 | | Flag (cs, {flag_description = hlp; 4437 | flag_default = choices}) -> 4438 | begin 4439 | let apply ?short_desc () = 4440 | var_ignore 4441 | (var_define 4442 | ~cli:CLIEnable 4443 | ?short_desc 4444 | (OASISUtils.varname_of_string cs.cs_name) 4445 | (fun () -> 4446 | string_of_bool 4447 | (var_choose 4448 | ~name:(Printf.sprintf 4449 | (f_ "default value of flag %s") 4450 | cs.cs_name) 4451 | ~printer:string_of_bool 4452 | choices))) 4453 | in 4454 | match hlp with 4455 | | Some hlp -> 4456 | apply ~short_desc:(fun () -> hlp) () 4457 | | None -> 4458 | apply () 4459 | end 4460 | | _ -> 4461 | ()) 4462 | t.package.sections; 4463 | 4464 | BaseStandardVar.init t.package; 4465 | 4466 | BaseDynVar.init t.package; 4467 | 4468 | if t.setup_update && update_setup_ml t then 4469 | () 4470 | else 4471 | !act_ref t (Array.of_list (List.rev !extra_args_ref)) 4472 | 4473 | with e when !catch_exn -> 4474 | error "%s" (Printexc.to_string e); 4475 | exit 1 4476 | 4477 | end 4478 | 4479 | 4480 | # 4480 "setup.ml" 4481 | module InternalConfigurePlugin = struct 4482 | (* # 21 "src/plugins/internal/InternalConfigurePlugin.ml" *) 4483 | 4484 | (** Configure using internal scheme 4485 | @author Sylvain Le Gall 4486 | *) 4487 | 4488 | open BaseEnv 4489 | open OASISTypes 4490 | open OASISUtils 4491 | open OASISGettext 4492 | open BaseMessage 4493 | 4494 | (** Configure build using provided series of check to be done 4495 | * and then output corresponding file. 4496 | *) 4497 | let configure pkg argv = 4498 | let var_ignore_eval var = 4499 | let _s : string = 4500 | var () 4501 | in 4502 | () 4503 | in 4504 | 4505 | let errors = 4506 | ref SetString.empty 4507 | in 4508 | 4509 | let buff = 4510 | Buffer.create 13 4511 | in 4512 | 4513 | let add_errors fmt = 4514 | Printf.kbprintf 4515 | (fun b -> 4516 | errors := SetString.add (Buffer.contents b) !errors; 4517 | Buffer.clear b) 4518 | buff 4519 | fmt 4520 | in 4521 | 4522 | let warn_exception e = 4523 | warning "%s" (Printexc.to_string e) 4524 | in 4525 | 4526 | (* Check tools *) 4527 | let check_tools lst = 4528 | List.iter 4529 | (function 4530 | | ExternalTool tool -> 4531 | begin 4532 | try 4533 | var_ignore_eval (BaseCheck.prog tool) 4534 | with e -> 4535 | warn_exception e; 4536 | add_errors (f_ "Cannot find external tool '%s'") tool 4537 | end 4538 | | InternalExecutable nm1 -> 4539 | (* Check that matching tool is built *) 4540 | List.iter 4541 | (function 4542 | | Executable ({cs_name = nm2}, 4543 | {bs_build = build}, 4544 | _) when nm1 = nm2 -> 4545 | if not (var_choose build) then 4546 | add_errors 4547 | (f_ "Cannot find buildable internal executable \ 4548 | '%s' when checking build depends") 4549 | nm1 4550 | | _ -> 4551 | ()) 4552 | pkg.sections) 4553 | lst 4554 | in 4555 | 4556 | let build_checks sct bs = 4557 | if var_choose bs.bs_build then 4558 | begin 4559 | if bs.bs_compiled_object = Native then 4560 | begin 4561 | try 4562 | var_ignore_eval BaseStandardVar.ocamlopt 4563 | with e -> 4564 | warn_exception e; 4565 | add_errors 4566 | (f_ "Section %s requires native compilation") 4567 | (OASISSection.string_of_section sct) 4568 | end; 4569 | 4570 | (* Check tools *) 4571 | check_tools bs.bs_build_tools; 4572 | 4573 | (* Check depends *) 4574 | List.iter 4575 | (function 4576 | | FindlibPackage (findlib_pkg, version_comparator) -> 4577 | begin 4578 | try 4579 | var_ignore_eval 4580 | (BaseCheck.package ?version_comparator findlib_pkg) 4581 | with e -> 4582 | warn_exception e; 4583 | match version_comparator with 4584 | | None -> 4585 | add_errors 4586 | (f_ "Cannot find findlib package %s") 4587 | findlib_pkg 4588 | | Some ver_cmp -> 4589 | add_errors 4590 | (f_ "Cannot find findlib package %s (%s)") 4591 | findlib_pkg 4592 | (OASISVersion.string_of_comparator ver_cmp) 4593 | end 4594 | | InternalLibrary nm1 -> 4595 | (* Check that matching library is built *) 4596 | List.iter 4597 | (function 4598 | | Library ({cs_name = nm2}, 4599 | {bs_build = build}, 4600 | _) when nm1 = nm2 -> 4601 | if not (var_choose build) then 4602 | add_errors 4603 | (f_ "Cannot find buildable internal library \ 4604 | '%s' when checking build depends") 4605 | nm1 4606 | | _ -> 4607 | ()) 4608 | pkg.sections) 4609 | bs.bs_build_depends 4610 | end 4611 | in 4612 | 4613 | (* Parse command line *) 4614 | BaseArgExt.parse argv (BaseEnv.args ()); 4615 | 4616 | (* OCaml version *) 4617 | begin 4618 | match pkg.ocaml_version with 4619 | | Some ver_cmp -> 4620 | begin 4621 | try 4622 | var_ignore_eval 4623 | (BaseCheck.version 4624 | "ocaml" 4625 | ver_cmp 4626 | BaseStandardVar.ocaml_version) 4627 | with e -> 4628 | warn_exception e; 4629 | add_errors 4630 | (f_ "OCaml version %s doesn't match version constraint %s") 4631 | (BaseStandardVar.ocaml_version ()) 4632 | (OASISVersion.string_of_comparator ver_cmp) 4633 | end 4634 | | None -> 4635 | () 4636 | end; 4637 | 4638 | (* Findlib version *) 4639 | begin 4640 | match pkg.findlib_version with 4641 | | Some ver_cmp -> 4642 | begin 4643 | try 4644 | var_ignore_eval 4645 | (BaseCheck.version 4646 | "findlib" 4647 | ver_cmp 4648 | BaseStandardVar.findlib_version) 4649 | with e -> 4650 | warn_exception e; 4651 | add_errors 4652 | (f_ "Findlib version %s doesn't match version constraint %s") 4653 | (BaseStandardVar.findlib_version ()) 4654 | (OASISVersion.string_of_comparator ver_cmp) 4655 | end 4656 | | None -> 4657 | () 4658 | end; 4659 | 4660 | (* FlexDLL *) 4661 | if BaseStandardVar.os_type () = "Win32" || 4662 | BaseStandardVar.os_type () = "Cygwin" then 4663 | begin 4664 | try 4665 | var_ignore_eval BaseStandardVar.flexlink 4666 | with e -> 4667 | warn_exception e; 4668 | add_errors (f_ "Cannot find 'flexlink'") 4669 | end; 4670 | 4671 | (* Check build depends *) 4672 | List.iter 4673 | (function 4674 | | Executable (_, bs, _) 4675 | | Library (_, bs, _) as sct -> 4676 | build_checks sct bs 4677 | | Doc (_, doc) -> 4678 | if var_choose doc.doc_build then 4679 | check_tools doc.doc_build_tools 4680 | | Test (_, test) -> 4681 | if var_choose test.test_run then 4682 | check_tools test.test_tools 4683 | | _ -> 4684 | ()) 4685 | pkg.sections; 4686 | 4687 | (* Check if we need native dynlink (presence of libraries that compile to 4688 | * native) 4689 | *) 4690 | begin 4691 | let has_cmxa = 4692 | List.exists 4693 | (function 4694 | | Library (_, bs, _) -> 4695 | var_choose bs.bs_build && 4696 | (bs.bs_compiled_object = Native || 4697 | (bs.bs_compiled_object = Best && 4698 | bool_of_string (BaseStandardVar.is_native ()))) 4699 | | _ -> 4700 | false) 4701 | pkg.sections 4702 | in 4703 | if has_cmxa then 4704 | var_ignore_eval BaseStandardVar.native_dynlink 4705 | end; 4706 | 4707 | (* Check errors *) 4708 | if SetString.empty != !errors then 4709 | begin 4710 | List.iter 4711 | (fun e -> error "%s" e) 4712 | (SetString.elements !errors); 4713 | failwithf 4714 | (fn_ 4715 | "%d configuration error" 4716 | "%d configuration errors" 4717 | (SetString.cardinal !errors)) 4718 | (SetString.cardinal !errors) 4719 | end 4720 | 4721 | end 4722 | 4723 | module InternalInstallPlugin = struct 4724 | (* # 21 "src/plugins/internal/InternalInstallPlugin.ml" *) 4725 | 4726 | (** Install using internal scheme 4727 | @author Sylvain Le Gall 4728 | *) 4729 | 4730 | open BaseEnv 4731 | open BaseStandardVar 4732 | open BaseMessage 4733 | open OASISTypes 4734 | open OASISLibrary 4735 | open OASISGettext 4736 | open OASISUtils 4737 | 4738 | let exec_hook = 4739 | ref (fun (cs, bs, exec) -> cs, bs, exec) 4740 | 4741 | let lib_hook = 4742 | ref (fun (cs, bs, lib) -> cs, bs, lib, []) 4743 | 4744 | let doc_hook = 4745 | ref (fun (cs, doc) -> cs, doc) 4746 | 4747 | let install_file_ev = 4748 | "install-file" 4749 | 4750 | let install_dir_ev = 4751 | "install-dir" 4752 | 4753 | let install_findlib_ev = 4754 | "install-findlib" 4755 | 4756 | let win32_max_command_line_length = 8000 4757 | 4758 | let split_install_command ocamlfind findlib_name meta files = 4759 | if Sys.os_type = "Win32" then 4760 | (* Arguments for the first command: *) 4761 | let first_args = ["install"; findlib_name; meta] in 4762 | (* Arguments for remaining commands: *) 4763 | let other_args = ["install"; findlib_name; "-add"] in 4764 | (* Extract as much files as possible from [files], [len] is 4765 | the current command line length: *) 4766 | let rec get_files len acc files = 4767 | match files with 4768 | | [] -> 4769 | (List.rev acc, []) 4770 | | file :: rest -> 4771 | let len = len + 1 + String.length file in 4772 | if len > win32_max_command_line_length then 4773 | (List.rev acc, files) 4774 | else 4775 | get_files len (file :: acc) rest 4776 | in 4777 | (* Split the command into several commands. *) 4778 | let rec split args files = 4779 | match files with 4780 | | [] -> 4781 | [] 4782 | | _ -> 4783 | (* Length of "ocamlfind install [META|-add]" *) 4784 | let len = 4785 | List.fold_left 4786 | (fun len arg -> 4787 | len + 1 (* for the space *) + String.length arg) 4788 | (String.length ocamlfind) 4789 | args 4790 | in 4791 | match get_files len [] files with 4792 | | ([], _) -> 4793 | failwith (s_ "Command line too long.") 4794 | | (firsts, others) -> 4795 | let cmd = args @ firsts in 4796 | (* Use -add for remaining commands: *) 4797 | let () = 4798 | let findlib_ge_132 = 4799 | OASISVersion.comparator_apply 4800 | (OASISVersion.version_of_string 4801 | (BaseStandardVar.findlib_version ())) 4802 | (OASISVersion.VGreaterEqual 4803 | (OASISVersion.version_of_string "1.3.2")) 4804 | in 4805 | if not findlib_ge_132 then 4806 | failwithf 4807 | (f_ "Installing the library %s require to use the flag \ 4808 | '-add' of ocamlfind because the command line is too \ 4809 | long. This flag is only available for findlib 1.3.2. \ 4810 | Please upgrade findlib from %s to 1.3.2") 4811 | findlib_name (BaseStandardVar.findlib_version ()) 4812 | in 4813 | let cmds = split other_args others in 4814 | cmd :: cmds 4815 | in 4816 | (* The first command does not use -add: *) 4817 | split first_args files 4818 | else 4819 | ["install" :: findlib_name :: meta :: files] 4820 | 4821 | let install pkg argv = 4822 | 4823 | let in_destdir = 4824 | try 4825 | let destdir = 4826 | destdir () 4827 | in 4828 | (* Practically speaking destdir is prepended 4829 | * at the beginning of the target filename 4830 | *) 4831 | fun fn -> destdir^fn 4832 | with PropList.Not_set _ -> 4833 | fun fn -> fn 4834 | in 4835 | 4836 | let install_file ?tgt_fn src_file envdir = 4837 | let tgt_dir = 4838 | in_destdir (envdir ()) 4839 | in 4840 | let tgt_file = 4841 | Filename.concat 4842 | tgt_dir 4843 | (match tgt_fn with 4844 | | Some fn -> 4845 | fn 4846 | | None -> 4847 | Filename.basename src_file) 4848 | in 4849 | (* Create target directory if needed *) 4850 | OASISFileUtil.mkdir_parent 4851 | ~ctxt:!BaseContext.default 4852 | (fun dn -> 4853 | info (f_ "Creating directory '%s'") dn; 4854 | BaseLog.register install_dir_ev dn) 4855 | tgt_dir; 4856 | 4857 | (* Really install files *) 4858 | info (f_ "Copying file '%s' to '%s'") src_file tgt_file; 4859 | OASISFileUtil.cp ~ctxt:!BaseContext.default src_file tgt_file; 4860 | BaseLog.register install_file_ev tgt_file 4861 | in 4862 | 4863 | (* Install data into defined directory *) 4864 | let install_data srcdir lst tgtdir = 4865 | let tgtdir = 4866 | OASISHostPath.of_unix (var_expand tgtdir) 4867 | in 4868 | List.iter 4869 | (fun (src, tgt_opt) -> 4870 | let real_srcs = 4871 | OASISFileUtil.glob 4872 | ~ctxt:!BaseContext.default 4873 | (Filename.concat srcdir src) 4874 | in 4875 | if real_srcs = [] then 4876 | failwithf 4877 | (f_ "Wildcard '%s' doesn't match any files") 4878 | src; 4879 | List.iter 4880 | (fun fn -> 4881 | install_file 4882 | fn 4883 | (fun () -> 4884 | match tgt_opt with 4885 | | Some s -> 4886 | OASISHostPath.of_unix (var_expand s) 4887 | | None -> 4888 | tgtdir)) 4889 | real_srcs) 4890 | lst 4891 | in 4892 | 4893 | (** Install all libraries *) 4894 | let install_libs pkg = 4895 | 4896 | let files_of_library (f_data, acc) data_lib = 4897 | let cs, bs, lib, lib_extra = 4898 | !lib_hook data_lib 4899 | in 4900 | if var_choose bs.bs_install && 4901 | BaseBuilt.is_built BaseBuilt.BLib cs.cs_name then 4902 | begin 4903 | let acc = 4904 | (* Start with acc + lib_extra *) 4905 | List.rev_append lib_extra acc 4906 | in 4907 | let acc = 4908 | (* Add uncompiled header from the source tree *) 4909 | let path = 4910 | OASISHostPath.of_unix bs.bs_path 4911 | in 4912 | List.fold_left 4913 | (fun acc modul -> 4914 | try 4915 | List.find 4916 | OASISFileUtil.file_exists_case 4917 | (List.map 4918 | (Filename.concat path) 4919 | [modul^".mli"; 4920 | modul^".ml"; 4921 | String.uncapitalize modul^".mli"; 4922 | String.capitalize modul^".mli"; 4923 | String.uncapitalize modul^".ml"; 4924 | String.capitalize modul^".ml"]) 4925 | :: acc 4926 | with Not_found -> 4927 | begin 4928 | warning 4929 | (f_ "Cannot find source header for module %s \ 4930 | in library %s") 4931 | modul cs.cs_name; 4932 | acc 4933 | end) 4934 | acc 4935 | lib.lib_modules 4936 | in 4937 | 4938 | let acc = 4939 | (* Get generated files *) 4940 | BaseBuilt.fold 4941 | BaseBuilt.BLib 4942 | cs.cs_name 4943 | (fun acc fn -> fn :: acc) 4944 | acc 4945 | in 4946 | 4947 | let f_data () = 4948 | (* Install data associated with the library *) 4949 | install_data 4950 | bs.bs_path 4951 | bs.bs_data_files 4952 | (Filename.concat 4953 | (datarootdir ()) 4954 | pkg.name); 4955 | f_data () 4956 | in 4957 | 4958 | (f_data, acc) 4959 | end 4960 | else 4961 | begin 4962 | (f_data, acc) 4963 | end 4964 | in 4965 | 4966 | (* Install one group of library *) 4967 | let install_group_lib grp = 4968 | (* Iterate through all group nodes *) 4969 | let rec install_group_lib_aux data_and_files grp = 4970 | let data_and_files, children = 4971 | match grp with 4972 | | Container (_, children) -> 4973 | data_and_files, children 4974 | | Package (_, cs, bs, lib, children) -> 4975 | files_of_library data_and_files (cs, bs, lib), children 4976 | in 4977 | List.fold_left 4978 | install_group_lib_aux 4979 | data_and_files 4980 | children 4981 | in 4982 | 4983 | (* Findlib name of the root library *) 4984 | let findlib_name = 4985 | findlib_of_group grp 4986 | in 4987 | 4988 | (* Determine root library *) 4989 | let root_lib = 4990 | root_of_group grp 4991 | in 4992 | 4993 | (* All files to install for this library *) 4994 | let f_data, files = 4995 | install_group_lib_aux (ignore, []) grp 4996 | in 4997 | 4998 | (* Really install, if there is something to install *) 4999 | if files = [] then 5000 | begin 5001 | warning 5002 | (f_ "Nothing to install for findlib library '%s'") 5003 | findlib_name 5004 | end 5005 | else 5006 | begin 5007 | let meta = 5008 | (* Search META file *) 5009 | let (_, bs, _) = 5010 | root_lib 5011 | in 5012 | let res = 5013 | Filename.concat bs.bs_path "META" 5014 | in 5015 | if not (OASISFileUtil.file_exists_case res) then 5016 | failwithf 5017 | (f_ "Cannot find file '%s' for findlib library %s") 5018 | res 5019 | findlib_name; 5020 | res 5021 | in 5022 | let files = 5023 | (* Make filename shorter to avoid hitting command max line length 5024 | * too early, esp. on Windows. 5025 | *) 5026 | let remove_prefix p n = 5027 | let plen = String.length p in 5028 | let nlen = String.length n in 5029 | if plen <= nlen && String.sub n 0 plen = p then 5030 | begin 5031 | let fn_sep = 5032 | if Sys.os_type = "Win32" then 5033 | '\\' 5034 | else 5035 | '/' 5036 | in 5037 | let cutpoint = plen + 5038 | (if plen < nlen && n.[plen] = fn_sep then 5039 | 1 5040 | else 5041 | 0) 5042 | in 5043 | String.sub n cutpoint (nlen - cutpoint) 5044 | end 5045 | else 5046 | n 5047 | in 5048 | List.map (remove_prefix (Sys.getcwd ())) files 5049 | in 5050 | info 5051 | (f_ "Installing findlib library '%s'") 5052 | findlib_name; 5053 | let ocamlfind = ocamlfind () in 5054 | let commands = 5055 | split_install_command 5056 | ocamlfind 5057 | findlib_name 5058 | meta 5059 | files 5060 | in 5061 | List.iter 5062 | (OASISExec.run ~ctxt:!BaseContext.default ocamlfind) 5063 | commands; 5064 | BaseLog.register install_findlib_ev findlib_name 5065 | end; 5066 | 5067 | (* Install data files *) 5068 | f_data (); 5069 | 5070 | in 5071 | 5072 | let group_libs, _, _ = 5073 | findlib_mapping pkg 5074 | in 5075 | 5076 | (* We install libraries in groups *) 5077 | List.iter install_group_lib group_libs 5078 | in 5079 | 5080 | let install_execs pkg = 5081 | let install_exec data_exec = 5082 | let (cs, bs, exec) = 5083 | !exec_hook data_exec 5084 | in 5085 | if var_choose bs.bs_install && 5086 | BaseBuilt.is_built BaseBuilt.BExec cs.cs_name then 5087 | begin 5088 | let exec_libdir () = 5089 | Filename.concat 5090 | (libdir ()) 5091 | pkg.name 5092 | in 5093 | BaseBuilt.fold 5094 | BaseBuilt.BExec 5095 | cs.cs_name 5096 | (fun () fn -> 5097 | install_file 5098 | ~tgt_fn:(cs.cs_name ^ ext_program ()) 5099 | fn 5100 | bindir) 5101 | (); 5102 | BaseBuilt.fold 5103 | BaseBuilt.BExecLib 5104 | cs.cs_name 5105 | (fun () fn -> 5106 | install_file 5107 | fn 5108 | exec_libdir) 5109 | (); 5110 | install_data 5111 | bs.bs_path 5112 | bs.bs_data_files 5113 | (Filename.concat 5114 | (datarootdir ()) 5115 | pkg.name) 5116 | end 5117 | in 5118 | List.iter 5119 | (function 5120 | | Executable (cs, bs, exec)-> 5121 | install_exec (cs, bs, exec) 5122 | | _ -> 5123 | ()) 5124 | pkg.sections 5125 | in 5126 | 5127 | let install_docs pkg = 5128 | let install_doc data = 5129 | let (cs, doc) = 5130 | !doc_hook data 5131 | in 5132 | if var_choose doc.doc_install && 5133 | BaseBuilt.is_built BaseBuilt.BDoc cs.cs_name then 5134 | begin 5135 | let tgt_dir = 5136 | OASISHostPath.of_unix (var_expand doc.doc_install_dir) 5137 | in 5138 | BaseBuilt.fold 5139 | BaseBuilt.BDoc 5140 | cs.cs_name 5141 | (fun () fn -> 5142 | install_file 5143 | fn 5144 | (fun () -> tgt_dir)) 5145 | (); 5146 | install_data 5147 | Filename.current_dir_name 5148 | doc.doc_data_files 5149 | doc.doc_install_dir 5150 | end 5151 | in 5152 | List.iter 5153 | (function 5154 | | Doc (cs, doc) -> 5155 | install_doc (cs, doc) 5156 | | _ -> 5157 | ()) 5158 | pkg.sections 5159 | in 5160 | 5161 | install_libs pkg; 5162 | install_execs pkg; 5163 | install_docs pkg 5164 | 5165 | (* Uninstall already installed data *) 5166 | let uninstall _ argv = 5167 | List.iter 5168 | (fun (ev, data) -> 5169 | if ev = install_file_ev then 5170 | begin 5171 | if OASISFileUtil.file_exists_case data then 5172 | begin 5173 | info 5174 | (f_ "Removing file '%s'") 5175 | data; 5176 | Sys.remove data 5177 | end 5178 | else 5179 | begin 5180 | warning 5181 | (f_ "File '%s' doesn't exist anymore") 5182 | data 5183 | end 5184 | end 5185 | else if ev = install_dir_ev then 5186 | begin 5187 | if Sys.file_exists data && Sys.is_directory data then 5188 | begin 5189 | if Sys.readdir data = [||] then 5190 | begin 5191 | info 5192 | (f_ "Removing directory '%s'") 5193 | data; 5194 | OASISFileUtil.rmdir ~ctxt:!BaseContext.default data 5195 | end 5196 | else 5197 | begin 5198 | warning 5199 | (f_ "Directory '%s' is not empty (%s)") 5200 | data 5201 | (String.concat 5202 | ", " 5203 | (Array.to_list 5204 | (Sys.readdir data))) 5205 | end 5206 | end 5207 | else 5208 | begin 5209 | warning 5210 | (f_ "Directory '%s' doesn't exist anymore") 5211 | data 5212 | end 5213 | end 5214 | else if ev = install_findlib_ev then 5215 | begin 5216 | info (f_ "Removing findlib library '%s'") data; 5217 | OASISExec.run ~ctxt:!BaseContext.default 5218 | (ocamlfind ()) ["remove"; data] 5219 | end 5220 | else 5221 | failwithf (f_ "Unknown log event '%s'") ev; 5222 | BaseLog.unregister ev data) 5223 | (* We process event in reverse order *) 5224 | (List.rev 5225 | (BaseLog.filter 5226 | [install_file_ev; 5227 | install_dir_ev; 5228 | install_findlib_ev;])) 5229 | 5230 | end 5231 | 5232 | 5233 | # 5233 "setup.ml" 5234 | module OCamlbuildCommon = struct 5235 | (* # 21 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *) 5236 | 5237 | (** Functions common to OCamlbuild build and doc plugin 5238 | *) 5239 | 5240 | open OASISGettext 5241 | open BaseEnv 5242 | open BaseStandardVar 5243 | 5244 | let ocamlbuild_clean_ev = 5245 | "ocamlbuild-clean" 5246 | 5247 | let ocamlbuildflags = 5248 | var_define 5249 | ~short_desc:(fun () -> "OCamlbuild additional flags") 5250 | "ocamlbuildflags" 5251 | (fun () -> "") 5252 | 5253 | (** Fix special arguments depending on environment *) 5254 | let fix_args args extra_argv = 5255 | List.flatten 5256 | [ 5257 | if (os_type ()) = "Win32" then 5258 | [ 5259 | "-classic-display"; 5260 | "-no-log"; 5261 | "-no-links"; 5262 | "-install-lib-dir"; 5263 | (Filename.concat (standard_library ()) "ocamlbuild") 5264 | ] 5265 | else 5266 | []; 5267 | 5268 | if not (bool_of_string (is_native ())) || (os_type ()) = "Win32" then 5269 | [ 5270 | "-byte-plugin" 5271 | ] 5272 | else 5273 | []; 5274 | args; 5275 | 5276 | if bool_of_string (debug ()) then 5277 | ["-tag"; "debug"] 5278 | else 5279 | []; 5280 | 5281 | if bool_of_string (profile ()) then 5282 | ["-tag"; "profile"] 5283 | else 5284 | []; 5285 | 5286 | OASISString.nsplit (ocamlbuildflags ()) ' '; 5287 | 5288 | Array.to_list extra_argv; 5289 | ] 5290 | 5291 | (** Run 'ocamlbuild -clean' if not already done *) 5292 | let run_clean extra_argv = 5293 | let extra_cli = 5294 | String.concat " " (Array.to_list extra_argv) 5295 | in 5296 | (* Run if never called with these args *) 5297 | if not (BaseLog.exists ocamlbuild_clean_ev extra_cli) then 5298 | begin 5299 | OASISExec.run ~ctxt:!BaseContext.default 5300 | (ocamlbuild ()) (fix_args ["-clean"] extra_argv); 5301 | BaseLog.register ocamlbuild_clean_ev extra_cli; 5302 | at_exit 5303 | (fun () -> 5304 | try 5305 | BaseLog.unregister ocamlbuild_clean_ev extra_cli 5306 | with _ -> 5307 | ()) 5308 | end 5309 | 5310 | (** Run ocamlbuild, unregister all clean events *) 5311 | let run_ocamlbuild args extra_argv = 5312 | (* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html 5313 | *) 5314 | OASISExec.run ~ctxt:!BaseContext.default 5315 | (ocamlbuild ()) (fix_args args extra_argv); 5316 | (* Remove any clean event, we must run it again *) 5317 | List.iter 5318 | (fun (e, d) -> BaseLog.unregister e d) 5319 | (BaseLog.filter [ocamlbuild_clean_ev]) 5320 | 5321 | (** Determine real build directory *) 5322 | let build_dir extra_argv = 5323 | let rec search_args dir = 5324 | function 5325 | | "-build-dir" :: dir :: tl -> 5326 | search_args dir tl 5327 | | _ :: tl -> 5328 | search_args dir tl 5329 | | [] -> 5330 | dir 5331 | in 5332 | search_args "_build" (fix_args [] extra_argv) 5333 | 5334 | end 5335 | 5336 | module OCamlbuildPlugin = struct 5337 | (* # 21 "src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *) 5338 | 5339 | (** Build using ocamlbuild 5340 | @author Sylvain Le Gall 5341 | *) 5342 | 5343 | open OASISTypes 5344 | open OASISGettext 5345 | open OASISUtils 5346 | open BaseEnv 5347 | open OCamlbuildCommon 5348 | open BaseStandardVar 5349 | open BaseMessage 5350 | 5351 | let cond_targets_hook = 5352 | ref (fun lst -> lst) 5353 | 5354 | let build pkg argv = 5355 | 5356 | (* Return the filename in build directory *) 5357 | let in_build_dir fn = 5358 | Filename.concat 5359 | (build_dir argv) 5360 | fn 5361 | in 5362 | 5363 | (* Return the unix filename in host build directory *) 5364 | let in_build_dir_of_unix fn = 5365 | in_build_dir (OASISHostPath.of_unix fn) 5366 | in 5367 | 5368 | let cond_targets = 5369 | List.fold_left 5370 | (fun acc -> 5371 | function 5372 | | Library (cs, bs, lib) when var_choose bs.bs_build -> 5373 | begin 5374 | let evs, unix_files = 5375 | BaseBuilt.of_library 5376 | in_build_dir_of_unix 5377 | (cs, bs, lib) 5378 | in 5379 | 5380 | let ends_with nd fn = 5381 | let nd_len = 5382 | String.length nd 5383 | in 5384 | (String.length fn >= nd_len) 5385 | && 5386 | (String.sub 5387 | fn 5388 | (String.length fn - nd_len) 5389 | nd_len) = nd 5390 | in 5391 | 5392 | let tgts = 5393 | List.flatten 5394 | (List.filter 5395 | (fun l -> l <> []) 5396 | (List.map 5397 | (List.filter 5398 | (fun fn -> 5399 | ends_with ".cma" fn 5400 | || ends_with ".cmxs" fn 5401 | || ends_with ".cmxa" fn 5402 | || ends_with (ext_lib ()) fn 5403 | || ends_with (ext_dll ()) fn)) 5404 | unix_files)) 5405 | in 5406 | 5407 | match tgts with 5408 | | _ :: _ -> 5409 | (evs, tgts) :: acc 5410 | | [] -> 5411 | failwithf 5412 | (f_ "No possible ocamlbuild targets for library %s") 5413 | cs.cs_name 5414 | end 5415 | 5416 | | Executable (cs, bs, exec) when var_choose bs.bs_build -> 5417 | begin 5418 | let evs, unix_exec_is, unix_dll_opt = 5419 | BaseBuilt.of_executable 5420 | in_build_dir_of_unix 5421 | (cs, bs, exec) 5422 | in 5423 | 5424 | let target ext = 5425 | let unix_tgt = 5426 | (OASISUnixPath.concat 5427 | bs.bs_path 5428 | (OASISUnixPath.chop_extension 5429 | exec.exec_main_is))^ext 5430 | in 5431 | let evs = 5432 | (* Fix evs, we want to use the unix_tgt, without copying *) 5433 | List.map 5434 | (function 5435 | | BaseBuilt.BExec, nm, lst when nm = cs.cs_name -> 5436 | BaseBuilt.BExec, nm, [[in_build_dir_of_unix unix_tgt]] 5437 | | ev -> 5438 | ev) 5439 | evs 5440 | in 5441 | evs, [unix_tgt] 5442 | in 5443 | 5444 | (* Add executable *) 5445 | let acc = 5446 | match bs.bs_compiled_object with 5447 | | Native -> 5448 | (target ".native") :: acc 5449 | | Best when bool_of_string (is_native ()) -> 5450 | (target ".native") :: acc 5451 | | Byte 5452 | | Best -> 5453 | (target ".byte") :: acc 5454 | in 5455 | acc 5456 | end 5457 | 5458 | | Library _ | Executable _ | Test _ 5459 | | SrcRepo _ | Flag _ | Doc _ -> 5460 | acc) 5461 | [] 5462 | (* Keep the pkg.sections ordered *) 5463 | (List.rev pkg.sections); 5464 | in 5465 | 5466 | (* Check and register built files *) 5467 | let check_and_register (bt, bnm, lst) = 5468 | List.iter 5469 | (fun fns -> 5470 | if not (List.exists OASISFileUtil.file_exists_case fns) then 5471 | failwithf 5472 | (f_ "No one of expected built files %s exists") 5473 | (String.concat (s_ ", ") (List.map (Printf.sprintf "'%s'") fns))) 5474 | lst; 5475 | (BaseBuilt.register bt bnm lst) 5476 | in 5477 | 5478 | let cond_targets = 5479 | (* Run the hook *) 5480 | !cond_targets_hook cond_targets 5481 | in 5482 | 5483 | (* Run a list of target... *) 5484 | run_ocamlbuild 5485 | (List.flatten 5486 | (List.map snd cond_targets)) 5487 | argv; 5488 | (* ... and register events *) 5489 | List.iter 5490 | check_and_register 5491 | (List.flatten (List.map fst cond_targets)) 5492 | 5493 | 5494 | let clean pkg extra_args = 5495 | run_clean extra_args; 5496 | List.iter 5497 | (function 5498 | | Library (cs, _, _) -> 5499 | BaseBuilt.unregister BaseBuilt.BLib cs.cs_name 5500 | | Executable (cs, _, _) -> 5501 | BaseBuilt.unregister BaseBuilt.BExec cs.cs_name; 5502 | BaseBuilt.unregister BaseBuilt.BExecLib cs.cs_name 5503 | | _ -> 5504 | ()) 5505 | pkg.sections 5506 | 5507 | end 5508 | 5509 | module OCamlbuildDocPlugin = struct 5510 | (* # 21 "src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *) 5511 | 5512 | (* Create documentation using ocamlbuild .odocl files 5513 | @author Sylvain Le Gall 5514 | *) 5515 | 5516 | open OASISTypes 5517 | open OASISGettext 5518 | open OASISMessage 5519 | open OCamlbuildCommon 5520 | open BaseStandardVar 5521 | 5522 | 5523 | 5524 | let doc_build path pkg (cs, doc) argv = 5525 | let index_html = 5526 | OASISUnixPath.make 5527 | [ 5528 | path; 5529 | cs.cs_name^".docdir"; 5530 | "index.html"; 5531 | ] 5532 | in 5533 | let tgt_dir = 5534 | OASISHostPath.make 5535 | [ 5536 | build_dir argv; 5537 | OASISHostPath.of_unix path; 5538 | cs.cs_name^".docdir"; 5539 | ] 5540 | in 5541 | run_ocamlbuild [index_html] argv; 5542 | List.iter 5543 | (fun glb -> 5544 | BaseBuilt.register 5545 | BaseBuilt.BDoc 5546 | cs.cs_name 5547 | [OASISFileUtil.glob ~ctxt:!BaseContext.default 5548 | (Filename.concat tgt_dir glb)]) 5549 | ["*.html"; "*.css"] 5550 | 5551 | let doc_clean t pkg (cs, doc) argv = 5552 | run_clean argv; 5553 | BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name 5554 | 5555 | end 5556 | 5557 | 5558 | # 5558 "setup.ml" 5559 | open OASISTypes;; 5560 | 5561 | let setup_t = 5562 | { 5563 | BaseSetup.configure = InternalConfigurePlugin.configure; 5564 | build = OCamlbuildPlugin.build; 5565 | test = []; 5566 | doc = []; 5567 | install = InternalInstallPlugin.install; 5568 | uninstall = InternalInstallPlugin.uninstall; 5569 | clean = [OCamlbuildPlugin.clean]; 5570 | clean_test = []; 5571 | clean_doc = []; 5572 | distclean = []; 5573 | distclean_test = []; 5574 | distclean_doc = []; 5575 | package = 5576 | { 5577 | oasis_version = "0.2"; 5578 | ocaml_version = None; 5579 | findlib_version = None; 5580 | name = "ocaml-quickcheck"; 5581 | version = "0.0.3"; 5582 | license = 5583 | OASISLicense.DEP5License 5584 | (OASISLicense.DEP5Unit 5585 | { 5586 | OASISLicense.license = "MIT"; 5587 | excption = None; 5588 | version = OASISLicense.NoVersion; 5589 | }); 5590 | license_file = Some "LICENSE"; 5591 | copyrights = []; 5592 | maintainers = []; 5593 | authors = ["Alan Falloon"; "Roma Sokolov"]; 5594 | homepage = None; 5595 | synopsis = 5596 | "Ocaml port of haskell QuickCheck -- probabilistic testing"; 5597 | description = None; 5598 | categories = []; 5599 | conf_type = (`Configure, "internal", Some "0.3"); 5600 | conf_custom = 5601 | { 5602 | pre_command = [(OASISExpr.EBool true, None)]; 5603 | post_command = [(OASISExpr.EBool true, None)]; 5604 | }; 5605 | build_type = (`Build, "ocamlbuild", Some "0.3"); 5606 | build_custom = 5607 | { 5608 | pre_command = [(OASISExpr.EBool true, None)]; 5609 | post_command = [(OASISExpr.EBool true, None)]; 5610 | }; 5611 | install_type = (`Install, "internal", Some "0.3"); 5612 | install_custom = 5613 | { 5614 | pre_command = [(OASISExpr.EBool true, None)]; 5615 | post_command = [(OASISExpr.EBool true, None)]; 5616 | }; 5617 | uninstall_custom = 5618 | { 5619 | pre_command = [(OASISExpr.EBool true, None)]; 5620 | post_command = [(OASISExpr.EBool true, None)]; 5621 | }; 5622 | clean_custom = 5623 | { 5624 | pre_command = [(OASISExpr.EBool true, None)]; 5625 | post_command = [(OASISExpr.EBool true, None)]; 5626 | }; 5627 | distclean_custom = 5628 | { 5629 | pre_command = [(OASISExpr.EBool true, None)]; 5630 | post_command = [(OASISExpr.EBool true, None)]; 5631 | }; 5632 | files_ab = []; 5633 | sections = 5634 | [ 5635 | Library 5636 | ({ 5637 | cs_name = "quickcheck"; 5638 | cs_data = PropList.Data.create (); 5639 | cs_plugin_data = []; 5640 | }, 5641 | { 5642 | bs_build = [(OASISExpr.EBool true, true)]; 5643 | bs_install = [(OASISExpr.EBool true, true)]; 5644 | bs_path = "src"; 5645 | bs_compiled_object = Best; 5646 | bs_build_depends = [FindlibPackage ("optcomp", None)]; 5647 | bs_build_tools = [ExternalTool "ocamlbuild"]; 5648 | bs_c_sources = []; 5649 | bs_data_files = []; 5650 | bs_ccopt = [(OASISExpr.EBool true, [])]; 5651 | bs_cclib = [(OASISExpr.EBool true, [])]; 5652 | bs_dlllib = [(OASISExpr.EBool true, [])]; 5653 | bs_dllpath = [(OASISExpr.EBool true, [])]; 5654 | bs_byteopt = 5655 | [(OASISExpr.EBool true, ["-w"; "@a"; "-g"])]; 5656 | bs_nativeopt = 5657 | [(OASISExpr.EBool true, ["-w"; "@a"; "-g"])]; 5658 | }, 5659 | { 5660 | lib_modules = 5661 | ["QuickCheck"; "QuickCheck_gen"; "QuickCheck_util"]; 5662 | lib_pack = false; 5663 | lib_internal_modules = []; 5664 | lib_findlib_parent = None; 5665 | lib_findlib_name = None; 5666 | lib_findlib_containers = []; 5667 | }); 5668 | Executable 5669 | ({ 5670 | cs_name = "test"; 5671 | cs_data = PropList.Data.create (); 5672 | cs_plugin_data = []; 5673 | }, 5674 | { 5675 | bs_build = [(OASISExpr.EBool true, true)]; 5676 | bs_install = [(OASISExpr.EBool true, false)]; 5677 | bs_path = "tests/"; 5678 | bs_compiled_object = Best; 5679 | bs_build_depends = 5680 | [ 5681 | FindlibPackage ("optcomp", None); 5682 | InternalLibrary "quickcheck" 5683 | ]; 5684 | bs_build_tools = [ExternalTool "ocamlbuild"]; 5685 | bs_c_sources = []; 5686 | bs_data_files = []; 5687 | bs_ccopt = [(OASISExpr.EBool true, [])]; 5688 | bs_cclib = [(OASISExpr.EBool true, [])]; 5689 | bs_dlllib = [(OASISExpr.EBool true, [])]; 5690 | bs_dllpath = [(OASISExpr.EBool true, [])]; 5691 | bs_byteopt = [(OASISExpr.EBool true, [])]; 5692 | bs_nativeopt = [(OASISExpr.EBool true, [])]; 5693 | }, 5694 | {exec_custom = false; exec_main_is = "test.ml"; }); 5695 | SrcRepo 5696 | ({ 5697 | cs_name = "github"; 5698 | cs_data = PropList.Data.create (); 5699 | cs_plugin_data = []; 5700 | }, 5701 | { 5702 | src_repo_type = Git; 5703 | src_repo_location = 5704 | "git://github.com/camlunity/ocaml-quickcheck.git"; 5705 | src_repo_browser = 5706 | Some "https://github.com/camlunity/ocaml-quickcheck"; 5707 | src_repo_module = None; 5708 | src_repo_branch = None; 5709 | src_repo_tag = None; 5710 | src_repo_subdir = None; 5711 | }) 5712 | ]; 5713 | plugins = 5714 | [ 5715 | (`Extra, "DevFiles", Some "0.2"); 5716 | (`Extra, "META", Some "0.2"); 5717 | (`Extra, "StdFiles", Some "0.2") 5718 | ]; 5719 | schema_data = PropList.Data.create (); 5720 | plugin_data = []; 5721 | }; 5722 | oasis_fn = Some "_oasis"; 5723 | oasis_version = "0.3.0"; 5724 | oasis_digest = Some "\004\002\187\160\194\142r\145'\r+d\027\017\241\166"; 5725 | oasis_exec = None; 5726 | oasis_setup_args = []; 5727 | setup_update = false; 5728 | };; 5729 | 5730 | let setup () = BaseSetup.setup setup_t;; 5731 | 5732 | # 5733 "setup.ml" 5733 | (* OASIS_STOP *) 5734 | let () = setup ();; 5735 | --------------------------------------------------------------------------------