-----------------------------------------------------------------------
-- gen-model-xmi -- UML-XMI model
-- Copyright (C) 2012, 2013, 2015, 2016, 2021, 2022 Stephane Carrez
-- Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-----------------------------------------------------------------------
with Ada.Tags;
with Util.Strings;
with Util.Log.Loggers;
package body Gen.Model.XMI is
use Ada.Strings.Unbounded;
Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Model.XMI");
procedure Append_Message (Into : in out UString;
Message : in String);
-- ------------------------------
-- Append a message to the error message. A newline is inserted if the buffer contains
-- an existing message.
-- ------------------------------
procedure Append_Message (Into : in out UString;
Message : in String) is
begin
if Length (Into) > 0 then
Append (Into, ASCII.LF);
end if;
Append (Into, Message);
end Append_Message;
-- ------------------------------
-- Iterate on the model element of the type On and execute the Process
-- procedure.
-- ------------------------------
procedure Iterate (Model : in Model_Map.Map;
On : in Element_Type;
Process : not null access procedure (Id : in UString;
Node : in Model_Element_Access)) is
Iter : Model_Map_Cursor := Model.First;
begin
while Has_Element (Iter) loop
declare
Node : constant Model_Element_Access := Element (Iter);
begin
if Node.Get_Type = On then
Process (Model_Map.Key (Iter), Node);
end if;
end;
Next (Iter);
end loop;
end Iterate;
-- ------------------------------
-- Iterate over the model elements of the list.
-- ------------------------------
procedure Iterate_Elements (Closure : in out T;
List : in Model_Vector;
Process : not null access
procedure (Closure : in out T;
Node : in Model_Element_Access)) is
Iter : Model_Cursor := List.First;
begin
while Model_Vectors.Has_Element (Iter) loop
Process (Closure, Model_Vectors.Element (Iter));
Model_Vectors.Next (Iter);
end loop;
end Iterate_Elements;
-- ------------------------------
-- Find the model element with the given XMI id or given name.
-- Returns null if the model element is not found.
-- ------------------------------
function Find (Model : in Model_Map.Map;
Key : in String;
Mode : in Search_Type := BY_ID) return Model_Element_Access is
begin
if Mode = BY_ID then
declare
Pos : constant Model_Map_Cursor := Model.Find (To_UString (Key));
begin
if Has_Element (Pos) then
return Element (Pos);
else
Log.Error ("Model element id '{0}' not found", Key);
return null;
end if;
end;
else
declare
Iter : Model_Map_Cursor := Model.First;
Pos : Natural;
begin
if Key (Key'First) /= '@' then
Pos := Util.Strings.Index (Key, '.');
else
Pos := 0;
end if;
while Has_Element (Iter) loop
declare
Node : Model_Element_Access := Element (Iter);
begin
-- Find in the package only. If there is no '.', check the package name only.
if Node.Get_Type = XMI_PACKAGE then
if Pos = 0 and then Node.Name = Key then
return Node;
end if;
-- Check that the package name matches and look in it.
if Pos > 0 and then Node.Name = Key (Key'First .. Pos - 1) then
Node := Node.Find (Key (Pos + 1 .. Key'Last));
if Node /= null then
return Node;
end if;
end if;
end if;
end;
Next (Iter);
end loop;
end;
return null;
end if;
end Find;
-- ------------------------------
-- Find from the model file identified by Name, the model element with the
-- identifier or name represented by Key.
-- Returns null if the model element is not found.
-- ------------------------------
function Find_Element (Model : in UML_Model;
Name : in String;
Key : in String;
Mode : in Search_Type := BY_ID)
return Element_Type_Access is
Model_Pos : constant UML_Model_Map.Cursor := Model.Find (To_UString (Name));
Item : Model_Element_Access;
begin
if UML_Model_Map.Has_Element (Model_Pos) then
if Mode = BY_ID or else Mode = BY_NAME then
Item := Find (UML_Model_Map.Element (Model_Pos), Key, Mode);
else
declare
Iter : Model_Map_Cursor := UML_Model_Map.Element (Model_Pos).First;
begin
while Has_Element (Iter) loop
declare
Node : constant Model_Element_Access := Element (Iter);
begin
if Node.all in Element_Type'Class and then Node.Name = Key then
return Element_Type'Class (Node.all)'Access;
end if;
end;
Next (Iter);
end loop;
end;
end if;
if Item = null then
Log.Error ("The model file {0} does not define {1}",
Name, Key);
return null;
end if;
if not (Item.all in Element_Type'Class) then
Log.Error ("The model file {0} defines the element {1}",
Name, Key);
return null;
end if;
return Element_Type'Class (Item.all)'Access;
else
Log.Error ("Model file {0} not found", Name);
return null;
end if;
end Find_Element;
-- ------------------------------
-- Find the model element within all loaded UML models.
-- Returns null if the model element is not found.
-- ------------------------------
function Find (Model : in UML_Model;
Current : in Model_Map.Map;
Id : in UString)
return Model_Element_Access is
Pos : constant Natural := Index (Id, "#");
First : Natural;
begin
if Pos = 0 then
return Find (Current, To_String (Id));
end if;
First := Index (Id, "/", Pos, Ada.Strings.Backward);
if First = 0 then
First := 1;
else
First := First + 1;
end if;
declare
Len : constant Natural := Length (Id);
Name : constant UString := Unbounded_Slice (Id, First, Pos - 1);
Model_Pos : constant UML_Model_Map.Cursor := Model.Find (Name);
begin
if UML_Model_Map.Has_Element (Model_Pos) then
return Find (UML_Model_Map.Element (Model_Pos),
Slice (Id, Pos + 1, Len));
else
Log.Error ("Model element {0} not found", To_String (Id));
return null;
end if;
end;
end Find;
-- ------------------------------
-- Dump the XMI model elements.
-- ------------------------------
procedure Dump (Map : in Model_Map.Map) is
Iter : Model_Map_Cursor := Map.First;
begin
while Has_Element (Iter) loop
Element (Iter).Dump;
Next (Iter);
end loop;
end Dump;
-- ------------------------------
-- Reconcile all the UML model elements by resolving all the references to UML elements.
-- ------------------------------
procedure Reconcile (Model : in out UML_Model;
Debug : in Boolean := False) is
procedure Reconcile_Model (Key : in UString;
Map : in out Model_Map.Map);
procedure Reconcile_Model (Key : in UString;
Map : in out Model_Map.Map) is
pragma Unreferenced (Key);
Iter : Model_Map_Cursor := Map.First;
begin
while Has_Element (Iter) loop
declare
Node : constant Model_Element_Access := Element (Iter);
begin
Node.Reconcile (Model);
end;
Next (Iter);
end loop;
if Debug then
Gen.Model.XMI.Dump (Map);
end if;
end Reconcile_Model;
Iter : UML_Model_Map.Cursor := Model.First;
begin
while UML_Model_Map.Has_Element (Iter) loop
UML_Model_Map.Update_Element (Model, Iter, Reconcile_Model'Access);
UML_Model_Map.Next (Iter);
end loop;
end Reconcile;
-- ------------------------------
-- Reconcile the element by resolving the references to other elements in the model.
-- ------------------------------
procedure Reconcile (Node : in out Model_Element;
Model : in UML_Model) is
Iter : Model_Cursor := Node.Stereotypes.First;
begin
while Model_Vectors.Has_Element (Iter) loop
Model_Vectors.Element (Iter).Reconcile (Model);
Model_Vectors.Next (Iter);
end loop;
end Reconcile;
-- ------------------------------
-- Find the element with the given name. If the name is a qualified name, navigate
-- down the package/class to find the appropriate element.
-- Returns null if the element was not found.
-- ------------------------------
function Find (Node : in Model_Element;
Name : in String) return Model_Element_Access is
Pos : constant Natural := Util.Strings.Index (Name, '.');
Iter : Model_Cursor;
Item : Model_Element_Access;
begin
if Pos = 0 or else Name (Name'First) = '@' then
Iter := Node.Elements.First;
while Model_Vectors.Has_Element (Iter) loop
Item := Model_Vectors.Element (Iter);
if Item.Name = Name then
return Item;
end if;
Model_Vectors.Next (Iter);
end loop;
return null;
else
Item := Node.Find (Name (Name'First .. Pos - 1));
if Item = null then
return null;
end if;
return Item.Find (Name (Pos + 1 .. Name'Last));
end if;
end Find;
-- ------------------------------
-- Set the model name.
-- ------------------------------
procedure Set_Name (Node : in out Model_Element;
Value : in UBO.Object) is
begin
if not UBO.Is_Null (Value) then
Node.Set_Name (UBO.To_Unbounded_String (Value));
end if;
end Set_Name;
-- ------------------------------
-- Set the model XMI unique id.
-- ------------------------------
procedure Set_XMI_Id (Node : in out Model_Element;
Value : in UBO.Object) is
begin
Node.XMI_Id := UBO.To_Unbounded_String (Value);
end Set_XMI_Id;
-- ------------------------------
-- Validate the node definition as much as we can before the reconcile phase.
-- If an error is detected, return a message. Returns an empty string if everything is ok.
-- ------------------------------
function Get_Error_Message (Node : in Model_Element) return String is
Result : UString;
begin
if Length (Node.XMI_Id) = 0 then
Append (Result, "the 'xmi.id' attribute is empty");
end if;
return To_String (Result);
end Get_Error_Message;
-- ------------------------------
-- Dump the node to get some debugging description about it.
-- ------------------------------
procedure Dump (Node : in Model_Element) is
begin
Log.Info ("XMI {0} - {2}: {1}",
Element_Type'Image (Model_Element'Class (Node).Get_Type),
To_String (Node.XMI_Id), To_String (Node.Name));
if Node.Parent /= null then
Log.Info (" Parent: {0} ({1})", To_String (Node.Parent.Name),
Element_Type'Image (Node.Parent.Get_Type));
end if;
declare
Iter : Model_Cursor := Node.Tagged_Values.First;
Tag : Tagged_Value_Element_Access;
begin
while Model_Vectors.Has_Element (Iter) loop
Tag := Tagged_Value_Element'Class (Model_Vectors.Element (Iter).all)'Access;
if Tag.Tag_Def /= null then
Log.Info (" Tag: {0} = {1}",
To_String (Tag.Tag_Def.Name),
To_String (Tag.Value));
else
Log.Info (" Undef tag: {0} = {1}",
To_String (Tag.XMI_Id), To_String (Tag.Value));
end if;
Model_Vectors.Next (Iter);
end loop;
end;
declare
Stereotype : Model_Cursor := Node.Stereotypes.First;
begin
while Model_Vectors.Has_Element (Stereotype) loop
Log.Info (" Stereotype: <<{0}>>: {1}",
To_String (Model_Vectors.Element (Stereotype).Name),
To_String (Model_Vectors.Element (Stereotype).XMI_Id));
Model_Vectors.Next (Stereotype);
end loop;
end;
end Dump;
-- ------------------------------
-- Find the tag value element with the given name.
-- Returns null if there is no such tag.
-- ------------------------------
function Find_Tag_Value (Node : in Model_Element;
Name : in String) return Tagged_Value_Element_Access is
Pos : Model_Cursor := Node.Tagged_Values.First;
Tag : Model_Element_Access;
begin
while Model_Vectors.Has_Element (Pos) loop
Tag := Model_Vectors.Element (Pos);
if Tag.Name = Name then
return Tagged_Value_Element'Class (Tag.all)'Access;
end if;
Model_Vectors.Next (Pos);
end loop;
return null;
end Find_Tag_Value;
-- ------------------------------
-- Find the tag value associated with the given tag definition.
-- Returns the tag value if it was found, otherwise returns the default
-- ------------------------------
function Find_Tag_Value (Node : in Model_Element;
Definition : in Tag_Definition_Element_Access;
Default : in String := "") return String is
Pos : Model_Cursor := Node.Tagged_Values.First;
Tag : Model_Element_Access;
begin
while Model_Vectors.Has_Element (Pos) loop
Tag := Model_Vectors.Element (Pos);
if Tag.all in Tagged_Value_Element'Class and then
Tagged_Value_Element'Class (Tag.all).Tag_Def = Definition
then
return To_String (Tagged_Value_Element'Class (Tag.all).Value);
end if;
Model_Vectors.Next (Pos);
end loop;
return Default;
end Find_Tag_Value;
-- ------------------------------
-- Get the documentation and comment associated with the model element.
-- Returns the empty string if there is no comment.
-- ------------------------------
function Get_Comment (Node : in Model_Element) return String is
procedure Collect_Comment (Id : in UString;
Item : in Model_Element_Access);
Doc : constant Tagged_Value_Element_Access := Node.Find_Tag_Value (TAG_DOCUMENTATION);
Result : UString;
procedure Collect_Comment (Id : in UString;
Item : in Model_Element_Access) is
pragma Unreferenced (Id);
Comment : constant Comment_Element_Access := Comment_Element'Class (Item.all)'Access;
begin
if Comment.Ref_Id = Node.XMI_Id then
Append (Result, Comment.Text);
end if;
end Collect_Comment;
begin
Iterate (Node.Model.all, XMI_COMMENT, Collect_Comment'Access);
if Doc /= null then
Append (Result, Doc.Value);
end if;
return To_String (Result);
end Get_Comment;
-- ------------------------------
-- Get the full qualified name for the element.
-- ------------------------------
function Get_Qualified_Name (Node : in Model_Element) return String is
begin
if Node.Parent /= null then
return Node.Parent.Get_Qualified_Name & "." & To_String (Node.Name);
else
return To_String (Node.Name);
end if;
end Get_Qualified_Name;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Ref_Type_Element) return Element_Type is
begin
if Node.Ref /= null then
return Node.Ref.Get_Type;
else
return XMI_UNKNOWN;
end if;
end Get_Type;
-- ------------------------------
-- Reconcile the element by resolving the references to other elements in the model.
-- ------------------------------
overriding
procedure Reconcile (Node : in out Ref_Type_Element;
Model : in UML_Model) is
Item : constant Model_Element_Access := Find (Model, Node.Model.all, Node.Ref_Id);
begin
if Item /= null then
Node.Set_Name (Item.Name);
Node.Ref := Item;
Node.XMI_Id := Item.XMI_Id;
end if;
Model_Element (Node).Reconcile (Model);
end Reconcile;
-- ------------------------------
-- Set the reference id and collect in the profiles set the UML profiles that must
-- be loaded to get the reference.
-- ------------------------------
procedure Set_Reference_Id (Node : in out Ref_Type_Element;
Ref : in String;
Profiles : in out Util.Strings.Sets.Set) is
Pos : constant Natural := Util.Strings.Index (Ref, '#');
begin
Node.Ref_Id := To_UString (Ref);
if Pos > 0 then
declare
First : constant Natural := Util.Strings.Rindex (Ref, '/', Pos);
begin
Profiles.Include (Ref (First + 1 .. Pos - 1));
end;
end if;
end Set_Reference_Id;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Data_Type_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_DATA_TYPE;
end Get_Type;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Enum_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_ENUMERATION;
end Get_Type;
-- ------------------------------
-- Validate the node definition as much as we can before the reconcile phase.
-- An enum must not be empty, it must have at least one literal.
-- If an error is detected, return a message. Returns an empty string if everything is ok.
-- ------------------------------
overriding
function Get_Error_Message (Node : in Enum_Element) return String is
Result : UString;
begin
Append (Result, Model_Element (Node).Get_Error_Message);
if Node.Elements.Is_Empty then
Append_Message (Result, "the enum '" & To_String (Node.Name) & "' is empty.");
end if;
return To_String (Result);
end Get_Error_Message;
-- ------------------------------
-- Create an enum literal and add it to the enum.
-- ------------------------------
procedure Add_Literal (Node : in out Enum_Element;
Id : in UBO.Object;
Name : in UBO.Object;
Literal : out Literal_Element_Access) is
begin
Literal := new Literal_Element (Node.Model);
Literal.XMI_Id := UBO.To_Unbounded_String (Id);
Literal.Set_Name (UBO.To_Unbounded_String (Name));
Node.Elements.Append (Literal.all'Access);
end Add_Literal;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Literal_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_ENUMERATION_LITERAL;
end Get_Type;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Stereotype_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_STEREOTYPE;
end Get_Type;
-- ------------------------------
-- Returns True if the model element has the stereotype with the given name.
-- ------------------------------
function Has_Stereotype (Node : in Model_Element'Class;
Stereotype : in Stereotype_Element_Access) return Boolean is
Iter : Model_Cursor := Node.Stereotypes.First;
begin
if Stereotype = null then
return False;
end if;
while Model_Vectors.Has_Element (Iter) loop
declare
S : constant Model_Element_Access := Model_Vectors.Element (Iter);
begin
if S = Stereotype.all'Access then
return True;
end if;
if S.XMI_Id = Stereotype.XMI_Id then
return True;
end if;
end;
Model_Vectors.Next (Iter);
end loop;
return False;
end Has_Stereotype;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Comment_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_COMMENT;
end Get_Type;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Operation_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_OPERATION;
end Get_Type;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Attribute_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_ATTRIBUTE;
end Get_Type;
-- ------------------------------
-- Reconcile the element by resolving the references to other elements in the model.
-- ------------------------------
overriding
procedure Reconcile (Node : in out Attribute_Element;
Model : in UML_Model) is
Item : Model_Element_Access;
begin
if Length (Node.Ref_Id) = 0 then
return;
end if;
Item := Find (Model, Node.Model.all, Node.Ref_Id);
Model_Element (Node).Reconcile (Model);
if Item = null then
return;
end if;
if not (Item.all in Data_Type_Element'Class) then
Log.Error ("Invalid data type {0}", To_String (Node.Ref_Id));
return;
end if;
Node.Data_Type := Data_Type_Element'Class (Item.all)'Access;
end Reconcile;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Parameter_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_PARAMETER;
end Get_Type;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Association_End_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_ASSOCIATION_END;
end Get_Type;
-- ------------------------------
-- Get the documentation and comment associated with the model element.
-- Integrates the comment from the association itself as well as this association end.
-- Returns the empty string if there is no comment.
-- ------------------------------
overriding
function Get_Comment (Node : in Association_End_Element) return String is
Comment : constant String := Model_Element (Node).Get_Comment;
Association_Comment : constant String := Node.Parent.Get_Comment;
begin
if Association_Comment'Length = 0 then
return Comment;
elsif Comment'Length = 0 then
return Association_Comment;
else
return Association_Comment & ASCII.LF & Comment;
end if;
end Get_Comment;
-- ------------------------------
-- Reconcile the element by resolving the references to other elements in the model.
-- ------------------------------
overriding
procedure Reconcile (Node : in out Association_End_Element;
Model : in UML_Model) is
begin
Model_Element (Node).Reconcile (Model);
end Reconcile;
-- ------------------------------
-- Make the association between the two ends.
-- ------------------------------
procedure Make_Association (From : in out Association_End_Element;
To : in out Association_End_Element'Class;
Model : in UML_Model) is
Target : Model_Element_Access;
Source : Model_Element_Access;
begin
Log.Info ("Reconcile association {0} - {1}",
To_String (From.Name), To_String (To.Name));
Target := Find (Model, From.Model.all, To.Ref_Id);
if Target = null then
Log.Error ("Association end {0} not found", To_String (From.Name));
return;
end if;
Source := Find (Model, From.Model.all, From.Ref_Id);
if Source = null then
Log.Error ("Association end {0} not found", To_String (To.Name));
return;
end if;
if From.Navigable then
Class_Element'Class (Target.all).Associations.Append (From'Unchecked_Access);
From.Target_Element := Target.all'Access;
From.Source_Element := Source.all'Access;
Log.Info ("Class {0} { {1}: {2} }",
To_String (Target.Name),
To_String (From.Name),
To_String (Source.Name));
if Length (From.Name) = 0 then
Log.Error ("Class {0}: missing association end name to class {1}",
To_String (Target.Name), To_String (Source.Name));
end if;
end if;
end Make_Association;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Association_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_ASSOCIATION;
end Get_Type;
-- ------------------------------
-- Validate the node definition as much as we can before the reconcile phase.
-- An association must contain two ends and a name is necessary on the navigable ends.
-- If an error is detected, return a message. Returns an empty string if everything is ok.
-- ------------------------------
overriding
function Get_Error_Message (Node : in Association_Element) return String is
use type Ada.Containers.Count_Type;
Result : UString;
begin
Append (Result, Model_Element (Node).Get_Error_Message);
if Length (Node.Name) = 0 then
Append_Message (Result, "Association has an empty name.");
end if;
if Node.Connections.Length = 2 then
declare
First, Second : Association_End_Element_Access;
begin
First := Association_End_Element'Class (Node.Connections.Element (1).all)'Access;
Second := Association_End_Element'Class (Node.Connections.Element (2).all)'Access;
if First.Navigable and then Length (First.Name) = 0 then
Append_Message (Result, "Association '" & To_String (Node.Name) &
"' has a navigable association end with an empty name.");
end if;
if Second.Navigable and then Length (Second.Name) = 0 then
Append_Message (Result, "Association '" & To_String (Node.Name) &
"' has a navigable association end with an empty name.");
end if;
if not First.Navigable and then not Second.Navigable then
Append_Message (Result, "Association '" & To_String (Node.Name) &
"' has no navigable association ends.");
end if;
end;
elsif Node.Connections.Length /= 0 then
Append_Message (Result, "Association '" & To_String (Node.Name)
& "' needs 2 association ends");
end if;
return To_String (Result);
end Get_Error_Message;
-- ------------------------------
-- Reconcile the association between classes in the package. Find the association
-- ends and add the necessary links to the corresponding class elements.
-- ------------------------------
overriding
procedure Reconcile (Node : in out Association_Element;
Model : in UML_Model) is
use type Ada.Containers.Count_Type;
begin
Model_Element (Node).Reconcile (Model);
if Node.Connections.Length >= 2 then
declare
First, Second : Association_End_Element_Access;
begin
First := Association_End_Element'Class (Node.Connections.Element (1).all)'Access;
Second := Association_End_Element'Class (Node.Connections.Element (2).all)'Access;
First.Make_Association (Second.all, Model);
Second.Make_Association (First.all, Model);
end;
elsif Node.Connections.Length > 0 then
Log.Info ("Association {0} needs 2 association ends", To_String (Node.Name));
end if;
end Reconcile;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Generalization_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_GENERALIZATION;
end Get_Type;
-- ------------------------------
-- Reconcile the association between classes in the package. Find the association
-- ends and add the necessary links to the corresponding class elements.
-- ------------------------------
overriding
procedure Reconcile (Node : in out Generalization_Element;
Model : in UML_Model) is
begin
Ref_Type_Element (Node).Reconcile (Model);
Node.Child_Class := Find (Model, Node.Model.all, Node.Child_Id);
if Node.Child_Class /= null then
if Node.Child_Class.all in Class_Element'Class then
Class_Element'Class (Node.Child_Class.all).Parent_Class := Node'Unchecked_Access;
elsif Node.Child_Class.all in Data_Type_Element'Class then
Data_Type_Element'Class (Node.Child_Class.all).Parent_Type := Node'Unchecked_Access;
end if;
end if;
end Reconcile;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Tagged_Value_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_TAGGED_VALUE;
end Get_Type;
-- ------------------------------
-- Reconcile the element by resolving the references to other elements in the model.
-- ------------------------------
overriding
procedure Reconcile (Node : in out Tagged_Value_Element;
Model : in UML_Model) is
Item : constant Model_Element_Access := Find (Model, Node.Model.all, Node.Ref_Id);
begin
Model_Element (Node).Reconcile (Model);
if Item /= null then
Node.Set_Name (Item.Name);
if not (Item.all in Tag_Definition_Element'Class) then
Log.Error ("Element {0} is not a tag definition. Tag is {1}, reference is {2}",
To_String (Item.Name),
Ada.Tags.Expanded_Name (Item'Tag),
To_String (Node.Ref_Id));
else
Node.Tag_Def := Tag_Definition_Element'Class (Item.all)'Access;
end if;
end if;
end Reconcile;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Tag_Definition_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_TAG_DEFINITION;
end Get_Type;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Class_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_CLASS;
end Get_Type;
-- ------------------------------
-- Reconcile the element by resolving the references to other elements in the model.
-- ------------------------------
overriding
procedure Reconcile (Node : in out Class_Element;
Model : in UML_Model) is
begin
if Node.Parent_Class /= null then
Node.Parent_Class.Reconcile (Model);
end if;
Data_Type_Element (Node).Reconcile (Model);
end Reconcile;
-- ------------------------------
-- Get the element type.
-- ------------------------------
overriding
function Get_Type (Node : in Package_Element) return Element_Type is
pragma Unreferenced (Node);
begin
return XMI_PACKAGE;
end Get_Type;
end Gen.Model.XMI;