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

[inferbo] Use inline record for Loc.Field

Browse Source 
Summary:
It uses inline record for Loc.Field

Depends on D16807279

Reviewed By: ezgicicek

Differential Revision: D16807299

fbshipit-source-id: 45eab34a4
master
Sungkeun Cho 6 years ago committed by Facebook Github Bot
parent d287177820
commit 761d8bd614
5 changed files with 47 additions and 45 deletions
Show Stats Download Patch File Download Diff File

48
infer/src/bufferoverrun/absLoc.ml
Unescape View File

@ -132,7 +132,7 @@ module Loc = struct
type t = type t =
| Var of Var.t | Var of Var.t
| Allocsite of Allocsite.t | Allocsite of Allocsite.t
| Field of t * Typ.Fieldname.t | Field of {prefix: t; fn: Typ.Fieldname.t}
| StarField of {prefix: t; last_field: Typ.Fieldname.t} | StarField of {prefix: t; last_field: Typ.Fieldname.t}
[@@deriving compare] [@@deriving compare]
@ -143,14 +143,14 @@ module Loc = struct
let append_field l0 ~fn = let append_field l0 ~fn =
let rec aux = function let rec aux = function
| Var _ | Allocsite _ -> | Var _ | Allocsite _ ->
Field (l0, fn) Field {prefix= l0; fn}
| StarField {last_field} as l when Typ.Fieldname.equal fn last_field -> | StarField {last_field} as l when Typ.Fieldname.equal fn last_field ->
l l
| StarField {prefix} -> | StarField {prefix} ->
StarField {prefix; last_field= fn} StarField {prefix; last_field= fn}
| Field (_, fn') when Typ.Fieldname.equal fn fn' -> | Field {fn= fn'} when Typ.Fieldname.equal fn fn' ->
StarField {prefix= l0; last_field= fn} StarField {prefix= l0; last_field= fn}
| Field (l, _) -> | Field {prefix= l} ->
aux l aux l
in in
aux l0 aux l0
@ -164,7 +164,7 @@ module Loc = struct
l l
| StarField {prefix} -> | StarField {prefix} ->
StarField {prefix; last_field= fn} StarField {prefix; last_field= fn}
| Field (l, _) -> | Field {prefix= l} ->
aux l aux l
in in
aux l0 aux l0
@ -173,7 +173,7 @@ module Loc = struct
type t = private type t = private
| Var of Var.t | Var of Var.t
| Allocsite of Allocsite.t | Allocsite of Allocsite.t
| Field of t * Typ.Fieldname.t | Field of {prefix: t; fn: Typ.Fieldname.t}
| StarField of {prefix: t; last_field: Typ.Fieldname.t} | StarField of {prefix: t; last_field: Typ.Fieldname.t}
[@@deriving compare] [@@deriving compare]
@ -199,7 +199,7 @@ module Loc = struct
false false
| Allocsite a -> | Allocsite a ->
Allocsite.is_unknown a Allocsite.is_unknown a
| Field (x, _) | StarField {prefix= x} -> | Field {prefix= x} | StarField {prefix= x} ->
is_unknown x is_unknown x
@ -215,17 +215,19 @@ module Loc = struct
| Allocsite a -> | Allocsite a ->
Allocsite.pp_paren ~paren fmt a Allocsite.pp_paren ~paren fmt a
| Field | Field
( Allocsite { prefix=
Allocsite
(Allocsite.Symbol (SP.Deref ((SP.Deref_COneValuePointer | SP.Deref_CPointer), p))) (Allocsite.Symbol (SP.Deref ((SP.Deref_COneValuePointer | SP.Deref_CPointer), p)))
, f ) ; fn= f }
| Field | Field
( Allocsite { prefix=
Allocsite
(Allocsite.Known (Allocsite.Known
{path= Some (SP.Deref ((SP.Deref_COneValuePointer | SP.Deref_CPointer), p))}) {path= Some (SP.Deref ((SP.Deref_COneValuePointer | SP.Deref_CPointer), p))})
, f ) -> ; fn= f } ->
BufferOverrunField.pp ~pp_lhs:(SP.pp_partial_paren ~paren:true) BufferOverrunField.pp ~pp_lhs:(SP.pp_partial_paren ~paren:true)
~pp_lhs_alone:(SP.pp_pointer ~paren) ~sep:"->" fmt p f ~pp_lhs_alone:(SP.pp_pointer ~paren) ~sep:"->" fmt p f
| Field (l, f) -> | Field {prefix= l; fn= f} ->
BufferOverrunField.pp ~pp_lhs:(pp_paren ~paren:true) ~pp_lhs_alone:(pp_paren ~paren) BufferOverrunField.pp ~pp_lhs:(pp_paren ~paren:true) ~pp_lhs_alone:(pp_paren ~paren)
~sep:"." fmt l f ~sep:"." fmt l f
| StarField {prefix; last_field} -> | StarField {prefix; last_field} ->
@ -242,14 +244,14 @@ module Loc = struct
let is_var = function Var _ -> true | _ -> false let is_var = function Var _ -> true | _ -> false
let is_c_strlen = function let is_c_strlen = function
| Field (_, fn) -> | Field {fn} ->
Typ.Fieldname.equal fn (BufferOverrunField.c_strlen ()) Typ.Fieldname.equal fn (BufferOverrunField.c_strlen ())
| _ -> | _ ->
false false
let is_java_collection_internal_array = function let is_java_collection_internal_array = function
| Field (_, fn) -> | Field {fn} ->
Typ.Fieldname.equal fn BufferOverrunField.java_collection_internal_array Typ.Fieldname.equal fn BufferOverrunField.java_collection_internal_array
| _ -> | _ ->
false false
@ -260,7 +262,7 @@ module Loc = struct
true true
| Allocsite a -> | Allocsite a ->
Allocsite.is_pretty a Allocsite.is_pretty a
| Field (loc, _) | StarField {prefix= loc} -> | Field {prefix= loc} | StarField {prefix= loc} ->
is_pretty loc is_pretty loc
@ -276,7 +278,7 @@ module Loc = struct
of_pvar pvar of_pvar pvar
| Symb.SymbolPath.Deref _ | Symb.SymbolPath.Callsite _ -> | Symb.SymbolPath.Deref _ | Symb.SymbolPath.Callsite _ ->
of_allocsite (Allocsite.make_symbol path) of_allocsite (Allocsite.make_symbol path)
| Symb.SymbolPath.Field (fn, path) -> | Symb.SymbolPath.Field {fn; prefix= path} ->
append_field (of_path path) ~fn append_field (of_path path) ~fn
| Symb.SymbolPath.StarField {last_field= fn; prefix} -> | Symb.SymbolPath.StarField {last_field= fn; prefix} ->
append_star_field (of_path prefix) ~fn append_star_field (of_path prefix) ~fn
@ -290,13 +292,13 @@ module Loc = struct
let is_field_of ~loc ~field_loc = let is_field_of ~loc ~field_loc =
match field_loc with Field (l, _) | StarField {prefix= l} -> equal loc l | _ -> false match field_loc with Field {prefix= l} | StarField {prefix= l} -> equal loc l | _ -> false
let is_literal_string = function Allocsite a -> Allocsite.is_literal_string a | _ -> None let is_literal_string = function Allocsite a -> Allocsite.is_literal_string a | _ -> None
let is_literal_string_strlen = function let is_literal_string_strlen = function
| Field (l, fn) when Typ.Fieldname.equal (BufferOverrunField.c_strlen ()) fn -> | Field {prefix= l; fn} when Typ.Fieldname.equal (BufferOverrunField.c_strlen ()) fn ->
is_literal_string l is_literal_string l
| _ -> | _ ->
None None
@ -307,7 +309,7 @@ module Loc = struct
Pvar.is_global pvar Pvar.is_global pvar
| Var (Var.LogicalVar _) | Allocsite _ -> | Var (Var.LogicalVar _) | Allocsite _ ->
false false
| Field (loc, _) | StarField {prefix= loc} -> | Field {prefix= loc} | StarField {prefix= loc} ->
is_global loc is_global loc
@ -318,7 +320,7 @@ module Loc = struct
Some (Symb.SymbolPath.of_pvar pvar) Some (Symb.SymbolPath.of_pvar pvar)
| Allocsite allocsite -> | Allocsite allocsite ->
Allocsite.get_path allocsite Allocsite.get_path allocsite
| Field (l, fn) -> | Field {prefix= l; fn} ->
Option.map (get_path l) ~f:(fun p -> Symb.SymbolPath.field p fn) Option.map (get_path l) ~f:(fun p -> Symb.SymbolPath.field p fn)
| StarField {prefix; last_field} -> | StarField {prefix; last_field} ->
get_path prefix |> Option.map ~f:(fun p -> Symb.SymbolPath.star_field p last_field) get_path prefix |> Option.map ~f:(fun p -> Symb.SymbolPath.star_field p last_field)
@ -329,7 +331,7 @@ module Loc = struct
None None
| Allocsite allocsite -> | Allocsite allocsite ->
Allocsite.get_param_path allocsite Allocsite.get_param_path allocsite
| Field (l, fn) -> | Field {prefix= l; fn} ->
Option.map (get_param_path l) ~f:(fun p -> Symb.SymbolPath.field p fn) Option.map (get_param_path l) ~f:(fun p -> Symb.SymbolPath.field p fn)
| StarField {prefix; last_field} -> | StarField {prefix; last_field} ->
get_param_path prefix |> Option.map ~f:(fun p -> Symb.SymbolPath.star_field p last_field) get_param_path prefix |> Option.map ~f:(fun p -> Symb.SymbolPath.star_field p last_field)
@ -342,7 +344,7 @@ module Loc = struct
Allocsite.represents_multiple_values allocsite Allocsite.represents_multiple_values allocsite
| Field _ as x when is_c_strlen x || is_java_collection_internal_array x -> | Field _ as x when is_c_strlen x || is_java_collection_internal_array x ->
false false
| Field (l, _) -> | Field {prefix= l} ->
represents_multiple_values l represents_multiple_values l
| StarField _ -> | StarField _ ->
true true
@ -355,7 +357,7 @@ module Loc = struct
f pvar f pvar
| Allocsite allocsite -> | Allocsite allocsite ->
Allocsite.exists_pvar ~f allocsite Allocsite.exists_pvar ~f allocsite
| Field (l, _) | StarField {prefix= l} -> | Field {prefix= l} | StarField {prefix= l} ->
exists_pvar ~f l exists_pvar ~f l

4
infer/src/bufferoverrun/bufferOverrunOndemandEnv.ml
Unescape View File

@ -51,7 +51,7 @@ let mk pdesc =
L.(die InternalError) "Deref of unmodeled type `%a`" Typ.Name.pp typename ) L.(die InternalError) "Deref of unmodeled type `%a`" Typ.Name.pp typename )
| _ -> | _ ->
L.(die InternalError) "Untyped expression is given." ) ) L.(die InternalError) "Untyped expression is given." ) )
| SPath.Field (fn, x) -> ( | SPath.Field {fn; prefix= x} -> (
match BufferOverrunField.get_type fn with match BufferOverrunField.get_type fn with
| None -> | None ->
let lookup = Tenv.lookup tenv in let lookup = Tenv.lookup tenv in
@ -70,7 +70,7 @@ let mk pdesc =
let rec may_last_field = function let rec may_last_field = function
| SPath.Pvar _ | SPath.Deref _ | SPath.Callsite _ -> | SPath.Pvar _ | SPath.Deref _ | SPath.Callsite _ ->
true true
| SPath.Field (fn, x) | SPath.StarField {last_field= fn; prefix= x} -> | SPath.Field {fn; prefix= x} | SPath.StarField {last_field= fn; prefix= x} ->
may_last_field x may_last_field x
&& Option.value_map ~default:true (typ_of_param_path x) ~f:(fun parent_typ -> && Option.value_map ~default:true (typ_of_param_path x) ~f:(fun parent_typ ->
match parent_typ.Typ.desc with match parent_typ.Typ.desc with

2
infer/src/bufferoverrun/bufferOverrunSemantics.ml
Unescape View File

@ -415,7 +415,7 @@ and eval_locpath ~mode params p mem =
| Symb.SymbolPath.Deref (_, p) -> | Symb.SymbolPath.Deref (_, p) ->
let v = eval_sympath_partial ~mode params p mem in let v = eval_sympath_partial ~mode params p mem in
Val.get_all_locs v Val.get_all_locs v
| Symb.SymbolPath.Field (fn, p) -> | Symb.SymbolPath.Field {fn; prefix= p} ->
let locs = eval_locpath ~mode params p mem in let locs = eval_locpath ~mode params p mem in
PowLoc.append_field ~fn locs PowLoc.append_field ~fn locs
| Symb.SymbolPath.StarField {last_field= fn; prefix} -> | Symb.SymbolPath.StarField {last_field= fn; prefix} ->

30
infer/src/bufferoverrun/symb.ml
Unescape View File

@ -32,7 +32,7 @@ module SymbolPath = struct
type partial = type partial =
| Pvar of Pvar.t | Pvar of Pvar.t
| Deref of deref_kind * partial | Deref of deref_kind * partial
| Field of Typ.Fieldname.t * partial | Field of {fn: Typ.Fieldname.t; prefix: partial}
| Callsite of {ret_typ: Typ.t; cs: CallSite.t} | Callsite of {ret_typ: Typ.t; cs: CallSite.t}
| StarField of {last_field: Typ.Fieldname.t; prefix: partial} | StarField of {last_field: Typ.Fieldname.t; prefix: partial}
[@@deriving compare] [@@deriving compare]
@ -47,7 +47,7 @@ module SymbolPath = struct
let rec aux = function let rec aux = function
| Pvar _ | Callsite _ -> | Pvar _ | Callsite _ ->
StarField {last_field= fn; prefix= p0} StarField {last_field= fn; prefix= p0}
| Deref (_, p) | Field (_, p) -> | Deref (_, p) | Field {prefix= p} ->
aux p aux p
| StarField {last_field} as p when Typ.Fieldname.equal fn last_field -> | StarField {last_field} as p when Typ.Fieldname.equal fn last_field ->
p p
@ -60,10 +60,10 @@ module SymbolPath = struct
let field p0 fn = let field p0 fn =
let rec aux = function let rec aux = function
| Pvar _ | Callsite _ -> | Pvar _ | Callsite _ ->
Field (fn, p0) Field {fn; prefix= p0}
| Field (fn', _) when Typ.Fieldname.equal fn fn' -> | Field {fn= fn'} when Typ.Fieldname.equal fn fn' ->
StarField {last_field= fn; prefix= p0} StarField {last_field= fn; prefix= p0}
| Field (_, p) | Deref (_, p) -> | Field {prefix= p} | Deref (_, p) ->
aux p aux p
| StarField {last_field} as p when Typ.Fieldname.equal fn last_field -> | StarField {last_field} as p when Typ.Fieldname.equal fn last_field ->
p p
@ -76,7 +76,7 @@ module SymbolPath = struct
type partial = private type partial = private
| Pvar of Pvar.t | Pvar of Pvar.t
| Deref of deref_kind * partial | Deref of deref_kind * partial
| Field of Typ.Fieldname.t * partial | Field of {fn: Typ.Fieldname.t; prefix: partial}
| Callsite of {ret_typ: Typ.t; cs: CallSite.t} | Callsite of {ret_typ: Typ.t; cs: CallSite.t}
| StarField of {last_field: Typ.Fieldname.t; prefix: partial} | StarField of {last_field: Typ.Fieldname.t; prefix: partial}
[@@deriving compare] [@@deriving compare]
@ -116,7 +116,7 @@ module SymbolPath = struct
let rec get_pvar = function let rec get_pvar = function
| Pvar pvar -> | Pvar pvar ->
Some pvar Some pvar
| Deref (_, partial) | Field (_, partial) | StarField {prefix= partial} -> | Deref (_, partial) | Field {prefix= partial} | StarField {prefix= partial} ->
get_pvar partial get_pvar partial
| Callsite _ -> | Callsite _ ->
None None
@ -131,10 +131,10 @@ module SymbolPath = struct
F.fprintf fmt "%a[*]" (pp_partial_paren ~paren:true) p F.fprintf fmt "%a[*]" (pp_partial_paren ~paren:true) p
| Deref ((Deref_COneValuePointer | Deref_CPointer | Deref_JavaPointer), p) -> | Deref ((Deref_COneValuePointer | Deref_CPointer | Deref_JavaPointer), p) ->
pp_pointer ~paren fmt p pp_pointer ~paren fmt p
| Field (fn, Deref ((Deref_COneValuePointer | Deref_CPointer), p)) -> | Field {fn; prefix= Deref ((Deref_COneValuePointer | Deref_CPointer), p)} ->
BufferOverrunField.pp ~pp_lhs:(pp_partial_paren ~paren:true) BufferOverrunField.pp ~pp_lhs:(pp_partial_paren ~paren:true)
~pp_lhs_alone:(pp_pointer ~paren) ~sep:"->" fmt p fn ~pp_lhs_alone:(pp_pointer ~paren) ~sep:"->" fmt p fn
| Field (fn, p) -> | Field {fn; prefix= p} ->
BufferOverrunField.pp ~pp_lhs:(pp_partial_paren ~paren:true) BufferOverrunField.pp ~pp_lhs:(pp_partial_paren ~paren:true)
~pp_lhs_alone:(pp_partial_paren ~paren) ~sep:"." fmt p fn ~pp_lhs_alone:(pp_partial_paren ~paren) ~sep:"." fmt p fn
| Callsite {cs} -> | Callsite {cs} ->
@ -178,7 +178,7 @@ module SymbolPath = struct
| Deref (Deref_CPointer, p) | Deref (Deref_CPointer, p)
(* Deref_CPointer is unsound here but avoids many FPs for non-array pointers *) (* Deref_CPointer is unsound here but avoids many FPs for non-array pointers *)
| Deref ((Deref_COneValuePointer | Deref_JavaPointer), p) | Deref ((Deref_COneValuePointer | Deref_JavaPointer), p)
| Field (_, p) -> | Field {prefix= p} ->
represents_multiple_values p represents_multiple_values p
@ -189,7 +189,7 @@ module SymbolPath = struct
false false
| Deref ((Deref_ArrayIndex | Deref_CPointer), _) -> | Deref ((Deref_ArrayIndex | Deref_CPointer), _) ->
true true
| Deref ((Deref_COneValuePointer | Deref_JavaPointer), p) | Field (_, p) -> | Deref ((Deref_COneValuePointer | Deref_JavaPointer), p) | Field {prefix= p} ->
represents_multiple_values_sound p represents_multiple_values_sound p
@ -198,14 +198,14 @@ module SymbolPath = struct
true true
| Pvar _ -> | Pvar _ ->
false false
| Deref (_, p) | Field (_, p) | StarField {prefix= p} -> | Deref (_, p) | Field {prefix= p} | StarField {prefix= p} ->
represents_callsite_sound_partial p represents_callsite_sound_partial p
let rec exists_pvar_partial ~f = function let rec exists_pvar_partial ~f = function
| Pvar pvar -> | Pvar pvar ->
f pvar f pvar
| Deref (_, p) | Field (_, p) | StarField {prefix= p} -> | Deref (_, p) | Field {prefix= p} | StarField {prefix= p} ->
exists_pvar_partial ~f p exists_pvar_partial ~f p
| Callsite _ -> | Callsite _ ->
false false
@ -216,7 +216,7 @@ module SymbolPath = struct
f (Pvar.to_string pvar) f (Pvar.to_string pvar)
| Deref (_, x) -> | Deref (_, x) ->
exists_str_partial ~f x exists_str_partial ~f x
| Field (fld, x) | StarField {last_field= fld; prefix= x} -> | Field {fn= fld; prefix= x} | StarField {last_field= fld; prefix= x} ->
f (Typ.Fieldname.to_string fld) || exists_str_partial ~f x f (Typ.Fieldname.to_string fld) || exists_str_partial ~f x
| Callsite _ -> | Callsite _ ->
false false
@ -235,7 +235,7 @@ module SymbolPath = struct
let is_cpp_vector_elem = function let is_cpp_vector_elem = function
| Field (fn, _) -> | Field {fn} ->
BufferOverrunField.is_cpp_vector_elem fn BufferOverrunField.is_cpp_vector_elem fn
| _ -> | _ ->
false false

2
infer/src/bufferoverrun/symb.mli
Unescape View File

@ -25,7 +25,7 @@ module SymbolPath : sig
type partial = private type partial = private
| Pvar of Pvar.t | Pvar of Pvar.t
| Deref of deref_kind * partial | Deref of deref_kind * partial
| Field of Typ.Fieldname.t * partial | Field of {fn: Typ.Fieldname.t; prefix: partial}
| Callsite of {ret_typ: Typ.t; cs: CallSite.t} | Callsite of {ret_typ: Typ.t; cs: CallSite.t}
| StarField of {last_field: Typ.Fieldname.t; prefix: partial} | StarField of {last_field: Typ.Fieldname.t; prefix: partial}
(** (**

Write Preview
Loading…
Cancel
Save