├── lib_test ├── data.txt └── test.ml ├── .gitignore ├── README.md ├── lib ├── META ├── safeStringBuffer.mli └── safeStringBuffer.ml ├── configure ├── opam ├── _oasis ├── Makefile ├── _tags ├── LICENSE └── myocamlbuild.ml /lib_test/data.txt: -------------------------------------------------------------------------------- 1 | abc 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | setup.data 2 | setup.log 3 | *~ 4 | _build 5 | *.mldylib 6 | *.mllib 7 | *.native 8 | *.byte 9 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | A buffer implementation optimized for immutable strings. 2 | 3 | The interface is (almost) identical to the [Buffer][buffer] module in the 4 | standard library, but this module is typically faster and has significantly 5 | lower memory usage. 6 | 7 | [buffer]: http://caml.inria.fr/pub/docs/manual-ocaml/libref/Buffer.html 8 | -------------------------------------------------------------------------------- /lib/META: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: cc0313c83836f956c422c616c22d7da7) 3 | version = "0.1.0" 4 | description = "Rope-based buffer implementation" 5 | requires = "bytes" 6 | archive(byte) = "ropebuffer.cma" 7 | archive(byte, plugin) = "ropebuffer.cma" 8 | archive(native) = "ropebuffer.cmxa" 9 | archive(native, plugin) = "ropebuffer.cmxs" 10 | exists_if = "ropebuffer.cma" 11 | # OASIS_STOP 12 | 13 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # OASIS_START 4 | # DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499) 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 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.3" 2 | name: "safe-string-buffer" 3 | version: "dev" 4 | maintainer: "Jeremy Yallop " 5 | authors: "Jeremy Yallop " 6 | homepage: "https://github.com/yallop/ocaml-safe-string-buffer" 7 | bug-reports: "https://github.com/yallop/ocaml-safe-string-buffer/issues" 8 | dev-repo: "https://github.com/yallop/ocaml-safe-string-buffer.git" 9 | license: "MIT" 10 | build: [ 11 | ["oasis" "setup"] 12 | [make] 13 | ] 14 | install: [make "install"] 15 | remove: ["ocamlfind" "remove" "safe-string-buffer"] 16 | depends: [ 17 | "ocamlfind" {build} 18 | ] 19 | available: [ ocaml-version >= "4.02.0" ] 20 | -------------------------------------------------------------------------------- /_oasis: -------------------------------------------------------------------------------- 1 | OASISFormat: 0.4 2 | Name: safe-string-buffer 3 | Version: 0.1.0 4 | Synopsis: Buffer implementation optimized using -safe-string. 5 | Authors: Jeremy Yallop 6 | License: MIT 7 | Plugins: META (0.3), DevFiles (0.3) 8 | BuildTools: ocamlbuild 9 | 10 | Library safe_string_buffer 11 | Path: lib/ 12 | Findlibname: safe-string-buffer 13 | Modules: SafeStringBuffer 14 | BuildDepends: bytes 15 | 16 | Executable test 17 | Path: lib_test/ 18 | MainIs: test.ml 19 | Build$: flag(tests) 20 | CompiledObject: best 21 | Install: false 22 | BuildDepends: safe-string-buffer,oUnit 23 | 24 | Test test_safe_string_buffer 25 | Run$: flag(tests) 26 | Command: $test 27 | WorkingDirectory: lib_test 28 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954) 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 | configure: 37 | $(SETUP) -configure $(CONFIGUREFLAGS) 38 | 39 | .PHONY: build doc test all install uninstall reinstall clean distclean configure 40 | 41 | # OASIS_STOP 42 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: c8ffb9fc5c7657e289053980371f3b67) 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 | true: annot, bin_annot 7 | <**/.svn>: -traverse 8 | <**/.svn>: not_hygienic 9 | ".bzr": -traverse 10 | ".bzr": not_hygienic 11 | ".hg": -traverse 12 | ".hg": not_hygienic 13 | ".git": -traverse 14 | ".git": not_hygienic 15 | "_darcs": -traverse 16 | "_darcs": not_hygienic 17 | # Library safe_string_buffer 18 | "lib/safe_string_buffer.cmxs": use_safe_string_buffer 19 | : pkg_bytes 20 | # Executable test 21 | : pkg_bytes 22 | : pkg_oUnit 23 | : use_safe_string_buffer 24 | : pkg_bytes 25 | : pkg_oUnit 26 | : use_safe_string_buffer 27 | # OASIS_STOP 28 | : safe_string 29 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015-2016 Jeremy Yallop 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 | -------------------------------------------------------------------------------- /lib/safeStringBuffer.mli: -------------------------------------------------------------------------------- 1 | (** A buffer implementation optimized for immutable strings. 2 | * 3 | * The interface is (almost) identical to the Buffer module in the 4 | * standard library, but this module is typically faster and has 5 | * significantly lower memory usage. 6 | *) 7 | 8 | type t 9 | (** The type of buffers *) 10 | 11 | val create : int -> t 12 | (** [create n] creates an initially-empty buffer. 13 | 14 | The argument [n] is ignored; it's only there for compatibility with 15 | {!Buffer.} 16 | 17 | O(1) time, allocates a couple of words. *) 18 | 19 | val length : t -> int 20 | (** [length buf] returns the number of characters currently contained 21 | in the buffer [buf]. 22 | 23 | O(1) time, does not allocate. *) 24 | 25 | val reset : t -> unit 26 | (** [reset buf] empties the buffer [buf], releasing references to its 27 | internal storage. 28 | 29 | O(1) time, does not allocate. *) 30 | 31 | val clear : t -> unit 32 | (** [clear] is an alias for [reset]. *) 33 | 34 | val add_char : t -> char -> unit 35 | (** [add_char buf c] appends the char [c] to [buf]. 36 | 37 | O(1) time, allocates a couple of words. *) 38 | 39 | val add_string : t -> string -> unit 40 | (** [add_string buf s] appends the string [s] to [buf] 41 | 42 | O(1) time, allocates a couple of words. *) 43 | 44 | val add_bytes : t -> bytes -> unit 45 | (** [add_bytes buf s] appends the string [s] to [buf] 46 | 47 | O(1) time, allocates a couple of words and a copy of [b]. *) 48 | 49 | val add_substring : t -> string -> int -> int -> unit 50 | (** [add_substring buf s offset len] appends the substring 51 | [String.sub s offset len] to [buf]. 52 | 53 | O(1) time, allocates a couple of words and a copy of [len] characters from 54 | [s]. *) 55 | 56 | val add_subbytes : t -> bytes -> int -> int -> unit 57 | (** [add_substring buf s offset len] appends the subsequence 58 | [Bytes.sub s offset len] to [buf]. 59 | 60 | O(1) time, allocates a couple of words and a copy of [len] characters from 61 | [b]. *) 62 | 63 | val add_buffer : t -> Buffer.t -> unit 64 | (** [add_buffer buf b] appends the contents of the buffer [b] to [buf]. 65 | 66 | O(1) time, allocates a couple of words and a copy of [Buffer.length buf] 67 | characters from [b]. *) 68 | 69 | val add_safe_string_buffer : t -> t -> unit 70 | (** [add_safe_string_buffer buf b] appends the contents of the buffer [b] to 71 | [buf]. 72 | 73 | O(n) time in the number of elements (not characters) in [v], allocates a 74 | couple of words for each element in [v]. *) 75 | 76 | val add_channel : t -> in_channel -> int -> unit 77 | (** [add_channel buf in_channel n] reads up to [n] characters from 78 | [in_channel] and appends them to [buf]. *) 79 | 80 | val add_substitute : t -> (string -> string) -> string -> unit 81 | (** [add_substitute] behaves like {!Buffer.add_substitute}. *) 82 | 83 | val nth : t -> int -> char 84 | (** [nth buf n] returns the [n]th character of [buf]. 85 | 86 | O(n) time in the number of elements (not characters) in [buf], does not 87 | allocate. *) 88 | 89 | val blit : t -> int -> bytes -> int -> int -> unit 90 | (** [blit buf src_offset bytes dst_offset len] copies [len] characters from 91 | [buf], starting at [src_offset], into [bytes], starting at [dst_offset]. 92 | 93 | O(n) time in the number of elements (not characters) in [buf], does not 94 | allocate. *) 95 | 96 | val sub : t -> int -> int -> string 97 | (** [sub buf offset len] extracts the substring of [buf] between [offset] and 98 | [offset + len]. 99 | 100 | O(n) time in the number of elements (not characters) in [buf], allocates a 101 | string of length [n]. *) 102 | 103 | val output_buffer : out_channel -> t -> unit 104 | (** [outbut_buffer out_channel buf] writes the contents of [buf] on the 105 | channel [out_channel]. *) 106 | 107 | val contents : t -> string 108 | (** [contents buf] returns the contents of [buf] as a string. *) 109 | 110 | val to_bytes : t -> bytes 111 | (** [to_bytes buf] returns the contents of [buf] as a bytes sequence. *) 112 | 113 | val bprintf : t -> ('a, unit, string, unit) format4 -> 'a 114 | (** [bprintf] behaves like {!Printf.bprintf}. *) 115 | 116 | val formatter_of_safe_string_buffer : t -> Format.formatter 117 | (** [formatter_of_safe_string_buffer] behaves like 118 | {!Format.formatter_of_buffer}. *) 119 | -------------------------------------------------------------------------------- /lib/safeStringBuffer.ml: -------------------------------------------------------------------------------- 1 | module Check_safe_string_used = 2 | struct 3 | (* The SafeStringBuffer module must be compiled with -safe-string, since it 4 | assumes that strings passed in are not subsequently modified elsewhere. 5 | The Check_safe_string_used module checks statically that -safe-string is 6 | in use. *) 7 | type _ safe_string_check = 8 | (* The index of Anything can be refined to any type *) 9 | Anything : _ safe_string_check 10 | (* The index of Is_sting can only be refined to type string *) 11 | | Is_string : string safe_string_check 12 | 13 | (* Check that the -safe-string option is used. Iff -safe-string is 14 | enabled then bytes and string are incompatible types, and so the 15 | pattern matching is exhaustive. *) 16 | [@@@ocaml.warning "@8"] 17 | let check_safe_string_used : bytes safe_string_check -> unit = function 18 | Anything -> () 19 | end 20 | 21 | type t = 22 | { mutable elements: string list; 23 | (** A buffer is stored as a list of elements, kept in reverse order; that 24 | is, the first element on the list is the most recently added. *) 25 | mutable length: int; 26 | (** The length field is the sum of the length of the elements. *) } 27 | 28 | let create _ = { elements = []; length = 0 } 29 | 30 | let add_string buf s = 31 | begin 32 | buf.elements <- s :: buf.elements; 33 | buf.length <- buf.length + String.length s 34 | end 35 | 36 | let add_bytes buf b = add_string buf (Bytes.to_string b) 37 | 38 | let add_char buf c = add_string buf (String.make 1 c) 39 | 40 | let length { length } = length 41 | 42 | let add_subbytes buf b ofs len = 43 | if ofs < 0 || len < 0 || ofs + len > Bytes.length b 44 | then invalid_arg "add_subbytes" 45 | else add_string buf (Bytes.sub_string b ofs len) 46 | 47 | let add_substring buf s ofs len = 48 | if ofs < 0 || len < 0 || ofs + len > String.length s 49 | then invalid_arg "add_substring" 50 | else if ofs = 0 && len = String.length s then add_string buf s 51 | else add_string buf (String.sub s ofs len) 52 | 53 | let clear buf = 54 | begin 55 | buf.elements <- []; 56 | buf.length <- 0 57 | end 58 | 59 | let reset = clear 60 | 61 | let to_bytes {elements; length} = 62 | let b = Bytes.create length in 63 | let _ = List.fold_left 64 | (fun i s -> 65 | let l = String.length s in 66 | Bytes.blit_string s 0 b (i - l) l; 67 | i - l) 68 | length 69 | elements 70 | in 71 | b 72 | 73 | let contents = function 74 | { elements = [] } -> "" 75 | | { elements = [s] } -> s 76 | | buf -> Bytes.unsafe_to_string (to_bytes buf) 77 | 78 | let iter_elements f elements = 79 | List.fold_right (fun elem () -> ignore (f elem)) elements () 80 | 81 | let output_buffer outch { elements } = 82 | iter_elements (output_string outch) elements 83 | 84 | let add_safe_string_buffer l r = 85 | begin 86 | l.elements <- r.elements @ l.elements; 87 | l.length <- l.length + r.length 88 | end 89 | 90 | let add_buffer buf b = add_string buf (Buffer.contents b) 91 | 92 | let nth buf i = 93 | if i < 0 || i >= buf.length then invalid_arg "nth" else 94 | let rec loop length = function 95 | [] -> 96 | (* Invariant violated: the bounds check above should have 97 | caught this case *) 98 | assert false 99 | | s :: ss -> 100 | let slen = String.length s in 101 | let sslen = length - slen in 102 | if i >= sslen then s.[i - sslen] 103 | else loop sslen ss 104 | in loop buf.length buf.elements 105 | 106 | let rec blit_loop elements elements_len srcofs dst dstofs length = 107 | match elements with 108 | [] -> () 109 | | last :: firsts -> 110 | let last_len = String.length last in 111 | let first_len = elements_len - last_len in 112 | 113 | (* Case 1: the string to copy lies entirely within last *) 114 | if srcofs >= first_len then 115 | Bytes.blit_string last (srcofs - first_len) dst dstofs length 116 | 117 | (* Case 2: the string to copy lies entirely within firsts *) 118 | else if srcofs + length < first_len then 119 | blit_loop firsts first_len srcofs dst dstofs length 120 | 121 | (* Case 3: the string to copy lies partly within firsts and 122 | partly within last. *) 123 | else 124 | let nchars = srcofs + length - first_len in 125 | begin 126 | Bytes.blit_string last 0 dst (dstofs + length - nchars) nchars; 127 | blit_loop firsts first_len srcofs dst dstofs (length - nchars) 128 | end 129 | 130 | let blit buf srcofs dst dstofs length = 131 | if length < 0 || srcofs < 0 || srcofs > buf.length - length 132 | || dstofs < 0 || dstofs > (Bytes.length dst) - length 133 | then invalid_arg "blit" 134 | else blit_loop buf.elements buf.length srcofs dst dstofs length 135 | 136 | let sub buf ofs length = 137 | if length < 0 || ofs < 0 || ofs > buf.length - length 138 | then invalid_arg "sub" 139 | else 140 | let b = Bytes.create length in 141 | begin 142 | blit buf ofs b 0 length; 143 | Bytes.unsafe_to_string b 144 | end 145 | 146 | let bprintf buf = Printf.kprintf (add_string buf) 147 | 148 | let formatter_of_safe_string_buffer buf = 149 | Format.make_formatter (add_substring buf) ignore 150 | 151 | let add_channel buf channel n = 152 | let b = Buffer.create 16 in 153 | match Buffer.add_channel b channel n with 154 | () -> add_buffer buf b 155 | | exception (End_of_file as e) -> 156 | begin 157 | add_buffer buf b; 158 | raise e 159 | end 160 | 161 | let add_substitute buf f s = 162 | let b = Buffer.create 16 in 163 | let () = Buffer.add_substitute b f s in 164 | add_buffer buf b 165 | -------------------------------------------------------------------------------- /lib_test/test.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let test_length _ = 4 | let buf = SafeStringBuffer.create 1 in begin 5 | assert_equal 0 (SafeStringBuffer.length buf); 6 | 7 | let () = SafeStringBuffer.add_string buf "four" in 8 | assert_equal 4 (SafeStringBuffer.length buf); 9 | 10 | let () = SafeStringBuffer.add_char buf 'a' in 11 | assert_equal 5 (SafeStringBuffer.length buf); 12 | end 13 | 14 | 15 | let test_create _ = 16 | let buf1 = SafeStringBuffer.create 1 17 | and buf2 = SafeStringBuffer.create 1 in begin 18 | assert_bool "create builds physically-distinct buffers" 19 | (buf1 != buf2); 20 | 21 | let () = SafeStringBuffer.add_string buf1 "x" in 22 | 23 | assert_equal "" (SafeStringBuffer.contents buf2); 24 | assert_equal "x" (SafeStringBuffer.contents buf1); 25 | end 26 | 27 | 28 | let test_add _ = 29 | let test_invalid_bounds ~msg name f = 30 | assert_raises ~msg (Invalid_argument name) f in 31 | let buf = SafeStringBuffer.create 1 in begin 32 | let () = SafeStringBuffer.add_char buf 'a' in 33 | assert_equal "a" (SafeStringBuffer.contents buf); 34 | 35 | let () = SafeStringBuffer.add_string buf "bcd" in 36 | assert_equal "abcd" (SafeStringBuffer.contents buf); 37 | 38 | 39 | let () = SafeStringBuffer.add_bytes buf (Bytes.of_string "efg") in 40 | assert_equal "abcdefg" (SafeStringBuffer.contents buf); 41 | 42 | let () = SafeStringBuffer.add_substring buf "abcdefghijklmno" 7 4 in 43 | assert_equal "abcdefghijk" (SafeStringBuffer.contents buf); 44 | 45 | let () = test_invalid_bounds "add_substring" 46 | ~msg:"negative offset" 47 | (fun () -> SafeStringBuffer.add_substring buf "abc" (-1) 1); in 48 | 49 | let () = test_invalid_bounds "add_substring" 50 | ~msg:"negative length" 51 | (fun () -> SafeStringBuffer.add_substring buf "abc" 1 (-1)); in 52 | 53 | let () = test_invalid_bounds "add_substring" 54 | ~msg:"length > length(string)" 55 | (fun () -> SafeStringBuffer.add_substring buf "abc" 0 4); in 56 | 57 | let () = test_invalid_bounds "add_substring" 58 | ~msg:"offset + length > length(string)" 59 | (fun () -> SafeStringBuffer.add_substring buf "abc" 1 3); in 60 | 61 | let () = SafeStringBuffer.add_subbytes buf (Bytes.of_string "abcdefghijklmno") 11 2 in 62 | assert_equal "abcdefghijklm" (SafeStringBuffer.contents buf); 63 | 64 | let () = test_invalid_bounds "add_subbytes" 65 | ~msg:"negative offset" 66 | (fun () -> SafeStringBuffer.add_subbytes buf (Bytes.of_string "abc") (-1) 1); in 67 | 68 | let () = test_invalid_bounds "add_subbytes" 69 | ~msg:"negative length" 70 | (fun () -> SafeStringBuffer.add_subbytes buf (Bytes.of_string "abc") 1 (-1)); in 71 | 72 | let () = test_invalid_bounds "add_subbytes" 73 | ~msg:"length > length(bytes)" 74 | (fun () -> SafeStringBuffer.add_subbytes buf (Bytes.of_string "abc") 0 4); in 75 | 76 | let () = test_invalid_bounds "add_subbytes" 77 | ~msg:"offset + length > length(bytes)" 78 | (fun () -> SafeStringBuffer.add_subbytes buf (Bytes.of_string "abc") 1 3); in 79 | 80 | let buf2 = Buffer.create 10 in 81 | let () = Buffer.add_string buf2 "nopq" in 82 | let () = SafeStringBuffer.add_buffer buf buf2 in 83 | assert_equal "abcdefghijklmnopq" (SafeStringBuffer.contents buf); 84 | 85 | let buf3 = SafeStringBuffer.create 1 in 86 | let () = SafeStringBuffer.add_string buf3 "rst" in 87 | let () = SafeStringBuffer.add_safe_string_buffer buf buf3 in 88 | assert_equal "abcdefghijklmnopqrst" (SafeStringBuffer.contents buf); 89 | 90 | (* test add_channel full read *) 91 | let buf = SafeStringBuffer.create 1 in 92 | let fd = open_in "data.txt" in 93 | let () = SafeStringBuffer.add_channel buf fd 4 in 94 | assert_equal "abc\n" (SafeStringBuffer.contents buf); 95 | 96 | (* test add_channel partial read *) 97 | let buf = SafeStringBuffer.create 1 in let fd = open_in "data.txt" in 98 | let () = SafeStringBuffer.add_channel buf fd 2 in 99 | assert_equal "ab" (SafeStringBuffer.contents buf); 100 | 101 | (* test add_channel short read. *) 102 | let buf = SafeStringBuffer.create 1 in let fd = open_in "data.txt" in 103 | let () = 104 | assert_raises End_of_file @@ fun () -> 105 | SafeStringBuffer.add_channel buf fd 6 106 | in 107 | (* This is currently broken due to a bug in the standard library: 108 | http://caml.inria.fr/mantis/view.php?id=7136 *) 109 | () 110 | (* assert_equal "abc\n" (SafeStringBuffer.contents buf) *) 111 | ; 112 | 113 | (* Simple tests for the success case only, since the behaviour of 114 | add_substitute is not currently very precisely specified. *) 115 | let buf = SafeStringBuffer.create 1 in 116 | let () = SafeStringBuffer.add_substitute buf (function "x" -> "y" | "abc" -> "def" | s -> s) 117 | "r$abc${x}s" in 118 | assert_equal "rdefys" 119 | (SafeStringBuffer.contents buf) 120 | end 121 | 122 | 123 | let test_clear _ = 124 | let buf = SafeStringBuffer.create 1 in 125 | let () = SafeStringBuffer.add_string buf "abc" in 126 | assert_equal "abc" (SafeStringBuffer.contents buf); 127 | let () = SafeStringBuffer.clear buf in 128 | assert_equal "" (SafeStringBuffer.contents buf) 129 | 130 | 131 | let test_reset _ = 132 | let buf = SafeStringBuffer.create 1 in 133 | let () = SafeStringBuffer.add_string buf "abc" in 134 | assert_equal "abc" (SafeStringBuffer.contents buf); 135 | let () = SafeStringBuffer.reset buf in 136 | assert_equal "" (SafeStringBuffer.contents buf) 137 | 138 | 139 | let test_formatter _ = 140 | let buf = SafeStringBuffer.create 1 in 141 | let fmt = SafeStringBuffer.formatter_of_safe_string_buffer buf in 142 | let () = Format.fprintf fmt "x%az@." (fun fmt -> Format.fprintf fmt "%d") 3 in 143 | assert_equal "x3z\n" (SafeStringBuffer.contents buf) 144 | 145 | 146 | let test_bprintf _ = 147 | let buf = SafeStringBuffer.create 1 in 148 | let () = SafeStringBuffer.bprintf buf "%d%s" 3 "four" in 149 | assert_equal "3four" (SafeStringBuffer.contents buf) 150 | 151 | 152 | let test_to_bytes _ = 153 | let buf = SafeStringBuffer.create 1 in 154 | let () = SafeStringBuffer.add_string buf "a" in 155 | let b1 = SafeStringBuffer.to_bytes buf in 156 | let b2 = SafeStringBuffer.to_bytes buf in begin 157 | assert_equal (Bytes.of_string "a") b1; 158 | assert_equal (Bytes.of_string "a") b2; 159 | assert_bool "to_bytes allocates fresh values" (b1 != b2) 160 | end 161 | 162 | 163 | let test_sub _ = 164 | let buf = SafeStringBuffer.create 1 in 165 | let () = List.iter (SafeStringBuffer.add_string buf) ["abc"; ""; "def"; "ghi"] in 166 | let s = SafeStringBuffer.contents buf in 167 | let slen = String.length s in 168 | begin 169 | for ofs = 0 to slen - 1 do 170 | for len = 0 to slen - ofs do 171 | assert_equal 172 | (SafeStringBuffer.sub buf ofs len) 173 | (String.sub s ofs len) 174 | done 175 | done 176 | end 177 | 178 | 179 | let test_sub_invalid_args _ = 180 | let buf = SafeStringBuffer.create 1 in 181 | let () = List.iter (SafeStringBuffer.add_string buf) ["abc"; ""; "def"; "ghi"] in 182 | let test_invalid_bounds ~msg ofs len = 183 | assert_raises ~msg (Invalid_argument "sub") @@ fun () -> 184 | SafeStringBuffer.sub buf ofs len 185 | in 186 | begin 187 | test_invalid_bounds (-1) 1 188 | ~msg:"Negative offset"; 189 | test_invalid_bounds 0 (-1) 190 | ~msg:"Negative length"; 191 | test_invalid_bounds 0 (String.length (SafeStringBuffer.contents buf) + 1) 192 | ~msg:"Length too large"; 193 | test_invalid_bounds 1 (String.length (SafeStringBuffer.contents buf)) 194 | ~msg:"Length too large (non-zero offset)"; 195 | end 196 | 197 | 198 | let test_nth _ = 199 | let buf = SafeStringBuffer.create 1 in begin 200 | SafeStringBuffer.add_string buf "abc"; 201 | assert_equal 'a' (SafeStringBuffer.nth buf 0); 202 | assert_equal 'b' (SafeStringBuffer.nth buf 1); 203 | assert_equal 'c' (SafeStringBuffer.nth buf 2); 204 | 205 | SafeStringBuffer.add_string buf "def"; 206 | assert_equal 'a' (SafeStringBuffer.nth buf 0); 207 | assert_equal 'b' (SafeStringBuffer.nth buf 1); 208 | assert_equal 'c' (SafeStringBuffer.nth buf 2); 209 | assert_equal 'd' (SafeStringBuffer.nth buf 3); 210 | assert_equal 'e' (SafeStringBuffer.nth buf 4); 211 | assert_equal 'f' (SafeStringBuffer.nth buf 5); 212 | end 213 | 214 | let test_nth_invalid_args _ = 215 | let buf = SafeStringBuffer.create 1 in let test_invalid_bounds ~msg i = 216 | assert_raises ~msg (Invalid_argument "nth") @@ fun () -> 217 | SafeStringBuffer.nth buf i 218 | in 219 | begin 220 | test_invalid_bounds 0 221 | ~msg:"accessing empty buffer"; 222 | 223 | SafeStringBuffer.add_string buf "abc"; 224 | 225 | test_invalid_bounds (-1) 226 | ~msg:"negative index"; 227 | 228 | test_invalid_bounds 3 229 | ~msg:"index out of range"; 230 | end 231 | 232 | 233 | let test_blit _ = 234 | let buf = SafeStringBuffer.create 1 in 235 | let () = SafeStringBuffer.add_string buf "abc" in 236 | begin 237 | let bytes = Bytes.make 3 '3' in 238 | let () = SafeStringBuffer.blit buf 0 bytes 0 3 in 239 | assert_equal (Bytes.of_string "abc") bytes; 240 | 241 | let bytes = Bytes.make 3 '3' in 242 | let () = SafeStringBuffer.blit buf 0 bytes 0 2 in 243 | assert_equal (Bytes.of_string "ab3") bytes; 244 | 245 | let bytes = Bytes.make 3 '3' in 246 | let () = SafeStringBuffer.blit buf 0 bytes 1 2 in 247 | assert_equal (Bytes.of_string "3ab") bytes; 248 | 249 | let bytes = Bytes.make 3 '3' in 250 | let () = SafeStringBuffer.blit buf 1 bytes 0 2 in 251 | assert_equal (Bytes.of_string "bc3") bytes; 252 | 253 | let bytes = Bytes.make 3 '3' in 254 | let () = SafeStringBuffer.blit buf 1 bytes 1 2 in 255 | assert_equal (Bytes.of_string "3bc") bytes; 256 | end 257 | 258 | 259 | let test_blit_invalid_args _ = 260 | let buf = SafeStringBuffer.create 1 in 261 | let () = SafeStringBuffer.add_string buf "abc" and smallbytes = Bytes.create 2 262 | and bigbytes = Bytes.create 10 in 263 | let test_invalid_bounds ~msg ~srcoff ~dst ~dstoff ~len : unit = 264 | assert_raises ~msg (Invalid_argument "blit") @@ fun () -> 265 | SafeStringBuffer.blit buf srcoff dst dstoff len 266 | in 267 | begin 268 | test_invalid_bounds 269 | ~srcoff:(-1) ~dstoff:0 ~len:1 270 | ~dst:smallbytes 271 | ~msg:"Negative source offset"; 272 | 273 | test_invalid_bounds 274 | ~srcoff:0 ~dstoff:0 ~len:4 275 | ~dst:bigbytes 276 | ~msg:"Source offset + len > length buf"; 277 | 278 | test_invalid_bounds 279 | ~srcoff:1 ~dstoff:0 ~len:(-1) 280 | ~dst:bigbytes 281 | ~msg:"Negative len"; 282 | 283 | test_invalid_bounds 284 | ~srcoff:0 ~dstoff:2 ~len:2 285 | ~dst:smallbytes 286 | ~msg:"Dst offset + len > length dst"; 287 | 288 | test_invalid_bounds 289 | ~srcoff:0 ~dstoff:3 ~len:0 290 | ~dst:smallbytes 291 | ~msg:"Dst offset > length dst"; 292 | end 293 | 294 | 295 | let suite = "SafeStringBuffer tests" >::: [ 296 | "length" 297 | >:: test_length; 298 | 299 | "create" 300 | >:: test_create; 301 | 302 | "add" 303 | >:: test_add; 304 | 305 | "clear" 306 | >:: test_clear; 307 | 308 | "reset" 309 | >:: test_reset; 310 | 311 | "formatter" 312 | >:: test_formatter; 313 | 314 | "bprintf" 315 | >:: test_bprintf; 316 | 317 | "to_bytes" 318 | >:: test_to_bytes; 319 | 320 | "sub" 321 | >:: test_sub; 322 | 323 | "sub: invalid arguments" 324 | >:: test_sub_invalid_args; 325 | 326 | "blit" 327 | >:: test_blit; 328 | 329 | "blit" 330 | >:: test_blit_invalid_args; 331 | 332 | "nth" 333 | >:: test_nth; 334 | 335 | "nth" 336 | >:: test_nth_invalid_args; 337 | ] 338 | 339 | let _ = 340 | run_test_tt_main suite 341 | -------------------------------------------------------------------------------- /myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | (* OASIS_START *) 2 | (* DO NOT EDIT (digest: 09de38828664178db948af9462a153ce) *) 3 | module OASISGettext = struct 4 | (* # 22 "src/oasis/OASISGettext.ml" *) 5 | 6 | 7 | let ns_ str = 8 | str 9 | 10 | 11 | let s_ str = 12 | str 13 | 14 | 15 | let f_ (str: ('a, 'b, 'c, 'd) format4) = 16 | str 17 | 18 | 19 | let fn_ fmt1 fmt2 n = 20 | if n = 1 then 21 | fmt1^^"" 22 | else 23 | fmt2^^"" 24 | 25 | 26 | let init = 27 | [] 28 | 29 | 30 | end 31 | 32 | module OASISExpr = struct 33 | (* # 22 "src/oasis/OASISExpr.ml" *) 34 | 35 | 36 | 37 | 38 | 39 | open OASISGettext 40 | 41 | 42 | type test = string 43 | 44 | 45 | type flag = string 46 | 47 | 48 | type t = 49 | | EBool of bool 50 | | ENot of t 51 | | EAnd of t * t 52 | | EOr of t * t 53 | | EFlag of flag 54 | | ETest of test * string 55 | 56 | 57 | 58 | type 'a choices = (t * 'a) list 59 | 60 | 61 | let eval var_get t = 62 | let rec eval' = 63 | function 64 | | EBool b -> 65 | b 66 | 67 | | ENot e -> 68 | not (eval' e) 69 | 70 | | EAnd (e1, e2) -> 71 | (eval' e1) && (eval' e2) 72 | 73 | | EOr (e1, e2) -> 74 | (eval' e1) || (eval' e2) 75 | 76 | | EFlag nm -> 77 | let v = 78 | var_get nm 79 | in 80 | assert(v = "true" || v = "false"); 81 | (v = "true") 82 | 83 | | ETest (nm, vl) -> 84 | let v = 85 | var_get nm 86 | in 87 | (v = vl) 88 | in 89 | eval' t 90 | 91 | 92 | let choose ?printer ?name var_get lst = 93 | let rec choose_aux = 94 | function 95 | | (cond, vl) :: tl -> 96 | if eval var_get cond then 97 | vl 98 | else 99 | choose_aux tl 100 | | [] -> 101 | let str_lst = 102 | if lst = [] then 103 | s_ "" 104 | else 105 | String.concat 106 | (s_ ", ") 107 | (List.map 108 | (fun (cond, vl) -> 109 | match printer with 110 | | Some p -> p vl 111 | | None -> s_ "") 112 | lst) 113 | in 114 | match name with 115 | | Some nm -> 116 | failwith 117 | (Printf.sprintf 118 | (f_ "No result for the choice list '%s': %s") 119 | nm str_lst) 120 | | None -> 121 | failwith 122 | (Printf.sprintf 123 | (f_ "No result for a choice list: %s") 124 | str_lst) 125 | in 126 | choose_aux (List.rev lst) 127 | 128 | 129 | end 130 | 131 | 132 | # 132 "myocamlbuild.ml" 133 | module BaseEnvLight = struct 134 | (* # 22 "src/base/BaseEnvLight.ml" *) 135 | 136 | 137 | module MapString = Map.Make(String) 138 | 139 | 140 | type t = string MapString.t 141 | 142 | 143 | let default_filename = 144 | Filename.concat 145 | (Sys.getcwd ()) 146 | "setup.data" 147 | 148 | 149 | let load ?(allow_empty=false) ?(filename=default_filename) () = 150 | if Sys.file_exists filename then 151 | begin 152 | let chn = 153 | open_in_bin filename 154 | in 155 | let st = 156 | Stream.of_channel chn 157 | in 158 | let line = 159 | ref 1 160 | in 161 | let st_line = 162 | Stream.from 163 | (fun _ -> 164 | try 165 | match Stream.next st with 166 | | '\n' -> incr line; Some '\n' 167 | | c -> Some c 168 | with Stream.Failure -> None) 169 | in 170 | let lexer = 171 | Genlex.make_lexer ["="] st_line 172 | in 173 | let rec read_file mp = 174 | match Stream.npeek 3 lexer with 175 | | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> 176 | Stream.junk lexer; 177 | Stream.junk lexer; 178 | Stream.junk lexer; 179 | read_file (MapString.add nm value mp) 180 | | [] -> 181 | mp 182 | | _ -> 183 | failwith 184 | (Printf.sprintf 185 | "Malformed data file '%s' line %d" 186 | filename !line) 187 | in 188 | let mp = 189 | read_file MapString.empty 190 | in 191 | close_in chn; 192 | mp 193 | end 194 | else if allow_empty then 195 | begin 196 | MapString.empty 197 | end 198 | else 199 | begin 200 | failwith 201 | (Printf.sprintf 202 | "Unable to load environment, the file '%s' doesn't exist." 203 | filename) 204 | end 205 | 206 | 207 | let rec var_expand str env = 208 | let buff = 209 | Buffer.create ((String.length str) * 2) 210 | in 211 | Buffer.add_substitute 212 | buff 213 | (fun var -> 214 | try 215 | var_expand (MapString.find var env) env 216 | with Not_found -> 217 | failwith 218 | (Printf.sprintf 219 | "No variable %s defined when trying to expand %S." 220 | var 221 | str)) 222 | str; 223 | Buffer.contents buff 224 | 225 | 226 | let var_get name env = 227 | var_expand (MapString.find name env) env 228 | 229 | 230 | let var_choose lst env = 231 | OASISExpr.choose 232 | (fun nm -> var_get nm env) 233 | lst 234 | end 235 | 236 | 237 | # 237 "myocamlbuild.ml" 238 | module MyOCamlbuildFindlib = struct 239 | (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) 240 | 241 | 242 | (** OCamlbuild extension, copied from 243 | * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild 244 | * by N. Pouillard and others 245 | * 246 | * Updated on 2009/02/28 247 | * 248 | * Modified by Sylvain Le Gall 249 | *) 250 | open Ocamlbuild_plugin 251 | 252 | type conf = 253 | { no_automatic_syntax: bool; 254 | } 255 | 256 | (* these functions are not really officially exported *) 257 | let run_and_read = 258 | Ocamlbuild_pack.My_unix.run_and_read 259 | 260 | 261 | let blank_sep_strings = 262 | Ocamlbuild_pack.Lexers.blank_sep_strings 263 | 264 | 265 | let exec_from_conf exec = 266 | let exec = 267 | let env_filename = Pathname.basename BaseEnvLight.default_filename in 268 | let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in 269 | try 270 | BaseEnvLight.var_get exec env 271 | with Not_found -> 272 | Printf.eprintf "W: Cannot get variable %s\n" exec; 273 | exec 274 | in 275 | let fix_win32 str = 276 | if Sys.os_type = "Win32" then begin 277 | let buff = Buffer.create (String.length str) in 278 | (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'. 279 | *) 280 | String.iter 281 | (fun c -> Buffer.add_char buff (if c = '\\' then '/' else c)) 282 | str; 283 | Buffer.contents buff 284 | end else begin 285 | str 286 | end 287 | in 288 | fix_win32 exec 289 | 290 | let split s ch = 291 | let buf = Buffer.create 13 in 292 | let x = ref [] in 293 | let flush () = 294 | x := (Buffer.contents buf) :: !x; 295 | Buffer.clear buf 296 | in 297 | String.iter 298 | (fun c -> 299 | if c = ch then 300 | flush () 301 | else 302 | Buffer.add_char buf c) 303 | s; 304 | flush (); 305 | List.rev !x 306 | 307 | 308 | let split_nl s = split s '\n' 309 | 310 | 311 | let before_space s = 312 | try 313 | String.before s (String.index s ' ') 314 | with Not_found -> s 315 | 316 | (* ocamlfind command *) 317 | let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x] 318 | 319 | (* This lists all supported packages. *) 320 | let find_packages () = 321 | List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list")) 322 | 323 | 324 | (* Mock to list available syntaxes. *) 325 | let find_syntaxes () = ["camlp4o"; "camlp4r"] 326 | 327 | 328 | let well_known_syntax = [ 329 | "camlp4.quotations.o"; 330 | "camlp4.quotations.r"; 331 | "camlp4.exceptiontracer"; 332 | "camlp4.extend"; 333 | "camlp4.foldgenerator"; 334 | "camlp4.listcomprehension"; 335 | "camlp4.locationstripper"; 336 | "camlp4.macro"; 337 | "camlp4.mapgenerator"; 338 | "camlp4.metagenerator"; 339 | "camlp4.profiler"; 340 | "camlp4.tracer" 341 | ] 342 | 343 | 344 | let dispatch conf = 345 | function 346 | | After_options -> 347 | (* By using Before_options one let command line options have an higher 348 | * priority on the contrary using After_options will guarantee to have 349 | * the higher priority override default commands by ocamlfind ones *) 350 | Options.ocamlc := ocamlfind & A"ocamlc"; 351 | Options.ocamlopt := ocamlfind & A"ocamlopt"; 352 | Options.ocamldep := ocamlfind & A"ocamldep"; 353 | Options.ocamldoc := ocamlfind & A"ocamldoc"; 354 | Options.ocamlmktop := ocamlfind & A"ocamlmktop"; 355 | Options.ocamlmklib := ocamlfind & A"ocamlmklib" 356 | 357 | | After_rules -> 358 | 359 | (* When one link an OCaml library/binary/package, one should use 360 | * -linkpkg *) 361 | flag ["ocaml"; "link"; "program"] & A"-linkpkg"; 362 | 363 | if not (conf.no_automatic_syntax) then begin 364 | (* For each ocamlfind package one inject the -package option when 365 | * compiling, computing dependencies, generating documentation and 366 | * linking. *) 367 | List.iter 368 | begin fun pkg -> 369 | let base_args = [A"-package"; A pkg] in 370 | (* TODO: consider how to really choose camlp4o or camlp4r. *) 371 | let syn_args = [A"-syntax"; A "camlp4o"] in 372 | let (args, pargs) = 373 | (* Heuristic to identify syntax extensions: whether they end in 374 | ".syntax"; some might not. 375 | *) 376 | if Filename.check_suffix pkg "syntax" || 377 | List.mem pkg well_known_syntax then 378 | (syn_args @ base_args, syn_args) 379 | else 380 | (base_args, []) 381 | in 382 | flag ["ocaml"; "compile"; "pkg_"^pkg] & S args; 383 | flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args; 384 | flag ["ocaml"; "doc"; "pkg_"^pkg] & S args; 385 | flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args; 386 | flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args; 387 | 388 | (* TODO: Check if this is allowed for OCaml < 3.12.1 *) 389 | flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs; 390 | flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs; 391 | flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs; 392 | flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs; 393 | end 394 | (find_packages ()); 395 | end; 396 | 397 | (* Like -package but for extensions syntax. Morover -syntax is useless 398 | * when linking. *) 399 | List.iter begin fun syntax -> 400 | flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 401 | flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 402 | flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 403 | flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & 404 | S[A"-syntax"; A syntax]; 405 | end (find_syntaxes ()); 406 | 407 | (* The default "thread" tag is not compatible with ocamlfind. 408 | * Indeed, the default rules add the "threads.cma" or "threads.cmxa" 409 | * options when using this tag. When using the "-linkpkg" option with 410 | * ocamlfind, this module will then be added twice on the command line. 411 | * 412 | * To solve this, one approach is to add the "-thread" option when using 413 | * the "threads" package using the previous plugin. 414 | *) 415 | flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]); 416 | flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]); 417 | flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]); 418 | flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]); 419 | flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]); 420 | flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]); 421 | flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]); 422 | flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]); 423 | 424 | | _ -> 425 | () 426 | end 427 | 428 | module MyOCamlbuildBase = struct 429 | (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) 430 | 431 | 432 | (** Base functions for writing myocamlbuild.ml 433 | @author Sylvain Le Gall 434 | *) 435 | 436 | 437 | 438 | 439 | 440 | open Ocamlbuild_plugin 441 | module OC = Ocamlbuild_pack.Ocaml_compiler 442 | 443 | 444 | type dir = string 445 | type file = string 446 | type name = string 447 | type tag = string 448 | 449 | 450 | (* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) 451 | 452 | 453 | type t = 454 | { 455 | lib_ocaml: (name * dir list * string list) list; 456 | lib_c: (name * dir * file list) list; 457 | flags: (tag list * (spec OASISExpr.choices)) list; 458 | (* Replace the 'dir: include' from _tags by a precise interdepends in 459 | * directory. 460 | *) 461 | includes: (dir * dir list) list; 462 | } 463 | 464 | 465 | let env_filename = 466 | Pathname.basename 467 | BaseEnvLight.default_filename 468 | 469 | 470 | let dispatch_combine lst = 471 | fun e -> 472 | List.iter 473 | (fun dispatch -> dispatch e) 474 | lst 475 | 476 | 477 | let tag_libstubs nm = 478 | "use_lib"^nm^"_stubs" 479 | 480 | 481 | let nm_libstubs nm = 482 | nm^"_stubs" 483 | 484 | 485 | let dispatch t e = 486 | let env = 487 | BaseEnvLight.load 488 | ~filename:env_filename 489 | ~allow_empty:true 490 | () 491 | in 492 | match e with 493 | | Before_options -> 494 | let no_trailing_dot s = 495 | if String.length s >= 1 && s.[0] = '.' then 496 | String.sub s 1 ((String.length s) - 1) 497 | else 498 | s 499 | in 500 | List.iter 501 | (fun (opt, var) -> 502 | try 503 | opt := no_trailing_dot (BaseEnvLight.var_get var env) 504 | with Not_found -> 505 | Printf.eprintf "W: Cannot get variable %s\n" var) 506 | [ 507 | Options.ext_obj, "ext_obj"; 508 | Options.ext_lib, "ext_lib"; 509 | Options.ext_dll, "ext_dll"; 510 | ] 511 | 512 | | After_rules -> 513 | (* Declare OCaml libraries *) 514 | List.iter 515 | (function 516 | | nm, [], intf_modules -> 517 | ocaml_lib nm; 518 | let cmis = 519 | List.map (fun m -> (String.uncapitalize m) ^ ".cmi") 520 | intf_modules in 521 | dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis 522 | | nm, dir :: tl, intf_modules -> 523 | ocaml_lib ~dir:dir (dir^"/"^nm); 524 | List.iter 525 | (fun dir -> 526 | List.iter 527 | (fun str -> 528 | flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir])) 529 | ["compile"; "infer_interface"; "doc"]) 530 | tl; 531 | let cmis = 532 | List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi") 533 | intf_modules in 534 | dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"] 535 | cmis) 536 | t.lib_ocaml; 537 | 538 | (* Declare directories dependencies, replace "include" in _tags. *) 539 | List.iter 540 | (fun (dir, include_dirs) -> 541 | Pathname.define_context dir include_dirs) 542 | t.includes; 543 | 544 | (* Declare C libraries *) 545 | List.iter 546 | (fun (lib, dir, headers) -> 547 | (* Handle C part of library *) 548 | flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib] 549 | (S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib"; 550 | A("-l"^(nm_libstubs lib))]); 551 | 552 | flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib] 553 | (S[A"-cclib"; A("-l"^(nm_libstubs lib))]); 554 | 555 | flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib] 556 | (S[A"-dllib"; A("dll"^(nm_libstubs lib))]); 557 | 558 | (* When ocaml link something that use the C library, then one 559 | need that file to be up to date. 560 | This holds both for programs and for libraries. 561 | *) 562 | dep ["link"; "ocaml"; tag_libstubs lib] 563 | [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; 564 | 565 | dep ["compile"; "ocaml"; tag_libstubs lib] 566 | [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; 567 | 568 | (* TODO: be more specific about what depends on headers *) 569 | (* Depends on .h files *) 570 | dep ["compile"; "c"] 571 | headers; 572 | 573 | (* Setup search path for lib *) 574 | flag ["link"; "ocaml"; "use_"^lib] 575 | (S[A"-I"; P(dir)]); 576 | ) 577 | t.lib_c; 578 | 579 | (* Add flags *) 580 | List.iter 581 | (fun (tags, cond_specs) -> 582 | let spec = BaseEnvLight.var_choose cond_specs env in 583 | let rec eval_specs = 584 | function 585 | | S lst -> S (List.map eval_specs lst) 586 | | A str -> A (BaseEnvLight.var_expand str env) 587 | | spec -> spec 588 | in 589 | flag tags & (eval_specs spec)) 590 | t.flags 591 | | _ -> 592 | () 593 | 594 | 595 | let dispatch_default conf t = 596 | dispatch_combine 597 | [ 598 | dispatch t; 599 | MyOCamlbuildFindlib.dispatch conf; 600 | ] 601 | 602 | 603 | end 604 | 605 | 606 | # 606 "myocamlbuild.ml" 607 | open Ocamlbuild_plugin;; 608 | let package_default = 609 | { 610 | MyOCamlbuildBase.lib_ocaml = [("ropebuffer", ["lib"], [])]; 611 | lib_c = []; 612 | flags = []; 613 | includes = [("lib_test", ["lib"])] 614 | } 615 | ;; 616 | 617 | let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} 618 | 619 | let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; 620 | 621 | # 622 "myocamlbuild.ml" 622 | (* OASIS_STOP *) 623 | Ocamlbuild_plugin.dispatch dispatch_default;; 624 | --------------------------------------------------------------------------------