diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c3/c38102e.ada')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c3/c38102e.ada | 164 |
1 files changed, 164 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c3/c38102e.ada b/gcc/testsuite/ada/acats/tests/c3/c38102e.ada new file mode 100644 index 000000000..6ffec0599 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/c3/c38102e.ada @@ -0,0 +1,164 @@ +-- C38102E.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. +--* +-- CHECK THAT AN INCOMPLETE TYPE CAN BE REDECLARED AS A DERIVED GENERIC +-- FORMAL TYPE. + +-- AH 8/15/86 +-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X. +-- DNT 11/28/95 CHANGED TO FLAG1 := F4. + +WITH REPORT; USE REPORT; +PROCEDURE C38102E IS + TYPE RAINBOW IS (RED, ORANGE, YELLOW, GREEN, BLUE, INDIGO, VIOLET); + TYPE T_FLOAT IS DIGITS 5 RANGE -4.0 .. 4.0; + TYPE T_FIXED IS DELTA 0.01 RANGE 0.0 .. 1.5; + SUBTYPE P1 IS INTEGER; + TYPE P2 IS RANGE 0 .. 10; + TYPE P3 IS ARRAY (P2) OF INTEGER; + TYPE P4 IS ARRAY (P2, P2) OF INTEGER; + + F1, F2 : BOOLEAN; + + GENERIC + TYPE G1 IS (<>); + TYPE G2 IS RANGE <>; + FUNCTION G_DISCRETE RETURN BOOLEAN; + + FUNCTION G_DISCRETE RETURN BOOLEAN IS + TYPE INC1; + TYPE INC2; + TYPE F1 IS NEW G1; + TYPE INC1 IS NEW G1; + TYPE INC2 IS NEW G2; + + OBJ1_0 : INC1; + OBJ1_1 : INC1; + OBJ2_0 : INC2; + OBJ2_1 : INC2; + OBJ3 : F1; + + RESULT_VALUE1 : BOOLEAN := FALSE; + RESULT_VALUE2 : BOOLEAN := FALSE; + BEGIN + OBJ3 := F1'LAST; + OBJ3 := F1'PRED(OBJ3); + IF INC1(OBJ3) = INC1'PRED(INC1'LAST) THEN + RESULT_VALUE1 := TRUE; + END IF; + OBJ2_0 := INC2'FIRST; + OBJ2_1 := INC2'LAST; + IF (OBJ2_0 + OBJ2_1) = (INC2'SUCC(OBJ2_0) + + INC2'PRED(OBJ2_1)) THEN + RESULT_VALUE2 := TRUE; + END IF; + + RETURN (RESULT_VALUE1 AND RESULT_VALUE2); + END G_DISCRETE; + + GENERIC + TYPE G3 IS DIGITS <>; + TYPE G4 IS DELTA <>; + PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN); + + PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN) IS + F1, F2, F3, F4, F5, F6, F7, F8 : BOOLEAN; + TYPE INC3; + TYPE INC4; + TYPE P1 IS NEW G3; + TYPE P2 IS NEW G4; + TYPE INC3 IS NEW G3; + TYPE INC4 IS NEW G4; + BEGIN + F4 := P1'LAST = P1(INC3'LAST) AND P1'FIRST = P1(INC3'FIRST); + + F5 := P2'FORE = INC4'FORE; + F6 := P2'AFT = INC4'AFT; + F7 := ABS(P2'LAST - P2'FIRST) = P2(ABS(INC4'LAST - + INC4'FIRST)); + F8 := INC4(P2'LAST / P2'LAST) = INC4(INC4'LAST / INC4'LAST); + + FLAG1 := F4; + FLAG2 := F5 AND F6 AND F7 AND F8; + END REALS; + + GENERIC + TYPE ITEM IS PRIVATE; + TYPE INDEX IS RANGE <>; + TYPE G5 IS ARRAY (INDEX) OF ITEM; + TYPE G6 IS ARRAY (INDEX, INDEX) OF ITEM; + PACKAGE DIMENSIONS IS + TYPE INC5; + TYPE INC6; + TYPE D1 IS NEW G5; + TYPE D2 IS NEW G6; + TYPE INC5 IS NEW G5; + TYPE INC6 IS NEW G6; + FUNCTION CHECK RETURN BOOLEAN; + END DIMENSIONS; + + PACKAGE BODY DIMENSIONS IS + FUNCTION CHECK RETURN BOOLEAN IS + A1 : INC5; + A2 : INC6; + DIM1 : D1; + DIM2 : D2; + F1, F2 : BOOLEAN; + BEGIN + F1 := A1(INDEX'FIRST)'SIZE = DIM1(INDEX'FIRST)'SIZE; + F2 := A2(INDEX'FIRST, INDEX'LAST)'SIZE = + DIM2(INDEX'FIRST, INDEX'LAST)'SIZE; + + RETURN (F1 AND F2); + END CHECK; + END DIMENSIONS; + + PROCEDURE PROC IS NEW REALS (G3 => T_FLOAT, G4 => T_FIXED); + FUNCTION DISCRETE IS NEW G_DISCRETE (G1 => RAINBOW, G2 => P2); + PACKAGE PKG IS NEW DIMENSIONS (ITEM => P1, INDEX => P2, G5 => P3, + G6 => P4); + + USE PKG; +BEGIN + TEST ("C38102E", "INCOMPLETE TYPES CAN BE DERIVED GENERIC " & + "FORMAL TYPES"); + + IF NOT DISCRETE THEN + FAILED ("INTEGER AND ENUMERATED TYPES NOT DERIVED"); + END IF; + + PROC (F1, F2); + IF (NOT F1) THEN + FAILED ("FLOAT TYPES NOT DERIVED"); + END IF; + IF (NOT F2) THEN + FAILED ("FIXED TYPES NOT DERIVED"); + END IF; + + IF NOT CHECK THEN + FAILED ("ONE AND TWO DIMENSIONAL ARRAY TYPES NOT DERIVED"); + END IF; + + RESULT; +END C38102E; |