WITH SYSTEM; USE SYSTEM;
WITH REPORT; USE REPORT;
PROCEDURE C34009G IS
PACKAGE PKG IS
TYPE PARENT IS LIMITED PRIVATE;
FUNCTION CREATE (X : INTEGER) RETURN PARENT;
FUNCTION CON (X : INTEGER) RETURN PARENT;
FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN;
PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT);
PRIVATE
TYPE PARENT IS NEW INTEGER;
END PKG;
USE PKG;
TYPE T IS NEW PARENT;
X : T;
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;
FUNCTION EQUAL (X, Y : PARENT) RETURN BOOLEAN IS
BEGIN
RETURN X = Y;
END EQUAL;
PROCEDURE ASSIGN (X : OUT PARENT; Y : PARENT) IS
BEGIN
X := Y;
END ASSIGN;
END PKG;
BEGIN
TEST ("C34009G", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
"ARE DECLARED (IMPLICITLY) FOR DERIVED " &
"LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS");
ASSIGN (X, CREATE (30));
IF NOT EQUAL (T'(X), CON (30)) THEN
FAILED ("INCORRECT QUALIFICATION");
END IF;
IF NOT EQUAL (T (X), CON (30)) THEN
FAILED ("INCORRECT SELF CONVERSION");
END IF;
ASSIGN (W, CREATE (-30));
IF NOT EQUAL (T (W), CON (-30)) THEN
FAILED ("INCORRECT CONVERSION FROM PARENT");
END IF;
IF NOT EQUAL (PARENT (X), CON (30)) THEN
FAILED ("INCORRECT CONVERSION TO PARENT");
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;
IF X'SIZE < T'SIZE THEN
FAILED ("INCORRECT OBJECT'SIZE");
END IF;
RESULT;
END C34009G;