-- C62003A.ADA -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- released technical data and computer software in whole or in part, in -- any manner and for any purpose whatsoever, and to have or permit others -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- CHECK THAT SCALAR AND ACCESS PARAMETERS ARE COPIED. -- SUBTESTS ARE: -- (A) SCALAR PARAMETERS TO PROCEDURES. -- (B) SCALAR PARAMETERS TO FUNCTIONS. -- (C) ACCESS PARAMETERS TO PROCEDURES. -- (D) ACCESS PARAMETERS TO FUNCTIONS. -- DAS 01/14/80 -- SPS 10/26/82 -- CPP 05/25/84 -- EG 10/29/85 ELIMINATE THE USE OF NUMERIC_ERROR IN TEST. WITH REPORT; PROCEDURE C62003A IS USE REPORT; BEGIN TEST ("C62003A", "CHECK THAT SCALAR AND ACCESS PARAMETERS ARE " & "COPIED"); -------------------------------------------------- DECLARE -- (A) I : INTEGER; E : EXCEPTION; PROCEDURE P (PI : IN INTEGER; PO : OUT INTEGER; PIO : IN OUT INTEGER) IS TMP : INTEGER; BEGIN TMP := PI; -- SAVE VALUE OF PI AT PROC ENTRY. PO := 10; IF (PI /= TMP) THEN FAILED ("ASSIGNMENT TO SCALAR OUT " & "PARAMETER CHANGES THE VALUE OF " & "INPUT PARAMETER"); TMP := PI; -- RESET TMP FOR NEXT CASE. END IF; PIO := PIO + 100; IF (PI /= TMP) THEN FAILED ("ASSIGNMENT TO SCALAR IN OUT " & "PARAMETER CHANGES THE VALUE OF " & "INPUT PARAMETER"); TMP := PI; -- RESET TMP FOR NEXT CASE. END IF; I := I + 1; IF (PI /= TMP) THEN FAILED ("ASSIGNMENT TO SCALAR ACTUAL " & "PARAMETER CHANGES THE VALUE OF " & "INPUT PARAMETER"); END IF; RAISE E; -- CHECK EXCEPTION HANDLING. END P; BEGIN -- (A) I := 0; -- INITIALIZE I SO VARIOUS CASES CAN BE DETECTED. P (I, I, I); FAILED ("EXCEPTION NOT RAISED - A"); EXCEPTION WHEN E => IF (I /= 1) THEN CASE I IS WHEN 11 => FAILED ("OUT ACTUAL SCALAR PARAMETER " & "CHANGED GLOBAL VALUE"); WHEN 101 => FAILED ("IN OUT ACTUAL SCALAR " & "PARAMETER CHANGED GLOBAL VALUE"); WHEN 111 => FAILED ("OUT AND IN OUT ACTUAL SCALAR " & "PARAMETERS CHANGED GLOBAL " & "VALUE"); WHEN OTHERS => FAILED ("UNDETERMINED CHANGE TO GLOBAL " & "VALUE"); END CASE; END IF; WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED - A"); END; -- (A) -------------------------------------------------- DECLARE -- (B) I,J : INTEGER; FUNCTION F (FI : IN INTEGER) RETURN INTEGER IS TMP : INTEGER := FI; BEGIN I := I + 1; IF (FI /= TMP) THEN FAILED ("ASSIGNMENT TO SCALAR ACTUAL FUNCTION " & "PARAMETER CHANGES THE VALUE OF " & "INPUT PARAMETER"); END IF; RETURN (100); END F; BEGIN -- (B) I := 100; J := F(I); END; -- (B) -------------------------------------------------- DECLARE -- (C) TYPE ACCTYPE IS ACCESS INTEGER; I : ACCTYPE; E : EXCEPTION; PROCEDURE P (PI : IN ACCTYPE; PO : OUT ACCTYPE; PIO : IN OUT ACCTYPE) IS TMP : ACCTYPE; BEGIN TMP := PI; -- SAVE VALUE OF PI AT PROC ENTRY. I := NEW INTEGER'(101); IF (PI /= TMP) THEN FAILED ("ASSIGNMENT TO ACCESS ACTUAL " & "PARAMETER CHANGES THE VALUE OF " & "INPUT PARAMETER"); TMP := PI; -- RESET TMP FOR NEXT CASE. END IF; PO := NEW INTEGER'(1); IF (PI /= TMP) THEN FAILED ("ASSIGNMENT TO ACCESS OUT " & "PARAMETER CHANGES THE VALUE OF " & "INPUT PARAMETER"); TMP := PI; -- RESET TMP FOR NEXT CASE. END IF; PIO := NEW INTEGER'(10); IF (PI /= TMP) THEN FAILED ("ASSIGNMENT TO ACCESS IN OUT " & "PARAMETER CHANGES THE VALUE OF " & "INPUT PARAMETER"); END IF; RAISE E; -- CHECK EXCEPTION HANDLING. END P; BEGIN -- (C) I := NEW INTEGER'(100); P (I, I, I); FAILED ("EXCEPTION NOT RAISED - C"); EXCEPTION WHEN E => IF (I.ALL /= 101) 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) -------------------------------------------------- DECLARE -- (D) TYPE ACCTYPE IS ACCESS INTEGER; I,J : ACCTYPE; FUNCTION F (FI : IN ACCTYPE) RETURN ACCTYPE IS TMP : ACCTYPE := FI; BEGIN I := NEW INTEGER; IF (FI /= TMP) THEN FAILED ("ASSIGNMENT TO ACCESS ACTUAL FUNCTION " & "PARAMETER CHANGES THE VALUE OF " & "INPUT PARAMETER"); END IF; RETURN (NULL); END F; BEGIN -- (D) I := NULL; J := F(I); END; -- (D) -------------------------------------------------- RESULT; END C62003A;