diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cc/cc51007.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cc/cc51007.a | 305 |
1 files changed, 0 insertions, 305 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cc/cc51007.a b/gcc/testsuite/ada/acats/tests/cc/cc51007.a deleted file mode 100644 index d8f78779dee..00000000000 --- a/gcc/testsuite/ada/acats/tests/cc/cc51007.a +++ /dev/null @@ -1,305 +0,0 @@ --- CC51007.A --- --- 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 generic formal derived tagged type is a private extension. --- Specifically, check that, for a generic formal derived type whose --- ancestor type has abstract primitive subprograms, neither the formal --- derived type nor its descendants need be abstract. Check that objects --- and components of the formal derived type and its nonabstract --- descendants may be declared and allocated, as may nonabstract --- functions returning these types, and that aggregates of nonabstract --- descendants of the formal derived type are legal. Check that calls to --- the abstract primitive subprograms of the ancestor dispatch to the --- bodies corresponding to the tag of the actual parameters. --- --- TEST DESCRIPTION: --- Although the ancestor type is abstract and has abstract primitive --- subprograms, these subprograms, when inherited by a formal nonabstract --- derived type, are not abstract, since the formal derived type is a --- nonabstract private extension. --- --- Thus, derivatives of the formal derived type need not be abstract, --- and both the formal derived type and its derivatives are considered --- nonabstract types. --- --- This test verifies that the restrictions placed on abstract types do --- not apply to the formal derived type or its derivatives. Specifically, --- objects of, components of, allocators of, and nonabstract functions --- returning the formal derived type or its derivatives are legal. In --- addition, the test verifies that a call within the instance to a --- primitive subprogram of the (abstract) ancestor type dispatches to --- the body corresponding to the tag of the actual parameter. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 23 Dec 94 SAIC Deleted illegal extension aggregate. Corrected --- dispatching call. Editorial changes to commentary. --- 05 Nov 95 SAIC ACVC 2.0.1 fixes: Moved instantiation of CC51007_3 --- to library level. --- 11 Aug 96 SAIC ACVC 2.1: Added pragma Elaborate to context --- clauses of CC51007_1 and CC51007_4. --- ---! - -package CC51007_0 is - - Max_Length : constant := 10; - type Text is new String(1 .. Max_Length); - - type Alert is abstract tagged record -- Root type of class - Message : Text := (others => '*'); -- (abstract). - end record; - - procedure Handle (A: in out Alert) is abstract; -- Abstract dispatching - -- operation. - -end CC51007_0; - --- No body for CC51007_0; - - - --===================================================================-- - - -with CC51007_0; - -with Ada.Calendar; -pragma Elaborate (Ada.Calendar); - -package CC51007_1 is - - type Low_Alert is new CC51007_0.Alert with record - Time_Of_Arrival : Ada.Calendar.Time := Ada.Calendar.Time_Of (1901, 8, 1); - end record; - - procedure Handle (A: in out Low_Alert); -- Overrides parent's - -- implementation. - Low : Low_Alert; - -end CC51007_1; - - - --===================================================================-- - - -package body CC51007_1 is - - procedure Handle (A: in out Low_Alert) is -- Artificial for - begin -- testing. - A.Time_Of_Arrival := Ada.Calendar.Time_Of (1984, 1, 1); - A.Message := "Low Alert!"; - end Handle; - -end CC51007_1; - - - --===================================================================-- - - -with CC51007_1; -package CC51007_2 is - - type Person is (OOD, CO, CinC); - - type Medium_Alert is new CC51007_1.Low_Alert with record - Action_Officer : Person := OOD; - end record; - - procedure Handle (A: in out Medium_Alert); -- Overrides parent's - -- implementation. - Med : Medium_Alert; - -end CC51007_2; - - - --===================================================================-- - - -with Ada.Calendar; -package body CC51007_2 is - - procedure Handle (A: in out Medium_Alert) is -- Artificial for - begin -- testing. - A.Action_Officer := CO; - A.Time_Of_Arrival := Ada.Calendar.Time_Of (2001, 1, 1); - A.Message := "Med Alert!"; - end Handle; - -end CC51007_2; - - - --===================================================================-- - - -with CC51007_0; -generic - type Alert_Type is new CC51007_0.Alert with private; - Initial_State : in Alert_Type; -package CC51007_3 is - - function Clear_Message (A: Alert_Type) -- Function returning - return Alert_Type; -- formal type. - - - Max_Note : Natural := 10; - type Note is new String (1 .. Max_Note); - - type Extended_Alert is new Alert_Type with record - Addendum : Note := (others => '*'); - end record; - - -- In instance, inherits version of Handle from - -- actual corresponding to formal type. - - function Annotate_Alert (A: in Alert_Type'Class) -- Function returning - return Extended_Alert; -- derived type. - - - Init_Ext_Alert : constant Extended_Alert := -- Object declaration. - (Initial_State with Addendum => "----------"); -- Aggregate. - - - type Alert_Type_Ptr is access constant Alert_Type; - type Ext_Alert_Ptr is access Extended_Alert; - - Init_Alert_Ptr : Alert_Type_Ptr := - new Alert_Type'(Initial_State); -- Allocator. - - Init_Ext_Alert_Ptr : Ext_Alert_Ptr := - new Extended_Alert'(Init_Ext_Alert); -- Allocator. - - - type Alert_Pair is record - A : Alert_Type; -- Component. - EA : Extended_Alert; -- Component. - end record; - -end CC51007_3; - - - --===================================================================-- - - -package body CC51007_3 is - - function Clear_Message (A: Alert_Type) return Alert_Type is - Temp : Alert_Type := A; -- Object declaration. - begin - Temp.Message := (others => '-'); - return Temp; - end Clear_Message; - - function Annotate_Alert (A: in Alert_Type'Class) return Extended_Alert is - Temp : Alert_Type'Class := A; - begin - Handle (Temp); -- Dispatching call to - -- operation of ancestor. - return (Alert_Type(Temp) with Addendum => "No comment"); - end Annotate_Alert; - -end CC51007_3; - - - --===================================================================-- - - -with CC51007_1; - -with CC51007_3; -pragma Elaborate (CC51007_3); - -package CC51007_4 is new CC51007_3 (CC51007_1.Low_Alert, CC51007_1.Low); - - - --===================================================================-- - - -with CC51007_1; -with CC51007_2; -with CC51007_3; -with CC51007_4; - -with Ada.Calendar; -with Report; -procedure CC51007 is - - package Alert_Support renames CC51007_4; - - Ext : Alert_Support.Extended_Alert; - - TC_Result : Alert_Support.Extended_Alert; - - TC_Low_Expected : constant Alert_Support.Extended_Alert := - (Time_Of_Arrival => Ada.Calendar.Time_Of (1984, 1, 1), - Message => "Low Alert!", - Addendum => "No comment"); - - TC_Med_Expected : constant Alert_Support.Extended_Alert := - (Time_Of_Arrival => Ada.Calendar.Time_Of (2001, 1, 1), - Message => "Med Alert!", - Addendum => "No comment"); - - TC_Ext_Expected : constant Alert_Support.Extended_Alert := TC_Low_Expected; - - - use type Alert_Support.Extended_Alert; - -begin - Report.Test ("CC51007", "Check that, for a generic formal derived type " & - "whose ancestor type has abstract primitive subprograms, " & - "neither the formal derived type nor its descendants need " & - "be abstract, and that objects of, components of, " & - "allocators of, aggregates of, and nonabstract functions " & - "returning these types are legal. Check that calls to the " & - "abstract primitive subprograms of the ancestor dispatch " & - "to the bodies corresponding to the tag of the actual " & - "parameters"); - - - TC_Result := Alert_Support.Annotate_Alert (CC51007_1.Low); -- Dispatching - -- call. - if TC_Result /= TC_Low_Expected then - Report.Failed ("Wrong results from dispatching call (Low_Alert)"); - end if; - - - TC_Result := Alert_Support.Annotate_Alert (CC51007_2.Med); -- Dispatching - -- call. - if TC_Result /= TC_Med_Expected then - Report.Failed ("Wrong results from dispatching call (Medium_Alert)"); - end if; - - - TC_Result := Alert_Support.Annotate_Alert (Ext); -- Results in dispatching - -- call. - if TC_Result /= TC_Ext_Expected then - Report.Failed ("Wrong results from dispatching call (Extended_Alert)"); - end if; - - - Report.Result; -end CC51007; |