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: 3426 $ $Date: 2012-11-13 20:51:20 +0400 (Tue, 13 Nov 2012) $ 43------------------------------------------------------------------------------ 44with AMF.Elements; 45with AMF.Internals.Element_Collections; 46with AMF.Internals.Extents; 47with AMF.Internals.Helpers; 48with AMF.Internals.Tables.UML_Attributes; 49with AMF.Internals.Tables.UML_Element_Table; 50with AMF.Internals.Tables.UML_Reflection; 51 52package body AMF.Internals.UML_Elements is 53 54 ------------------------ 55 -- All_Owned_Elements -- 56 ------------------------ 57 58 overriding function All_Owned_Elements 59 (Self : not null access constant UML_Element_Proxy) 60 return AMF.UML.Elements.Collections.Set_Of_UML_Element is 61 begin 62 -- Generated stub: replace with real body! 63 pragma Compile_Time_Warning (Standard.True, "All_Owned_Elements unimplemented"); 64 raise Program_Error with "Unimplemented procedure UML_Variable_Proxy.All_Owned_Elements"; 65 return All_Owned_Elements (Self); 66 end All_Owned_Elements; 67 68 --------------- 69 -- Container -- 70 --------------- 71 72 overriding function Container 73 (Self : not null access constant UML_Element_Proxy) 74 return AMF.Elements.Element_Access is 75 begin 76 -- For UML elements Element::owner is container of the element. 77 78 return AMF.Elements.Element_Access (Self.Get_Owner); 79 end Container; 80 81 ------------ 82 -- Extent -- 83 ------------ 84 85 overriding function Extent 86 (Self : not null access constant UML_Element_Base) 87 return AMF.Extents.Extent_Access is 88 begin 89 return 90 AMF.Internals.Extents.Proxy 91 (AMF.Internals.Tables.UML_Element_Table.Table (Self.Element).Extent); 92 end Extent; 93 94 --------- 95 -- Get -- 96 --------- 97 98 overriding function Get 99 (Self : not null access constant UML_Element_Base; 100 Property : not null AMF.CMOF.Properties.CMOF_Property_Access) 101 return League.Holders.Holder is 102 begin 103 return 104 AMF.Internals.Tables.UML_Reflection.Get 105 (Self.Element, 106 AMF.Internals.Helpers.To_Element 107 (AMF.Elements.Element_Access (Property))); 108 end Get; 109 110 -------------------- 111 -- Get_Meta_Class -- 112 -------------------- 113 114 overriding function Get_Meta_Class 115 (Self : not null access constant UML_Element_Base) 116 return AMF.CMOF.Classes.CMOF_Class_Access is 117 begin 118 return 119 AMF.CMOF.Classes.CMOF_Class_Access 120 (AMF.Internals.Helpers.To_Element 121 (AMF.Internals.Tables.UML_Reflection.Get_Meta_Class (Self.Element))); 122 end Get_Meta_Class; 123 124 ----------------------- 125 -- Get_Owned_Comment -- 126 ----------------------- 127 128 overriding function Get_Owned_Comment 129 (Self : not null access constant UML_Element_Proxy) 130 return AMF.UML.Comments.Collections.Set_Of_UML_Comment is 131 begin 132 return 133 AMF.UML.Comments.Collections.Wrap 134 (AMF.Internals.Element_Collections.Wrap 135 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Owned_Comment 136 (Self.Element))); 137 end Get_Owned_Comment; 138 139 ----------------------- 140 -- Get_Owned_Element -- 141 ----------------------- 142 143 overriding function Get_Owned_Element 144 (Self : not null access constant UML_Element_Proxy) 145 return AMF.UML.Elements.Collections.Set_Of_UML_Element is 146 begin 147 return 148 AMF.UML.Elements.Collections.Wrap 149 (AMF.Internals.Element_Collections.Wrap 150 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Owned_Element 151 (Self.Element))); 152 end Get_Owned_Element; 153 154 --------------- 155 -- Get_Owner -- 156 --------------- 157 158 overriding function Get_Owner 159 (Self : not null access constant UML_Element_Proxy) 160 return AMF.UML.Elements.UML_Element_Access is 161 begin 162 return 163 AMF.UML.Elements.UML_Element_Access 164 (AMF.Internals.Helpers.To_Element 165 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Owner 166 (Self.Element))); 167 end Get_Owner; 168 169 ------------------- 170 -- Must_Be_Owned -- 171 ------------------- 172 173 overriding function Must_Be_Owned 174 (Self : not null access constant UML_Element_Proxy) return Boolean 175 is 176 pragma Unreferenced (Self); 177 178 -- [UML241] 7.3.14 Element (from Kernel) 179 -- 180 -- The query mustBeOwned() indicates whether elements of this type must 181 -- have an owner. Subclasses of Element that do not require an owner 182 -- must override this operation. 183 -- 184 -- Element::mustBeOwned() : Boolean; 185 -- mustBeOwned = true 186 187 begin 188 return True; 189 end Must_Be_Owned; 190 191 --------- 192 -- Set -- 193 --------- 194 195 overriding procedure Set 196 (Self : not null access UML_Element_Base; 197 Property : not null AMF.CMOF.Properties.CMOF_Property_Access; 198 Value : League.Holders.Holder) is 199 begin 200 AMF.Internals.Tables.UML_Reflection.Set 201 (Self.Element, 202 AMF.Internals.Helpers.To_Element 203 (AMF.Elements.Element_Access (Property)), 204 Value); 205 end Set; 206 207end AMF.Internals.UML_Elements; 208