diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/ca/ca11b02.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/ca/ca11b02.a | 169 |
1 files changed, 0 insertions, 169 deletions
diff --git a/gcc/testsuite/ada/acats/tests/ca/ca11b02.a b/gcc/testsuite/ada/acats/tests/ca/ca11b02.a deleted file mode 100644 index 0743f73336b..00000000000 --- a/gcc/testsuite/ada/acats/tests/ca/ca11b02.a +++ /dev/null @@ -1,169 +0,0 @@ --- CA11B02.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 type derived in a client of a public child inherits --- primitive operations from parent. --- --- TEST DESCRIPTION: --- Declare a root record type with discriminant in a package --- specification. Declare a primitive subprogram for the type --- (foundation code). --- --- Add a public child to the above package. Derive a new type --- with constraint to the discriminant record type from the parent --- package. Declare a new primitive subprogram to write to the child --- derived type. --- --- In the main program, "with" the child. Derive a new type using the --- record type from the child package. Access the inherited operations --- from both parent and child packages. --- --- TEST FILES: --- This test depends on the following foundation code: --- --- FA11B00.A --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - --- Child package of FA11B00. -package FA11B00.CA11B02_0 is -- Application_Two_Widget --- This public child declares a derived type from its parent. It --- represents processing of widgets in a window system. - - -- Dimension of app2_widget is limited to 5000 pixels. - - type App2_Widget is new App1_Widget (Maximum_Size => 5000); - -- Derived record of parent type. - - -- Inherits procedure App1_Widget_Specific_Oper from parent. - - - -- Primitive operation of type App2_Widget. - - procedure App2_Widget_Specific_Op1 (The_Widget : in out App2_Widget; - S : in Widget_Size); - - -- Primitive operation of type App2_Widget. - - procedure App2_Widget_Specific_Op2 (The_Widget : in out App2_Widget; - Loc : in Widget_Location); - -end FA11B00.CA11B02_0; -- Application_Two_Widget - - ---=======================================================================-- - - -package body FA11B00.CA11B02_0 is -- Application_Two_Widget - - procedure App2_Widget_Specific_Op1 (The_Widget : in out App2_Widget; - S : in Widget_Size) is - begin - The_Widget.Size := S; - end App2_Widget_Specific_Op1; - - --==============================================-- - - procedure App2_Widget_Specific_Op2 (The_Widget : in out App2_Widget; - Loc : in Widget_Location) is - begin - The_Widget.Location := Loc; - end App2_Widget_Specific_Op2; - -end FA11B00.CA11B02_0; -- Application_Two_Widget - - ---=======================================================================-- - -with FA11B00.CA11B02_0; -- Application_Two_Widget - -- implicitly with Application_One_Widget. -with Report; - -procedure CA11B02 is - - package Application_One_Widget renames FA11B00; - - package Application_Two_Widget renames FA11B00.CA11B02_0; - - use Application_One_Widget ; - use Application_Two_Widget ; - - type Emulator_Widget is new App2_Widget; -- Derived record of - -- parent type. - - White_Widget, Amber_Widget : Emulator_Widget; - - -begin - - Report.Test ("CA11B02", "Check that a type derived in client of a " & - "public child inherits primitive operations from parent"); - - App1_Widget_Specific_Oper (C => White, L => "Line Editor ", - The_Widget => White_Widget, I => 10); - -- Inherited from Application_One_Widget. - If White_Widget.Color /= White or - White_Widget.Id /= Widget_ID (Report.Ident_Int (10)) or - White_Widget.Label /= "Line Editor " - then - Report.Failed ("Incorrect result for White_Widget"); - end if; - - -- perform an App2_Widget specific operation. - - App2_Widget_Specific_Op1 (White_Widget, S => (100, 200)); - - If White_Widget.Size.X_Length /= 100 or - White_Widget.Size.Y_Length /= 200 - then - Report.Failed ("Incorrect size for White_Widget"); - end if; - - App1_Widget_Specific_Oper (Amber_Widget, 5, Amber, "Screen Editor "); - -- Inherited from Application_One_Widget. - - -- perform an App2_Widget specific operations. - - App2_Widget_Specific_Op1 (S => (1024,100), The_Widget => Amber_Widget); - App2_Widget_Specific_Op2 (Amber_Widget, (1024, 760)); - - If Amber_Widget.Color /= Amber or - Amber_Widget.Id /= Widget_ID (Report.Ident_Int (5)) or - Amber_Widget.Label /= "Screen Editor " or - Amber_Widget.Size /= (1024,100) or - Amber_Widget.Location.X_Location /= 1024 or - Amber_Widget.Location.Y_Location /= 760 - then - Report.Failed ("Incorrect result for Amber_Widget"); - end if; - - Report.Result; - -end CA11B02; |