Skip to content
Snippets Groups Projects
Commit 9a434b7a authored by David Bühler's avatar David Bühler
Browse files

[Eva] Requests: fixes evaluation of \result in post-conditions.

parent bc471902
No related branches found
No related tags found
No related merge requests found
...@@ -226,8 +226,10 @@ let marker_evaluation_point = function ...@@ -226,8 +226,10 @@ let marker_evaluation_point = function
| PTermLval (_, _, prop, _) | PIP prop -> property_evaluation_point prop | PTermLval (_, _, prop, _) | PIP prop -> property_evaluation_point prop
| PType _ -> raise Not_found | PType _ -> raise Not_found
let term_lval_to_lval tlval = let term_lval_to_lval kf tlval =
try Logic_to_c.term_lval_to_lval tlval try
let result = Option.bind kf Eva_utils.find_return_var in
Logic_to_c.term_lval_to_lval ?result tlval
with Logic_to_c.No_conversion -> raise Not_found with Logic_to_c.No_conversion -> raise Not_found
let print_value fmt loc = let print_value fmt loc =
...@@ -242,8 +244,8 @@ let print_value fmt loc = ...@@ -242,8 +244,8 @@ let print_value fmt loc =
Results.eval_exp expr Results.eval_exp expr
| PVDecl (_, _, vi) when is_scalar vi.vtype -> | PVDecl (_, _, vi) when is_scalar vi.vtype ->
Results.eval_var vi Results.eval_var vi
| PTermLval (_, _, _ip, tlval) -> | PTermLval (kf, _, _ip, tlval) ->
let lval = term_lval_to_lval tlval in let lval = term_lval_to_lval kf tlval in
if is_scalar (Cil.typeOfLval lval) if is_scalar (Cil.typeOfLval lval)
then Results.eval_lval lval then Results.eval_lval lval
else raise Not_found else raise Not_found
...@@ -288,8 +290,8 @@ module EvaTaints = struct ...@@ -288,8 +290,8 @@ module EvaTaints = struct
| PLval (_, Kstmt stmt, lval) -> Some (expr_of_lval lval, stmt) | PLval (_, Kstmt stmt, lval) -> Some (expr_of_lval lval, stmt)
| PExp (_, Kstmt stmt, expr) -> Some (expr, stmt) | PExp (_, Kstmt stmt, expr) -> Some (expr, stmt)
| PVDecl (_, Kstmt stmt, vi) -> Some (expr_of_lval (Var vi, NoOffset), stmt) | PVDecl (_, Kstmt stmt, vi) -> Some (expr_of_lval (Var vi, NoOffset), stmt)
| PTermLval (_, Kstmt stmt, _, tlval) -> | PTermLval (kf, Kstmt stmt, _, tlval) ->
Some (term_lval_to_lval tlval |> expr_of_lval, stmt) Some (term_lval_to_lval kf tlval |> expr_of_lval, stmt)
| _ -> None | _ -> None
let of_marker marker = let of_marker marker =
......
...@@ -32,3 +32,7 @@ type evaluation_point = ...@@ -32,3 +32,7 @@ type evaluation_point =
(* Returns the evaluation point of a marker. (* Returns the evaluation point of a marker.
@raises Not_found if the marker cannot be evaluated. *) @raises Not_found if the marker cannot be evaluated. *)
val marker_evaluation_point: Printer_tag.localizable -> evaluation_point val marker_evaluation_point: Printer_tag.localizable -> evaluation_point
(* Converts an ACSL lval into a C lval.
@raises Not_found if the conversion fails. *)
val term_lval_to_lval: kernel_function option -> term_lval -> lval
...@@ -114,12 +114,6 @@ let probe_property = function ...@@ -114,12 +114,6 @@ let probe_property = function
Ppred (Logic_const.pred_of_id_pred pred) Ppred (Logic_const.pred_of_id_pred pred)
| _ -> raise Not_found | _ -> raise Not_found
let probe_term_lval kf tlval =
try
let result = Option.bind kf Library_functions.get_retres_vi in
Plval (Logic_to_c.term_lval_to_lval ?result tlval)
with Logic_to_c.No_conversion -> raise Not_found
let probe_marker = function let probe_marker = function
| Printer_tag.PLval (_, _, (Var vi, NoOffset)) | Printer_tag.PLval (_, _, (Var vi, NoOffset))
| PVDecl (_, _, vi) when Cil.isFunctionType vi.vtype -> raise Not_found | PVDecl (_, _, vi) when Cil.isFunctionType vi.vtype -> raise Not_found
...@@ -127,7 +121,8 @@ let probe_marker = function ...@@ -127,7 +121,8 @@ let probe_marker = function
| PExp (_, _, e) -> Pexpr e | PExp (_, _, e) -> Pexpr e
| PStmt (_, s) | PStmtStart (_, s) -> probe_stmt s | PStmt (_, s) | PStmtStart (_, s) -> probe_stmt s
| PVDecl (_, _, v) -> Plval (Var v, NoOffset) | PVDecl (_, _, v) -> Plval (Var v, NoOffset)
| PTermLval (kf, _, _, tlval) -> probe_term_lval kf tlval | PTermLval (kf, _, _, tlval) ->
Plval (General_requests.term_lval_to_lval kf tlval)
| PIP property -> probe_property property | PIP property -> probe_property property
| _ -> raise Not_found | _ -> raise Not_found
...@@ -475,9 +470,16 @@ module Proxy(A : Analysis.S) : EvaProxy = struct ...@@ -475,9 +470,16 @@ module Proxy(A : Analysis.S) : EvaProxy = struct
let eval_expr expr state = let eval_expr expr state =
A.eval_expr state expr >>=: fun value -> Value value A.eval_expr state expr >>=: fun value -> Value value
let eval_pred predicate state = let eval_pred eval_point predicate state =
let result =
match eval_point with
| Initial | Pre _ -> None
| Stmt stmt ->
let kf = Kernel_function.find_englobing_kf stmt in
Eva_utils.find_return_var kf
in
let env = let env =
Abstract_domain.{ states = (function _ -> A.Dom.top) ; result = None } Abstract_domain.{ states = (function _ -> A.Dom.top) ; result }
in in
let truth = A.Dom.evaluate_predicate env state predicate in let truth = A.Dom.evaluate_predicate env state predicate in
`Value (Status truth), Alarmset.none `Value (Status truth), Alarmset.none
...@@ -518,7 +520,7 @@ module Proxy(A : Analysis.S) : EvaProxy = struct ...@@ -518,7 +520,7 @@ module Proxy(A : Analysis.S) : EvaProxy = struct
| Pexpr expr -> | Pexpr expr ->
eval_steps (Cil.typeOf expr) (eval_expr expr) eval_point callstack eval_steps (Cil.typeOf expr) (eval_expr expr) eval_point callstack
| Ppred pred -> | Ppred pred ->
eval_steps Cil.intType (eval_pred pred) eval_point callstack eval_steps Cil.intType (eval_pred eval_point pred) eval_point callstack
end end
let proxy = let proxy =
......
...@@ -138,6 +138,11 @@ let create_new_var name typ = ...@@ -138,6 +138,11 @@ let create_new_var name typ =
let is_const_write_invalid typ = Cil.typeHasQualifier "const" typ let is_const_write_invalid typ = Cil.typeHasQualifier "const" typ
let find_return_var kf =
match (Kernel_function.find_return kf).skind with
| Return (Some ({enode = Lval ((Var vi, NoOffset))}), _) -> Some vi
| _ | exception Kernel_function.No_Statement -> None
(* Find if a postcondition contains [\result] *) (* Find if a postcondition contains [\result] *)
class postconditions_mention_result = object class postconditions_mention_result = object
inherit Visitor.frama_c_inplace inherit Visitor.frama_c_inplace
......
...@@ -72,6 +72,10 @@ val is_const_write_invalid: typ -> bool ...@@ -72,6 +72,10 @@ val is_const_write_invalid: typ -> bool
(** Detect that the type is const, and that option [-global-const] is set. In (** Detect that the type is const, and that option [-global-const] is set. In
this case, we forbid writing in a l-value that has this type. *) this case, we forbid writing in a l-value that has this type. *)
val find_return_var: kernel_function -> varinfo option
(** Returns the varinfo returned by the given function.
Returns None if the function returns void or has no return statement. *)
val postconditions_mention_result: Cil_types.funspec -> bool val postconditions_mention_result: Cil_types.funspec -> bool
(** Does the post-conditions of this specification mention [\result]? *) (** Does the post-conditions of this specification mention [\result]? *)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment