1-- C390A011.AM
2--
3--                             Grant of Unlimited Rights
4--
5--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7--     unlimited rights in the software and documentation contained herein.
8--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9--     this public release, the Government intends to confer upon all
10--     recipients unlimited rights  equal to those held by the Government.
11--     These rights include rights to use, duplicate, release or disclose the
12--     released technical data and computer software in whole or in part, in
13--     any manner and for any purpose whatsoever, and to have or permit others
14--     to do so.
15--
16--                                    DISCLAIMER
17--
18--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23--     PARTICULAR PURPOSE OF SAID MATERIAL.
24--*
25--
26-- OBJECTIVE:
27--      Check that a nonprivate tagged type declared in a package specification
28--      may be extended with a record extension in a different package
29--      specification, and that this record extension may in turn be extended
30--      by a record extension.
31--
32--      Check that each derivative inherits the user-defined primitive
33--      subprograms of its parent (including those that its parent inherited),
34--      that it may override these inherited primitive subprograms, and that it
35--      may also declare its own primitive subprograms.
36--
37--      Check that predefined equality operators are defined for the tagged
38--      type and its derivatives.
39--
40--      Check that type conversion is defined from a type extension to its
41--      parent, and that this parent itself may be a type extension.
42--
43-- TEST DESCRIPTION:
44--      Declare a root tagged type and two associated primitive subprograms
45--      in a package specification (foundation code).
46--
47--      Extend the root type with a record extension in a different package
48--      specification. Declare a new primitive subprogram for the extension,
49--      and override one of the two inherited subprograms. Within the
50--      overriding subprogram, utilize type conversion to call the parent's
51--      implementation of the same subprogram. Also within the overriding
52--      subprogram, call the new primitive subprogram and each inherited
53--      subprogram.
54--
55--      Extend the extension with a record extension in the same package
56--      specification. Declare a new primitive subprogram for this second
57--      extension, and override one of the three inherited subprograms.
58--      Within the overriding subprogram, utilize type conversion to call the
59--      parent's implementation of the same subprogram. Also within the
60--      overriding subprogram, call the new primitive subprogram and each
61--      inherited subprogram.
62--
63--      In the main program, declare objects of the root tagged type
64--      and the two type extensions. For each object, call the overriding
65--      subprogram, and verify the correctness of the components by using
66--      aggregates and equality operators, or by checking the components
67--      directly.
68--
69-- TEST FILES:
70--      This test consists of the following files:
71--
72--         F390A00.A
73--         C390A010.A
74--      => C390A011.AM
75--
76--
77-- CHANGE HISTORY:
78--      06 Dec 94   SAIC    ACVC 2.0
79--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
80--
81--!
82
83with Report;
84
85with F390A00;   -- Basic alert abstraction.
86with C390A010;  -- Extended alert abstraction.
87
88use  F390A00;   -- Primitive operations of Alert_Type directly visible.
89
90with Ada.Calendar;
91
92procedure C390A011 is
93   use type Ada.Calendar.Time;  -- Equality/inequality ops directly visible.
94begin
95
96   Report.Test ("C390A01", "Primitive operation inheritance by type " &
97                "extensions: all extensions declared in same package, " &
98                "but a different package from that of root type");
99
100
101   ALERT_SUBTEST: -------------------------------------------------------------
102
103      declare
104         Alarm : F390A00.Alert_Type;  -- Root tagged type.
105      begin
106
107         -- Check "/=" operator availability. Aggregate with positional
108         -- associations:
109         if Alarm /= (Default_Time, Null_Device) then
110            Report.Failed ("Wrong initial values for Alert_Type");
111         end if;
112
113         Handle (Alarm);
114
115         -- Check "=" operator availability. Aggregate with named
116         -- associations:
117         if not (Alarm = (Arrival_Time => Alert_Time,
118                          Display_On   => Null_Device))
119         then
120            Report.Failed ("Wrong values for Alert_Type after Handle");
121         end if;
122
123      end Alert_Subtest;
124
125
126   -- Check intermediate display counts:
127
128   if F390A00.Display_Count_For (Null_Device) /= 1 or
129      F390A00.Display_Count_For (Teletype)    /= 0 or
130      F390A00.Display_Count_For (Console)     /= 0 or
131      F390A00.Display_Count_For (Big_Screen)  /= 0
132   then
133      Report.Failed ("Wrong display counts after Alert_Type");
134   end if;
135
136
137   LOW_ALERT_SUBTEST: ---------------------------------------------------------
138
139      declare
140         Low_Alarm : C390A010.Low_Alert_Type;  -- Extension of tagged type.
141         use C390A010; -- Primitive operations of extension directly visible.
142      begin
143
144         -- Check "=" operator availability. Aggregate with positional
145         -- associations:
146         if not (Low_Alarm = (Default_Time, Null_Device, 0)) then
147            Report.Failed ("Wrong initial values for Low_Alert_Type");
148         end if;
149
150         Handle (Low_Alarm);
151
152         -- Check component availability:
153         if Low_Alarm.Arrival_Time /= Alert_Time or
154            Low_Alarm.Display_On   /= Teletype   or
155            Low_Alarm.Level        /= 1
156         then
157            Report.Failed ("Wrong values for Low_Alert_Type after Handle");
158         end if;
159
160      end Low_Alert_Subtest;
161
162
163   -- Check intermediate display counts:
164
165   if F390A00.Display_Count_For /= (Null_Device => 2,
166                                    Teletype    => 1,
167                                    Console     => 0,
168                                    Big_Screen  => 0)
169   then
170      Report.Failed ("Wrong display counts after Low_Alert_Type");
171   end if;
172
173
174   MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
175
176      declare
177         Medium_Alarm : C390A010.Medium_Alert_Type; -- Extension of extension.
178         use C390A010; -- Primitive operations of extension directly visible.
179      begin
180
181         -- Check component availability:
182         if Medium_Alarm.Level          /= 0            or
183            Medium_Alarm.Arrival_Time   /= Default_Time or
184            Medium_Alarm.Action_Officer /= Nobody       or
185            Medium_Alarm.Display_On     /= Null_Device
186         then
187            Report.Failed ("Wrong initial values for Medium_Alert_Type");
188         end if;
189
190         Handle (Medium_Alarm);
191
192         -- Check "/=" operator availability. Aggregate with named
193         -- associations:
194         if Medium_Alarm /= (Arrival_Time   => Alert_Time,
195                             Display_On     => Console,
196                             Level          => 2,
197                             Action_Officer => Duty_Officer)
198         then
199            Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
200         end if;
201
202      end Medium_Alert_Subtest;
203
204
205   -- Check final display counts:
206
207   if F390A00.Display_Count_For /= (Null_Device => 3,
208                                    Teletype    => 2,
209                                    Console     => 1,
210                                    Big_Screen  => 0)
211   then
212      Report.Failed ("Wrong display counts after Medium_Alert_Type");
213   end if;
214
215
216   Report.Result;
217
218end C390A011;
219