@@ -2045,7 +2045,7 @@ struct
2045
2045
List. map mpt exps
2046
2046
)
2047
2047
2048
- let invalidate ?(deep =true ) ~ctx (st :store ) (exps : exp list ): store =
2048
+ let invalidate ~( must : bool ) ?(deep =true ) ~ctx (st :store ) (exps : exp list ): store =
2049
2049
if M. tracing && exps <> [] then M. tracel " invalidate" " Will invalidate expressions [%a]" (d_list " , " d_plainexp) exps;
2050
2050
if exps <> [] then M. info ~category: Imprecise " Invalidating expressions: %a" (d_list " , " d_exp) exps;
2051
2051
(* To invalidate a single address, we create a pair with its corresponding
@@ -2072,7 +2072,15 @@ struct
2072
2072
let vs = List. map (Tuple3. third) invalids' in
2073
2073
M. tracel " invalidate" " Setting addresses [%a] to values [%a]" (d_list " , " AD. pretty) addrs (d_list " , " VD. pretty) vs
2074
2074
);
2075
- set_many ~ctx st invalids'
2075
+ (* copied from set_many *)
2076
+ let f (acc : store ) ((lval :AD.t ),(typ :Cil.typ ),(value :value )): store =
2077
+ let acc' = set ~ctx acc lval typ value in
2078
+ if must then
2079
+ acc'
2080
+ else
2081
+ D. join acc acc'
2082
+ in
2083
+ List. fold_left f st invalids'
2076
2084
2077
2085
2078
2086
let make_entry ?(thread =false ) (ctx :(D.t, G.t, C.t, V.t) Analyses.ctx ) fundec args : D.t =
@@ -2211,8 +2219,8 @@ struct
2211
2219
in
2212
2220
(* TODO: what about escaped local variables? *)
2213
2221
(* invalidate arguments and non-static globals for unknown functions *)
2214
- let st' = invalidate ~deep: false ~ctx ctx.local shallow_addrs in
2215
- invalidate ~deep: true ~ctx st' deep_addrs
2222
+ let st' = invalidate ~must: false ~ deep:false ~ctx ctx.local shallow_addrs in
2223
+ invalidate ~must: false ~ deep:true ~ctx st' deep_addrs
2216
2224
2217
2225
let check_invalid_mem_dealloc ctx special_fn ptr =
2218
2226
let has_non_heap_var = AD. exists (function
@@ -2302,7 +2310,7 @@ struct
2302
2310
let invalidate_ret_lv st = match lv with
2303
2311
| Some lv ->
2304
2312
if M. tracing then M. tracel " invalidate" " Invalidating lhs %a for function call %s" d_plainlval lv f.vname;
2305
- invalidate ~deep: false ~ctx st [Cil. mkAddrOrStartOf lv]
2313
+ invalidate ~must: true ~ deep:false ~ctx st [Cil. mkAddrOrStartOf lv]
2306
2314
| None -> st
2307
2315
in
2308
2316
let addr_type_of_exp exp =
@@ -2636,14 +2644,14 @@ struct
2636
2644
| Int n when GobOption. exists (Z. equal Z. zero) (ID. to_int n) -> st
2637
2645
| Address ret_a ->
2638
2646
begin match eval_rv ~ctx st id with
2639
- | Thread a when ValueDomain.Threads. is_top a -> invalidate ~ctx st [ret_var]
2647
+ | Thread a when ValueDomain.Threads. is_top a -> invalidate ~must: true ~ ctx st [ret_var]
2640
2648
| Thread a ->
2641
2649
let v = List. fold VD. join (VD. bot () ) (List. map (fun x -> G. thread (ctx.global (V. thread x))) (ValueDomain.Threads. elements a)) in
2642
2650
(* TODO: is this type right? *)
2643
2651
set ~ctx st ret_a (Cilfacade. typeOf ret_var) v
2644
- | _ -> invalidate ~ctx st [ret_var]
2652
+ | _ -> invalidate ~must: true ~ ctx st [ret_var]
2645
2653
end
2646
- | _ -> invalidate ~ctx st [ret_var]
2654
+ | _ -> invalidate ~must: true ~ ctx st [ret_var]
2647
2655
in
2648
2656
let st' = invalidate_ret_lv st' in
2649
2657
Priv. thread_join (Analyses. ask_of_ctx ctx) (priv_getg ctx.global) id st'
0 commit comments