| -- C3900011.AM |
| -- |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- These rights include rights to use, duplicate, release or disclose the |
| -- released technical data and computer software in whole or in part, in |
| -- any manner and for any purpose whatsoever, and to have or permit others |
| -- to do so. |
| -- |
| -- DISCLAIMER |
| -- |
| -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR |
| -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED |
| -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE |
| -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE |
| -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A |
| -- PARTICULAR PURPOSE OF SAID MATERIAL. |
| --* |
| -- |
| -- OBJECTIVE: |
| -- Check that a record extension can be declared in the same package |
| -- as its parent, and that this parent may be a tagged record or a |
| -- record extension. Check that each derivative inherits all user- |
| -- defined primitive subprograms of its parent (including those that |
| -- its parent inherited), and that it may declare its own primitive |
| -- subprograms. |
| -- |
| -- Check that predefined equality operators are defined for the root |
| -- tagged type. |
| -- |
| -- Check that type conversion is defined from a type extension to its |
| -- parent, and that this parent itself may be a type extension. |
| -- |
| -- TEST DESCRIPTION: |
| -- Declare a root tagged type in a package specification. Declare two |
| -- primitive subprograms for the type. |
| -- |
| -- Extend the root type with a record extension in the same package |
| -- specification. Declare a new primitive subprogram for the extension |
| -- (in addition to its two inherited subprograms). |
| -- |
| -- Extend the extension with a record extension in the same package |
| -- specification. Declare a new primitive subprogram for this second |
| -- extension (in addition to its three inherited subprograms). |
| -- |
| -- In the main program, declare operations for the root tagged type which |
| -- utilize aggregates and equality operators to verify the correctness |
| -- of the components. Overload these operations for the two type |
| -- extensions. Within each of these overloading operations, utilize type |
| -- conversion to call the parent's implementation of the same operation. |
| -- |
| -- TEST FILES: |
| -- The following files comprise this test: |
| -- |
| -- C3900010.A |
| -- => C3900011.AM |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 06 Dec 94 SAIC ACVC 2.0 |
| -- |
| --! |
| |
| with C3900010; |
| with Report; |
| procedure C3900011 is |
| |
| |
| package Check_Alert_Values is |
| |
| -- Declare functions to verify correctness of tagged record components |
| -- before and after calls to their primitive subprograms. |
| |
| |
| -- Alert_Type: |
| |
| function Initial_Values_Okay (A : in C3900010.Alert_Type) |
| return Boolean; |
| |
| function Bad_Final_Values (A : in C3900010.Alert_Type) |
| return Boolean; |
| |
| |
| -- Low_Alert_Type: |
| |
| function Initial_Values_Okay (LA : in C3900010.Low_Alert_Type) |
| return Boolean; |
| |
| function Bad_Final_Values (LA : in C3900010.Low_Alert_Type) |
| return Boolean; |
| |
| |
| -- Medium_Alert_Type: |
| |
| function Initial_Values_Okay (MA : in C3900010.Medium_Alert_Type) |
| return Boolean; |
| |
| function Bad_Final_Values (MA : in C3900010.Medium_Alert_Type) |
| return Boolean; |
| |
| |
| end Check_Alert_Values; |
| |
| |
| --==========================================================-- |
| |
| |
| package body Check_Alert_Values is |
| |
| |
| function Initial_Values_Okay (A : in C3900010.Alert_Type) |
| return Boolean is |
| use type C3900010.Alert_Type; |
| begin -- "=" operator availability. |
| return (A = (Arrival_Time => C3900010.Default_Time, |
| Display_On => C3900010.Null_Device)); |
| end Initial_Values_Okay; |
| |
| |
| function Initial_Values_Okay (LA : in C3900010.Low_Alert_Type) |
| return Boolean is |
| begin -- Type conversion. |
| return (Initial_Values_Okay (C3900010.Alert_Type (LA)) and |
| LA.Level = 0); |
| end Initial_Values_Okay; |
| |
| |
| function Initial_Values_Okay (MA : in C3900010.Medium_Alert_Type) |
| return Boolean is |
| use type C3900010.Person_Enum; |
| begin -- Type conversion. |
| return (Initial_Values_Okay (C3900010.Low_Alert_Type (MA)) and |
| MA.Action_Officer = C3900010.Nobody); |
| end Initial_Values_Okay; |
| |
| |
| function Bad_Final_Values (A : in C3900010.Alert_Type) |
| return Boolean is |
| use type C3900010.Alert_Type; |
| begin -- "/=" operator availability. |
| return (A /= (Arrival_Time => C3900010.Alert_Time, |
| Display_On => C3900010.Null_Device)); |
| end Bad_Final_Values; |
| |
| |
| function Bad_Final_Values (LA : in C3900010.Low_Alert_Type) |
| return Boolean is |
| use type C3900010.Low_Alert_Type; |
| begin -- "=" operator availability. |
| return not ( LA = (Arrival_Time => C3900010.Alert_Time, |
| Display_On => C3900010.Teletype, |
| Level => 1) ); |
| end Bad_Final_Values; |
| |
| |
| function Bad_Final_Values (MA : in C3900010.Medium_Alert_Type) |
| return Boolean is |
| use type C3900010.Medium_Alert_Type; |
| begin -- "/=" operator availability. |
| return ( MA /= (C3900010.Alert_Time, |
| C3900010.Console, |
| 1, |
| C3900010.Duty_Officer) ); |
| end Bad_Final_Values; |
| |
| |
| end Check_Alert_Values; |
| |
| |
| --==========================================================-- |
| |
| |
| use Check_Alert_Values; |
| use C3900010; |
| |
| Root_Alarm : C3900010.Alert_Type; |
| Low_Alarm : C3900010.Low_Alert_Type; |
| Medium_Alarm : C3900010.Medium_Alert_Type; |
| |
| begin |
| |
| Report.Test ("C390001", "Primitive operation inheritance by type " & |
| "extensions: all extensions declared in same package " & |
| "as parent"); |
| |
| |
| -- Check root tagged type: |
| |
| if Initial_Values_Okay (Root_Alarm) then |
| Handle (Root_Alarm); -- Explicitly declared. |
| Display (Root_Alarm); -- Explicitly declared. |
| |
| if Bad_Final_Values (Root_Alarm) then |
| Report.Failed ("Wrong results after Alert_Type calls"); |
| end if; |
| else |
| Report.Failed ("Wrong initial values for Alert_Type"); |
| end if; |
| |
| |
| -- Check record extension of root tagged type: |
| |
| if Initial_Values_Okay (Low_Alarm) then |
| Handle (Low_Alarm); -- Inherited. |
| Low_Alarm.Display_On := Teletype; |
| Display (Low_Alarm); -- Inherited. |
| Low_Alarm.Level := Level_Of (Low_Alarm); -- Explicitly declared. |
| |
| if Bad_Final_Values (Low_Alarm) then |
| Report.Failed ("Wrong results after Low_Alert_Type calls"); |
| end if; |
| else |
| Report.Failed ("Wrong initial values for Low_Alert_Type"); |
| end if; |
| |
| |
| -- Check record extension of record extension: |
| |
| if Initial_Values_Okay (Medium_Alarm) then |
| Handle (Medium_Alarm); -- Inherited twice. |
| Medium_Alarm.Display_On := Console; |
| Display (Medium_Alarm); -- Inherited twice. |
| Medium_Alarm.Level := Level_Of (Medium_Alarm); -- Inherited. |
| Assign_Officer (Medium_Alarm, Duty_Officer); -- Explicitly declared. |
| |
| if Bad_Final_Values (Medium_Alarm) then |
| Report.Failed ("Wrong results after Medium_Alert_Type calls"); |
| end if; |
| else |
| Report.Failed ("Wrong initial values for Medium_Alert_Type"); |
| end if; |
| |
| |
| -- Check final display counts: |
| |
| if C3900010.Display_Count_For /= (Null_Device => 1, |
| Teletype => 1, |
| Console => 1, |
| Big_Screen => 0) |
| then |
| Report.Failed ("Wrong final values for display counts"); |
| end if; |
| |
| |
| Report.Result; |
| |
| end C3900011; |
