Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
TASTE
kazoo
Commits
83fd6478
Commit
83fd6478
authored
Nov 25, 2019
by
Maxime Perrotin
Browse files
Parse complex properties with classifier reference
parent
2bbe8136
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/taste-interface_view.adb
View file @
83fd6478
...
...
@@ -674,9 +674,23 @@ package body TASTE.Interface_View is
&
To_String
(
Result
.
Instance_Of
.
Value_Or
(
US
(
"???"
))));
elsif
Each
.
Name
=
"Taste::is_Instance_Of2"
then
-- Could not find a way to parse the classifier property,
-- see taste-parser_utils.adb
null
;
-- Each.Value has the form "foo.other"
-- We must keep only "foo"
declare
Inp
:
constant
String
:=
To_String
(
Each
.
Value
);
Sep
:
constant
String
:=
"."
;
Idx
:
constant
Natural
:=
Index
(
Inp
,
Sep
,
From
=>
Inp
'
First
);
begin
Result
.
Instance_Of
:=
Just
(
US
(
Inp
(
Inp
'
First
..
Idx
-
1
)));
exception
when
others
=>
Put_Error
(
"Incorrect instance: "
&
To_String
(
Each
.
Value
));
end
;
Put_Debug
(
"Instance (New form): "
&
To_String
(
Result
.
Instance_Of
.
Value_Or
(
US
(
"???"
))));
end
if
;
end
loop
;
...
...
src/taste-parser_utils.adb
View file @
83fd6478
...
...
@@ -13,12 +13,11 @@ with Ada.Characters.Latin_1,
GNAT
.
Strings
,
GNAT
.
Command_Line
,
Templates_Parser
.
Utils
,
-- Templates_Parser.Query,
Ocarina
.
AADL_Values
,
Ocarina
.
Configuration
,
Ocarina
.
FE_AADL
.
Parser
,
Ocarina
.
Instances
.
Queries
,
--
Ocarina.ME_AADL.AADL_
Instances.Enti
ties,
Ocarina
.
ME_AADL
.
AADL_
Tree
.
Entities
.
Proper
ties
,
TASTE
.
Parser_Version
;
package
body
TASTE
.
Parser_Utils
is
...
...
@@ -26,7 +25,7 @@ package body TASTE.Parser_Utils is
use
GNAT
.
OS_Lib
,
GNAT
.
Command_Line
,
Templates_Parser
.
Utils
,
--
Ocarina.ME_AADL.AADL_
Instances.Enti
ties,
Ocarina
.
ME_AADL
.
AADL_
Tree
.
Entities
.
Proper
ties
,
Ocarina
.
Instances
.
Queries
;
procedure
Put_Info
(
Info
:
String
)
is
...
...
@@ -334,68 +333,61 @@ package body TASTE.Parser_Utils is
-- Input parameter is an AADL instance --
--------------------------------------------
function
Get_Properties_Map
(
D
:
Node_Id
)
return
Property_Maps
.
Map
is
p
roperties
:
constant
List_Id
:=
AIN
.
Properties
(
D
);
r
esult
:
Property_Maps
.
Map
:=
Property_Maps
.
Empty_Map
;
p
roperty
:
Node_Id
:=
AIN
.
First_Node
(
properties
);
p
rop_
v
alue
:
Node_Id
;
s
ingle_
v
al
:
Node_Id
;
P
roperties
:
constant
List_Id
:=
AIN
.
Properties
(
D
);
R
esult
:
Property_Maps
.
Map
:=
Property_Maps
.
Empty_Map
;
P
roperty
:
Node_Id
:=
AIN
.
First_Node
(
properties
);
P
rop_
V
alue
,
S
ingle_
V
al
:
Node_Id
;
begin
while
Present
(
property
)
loop
prop_value
:=
AIN
.
Property_Association_Value
(
property
);
if
Present
(
ATN
.
Single_Value
(
prop_value
))
then
-- Only support single-value properties for now
single_val
:=
ATN
.
Single_Value
(
prop_value
);
-- declare
-- dummy_foo : Node_Id;
-- dummy_bar : Name_Id;
-- dummy_path : List_Id;
-- begin
-- if ATN.Kind (single_val) = ATN.K_Component_Classifier_Term
-- then
-- dummy_foo := ATN.Identifier (single_val); -- No exception
-- dummy_foo := ATN.Entity (single_val); -- No exception
-- Put_Debug (ATN.Kind (dummy_foo)'Img); -- K_UNITS_TYPE
-- dummy_path := ATN.Namespace_Path (single_val); -- no exc
-- dummy_foo := ATN.First_Node (dummy_path); -- exception!
-- Put_Debug ("no exception!");
-- end if;
-- exception
-- when others =>
-- Put_Error ("sorry! exception!");
-- end;
result
.
Insert
(
Key
=>
AIN_Case
(
property
),
New_Item
=>
(
Name
=>
US
(
AIN_Case
(
property
)),
Value
=>
US
(
case
ATN
.
Kind
(
single_val
)
is
when
ATN
.
K_Signed_AADLNumber
=>
Ocarina
.
AADL_Values
.
Image
(
ATN
.
Value
(
ATN
.
Number_Value
(
single_val
)))
&
(
if
Present
(
ATN
.
Unit_Identifier
(
single_val
))
then
" "
&
Get_Name_String
(
ATN
.
Display_Name
(
ATN
.
Unit_Identifier
(
single_val
)))
else
""
),
when
ATN
.
K_Literal
=>
Ocarina
.
AADL_Values
.
Image
(
ATN
.
Value
(
single_val
),
Quoted
=>
False
),
when
ATN
.
K_Reference_Term
=>
Get_Name_String
(
ATN
.
Display_Name
(
ATN
.
First_Node
-- XXX must iterate
(
ATN
.
List_Items
(
ATN
.
Reference_Term
(
single_val
))))),
when
ATN
.
K_Enumeration_Term
=>
Get_Name_String
(
ATN
.
Display_Name
(
ATN
.
Identifier
(
single_val
))),
when
ATN
.
K_Number_Range_Term
=>
"RANGE NOT SUPPORTED!"
,
when
ATN
.
K_Component_Classifier_Term
=>
-- Property used e.g. to reference a component type
"Ohoh - I don't know how to parse this property..."
,
when
others
=>
"ERROR! Kazoo does not support Kind: "
&
ATN
.
Kind
(
single_val
)'
Img
)));
Single_Val
:=
ATN
.
Single_Value
(
Prop_Value
);
Result
.
Insert
(
Key
=>
AIN_Case
(
property
),
New_Item
=>
(
Name
=>
US
(
AIN_Case
(
property
)),
Value
=>
US
(
case
ATN
.
Kind
(
single_val
)
is
when
ATN
.
K_Signed_AADLNumber
=>
Ocarina
.
AADL_Values
.
Image
(
ATN
.
Value
(
ATN
.
Number_Value
(
single_val
)))
&
(
if
Present
(
ATN
.
Unit_Identifier
(
single_val
))
then
" "
&
Get_Name_String
(
ATN
.
Display_Name
(
ATN
.
Unit_Identifier
(
single_val
)))
else
""
),
when
ATN
.
K_Literal
=>
Ocarina
.
AADL_Values
.
Image
(
ATN
.
Value
(
single_val
),
Quoted
=>
False
),
when
ATN
.
K_Reference_Term
=>
Get_Name_String
(
ATN
.
Display_Name
(
ATN
.
First_Node
-- XXX must iterate
(
ATN
.
List_Items
(
ATN
.
Reference_Term
(
single_val
))))),
when
ATN
.
K_Enumeration_Term
=>
Get_Name_String
(
ATN
.
Display_Name
(
ATN
.
Identifier
(
single_val
))),
when
ATN
.
K_Number_Range_Term
=>
"RANGE NOT SUPPORTED!"
,
when
ATN
.
K_Component_Classifier_Term
=>
-- When property is "classifier (...)" the following
-- returns the name of the component (e.g. foo.other)
Get_Name_String
(
AIN
.
Display_Name
(
AIN
.
Identifier
(
Get_Classifier_Of_Property_Value
(
ATN
.
Expanded_Single_Value
(
Prop_Value
))))),
when
others
=>
"ERROR! Kazoo does not support Kind: "
&
ATN
.
Kind
(
single_val
)'
Img
)));
end
if
;
p
roperty
:=
AIN
.
Next_Node
(
p
roperty
);
P
roperty
:=
AIN
.
Next_Node
(
P
roperty
);
end
loop
;
return
r
esult
;
return
R
esult
;
end
Get_Properties_Map
;
-- Initialization step: we look for ocarina on path to define
...
...
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