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

   1 -- CC70002.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 these actual parameters may
  29 --      be formal types, formal objects, and formal subprograms. Check that
  30 --      the visible part of the generic formal package includes the first list
  31 --      of basic declarative items of the package specification, and that if
  32 --      the formal package actual part is (<>), it also includes the generic
  33 --      formal part of the template for the formal package.
  34 --
  35 -- TEST DESCRIPTION:
  36 --      Declare a generic package which defines a "signature" for mathematical
  37 --      groups. Declare a second generic package which defines a
  38 --      two-dimensional matrix abstraction. Declare a third generic package
  39 --      which provides mathematical group operations for two-dimensional
  40 --      matrices. Provide this third generic with two formal parameters: (1)
  41 --      a generic formal package with the second generic as template and a
  42 --      (<>) actual part, and (2) a generic formal package with the first
  43 --      generic as template and an actual part that takes a formal type,
  44 --      object, and subprogram from the first formal package as actuals.
  45 --
  46 --
  47 -- CHANGE HISTORY:
  48 --      06 Dec 94   SAIC    ACVC 2.0
  49 --
  50 --!
  51
  52 generic              -- Mathematical group signature.
  53
  54    type Group_Type is private;
  55
  56    Identity : in Group_Type;
  57
  58    with function Operation (Left, Right : Group_Type) return Group_Type;
  59 -- with function Inverse... (omitted for brevity).
  60
  61 package CC70002_0 is
  62
  63    function Power (Left : Group_Type; Right : Integer) return Group_Type;
  64
  65    -- ... Other group operations.
  66
  67 end CC70002_0;
  68
  69
  70      --==================================================================--
  71
  72
  73 package body CC70002_0 is
  74
  75    -- The implementation of Power is purely artificial; the validity of its
  76    -- implementation in the context of the abstraction is irrelevant to the
  77    -- feature being tested.
  78
  79    function Power (Left : Group_Type; Right : Integer) return Group_Type is
  80       Result : Group_Type := Identity;
  81    begin
  82       Result := Operation (Result, Left);  -- All this really does is add
  83       return Result;                       -- one to each matrix element.
  84    end Power;
  85
  86 end CC70002_0;
  87
  88
  89      --==================================================================--
  90
  91
  92 generic          -- 2D matrix abstraction.
  93    type Element_Type is range <>;
  94
  95    type Abscissa is range <>;
  96    type Ordinate is range <>;
  97
  98    type Matrix_2D is array (Abscissa, Ordinate) of Element_Type;
  99 package CC70002_1 is
 100
 101    Add_Ident : constant Matrix_2D := (Abscissa => (others => 1));
 102                                                           -- Artificial for
 103                                                           -- testing purposes.
 104    -- ... Other identity matrices.
 105
 106
 107    function "+" (A, B : Matrix_2D) return Matrix_2D;
 108
 109    -- ... Other operations.
 110
 111 end CC70002_1;
 112
 113
 114      --==================================================================--
 115
 116
 117 package body CC70002_1 is
 118
 119    function "+" (A, B : Matrix_2D) return Matrix_2D is
 120       C : Matrix_2D;
 121    begin
 122       for I in Abscissa loop
 123          for J in Ordinate loop
 124             C(I,J) := A(I,J) + B(I,J);
 125          end loop;
 126       end loop;
 127       return C;
 128    end "+";
 129
 130 end CC70002_1;
 131
 132
 133      --==================================================================--
 134
 135
 136 with CC70002_0;  -- Mathematical group signature.
 137 with CC70002_1;  -- 2D matrix abstraction.
 138
 139 generic          -- Mathematical 2D matrix addition group.
 140
 141    with package Matrix_Ops is new CC70002_1 (<>);
 142
 143    -- Although the restriction of the formal package below to signatures
 144    -- describing addition groups, and then only for 2D matrices, is rather
 145    -- artificial in the context of this "application," the passing of types,
 146    -- objects, and subprograms as actuals to a formal package is not.
 147
 148    with package Math_Sig is new CC70002_0
 149      (Group_Type => Matrix_Ops.Matrix_2D,
 150       Identity   => Matrix_Ops.Add_Ident,
 151       Operation  => Matrix_Ops."+");
 152
 153 package CC70002_2 is
 154
 155    -- Add two matrices that are to be multiplied by coefficients:
 156    -- [ ] = CA*[ ] + CB*[ ].
 157
 158    function Add_Matrices_With_Coefficients (A  : Matrix_Ops.Matrix_2D;
 159                                             CA : Integer;
 160                                             B  : Matrix_Ops.Matrix_2D;
 161                                             CB : Integer)
 162      return Matrix_Ops.Matrix_2D;
 163
 164    -- ...Other operations.
 165
 166 end CC70002_2;
 167
 168
 169      --==================================================================--
 170
 171
 172 package body CC70002_2 is
 173
 174    function Add_Matrices_With_Coefficients (A  : Matrix_Ops.Matrix_2D;
 175                                             CA : Integer;
 176                                             B  : Matrix_Ops.Matrix_2D;
 177                                             CB : Integer)
 178      return Matrix_Ops.Matrix_2D is
 179       Left, Right : Matrix_Ops.Matrix_2D;
 180    begin
 181       Left  := Math_Sig.Power (A, CA);      -- Multiply 1st array by its coeff.
 182       Right := Math_Sig.Power (B, CB);      -- Multiply 2nd array by its coeff.
 183       return (Matrix_Ops."+" (Left, Right));-- Add these two arrays.
 184    end Add_Matrices_With_Coefficients;
 185
 186 end CC70002_2;
 187
 188
 189      --==================================================================--
 190
 191
 192 with CC70002_0;  -- Mathematical group signature.
 193 with CC70002_1;  -- 2D matrix abstraction.
 194 with CC70002_2;  -- Mathematical 2D matrix addition group.
 195
 196 with Report;
 197 procedure CC70002 is
 198
 199    subtype Cell_Type     is Positive range 1 .. 3;
 200    subtype Category_Type is Positive range 1 .. 2;
 201
 202    type Data_Points is new Natural range 0 .. 100;
 203
 204    type Table_Type is array (Cell_Type, Category_Type) of Data_Points;
 205
 206    package Data_Table_Support is new CC70002_1 (Data_Points,
 207                                                 Cell_Type,
 208                                                 Category_Type,
 209                                                 Table_Type);
 210
 211    package Data_Table_Addition_Group is new CC70002_0
 212      (Group_Type => Table_Type,
 213       Identity   => Data_Table_Support.Add_Ident,
 214       Operation  => Data_Table_Support."+");
 215
 216    package Table_Add_Ops is new CC70002_2
 217      (Data_Table_Support, Data_Table_Addition_Group);
 218
 219
 220    Scores_Table : Table_Type := ( (  12,   0),
 221                                   (  21,  33),
 222                                   (  49,   9) );
 223    Expected     : Table_Type := ( (  26,   2),
 224                                   (  44,  68),
 225                                   ( 100,  20) );
 226
 227 begin
 228    Report.Test ("CC70002", "Check that a generic formal package actual " &
 229                 "part may specify formal objects, formal subprograms, " &
 230                 "and formal types");
 231
 232    Scores_Table := Table_Add_Ops.Add_Matrices_With_Coefficients
 233                      (Scores_Table, 2,
 234                       Scores_Table, 1);
 235
 236    if (Scores_Table /= Expected) then
 237       Report.Failed ("Incorrect result for multi-dimensional array");
 238    end if;
 239
 240    Report.Result;
 241 end CC70002;