cc1223a.ada

来自「用于进行gcc测试」· ADA 代码 · 共 298 行

-- CC1223A.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 A FORMAL FIXED 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, 'DELTA, 'FORE, 
--     'AFT, 'MACHINE_ROUNDS, 'MACHINE_OVERFLOWS.

-- HISTORY:
--     RJW 09/30/86  CREATED ORIGINAL TEST.
--     JLH 09/25/87  REFORMATTED HEADER.
--     RJW 08/21/89  MODIFIED CHECKS FOR 'MANTISSA AND 'AFT.
--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.

WITH SYSTEM; USE SYSTEM;
WITH REPORT; USE REPORT;

PROCEDURE CC1223A IS

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

BEGIN
     TEST ( "CC1223A",  "FOR A FORMAL FIXED 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 DELTA <>;
               TYPE T1 IS DELTA <>;
               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 (FIXED, FIXED, 0.0, 0.0);
          PROCEDURE P2 IS NEW P (DURATION, DURATION, 0.0, 0.0);

     BEGIN
          P1 (2.0, "FIXED");
          P2 (2.0, "DURATION");
     END; -- (A).

     DECLARE -- (B) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER
             --     NUMERIC TYPES, AND IMPLICIT CONVERSION FROM
             --     REAL LITERAL.

          GENERIC
               TYPE T IS DELTA <>;
          PROCEDURE P (STR : STRING);

          PROCEDURE P (STR : STRING) IS

               FL0  : FLOAT := 0.0;
               FL2  : FLOAT := 2.0;
               FLN2 : FLOAT := -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 (FL0) /= T0 THEN
                    FAILED ( "INCORRECT CONVERSION FROM " &
                             "FLOAT VALUE 0.0 WITH TYPE " & STR);
               END IF;

               IF T (FL2) /= IDENT (T2) THEN
                    FAILED ( "INCORRECT CONVERSION FROM " &
                             "FLOAT VALUE 2.0 WITH TYPE " & STR);
               END IF;

               IF T (FLN2) /= TN2 THEN
                    FAILED ( "INCORRECT CONVERSION FROM " &
                             "FLOAT 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 FLOAT (T0) /= FL0 THEN
                    FAILED ( "INCORRECT CONVERSION TO " &
                             "FLOAT VALUE 0.0 WITH TYPE " & STR);
               END IF;

               IF FLOAT (IDENT (T2)) /= FL2 THEN
                    FAILED ( "INCORRECT CONVERSION TO " &
                             "FLOAT VALUE 2.0 WITH TYPE " & STR);
               END IF;

               IF FLOAT (TN2) /= FLN2 THEN
                    FAILED ( "INCORRECT CONVERSION TO " &
                             "FLOAT 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 (FIXED);
          PROCEDURE P2 IS NEW P (DURATION);

     BEGIN
           P1 ( "FIXED" );
           P2 ( "DURATION" );
     END; -- (B).

     DECLARE -- (C) CHECKS FOR ATTRIBUTES.

          GENERIC
               TYPE T IS DELTA <>;
               F, L, D : T;
          PROCEDURE P (STR : STRING);

          PROCEDURE P (STR : STRING) IS

               F1 : T;
               A  : ADDRESS := F'ADDRESS;
               S  : INTEGER := F'SIZE;

               I  : INTEGER;

               B1 : BOOLEAN := T'MACHINE_ROUNDS;
               B2 : BOOLEAN := T'MACHINE_OVERFLOWS;

          BEGIN
               IF T'DELTA /= D THEN
                    FAILED ( "INCORRECT VALUE FOR " &
                              STR & "'DELTA" );
               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;

               IF T'FORE < 2 THEN
                    FAILED ( "INCORRECT VALUE FOR " &
                              STR & "'FORE" );
               END IF;

               IF T'AFT <= 0 THEN
                    FAILED ( "INCORRECT VALUE FOR " & STR & "'AFT" );
               END IF;

          END P;

          PROCEDURE P1 IS
               NEW P (FIXED, FIXED'FIRST, FIXED'LAST, FIXED'DELTA);
          PROCEDURE P2 IS
               NEW P (DURATION, DURATION'FIRST, DURATION'LAST,
                      DURATION'DELTA);

     BEGIN
           P1 ( "FIXED" );
           P2 ( "DURATION" );
     END; -- (C).

     RESULT;
END CC1223A;