WITH SYSTEM; USE SYSTEM;
WITH REPORT; USE REPORT;
PROCEDURE C34009A IS
PACKAGE PKG IS
TYPE PARENT IS PRIVATE;
FUNCTION CREATE (X : INTEGER) RETURN PARENT;
FUNCTION CON (X : INTEGER) RETURN PARENT;
PRIVATE
TYPE PARENT IS NEW INTEGER;
END PKG;
USE PKG;
TYPE T IS NEW PARENT;
X : T;
K : INTEGER := X'SIZE;
W : PARENT;
B : BOOLEAN := FALSE;
PROCEDURE A (X : ADDRESS) IS
BEGIN
B := IDENT_BOOL (TRUE);
END A;
PACKAGE BODY PKG IS
FUNCTION CREATE (X : INTEGER) RETURN PARENT IS
BEGIN
RETURN PARENT (IDENT_INT (X));
END CREATE;
FUNCTION CON (X : INTEGER) RETURN PARENT IS
BEGIN
RETURN PARENT (X);
END CON;
END PKG;
BEGIN
TEST ("C34009A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
"ARE DECLARED (IMPLICITLY) FOR DERIVED " &
"NON-LIMITED PRIVATE TYPES WITHOUT " &
"DISCRIMINANTS");
X := CREATE (30);
IF X /= CON (30) THEN
FAILED ("INCORRECT :=");
END IF;
IF T'(X) /= CON (30) THEN
FAILED ("INCORRECT QUALIFICATION");
END IF;
IF T (X) /= CON (30) THEN
FAILED ("INCORRECT SELF CONVERSION");
END IF;
W := CREATE (-30);
IF T (W) /= CON (-30) THEN
FAILED ("INCORRECT CONVERSION FROM PARENT");
END IF;
IF PARENT (X) /= CON (30) THEN
FAILED ("INCORRECT CONVERSION TO PARENT");
END IF;
IF X = CON (0) THEN
FAILED ("INCORRECT =");
END IF;
IF X /= CON (30) 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;
B := FALSE;
A (X'ADDRESS);
IF NOT B THEN
FAILED ("INCORRECT 'ADDRESS");
END IF;
RESULT;
END C34009A;