WITH REPORT;
PROCEDURE C52011B IS
USE REPORT;
TYPE REC(DISC : INTEGER := -1 ) IS
RECORD
NULL;
END RECORD;
TYPE REC_NAME IS ACCESS REC;
SUBTYPE S1 IS REC_NAME(IDENT_INT(5));
SUBTYPE S2 IS REC_NAME(IDENT_INT(3));
W : REC_NAME := NULL; X1,X2 : S1 := NULL; Y1,Y2 : S2 := NULL;
W_NONNULL : REC_NAME := NEW REC(7) ;
X1_NONNULL : S1 := NEW REC(IDENT_INT(5));
Y1_NONNULL : S2 := NEW REC(IDENT_INT(3));
TOO_EARLY : BOOLEAN := TRUE;
BEGIN
TEST ("C52011B", "DISCRIMINANT CONSTRAINTS ON ACCESS SUBTYPE " &
"OBJECTS MUST BE SATISFIED FOR ASSIGNMENT");
BEGIN
IF EQUAL(3,3) THEN
W_NONNULL := X1; END IF;
IF W_NONNULL /= X1 THEN
FAILED ("ASSIGNMENT FAILED - 1");
END IF;
IF EQUAL(3,3) THEN
W := Y1; END IF;
IF W /= Y1 THEN
FAILED ("ASSIGNMENT FAILED - 2");
END IF;
IF EQUAL(3,3) THEN
X1_NONNULL := Y1; END IF;
IF X1_NONNULL /= Y1 THEN
FAILED ("ASSIGNMENT FAILED - 3");
END IF;
IF EQUAL(3,3) THEN
Y1_NONNULL := Y2; END IF;
IF Y1_NONNULL /= Y2 THEN
FAILED ("ASSIGNMENT FAILED - 4");
END IF;
X1 := NEW REC(IDENT_INT(5));
IF EQUAL(3,3) THEN
X2 := X1; END IF;
IF X1 /= X2 THEN
FAILED ("ASSIGNMENT FAILED - 5");
END IF;
IF EQUAL(3,3) THEN
W := X1; END IF;
IF W /= X1 THEN
FAILED ("ASSIGNMENT FAILED - 6");
END IF;
BEGIN
Y1 := X1; IF Y1.DISC /= REPORT.IDENT_INT(3) THEN
FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
"VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
"AND CONSTRAINT IS CHANGED");
ELSE
FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " &
"VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " &
"AND CONSTRAINT IS NOT CHANGED");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR => NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION - 1");
END;
W := NEW REC(IDENT_INT(3));
BEGIN
X1 := W; IF X1.DISC /= REPORT.IDENT_INT(5) THEN
FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
"ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
"ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
"AND CONSTRAINT IS CHANGED");
ELSE
FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " &
"ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "&
"ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " &
"AND CONSTRAINT IS NOT CHANGED");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL ;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION - 2");
END;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION RAISED");
END;
RESULT;
END C52011B;