Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
F
frama-c
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Deploy
Releases
Container Registry
Model registry
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
pub
frama-c
Commits
d670467b
Commit
d670467b
authored
1 month ago
by
David Bühler
Browse files
Options
Downloads
Patches
Plain Diff
[Eva] Fixes evaluation functions used by Inout and From on "\from &g" clauses.
parent
cdd734f7
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
src/plugins/eva/legacy/logic_inout.ml
+44
-22
44 additions, 22 deletions
src/plugins/eva/legacy/logic_inout.ml
with
44 additions
and
22 deletions
src/plugins/eva/legacy/logic_inout.ml
+
44
−
22
View file @
d670467b
...
@@ -65,22 +65,35 @@ let eval_error_reason fmt e =
...
@@ -65,22 +65,35 @@ let eval_error_reason fmt e =
if
e
<>
Eval_terms
.
CAlarm
if
e
<>
Eval_terms
.
CAlarm
then
Eval_terms
.
pretty_logic_evaluation_error
fmt
e
then
Eval_terms
.
pretty_logic_evaluation_error
fmt
e
(* Does [term] refers to the address of a C variable (or function)? *)
let
is_address
term
=
match
term
.
term_node
with
|
TAddrOf
(
TVar
_
,
_
)
|
TStartOf
(
TVar
_
,
_
)
->
true
|
TLval
(
TVar
lv
,
_
)
when
Cil
.
isLogicFunctionType
lv
.
lv_type
->
true
|
_
->
false
let
eval_tlval_as_zone
assigns
kind
env
acc
t
=
let
eval_tlval_as_zone
assigns
kind
env
acc
t
=
try
let
term
=
t
.
it_content
in
let
alarm_mode
=
Eval_terms
.
Ignore
in
(* If the term is an address, it has no memory dependency.
let
zone
=
Eval_terms
.
eval_tlval_as_zone
~
alarm_mode
kind
env
t
.
it_content
in
This is possible in "\from &g" clauses. *)
Locations
.
Zone
.
join
acc
zone
if
is_address
term
then
with
Eval_terms
.
LogicEvalError
e
->
acc
let
pp_clause
fmt
=
else
if
kind
=
Read
try
then
Printer
.
pp_from
fmt
assigns
let
alarm_mode
=
Eval_terms
.
Ignore
in
else
Printer
.
pp_term
fmt
(
fst
assigns
)
.
it_content
let
zone
=
Eval_terms
.
eval_tlval_as_zone
~
alarm_mode
kind
env
term
in
in
Locations
.
Zone
.
join
acc
zone
Self
.
warning
~
current
:
true
~
once
:
true
with
Eval_terms
.
LogicEvalError
e
->
"Failed to interpret %sassigns clause '%t'%a"
let
pp_clause
fmt
=
(
if
kind
=
Read
then
"inputs in "
else
""
)
if
kind
=
Read
pp_clause
eval_error_reason
e
;
then
Printer
.
pp_from
fmt
assigns
Locations
.
Zone
.
top
else
Printer
.
pp_term
fmt
(
fst
assigns
)
.
it_content
in
Self
.
warning
~
current
:
true
~
once
:
true
"Failed to interpret %sassigns clause '%t'%a"
(
if
kind
=
Read
then
"inputs in "
else
""
)
pp_clause
eval_error_reason
e
;
Locations
.
Zone
.
top
let
assigns_inputs_to_zone
state
assigns
=
let
assigns_inputs_to_zone
state
assigns
=
let
env
=
Eval_terms
.
env_assigns
~
pre
:
state
in
let
env
=
Eval_terms
.
env_assigns
~
pre
:
state
in
...
@@ -110,16 +123,25 @@ type tlval_zones = {
...
@@ -110,16 +123,25 @@ type tlval_zones = {
deps
:
Locations
.
Zone
.
t
;
deps
:
Locations
.
Zone
.
t
;
}
}
let
bottom_zones
=
let
bottom
=
Locations
.
Zone
.
bottom
in
{
under
=
bottom
;
over
=
bottom
;
deps
=
bottom
;
}
let
assigns_tlval_to_zones
state
access
tlval
=
let
assigns_tlval_to_zones
state
access
tlval
=
let
env
=
Eval_terms
.
env_post_f
~
pre
:
state
~
post
:
state
~
result
:
None
()
in
let
env
=
Eval_terms
.
env_post_f
~
pre
:
state
~
post
:
state
~
result
:
None
()
in
let
alarm_mode
=
Eval_terms
.
Ignore
in
let
alarm_mode
=
Eval_terms
.
Ignore
in
try
(* If the term is an address, it has no memory dependency.
let
under
,
over
=
This is possible in "\from &g" clauses. *)
Eval_terms
.
eval_tlval_as_zone_under_over
~
alarm_mode
access
env
tlval
if
is_address
tlval
then
in
Some
bottom_zones
let
deps
=
join_logic_deps
(
Eval_terms
.
tlval_deps
env
tlval
)
in
else
Some
{
under
;
over
;
deps
;
}
try
with
Eval_terms
.
LogicEvalError
_
->
None
let
under
,
over
=
Eval_terms
.
eval_tlval_as_zone_under_over
~
alarm_mode
access
env
tlval
in
let
deps
=
join_logic_deps
(
Eval_terms
.
tlval_deps
env
tlval
)
in
Some
{
under
;
over
;
deps
;
}
with
Eval_terms
.
LogicEvalError
_
->
None
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment