Commit 4d31ad17 authored by Maxime Perrotin's avatar Maxime Perrotin

Fill new AST with context parameters

parent 2f56caee
......@@ -381,6 +381,7 @@ package body Buildsupport_Utils is
function AADL_to_Ada_IV (System : Node_Id) return Complete_Interface_View is
use type Functions.Vector;
use type Channels.Vector;
use type Ctxt_Params.Vector;
Funcs : Functions.Vector := Functions.Empty_Vector;
Routes : Channels.Vector; -- := Channels.Empty_Vector;
Current_Function : Node_Id;
......@@ -402,6 +403,8 @@ package body Buildsupport_Utils is
Zip_Id : Name_Id := No_Name;
-- To get the context parameters
Subco : Node_Id;
CP : Context_Parameter;
CP_ASN1 : Node_Id;
begin
Result.Name := US (Name);
Result.Language := Get_Source_Language (Inst);
......@@ -415,7 +418,23 @@ package body Buildsupport_Utils is
while Present (Subco) loop
case Get_Category_Of_Component (Subco) is
when CC_Data =>
null;
CP_ASN1 := Corresponding_Instance (Subco);
CP.Name := US (AIN_Case (Subco));
CP.Sort :=
US (Get_Name_String (Get_Type_Source_Name (CP_ASN1)));
CP.Default_Value :=
US (Get_Name_String (Get_String_Property
(CP_ASN1, "taste::fs_default_value")));
CP.ASN1_Module := US (Get_ASN1_Module_Name (CP_ASN1));
declare
NA : constant Name_Array := Get_Source_Text (CP_ASN1);
begin
if NA'Length > 0 then
CP.ASN1_File_Name :=
Just (US (Get_Name_String (NA (1))));
end if;
end;
Result.Context_Params := Result.Context_Params & CP;
when others =>
null;
end case;
......
......@@ -142,7 +142,7 @@ package Buildsupport_Utils is
Sort : Unbounded_String;
Default_Value : Unbounded_String;
ASN1_Module : Unbounded_String;
ASN1_File_Name : Option (Present => False);
ASN1_File_Name : Option;
end record;
package Ctxt_Params is new Indefinite_Vectors (Natural, Context_Parameter);
......@@ -151,7 +151,7 @@ package Buildsupport_Utils is
record
Name : Unbounded_String;
Language : Supported_Source_Language;
Zip_File : Option (Present => False);
Zip_File : Option := Nothing;
Context_Params : Ctxt_Params.Vector;
User_Properties : Property_Maps.Map;
Timers : String_Vectors.Vector;
......
......@@ -5,37 +5,32 @@
generic
type T is private;
package Option_Type is
pragma Assertion_Policy (check);
type Option (Present : Boolean) is tagged private;
type Option is tagged private;
function Just (I : T) return Option;
function Nothing return Option;
function Just (O : Option) return T
with Pre => O.Present;
function Just (O : Option) return T;
function Value (O : Option) return T renames Just;
function Value_Or (O : Option; Default : T) return T;
function Has_Value (O : Option) return Boolean is (O.Present);
function Has_Value (O : Option) return Boolean;
private
type Option (Present : Boolean) is tagged
type Option is tagged
record
case Present is
when True =>
Value : T;
when False =>
null;
end case;
Present : Boolean := False;
Value : T;
end record;
function Just (I : T) return Option is
(Present => True, Value => I);
function Nothing return Option is
(Present => False);
(Present => False, others => <>);
function Just (O : Option) return T is (O.Value);
function Value_Or (O : Option; Default : T) return T is
(if O.Present then O.Value else Default);
function Has_Value (O : Option) return Boolean is (O.Present);
end Option_Type;
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