diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c7/c74004a.ada')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c7/c74004a.ada | 375 |
1 files changed, 375 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c7/c74004a.ada b/gcc/testsuite/ada/acats/tests/c7/c74004a.ada new file mode 100644 index 000000000..f2a016b09 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/c7/c74004a.ada @@ -0,0 +1,375 @@ +-- 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; |