Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
OpenGEODE
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
TASTE
OpenGEODE
Commits
02654e92
Commit
02654e92
authored
Jan 03, 2017
by
Maxime Perrotin
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Update test-iterators
parent
b7c5a419
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
78 additions
and
81 deletions
+78
-81
opengeode/AdaGenerator.py
opengeode/AdaGenerator.py
+17
-11
tests/regression/test-iterators/iter_lib/generic_integer.ads
tests/regression/test-iterators/iter_lib/generic_integer.ads
+11
-7
tests/regression/test-iterators/iter_lib/generic_seqof.adb
tests/regression/test-iterators/iter_lib/generic_seqof.adb
+1
-1
tests/regression/test-iterators/iter_lib/generic_seqof.ads
tests/regression/test-iterators/iter_lib/generic_seqof.ads
+7
-3
tests/regression/test-iterators/test.adb
tests/regression/test-iterators/test.adb
+42
-59
No files found.
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
:
a
liased
a
sn1SccT_Int
;
when
arr_pi
=>
Arr_Param
:
asn1SccT_SeqOf
;
Arr_Param
:
a
liased
a
sn1SccT_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
.
Length
:=
each
.
Length
;
for
idx
in
1
..
asn1_p
.
L
ength
loop
asn1_p
.
Data
(
idx
)
:=
asn1SccT_Int
'(
asn1SccT_Int
(
each
.
Data
(
idx
))
);
event
.
arr_param
.
length
:=
each
.
length
;
-- only variable-sized arrays
for
idx
in
1
..
each
.
l
ength
loop
event
.
arr_param
.
data
(
idx
)
:=
each
.
data
(
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
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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