WITH REPORT; USE REPORT;
PROCEDURE C35102A IS
TYPE E1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
TYPE E2 IS ('A', 'C', RED, BLUE);
PACKAGE SHOW_TEST_HEADER IS
END SHOW_TEST_HEADER;
PACKAGE BODY SHOW_TEST_HEADER IS
BEGIN
TEST ( "C35102A",
"CHECK THAT AN ENUMERATION LITERAL BELONGING " &
"TO ONE ENUMERATION TYPE MAY BE DECLARED IN " &
"ANOTHER ENUMERATION TYPE DEFINITION IN THE " &
"SAME DECLARATIVE REGION" );
END SHOW_TEST_HEADER;
FUNCTION MY_FTN ( E : E1 ) RETURN E2 IS
TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
TYPE ENUM2 IS ('A', 'C', RED, BLUE);
BEGIN
IF ENUM2'SUCC ('A') /= 'C' THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
"IN MY_FTN - 1" );
END IF;
IF ENUM1'POS (RED) /= 3 THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
"IN MY_FTN - 1" );
END IF;
RETURN E2'VAL ( IDENT_INT ( E1'POS(E) ) );
END MY_FTN;
PACKAGE MY_PACK IS
END MY_PACK;
PACKAGE BODY MY_PACK IS
TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
TYPE ENUM2 IS ('A', 'C', RED, BLUE);
BEGIN IF ENUM2'SUCC ('A') /= 'C' THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
"IN MY_PACK - 1" );
END IF;
IF ENUM1'POS (RED) /= 3 THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
"IN MY_PACK - 1" );
END IF;
END MY_PACK;
PACKAGE PKG IS
TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
TYPE ENUM2 IS ('A', 'C', RED, BLUE);
END PKG;
PACKAGE BODY PKG IS
BEGIN
IF ENUM2'SUCC ('A') /= 'C' THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
"IN PKG - 1" );
END IF;
IF ENUM1'POS (RED) /= 3 THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
"IN PKG - 1" );
END IF;
END PKG;
PACKAGE PRIV IS
TYPE ENUM1 IS PRIVATE;
TYPE ENUM2 IS PRIVATE;
FUNCTION FE1 (E : E1) RETURN ENUM1;
FUNCTION FE2 (E : E2) RETURN ENUM2;
PRIVATE
TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
TYPE ENUM2 IS ('A', 'C', RED, BLUE);
END PRIV;
PACKAGE BODY PRIV IS
FUNCTION FE1 (E : E1) RETURN ENUM1 IS
BEGIN
RETURN ENUM1'VAL (IDENT_INT (E1'POS (E)));
END FE1;
FUNCTION FE2 (E : E2) RETURN ENUM2 IS
BEGIN
RETURN ENUM2'VAL (IDENT_INT (E2'POS (E)));
END FE2;
BEGIN
IF ENUM2'SUCC ('A') /= 'C' THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
"IN PRIV - 1" );
END IF;
IF ENUM1'POS (RED) /= 3 THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
"IN PRIV - 1" );
END IF;
END PRIV;
PACKAGE LPRIV IS
TYPE ENUM1 IS LIMITED PRIVATE;
TYPE ENUM2 IS LIMITED PRIVATE;
FUNCTION FE1 (E : E1) RETURN ENUM1;
FUNCTION FE2 (E : E2) RETURN ENUM2;
FUNCTION EQUALS (A, B : ENUM1) RETURN BOOLEAN;
FUNCTION EQUALS (A, B : ENUM2) RETURN BOOLEAN;
PRIVATE
TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
TYPE ENUM2 IS ('A', 'C', RED, BLUE);
END LPRIV;
PACKAGE BODY LPRIV IS
FUNCTION FE1 (E : E1) RETURN ENUM1 IS
BEGIN
RETURN ENUM1'VAL (IDENT_INT (E1'POS (E)));
END FE1;
FUNCTION FE2 (E : E2) RETURN ENUM2 IS
BEGIN
RETURN ENUM2'VAL (IDENT_INT (E2'POS (E)));
END FE2;
FUNCTION EQUALS (A, B : ENUM1) RETURN BOOLEAN IS
BEGIN
IF A = B THEN
RETURN TRUE;
ELSE
RETURN FALSE;
END IF;
END EQUALS;
FUNCTION EQUALS (A, B : ENUM2) RETURN BOOLEAN IS
BEGIN
IF A = B THEN
RETURN TRUE;
ELSE
RETURN FALSE;
END IF;
END EQUALS;
BEGIN
IF ENUM2'SUCC ('A') /= 'C' THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
"IN LPRIV - 1" );
END IF;
IF ENUM1'POS (RED) /= 3 THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
"IN LPRIV - 2" );
END IF;
END LPRIV;
TASK T1;
TASK BODY T1 IS
TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
TYPE ENUM2 IS ('A', 'C', RED, BLUE);
BEGIN
IF ENUM2'SUCC ('A') /= 'C' THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
"IN T1" );
END IF;
IF ENUM1'POS (RED) /= 3 THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
"IN T1" );
END IF;
END T1;
TASK T2 IS
ENTRY E;
END T2;
TASK BODY T2 IS
BEGIN
ACCEPT E DO
DECLARE
TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
TYPE ENUM2 IS ('A', 'C', RED, BLUE);
BEGIN
IF ENUM2'SUCC ('A') /= 'C' THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
"IN T2.E" );
END IF;
IF ENUM1'POS (RED) /= 3 THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN " &
"ENUM1 IN T2.E" );
END IF;
END;
END E;
END T2;
GENERIC
PROCEDURE GP1;
PROCEDURE GP1 IS
TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
TYPE ENUM2 IS ('A', 'C', RED, BLUE);
BEGIN
IF ENUM2'SUCC ('A') /= 'C' THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
"IN GP1" );
END IF;
IF ENUM1'POS (RED) /= 3 THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
"IN GP1" );
END IF;
END GP1;
GENERIC
TYPE E1 IS (<>);
TYPE E2 IS (<>);
PROCEDURE GP2;
PROCEDURE GP2 IS
BEGIN
IF E2'SUCC (E2'VALUE ("'A'")) /= E2'VALUE ("'C'") THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN E2 " &
"IN GP2" );
END IF;
IF E1'POS (E1'VALUE ("RED")) /= 3 THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN E1 " &
"IN GP2" );
END IF;
END GP2;
PROCEDURE NEWGP1 IS NEW GP1;
PROCEDURE NEWGP2 IS NEW GP2 (E1, E2);
BEGIN
DECLARE
TYPE ENUM1 IS ('A', 'B', 'C', RED, YELLOW, BLUE);
TYPE ENUM2 IS ('A', 'C', RED, BLUE);
BEGIN
IF ENUM2'SUCC ('A') /= 'C' THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
"IN BLOCK" );
END IF;
IF ENUM1'POS (RED) /= 3 THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
"IN BLOCK" );
END IF;
END;
DECLARE
USE PKG;
BEGIN
IF ENUM2'SUCC ('A') /= 'C' THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
"IN PKG - 2" );
END IF;
IF ENUM1'POS (RED) /= 3 THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
"IN PKG - 2" );
END IF;
END;
DECLARE
USE PRIV;
BEGIN
IF FE2 (E2'SUCC('A')) /= FE2 ('C') THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
"IN PRIV - 2" );
END IF;
IF FE1 (RED) /= FE1 (E1'VAL (3)) THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
"IN PRIV - 2" );
END IF;
END;
DECLARE
USE LPRIV;
BEGIN
IF NOT EQUALS (FE2 (E2'SUCC('A')), FE2 ('C')) THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN ENUM2 " &
"IN LPRIV - 2" );
END IF;
IF NOT EQUALS (FE1 (RED), FE1 (E1'VAL (3))) THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN ENUM1 " &
"IN LPRIV - 2" );
END IF;
END;
BEGIN
IF E2'SUCC ('A') /= 'C' THEN
FAILED ( "'A' NOT DECLARED CORRECTLY IN E2" );
END IF;
IF E1'POS (RED) /= 3 THEN
FAILED ( "RED NOT DECLARED CORRECTLY IN E1" );
END IF;
END;
NEWGP1;
NEWGP2;
T2.E;
RESULT;
END C35102A;