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
7703145e
Commit
7703145e
authored
4 years ago
by
David Bühler
Browse files
Options
Downloads
Patches
Plain Diff
[Eva] Values request: evaluates lvalues using Eva.copy_lvalues.
parent
55e080fa
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/value/api/values_request.ml
+33
-25
33 additions, 25 deletions
src/plugins/value/api/values_request.ml
with
33 additions
and
25 deletions
src/plugins/value/api/values_request.ml
+
33
−
25
View file @
7703145e
...
@@ -231,32 +231,26 @@ end
...
@@ -231,32 +231,26 @@ end
module
Make
(
Eva
:
Analysis
.
S
)
:
S
=
struct
module
Make
(
Eva
:
Analysis
.
S
)
:
S
=
struct
let
eval
f
state
elt
=
let
make_before
eval
before
=
let
value
,
alarms
=
f
state
elt
in
let
alarm
=
not
(
Alarmset
.
is_empty
alarms
)
in
let
str
=
Format
.
asprintf
"%a"
(
Bottom
.
pretty
Eva
.
Val
.
pretty
)
value
in
{
value
=
str
;
alarm
}
let
make_before
f
before
elt
=
let
before
=
let
before
=
match
before
with
match
before
with
|
`Bottom
->
Unreachable
|
`Bottom
->
Unreachable
|
`Value
state
->
Evaluation
(
eval
f
state
elt
)
|
`Value
state
->
Evaluation
(
eval
state
)
in
in
{
before
;
after_instr
=
None
;
after_then
=
None
;
after_else
=
None
;
}
{
before
;
after_instr
=
None
;
after_then
=
None
;
after_else
=
None
;
}
let
make_callstack
stmt
f
elt
=
let
make_callstack
stmt
eval
=
let
before
=
Eva
.
get_stmt_state_by_callstack
~
after
:
false
stmt
in
let
before
=
Eva
.
get_stmt_state_by_callstack
~
after
:
false
stmt
in
match
before
with
match
before
with
|
(
`Bottom
|
`Top
)
->
[]
|
(
`Bottom
|
`Top
)
->
[]
|
`Value
before
->
|
`Value
before
->
let
aux
callstack
before
acc
=
let
aux
callstack
before
acc
=
let
before_after
=
make_before
f
(
`Value
before
)
elt
in
let
before_after
=
make_before
eval
(
`Value
before
)
in
(
callstack
,
before_after
)
::
acc
(
callstack
,
before_after
)
::
acc
in
in
Value_types
.
Callstack
.
Hashtbl
.
fold
aux
before
[]
Value_types
.
Callstack
.
Hashtbl
.
fold
aux
before
[]
let
make_before_after
f
~
before
~
after
elt
=
let
make_before_after
eval
~
before
~
after
=
match
before
with
match
before
with
|
`Bottom
->
|
`Bottom
->
{
before
=
Unreachable
;
{
before
=
Unreachable
;
...
@@ -264,12 +258,12 @@ module Make (Eva: Analysis.S) : S = struct
...
@@ -264,12 +258,12 @@ module Make (Eva: Analysis.S) : S = struct
after_then
=
None
;
after_then
=
None
;
after_else
=
None
;
}
after_else
=
None
;
}
|
`Value
before
->
|
`Value
before
->
let
before
=
eval
f
before
elt
in
let
before
=
eval
before
in
let
after_instr
=
let
after_instr
=
match
after
with
match
after
with
|
`Bottom
->
Some
(
Reduced
Unreachable
)
|
`Bottom
->
Some
(
Reduced
Unreachable
)
|
`Value
after
->
|
`Value
after
->
let
after
=
eval
f
after
elt
in
let
after
=
eval
after
in
if
String
.
equal
before
.
value
after
.
value
if
String
.
equal
before
.
value
after
.
value
then
Some
Unchanged
then
Some
Unchanged
else
Some
(
Reduced
(
Evaluation
after
))
else
Some
(
Reduced
(
Evaluation
after
))
...
@@ -277,7 +271,7 @@ module Make (Eva: Analysis.S) : S = struct
...
@@ -277,7 +271,7 @@ module Make (Eva: Analysis.S) : S = struct
{
before
=
Evaluation
before
;
{
before
=
Evaluation
before
;
after_instr
;
after_then
=
None
;
after_else
=
None
;
}
after_instr
;
after_then
=
None
;
after_else
=
None
;
}
let
make_instr_callstack
stmt
f
elt
=
let
make_instr_callstack
stmt
eval
=
let
before
=
Eva
.
get_stmt_state_by_callstack
~
after
:
false
stmt
in
let
before
=
Eva
.
get_stmt_state_by_callstack
~
after
:
false
stmt
in
let
after
=
Eva
.
get_stmt_state_by_callstack
~
after
:
true
stmt
in
let
after
=
Eva
.
get_stmt_state_by_callstack
~
after
:
true
stmt
in
match
before
,
after
with
match
before
,
after
with
...
@@ -290,38 +284,52 @@ module Make (Eva: Analysis.S) : S = struct
...
@@ -290,38 +284,52 @@ module Make (Eva: Analysis.S) : S = struct
try
`Value
(
Value_types
.
Callstack
.
Hashtbl
.
find
after
callstack
)
try
`Value
(
Value_types
.
Callstack
.
Hashtbl
.
find
after
callstack
)
with
Not_found
->
`Bottom
with
Not_found
->
`Bottom
in
in
let
before_after
=
make_before_after
f
~
before
~
after
elt
in
let
before_after
=
make_before_after
eval
~
before
~
after
in
(
callstack
,
before_after
)
::
acc
(
callstack
,
before_after
)
::
acc
in
in
Value_types
.
Callstack
.
Hashtbl
.
fold
aux
before
[]
Value_types
.
Callstack
.
Hashtbl
.
fold
aux
before
[]
let
make
f
elt
kinstr
=
let
make
eval
kinstr
=
let
before
=
Eva
.
get_kinstr_state
~
after
:
false
kinstr
in
let
before
=
Eva
.
get_kinstr_state
~
after
:
false
kinstr
in
let
values
,
callstack
=
let
values
,
callstack
=
match
kinstr
with
match
kinstr
with
|
Cil_types
.
Kglobal
->
|
Cil_types
.
Kglobal
->
make_before
f
before
elt
,
None
make_before
eval
before
,
None
|
Cil_types
.
Kstmt
stmt
->
|
Cil_types
.
Kstmt
stmt
->
match
stmt
.
skind
with
match
stmt
.
skind
with
|
Instr
_
->
|
Instr
_
->
let
after
=
Eva
.
get_kinstr_state
~
after
:
true
kinstr
in
let
after
=
Eva
.
get_kinstr_state
~
after
:
true
kinstr
in
let
values
=
make_before_after
f
~
before
~
after
elt
in
let
values
=
make_before_after
eval
~
before
~
after
in
let
callstack
=
make_instr_callstack
stmt
f
elt
in
let
callstack
=
make_instr_callstack
stmt
eval
in
values
,
Some
callstack
values
,
Some
callstack
|
_
->
|
_
->
make_before
f
before
elt
,
make_before
eval
before
,
Some
(
make_callstack
stmt
eval
)
Some
(
make_callstack
stmt
f
elt
)
in
in
{
values
;
callstack
;
}
{
values
;
callstack
;
}
let
evaluate
kinstr
expr
=
let
evaluate
kinstr
expr
=
make
(
Eva
.
eval_expr
)
expr
kinstr
let
eval
state
=
let
value
,
alarms
=
Eva
.
eval_expr
state
expr
in
let
alarm
=
not
(
Alarmset
.
is_empty
alarms
)
in
let
str
=
Format
.
asprintf
"%a"
(
Bottom
.
pretty
Eva
.
Val
.
pretty
)
value
in
{
value
=
str
;
alarm
}
in
make
eval
kinstr
let
lvaluate
kinstr
lval
=
let
lvaluate
kinstr
lval
=
let
loc
=
Cil_datatype
.
Location
.
unknown
in
let
eval
state
=
let
expr
=
Cil
.
new_exp
~
loc
(
Lval
lval
)
in
let
value
,
alarms
=
Eva
.
copy_lvalue
state
lval
in
make
(
Eva
.
eval_expr
)
expr
kinstr
let
alarm
=
not
(
Alarmset
.
is_empty
alarms
)
in
let
flagged_value
=
match
value
with
|
`Bottom
->
Eval
.
Flagged_Value
.
bottom
|
`Value
v
->
v
in
let
pretty
=
Eval
.
Flagged_Value
.
pretty
Eva
.
Val
.
pretty
in
let
str
=
Format
.
asprintf
"%a"
pretty
flagged_value
in
{
value
=
str
;
alarm
}
in
make
eval
kinstr
end
end
...
...
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