Commit 02654e92 authored by Maxime Perrotin's avatar Maxime Perrotin

Update test-iterators

parent b7c5a419
......@@ -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
......
with SimpleTypes;
with Generic_Basic;
with Interfaces;
use Interfaces;
generic
Min: Integer;
Max: Integer;
Min: Interfaces.Integer_64;
Max: Interfaces.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 => Integer,
package Integer_type is new SimpleTypes(Element => Interfaces.Integer_64,
Elem_Init => Elem_Init,
Has_Elem => Has_Elem,
Elem_First => Elem_First,
......
......@@ -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));
......
......@@ -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;
......
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_ctxt_ty;
context : Context_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_ctxt_ty'object_size / stream_element'size;
Context_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 := ctxt;
New_State.context := Process_Ctxt;
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.Length 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.length 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_ctxt := Grafset.Element(Key => queue.Last_Element).Context;
Process_Ctxt := Grafset.Element(Key => queue.Last_Element).Context;
exhaustive_simulation;
queue.delete_last;
end loop;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment