1------------------------------------------------------------------------------
2--                                                                          --
3--                            Matreshka Project                             --
4--                                                                          --
5--                          Ada Modeling Framework                          --
6--                                                                          --
7--                        Runtime Library Component                         --
8--                                                                          --
9------------------------------------------------------------------------------
10--                                                                          --
11-- Copyright © 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: 2807 $ $Date: 2012-04-07 01:28:23 +0400 (Sat, 07 Apr 2012) $
43------------------------------------------------------------------------------
44--  This file is generated, don't edit it.
45------------------------------------------------------------------------------
46with AMF.Elements;
47with AMF.Internals.Helpers;
48with AMF.Internals.Tables.Utp_Attributes;
49with AMF.String_Collections;
50with AMF.UML.Behaviors;
51with AMF.UML.Operations;
52with AMF.Visitors.Utp_Iterators;
53with AMF.Visitors.Utp_Visitors;
54with League.Strings.Internals;
55with Matreshka.Internals.Strings;
56
57package body AMF.Internals.Utp_Test_Cases is
58
59   -----------------------
60   -- Get_Base_Behavior --
61   -----------------------
62
63   overriding function Get_Base_Behavior
64    (Self : not null access constant Utp_Test_Case_Proxy)
65       return AMF.UML.Behaviors.UML_Behavior_Access is
66   begin
67      return
68        AMF.UML.Behaviors.UML_Behavior_Access
69         (AMF.Internals.Helpers.To_Element
70           (AMF.Internals.Tables.Utp_Attributes.Internal_Get_Base_Behavior
71             (Self.Element)));
72   end Get_Base_Behavior;
73
74   -----------------------
75   -- Set_Base_Behavior --
76   -----------------------
77
78   overriding procedure Set_Base_Behavior
79    (Self : not null access Utp_Test_Case_Proxy;
80     To   : AMF.UML.Behaviors.UML_Behavior_Access) is
81   begin
82      AMF.Internals.Tables.Utp_Attributes.Internal_Set_Base_Behavior
83       (Self.Element,
84        AMF.Internals.Helpers.To_Element
85         (AMF.Elements.Element_Access (To)));
86   end Set_Base_Behavior;
87
88   ------------------------
89   -- Get_Base_Operation --
90   ------------------------
91
92   overriding function Get_Base_Operation
93    (Self : not null access constant Utp_Test_Case_Proxy)
94       return AMF.UML.Operations.UML_Operation_Access is
95   begin
96      return
97        AMF.UML.Operations.UML_Operation_Access
98         (AMF.Internals.Helpers.To_Element
99           (AMF.Internals.Tables.Utp_Attributes.Internal_Get_Base_Operation
100             (Self.Element)));
101   end Get_Base_Operation;
102
103   ------------------------
104   -- Set_Base_Operation --
105   ------------------------
106
107   overriding procedure Set_Base_Operation
108    (Self : not null access Utp_Test_Case_Proxy;
109     To   : AMF.UML.Operations.UML_Operation_Access) is
110   begin
111      AMF.Internals.Tables.Utp_Attributes.Internal_Set_Base_Operation
112       (Self.Element,
113        AMF.Internals.Helpers.To_Element
114         (AMF.Elements.Element_Access (To)));
115   end Set_Base_Operation;
116
117   ------------------
118   -- Get_Priority --
119   ------------------
120
121   overriding function Get_Priority
122    (Self : not null access constant Utp_Test_Case_Proxy)
123       return AMF.Optional_String is
124   begin
125      declare
126         use type Matreshka.Internals.Strings.Shared_String_Access;
127
128         Aux : constant Matreshka.Internals.Strings.Shared_String_Access
129           := AMF.Internals.Tables.Utp_Attributes.Internal_Get_Priority (Self.Element);
130
131      begin
132         if Aux = null then
133            return (Is_Empty => True);
134
135         else
136            return (False, League.Strings.Internals.Create (Aux));
137         end if;
138      end;
139   end Get_Priority;
140
141   ------------------
142   -- Set_Priority --
143   ------------------
144
145   overriding procedure Set_Priority
146    (Self : not null access Utp_Test_Case_Proxy;
147     To   : AMF.Optional_String) is
148   begin
149      if To.Is_Empty then
150         AMF.Internals.Tables.Utp_Attributes.Internal_Set_Priority
151          (Self.Element, null);
152
153      else
154         AMF.Internals.Tables.Utp_Attributes.Internal_Set_Priority
155          (Self.Element,
156           League.Strings.Internals.Internal (To.Value));
157      end if;
158   end Set_Priority;
159
160   --------------------------------
161   -- Get_Compatible_SUT_Version --
162   --------------------------------
163
164   overriding function Get_Compatible_SUT_Version
165    (Self : not null access constant Utp_Test_Case_Proxy)
166       return AMF.String_Collections.Set_Of_String is
167   begin
168      raise Program_Error;
169      return X : AMF.String_Collections.Set_Of_String;
170   end Get_Compatible_SUT_Version;
171
172   --------------------------------
173   -- Get_Compatible_SUT_Variant --
174   --------------------------------
175
176   overriding function Get_Compatible_SUT_Variant
177    (Self : not null access constant Utp_Test_Case_Proxy)
178       return AMF.String_Collections.Set_Of_String is
179   begin
180      raise Program_Error;
181      return X : AMF.String_Collections.Set_Of_String;
182   end Get_Compatible_SUT_Variant;
183
184   -------------------
185   -- Enter_Element --
186   -------------------
187
188   overriding procedure Enter_Element
189    (Self    : not null access constant Utp_Test_Case_Proxy;
190     Visitor : in out AMF.Visitors.Abstract_Visitor'Class;
191     Control : in out AMF.Visitors.Traverse_Control) is
192   begin
193      if Visitor in AMF.Visitors.Utp_Visitors.Utp_Visitor'Class then
194         AMF.Visitors.Utp_Visitors.Utp_Visitor'Class
195          (Visitor).Enter_Test_Case
196            (AMF.Utp.Test_Cases.Utp_Test_Case_Access (Self),
197           Control);
198      end if;
199   end Enter_Element;
200
201   -------------------
202   -- Leave_Element --
203   -------------------
204
205   overriding procedure Leave_Element
206    (Self    : not null access constant Utp_Test_Case_Proxy;
207     Visitor : in out AMF.Visitors.Abstract_Visitor'Class;
208     Control : in out AMF.Visitors.Traverse_Control) is
209   begin
210      if Visitor in AMF.Visitors.Utp_Visitors.Utp_Visitor'Class then
211         AMF.Visitors.Utp_Visitors.Utp_Visitor'Class
212          (Visitor).Leave_Test_Case
213            (AMF.Utp.Test_Cases.Utp_Test_Case_Access (Self),
214           Control);
215      end if;
216   end Leave_Element;
217
218   -------------------
219   -- Visit_Element --
220   -------------------
221
222   overriding procedure Visit_Element
223    (Self     : not null access constant Utp_Test_Case_Proxy;
224     Iterator : in out AMF.Visitors.Abstract_Iterator'Class;
225     Visitor  : in out AMF.Visitors.Abstract_Visitor'Class;
226     Control  : in out AMF.Visitors.Traverse_Control) is
227   begin
228      if Iterator in AMF.Visitors.Utp_Iterators.Utp_Iterator'Class then
229         AMF.Visitors.Utp_Iterators.Utp_Iterator'Class
230          (Iterator).Visit_Test_Case
231            (Visitor,
232             AMF.Utp.Test_Cases.Utp_Test_Case_Access (Self),
233           Control);
234      end if;
235   end Visit_Element;
236
237end AMF.Internals.Utp_Test_Cases;
238