From f5b38c0af84ad3f0fb4b2d1e4e4ab569a90bbf18 Mon Sep 17 00:00:00 2001 From: Philip White Date: Tue, 4 Apr 2023 11:00:20 -0400 Subject: [PATCH] Sourcemap: stop producing sourcemap mappings with negative lines and columns This patch began by changing the mapping type in compiler/lib/source_map.ml so that it more obviously encodes the possible cases for a particular mapping. All other changes were made in response to the type errors that ensued. --- CHANGES.md | 1 + compiler/lib/js_output.ml | 24 ++--- compiler/lib/source_map.ml | 106 ++++++++++----------- compiler/lib/source_map.mli | 12 ++- compiler/tests-compiler/sourcemap.ml | 28 +++--- compiler/tests-sourcemap/dump.reference | 2 - compiler/tests-sourcemap/dump_sourcemap.ml | 23 ++--- 7 files changed, 96 insertions(+), 100 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index c0802098b0..05e9b70fb8 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,6 +5,7 @@ ## Bug fixes * Compiler: put custom header at the top of the output file (fix #1441) * Compiler (js parser): fix parsing of js labels (fix #1440) +* Sourcemap: stop producing sourcemaps mappings with negative lines or columns # 5.1.1 (2023-03-15) - Lille ## Bug fixes diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml index 499915c09c..86b4e1da36 100644 --- a/compiler/lib/js_output.ml +++ b/compiler/lib/js_output.ml @@ -87,22 +87,13 @@ struct | U | Pi { Parse_info.src = None | Some ""; _ } -> push_mapping (PP.pos f) - { Source_map.gen_line = -1 - ; gen_col = -1 - ; ori_source = -1 - ; ori_line = -1 - ; ori_col = -1 - ; ori_name = None - } + { Source_map.gen_line = -1; gen_col = -1; ori_location = None } | Pi { Parse_info.src = Some file; line; col; _ } -> push_mapping (PP.pos f) { Source_map.gen_line = -1 ; gen_col = -1 - ; ori_source = get_file_index file - ; ori_line = line - ; ori_col = col - ; ori_name = None + ; ori_location = Some { source = get_file_index file; line; col; name = None } } let output_debug_info_ident f nm loc = @@ -115,10 +106,13 @@ struct (PP.pos f) { Source_map.gen_line = -1 ; gen_col = -1 - ; ori_source = get_file_index file - ; ori_line = line - ; ori_col = col - ; ori_name = Some (get_name_index nm) + ; ori_location = + Some + { source = get_file_index file + ; line + ; col + ; name = Some (get_name_index nm) + } } let ident f = function diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml index 0d8c8a2566..9cdf13e235 100644 --- a/compiler/lib/source_map.ml +++ b/compiler/lib/source_map.ml @@ -19,13 +19,17 @@ open! Stdlib +type ori_location = + { source : int + ; line : int + ; col : int + ; name : int option + } + type map = { gen_line : int ; gen_col : int - ; ori_source : int - ; ori_line : int - ; ori_col : int - ; ori_name : int option + ; ori_location : ori_location option } type mapping = map list @@ -52,7 +56,11 @@ let empty ~filename = let map_line_number ~f = let f i = if i < 0 then i else f i in - fun m -> { m with ori_line = f m.ori_line; gen_line = f m.gen_line } + fun m -> + { m with + gen_line = f m.gen_line + ; ori_location = Option.map m.ori_location ~f:(fun l -> { l with line = f l.line }) + } let string_of_mapping mapping = let mapping = @@ -79,15 +87,7 @@ let string_of_mapping mapping = if i < len then let c = a.(i) in - if prev >= 0 - && c.ori_source = a.(prev).ori_source - && c.ori_line = a.(prev).ori_line - && c.ori_col = a.(prev).ori_col - then (* We already are at this location *) - loop prev (i + 1) - else if i + 1 < len - && c.gen_line = a.(i + 1).gen_line - && c.gen_col = a.(i + 1).gen_col + if i + 1 < len && c.gen_line = a.(i + 1).gen_line && c.gen_col = a.(i + 1).gen_col then (* Only keep one source location per generated location *) loop prev (i + 1) else ( @@ -104,26 +104,25 @@ let string_of_mapping mapping = let l = (c.gen_col - !gen_col) :: - (if c.ori_source = -1 - then [] - else - (c.ori_source - !ori_source) - :: (c.ori_line - !ori_line) - :: (c.ori_col - !ori_col) - :: - (match c.ori_name with - | None -> [] - | Some n -> - let n' = !ori_name in - ori_name := n; - [ n - n' ])) + (match c.ori_location with + | None -> [] + | Some ori -> + (ori.source - !ori_source) + :: (ori.line - !ori_line) + :: (ori.col - !ori_col) + :: + (match ori.name with + | None -> [] + | Some n -> + let n' = !ori_name in + ori_name := n; + [ n - n' ])) in gen_col := c.gen_col; - if c.ori_source <> -1 - then ( - ori_source := c.ori_source; - ori_line := c.ori_line; - ori_col := c.ori_col); + Option.iter c.ori_location ~f:(fun ori -> + ori_source := ori.source; + ori_line := ori.line; + ori_col := ori.col); Vlq64.encode_l buf l; loop i (i + 1)) in @@ -158,13 +157,7 @@ let mapping_of_string str = match v with | [ g ] -> gen_col := !gen_col + g; - { gen_line = line - ; gen_col = !gen_col - ; ori_source = -1 - ; ori_line = -1 - ; ori_col = -1 - ; ori_name = None - } + { gen_line = line; gen_col = !gen_col; ori_location = None } | [ g; os; ol; oc ] -> gen_col := !gen_col + g; ori_source := !ori_source + os; @@ -172,10 +165,13 @@ let mapping_of_string str = ori_col := !ori_col + oc; { gen_line = line ; gen_col = !gen_col - ; ori_source = !ori_source - ; ori_line = !ori_line - ; ori_col = !ori_col - ; ori_name = None + ; ori_location = + Some + { source = !ori_source + ; line = !ori_line + ; col = !ori_col + ; name = None + } } | [ g; os; ol; oc; on ] -> gen_col := !gen_col + g; @@ -185,10 +181,13 @@ let mapping_of_string str = ori_name := !ori_name + on; { gen_line = line ; gen_col = !gen_col - ; ori_source = !ori_source - ; ori_line = !ori_line - ; ori_col = !ori_col - ; ori_name = Some !ori_name + ; ori_location = + Some + { source = !ori_source + ; line = !ori_line + ; col = !ori_col + ; name = Some !ori_name + } } | _ -> invalid_arg "Source_map.mapping_of_string" in @@ -198,14 +197,13 @@ let mapping_of_string str = readline 0 0 [] let maps ~sources_offset ~names_offset x = - let gen_line = x.gen_line in - let ori_source = x.ori_source + sources_offset in - let ori_name = - match x.ori_name with - | None -> None - | Some ori_name -> Some (ori_name + names_offset) + let ori_location = + Option.map x.ori_location ~f:(fun ori -> + let source = ori.source + sources_offset in + let name = Option.map ori.name ~f:(fun name -> name + names_offset) in + { ori with source; name }) in - { x with gen_line; ori_source; ori_name } + { x with ori_location } let filter_map sm ~f = let a = Array.of_list sm.mappings in diff --git a/compiler/lib/source_map.mli b/compiler/lib/source_map.mli index c7e781f205..b20351d085 100644 --- a/compiler/lib/source_map.mli +++ b/compiler/lib/source_map.mli @@ -17,13 +17,17 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) +type ori_location = + { source : int + ; line : int + ; col : int + ; name : int option + } + type map = { gen_line : int ; gen_col : int - ; ori_source : int - ; ori_line : int - ; ori_col : int - ; ori_name : int option + ; ori_location : ori_location option } type mapping = map list diff --git a/compiler/tests-compiler/sourcemap.ml b/compiler/tests-compiler/sourcemap.ml index 5a7a03c982..86190e02ae 100644 --- a/compiler/tests-compiler/sourcemap.ml +++ b/compiler/tests-compiler/sourcemap.ml @@ -24,17 +24,17 @@ let print_mapping (sm : Source_map.t) = let sources = Array.of_list sm.sources in let _names = Array.of_list sm.names in List.iter sm.mappings ~f:(fun (m : Source_map.map) -> - let file = function - | -1 -> "null" - | n -> normalize_path sources.(n) - in - Printf.printf - "%s:%d:%d -> %d:%d\n" - (file m.ori_source) - m.ori_line - m.ori_col - m.gen_line - m.gen_col) + match m.ori_location with + | Some ori -> + let file n = normalize_path sources.(n) in + Printf.printf + "%s:%d:%d -> %d:%d\n" + (file ori.source) + ori.line + ori.col + m.gen_line + m.gen_col + | None -> Printf.printf "null -> %d:%d\n" m.gen_line m.gen_col) let%expect_test _ = with_temp_dir ~f:(fun () -> @@ -78,7 +78,7 @@ let%expect_test _ = /dune-root/test.ml:1:7 -> 6:25 /dune-root/test.ml:1:12 -> 6:27 /dune-root/test.ml:1:4 -> 7:18 - null:-1:-1 -> 10:2 + null -> 10:2 |}] let%expect_test _ = @@ -119,8 +119,8 @@ let%expect_test _ = ;;;;EAEE,EAAE,EAAC,CAAE;ECQY,UACC |}] let%expect_test _ = - let gen (gen_line, gen_col) (ori_line, ori_col) ori_source : Source_map.map = - { gen_line; gen_col; ori_source; ori_line; ori_col; ori_name = None } + let gen (gen_line, gen_col) (line, col) source : Source_map.map = + { gen_line; gen_col; ori_location = Some { source; line; col; name = None } } in let s1 : Source_map.t = { (Source_map.empty ~filename:"1.map") with diff --git a/compiler/tests-sourcemap/dump.reference b/compiler/tests-sourcemap/dump.reference index d241c27442..d9a8cf150c 100644 --- a/compiler/tests-sourcemap/dump.reference +++ b/compiler/tests-sourcemap/dump.reference @@ -5,5 +5,3 @@ b.ml:1:10 -> 17: function f(x){<>return x - 1 | 0;} b.ml:1:6 -> 24: function f(x){return <>x - 1 | 0;} b.ml:1:15 -> 34: function f(x){return x - 1 | 0;<>} b.ml:1:4 -> 23: var Testlib_B = [0, <>f]; -a.ml:-1:-1 -> 3: <>function caml_call1(f, a0){ -a.ml:-1:-1 -> 2: <>} diff --git a/compiler/tests-sourcemap/dump_sourcemap.ml b/compiler/tests-sourcemap/dump_sourcemap.ml index 67f72c8da1..952b44b9aa 100644 --- a/compiler/tests-sourcemap/dump_sourcemap.ml +++ b/compiler/tests-sourcemap/dump_sourcemap.ml @@ -54,17 +54,18 @@ let print_mapping lines (sm : Source_map.t) = ^ "<>" ^ String.sub line ~pos:col ~len:(len - col) in - if match file m.ori_source with - | "a.ml" | "b.ml" | "c.ml" | "d.ml" -> true - | _ -> false - then - Printf.printf - "%s:%d:%d -> %d:%s\n" - (file m.ori_source) - m.ori_line - m.ori_col - m.gen_col - (mark m.gen_col lines.(m.gen_line - 1))) + Option.iter m.ori_location ~f:(fun (ori : Source_map.ori_location) -> + if match file ori.source with + | "a.ml" | "b.ml" | "c.ml" | "d.ml" -> true + | _ -> false + then + Printf.printf + "%s:%d:%d -> %d:%s\n" + (file ori.source) + ori.line + ori.col + m.gen_col + (mark m.gen_col lines.(m.gen_line - 1)))) let files = Sys.argv |> Array.to_list |> List.tl