WITH SYSTEM; USE SYSTEM;
WITH REPORT; USE REPORT;
PROCEDURE C34007M IS
SUBTYPE COMPONENT IS INTEGER;
TYPE DESIGNATED IS
RECORD
C : COMPONENT;
B : BOOLEAN := TRUE;
END RECORD;
TYPE PARENT IS ACCESS DESIGNATED;
TYPE T IS NEW PARENT;
X : T := NEW DESIGNATED'(2, FALSE);
K : INTEGER := X'SIZE;
Y : T := NEW DESIGNATED'(1, TRUE);
W : PARENT := NEW DESIGNATED'(2, FALSE);
C : COMPONENT := 1;
PROCEDURE A (X : ADDRESS) IS
BEGIN
NULL;
END A;
FUNCTION IDENT (X : T) RETURN T IS
BEGIN
IF X = NULL OR ELSE EQUAL (X.C, X.C) THEN
RETURN X; END IF;
RETURN NEW DESIGNATED'(-1, FALSE);
END IDENT;
BEGIN
TEST ("C34007M", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
"ARE DECLARED (IMPLICITLY) FOR DERIVED " &
"ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
"RECORD TYPE WITHOUT DISCRIMINANTS");
IF Y = NULL OR ELSE Y.ALL /= (1, TRUE) THEN
FAILED ("INCORRECT INITIALIZATION");
END IF;
X := IDENT (Y);
IF X /= Y THEN
FAILED ("INCORRECT :=");
END IF;
IF T'(X) /= Y THEN
FAILED ("INCORRECT QUALIFICATION");
END IF;
IF T (X) /= Y THEN
FAILED ("INCORRECT SELF CONVERSION");
END IF;
IF EQUAL (3, 3) THEN
W := NEW DESIGNATED'(1, TRUE);
END IF;
X := T (W);
IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, TRUE) THEN
FAILED ("INCORRECT CONVERSION FROM PARENT");
END IF;
X := IDENT (Y);
W := PARENT (X);
IF W = NULL OR ELSE W.ALL /= (1, TRUE) OR ELSE T (W) /= Y THEN
FAILED ("INCORRECT CONVERSION TO PARENT");
END IF;
IF IDENT (NULL) /= NULL OR X = NULL THEN
FAILED ("INCORRECT NULL");
END IF;
X := IDENT (NEW DESIGNATED'(1, TRUE));
IF X = NULL OR ELSE X = Y OR ELSE X.ALL /= (1, TRUE) THEN
FAILED ("INCORRECT ALLOCATOR");
END IF;
X := IDENT (Y);
IF X.C /= 1 OR X.B /= TRUE THEN
FAILED ("INCORRECT SELECTION (VALUE)");
END IF;
X.C := IDENT_INT (3);
X.B := IDENT_BOOL (FALSE);
IF X /= Y OR Y.ALL /= (3, FALSE) THEN
FAILED ("INCORRECT SELECTION (ASSIGNMENT)");
END IF;
Y.ALL := (1, TRUE);
X := IDENT (Y);
IF X.ALL /= (1, TRUE) THEN
FAILED ("INCORRECT .ALL (VALUE)");
END IF;
X.ALL := (10, FALSE);
IF X /= Y OR Y.ALL /= (10, FALSE) THEN
FAILED ("INCORRECT .ALL (ASSIGNMENT)");
END IF;
Y.ALL := (1, TRUE);
X := IDENT (NULL);
BEGIN
IF X.ALL = (0, FALSE) THEN
FAILED ("NO EXCEPTION FOR NULL.ALL - 1");
ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR =>
NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION FOR NULL.ALL");
END;
X := IDENT (Y);
IF X = NULL OR X = NEW DESIGNATED OR NOT (X = Y) THEN
FAILED ("INCORRECT =");
END IF;
IF X /= Y OR NOT (X /= NULL) THEN
FAILED ("INCORRECT /=");
END IF;
IF NOT (X IN T) THEN
FAILED ("INCORRECT ""IN""");
END IF;
IF X NOT IN T THEN
FAILED ("INCORRECT ""NOT IN""");
END IF;
A (X'ADDRESS);
BEGIN
IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN
FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " &
"EQUAL TO COLLECTION SIZE OF PARENT TYPE");
END IF;
EXCEPTION
WHEN PROGRAM_ERROR =>
COMMENT ("PROGRAM_ERROR RAISED FOR " &
"UNDEFINED STORAGE_SIZE (AI-00608)");
WHEN OTHERS =>
FAILED ("UNEXPECTED EXCEPTION RAISED");
END;
RESULT;
END C34007M;