1------------------------------------------------------------------------------ 2-- -- 3-- Matreshka Project -- 4-- -- 5-- Ada Modeling Framework -- 6-- -- 7-- Runtime Library Component -- 8-- -- 9------------------------------------------------------------------------------ 10-- -- 11-- Copyright © 2011-2012, Vadim Godunko <vgodunko@gmail.com> -- 12-- All rights reserved. -- 13-- -- 14-- Redistribution and use in source and binary forms, with or without -- 15-- modification, are permitted provided that the following conditions -- 16-- are met: -- 17-- -- 18-- * Redistributions of source code must retain the above copyright -- 19-- notice, this list of conditions and the following disclaimer. -- 20-- -- 21-- * Redistributions in binary form must reproduce the above copyright -- 22-- notice, this list of conditions and the following disclaimer in the -- 23-- documentation and/or other materials provided with the distribution. -- 24-- -- 25-- * Neither the name of the Vadim Godunko, IE nor the names of its -- 26-- contributors may be used to endorse or promote products derived from -- 27-- this software without specific prior written permission. -- 28-- -- 29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -- 35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- 36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- 37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- 38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- 39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 40-- -- 41------------------------------------------------------------------------------ 42-- $Revision: 2937 $ $Date: 2012-05-01 21:07:27 +0400 (Tue, 01 May 2012) $ 43------------------------------------------------------------------------------ 44with League.Strings.Internals; 45with Matreshka.Internals.Strings; 46 47with AMF.Internals.Tables.UML_Attributes; 48 49package body AMF.Internals.UML_Named_Elements is 50 51 -------------------- 52 -- All_Namespaces -- 53 -------------------- 54 55 overriding function All_Namespaces 56 (Self : not null access constant UML_Named_Element_Proxy) 57 return AMF.UML.Namespaces.Collections.Ordered_Set_Of_UML_Namespace 58 is 59 -- [UML 2.4.1] 7.3.34 NamedElement (from Kernel, Dependencies) 60 -- 61 -- [1] The query allNamespaces() gives the sequence of namespaces in 62 -- which the NamedElement is nested, working outwards. 63 -- 64 -- NamedElement::allNamespaces(): Sequence(Namespace); 65 -- 66 -- allNamespaces = 67 -- if self.namespace->isEmpty() 68 -- then Sequence{} 69 -- else self.namespace.allNamespaces()->prepend(self.namespace) 70 -- endif 71 72 use type AMF.UML.Namespaces.UML_Namespace_Access; 73 74 The_Namespace : AMF.UML.Namespaces.UML_Namespace_Access 75 := UML_Named_Element_Proxy'Class (Self.all).Get_Namespace; 76 77 begin 78 return Result : 79 AMF.UML.Namespaces.Collections.Ordered_Set_Of_UML_Namespace 80 do 81 while The_Namespace /= null loop 82 Result.Add (The_Namespace); 83 The_Namespace := The_Namespace.Get_Namespace; 84 end loop; 85 end return; 86 end All_Namespaces; 87 88 -------------- 89 -- Get_Name -- 90 -------------- 91 92 overriding function Get_Name 93 (Self : not null access constant UML_Named_Element_Proxy) 94 return AMF.Optional_String is 95 begin 96 declare 97 use type Matreshka.Internals.Strings.Shared_String_Access; 98 99 Aux : constant Matreshka.Internals.Strings.Shared_String_Access 100 := AMF.Internals.Tables.UML_Attributes.Internal_Get_Name 101 (Self.Element); 102 103 begin 104 if Aux = null then 105 return (Is_Empty => True); 106 107 else 108 return (False, League.Strings.Internals.Create (Aux)); 109 end if; 110 end; 111 end Get_Name; 112 113 -------------------- 114 -- Get_Visibility -- 115 -------------------- 116 117 overriding function Get_Visibility 118 (Self : not null access constant UML_Named_Element_Proxy) 119 return AMF.UML.Optional_UML_Visibility_Kind is 120 begin 121 return 122 AMF.Internals.Tables.UML_Attributes.Internal_Get_Visibility 123 (Self.Element); 124 end Get_Visibility; 125 126 -------------------- 127 -- Qualified_Name -- 128 -------------------- 129 130 overriding function Qualified_Name 131 (Self : not null access constant UML_Named_Element_Proxy) 132 return League.Strings.Universal_String 133 is 134 -- [UML 2.4.1] 7.3.34 NamedElement (from Kernel, Dependencies) 135 -- 136 -- Constraints 137 -- [1] If there is no name, or one of the containing namespaces has no 138 -- name, there is no qualified name. 139 -- 140 -- (self.name->isEmpty() 141 -- or self.allNamespaces()->select 142 -- (ns | ns.name->isEmpty())->notEmpty()) 143 -- implies self.qualifiedName->isEmpty() 144 -- 145 -- [2] When there is a name, and all of the containing namespaces have a 146 -- name, the qualified name is constructed from the names of the 147 -- containing namespaces. 148 -- 149 -- (self.name->notEmpty() 150 -- and self.allNamespaces()->select 151 -- (ns | ns.name->isEmpty())->isEmpty()) 152 -- implies 153 -- self.qualifiedName = 154 -- self.allNamespaces()->iterate 155 -- ( ns : Namespace; result: String = self.name | 156 -- ns.name->union(self.separator())->union(result)) 157 158 Namespaces : constant 159 AMF.UML.Namespaces.Collections.Ordered_Set_Of_UML_Namespace 160 := UML_Named_Element_Proxy'Class (Self.all).All_Namespaces; 161 Separator : constant League.Strings.Universal_String 162 := UML_Named_Element_Proxy'Class (Self.all).Separator; 163 Name : AMF.Optional_String 164 := UML_Named_Element_Proxy'Class (Self.all).Get_Name; 165 166 begin 167 if Name.Is_Empty then 168 return League.Strings.Empty_Universal_String; 169 end if; 170 171 return Result : League.Strings.Universal_String := Name.Value do 172 for J in 1 .. Namespaces.Length loop 173 Name := Namespaces.Element (J).Get_Name; 174 175 if Name.Is_Empty then 176 -- When name of one of owning namespaces is empty the qualified 177 -- name is empty also. Clear result and exit from namespaces 178 -- loop. 179 180 Result.Clear; 181 182 exit; 183 184 else 185 -- Otherwise prepend separator and name of the namespace. 186 187 Result.Prepend (Separator); 188 Result.Prepend (Name.Value); 189 end if; 190 end loop; 191 end return; 192 end Qualified_Name; 193 194 --------------- 195 -- Separator -- 196 --------------- 197 198 overriding function Separator 199 (Self : not null access constant UML_Named_Element_Proxy) 200 return League.Strings.Universal_String 201 is 202 pragma Unreferenced (Self); 203 204 -- [UML241] 7.3.34 NamedElement (from Kernel, Dependencies) 205 -- 206 -- The query separator() gives the string that is used to separate names 207 -- when constructing a qualified name. 208 -- 209 -- NamedElement::separator(): String; 210 -- separator = ‘::’ 211 212 begin 213 return League.Strings.To_Universal_String ("::"); 214 end Separator; 215 216 -------------- 217 -- Set_Name -- 218 -------------- 219 220 overriding procedure Set_Name 221 (Self : not null access UML_Named_Element_Proxy; 222 To : AMF.Optional_String) is 223 begin 224 if To.Is_Empty then 225 AMF.Internals.Tables.UML_Attributes.Internal_Set_Name 226 (Self.Element, null); 227 228 else 229 AMF.Internals.Tables.UML_Attributes.Internal_Set_Name 230 (Self.Element, League.Strings.Internals.Internal (To.Value)); 231 end if; 232 end Set_Name; 233 234 -------------------- 235 -- Set_Visibility -- 236 -------------------- 237 238 overriding procedure Set_Visibility 239 (Self : not null access UML_Named_Element_Proxy; 240 To : AMF.UML.Optional_UML_Visibility_Kind) is 241 begin 242 AMF.Internals.Tables.UML_Attributes.Internal_Set_Visibility 243 (Self.Element, To); 244 end Set_Visibility; 245 246end AMF.Internals.UML_Named_Elements; 247