Subversion Repositories openrisc_me

-- CC51A01.A

--

--                             Grant of Unlimited Rights

--

--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,

--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained

--     unlimited rights in the software and documentation contained herein.

--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making

--     this public release, the Government intends to confer upon all

--     recipients unlimited rights  equal to those held by the Government.

--     These rights include rights to use, duplicate, release or disclose the

--     released technical data and computer software in whole or in part, in

--     any manner and for any purpose whatsoever, and to have or permit others

--     to do so.

--

--                                    DISCLAIMER

--

--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR

--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED

--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE

--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE

--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A

--     PARTICULAR PURPOSE OF SAID MATERIAL.

--*

--

-- OBJECTIVE:

--      Check that, in an instance, each implicit declaration of a user-defined

--      subprogram of a formal derived record type declares a view of the

--      corresponding primitive subprogram of the ancestor, even if the

--      primitive subprogram has been overridden for the actual type.

--

-- TEST DESCRIPTION:

--      Declare a "fraction" type abstraction in a package (foundation code).

--      Declare a "fraction" I/O routine in a generic package with a formal

--      derived type whose ancestor type is the fraction type declared in

--      the first package. Within the I/O routine, call other operations of

--      ancestor type. Derive from the root fraction type in another package

--      and override one of the operations called in the generic I/O routine.

--      Derive from the derivative of the root fraction type. Instantiate

--      the generic package for each of the three types and call the I/O

--      routine.

--

-- TEST FILES:

--      The following files comprise this test:

--

--         FC51A00.A

--         CC51A01.A

--

--

-- CHANGE HISTORY:

--      06 Dec 94   SAIC    ACVC 2.0

--

--!

with FC51A00;         -- Fraction type abstraction.

generic               -- Fraction I/O support.

   type Fraction is new FC51A00.Fraction_Type;     -- Formal derived type of a

package CC51A01_0 is                               -- (private) record type.

   -- Simulate writing a fraction to standard output. In a real application,

   -- this subprogram might be a procedure which uses Text_IO routines. For

   -- the purposes of the test, the "output" is returned to the caller as a

   -- string.

   function Put (Item : in Fraction) return String;

   -- ... Other I/O operations for fractions.

end CC51A01_0;

     --==================================================================--

package body CC51A01_0 is

   function Put (Item : in Fraction) return String is

      Num : constant String :=              -- Fraction's primitive subprograms

        Integer'Image (Numerator (Item));   -- are inherited from its parent

      Den : constant String :=              -- (FC51A00.Fraction_Type) and NOT

        Integer'Image (Denominator (Item)); -- from the actual type.

   begin

      return (Num & '/' & Den);

   end Put;

end CC51A01_0;

     --==================================================================--

with FC51A00;         -- Fraction type abstraction.

package CC51A01_1 is

   -- Derive directly from the root type of the class and override one of the

   -- primitive subprograms.

   type Pos_Fraction is new FC51A00.Fraction_Type;     -- Derived directly from

                                                       -- root type of class.

   -- Inherits "/" from root type.

   -- Inherits "-" from root type.

   -- Inherits Numerator from root type.

   -- Inherits Denominator from root type.

   -- Return absolute value of numerator as integer.

   function Numerator (Frac : Pos_Fraction)            -- Overrides parent's

     return Integer;                                   -- operation.

end CC51A01_1;

     --==================================================================--

package body CC51A01_1 is

   -- This body should never be called.

   --

   -- The test sends the function Numerator a fraction with a negative

   -- numerator, and expects this negative numerator to be returned. This

   -- version of the function returns the absolute value of the numerator.

   -- Thus, a call to this version is detectable by examining the sign

   -- of the return value.

   function Numerator (Frac : Pos_Fraction) return Integer is

      Converted_Frac : FC51A00.Fraction_Type := FC51A00.Fraction_Type (Frac);

      Orig_Numerator : Integer := FC51A00.Numerator (Converted_Frac);

   begin

      return abs (Orig_Numerator);

   end Numerator;

end CC51A01_1;

     --==================================================================--

with FC51A00;     -- Fraction type abstraction.

with CC51A01_0;   -- Fraction I/O support.

with CC51A01_1;   -- Positive fraction type abstraction.

with Report;

procedure CC51A01 is

   type Distance is new CC51A01_1.Pos_Fraction;    -- Derived indirectly from

                                                   -- root type of class.

   -- Inherits "/" indirectly from root type.

   -- Inherits "-" indirectly from root type.

   -- Inherits Numerator directly from parent type.

   -- Inherits Denominator indirectly from root type.

   use FC51A00, CC51A01_1;                         -- All primitive subprograms

                                                   -- directly visible.

   package Fraction_IO     is new CC51A01_0 (Fraction_Type);

   package Pos_Fraction_IO is new CC51A01_0 (Pos_Fraction);

   package Distance_IO     is new CC51A01_0 (Distance);

   -- For each of the instances above, the subprogram "Put" should produce

   -- the same result. That is, the primitive subprograms called by Put

   -- should in all cases be those of the type Fraction_Type, which is the

   -- ancestor type for the formal derived type in the generic unit. In

   -- particular, for Pos_Fraction_IO and Distance_IO, the versions of

   -- Numerator called should NOT be those of the actual types, which override

   -- Fraction_Type's version.

   TC_Expected_Result : constant String := "-3/ 16";

   TC_Root_Type_Of_Class  : Fraction_Type := -3/16;

   TC_Direct_Derivative   : Pos_Fraction  := -3/16;

   TC_Indirect_Derivative : Distance      := -3/16;

begin

   Report.Test ("CC51A01", "Check that, in an instance, each implicit "     &

                "declaration of a user-defined subprogram of a formal "     &

                "derived record type declares a view of the corresponding " &

                "primitive subprogram of the ancestor, even if the "        &

                "primitive subprogram has been overridden for the actual "  &

                "type");

   if (Fraction_IO.Put (TC_Root_Type_Of_Class) /= TC_Expected_Result) then

      Report.Failed ("Wrong result for root type");

   end if;

   if (Pos_Fraction_IO.Put (TC_Direct_Derivative) /= TC_Expected_Result) then

      Report.Failed ("Wrong result for direct derivative");

   end if;

   if (Distance_IO.Put (TC_Indirect_Derivative) /= TC_Expected_Result) then

      Report.Failed ("Wrong result for INdirect derivative");

   end if;

   Report.Result;

end CC51A01;