From c147ab419712f8df7aaf0ff55d5211a970b5e39d Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Mon, 8 Aug 2016 09:48:13 -0700 Subject: [PATCH] Refactor Sil.attribute and associates to PredSymb Summary: Move the Sil.attribute type and associated types and operations to a new PredSymb module. Reviewed By: cristianoc Differential Revision: D3683834 fbshipit-source-id: d3606a8 --- infer/src/IR/Cfg.rei | 2 +- infer/src/IR/PredSymb.re | 363 ++++++++++++++++++++++++++++ infer/src/IR/PredSymb.rei | 160 ++++++++++++ infer/src/IR/ProcAttributes.re | 6 +- infer/src/IR/ProcAttributes.rei | 4 +- infer/src/IR/Sil.re | 361 +-------------------------- infer/src/IR/Sil.rei | 151 +----------- infer/src/backend/abs.ml | 30 +-- infer/src/backend/errdesc.ml | 24 +- infer/src/backend/errdesc.mli | 14 +- infer/src/backend/exceptions.ml | 13 +- infer/src/backend/exceptions.mli | 4 +- infer/src/backend/interproc.ml | 12 +- infer/src/backend/localise.ml | 44 ++-- infer/src/backend/localise.mli | 8 +- infer/src/backend/modelBuiltins.ml | 84 +++---- infer/src/backend/paths.ml | 12 +- infer/src/backend/paths.mli | 6 +- infer/src/backend/printer.ml | 4 +- infer/src/backend/prop.ml | 38 +-- infer/src/backend/prop.mli | 22 +- infer/src/backend/rearrange.ml | 2 +- infer/src/backend/state.ml | 2 +- infer/src/backend/state.mli | 8 +- infer/src/backend/symExec.ml | 10 +- infer/src/backend/symExec.mli | 3 +- infer/src/backend/tabulation.ml | 28 +-- infer/src/backend/tabulation.mli | 4 +- infer/src/backend/taint.ml | 68 +++--- infer/src/backend/taint.mli | 11 +- infer/src/checkers/patternMatch.ml | 2 +- infer/src/checkers/patternMatch.mli | 2 +- infer/src/clang/cMethod_trans.ml | 2 +- infer/src/eradicate/eradicate.ml | 2 +- infer/src/java/jTrans.ml | 8 +- 35 files changed, 780 insertions(+), 734 deletions(-) create mode 100644 infer/src/IR/PredSymb.re create mode 100644 infer/src/IR/PredSymb.rei diff --git a/infer/src/IR/Cfg.rei b/infer/src/IR/Cfg.rei index e6e7d7966..b4abd3b09 100644 --- a/infer/src/IR/Cfg.rei +++ b/infer/src/IR/Cfg.rei @@ -69,7 +69,7 @@ let module Procdesc: { let get_captured: t => list (Mangled.t, Typ.t); /** Return the visibility attribute */ - let get_access: t => Sil.access; + let get_access: t => PredSymb.access; let get_nodes: t => list node; /** Get the procedure's nodes up until the first branching */ diff --git a/infer/src/IR/PredSymb.re b/infer/src/IR/PredSymb.re new file mode 100644 index 000000000..f3e96778d --- /dev/null +++ b/infer/src/IR/PredSymb.re @@ -0,0 +1,363 @@ +/* + * vim: set ft=rust: + * vim: set ft=reason: + * + * Copyright (c) 2009 - 2013 Monoidics ltd. + * Copyright (c) 2013 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + */ + +open! Utils; + + +/** The Smallfoot Intermediate Language: Predicate Symbols */ +let module L = Logging; + +let module F = Format; + +type func_attribute = + | FA_sentinel of int int /** __attribute__((sentinel(int, int))) */; + + +/** Visibility modifiers. */ +type access = | Default | Public | Private | Protected; + + +/** Return the value of the FA_sentinel attribute in [attr_list] if it is found */ +let get_sentinel_func_attribute_value attr_list => + switch attr_list { + | [FA_sentinel sentinel null_pos, ..._] => Some (sentinel, null_pos) + | [] => None + }; + +type mem_kind = + | Mmalloc /** memory allocated with malloc */ + | Mnew /** memory allocated with new */ + | Mnew_array /** memory allocated with new[] */ + | Mobjc /** memory allocated with objective-c alloc */; + +let mem_kind_to_num = + fun + | Mmalloc => 0 + | Mnew => 1 + | Mnew_array => 2 + | Mobjc => 3; + +let mem_kind_compare mk1 mk2 => int_compare (mem_kind_to_num mk1) (mem_kind_to_num mk2); + + +/** resource that can be allocated */ +type resource = | Rmemory of mem_kind | Rfile | Rignore | Rlock; + +let resource_compare r1 r2 => { + let res_to_num = + fun + | Rmemory mk => mem_kind_to_num mk + | Rfile => 100 + | Rignore => 200 + | Rlock => 300; + int_compare (res_to_num r1) (res_to_num r2) +}; + + +/** kind of resource action */ +type res_act_kind = | Racquire | Rrelease; + +let res_act_kind_compare rak1 rak2 => + switch (rak1, rak2) { + | (Racquire, Racquire) => 0 + | (Racquire, Rrelease) => (-1) + | (Rrelease, Racquire) => 1 + | (Rrelease, Rrelease) => 0 + }; + + +/** kind of dangling pointers */ +type dangling_kind = + /** pointer is dangling because it is uninitialized */ + | DAuninit + /** pointer is dangling because it is the address + of a stack variable which went out of scope */ + | DAaddr_stack_var + /** pointer is -1 */ + | DAminusone; + +let dangling_kind_compare dk1 dk2 => + switch (dk1, dk2) { + | (DAuninit, DAuninit) => 0 + | (DAuninit, _) => (-1) + | (_, DAuninit) => 1 + | (DAaddr_stack_var, DAaddr_stack_var) => 0 + | (DAaddr_stack_var, _) => (-1) + | (_, DAaddr_stack_var) => 1 + | (DAminusone, DAminusone) => 0 + }; + + +/** position in a path: proc name, node id */ +type path_pos = (Procname.t, int); + +let path_pos_compare (pn1, nid1) (pn2, nid2) => { + let n = Procname.compare pn1 pn2; + if (n != 0) { + n + } else { + int_compare nid1 nid2 + } +}; + +let path_pos_equal pp1 pp2 => path_pos_compare pp1 pp2 == 0; + +type taint_kind = + | Tk_unverified_SSL_socket + | Tk_shared_preferences_data + | Tk_privacy_annotation + | Tk_integrity_annotation + | Tk_unknown; + +let taint_kind_compare tk1 tk2 => + switch (tk1, tk2) { + | (Tk_unverified_SSL_socket, Tk_unverified_SSL_socket) => 0 + | (Tk_unverified_SSL_socket, _) => (-1) + | (_, Tk_unverified_SSL_socket) => 1 + | (Tk_shared_preferences_data, Tk_shared_preferences_data) => 0 + | (Tk_shared_preferences_data, _) => 1 + | (_, Tk_shared_preferences_data) => (-1) + | (Tk_privacy_annotation, Tk_privacy_annotation) => 0 + | (Tk_privacy_annotation, _) => 1 + | (_, Tk_privacy_annotation) => (-1) + | (Tk_integrity_annotation, Tk_integrity_annotation) => 0 + | (Tk_integrity_annotation, _) => 1 + | (_, Tk_integrity_annotation) => (-1) + | (Tk_unknown, Tk_unknown) => 0 + }; + +type taint_info = {taint_source: Procname.t, taint_kind: taint_kind}; + +let taint_info_compare {taint_source: ts1, taint_kind: tk1} {taint_source: ts2, taint_kind: tk2} => + taint_kind_compare tk1 tk2 |> next Procname.compare ts1 ts2; + + +/** acquire/release action on a resource */ +type res_action = { + ra_kind: res_act_kind, /** kind of action */ + ra_res: resource, /** kind of resource */ + ra_pname: Procname.t, /** name of the procedure used to acquire/release the resource */ + ra_loc: Location.t, /** location of the acquire/release */ + ra_vpath: DecompiledExp.vpath /** vpath of the resource value */ +}; + + +/** Attributes are nary function symbols that are applied to expression arguments in Apred and + Anpred atomic formulas. Many operations don't make much sense for nullary predicates, and are + generally treated as no-ops. The first argument is treated specially, as the "anchor" of the + predicate application. For example, adding or removing an attribute uses the anchor to identify + the atom to operate on. Also, abstraction and normalization operations treat the anchor + specially and maintain more information on it than other arguments. Therefore when attaching an + attribute to an expression, that expression should be the first argument, optionally followed by + additional related expressions. */ +type t = + | Aresource of res_action /** resource acquire/release */ + | Aautorelease + | Adangling of dangling_kind /** dangling pointer */ + /** undefined value obtained by calling the given procedure, plus its return value annots */ + | Aundef of Procname.t Typ.item_annotation Location.t path_pos + | Ataint of taint_info + | Auntaint of taint_info + | Alocked + | Aunlocked + /** value appeared in second argument of division at given path position */ + | Adiv0 of path_pos + /** attributed exp is null due to a call to a method with given path as null receiver */ + | Aobjc_null + /** value was returned from a call to the given procedure, plus the annots of the return value */ + | Aretval of Procname.t Typ.item_annotation + /** denotes an object registered as an observers to a notification center */ + | Aobserver + /** denotes an object unsubscribed from observers of a notification center */ + | Aunsubscribed_observer; + +let compare (att1: t) (att2: t) :int => + switch (att1, att2) { + | (Aresource ra1, Aresource ra2) => + let n = res_act_kind_compare ra1.ra_kind ra2.ra_kind; + if (n != 0) { + n + } else { + /* ignore other values beside resources: arbitrary merging into one */ + resource_compare + ra1.ra_res ra2.ra_res + } + | (Aresource _, _) => (-1) + | (_, Aresource _) => 1 + | (Aautorelease, Aautorelease) => 0 + | (Aautorelease, _) => (-1) + | (_, Aautorelease) => 1 + | (Adangling dk1, Adangling dk2) => dangling_kind_compare dk1 dk2 + | (Adangling _, _) => (-1) + | (_, Adangling _) => 1 + | (Aundef pn1 _ _ _, Aundef pn2 _ _ _) => Procname.compare pn1 pn2 + | (Ataint ti1, Ataint ti2) => taint_info_compare ti1 ti2 + | (Ataint _, _) => (-1) + | (_, Ataint _) => 1 + | (Auntaint ti1, Auntaint ti2) => taint_info_compare ti1 ti2 + | (Auntaint _, _) => (-1) + | (_, Auntaint _) => 1 + | (Alocked, Alocked) => 0 + | (Alocked, _) => (-1) + | (_, Alocked) => 1 + | (Aunlocked, Aunlocked) => 0 + | (Aunlocked, _) => (-1) + | (_, Aunlocked) => 1 + | (Adiv0 pp1, Adiv0 pp2) => path_pos_compare pp1 pp2 + | (Adiv0 _, _) => (-1) + | (_, Adiv0 _) => 1 + | (Aobjc_null, Aobjc_null) => 0 + | (Aobjc_null, _) => (-1) + | (_, Aobjc_null) => 1 + | (Aretval pn1 annots1, Aretval pn2 annots2) => + let n = Procname.compare pn1 pn2; + if (n != 0) { + n + } else { + Typ.item_annotation_compare annots1 annots2 + } + | (Aretval _, _) => (-1) + | (_, Aretval _) => 1 + | (Aobserver, Aobserver) => 0 + | (Aobserver, _) => (-1) + | (_, Aobserver) => 1 + | (Aunsubscribed_observer, Aunsubscribed_observer) => 0 + | (Aunsubscribed_observer, _) => (-1) + | (_, Aunsubscribed_observer) => 1 + }; + +let equal att1 att2 => compare att1 att2 == 0; + + +/** name of the allocation function for the given memory kind */ +let mem_alloc_pname = + fun + | Mmalloc => Procname.from_string_c_fun "malloc" + | Mnew => Procname.from_string_c_fun "new" + | Mnew_array => Procname.from_string_c_fun "new[]" + | Mobjc => Procname.from_string_c_fun "alloc"; + + +/** name of the deallocation function for the given memory kind */ +let mem_dealloc_pname = + fun + | Mmalloc => Procname.from_string_c_fun "free" + | Mnew => Procname.from_string_c_fun "delete" + | Mnew_array => Procname.from_string_c_fun "delete[]" + | Mobjc => Procname.from_string_c_fun "dealloc"; + + +/** Categories of attributes */ +type category = + | ACresource + | ACautorelease + | ACtaint + | AClock + | ACdiv0 + | ACobjc_null + | ACundef + | ACretval + | ACobserver; + +let category_compare (ac1: category) (ac2: category) :int => Pervasives.compare ac1 ac2; + +let category_equal att1 att2 => category_compare att1 att2 == 0; + +let to_category att => + switch att { + | Aresource _ + | Adangling _ => ACresource + | Ataint _ + | Auntaint _ => ACtaint + | Alocked + | Aunlocked => AClock + | Aautorelease => ACautorelease + | Adiv0 _ => ACdiv0 + | Aobjc_null => ACobjc_null + | Aretval _ => ACretval + | Aundef _ => ACundef + | Aobserver + | Aunsubscribed_observer => ACobserver + }; + +let is_undef = + fun + | Aundef _ => true + | _ => false; + + +/** convert the attribute to a string */ +let to_string pe => + fun + | Aresource ra => { + let mk_name = ( + fun + | Mmalloc => "ma" + | Mnew => "ne" + | Mnew_array => "na" + | Mobjc => "oc" + ); + let name = + switch (ra.ra_kind, ra.ra_res) { + | (Racquire, Rmemory mk) => "MEM" ^ mk_name mk + | (Racquire, Rfile) => "FILE" + | (Rrelease, Rmemory mk) => "FREED" ^ mk_name mk + | (Rrelease, Rfile) => "CLOSED" + | (_, Rignore) => "IGNORE" + | (Racquire, Rlock) => "LOCKED" + | (Rrelease, Rlock) => "UNLOCKED" + }; + let str_vpath = + if Config.trace_error { + pp_to_string (DecompiledExp.pp_vpath pe) ra.ra_vpath + } else { + "" + }; + name ^ + Binop.str pe Lt ^ + Procname.to_string ra.ra_pname ^ + ":" ^ + string_of_int ra.ra_loc.Location.line ^ + Binop.str pe Gt ^ + str_vpath + } + | Aautorelease => "AUTORELEASE" + | Adangling dk => { + let dks = + switch dk { + | DAuninit => "UNINIT" + | DAaddr_stack_var => "ADDR_STACK" + | DAminusone => "MINUS1" + }; + "DANGL" ^ Binop.str pe Lt ^ dks ^ Binop.str pe Gt + } + | Aundef pn _ loc _ => + "UND" ^ + Binop.str pe Lt ^ + Procname.to_string pn ^ + Binop.str pe Gt ^ + ":" ^ + string_of_int loc.Location.line + | Ataint {taint_source} => "TAINTED[" ^ Procname.to_string taint_source ^ "]" + | Auntaint _ => "UNTAINTED" + | Alocked => "LOCKED" + | Aunlocked => "UNLOCKED" + | Adiv0 (_, _) => "DIV0" + | Aobjc_null => "OBJC_NULL" + | Aretval pn _ => "RET" ^ Binop.str pe Lt ^ Procname.to_string pn ^ Binop.str pe Gt + | Aobserver => "OBSERVER" + | Aunsubscribed_observer => "UNSUBSCRIBED_OBSERVER"; + + +/** dump an attribute */ +let d_attribute (a: t) => L.add_print_action (L.PTattribute, Obj.repr a); diff --git a/infer/src/IR/PredSymb.rei b/infer/src/IR/PredSymb.rei new file mode 100644 index 000000000..d97184bf1 --- /dev/null +++ b/infer/src/IR/PredSymb.rei @@ -0,0 +1,160 @@ +/* + * vim: set ft=rust: + * vim: set ft=reason: + * + * Copyright (c) 2009 - 2013 Monoidics ltd. + * Copyright (c) 2013 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + */ + +open! Utils; + + +/** The Smallfoot Intermediate Language: Predicate Symbols */ +let module L = Logging; + +let module F = Format; + + +/** {2 Programs and Types} */ +type func_attribute = | FA_sentinel of int int; + + +/** Return the value of the FA_sentinel attribute in [attr_list] if it is found */ +let get_sentinel_func_attribute_value: list func_attribute => option (int, int); + + +/** Visibility modifiers. */ +type access = | Default | Public | Private | Protected; + +type mem_kind = + | Mmalloc /** memory allocated with malloc */ + | Mnew /** memory allocated with new */ + | Mnew_array /** memory allocated with new[] */ + | Mobjc /** memory allocated with objective-c alloc */; + +let mem_kind_compare: mem_kind => mem_kind => int; + + +/** resource that can be allocated */ +type resource = | Rmemory of mem_kind | Rfile | Rignore | Rlock; + +let resource_compare: resource => resource => int; + + +/** kind of resource action */ +type res_act_kind = | Racquire | Rrelease; + +let res_act_kind_compare: res_act_kind => res_act_kind => int; + + +/** kind of dangling pointers */ +type dangling_kind = + /** pointer is dangling because it is uninitialized */ + | DAuninit + /** pointer is dangling because it is the address of a stack variable which went out of scope */ + | DAaddr_stack_var + /** pointer is -1 */ + | DAminusone; + + +/** position in a path: proc name, node id */ +type path_pos = (Procname.t, int); + +let path_pos_equal: path_pos => path_pos => bool; + +type taint_kind = + | Tk_unverified_SSL_socket + | Tk_shared_preferences_data + | Tk_privacy_annotation + | Tk_integrity_annotation + | Tk_unknown; + +type taint_info = {taint_source: Procname.t, taint_kind: taint_kind}; + + +/** acquire/release action on a resource */ +type res_action = { + ra_kind: res_act_kind, /** kind of action */ + ra_res: resource, /** kind of resource */ + ra_pname: Procname.t, /** name of the procedure used to acquire/release the resource */ + ra_loc: Location.t, /** location of the acquire/release */ + ra_vpath: DecompiledExp.vpath /** vpath of the resource value */ +}; + + +/** Attributes are nary function symbols that are applied to expression arguments in Apred and + Anpred atomic formulas. Many operations don't make much sense for nullary predicates, and are + generally treated as no-ops. The first argument is treated specially, as the "anchor" of the + predicate application. For example, adding or removing an attribute uses the anchor to identify + the atom to operate on. Also, abstraction and normalization operations treat the anchor + specially and maintain more information on it than other arguments. Therefore when attaching an + attribute to an expression, that expression should be the first argument, optionally followed by + additional related expressions. */ +type t = + | Aresource of res_action /** resource acquire/release */ + | Aautorelease + | Adangling of dangling_kind /** dangling pointer */ + /** undefined value obtained by calling the given procedure, plus its return value annots */ + | Aundef of Procname.t Typ.item_annotation Location.t path_pos + | Ataint of taint_info + | Auntaint of taint_info + | Alocked + | Aunlocked + /** value appeared in second argument of division at given path position */ + | Adiv0 of path_pos + /** attributed exp is null due to a call to a method with given path as null receiver */ + | Aobjc_null + /** value was returned from a call to the given procedure, plus the annots of the return value */ + | Aretval of Procname.t Typ.item_annotation + /** denotes an object registered as an observers to a notification center */ + | Aobserver + /** denotes an object unsubscribed from observers of a notification center */ + | Aunsubscribed_observer; + +let compare: t => t => int; + +let equal: t => t => bool; + + +/** name of the allocation function for the given memory kind */ +let mem_alloc_pname: mem_kind => Procname.t; + + +/** name of the deallocation function for the given memory kind */ +let mem_dealloc_pname: mem_kind => Procname.t; + + +/** Categories of attributes */ +type category = + | ACresource + | ACautorelease + | ACtaint + | AClock + | ACdiv0 + | ACobjc_null + | ACundef + | ACretval + | ACobserver; + +let category_compare: category => category => int; + +let category_equal: category => category => bool; + + +/** Return the category to which the attribute belongs. */ +let to_category: t => category; + +let is_undef: t => bool; + + +/** convert the attribute to a string */ +let to_string: printenv => t => string; + + +/** Dump an attribute. */ +let d_attribute: t => unit; diff --git a/infer/src/IR/ProcAttributes.re b/infer/src/IR/ProcAttributes.re index 2bf1f6806..f925c6438 100644 --- a/infer/src/IR/ProcAttributes.re +++ b/infer/src/IR/ProcAttributes.re @@ -23,13 +23,13 @@ let module F = Format; type objc_accessor_type = | Objc_getter of Ident.fieldname | Objc_setter of Ident.fieldname; type t = { - access: Sil.access, /** visibility access */ + access: PredSymb.access, /** visibility access */ captured: list (Mangled.t, Typ.t), /** name and type of variables captured in blocks */ mutable changed: bool, /** true if proc has changed since last analysis */ err_log: Errlog.t, /** Error log for the procedure */ exceptions: list string, /** exceptions thrown by the procedure */ formals: list (Mangled.t, Typ.t), /** name and type of formal parameters */ - func_attributes: list Sil.func_attribute, + func_attributes: list PredSymb.func_attribute, is_abstract: bool, /** the procedure is abstract */ mutable is_bridge_method: bool, /** the procedure is a bridge method */ is_defined: bool, /** true if the procedure is defined, and not just declared */ @@ -48,7 +48,7 @@ type t = { }; let default proc_name language => { - access: Sil.Default, + access: PredSymb.Default, captured: [], changed: true, err_log: Errlog.empty (), diff --git a/infer/src/IR/ProcAttributes.rei b/infer/src/IR/ProcAttributes.rei index f219a7ac2..38974d664 100644 --- a/infer/src/IR/ProcAttributes.rei +++ b/infer/src/IR/ProcAttributes.rei @@ -17,13 +17,13 @@ open! Utils; type objc_accessor_type = | Objc_getter of Ident.fieldname | Objc_setter of Ident.fieldname; type t = { - access: Sil.access, /** visibility access */ + access: PredSymb.access, /** visibility access */ captured: list (Mangled.t, Typ.t), /** name and type of variables captured in blocks */ mutable changed: bool, /** true if proc has changed since last analysis */ err_log: Errlog.t, /** Error log for the procedure */ exceptions: list string, /** exceptions thrown by the procedure */ formals: list (Mangled.t, Typ.t), /** name and type of formal parameters */ - func_attributes: list Sil.func_attribute, + func_attributes: list PredSymb.func_attribute, is_abstract: bool, /** the procedure is abstract */ mutable is_bridge_method: bool, /** the procedure is a bridge method */ is_defined: bool, /** true if the procedure is defined, and not just declared */ diff --git a/infer/src/IR/Sil.re b/infer/src/IR/Sil.re index ccbcf6c05..16dbd1078 100644 --- a/infer/src/IR/Sil.re +++ b/infer/src/IR/Sil.re @@ -21,100 +21,6 @@ let module F = Format; /** {2 Programs and Types} */ -type func_attribute = - | FA_sentinel of int int /** __attribute__((sentinel(int, int))) */; - - -/** Visibility modifiers. */ -type access = | Default | Public | Private | Protected; - - -/** Return the value of the FA_sentinel attribute in [attr_list] if it is found */ -let get_sentinel_func_attribute_value attr_list => - switch attr_list { - | [FA_sentinel sentinel null_pos, ..._] => Some (sentinel, null_pos) - | [] => None - }; - -type mem_kind = - | Mmalloc /** memory allocated with malloc */ - | Mnew /** memory allocated with new */ - | Mnew_array /** memory allocated with new[] */ - | Mobjc /** memory allocated with objective-c alloc */; - - -/** resource that can be allocated */ -type resource = | Rmemory of mem_kind | Rfile | Rignore | Rlock; - - -/** kind of resource action */ -type res_act_kind = | Racquire | Rrelease; - - -/** kind of dangling pointers */ -type dangling_kind = - /** pointer is dangling because it is uninitialized */ - | DAuninit - /** pointer is dangling because it is the address - of a stack variable which went out of scope */ - | DAaddr_stack_var - /** pointer is -1 */ - | DAminusone; - - -/** position in a path: proc name, node id */ -type path_pos = (Procname.t, int); - -type taint_kind = - | Tk_unverified_SSL_socket - | Tk_shared_preferences_data - | Tk_privacy_annotation - | Tk_integrity_annotation - | Tk_unknown; - -type taint_info = {taint_source: Procname.t, taint_kind: taint_kind}; - - -/** acquire/release action on a resource */ -type res_action = { - ra_kind: res_act_kind, /** kind of action */ - ra_res: resource, /** kind of resource */ - ra_pname: Procname.t, /** name of the procedure used to acquire/release the resource */ - ra_loc: Location.t, /** location of the acquire/release */ - ra_vpath: DecompiledExp.vpath /** vpath of the resource value */ -}; - - -/** Attributes are nary function symbols that are applied to expression arguments in Apred and - Anpred atomic formulas. Many operations don't make much sense for nullary predicates, and are - generally treated as no-ops. The first argument is treated specially, as the "anchor" of the - predicate application. For example, adding or removing an attribute uses the anchor to identify - the atom to operate on. Also, abstraction and normalization operations treat the anchor - specially and maintain more information on it than other arguments. Therefore when attaching an - attribute to an expression, that expression should be the first argument, optionally followed by - additional related expressions. */ -type attribute = - | Aresource of res_action /** resource acquire/release */ - | Aautorelease - | Adangling of dangling_kind /** dangling pointer */ - /** undefined value obtained by calling the given procedure, plus its return value annots */ - | Aundef of Procname.t Typ.item_annotation Location.t path_pos - | Ataint of taint_info - | Auntaint of taint_info - | Alocked - | Aunlocked - /** value appeared in second argument of division at given path position */ - | Adiv0 of path_pos - /** attributed exp is null due to a call to a method with given path as null receiver */ - | Aobjc_null - /** value was returned from a call to the given procedure, plus the annots of the return value */ - | Aretval of Procname.t Typ.item_annotation - /** denotes an object registered as an observers to a notification center */ - | Aobserver - /** denotes an object unsubscribed from observers of a notification center */ - | Aunsubscribed_observer; - - /** Kind of prune instruction */ type if_kind = | Ik_bexp /* boolean expressions, and exp ? exp : exp */ @@ -178,8 +84,8 @@ type offset = | Off_fld of Ident.fieldname Typ.t | Off_index of Exp.t; type atom = | Aeq of Exp.t Exp.t /** equality */ | Aneq of Exp.t Exp.t /** disequality */ - | Apred of attribute (list Exp.t) /** predicate symbol applied to exps */ - | Anpred of attribute (list Exp.t) /** negated predicate symbol applied to exps */; + | Apred of PredSymb.t (list Exp.t) /** predicate symbol applied to exps */ + | Anpred of PredSymb.t (list Exp.t) /** negated predicate symbol applied to exps */; /** kind of lseg or dllseg predicates */ @@ -206,9 +112,9 @@ type inst = | Ilookup | Inone | Inullify - | Irearrange of zero_flag null_case_flag int path_pos + | Irearrange of zero_flag null_case_flag int PredSymb.path_pos | Itaint - | Iupdate of zero_flag null_case_flag int path_pos + | Iupdate of zero_flag null_case_flag int PredSymb.path_pos | Ireturn_from_call of int | Ireturn_from_pointer_wrapper_call of int; @@ -312,196 +218,12 @@ let is_static_local_name pname pvar => } }; -let path_pos_compare (pn1, nid1) (pn2, nid2) => { - let n = Procname.compare pn1 pn2; - if (n != 0) { - n - } else { - int_compare nid1 nid2 - } -}; - -let path_pos_equal pp1 pp2 => path_pos_compare pp1 pp2 == 0; - -let mem_kind_to_num = - fun - | Mmalloc => 0 - | Mnew => 1 - | Mnew_array => 2 - | Mobjc => 3; - - -/** name of the allocation function for the given memory kind */ -let mem_alloc_pname = - fun - | Mmalloc => Procname.from_string_c_fun "malloc" - | Mnew => Procname.from_string_c_fun "new" - | Mnew_array => Procname.from_string_c_fun "new[]" - | Mobjc => Procname.from_string_c_fun "alloc"; - - -/** name of the deallocation function for the given memory kind */ -let mem_dealloc_pname = - fun - | Mmalloc => Procname.from_string_c_fun "free" - | Mnew => Procname.from_string_c_fun "delete" - | Mnew_array => Procname.from_string_c_fun "delete[]" - | Mobjc => Procname.from_string_c_fun "dealloc"; - -let mem_kind_compare mk1 mk2 => int_compare (mem_kind_to_num mk1) (mem_kind_to_num mk2); - -let resource_compare r1 r2 => { - let res_to_num = - fun - | Rmemory mk => mem_kind_to_num mk - | Rfile => 100 - | Rignore => 200 - | Rlock => 300; - int_compare (res_to_num r1) (res_to_num r2) -}; - -let res_act_kind_compare rak1 rak2 => - switch (rak1, rak2) { - | (Racquire, Racquire) => 0 - | (Racquire, Rrelease) => (-1) - | (Rrelease, Racquire) => 1 - | (Rrelease, Rrelease) => 0 - }; - -let dangling_kind_compare dk1 dk2 => - switch (dk1, dk2) { - | (DAuninit, DAuninit) => 0 - | (DAuninit, _) => (-1) - | (_, DAuninit) => 1 - | (DAaddr_stack_var, DAaddr_stack_var) => 0 - | (DAaddr_stack_var, _) => (-1) - | (_, DAaddr_stack_var) => 1 - | (DAminusone, DAminusone) => 0 - }; - -let taint_kind_compare tk1 tk2 => - switch (tk1, tk2) { - | (Tk_unverified_SSL_socket, Tk_unverified_SSL_socket) => 0 - | (Tk_unverified_SSL_socket, _) => (-1) - | (_, Tk_unverified_SSL_socket) => 1 - | (Tk_shared_preferences_data, Tk_shared_preferences_data) => 0 - | (Tk_shared_preferences_data, _) => 1 - | (_, Tk_shared_preferences_data) => (-1) - | (Tk_privacy_annotation, Tk_privacy_annotation) => 0 - | (Tk_privacy_annotation, _) => 1 - | (_, Tk_privacy_annotation) => (-1) - | (Tk_integrity_annotation, Tk_integrity_annotation) => 0 - | (Tk_integrity_annotation, _) => 1 - | (_, Tk_integrity_annotation) => (-1) - | (Tk_unknown, Tk_unknown) => 0 - }; - -let taint_info_compare {taint_source: ts1, taint_kind: tk1} {taint_source: ts2, taint_kind: tk2} => - taint_kind_compare tk1 tk2 |> next Procname.compare ts1 ts2; - - -/** Categories of attributes */ -type attribute_category = - | ACresource - | ACautorelease - | ACtaint - | AClock - | ACdiv0 - | ACobjc_null - | ACundef - | ACretval - | ACobserver; - -let attribute_category_compare (ac1: attribute_category) (ac2: attribute_category) :int => - Pervasives.compare ac1 ac2; - -let attribute_category_equal att1 att2 => attribute_category_compare att1 att2 == 0; - -let attribute_to_category att => - switch att { - | Aresource _ - | Adangling _ => ACresource - | Ataint _ - | Auntaint _ => ACtaint - | Alocked - | Aunlocked => AClock - | Aautorelease => ACautorelease - | Adiv0 _ => ACdiv0 - | Aobjc_null => ACobjc_null - | Aretval _ => ACretval - | Aundef _ => ACundef - | Aobserver - | Aunsubscribed_observer => ACobserver - }; - -let attr_is_undef = - fun - | Aundef _ => true - | _ => false; - -let attribute_compare (att1: attribute) (att2: attribute) :int => - switch (att1, att2) { - | (Aresource ra1, Aresource ra2) => - let n = res_act_kind_compare ra1.ra_kind ra2.ra_kind; - if (n != 0) { - n - } else { - /* ignore other values beside resources: arbitrary merging into one */ - resource_compare - ra1.ra_res ra2.ra_res - } - | (Aresource _, _) => (-1) - | (_, Aresource _) => 1 - | (Aautorelease, Aautorelease) => 0 - | (Aautorelease, _) => (-1) - | (_, Aautorelease) => 1 - | (Adangling dk1, Adangling dk2) => dangling_kind_compare dk1 dk2 - | (Adangling _, _) => (-1) - | (_, Adangling _) => 1 - | (Aundef pn1 _ _ _, Aundef pn2 _ _ _) => Procname.compare pn1 pn2 - | (Ataint ti1, Ataint ti2) => taint_info_compare ti1 ti2 - | (Ataint _, _) => (-1) - | (_, Ataint _) => 1 - | (Auntaint ti1, Auntaint ti2) => taint_info_compare ti1 ti2 - | (Auntaint _, _) => (-1) - | (_, Auntaint _) => 1 - | (Alocked, Alocked) => 0 - | (Alocked, _) => (-1) - | (_, Alocked) => 1 - | (Aunlocked, Aunlocked) => 0 - | (Aunlocked, _) => (-1) - | (_, Aunlocked) => 1 - | (Adiv0 pp1, Adiv0 pp2) => path_pos_compare pp1 pp2 - | (Adiv0 _, _) => (-1) - | (_, Adiv0 _) => 1 - | (Aobjc_null, Aobjc_null) => 0 - | (Aobjc_null, _) => (-1) - | (_, Aobjc_null) => 1 - | (Aretval pn1 annots1, Aretval pn2 annots2) => - let n = Procname.compare pn1 pn2; - if (n != 0) { - n - } else { - Typ.item_annotation_compare annots1 annots2 - } - | (Aretval _, _) => (-1) - | (_, Aretval _) => 1 - | (Aobserver, Aobserver) => 0 - | (Aobserver, _) => (-1) - | (_, Aobserver) => 1 - | (Aunsubscribed_observer, Aunsubscribed_observer) => 0 - | (Aunsubscribed_observer, _) => (-1) - | (_, Aunsubscribed_observer) => 1 - }; - let ident_exp_compare = pair_compare Ident.compare Exp.compare; let ident_exp_equal ide1 ide2 => ident_exp_compare ide1 ide2 == 0; let exp_list_compare = IList.compare Exp.compare; -let attribute_equal att1 att2 => attribute_compare att1 att2 == 0; - /** Compare atoms. Equalities come before disequalities */ let atom_compare a b => @@ -528,7 +250,7 @@ let atom_compare a b => | (Aneq _, _) => (-1) | (_, Aneq _) => 1 | (Apred a1 es1, Apred a2 es2) => - let n = attribute_compare a1 a2; + let n = PredSymb.compare a1 a2; if (n != 0) { n } else { @@ -537,7 +259,7 @@ let atom_compare a b => | (Apred _, _) => (-1) | (_, Apred _) => 1 | (Anpred a1 es1, Anpred a2 es2) => - let n = attribute_compare a1 a2; + let n = PredSymb.compare a1 a2; if (n != 0) { n } else { @@ -804,69 +526,6 @@ let pp_seq_diff pp pe0 f => }; -/** convert the attribute to a string */ -let attribute_to_string pe => - fun - | Aresource ra => { - let mk_name = ( - fun - | Mmalloc => "ma" - | Mnew => "ne" - | Mnew_array => "na" - | Mobjc => "oc" - ); - let name = - switch (ra.ra_kind, ra.ra_res) { - | (Racquire, Rmemory mk) => "MEM" ^ mk_name mk - | (Racquire, Rfile) => "FILE" - | (Rrelease, Rmemory mk) => "FREED" ^ mk_name mk - | (Rrelease, Rfile) => "CLOSED" - | (_, Rignore) => "IGNORE" - | (Racquire, Rlock) => "LOCKED" - | (Rrelease, Rlock) => "UNLOCKED" - }; - let str_vpath = - if Config.trace_error { - pp_to_string (DecompiledExp.pp_vpath pe) ra.ra_vpath - } else { - "" - }; - name ^ - Binop.str pe Lt ^ - Procname.to_string ra.ra_pname ^ - ":" ^ - string_of_int ra.ra_loc.Location.line ^ - Binop.str pe Gt ^ - str_vpath - } - | Aautorelease => "AUTORELEASE" - | Adangling dk => { - let dks = - switch dk { - | DAuninit => "UNINIT" - | DAaddr_stack_var => "ADDR_STACK" - | DAminusone => "MINUS1" - }; - "DANGL" ^ Binop.str pe Lt ^ dks ^ Binop.str pe Gt - } - | Aundef pn _ loc _ => - "UND" ^ - Binop.str pe Lt ^ - Procname.to_string pn ^ - Binop.str pe Gt ^ - ":" ^ - string_of_int loc.Location.line - | Ataint {taint_source} => "TAINTED[" ^ Procname.to_string taint_source ^ "]" - | Auntaint _ => "UNTAINTED" - | Alocked => "LOCKED" - | Aunlocked => "UNLOCKED" - | Adiv0 (_, _) => "DIV0" - | Aobjc_null => "OBJC_NULL" - | Aretval pn _ => "RET" ^ Binop.str pe Lt ^ Procname.to_string pn ^ Binop.str pe Gt - | Aobserver => "OBSERVER" - | Aunsubscribed_observer => "UNSUBSCRIBED_OBSERVER"; - - /** Pretty print an expression. */ let rec _pp_exp pe0 pp_t f e0 => { let (pe, changed) = color_pre_wrapper pe0 f e0; @@ -1096,17 +755,13 @@ let pp_atom pe0 f a => { | PP_HTML => F.fprintf f "%a != %a" (pp_exp pe) e1 (pp_exp pe) e2 | PP_LATEX => F.fprintf f "%a{\\neq}%a" (pp_exp pe) e1 (pp_exp pe) e2 } - | Apred a es => F.fprintf f "%s(%a)" (attribute_to_string pe a) (pp_comma_seq (pp_exp pe)) es - | Anpred a es => F.fprintf f "!%s(%a)" (attribute_to_string pe a) (pp_comma_seq (pp_exp pe)) es + | Apred a es => F.fprintf f "%s(%a)" (PredSymb.to_string pe a) (pp_comma_seq (pp_exp pe)) es + | Anpred a es => F.fprintf f "!%s(%a)" (PredSymb.to_string pe a) (pp_comma_seq (pp_exp pe)) es }; color_post_wrapper changed pe0 f }; -/** dump an attribute */ -let d_attribute (a: attribute) => L.add_print_action (L.PTattribute, Obj.repr a); - - /** dump an atom */ let d_atom (a: atom) => L.add_print_action (L.PTatom, Obj.repr a); diff --git a/infer/src/IR/Sil.rei b/infer/src/IR/Sil.rei index 964c5cb51..22c4f7f13 100644 --- a/infer/src/IR/Sil.rei +++ b/infer/src/IR/Sil.rei @@ -19,90 +19,6 @@ let module F = Format; /** {2 Programs and Types} */ -type func_attribute = | FA_sentinel of int int; - - -/** Visibility modifiers. */ -type access = | Default | Public | Private | Protected; - -type mem_kind = - | Mmalloc /** memory allocated with malloc */ - | Mnew /** memory allocated with new */ - | Mnew_array /** memory allocated with new[] */ - | Mobjc /** memory allocated with objective-c alloc */; - - -/** resource that can be allocated */ -type resource = | Rmemory of mem_kind | Rfile | Rignore | Rlock; - - -/** kind of resource action */ -type res_act_kind = | Racquire | Rrelease; - - -/** kind of dangling pointers */ -type dangling_kind = - /** pointer is dangling because it is uninitialized */ - | DAuninit - /** pointer is dangling because it is the address of a stack variable which went out of scope */ - | DAaddr_stack_var - /** pointer is -1 */ - | DAminusone; - - -/** position in a path: proc name, node id */ -type path_pos = (Procname.t, int); - -type taint_kind = - | Tk_unverified_SSL_socket - | Tk_shared_preferences_data - | Tk_privacy_annotation - | Tk_integrity_annotation - | Tk_unknown; - -type taint_info = {taint_source: Procname.t, taint_kind: taint_kind}; - - -/** acquire/release action on a resource */ -type res_action = { - ra_kind: res_act_kind, /** kind of action */ - ra_res: resource, /** kind of resource */ - ra_pname: Procname.t, /** name of the procedure used to acquire/release the resource */ - ra_loc: Location.t, /** location of the acquire/release */ - ra_vpath: DecompiledExp.vpath /** vpath of the resource value */ -}; - - -/** Attributes are nary function symbols that are applied to expression arguments in Apred and - Anpred atomic formulas. Many operations don't make much sense for nullary predicates, and are - generally treated as no-ops. The first argument is treated specially, as the "anchor" of the - predicate application. For example, adding or removing an attribute uses the anchor to identify - the atom to operate on. Also, abstraction and normalization operations treat the anchor - specially and maintain more information on it than other arguments. Therefore when attaching an - attribute to an expression, that expression should be the first argument, optionally followed by - additional related expressions. */ -type attribute = - | Aresource of res_action /** resource acquire/release */ - | Aautorelease - | Adangling of dangling_kind /** dangling pointer */ - /** undefined value obtained by calling the given procedure, plus its return value annots */ - | Aundef of Procname.t Typ.item_annotation Location.t path_pos - | Ataint of taint_info - | Auntaint of taint_info - | Alocked - | Aunlocked - /** value appeared in second argument of division at given path position */ - | Adiv0 of path_pos - /** attributed exp is null due to a call to a method with given path as null receiver */ - | Aobjc_null - /** value was returned from a call to the given procedure, plus the annots of the return value */ - | Aretval of Procname.t Typ.item_annotation - /** denotes an object registered as an observers to a notification center */ - | Aobserver - /** denotes an object unsubscribed from observers of a notification center */ - | Aunsubscribed_observer; - - /** Convert expression lists to expression sets. */ let elist_to_eset: list Exp.t => Exp.Set.t; @@ -160,8 +76,8 @@ type offset = | Off_fld of Ident.fieldname Typ.t | Off_index of Exp.t; type atom = | Aeq of Exp.t Exp.t /** equality */ | Aneq of Exp.t Exp.t /** disequality */ - | Apred of attribute (list Exp.t) /** predicate symbol applied to exps */ - | Anpred of attribute (list Exp.t) /** negated predicate symbol applied to exps */; + | Apred of PredSymb.t (list Exp.t) /** predicate symbol applied to exps */ + | Anpred of PredSymb.t (list Exp.t) /** negated predicate symbol applied to exps */; /** kind of lseg or dllseg predicates */ @@ -188,9 +104,9 @@ type inst = | Ilookup | Inone | Inullify - | Irearrange of zero_flag null_case_flag int path_pos + | Irearrange of zero_flag null_case_flag int PredSymb.path_pos | Itaint - | Iupdate of zero_flag null_case_flag int path_pos + | Iupdate of zero_flag null_case_flag int PredSymb.path_pos | Ireturn_from_call of int | Ireturn_from_pointer_wrapper_call of int; @@ -212,11 +128,11 @@ let inst_nullify: inst; /** the boolean indicates whether the pointer is known nonzero */ -let inst_rearrange: bool => Location.t => path_pos => inst; +let inst_rearrange: bool => Location.t => PredSymb.path_pos => inst; let inst_taint: inst; -let inst_update: Location.t => path_pos => inst; +let inst_update: Location.t => PredSymb.path_pos => inst; /** Get the null case flag of the inst. */ @@ -318,8 +234,6 @@ let hpred_compact: sharing_env => hpred => hpred; /** {2 Comparision And Inspection Functions} */ let has_objc_ref_counter: hpred => bool; -let path_pos_equal: path_pos => path_pos => bool; - /** Returns the zero value of a type, for int, float and ptr types, None othwewise */ let zero_value_of_numerical_type_option: Typ.t => option Exp.t; @@ -343,39 +257,6 @@ let block_pvar: Pvar.t; /** Check if a pvar is a local pointing to a block in objc */ let is_block_pvar: Pvar.t => bool; -let mem_kind_compare: mem_kind => mem_kind => int; - -let res_act_kind_compare: res_act_kind => res_act_kind => int; - -let resource_compare: resource => resource => int; - -let attribute_compare: attribute => attribute => int; - -let attribute_equal: attribute => attribute => bool; - - -/** Categories of attributes */ -type attribute_category = - | ACresource - | ACautorelease - | ACtaint - | AClock - | ACdiv0 - | ACobjc_null - | ACundef - | ACretval - | ACobserver; - -let attribute_category_compare: attribute_category => attribute_category => int; - -let attribute_category_equal: attribute_category => attribute_category => bool; - - -/** Return the category to which the attribute belongs. */ -let attribute_to_category: attribute => attribute_category; - -let attr_is_undef: attribute => bool; - let exp_typ_compare: (Exp.t, Typ.t) => (Exp.t, Typ.t) => int; let instr_compare: instr => instr => int; @@ -422,10 +303,6 @@ let exp_strexp_compare: (Exp.t, strexp) => (Exp.t, strexp) => int; let hpred_get_lhs: hpred => Exp.t; -/** Return the value of the FA_sentinel attribute in [attr_list] if it is found */ -let get_sentinel_func_attribute_value: list func_attribute => option (int, int); - - /** {2 Pretty Printing} */ /** Begin change color if using diff printing, return updated printenv and change status */ let color_pre_wrapper: printenv => F.formatter => 'a => (printenv, bool); @@ -435,18 +312,6 @@ let color_pre_wrapper: printenv => F.formatter => 'a => (printenv, bool); let color_post_wrapper: bool => printenv => F.formatter => unit; -/** name of the allocation function for the given memory kind */ -let mem_alloc_pname: mem_kind => Procname.t; - - -/** name of the deallocation function for the given memory kind */ -let mem_dealloc_pname: mem_kind => Procname.t; - - -/** convert the attribute to a string */ -let attribute_to_string: printenv => attribute => string; - - /** Pretty print an expression. */ let pp_exp: printenv => F.formatter => Exp.t => unit; @@ -527,10 +392,6 @@ let d_instr_list: list instr => unit; let pp_atom: printenv => F.formatter => atom => unit; -/** Dump an attribute. */ -let d_attribute: attribute => unit; - - /** Dump an atom. */ let d_atom: atom => unit; diff --git a/infer/src/backend/abs.ml b/infer/src/backend/abs.ml index 19165f308..2a6ccf2a5 100644 --- a/infer/src/backend/abs.ml +++ b/infer/src/backend/abs.ml @@ -1101,7 +1101,7 @@ let check_junk ?original_prop pname tenv prop = check_observer_is_unsubscribed_deallocation prop e; match Prop.get_resource_attribute prop e with | Some (Apred (Aresource ({ ra_kind = Racquire }) as a, _)) -> - L.d_str "ATTRIBUTE: "; Sil.d_attribute a; L.d_ln (); + L.d_str "ATTRIBUTE: "; PredSymb.d_attribute a; L.d_ln (); res := Some a | _ -> (match Prop.get_undef_attribute prop e with @@ -1111,14 +1111,14 @@ let check_junk ?original_prop pname tenv prop = IList.iter do_entry entries; !res in L.d_decrease_indent 1; - let is_undefined = Option.map_default Sil.attr_is_undef false alloc_attribute in + let is_undefined = Option.map_default PredSymb.is_undef false alloc_attribute in let resource = match Errdesc.hpred_is_open_resource prop hpred with | Some res -> res - | None -> Sil.Rmemory Sil.Mmalloc in + | None -> PredSymb.Rmemory PredSymb.Mmalloc in let ml_bucket_opt = match resource with - | Sil.Rmemory Sil.Mobjc -> should_raise_objc_leak hpred - | Sil.Rmemory Sil.Mnew | Sil.Rmemory Sil.Mnew_array + | PredSymb.Rmemory PredSymb.Mobjc -> should_raise_objc_leak hpred + | PredSymb.Rmemory PredSymb.Mnew | PredSymb.Rmemory PredSymb.Mnew_array when !Config.curr_language = Config.Clang -> Mleak_buckets.should_raise_cpp_leak | _ -> None in @@ -1136,7 +1136,7 @@ let check_junk ?original_prop pname tenv prop = __POS__) in let ignore_resource, exn = (match alloc_attribute, resource with - | Some _, Sil.Rmemory Sil.Mobjc when (hpred_in_cycle hpred) -> + | Some _, Rmemory Mobjc when (hpred_in_cycle hpred) -> (* When there is a cycle in objc we ignore it only if it's empty or it has weak or unsafe_unretained fields. Otherwise we report a retain cycle. *) @@ -1145,25 +1145,25 @@ let check_junk ?original_prop pname tenv prop = (IList.length cycle = 0) || (cycle_has_weak_or_unretained_or_assign_field cycle) in ignore_cycle, exn_retain_cycle cycle - | Some _, Sil.Rmemory Sil.Mobjc - | Some _, Sil.Rmemory Sil.Mnew - | Some _, Sil.Rmemory Sil.Mnew_array when !Config.curr_language = Config.Clang -> + | Some _, Rmemory Mobjc + | Some _, Rmemory Mnew + | Some _, Rmemory Mnew_array when !Config.curr_language = Config.Clang -> ml_bucket_opt = None, exn_leak - | Some _, Sil.Rmemory _ -> !Config.curr_language = Config.Java, exn_leak - | Some _, Sil.Rignore -> true, exn_leak - | Some _, Sil.Rfile -> false, exn_leak - | Some _, Sil.Rlock -> false, exn_leak + | Some _, Rmemory _ -> !Config.curr_language = Config.Java, exn_leak + | Some _, Rignore -> true, exn_leak + | Some _, Rfile -> false, exn_leak + | Some _, Rlock -> false, exn_leak | _ when hpred_in_cycle hpred && Sil.has_objc_ref_counter hpred -> (* When it's a cycle and the object has a ref counter then we have a retain cycle. Objc object may not have the - Sil.Mobjc qualifier when added in footprint doing abduction *) + Mobjc qualifier when added in footprint doing abduction *) let cycle = get_var_retain_cycle (remove_opt original_prop) in IList.length cycle = 0, exn_retain_cycle cycle | _ -> !Config.curr_language = Config.Java, exn_leak) in let already_reported () = let attr_opt_equal ao1 ao2 = match ao1, ao2 with | None, None -> true - | Some a1, Some a2 -> Sil.attribute_equal a1 a2 + | Some a1, Some a2 -> PredSymb.equal a1 a2 | Some _, None | None, Some _ -> false in (alloc_attribute = None && !leaks_reported <> []) || diff --git a/infer/src/backend/errdesc.ml b/infer/src/backend/errdesc.ml index dc83f9ed6..a56803673 100644 --- a/infer/src/backend/errdesc.ml +++ b/infer/src/backend/errdesc.ml @@ -68,7 +68,7 @@ let explain_context_leak pname context_typ fieldname error_path = (** Explain a deallocate stack variable error *) let explain_deallocate_stack_var pvar ra = let pvar_str = Pvar.to_string pvar in - Localise.desc_deallocate_stack_variable pvar_str ra.Sil.ra_pname ra.Sil.ra_loc + Localise.desc_deallocate_stack_variable pvar_str ra.PredSymb.ra_pname ra.PredSymb.ra_loc (** Explain a deallocate constant string error *) let explain_deallocate_constant_string s ra = @@ -76,7 +76,7 @@ let explain_deallocate_constant_string s ra = let pp fmt () = Sil.pp_exp pe_text fmt (Exp.Const (Const.Cstr s)) in pp_to_string pp () in - Localise.desc_deallocate_static_memory const_str ra.Sil.ra_pname ra.Sil.ra_loc + Localise.desc_deallocate_static_memory const_str ra.PredSymb.ra_pname ra.PredSymb.ra_loc let verbose = Config.trace_error @@ -431,12 +431,12 @@ let explain_allocation_mismatch ra_alloc ra_dealloc = let get_primitive_called is_alloc ra = (* primitive alloc/dealloc function ultimately used, and function actually called *) (* e.g. malloc and my_malloc *) - let primitive = match ra.Sil.ra_res with - | Sil.Rmemory mk_alloc -> - (if is_alloc then Sil.mem_alloc_pname else Sil.mem_dealloc_pname) mk_alloc - | _ -> ra_alloc.Sil.ra_pname in - let called = ra.Sil.ra_pname in - (primitive, called, ra.Sil.ra_loc) in + let primitive = match ra.PredSymb.ra_res with + | PredSymb.Rmemory mk_alloc -> + (if is_alloc then PredSymb.mem_alloc_pname else PredSymb.mem_dealloc_pname) mk_alloc + | _ -> ra_alloc.PredSymb.ra_pname in + let called = ra.PredSymb.ra_pname in + (primitive, called, ra.PredSymb.ra_loc) in Localise.desc_allocation_mismatch (get_primitive_called true ra_alloc) (get_primitive_called false ra_dealloc) @@ -507,11 +507,11 @@ let explain_leak tenv hpred prop alloc_att_opt bucket = Some (DExp.to_string de) | _ -> None in let res_action_opt, resource_opt, vpath = match alloc_att_opt with - | Some (Sil.Aresource ({ Sil.ra_kind = Sil.Racquire } as ra)) -> - Some ra, Some ra.Sil.ra_res, ra.Sil.ra_vpath + | Some (PredSymb.Aresource ({ ra_kind = Racquire } as ra)) -> + Some ra, Some ra.ra_res, ra.ra_vpath | _ -> (None, None, None) in let is_file = match resource_opt with - | Some Sil.Rfile -> true + | Some PredSymb.Rfile -> true | _ -> false in let check_pvar pvar = (* check that pvar is local or global and has the same type as the leaked hpred *) @@ -1089,7 +1089,7 @@ let explain_retain_cycle prop cycle loc dotty_str = (** Explain a tainted value error *) let explain_tainted_value_reaching_sensitive_function - prop e { Sil.taint_source; taint_kind } sensitive_fun loc = + prop e { PredSymb.taint_source; taint_kind } sensitive_fun loc = let var_desc = match e with | Exp.Lvar pv -> Pvar.to_string pv diff --git a/infer/src/backend/errdesc.mli b/infer/src/backend/errdesc.mli index 142a73671..8e4b5f69b 100644 --- a/infer/src/backend/errdesc.mli +++ b/infer/src/backend/errdesc.mli @@ -20,7 +20,7 @@ val vpath_find : 'a Prop.t -> Exp.t -> DecompiledExp.vpath * Typ.t option val id_is_assigned_then_dead : Cfg.Node.t -> Ident.t -> bool (** Check whether the hpred is a |-> representing a resource in the Racquire state *) -val hpred_is_open_resource : 'a Prop.t -> Sil.hpred -> Sil.resource option +val hpred_is_open_resource : 'a Prop.t -> Sil.hpred -> PredSymb.resource option (** Find the function call instruction used to initialize normal variable [id], and return the function name and arguments *) @@ -45,7 +45,8 @@ val explain_context_leak : Procname.t -> Typ.t -> Ident.fieldname -> (Ident.fieldname option * Typ.t) list -> Localise.error_desc (** Produce a description of a mismatch between an allocation function and a deallocation function *) -val explain_allocation_mismatch : Sil.res_action -> Sil.res_action -> Localise.error_desc +val explain_allocation_mismatch : + PredSymb.res_action -> PredSymb.res_action -> Localise.error_desc (** Produce a description of the array access performed in the current instruction, if any. *) val explain_array_access : Localise.deref_str -> 'a Prop.t -> Location.t -> Localise.error_desc @@ -56,10 +57,10 @@ val explain_class_cast_exception : Cfg.Node.t -> Location.t -> Localise.error_desc (** Explain a deallocate stack variable error *) -val explain_deallocate_stack_var : Pvar.t -> Sil.res_action -> Localise.error_desc +val explain_deallocate_stack_var : Pvar.t -> PredSymb.res_action -> Localise.error_desc (** Explain a deallocate constant string error *) -val explain_deallocate_constant_string : string -> Sil.res_action -> Localise.error_desc +val explain_deallocate_constant_string : string -> PredSymb.res_action -> Localise.error_desc (** Produce a description of which expression is dereferenced in the current instruction, if any. *) val explain_dereference : @@ -110,14 +111,15 @@ val explain_unary_minus_applied_to_unsigned_expression : (** Explain a tainted value error *) val explain_tainted_value_reaching_sensitive_function : - Prop.normal Prop.t -> Exp.t -> Sil.taint_info -> Procname.t -> Location.t -> Localise.error_desc + Prop.normal Prop.t -> Exp.t -> PredSymb.taint_info -> Procname.t -> Location.t -> + Localise.error_desc (** Produce a description of a leak by looking at the current state. If the current instruction is a variable nullify, blame the variable. If it is an abstraction, blame any variable nullify at the current node. If there is an alloc attribute, print the function call and line number. *) val explain_leak : - Tenv.t -> Sil.hpred -> 'a Prop.t -> Sil.attribute option -> string option -> + Tenv.t -> Sil.hpred -> 'a Prop.t -> PredSymb.t option -> string option -> Exceptions.exception_visibility * Localise.error_desc (** Produce a description of the memory access performed in the current instruction, if any. *) diff --git a/infer/src/backend/exceptions.ml b/infer/src/backend/exceptions.ml index a02750800..120d54060 100644 --- a/infer/src/backend/exceptions.ml +++ b/infer/src/backend/exceptions.ml @@ -46,7 +46,8 @@ exception Condition_is_assignment of Localise.error_desc * L.ml_loc exception Condition_always_true_false of Localise.error_desc * bool * L.ml_loc exception Context_leak of Localise.error_desc * L.ml_loc exception Custom_error of string * Localise.error_desc -exception Dangling_pointer_dereference of Sil.dangling_kind option * Localise.error_desc * L.ml_loc +exception Dangling_pointer_dereference of + PredSymb.dangling_kind option * Localise.error_desc * L.ml_loc exception Deallocate_stack_variable of Localise.error_desc exception Deallocate_static_memory of Localise.error_desc exception Deallocation_mismatch of Localise.error_desc * L.ml_loc @@ -61,7 +62,7 @@ exception Internal_error of Localise.error_desc exception Java_runtime_exception of Typename.t * string * Localise.error_desc exception Leak of bool * Prop.normal Prop.t * Sil.hpred * (exception_visibility * Localise.error_desc) - * bool * Sil.resource * L.ml_loc + * bool * PredSymb.resource * L.ml_loc exception Missing_fld of Ident.fieldname * L.ml_loc exception Premature_nil_termination of Localise.error_desc * L.ml_loc exception Null_dereference of Localise.error_desc * L.ml_loc @@ -210,10 +211,10 @@ let recognize_exception exn = error_desc, Some ml_loc, Exn_developer, High, None, Prover) else let loc_str = match resource with - | Sil.Rmemory _ -> Localise.memory_leak - | Sil.Rfile -> Localise.resource_leak - | Sil.Rlock -> Localise.resource_leak - | Sil.Rignore -> Localise.memory_leak in + | PredSymb.Rmemory _ -> Localise.memory_leak + | PredSymb.Rfile -> Localise.resource_leak + | PredSymb.Rlock -> Localise.resource_leak + | PredSymb.Rignore -> Localise.memory_leak in (loc_str, error_desc, Some ml_loc, exn_vis, High, None, Prover) | Match_failure (f, l, c) -> let ml_loc = (f, l, c, c) in diff --git a/infer/src/backend/exceptions.mli b/infer/src/backend/exceptions.mli index 159cf61dc..6f0231b03 100644 --- a/infer/src/backend/exceptions.mli +++ b/infer/src/backend/exceptions.mli @@ -46,7 +46,7 @@ exception Condition_is_assignment of Localise.error_desc * Logging.ml_loc exception Context_leak of Localise.error_desc * Logging.ml_loc exception Custom_error of string * Localise.error_desc exception Dangling_pointer_dereference of - Sil.dangling_kind option * Localise.error_desc * Logging.ml_loc + PredSymb.dangling_kind option * Localise.error_desc * Logging.ml_loc exception Deallocate_stack_variable of Localise.error_desc exception Deallocate_static_memory of Localise.error_desc exception Deallocation_mismatch of Localise.error_desc * Logging.ml_loc @@ -61,7 +61,7 @@ exception Internal_error of Localise.error_desc exception Java_runtime_exception of Typename.t * string * Localise.error_desc exception Leak of bool * Prop.normal Prop.t * Sil.hpred * (exception_visibility * Localise.error_desc) - * bool * Sil.resource * Logging.ml_loc + * bool * PredSymb.resource * Logging.ml_loc exception Missing_fld of Ident.fieldname * Logging.ml_loc exception Premature_nil_termination of Localise.error_desc * Logging.ml_loc exception Null_dereference of Localise.error_desc * Logging.ml_loc diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index ec74f919b..6514e0292 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -551,7 +551,7 @@ let forward_tabulate tenv wl = |> IList.fold_left (fun prop_acc (param, taint_kind) -> let attr = - Sil.Ataint { taint_source = proc_name; taint_kind; } in + PredSymb.Ataint { taint_source = proc_name; taint_kind; } in Taint.add_tainting_attribute attr param prop_acc) prop in let doit () = @@ -727,7 +727,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = let pre, post = Prop.extract_spec prop'' in let pre' = Prop.normalize (Prop.prop_sub sub pre) in if !Config.curr_language = - Config.Java && Cfg.Procdesc.get_access pdesc <> Sil.Private then + Config.Java && Cfg.Procdesc.get_access pdesc <> PredSymb.Private then report_context_leaks pname (Prop.get_sigma post) tenv; let post' = if Prover.check_inconsistency_base prop then None @@ -773,9 +773,9 @@ let collect_postconditions wl tenv pdesc : Paths.PathSet.t * Specs.Visitedset.t | Procname.ObjC_Cpp _ -> if (Procname.is_constructor pname) then Paths.PathSet.map (fun prop -> - let prop = Prop.remove_resource_attribute Sil.Racquire Sil.Rfile prop in - let prop = Prop.remove_resource_attribute Sil.Racquire (Sil.Rmemory Sil.Mmalloc) prop in - Prop.remove_resource_attribute Sil.Racquire (Sil.Rmemory Sil.Mobjc) prop + let prop = Prop.remove_resource_attribute Racquire Rfile prop in + let prop = Prop.remove_resource_attribute Racquire (Rmemory Mmalloc) prop in + Prop.remove_resource_attribute Racquire (Rmemory Mobjc) prop ) pathset else pathset | _ -> pathset in @@ -1149,7 +1149,7 @@ let is_unavoidable pre = let report_runtime_exceptions tenv pdesc summary = let pname = Specs.get_proc_name summary in let is_public_method = - (Specs.get_attributes summary).ProcAttributes.access = Sil.Public in + (Specs.get_attributes summary).ProcAttributes.access = PredSymb.Public in let is_main = is_public_method && diff --git a/infer/src/backend/localise.ml b/infer/src/backend/localise.ml index 47f4a6ad2..0e1720833 100644 --- a/infer/src/backend/localise.ml +++ b/infer/src/backend/localise.ml @@ -242,7 +242,7 @@ let by_call_to tags proc_name = "by " ^ call_to tags proc_name let by_call_to_ra tags ra = - "by " ^ call_to_at_line tags ra.Sil.ra_pname ra.Sil.ra_loc + "by " ^ call_to_at_line tags ra.PredSymb.ra_pname ra.PredSymb.ra_loc let rec format_typ = function | Typ.Tptr (typ, _) when !Config.curr_language = Config.Java -> @@ -342,11 +342,11 @@ let deref_str_undef (proc_name, loc) = let deref_str_freed ra = let tags = Tags.create () in let freed_or_closed_by_call = - let freed_or_closed = match ra.Sil.ra_res with - | Sil.Rmemory _ -> "freed" - | Sil.Rfile -> "closed" - | Sil.Rignore -> "freed" - | Sil.Rlock -> "locked" in + let freed_or_closed = match ra.PredSymb.ra_res with + | PredSymb.Rmemory _ -> "freed" + | PredSymb.Rfile -> "closed" + | PredSymb.Rignore -> "freed" + | PredSymb.Rlock -> "locked" in freed_or_closed ^ " " ^ by_call_to_ra tags ra in { tags = tags; value_pre = Some (pointer_or_object ()); @@ -356,9 +356,9 @@ let deref_str_freed ra = (** dereference strings for a dangling pointer dereference *) let deref_str_dangling dangling_kind_opt = let dangling_kind_prefix = match dangling_kind_opt with - | Some Sil.DAuninit -> "uninitialized " - | Some Sil.DAaddr_stack_var -> "deallocated stack " - | Some Sil.DAminusone -> "-1 " + | Some PredSymb.DAuninit -> "uninitialized " + | Some PredSymb.DAaddr_stack_var -> "deallocated stack " + | Some PredSymb.DAminusone -> "-1 " | None -> "" in { tags = Tags.create (); value_pre = Some (dangling_kind_prefix ^ (pointer_or_object ())); @@ -696,10 +696,10 @@ let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc | _ -> " " in let desc_str = match resource_opt with - | Some Sil.Rmemory _ -> mem_dyn_allocated ^ _to ^ value_str - | Some Sil.Rfile -> "resource" ^ typ_str ^ "acquired" ^ _to ^ value_str - | Some Sil.Rlock -> lock_acquired ^ _on ^ value_str - | Some Sil.Rignore + | Some PredSymb.Rmemory _ -> mem_dyn_allocated ^ _to ^ value_str + | Some PredSymb.Rfile -> "resource" ^ typ_str ^ "acquired" ^ _to ^ value_str + | Some PredSymb.Rlock -> lock_acquired ^ _on ^ value_str + | Some PredSymb.Rignore | None -> if value_str_opt = None then "memory" else value_str in if desc_str = "" then [] else [desc_str] in let by_call_to = match resource_action_opt with @@ -707,10 +707,10 @@ let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc | None -> [] in let is_not_rxxx_after = let rxxx = match resource_opt with - | Some Sil.Rmemory _ -> reachable - | Some Sil.Rfile - | Some Sil.Rlock -> released - | Some Sil.Rignore + | Some PredSymb.Rmemory _ -> reachable + | Some PredSymb.Rfile + | Some PredSymb.Rlock -> released + | Some PredSymb.Rignore | None -> reachable in [("is not " ^ rxxx ^ " after " ^ _line tags loc)] in let bucket_str = @@ -855,35 +855,35 @@ let desc_tainted_value_reaching_sensitive_function Tags.add tags Tags.value expr_str; let description = match taint_kind with - | Sil.Tk_unverified_SSL_socket -> + | PredSymb.Tk_unverified_SSL_socket -> F.sprintf "The hostname of SSL socket `%s` (returned from %s) has not been verified! Reading from the socket via the call to %s %s is dangerous. You should verify the hostname of the socket using a HostnameVerifier before reading; otherwise, you may be vulnerable to a man-in-the-middle attack." expr_str (format_method tainting_fun) (format_method sensitive_fun) (at_line tags loc) - | Sil.Tk_shared_preferences_data -> + | PredSymb.Tk_shared_preferences_data -> F.sprintf "`%s` holds sensitive data read from a SharedPreferences object (via call to %s). This data may leak via the call to %s %s." expr_str (format_method tainting_fun) (format_method sensitive_fun) (at_line tags loc) - | Sil.Tk_privacy_annotation -> + | PredSymb.Tk_privacy_annotation -> F.sprintf "`%s` holds privacy-sensitive data (source: call to %s). This data may leak via the call to %s %s." expr_str (format_method tainting_fun) (format_method sensitive_fun) (at_line tags loc) - | Sil.Tk_integrity_annotation -> + | PredSymb.Tk_integrity_annotation -> F.sprintf "`%s` holds untrusted user-controlled data (source: call to %s). This data may flow into a security-sensitive sink via the call to %s %s." expr_str (format_method tainting_fun) (format_method sensitive_fun) (at_line tags loc) - | Sil.Tk_unknown -> + | PredSymb.Tk_unknown -> F.sprintf "Value `%s` could be insecure (tainted) due to call to function %s %s %s %s. Function %s %s" expr_str diff --git a/infer/src/backend/localise.mli b/infer/src/backend/localise.mli index 1dec2baa8..092f28413 100644 --- a/infer/src/backend/localise.mli +++ b/infer/src/backend/localise.mli @@ -153,10 +153,10 @@ val deref_str_weak_variable_in_block : Procname.t option -> string -> deref_str val deref_str_undef : Procname.t * Location.t -> deref_str (** dereference strings for a freed pointer dereference *) -val deref_str_freed : Sil.res_action -> deref_str +val deref_str_freed : PredSymb.res_action -> deref_str (** dereference strings for a dangling pointer dereference *) -val deref_str_dangling : Sil.dangling_kind option -> deref_str +val deref_str_dangling : PredSymb.dangling_kind option -> deref_str (** dereference strings for an array out of bound access *) val deref_str_array_bound : IntLit.t option -> IntLit.t option -> deref_str @@ -213,7 +213,7 @@ val is_empty_vector_access_desc : error_desc -> bool val desc_frontend_warning : string -> string option -> Location.t -> error_desc val desc_leak : - Exp.t option -> string option -> Sil.resource option -> Sil.res_action option -> + Exp.t option -> string option -> PredSymb.resource option -> PredSymb.res_action option -> Location.t -> string option -> error_desc val desc_null_test_after_dereference : string -> int -> Location.t -> error_desc @@ -264,6 +264,6 @@ val desc_unsafe_guarded_by_access : Procname.t -> Ident.fieldname -> string -> Location.t -> error_desc val desc_tainted_value_reaching_sensitive_function : - Sil.taint_kind -> string -> Procname.t -> Procname.t -> Location.t -> error_desc + PredSymb.taint_kind -> string -> Procname.t -> Procname.t -> Location.t -> error_desc val desc_uninitialized_dangling_pointer_deref : deref_str -> string -> Location.t -> error_desc diff --git a/infer/src/backend/modelBuiltins.ml b/infer/src/backend/modelBuiltins.ml index e978f1e6e..27ee9f0ef 100644 --- a/infer/src/backend/modelBuiltins.ml +++ b/infer/src/backend/modelBuiltins.ml @@ -315,9 +315,9 @@ let set_resource_attribute prop path n_lexp loc ra_res = | Some (Apred (Aresource ra, _)) -> Prop.add_or_replace_attribute prop (Apred (Aresource { ra with ra_res }, [n_lexp])) | _ -> - let pname = Sil.mem_alloc_pname Sil.Mnew in + let pname = PredSymb.mem_alloc_pname PredSymb.Mnew in let ra = - { Sil. + { PredSymb. ra_kind = Racquire; ra_res = ra_res; ra_pname = pname; @@ -333,7 +333,7 @@ let execute___set_file_attribute { Builtin.pdesc; prop_; path; ret_ids; args; lo | [(lexp, _)], _ -> let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp pname lexp prop_ in - set_resource_attribute prop path n_lexp loc Sil.Rfile + set_resource_attribute prop path n_lexp loc PredSymb.Rfile | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** Set the attibute of the value as lock *) @@ -343,7 +343,7 @@ let execute___set_lock_attribute { Builtin.pdesc; prop_; path; ret_ids; args; lo | [(lexp, _)], _ -> let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp pname lexp prop_ in - set_resource_attribute prop path n_lexp loc Sil.Rlock + set_resource_attribute prop path n_lexp loc PredSymb.Rlock | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** Set the resource attribute of the first real argument of method as ignore, the first argument is @@ -355,7 +355,7 @@ let execute___method_set_ignore_attribute | [_ ; (lexp, _)], _ -> let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp pname lexp prop_ in - set_resource_attribute prop path n_lexp loc Sil.Rignore + set_resource_attribute prop path n_lexp loc PredSymb.Rignore | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** Set the attibute of the value as memory *) @@ -365,7 +365,7 @@ let execute___set_mem_attribute { Builtin.pdesc; prop_; path; ret_ids; args; loc | [(lexp, _)], _ -> let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp pname lexp prop_ in - set_resource_attribute prop path n_lexp loc (Sil.Rmemory Sil.Mnew) + set_resource_attribute prop path n_lexp loc (PredSymb.Rmemory PredSymb.Mnew) | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** report an error if [lexp] is tainted; otherwise, add untained([lexp]) as a precondition *) @@ -376,7 +376,7 @@ let execute___check_untainted | [(lexp, _)], _ -> let caller_pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp caller_pname lexp prop_ in - [(check_untainted n_lexp Sil.Tk_unknown caller_pname callee_pname prop, path)] + [(check_untainted n_lexp PredSymb.Tk_unknown caller_pname callee_pname prop, path)] | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** take a pointer to a struct, and return the value of a hidden field in the struct *) @@ -555,7 +555,7 @@ let execute___release_autorelease_pool ({ Builtin.prop_; path; } as builtin_args) : Builtin.ret_typ = if Config.objc_memory_model_on then - let autoreleased_objects = Prop.get_atoms_with_attribute prop_ Sil.Aautorelease in + let autoreleased_objects = Prop.get_atoms_with_attribute prop_ PredSymb.Aautorelease in let prop_without_attribute = Prop.remove_attribute prop_ Aautorelease in let call_release res atom = match res, atom with @@ -601,14 +601,14 @@ let execute___set_attr attr { Builtin.pdesc; prop_; path; args; } let execute___delete_locked_attribute { Builtin.prop_; pdesc; path; args; } : Builtin.ret_typ = match args with - | [(lexp, _)] -> delete_attr pdesc prop_ path lexp Sil.Alocked + | [(lexp, _)] -> delete_attr pdesc prop_ path lexp PredSymb.Alocked | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** Set the attibute of the value as locked*) let execute___set_locked_attribute builtin_args : Builtin.ret_typ = - execute___set_attr (Sil.Alocked) builtin_args + execute___set_attr (PredSymb.Alocked) builtin_args (** Set the attibute of the value as resource/unlocked*) let execute___set_unlocked_attribute @@ -617,12 +617,12 @@ let execute___set_unlocked_attribute let pname = Cfg.Procdesc.get_proc_name pdesc in (* ra_kind = Rrelease in following indicates unlocked *) let ra = { - Sil.ra_kind = Sil.Rrelease; - ra_res = Sil.Rlock; + PredSymb.ra_kind = PredSymb.Rrelease; + ra_res = PredSymb.Rlock; ra_pname = pname; ra_loc = loc; ra_vpath = None; } in - execute___set_attr (Sil.Aresource ra) builtin_args + execute___set_attr (PredSymb.Aresource ra) builtin_args (** Set the attibute of the value as tainted *) let execute___set_taint_attribute @@ -632,10 +632,10 @@ let execute___set_taint_attribute | (exp, _) :: [(Exp.Const (Const.Cstr taint_kind_str), _)] -> let taint_source = Cfg.Procdesc.get_proc_name pdesc in let taint_kind = match taint_kind_str with - | "UnverifiedSSLSocket" -> Sil.Tk_unverified_SSL_socket - | "SharedPreferenceData" -> Sil.Tk_shared_preferences_data + | "UnverifiedSSLSocket" -> PredSymb.Tk_unverified_SSL_socket + | "SharedPreferenceData" -> PredSymb.Tk_shared_preferences_data | other_str -> failwith ("Unrecognized taint kind " ^ other_str) in - set_attr pdesc prop_ path exp (Sil.Ataint { Sil.taint_source; taint_kind}) + set_attr pdesc prop_ path exp (PredSymb.Ataint { PredSymb.taint_source; taint_kind}) | _ -> (* note: we can also get this if [taint_kind] is not a string literal *) raise (Exceptions.Wrong_argument_number __POS__) @@ -647,8 +647,8 @@ let execute___set_untaint_attribute match args with | (exp, _) :: [] -> let taint_source = Cfg.Procdesc.get_proc_name pdesc in - let taint_kind = Sil.Tk_unknown in (* TODO: change builtin to specify taint kind *) - set_attr pdesc prop_ path exp (Sil.Auntaint { Sil.taint_source; taint_kind}) + let taint_kind = PredSymb.Tk_unknown in (* TODO: change builtin to specify taint kind *) + set_attr pdesc prop_ path exp (PredSymb.Auntaint { PredSymb.taint_source; taint_kind}) | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -685,13 +685,13 @@ let _execute_free mk loc acc iter = match Prop.prop_iter_current iter with | (Sil.Hpointsto(lexp, _, _), []) -> let prop = Prop.prop_iter_remove_curr_then_to_prop iter in - let pname = Sil.mem_dealloc_pname mk in + let pname = PredSymb.mem_dealloc_pname mk in let ra = - { Sil.ra_kind = Sil.Rrelease; - Sil.ra_res = Sil.Rmemory mk; - Sil.ra_pname = pname; - Sil.ra_loc = loc; - Sil.ra_vpath = None } in + { PredSymb.ra_kind = PredSymb.Rrelease; + PredSymb.ra_res = PredSymb.Rmemory mk; + PredSymb.ra_pname = pname; + PredSymb.ra_loc = loc; + PredSymb.ra_vpath = None } in (* mark value as freed *) let p_res = Prop.add_or_replace_attribute_check_changed @@ -769,7 +769,7 @@ let execute_alloc mk can_return_null | None -> s in Exp.Sizeof (struct_type, len, subt), pname | [(size_exp, _)] -> (* for malloc and __new *) - size_exp, Sil.mem_alloc_pname mk + size_exp, PredSymb.mem_alloc_pname mk | [(size_exp, _); (Exp.Const (Const.Cfun pname), _)] -> size_exp, pname | _ -> @@ -790,11 +790,11 @@ let execute_alloc mk can_return_null let prop_plus_ptsto = let prop' = Prop.normalize (Prop.prop_sigma_star prop [ptsto_new]) in let ra = - { Sil.ra_kind = Sil.Racquire; - Sil.ra_res = Sil.Rmemory mk; - Sil.ra_pname = procname; - Sil.ra_loc = loc; - Sil.ra_vpath = None } in + { PredSymb.ra_kind = PredSymb.Racquire; + PredSymb.ra_res = PredSymb.Rmemory mk; + PredSymb.ra_pname = procname; + PredSymb.ra_loc = loc; + PredSymb.ra_vpath = None } in (* mark value as allocated *) Prop.add_or_replace_attribute prop' (Apred (Aresource ra, [exp_new])) in let prop_alloc = Prop.conjoin_eq (Exp.Var ret_id) exp_new prop_plus_ptsto in @@ -807,7 +807,7 @@ let execute___cxx_typeid ({ Builtin.pdesc; tenv; prop_; args; loc} as r) : Builtin.ret_typ = match args with | type_info_exp :: rest -> - (let res = execute_alloc Sil.Mnew false { r with args = [type_info_exp] } in + (let res = execute_alloc PredSymb.Mnew false { r with args = [type_info_exp] } in match rest with | [(field_exp, _); (lexp, typ)] -> let pname = Cfg.Procdesc.get_proc_name pdesc in @@ -974,10 +974,10 @@ let _ = Builtin.register "__check_untainted" execute___check_untainted let __delete = Builtin.register (* like free *) - "__delete" (execute_free Sil.Mnew) + "__delete" (execute_free PredSymb.Mnew) let __delete_array = Builtin.register (* like free *) - "__delete_array" (execute_free Sil.Mnew_array) + "__delete_array" (execute_free PredSymb.Mnew_array) let __exit = Builtin.register (* _exit from C library *) "_exit" execute_exit @@ -1006,16 +1006,16 @@ let _ = Builtin.register "__method_set_ignore_attribute" execute___method_set_ignore_attribute let __new = Builtin.register (* like malloc, but always succeeds *) - "__new" (execute_alloc Sil.Mnew false) + "__new" (execute_alloc PredSymb.Mnew false) let __new_array = Builtin.register (* like malloc, but always succeeds *) - "__new_array" (execute_alloc Sil.Mnew_array false) + "__new_array" (execute_alloc PredSymb.Mnew_array false) let __objc_alloc = Builtin.register (* Objective C alloc *) - "__objc_alloc" (execute_alloc Sil.Mobjc true) + "__objc_alloc" (execute_alloc PredSymb.Mobjc true) let __objc_alloc_no_fail = Builtin.register (* like __objc_alloc, but does not return nil *) - "__objc_alloc_no_fail" (execute_alloc Sil.Mobjc false) + "__objc_alloc_no_fail" (execute_alloc PredSymb.Mobjc false) let __objc_cast = Builtin.register (* objective-c "cast" *) "__objc_cast" execute___objc_cast @@ -1062,11 +1062,11 @@ let __set_mem_attribute = Builtin.register "__set_mem_attribute" execute___set_mem_attribute let __set_observer_attribute = Builtin.register (* set the observer attribute of the parameter *) - "__set_observer_attribute" (execute___set_attr Sil.Aobserver) + "__set_observer_attribute" (execute___set_attr PredSymb.Aobserver) let __set_unsubscribed_observer_attribute = Builtin.register (* set the unregistered observer attribute of the parameter *) "__set_unsubscribed_observer_attribute" - (execute___set_attr Sil.Aunsubscribed_observer) + (execute___set_attr PredSymb.Aunsubscribed_observer) let __split_get_nth = Builtin.register (* splits a string given a separator and returns the nth string *) "__split_get_nth" execute___split_get_nth @@ -1104,7 +1104,7 @@ let _ = Builtin.register "exit" execute_exit let _ = Builtin.register (* free from C library, requires allocated memory *) - "free" (execute_free Sil.Mmalloc) + "free" (execute_free PredSymb.Mmalloc) let _ = Builtin.register (* fscanf from C library *) "fscanf" (execute_scan_function 2) @@ -1113,10 +1113,10 @@ let _ = Builtin.register "fwscanf" (execute_scan_function 2) let _ = Builtin.register (* malloc from C library *) - "malloc" (execute_alloc Sil.Mmalloc (not Config.unsafe_malloc)) + "malloc" (execute_alloc PredSymb.Mmalloc (not Config.unsafe_malloc)) let malloc_no_fail = Builtin.register (* malloc from ObjC library *) - "malloc_no_fail" (execute_alloc Sil.Mmalloc false) + "malloc_no_fail" (execute_alloc PredSymb.Mmalloc false) let _ = Builtin.register (* register execution handler for pthread_create *) "pthread_create" execute_pthread_create diff --git a/infer/src/backend/paths.ml b/infer/src/backend/paths.ml index f67a6e4e1..eaa1836be 100644 --- a/infer/src/backend/paths.ml +++ b/infer/src/backend/paths.ml @@ -30,10 +30,10 @@ module Path : sig val contains : t -> t -> bool (** check wether the path contains the given position *) - val contains_position : t -> Sil.path_pos -> bool + val contains_position : t -> PredSymb.path_pos -> bool (** Create the location trace of the path, up to the path position if specified *) - val create_loc_trace : t -> Sil.path_pos option -> Errlog.loc_trace + val create_loc_trace : t -> PredSymb.path_pos option -> Errlog.loc_trace (** return the current node of the path *) val curr_node : t -> Cfg.node option @@ -57,7 +57,7 @@ module Path : sig Do not iterate past the given position. [f level path session exn_opt] is passed the current nesting [level] and [path] and previous [session] *) val iter_longest_sequence : - (int -> t -> int -> Typename.t option -> unit) -> Sil.path_pos option -> t -> unit + (int -> t -> int -> Typename.t option -> unit) -> PredSymb.path_pos option -> t -> unit (** join two paths *) val join : t -> t -> t @@ -278,7 +278,7 @@ end = struct let contains_position path pos = let found = ref false in let f node = - if Sil.path_pos_equal (get_path_pos node) pos then found := true; + if PredSymb.path_pos_equal (get_path_pos node) pos then found := true; true in Invariant.compute_stats true f path; Invariant.reset_stats path; @@ -314,10 +314,10 @@ end = struct [f level path session exn_opt] is passed the current nesting [level] and [path] and previous [session] and possible exception [exn_opt] *) let iter_longest_sequence (f : int -> t -> int -> Typename.t option -> unit) - (pos_opt : Sil.path_pos option) (path: t) : unit = + (pos_opt : PredSymb.path_pos option) (path: t) : unit = let filter node = match pos_opt with | None -> true - | Some pos -> Sil.path_pos_equal (get_path_pos node) pos in + | Some pos -> PredSymb.path_pos_equal (get_path_pos node) pos in let path_pos_at_path p = try match curr_node p with diff --git a/infer/src/backend/paths.mli b/infer/src/backend/paths.mli index 8c807bc4f..9a99c0c0c 100644 --- a/infer/src/backend/paths.mli +++ b/infer/src/backend/paths.mli @@ -25,10 +25,10 @@ module Path : sig val contains : t -> t -> bool (** check wether the path contains the given position *) - val contains_position : t -> Sil.path_pos -> bool + val contains_position : t -> PredSymb.path_pos -> bool (** Create the location trace of the path, up to the path position if specified *) - val create_loc_trace : t -> Sil.path_pos option -> Errlog.loc_trace + val create_loc_trace : t -> PredSymb.path_pos option -> Errlog.loc_trace (** return the current node of the path *) val curr_node : t -> Cfg.node option @@ -51,7 +51,7 @@ module Path : sig Do not iterate past the given position. [f level path session exn_opt] is passed the current nesting [level] and [path] and previous [session] and possible exception [exn_opt] *) val iter_longest_sequence : - (int -> t -> int -> Typename.t option -> unit) -> Sil.path_pos option -> t -> unit + (int -> t -> int -> Typename.t option -> unit) -> PredSymb.path_pos option -> t -> unit (** join two paths *) val join : t -> t -> t diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index 6ca9794ad..604bb8d5d 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -173,8 +173,8 @@ let force_delayed_print fmt = let (a: Sil.atom) = Obj.obj a in Sil.pp_atom pe_default fmt a | (L.PTattribute, a) -> - let (a: Sil.attribute) = Obj.obj a in - F.pp_print_string fmt (Sil.attribute_to_string pe_default a) + let (a: PredSymb.t) = Obj.obj a in + F.pp_print_string fmt (PredSymb.to_string pe_default a) | (L.PTdecrease_indent, n) -> let (n: int) = Obj.obj n in for _ = 1 to n do F.fprintf fmt "@]" done diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index a56bf8056..03acd1b89 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -1795,9 +1795,9 @@ let get_attributes prop exp = IList.fold_left atom_get_attr [] prop.pi let attributes_in_same_category attr1 attr2 = - let cat1 = Sil.attribute_to_category attr1 in - let cat2 = Sil.attribute_to_category attr2 in - Sil.attribute_category_equal cat1 cat2 + let cat1 = PredSymb.to_category attr1 in + let cat2 = PredSymb.to_category attr2 in + PredSymb.category_equal cat1 cat2 let get_attribute prop exp category = let atts = get_attributes prop exp in @@ -1805,39 +1805,39 @@ let get_attribute prop exp category = Some (IList.find (function | Sil.Apred (att, _) | Anpred (att, _) -> - Sil.attribute_category_equal (Sil.attribute_to_category att) category + PredSymb.category_equal (PredSymb.to_category att) category | _ -> false ) atts) with Not_found -> None let get_undef_attribute prop exp = - get_attribute prop exp Sil.ACundef + get_attribute prop exp PredSymb.ACundef let get_resource_attribute prop exp = - get_attribute prop exp Sil.ACresource + get_attribute prop exp PredSymb.ACresource let get_taint_attribute prop exp = - get_attribute prop exp Sil.ACtaint + get_attribute prop exp PredSymb.ACtaint let get_autorelease_attribute prop exp = - get_attribute prop exp Sil.ACautorelease + get_attribute prop exp PredSymb.ACautorelease let get_objc_null_attribute prop exp = - get_attribute prop exp Sil.ACobjc_null + get_attribute prop exp PredSymb.ACobjc_null let get_div0_attribute prop exp = - get_attribute prop exp Sil.ACdiv0 + get_attribute prop exp PredSymb.ACdiv0 let get_observer_attribute prop exp = - get_attribute prop exp Sil.ACobserver + get_attribute prop exp PredSymb.ACobserver let get_retval_attribute prop exp = - get_attribute prop exp Sil.ACretval + get_attribute prop exp PredSymb.ACretval let has_dangling_uninit_attribute prop exp = let la = get_attributes prop exp in IList.exists (function - | Sil.Apred (a, _) -> Sil.attribute_equal a (Adangling DAuninit) + | Sil.Apred (a, _) -> PredSymb.equal a (Adangling DAuninit) | _ -> false ) la @@ -1884,7 +1884,7 @@ let add_or_replace_attribute prop atom = (** mark Exp.Var's or Exp.Lvar's as undefined *) let mark_vars_as_undefined prop vars_to_mark callee_pname ret_annots loc path_pos = - let att_undef = Sil.Aundef (callee_pname, ret_annots, loc, path_pos) in + let att_undef = PredSymb.Aundef (callee_pname, ret_annots, loc, path_pos) in let mark_var_as_undefined exp prop = match exp with | Exp.Var _ | Lvar _ -> add_or_replace_attribute prop (Apred (att_undef, [exp])) @@ -1897,15 +1897,15 @@ let filter_atoms ~f prop = (** Remove an attribute from all the atoms in the heap *) let remove_attribute prop att0 = let f = function - | Sil.Apred (att, _) | Anpred (att, _) -> not (Sil.attribute_equal att0 att) + | Sil.Apred (att, _) | Anpred (att, _) -> not (PredSymb.equal att0 att) | _ -> true in filter_atoms ~f prop let remove_resource_attribute ra_kind ra_res = let f = function | Sil.Apred (Aresource res_action, _) -> - Sil.res_act_kind_compare res_action.ra_kind ra_kind <> 0 - || Sil.resource_compare res_action.ra_res ra_res <> 0 + PredSymb.res_act_kind_compare res_action.ra_kind ra_kind <> 0 + || PredSymb.resource_compare res_action.ra_res ra_res <> 0 | _ -> true in filter_atoms ~f @@ -1947,14 +1947,14 @@ let rec nullify_exp_with_objc_null prop exp = (** Get all the attributes of the prop *) let get_atoms_with_attribute prop att = IList.filter (function - | Sil.Apred (att', _) | Anpred (att', _) -> Sil.attribute_equal att' att + | Sil.Apred (att', _) | Anpred (att', _) -> PredSymb.equal att' att | _ -> false ) (get_pi prop) (** Apply f to every resource attribute in the prop *) let attribute_map_resource prop f = let attribute_map e = function - | Sil.Aresource ra -> Sil.Aresource (f e ra) + | PredSymb.Aresource ra -> PredSymb.Aresource (f e ra) | att -> att in let atom_map = function | Sil.Apred (att, ([e] as es)) -> Sil.Apred (attribute_map e att, es) diff --git a/infer/src/backend/prop.mli b/infer/src/backend/prop.mli index 8d71700f2..4b5e82261 100644 --- a/infer/src/backend/prop.mli +++ b/infer/src/backend/prop.mli @@ -169,7 +169,8 @@ type arith_problem = | UminusUnsigned of Exp.t * Typ.t (** Look for an arithmetic problem in [exp] *) -val find_arithmetic_problem : path_pos -> normal t -> Exp.t -> arith_problem option * normal t +val find_arithmetic_problem : + PredSymb.path_pos -> normal t -> Exp.t -> arith_problem option * normal t (** Normalize [exp] using the pure part of [prop]. Later, we should change this such that the normalization exposes offsets of [exp] @@ -223,10 +224,10 @@ val mk_neq : Exp.t -> Exp.t -> atom val mk_eq : Exp.t -> Exp.t -> atom (** Construct a positive pred. *) -val mk_pred : attribute -> Exp.t list -> atom +val mk_pred : PredSymb.t -> Exp.t list -> atom (** Construct a negative pred. *) -val mk_npred : attribute -> Exp.t list -> atom +val mk_npred : PredSymb.t -> Exp.t list -> atom (** create a strexp of the given type, populating the structures if [expand_structs] is true *) val create_strexp_of_type : @@ -283,7 +284,8 @@ val conjoin_neq : ?footprint: bool -> Exp.t -> Exp.t -> normal t -> normal t val atom_is_attribute : atom -> bool (** Apply f to every resource attribute in the prop *) -val attribute_map_resource : normal t -> (Exp.t -> Sil.res_action -> Sil.res_action) -> normal t +val attribute_map_resource : + normal t -> (Exp.t -> PredSymb.res_action -> PredSymb.res_action) -> normal t (** Return the exp and attribute marked in the atom if any, and return None otherwise *) val atom_get_attribute : atom -> atom option @@ -322,22 +324,22 @@ val has_dangling_uninit_attribute : 'a t -> Exp.t -> bool (** Set an attribute associated to the argument expressions *) val set_attribute : ?footprint: bool -> ?polarity: bool -> - normal t -> attribute -> Exp.t list -> normal t + normal t -> PredSymb.t -> Exp.t list -> normal t val add_or_replace_attribute_check_changed : - (Sil.attribute -> Sil.attribute -> unit) -> normal t -> atom -> normal t + (PredSymb.t -> PredSymb.t -> unit) -> normal t -> atom -> normal t (** Replace an attribute associated to the expression *) val add_or_replace_attribute : normal t -> atom -> normal t (** mark Exp.Var's or Exp.Lvar's as undefined *) val mark_vars_as_undefined : normal t -> Exp.t list -> Procname.t -> Typ.item_annotation -> - Location.t -> Sil.path_pos -> normal t + Location.t -> PredSymb.path_pos -> normal t (** Remove an attribute from all the atoms in the heap *) -val remove_attribute : 'a t -> Sil.attribute -> normal t +val remove_attribute : 'a t -> PredSymb.t -> normal t -val remove_resource_attribute : Sil.res_act_kind -> Sil.resource -> 'a t -> normal t +val remove_resource_attribute : PredSymb.res_act_kind -> PredSymb.resource -> 'a t -> normal t (** [replace_objc_null lhs rhs]. If rhs has the objc_null attribute, replace the attribute and set the lhs = 0 *) @@ -349,7 +351,7 @@ val nullify_exp_with_objc_null : normal t -> Exp.t -> normal t val remove_attribute_from_exp : 'a t -> atom -> normal t (** Retrieve all the atoms that contain a specific attribute *) -val get_atoms_with_attribute : 'a t -> Sil.attribute -> Sil.atom list +val get_atoms_with_attribute : 'a t -> PredSymb.t -> Sil.atom list (** Return the sub part of [prop]. *) val get_sub : 'a t -> subst diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index 60871ae99..f82de2021 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -767,7 +767,7 @@ let add_guarded_by_constraints prop lexp pdesc = flds | _ -> false) (Prop.get_sigma prop) in - Cfg.Procdesc.get_access pdesc <> Sil.Private && + Cfg.Procdesc.get_access pdesc <> PredSymb.Private && not (Annotations.pdesc_has_annot pdesc Annotations.visibleForTesting) && not (Procname.java_is_access_method (Cfg.Procdesc.get_proc_name pdesc)) && not (is_accessible_through_local_ref lexp) in diff --git a/infer/src/backend/state.ml b/infer/src/backend/state.ml index 669259ee1..947233329 100644 --- a/infer/src/backend/state.ml +++ b/infer/src/backend/state.ml @@ -46,7 +46,7 @@ type t = { mutable last_node : Cfg.Node.t; (** Last node seen *) - mutable last_path : (Paths.Path.t * (Sil.path_pos option)) option; + mutable last_path : (Paths.Path.t * (PredSymb.path_pos option)) option; (** Last path seen *) mutable last_prop_tenv_pdesc : (Prop.normal Prop.t * Tenv.t * Cfg.Procdesc.t) option; diff --git a/infer/src/backend/state.mli b/infer/src/backend/state.mli index 60432b972..d8fcd7db2 100644 --- a/infer/src/backend/state.mli +++ b/infer/src/backend/state.mli @@ -30,7 +30,7 @@ val get_diverging_states_node : unit -> Paths.PathSet.t val get_diverging_states_proc : unit -> Paths.PathSet.t (** Get update instrumentation for the current loc *) -val get_inst_update : Sil.path_pos -> Sil.inst +val get_inst_update : PredSymb.path_pos -> Sil.inst (** Get last instruction seen in symbolic execution *) val get_instr : unit -> Sil.instr option @@ -56,10 +56,10 @@ val get_normalized_pre : (Tenv.t -> Prop.normal Prop.t -> Prop.normal Prop.t) -> Prop.normal Prop.t option (** Get last path seen in symbolic execution *) -val get_path : unit -> Paths.Path.t * (Sil.path_pos option) +val get_path : unit -> Paths.Path.t * (PredSymb.path_pos option) (** Get the last path position seen in symbolic execution *) -val get_path_pos : unit -> Sil.path_pos +val get_path_pos : unit -> PredSymb.path_pos (** Get last last prop,tenv,pdesc seen in symbolic execution *) val get_prop_tenv_pdesc : unit -> (Prop.normal Prop.t * Tenv.t * Cfg.Procdesc.t) option @@ -119,7 +119,7 @@ val set_instr : Sil.instr -> unit val set_node : Cfg.node -> unit (** Get last path seen in symbolic execution *) -val set_path : Paths.Path.t -> Sil.path_pos option -> unit +val set_path : Paths.Path.t -> PredSymb.path_pos option -> unit (** Set last prop,tenv,pdesc seen in symbolic execution *) val set_prop_tenv_pdesc : Prop.normal Prop.t -> Tenv.t -> Cfg.Procdesc.t -> unit diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index 788aef6ab..81a10a557 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -862,7 +862,7 @@ let add_constraints_on_retval pdesc prop ret_exp ~has_nullable_annot typ callee_ if Config.taint_analysis then match Taint.returns_tainted callee_pname None with | Some taint_kind -> - add_tainted_post ret_exp { Sil.taint_source = callee_pname; taint_kind; } prop'' + add_tainted_post ret_exp { taint_source = callee_pname; taint_kind; } prop'' | None -> prop'' else prop'' else add_ret_non_null ret_exp typ prop @@ -871,7 +871,7 @@ let add_taint prop lhs_id rhs_exp pname tenv = let add_attribute_if_field_tainted prop fieldname struct_typ = if Taint.has_taint_annotation fieldname struct_typ then - let taint_info = { Sil.taint_source = pname; taint_kind = Tk_unknown; } in + let taint_info = { PredSymb.taint_source = pname; taint_kind = Tk_unknown; } in Prop.add_or_replace_attribute prop (Apred (Ataint taint_info, [Exp.Var lhs_id])) else prop in @@ -1378,7 +1378,7 @@ and check_untainted exp taint_kind caller_pname callee_pname prop = Prop.add_or_replace_attribute prop (Apred (Auntaint taint_info, [exp])) | _ -> if !Config.footprint then - let taint_info = { Sil.taint_source = callee_pname; taint_kind; } in + let taint_info = { PredSymb.taint_source = callee_pname; taint_kind; } in (* add untained(n_lexp) to the footprint *) Prop.set_attribute ~footprint:true prop (Auntaint taint_info) [exp] else prop @@ -1497,7 +1497,7 @@ and check_variadic_sentinel_if_present | None -> [(prop_, path)] | Some callee_attributes -> - match Sil.get_sentinel_func_attribute_value + match PredSymb.get_sentinel_func_attribute_value callee_attributes.ProcAttributes.func_attributes with | None -> [(prop_, path)] | Some sentinel_arg -> @@ -1639,7 +1639,7 @@ and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), pa let p'' = let map_res_action e ra = (* update the vpath in resource attributes *) let vpath, _ = Errdesc.vpath_find p' e in - { ra with Sil.ra_vpath = vpath } in + { ra with PredSymb.ra_vpath = vpath } in Prop.attribute_map_resource p' map_res_action in p'', fav in let post_process_result fav_normal p path = diff --git a/infer/src/backend/symExec.mli b/infer/src/backend/symExec.mli index 63f0ff19f..a0eb955a0 100644 --- a/infer/src/backend/symExec.mli +++ b/infer/src/backend/symExec.mli @@ -31,7 +31,8 @@ val unknown_or_scan_call : is_scan:bool -> Typ.t option -> Typ.item_annotation - val check_variadic_sentinel : ?fails_on_nil:bool -> int -> int * int -> Builtin.t val check_untainted : - Exp.t -> Sil.taint_kind -> Procname.t -> Procname.t -> Prop.normal Prop.t -> Prop.normal Prop.t + Exp.t -> PredSymb.taint_kind -> Procname.t -> Procname.t -> Prop.normal Prop.t -> + Prop.normal Prop.t (** Check for arithmetic problems and normalize an expression. *) val check_arith_norm_exp : diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index d4ccca21b..34939eb57 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -27,10 +27,10 @@ type splitting = { } type deref_error = - | Deref_freed of Sil.res_action (** dereference a freed pointer *) + | Deref_freed of PredSymb.res_action (** dereference a freed pointer *) | Deref_minusone (** dereference -1 *) - | Deref_null of Sil.path_pos (** dereference null *) - | Deref_undef of Procname.t * Location.t * Sil.path_pos + | Deref_null of PredSymb.path_pos (** dereference null *) + | Deref_undef of Procname.t * Location.t * PredSymb.path_pos (** dereference a value coming from the given undefined function *) | Deref_undef_exp (** dereference an undefined expression *) @@ -314,7 +314,7 @@ let check_dereferences callee_pname actual_pre sub spec_pre formal_params = (* Check if the dereferenced expr has the dangling uninitialized attribute. *) (* In that case it raise a dangling pointer dereferece *) if Prop.has_dangling_uninit_attribute spec_pre e then - Some (Deref_undef_exp, desc false (Localise.deref_str_dangling (Some Sil.DAuninit)) ) + Some (Deref_undef_exp, desc false (Localise.deref_str_dangling (Some PredSymb.DAuninit)) ) else if Exp.equal e_sub Exp.minus_one then Some (Deref_minusone, desc true (Localise.deref_str_dangling None)) else match Prop.get_resource_attribute actual_pre e_sub with @@ -387,10 +387,10 @@ let post_process_post | _ -> false in let atom_update_alloc_attribute = function | Sil.Apred (Aresource ra, [e]) - when not (ra.Sil.ra_kind = Sil.Rrelease && actual_pre_has_freed_attribute e) -> + when not (ra.ra_kind = PredSymb.Rrelease && actual_pre_has_freed_attribute e) -> (* unless it was already freed before the call *) let vpath, _ = Errdesc.vpath_find post e in - let ra' = { ra with Sil.ra_pname = callee_pname; Sil.ra_loc = loc; Sil.ra_vpath = vpath } in + let ra' = { ra with ra_pname = callee_pname; ra_loc = loc; ra_vpath = vpath } in Sil.Apred (Aresource ra', [e]) | a -> a in let prop' = Prop.replace_sigma (post_process_sigma (Prop.get_sigma post) loc) post in @@ -586,9 +586,9 @@ let prop_footprint_add_pi_sigma_starfld_sigma (** Check if the attribute change is a mismatch between a kind of allocation and a different kind of deallocation *) let check_attr_dealloc_mismatch att_old att_new = match att_old, att_new with - | Sil.Aresource ({ Sil.ra_kind = Sil.Racquire; Sil.ra_res = Sil.Rmemory mk_old } as ra_old), - Sil.Aresource ({ Sil.ra_kind = Sil.Rrelease; Sil.ra_res = Sil.Rmemory mk_new } as ra_new) - when Sil.mem_kind_compare mk_old mk_new <> 0 -> + | PredSymb.Aresource ({ ra_kind = Racquire; ra_res = Rmemory mk_old } as ra_old), + PredSymb.Aresource ({ ra_kind = Rrelease; ra_res = Rmemory mk_new } as ra_new) + when PredSymb.mem_kind_compare mk_old mk_new <> 0 -> let desc = Errdesc.explain_allocation_mismatch ra_old ra_new in raise (Exceptions.Deallocation_mismatch (desc, __POS__)) | _ -> () @@ -801,7 +801,7 @@ let mk_pre pre formal_params callee_pname callee_attrs = Taint.get_params_to_taint tainted_param_nums formal_params |> IList.fold_left (fun prop_acc (param, taint_kind) -> - let attr = Sil.Auntaint { taint_source = callee_pname; taint_kind; } in + let attr = PredSymb.Auntaint { taint_source = callee_pname; taint_kind; } in Taint.add_tainting_attribute attr param prop_acc) (Prop.normalize pre) |> Prop.expose @@ -998,7 +998,7 @@ let check_uninitialize_dangling_deref callee_pname actual_pre sub formal_params IList.iter (fun (p, _ ) -> match check_dereferences callee_pname actual_pre sub p formal_params with | Some (Deref_undef_exp, desc) -> - raise (Exceptions.Dangling_pointer_dereference (Some Sil.DAuninit, desc, __POS__)) + raise (Exceptions.Dangling_pointer_dereference (Some PredSymb.DAuninit, desc, __POS__)) | _ -> ()) props (** Perform symbolic execution for a single spec *) @@ -1159,12 +1159,12 @@ let exe_call_postprocess ret_ids trace_call callee_pname callee_attrs loc result trace_call Specs.CallStats.CR_not_met; extend_path path_opt None; raise (Exceptions.Dangling_pointer_dereference - (Some Sil.DAminusone, desc, __POS__)) + (Some PredSymb.DAminusone, desc, __POS__)) | Dereference_error (Deref_undef_exp, desc, path_opt) -> trace_call Specs.CallStats.CR_not_met; extend_path path_opt None; raise (Exceptions.Dangling_pointer_dereference - (Some Sil.DAuninit, desc, __POS__)) + (Some PredSymb.DAuninit, desc, __POS__)) | Dereference_error (Deref_null pos, desc, path_opt) -> trace_call Specs.CallStats.CR_not_met; extend_path path_opt (Some pos); @@ -1261,7 +1261,7 @@ let exe_call_postprocess ret_ids trace_call callee_pname callee_attrs loc result (* add attribute to remember what function call a return id came from *) let ret_var = Exp.Var ret_id in let mark_id_as_retval (p, path) = - let att_retval = Sil.Aretval (callee_pname, ret_annot) in + let att_retval = PredSymb.Aretval (callee_pname, ret_annot) in Prop.set_attribute p att_retval [ret_var], path in IList.map mark_id_as_retval res | _ -> res diff --git a/infer/src/backend/tabulation.mli b/infer/src/backend/tabulation.mli index f86a8c309..291715358 100644 --- a/infer/src/backend/tabulation.mli +++ b/infer/src/backend/tabulation.mli @@ -20,11 +20,11 @@ val remove_constant_string_class : 'a Prop.t -> Prop.normal Prop.t (** Check if the attribute change is a mismatch between a kind of allocation and a different kind of deallocation *) -val check_attr_dealloc_mismatch : Sil.attribute -> Sil.attribute -> unit +val check_attr_dealloc_mismatch : PredSymb.t -> PredSymb.t -> unit (** Check whether a sexp contains a dereference without null check, and return the line number and path position *) -val find_dereference_without_null_check_in_sexp : Sil.strexp -> (int * Sil.path_pos) option +val find_dereference_without_null_check_in_sexp : Sil.strexp -> (int * PredSymb.path_pos) option (** raise a cast exception *) val raise_cast_exception : diff --git a/infer/src/backend/taint.ml b/infer/src/backend/taint.ml index e3152ed38..339cfded9 100644 --- a/infer/src/backend/taint.ml +++ b/infer/src/backend/taint.ml @@ -22,7 +22,7 @@ let sources = [ ret_type = "java.lang.Object"; params = []; is_static = true; - taint_kind = Sil.Tk_unknown; + taint_kind = Tk_unknown; language = Config.Java; }; { @@ -31,7 +31,7 @@ let sources = [ ret_type = "java.lang.Object"; params = []; is_static = true; - taint_kind = Sil.Tk_unknown; + taint_kind = Tk_unknown; language = Config.Java }; (* actual specs *) @@ -41,7 +41,7 @@ let sources = [ ret_type = "java.lang.String"; params = ["java.lang.String"; "java.lang.String"]; is_static = false; - taint_kind = Sil.Tk_shared_preferences_data; + taint_kind = Tk_shared_preferences_data; language = Config.Java }; (* === iOS === *) @@ -51,7 +51,7 @@ let sources = [ ret_type = "NSString *"; params = []; is_static = false; - taint_kind = Sil.Tk_privacy_annotation; + taint_kind = Tk_privacy_annotation; language = Config.Clang }; @@ -68,7 +68,7 @@ let sinks = [ ret_type = "void"; params = ["java.lang.Object"]; is_static = true; - taint_kind = Sil.Tk_unknown; + taint_kind = Tk_unknown; language = Config.Java }, [0]); ({ @@ -77,7 +77,7 @@ let sinks = [ ret_type = "void"; params = ["java.lang.Object"]; is_static = true; - taint_kind = Sil.Tk_unknown; + taint_kind = Tk_unknown; language = Config.Java }, [0]); (* actual specs *) @@ -87,7 +87,7 @@ let sinks = [ ret_type = "int"; params = ["java.lang.String"; "java.lang.String"]; is_static = true; - taint_kind = Sil.Tk_privacy_annotation; + taint_kind = Tk_privacy_annotation; language = Config.Java }, [0;1]); ({ @@ -96,7 +96,7 @@ let sinks = [ ret_type = "java.io.InputStream"; params = ["android.net.Uri"]; is_static = false; - taint_kind = Sil.Tk_privacy_annotation; + taint_kind = Tk_privacy_annotation; language = Config.Java; }, [1]); ({ @@ -105,7 +105,7 @@ let sinks = [ ret_type = "java.io.OutputStream"; params = ["android.net.Uri"]; is_static = false; - taint_kind = Sil.Tk_privacy_annotation; + taint_kind = Tk_privacy_annotation; language = Config.Java; }, [0]); ({ @@ -114,7 +114,7 @@ let sinks = [ ret_type = "java.io.OutputStream"; params = ["android.net.Uri"; "java.lang.String"]; is_static = false; - taint_kind = Sil.Tk_privacy_annotation; + taint_kind = Tk_privacy_annotation; language = Config.Java; }, [0]); ({ @@ -123,7 +123,7 @@ let sinks = [ ret_type = "android.content.res.AssetFileDescriptor"; params = ["android.net.Uri"; "java.lang.String"]; is_static = false; - taint_kind = Sil.Tk_privacy_annotation; + taint_kind = Tk_privacy_annotation; language = Config.Java; }, [0]); ({ @@ -132,7 +132,7 @@ let sinks = [ ret_type = "android.content.res.AssetFileDescriptor"; params = ["android.net.Uri"; "java.lang.String"; "android.os.CancellationSignal"]; is_static = false; - taint_kind = Sil.Tk_privacy_annotation; + taint_kind = Tk_privacy_annotation; language = Config.Java; }, [0]); ({ @@ -141,7 +141,7 @@ let sinks = [ ret_type = "android.os.ParcelFileDescriptor"; params = ["android.net.Uri"; "java.lang.String"; "android.os.CancellationSignal"]; is_static = false; - taint_kind = Sil.Tk_privacy_annotation; + taint_kind = Tk_privacy_annotation; language = Config.Java; }, [0]); ({ @@ -150,7 +150,7 @@ let sinks = [ ret_type = "android.os.ParcelFileDescriptor"; params = ["android.net.Uri"; "java.lang.String"]; is_static = false; - taint_kind = Sil.Tk_privacy_annotation; + taint_kind = Tk_privacy_annotation; language = Config.Java; }, [0]); ({ @@ -160,7 +160,7 @@ let sinks = [ params = ["android.net.Uri"; "java.lang.String"; "android.os.Bundle"; "android.os.CancellationSignal"]; is_static = false; - taint_kind = Sil.Tk_privacy_annotation; + taint_kind = Tk_privacy_annotation; language = Config.Java; }, [0]); ({ @@ -169,7 +169,7 @@ let sinks = [ ret_type = "android.content.res.AssetFileDescriptor"; params = ["android.net.Uri"; "java.lang.String"; "android.os.Bundle"]; is_static = false; - taint_kind = Sil.Tk_privacy_annotation; + taint_kind = Tk_privacy_annotation; language = Config.Java; }, [0]); @@ -180,7 +180,7 @@ let sinks = [ ret_type = "instancetype"; params = []; is_static = true; - taint_kind = Sil.Tk_unknown; + taint_kind = Tk_unknown; language = Config.Clang; }, [-2]); ({ @@ -189,7 +189,7 @@ let sinks = [ ret_type = "instancetype"; params = []; is_static = true; - taint_kind = Sil.Tk_unknown; + taint_kind = Tk_unknown; language = Config.Clang }, [-2]); ({ @@ -198,7 +198,7 @@ let sinks = [ ret_type = "instancetype"; params = []; is_static = true; - taint_kind = Sil.Tk_unknown; + taint_kind = Tk_unknown; language = Config.Clang }, [-2]); ({ @@ -207,7 +207,7 @@ let sinks = [ ret_type = "instancetype"; params = []; is_static = false; - taint_kind = Sil.Tk_unknown; + taint_kind = Tk_unknown; language = Config.Clang }, [-2]); ({ @@ -216,7 +216,7 @@ let sinks = [ ret_type = "instancetype"; params = []; is_static = true; - taint_kind = Sil.Tk_unknown; + taint_kind = Tk_unknown; language = Config.Clang }, [0]); @@ -227,7 +227,7 @@ let sinks = [ ret_type = "void"; params = []; is_static = false; - taint_kind = Sil.Tk_unknown; + taint_kind = Tk_unknown; language = Config.Clang; }, [1]); (* it's instance method *) ] @ FbTaint.sinks @@ -240,7 +240,7 @@ let functions_with_tainted_params = [ ret_type = "BOOL"; params = []; is_static = false; (* it's instance method *) - taint_kind = Sil.Tk_unknown; + taint_kind = Tk_unknown; language = Config.Clang; }, [2]); @@ -255,7 +255,7 @@ let functions_with_tainted_params = [ ret_type = "BOOL"; params = []; is_static = false; (* it's instance method *) - taint_kind = Sil.Tk_integrity_annotation; + taint_kind = Tk_integrity_annotation; language = Config.Clang; }, [2]); ] @ FbTaint.functions_with_tainted_params @@ -281,7 +281,7 @@ let taint_spec_to_taint_info taint_spec = match taint_spec.language with | Config.Clang -> objc_method_to_procname taint_spec | Config.Java -> java_method_to_procname taint_spec in - { Sil.taint_source; taint_kind = taint_spec.taint_kind } + { PredSymb.taint_source; taint_kind = taint_spec.taint_kind } let sources = IList.map taint_spec_to_taint_info sources @@ -305,23 +305,23 @@ let attrs_opt_get_annots = function (** returns true if [callee_pname] returns a tainted value *) let returns_tainted callee_pname callee_attrs_opt = let procname_matches taint_info = - Procname.equal taint_info.Sil.taint_source callee_pname in + Procname.equal taint_info.PredSymb.taint_source callee_pname in try let taint_info = IList.find procname_matches sources in - Some taint_info.Sil.taint_kind + Some taint_info.PredSymb.taint_kind with Not_found -> let ret_annot, _ = attrs_opt_get_annots callee_attrs_opt in if Annotations.ia_is_integrity_source ret_annot - then Some Sil.Tk_integrity_annotation + then Some PredSymb.Tk_integrity_annotation else if Annotations.ia_is_privacy_source ret_annot - then Some Sil.Tk_privacy_annotation + then Some PredSymb.Tk_privacy_annotation else None let find_callee taint_infos callee_pname = try Some (IList.find - (fun (taint_info, _) -> Procname.equal taint_info.Sil.taint_source callee_pname) + (fun (taint_info, _) -> Procname.equal taint_info.PredSymb.taint_source callee_pname) taint_infos) with Not_found -> None @@ -335,20 +335,20 @@ let accepts_sensitive_params callee_pname callee_attrs_opt = IList.mapi (fun param_num attr -> param_num + offset, attr) param_annots in let tag_tainted_indices acc (index, attr) = if Annotations.ia_is_integrity_sink attr - then (index, Sil.Tk_privacy_annotation) :: acc + then (index, PredSymb.Tk_privacy_annotation) :: acc else if Annotations.ia_is_privacy_sink attr - then (index, Sil.Tk_privacy_annotation) :: acc + then (index, PredSymb.Tk_privacy_annotation) :: acc else acc in IList.fold_left tag_tainted_indices [] indices_and_annots | Some (taint_info, tainted_param_indices) -> - IList.map (fun param_num -> param_num, taint_info.Sil.taint_kind) tainted_param_indices + IList.map (fun param_num -> param_num, taint_info.PredSymb.taint_kind) tainted_param_indices (** returns list of zero-indexed parameter numbers of [callee_pname] that should be considered tainted during symbolic execution *) let tainted_params callee_pname = match find_callee func_with_tainted_params callee_pname with | Some (taint_info, tainted_param_indices) -> - IList.map (fun param_num -> param_num, taint_info.Sil.taint_kind) tainted_param_indices + IList.map (fun param_num -> param_num, taint_info.PredSymb.taint_kind) tainted_param_indices | None -> [] let has_taint_annotation fieldname struct_typ = diff --git a/infer/src/backend/taint.mli b/infer/src/backend/taint.mli index d40d22dab..fa38ad817 100644 --- a/infer/src/backend/taint.mli +++ b/infer/src/backend/taint.mli @@ -10,19 +10,20 @@ open! Utils (** returns true if [callee_pname] returns a tainted value *) -val returns_tainted : Procname.t -> ProcAttributes.t option -> Sil.taint_kind option +val returns_tainted : Procname.t -> ProcAttributes.t option -> PredSymb.taint_kind option (** returns list of zero-indexed argument numbers of [callee_pname] that may be tainted *) -val accepts_sensitive_params : Procname.t -> ProcAttributes.t option -> (int * Sil.taint_kind) list +val accepts_sensitive_params : + Procname.t -> ProcAttributes.t option -> (int * PredSymb.taint_kind) list (** returns list of zero-indexed parameter numbers of [callee_pname] that should be considered tainted during symbolic execution *) -val tainted_params : Procname.t -> (int * Sil.taint_kind) list +val tainted_params : Procname.t -> (int * PredSymb.taint_kind) list (** returns the taint_kind of [fieldname] if it has a taint source annotation *) val has_taint_annotation : Ident.fieldname -> Typ.struct_typ -> bool -val add_tainting_attribute : Sil.attribute -> Pvar.t -> Prop.normal Prop.t -> Prop.normal Prop.t +val add_tainting_attribute : PredSymb.t -> Pvar.t -> Prop.normal Prop.t -> Prop.normal Prop.t val get_params_to_taint : - (int * Sil.taint_kind) list -> Pvar.t list -> (Pvar.t * Sil.taint_kind) list + (int * PredSymb.taint_kind) list -> Pvar.t list -> (Pvar.t * PredSymb.taint_kind) list diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index 5e4aab2eb..d252542fb 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -20,7 +20,7 @@ type taint_spec = { ret_type : string; params : string list; is_static : bool; - taint_kind : Sil.taint_kind; + taint_kind : PredSymb.taint_kind; language : Config.language } diff --git a/infer/src/checkers/patternMatch.mli b/infer/src/checkers/patternMatch.mli index 4a6ed3879..589cff50e 100644 --- a/infer/src/checkers/patternMatch.mli +++ b/infer/src/checkers/patternMatch.mli @@ -17,7 +17,7 @@ type taint_spec = { ret_type : string; params : string list; is_static : bool; - taint_kind : Sil.taint_kind; + taint_kind : PredSymb.taint_kind; language : Config.language } diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index b44c5244d..c426e79bf 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -321,7 +321,7 @@ let sil_func_attributes_of_attributes attrs = | a:: b::[] -> (int_of_string a, int_of_string b) | _ -> assert false in - do_translation (Sil.FA_sentinel(sentinel, null_pos):: acc) tl + do_translation (PredSymb.FA_sentinel(sentinel, null_pos):: acc) tl | _:: tl -> do_translation acc tl in do_translation [] attrs diff --git a/infer/src/eradicate/eradicate.ml b/infer/src/eradicate/eradicate.ml index ff1166797..05823da87 100644 --- a/infer/src/eradicate/eradicate.ml +++ b/infer/src/eradicate/eradicate.ml @@ -196,7 +196,7 @@ struct let do_proc (init_pn, init_pd) = let filter callee_pn callee_attributes = let is_private = - callee_attributes.ProcAttributes.access = Sil.Private in + callee_attributes.ProcAttributes.access = PredSymb.Private in let same_class = let get_class_opt pn = match pn with | Procname.Java pn_java -> diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index 54583670a..a9395063d 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -270,10 +270,10 @@ let create_local_procdesc program linereader cfg tenv node m = let proc_name = Procname.Java proc_name_java in let create_new_procdesc () = let trans_access = function - | `Default -> Sil.Default - | `Public -> Sil.Public - | `Private -> Sil.Private - | `Protected -> Sil.Protected in + | `Default -> PredSymb.Default + | `Public -> PredSymb.Public + | `Private -> PredSymb.Private + | `Protected -> PredSymb.Protected in try match m with | Javalib.AbstractMethod am -> (* create a procdesc with empty body *)