From d3dce16e7530ef85c7e1d297831c0e6eb5d2024e Mon Sep 17 00:00:00 2001 From: Jules Villard Date: Tue, 3 Dec 2024 07:26:19 -0800 Subject: [PATCH] [suppressions] compute list of errors Summary: Make `Suppressions.parse_lines` return a list of errors instead of reporting them as we go. This will allow us to test which errors are reported in unit tests. Use a simple error monad to simplify notations. Reviewed By: skcho Differential Revision: D66700714 fbshipit-source-id: e51f61b7295a52cf4bf2bff547eb659f378f4ba8 --- infer/src/integration/Suppressions.ml | 122 +++++++++++++++++++++----- 1 file changed, 99 insertions(+), 23 deletions(-) diff --git a/infer/src/integration/Suppressions.ml b/infer/src/integration/Suppressions.ml index 862e31f6c4..ff0bead47d 100644 --- a/infer/src/integration/Suppressions.ml +++ b/infer/src/integration/Suppressions.ml @@ -75,23 +75,77 @@ let substring_after_match rx s = let regex_cache = ref IString.Map.empty +module ParseResult = struct + type error = UserError of (unit -> string) + + let pp_error fmt (UserError error) = F.pp_print_string fmt (error ()) + + type 'a parse_result = 'a * error list + + let _pp_parse_result pp fmt ((x, errors) : _ parse_result) = + if List.is_empty errors then pp fmt x + else + F.fprintf fmt "@[RESULT: @[%a@]@\nERRORS: @[%a@]@]" pp x + (Pp.semicolon_seq ~print_env:Pp.text_break pp_error) + errors + + + let bind (x, errors) f = + let x', errors' = f x in + (x', errors' @ errors) + + + let ret x = (x, []) + + let map x f = bind x (fun x' -> ret (f x')) + + let ( >>= ) x f = bind x f + + let ( >>| ) x f = map x f + + let ( let* ) x f = bind x f + + let ( let+ ) x f = map x f + + let error f = ((), [UserError f]) + + let result_list_fold l ~init ~f = + let acc, rev_errors = + List.fold l ~init:(init, []) ~f:(fun (acc, rev_errors) x -> + let acc, errors = f acc x in + let rev_errors = List.rev_append errors rev_errors in + (acc, rev_errors) ) + in + (acc, List.rev rev_errors) + + + let result_list_filter l ~f = + result_list_fold l ~init:[] ~f:(fun rev_l' x -> + let+ b = f x in + if b then x :: rev_l' else rev_l' ) + >>| List.rev +end + +include ParseResult + let get_regex s = match IString.Map.find_opt s !regex_cache with | None -> ( try let r = Str.regexp s in regex_cache := IString.Map.add s r !regex_cache ; - Some r + ret (Some r) with _ -> - L.user_error "Invalid regex: %s@\n" s ; + let+ () = error (fun () -> F.asprintf "Invalid regex: %s@\n" s) in None ) - | v -> - v + | Some _ as v -> + ret v (* return all matching issue_types for a given regex-string *) let matching_issue_types s = - match get_regex s with + let+ regex = get_regex s in + match regex with | Some rx -> IssueType.all_issues () |> List.map ~f:(fun {IssueType.unique_id} -> unique_id) @@ -102,7 +156,7 @@ let matching_issue_types s = (* does a given regex-string match any issue_type (but not all of them) *) let valid_issue_type s = - let matching = matching_issue_types s in + let+ matching = matching_issue_types s in List.is_empty matching |> not && List.length matching <> List.length (IssueType.all_issues ()) @@ -110,11 +164,16 @@ let valid_issue_type s = let extract_valid_issue_types s = s |> String.split ~on:',' |> List.map ~f:String.strip |> List.filter ~f:(fun s -> s |> String.is_empty |> not) - |> List.filter ~f:(fun s -> - let valid = valid_issue_type s in - if not valid then L.user_error "%s not a valid issue_type / wildcard@\n" s ; - valid ) - |> IString.Set.of_list + |> ret + >>= result_list_filter ~f:(fun s -> + let* valid = valid_issue_type s in + let+ () = + if not valid then + error (fun () -> F.asprintf "%s not a valid issue_type / wildcard@\n" s) + else ret () + in + valid ) + >>| IString.Set.of_list (* trailing space intentional *) @@ -123,30 +182,37 @@ let ignore_rx = Str.regexp_string "@infer-ignore " let ignore_all_rx = Str.regexp_string "@infer-ignore-every " let parse_lines ?file lines = - let parse_result = - List.fold lines + let+ parse_result = + result_list_fold lines ~init: {current_line= 1; block_start= None; issue_types= IString.Set.empty; res= IString.Map.empty} ~f:(fun {current_line; block_start; issue_types; res} line -> let next_line = current_line + 1 in match (substring_after_match ignore_all_rx line, substring_after_match ignore_rx line) with | None, None -> - { current_line= next_line - ; block_start= None - ; issue_types= IString.Set.empty - ; res= update_suppressions block_start current_line issue_types res } + ret + { current_line= next_line + ; block_start= None + ; issue_types= IString.Set.empty + ; res= update_suppressions block_start current_line issue_types res } | Some s, other -> - if Option.is_some other then - L.user_error "Both @infer-ignore-every and @infer-ignore found in %s line %d@\n" - (Option.value ~default:"" file) next_line ; + let* () = + if Option.is_some other then + error (fun () -> + F.asprintf "Both @infer-ignore-every and @infer-ignore found in %s line %d@\n" + (Option.value ~default:"" file) next_line ) + else ret () + in + let+ valid_issue_types = extract_valid_issue_types s in { current_line= next_line ; block_start= None ; issue_types= IString.Set.empty - ; res= update_suppressions_every (extract_valid_issue_types s) res } + ; res= update_suppressions_every valid_issue_types res } | _, Some s -> + let+ valid_issue_types = extract_valid_issue_types s in { current_line= next_line ; block_start= (if Option.is_some block_start then block_start else Some current_line) - ; issue_types= IString.Set.union issue_types (extract_valid_issue_types s) + ; issue_types= IString.Set.union issue_types valid_issue_types ; res } ) in L.debug Report Verbose "Parse state: %a@\n" pp_fold_state parse_result ; @@ -158,10 +224,20 @@ let parse_lines ?file lines = res +let parse_lines ?file lines = + let suppressions, errors = parse_lines ?file lines in + List.iter errors ~f:(fun (UserError error) -> L.user_error "%s" (error ())) ; + suppressions + + let first_key_match ~suppressions s = IString.Map.to_seq suppressions |> Seq.find (fun (k, _) -> - match get_regex k with Some rx -> Str.string_match rx s 0 | _ -> false ) + match IString.Map.find_opt k !regex_cache with + | Some rx -> + Str.string_match rx s 0 + | None -> + false ) |> Option.map ~f:snd