Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
TASTE
OpenGEODE
Commits
02654e92
Commit
02654e92
authored
Jan 03, 2017
by
Maxime Perrotin
Browse files
Update test-iterators
parent
b7c5a419
Changes
5
Hide whitespace changes
Inline
Side-by-side
opengeode/AdaGenerator.py
View file @
02654e92
...
...
@@ -242,22 +242,23 @@ LD_LIBRARY_PATH=. opengeode-simulator
# Parallel states in a state aggregation may terminate
full_statelist
.
add
(
u
'{}finished'
.
format
(
UNICODE_SEP
))
context_decl
=
[]
if
full_statelist
:
process_level
_decl
.
append
(
u
'type States is ({});'
context
_decl
.
append
(
u
'type States is ({});'
.
format
(
u
', '
.
join
(
full_statelist
)
or
u
'No_State'
))
# Generate the code to declare process-level context
process_level
_decl
.
extend
([
'type {}_Ty is'
.
format
(
LPREFIX
),
'record'
])
context
_decl
.
extend
([
'type {}_Ty is'
.
format
(
LPREFIX
),
'record'
])
if
full_statelist
:
process_level
_decl
.
append
(
'state : States;'
)
context
_decl
.
append
(
'state : States;'
)
process_level
_decl
.
append
(
'initDone : Boolean := False;'
)
context
_decl
.
append
(
'initDone : Boolean := False;'
)
# State aggregation: add list of substates (XXX to be added in C generator)
for
substates
in
aggregates
.
viewvalues
():
for
each
in
substates
:
process_level
_decl
.
append
(
u
'{}{}state: States;'
context
_decl
.
append
(
u
'{}{}state: States;'
.
format
(
each
.
statename
,
UNICODE_SEP
))
for
var_name
,
(
var_type
,
def_value
)
in
process
.
variables
.
viewitems
():
...
...
@@ -269,29 +270,33 @@ LD_LIBRARY_PATH=. opengeode-simulator
if
varbty
.
kind
in
(
'SequenceOfType'
,
'OctetStringType'
):
dstr
=
array_content
(
def_value
,
dstr
,
varbty
)
assert
not
dst
and
not
dlocal
,
'DCL: Expecting a ground expression'
process_level
_decl
.
append
(
context
_decl
.
append
(
u
'{n} : aliased {sort}{default};'
.
format
(
n
=
var_name
,
sort
=
type_name
(
var_type
),
default
=
u
' := '
+
dstr
if
def_value
else
u
''
))
process_level
_decl
.
append
(
'end record;'
)
process_level
_decl
.
append
(
'{ctxt}: {ctxt}_Ty;'
.
format
(
ctxt
=
LPREFIX
))
context
_decl
.
append
(
'end record;'
)
context
_decl
.
append
(
'{ctxt}: {ctxt}_Ty;'
.
format
(
ctxt
=
LPREFIX
))
if
simu
:
# Export the context, so that it can be manipulated from outside
# (in practice used by the "properties" module.
process_level
_decl
.
append
(
u
'pragma export (C, {ctxt}, "{ctxt}");'
context
_decl
.
append
(
u
'pragma export (C, {ctxt}, "{ctxt}");'
.
format
(
ctxt
=
LPREFIX
))
# Exhaustive simulation needs a backup of the context to quickly undo
process_level
_decl
.
append
(
u
'{ctxt}_bk: {ctxt}_Ty;'
context
_decl
.
append
(
u
'{ctxt}_bk: {ctxt}_Ty;'
.
format
(
ctxt
=
LPREFIX
))
elif
import_context
:
# Possibility to have the context defined outside the module
# in order for a model checker to view/modify internals without any
# copy at runtime
process_level
_decl
.
append
(
u
'pragma import (C, ctxt, "{}_ctxt");'
context
_decl
.
append
(
u
'pragma import (C, ctxt, "{}_ctxt");'
.
format
(
import_context
))
if
not
simu
:
process_level_decl
.
extend
(
context_decl
)
# Continuous State transition id
process_level_decl
.
append
(
'CS_Only : constant Integer := {};'
.
format
(
len
(
process
.
transitions
)))
...
...
@@ -382,6 +387,7 @@ package {process_name} is'''.format(process_name=process_name,
dll_api
=
[]
if
simu
:
ads_template
.
extend
(
context_decl
)
ads_template
.
append
(
'-- API for simulation via DLL'
)
dll_api
.
append
(
'-- API to remotely change internal data'
)
# Add function allowing to trace current state as a string
...
...
tests/regression/test-iterators/iter_lib/generic_integer.ads
View file @
02654e92
with
SimpleTypes
;
with
Generic_Basic
;
with
Interfaces
;
use
Interfaces
;
generic
Min
:
Inte
ger
;
Max
:
Inte
ger
;
Min
:
Inte
rfaces
.
Integer_64
;
Max
:
Inte
rfaces
.
Integer_64
;
package
Generic_Integer
is
function
Elem_Init
return
Integer
is
(
Min
);
function
Has_Elem
(
Value
:
Integer
)
return
Boolean
is
(
Value
<=
Max
);
function
Elem_First
return
Integer
is
(
Min
);
function
Elem_Next
(
Value
:
Integer
)
return
Integer
is
(
Value
+
1
);
function
Elem_Init
return
Interfaces
.
Integer_64
is
(
Min
);
function
Has_Elem
(
Value
:
Interfaces
.
Integer_64
)
return
Boolean
is
(
Value
<=
Max
);
function
Elem_First
return
Interfaces
.
Integer_64
is
(
Min
);
function
Elem_Next
(
Value
:
Interfaces
.
Integer_64
)
return
Interfaces
.
Integer_64
is
(
Value
+
1
);
package
Integer_type
is
new
SimpleTypes
(
Element
=>
Inte
ger
,
package
Integer_type
is
new
SimpleTypes
(
Element
=>
Inte
rfaces
.
Integer_64
,
Elem_Init
=>
Elem_Init
,
Has_Elem
=>
Has_Elem
,
Elem_First
=>
Elem_First
,
...
...
tests/regression/test-iterators/iter_lib/generic_seqof.adb
View file @
02654e92
...
...
@@ -46,7 +46,7 @@ package body Generic_SeqOf is
-- Exhausted "rest": iterate on the first item
Ptr_elem
:=
Ptr
.
LenIt
.
Next
(
Ptr_elem
);
if
Length_Pkg
.
Has_Element
(
Ptr_elem
)
then
Ptr
.
Value
.
Length
:=
Ptr_elem
.
Value
.
Value
;
Ptr
.
Value
.
Length
:=
Integer
(
Ptr_elem
.
Value
.
Value
)
;
Ptr
.
Length
:=
Ptr
.
Value
.
Length
;
Ptr
.
RestVal
:=
new
P
.
ASN1_SeqOf
(
Ptr
.
Value
.
Length
);
Ptr
.
RestIt
:=
new
P
.
ASN1_SeqOf_It
'(
P
.
ASN1_SeqOf_It
(
Ptr
.
RestVal
.
Iterate
));
...
...
tests/regression/test-iterators/iter_lib/generic_seqof.ads
View file @
02654e92
...
...
@@ -7,16 +7,20 @@ with generic_fixed_seqof;
with
generic_integer
;
with
generic_basic
;
with
Interfaces
;
use
Interfaces
;
-- Iterator for a variable-size array of basic type
generic
Min
:
Integer
;
Max
:
Integer
;
Min
:
Natural
;
Max
:
Natural
;
with
package
Basic
is
new
Generic_Basic
(
<>
);
package
Generic_SeqOf
is
Package
P
is
new
Generic_Fixed_SeqOF
(
P
=>
Basic
);
-- Create an integer type with a range constraint to iterate on
package
Length_ty
is
new
Generic_Integer
(
Min
,
Max
);
package
Length_ty
is
new
Generic_Integer
(
Integer_64
(
Min
),
Integer_64
(
Max
));
-- Instantiate the package to iterate on the integer for the length
package
Length_Pkg
renames
Length_ty
.
It
;
...
...
tests/regression/test-iterators/test.adb
View file @
02654e92
with
orchestrator
;
use
orchestrator
;
with
orchestrator_stop_conditions
;
with
asn1_iterators
;
use
asn1_iterators
;
...
...
@@ -24,21 +25,21 @@ with ada.calendar;
use
ada
.
calendar
;
procedure
test
is
-- Reproduce the Context, and import it
type
States
is
(
running
,
wait
);
type
orchestrator_ctxt_Ty
is
record
state
:
States
;
initDone
:
Boolean
:=
False
;
counter
:
aliased
asn1SccT_Int
:=
0
;
seqof
:
aliased
asn1SccT_SeqOf
;
t
:
aliased
asn1SccT_Int
:=
0
;
end
record
;
orchestrator_ctxt
:
orchestrator_ctxt_Ty
;
pragma
Import
(
C
,
orchestrator_ctxt
,
"orchestrator_ctxt"
);
subtype
Context_ty
is
Orchestrator_Ctxt_ty
;
Process_Ctxt
:
Context_ty
renames
Orchestrator_Ctxt
;
-- To save/restore the context when calling a PI:
backup_ctxt
:
orchestrator_ctxt_ty
;
backup_ctxt
:
Context_ty
;
procedure
save_context
is
begin
backup_ctxt
:=
Process_Ctxt
;
end
;
procedure
restore_context
is
begin
Process_Ctxt
:=
backup_ctxt
;
end
;
-- Type representing an event (input or output)
type
Interfaces
is
(
start
,
pulse_pi
,
arr_pi
,
paramless_pi
);
...
...
@@ -48,40 +49,34 @@ procedure test is
when
start
=>
null
;
when
pulse_pi
=>
Pulse_Param
:
asn1SccT_Int
;
Pulse_Param
:
aliased
asn1SccT_Int
;
when
arr_pi
=>
Arr_Param
:
asn1SccT_SeqOf
;
Arr_Param
:
aliased
asn1SccT_SeqOf
;
when
paramless_pi
=>
null
;
end
case
;
end
record
;
-- Type representing an entry in the state graph
(could be generic)
-- Type representing an entry in the state graph
type
Global_State
(
I
:
Interfaces
)
is
record
event
:
Event_ty
(
I
);
context
:
Orchestrator_ct
xt_ty
;
context
:
Conte
xt_ty
;
end
record
;
-- We'll store only pointers to graph states in the set
type
State_Access
is
access
Global_State
;
count
:
natural
:=
0
;
procedure
save_context
is
begin
backup_ctxt
:=
orchestrator_ctxt
;
end
;
procedure
restore_context
is
begin
orchestrator_ctxt
:=
backup_ctxt
;
end
;
-- The state graph itself is stored in a dictionary type (map)
package
State_graph
is
new
Ordered_Maps
(
Key_Type
=>
Hash_Type
,
Element_Type
=>
State_Access
);
Grafset
:
State_graph
.
Map
;
-- We will store the state graph in an ordered map. Use md5 to hash the
-- SDL context and use as map key.
-- State graph index: Use md5 first to get a string representing
-- the context object, then strings.hash to get a number that can be used
-- as a map key. This can surely be improved!
Ctxt_Size
:
constant
stream_element_offset
:=
orchestrator_ct
xt_ty
'
object_size
/
stream_element
'
size
;
Conte
xt_ty
'
object_size
/
stream_element
'
size
;
type
SEA_Pointer
is
access
all
Stream_Element_Array
(
1
..
Ctxt_Size
);
...
...
@@ -91,19 +86,13 @@ procedure test is
function
State_Hash
(
state
:
State_Access
)
return
Hash_Type
is
(
Ada
.
Strings
.
Hash
(
gnat
.
md5
.
digest
(
as_sea_ptr
(
state
.
context
'
address
).
all
)));
package
State_graph
is
new
Ordered_Maps
(
Key_Type
=>
Hash_Type
,
Element_Type
=>
State_Access
);
Grafset
:
State_graph
.
Map
;
function
Add_to_graph
(
event
:
Event_ty
;
ctxt
:
orchestrator_ctxt_ty
)
return
Hash_Type
is
-- Add a state to the graph: compute the hash (key) and store if not already there
function
Add_to_graph
(
event
:
Event_ty
)
return
Hash_Type
is
New_State
:
constant
State_Access
:=
new
Global_State
(
event
.
Option
);
New_Hash
:
Hash_Type
;
begin
New_State
.
event
:=
event
;
New_State
.
context
:=
c
txt
;
New_State
.
context
:=
Process_C
txt
;
New_Hash
:=
State_Hash
(
New_State
);
if
not
Grafset
.
Contains
(
Key
=>
New_Hash
)
then
Grafset
.
Insert
(
Key
=>
New_Hash
,
New_Item
=>
New_State
);
...
...
@@ -111,6 +100,8 @@ procedure test is
return
New_Hash
;
end
;
-- To count the number of calls to the function's provided interfaces
count
:
natural
:=
0
;
-- Vector of hashes (integers) used for the model checking
subtype
Vect_Count
is
Positive
range
1
..
1000
;
...
...
@@ -159,18 +150,15 @@ procedure test is
-- One function per PI to exhaust the interface parameters
procedure
exhaust_pulse
is
pulse_it
:
T_Int_pkg
.
Instance
;
asn1_p
:
aliased
asn1SccT_Int
;
event
:
Event_ty
(
pulse_pi
);
S_Hash
:
Hash_Type
;
begin
save_context
;
for
each
of
pulse_it
loop
event
.
pulse_param
:=
asn1SccT_Int
(
each
);
asn1_p
:=
asn1SccT_Int
'(
event
.
pulse_param
);
orchestrator
.
pulse
(
asn1_p
'
access
);
event
.
pulse_param
:=
each
;
orchestrator
.
pulse
(
event
.
pulse_param
'
access
);
count
:=
count
+
1
;
S_Hash
:=
Add_to_graph
(
event
=>
event
,
ctxt
=>
orchestrator_ctxt
);
S_Hash
:=
Add_to_graph
(
event
=>
event
);
check_and_report
(
S_Hash
);
restore_context
;
end
loop
;
...
...
@@ -178,21 +166,18 @@ procedure test is
procedure
exhaust_arr
is
arr_it
:
T_SeqOf_pkg
.
Instance
;
asn1_p
:
aliased
asn1SccT_SeqOf
;
event
:
Event_ty
(
arr_pi
);
S_Hash
:
Hash_Type
;
begin
save_context
;
for
each
of
arr_it
loop
asn1_p
.
L
ength
:=
each
.
L
ength
;
for
idx
in
1
..
asn1_p
.
L
ength
loop
asn1_p
.
Data
(
idx
)
:=
asn1SccT_Int
'(
asn1SccT_Int
(
each
.
D
ata
(
idx
)
))
;
event
.
arr_param
.
l
ength
:=
each
.
l
ength
;
-- only variable-sized arrays
for
idx
in
1
..
each
.
l
ength
loop
event
.
arr_param
.
data
(
idx
)
:=
each
.
d
ata
(
idx
);
end
loop
;
event
.
Arr_Param
:=
asn1_p
;
orchestrator
.
arr
(
asn1_p
'
access
);
orchestrator
.
arr
(
event
.
arr_param
'
access
);
count
:=
count
+
1
;
S_Hash
:=
Add_to_graph
(
event
=>
event
,
ctxt
=>
orchestrator_ctxt
);
S_Hash
:=
Add_to_graph
(
event
=>
event
);
check_and_report
(
S_Hash
);
restore_context
;
end
loop
;
...
...
@@ -205,8 +190,7 @@ procedure test is
save_context
;
orchestrator
.
paramless
;
count
:=
count
+
1
;
S_Hash
:=
Add_to_graph
(
event
=>
event
,
ctxt
=>
orchestrator_ctxt
);
S_Hash
:=
Add_to_graph
(
event
=>
event
);
check_and_report
(
S_Hash
);
restore_context
;
end
;
...
...
@@ -224,13 +208,12 @@ procedure test is
begin
put_line
(
"Exhaustive simulation. Hit Ctrl-C to stop if it is too long..."
);
orchestrator
.
startup
;
S_Hash
:=
Add_to_graph
(
event
=>
event
,
ctxt
=>
orchestrator_ctxt
);
S_Hash
:=
Add_to_graph
(
event
=>
event
);
check_and_report
(
S_Hash
);
queue
.
append
(
S_Hash
);
visited
.
append
(
S_Hash
);
while
queue
.
Length
>
0
loop
orchestrator_c
txt
:=
Grafset
.
Element
(
Key
=>
queue
.
Last_Element
).
Context
;
Process_C
txt
:=
Grafset
.
Element
(
Key
=>
queue
.
Last_Element
).
Context
;
exhaustive_simulation
;
queue
.
delete_last
;
end
loop
;
...
...
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment