Subversion Repositories openrisc

-- CC1222A.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.

--*

-- FOR A FORMAL FLOATING POINT TYPE, CHECK THAT THE FOLLOWING BASIC 

-- OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE

-- WITHIN THE GENERIC UNIT: ASSIGNMENT, MEMBERSHIP TESTS, 

-- QUALIFICATION, EXPLICIT CONVERSION TO AND FROM OTHER NUMERIC TYPES, 

-- AND REAL LITERALS (IMPLICIT CONVERSION FROM UNIVERSAL REAL TO THE 

-- FORMAL TYPE), 'FIRST, 'LAST, 'SIZE, 'ADDRESS, 'DIGITS, 'MACHINE_RADIX,

-- 'MACHINE_MANTISSA, 'MACHINE_EMAX, 'MACHINE_EMIN, 'MACHINE_ROUNDS,

-- 'MACHINE_OVERFLOWS.

-- R.WILLIAMS 9/30/86

-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.

WITH REPORT; USE REPORT;

WITH SYSTEM; USE SYSTEM;

PROCEDURE CC1222A IS

     TYPE NEWFLT IS NEW FLOAT;

BEGIN

     TEST ( "CC1222A",  "FOR A FORMAL FLOATING POINT TYPE, CHECK " &

                        "THAT THE BASIC OPERATIONS ARE " &

                        "IMPLICITLY DECLARED AND ARE THEREFORE " &

                        "AVAILABLE WITHIN THE GENERIC UNIT" );

     DECLARE -- (A). CHECKS FOR ASSIGNMENT, MEMBERSHIP TESTS AND 

             --      QUALIFICATION.

          GENERIC

               TYPE T IS DIGITS <>;

               TYPE T1 IS DIGITS <>;

               F  : T;

               F1 : T1;

          PROCEDURE P (F2 : T; STR : STRING);

          PROCEDURE P (F2 : T; STR : STRING) IS

               SUBTYPE ST IS T RANGE -1.0 .. 1.0;

               F3, F4  : T;

               FUNCTION FUN (X : T) RETURN BOOLEAN IS

               BEGIN

                    RETURN IDENT_BOOL (TRUE);

               END FUN;

               FUNCTION FUN (X : T1) RETURN BOOLEAN IS

               BEGIN

                    RETURN IDENT_BOOL (FALSE);

               END FUN;

          BEGIN

               F3 := F;

               F4 := F2;

               F3 := F4;

               IF F3 /= F2 THEN

                    FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " &

                             "WITH TYPE - " & STR);

               END IF;

               IF F IN ST THEN

                    NULL;

               ELSE

                    FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " &

                             "TYPE  - " & STR);

               END IF;

               IF F2 NOT IN ST THEN

                    NULL;

               ELSE

                    FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " &

                             "TYPE  - " & STR);

               END IF;

               IF T'(F) /= F THEN

                    FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &

                             "WITH TYPE - " & STR & " - 1" );

               END IF;

               IF FUN (T'(1.0)) THEN

                    NULL;

               ELSE

                    FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " &

                             "WITH TYPE - " & STR & " - 2" );

               END IF;

          END P;

          PROCEDURE P1 IS NEW P (FLOAT,  FLOAT,  0.0, 0.0);

          PROCEDURE P2 IS NEW P (NEWFLT, NEWFLT, 0.0, 0.0);

     BEGIN

          P1 (2.0, "FLOAT");

          P2 (2.0, "NEWFLT");

     END; -- (A).         

     DECLARE -- (B) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER 

             --     NUMERIC TYPES, AND IMPLICIT CONVERSION FROM 

             --     REAL LITERAL.

          GENERIC

               TYPE T IS DIGITS <>;

          PROCEDURE P (STR : STRING);

          PROCEDURE P (STR : STRING) IS

               TYPE FIXED IS DELTA 0.1 RANGE -100.0 .. 100.0;

               FI0  : FIXED := 0.0;

               FI2  : FIXED := 2.0;

               FIN2 : FIXED := -2.0;

               I0  : INTEGER := 0;

               I2  : INTEGER := 2;

               IN2 : INTEGER := -2;

               T0  : T := 0.0;

               T2  : T := 2.0;

               TN2 : T := -2.0;

               FUNCTION IDENT (X : T) RETURN T IS

               BEGIN

                    IF EQUAL (3, 3) THEN

                         RETURN X;

                    ELSE

                         RETURN T'FIRST;

                    END IF;

               END IDENT;

          BEGIN

               IF T0 + 1.0 /= 1.0 THEN

                    FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &

                             "CONVERSION WITH TYPE " & STR & " - 1" );

               END IF;

               IF T2 + 1.0 /= 3.0 THEN

                    FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &

                             "CONVERSION WITH TYPE " & STR & " - 2" );

               END IF;

               IF TN2 + 1.0 /= -1.0 THEN

                    FAILED ( "INCORRECT RESULTS FOR IMPLICIT " &

                             "CONVERSION WITH TYPE " & STR & " - 3" );

               END IF;

               IF T (FI0) /= T0 THEN

                    FAILED ( "INCORRECT CONVERSION FROM " &

                             "FIXED VALUE 0.0 WITH TYPE " & STR);

               END IF;

               IF T (FI2) /= IDENT (T2) THEN

                    FAILED ( "INCORRECT CONVERSION FROM " &

                             "FIXED VALUE 2.0 WITH TYPE " & STR);

               END IF;

               IF T (FIN2) /= TN2 THEN

                    FAILED ( "INCORRECT CONVERSION FROM " &

                             "FIXED VALUE -2.0 WITH TYPE " & STR);

               END IF;

               IF T (I0) /= IDENT (T0) THEN

                    FAILED ( "INCORRECT CONVERSION FROM " &

                             "INTEGER VALUE 0 WITH TYPE " & STR);

               END IF;

               IF T (I2) /= T2 THEN

                    FAILED ( "INCORRECT CONVERSION FROM " &

                             "INTEGER VALUE 2 WITH TYPE " & STR);

               END IF;

               IF T (IN2) /= IDENT (TN2) THEN

                    FAILED ( "INCORRECT CONVERSION FROM " &

                             "INTEGER VALUE -2 WITH TYPE " & STR);

               END IF;

               IF FIXED (T0) /= FI0 THEN

                    FAILED ( "INCORRECT CONVERSION TO " &

                             "FIXED VALUE 0.0 WITH TYPE " & STR);

               END IF;

               IF FIXED (IDENT (T2)) /= FI2 THEN

                    FAILED ( "INCORRECT CONVERSION TO " &

                             "FIXED VALUE 2.0 WITH TYPE " & STR);

               END IF;

               IF FIXED (TN2) /= FIN2 THEN

                    FAILED ( "INCORRECT CONVERSION TO " &

                             "FIXED VALUE -2.0 WITH TYPE " & STR);

               END IF;

               IF INTEGER (IDENT (T0)) /= I0 THEN

                    FAILED ( "INCORRECT CONVERSION TO " &

                             "INTEGER VALUE 0 WITH TYPE " & STR);

               END IF;

               IF INTEGER (T2) /= I2 THEN

                    FAILED ( "INCORRECT CONVERSION TO " &

                             "INTEGER VALUE 2 WITH TYPE " & STR);

               END IF;

               IF INTEGER (IDENT (TN2)) /= IN2 THEN

                    FAILED ( "INCORRECT CONVERSION TO " &

                             "INTEGER VALUE -2 WITH TYPE " & STR);

               END IF;

          END P;

          PROCEDURE P1 IS NEW P (FLOAT);

          PROCEDURE P2 IS NEW P (NEWFLT);

     BEGIN

           P1 ( "FLOAT" );

           P2 ( "NEWFLT" );

     END; -- (B).         

     DECLARE -- (C) CHECKS FOR ATTRIBUTES.

          GENERIC

               TYPE T IS DIGITS <>;

               F, L : T;

               D : INTEGER;

          PROCEDURE P (STR : STRING);

          PROCEDURE P (STR : STRING) IS

               F1 : T;

               A  : ADDRESS := F'ADDRESS;

               S  : INTEGER := F'SIZE;

               I  : INTEGER;

               I1 : INTEGER := T'MACHINE_RADIX;

               I2 : INTEGER := T'MACHINE_MANTISSA;

               I3 : INTEGER := T'MACHINE_EMAX;

               I4 : INTEGER := T'MACHINE_EMIN;

               B1 : BOOLEAN := T'MACHINE_ROUNDS;

               B2 : BOOLEAN := T'MACHINE_OVERFLOWS;

          BEGIN

               IF T'DIGITS /= D THEN

                    FAILED ( "INCORRECT VALUE FOR " &

                              STR & "'DIGITS" );

               END IF;

               IF T'FIRST /= F THEN

                    FAILED ( "INCORRECT VALUE FOR " &

                              STR & "'FIRST" );

               END IF;

               IF T'LAST /= L THEN

                    FAILED ( "INCORRECT VALUE FOR " &

                              STR & "'LAST" );

               END IF;

          END P;

          PROCEDURE P1 IS

               NEW P (FLOAT, FLOAT'FIRST, FLOAT'LAST, FLOAT'DIGITS);

          PROCEDURE P2 IS

               NEW P (NEWFLT, NEWFLT'FIRST, NEWFLT'LAST,

                      NEWFLT'DIGITS);

     BEGIN

           P1 ( "FLOAT" );

           P2 ( "NEWFLT" );

     END; -- (C).         

     RESULT;

END CC1222A;