diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cc/cc51001.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cc/cc51001.a | 186 |
1 files changed, 0 insertions, 186 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cc/cc51001.a b/gcc/testsuite/ada/acats/tests/cc/cc51001.a deleted file mode 100644 index 6aa76a6f8e6..00000000000 --- a/gcc/testsuite/ada/acats/tests/cc/cc51001.a +++ /dev/null @@ -1,186 +0,0 @@ --- CC51001.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 formal parameter of a generic package may be a formal --- derived type. Check that the formal derived type may have an unknown --- discriminant part. Check that the ancestor type in a formal derived --- type definition may be a tagged type, and that the actual parameter --- may be a descendant of the ancestor type. Check that the formal derived --- type belongs to the derivation class rooted at the ancestor type; --- specifically, that components of the ancestor type may be referenced --- within the generic. Check that if a formal derived subtype is --- indefinite then the actual may be either definite or indefinite. --- --- TEST DESCRIPTION: --- Define a class of tagged types with a definite root type. Extend the --- root type with a discriminated component. Since discriminants of --- tagged types may not have defaults, the type is indefinite. --- --- Extend the extension with a second discriminated component, but with --- a new discriminant part. Declare a generic package with a formal --- derived type using the root type of the class as ancestor, and an --- unknown discriminant part. Declare an operation in the generic which --- accesses the common component of types in the class. --- --- In the main program, instantiate the generic with each type in the --- class and verify that the operation correctly accesses the common --- component. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -package CC51001_0 is -- Root type for message class. - - subtype Msg_String is String (1 .. 20); - - type Msg_Type is tagged record -- Root type of - Text : Msg_String := (others => ' '); -- class (definite). - end record; - -end CC51001_0; - - --- No body for CC51001_0. - - - --==================================================================-- - - -with CC51001_0; -- Root type for message class. -package CC51001_1 is -- Extensions to message class. - - subtype Source_Length is Natural range 0 .. 10; - - type From_Msg_Type (SLen : Source_Length) is -- Direct derivative - new CC51001_0.Msg_Type with record -- of root type - From : String (1 .. SLen); -- (indefinite). - end record; - - subtype Dest_Length is Natural range 0 .. 10; - - - - type To_From_Msg_Type (DLen : Dest_Length) is -- Indirect - new From_Msg_Type (SLen => 10) with record -- derivative of - To : String (1 .. DLen); -- root type - end record; -- (indefinite). - -end CC51001_1; - - --- No body for CC51001_1. - - - --==================================================================-- - - -with CC51001_0; -- Root type for message class. -generic -- I/O operations for message class. - type Message_Type (<>) is new CC51001_0.Msg_Type with private; -package CC51001_2 is - - -- This subprogram contains an artificial result for testing purposes: - -- the function returns the text of the message to the caller as a string. - - function Print_Message (M : in Message_Type) return String; - - -- ... Other operations. - -end CC51001_2; - - - --==================================================================-- - - -package body CC51001_2 is - - -- The implementations of the operations below are purely artificial; the - -- validity of their implementations in the context of the abstraction is - -- irrelevant to the feature being tested. - - function Print_Message (M : in Message_Type) return String is - begin - return M.Text; - end Print_Message; - -end CC51001_2; - - - --==================================================================-- - - -with CC51001_0; -- Root type for message class. -with CC51001_1; -- Extensions to message class. -with CC51001_2; -- I/O operations for message class. - -with Report; -procedure CC51001 is - - -- Instantiate for various types in the class: - - package Msgs is new CC51001_2 (CC51001_0.Msg_Type); -- Definite. - package FMsgs is new CC51001_2 (CC51001_1.From_Msg_Type); -- Indefinite. - package TFMsgs is new CC51001_2 (CC51001_1.To_From_Msg_Type); -- Indefinite. - - - - Msg : CC51001_0.Msg_Type := (Text => "This is message #001"); - FMsg : CC51001_1.From_Msg_Type := (Text => "This is message #002", - SLen => 2, - From => "Me"); - TFMsg : CC51001_1.To_From_Msg_Type := (Text => "This is message #003", - From => "You ", - DLen => 4, - To => "Them"); - - Expected_Msg : constant String := "This is message #001"; - Expected_FMsg : constant String := "This is message #002"; - Expected_TFMsg : constant String := "This is message #003"; - -begin - Report.Test ("CC51001", "Check that the formal derived type may have " & - "an unknown discriminant part. Check that the ancestor " & - "type in a formal derived type definition may be a " & - "tagged type, and that the actual parameter may be any " & - "definite or indefinite descendant of the ancestor type"); - - if (Msgs.Print_Message (Msg) /= Expected_Msg) then - Report.Failed ("Wrong result for definite root type"); - end if; - - if (FMsgs.Print_Message (FMsg) /= Expected_FMsg) then - Report.Failed ("Wrong result for direct indefinite derivative"); - end if; - - if (TFMsgs.Print_Message (TFMsg) /= Expected_TFMsg) then - Report.Failed ("Wrong result for Indirect indefinite derivative"); - end if; - - Report.Result; -end CC51001; |