pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Simplify payloads with ppx_fields_conv

Browse Source 
Summary: Reduces payload fields boilerplate.

Reviewed By: jeremydubreil

Differential Revision: D15051982

fbshipit-source-id: eb77e7994
master
Mehdi Bouaziz 6 years ago committed by Facebook Github Bot
parent 4e249b8cc3
commit 9d2e9102ad
28 changed files with 36 additions and 94 deletions
Show Stats Download Patch File Download Diff File

12
infer/src/absint/SummaryPayload.ml
Unescape View File

@ -10,9 +10,7 @@ open! IStd
module type Payload = sig
type t
val update_payloads : t -> Payloads.t -> Payloads.t
val of_payloads : Payloads.t -> t option
val field : (Payloads.t, t option) Field.t
end
module type S = sig
@ -30,11 +28,15 @@ end
module Make (P : Payload) : S with type t = P.t = struct
type t = P.t
let update_payloads = Field.fset P.field
let of_payloads = Field.get P.field
let update_summary p (summary : Summary.t) =
{summary with payloads= P.update_payloads p summary.payloads}
{summary with payloads= update_payloads summary.payloads (Some p)}
let of_summary (summary : Summary.t) = P.of_payloads summary.payloads
let of_summary (summary : Summary.t) = of_payloads summary.payloads
let read_full caller_pdesc callee_pname =
let open Option.Monad_infix in

6
infer/src/absint/SummaryPayload.mli
Unescape View File

@ -10,11 +10,7 @@ open! IStd
module type Payload = sig
type t
val update_payloads : t -> Payloads.t -> Payloads.t
(** Update the corresponding part of the payloads *)
val of_payloads : Payloads.t -> t option
(** Read the corresponding part of the payloads *)
val field : (Payloads.t, t option) Field.t
end
module type S = sig

1
infer/src/backend/Payloads.ml
Unescape View File

@ -25,6 +25,7 @@ type t =
; starvation: StarvationDomain.summary option
; typestate: TypeState.t option
; uninit: UninitDomain.Summary.t option }
[@@deriving fields]
let pp pe fmt
{ annot_map

1
infer/src/backend/Payloads.mli
Unescape View File

@ -25,6 +25,7 @@ type t =
; starvation: StarvationDomain.summary option
; typestate: TypeState.t option
; uninit: UninitDomain.Summary.t option }
[@@deriving fields]
val pp : Pp.env -> Format.formatter -> t -> unit

6
infer/src/bufferoverrun/bufferOverrunAnalysis.ml
Unescape View File

@ -19,11 +19,7 @@ module Sem = BufferOverrunSemantics
module Payload = SummaryPayload.Make (struct
type t = BufferOverrunAnalysisSummary.t
let update_payloads astate (payloads : Payloads.t) =
{payloads with buffer_overrun_analysis= Some astate}
let of_payloads (payloads : Payloads.t) = payloads.buffer_overrun_analysis
let field = Payloads.Fields.buffer_overrun_analysis
end)
type summary_and_formals = BufferOverrunAnalysisSummary.t * (Pvar.t * Typ.t) list

6
infer/src/bufferoverrun/bufferOverrunChecker.ml
Unescape View File

@ -23,11 +23,7 @@ module Trace = BufferOverrunTrace
module Payload = SummaryPayload.Make (struct
type t = BufferOverrunCheckerSummary.t
let update_payloads astate (payloads : Payloads.t) =
{payloads with buffer_overrun_checker= Some astate}
let of_payloads (payloads : Payloads.t) = payloads.buffer_overrun_checker
let field = Payloads.Fields.buffer_overrun_checker
end)
module UnusedBranch = struct

4
infer/src/checkers/Litho.ml
Unescape View File

@ -12,9 +12,7 @@ module Domain = LithoDomain
module Payload = SummaryPayload.Make (struct
type t = Domain.t
let update_payloads astate (payloads : Payloads.t) = {payloads with litho= Some astate}
let of_payloads (payloads : Payloads.t) = payloads.litho
let field = Payloads.Fields.litho
end)
module LithoFramework = struct

4
infer/src/checkers/Siof.ml
Unescape View File

@ -60,9 +60,7 @@ let is_modelled =
module Payload = SummaryPayload.Make (struct
type t = SiofDomain.Summary.t
let update_payloads astate (payloads : Payloads.t) = {payloads with siof= Some astate}
let of_payloads (payloads : Payloads.t) = payloads.siof
let field = Payloads.Fields.siof
end)
module TransferFunctions (CFG : ProcCfg.S) = struct

4
infer/src/checkers/annotationReachability.ml
Unescape View File

@ -62,9 +62,7 @@ end
module Payload = SummaryPayload.Make (struct
type t = AnnotReachabilityDomain.t
let update_payloads annot_map (payloads : Payloads.t) = {payloads with annot_map= Some annot_map}
let of_payloads (payloads : Payloads.t) = payloads.annot_map
let field = Payloads.Fields.annot_map
end)
let is_modeled_expensive tenv = function

4
infer/src/checkers/classLoads.ml
Unescape View File

@ -19,9 +19,7 @@ module L = Logging
module Payload = SummaryPayload.Make (struct
type t = ClassLoadsDomain.summary
let update_payloads post (payloads : Payloads.t) = {payloads with class_loads= Some post}
let of_payloads (payloads : Payloads.t) = payloads.class_loads
let field = Payloads.Fields.class_loads
end)
let do_call pdesc callee loc init =

4
infer/src/checkers/cost.ml
Unescape View File

@ -13,9 +13,7 @@ module BasicCost = CostDomain.BasicCost
module Payload = SummaryPayload.Make (struct
type t = CostDomain.summary
let update_payloads sum (payloads : Payloads.t) = {payloads with cost= Some sum}
let of_payloads (payloads : Payloads.t) = payloads.cost
let field = Payloads.Fields.cost
end)
(* We use this threshold to give error if the cost is above it.

4
infer/src/checkers/purity.ml
Unescape View File

@ -17,9 +17,7 @@ let debug fmt = L.(debug Analysis Verbose fmt)
module Payload = SummaryPayload.Make (struct
type t = PurityDomain.summary
let update_payloads post (payloads : Payloads.t) = {payloads with purity= Some post}
let of_payloads (payloads : Payloads.t) = payloads.purity
let field = Payloads.Fields.purity
end)
type purity_extras =

4
infer/src/checkers/uninit.ml
Unescape View File

@ -19,9 +19,7 @@ module RecordDomain = UninitDomain.Record (MaybeUninitVars) (AliasedVars) (D)
module Payload = SummaryPayload.Make (struct
type t = UninitDomain.Summary.t
let update_payloads sum (payloads : Payloads.t) = {payloads with uninit= Some sum}
let of_payloads (payloads : Payloads.t) = payloads.uninit
let field = Payloads.Fields.uninit
end)
module Models = struct

4
infer/src/concurrency/RacerD.ml
Unescape View File

@ -13,9 +13,7 @@ module MF = MarkupFormatter
module Payload = SummaryPayload.Make (struct
type t = RacerDDomain.summary
let update_payloads post (payloads : Payloads.t) = {payloads with racerd= Some post}
let of_payloads (payloads : Payloads.t) = payloads.racerd
let field = Payloads.Fields.racerd
end)
module TransferFunctions (CFG : ProcCfg.S) = struct

4
infer/src/concurrency/starvation.ml
Unescape View File

@ -33,9 +33,7 @@ let is_nonblocking tenv proc_desc =
module Payload = SummaryPayload.Make (struct
type t = StarvationDomain.summary
let update_payloads post (payloads : Payloads.t) = {payloads with starvation= Some post}
let of_payloads (payloads : Payloads.t) = payloads.starvation
let field = Payloads.Fields.starvation
end)
(* using an indentifier for a class object, create an access path representing that lock;

2
infer/src/deadcode/dune.in
Unescape View File

@ -16,7 +16,7 @@ Format.sprintf
(ocamlopt_flags (%s))
(libraries %s)
(modules All_infer_in_one_file)
(preprocess (pps ppx_compare ppx_sexp_conv ppx_variants_conv -no-check))
(preprocess (pps ppx_compare ppx_fields_conv ppx_sexp_conv ppx_variants_conv -no-check))
)
|}
(String.concat " " common_cflags)

6
infer/src/dune.in
Unescape View File

@ -63,7 +63,7 @@ let stanzas =
(ocamlopt_flags (%s))
(libraries %s)
(modules :standard \ %s infertop)
(preprocess (pps ppx_compare ppx_sexp_conv ppx_variants_conv -no-check))
(preprocess (pps ppx_compare ppx_fields_conv ppx_sexp_conv ppx_variants_conv -no-check))
)
(documentation
@ -83,7 +83,7 @@ let stanzas =
(ocamlopt_flags (%s))
(libraries InferModules)
(modules %s)
(preprocess (pps ppx_compare ppx_sexp_conv ppx_variants_conv -no-check))
(preprocess (pps ppx_compare ppx_fields_conv ppx_sexp_conv ppx_variants_conv -no-check))
)
|}
(String.concat " " infer_binaries)
@ -97,7 +97,7 @@ let stanzas =
(flags (%s))
(libraries utop InferModules)
(modules Infertop)
(preprocess (pps ppx_compare ppx_sexp_conv ppx_variants_conv -no-check))
(preprocess (pps ppx_compare ppx_fields_conv ppx_sexp_conv ppx_variants_conv -no-check))
(link_flags (-linkall -warn-error -31))
)
|}

6
infer/src/labs/00_dummy_checker/ResourceLeaks.ml
Unescape View File

@ -13,11 +13,7 @@ module L = Logging
module Payload = SummaryPayload.Make (struct
type t = ResourceLeakDomain.t
let update_payloads resources_payload (payloads : Payloads.t) =
{payloads with lab_resource_leaks= Some resources_payload}
let of_payloads {Payloads.lab_resource_leaks} = lab_resource_leaks
let field = Payloads.Fields.lab_resource_leaks
end)
module TransferFunctions (CFG : ProcCfg.S) = struct

6
infer/src/labs/01_integer_domain/ResourceLeaks.ml
Unescape View File

@ -13,11 +13,7 @@ module L = Logging
module Payload = SummaryPayload.Make (struct
type t = ResourceLeakDomain.t
let update_payloads resources_payload (payloads : Payloads.t) =
{payloads with lab_resource_leaks= Some resources_payload}
let of_payloads {Payloads.lab_resource_leaks} = lab_resource_leaks
let field = Payloads.Fields.lab_resource_leaks
end)
module TransferFunctions (CFG : ProcCfg.S) = struct

6
infer/src/labs/02_domain_join/ResourceLeaks.ml
Unescape View File

@ -13,11 +13,7 @@ module L = Logging
module Payload = SummaryPayload.Make (struct
type t = ResourceLeakDomain.t
let update_payloads resources_payload (payloads : Payloads.t) =
{payloads with lab_resource_leaks= Some resources_payload}
let of_payloads {Payloads.lab_resource_leaks} = lab_resource_leaks
let field = Payloads.Fields.lab_resource_leaks
end)
module TransferFunctions (CFG : ProcCfg.S) = struct

6
infer/src/labs/03_domain_top/ResourceLeaks.ml
Unescape View File

@ -13,11 +13,7 @@ module L = Logging
module Payload = SummaryPayload.Make (struct
type t = ResourceLeakDomain.t
let update_payloads resources_payload (payloads : Payloads.t) =
{payloads with lab_resource_leaks= Some resources_payload}
let of_payloads {Payloads.lab_resource_leaks} = lab_resource_leaks
let field = Payloads.Fields.lab_resource_leaks
end)
module TransferFunctions (CFG : ProcCfg.S) = struct

6
infer/src/labs/04_interprocedural/ResourceLeaks.ml
Unescape View File

@ -13,11 +13,7 @@ module L = Logging
module Payload = SummaryPayload.Make (struct
type t = ResourceLeakDomain.t
let update_payloads resources_payload (payloads : Payloads.t) =
{payloads with lab_resource_leaks= Some resources_payload}
let of_payloads {Payloads.lab_resource_leaks} = lab_resource_leaks
let field = Payloads.Fields.lab_resource_leaks
end)
module TransferFunctions (CFG : ProcCfg.S) = struct

6
infer/src/labs/05_access_paths_interprocedural/ResourceLeaks.ml
Unescape View File

@ -13,11 +13,7 @@ module L = Logging
module Payload = SummaryPayload.Make (struct
type t = ResourceLeakDomain.summary
let update_payloads resources_payload (payloads : Payloads.t) =
{payloads with lab_resource_leaks= Some resources_payload}
let of_payloads {Payloads.lab_resource_leaks} = lab_resource_leaks
let field = Payloads.Fields.lab_resource_leaks
end)
module TransferFunctions (CFG : ProcCfg.S) = struct

6
infer/src/labs/ResourceLeaks.ml
Unescape View File

@ -13,11 +13,7 @@ module L = Logging
module Payload = SummaryPayload.Make (struct
type t = ResourceLeakDomain.t
let update_payloads resources_payload (payloads : Payloads.t) =
{payloads with lab_resource_leaks= Some resources_payload}
let of_payloads {Payloads.lab_resource_leaks} = lab_resource_leaks
let field = Payloads.Fields.lab_resource_leaks
end)
module TransferFunctions (CFG : ProcCfg.S) = struct

4
infer/src/pulse/Pulse.ml
Unescape View File

@ -40,9 +40,7 @@ let check_error summary = function
module Payload = SummaryPayload.Make (struct
type t = PulseSummary.t
let update_payloads astate (payloads : Payloads.t) = {payloads with pulse= Some astate}
let of_payloads (payloads : Payloads.t) = payloads.pulse
let field = Payloads.Fields.pulse
end)
module PulseTransferFunctions = struct

6
infer/src/quandary/TaintAnalysis.ml
Unescape View File

@ -17,11 +17,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct
module Payload = SummaryPayload.Make (struct
type t = QuandarySummary.t
let update_payloads quandary_payload (payloads : Payloads.t) =
{payloads with quandary= Some quandary_payload}
let of_payloads (payloads : Payloads.t) = payloads.quandary
let field = Payloads.Fields.quandary
end)
module Domain = TaintDomain

1
opam
Unescape View File

@ -42,6 +42,7 @@ depends: [
"ounit" {>="2.0.5"}
"parmap" {>="1.0-rc8"}
"ppx_deriving" {>="4.1"}
"ppx_fields_conv" {">=v0.11.0" & < "v0.12"}
"sawja" {>="1.5.4"}
"sqlite3"
"utop" {with-test}

1
scripts/toplevel_init
Unescape View File

@ -11,6 +11,7 @@
#require "ctypes.stubs";;
#require "ocamlgraph";;
#require "ppx_compare";;
#require "ppx_fields_conv";;
#require "sawja";;
#require "sqlite3";;
#require "xmlm";;

Write Preview
Loading…
Cancel
Save