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
7d861098
Commit
7d861098
authored
Apr 23, 2021
by
Daniel Tuulik
Browse files
Merge branch 'qgen_fix_adacore' of
https://gitrepos.estec.esa.int/taste/kazoo
into qgen_fix_adacore
parents
762a5387
c7683f55
Changes
146
Hide whitespace changes
Inline
Side-by-side
doc/Makefile
View file @
7d861098
...
...
@@ -2,7 +2,7 @@ all:
mkdir
-p
tmp
mkdir
-p
new-templates
# Extract the latest template tags from any demo project and put them in the new-templates folder
cd
../test/
test-cv
&&
kazoo
--doc
-o
../../doc/tmp
--gw
-g
--glue
&&
mv
../../doc/tmp/Dump/Doc/
*
../../doc/new-templates
cd
../test/
Demo_Distrib
&&
kazoo
--doc
-o
../../doc/tmp
--gw
-g
--glue
&&
mv
../../doc/tmp/Dump/Doc/
*
../../doc/new-templates
mkdir
-p
preprocess
cp
templates/templates_from_wiki preprocess
# copy the previous one
mv
templates/templates_from_wiki templates/templates_from_wiki.old
# delete the old templates
...
...
doc/order.txt
View file @
7d861098
...
...
@@ -7,6 +7,7 @@ templates/skeletons/sub/function.tmplt
templates/skeletons/sub/interface.tmplt
templates/skeletons/sub/makefile.tmplt
templates/concurrency_view/sub/trigger.tmplt
templates/concurrency_view/sub/bus.tmplt
templates/concurrency_view/sub/thread.tmplt
templates/concurrency_view/sub/pi.tmplt
templates/concurrency_view/sub/ri.tmplt
...
...
doc/preprocess/templates_from_wiki
View file @
7d861098
...
...
@@ -18,6 +18,12 @@ This template is evaluated only once. The output is saved to the Makefile within
|Has_Context_Param
|↳ and flag to indicate if function has context parameters
|-
|Instance_Of
|↳ and the instance name or empty string
|-
|Is_Shared_Type
|↳ true if component is an instance of a function stored in the shared types folder
|-
|CP_Files
|List of all context parameters ASN.1 files
|-
...
...
@@ -118,7 +124,7 @@ This template is evaluated for every function which has context parameters. The
|DOCUMENTATION MISSING
|-
|Instance_Of
|
DOCUMENTATION MISSING
|
Name of instance or empty string
|}
=== templates/skeletons/sub/trigger.tmplt ===
This template is evaluated to trigger processing of other files from given directory.
...
...
@@ -689,6 +695,28 @@ This file is processed for every node. The result of this file indicates if the
|Is_Distributed
|True if the system contains at least one bus
|}
=== templates/concurrency_view/sub/bus.tmplt ===
This template is parsed for all busses referenced in system.tmplt
{| class="wikitable"
!Parameter name
!Description
|-
|Bus_Name
|Name of the bus
|-
|Classifier
|AADL Classifier for the bus
|-
|Property_Names
|AADL property names (vector tag)
|-
|Property_Values
|AADL property values
|-
|AADL_Package
|AADL package name containing the bus
|}
=== templates/concurrency_view/sub/thread.tmplt ===
This file is processed for every thread in every partition in every node.
{| class="wikitable"
...
...
@@ -1148,7 +1176,7 @@ This template is evaluated for every block.
|True if function is a function type
|-
|Instance_Of
|
DOCUMENTATION MISSING
|
Name of instance or empty string
|-
|Debug_Flag
|if -g is set in the command line
...
...
@@ -1551,6 +1579,9 @@ filesys.tmplt.
|Bus_Classifier
| ↳ Corresponding AADL classifier
|-
|Bus_Properties
| ↳ Corresponding AADL properties (from bus.tmplt)
|-
|Device_Node_Name
|
|-
...
...
@@ -1669,4 +1700,4 @@ filesys.tmplt.
|-
|Block_Languages
|DOCUMENTATION MISSING
|}
|}
\ No newline at end of file
doc/templates/templates_concurrency_view_sub_block.ascii
View file @
7d861098
...
...
@@ -126,7 +126,7 @@ This template is evaluated for every block.
| Is_Type | True if function is a function |
| | type |
+-----------------------------------+-----------------------------------+
| Instance_Of |
DOCUMENTATION MISSING
|
| Instance_Of |
Name of instance or empty string
|
+-----------------------------------+-----------------------------------+
| Debug_Flag | if -g is set in the command line |
+-----------------------------------+-----------------------------------+
...
...
doc/templates/templates_concurrency_view_sub_bus.ascii
0 → 100644
View file @
7d861098
templates/concurrency_view/sub/bus.tmplt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This template is parsed for all busses referenced in system.tmplt
+-----------------+--------------------------------------+
| Parameter name | Description |
+=================+======================================+
| Bus_Name | Name of the bus |
+-----------------+--------------------------------------+
| Classifier | AADL Classifier for the bus |
+-----------------+--------------------------------------+
| Property_Names | AADL property names (vector tag) |
+-----------------+--------------------------------------+
| Property_Values | AADL property values |
+-----------------+--------------------------------------+
| AADL_Package | AADL package name containing the bus |
+-----------------+--------------------------------------+
doc/templates/templates_concurrency_view_sub_system.ascii
View file @
7d861098
...
...
@@ -64,6 +64,9 @@ to the file with name returned by filesys.tmplt.
+-----------------------------------+-----------------------------------+
| Bus_Classifier | ↳ Corresponding AADL classifier |
+-----------------------------------+-----------------------------------+
| Bus_Properties | ↳ Corresponding AADL properties |
| | (from bus.tmplt) |
+-----------------------------------+-----------------------------------+
| Device_Node_Name | |
+-----------------------------------+-----------------------------------+
| Device_Partition | |
...
...
doc/templates/templates_from_wiki
View file @
7d861098
...
...
@@ -18,6 +18,12 @@ This template is evaluated only once. The output is saved to the Makefile within
|Has_Context_Param
|↳ and flag to indicate if function has context parameters
|-
|Instance_Of
|↳ and the instance name or empty string
|-
|Is_Shared_Type
|↳ true if component is an instance of a function stored in the shared types folder
|-
|CP_Files
|List of all context parameters ASN.1 files
|-
...
...
@@ -118,7 +124,7 @@ This template is evaluated for every function which has context parameters. The
|DOCUMENTATION MISSING
|-
|Instance_Of
|
DOCUMENTATION MISSING
|
Name of instance or empty string
|}
=== templates/skeletons/sub/trigger.tmplt ===
This template is evaluated to trigger processing of other files from given directory.
...
...
@@ -689,6 +695,28 @@ This file is processed for every node. The result of this file indicates if the
|Is_Distributed
|True if the system contains at least one bus
|}
=== templates/concurrency_view/sub/bus.tmplt ===
This template is parsed for all busses referenced in system.tmplt
{| class="wikitable"
!Parameter name
!Description
|-
|Bus_Name
|Name of the bus
|-
|Classifier
|AADL Classifier for the bus
|-
|Property_Names
|AADL property names (vector tag)
|-
|Property_Values
|AADL property values
|-
|AADL_Package
|AADL package name containing the bus
|}
=== templates/concurrency_view/sub/thread.tmplt ===
This file is processed for every thread in every partition in every node.
{| class="wikitable"
...
...
@@ -1148,7 +1176,7 @@ This template is evaluated for every block.
|True if function is a function type
|-
|Instance_Of
|
DOCUMENTATION MISSING
|
Name of instance or empty string
|-
|Debug_Flag
|if -g is set in the command line
...
...
@@ -1551,6 +1579,9 @@ filesys.tmplt.
|Bus_Classifier
| ↳ Corresponding AADL classifier
|-
|Bus_Properties
| ↳ Corresponding AADL properties (from bus.tmplt)
|-
|Device_Node_Name
|
|-
...
...
doc/templates/templates_skeletons_context_parameters.ascii
View file @
7d861098
...
...
@@ -23,5 +23,5 @@ parameters. The output is saved to the file Context-.asn
+----------------+-----------------------------------------------------+
| Is_Type | DOCUMENTATION MISSING |
+----------------+-----------------------------------------------------+
| Instance_Of |
DOCUMENTATION MISSING
|
| Instance_Of |
Name of instance or empty string
|
+----------------+-----------------------------------------------------+
doc/templates/templates_skeletons_makefile.ascii
View file @
7d861098
...
...
@@ -19,6 +19,13 @@ Makefile within output directory.
| Has_Context_Param | ↳ and flag to indicate if |
| | function has context parameters |
+-----------------------------------+-----------------------------------+
| Instance_Of | ↳ and the instance name or empty |
| | string |
+-----------------------------------+-----------------------------------+
| Is_Shared_Type | ↳ true if component is an |
| | instance of a function stored in |
| | the shared types folder |
+-----------------------------------+-----------------------------------+
| CP_Files | List of all context parameters |
| | ASN.1 files |
+-----------------------------------+-----------------------------------+
...
...
src/taste-aadl_parser.adb
View file @
7d861098
-- ************************ TASTE AADL Parser ************************** --
-- Based on Ocarina **************************************************** --
-- (c) 2019-202
0
Maxime Perrotin / ESA - maxime.perrotin@esa.int
-- (c) 2019-202
1
Maxime Perrotin / ESA - maxime.perrotin@esa.int
-- ********************************************************************* --
--
with
System
.
Assertions
,
...
...
@@ -348,9 +348,9 @@ package body TASTE.AADL_Parser is
Result
:
Ports
.
Map
;
Visited_Functions
:
String_Sets
.
Set
;
procedure
Rec_Find_Thread
(
Ports_Map
:
in
out
Ports
.
Map
;
Visited
:
in
out
String_Sets
.
Set
;
Func
:
Taste_Terminal_Function
)
is
procedure
Rec_Find_Thread
(
Ports_Map
:
in
out
Ports
.
Map
;
Visited
:
in
out
String_Sets
.
Set
;
Func
:
Taste_Terminal_Function
)
is
use
String_Sets
;
Current_Function
:
constant
String_Sets
.
Set
:=
String_Sets
.
To_Set
(
To_String
(
Func
.
Name
));
...
...
@@ -390,7 +390,13 @@ package body TASTE.AADL_Parser is
Remote_Thread_Name
:
constant
Unbounded_String
:=
To_Lower
(
To_String
(
Dist
.
Function_Name
))
&
"_"
&
Dist
.
Interface_Name
;
Port_Name
:
constant
Unbounded_String
:=
RI
.
Name
;
-- The port name cannot be RI.Name because that could
-- cause multiple ports with the same name if more than
-- one function connected through a chain of sync calls
-- have a RI of that name.
-- Port_Name : constant Unbounded_String := RI.Name;
Port_Name
:
constant
Unbounded_String
:=
Dist
.
Function_Name
&
"_"
&
RI
.
Name
;
New_P
:
constant
Thread_Port
:=
(
Name
=>
Port_Name
,
Remote_Thread
=>
Remote_Thread_Name
,
...
...
@@ -637,7 +643,8 @@ package body TASTE.AADL_Parser is
Partition
.
Out_Ports
.
Insert
(
Key
=>
To_String
(
Out_Port
.
RI
.
Name
),
New_Item
=>
(
Port_Name
=>
Out_Port
.
RI
.
Name
,
-- Out_Port.RI.Name,
Out_Port
.
Name
,
Connected_Threads
=>
String_Vectors
.
Empty_Vector
&
To_String
(
T
.
Name
),
...
...
src/taste-backend-code_generators.adb
View file @
7d861098
...
...
@@ -79,6 +79,8 @@ package body TASTE.Backend.Code_Generators is
Language_Tag
,
Has_Context_Param_Tag
,
Is_Type_Tag
,
Is_Shared_Type_Tag
,
Instance_Of_Tag
,
Is_FPGA_Tag
,
CPU_Platform_Tag
:
Vector_Tag
;
Content_Set
:
Translate_Set
;
...
...
@@ -92,11 +94,18 @@ package body TASTE.Backend.Code_Generators is
end
if
;
for
Each
of
Model
.
Interface_View
.
Flat_Functions
loop
Languages
:=
Languages
or
To_Set
(
US
(
Language_Spelling
(
Each
)));
Functions_Tag
:=
Functions_Tag
&
Each
.
Name
;
Language_Tag
:=
Language_Tag
&
Language_Spelling
(
Each
);
Is_Type_Tag
:=
Is_Type_Tag
&
Each
.
Is_Type
;
Functions_Tag
:=
Functions_Tag
&
Each
.
Name
;
Language_Tag
:=
Language_Tag
&
Language_Spelling
(
Each
);
Is_Type_Tag
:=
Is_Type_Tag
&
Each
.
Is_Type
;
Instance_Of_Tag
:=
Instance_Of_Tag
&
Each
.
Instance_Of
.
Value_Or
(
US
(
""
));
Has_Context_Param_Tag
:=
Has_Context_Param_Tag
&
(
not
Each
.
Context_Params
.
Is_Empty
);
-- Determine if the function type is in the shared folder
Is_Shared_Type_Tag
:=
Is_Shared_Type_Tag
&
(
Each
.
Instance_Of
.
Has_Value
and
then
not
Model
.
Interface_View
.
Flat_Functions
.
Contains
(
To_String
(
Each
.
Instance_Of
.
Unsafe_Just
)));
if
Each
.
User_Properties
.
Contains
(
"TASTE_IV_Properties::FPGA_Configurations"
)
...
...
@@ -126,6 +135,8 @@ package body TASTE.Backend.Code_Generators is
&
Assoc
(
"Function_Names"
,
Functions_Tag
)
&
Assoc
(
"Language"
,
Language_Tag
)
&
Assoc
(
"Is_Type"
,
Is_Type_Tag
)
&
Assoc
(
"Is_Shared_Type"
,
Is_Shared_Type_Tag
)
&
Assoc
(
"Instance_Of"
,
Instance_Of_Tag
)
&
Assoc
(
"CP_Files"
,
All_CP_Files
)
&
Assoc
(
"Has_Context_Param"
,
Has_Context_Param_Tag
)
&
Assoc
(
"Is_FPGA"
,
Is_FPGA_Tag
)
...
...
src/taste-concurrency_view.adb
View file @
7d861098
...
...
@@ -223,6 +223,26 @@ package body TASTE.Concurrency_View is
declare
Path
:
constant
String
:=
Full_Name
(
Current
);
-- Optional template for Busses, useful to render the bus
-- properties.
function
Generate_Bus
(
Bus
:
Taste_Bus
)
return
String
is
File_Id
:
constant
String
:=
Path
&
"/bus.tmplt"
;
Trigger
:
constant
Boolean
:=
Exists
(
File_Id
);
Bus_Assoc
:
constant
Translate_Set
:=
Properties_To_Template
(
Bus
.
Properties
)
&
Assoc
(
"Bus_Name"
,
Bus
.
Name
)
&
Assoc
(
"AADL_Package"
,
Bus
.
AADL_Package
)
&
Assoc
(
"Classifier"
,
Bus
.
Classifier
);
Result
:
constant
String
:=
(
if
Trigger
then
Strip_String
(
Parse
(
File_Id
,
Bus_Assoc
))
else
""
);
begin
Document_Template
(
Templates_Concurrency_View_Sub_Bus
,
Bus_Assoc
);
return
Result
;
end
Generate_Bus
;
function
Generate_Partition
(
Node_Name
:
String
;
Partition_Name
:
String
)
return
String
...
...
@@ -676,6 +696,7 @@ package body TASTE.Concurrency_View is
Part_Dest_Name
:
Vector_Tag
;
-- Inter-partition connections (TSP)
Bus_Names
,
Bus_AADL_Pkg
,
Bus_Properties
,
Bus_Classifier
:
Vector_Tag
;
-- System busses
Device_Node_Name
,
Device_Partition_Name
:
Vector_Tag
;
...
...
@@ -699,6 +720,7 @@ package body TASTE.Concurrency_View is
Bus_Names
:=
Bus_Names
&
Bus
.
Name
;
Bus_AADL_Pkg
:=
Bus_AADL_Pkg
&
Bus
.
AADL_Package
;
Bus_Classifier
:=
Bus_Classifier
&
Bus
.
Classifier
;
Bus_Properties
:=
Bus_Properties
&
Generate_Bus
(
Bus
);
end
loop
;
-- Bus connections: we need the output port name, partition and
...
...
@@ -910,6 +932,7 @@ package body TASTE.Concurrency_View is
&
Assoc
(
"Bus_Names"
,
Bus_Names
)
&
Assoc
(
"Bus_AADL_Package"
,
Bus_AADL_Pkg
)
&
Assoc
(
"Bus_Classifier"
,
Bus_Classifier
)
&
Assoc
(
"Bus_Properties"
,
Bus_Properties
)
&
Assoc
(
"Device_Node_Name"
,
Device_Node_Name
)
&
Assoc
(
"Device_Partition"
,
Device_Partition_Name
)
&
Assoc
(
"Unique_Dev_ASN1_Files"
,
Unique_ASN1_Files
)
...
...
src/taste-deployment_view.adb
View file @
7d861098
...
...
@@ -774,7 +774,7 @@ package body TASTE.Deployment_View is
-- Update the information in the deployment view
C_DV
.
Source_Function
:=
C_IV
.
Caller
;
C_DV
.
Source_Port
:=
C_IV
.
RI_Name
;
C_DV
.
Source_Port
:=
C_IV
.
Callee
&
"_"
&
C_IV
.
RI_Name
;
C_DV
.
Dest_Function
:=
C_IV
.
Callee
;
C_DV
.
Dest_Port
:=
C_IV
.
PI_Name
;
end
if
;
...
...
src/taste-parser_utils.adb
View file @
7d861098
-- *************************** taste aadl parser ************************* --
-- (c) 2008-201
8
European Space Agency - maxime.perrotin@esa.int
-- (c) 2008-20
2
1 European Space Agency - maxime.perrotin@esa.int
-- LGPL license, see LICENSE file
with
Ada
.
Characters
.
Latin_1
,
...
...
@@ -144,6 +144,26 @@ package body TASTE.Parser_Utils is
Sep
=>
Sep
));
end
Join_Strings
;
function
Filter_First_Elem
(
unused_Value
,
Parameters
:
String
;
Context
:
Filter_Context
)
return
String
is
Assoc
:
Association
;
Table
:
Tag
;
begin
Assoc
:=
Get
(
Context
.
Translations
,
Parameters
);
if
Assoc
=
Null_Association
then
return
""
;
end
if
;
Table
:=
Get
(
Assoc
);
return
Item
(
Table
,
1
);
exception
when
Constraint_Error
=>
-- If Association is not a Tag (table) or if zero elements
return
""
;
end
Filter_First_Elem
;
function
Filter_Uniq
(
Value
,
Parameters
:
String
;
unused_Context
:
Filter_Context
)
return
String
...
...
@@ -414,6 +434,123 @@ package body TASTE.Parser_Utils is
-- Get all properties as a Map Key/String --
-- Input parameter is an AADL instance --
--------------------------------------------
function
Numeric_Term_As_String
(
Node
:
Node_Id
)
return
String
is
function
Signed_Number
(
Value
,
Unit
:
Node_Id
)
return
String
is
Result
:
Unbounded_String
;
begin
if
ATN
.
Kind
(
Value
)
=
K_Literal
then
-- aadlinteger or aadlreal
Result
:=
US
(
Ocarina
.
AADL_Values
.
Image
(
ATN
.
Value
(
Value
)));
else
-- If this is ever needed, relevant code to adapt is in
-- ocarina-be_aadl-properties-values.adb
Result
:=
US
(
"UNSUPPORTED CONSTANTS"
);
end
if
;
if
Present
(
Unit
)
then
Result
:=
Result
&
US
(
Get_Name_String
(
ATN
.
Display_Name
(
Unit
)));
end
if
;
return
To_String
(
Result
);
end
Signed_Number
;
begin
return
(
case
ATN
.
Kind
(
Node
)
is
when
K_Minus_Numeric_Term
=>
"-"
&
Numeric_Term_As_String
(
ATN
.
Numeric_Term
(
Node
)),
when
K_Signed_AADLNumber
=>
Signed_Number
(
Number_Value
(
Node
),
Unit_Identifier
(
Node
)),
when
K_Entity_Reference
=>
-- This comes from ocarina-be_aadl-identifiers.adb, function
-- Print_Entity_Reference
(
if
ATN
.
Namespace_Identifier
(
Node
)
/=
No_Node
then
Get_Name_String
(
ATN
.
Display_Name
(
ATN
.
Namespace_Identifier
(
Node
)))
&
"::"
else
""
)
&
Get_Name_String
(
ATN
.
Display_Name
(
Node
)),
when
K_Property_Term
|
K_Unique_Property_Const_Identifier
=>
-- This comes from ocarina-be_aadl-identifiers.adb, function
-- Print_Entity_Reference
(
if
ATN
.
Property_Set_Identifier
(
Node
)
/=
No_Node
then
Get_Name_String
(
ATN
.
Display_Name
(
ATN
.
Property_Set_Identifier
(
Node
)))
&
"::"
else
""
)
&
Get_Name_String
(
ATN
.
Display_Name
(
Node
)),
when
others
=>
"ERROR WITH NUMERIC TERM"
);
end
Numeric_Term_As_String
;
function
Record_As_String
(
Node
:
Node_Id
)
return
String
;
function
Property_Value_As_String
(
Single_Val
:
Node_Id
;
Array_Value
:
Node_Id
:=
No_Node
)
return
String
is
-- return the sting corresponding to a property value
begin
return
(
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
=>
Numeric_Term_As_String
(
Lower_Bound
(
Single_Val
))
&
".."
&
Numeric_Term_As_String
(
Upper_Bound
(
Single_Val
)),
when
ATN
.
K_Component_Classifier_Term
=>
-- When property is "classifier (...)" the following
-- returns the name of the component (e.g. foo.other)
(
if
Array_Value
/=
No_Node
then
Get_Name_String
(
AIN
.
Display_Name
(
AIN
.
Identifier
(
Get_Classifier_Of_Property_Value
(
ATN
.
Expanded_Single_Value
(
Array_Value
)))))
else
"UNSUPPORTED CLASSIFIER HERE"
),
when
ATN
.
K_Record_Term
=>
Record_As_String
(
single_val
),
when
others
=>
"ERROR! Kazoo does not support Kind: "
&
ATN
.
Kind
(
single_val
)'
Img
);
end
Property_Value_As_String
;
function
Record_As_String
(
Node
:
Node_Id
)
return
String
is
-- Get the string of a complex record property
-- We have to form this string as Ocarina does not have an API for that
-- (the closest is found in ocarina-be_aadl-properties-values.adb but
-- it only prints to screen)
List_Node
:
Node_Id
:=
ATN
.
First_Node
(
ATN
.
List_Items
(
Node
));
Result
:
Unbounded_String
:=
US
(
"[ "
);
begin
while
Present
(
List_Node
)
loop
if
Kind
(
List_Node
)
=
K_Record_Term_Element
then
Result
:=
Result
&
US
(
Get_Name_String
(
ATN
.
Display_Name
(
ATN
.
Identifier
(
List_Node
))))
&
" => "
&
Property_Value_As_String
(
Property_Expression
(
List_Node
));
else
Result
:=
Result
&
"ERROR - UNIDENTIFIED RECORD FIELD"
;
end
if
;
Result
:=
Result
&
"; "
;
List_Node
:=
ATN
.
Next_Node
(
List_Node
);
end
loop
;
return
To_String
(
Result
&
" ]"
);
end
Record_As_String
;
function
Get_Properties_Map
(
D
:
Node_Id
)
return
Property_Maps
.
Map
is
Properties
:
constant
List_Id
:=
AIN
.
Properties
(
D
);
Result
:
Property_Maps
.
Map
:=
Property_Maps
.
Empty_Map
;
...
...
@@ -422,50 +559,15 @@ package body TASTE.Parser_Utils is
Single_Val
:
Node_Id
;
begin
while
Present
(
property
)
loop
prop_value
:=
AIN
.
Property_Association_Value
(
property
);
Prop_Value
:=
AIN
.
Property_Association_Value
(
property
);
Single_Val
:=
ATN
.
Single_Value
(
Prop_Value
);
if
Present
(
ATN
.
Single_Value
(
prop_value
))
then
-- Only support single-value properties for now
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
)));
Value
=>
US
(
Property_Value_As_String
(
Single_Val
,
Prop_Value
))));
end
if
;
Property
:=
AIN
.
Next_Node
(
Property
);
end
loop
;
...
...
@@ -500,4 +602,5 @@ package body TASTE.Parser_Utils is
end
Join_Sets
;
begin
Register_Filter
(
"UNIQ"
,
Filter_Uniq
'
Access
);
Register_Filter
(
"FIRST_ELEM"
,
Filter_First_Elem
'
Access
);
end
TASTE
.
Parser_Utils
;
src/taste-parser_utils.ads
View file @
7d861098
...
...
@@ -85,6 +85,12 @@ package TASTE.Parser_Utils is
(
Value
,
Parameters
:
String
;
unused_Context
:
Filter_Context
)
return
String
;
-- Return the first value in a table
-- @_FIRST_ELEM(Tag_Name):Vector_Tag_@
function
Filter_First_Elem
(
unused_Value
,
Parameters
:
String
;
Context
:
Filter_Context
)
return
String
;
-- Generate documentation for a translate set
-- Template_Category enumerants reflect the path containing the template
...
...
@@ -110,6 +116,7 @@ package TASTE.Parser_Utils is
Templates_Concurrency_View_Sub_Partition
,
Templates_Concurrency_View_Sub_Node
,
Templates_Concurrency_View_Sub_System
,
Templates_Concurrency_View_Sub_Bus
,
Templates_Dump_Interfaceview
,
Templates_Dump_Deploymentview
);
...
...
src/taste-semantic_check.adb
View file @
7d861098
...
...
@@ -22,29 +22,50 @@ package body TASTE.Semantic_Check is
-- Allow case insensitive checks of unbounded strings:
function
"="
(
A
,
B
:
Unbounded_String
)
return
Boolean
is
(
To_Lower
(
To_String
(
A
))
=
(
To_Lower
(
To_String
(
B
))));
Error_Found
:
Boolean
:=
False
;
begin