-- CC70C02.A -- -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and -- F08630-91-C-0015, 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 generic formal package is an instance. Specifically, -- check that a generic formal package may be passed as an actual -- parameter to another generic formal package. Check that the -- visible part of the generic formal package includes the first list of -- basic declarative items of the package specification. -- -- TEST DESCRIPTION: -- A generic formal package is a package, and is an instance. -- -- Declare a list type in a generic package for lists of elements of any -- nonlimited type (foundation code). Declare a second generic package -- which declares operations for the list type, and parameterize it with -- a generic formal package with the list-type package as template -- (foundation code). Declare a third generic package which declares -- additional operations for the list type, and parameterize it with two -- generic formal packages, one with the list-type package as template, -- the other with the second generic package as template. Use the first -- formal package as the generic formal actual part for the second formal -- package. -- -- TEST FILES: -- The following files comprise this test: -- -- FC70C00.A -- CC70C02.A -- -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- --! with FC70C00_0; -- List abstraction. with FC70C00_1; -- Basic list operations. generic -- Import both the list-type abstraction defined in FC70C00_0 and the basic -- list operations defined in FC70C00_1. To ensure that only basic operation -- instances for lists of the same element type as that used to instantiate -- the list type are accepted as actuals to this generic, pass the list-type -- formal package as an actual parameter to the list-operation formal -- package. with package Lists is new FC70C00_0 (<>); with package Basic_List_Ops is new FC70C00_1 (Lists); package CC70C02_0 is -- Additional list operations. End_of_List_Reached : exception; -- Read from current element and advance "current" pointer. procedure Read_Element (L : in out Lists.List_Type; E : out Lists.Element_Type); -- Add element to end of list. procedure Add_Element (L : in out Lists.List_Type; E : in Lists.Element_Type); end CC70C02_0; --==================================================================-- package body CC70C02_0 is procedure Read_Element (L : in out Lists.List_Type; E : out Lists.Element_Type) is begin if Basic_List_Ops.End_Of_List (L) then -- Use of op from the previous raise End_Of_List_Reached; -- generic package. else E := L.Current.Item; -- Retrieve current element. L.Current := L.Current.Next; -- Advance "current" pointer. end if; end Read_Element; procedure Add_Element (L : in out Lists.List_Type; E : in Lists.Element_Type) is New_Node : Lists.Node_Pointer := new Lists.Node_Type'(E, null); use type Lists.Node_Pointer; begin if L.First = null then -- No elements in list, so add new L.First := New_Node; -- element at beginning of list. else L.Last.Next := New_Node; -- Add new element at end of list. end if; L.Last := New_Node; -- Set last-in-list pointer. end Add_Element; end CC70C02_0; --==================================================================-- with FC70C00_0; -- Generic list type abstraction. with FC70C00_1; -- Generic list operations. with CC70C02_0; -- Additional generic list operations. with Report; procedure CC70C02 is type Points is range 0 .. 100; -- Discrete type. package Lists_of_Points is new FC70C00_0 (Points); -- Points lists. package Basic_Point_Ops is new -- Basic points-list ops. FC70C00_1 (Lists_Of_Points); package Points_List_Ops is new -- More points-list ops. CC70C02_0 (Lists => Lists_Of_Points, Basic_List_Ops => Basic_Point_Ops); Scores : Lists_of_Points.List_Type; -- List of points. -- Begin test code declarations: ----------------------- type TC_Score_Array is array (1 .. 3) of Points; TC_List_Values : constant TC_Score_Array := (23, 15, 0); TC_Correct_List_Values : Boolean := False; procedure TC_Initialize_List (L : in out Lists_Of_Points.List_Type) is begin -- Initial list contains 3 scores for I in TC_Score_Array'Range loop -- with the values 23, 15, and 0. Points_List_Ops.Add_Element (L, TC_List_Values(I)); end loop; end TC_Initialize_List; procedure TC_Verify_List (L : in out Lists_Of_Points.List_Type; Expected : in TC_Score_Array; OK : out Boolean) is Actual : TC_Score_Array; begin Basic_Point_Ops.Reset (L); for I in TC_Score_Array'Range loop Points_List_Ops.Read_Element (L, Actual(I)); end loop; OK := (Actual = Expected); end TC_Verify_List; -- End test code declarations. ------------------------- begin Report.Test ("CC70C02", "Check that a generic formal package may be " & "passed as an actual to another formal package"); TC_Initialize_List (Scores); TC_Verify_List (Scores, TC_List_Values, TC_Correct_List_Values); if not TC_Correct_List_Values then Report.Failed ("List contains incorrect values"); end if; Report.Result; end CC70C02;