3 -- Grant of Unlimited Rights
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
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.
27 -- Check that an abstract type can be declared, and in turn concrete
28 -- types can be derived from it. Check that the definition of
29 -- actual subprograms associated with the derived types dispatch
33 -- This test declares an abstract type Breaker in a package, and
34 -- then derives from it. The type Basic_Breaker defines the least
35 -- possible in order to not be abstract. The type Ground_Fault is
36 -- defined to inherit as much as possible, whereas type Special_Breaker
37 -- overrides everything it can. The type Special_Breaker also includes
38 -- an embedded Basic_Breaker object. The main program then utilizes
39 -- each of the three types of breaker, and to ascertain that the
40 -- overloading and tagging resolution are correct, each "Create"
41 -- procedure is called with a unique value. The diagram below
42 -- illustrates the relationships. This test is derived from C3A2001.
44 -- Abstract type: Breaker
46 -- Basic_Breaker (Short)
48 -- (Sharp) Ground_Fault Special_Breaker (Shock)
50 -- Test structure is an array of class-wide objects, modeling a circuit
51 -- as a list of components. The test then creates some values, and
52 -- traverses the list to determine correct operation.
56 -- 06 Dec 94 SAIC ACVC 2.0
57 -- 13 Nov 95 SAIC Revised for 2.0.1
61 ----------------------------------------------------------------- C393001_1
66 type Breaker
is abstract tagged private;
67 type Status
is ( Power_Off
, Power_On
, Tripped
, Failed
);
69 procedure Flip
( The_Breaker
: in out Breaker
) is abstract;
70 procedure Trip
( The_Breaker
: in out Breaker
) is abstract;
71 procedure Reset
( The_Breaker
: in out Breaker
) is abstract;
72 procedure Fail
( The_Breaker
: in out Breaker
);
74 procedure Set
( The_Breaker
: in out Breaker
'Class; To_State
: Status
);
76 function Status_Of
( The_Breaker
: Breaker
) return Status
;
79 type Breaker
is abstract tagged record
80 State
: Status
:= Power_Off
;
85 package body C393001_1
is
86 procedure Fail
( The_Breaker
: in out Breaker
) is ------------------- a
89 The_Breaker
.State
:= Failed
;
92 procedure Set
( The_Breaker
: in out Breaker
'Class; To_State
: Status
) is
94 The_Breaker
.State
:= To_State
;
97 function Status_Of
( The_Breaker
: Breaker
) return Status
is ------- b
100 return The_Breaker
.State
;
104 ----------------------------------------------------------------- C393001_2
109 type Basic_Breaker
is new C393001_1
.Breaker
with private;
111 type Voltages
is ( V12
, V110
, V220
, V440
);
112 type Amps
is ( A1
, A5
, A10
, A25
, A100
);
114 function Construct
( Voltage
: Voltages
; Amperage
: Amps
)
115 return Basic_Breaker
;
117 procedure Flip
( The_Breaker
: in out Basic_Breaker
);
118 procedure Trip
( The_Breaker
: in out Basic_Breaker
);
119 procedure Reset
( The_Breaker
: in out Basic_Breaker
);
121 type Basic_Breaker
is new C393001_1
.Breaker
with record
122 Voltage_Level
: Voltages
:= V110
;
128 package body C393001_2
is
129 function Construct
( Voltage
: Voltages
; Amperage
: Amps
) ----------- c
130 return Basic_Breaker
is
133 TCTouch
.Touch
( 'c' );
134 It
.Amperage
:= Amperage
;
135 It
.Voltage_Level
:= Voltage
;
136 C393001_1
.Set
( It
, C393001_1
.Power_Off
);
140 procedure Flip
( The_Breaker
: in out Basic_Breaker
) is ------------ d
142 TCTouch
.Touch
( 'd' );
143 case Status_Of
( The_Breaker
) is
144 when C393001_1
.Power_Off
=>
145 C393001_1
.Set
( The_Breaker
, C393001_1
.Power_On
);
146 when C393001_1
.Power_On
=>
147 C393001_1
.Set
( The_Breaker
, C393001_1
.Power_Off
);
148 when C393001_1
.Tripped | C393001_1
.Failed
=> null;
152 procedure Trip
( The_Breaker
: in out Basic_Breaker
) is ------------ e
154 TCTouch
.Touch
( 'e' );
155 C393001_1
.Set
( The_Breaker
, C393001_1
.Tripped
);
158 procedure Reset
( The_Breaker
: in out Basic_Breaker
) is ------------ f
160 TCTouch
.Touch
( 'f' );
161 case Status_Of
( The_Breaker
) is
162 when C393001_1
.Power_Off | C393001_1
.Tripped
=>
163 C393001_1
.Set
( The_Breaker
, C393001_1
.Power_On
);
164 when C393001_1
.Power_On | C393001_1
.Failed
=> null;
170 with C393001_1
,C393001_2
;
173 type Ground_Fault
is new C393001_2
.Basic_Breaker
with private;
175 function Construct
( Voltage
: C393001_2
.Voltages
; Amperage
: C393001_2
.Amps
179 procedure Set_Trip
( The_Breaker
: in out Ground_Fault
;
180 Capacitance
: in Integer );
183 type Ground_Fault
is new C393001_2
.Basic_Breaker
with record
184 Capacitance
: Integer;
188 ----------------------------------------------------------------- C393001_3
191 package body C393001_3
is
193 function Construct
( Voltage
: C393001_2
.Voltages
; ------------------ g
194 Amperage
: C393001_2
.Amps
)
195 return Ground_Fault
is
199 procedure Set_Root
( It
: in out C393001_2
.Basic_Breaker
) is
201 It
:= C393001_2
.Construct
( Voltage
, Amperage
);
205 TCTouch
.Touch
( 'g' );
206 Set_Root
( C393001_2
.Basic_Breaker
( It
) );
211 procedure Set_Trip
( The_Breaker
: in out Ground_Fault
; -------------- h
212 Capacitance
: in Integer ) is
214 TCTouch
.Touch
( 'h' );
215 The_Breaker
.Capacitance
:= Capacitance
;
220 ----------------------------------------------------------------- C393001_4
222 with C393001_1
, C393001_2
;
225 type Special_Breaker
is new C393001_2
.Basic_Breaker
with private;
227 function Construct
( Voltage
: C393001_2
.Voltages
;
228 Amperage
: C393001_2
.Amps
)
229 return Special_Breaker
;
231 procedure Flip
( The_Breaker
: in out Special_Breaker
);
232 procedure Trip
( The_Breaker
: in out Special_Breaker
);
233 procedure Reset
( The_Breaker
: in out Special_Breaker
);
234 procedure Fail
( The_Breaker
: in out Special_Breaker
);
236 function Status_Of
( The_Breaker
: Special_Breaker
) return C393001_1
.Status
;
237 function On_Backup
( The_Breaker
: Special_Breaker
) return Boolean;
240 type Special_Breaker
is new C393001_2
.Basic_Breaker
with record
241 Backup
: C393001_2
.Basic_Breaker
;
246 package body C393001_4
is
248 function Construct
( Voltage
: C393001_2
.Voltages
; --------------- i
249 Amperage
: C393001_2
.Amps
)
250 return Special_Breaker
is
252 procedure Set_Root
( It
: in out C393001_2
.Basic_Breaker
) is
254 It
:= C393001_2
.Construct
( Voltage
, Amperage
);
257 TCTouch
.Touch
( 'i' );
258 Set_Root
( C393001_2
.Basic_Breaker
( It
) );
259 Set_Root
( It
.Backup
);
263 function Status_Of
( It
: C393001_1
.Breaker
) return C393001_1
.Status
264 renames C393001_1
.Status_Of
;
266 procedure Flip
( The_Breaker
: in out Special_Breaker
) is ---------- j
268 TCTouch
.Touch
( 'j' );
269 case Status_Of
( C393001_1
.Breaker
( The_Breaker
)) is
270 when C393001_1
.Power_Off | C393001_1
.Power_On
=>
271 C393001_2
.Flip
( C393001_2
.Basic_Breaker
( The_Breaker
) );
273 C393001_2
.Flip
( The_Breaker
.Backup
);
277 procedure Trip
( The_Breaker
: in out Special_Breaker
) is ---------- k
279 TCTouch
.Touch
( 'k' );
280 case Status_Of
( C393001_1
.Breaker
( The_Breaker
)) is
281 when C393001_1
.Power_Off
=> null;
282 when C393001_1
.Power_On
=>
283 C393001_2
.Reset
( The_Breaker
.Backup
);
284 C393001_2
.Trip
( C393001_2
.Basic_Breaker
( The_Breaker
) );
286 C393001_2
.Trip
( The_Breaker
.Backup
);
290 procedure Reset
( The_Breaker
: in out Special_Breaker
) is ---------- l
292 TCTouch
.Touch
( 'l' );
293 case Status_Of
( C393001_1
.Breaker
( The_Breaker
)) is
294 when C393001_1
.Tripped
=>
295 C393001_2
.Reset
( C393001_2
.Basic_Breaker
( The_Breaker
));
296 when C393001_1
.Failed
=>
297 C393001_2
.Reset
( The_Breaker
.Backup
);
298 when C393001_1
.Power_On | C393001_1
.Power_Off
=>
303 procedure Fail
( The_Breaker
: in out Special_Breaker
) is ---------- m
305 TCTouch
.Touch
( 'm' );
306 case Status_Of
( C393001_1
.Breaker
( The_Breaker
)) is
307 when C393001_1
.Failed
=>
308 C393001_2
.Fail
( The_Breaker
.Backup
);
310 C393001_2
.Fail
( C393001_2
.Basic_Breaker
( The_Breaker
));
311 C393001_2
.Reset
( The_Breaker
.Backup
);
315 function Status_Of
( The_Breaker
: Special_Breaker
) ----------------- n
316 return C393001_1
.Status
is
318 TCTouch
.Touch
( 'n' );
319 case Status_Of
( C393001_1
.Breaker
( The_Breaker
)) is
320 when C393001_1
.Power_On
=> return C393001_1
.Power_On
;
321 when C393001_1
.Power_Off
=> return C393001_1
.Power_Off
;
323 return C393001_2
.Status_Of
( The_Breaker
.Backup
);
327 function On_Backup
( The_Breaker
: Special_Breaker
) return Boolean is
329 use type C393001_1
.Status
;
331 return Status_Of
(Basic_Breaker
(The_Breaker
)) = C393001_1
.Tripped
332 or Status_Of
(Basic_Breaker
(The_Breaker
)) = C393001_1
.Failed
;
337 ------------------------------------------------------------------- C393001
339 with Report
, TCTouch
;
340 with C393001_1
, C393001_2
, C393001_3
, C393001_4
;
343 procedure Flipper
( The_Circuit
: in out C393001_1
.Breaker
'Class ) is
345 C393001_1
.Flip
( The_Circuit
);
348 procedure Tripper
( The_Circuit
: in out C393001_1
.Breaker
'Class ) is
350 C393001_1
.Trip
( The_Circuit
);
353 procedure Restore
( The_Circuit
: in out C393001_1
.Breaker
'Class ) is
355 C393001_1
.Reset
( The_Circuit
);
358 procedure Failure
( The_Circuit
: in out C393001_1
.Breaker
'Class ) is
360 C393001_1
.Fail
( The_Circuit
);
363 Short
: C393001_1
.Breaker
'Class -- Basic_Breaker
364 := C393001_2
.Construct
( C393001_2
.V440
, C393001_2
.A5
);
365 Sharp
: C393001_1
.Breaker
'Class -- Ground_Fault
366 := C393001_3
.Construct
( C393001_2
.V110
, C393001_2
.A1
);
367 Shock
: C393001_1
.Breaker
'Class -- Special_Breaker
368 := C393001_4
.Construct
( C393001_2
.V12
, C393001_2
.A100
);
370 begin -- Main test procedure.
372 Report
.Test
("C393001", "Check that an abstract type can be declared " &
373 "and used. Check actual subprograms dispatch correctly" );
375 TCTouch
.Validate
( "cgcicc", "Declaration" );
378 TCTouch
.Validate
( "db", "Flipping Short" );
380 TCTouch
.Validate
( "db", "Flipping Sharp" );
382 TCTouch
.Validate
( "jbdb", "Flipping Shock" );
385 TCTouch
.Validate
( "e", "Tripping Short" );
387 TCTouch
.Validate
( "e", "Tripping Sharp" );
389 TCTouch
.Validate
( "kbfbe", "Tripping Shock" );
392 TCTouch
.Validate
( "fb", "Restoring Short" );
394 TCTouch
.Validate
( "fb", "Restoring Sharp" );
396 TCTouch
.Validate
( "lbfb", "Restoring Shock" );
399 TCTouch
.Validate
( "a", "Shock Failing" );
401 TCTouch
.Validate
( "a", "Shock Failing" );
403 TCTouch
.Validate
( "mbafb", "Shock Failing" );