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

   1 -- CC51A01.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, in an instance, each implicit declaration of a user-defined
  28 --      subprogram of a formal derived record type declares a view of the
  29 --      corresponding primitive subprogram of the ancestor, even if the
  30 --      primitive subprogram has been overridden for the actual type.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      Declare a "fraction" type abstraction in a package (foundation code).
  34 --      Declare a "fraction" I/O routine in a generic package with a formal
  35 --      derived type whose ancestor type is the fraction type declared in
  36 --      the first package. Within the I/O routine, call other operations of
  37 --      ancestor type. Derive from the root fraction type in another package
  38 --      and override one of the operations called in the generic I/O routine.
  39 --      Derive from the derivative of the root fraction type. Instantiate
  40 --      the generic package for each of the three types and call the I/O
  41 --      routine.
  42 --
  43 -- TEST FILES:
  44 --      The following files comprise this test:
  45 --
  46 --         FC51A00.A
  47 --         CC51A01.A
  48 --
  49 --
  50 -- CHANGE HISTORY:
  51 --      06 Dec 94   SAIC    ACVC 2.0
  52 --
  53 --!
  54
  55 with FC51A00;         -- Fraction type abstraction.
  56 generic               -- Fraction I/O support.
  57    type Fraction is new FC51A00.Fraction_Type;     -- Formal derived type of a
  58 package CC51A01_0 is                               -- (private) record type.
  59
  60    -- Simulate writing a fraction to standard output. In a real application,
  61    -- this subprogram might be a procedure which uses Text_IO routines. For
  62    -- the purposes of the test, the "output" is returned to the caller as a
  63    -- string.
  64    function Put (Item : in Fraction) return String;
  65
  66    -- ... Other I/O operations for fractions.
  67
  68 end CC51A01_0;
  69
  70
  71      --==================================================================--
  72
  73
  74 package body CC51A01_0 is
  75
  76    function Put (Item : in Fraction) return String is
  77       Num : constant String :=              -- Fraction's primitive subprograms
  78         Integer'Image (Numerator (Item));   -- are inherited from its parent
  79       Den : constant String :=              -- (FC51A00.Fraction_Type) and NOT
  80         Integer'Image (Denominator (Item)); -- from the actual type.
  81    begin
  82       return (Num & '/' & Den);
  83    end Put;
  84
  85 end CC51A01_0;
  86
  87
  88      --==================================================================--
  89
  90
  91 with FC51A00;         -- Fraction type abstraction.
  92 package CC51A01_1 is
  93
  94    -- Derive directly from the root type of the class and override one of the
  95    -- primitive subprograms.
  96
  97    type Pos_Fraction is new FC51A00.Fraction_Type;     -- Derived directly from
  98                                                        -- root type of class.
  99    -- Inherits "/" from root type.
 100    -- Inherits "-" from root type.
 101    -- Inherits Numerator from root type.
 102    -- Inherits Denominator from root type.
 103
 104    -- Return absolute value of numerator as integer.
 105    function Numerator (Frac : Pos_Fraction)            -- Overrides parent's
 106      return Integer;                                   -- operation.
 107
 108 end CC51A01_1;
 109
 110
 111      --==================================================================--
 112
 113
 114 package body CC51A01_1 is
 115
 116    -- This body should never be called.
 117    --
 118    -- The test sends the function Numerator a fraction with a negative
 119    -- numerator, and expects this negative numerator to be returned. This
 120    -- version of the function returns the absolute value of the numerator.
 121    -- Thus, a call to this version is detectable by examining the sign
 122    -- of the return value.
 123
 124    function Numerator (Frac : Pos_Fraction) return Integer is
 125       Converted_Frac : FC51A00.Fraction_Type := FC51A00.Fraction_Type (Frac);
 126       Orig_Numerator : Integer := FC51A00.Numerator (Converted_Frac);
 127    begin
 128       return abs (Orig_Numerator);
 129    end Numerator;
 130
 131 end CC51A01_1;
 132
 133
 134      --==================================================================--
 135
 136
 137 with FC51A00;     -- Fraction type abstraction.
 138 with CC51A01_0;   -- Fraction I/O support.
 139 with CC51A01_1;   -- Positive fraction type abstraction.
 140
 141 with Report;
 142 procedure CC51A01 is
 143
 144    type Distance is new CC51A01_1.Pos_Fraction;    -- Derived indirectly from
 145                                                    -- root type of class.
 146    -- Inherits "/" indirectly from root type.
 147    -- Inherits "-" indirectly from root type.
 148    -- Inherits Numerator directly from parent type.
 149    -- Inherits Denominator indirectly from root type.
 150
 151    use FC51A00, CC51A01_1;                         -- All primitive subprograms
 152                                                    -- directly visible.
 153
 154    package Fraction_IO     is new CC51A01_0 (Fraction_Type);
 155    package Pos_Fraction_IO is new CC51A01_0 (Pos_Fraction);
 156    package Distance_IO     is new CC51A01_0 (Distance);
 157
 158    -- For each of the instances above, the subprogram "Put" should produce
 159    -- the same result. That is, the primitive subprograms called by Put
 160    -- should in all cases be those of the type Fraction_Type, which is the
 161    -- ancestor type for the formal derived type in the generic unit. In
 162    -- particular, for Pos_Fraction_IO and Distance_IO, the versions of
 163    -- Numerator called should NOT be those of the actual types, which override
 164    -- Fraction_Type's version.
 165
 166    TC_Expected_Result : constant String := "-3/ 16";
 167
 168    TC_Root_Type_Of_Class  : Fraction_Type := -3/16;
 169    TC_Direct_Derivative   : Pos_Fraction  := -3/16;
 170    TC_Indirect_Derivative : Distance      := -3/16;
 171
 172 begin
 173    Report.Test ("CC51A01", "Check that, in an instance, each implicit "     &
 174                 "declaration of a user-defined subprogram of a formal "     &
 175                 "derived record type declares a view of the corresponding " &
 176                 "primitive subprogram of the ancestor, even if the "        &
 177                 "primitive subprogram has been overridden for the actual "  &
 178                 "type");
 179
 180    if (Fraction_IO.Put (TC_Root_Type_Of_Class) /= TC_Expected_Result) then
 181       Report.Failed ("Wrong result for root type");
 182    end if;
 183
 184    if (Pos_Fraction_IO.Put (TC_Direct_Derivative) /= TC_Expected_Result) then
 185       Report.Failed ("Wrong result for direct derivative");
 186    end if;
 187
 188    if (Distance_IO.Put (TC_Indirect_Derivative) /= TC_Expected_Result) then
 189       Report.Failed ("Wrong result for INdirect derivative");
 190    end if;
 191
 192    Report.Result;
 193 end CC51A01;