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