WITH REPORT; USE REPORT;
PROCEDURE C62003B IS
BEGIN
TEST("C62003B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
"PARAMETERS ARE COPIED");
A_B: 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
A : DECLARE
I : T;
E : EXCEPTION;
PROCEDURE P (PI : IN T; PO : OUT T; PIO : IN OUT T) IS
TEMP : T;
BEGIN
TEMP := PI;
PO := C10;
IF (PI /= TEMP) THEN
FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) OUT " &
"PARAMETER CHANGES THE VALUE OF " &
"INPUT PARAMETER");
TEMP := PI; END IF;
PIO := PIO + C100;
IF (PI /= TEMP) THEN
FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) IN " &
"OUT PARAMETER CHANGES THE VALUE OF " &
"INPUT PARAMETER");
TEMP := PI; END IF;
I := I + C1;
IF (PI /= TEMP) THEN
FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) " &
"ACTUAL PARAMETER CHANGES THE " &
"VALUE OF INPUT PARAMETER");
END IF;
RAISE E; END P;
BEGIN I := C0; P (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 A;
B : DECLARE
I, J : T;
FUNCTION F (FI : IN T) RETURN T IS
TEMP : T := FI;
BEGIN
I := I + C1;
IF (FI /= TEMP) THEN
FAILED ("ASSIGNMENT TO PRIVATE (SCALAR) " &
"ACTUAL FUNCTION PARAMETER CHANGES " &
"THE VALUE OF INPUT PARAMETER ");
END IF;
RETURN C0;
END F;
BEGIN I := C0;
J := F(I);
END B;
END A_B;
C_D: 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
C : DECLARE
I : T;
E : EXCEPTION;
PROCEDURE P (PI : IN T; PO : OUT T; PIO : IN OUT T) IS
TEMP : T;
BEGIN
TEMP := PI;
I := C101;
IF (PI /= TEMP) THEN
FAILED ("ASSIGNMENT TO PRIVATE (ACCESS) " &
"ACTUAL VARIABLE CHANGES THE VALUE " &
"OF INPUT PARAMETER");
TEMP := PI; END IF;
PO := C1;
IF (PI /= TEMP) THEN
FAILED ("ASSIGNMENT TO PRIVATE (ACCESS) OUT " &
"PARAMETER CHANGES THE VALUE OF " &
"INPUT PARAMETER");
TEMP := PI; END IF;
PIO := C10;
IF (PI /= TEMP) THEN
FAILED ("ASSIGNMENT TO PRIVATE (ACCESS) IN " &
"OUT PARAMETER CHANGES THE VALUE " &
"OF INPUT PARAMETER");
END IF;
RAISE E; END P;
BEGIN I := C100;
P (I, I, I);
FAILED ("EXCEPTION NOT RAISED - C");
EXCEPTION
WHEN E =>
IF (I /= C101) THEN
FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
"PARAMETER VALUE CHANGED DESPITE " &
"RAISED EXCEPTION");
END IF;
WHEN OTHERS =>
FAILED ("WRONG EXCEPTION RAISED - C");
END C;
D : DECLARE
I, J : T;
FUNCTION F (FI : IN T) RETURN T IS
TEMP : T := FI;
BEGIN I := C100;
IF (FI /= TEMP) THEN
FAILED ("ASSIGNMENT TO PRIVATE " &
"(ACCESS) ACTUAL FUNCTION " &
"PARAMETER CHANGES THE VALUE " &
"OF INPUT PARAMETER");
END IF;
RETURN C_NULL;
END F;
BEGIN I := C_NULL;
J := F(I);
END D;
END C_D;
RESULT;
END C62003B;