@ -362,12 +362,7 @@ let set_post_cell (addr, history) (edges_map, attr_set) location astate =
| > BaseAddressAttributes . add addr attr_set )
module PrePost = struct
type domain_t = t
type t = domain_t
let filter_for_summary astate =
let filter_for_summary astate =
let post_stack =
BaseStack . filter
( fun var _ -> Var . appears_in_source_code var && not ( is_local var astate ) )
@ -384,14 +379,14 @@ module PrePost = struct
; post = Domain . update ~ stack : post_stack ~ heap : post_heap astate . post }
let add_out_of_scope_attribute addr pvar location history heap typ =
let add_out_of_scope_attribute addr pvar location history heap typ =
BaseAddressAttributes . add_one addr
( Invalid ( GoneOutOfScope ( pvar , typ ) , Immediate { location ; history } ) )
heap
(* * invalidate local variables going out of scope *)
let invalidate_locals pdesc astate : t =
(* * invalidate local variables going out of scope *)
let invalidate_locals pdesc astate : t =
let attrs : BaseAddressAttributes . t = ( astate . post :> BaseDomain . t ) . attrs in
let attrs' =
BaseAddressAttributes . fold
@ -416,21 +411,21 @@ module PrePost = struct
else { astate with pre = astate . pre ; post = Domain . update astate . post ~ attrs : attrs' }
let of_post pdesc astate =
let of_post pdesc astate =
let domain = filter_for_summary astate in
let domain , _ = discard_unreachable domain in
invalidate_locals pdesc domain
(* {2 machinery to apply a pre/post pair corresponding to a function's summary in a function call
(* {2 machinery to apply a pre/post pair corresponding to a function's summary in a function call
to the current state } * )
module AddressSet = AbstractValue . Set
module AddressMap = AbstractValue . Map
module AddressSet = AbstractValue . Set
module AddressMap = AbstractValue . Map
(* * stuff we carry around when computing the result of applying one pre/post pair *)
type call_state =
{ astate : domain_ t (* * caller's abstract state computed so far *)
(* * stuff we carry around when computing the result of applying one pre/post pair *)
type call_state =
{ astate : t (* * caller's abstract state computed so far *)
; subst : ( AbstractValue . t * ValueHistory . t ) AddressMap . t
(* * translation from callee addresses to caller addresses and their caller histories *)
; rev_subst : AbstractValue . t AddressMap . t
@ -442,7 +437,7 @@ module PrePost = struct
visit each subgraph from each formal independently so we reset [ visited ] between the
visit of each formal * ) }
let pp_call_state fmt { astate ; subst ; rev_subst ; visited } =
let pp_call_state fmt { astate ; subst ; rev_subst ; visited } =
F . fprintf fmt
" @[<v>{ astate=@[<hv2>%a@];@, \
\ subst = @ [< hv2 > % a @ ] ; @ , \
@ -455,7 +450,7 @@ module PrePost = struct
rev_subst AddressSet . pp visited
type contradiction =
type contradiction =
| Aliasing of
{ addr_caller : AbstractValue . t
; addr_callee : AbstractValue . t
@ -463,8 +458,8 @@ module PrePost = struct
; call_state : call_state }
(* * raised when the precondition and the current state disagree on the aliasing, i.e. some
addresses [ callee_addr ] and [ callee_addr' ] that are distinct in the pre are aliased to a
single address [ caller_addr ] in the caller's current state . Typically raised when
calling [ foo ( z , z ) ] where the spec for [ foo ( x , y ) ] says that [ x ] and [ y ] are disjoint . * )
single address [ caller_addr ] in the caller's current state . Typically raised when calling
[ foo ( z , z ) ] where the spec for [ foo ( x , y ) ] says that [ x ] and [ y ] are disjoint . * )
| CItv of
{ addr_caller : AbstractValue . t
; addr_callee : AbstractValue . t
@ -483,7 +478,7 @@ module PrePost = struct
| FormalActualLength of
{ formals : Var . t list ; actuals : ( ( AbstractValue . t * ValueHistory . t ) * Typ . t ) list }
let pp_contradiction fmt = function
let pp_contradiction fmt = function
| Aliasing { addr_caller ; addr_callee ; addr_callee' ; call_state } ->
F . fprintf fmt
" address %a in caller already bound to %a, not %a@ \n note: current call state was %a "
@ -493,8 +488,8 @@ module PrePost = struct
F . fprintf fmt
" caller addr %a%a but callee addr %a%a; %a=%a is unsatisfiable@ \n \
note : current call state was % a " AbstractValue.pp addr_caller (Pp.option CItv.pp)
arith_caller AbstractValue . pp addr_callee ( Pp . option CItv . pp ) arith_callee
AbstractValue . pp addr_caller AbstractValue . pp addr_callee pp_call_state call_state
arith_caller AbstractValue . pp addr_callee ( Pp . option CItv . pp ) arith_callee AbstractValue . pp
addr_caller AbstractValue . pp addr_callee pp_call_state call_state
| ArithmeticBo { addr_caller ; addr_callee ; arith_callee ; call_state } ->
F . fprintf fmt
" callee addr %a%a is incompatible with caller addr %a's arithmetic constraints@ \n \
@ -505,9 +500,9 @@ module PrePost = struct
( List . length actuals )
exception Contradiction of contradiction
exception Contradiction of contradiction
let fold_globals_of_stack call_loc stack call_state ~ f =
let fold_globals_of_stack call_loc stack call_state ~ f =
Container . fold_result ~ fold : ( IContainer . fold_of_pervasives_map_fold ~ fold : BaseStack . fold )
stack ~ init : call_state ~ f : ( fun call_state ( var , stack_value ) ->
match var with
@ -524,7 +519,7 @@ module PrePost = struct
Ok call_state )
let visit call_state ~ addr_callee ~ addr_hist_caller =
let visit call_state ~ addr_callee ~ addr_hist_caller =
let addr_caller = fst addr_hist_caller in
( match AddressMap . find_opt addr_caller call_state . rev_subst with
| Some addr_callee' when not ( AbstractValue . equal addr_callee addr_callee' ) ->
@ -540,23 +535,23 @@ module PrePost = struct
; rev_subst = AddressMap . add addr_caller addr_callee call_state . rev_subst } )
let pp f { pre ; post ; skipped_calls } =
let pp f { pre ; post ; skipped_calls } =
F . fprintf f " PRE:@ \n @[%a@]@ \n " BaseDomain . pp ( pre :> BaseDomain . t ) ;
F . fprintf f " POST:@ \n @[%a@]@ \n " BaseDomain . pp ( post :> BaseDomain . t ) ;
F . fprintf f " SKIPPED_CALLS:@ @[%a@]@ \n " SkippedCalls . pp skipped_calls
(* {3 reading the pre from the current state} *)
(* {3 reading the pre from the current state} *)
let add_call_to_trace proc_name call_location caller_history in_call =
let add_call_to_trace proc_name call_location caller_history in_call =
Trace . ViaCall { f = Call proc_name ; location = call_location ; history = caller_history ; in_call }
(* * Materialize the ( abstract memory ) subgraph of [pre] reachable from [addr_pre] in
(* * Materialize the ( abstract memory ) subgraph of [pre] reachable from [addr_pre] in
[ call_state . astate ] starting from address [ addr_caller ] . Report an error if some invalid
addresses are traversed in the process . * )
let rec materialize_pre_from_address callee_proc_name call_location ~ pre ~ addr_pre
~ addr_hist_caller call_state =
let rec materialize_pre_from_address callee_proc_name call_location ~ pre ~ addr_pre ~ addr_hist_caller
call_state =
match visit call_state ~ addr_callee : addr_pre ~ addr_hist_caller with
| ` AlreadyVisited , call_state ->
Ok call_state
@ -565,21 +560,19 @@ module PrePost = struct
| None ->
Ok call_state
| Some edges_pre ->
Container . fold_result
~ fold : ( IContainer . fold_of_pervasives_map_fold ~ fold : Memory . Edges . fold )
Container . fold_result ~ fold : ( IContainer . fold_of_pervasives_map_fold ~ fold : Memory . Edges . fold )
~ init : call_state edges_pre ~ f : ( fun call_state ( access , ( addr_pre_dest , _ ) ) ->
let astate , addr_hist_dest_caller =
Memory . eval_edge addr_hist_caller access call_state . astate
in
let call_state = { call_state with astate } in
materialize_pre_from_address callee_proc_name call_location ~ pre
~ addr_pre : addr_pre_dest ~ addr_hist_caller : addr_hist_dest_caller call_state ) )
materialize_pre_from_address callee_proc_name call_location ~ pre ~ addr_pre : addr_pre_dest
~ addr_hist_caller : addr_hist_dest_caller call_state ) )
(* * materialize subgraph of [pre] rooted at the address represented by a [formal] parameter that
has been instantiated with the corresponding [ actual ] into the current state
[ call_state . astate ] * )
let materialize_pre_from_actual callee_proc_name call_location ~ pre ~ formal ~ actual call_state =
(* * materialize subgraph of [pre] rooted at the address represented by a [formal] parameter that has
been instantiated with the corresponding [ actual ] into the current state [ call_state . astate ] * )
let materialize_pre_from_actual callee_proc_name call_location ~ pre ~ formal ~ actual call_state =
L . d_printfln " Materializing PRE from [%a <- %a] " Var . pp formal AbstractValue . pp ( fst actual ) ;
( let open IOption . Let_syntax in
let * addr_formal_pre , _ = BaseStack . find_opt formal pre . BaseDomain . stack in
@ -589,7 +582,7 @@ module PrePost = struct
| > function Some result -> result | None -> Ok call_state
let is_cell_read_only ~ edges_pre_opt ~ cell_post : ( edges_post , attrs_post ) =
let is_cell_read_only ~ edges_pre_opt ~ cell_post : ( edges_post , attrs_post ) =
match edges_pre_opt with
| None ->
false
@ -610,7 +603,7 @@ module PrePost = struct
false
let materialize_pre_for_parameters callee_proc_name call_location pre_post ~ formals ~ actuals
let materialize_pre_for_parameters callee_proc_name call_location pre_post ~ formals ~ actuals
call_state =
(* For each [ ( formal, actual ) ] pair, resolve them to addresses in their respective states then
call [ materialize_pre_from ] on them . Give up if calling the function introduces aliasing .
@ -627,7 +620,7 @@ module PrePost = struct
result
let materialize_pre_for_globals callee_proc_name call_location pre_post call_state =
let materialize_pre_for_globals callee_proc_name call_location pre_post call_state =
fold_globals_of_stack call_location ( pre_post . pre :> BaseDomain . t ) . stack call_state
~ f : ( fun _ var ~ stack_value : ( addr_pre , _ ) ~ addr_hist_caller call_state ->
materialize_pre_from_address callee_proc_name call_location
@ -635,7 +628,7 @@ module PrePost = struct
~ addr_pre ~ addr_hist_caller call_state )
let eval_sym_of_subst astate subst s bound_end =
let eval_sym_of_subst astate subst s bound_end =
let v = Symb . Symbol . get_pulse_value_exn s in
match PulseAbstractValue . Map . find_opt v ! subst with
| Some ( v' , _ ) ->
@ -646,7 +639,7 @@ module PrePost = struct
Bounds . Bound . of_pulse_value v'
let subst_attribute call_state subst_ref astate ~ addr_caller attr ~ addr_callee =
let subst_attribute call_state subst_ref astate ~ addr_caller attr ~ addr_callee =
match ( attr : Attribute . t ) with
| CItv ( arith_callee , hist ) -> (
let arith_caller_opt = AddressAttributes . get_citv addr_caller astate | > Option . map ~ f : fst in
@ -673,8 +666,7 @@ module PrePost = struct
Attribute . BoItv itv'
| Bottom ->
raise
( Contradiction ( ArithmeticBo { addr_callee ; addr_caller ; arith_callee = itv ; call_state } ) )
)
( Contradiction ( ArithmeticBo { addr_callee ; addr_caller ; arith_callee = itv ; call_state } ) ) )
| AddressOfCppTemporary _
| AddressOfStackVariable _
| Allocated _
@ -687,7 +679,7 @@ module PrePost = struct
attr
let add_call_to_attributes proc_name call_location ~ addr_callee ~ addr_caller caller_history attrs
let add_call_to_attributes proc_name call_location ~ addr_callee ~ addr_caller caller_history attrs
call_state =
let add_call_to_attribute attr =
match ( attr : Attribute . t ) with
@ -719,11 +711,11 @@ module PrePost = struct
( ! subst_ref , attrs )
let apply_arithmetic_constraints callee_proc_name call_location pre_post call_state =
let apply_arithmetic_constraints callee_proc_name call_location pre_post call_state =
let one_address_sat addr_callee callee_attrs ( addr_caller , caller_history ) call_state =
let subst , attrs_caller =
add_call_to_attributes callee_proc_name call_location ~ addr_callee ~ addr_caller
caller_history callee_attrs call_state
add_call_to_attributes callee_proc_name call_location ~ addr_callee ~ addr_caller caller_history
callee_attrs call_state
in
let astate = AddressAttributes . abduce_and_add addr_caller attrs_caller call_state . astate in
if phys_equal subst call_state . subst && phys_equal astate call_state . astate then call_state
@ -740,7 +732,7 @@ module PrePost = struct
call_state . subst call_state
let materialize_pre callee_proc_name call_location pre_post ~ formals ~ actuals call_state =
let materialize_pre callee_proc_name call_location pre_post ~ formals ~ actuals call_state =
PerfEvent . ( log ( fun logger -> log_begin_event logger ~ name : " pulse call pre " () ) ) ;
let r =
let open IResult . Let_syntax in
@ -756,9 +748,9 @@ module PrePost = struct
r
(* {3 applying the post to the current state} *)
(* {3 applying the post to the current state} *)
let subst_find_or_new subst addr_callee ~ default_hist_caller =
let subst_find_or_new subst addr_callee ~ default_hist_caller =
match AddressMap . find_opt addr_callee subst with
| None ->
let addr_hist_fresh = ( AbstractValue . mk_fresh () , default_hist_caller ) in
@ -767,7 +759,7 @@ module PrePost = struct
( subst , addr_hist_caller )
let call_state_subst_find_or_new call_state addr_callee ~ default_hist_caller =
let call_state_subst_find_or_new call_state addr_callee ~ default_hist_caller =
let new_subst , addr_hist_caller =
subst_find_or_new call_state . subst addr_callee ~ default_hist_caller
in
@ -775,7 +767,7 @@ module PrePost = struct
else ( { call_state with subst = new_subst } , addr_hist_caller )
let delete_edges_in_callee_pre_from_caller ~ addr_callee : _ ~ edges_pre_opt ~ addr_caller call_state =
let delete_edges_in_callee_pre_from_caller ~ addr_callee : _ ~ edges_pre_opt ~ addr_caller call_state =
match BaseMemory . find_opt addr_caller ( call_state . astate . post :> base_domain ) . heap with
| None ->
BaseMemory . Edges . empty
@ -795,7 +787,7 @@ module PrePost = struct
old_post_edges edges_pre )
let record_post_cell callee_proc_name call_loc ~ addr_callee ~ edges_pre_opt
let record_post_cell callee_proc_name call_loc ~ addr_callee ~ edges_pre_opt
~ cell_post : ( edges_post , attrs_post ) ~ addr_hist_caller : ( addr_caller , hist_caller ) call_state =
let post_edges_minus_pre =
delete_edges_in_callee_pre_from_caller ~ addr_callee ~ edges_pre_opt ~ addr_caller call_state
@ -805,9 +797,7 @@ module PrePost = struct
add_call_to_attributes ~ addr_callee ~ addr_caller callee_proc_name call_loc hist_caller
attrs_post call_state
in
let astate =
AddressAttributes . abduce_and_add addr_caller attrs_post_caller call_state . astate
in
let astate = AddressAttributes . abduce_and_add addr_caller attrs_post_caller call_state . astate in
{ call_state with subst ; astate }
in
let heap = ( call_state . astate . post :> base_domain ) . heap in
@ -855,7 +845,7 @@ module PrePost = struct
{ call_state with subst ; astate = { call_state . astate with post = caller_post } }
let rec record_post_for_address callee_proc_name call_loc ( { pre } as pre_post ) ~ addr_callee
let rec record_post_for_address callee_proc_name call_loc ( { pre } as pre_post ) ~ addr_callee
~ addr_hist_caller call_state =
L . d_printfln " %a<->%a " AbstractValue . pp addr_callee AbstractValue . pp ( fst addr_hist_caller ) ;
match visit call_state ~ addr_callee ~ addr_hist_caller with
@ -866,14 +856,12 @@ module PrePost = struct
| None ->
call_state
| Some ( ( edges_post , _ attrs_post ) as cell_post ) ->
let edges_pre_opt =
BaseMemory . find_opt addr_callee ( pre :> BaseDomain . t ) . BaseDomain . heap
in
let edges_pre_opt = BaseMemory . find_opt addr_callee ( pre :> BaseDomain . t ) . BaseDomain . heap in
let call_state_after_post =
if is_cell_read_only ~ edges_pre_opt ~ cell_post then call_state
else
record_post_cell callee_proc_name call_loc ~ addr_callee ~ edges_pre_opt
~ addr_hist_caller ~ cell_post call_state
record_post_cell callee_proc_name call_loc ~ addr_callee ~ edges_pre_opt ~ addr_hist_caller
~ cell_post call_state
in
IContainer . fold_of_pervasives_map_fold ~ fold : Memory . Edges . fold ~ init : call_state_after_post
edges_post ~ f : ( fun call_state ( _ access , ( addr_callee_dest , _ ) ) ->
@ -881,13 +869,12 @@ module PrePost = struct
call_state_subst_find_or_new call_state addr_callee_dest
~ default_hist_caller : ( snd addr_hist_caller )
in
record_post_for_address callee_proc_name call_loc pre_post
~ addr_callee : addr_callee_dest ~ addr_hist_caller : addr_hist_curr_dest call_state ) )
record_post_for_address callee_proc_name call_loc pre_post ~ addr_callee : addr_callee_dest
~ addr_hist_caller : addr_hist_curr_dest call_state ) )
let record_post_for_actual callee_proc_name call_loc pre_post ~ formal ~ actual call_state =
L . d_printfln_escaped " Recording POST from [%a] <-> %a " Var . pp formal AbstractValue . pp
( fst actual ) ;
let record_post_for_actual callee_proc_name call_loc pre_post ~ formal ~ actual call_state =
L . d_printfln_escaped " Recording POST from [%a] <-> %a " Var . pp formal AbstractValue . pp ( fst actual ) ;
match
let open IOption . Let_syntax in
let * addr_formal_pre , _ =
@ -906,7 +893,7 @@ module PrePost = struct
call_state
let record_post_for_return callee_proc_name call_loc pre_post call_state =
let record_post_for_return callee_proc_name call_loc pre_post call_state =
let return_var = Var . of_pvar ( Pvar . get_ret_pvar callee_proc_name ) in
match BaseStack . find_opt return_var ( pre_post . post :> BaseDomain . t ) . stack with
| None ->
@ -934,8 +921,7 @@ module PrePost = struct
( call_state , Some return_caller_addr_hist ) )
let apply_post_for_parameters callee_proc_name call_location pre_post ~ formals ~ actuals call_state
=
let apply_post_for_parameters callee_proc_name call_location pre_post ~ formals ~ actuals call_state =
(* for each [ ( formal_i, actual_i ) ] pair, do [post_i = post union subst ( graph reachable from
formal_i in post ) ] , deleting previous info when comparing pre and post shows a difference
( TODO : record in the pre when a location is written to instead of just comparing values
@ -943,8 +929,7 @@ module PrePost = struct
post but nuke other fields in the meantime ? is that possible ? ) . * )
match
List . fold2 formals actuals ~ init : call_state ~ f : ( fun call_state formal ( actual , _ ) ->
record_post_for_actual callee_proc_name call_location pre_post ~ formal ~ actual call_state
)
record_post_for_actual callee_proc_name call_location pre_post ~ formal ~ actual call_state )
with
| Unequal_lengths ->
(* should have been checked before by [materialize_pre] *)
@ -953,7 +938,7 @@ module PrePost = struct
call_state
let apply_post_for_globals callee_proc_name call_location pre_post call_state =
let apply_post_for_globals callee_proc_name call_location pre_post call_state =
match
fold_globals_of_stack call_location ( pre_post . pre :> BaseDomain . t ) . stack call_state
~ f : ( fun _ var ~ stack_value : ( addr_callee , _ ) ~ addr_hist_caller call_state ->
@ -967,7 +952,7 @@ module PrePost = struct
call_state
let record_post_remaining_attributes callee_proc_name call_loc pre_post call_state =
let record_post_remaining_attributes callee_proc_name call_loc pre_post call_state =
BaseAddressAttributes . fold
( fun addr_callee attrs call_state ->
if AddressSet . mem addr_callee call_state . visited then
@ -987,7 +972,7 @@ module PrePost = struct
( pre_post . post :> BaseDomain . t ) . attrs call_state
let record_skipped_calls callee_proc_name call_loc pre_post call_state =
let record_skipped_calls callee_proc_name call_loc pre_post call_state =
let callee_skipped_map = pre_post . skipped_calls in
let caller_skipped_map =
SkippedCalls . map
@ -1001,7 +986,7 @@ module PrePost = struct
{ call_state with astate = { call_state . astate with skipped_calls = caller_skipped_map } }
let apply_post callee_proc_name call_location pre_post ~ formals ~ actuals call_state =
let apply_post callee_proc_name call_location pre_post ~ formals ~ actuals call_state =
PerfEvent . ( log ( fun logger -> log_begin_event logger ~ name : " pulse call post " () ) ) ;
let r =
apply_post_for_parameters callee_proc_name call_location pre_post ~ formals ~ actuals call_state
@ -1017,7 +1002,7 @@ module PrePost = struct
r
let check_all_valid callee_proc_name call_location { pre ; post = _ } call_state =
let check_all_valid callee_proc_name call_location { pre ; post = _ } call_state =
AddressMap . fold
( fun addr_pre ( addr_caller , hist_caller ) astate_result ->
match astate_result with
@ -1038,12 +1023,12 @@ module PrePost = struct
AddressAttributes . check_valid access_trace addr_caller astate
| > Result . map_error ~ f : ( fun ( invalidation , invalidation_trace ) ->
L . d_printfln " ERROR: caller's %a invalid! " AbstractValue . pp addr_caller ;
Diagnostic . AccessToInvalidAddress
{ invalidation ; invalidation_trace ; access_trace } ) ) )
Diagnostic . AccessToInvalidAddress { invalidation ; invalidation_trace ; access_trace }
) ) )
call_state . subst ( Ok call_state . astate )
(* - read all the pre, assert validity of addresses and materializes * everything * ( to throw stuff
(* - read all the pre, assert validity of addresses and materializes * everything * ( to throw stuff
in the * current * pre as appropriate so that callers of the current procedure will also know
about the deeper reads )
@ -1057,7 +1042,7 @@ module PrePost = struct
the noise that this will introduce since we don't care about values . For instance , if the pre
is for a path where [ formal != 0 ] and we pass [ 0 ] then it will be an FP . Maybe the solution is
to bake in some value analysis . * )
let apply callee_proc_name call_location pre_post ~ formals ~ actuals astate =
let apply callee_proc_name call_location pre_post ~ formals ~ actuals astate =
L . d_printfln " Applying pre/post for %a(%a):@ \n %a " Procname . pp callee_proc_name
( Pp . seq ~ sep : " , " Var . pp ) formals pp pre_post ;
let empty_call_state =
@ -1094,9 +1079,8 @@ module PrePost = struct
error )
let get_pre { pre } = ( pre :> BaseDomain . t )
let get_pre { pre } = ( pre :> BaseDomain . t )
let get_post { post } = ( post :> BaseDomain . t )
let get_post { post } = ( post :> BaseDomain . t )
let get_skipped_calls { skipped_calls } = skipped_calls
end
let get_skipped_calls { skipped_calls } = skipped_calls