gomp-20050608-branch/gcc/testsuite/ada/acats/tests/cc/cc70b02.a

   1 -- CC70B02.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 such an actual parameter may
  29 --      be a formal parameter of a previously declared formal package
  30 --      (with a (<>) actual part). Check that a use clause in the generic
  31 --      formal part provides direct visibility of declarations within the
  32 --      generic formal package, including formal parameters (if the formal
  33 --      package has a (<>) actual part). Check that the scope of such a use
  34 --      clause extends to the generic subprogram body. Check that the visible
  35 --      part of the generic formal package includes the first list of basic
  36 --      declarative items of the package specification.
  37 --
  38 --      Check the case where the formal package is declared in a generic
  39 --      package.
  40 --
  41 -- TEST DESCRIPTION:
  42 --      Declare a list abstraction in a generic package which manages lists of
  43 --      elements of any nonlimited type (foundation code). Declare a second
  44 --      generic package which declares operations on discrete types. Declare
  45 --      a third generic package which combines the abstractions of the first
  46 --      two generics and declares operations on lists of elements of discrete
  47 --      types. Provide the third generic package with two formal parameters:
  48 --      (1) a generic formal package with the discrete operation package as
  49 --      template, and (2) a generic formal package with the list abstraction
  50 --      package as template. Use the formal discrete type of the discrete
  51 --      operations generic as the generic formal actual part for the second
  52 --      formal package. Include a use clause for the first formal package in
  53 --      the third generic package formal part.
  54 --
  55 -- TEST FILES:
  56 --      The following files comprise this test:
  57 --
  58 --         FC70B00.A
  59 --         CC70B02.A
  60 --
  61 --
  62 -- CHANGE HISTORY:
  63 --      06 Dec 94   SAIC    ACVC 2.0
  64 --
  65 --!
  66
  67 generic
  68    type Discrete_Type is (<>);  -- Discrete types only.
  69 package CC70B02_0 is            -- Discrete type operations.
  70
  71    procedure Double (Object : in out Discrete_Type);
  72
  73    -- ... Other operations on discrete objects.
  74
  75 end CC70B02_0;
  76
  77
  78      --==================================================================--
  79
  80
  81 package body CC70B02_0 is
  82
  83    procedure Double (Object : in out Discrete_Type) is
  84       Doubled_Position : Integer := Discrete_Type'Pos (Object) * 2;
  85    begin
  86       -- ... Error-checking code omitted for brevity.
  87       Object := Discrete_Type'Val (Doubled_Position);
  88    end Double;
  89
  90 end CC70B02_0;
  91
  92
  93      --==================================================================--
  94
  95
  96 with CC70B02_0;                  -- Discrete type operations.
  97 with FC70B00;                    -- List abstraction.
  98 generic
  99
 100    -- Import both the discrete-operation and list abstractions. To ensure that
 101    -- only list abstraction instances defining lists of *discrete* elements
 102    -- will be accepted as actuals to this generic, pass the formal discrete
 103    -- type from the discrete-operation abstraction as an actual parameter to
 104    -- the list-abstraction formal package.
 105    --
 106    -- Only list instances declared for the same discrete type as that used
 107    -- to instantiate the discrete-operation package will be accepted.
 108
 109    with package Discrete_Ops is new CC70B02_0 (<>);
 110
 111    use Discrete_Ops;             -- Discrete_Ops directly visible.
 112
 113    with package List_Mgr is new FC70B00 (Discrete_Type);  -- Discrete_Type is
 114                                                           -- formal parameter
 115                                                           -- of template for
 116                                                           -- Discrete_Ops.
 117 package CC70B02_1 is             -- Discrete list operations.
 118
 119    procedure Double_List (L : in out List_Mgr.List_Type);
 120
 121    -- ... Other operations on lists of discrete objects.
 122
 123 end CC70B02_1;
 124
 125
 126      --==================================================================--
 127
 128
 129 package body CC70B02_1 is
 130
 131    procedure Double_List (L : in out List_Mgr.List_Type) is
 132       Element : Discrete_Type;  -- Formal part of Discrete_Ops template
 133    begin                        -- is directly visible here.
 134       List_Mgr.Reset (L);
 135       while not List_Mgr.End_Of_List (L) loop
 136          List_Mgr.View_Element (L, Element);
 137          Double (Element);
 138          List_Mgr.Write_Element (L, Element);
 139       end loop;
 140    end Double_List;
 141
 142 end CC70B02_1;
 143
 144
 145      --==================================================================--
 146
 147
 148 with FC70B00;    -- Generic list abstraction.
 149 with CC70B02_0;  -- Generic discrete type operations.
 150 with CC70B02_1;  -- Generic discrete list operations.
 151
 152 with Report;
 153 procedure CC70B02 is
 154
 155    type Points is range 0 .. 100;                   -- Discrete type.
 156
 157    package Points_Ops is new CC70B02_0 (Points);    -- Points-type operations.
 158    package Lists_of_Points is new FC70B00 (Points); -- Points lists.
 159    package Points_List_Ops is new                   -- Points-list operations.
 160      CC70B02_1 (Points_Ops, Lists_Of_Points);
 161
 162    Scores : Lists_of_Points.List_Type;              -- List of points.
 163
 164
 165    -- Begin test code declarations: -----------------------
 166
 167    type TC_Score_Array is array (1 .. 3) of Points;
 168
 169    TC_Initial_Values : constant TC_Score_Array := (23, 15,  0);
 170    TC_Final_Values   : constant TC_Score_Array := (46, 30,  0);
 171
 172    TC_Correct_Initial_Values : Boolean := False;
 173    TC_Correct_Final_Values   : Boolean := False;
 174
 175
 176    procedure TC_Initialize_List (L : in out Lists_Of_Points.List_Type) is
 177    begin                                  -- Initial list contains 3 scores
 178       for I in TC_Score_Array'Range loop  -- with the values 23, 15, and 0.
 179          Lists_Of_Points.Add_Element (L, TC_Initial_Values(I));
 180       end loop;
 181    end TC_Initialize_List;
 182
 183
 184    procedure TC_Verify_List (L        : in out Lists_Of_Points.List_Type;
 185                              Expected : in     TC_Score_Array;
 186                              OK       :    out Boolean) is
 187       Actual : TC_Score_Array;
 188    begin                                  -- Verify that all scores have been
 189       Lists_Of_Points.Reset (L);          -- set to zero.
 190       for I in TC_Score_Array'Range loop
 191          Lists_Of_Points.Read_Element (L, Actual(I));
 192       end loop;
 193       OK := (Actual = Expected);
 194    end TC_Verify_List;
 195
 196    -- End test code declarations. -------------------------
 197
 198
 199 begin
 200    Report.Test ("CC70B02", "Check that a library-level generic package "      &
 201                 "may have a formal package as a formal parameter, and that "  &
 202                 "the generic formal actual part may specify explicit actual " &
 203                 "parameters (including a formal parameter of a previously "   &
 204                 "declared formal package). Check that a use clause is legal " &
 205                 "in the generic formal part");
 206
 207    TC_Initialize_List (Scores);
 208    TC_Verify_List (Scores, TC_Initial_Values, TC_Correct_Initial_Values);
 209
 210    if not TC_Correct_Initial_Values then
 211       Report.Failed ("List contains incorrect initial values");
 212    end if;
 213
 214    Points_List_Ops.Double_List (Scores);
 215    TC_Verify_List (Scores, TC_Final_Values, TC_Correct_Final_Values);
 216
 217    if not TC_Correct_Final_Values then
 218       Report.Failed ("List contains incorrect final values");
 219    end if;
 220
 221    Report.Result;
 222 end CC70B02;