-- CC1111A.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 AFTER A GENERIC UNIT IS INSTANTIATED, THE SUBTYPE OF -- AN IN OUT OBJECT PARAMETER IS DETERMINED BY THE ACTUAL PARAMETER -- (TESTS INTEGER, ENUMERATION, FLOATING POINT, FIXED POINT, ARRAY, -- ACCESS, AND DISCRIMINATED TYPES). -- HISTORY: -- BCB 03/28/88 CREATED ORIGINAL TEST. -- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X. WITH REPORT; USE REPORT; PROCEDURE CC1111A IS SUBTYPE INT IS INTEGER RANGE 0..5; INTVAR : INTEGER RANGE 1..3; TYPE ENUM IS (ONE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT); SUBTYPE SUBENUM IS ENUM RANGE ONE .. FIVE; ENUMVAR : ENUM RANGE TWO .. THREE; TYPE FLT IS DIGITS 5 RANGE -5.0 .. 5.0; SUBTYPE SUBFLT IS FLT RANGE -1.0 .. 1.0; FLTVAR : FLT RANGE 0.0 .. 1.0; TYPE FIX IS DELTA 0.5 RANGE -5.0 .. 5.0; SUBTYPE SUBFIX IS FIX RANGE -1.0 .. 1.0; FIXVAR : FIX RANGE 0.0 .. 1.0; SUBTYPE STR IS STRING (1..10); STRVAR : STRING (1..5); TYPE REC (DISC : INTEGER := 5) IS RECORD NULL; END RECORD; SUBTYPE SUBREC IS REC (6); RECVAR : REC(5); SUBRECVAR : SUBREC; TYPE ACCREC IS ACCESS REC; SUBTYPE A1 IS ACCREC(1); SUBTYPE A2 IS ACCREC(2); A1VAR : A1 := NEW REC(1); A2VAR : A2 := NEW REC(2); PACKAGE P IS TYPE PRIV IS PRIVATE; PRIVATE TYPE PRIV IS RANGE 1 .. 100; SUBTYPE SUBPRIV IS PRIV RANGE 5 .. 10; PRIVVAR : PRIV RANGE 8 .. 10; END P; PACKAGE BODY P IS FUNCTION PRIVEQUAL (ONE, TWO : SUBPRIV) RETURN BOOLEAN; FUNCTION PRIVEQUAL (ONE, TWO : SUBPRIV) RETURN BOOLEAN IS BEGIN RETURN ONE = TWO; END PRIVEQUAL; GENERIC INPUT : SUBPRIV; OUTPUT : IN OUT SUBPRIV; PROCEDURE I; PROCEDURE I IS BEGIN OUTPUT := INPUT; FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " & "PRIVATE TYPE"); IF PRIVEQUAL (OUTPUT, OUTPUT) THEN COMMENT ("DON'T OPTIMIZE OUTPUT"); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED"); END I; PROCEDURE I1 IS NEW I (5, PRIVVAR); PROCEDURE I2 IS NEW I (SUBPRIV'FIRST, PRIVVAR); BEGIN TEST ("CC1111A", "CHECK THAT AFTER A GENERIC UNIT IS " & "INSTANTIATED, THE SUBTYPE OF AN IN OUT " & "OBJECT PARAMETER IS DETERMINED BY THE " & "ACTUAL PARAMETER (TESTS INTEGER, " & "ENUMERATION, FLOATING POINT, FIXED POINT " & ", ARRAY, ACCESS, AND DISCRIMINATED TYPES)"); I1; I2; END P; USE P; GENERIC TYPE GP IS PRIVATE; FUNCTION GEN_IDENT (X : GP) RETURN GP; GENERIC INPUT : INT; OUTPUT : IN OUT INT; PROCEDURE B; GENERIC INPUT : SUBENUM; OUTPUT : IN OUT SUBENUM; PROCEDURE C; GENERIC INPUT : SUBFLT; OUTPUT : IN OUT SUBFLT; PROCEDURE D; GENERIC INPUT : SUBFIX; OUTPUT : IN OUT SUBFIX; PROCEDURE E; GENERIC INPUT : STR; OUTPUT : IN OUT STR; PROCEDURE F; GENERIC INPUT : A1; OUTPUT : IN OUT A1; PROCEDURE G; GENERIC INPUT : SUBREC; OUTPUT : IN OUT SUBREC; PROCEDURE H; GENERIC TYPE GP IS PRIVATE; FUNCTION GENEQUAL (ONE, TWO : GP) RETURN BOOLEAN; FUNCTION GENEQUAL (ONE, TWO : GP) RETURN BOOLEAN IS BEGIN RETURN ONE = TWO; END GENEQUAL; FUNCTION GEN_IDENT (X : GP) RETURN GP IS BEGIN RETURN X; END GEN_IDENT; FUNCTION INT_IDENT IS NEW GEN_IDENT (INT); FUNCTION SUBENUM_IDENT IS NEW GEN_IDENT (SUBENUM); FUNCTION SUBFLT_IDENT IS NEW GEN_IDENT (SUBFLT); FUNCTION SUBFIX_IDENT IS NEW GEN_IDENT (SUBFIX); FUNCTION ENUMEQUAL IS NEW GENEQUAL (SUBENUM); FUNCTION FLTEQUAL IS NEW GENEQUAL (SUBFLT); FUNCTION FIXEQUAL IS NEW GENEQUAL (SUBFIX); FUNCTION STREQUAL IS NEW GENEQUAL (STR); FUNCTION ACCEQUAL IS NEW GENEQUAL (A2); FUNCTION RECEQUAL IS NEW GENEQUAL (REC); PROCEDURE B IS BEGIN OUTPUT := INPUT; FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " & "INTEGER TYPE"); IF EQUAL (OUTPUT, OUTPUT) THEN COMMENT ("DON'T OPTIMIZE OUTPUT"); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED"); END B; PROCEDURE C IS BEGIN OUTPUT := INPUT; FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " & "ENUMERATION TYPE"); IF ENUMEQUAL (OUTPUT, OUTPUT) THEN COMMENT ("DON'T OPTIMIZE OUTPUT"); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED"); END C; PROCEDURE D IS BEGIN OUTPUT := INPUT; FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " & "FLOATING POINT TYPE"); IF FLTEQUAL (OUTPUT, OUTPUT) THEN COMMENT ("DON'T OPTIMIZE OUTPUT"); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED"); END D; PROCEDURE E IS BEGIN OUTPUT := INPUT; FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " & "FIXED POINT TYPE"); IF FIXEQUAL (OUTPUT, OUTPUT) THEN COMMENT ("DON'T OPTIMIZE OUTPUT"); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED"); END E; PROCEDURE F IS BEGIN OUTPUT := INPUT; FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " & "ARRAY TYPE"); IF STREQUAL (OUTPUT, OUTPUT) THEN COMMENT ("DON'T OPTIMIZE OUTPUT"); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED"); END F; PROCEDURE G IS BEGIN OUTPUT := INPUT; FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " & "ACCESS TYPE"); IF ACCEQUAL (OUTPUT, OUTPUT) THEN COMMENT ("DON'T OPTIMIZE OUTPUT"); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED"); END G; PROCEDURE H IS BEGIN OUTPUT := INPUT; FAILED ("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " & "DISCRIMINATED RECORD TYPE"); IF RECEQUAL (OUTPUT, OUTPUT) THEN COMMENT ("DON'T OPTIMIZE OUTPUT"); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => NULL; WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED"); END H; PROCEDURE B1 IS NEW B (4, INTVAR); PROCEDURE C1 IS NEW C (FOUR, ENUMVAR); PROCEDURE D1 IS NEW D (-1.0, FLTVAR); PROCEDURE E1 IS NEW E (-1.0, FIXVAR); PROCEDURE F1 IS NEW F ("9876543210", STRVAR); PROCEDURE G1 IS NEW G (A1VAR, A2VAR); PROCEDURE H1 IS NEW H (SUBRECVAR, RECVAR); PROCEDURE B2 IS NEW B (INT_IDENT(INT'FIRST), INTVAR); PROCEDURE C2 IS NEW C (SUBENUM_IDENT(SUBENUM'FIRST), ENUMVAR); PROCEDURE D2 IS NEW D (SUBFLT_IDENT(SUBFLT'FIRST), FLTVAR); PROCEDURE E2 IS NEW E (SUBFIX_IDENT(SUBFIX'FIRST), FIXVAR); BEGIN B1; C1; D1; E1; F1; G1; H1; B2; C2; D2; E2; RESULT; END CC1111A;