1-- C3900053.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 private tagged type declared in a package specification
28--      may be extended with a private extension in a different package
29--      specification, and that this private extension may in turn be extended
30--      by a private extension in a third package.
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 type conversion is defined from a type extension to its
38--      parent, and that this parent itself may be a type extension.
39--
40-- TEST DESCRIPTION:
41--      Declare a root tagged private type and two associated primitive
42--      subprograms in a package specification. Declare operations to verify
43--      the correctness of the components. Declare operations which return
44--      values of the type's private components, and which will be
45--      inherited by later derivatives.
46--
47--      Extend the root type with a private extension in a second 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. Declare operations of the private extension which
54--      override the verification operations of its parent. Declare operations
55--      of the private extension which return values of the extension's
56--      private components, and which will be inherited by later derivatives.
57--
58--      Extend the extension with a private extension in a third package
59--      specification. Declare a new primitive subprogram for this private
60--      extension, and override one of the three inherited subprograms.
61--      Within the overriding subprogram, utilize type conversion to call the
62--      parent's implementation of the same subprogram. Also within the
63--      overriding subprogram, call the new primitive subprogram and each
64--      inherited subprogram. Declare operations of the private extension
65--      which override the verification operations of its parent.
66--
67--      In the main program, declare objects of the root tagged type and
68--      the two type extensions. For each object, call the overriding
69--      subprogram, and verify the correctness of the components by calling
70--      the verification operations.
71--
72-- TEST FILES:
73--      This test consists of the following files:
74--
75--         C3900050.A
76--         C3900051.A
77--         C3900052.A
78--      => C3900053.AM
79--
80--
81-- CHANGE HISTORY:
82--      06 Dec 94   SAIC    ACVC 2.0
83--      15 May 96   SAIC    ACVC 2.1: Modified prologue.
84--
85--!
86
87with Report;
88
89with C3900050; -- Basic alert abstraction.
90with C3900051; -- Extended alert abstraction.
91with C3900052; -- Further extended alert abstraction.
92
93use  C3900050; -- Primitive operations of Alert_Type directly visible.
94
95procedure C3900053 is
96begin
97
98   Report.Test ("C390005", "Primitive operation inheritance by type " &
99                "extensions: root type is private; all extensions are " &
100                "private and declared in different packages");
101
102
103   ALERT_SUBTEST: -------------------------------------------------------------
104
105      declare
106         Alarm : C3900050.Alert_Type;     -- Root tagged private type.
107      begin
108         if not Initial_Values_Okay (Alarm) then
109            Report.Failed ("Wrong initial values for Alert_Type");
110         end if;
111
112         Handle (Alarm);
113
114         if Bad_Final_Values (Alarm) then
115            Report.Failed ("Wrong values for Alert_Type after Handle");
116         end if;
117      end Alert_Subtest;
118
119
120   -- Check intermediate display counts:
121
122   if C3900050.Display_Count_For (Null_Device) /= 1 or
123      C3900050.Display_Count_For (Teletype)    /= 0 or
124      C3900050.Display_Count_For (Console)     /= 0 or
125      C3900050.Display_Count_For (Big_Screen)  /= 0
126   then
127      Report.Failed ("Wrong display counts after Alert_Type");
128   end if;
129
130
131   LOW_ALERT_SUBTEST: ---------------------------------------------------------
132
133      declare
134         Low_Alarm : C3900051.Low_Alert_Type; -- Priv. ext. of tagged type.
135         use C3900051; -- Primitive operations of extension directly visible.
136      begin
137         if not Initial_Values_Okay (Low_Alarm) then
138            Report.Failed ("Wrong initial values for Low_Alert_Type");
139         end if;
140
141         Handle (Low_Alarm);
142
143         if Bad_Final_Values (Low_Alarm) then
144            Report.Failed ("Wrong values for Low_Alert_Type after Handle");
145         end if;
146      end Low_Alert_Subtest;
147
148
149   -- Check intermediate display counts:
150
151   if C3900050.Display_Count_For /= (Null_Device => 2,
152                                     Teletype    => 1,
153                                     Console     => 0,
154                                     Big_Screen  => 0)
155   then
156      Report.Failed ("Wrong display counts after Low_Alert_Type");
157   end if;
158
159
160   MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
161
162      declare
163         Medium_Alarm : C3900052.Medium_Alert_Type; -- Priv. ext. of extension.
164         use C3900052; -- Primitive operations of extension directly visible.
165      begin
166         if not Initial_Values_Okay (Medium_Alarm) then
167            Report.Failed ("Wrong initial values for Medium_Alert_Type");
168         end if;
169
170         Handle (Medium_Alarm);
171
172         if Bad_Final_Values (Medium_Alarm) then
173            Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
174         end if;
175      end Medium_Alert_Subtest;
176
177
178   -- Check final display counts:
179
180   if C3900050.Display_Count_For /= (Null_Device => 3,
181                                     Teletype    => 2,
182                                     Console     => 1,
183                                     Big_Screen  => 0)
184   then
185      Report.Failed ("Wrong display counts after Medium_Alert_Type");
186   end if;
187
188
189   Report.Result;
190
191end C3900053;
192