diff --git a/infer/src/base/Utils.ml b/infer/src/base/Utils.ml index d523db6e4..9098f4c55 100644 --- a/infer/src/base/Utils.ml +++ b/infer/src/base/Utils.ml @@ -81,6 +81,23 @@ let trd3 (_,_,x) = x let int_of_bool b = if b then 1 else 0 +let tags_compare (x : 'a) (y : 'a) = + let x = Obj.repr x + and y = Obj.repr y in + if Obj.is_int x + then + if Obj.is_int y + (* we can use (-) because tags are small and won't overflow *) + then Obj.obj x - Obj.obj y + else -1 + else if Obj.is_int y + then 1 + else + let r = Obj.tag x - Obj.tag y in + if r = 0 + then failwith "Comparing parameterized constructors" + else r + (** {2 Useful Modules} *) (** Set of integers *) diff --git a/infer/src/base/Utils.mli b/infer/src/base/Utils.mli index a12ce03ff..fdcd02b40 100644 --- a/infer/src/base/Utils.mli +++ b/infer/src/base/Utils.mli @@ -69,6 +69,10 @@ val string_equal : string -> string -> bool (** Comparison for floats *) val float_compare : float -> float -> int +(** Use this function to compare sum types (ONLY!) in the default case of your custom compare + function. It will fail if you try to check equality of parameterized constructors *) +val tags_compare: 'a -> 'a -> int + (** Return the first component of a triple. *) val fst3 : 'a * 'b * 'c -> 'a diff --git a/infer/src/quandary/CppTrace.ml b/infer/src/quandary/CppTrace.ml index 2955e1e6c..544030ecf 100644 --- a/infer/src/quandary/CppTrace.ml +++ b/infer/src/quandary/CppTrace.ml @@ -22,12 +22,7 @@ module CppSource = struct let compare sk1 sk2 = match sk1, sk2 with | Footprint ap1, Footprint ap2 -> AccessPath.compare ap1 ap2 - | Footprint _, _ -> (-1) - | _, Footprint _ -> 1 - | EnvironmentVariable, EnvironmentVariable -> 0 - | EnvironmentVariable, _ -> (-1) - | _, EnvironmentVariable -> 1 - | Other, Other -> 0 + | _ -> tags_compare sk1 sk2 end type kind = SourceKind.t @@ -107,11 +102,7 @@ module CppSink = struct | ShellExec (** shell exec function *) | Other (** for testing or uncategorized sinks *) - let compare snk1 snk2 = match snk1, snk2 with - | ShellExec, ShellExec -> 0 - | ShellExec, _ -> (-1) - | _, ShellExec -> 1 - | Other, Other -> 0 + let compare snk1 snk2 = tags_compare snk1 snk2 end type kind = SinkKind.t diff --git a/infer/src/quandary/JavaTrace.ml b/infer/src/quandary/JavaTrace.ml index 631f81941..393caff8a 100644 --- a/infer/src/quandary/JavaTrace.ml +++ b/infer/src/quandary/JavaTrace.ml @@ -22,16 +22,8 @@ module JavaSource = struct | Other (** for testing or uncategorized sources *) let compare sk1 sk2 = match sk1, sk2 with - | SharedPreferences, SharedPreferences -> 0 - | SharedPreferences, _ -> (-1) - | _, SharedPreferences -> 1 | Footprint ap1, Footprint ap2 -> AccessPath.compare ap1 ap2 - | Footprint _, _ -> (-1) - | _, Footprint _ -> 1 - | Intent, Intent -> 0 - | Intent, _ -> (-1) - | _, Intent -> 1 - | Other, Other -> 0 + | _ -> tags_compare sk1 sk2 end type kind = SourceKind.t @@ -109,14 +101,7 @@ module JavaSink = struct | Logging (** sink that logs one or more of its arguments *) | Other (** for testing or uncategorized sinks *) - let compare snk1 snk2 = match snk1, snk2 with - | Logging, Logging -> 0 - | Logging, _ -> (-1) - | _, Logging -> 1 - | Intent, Intent -> 0 - | Intent, _ -> (-1) - | _, Intent -> 1 - | Other, Other -> 0 + let compare snk1 snk2 = tags_compare snk1 snk2 end type kind = SinkKind.t