gcc/testsuite/ada/acats/tests/cc/cc70b01.a

   1 -- CC70B01.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that a formal package actual part may specify actual parameters
  28 --      for a generic formal package. Check that a use clause in the generic
  29 --      formal part provides direct visibility of declarations within the
  30 --      generic formal package. Check that the scope of such a use clause
  31 --      extends to the generic subprogram body. Check that the visible part of
  32 --      the generic formal package includes the first list of basic
  33 --      declarative items of the package specification.
  34 --
  35 --      Check the case where the formal package is declared in a generic
  36 --      subprogram.
  37 --
  38 -- TEST DESCRIPTION:
  39 --      Declare a list abstraction in a generic package which manages lists of
  40 --      elements of any nonlimited type (foundation code). Declare a generic
  41 --      subprogram which operates on lists of elements of discrete types.
  42 --      Provide the generic subprogram with two formal parameters: (1) a
  43 --      formal discrete type which represents a list element type, and (2) a
  44 --      generic formal package with the list abstraction package as template.
  45 --      Use the formal discrete type as the generic formal actual part for the
  46 --      formal package. Include a use clause for the formal package in the
  47 --      generic subprogram formal part.
  48 --
  49 -- TEST FILES:
  50 --      The following files comprise this test:
  51 --
  52 --         FC70B00.A
  53 --         CC70B01.A
  54 --
  55 --
  56 -- CHANGE HISTORY:
  57 --      06 Dec 94   SAIC    ACVC 2.0
  58 --
  59 --!
  60
  61 -- Declare a generic subprogram which performs an operation on lists of
  62 -- discrete objects.
  63
  64 with FC70B00;  -- Generic list abstraction.
  65 generic
  66
  67    -- Import the list abstraction defined in FC70B00. To ensure that only
  68    -- list abstraction instances defining lists of *discrete* elements will be
  69    -- accepted as actuals to this generic, declare a formal discrete type and
  70    -- pass it as an actual parameter to the formal package.
  71    --
  72    -- Only instances declared for the same discrete type as that used to
  73    -- instantiate this generic subprogram will be accepted.
  74
  75    type Elem_Type is (<>);                  -- Discrete types only.
  76    with package List_Mgr is new FC70B00 (Elem_Type);
  77
  78    use List_Mgr;                            -- Use clause for formal package.
  79
  80 procedure CC70B01_0 (L : in out List_Type); -- List_Mgr.List_Type directly
  81                                             -- visible.
  82
  83
  84      --==================================================================--
  85
  86
  87 procedure CC70B01_0 (L : in out List_Type) is  -- Declarations in List_Mgr
  88 begin                                          -- still directly visible.
  89    Reset (L);
  90    while not End_Of_List (L) loop
  91       Write_Element (L, Elem_Type'First);      -- This statement assumes
  92    end loop;                                   -- Elem_Type is discrete.
  93 end CC70B01_0;
  94
  95
  96      --==================================================================--
  97
  98
  99 with FC70B00;    -- Generic list abstraction.
 100 with CC70B01_0;  -- Generic "zeroing" operation for lists of discrete types.
 101
 102 with Report;
 103 procedure CC70B01 is
 104
 105    type Points is range 0 .. 10;                    -- Discrete type.
 106    package Lists_of_Scores is new FC70B00 (Points); -- List-of-points
 107                                                     -- abstraction.
 108    Scores : Lists_of_Scores.List_Type;              -- List of points.
 109
 110    procedure Reset_All_Scores is new                -- Operation on lists of
 111      CC70B01_0 (Points, Lists_of_Scores);           -- points.
 112
 113
 114    -- Begin test code declarations: -----------------------
 115
 116    type TC_Score_Array is array (1 .. 3) of Points;
 117
 118    TC_Initial_Values : constant TC_Score_Array := (2, 4, 6);
 119    TC_Final_Values   : constant TC_Score_Array := (0, 0, 0);
 120
 121    TC_Correct_Initial_Values : Boolean := False;
 122    TC_Correct_Final_Values   : Boolean := False;
 123
 124
 125    procedure TC_Initialize_List (L : in out Lists_of_Scores.List_Type) is
 126    begin                                  -- Initial list contains 3 scores
 127       for I in TC_Score_Array'Range loop  -- with the values 2, 4, and 6.
 128          Lists_of_Scores.Add_Element (L, TC_Initial_Values(I));
 129       end loop;
 130    end TC_Initialize_List;
 131
 132
 133    procedure TC_Verify_List (L        : in out Lists_of_Scores.List_Type;
 134                              Expected : in     TC_Score_Array;
 135                              OK       :    out Boolean) is
 136       Actual : TC_Score_Array;
 137    begin                                  -- Verify that all scores have been
 138       Lists_of_Scores.Reset (L);          -- set to zero.
 139       for I in TC_Score_Array'Range loop
 140          Lists_of_Scores.Read_Element (L, Actual(I));
 141       end loop;
 142       OK := (Actual = Expected);
 143    end TC_Verify_List;
 144
 145    -- End test code declarations. -------------------------
 146
 147
 148 begin
 149    Report.Test ("CC70B01", "Check that a library-level generic subprogram "   &
 150                 "may have a formal package as a formal parameter, and that "  &
 151                 "the generic formal actual part may specify explicit actual " &
 152                 "parameters. Check that a use clause is legal in the "        &
 153                 "generic formal part");
 154
 155    TC_Initialize_List (Scores);
 156    TC_Verify_List (Scores, TC_Initial_Values, TC_Correct_Initial_Values);
 157
 158    if not TC_Correct_Initial_Values then
 159       Report.Failed ("List contains incorrect initial values");
 160    end if;
 161
 162    Reset_All_Scores (Scores);
 163    TC_Verify_List (Scores, TC_Final_Values, TC_Correct_Final_Values);
 164
 165    if not TC_Correct_Final_Values then
 166       Report.Failed ("List contains incorrect final values");
 167    end if;
 168
 169    Report.Result;
 170 end CC70B01;