package core_kernel
Industrial strength alternative to OCaml's standard library
Install
Dune Dependency
Authors
Maintainers
Sources
v0.17.0.tar.gz
sha256=fd2b8c6715794df7a810a62b226f53720f211cd344b4afc9fab0498796d6b466
doc/src/core_kernel.version_util/version_util.ml.html
Source file version_util.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355
open! Core (* The [generated_build_info ()] string can be: - The empty string, from the default C function. This indicates that the build system does not support build info for this executable, e.g. because it's a test runner. - A printed sexp, from the C function generated by the build system, which is parsable by the [Build_info.t] type below. *) external generated_build_info : unit -> string = "generated_build_info" (* The [generated_hg_version ()] can be: - The empty string, from the default C function. This indicates that the build system does not support version info for this executable, e.g. because it's a test runner. - "NO_VERSION_UTIL" from the C function generated by the build system; or - "repo1 rev40\nrepo2 rev40" from the C function generated by the build system. The last two are prefixed by the [Version_util.start_marker]. When the prefix is present, there is also enough padding for ~4K worth of data. This allows us to rewrite binaries to insert the version util after linking. *) external generated_hg_version : unit -> string = "generated_hg_version" (** Make sure to update [bin/generate_static_string_c_code.sh] too if you are changing these constants. *) module Version_util_section = Section.Make (struct let name = "version_util" let length_including_start_marker = 4096 (* BEFORE CHANGING: Please note the bidirectional version compatibility guarantee granted in the mli file for [Expert.get_version_util]. If we ever need to change the version util format, we should update the code to be able to read both the old and new formats, then wait a month, then change the write function to only write the new format. The old and new formats can be distinguished by minting a new [start_marker] for the new format. *) let start_marker = (* This trick is to prevent the marker from occurring verbatim in the binary that uses [Expert.insert_version_util], so that we don't by accident rewrite our own code. [opaque_identity] is used to prevent the compiler from converting this computation into a literal, thus undoing this trick. We could split the marker in half instead, but that would make grepping hard for humans. Grep in the tree to see the place that generates this. *) (Sys.opaque_identity ( ^ )) "rUb71QgfHXXwnBWBoJfb0Sa3R60vihdV" ":" ;; end) (** Make sure to update [bin/generate_static_string_c_code.sh] too if you are changing these constants. *) module Build_info_section = Section.Make (struct let name = "build info" let length_including_start_marker = 4096 let start_marker = (* Same trick as in [Version_util_section]. *) (Sys.opaque_identity ( ^ )) "vNxXpiccvPI9MHVFJuNwNxj8eu9W5KCB" ":" ;; end) (* BEFORE CHANGING: Note version compatibility guarantee above. *) let parse_generated_hg_version = function | "" -> [ "NO_VERSION_UTIL" ] | generated_hg_version -> generated_hg_version |> String.chop_suffix_if_exists ~suffix:"\n" |> Version_util_section.chop_start_marker_if_exists |> String.split ~on:'\n' |> List.map ~f:(fun line -> match String.rsplit2 line ~on:' ' with | None -> line (* no version util *) | Some (repo, rev_status) -> (* For compability with downstream tools that might rely on this output format, and with [Version.parse].*) String.concat [ repo ; "_" ; String.prefix rev_status 12 ; (* The revision can have a one-character '+' suffix. Keep it. *) (if String.length rev_status mod 2 = 1 then String.suffix rev_status 1 else "") ]) ;; let version_list = parse_generated_hg_version (generated_hg_version ()) let version = String.concat version_list ~sep:" " module Version = struct type t = { repo : string ; version : string } [@@deriving compare, sexp_of] let parse1 version = match String.rsplit2 version ~on:'_' with | None -> error_s [%message "Could not parse version" version] | Some (repo, version) -> Ok { repo; version } ;; let parse_list l = (* We might get multiple such lines if we have multiple repos *) if List.exists l ~f:(String.( = ) "NO_VERSION_UTIL") then Ok None else List.map l ~f:parse1 |> Or_error.combine_errors |> Or_error.map ~f:(fun x -> Some x) ;; let parse_lines versions = parse_list (String.split_lines versions) let current_version () = ok_exn (parse_list version_list) let present = function | None -> error_s [%sexp "executable built without version util"] | Some x -> Ok x ;; let parse_list_present x = Or_error.bind ~f:present (parse_list x) let parse_lines_present x = Or_error.bind ~f:present (parse_lines x) let current_version_present () = present (current_version ()) end module Expert = struct (* BEFORE CHANGING: Please note the bidirectional version compatibility guarantee granted in the mli file. *) let get_version_util ~contents_of_exe = let%map.Option section = Version_util_section.get ~contents_of_exe in String.concat ~sep:" " (parse_generated_hg_version section) ;; let text (versions_opt : Version.t list option) = match versions_opt with | None -> "NO_VERSION_UTIL" | Some versions -> if List.is_empty versions then failwith "version_util must include at least one repository"; if List.contains_dup ~compare:String.compare (List.map versions ~f:(fun v -> v.repo)) then failwith "version_util must not contain duplicate repositories"; versions |> List.sort ~compare:Version.compare |> List.map ~f:(fun { repo; version } -> if not (String.mem repo '/') then failwith [%string "%{repo} doesn't look like a repo url"]; (let version' = String.chop_suffix_if_exists version ~suffix:"+" in if (String.length version' = 40 || String.length version' = 64) && String.for_all version' ~f:Char.is_hex_digit_lower then () else failwith [%string "%{version} doesn't look like a full hg version"]); repo ^ " " ^ version ^ "\n") |> String.concat ;; let raw_text v = Version_util_section.Expert.pad_with_at_least_one_nul_byte_exn (text v) let replace_version_util ~contents_of_exe versions_opt = (* Expert because we don't really want people to casually use this, so its contents can be trusted. *) Version_util_section.replace ~contents_of_exe ~data:(text versions_opt) ;; let parse_generated_hg_version = parse_generated_hg_version module Experimental = struct let get_build_info = Build_info_section.get let remove_build_info ~contents_of_exe = Build_info_section.replace ~contents_of_exe ~data:"NO_BUILD_INFO" ;; end module For_tests = struct let count_section_occurrences ~contents_of_exe = Version_util_section.count_occurrences ~contents_of_exe + Build_info_section.count_occurrences ~contents_of_exe ;; end end module Build_info = struct module Application_specific_fields = struct type t = Sexp.t String.Map.t [@@deriving sexp] end module Time_with_limited_parsing = struct type t = Time_float.t * Sexp.t let t_of_sexp sexp = let str = string_of_sexp sexp in try match String.chop_suffix str ~suffix:"Z" with | None -> failwith "zone must be Z" | Some rest -> (match String.lsplit2 rest ~on:' ' with | None -> failwith "time must contain one space between date and ofday" | Some (date, ofday) -> let date = Date.t_of_sexp (sexp_of_string date) in let ofday = Time_float.Ofday.t_of_sexp (sexp_of_string ofday) in Time_float.of_date_ofday date ofday ~zone:Time_float.Zone.utc, sexp) with | Sexplib.Conv.Of_sexp_error (e, _) | e -> raise (Sexplib.Conv.Of_sexp_error (e, sexp)) ;; let sexp_of_t_ref = ref (fun (_, sexp) -> sexp) let sexp_of_t time = !sexp_of_t_ref time let epoch : t = Time_float.epoch, Atom "1970-01-01 00:00:00Z" end type t = { username : string option [@sexp.option] ; hostname : string option [@sexp.option] ; kernel : string option [@sexp.option] ; build_time : Time_with_limited_parsing.t option [@sexp.option] ; x_library_inlining : bool ; portable_int63 : bool ; dynlinkable_code : bool ; risk_system : bool [@sexp.default false] ; ocaml_version : string ; executable_path : string ; build_system : string ; allowed_projections : string list option [@sexp.option] ; with_fdo : (string * Md5.t option) option [@sexp.option] ; application_specific_fields : Application_specific_fields.t option [@sexp.option] } [@@deriving sexp] module Structured = struct type nonrec t = | Not_supported | Unset | Set of (string * Sexp.t * t) let t = Exn.handle_uncaught_and_exit (fun () -> match generated_build_info () with | "" -> Not_supported | non_empty_string -> (match Build_info_section.chop_start_marker_if_exists non_empty_string with | "NO_BUILD_INFO" -> Unset | str -> let sexp = Sexp.of_string str in let t = t_of_sexp sexp in Set (str, sexp, t))) ;; end let dummy : t = { username = None ; hostname = None ; kernel = None ; build_time = Some Time_with_limited_parsing.epoch ; x_library_inlining = false ; portable_int63 = true ; dynlinkable_code = false ; risk_system = false ; ocaml_version = "" ; executable_path = "" ; build_system = "" ; allowed_projections = None ; with_fdo = None ; application_specific_fields = None } ;; let build_system_supports_version_util = match Structured.t with | Not_supported -> false | Unset | Set _ -> true ;; let build_info_status = match Structured.t with | Not_supported -> `Not_supported | Unset -> `Unset | Set _ -> `Set ;; let build_info, build_info_as_sexp, t = match Structured.t with | Not_supported | Unset -> let t = dummy in let sexp = sexp_of_t t in let str = Sexp.to_string_mach sexp in str, sexp, t | Set tuple -> tuple ;; let { username ; hostname ; kernel ; build_time = build_time_and_sexp ; x_library_inlining ; portable_int63 = _ ; dynlinkable_code ; risk_system = _ ; ocaml_version ; executable_path ; build_system ; allowed_projections ; with_fdo ; application_specific_fields } = t ;; let build_time = match build_time_and_sexp with | None -> None | Some (time, _sexp) -> Some time ;; let reprint_build_info sexp_of_time = Ref.set_temporarily Time_with_limited_parsing.sexp_of_t_ref (fun (time, _) -> sexp_of_time time) ~f:(fun () -> Sexp.to_string (sexp_of_t t)) ;; end include Build_info let compiled_for_speed = x_library_inlining && not dynlinkable_code module For_tests = struct let build_info_status = Build_info.build_info_status let parse_generated_hg_version = parse_generated_hg_version end let arg_spec = [ ( "-version" , Arg.Unit (fun () -> List.iter version_list ~f:print_endline; exit 0) , " Print the hg revision of this build and exit" ) ; ( "-build_info" , Arg.Unit (fun () -> print_endline build_info; exit 0) , " Print build info as sexp and exit" ) ] ;; module Private__For_version_util_async = struct let version_util_start_marker = Version_util_section.Expert.start_marker let parse_generated_hg_version = parse_generated_hg_version let raw_text = Expert.raw_text end
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>