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: 2982 $ $Date: 2012-05-15 21:26:04 +0400 (Tue, 15 May 2012) $ 43------------------------------------------------------------------------------ 44with AMF.Elements; 45with AMF.Factories.UML_Factories; 46with AMF.Internals.Helpers; 47with AMF.Internals.Tables.UML_Attributes; 48with AMF.Stores; 49with AMF.UML.Literal_Integers; 50with AMF.UML.Literal_Unlimited_Naturals; 51 52package body AMF.Internals.UML_Multiplicity_Elements is 53 54 use type AMF.UML.Value_Specifications.UML_Value_Specification_Access; 55 56 UML_URI : constant League.Strings.Universal_String 57 := League.Strings.To_Universal_String 58 ("http://www.omg.org/spec/UML/20100901"); 59 60 -------------------- 61 -- Get_Is_Ordered -- 62 -------------------- 63 64 overriding function Get_Is_Ordered 65 (Self : not null access constant UML_Multiplicity_Element_Proxy) 66 return Boolean is 67 begin 68 return 69 AMF.Internals.Tables.UML_Attributes.Internal_Get_Is_Ordered 70 (Self.Element); 71 end Get_Is_Ordered; 72 73 ------------------- 74 -- Get_Is_Unique -- 75 ------------------- 76 77 overriding function Get_Is_Unique 78 (Self : not null access constant UML_Multiplicity_Element_Proxy) 79 return Boolean is 80 begin 81 return 82 AMF.Internals.Tables.UML_Attributes.Internal_Get_Is_Unique 83 (Self.Element); 84 end Get_Is_Unique; 85 86 --------------- 87 -- Get_Lower -- 88 --------------- 89 90 overriding function Get_Lower 91 (Self : not null access constant UML_Multiplicity_Element_Proxy) 92 return AMF.Optional_Integer is 93 begin 94 -- [UML2.4.1] 7.3.33 MultiplicityElement (from Kernel) 95 -- 96 -- [5] The derived lower attribute must equal the lowerBound. 97 -- 98 -- lower = lowerBound() 99 100 return UML_Multiplicity_Element_Proxy'Class (Self.all).Lower_Bound; 101 end Get_Lower; 102 103 --------------------- 104 -- Get_Lower_Value -- 105 --------------------- 106 107 overriding function Get_Lower_Value 108 (Self : not null access constant UML_Multiplicity_Element_Proxy) 109 return AMF.UML.Value_Specifications.UML_Value_Specification_Access is 110 begin 111 return 112 AMF.UML.Value_Specifications.UML_Value_Specification_Access 113 (AMF.Internals.Helpers.To_Element 114 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Lower_Value 115 (Self.Element))); 116 end Get_Lower_Value; 117 118 --------------- 119 -- Get_Upper -- 120 --------------- 121 122 overriding function Get_Upper 123 (Self : not null access constant UML_Multiplicity_Element_Proxy) 124 return AMF.Optional_Unlimited_Natural is 125 begin 126 -- [UML2.4.1] 7.3.33 MultiplicityElement (from Kernel) 127 -- 128 -- [6] The derived upper attribute must equal the upperBound. 129 -- 130 -- upper = upperBound() 131 132 return UML_Multiplicity_Element_Proxy'Class (Self.all).Upper_Bound; 133 end Get_Upper; 134 135 --------------------- 136 -- Get_Upper_Value -- 137 --------------------- 138 139 overriding function Get_Upper_Value 140 (Self : not null access constant UML_Multiplicity_Element_Proxy) 141 return AMF.UML.Value_Specifications.UML_Value_Specification_Access is 142 begin 143 return 144 AMF.UML.Value_Specifications.UML_Value_Specification_Access 145 (AMF.Internals.Helpers.To_Element 146 (AMF.Internals.Tables.UML_Attributes.Internal_Get_Upper_Value 147 (Self.Element))); 148 end Get_Upper_Value; 149 150 -------------------- 151 -- Is_Multivalued -- 152 -------------------- 153 154 overriding function Is_Multivalued 155 (Self : not null access constant UML_Multiplicity_Element_Proxy) 156 return Boolean 157 is 158 -- 7.3.33 MultiplicityElement (from Kernel) 159 -- 160 -- [1] The query isMultivalued() checks whether this multiplicity has an 161 -- upper bound greater than one. 162 -- 163 -- MultiplicityElement::isMultivalued() : Boolean; 164 -- pre: upperBound()->notEmpty() 165 -- isMultivalued = (upperBound() > 1) 166 167 Upper_Bound : constant Optional_Unlimited_Natural 168 := UML_Multiplicity_Element_Proxy'Class (Self.all).Upper_Bound; 169 170 begin 171 if Upper_Bound.Is_Empty then 172 raise Constraint_Error; 173 end if; 174 175 return Upper_Bound.Value > 1; 176 end Is_Multivalued; 177 178 ----------------- 179 -- Lower_Bound -- 180 ----------------- 181 182 overriding function Lower_Bound 183 (Self : not null access constant UML_Multiplicity_Element_Proxy) 184 return AMF.Optional_Integer 185 is 186 -- 7.3.33 MultiplicityElement (from Kernel) 187 -- 188 -- [4] The query lowerBound() returns the lower bound of the 189 -- multiplicity as an integer. 190 -- 191 -- MultiplicityElement::lowerBound() : [Integer]; 192 -- lowerBound = 193 -- if lowerValue->isEmpty() then 1 194 -- else lowerValue.integerValue() endif 195 196 Lower_Value : constant 197 AMF.UML.Value_Specifications.UML_Value_Specification_Access 198 := UML_Multiplicity_Element_Proxy'Class (Self.all).Get_Lower_Value; 199 200 begin 201 if Lower_Value = null then 202 return (False, 1); 203 204 else 205 return Lower_Value.Integer_Value; 206 end if; 207 end Lower_Bound; 208 209 -------------------- 210 -- Set_Is_Ordered -- 211 -------------------- 212 213 overriding procedure Set_Is_Ordered 214 (Self : not null access UML_Multiplicity_Element_Proxy; 215 To : Boolean) is 216 begin 217 AMF.Internals.Tables.UML_Attributes.Internal_Set_Is_Ordered 218 (Self.Element, To); 219 end Set_Is_Ordered; 220 221 ------------------- 222 -- Set_Is_Unique -- 223 ------------------- 224 225 overriding procedure Set_Is_Unique 226 (Self : not null access UML_Multiplicity_Element_Proxy; 227 To : Boolean) is 228 begin 229 AMF.Internals.Tables.UML_Attributes.Internal_Set_Is_Unique (Self.Element, To); 230 end Set_Is_Unique; 231 232 --------------- 233 -- Set_Lower -- 234 --------------- 235 236 overriding procedure Set_Lower 237 (Self : not null access UML_Multiplicity_Element_Proxy; 238 To : AMF.Optional_Integer) 239 is 240 Lower : AMF.UML.Value_Specifications.UML_Value_Specification_Access 241 := UML_Multiplicity_Element_Proxy'Class (Self.all).Get_Lower_Value; 242 Factory : AMF.Factories.UML_Factories.UML_Factory_Access; 243 244 begin 245 if To.Is_Empty then 246 if Lower /= null then 247 -- XXX Remove of the element is not implemented. 248 249 raise Program_Error; 250 end if; 251 252 else 253 if Lower = null then 254 Factory := 255 AMF.Factories.UML_Factories.UML_Factory_Access 256 (AMF.Stores.Store'Class (Self.Extent.all).Get_Factory (UML_URI)); 257 Lower := 258 AMF.UML.Value_Specifications.UML_Value_Specification_Access 259 (Factory.Create_Literal_Integer); 260 UML_Multiplicity_Element_Proxy'Class 261 (Self.all).Set_Lower_Value (Lower); 262 end if; 263 264 AMF.UML.Literal_Integers.UML_Literal_Integer'Class 265 (Lower.all).Set_Value (To.Value); 266 end if; 267 end Set_Lower; 268 269 --------------------- 270 -- Set_Lower_Value -- 271 --------------------- 272 273 overriding procedure Set_Lower_Value 274 (Self : not null access UML_Multiplicity_Element_Proxy; 275 To : AMF.UML.Value_Specifications.UML_Value_Specification_Access) is 276 begin 277 AMF.Internals.Tables.UML_Attributes.Internal_Set_Lower_Value 278 (Self.Element, 279 AMF.Internals.Helpers.To_Element 280 (AMF.Elements.Element_Access (To))); 281 end Set_Lower_Value; 282 283 --------------- 284 -- Set_Upper -- 285 --------------- 286 287 overriding procedure Set_Upper 288 (Self : not null access UML_Multiplicity_Element_Proxy; 289 To : AMF.Optional_Unlimited_Natural) 290 is 291 Upper : AMF.UML.Value_Specifications.UML_Value_Specification_Access 292 := UML_Multiplicity_Element_Proxy'Class (Self.all).Get_Upper_Value; 293 Factory : AMF.Factories.UML_Factories.UML_Factory_Access; 294 295 begin 296 if To.Is_Empty then 297 if Upper /= null then 298 -- XXX Remove of the element is not implemented. 299 300 raise Program_Error; 301 end if; 302 303 else 304 if Upper = null then 305 Factory := 306 AMF.Factories.UML_Factories.UML_Factory_Access 307 (AMF.Stores.Store'Class (Self.Extent.all).Get_Factory (UML_URI)); 308 Upper := 309 AMF.UML.Value_Specifications.UML_Value_Specification_Access 310 (Factory.Create_Literal_Unlimited_Natural); 311 UML_Multiplicity_Element_Proxy'Class 312 (Self.all).Set_Upper_Value (Upper); 313 end if; 314 315 AMF.UML.Literal_Unlimited_Naturals.UML_Literal_Unlimited_Natural'Class 316 (Upper.all).Set_Value (To.Value); 317 end if; 318 end Set_Upper; 319 320 --------------------- 321 -- Set_Upper_Value -- 322 --------------------- 323 324 overriding procedure Set_Upper_Value 325 (Self : not null access UML_Multiplicity_Element_Proxy; 326 To : AMF.UML.Value_Specifications.UML_Value_Specification_Access) is 327 begin 328 AMF.Internals.Tables.UML_Attributes.Internal_Set_Upper_Value 329 (Self.Element, 330 AMF.Internals.Helpers.To_Element 331 (AMF.Elements.Element_Access (To))); 332 end Set_Upper_Value; 333 334 ----------------- 335 -- Upper_Bound -- 336 ----------------- 337 338 overriding function Upper_Bound 339 (Self : not null access constant UML_Multiplicity_Element_Proxy) 340 return AMF.Optional_Unlimited_Natural 341 is 342 -- 7.3.33 MultiplicityElement (from Kernel) 343 -- 344 -- [5] The query upperBound() returns the upper bound of the 345 -- multiplicity for a bounded multiplicity as an unlimited natural. 346 -- 347 -- MultiplicityElement::upperBound() : [UnlimitedNatural]; 348 -- upperBound = 349 -- if upperValue->isEmpty() then 1 350 -- else upperValue.unlimitedValue() endif 351 352 Upper_Value : constant 353 AMF.UML.Value_Specifications.UML_Value_Specification_Access 354 := UML_Multiplicity_Element_Proxy'Class (Self.all).Get_Upper_Value; 355 356 begin 357 if Upper_Value = null then 358 return (False, (False, 1)); 359 360 else 361 return Upper_Value.Unlimited_Value; 362 end if; 363 end Upper_Bound; 364 365end AMF.Internals.UML_Multiplicity_Elements; 366