WITH REPORT; USE REPORT;
PROCEDURE C95072B IS
BEGIN
TEST("C95072B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
"PARAMETERS ARE COPIED");
DECLARE
PACKAGE SCALAR_PKG IS
TYPE T IS PRIVATE;
C0 : CONSTANT T;
C1 : CONSTANT T;
C10 : CONSTANT T;
C100 : CONSTANT T;
FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T;
FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER;
PRIVATE
TYPE T IS NEW INTEGER;
C0 : CONSTANT T := 0;
C1 : CONSTANT T := 1;
C10 : CONSTANT T := 10;
C100 : CONSTANT T := 100;
END SCALAR_PKG;
PACKAGE BODY SCALAR_PKG IS
FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T IS
BEGIN
RETURN T (INTEGER(OLD) + INTEGER(INCREMENT));
END "+";
FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER IS
BEGIN
RETURN INTEGER (OLD_PRIVATE);
END CONVERT;
END SCALAR_PKG;
USE SCALAR_PKG;
BEGIN
DECLARE
I : T;
E : EXCEPTION;
TASK TA IS
ENTRY EA (EI : IN T; EO : OUT T;
EIO : IN OUT T);
END TA;
TASK BODY TA IS
TEMP : T;
BEGIN
ACCEPT EA (EI : IN T; EO : OUT T;
EIO : IN OUT T) DO
TEMP := EI;
EO := C10;
IF EI /= TEMP THEN
FAILED ("ASSIGNMENT TO PRIVATE " &
"(SCALAR) OUT PARAMETER " &
"CHANGES THE VALUE OF INPUT " &
"PARAMETER");
TEMP := EI; END IF;
EIO := EIO + C100;
IF EI /= TEMP THEN
FAILED ("ASSIGNMENT TO PRIVATE " &
"(SCALAR) IN OUT PARAMETER " &
"CHANGES THE VALUE OF INPUT " &
"PARAMETER");
TEMP := EI; END IF;
I := I + C1;
IF EI /= TEMP THEN
FAILED ("ASSIGNMENT TO PRIVATE " &
"(SCALAR) ACTUAL PARAMETER " &
"CHANGES THE VALUE OF " &
"INPUT PARAMETER");
END IF;
RAISE E; END EA;
EXCEPTION
WHEN OTHERS => NULL;
END TA;
BEGIN
I := C0; TA.EA (I, I, I);
FAILED ("EXCEPTION NOT RAISED - A");
EXCEPTION
WHEN E =>
IF I /= C1 THEN
CASE CONVERT (I) IS
WHEN 11 =>
FAILED ("OUT ACTUAL PRIVATE " &
"(SCALAR) PARAMETER " &
"CHANGED GLOBAL VALUE");
WHEN 101 =>
FAILED ("IN OUT ACTUAL PRIVATE " &
"(SCALAR) PARAMETER " &
"CHANGED GLOBAL VALUE");
WHEN 111 =>
FAILED ("OUT AND IN OUT ACTUAL " &
"PRIVATE (SCALAR) " &
"PARAMETER CHANGED " &
"GLOBAL VALUE");
WHEN OTHERS =>
FAILED ("UNDETERMINED CHANGE TO " &
"GLOBAL VALUE");
END CASE;
END IF;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - A");
END;
END;
DECLARE
PACKAGE ACCESS_PKG IS
TYPE T IS PRIVATE;
C_NULL : CONSTANT T;
C1 : CONSTANT T;
C10 : CONSTANT T;
C100 : CONSTANT T;
C101 : CONSTANT T;
PRIVATE
TYPE T IS ACCESS INTEGER;
C_NULL : CONSTANT T := NULL;
C1 : CONSTANT T := NEW INTEGER'(1);
C10 : CONSTANT T := NEW INTEGER'(10);
C100 : CONSTANT T := NEW INTEGER'(100);
C101 : CONSTANT T := NEW INTEGER'(101);
END ACCESS_PKG;
USE ACCESS_PKG;
BEGIN
DECLARE
I : T;
E : EXCEPTION;
TASK TB IS
ENTRY EB (EI : IN T; EO : OUT T;
EIO : IN OUT T);
END TB;
TASK BODY TB IS
TEMP : T;
BEGIN
ACCEPT EB (EI : IN T; EO : OUT T;
EIO : IN OUT T) DO
TEMP := EI;
I := C101;
IF EI /= TEMP THEN
FAILED ("ASSIGNMENT TO PRIVATE " &
"(ACCESS) ACTUAL VARIABLE " &
"CHANGES THE VALUE OF INPUT " &
"PARAMETER");
TEMP := EI; END IF;
EO := C1;
IF EI /= TEMP THEN
FAILED ("ASSIGNMENT TO PRIVATE " &
"(ACCESS) OUT PARAMETER " &
"CHANGES THE VALUE OF INPUT " &
"PARAMETER");
TEMP := EI; END IF;
EIO := C10;
IF EI /= TEMP THEN
FAILED ("ASSIGNMENT TO PRIVATE " &
"(ACCESS) IN OUT PARAMETER " &
"CHANGES THE VALUE OF INPUT " &
"PARAMETER");
END IF;
RAISE E; END EB;
EXCEPTION
WHEN OTHERS => NULL;
END TB;
BEGIN
I := C100;
TB.EB (I, I, I);
FAILED ("EXCEPTION NOT RAISED - B");
EXCEPTION
WHEN E =>
IF I /= C101 THEN
FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
"PARAMETER VALUE CHANGED DESPITE " &
"RAISED EXCEPTION");
END IF;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - B");
END;
END;
RESULT;
END C95072B;