[quandary] move source and sink kinds into their own modules

Reviewed By: jvillard

Differential Revision: D4106265

fbshipit-source-id: 10c6659

infer/src/quandary/CppTrace.ml

@@ -14,7 +14,7 @@ module L = Logging
 
 module CppSource = struct
 
-  module SourceKind = struct
+  module Kind = struct
     type t =
       | Footprint of AccessPath.t (** source that was read from the environment. *)
       | EnvironmentVariable (** source that was read from an environment variable *)
@@ -23,22 +23,28 @@ module CppSource = struct
     let compare sk1 sk2 = match sk1, sk2 with
       | Footprint ap1, Footprint ap2 -> AccessPath.compare ap1 ap2
       | _ -> tags_compare sk1 sk2
-  end
 
-  type kind = SourceKind.t
+    let equal sk1 sk2 =
+      compare sk1 sk2 = 0
+
+    let pp fmt = function
+      | Footprint ap -> F.fprintf fmt "Footprint[%a]" AccessPath.pp ap
+      | EnvironmentVariable -> F.fprintf fmt "EnvironmentVariable"
+      | Other -> F.fprintf fmt "Other"
+  end
 
   type t =
     {
-      kind : kind;
+      kind : Kind.t;
       site : CallSite.t;
     }
 
   let is_footprint t = match t.kind with
-    | SourceKind.Footprint _ -> true
+    | Kind.Footprint _ -> true
     | _ -> false
 
   let get_footprint_access_path t = match t.kind with
-    | SourceKind.Footprint access_path -> Some access_path
+    | Kind.Footprint access_path -> Some access_path
     | _ -> None
 
   let call_site t =
@@ -51,7 +57,7 @@ module CppSource = struct
     { site; kind; }
 
   let make_footprint ap site =
-    { kind = SourceKind.Footprint ap; site; }
+    { kind = Kind.Footprint ap; site; }
 
   let get site = match CallSite.pname site with
     | (Procname.ObjC_Cpp cpp_pname) as pname ->
@@ -77,19 +83,14 @@ module CppSource = struct
     { t with site = callee_site; }
 
   let compare src1 src2 =
-    SourceKind.compare src1.kind src2.kind
+    Kind.compare src1.kind src2.kind
     |> next CallSite.compare src1.site src2.site
 
   let equal t1 t2 =
     compare t1 t2 = 0
 
-  let pp_kind fmt (kind : kind) = match kind with
-    | Footprint ap -> F.fprintf fmt "Footprint[%a]" AccessPath.pp ap
-    | EnvironmentVariable -> F.fprintf fmt "EnvironmentVariable"
-    | Other -> F.fprintf fmt "Other"
-
   let pp fmt s =
-    F.fprintf fmt "%a(%a)" pp_kind s.kind CallSite.pp s.site
+    F.fprintf fmt "%a(%a)" Kind.pp s.kind CallSite.pp s.site
 
   module Set = PrettyPrintable.MakePPSet(struct
       type nonrec t = t
@@ -100,19 +101,24 @@ end
 
 module CppSink = struct
 
-  module SinkKind = struct
+  module Kind = struct
     type t =
       | ShellExec (** shell exec function *)
       | Other (** for testing or uncategorized sinks *)
 
     let compare snk1 snk2 = tags_compare snk1 snk2
-  end
 
-  type kind = SinkKind.t
+    let equal snk1 snk2 =
+      compare snk1 snk2 = 0
+
+    let pp fmt = function
+      | ShellExec -> F.fprintf fmt "ShellExec"
+      | Other -> F.fprintf fmt "Other"
+  end
 
   type t =
     {
-      kind : kind;
+      kind : Kind.t;
       site : CallSite.t;
     }
 
@@ -157,18 +163,14 @@ module CppSink = struct
     { t with site = callee_site; }
 
   let compare snk1 snk2 =
-    SinkKind.compare snk1.kind snk2.kind
+    Kind.compare snk1.kind snk2.kind
     |> next CallSite.compare snk1.site snk2.site
 
   let equal t1 t2 =
     compare t1 t2 = 0
 
-  let pp_kind fmt (kind : kind) = match kind with
-    | ShellExec -> F.fprintf fmt "ShellExec"
-    | Other -> F.fprintf fmt "Other"
-
   let pp fmt s =
-    F.fprintf fmt "%a(%a)" pp_kind s.kind CallSite.pp s.site
+    F.fprintf fmt "%a(%a)" Kind.pp s.kind CallSite.pp s.site
 
   module Set = PrettyPrintable.MakePPSet(struct
       type nonrec t = t
@@ -183,12 +185,10 @@ include
     module Sink = CppSink
 
     let should_report source sink =
-      let open Source in
-      let open Sink in
       match Source.kind source, Sink.kind sink with
-      | SourceKind.EnvironmentVariable, SinkKind.ShellExec ->
+      | Source.Kind.EnvironmentVariable, Sink.Kind.ShellExec ->
           true
-      | SourceKind.Other, SinkKind.Other ->
+      | Source.Kind.Other, Sink.Kind.Other ->
           true
       | _ ->
           false
@@ -202,5 +202,4 @@ include
       let msg = Localise.to_string Localise.quandary_taint_error in
       let description = pp_to_string pp_error () in
       Exceptions.Checkers (msg, Localise.verbatim_desc description)
-
   end)

infer/src/quandary/JavaTrace.ml

@@ -14,7 +14,7 @@ module L = Logging
 
 module JavaSource = struct
 
-  module SourceKind = struct
+  module Kind = struct
     type t =
       | PrivateData (** private user or device-specific data *)
       | Footprint of AccessPath.t (** source that was read from the environment. *)
@@ -25,22 +25,26 @@ module JavaSource = struct
       | PrivateData, PrivateData -> 0
       | Footprint ap1, Footprint ap2 -> AccessPath.compare ap1 ap2
       | _ -> tags_compare sk1 sk2
-  end
 
-  type kind = SourceKind.t
+    let pp fmt = function
+      | Intent -> F.fprintf fmt "Intent"
+      | PrivateData -> F.fprintf fmt "PrivateData"
+      | Footprint ap -> F.fprintf fmt "Footprint[%a]" AccessPath.pp ap
+      | Other -> F.fprintf fmt "Other"
+  end
 
   type t =
     {
-      kind : kind;
+      kind : Kind.t;
       site : CallSite.t;
     }
 
   let is_footprint t = match t.kind with
-    | SourceKind.Footprint _ -> true
+    | Kind.Footprint _ -> true
     | _ -> false
 
   let get_footprint_access_path t = match t.kind with
-    | SourceKind.Footprint access_path -> Some access_path
+    | Kind.Footprint access_path -> Some access_path
     | _ -> None
 
   let call_site t =
@@ -53,7 +57,7 @@ module JavaSource = struct
     { site; kind; }
 
   let make_footprint ap site =
-    { kind = (SourceKind.Footprint ap); site; }
+    { kind = Kind.Footprint ap; site; }
 
   let get site = match CallSite.pname site with
     | Procname.Java pname ->
@@ -85,20 +89,11 @@ module JavaSource = struct
     { t with site = callee_site; }
 
   let compare src1 src2 =
-    SourceKind.compare src1.kind src2.kind
+    Kind.compare src1.kind src2.kind
     |> next CallSite.compare src1.site src2.site
 
-  let equal t1 t2 =
-    compare t1 t2 = 0
-
-  let pp_kind fmt (kind : kind) = match kind with
-    | Intent -> F.fprintf fmt "Intent"
-    | PrivateData -> F.fprintf fmt "PrivateData"
-    | Footprint ap -> F.fprintf fmt "Footprint[%a]" AccessPath.pp ap
-    | Other -> F.fprintf fmt "Other"
-
   let pp fmt s =
-    F.fprintf fmt "%a(%a)" pp_kind s.kind CallSite.pp s.site
+    F.fprintf fmt "%a(%a)" Kind.pp s.kind CallSite.pp s.site
 
   module Set = PrettyPrintable.MakePPSet(struct
       type nonrec t = t
@@ -109,20 +104,23 @@ end
 
 module JavaSink = struct
 
-  module SinkKind = struct
+  module Kind = struct
     type t =
       | Intent (** sink that trusts an Intent *)
       | Logging (** sink that logs one or more of its arguments *)
       | Other (** for testing or uncategorized sinks *)
 
     let compare snk1 snk2 = tags_compare snk1 snk2
-  end
 
-  type kind = SinkKind.t
+    let pp fmt = function
+      | Intent -> F.fprintf fmt "Intent"
+      | Logging -> F.fprintf fmt "Logging"
+      | Other -> F.fprintf fmt "Other"
+  end
 
   type t =
     {
-      kind : kind;
+      kind : Kind.t;
       site : CallSite.t;
     }
 
@@ -187,19 +185,11 @@ module JavaSink = struct
     { t with site = callee_site; }
 
   let compare snk1 snk2 =
-    SinkKind.compare snk1.kind snk2.kind
+    Kind.compare snk1.kind snk2.kind
     |> next CallSite.compare snk1.site snk2.site
 
-  let equal t1 t2 =
-    compare t1 t2 = 0
-
-  let pp_kind fmt (kind : kind) = match kind with
-    | Intent -> F.fprintf fmt "Intent"
-    | Logging -> F.fprintf fmt "Logging"
-    | Other -> F.fprintf fmt "Other"
-
   let pp fmt s =
-    F.fprintf fmt "%a(%a)" pp_kind s.kind CallSite.pp s.site
+    F.fprintf fmt "%a(%a)" Kind.pp s.kind CallSite.pp s.site
 
   module Set = PrettyPrintable.MakePPSet(struct
       type nonrec t = t
@@ -214,13 +204,11 @@ include
     module Sink = JavaSink
 
     let should_report source sink =
-      let open Source in
-      let open Sink in
       match Source.kind source, Sink.kind sink with
-      | SourceKind.Other, SinkKind.Other
+      | Source.Kind.Other, Sink.Kind.Other
-      | SourceKind.PrivateData, SinkKind.Logging ->
+      | Source.Kind.PrivateData, Sink.Kind.Logging ->
           true
-      | SourceKind.Intent, SinkKind.Intent ->
+      | Source.Kind.Intent, Sink.Kind.Intent ->
           true
       | _ ->
           false
@@ -234,5 +222,4 @@ include
       let msg = Localise.to_string Localise.quandary_taint_error in
       let description = pp_to_string pp_error () in
       Exceptions.Checkers (msg, Localise.verbatim_desc description)
-
   end)

infer/src/quandary/TraceElem.ml

@@ -9,19 +9,24 @@
 
 module F = Format
 
+module type Kind = sig
+  type t
+
+  val compare : t -> t -> int
+  val pp : F.formatter -> t -> unit
+end
+
 module type S = sig
-  type kind
   type t
 
+  module Kind : Kind
+
   val call_site : t -> CallSite.t
-  val kind : t -> kind
+  val kind : t -> Kind.t
 
-  val make : kind -> CallSite.t -> t
+  val make : Kind.t -> CallSite.t -> t
   val to_callee : t -> CallSite.t -> t
 
-  val compare : t -> t -> int
-  val equal : t -> t -> bool
-  val pp_kind : F.formatter -> kind -> unit
   val pp : F.formatter -> t -> unit
 
   module Set : PrettyPrintable.PPSet with type elt = t

infer/src/unit/TaintTests.ml

@@ -13,15 +13,19 @@ module F = Format
 
 module MockTrace = Trace.Make(struct
     module MockTraceElem = struct
-      type kind = unit
       type t = CallSite.t
+
+      module Kind = struct
+        type t = unit
+        let compare _ _ = assert false
+        let pp _ _ = assert false
+      end
+
       let call_site t = t
       let kind _ = ()
       let make _ site = site
       let compare = CallSite.compare
-      let equal = CallSite.equal
       let pp = CallSite.pp
-      let pp_kind _ _ = assert false
 
       let to_callee t _ = t
 

infer/src/unit/TraceTests.ml

@@ -13,13 +13,11 @@ module L = Logging
 module F = Format
 
 module MockTraceElem = struct
-  type kind =
+  type t =
     | Kind1
     | Kind2
     | Footprint
 
-  type t = kind
-
   let call_site _ = CallSite.dummy
 
   let kind t = t
@@ -39,12 +37,16 @@ module MockTraceElem = struct
   let equal t1 t2 =
     compare t1 t2 = 0
 
-  let pp_kind fmt = function
+  let pp fmt = function
     | Kind1 -> F.fprintf fmt "Kind1"
     | Kind2 -> F.fprintf fmt "Kind2"
     | Footprint -> F.fprintf fmt "Footprint"
 
-  let pp = pp_kind
+  module Kind = struct
+    type nonrec t = t
+    let compare = compare
+    let pp = pp
+  end
 
   module Set = PrettyPrintable.MakePPSet(struct
       type nonrec t = t