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

   1 -- CA11012.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 package of a library level instantiation
  28 --      of a generic can be the instantiation of a child package of
  29 --      the generic. Check that the child instance can use its parent's
  30 --      declarations and operations, including a formal type of the parent.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      Declare a generic package which simulates an integer complex
  34 --      abstraction.  Declare a generic child package of this package
  35 --      which defines additional complex operations.
  36 --
  37 --      Instantiate the first generic package, then instantiate the child
  38 --      generic package as a child unit of the first instance.  In the main
  39 --      program, check that the operations in both instances perform as
  40 --      expected.
  41 --
  42 --
  43 -- CHANGE HISTORY:
  44 --      06 Dec 94   SAIC    ACVC 2.0
  45 --      21 Dec 94   SAIC    Corrected visibility errors for literals
  46 --      27 Feb 97   PWB.CTA Added elaboration pragma at package CA11012_3
  47 --!
  48
  49 generic               -- Complex number abstraction.
  50    type Int_Type is range <>;
  51
  52 package CA11012_0 is
  53
  54    -- Simulate a generic complex number support package. Complex numbers
  55    -- are treated as coordinates in the Cartesian plane.
  56
  57    type Complex_Type is private;
  58
  59    Zero : constant Complex_Type;                      -- Real number (0,0).
  60
  61    function Complex (Real, Imag : Int_Type)           -- Create a complex
  62      return Complex_Type;                             -- number.
  63
  64    function "-" (Right : Complex_Type)                -- Invert a complex
  65      return Complex_Type;                             -- number.
  66
  67    function "+" (Left, Right : Complex_Type)          -- Add two complex
  68      return Complex_Type;                             -- numbers.
  69
  70 private
  71    type Complex_Type is record
  72       Real : Int_Type;
  73       Imag : Int_Type;
  74    end record;
  75
  76    Zero : constant Complex_Type := (Real => 0, Imag => 0);
  77
  78 end CA11012_0;
  79
  80      --==================================================================--
  81
  82 package body CA11012_0 is
  83
  84    function Complex (Real, Imag : Int_Type) return Complex_Type is
  85    begin
  86       return (Real, Imag);
  87    end Complex;
  88    ---------------------------------------------------------------
  89    function "-" (Right : Complex_Type) return Complex_Type is
  90    begin
  91       return (-Right.Real, -Right.Imag);
  92    end "-";
  93    ---------------------------------------------------------------
  94    function "+" (Left, Right : Complex_Type) return Complex_Type is
  95    begin
  96       return ( (Left.Real + Right.Real, Left.Imag + Right.Imag) );
  97    end "+";
  98
  99 end CA11012_0;
 100
 101      --==================================================================--
 102
 103 -- Generic child of complex number package.  Child must be generic since
 104 -- parent is generic.
 105
 106 generic               -- Complex additional operations
 107
 108 package CA11012_0.CA11012_1 is
 109
 110    -- More operations on complex number. This child adds a layer of
 111    -- functionality to the parent generic.
 112
 113    function Real_Part (Complex_No : Complex_Type)
 114      return Int_Type;
 115
 116    function Imag_Part (Complex_No : Complex_Type)
 117      return Int_Type;
 118
 119    function "*" (Factor : Int_Type;
 120                  C      : Complex_Type) return Complex_Type;
 121
 122    function Vector_Magnitude (Complex_No : Complex_Type)
 123      return Int_Type;
 124
 125 end CA11012_0.CA11012_1;
 126
 127      --==================================================================--
 128
 129 package body CA11012_0.CA11012_1 is
 130
 131    function Real_Part (Complex_No : Complex_Type) return Int_Type is
 132    begin
 133       return (Complex_No.Real);
 134    end Real_Part;
 135    ---------------------------------------------------------------
 136    function Imag_Part (Complex_No : Complex_Type) return Int_Type is
 137    begin
 138       return (Complex_No.Imag);
 139    end Imag_Part;
 140    ---------------------------------------------------------------
 141    function "*" (Factor : Int_Type;
 142                  C      : Complex_Type) return Complex_Type is
 143       Result : Complex_Type := Zero;   -- Zero is declared in parent,
 144                                        -- Complex_Number
 145    begin
 146       for I in 1 .. abs (Factor) loop
 147          Result := Result + C;         -- Complex_Number "+"
 148       end loop;
 149
 150       if Factor < 0 then
 151          Result := - Result;           -- Complex_Number "-"
 152       end if;
 153
 154       return Result;
 155    end "*";
 156    ---------------------------------------------------------------
 157    function Vector_Magnitude (Complex_No : Complex_Type)
 158      return Int_Type is                -- Not a real vector magnitude.
 159    begin
 160       return (Complex_No.Real + Complex_No.Imag);
 161    end Vector_Magnitude;
 162
 163 end CA11012_0.CA11012_1;
 164
 165      --==================================================================--
 166
 167 package CA11012_2 is
 168
 169    subtype My_Integer is integer range -100 .. 100;
 170
 171    -- ... Various other types used by the application.
 172
 173 end CA11012_2;
 174
 175 -- No body for CA11012_2;
 176
 177      --==================================================================--
 178
 179 -- Declare instances of the generic complex packages for integer type.
 180 -- The instance of the child must itself be declared as a child of the
 181 -- instance of the parent.
 182
 183 with CA11012_0;                        -- Complex number abstraction
 184 with CA11012_2;                        -- Package containing integer type
 185 pragma Elaborate (CA11012_0);
 186 package CA11012_3 is new CA11012_0 (Int_Type => CA11012_2.My_Integer);
 187
 188 with CA11012_0.CA11012_1;              -- Complex additional operations
 189 with CA11012_3;
 190 package CA11012_3.CA11012_4 is new CA11012_3.CA11012_1;
 191
 192      --==================================================================--
 193
 194 with CA11012_2;                -- Package containing integer type
 195 with CA11012_3.CA11012_4;      -- Complex abstraction + additional operations
 196 with Report;
 197
 198 procedure CA11012 is
 199
 200    package My_Complex_Pkg renames CA11012_3;
 201
 202    package My_Complex_Operation renames CA11012_3.CA11012_4;
 203
 204    use My_Complex_Pkg,                                -- All user-defined
 205        My_Complex_Operation;                          -- operators directly
 206                                                       -- visible.
 207    Complex_One, Complex_Two : Complex_Type;
 208
 209 begin
 210
 211    Report.Test ("CA11012", "Check that child instance can use its parent's "  &
 212                            "declarations and operations, including a formal " &
 213                            "type of the parent");
 214
 215    Correct_Range_Test:
 216    declare
 217       My_Literal  : CA11012_2.My_Integer := -3;
 218
 219    begin
 220       Complex_One := Complex (-4, 7);          -- Operation from the generic
 221                                                -- parent package.
 222
 223       Complex_Two := My_Literal * Complex_One; -- Operation from the generic
 224                                                -- child package.
 225
 226       if Real_Part (Complex_Two) /= 12         -- Operation from the generic
 227         or Imag_Part (Complex_Two) /= -21      -- child package.
 228           then
 229              Report.Failed ("Incorrect results from complex operation");
 230       end if;
 231
 232    end Correct_Range_Test;
 233
 234    ---------------------------------------------------------------
 235
 236    Out_Of_Range_Test:
 237    declare
 238       My_Vector : CA11012_2.My_Integer;
 239
 240    begin
 241       Complex_One := Complex (70, 70);         -- Operation from the generic
 242                                                -- parent package.
 243       My_Vector := Vector_Magnitude (Complex_One);
 244                      -- Operation from the generic child package.
 245
 246       Report.Failed ("Exception not raised in child package");
 247
 248    exception
 249       when Constraint_Error =>
 250         Report.Comment ("Exception is raised as expected");
 251
 252       when others           =>
 253         Report.Failed ("Others exception is raised");
 254
 255    end Out_Of_Range_Test;
 256
 257    Report.Result;
 258
 259 end CA11012;