| -- C74004A.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: |
| -- CHECK THAT OPERATIONS DEPENDING ON THE FULL DECLARATION OF A |
| -- PRIVATE TYPE ARE AVAILABLE WITHIN THE PACKAGE BODY. |
| |
| -- HISTORY: |
| -- BCB 04/05/88 CREATED ORIGINAL TEST. |
| -- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X. |
| |
| WITH REPORT; USE REPORT; |
| |
| PROCEDURE C74004A IS |
| |
| PACKAGE P IS |
| TYPE PR IS PRIVATE; |
| TYPE ARR1 IS LIMITED PRIVATE; |
| TYPE ARR2 IS PRIVATE; |
| TYPE REC (D : INTEGER) IS PRIVATE; |
| TYPE ACC IS PRIVATE; |
| TYPE TSK IS LIMITED PRIVATE; |
| TYPE FLT IS LIMITED PRIVATE; |
| TYPE FIX IS LIMITED PRIVATE; |
| |
| TASK TYPE T IS |
| ENTRY ONE(V : IN OUT INTEGER); |
| END T; |
| |
| PROCEDURE CHECK (V : ARR2); |
| PRIVATE |
| TYPE PR IS NEW INTEGER; |
| |
| TYPE ARR1 IS ARRAY(1..5) OF INTEGER; |
| |
| TYPE ARR2 IS ARRAY(1..5) OF BOOLEAN; |
| |
| TYPE REC (D : INTEGER) IS RECORD |
| COMP1 : INTEGER; |
| COMP2 : BOOLEAN; |
| END RECORD; |
| |
| TYPE ACC IS ACCESS INTEGER; |
| |
| TYPE TSK IS NEW T; |
| |
| TYPE FLT IS DIGITS 5; |
| |
| TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0; |
| END P; |
| |
| PACKAGE BODY P IS |
| X1, X2, X3 : PR; |
| BOOL : BOOLEAN := IDENT_BOOL(FALSE); |
| VAL : INTEGER := IDENT_INT(0); |
| FVAL : FLOAT := 0.0; |
| ST : STRING(1..2); |
| O1 : ARR1 := (1,2,3,4,5); |
| Y1 : ARR2 := (FALSE,TRUE,FALSE,TRUE,FALSE); |
| Y2 : ARR2 := (OTHERS => TRUE); |
| Y3 : ARR2 := (OTHERS => FALSE); |
| Z1 : REC(0) := (0,1,FALSE); |
| W1, W2 : ACC := NEW INTEGER'(0); |
| V1 : TSK; |
| |
| TASK BODY T IS |
| BEGIN |
| ACCEPT ONE(V : IN OUT INTEGER) DO |
| V := IDENT_INT(10); |
| END ONE; |
| END T; |
| |
| PROCEDURE CHECK (V : ARR2) IS |
| BEGIN |
| IF V /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN |
| FAILED ("IMPROPER VALUE PASSED AS AGGREGATE"); |
| END IF; |
| END CHECK; |
| BEGIN |
| TEST ("C74004A", "CHECK THAT OPERATIONS DEPENDING ON THE " & |
| "FULL DECLARATION OF A PRIVATE TYPE ARE " & |
| "AVAILABLE WITHIN THE PACKAGE BODY"); |
| |
| X1 := 10; |
| X2 := 5; |
| |
| X3 := X1 + X2; |
| |
| IF X3 /= 15 THEN |
| FAILED ("IMPROPER RESULT FROM ADDITION OPERATOR"); |
| END IF; |
| |
| X3 := X1 - X2; |
| |
| IF X3 /= 5 THEN |
| FAILED ("IMPROPER RESULT FROM SUBTRACTION OPERATOR"); |
| END IF; |
| |
| X3 := X1 * X2; |
| |
| IF X3 /= 50 THEN |
| FAILED ("IMPROPER RESULT FROM MULTIPLICATION OPERATOR"); |
| END IF; |
| |
| X3 := X1 / X2; |
| |
| IF X3 /= 2 THEN |
| FAILED ("IMPROPER RESULT FROM DIVISION OPERATOR"); |
| END IF; |
| |
| X3 := X1 ** 2; |
| |
| IF X3 /= 100 THEN |
| FAILED ("IMPROPER RESULT FROM EXPONENTIATION OPERATOR"); |
| END IF; |
| |
| BOOL := X1 < X2; |
| |
| IF BOOL THEN |
| FAILED ("IMPROPER RESULT FROM LESS THAN OPERATOR"); |
| END IF; |
| |
| BOOL := X1 > X2; |
| |
| IF NOT BOOL THEN |
| FAILED ("IMPROPER RESULT FROM GREATER THAN OPERATOR"); |
| END IF; |
| |
| BOOL := X1 <= X2; |
| |
| IF BOOL THEN |
| FAILED ("IMPROPER RESULT FROM LESS THAN OR EQUAL TO " & |
| "OPERATOR"); |
| END IF; |
| |
| BOOL := X1 >= X2; |
| |
| IF NOT BOOL THEN |
| FAILED ("IMPROPER RESULT FROM GREATER THAN OR EQUAL " & |
| "TO OPERATOR"); |
| END IF; |
| |
| X3 := X1 MOD X2; |
| |
| IF X3 /= 0 THEN |
| FAILED ("IMPROPER RESULT FROM MOD OPERATOR"); |
| END IF; |
| |
| X3 := X1 REM X2; |
| |
| IF X3 /= 0 THEN |
| FAILED ("IMPROPER RESULT FROM REM OPERATOR"); |
| END IF; |
| |
| X3 := ABS(X1); |
| |
| IF X3 /= 10 THEN |
| FAILED ("IMPROPER RESULT FROM ABS OPERATOR - 1"); |
| END IF; |
| |
| X1 := -10; |
| |
| X3 := ABS(X1); |
| |
| IF X3 /= 10 THEN |
| FAILED ("IMPROPER RESULT FROM ABS OPERATOR - 2"); |
| END IF; |
| |
| X3 := PR'BASE'FIRST; |
| |
| IF X3 /= PR(INTEGER'FIRST) THEN |
| FAILED ("IMPROPER RESULT FROM 'BASE'FIRST"); |
| END IF; |
| |
| X3 := PR'FIRST; |
| |
| IF X3 /= PR(INTEGER'FIRST) THEN |
| FAILED ("IMPROPER RESULT FROM 'FIRST"); |
| END IF; |
| |
| VAL := PR'WIDTH; |
| |
| IF NOT EQUAL(VAL,INTEGER'WIDTH) THEN |
| FAILED ("IMPROPER RESULT FROM 'WIDTH"); |
| END IF; |
| |
| VAL := PR'POS(X3); |
| |
| IF NOT EQUAL(VAL,INTEGER'FIRST) THEN |
| FAILED ("IMPROPER RESULT FROM 'POS"); |
| END IF; |
| |
| X3 := PR'VAL(VAL); |
| |
| IF X3 /= PR(INTEGER'FIRST) THEN |
| FAILED ("IMPROPER RESULT FROM 'VAL"); |
| END IF; |
| |
| X3 := PR'SUCC(X2); |
| |
| IF X3 /= 6 THEN |
| FAILED ("IMPROPER RESULT FROM 'SUCC"); |
| END IF; |
| |
| X3 := PR'PRED(X2); |
| |
| IF X3 /= 4 THEN |
| FAILED ("IMPROPER RESULT FROM 'PRED"); |
| END IF; |
| |
| ST := PR'IMAGE(X3); |
| |
| IF ST /= INTEGER'IMAGE(INTEGER(X3)) THEN |
| FAILED ("IMPROPER RESULT FROM 'IMAGE"); |
| END IF; |
| |
| X3 := PR'VALUE(ST); |
| |
| IF X3 /= PR(INTEGER'VALUE(ST)) THEN |
| FAILED ("IMPROPER RESULT FROM 'VALUE"); |
| END IF; |
| |
| CHECK ((TRUE,FALSE,TRUE,FALSE,TRUE)); |
| |
| IF O1(2) /= IDENT_INT(2) THEN |
| FAILED ("IMPROPER VALUE FROM INDEXING"); |
| END IF; |
| |
| IF O1(2..4) /= (2,3,4) THEN |
| FAILED ("IMPROPER VALUES FROM SLICING"); |
| END IF; |
| |
| IF VAL IN O1'RANGE THEN |
| FAILED ("IMPROPER RESULT FROM 'RANGE"); |
| END IF; |
| |
| VAL := O1'LENGTH; |
| |
| IF NOT EQUAL(VAL,5) THEN |
| FAILED ("IMPROPER RESULT FROM 'LENGTH"); |
| END IF; |
| |
| Y3 := Y1(1..2) & Y2(3..5); |
| |
| IF Y3 /= (FALSE,TRUE,TRUE,TRUE,TRUE) THEN |
| FAILED ("IMPROPER RESULT FROM CATENATION"); |
| END IF; |
| |
| Y3 := NOT Y1; |
| |
| IF Y3 /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN |
| FAILED ("IMPROPER RESULT FROM NOT OPERATOR"); |
| END IF; |
| |
| Y3 := Y1 AND Y2; |
| |
| IF Y3 /= (FALSE,TRUE,FALSE,TRUE,FALSE) THEN |
| FAILED ("IMPROPER RESULT FROM AND OPERATOR"); |
| END IF; |
| |
| Y3 := Y1 OR Y2; |
| |
| IF Y3 /= (TRUE,TRUE,TRUE,TRUE,TRUE) THEN |
| FAILED ("IMPROPER RESULT FROM OR OPERATOR"); |
| END IF; |
| |
| Y3 := Y1 XOR Y2; |
| |
| IF Y3 /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN |
| FAILED ("IMPROPER RESULT FROM XOR OPERATOR"); |
| END IF; |
| |
| VAL := Z1.COMP1; |
| |
| IF NOT EQUAL(VAL,1) THEN |
| FAILED ("IMPROPER RESULT FROM SELECTION OF RECORD " & |
| "COMPONENTS"); |
| END IF; |
| |
| W1 := NEW INTEGER'(0); |
| |
| IF NOT EQUAL(W1.ALL,0) THEN |
| FAILED ("IMPROPER RESULT FROM ALLOCATION"); |
| END IF; |
| |
| W1 := NULL; |
| |
| IF W1 /= NULL THEN |
| FAILED ("IMPROPER RESULT FROM NULL LITERAL"); |
| END IF; |
| |
| VAL := W2.ALL; |
| |
| IF NOT EQUAL(VAL,0) THEN |
| FAILED ("IMPROPER RESULT FROM SELECTED COMPONENT"); |
| END IF; |
| |
| BOOL := V1'CALLABLE; |
| |
| IF NOT BOOL THEN |
| FAILED ("IMPROPER RESULT FROM 'CALLABLE"); |
| END IF; |
| |
| BOOL := V1'TERMINATED; |
| |
| IF BOOL THEN |
| FAILED ("IMPROPER RESULT FROM 'TERMINATED"); |
| END IF; |
| |
| V1.ONE(VAL); |
| |
| IF NOT EQUAL(VAL,10) THEN |
| FAILED ("IMPROPER RESULT RETURNED FROM ENTRY SELECTION"); |
| END IF; |
| |
| IF NOT (FLT(1.0) IN FLT) THEN |
| FAILED ("IMPROPER RESULT FROM IMPLICIT CONVERSION"); |
| END IF; |
| |
| VAL := FLT'DIGITS; |
| |
| IF NOT EQUAL(VAL,5) THEN |
| FAILED ("IMPROPER RESULT FROM 'DIGITS"); |
| END IF; |
| |
| BOOL := FLT'MACHINE_ROUNDS; |
| |
| BOOL := FLT'MACHINE_OVERFLOWS; |
| |
| VAL := FLT'MACHINE_RADIX; |
| |
| VAL := FLT'MACHINE_MANTISSA; |
| |
| VAL := FLT'MACHINE_EMAX; |
| |
| VAL := FLT'MACHINE_EMIN; |
| |
| FVAL := FIX'DELTA; |
| |
| IF FVAL /= 2.0**(-1) THEN |
| FAILED ("IMPROPER RESULT FROM 'DELTA"); |
| END IF; |
| |
| VAL := FIX'FORE; |
| |
| VAL := FIX'AFT; |
| |
| END P; |
| |
| USE P; |
| |
| BEGIN |
| RESULT; |
| END C74004A; |
