WITH REPORT;
USE REPORT;
PROCEDURE C58005H IS
PACKAGE PACK IS
TYPE PV (D : NATURAL) IS PRIVATE;
TYPE LP (D : NATURAL) IS LIMITED PRIVATE;
PRIVATE
TYPE PV (D : NATURAL) IS RECORD
NULL;
END RECORD;
TYPE LP (D : NATURAL) IS RECORD
NULL;
END RECORD;
END PACK;
USE PACK;
TYPE ARR IS ARRAY (NATURAL RANGE <>) OF NATURAL;
TYPE REC (D : NATURAL) IS RECORD
NULL;
END RECORD;
TYPE ACC_REC IS ACCESS REC;
TYPE ACC_ARR IS ACCESS ARR;
TYPE ACC_PV IS ACCESS PV;
TYPE ACC_LP IS ACCESS LP;
SUBTYPE ACC_REC1 IS ACC_REC (D => 1);
SUBTYPE ACC_REC2 IS ACC_REC (D => 2);
SUBTYPE ACC_ARR1 IS ACC_ARR (1 .. 10);
SUBTYPE ACC_ARR2 IS ACC_ARR (2 .. 5);
SUBTYPE ACC_PV1 IS ACC_PV (D => 1);
SUBTYPE ACC_PV2 IS ACC_PV (D => 2);
SUBTYPE ACC_LP1 IS ACC_LP (D => 1);
SUBTYPE ACC_LP2 IS ACC_LP (D => 2);
VAR1 : ACC_REC1 := NEW REC(1);
VAR2 : ACC_REC2 := NEW REC(2);
VAA1 : ACC_ARR1 := NEW ARR(1 .. 10);
VAA2 : ACC_ARR2 := NEW ARR(2 .. 5);
VAP1 : ACC_PV1 := NEW PV(1);
VAP2 : ACC_PV2 := NEW PV(2);
VAL1 : ACC_LP1 := NEW LP(1);
VAL2 : ACC_LP2 := NEW LP(2);
FUNCTION FREC ( X : ACC_REC1) RETURN ACC_REC2 IS
BEGIN
RETURN X;
END FREC;
FUNCTION FARR ( X : ACC_ARR1) RETURN ACC_ARR2 IS
BEGIN
RETURN X;
END FARR;
FUNCTION FPV ( X : ACC_PV1) RETURN ACC_PV2 IS
BEGIN
RETURN X;
END FPV;
FUNCTION FLP ( X : ACC_LP1) RETURN ACC_LP2 IS
BEGIN
RETURN X;
END FLP;
PACKAGE BODY PACK IS
FUNCTION LF (X : LP) RETURN INTEGER IS
BEGIN
RETURN IDENT_INT(3);
END LF;
BEGIN
NULL;
END PACK;
BEGIN
TEST ("C58005H", "CHECK ACCESS CONSTRAINTS ON RETURN VALUES " &
"OF FUNCTIONS");
BEGIN
VAR2 := FREC (VAR1);
IF VAR2.D /= REPORT.IDENT_INT(2) THEN
FAILED ("CONSTRAINT_ERROR NOT RAISED - REC 1");
ELSE
FAILED ("CONSTRAINT_ERROR NOT RAISED - REC 2");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR => NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - REC");
END;
BEGIN
VAA2 := FARR (VAA1);
IF VAA2'FIRST /= REPORT.IDENT_INT(2) THEN
FAILED ("CONSTRAINT_ERROR NOT RAISED - ARR 1");
ELSE
FAILED ("CONSTRAINT_ERROR NOT RAISED - ARR 2");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR => NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - ARR");
END;
BEGIN
VAP2 := FPV (VAP1);
IF VAP2.D /= REPORT.IDENT_INT(2) THEN
FAILED ("CONSTRAINT_ERROR NOT RAISED - PV 1");
ELSE
FAILED ("CONSTRAINT_ERROR NOT RAISED - PV 2");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR => NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - PV");
END;
BEGIN
VAL2 := FLP (VAL1);
IF VAL2.D /= REPORT.IDENT_INT(2) THEN
FAILED ("CONSTRAINT_ERROR NOT RAISED - LP 1");
ELSE
FAILED ("CONSTRAINT_ERROR NOT RAISED - LP 2");
END IF;
EXCEPTION
WHEN CONSTRAINT_ERROR => NULL;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - LP");
END;
RESULT;
END C58005H;