1-- C393011.A
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-- TEST OBJECTIVE:
27--      Check that an abstract extended type can be derived from an abstract
28--      type, and that a a non-abstract type may then be derived from the
29--      second abstract type.
30--
31-- TEST DESCRIPTION:
32--      Define an abstract type with three primitive operations, two of them
33--      abstract.  Derive an extended type from it, inheriting the non-
34--      abstract operation, overriding one of the abstract operations with
35--      a non-abstract operation, and overriding the other abstract operation
36--      with an abstract operation.  The extended type is therefore abstract;
37--      derive an extended type from it.  Override the abstract operation with
38--      a non-abstract operation; inherit one operation from the original
39--      abstract type, and inherit one operation from the intermediate
40--      abstract type.
41--
42--
43-- CHANGE HISTORY:
44--      06 Dec 94   SAIC    ACVC 2.0
45--
46--!
47
48 Package C393011_0 is
49     -- Definitions
50
51   type Status_Enum is (None, Unhandled, Pending, Handled);
52   type Serial_Type is new Integer range 0 .. Integer'Last;
53   subtype Priority_Type is Integer range 0..10;
54
55   type Display_Enum is (Bit_Bucket, TTY, Console, Big_Screen);
56
57   Next : Serial_Type := 1;
58   Display_Device : Display_Enum := Bit_Bucket;
59
60 end C393011_0;
61 -- Definitions;
62
63 --=======================================================================--
64
65 with C393011_0;
66   -- Definitions
67
68 Package C393011_1 is
69      -- Alert
70
71   package Definitions renames C393011_0;
72
73   type Alert_Type is abstract tagged record
74     Status     : Definitions.Status_Enum := Definitions.None;
75     Serial_Num : Definitions.Serial_Type := 0;
76     Priority   : Definitions.Priority_Type;
77   end record;
78                             -- Alert_Type is an abstract type with
79                             -- two operations to be overridden
80
81   procedure Set_Status ( A : in out Alert_Type;          -- not abstract
82                         To : Definitions.Status_Enum);
83
84   procedure Set_Serial ( A : in out Alert_Type) is abstract;
85   procedure Display    ( A : Alert_Type)        is abstract;
86
87 end C393011_1;
88  -- Alert
89
90 --=======================================================================--
91
92 with C393011_0;
93 package body C393011_1 is
94           -- Alert
95   procedure Set_Status ( A : in out Alert_Type;
96                         To : Definitions.Status_Enum) is
97     begin
98       A.Status := To;
99     end Set_Status;
100
101 end C393011_1;
102  -- Alert;
103
104 --=======================================================================--
105
106 with C393011_0,
107   -- Definitions,
108      C393011_1,
109   -- Alert,
110      Calendar;
111
112 Package C393011_3 is
113      -- New_Alert
114
115   type New_Alert_Type is abstract new C393011_1.Alert_Type with record
116     Display_Dev : C393011_0.Display_Enum := C393011_0.TTY;
117   end record;
118
119   -- procedure Set_Status is inherited
120
121   procedure Set_Serial ( A : in out New_Alert_Type);   -- override/see body
122
123   procedure Display    ( A : New_Alert_Type) is abstract;
124                          -- override is abstract
125                          -- still can't declare objects of New_Alert_Type
126
127 end C393011_3;
128  -- New_Alert
129
130 --=======================================================================--
131
132 with C393011_0;
133 Package Body C393011_3 is
134           -- New_Alert
135
136   package Definitions renames C393011_0;
137
138   procedure Set_Serial (A : in out New_Alert_Type) is
139     use type Definitions.Serial_Type;
140     begin
141       A.Serial_Num := Definitions.Next;
142       Definitions.Next := Definitions."+"( Definitions.Next, 1);
143     end Set_Serial;
144
145 End C393011_3;
146  -- New_Alert;
147
148 --=======================================================================--
149
150 with C393011_0,
151   -- Definitions
152      C393011_3;
153   -- New_Alert  -- package Alert is not visible
154 package C393011_4 is
155
156   package New_Alert renames C393011_3;
157   package Definitions renames C393011_0;
158
159   type Final_Alert_Type is new New_Alert.New_Alert_Type with null record;
160   -- inherits Set_Status including body
161   -- inherits Set_Serial including body
162   -- must override Display since inherited Display is abstract
163   procedure Display(FA : in     Final_Alert_Type);
164   procedure Handle (FA : in out Final_Alert_Type);
165
166 end C393011_4;
167
168 package body C393011_4 is
169
170   procedure Display    (FA : in Final_Alert_Type) is
171     begin
172       Definitions.Display_Device := FA.Display_Dev;
173     end Display;
174
175   procedure Handle (FA : in out Final_Alert_Type) is
176     begin
177       Set_Status (FA, Definitions.Handled);
178       Set_Serial (FA);
179       Display (FA);
180     end Handle;
181 end C393011_4;
182
183 with C393011_0,
184   -- Definitions
185      C393011_3;
186   -- New_Alert  -- package Alert is not visible
187 with C393011_4;
188 with Report;
189 procedure C393011 is
190   use C393011_4;
191   use Definitions;
192
193   FA : Final_Alert_Type;
194
195 begin
196
197   Report.Test ("C393011", "Check that an extended type can be derived " &
198                           "from an abstract type");
199
200   if (Definitions.Display_Device /= Definitions.Bit_Bucket)
201       or (Definitions.Next /= 1)
202       or (FA.Status /= Definitions.None)
203       or (FA.Serial_Num /= 0)
204       or (FA.Display_Dev /= TTY) then
205     Report.Failed ("Incorrect initial conditions");
206   end if;
207
208   Handle (FA);
209   if (Definitions.Display_Device /= Definitions.TTY)
210       or (Definitions.Next /= 2)
211       or (FA.Status /= Definitions.Handled)
212       or (FA.Serial_Num /= 1)
213       or (FA.Display_Dev /= TTY) then
214     Report.Failed ("Incorrect results from Handle");
215   end if;
216
217   Report.Result;
218
219 end C393011;
220
221