diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c7/c760012.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c7/c760012.a | 256 |
1 files changed, 0 insertions, 256 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c7/c760012.a b/gcc/testsuite/ada/acats/tests/c7/c760012.a deleted file mode 100644 index 08986a838c4..00000000000 --- a/gcc/testsuite/ada/acats/tests/c7/c760012.a +++ /dev/null @@ -1,256 +0,0 @@ --- C760012.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 record components that have per-object access discriminant --- constraints are initialized in the order of their component --- declarations, and after any components that are not so constrained. --- --- Check that record components that have per-object access discriminant --- constraints are finalized in the reverse order of their component --- declarations, and before any components that are not so constrained. --- --- TEST DESCRIPTION: --- The type List_Item is the "container" type. It holds two fields that --- have per-object access discriminant constraints, and two fields that --- are not discriminated. These four fields are all controlled types. --- A fifth field is a pointer used to maintain a linked list of these --- data objects. Each component is of a unique type which allows for --- the test to simply track the order of initialization and finalization. --- --- The types and their purpose are: --- Constrained_First - a controlled discriminated type --- Constrained_Second - a controlled discriminated type --- Simple_First - a controlled type with no discriminant --- Simple_Second - a controlled type with no discriminant --- --- The required order of operations: --- Initialize --- ( Simple_First | Simple_Second ) -- no "internal order" required --- Constrained_First --- Constrained_Second --- Finalize --- Constrained_Second --- Constrained_First --- ( Simple_First | Simple_Second ) -- must be inverse of init. --- --- --- CHANGE HISTORY: --- 23 MAY 95 SAIC Initial version --- 02 MAY 96 SAIC Reorganized for 2.1 --- 05 DEC 96 SAIC Simplified for 2.1; added init/fin ordering check --- 31 DEC 97 EDS Remove references to and uses of --- Initialization_Sequence ---! - ----------------------------------------------------------------- C760012_0 - -with Ada.Finalization; -with Ada.Unchecked_Deallocation; -package C760012_0 is - - type List_Item; - - type List is access all List_Item; - - package Firsts is -- distinguish first from second - type Constrained_First(Container : access List_Item) is - new Ada.Finalization.Limited_Controlled with null record; - procedure Initialize( T : in out Constrained_First ); - procedure Finalize ( T : in out Constrained_First ); - - type Simple_First is new Ada.Finalization.Controlled with - record - My_Init_Seq_Number : Natural; - end record; - procedure Initialize( T : in out Simple_First ); - procedure Finalize ( T : in out Simple_First ); - - end Firsts; - - type Constrained_Second(Container : access List_Item) is - new Ada.Finalization.Limited_Controlled with null record; - procedure Initialize( T : in out Constrained_Second ); - procedure Finalize ( T : in out Constrained_Second ); - - type Simple_Second is new Ada.Finalization.Controlled with - record - My_Init_Seq_Number : Natural; - end record; - procedure Initialize( T : in out Simple_Second ); - procedure Finalize ( T : in out Simple_Second ); - - -- by 3.8(18);6.0 the following type contains components constrained - -- by per-object expressions - - - type List_Item is new Ada.Finalization.Limited_Controlled - with record - ContentA : Firsts.Constrained_First( List_Item'Access ); -- C S - SimpleA : Firsts.Simple_First; -- A T - SimpleB : Simple_Second; -- A T - ContentB : Constrained_Second( List_Item'Access ); -- D R - Next : List; -- | | - end record; -- | | - procedure Initialize( L : in out List_Item ); ------------------+ | - procedure Finalize ( L : in out List_Item ); --------------------+ - - -- the tags are the same for SimpleA and SimpleB due to the fact that - -- the language does not specify an ordering with respect to this - -- component pair. 7.6(12) does specify the rest of the ordering. - - procedure Deallocate is new Ada.Unchecked_Deallocation(List_Item,List); - -end C760012_0; - --- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- - -with TCTouch; -package body C760012_0 is - - package body Firsts is - - procedure Initialize( T : in out Constrained_First ) is - begin - TCTouch.Touch('C'); ----------------------------------------------- C - end Initialize; - - procedure Finalize ( T : in out Constrained_First ) is - begin - TCTouch.Touch('S'); ----------------------------------------------- S - end Finalize; - - procedure Initialize( T : in out Simple_First ) is - begin - T.My_Init_Seq_Number := 0; - TCTouch.Touch('A'); ----------------------------------------------- A - end Initialize; - - procedure Finalize ( T : in out Simple_First ) is - begin - TCTouch.Touch('T'); ----------------------------------------------- T - end Finalize; - - end Firsts; - - procedure Initialize( T : in out Constrained_Second ) is - begin - TCTouch.Touch('D'); ------------------------------------------------- D - end Initialize; - - procedure Finalize ( T : in out Constrained_Second ) is - begin - TCTouch.Touch('R'); ------------------------------------------------- R - end Finalize; - - - procedure Initialize( T : in out Simple_Second ) is - begin - T.My_Init_Seq_Number := 0; - TCTouch.Touch('A'); ------------------------------------------------- A - end Initialize; - - procedure Finalize ( T : in out Simple_Second ) is - begin - TCTouch.Touch('T'); ------------------------------------------------- T - end Finalize; - - procedure Initialize( L : in out List_Item ) is - begin - TCTouch.Touch('F'); ------------------------------------------------- F - end Initialize; - - procedure Finalize ( L : in out List_Item ) is - begin - TCTouch.Touch('Q'); ------------------------------------------------- Q - end Finalize; - -end C760012_0; - ---------------------------------------------------------------------- C760012 - -with Report; -with TCTouch; -with C760012_0; -procedure C760012 is - - use type C760012_0.List; - - procedure Subtest_1 is - -- by 3.8(18);6.0 One_Of_Them is constrained by per-object constraints - -- 7.6.1(9);6.0 dictates the order of finalization of the components - - One_Of_Them : C760012_0.List_Item; - begin - if One_Of_Them.Next /= null then -- just to hold the subtest in place - Report.Failed("No default value for Next"); - end if; - end Subtest_1; - - List : C760012_0.List; - - procedure Subtest_2 is - begin - - List := new C760012_0.List_Item; - - List.Next := new C760012_0.List_Item; - - end Subtest_2; - - procedure Subtest_3 is - begin - - C760012_0.Deallocate( List.Next ); - - C760012_0.Deallocate( List ); - - end Subtest_3; - -begin -- Main test procedure. - - Report.Test ("C760012", "Check that record components that have " & - "per-object access discriminant constraints " & - "are initialized in the order of their " & - "component declarations, and after any " & - "components that are not so constrained. " & - "Check that record components that have " & - "per-object access discriminant constraints " & - "are finalized in the reverse order of their " & - "component declarations, and before any " & - "components that are not so constrained" ); - - Subtest_1; - TCTouch.Validate("AACDFQRSTT", "One object"); - - Subtest_2; - TCTouch.Validate("AACDFAACDF", "Two objects dynamically allocated"); - - Subtest_3; - TCTouch.Validate("QRSTTQRSTT", "Two objects deallocated"); - - Report.Result; - -end C760012; |