WITH SYSTEM; USE SYSTEM;
WITH REPORT; USE REPORT;
PROCEDURE C34007V IS
SUBTYPE COMPONENT IS INTEGER;
TYPE DESIGNATED IS ARRAY (NATURAL RANGE <>) OF COMPONENT;
SUBTYPE SUBDESIGNATED IS DESIGNATED (IDENT_INT (5) ..
IDENT_INT (7));
PACKAGE PKG IS
TYPE PARENT IS ACCESS DESIGNATED;
FUNCTION CREATE ( F, L : NATURAL;
C : COMPONENT;
DUMMY : PARENT ) RETURN PARENT;
END PKG;
USE PKG;
TYPE T IS NEW PARENT (IDENT_INT (5) .. IDENT_INT (7));
X : T := NEW SUBDESIGNATED'(OTHERS => 2);
K : INTEGER := X'SIZE;
Y : T := NEW SUBDESIGNATED'(1, 2, 3);
W : PARENT := NEW SUBDESIGNATED'(OTHERS => 2);
C : COMPONENT := 1;
N : CONSTANT := 1;
FUNCTION V RETURN T IS
BEGIN
RETURN NEW SUBDESIGNATED'(OTHERS => C);
END V;
PACKAGE BODY PKG IS
FUNCTION CREATE
( F, L : NATURAL;
C : COMPONENT;
DUMMY : PARENT
) RETURN PARENT
IS
A : PARENT := NEW DESIGNATED (F .. L);
B : COMPONENT := C;
BEGIN
FOR I IN F .. L LOOP
A (I) := B;
B := B + 1;
END LOOP;
RETURN A;
END CREATE;
END PKG;
FUNCTION IDENT (X : T) RETURN T IS
BEGIN
IF X = NULL OR ELSE
EQUAL (X'LENGTH, X'LENGTH) THEN
RETURN X; END IF;
RETURN NEW SUBDESIGNATED;
END IDENT;
BEGIN
TEST ("C34007V", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
"ARE DECLARED (IMPLICITLY) FOR DERIVED " &
"ACCESS TYPES WHOSE DESIGNATED TYPE IS A " &
"ONE-DIMENSIONAL ARRAY TYPE. THIS TEST IS " &
"PART 2 OF 2 TESTS WHICH COVER THE OBJECTIVE. " &
"THE FIRST PART IS IN TEST C34007V");
W := PARENT (CREATE (2, 3, 4, X));
IF W = NULL OR ELSE W.ALL /= (4, 5) THEN
FAILED ("INCORRECT CONVERSION TO PARENT - 2");
END IF;
X := IDENT (Y);
IF X.ALL /= (1, 2, 3) OR CREATE (2, 3, 4, X) . ALL /= (4, 5) THEN
FAILED ("INCORRECT .ALL (VALUE)");
END IF;
X.ALL := (10, 11, 12);
IF X /= Y OR Y.ALL /= (10, 11, 12) THEN
FAILED ("INCORRECT .ALL (ASSIGNMENT)");
END IF;
Y.ALL := (1, 2, 3);
BEGIN
CREATE (2, 3, 4, X) . ALL := (10, 11);
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION FOR .ALL (ASSIGNMENT)");
END;
X := IDENT (Y);
IF X (IDENT_INT (5)) /= 1 OR
CREATE (2, 3, 4, X) (3) /= 5 THEN
FAILED ("INCORRECT INDEX (VALUE)");
END IF;
Y.ALL := (1, 2, 3);
X := IDENT (Y);
BEGIN
CREATE (2, 3, 4, X) (2) := 10;
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION FOR INDEX (ASSIGNMENT)");
END;
IF X (IDENT_INT (6) .. IDENT_INT (7)) /= (2, 3) OR
CREATE (1, 4, 4, X) (1 .. 3) /= (4, 5, 6) THEN
FAILED ("INCORRECT SLICE (VALUE)");
END IF;
Y.ALL := (1, 2, 3);
X := IDENT (Y);
BEGIN
CREATE (1, 4, 4, X) (2 .. 4) := (10, 11, 12);
EXCEPTION
WHEN OTHERS =>
FAILED ("EXCEPTION FOR SLICE (ASSIGNMENT)");
END;
IF X = NULL OR X = NEW SUBDESIGNATED OR NOT (X = Y) OR
X = CREATE (2, 3, 4, X) THEN
FAILED ("INCORRECT =");
END IF;
IF X /= Y OR NOT (X /= NULL) OR NOT (X /= CREATE (2, 3, 4, X)) THEN
FAILED ("INCORRECT /=");
END IF;
IF NOT (X IN T) OR CREATE (2, 3, 4, X) IN T THEN
FAILED ("INCORRECT ""IN""");
END IF;
IF X NOT IN T OR NOT (CREATE (2, 3, 4, X) NOT IN T) THEN
FAILED ("INCORRECT ""NOT IN""");
END IF;
RESULT;
END C34007V;