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