Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
TASTE
Ocarina
Commits
bba0a978
Commit
bba0a978
authored
Dec 10, 2014
by
yoogx
Browse files
* Initial support for instanciating record properties
For ticket #17
parent
175c9d20
Changes
6
Hide whitespace changes
Inline
Side-by-side
src/core/instance/ocarina-instances-processor-properties.adb
View file @
bba0a978
...
...
@@ -259,7 +259,8 @@ package body Ocarina.Instances.Processor.Properties is
or
else
Kind
(
Property_Value
)
=
K_And_Boolean_Term
or
else
Kind
(
Property_Value
)
=
K_Or_Boolean_Term
or
else
Kind
(
Property_Value
)
=
K_Parenthesis_Boolean_Term
or
else
Kind
(
Property_Value
)
=
K_Component_Classifier_Term
);
or
else
Kind
(
Property_Value
)
=
K_Component_Classifier_Term
or
else
Kind
(
Property_Value
)
=
K_Record_Term
);
Evaluated_Value
:
Node_Id
;
Node
:
Node_Id
;
...
...
@@ -603,6 +604,15 @@ package body Ocarina.Instances.Processor.Properties is
(
Evaluated_Value
,
Component_Cat
(
Property_Value
));
when
K_Record_Term
=>
-- Simply propagate the list to the instance
Evaluated_Value
:=
New_Node
(
Kind
(
Property_Value
),
ATN
.
Loc
(
Property_Value
));
Set_List_Items
(
Evaluated_Value
,
ATN
.
List_Items
(
Property_Value
));
when
others
=>
raise
Program_Error
;
end
case
;
...
...
src/core/instance/ocarina-instances-properties.adb
View file @
bba0a978
...
...
@@ -466,11 +466,11 @@ package body Ocarina.Instances.Properties is
AIN
.
Property_Association_Value
(
Property_Association
),
Entity_Instance
));
-- IMPORTANT: we use entity instance where the
property
-- has been declared, as the reference node
to
-- duplicate the property, and not
pointed_instance,
-- which is the node on which the
property
-- applies. Indeed, for properties that are
-- IMPORTANT: we use entity instance where the
--
property
has been declared, as the reference node
--
to
duplicate the property, and not
--
pointed_instance,
which is the node on which the
--
property
applies. Indeed, for properties that are
-- references, the reference path is set from
-- entity_instance.
end
if
;
...
...
@@ -561,17 +561,21 @@ package body Ocarina.Instances.Properties is
List_Node
:=
ATN
.
First_Node
(
Expanded_Multi_Value
(
Property_Value
));
while
Present
(
List_Node
)
loop
Append_Node_To_List
(
Instantiate_Property_Value
(
Instance_Root
,
List_Node
,
Instance
),
Multi_Value
(
Duplicated_Property_Value
));
List_Node
:=
ATN
.
Next_Node
(
List_Node
);
end
loop
;
else
List_Node
:=
ATN
.
First_Node
(
Multi_Value
(
Property_Value
));
end
if
;
while
Present
(
List_Node
)
loop
Append_Node_To_List
(
Instantiate_Property_Value
(
Instance_Root
,
List_Node
,
Instance
),
Multi_Value
(
Duplicated_Property_Value
));
List_Node
:=
ATN
.
Next_Node
(
List_Node
);
end
loop
;
end
if
;
end
if
;
...
...
@@ -645,18 +649,19 @@ package body Ocarina.Instances.Properties is
is
pragma
Assert
(
No
(
Property_Value
)
or
else
Kind
(
Property_Value
)
=
K_Literal
or
else
Kind
(
Property_Value
)
=
K_Property_Term
or
else
Kind
(
Property_Value
)
=
K_Enumeration_Term
or
else
Kind
(
Property_Value
)
=
K_Number_Range_Term
or
else
Kind
(
Property_Value
)
=
K_Reference_Term
or
else
Kind
(
Property_Value
)
=
K_Minus_Numeric_Term
or
else
Kind
(
Property_Value
)
=
K_Signed_AADLNumber
or
else
Kind
(
Property_Value
)
=
K_Not_Boolean_Term
or
else
Kind
(
Property_Value
)
=
K_And_Boolean_Term
or
else
Kind
(
Property_Value
)
=
K_Or_Boolean_Term
or
else
Kind
(
Property_Value
)
=
K_Parenthesis_Boolean_Term
or
else
Kind
(
Property_Value
)
=
K_Component_Classifier_Term
);
or
else
Kind
(
Property_Value
)
=
K_Literal
or
else
Kind
(
Property_Value
)
=
K_Property_Term
or
else
Kind
(
Property_Value
)
=
K_Enumeration_Term
or
else
Kind
(
Property_Value
)
=
K_Number_Range_Term
or
else
Kind
(
Property_Value
)
=
K_Reference_Term
or
else
Kind
(
Property_Value
)
=
K_Minus_Numeric_Term
or
else
Kind
(
Property_Value
)
=
K_Signed_AADLNumber
or
else
Kind
(
Property_Value
)
=
K_Not_Boolean_Term
or
else
Kind
(
Property_Value
)
=
K_And_Boolean_Term
or
else
Kind
(
Property_Value
)
=
K_Or_Boolean_Term
or
else
Kind
(
Property_Value
)
=
K_Parenthesis_Boolean_Term
or
else
Kind
(
Property_Value
)
=
K_Component_Classifier_Term
or
else
Kind
(
Property_Value
)
=
K_Record_Term
);
pragma
Assert
(
Present
(
Instance
));
Instantiated_Value
:
Node_Id
:=
No_Node
;
...
...
@@ -675,7 +680,6 @@ package body Ocarina.Instances.Properties is
Set_Value
(
Instantiated_Value
,
Value
(
Property_Value
));
when
K_Property_Term
|
K_Enumeration_Term
=>
Instantiated_Value
:=
New_Node
(
Kind
(
Property_Value
),
ATN
.
Loc
(
Property_Value
));
ATN
.
Set_Identifier
...
...
@@ -800,6 +804,15 @@ package body Ocarina.Instances.Properties is
(
Instantiated_Value
,
Component_Cat
(
Property_Value
));
when
K_Record_Term
=>
-- Simply propagate the list to the instance
Instantiated_Value
:=
New_Node
(
Kind
(
Property_Value
),
ATN
.
Loc
(
Property_Value
));
Set_List_Items
(
Instantiated_Value
,
ATN
.
List_Items
(
Property_Value
));
when
others
=>
raise
Program_Error
;
end
case
;
...
...
src/core/instance/ocarina-instances-queries.adb
View file @
bba0a978
...
...
@@ -243,10 +243,6 @@ package body Ocarina.Instances.Queries is
end
if
;
end
Get_Enumeration_Property
;
------------------------------
-- Get_Enumeration_Property --
------------------------------
function
Get_Enumeration_Property
(
Entity
:
Node_Id
;
Name
:
Name_Id
;
...
...
@@ -443,12 +439,14 @@ package body Ocarina.Instances.Queries is
return
No_List
;
end
if
;
if
Present
(
Expanded_Multi_Value
(
AIN
.
Property_Association_Value
(
Property
)))
and
then
No
(
ATN
.
First_Node
(
Expanded_Multi_Value
(
AIN
.
Property_Association_Value
(
Property
))))
if
No
(
Expanded_Multi_Value
(
AIN
.
Property_Association_Value
(
Property
)))
or
else
(
Present
(
Expanded_Multi_Value
(
AIN
.
Property_Association_Value
(
Property
)))
and
then
No
(
ATN
.
First_Node
(
Expanded_Multi_Value
(
AIN
.
Property_Association_Value
(
Property
)))))
then
return
Multi_Value
(
AIN
.
Property_Association_Value
(
Property
));
end
if
;
...
...
@@ -642,25 +640,6 @@ package body Ocarina.Instances.Queries is
PT_Reference
;
end
Is_Defined_Reference_Property
;
------------------------------------
-- Is_Defined_Classifier_Property --
------------------------------------
function
Is_Defined_Classifier_Property
(
Entity
:
Node_Id
;
Name
:
Name_Id
;
In_Mode
:
Name_Id
:=
No_Name
)
return
Boolean
is
Property_Value
:
constant
Node_Id
:=
Get_Value_Of_Property_Association
(
Entity
,
Name
,
In_Mode
);
begin
return
Present
(
Property_Value
)
and
then
Get_Type_Of_Property_Value
(
Property_Value
,
True
)
=
PT_Classifier
;
end
Is_Defined_Classifier_Property
;
-------------------------------
-- Is_Defined_Range_Property --
-------------------------------
...
...
@@ -682,6 +661,46 @@ package body Ocarina.Instances.Queries is
PT_Range
;
end
Is_Defined_Range_Property
;
--------------------------------
-- Is_Defined_Record_Property --
--------------------------------
function
Is_Defined_Record_Property
(
Entity
:
Node_Id
;
Name
:
Name_Id
;
In_Mode
:
Name_Id
:=
No_Name
)
return
Boolean
is
Property
:
constant
Node_Id
:=
Get_Property_Association
(
Entity
,
Name
,
In_Mode
);
begin
return
Present
(
Property
)
and
then
Get_Type_Of_Property_Value
(
ATN
.
Property_Association_Value
(
AIN
.
Corresponding_Declaration
(
Property
)),
True
)
=
PT_Record
;
end
Is_Defined_Record_Property
;
------------------------------------
-- Is_Defined_Classifier_Property --
------------------------------------
function
Is_Defined_Classifier_Property
(
Entity
:
Node_Id
;
Name
:
Name_Id
;
In_Mode
:
Name_Id
:=
No_Name
)
return
Boolean
is
Property_Value
:
constant
Node_Id
:=
Get_Value_Of_Property_Association
(
Entity
,
Name
,
In_Mode
);
begin
return
Present
(
Property_Value
)
and
then
Get_Type_Of_Property_Value
(
Property_Value
,
True
)
=
PT_Classifier
;
end
Is_Defined_Classifier_Property
;
------------------------------
-- Is_Defined_List_Property --
------------------------------
...
...
src/core/instance/ocarina-instances-queries.ads
View file @
bba0a978
...
...
@@ -107,6 +107,11 @@ package Ocarina.Instances.Queries is
-- Cf. the documentation of
-- Ocarina.Analyzer.Queries.Is_Defined_Range_Property
function
Is_Defined_Record_Property
(
Entity
:
Node_Id
;
Name
:
Name_Id
;
In_Mode
:
Name_Id
:=
No_Name
)
return
Boolean
;
function
Is_Defined_List_Property
(
Entity
:
Node_Id
;
Name
:
Name_Id
;
...
...
src/core/tree/ocarina-me_aadl-aadl_tree-entities-properties.adb
View file @
bba0a978
...
...
@@ -203,6 +203,9 @@ package body Ocarina.ME_AADL.AADL_Tree.Entities.Properties is
when
K_Classifier_Type
=>
return
PT_Classifier
;
when
K_Record_Type
=>
return
PT_Record
;
when
others
=>
return
PT_Other
;
end
case
;
...
...
@@ -283,23 +286,26 @@ package body Ocarina.ME_AADL.AADL_Tree.Entities.Properties is
if
Use_Evaluated_Values
then
if
Expanded_Single_Value
(
Property_Value
)
/=
No_Node
then
Value_Node
:=
Expanded_Single_Value
(
Property_Value
);
elsif
Expanded_Multi_Value
(
Property_Value
)
/=
No_List
then
Value_Node
:=
First_Node
(
Expanded_Multi_Value
(
Property_Value
));
-- If we are dealing with a list of value, only
-- consider the first value, assuming the other ones
-- are of the same type.
-- If we are dealing with a list of value
s
, only
-- consider the first value, assuming the other ones
-- are of the same type.
else
Value_Node
:=
No_Node
;
end
if
;
-- XXX todo : fix why Property_Association with Range_Term
-- Property_Value doesn't have Expanded_Value.
-- XXX todo : fix why Property_Association with
-- Range_Term _and_ Record_Term Property_Value doesn't
-- have Expanded_Value.
if
No
(
Value_Node
)
then
if
Single_Value
(
Property_Value
)
/=
No_Node
then
Value_Node
:=
Single_Value
(
Property_Value
);
elsif
Multi_Value
(
Property_Value
)
/=
No_List
then
Value_Node
:=
First_Node
(
Multi_Value
(
Property_Value
));
end
if
;
...
...
@@ -354,6 +360,9 @@ package body Ocarina.ME_AADL.AADL_Tree.Entities.Properties is
when
K_Component_Classifier_Term
=>
Value_Type
:=
PT_Classifier
;
when
K_Record_Term
=>
Value_Type
:=
PT_Record
;
-- XXX add here unit_term and record_term case
when
others
=>
...
...
@@ -409,10 +418,6 @@ package body Ocarina.ME_AADL.AADL_Tree.Entities.Properties is
return
Get_Value_Type
(
Value
(
Property_Value
)).
SVal
;
end
Get_String_Of_Property_Value
;
----------------------------------
-- Get_String_Of_Property_Value --
----------------------------------
function
Get_String_Of_Property_Value
(
Property_Value
:
Node_Id
)
return
String
is
...
...
@@ -448,10 +453,6 @@ package body Ocarina.ME_AADL.AADL_Tree.Entities.Properties is
end
case
;
end
Get_Enumeration_Of_Property_Value
;
---------------------------------------
-- Get_Enumeration_Of_Property_Value --
---------------------------------------
function
Get_Enumeration_Of_Property_Value
(
Property_Value
:
Node_Id
)
return
String
is
...
...
@@ -512,6 +513,18 @@ package body Ocarina.ME_AADL.AADL_Tree.Entities.Properties is
return
Get_Referenced_Entity
(
Property_Value
);
end
Get_Classifier_Of_Property_Value
;
----------------------------------
-- Get_Record_Of_Property_Value --
----------------------------------
function
Get_Record_Of_Property_Value
(
Property_Value
:
Node_Id
)
return
List_Id
is
pragma
Unreferenced
(
Property_Value
);
begin
return
No_List
;
end
Get_Record_Of_Property_Value
;
---------------------------------------
-- Get_Value_Of_Property_Association --
---------------------------------------
...
...
src/core/tree/ocarina-me_aadl-aadl_tree-entities-properties.ads
View file @
bba0a978
...
...
@@ -53,6 +53,7 @@ package Ocarina.ME_AADL.AADL_Tree.Entities.Properties is
PT_Classifier
,
PT_Range
,
PT_List
,
Pt_Record
,
PT_Other
);
type
Named_Element
is
...
...
@@ -189,6 +190,10 @@ package Ocarina.ME_AADL.AADL_Tree.Entities.Properties is
function
Get_Reference_Of_Property_Value
(
Property_Value
:
Node_Id
)
return
Node_Id
;
function
Get_Record_Of_Property_Value
(
Property_Value
:
Node_Id
)
return
List_Id
;
-- For record, values as stored as a list
function
Get_Value_Of_Property_Association
(
Property
:
Node_Id
)
return
Value_Type
;
...
...
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