Skip to content

Commit

Permalink
[scopeleakage] Simplify config parsing
Browse files Browse the repository at this point in the history 
Summary: Leverage yojson ppx instead of parsing it manually.

Reviewed By: thizanne

Differential Revision: D63258026

fbshipit-source-id: 6c42db9f4fd6f27b93aad83cc7310dbe062623c0
  • Loading branch information
@geralt-encore @facebook-github-bot
geralt-encore authored and facebook-github-bot committed Sep 23, 2024
1 parent 2c33f89 commit 8f18847
Showing 1 changed file with 23 additions and 110 deletions.
133 changes: 23 additions & 110 deletions infer/src/checkers/scopeLeakage.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -63,18 +63,20 @@ module AnalysisConfig : sig

val pp : F.formatter -> t -> unit
end = struct
type classname_methods = {classname: string; methods: string list}
type classname_methods = {classname: string; methods: string list} [@@deriving of_yojson]

type generators = classname_methods list
type generators = classname_methods list [@@deriving of_yojson]

type scope_def = {classname: string; generators: generators}
type scope_def = {classname: string; generators: generators} [@@deriving of_yojson]

type must_not_hold_pair = {holder: string; held: string}
type must_not_hold_pair = {holder: string [@yojson.key "holds"]; held: string}
[@@deriving of_yojson]

type t =
{ annotation_classname: string
; scope_defs: scope_def list
; must_not_hold_pairs: must_not_hold_pair list }
{ annotation_classname: string [@yojson.key "annot-classname"]
; scope_defs: scope_def list [@yojson.key "scopes"]
; must_not_hold_pairs: must_not_hold_pair list [@yojson.key "must-not-hold"] }
[@@deriving of_yojson]

let empty = {annotation_classname= ""; scope_defs= []; must_not_hold_pairs= []}

Expand All @@ -92,7 +94,7 @@ end = struct
generators
in
let pp_must_not_hold_pair fmt {holder; held} =
F.fprintf fmt {| { "holder": "%s", "held": "%s" } |} holder held
F.fprintf fmt {| { "holds": "%s", "held": "%s" } |} holder held
in
F.fprintf fmt
{|"scope-leakage-config" : {
Expand All @@ -107,89 +109,6 @@ end = struct
(pp_list pp_must_not_hold_pair) config.must_not_hold_pairs


(** Finds a named JSON node in a map and aborts with an informative message otherwise. *)
let find_node map key node =
try Hashtbl.find map key
with _ ->
L.die UserError "Missing key \"%s\" in association node %a!@\n" key Yojson.Safe.pp node


(* Converts a JSON `Assoc into a Hashtbl. *)
let json_assoc_list_to_map assoc_list =
let result = Hashtbl.create 10 in
List.iter assoc_list ~f:(fun (key, node) -> Hashtbl.add result key node) ;
result


(* Converts a JSON string list node into a list of strings. *)
let json_list_to_string_list node =
match node with
| `List nodes ->
List.map nodes ~f:Yojson.Safe.Util.to_string
| _ ->
L.die UserError "Failed parsing a list of strings from %a!@\n" Yojson.Safe.pp node


(** node is a JSON entry of the form "classname" : string, "methods": [list of strings]. *)
let parse_classname_methods node =
match node with
| `Assoc assoc_list ->
let node_as_map = json_assoc_list_to_map assoc_list in
let classname = Yojson.Safe.Util.to_string (find_node node_as_map "classname" node) in
let methods = json_list_to_string_list (find_node node_as_map "methods" node) in
{classname; methods}
| _ ->
L.die UserError "Failed parsing a classname+methods node from %a!@\n" Yojson.Safe.pp node


let parse_generators node =
match node with
| `List list_node ->
List.map list_node ~f:parse_classname_methods
| _ ->
L.die UserError "Failed parsing a list of classname+methods list from %a!@\n" Yojson.Safe.pp
node


let parse_scope node =
match node with
| `Assoc generators_list ->
let node_as_map = json_assoc_list_to_map generators_list in
let classname_node = find_node node_as_map "classname" node in
let generators_node = find_node node_as_map "generators" node in
{ classname= Yojson.Safe.Util.to_string classname_node
; generators= parse_generators generators_node }
| _ ->
L.die UserError "Failed parsing scope node from %a!@\n" Yojson.Safe.pp node


let parse_scope_list node =
match node with
| `List node_list ->
List.map node_list ~f:parse_scope
| _ ->
L.die UserError "Failed parsing a list of scopes from %a" Yojson.Safe.pp node


let parse_must_not_hold_pair node =
match node with
| `Assoc node_assoc_list ->
let node_as_map = json_assoc_list_to_map node_assoc_list in
let left_node = find_node node_as_map "holds" node in
let right_node = find_node node_as_map "held" node in
{holder= Yojson.Safe.Util.to_string left_node; held= Yojson.Safe.Util.to_string right_node}
| _ ->
L.die UserError "Failed parsing a must-not-hold pair from %a!@\n" Yojson.Safe.pp node


let parse_must_not_hold node =
match node with
| `List node_list ->
List.map node_list ~f:parse_must_not_hold_pair
| _ ->
L.die UserError "Failed parsing a must-not-hold pair from %a!@\n" Yojson.Safe.pp node


(** Basic semantic checks. *)
let validate {scope_defs; must_not_hold_pairs} =
let scope_names = List.map scope_defs ~f:(fun {classname} -> classname) in
Expand All @@ -206,25 +125,19 @@ end = struct
held )


let parse node =
match node with
| `Assoc node_assoc_list ->
let node_as_map = json_assoc_list_to_map node_assoc_list in
let annot_classname_node = find_node node_as_map "annot-classname" node in
let scopes_node = find_node node_as_map "scopes" node in
let must_not_hold_node = find_node node_as_map "must-not-hold" node in
let result =
{ annotation_classname= Yojson.Safe.Util.to_string annot_classname_node
; scope_defs= parse_scope_list scopes_node
; must_not_hold_pairs= parse_must_not_hold must_not_hold_node }
in
validate result ;
result
| `List [] ->
L.debug Analysis Verbose "scope-leakage-config is empty!@\n" ;
empty
| _ ->
L.die UserError "Failed parsing a scope-leakage-config node from %a!@\n" Yojson.Safe.pp node
let parse json =
let config =
match json with
| `List [] ->
L.debug Analysis Verbose "scope-leakage-config is empty!@\n" ;
empty
| json -> (
try t_of_yojson json
with _ ->
L.die UserError "Failed parsing scope-leakage-config from %a!@\n" Yojson.Safe.pp json )
in
validate config ;
config
end

(** Parse the configuration into a global. *)
Expand Down

0 comments on commit 8f18847

Please sign in to comment.