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: 2973 $ $Date: 2012-05-13 10:51:25 +0400 (Sun, 13 May 2012) $ 43------------------------------------------------------------------------------ 44with AMF.Internals.Element_Collections; 45with AMF.Internals.Helpers; 46with AMF.Internals.Tables.CMOF_Attributes; 47with AMF.Visitors.CMOF_Iterators; 48with AMF.Visitors.CMOF_Visitors; 49 50package body AMF.Internals.CMOF_Constraints is 51 52 use AMF.Internals.Tables.CMOF_Attributes; 53 54 ------------------- 55 -- Enter_Element -- 56 ------------------- 57 58 overriding procedure Enter_Element 59 (Self : not null access constant CMOF_Constraint_Proxy; 60 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 61 Control : in out AMF.Visitors.Traverse_Control) is 62 begin 63 if Visitor in AMF.Visitors.CMOF_Visitors.CMOF_Visitor'Class then 64 AMF.Visitors.CMOF_Visitors.CMOF_Visitor'Class 65 (Visitor).Enter_Constraint 66 (AMF.CMOF.Constraints.CMOF_Constraint_Access (Self), 67 Control); 68 end if; 69 end Enter_Element; 70 71 ----------------------------- 72 -- Get_Constrained_Element -- 73 ----------------------------- 74 75 overriding function Get_Constrained_Element 76 (Self : not null access constant CMOF_Constraint_Proxy) 77 return AMF.CMOF.Elements.Collections.Ordered_Set_Of_CMOF_Element is 78 begin 79 return 80 AMF.CMOF.Elements.Collections.Wrap 81 (AMF.Internals.Element_Collections.Wrap 82 (Internal_Get_Constrained_Element (Self.Element))); 83 end Get_Constrained_Element; 84 85 ----------------- 86 -- Get_Context -- 87 ----------------- 88 89 overriding function Get_Context 90 (Self : not null access constant CMOF_Constraint_Proxy) 91 return AMF.CMOF.Namespaces.CMOF_Namespace_Access is 92 begin 93 return 94 AMF.CMOF.Namespaces.CMOF_Namespace_Access 95 (AMF.Internals.Helpers.To_Element (Internal_Get_Context (Self.Element))); 96 end Get_Context; 97 98 ----------------------- 99 -- Get_Specification -- 100 ----------------------- 101 102 overriding function Get_Specification 103 (Self : not null access constant CMOF_Constraint_Proxy) 104 return AMF.CMOF.Value_Specifications.CMOF_Value_Specification_Access is 105 begin 106 return 107 AMF.CMOF.Value_Specifications.CMOF_Value_Specification_Access 108 (AMF.Internals.Helpers.To_Element 109 (Internal_Get_Specification (Self.Element))); 110 end Get_Specification; 111 112 ------------------- 113 -- Leave_Element -- 114 ------------------- 115 116 overriding procedure Leave_Element 117 (Self : not null access constant CMOF_Constraint_Proxy; 118 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 119 Control : in out AMF.Visitors.Traverse_Control) is 120 begin 121 if Visitor in AMF.Visitors.CMOF_Visitors.CMOF_Visitor'Class then 122 AMF.Visitors.CMOF_Visitors.CMOF_Visitor'Class 123 (Visitor).Leave_Constraint 124 (AMF.CMOF.Constraints.CMOF_Constraint_Access (Self), 125 Control); 126 end if; 127 end Leave_Element; 128 129 ------------------- 130 -- Visit_Element -- 131 ------------------- 132 133 overriding procedure Visit_Element 134 (Self : not null access constant CMOF_Constraint_Proxy; 135 Iterator : in out AMF.Visitors.Abstract_Iterator'Class; 136 Visitor : in out AMF.Visitors.Abstract_Visitor'Class; 137 Control : in out AMF.Visitors.Traverse_Control) is 138 begin 139 if Iterator in AMF.Visitors.CMOF_Iterators.CMOF_Iterator'Class then 140 AMF.Visitors.CMOF_Iterators.CMOF_Iterator'Class 141 (Iterator).Visit_Constraint 142 (Visitor, 143 AMF.CMOF.Constraints.CMOF_Constraint_Access (Self), 144 Control); 145 end if; 146 end Visit_Element; 147 148 ------------------------ 149 -- All_Owned_Elements -- 150 ------------------------ 151 152 overriding function All_Owned_Elements 153 (Self : not null access constant CMOF_Constraint_Proxy) 154 return AMF.CMOF.Elements.Collections.Set_Of_CMOF_Element 155 is 156 begin 157 -- Generated stub: replace with real body! 158 pragma Compile_Time_Warning (Standard.True, "All_Owned_Elements unimplemented"); 159 raise Program_Error; 160 return All_Owned_Elements (Self); 161 end All_Owned_Elements; 162 163 ------------------------ 164 -- Get_Qualified_Name -- 165 ------------------------ 166 167 overriding function Get_Qualified_Name 168 (Self : not null access constant CMOF_Constraint_Proxy) 169 return Optional_String 170 is 171 begin 172 -- Generated stub: replace with real body! 173 pragma Compile_Time_Warning (Standard.True, "Get_Qualified_Name unimplemented"); 174 raise Program_Error; 175 return Get_Qualified_Name (Self); 176 end Get_Qualified_Name; 177 178 ----------------------------- 179 -- Is_Distinguishable_From -- 180 ----------------------------- 181 182 overriding function Is_Distinguishable_From 183 (Self : not null access constant CMOF_Constraint_Proxy; 184 N : AMF.CMOF.Named_Elements.CMOF_Named_Element_Access; 185 Ns : AMF.CMOF.Namespaces.CMOF_Namespace_Access) 186 return Boolean 187 is 188 begin 189 -- Generated stub: replace with real body! 190 pragma Compile_Time_Warning (Standard.True, "Is_Distinguishable_From unimplemented"); 191 raise Program_Error; 192 return Is_Distinguishable_From (Self, N, Ns); 193 end Is_Distinguishable_From; 194 195 ----------------------- 196 -- Set_Specification -- 197 ----------------------- 198 199 overriding procedure Set_Specification 200 (Self : not null access CMOF_Constraint_Proxy; 201 To : AMF.CMOF.Value_Specifications.CMOF_Value_Specification_Access) 202 is 203 begin 204 -- Generated stub: replace with real body! 205 pragma Compile_Time_Warning (Standard.True, "Set_Specification unimplemented"); 206 raise Program_Error; 207 end Set_Specification; 208 209 ----------------- 210 -- Set_Context -- 211 ----------------- 212 213 overriding procedure Set_Context 214 (Self : not null access CMOF_Constraint_Proxy; 215 To : AMF.CMOF.Namespaces.CMOF_Namespace_Access) 216 is 217 begin 218 -- Generated stub: replace with real body! 219 pragma Compile_Time_Warning (Standard.True, "Set_Context unimplemented"); 220 raise Program_Error; 221 end Set_Context; 222 223end AMF.Internals.CMOF_Constraints; 224