gcc/testsuite/ada/acats/tests/ca/ca11013.a

   1 -- CA11013.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 child function of a library level instantiation
  28 --      of a generic can be the instantiation of a child function of
  29 --      the generic. Check that the child instance can use its parent's
  30 --      declarations and operations, including a formal subprogram of the
  31 --      parent.
  32 --
  33 -- TEST DESCRIPTION:
  34 --      Declare a generic package which simulates a real complex
  35 --      abstraction.  Declare a generic child function of this package
  36 --      which builds a random complex number.  Declare a second
  37 --      package which defines a random complex number generator.  This
  38 --      package provides actual parameters for the generic parent package.
  39 --
  40 --      Instantiate the first generic package, then instantiate the child
  41 --      generic function as a child unit of the first instance.  In the main
  42 --      program, check that the operations in both instances perform as
  43 --      expected.
  44 --
  45 --
  46 -- CHANGE HISTORY:
  47 --      06 Dec 94   SAIC    ACVC 2.0
  48 --      16 Nov 95   SAIC    Update and repair for ACVC 2.0.1
  49 --      19 Oct 96   SAIC    ACVC 2.1: Added pragma Elaborate to context
  50 --                          clause of CA11013_3.
  51 --      27 Feb 97   CTA.PWB Added elaboration pragma at package CA11013_3
  52 --!
  53
  54 generic               -- Complex number abstraction.
  55    type Real_Type is digits <>;
  56    with function Random_Generator (Seed : Real_Type) return Real_Type;
  57
  58 package CA11013_0 is
  59
  60    -- Simulate a generic complex number support package. Complex numbers
  61    -- are treated as coordinates in the Cartesian plane.
  62
  63    type Complex_Type is
  64      record
  65         Real : Real_Type;
  66         Imag : Real_Type;
  67      end record;
  68
  69    function Make (Real, Imag : Real_Type)           -- Create a complex
  70      return Complex_Type;                           -- number.
  71
  72    procedure Components (Complex_No           : in Complex_Type;
  73                          Real_Part, Imag_Part : out Real_Type);
  74
  75 end CA11013_0;
  76
  77      --==================================================================--
  78
  79 package body CA11013_0 is
  80
  81    function Make (Real, Imag : Real_Type) return Complex_Type is
  82    begin
  83       return (Real, Imag);
  84    end Make;
  85    -------------------------------------------------------------
  86    procedure Components (Complex_No           : in Complex_Type;
  87                          Real_Part, Imag_Part : out Real_Type) is
  88    begin
  89       Real_Part := Complex_No.Real;
  90       Imag_Part := Complex_No.Imag;
  91    end Components;
  92
  93 end CA11013_0;
  94
  95      --==================================================================--
  96
  97 -- Generic child of complex number package.  This child adds a layer of
  98 -- functionality to the parent generic.
  99
 100 generic               -- Random complex number operation.
 101
 102 function CA11013_0.CA11013_1 (Seed : Real_Type) return Complex_Type;
 103
 104                --==============================================--
 105
 106 function CA11013_0.CA11013_1 (Seed : Real_Type) return Complex_Type is
 107
 108    Random_Real_Part  :  Real_Type  := Random_Generator (Seed);
 109                                       -- parent's formal subprogram
 110    Random_Imag_Part  :  Real_Type
 111                      := Random_Generator (Random_Generator (Seed));
 112                                       -- parent's formal subprogram
 113    Random_Complex_No :  Complex_Type;
 114
 115 begin -- CA11013_0.CA11013_1
 116
 117    Random_Complex_No := Make (Random_Real_Part, Random_Imag_Part);
 118                                       -- operation from parent
 119    return (Random_Complex_No);
 120
 121 end CA11013_0.CA11013_1;
 122
 123      --==================================================================--
 124
 125 package CA11013_2 is
 126
 127    -- To be used as actual parameters for random number generator
 128    -- in the parent package.
 129
 130    type My_Float is digits 6 range -10.0 .. 100.0;
 131
 132    function Random_Complex (Seed : My_float) return My_Float;
 133
 134 end CA11013_2;
 135
 136      --==================================================================--
 137
 138 package body CA11013_2 is
 139
 140    -- Not a real random number generator.
 141    function Random_Complex (Seed : My_float) return My_Float is
 142    begin
 143       return (Seed + 3.0);
 144    end Random_Complex;
 145
 146 end CA11013_2;
 147
 148      --==================================================================--
 149
 150 -- Declare instances of the generic complex packages for real type.
 151 -- The instance of the child must itself be declared as a child of the
 152 -- instance of the parent.
 153
 154 with CA11013_0;                       -- Complex number.
 155 with CA11013_2;                       -- Random number generator.
 156 pragma Elaborate (CA11013_0);
 157 package CA11013_3 is new
 158   CA11013_0 (Random_Generator => CA11013_2.Random_Complex,
 159              Real_Type        => CA11013_2.My_Float);
 160
 161 with CA11013_0.CA11013_1;             -- Random complex number operation.
 162 with CA11013_3;
 163 pragma Elaborate (CA11013_3);
 164 function CA11013_3.CA11013_4 is new CA11013_3.CA11013_1;
 165
 166      --==================================================================--
 167
 168 with Report;
 169 with CA11013_2;                       -- Random number generator.
 170 with CA11013_3.CA11013_4;             -- Complex abstraction + Random complex
 171                                       -- number operation.
 172 procedure CA11013 is
 173
 174    package My_Complex_Pkg renames CA11013_3;
 175    use type CA11013_2.My_Float;
 176
 177    My_Complex                 : My_Complex_Pkg.Complex_Type;
 178    My_Literal                 : CA11013_2.My_Float := 3.0;
 179    My_Real_Part, My_Imag_Part : CA11013_2.My_Float;
 180
 181 begin
 182
 183    Report.Test ("CA11013", "Check that child instance can use its parent's "  &
 184                            "declarations and operations, including a formal " &
 185                            "subprogram of the parent");
 186
 187    My_Complex := CA11013_3.CA11013_4 (My_Literal);
 188                  -- Operation from the generic child function.
 189
 190    My_Complex_Pkg.Components (My_Complex, My_Real_Part, My_Imag_Part);
 191                  -- Operation from the generic parent package.
 192
 193    if My_Real_Part /= 6.0           -- Operation from the generic
 194      or My_Imag_Part /= 9.0         -- parent package.
 195        then
 196          Report.Failed ("Incorrect results from complex operation");
 197    end if;
 198
 199    Report.Result;
 200
 201 end CA11013;