-- C95086E.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 CONSTRAINT_ERROR IS NOT RAISED BEFORE OR AFTER THE ENTRY -- CALL FOR IN OUT ARRAY PARAMETERS, WHERE THE ACTUAL PARAMETER HAS THE -- FORM OF A TYPE CONVERSION. THE FOLLOWING CASES ARE TESTED: -- (A) OK CASE. -- (B) FORMAL CONSTRAINED, BOTH FORMAL AND ACTUAL HAVE SAME NUMBER -- COMPONENTS PER DIMENSION, BUT ACTUAL INDEX BOUNDS LIE OUTSIDE -- FORMAL INDEX SUBTYPE. -- (C) FORMAL CONSTRAINED, FORMAL AND ACTUAL HAVE DIFFERENT NUMBER -- COMPONENTS PER DIMENSION, BOTH FORMAL AND ACTUAL ARE NULL -- ARRAYS. -- (D) FORMAL CONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE -- FORMAL INDEX SUBTYPE. -- (E) FORMAL UNCONSTRAINED, ACTUAL NULL, WITH INDEX BOUNDS OUTSIDE -- FORMAL INDEX SUBTYPE FOR NULL DIMENSIONS ONLY. -- RJW 2/3/86 -- TMB 11/15/95 ELIMINATED INCOMPATIBILITY WITH ADA95 -- TMB 11/19/96 FIXED SLIDING PROBLEM IN SECTION D WITH REPORT; USE REPORT; PROCEDURE C95086E IS BEGIN TEST ("C95086E", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " & "BEFORE OR AFTER THE ENTRY CALL FOR IN OUT ARRAY " & "PARAMETERS, WITH THE ACTUAL HAVING THE FORM OF A TYPE " & "CONVERSION"); --------------------------------------------- DECLARE -- (A) SUBTYPE INDEX IS INTEGER RANGE 1..5; TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF BOOLEAN; SUBTYPE FORMAL IS ARRAY_TYPE (1..3, 1..3); SUBTYPE ACTUAL IS ARRAY_TYPE (1..3, 1..3); AR : ACTUAL := (1..3 => (1..3 => TRUE)); CALLED : BOOLEAN := FALSE; TASK T IS ENTRY E (X : IN OUT FORMAL); END T; TASK BODY T IS BEGIN ACCEPT E (X : IN OUT FORMAL) DO CALLED := TRUE; END E; EXCEPTION WHEN OTHERS => FAILED ("EXCEPTION RAISED IN TASK - (A)"); END T; BEGIN -- (A) T.E (FORMAL (AR)); EXCEPTION WHEN CONSTRAINT_ERROR => IF NOT CALLED THEN FAILED ("EXCEPTION RAISED BEFORE CALL - (A)"); ELSE FAILED ("EXCEPTION RAISED ON RETURN - (A)"); END IF; WHEN OTHERS => FAILED ("EXCEPTION RAISED - (A)"); END; -- (A) --------------------------------------------- DECLARE -- (B) SUBTYPE INDEX IS INTEGER RANGE 1..3; TYPE FORMAL IS ARRAY (INDEX, INDEX) OF BOOLEAN; TYPE ACTUAL IS ARRAY (3..5, 3..5) OF BOOLEAN; AR : ACTUAL := (3..5 => (3..5 => FALSE)); CALLED : BOOLEAN := FALSE; TASK T IS ENTRY E (X : IN OUT FORMAL); END T; TASK BODY T IS BEGIN ACCEPT E (X : IN OUT FORMAL) DO CALLED := TRUE; X(3, 3) := TRUE; END E; EXCEPTION WHEN OTHERS => FAILED ("EXCEPTION RAISED IN TASK - (B)"); END T; BEGIN -- (B) T.E (FORMAL (AR)); IF AR(5, 5) /= TRUE THEN FAILED ("INCORRECT RETURNED VALUE - (B)"); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => IF NOT CALLED THEN FAILED ("EXCEPTION RAISED BEFORE CALL - (B)"); ELSE FAILED ("EXCEPTION RAISED ON RETURN - (B)"); END IF; WHEN OTHERS => FAILED ("EXCEPTION RAISED - (B)"); END; -- (B) --------------------------------------------- DECLARE -- (C) SUBTYPE INDEX IS INTEGER RANGE 1..5; TYPE ARRAY_TYPE IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF CHARACTER; SUBTYPE FORMAL IS ARRAY_TYPE (2..0, 1..3); AR : ARRAY_TYPE (2..1, 1..3) := (2..1 => (1..3 => ' ')); CALLED : BOOLEAN := FALSE; TASK T IS ENTRY E (X : IN OUT FORMAL); END T; TASK BODY T IS BEGIN ACCEPT E (X : IN OUT FORMAL) DO IF X'LAST /= 0 AND X'LAST(2) /= 3 THEN FAILED ("WRONG BOUNDS PASSED - (C)"); END IF; CALLED := TRUE; X := (2..0 => (1..3 => 'A')); END E; EXCEPTION WHEN OTHERS => FAILED ("EXCEPTION RAISED IN TASK - (C)"); END T; BEGIN -- (C) T.E (FORMAL (AR)); IF AR'LAST /= 1 AND AR'LAST(2) /= 3 THEN FAILED ("BOUNDS CHANGED - (C)"); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => IF NOT CALLED THEN FAILED ("EXCEPTION RAISED BEFORE CALL - (C)"); ELSE FAILED ("EXCEPTION RAISED ON RETURN - (C)"); END IF; WHEN OTHERS => FAILED ("EXCEPTION RAISED - (C)"); END; -- (C) --------------------------------------------- DECLARE -- (D) SUBTYPE INDEX IS INTEGER RANGE 1..3; TYPE FORMAL IS ARRAY (INDEX RANGE 1..3, INDEX RANGE 3..1) OF CHARACTER; TYPE ACTUAL IS ARRAY (3..5, 5..3) OF CHARACTER; AR : ACTUAL := (3..5 => (5..3 => ' ')); CALLED : BOOLEAN := FALSE; TASK T IS ENTRY E (X : IN OUT FORMAL); END T; TASK BODY T IS BEGIN ACCEPT E (X : IN OUT FORMAL) DO IF X'LAST /= 3 AND X'LAST(2) /= 1 THEN FAILED ("WRONG BOUNDS PASSED - (D)"); END IF; CALLED := TRUE; X := (1..3 => (3..1 => 'A')); END E; EXCEPTION WHEN OTHERS => FAILED ("EXCEPTION RAISED IN TASK - (D)"); END T; BEGIN -- (D) T.E (FORMAL (AR)); IF AR'LAST /= 5 AND AR'LAST(2) /= 3 THEN FAILED ("BOUNDS CHANGED - (D)"); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => IF NOT CALLED THEN FAILED ("EXCEPTION RAISED BEFORE CALL - (D)"); ELSE FAILED ("EXCEPTION RAISED ON RETURN - (D)"); END IF; WHEN OTHERS => FAILED ("EXCEPTION RAISED - (D)"); END; -- (D) --------------------------------------------- DECLARE -- (E) SUBTYPE INDEX IS INTEGER RANGE 1..3; TYPE FORMAL IS ARRAY (INDEX RANGE <>, INDEX RANGE <>) OF CHARACTER; TYPE ACTUAL IS ARRAY (POSITIVE RANGE 5..2, POSITIVE RANGE 1..3) OF CHARACTER; AR : ACTUAL := (5..2 => (1..3 => ' ')); CALLED : BOOLEAN := FALSE; TASK T IS ENTRY E (X : IN OUT FORMAL); END T; TASK BODY T IS BEGIN ACCEPT E (X : IN OUT FORMAL) DO IF X'LAST /= 2 AND X'LAST(2) /= 3 THEN FAILED ("WRONG BOUNDS PASSED - (E)"); END IF; CALLED := TRUE; X := (3..1 => (1..3 => ' ')); END E; EXCEPTION WHEN OTHERS => FAILED ("EXCEPTION RAISED IN TASK - (E)"); END T; BEGIN -- (E) T.E (FORMAL (AR)); IF AR'LAST /= 2 AND AR'LAST(2) /= 3 THEN FAILED ("BOUNDS CHANGED - (E)"); END IF; EXCEPTION WHEN CONSTRAINT_ERROR => IF NOT CALLED THEN FAILED ("EXCEPTION RAISED BEFORE CALL - (E)"); ELSE FAILED ("EXCEPTION RAISED ON RETURN - (E)"); END IF; WHEN OTHERS => FAILED ("EXCEPTION RAISED - (E)"); END; -- (E) --------------------------------------------- RESULT; END C95086E;