diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1220a.ada')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1220a.ada | 174 |
1 files changed, 174 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1220a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1220a.ada new file mode 100644 index 000000000..cabd5911a --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1220a.ada @@ -0,0 +1,174 @@ +-- CC1220A.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 A GENERIC UNIT CAN REFER TO AN IMPLICITLY +-- DECLARED PREDEFINED OPERATOR. + +-- HISTORY: +-- DAT 08/20/81 CREATED ORIGINAL TEST. +-- SPS 05/03/82 +-- BCB 08/04/88 MODIFIED HEADER FORMAT AND ADDED CHECKS FOR OTHER +-- OPERATIONS OF A DISCRETE TYPE. +-- RJW 03/27/90 REVISED TEST TO CHECK FOR A GENERIC FORMAL +-- DISCRETE TYPE. +-- CJJ 10/14/90 ADDED CHECKS FOR RELATIONAL OPERATOR (<, <=, >, >=); +-- MADE FAILED MESSAGES IN PROCEDURE BODY MORE SPECIFIC. + +WITH REPORT; USE REPORT; +WITH SYSTEM; USE SYSTEM; + +PROCEDURE CC1220A IS + +BEGIN + TEST ("CC1220A", "GENERIC UNIT CAN REFER TO IMPLICITLY " & + "DECLARED OPERATORS"); + + + DECLARE + + GENERIC + TYPE T IS (<>); + STR : STRING; + P1 : T := T'FIRST; + P2 : T := T(T'SUCC (P1)); + P3 : T := T'(T'PRED (P2)); + P4 : INTEGER := IDENT_INT(T'WIDTH); + P5 : BOOLEAN := (P1 < P2) AND (P2 > P3); + P6: BOOLEAN := (P1 <= P3) AND (P2 >= P1); + P7 : BOOLEAN := (P3 = P1); + P8 : T := T'BASE'FIRST; + P10 : T := T'LAST; + P11 : INTEGER := T'SIZE; + P12 : ADDRESS := P10'ADDRESS; + P13 : INTEGER := T'WIDTH; + P14 : INTEGER := T'POS(T'LAST); + P15 : T := T'VAL(1); + P16 : INTEGER := T'POS(P15); + P17 : STRING := T'IMAGE(T'BASE'LAST); + P18 : T := T'VALUE(P17); + P19 : BOOLEAN := (P15 IN T); + WITH FUNCTION IDENT (X : T) RETURN T; + PACKAGE PKG IS + ARR : ARRAY (1 .. 3) OF T := (P1,P2,P3); + B1 : BOOLEAN := P7 AND P19; + B2 : BOOLEAN := P5 AND P6; + END PKG; + + PACKAGE BODY PKG IS + BEGIN + IF P1 /= T(T'FIRST) THEN + FAILED ("IMPROPER VALUE FOR 'FIRST - " & STR); + END IF; + + IF T'SUCC (P1) /= IDENT (P2) OR + T'PRED (P2) /= IDENT (P1) THEN + FAILED ("IMPROPER VALUE FOR 'SUCC, PRED - " & STR); + END IF; + + IF P10 /= T(T'LAST) THEN + FAILED ("IMPROPER VALUE FOR 'LAST - " & STR); + END IF; + + IF NOT EQUAL(P11,T'SIZE) THEN + FAILED ("IMPROPER VALUE FOR 'SIZE - " & STR); + END IF; + + IF NOT EQUAL(P13,T'WIDTH) THEN + FAILED ("IMPROPER VALUE FOR 'WIDTH - " & STR); + END IF; + + IF NOT EQUAL (P16, T'POS (P15)) OR + T'VAL (P16) /= T(IDENT (P15)) THEN + FAILED ("IMPROPER VALUE FOR 'POS, 'VAL - " & STR); + END IF; + + IF T'VALUE (P17) /= T'BASE'LAST OR + T'IMAGE (P18) /= T'IMAGE (T'BASE'LAST) THEN + FAILED ("IMPROPER VALUE FOR 'VALUE, 'IMAGE - " & + STR); + END IF; + END PKG; + + BEGIN + DECLARE + TYPE CHAR IS ('A', 'B', 'C', 'D', 'E'); + + FUNCTION IDENT (C : CHAR) RETURN CHAR IS + BEGIN + RETURN CHAR'VAL (IDENT_INT (CHAR'POS (C))); + END IDENT; + + PACKAGE N_CHAR IS NEW PKG (T => CHAR, STR => "CHAR", + IDENT => IDENT); + BEGIN + IF N_CHAR.ARR (1) /= IDENT ('A') OR + N_CHAR.ARR (2) /= IDENT ('B') OR + N_CHAR.ARR (3) /= 'A' OR + N_CHAR.B1 /= TRUE OR + N_CHAR.B2 /= TRUE THEN + FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" & + " IN INSTANTIATION OF N_CHAR."); + END IF; + END; + + DECLARE + TYPE ENUM IS (JOVIAL, ADA, FORTRAN, BASIC); + + FUNCTION IDENT (C : ENUM) RETURN ENUM IS + BEGIN + RETURN ENUM'VAL (IDENT_INT (ENUM'POS (C))); + END IDENT; + + PACKAGE N_ENUM IS NEW PKG (T => ENUM, STR => "ENUM", + IDENT => IDENT); + + BEGIN + IF N_ENUM.ARR (1) /= IDENT (JOVIAL) OR + N_ENUM.ARR (2) /= IDENT (ADA) OR + N_ENUM.ARR (3) /= JOVIAL OR + N_ENUM.B1 /= TRUE OR + N_ENUM.B2 /= TRUE THEN + FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" & + " IN INSTANTIATION OF N_ENUM."); + END IF; + END; + + DECLARE + + PACKAGE N_INT IS NEW PKG (T => INTEGER, STR => "INTEGER", + IDENT => IDENT_INT); + BEGIN + IF N_INT.ARR (1) /= IDENT_INT (INTEGER'FIRST) OR + N_INT.ARR (2) /= IDENT_INT (INTEGER'FIRST + 1) OR + N_INT.ARR (3) /= INTEGER'FIRST OR + N_INT.B1 /= TRUE OR + N_INT.B2 /= TRUE THEN + FAILED ("IMPROPER VALUES FOR ARRAY COMPONENTS" & + " IN INSTANTIATION OF N_INT."); + END IF; + END; + END; + RESULT; +END CC1220A; |