diff gcc/testsuite/ada/acats/tests/cc/cc1223a.ada @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/cc/cc1223a.ada	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,297 @@
+-- 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;