diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/ca/ca11020.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/ca/ca11020.a | 238 |
1 files changed, 0 insertions, 238 deletions
diff --git a/gcc/testsuite/ada/acats/tests/ca/ca11020.a b/gcc/testsuite/ada/acats/tests/ca/ca11020.a deleted file mode 100644 index 4949ce9feee..00000000000 --- a/gcc/testsuite/ada/acats/tests/ca/ca11020.a +++ /dev/null @@ -1,238 +0,0 @@ --- CA11020.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 generic parent package can depend on one of --- its own public generic children. --- --- TEST DESCRIPTION: --- A scenario is created that demonstrates the potential of adding a --- public generic 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 bag abstraction in a generic package. Declare a public --- generic child of this package which adds a generic procedure to the --- original subsystem. In the parent body, instantiate the public --- child. Then instantiate the procedure as a child instance of the --- public child instance. --- --- In the main program, declare an instance of parent. Check that the --- operations in both parent and child packages perform as expected. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - --- Simulates bag application. - -generic - type Element is private; - with function Image (E : Element) return String; - -package CA11020_0 is - - type Bag is limited private; - - procedure Add (E : in Element; To_The_Bag : in out Bag); - - function Bag_Image (B : Bag) return string; - -private - type Node_Type; - type Bag is access Node_Type; - - type Node_Type is - record - The_Element : Element; - - -- Other components in real application, i.e., - -- The_Count : positive; - - Next : Bag; - end record; - -end CA11020_0; - - --==================================================================-- - --- More operations on Bag. - -generic - --- Parameters go here. - -package CA11020_0.CA11020_1 is - - -- ... Other declarations. - - generic -- Generic iterator procedure. - with procedure Use_Element (E : in Element); - - procedure Iterate (B : in Bag); -- Called once per element in the bag. - - -- ... Various other operations. - -end CA11020_0.CA11020_1; - - --==================================================================-- - -package body CA11020_0.CA11020_1 is - - procedure Iterate (B : in Bag) is - - -- Traverse each element in the bag. - - Elem : Bag := B; - - begin - while Elem /= null loop - Use_Element (Elem.The_Element); - Elem := Elem.Next; - end loop; - - end Iterate; - -end CA11020_0.CA11020_1; - - --==================================================================-- - -with CA11020_0.CA11020_1; -- Public generic child package. - -package body CA11020_0 is - - ---------------------------------------------------- - -- Parent's body depends on public generic child. -- - ---------------------------------------------------- - - -- Instantiate the public child. - - package MS is new CA11020_1; - - function Bag_Image (B : Bag) return string is - - Buffer : String (1 .. 10_000); - Last : Integer := 0; - - ----------------------------------------------------- - - -- Will be called by the iterator. - - procedure Append_Image (E : in Element) is - Im : constant String := Image (E); - - begin -- Append_Image - if Last /= 0 then -- Insert a comma. - Last := Last + 1; - Buffer (Last) := ','; - end if; - - Buffer (Last + 1 .. Last + Im'Length) := Im; - Last := Last + Im'Length; - - end Append_Image; - - ----------------------------------------------------- - - -- Instantiate procedure Iterate as a child of instance MS. - - procedure Append_All is new MS.Iterate (Use_Element => Append_Image); - - begin -- Bag_Image - - Append_All (B); - - return Buffer (1 .. Last); - - end Bag_Image; - - ----------------------------------------------------- - - procedure Add (E : in Element; To_The_Bag : in out Bag) is - - -- Not a real bag addition. - - Index : Bag := To_The_Bag; - - begin - -- ... Error-checking code omitted for brevity. - - if Index = null then - To_The_Bag := new Node_Type' (The_Element => E, - Next => null); - else - -- Goto the end of the list. - - while Index.Next /= null loop - Index := Index.Next; - end loop; - - -- Add element to the end of the list. - - Index.Next := new Node_Type' (The_Element => E, - Next => null); - end if; - - end Add; - -end CA11020_0; - - --==================================================================-- - -with CA11020_0; -- Bag application. - -with Report; - -procedure CA11020 is - - -- Instantiate the bag application for integer type and attribute - -- Image. - - package Bag_Of_Integers is new CA11020_0 (Integer, Integer'Image); - - My_Bag : Bag_Of_Integers.Bag; - -begin - - Report.Test ("CA11020", "Check that body of the generic parent package " & - "can depend on one of its own public generic children"); - - -- Add 10 consecutive integers to the bag. - - for I in 1 .. 10 loop - Bag_Of_Integers.Add (I, My_Bag); - end loop; - - if Bag_Of_Integers.Bag_Image (My_Bag) - /= " 1, 2, 3, 4, 5, 6, 7, 8, 9, 10" then - Report.Failed ("Incorrect results"); - end if; - - Report.Result; - -end CA11020; |