diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml index c5a6041bcd..8f4e184c34 100644 --- a/compiler/bin-js_of_ocaml/compile.ml +++ b/compiler/bin-js_of_ocaml/compile.ml @@ -56,6 +56,7 @@ let output_gen ~standalone ~custom_header ~build_info ~source_map output_file f match source_map, sm with | No_sourcemap, _ | _, None -> () | ((Inline | File _) as output), Some sm -> + if Debug.find "invariant" () then Source_map.invariant sm; let urlData = match output with | No_sourcemap -> assert false diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml index 4c1e1bcb1c..96fe0a22b6 100644 --- a/compiler/lib/source_map.ml +++ b/compiler/lib/source_map.ml @@ -256,7 +256,7 @@ module Mappings = struct ; ori_col = !ori_col ; ori_name = !ori_name } - | _ -> invalid_arg "Source_map.mapping_of_string" + | _ -> invalid_arg "Source_map.Mappings.decode_exn" in let acc = v :: acc in if last = stop then last + 1, acc else read_tokens line (last + 1) stop acc @@ -264,8 +264,21 @@ module Mappings = struct (* The binary format encodes lines starting at zero, but [ori_line] and [gen_line] are 1 based. *) readline 1 0 [] + + let invariant ~names:_ ~sources:_ (Uninterpreted str) = + (* We can't check much without decoding (which is expensive) *) + (* Just do very simple checks *) + if not + (String.for_all str ~f:(function + | ';' | ',' -> true + | x -> Vlq64.in_alphabet x)) + then invalid_arg "Mappings.invariant" end +let version_is_valid = function + | 3 -> true + | _ -> false + let rewrite_path path = if Filename.is_relative path then path @@ -463,7 +476,8 @@ module Standard = struct let of_json (json : Yojson.Raw.t) = match json with - | `Assoc (("version", `Intlit version) :: rest) when int_of_string version = 3 -> + | `Assoc (("version", `Intlit version) :: rest) + when version_is_valid (int_of_string version) -> let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in let file = string "file" rest in let sourceroot = string "sourceRoot" rest in @@ -491,7 +505,7 @@ module Standard = struct | None -> Mappings.empty | Some s -> Mappings.of_string_unsafe s in - { version = int_of_float (float_of_string version) + { version = int_of_string version ; file ; sourceroot ; names @@ -504,8 +518,21 @@ module Standard = struct let to_string m = Yojson.Raw.to_string (json m) let to_file m file = Yojson.Raw.to_file file (json m) + + let invariant + { version; file = _; sourceroot = _; names; sources_content; sources; mappings } = + if not (version_is_valid version) + then invalid_arg "Source_map.Standard.invariant: invalid version"; + match sources_content with + | None -> () + | Some x -> + if not (List.length sources = List.length x) + then + invalid_arg + "Source_map.Standard.invariant: sources and sourcesContent must have the \ + same size"; + Mappings.invariant ~names ~sources mappings end -(* IO *) module Index = struct type section = @@ -564,7 +591,7 @@ module Index = struct "line" fields ~errmsg: - "Source_map_io.Index.of_json: field 'line' absent or invalid from \ + "Source_map.Index.of_json: field 'line' absent or invalid from \ section" in let gen_column = @@ -572,44 +599,62 @@ module Index = struct "column" fields ~errmsg: - "Source_map_io.Index.of_json: field 'column' absent or invalid from \ + "Source_map.Index.of_json: field 'column' absent or invalid from \ section" in { Offset.gen_line; gen_column } - | _ -> - invalid_arg "Source_map_io.Index.of_json: 'offset' field of unexpected type" + | _ -> invalid_arg "Source_map.Index.of_json: 'offset' field of unexpected type" in (match List.assoc "url" json with | _ -> invalid_arg - "Source_map_io.Index.of_json: URLs in index maps are not currently \ - supported" + "Source_map.Index.of_json: URLs in index maps are not currently supported" | exception Not_found -> ()); let map = try Standard.of_json (List.assoc "map" json) with - | Not_found -> invalid_arg "Source_map_io.Index.of_json: field 'map' absent" + | Not_found -> invalid_arg "Source_map.Index.of_json: field 'map' absent" | Invalid_argument _ -> - invalid_arg "Source_map_io.Index.of_json: invalid sub-map object" + invalid_arg "Source_map.Index.of_json: invalid sub-map object" in { offset; map } - | _ -> invalid_arg "Source_map_io.Index.of_json: section of unexpected type" + | _ -> invalid_arg "Source_map.Index.of_json: section of unexpected type" let of_json = function - | `Assoc fields -> ( + | `Assoc (("version", `Intlit version) :: fields) + when version_is_valid (int_of_string version) -> ( let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in let file = string "file" fields in match List.assoc "sections" fields with | `List sections -> let sections = List.map ~f:section_of_json sections in - { version = 3; file; sections } - | _ -> invalid_arg "Source_map_io.Index.of_json: `sections` is not an array" + { version = int_of_string version; file; sections } + | _ -> invalid_arg "Source_map.Index.of_json: `sections` is not an array" | exception Not_found -> - invalid_arg "Source_map_io.Index.of_json: no `sections` field") - | _ -> invalid_arg "Source_map_io.of_json: map is not an object" + invalid_arg "Source_map.Index.of_json: no `sections` field") + | _ -> invalid_arg "Source_map.Index.of_json" let to_string m = Yojson.Raw.to_string (json m) let to_file m file = Yojson.Raw.to_file file (json m) + + let invariant { version; file = _; sections } = + if not (version_is_valid version) + then invalid_arg "Source_map.Index.invariant: invalid version"; + let _ : int = + List.fold_left + sections + ~init:(-1) + ~f:(fun acc { offset = { gen_line; gen_column }; map } -> + if gen_line < 0 || gen_column < 0 + then invalid_arg "Source_map.Index.invariant: invalid offset"; + if acc >= gen_line + then + invalid_arg + "Source_map.Index.invariant: overlapping or unordered map in sections"; + Standard.invariant map; + gen_line + Mappings.number_of_lines map.mappings) + in + () end type t = @@ -621,7 +666,7 @@ let of_json = function match List.assoc "sections" fields with | _ -> Index (Index.of_json json) | exception Not_found -> Standard (Standard.of_json json)) - | _ -> invalid_arg "Source_map_io.of_json: map is not an object" + | _ -> invalid_arg "Source_map.of_json: map is not an object" let of_string s = of_json (Yojson.Raw.from_string s) @@ -636,6 +681,10 @@ let to_file x f = | Standard m -> Standard.to_file m f | Index i -> Index.to_file i f +let invariant = function + | Standard m -> Standard.invariant m + | Index i -> Index.invariant i + type info = { mappings : Mappings.decoded ; sources : string list diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli index 635f81bb6c..78c1972048 100644 --- a/compiler/lib/source_map.mli +++ b/compiler/lib/source_map.mli @@ -137,6 +137,8 @@ val of_string : string -> t val of_file : string -> t +val invariant : t -> unit + type info = { mappings : Mappings.decoded ; sources : string list diff --git a/compiler/lib/vlq64.ml b/compiler/lib/vlq64.ml index 2c49cadb2a..22f71ce5fc 100644 --- a/compiler/lib/vlq64.ml +++ b/compiler/lib/vlq64.ml @@ -19,15 +19,17 @@ open! Stdlib -let code = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" +let alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" let code_rev = let a = Array.make 255 (-1) in - for i = 0 to String.length code - 1 do - a.(Char.code code.[i]) <- i + for i = 0 to String.length alphabet - 1 do + a.(Char.code alphabet.[i]) <- i done; a +let in_alphabet x = code_rev.(Char.code x) <> -1 + let vlq_base_shift = 5 (* binary: 100000 *) @@ -56,7 +58,7 @@ let fromVLQSigned v = (* assert (fromVLQSigned 3 = -1); *) (* assert (fromVLQSigned 5 = -2);; *) -let add_char buf x = Buffer.add_char buf code.[x] +let add_char buf x = Buffer.add_char buf alphabet.[x] let rec encode' buf x = let digit = x land vlq_base_mask in diff --git a/compiler/lib/vlq64.mli b/compiler/lib/vlq64.mli index 8866a58c4d..c3accf5215 100644 --- a/compiler/lib/vlq64.mli +++ b/compiler/lib/vlq64.mli @@ -17,6 +17,8 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +val in_alphabet : char -> bool + val encode_l : Buffer.t -> int list -> unit val decode_l : string -> pos:int -> len:int -> int list