Skip to content
Snippets Groups Projects
Commit 4ce59bc9 authored by Loïc Correnson's avatar Loïc Correnson
Browse files

[wp] fix internal doc of smoke-tests

parent 57e2041c
No related branches found
No related tags found
No related merge requests found
...@@ -464,7 +464,7 @@ module CodeAssertions = WpContext.StaticGenerator(CodeKey) ...@@ -464,7 +464,7 @@ module CodeAssertions = WpContext.StaticGenerator(CodeKey)
let get_code_assertions ?(smoking=false) kf stmt = let get_code_assertions ?(smoking=false) kf stmt =
let ca = CodeAssertions.get (kf,stmt) in let ca = CodeAssertions.get (kf,stmt) in
(* Make sur that smoke tests are in the end so that it can see surely false (* Make sure that smoke tests are in the end so that it can see surely false
assertions associated to this statement, in particular RTE assertions. *) assertions associated to this statement, in particular RTE assertions. *)
List.rev @@ List.rev @@
if smoking then if smoking then
...@@ -607,20 +607,22 @@ module LoopContract = WpContext.StaticGenerator(CodeKey) ...@@ -607,20 +607,22 @@ module LoopContract = WpContext.StaticGenerator(CodeKey)
end) end)
let get_loop_contract ?(smoking=false) ?terminates kf stmt = let get_loop_contract ?(smoking=false) ?terminates kf stmt =
(* Loop Contract *)
let lc = LoopContract.get (kf,stmt) in let lc = LoopContract.get (kf,stmt) in
let lc_smoke = if smoking && not (WpReached.is_dead_code stmt) then (* Loop Smoking *)
let lc =
if smoking && not (WpReached.is_dead_code stmt) then
let g = smoke kf ~id:"dead_loop" ~unreachable:stmt () in let g = smoke kf ~id:"dead_loop" ~unreachable:stmt () in
{ lc with loop_smoke = g :: lc.loop_smoke } { lc with loop_smoke = g :: lc.loop_smoke }
else lc else lc
in in
match lc_smoke.loop_terminates, terminates with (* Loop Termination *)
| None, _ -> match lc.loop_terminates, terminates with
lc_smoke | None, _ -> lc
| Some _, None -> | Some _, None -> { lc with loop_terminates = None }
{ lc_smoke with loop_terminates = None }
| Some loop_terminates, Some terminates -> | Some loop_terminates, Some terminates ->
let prop = Logic_const.pimplies(terminates, loop_terminates) in let prop = Logic_const.pimplies(terminates, loop_terminates) in
{ lc_smoke with loop_terminates = Some prop } { lc with loop_terminates = Some prop }
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* --- Clear Tablesnts --- *) (* --- Clear Tablesnts --- *)
......
...@@ -219,8 +219,7 @@ struct ...@@ -219,8 +219,7 @@ struct
let kl = Cil.CurrentLoc.get () in let kl = Cil.CurrentLoc.get () in
try try
Cil.CurrentLoc.set (Stmt.loc s) ; Cil.CurrentLoc.set (Stmt.loc s) ;
let smoking = let smoking = is_default_bhv env.mode && env.dead s in
is_default_bhv env.mode && env.dead s in
let cas = CfgAnnot.get_code_assertions ~smoking env.mode.kf s in let cas = CfgAnnot.get_code_assertions ~smoking env.mode.kf s in
let opt_fold f = Option.fold ~none:Fun.id ~some:f in let opt_fold f = Option.fold ~none:Fun.id ~some:f in
let do_assert env CfgAnnot.{ code_admitted ; code_verified } w = let do_assert env CfgAnnot.{ code_admitted ; code_verified } w =
......
...@@ -52,10 +52,11 @@ let calls infos = infos.calls ...@@ -52,10 +52,11 @@ let calls infos = infos.calls
let annots infos = infos.annots let annots infos = infos.annots
let doomed infos = infos.doomed let doomed infos = infos.doomed
let wpreached s = function let wp_reached_smoking s = function
| None -> false | None -> false
| Some reachability -> WpReached.smoking reachability s | Some reachability -> WpReached.smoking reachability s
let smoking infos s = wpreached s infos.reachability
let smoking infos s = wp_reached_smoking s infos.reachability
let unreachable infos v = let unreachable infos v =
match infos.body, infos.checkpath with match infos.body, infos.checkpath with
...@@ -457,7 +458,7 @@ let compile Key.{ kf ; smoking ; bhv ; prop } = ...@@ -457,7 +458,7 @@ let compile Key.{ kf ; smoking ; bhv ; prop } =
let loop_pids = loop_contract_pids kf stmt in let loop_pids = loop_contract_pids kf stmt in
if dead then if dead then
begin begin
if wpreached stmt reachability then if wp_reached_smoking stmt reachability then
(let p = CfgAnnot.get_unreachable kf stmt in (let p = CfgAnnot.get_unreachable kf stmt in
infos.doomed <- Bag.append infos.doomed p) ; infos.doomed <- Bag.append infos.doomed p) ;
infos.doomed <- Bag.concat infos.doomed (Bag.list ca_pids) ; infos.doomed <- Bag.concat infos.doomed (Bag.list ca_pids) ;
......
...@@ -211,9 +211,9 @@ let rec protected node = ...@@ -211,9 +211,9 @@ let rec protected node =
and protected_by prev = and protected_by prev =
match prev.flow with match prev.flow with
| F_dead | F_entry | F_effect -> true | F_return | F_dead | F_entry | F_effect -> true
| F_goto -> protected prev | F_goto -> protected prev
| F_call | F_branch | F_return -> unreachable prev | F_call | F_branch -> unreachable prev
let smoking_node n = let smoking_node n =
match n.flow with match n.flow with
......
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