Subversion Repositories openrisc

-- CXA5015.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 the following representation-oriented attributes are

--      available and that the produce correct results:

--      'Denorm, 'Signed_Zeros, 'Exponent 'Fraction, 'Compose, 'Scaling,

--      'Floor, 'Ceiling, 'Rounding, 'Unbiased_Rounding, 'Truncation,

--      'Remainder, 'Adjacent, 'Copy_Sign, 'Leading_Part, 'Machine, and

--      'Model_Small.

--

-- TEST DESCRIPTION:

--      This test checks whether certain attributes of floating point types

--      are available from an implementation.  Where attribute correctness

--      can be verified in a straight forward manner, the appropriate checks

--      are included here.  However, this test is not intended to ensure the

--      correctness of the results returned from all of the attributes

--      examined in this test; that process will occur in the tests of the

--      Numerics_Annex.

--

--

-- CHANGE HISTORY:

--      26 Jun 95   SAIC    Initial prerelease version.

--      29 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.

--      01 DEC 97   EDS     Fix value for checking the S'Adjacent attribute

--!

with Report;

procedure CXA5015 is

   subtype Float_Subtype   is Float range -10.0..10.0;

   type    Derived_Float_1 is digits  8;

   type    Derived_Float_2 is new Derived_Float_1 range -10.0..10.0E10;

   use type Float, Float_Subtype, Derived_Float_1, Derived_Float_2;

   TC_Boolean   : Boolean;

   TC_Float     : Float;

   TC_SFloat    : Float_Subtype;

   TC_DFloat_1  : Derived_Float_1;

   TC_DFloat_2  : Derived_Float_2;

   TC_Tolerance : Float := 0.001;

   function Not_Equal (Actual_Result, Expected_Result, Tolerance : Float)

     return Boolean is

   begin

      return abs(Actual_Result - Expected_Result) > Tolerance;

   end Not_Equal;

begin

   Report.Test ("CXA5015", "Check that certain representation-oriented " &

                           "attributes are available and that they "     &

                           "produce correct results");

   -- New Representation-Oriented Attributes.

   --

   -- Check the S'Denorm attribute.

   TC_Boolean := Float'Denorm;

   TC_Boolean := Float_Subtype'Denorm;

   TC_Boolean := Derived_Float_1'Denorm;

   TC_Boolean := Derived_Float_2'Denorm;

   -- Check the S'Signed_Zeroes attribute.

   TC_Boolean := Float'Signed_Zeros;

   TC_Boolean := Float_Subtype'Signed_Zeros;

   TC_Boolean := Derived_Float_1'Signed_Zeros;

   TC_Boolean := Derived_Float_2'Signed_Zeros;

   -- New Primitive Function Attributes.

   --

   -- Check the S'Exponent attribute.

   TC_Float    := 0.5;

   TC_SFloat   := 0.99;

   TC_DFloat_1 := 2.45;

   TC_DFloat_2 := 2.65;

   if Float'Exponent(TC_Float) > Float_Subtype'Exponent(TC_SFloat) or

      Float'Exponent(TC_Float) > 2

   then

      Report.Failed("Incorrect result from the 'Exponent attribute");

   end if;

   -- Check the S'Fraction attribute.

   if Not_Equal

        (Float'Fraction(TC_Float),

         TC_Float * Float(Float'Machine_Radix)**(-Float'Exponent(TC_Float)),

         TC_Tolerance)

   then

      Report.Failed("Incorrect result from the 'Fraction attribute - 1");

   end if;

   if Float'Fraction(TC_Float) <

      (1.0/Float(Float'Machine_Radix)) - TC_Tolerance  or

      Float'Fraction(TC_Float) >= 1.0 - TC_Tolerance

   then

      Report.Failed("Incorrect result from the 'Fraction attribute - 2");

   end if;

   -- Check the S'Compose attribute.

   if Not_Equal

       (Float'Compose(TC_Float, 3),

        TC_Float * Float(Float'Machine_Radix)**(3-Float'Exponent(TC_Float)),

        TC_Tolerance)

   then

      Report.Failed("Incorrect result from the 'Compose attribute");

   end if;

   -- Check the S'Scaling attribute.

   if Not_Equal

        (Float'Scaling(TC_Float, 2),

         TC_Float * Float(Float'Machine_Radix)**2,

         TC_Tolerance)

   then

      Report.Failed("Incorrect result from the 'Scaling attribute");

   end if;

   -- Check the S'Floor attribute.

   TC_Float    :=  0.99;

   TC_SFloat   :=  1.00;

   TC_DFloat_1 :=  2.50;

   TC_DFloat_2 := -2.50;

   if Float'Floor(TC_Float)               /=  0.0  or

      Float_Subtype'Floor(TC_SFloat)      /=  1.0  or

      Derived_Float_1'Floor(TC_DFloat_1)  /=  2.0  or

      Derived_Float_2'Floor(TC_DFloat_2)  /= -3.0

   then

      Report.Failed("Incorrect result from the 'Floor attribute");

   end if;

   -- Check the S'Ceiling attribute.

   TC_Float    :=  0.99;

   TC_SFloat   :=  1.00;

   TC_DFloat_1 :=  2.50;

   TC_DFloat_2 := -2.99;

   if Float'Ceiling(TC_Float)               /=  1.0  or

      Float_Subtype'Ceiling(TC_SFloat)      /=  1.0  or

      Derived_Float_1'Ceiling(TC_DFloat_1)  /=  3.0  or

      Derived_Float_2'Ceiling(TC_DFloat_2)  /= -2.0

   then

      Report.Failed("Incorrect result from the 'Ceiling attribute");

   end if;

   -- Check the S'Rounding attribute.

   TC_Float    :=  0.49;

   TC_SFloat   :=  1.00;

   TC_DFloat_1 :=  2.50;

   TC_DFloat_2 := -2.50;

   if Float'Rounding(TC_Float)               /=  0.0  or

      Float_Subtype'Rounding(TC_SFloat)      /=  1.0  or

      Derived_Float_1'Rounding(TC_DFloat_1)  /=  3.0  or

      Derived_Float_2'Rounding(TC_DFloat_2)  /= -3.0

   then

      Report.Failed("Incorrect result from the 'Rounding attribute");

   end if;

   -- Check the S'Unbiased_Rounding attribute.

   TC_Float    :=  0.50;

   TC_SFloat   :=  1.50;

   TC_DFloat_1 :=  2.50;

   TC_DFloat_2 := -2.50;

   if Float'Unbiased_Rounding(TC_Float)               /=  0.0  or

      Float_Subtype'Unbiased_Rounding(TC_SFloat)      /=  2.0  or

      Derived_Float_1'Unbiased_Rounding(TC_DFloat_1)  /=  2.0  or

      Derived_Float_2'Unbiased_Rounding(TC_DFloat_2)  /= -2.0

   then

      Report.Failed("Incorrect result from the 'Unbiased_Rounding " &

                    "attribute");

   end if;

   -- Check the S'Truncation attribute.

   TC_Float    := -0.99;

   TC_SFloat   :=  1.50;

   TC_DFloat_1 :=  2.99;

   TC_DFloat_2 := -2.50;

   if Float'Truncation(TC_Float)               /=  0.0  or

      Float_Subtype'Truncation(TC_SFloat)      /=  1.0  or

      Derived_Float_1'Truncation(TC_DFloat_1)  /=  2.0  or

      Derived_Float_2'Truncation(TC_DFloat_2)  /= -2.0

   then

      Report.Failed("Incorrect result from the 'Truncation attribute");

   end if;

   -- Check the S'Remainder attribute.

   TC_Float    :=  9.0;

   TC_SFloat   :=  7.5;

   TC_DFloat_1 :=  5.0;

   TC_DFloat_2 :=  8.0;

   if Float'Remainder(TC_Float, 2.0)                /=  1.0  or

      Float_Subtype'Remainder(TC_SFloat, 3.0)       /=  1.5  or

      Derived_Float_1'Remainder(TC_DFloat_1, 2.0)   /=  1.0  or

      Derived_Float_2'Remainder(TC_DFloat_2, 4.0)   /=  0.0

   then

      Report.Failed("Incorrect result from the 'Remainder attribute");

   end if;

   -- Check the S'Adjacent attribute.

   TC_Float    :=  4.0;

   TC_SFloat   := -1.0;

   if Float'Adjacent(TC_Float, TC_Float)           /=  TC_Float  or

      Float_Subtype'Adjacent(TC_SFloat, -1.0)      /=  TC_SFloat

   then

      Report.Failed("Incorrect result from the 'Adjacent attribute");

   end if;

   -- Check the S'Copy_Sign attribute.

   TC_Float    :=  0.0;

   TC_SFloat   := -1.0;

   TC_DFloat_1 :=  5.0;

   TC_DFloat_2 := -2.5;

   if Float'Copy_Sign(TC_Float, -2.0)               /=  0.0  or

      Float_Subtype'Copy_Sign(TC_SFloat, 4.0)       /=  1.0  or

      Derived_Float_1'Copy_Sign(TC_DFloat_1, -2.0)  /= -5.0  or

      Derived_Float_2'Copy_Sign(TC_DFloat_2, -2.0)  /= -2.5

   then

      Report.Failed("Incorrect result from the 'Copy_Sign attribute");

   end if;

   -- Check the S'Leading_Part attribute.

   TC_Float    :=  0.0;

   TC_SFloat   := -1.0;

   TC_DFloat_1 :=  5.88;

   TC_DFloat_2 := -2.52;

   -- Leading part obtained in the variables.

   TC_Float    :=  Float'Leading_Part(TC_Float, 2);

   TC_SFloat   :=  Float_Subtype'Leading_Part(TC_SFloat, 2);

   TC_DFloat_1 :=  Derived_Float_1'Leading_Part(TC_DFloat_1, 2);

   TC_DFloat_2 :=  Derived_Float_2'Leading_Part(TC_DFloat_2, 2);

   -- Checking for the leading part of the variables at this point should

   -- produce the same values.

   if Float'Leading_Part(TC_Float, 2)              /= TC_Float    or

      Float_Subtype'Leading_Part(TC_SFloat, 2)     /= TC_SFloat   or

      Derived_Float_1'Leading_Part(TC_DFloat_1, 2) /= TC_DFloat_1 or

      Derived_Float_2'Leading_Part(TC_DFloat_2, 2) /= TC_DFloat_2

   then

      Report.Failed("Incorrect result from the 'Leading_Part attribute");

   end if;

   -- Check the S'Machine attribute.

   TC_Float    :=  0.0;

   TC_SFloat   := -1.0;

   TC_DFloat_1 :=  5.88;

   TC_DFloat_2 := -2.52;

   -- Closest machine number obtained in the variables.

   TC_Float    :=  Float'Machine(TC_Float);

   TC_SFloat   :=  Float_Subtype'Machine(TC_SFloat);

   TC_DFloat_1 :=  Derived_Float_1'Machine(TC_DFloat_1);

   TC_DFloat_2 :=  Derived_Float_2'Machine(TC_DFloat_2);

   -- Checking for the closest machine number to each of the variables at

   -- this point should produce the same values.

   if Float'Machine(TC_Float)              /= TC_Float    or

      Float_Subtype'Machine(TC_SFloat)     /= TC_SFloat   or

      Derived_Float_1'Machine(TC_DFloat_1) /= TC_DFloat_1 or

      Derived_Float_2'Machine(TC_DFloat_2) /= TC_DFloat_2

   then

      Report.Failed("Incorrect result from the 'Machine attribute");

   end if;

   -- New Model-Oriented Attributes.

   --

   -- Check the S'Model_Small attribute.

   if Not_Equal

        (Float'Model_Small,

         Float(Float'Machine_Radix)**(Float'Model_Emin-1),

         TC_Tolerance)

   then

      Report.Failed("Incorrect result from the 'Model_Small attribute");

   end if;

   Report.Result;

end CXA5015;