diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/ca/ca11019.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/ca/ca11019.a | 306 |
1 files changed, 0 insertions, 306 deletions
diff --git a/gcc/testsuite/ada/acats/tests/ca/ca11019.a b/gcc/testsuite/ada/acats/tests/ca/ca11019.a deleted file mode 100644 index 92b3ba5358b..00000000000 --- a/gcc/testsuite/ada/acats/tests/ca/ca11019.a +++ /dev/null @@ -1,306 +0,0 @@ --- CA11019.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 body of the parent package may depend on one of its own --- private generic children. --- --- TEST DESCRIPTION: --- A scenario is created that demonstrates the potential of adding a --- generic private child during code maintenance without distubing a --- large subsystem. After child is added to the subsystem, a maintainer --- decides to take advantage of the new functionality and rewrites --- the parent's body. --- --- Declare a data collection abstraction in a package. Declare a private --- generic child of this package which provides parameterized code that --- have been written once and will be used three times to implement the --- services of the parent package. In the parent body, instantiate the --- private child. --- --- In the main program, check that the operations in the parent, --- and instance of the private child package perform as expected. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- 17 Nov 95 SAIC Update and repair for ACVC 2.0.1 --- ---! - -package CA11019_0 is - -- parent - - type Data_Record is tagged private; - type Data_Collection is private; - --- - --- - subtype Data_1 is integer range 0 .. 100; - procedure Add_1 (Data : Data_1; To : in out Data_Collection); - function Statistical_Op_1 (Data : Data_Collection) return Data_1; - --- - subtype Data_2 is integer range -100 .. 1000; - procedure Add_2 (Data : Data_2; To : in out Data_Collection); - function Statistical_Op_2 (Data : Data_Collection) return Data_2; - --- - subtype Data_3 is integer range -10_000 .. 10_000; - procedure Add_3 (Data : Data_3; To : in out Data_Collection); - function Statistical_Op_3 (Data : Data_Collection) return Data_3; - --- - -private - - type Data_Ptr is access Data_Record'class; - subtype Sequence_Number is positive range 1 .. 512; - - type Data_Record is tagged - record - Next : Data_Ptr := null; - Seq : Sequence_Number; - end record; - --- - type Data_Collection is - record - First : Data_Ptr := null; - Last : Data_Ptr := null; - end record; - -end CA11019_0; - -- parent - - --=================================================================-- - --- This generic package provides parameterized code that has been --- written once and will be used three times to implement the services --- of the parent package. - -private -generic - type Data_Type is range <>; - -package CA11019_0.CA11019_1 is - -- parent.child - - type Data_Elem is new Data_Record with - record - Value : Data_Type; - end record; - - Next_Avail_Seq_No : Sequence_Number := 1; - - procedure Sequence (Ptr : Data_Ptr); - -- the child must be private for this procedure to know details of - -- the implementation of data collections - - procedure Add (Datum : Data_Type; To : in out Data_Collection); - - function Op (Data : Data_Collection) return Data_Type; - -- op models a complicated operation that whose code can be - -- used for various data types - - -end CA11019_0.CA11019_1; - -- parent.child - - --=================================================================-- - - -package body CA11019_0.CA11019_1 is - -- parent.child - - procedure Sequence (Ptr : Data_Ptr) is - begin - Ptr.Seq := Next_Avail_Seq_No; - Next_Avail_Seq_No := Next_Avail_Seq_No + 1; - end Sequence; - - --------------------------------------------------------- - - procedure Add (Datum : Data_Type; To : in out Data_Collection) is - Ptr : Data_Ptr; - begin - if To.First = null then - -- assign new record with data value to - -- to.next <- null; - To.First := new Data_Elem'(Next => null, - Value => Datum, - Seq => 1); - Sequence (To.First); - To.Last := To.First; - else - -- chase to end of list - Ptr := To.First; - while Ptr.Next /= null loop - Ptr := Ptr.Next; - end loop; - -- and add element there - Ptr.Next := new Data_Elem'(Next => null, - Value => Datum, - Seq => 1); - Sequence (Ptr.Next); - To.Last := Ptr.Next; - end if; - - end Add; - - --------------------------------------------------------- - - function Op (Data : Data_Collection) return Data_Type is - -- for simplicity, just return the maximum of the data set - Max : Data_Type := Data_Elem( Data.First.all ).Value; - -- assuming non-empty collection - Ptr : Data_Ptr := Data.First; - - begin - -- no error checking - while Ptr.Next /= null loop - if Data_Elem( Ptr.Next.all ).Value > Max then - Max := Data_Elem( Ptr.Next.all ).Value; - end if; - Ptr := Ptr.Next; - end loop; - return Max; - end Op; - -end CA11019_0.CA11019_1; - -- parent.child - - --=================================================================-- - --- parent body depends on private generic child -with CA11019_0.CA11019_1; -- Private generic child. - -pragma Elaborate (CA11019_0.CA11019_1); -package body CA11019_0 is - - -- instantiate the generic child with data types needed by the - -- package interface services - package Data_1_Ops is new CA11019_1 - (Data_Type => Data_1); - - package Data_2_Ops is new CA11019_1 - (Data_Type => Data_2); - - package Data_3_Ops is new CA11019_1 - (Data_Type => Data_3); - - --------------------------------------------------------- - - procedure Add_1 (Data : Data_1; To : in out Data_Collection) is - begin - -- maybe do other stuff here - Data_1_Ops.Add (Data, To); - -- and here - end; - - --------------------------------------------------------- - - function Statistical_Op_1 (Data : Data_Collection) return Data_1 is - begin - -- maybe use generic operation(s) in some complicated ways - -- (but simplified out, for the sake of testing) - return Data_1_Ops.Op (Data); - end; - - --------------------------------------------------------- - - procedure Add_2 (Data : Data_2; To : in out Data_Collection) is - begin - Data_2_Ops.Add (Data, To); - end; - - --------------------------------------------------------- - - function Statistical_Op_2 (Data : Data_Collection) return Data_2 is - begin - return Data_2_Ops.Op (Data); - end; - - --------------------------------------------------------- - - procedure Add_3 (Data : Data_3; To : in out Data_Collection) is - begin - Data_3_Ops.Add (Data, To); - end; - - --------------------------------------------------------- - - function Statistical_Op_3 (Data : Data_Collection) return Data_3 is - begin - return Data_3_Ops.Op (Data); - end; - -end CA11019_0; - - - --=================================================-- - -with CA11019_0, - -- Main, - -- Main.Child is private - Report; - -procedure CA11019 is - - package Main renames CA11019_0; - - Col_1, - Col_2, - Col_3 : Main.Data_Collection; - -begin - - Report.Test ("CA11019", "Check that body of a (non-generic) package " & - "may depend on its private generic child"); - - -- build a data collection - - for I in 1 .. 10 loop - Main.Add_1 ( Main.Data_1(I), Col_1); - end loop; - - if Main.Statistical_Op_1 (Col_1) /= 10 then - Report.Failed ("Wrong data_1 value returned"); - end if; - - for I in reverse 10 .. 20 loop - Main.Add_2 ( Main.Data_2(I * 10), Col_2); - end loop; - - if Main.Statistical_Op_2 (Col_2) /= 200 then - Report.Failed ("Wrong data_2 value returned"); - end if; - - for I in 0 .. 10 loop - Main.Add_3 ( Main.Data_3(I + 5), Col_3); - end loop; - - if Main.Statistical_Op_3 (Col_3) /= 15 then - Report.Failed ("Wrong data_3 value returned"); - end if; - - Report.Result; - -end CA11019; |