Subversion Repositories openrisc_me

-- C45651A.ADA

--                             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:

--     FOR FIXED POINT TYPES, CHECK:

--          (A) FOR MODEL NUMBERS A >= 0.0, THAT ABS A = A.

--          (B) FOR MODEL NUMBERS A <= 0.0. THAT ABS A = -A.

--          (C) FOR NON-MODEL NUMBERS A > 0.0, THAT ABS A VALUES ARE

--              WITHIN THE APPROPRIATE MODEL INTERVAL.

--          (D) FOR NON-MODEL NUMBERS A < 0.0, THAT ABS A VALUES ARE

--              WITHIN THE APPROPRIATE MODEL INTERVAL.

--     CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF

--     DURATION'BASE.

-- HISTORY:

--     WRG 9/11/86

--     PWB 3/31/88  CHANGED RANGE FOR MEMBERSHIP TEST INVOLVING

--                  ABS (DECIMAL_M4'FIRST + DECIMAL_M4'SMALL / 2).

--     RJW 8/21/89  REMOVED CHECKS INVOLVING HARD-CODED FIXED-POINT

--                  UPPER BOUNDS WHICH WERE INCORRECT FOR SOME

--                  IMPLEMENTATIONS.  REVISED HEADER.

--     PWN 02/02/95 REMOVED INCONSISTENCIES WITH ADA 9X.

--     KAS 11/14/95 REMOVED CASES THAT DEPEND ON SPECIFIC VALUE FOR 'SMALL

--     TMB 11/19/94 REMOVED CASES RELATING TO 3.5.9(8) RULES - SMALL

--                  MAY BE LESS THAN OR EQUAL TO DELTA FOR FIXED POINT.

WITH REPORT; USE REPORT;

PROCEDURE C45651A IS

     -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S

     -- 'MANTISSA VALUE.

BEGIN

     TEST ("C45651A", "CHECK THAT, FOR FIXED POINT TYPES, THE ABS " &

                      "OPERATOR PRODUCES CORRECT RESULTS - BASIC " &

                      "TYPES");

     -------------------------------------------------------------------

A:   DECLARE

          TYPE LIKE_DURATION_M23 IS DELTA 0.020

               RANGE -86_400.0 .. 86_400.0;

          NON_MODEL_CONST : CONSTANT          := 2.0 / 3;

          NON_MODEL_VAR   : LIKE_DURATION_M23 := 0.0;

          SMALL, MAX, MIN, ZERO : LIKE_DURATION_M23 := 0.5;

          X                     : LIKE_DURATION_M23 := 1.0;

     BEGIN

          -- INITIALIZE "CONSTANTS":

          IF EQUAL (3, 3) THEN

               SMALL         := LIKE_DURATION_M23'SMALL;

               MAX           := LIKE_DURATION_M23'LAST;

               MIN           := LIKE_DURATION_M23'FIRST;

               ZERO          := 0.0;

               NON_MODEL_VAR := NON_MODEL_CONST;

          END IF;

          -- (A)

          IF EQUAL (3, 3) THEN

               X := SMALL;

          END IF;

          IF ABS X /= SMALL OR X /= ABS LIKE_DURATION_M23'SMALL THEN

               FAILED ("ABS (1.0 / 64) /= (1.0 / 64)");

          END IF;

          IF EQUAL (3, 3) THEN

               X := MAX;

          END IF;

          IF ABS X /= MAX OR X /= ABS LIKE_DURATION_M23'LAST THEN

               FAILED ("ABS 86_400.0 /= 86_400.0");

          END IF;

          -- (B)

          IF EQUAL (3, 3) THEN

               X := -SMALL;

          END IF;

          IF ABS X /= SMALL OR

             ABS (-LIKE_DURATION_M23'SMALL) /= SMALL THEN

               FAILED ("ABS -(1.0 / 64) /= (1.0 / 64)");

          END IF;

          IF EQUAL (3, 3) THEN

               X := MIN;

          END IF;

          IF ABS X /= MAX OR ABS LIKE_DURATION_M23'FIRST /= MAX THEN

               FAILED ("ABS -86_400.0 /= 86_400.0");

          END IF;

          -- (A) AND (B)

          IF EQUAL (3, 3) THEN

               X := 0.0;

          END IF;

          IF "ABS" (RIGHT => X) /= ZERO OR X /= ABS 0.0 THEN

               FAILED ("ABS 0.0 /= 0.0 -- (LIKE_DURATION_M23)");

          END IF;

          -- CHECK THAT VALUE OF NON_MODEL_VAR IS IN THE RANGE

          -- 42 * 'SMALL .. 43 * 'SMALL:

          IF NON_MODEL_VAR NOT IN 0.65625 .. 0.671875 THEN

               FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE " &

                       "- A");

          END IF;

          -- (C)

          IF ABS NON_MODEL_VAR NOT IN 0.65625 .. 0.671875 OR

             ABS LIKE_DURATION_M23'(NON_MODEL_CONST) NOT IN

                 0.65625 .. 0.671875 THEN

               FAILED ("ABS (2.0 / 3) NOT IN CORRECT RANGE - A");

          END IF;

          IF EQUAL (3, 3) THEN

               X := 86_399.992_187_5;  -- LIKE_DURATION_M23'LAST -

                                       -- 1.0 / 128.

          END IF;

          IF ABS X NOT IN 86_399.984_375 .. 86_400.0 OR

             ABS (LIKE_DURATION_M23'LAST - LIKE_DURATION_M23'SMALL / 2)

                 NOT IN 86_399.984_375 .. 86_400.0 THEN

               FAILED ("ABS (LIKE_DURATION_M23'LAST - " &

                       "LIKE_DURATION_M23'SMALL / 2) NOT IN CORRECT " &

                       "RANGE");

          END IF;

          -- (D)

          IF EQUAL (3, 3) THEN

               X := -NON_MODEL_CONST;

          END IF;

          IF ABS X NOT IN 0.65625 .. 0.671875 OR

             ABS (-LIKE_DURATION_M23'(NON_MODEL_CONST)) NOT IN

                 0.65625 .. 0.671875 THEN

               FAILED ("ABS (-2.0 / 3) NOT IN CORRECT RANGE - A");

          END IF;

          IF EQUAL (3, 3) THEN

               X := -86_399.992_187_5;  -- LIKE_DURATION_M23'FIRST +

                                        -- 1.0 / 128.

          END IF;

          IF ABS X NOT IN 86_399.984_375 .. 86_400.0 OR

             ABS (LIKE_DURATION_M23'FIRST + LIKE_DURATION_M23'SMALL / 2)

                 NOT IN 86_399.984_375 .. 86_400.0 THEN

               FAILED ("ABS (LIKE_DURATION_M23'FIRST +" &

                       "LIKE_DURATION_M23'SMALL / 2) NOT IN CORRECT " &

                       "RANGE");

          END IF;

     END A;

     -------------------------------------------------------------------

B:   DECLARE

          TYPE DECIMAL_M4 IS DELTA 100.0 RANGE -1000.0 .. 1000.0;

          NON_MODEL_CONST : CONSTANT   := 2.0 / 3;

          NON_MODEL_VAR   : DECIMAL_M4 := 0.0;

          SMALL, MAX, MIN, ZERO : DECIMAL_M4 := 128.0;

          X                     : DECIMAL_M4 :=   0.0;

     BEGIN

          -- INITIALIZE "CONSTANTS":

          IF EQUAL (3, 3) THEN

               SMALL         :=  DECIMAL_M4'SMALL;

               ZERO          :=  0.0;

               NON_MODEL_VAR := NON_MODEL_CONST;

          END IF;

          -- (A)

          IF EQUAL (3, 3) THEN

               X := SMALL;

          END IF;

          IF ABS X /= SMALL OR X /= ABS DECIMAL_M4'SMALL THEN

               FAILED ("ABS 64.0 /= 64.0");

          END IF;

          -- (B)

          IF EQUAL (3, 3) THEN

               X := -SMALL;

          END IF;

          IF ABS X /= SMALL OR ABS (-DECIMAL_M4'SMALL) /= SMALL THEN

               FAILED ("ABS -64.0 /= 64.0");

          END IF;

          -- (A) AND (B)

          IF EQUAL (3, 3) THEN

               X := 0.0;

          END IF;

          IF ABS X /= ZERO OR X /= ABS 0.0 THEN

               FAILED ("ABS 0.0 /= 0.0 -- (DECIMAL_M4)");

          END IF;

          -- CHECK THE VALUE OF NON_MODEL_VAR:

          IF NON_MODEL_VAR NOT IN 0.0 .. 64.0 THEN

               FAILED ("VALUE OF NON_MODEL_VAR NOT IN CORRECT RANGE " &

                       "- B");

          END IF;

          -- (C)

          IF ABS NON_MODEL_VAR NOT IN 0.0 .. 64.0 OR

             ABS DECIMAL_M4'(NON_MODEL_CONST) NOT IN 0.0 .. 64.0 THEN

               FAILED ("ABS (2.0 / 3) NOT IN CORRECT RANGE - B");

          END IF;

          IF EQUAL (3, 3) THEN

               X := 37.0;  -- INTERVAL IS 0.0 .. 64.0.

          END IF;

          IF EQUAL (3, 3) THEN

               X := 928.0;

          END IF;

          -- (D)

          IF EQUAL (3, 3) THEN

               X := -NON_MODEL_CONST;

          END IF;

          IF ABS X NOT IN 0.0 .. 64.0 OR

             ABS (-DECIMAL_M4'(NON_MODEL_CONST)) NOT IN 0.0 .. 64.0 THEN

               FAILED ("ABS -(2.0 / 3) NOT IN CORRECT RANGE - B");

          END IF;

          IF EQUAL (3, 3) THEN

               X := -37.0;  -- INTERVAL IS -SMALL .. 0.0.

          END IF;

          IF EQUAL (3, 3) THEN

               X := -928.0;

          END IF;

     END B;

     -------------------------------------------------------------------

     RESULT;

END C45651A;