-- C61008A.ADA
|
-- C61008A.ADA
|
|
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
-- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF THE DEFAULT VALUE
|
-- CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF THE DEFAULT VALUE
|
-- FOR A FORMAL PARAMETER DOES NOT SATISFY THE CONSTRAINTS OF THE
|
-- FOR A FORMAL PARAMETER DOES NOT SATISFY THE CONSTRAINTS OF THE
|
-- SUBTYPE_INDICATION WHEN THE DECLARATION IS ELABORATED, ONLY WHEN
|
-- SUBTYPE_INDICATION WHEN THE DECLARATION IS ELABORATED, ONLY WHEN
|
-- THE DEFAULT IS USED.
|
-- THE DEFAULT IS USED.
|
|
|
-- SUBTESTS ARE:
|
-- SUBTESTS ARE:
|
-- (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
|
-- (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
|
-- INITIALIZED WITH A STATIC AGGREGATE.
|
-- INITIALIZED WITH A STATIC AGGREGATE.
|
-- (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
|
-- (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
|
-- INITIALIZED WITH A STATIC VALUE.
|
-- INITIALIZED WITH A STATIC VALUE.
|
-- (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
|
-- (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
|
-- CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
|
-- CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
|
-- (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
|
-- (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
|
-- SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
|
-- SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
|
-- WITH A STATIC AGGREGATE.
|
-- WITH A STATIC AGGREGATE.
|
-- (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
|
-- (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
|
-- INITIALIZED WITH A STATIC AGGREGATE.
|
-- INITIALIZED WITH A STATIC AGGREGATE.
|
|
|
-- DAS 1/20/81
|
-- DAS 1/20/81
|
-- SPS 10/26/82
|
-- SPS 10/26/82
|
-- VKG 1/13/83
|
-- VKG 1/13/83
|
-- SPS 2/9/83
|
-- SPS 2/9/83
|
-- BHS 7/9/84
|
-- BHS 7/9/84
|
|
|
WITH REPORT;
|
WITH REPORT;
|
PROCEDURE C61008A IS
|
PROCEDURE C61008A IS
|
|
|
USE REPORT;
|
USE REPORT;
|
|
|
BEGIN
|
BEGIN
|
|
|
TEST ("C61008A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
|
TEST ("C61008A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
|
"AN INITIALIZATION VALUE DOES NOT SATISFY " &
|
"AN INITIALIZATION VALUE DOES NOT SATISFY " &
|
"CONSTRAINTS ON A FORMAL PARAMETER");
|
"CONSTRAINTS ON A FORMAL PARAMETER");
|
|
|
--------------------------------------------------
|
--------------------------------------------------
|
|
|
DECLARE -- (A)
|
DECLARE -- (A)
|
|
|
PROCEDURE PA (I1, I2 : INTEGER) IS
|
PROCEDURE PA (I1, I2 : INTEGER) IS
|
|
|
TYPE A1 IS ARRAY (1..I1,1..I2) OF INTEGER;
|
TYPE A1 IS ARRAY (1..I1,1..I2) OF INTEGER;
|
|
|
PROCEDURE PA1 (A : A1 := ((1,0),(0,1))) IS
|
PROCEDURE PA1 (A : A1 := ((1,0),(0,1))) IS
|
BEGIN
|
BEGIN
|
FAILED ("BODY OF PA1 EXECUTED");
|
FAILED ("BODY OF PA1 EXECUTED");
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED IN PA1");
|
FAILED ("EXCEPTION RAISED IN PA1");
|
END PA1;
|
END PA1;
|
|
|
BEGIN
|
BEGIN
|
PA1;
|
PA1;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
NULL;
|
NULL;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("WRONG EXCEPTION RAISED - PA1");
|
FAILED ("WRONG EXCEPTION RAISED - PA1");
|
END PA;
|
END PA;
|
|
|
BEGIN -- (A)
|
BEGIN -- (A)
|
PA (IDENT_INT(1), IDENT_INT(10));
|
PA (IDENT_INT(1), IDENT_INT(10));
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED IN CALL TO PA");
|
FAILED ("EXCEPTION RAISED IN CALL TO PA");
|
END; -- (A)
|
END; -- (A)
|
|
|
--------------------------------------------------
|
--------------------------------------------------
|
|
|
DECLARE -- (B)
|
DECLARE -- (B)
|
|
|
PROCEDURE PB (I1, I2 : INTEGER) IS
|
PROCEDURE PB (I1, I2 : INTEGER) IS
|
|
|
SUBTYPE INT IS INTEGER RANGE I1..I2;
|
SUBTYPE INT IS INTEGER RANGE I1..I2;
|
|
|
PROCEDURE PB1 (I : INT := -1) IS
|
PROCEDURE PB1 (I : INT := -1) IS
|
BEGIN
|
BEGIN
|
FAILED ("BODY OF PB1 EXECUTED");
|
FAILED ("BODY OF PB1 EXECUTED");
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED IN PB1");
|
FAILED ("EXCEPTION RAISED IN PB1");
|
END PB1;
|
END PB1;
|
|
|
BEGIN
|
BEGIN
|
PB1;
|
PB1;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
NULL;
|
NULL;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("WRONG EXCEPTION RAISED - PB1");
|
FAILED ("WRONG EXCEPTION RAISED - PB1");
|
END PB;
|
END PB;
|
|
|
BEGIN -- (B)
|
BEGIN -- (B)
|
PB (IDENT_INT(0), IDENT_INT(63));
|
PB (IDENT_INT(0), IDENT_INT(63));
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED IN CALL TO PB");
|
FAILED ("EXCEPTION RAISED IN CALL TO PB");
|
END; -- (B)
|
END; -- (B)
|
|
|
--------------------------------------------------
|
--------------------------------------------------
|
|
|
DECLARE -- (C)
|
DECLARE -- (C)
|
|
|
PROCEDURE PC (I1, I2 : INTEGER) IS
|
PROCEDURE PC (I1, I2 : INTEGER) IS
|
TYPE AR1 IS ARRAY (1..3) OF INTEGER RANGE I1..I2;
|
TYPE AR1 IS ARRAY (1..3) OF INTEGER RANGE I1..I2;
|
TYPE REC IS
|
TYPE REC IS
|
RECORD
|
RECORD
|
I : INTEGER RANGE I1..I2;
|
I : INTEGER RANGE I1..I2;
|
A : AR1 ;
|
A : AR1 ;
|
END RECORD;
|
END RECORD;
|
|
|
PROCEDURE PC1 (R : REC := (-3,(0,2,3))) IS
|
PROCEDURE PC1 (R : REC := (-3,(0,2,3))) IS
|
BEGIN
|
BEGIN
|
FAILED ("BODY OF PC1 EXECUTED");
|
FAILED ("BODY OF PC1 EXECUTED");
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED IN PC1");
|
FAILED ("EXCEPTION RAISED IN PC1");
|
END PC1;
|
END PC1;
|
|
|
BEGIN
|
BEGIN
|
PC1;
|
PC1;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
NULL;
|
NULL;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("WRONG EXCEPTION RAISED - PC1");
|
FAILED ("WRONG EXCEPTION RAISED - PC1");
|
END PC;
|
END PC;
|
|
|
BEGIN -- (C)
|
BEGIN -- (C)
|
PC (IDENT_INT(1), IDENT_INT(3));
|
PC (IDENT_INT(1), IDENT_INT(3));
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED IN CALL TO PC");
|
FAILED ("EXCEPTION RAISED IN CALL TO PC");
|
END; -- (C)
|
END; -- (C)
|
|
|
--------------------------------------------------
|
--------------------------------------------------
|
|
|
DECLARE -- (D1)
|
DECLARE -- (D1)
|
|
|
PROCEDURE P1D (I1, I2 : INTEGER) IS
|
PROCEDURE P1D (I1, I2 : INTEGER) IS
|
|
|
TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
|
TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
|
|
|
PROCEDURE P1D1 (A : A1 := ((1,-1),(1,2))) IS
|
PROCEDURE P1D1 (A : A1 := ((1,-1),(1,2))) IS
|
BEGIN
|
BEGIN
|
FAILED ("BODY OF P1D1 EXECUTED");
|
FAILED ("BODY OF P1D1 EXECUTED");
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED IN P1D1");
|
FAILED ("EXCEPTION RAISED IN P1D1");
|
END P1D1;
|
END P1D1;
|
|
|
BEGIN
|
BEGIN
|
P1D1;
|
P1D1;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
NULL;
|
NULL;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("WRONG EXCEPTION RAISED - P1D1");
|
FAILED ("WRONG EXCEPTION RAISED - P1D1");
|
END P1D;
|
END P1D;
|
|
|
BEGIN -- (D1)
|
BEGIN -- (D1)
|
P1D (IDENT_INT(1), IDENT_INT(2));
|
P1D (IDENT_INT(1), IDENT_INT(2));
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED IN CALL TO P1D");
|
FAILED ("EXCEPTION RAISED IN CALL TO P1D");
|
END; -- (D1)
|
END; -- (D1)
|
|
|
--------------------------------------------------
|
--------------------------------------------------
|
|
|
DECLARE -- (D2)
|
DECLARE -- (D2)
|
|
|
PROCEDURE P2D (I1, I2 : INTEGER) IS
|
PROCEDURE P2D (I1, I2 : INTEGER) IS
|
|
|
TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
|
TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
|
|
|
PROCEDURE P2D1 (A : A1 := (3..4 => (1,2))) IS
|
PROCEDURE P2D1 (A : A1 := (3..4 => (1,2))) IS
|
BEGIN
|
BEGIN
|
FAILED ("BODY OF P2D1 EXECUTED");
|
FAILED ("BODY OF P2D1 EXECUTED");
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED IN P2D1");
|
FAILED ("EXCEPTION RAISED IN P2D1");
|
END P2D1;
|
END P2D1;
|
|
|
BEGIN
|
BEGIN
|
P2D1;
|
P2D1;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
NULL;
|
NULL;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("WRONG EXCEPTION RAISED - P2D1");
|
FAILED ("WRONG EXCEPTION RAISED - P2D1");
|
END P2D;
|
END P2D;
|
|
|
BEGIN -- (D2)
|
BEGIN -- (D2)
|
P2D (IDENT_INT(1), IDENT_INT(2));
|
P2D (IDENT_INT(1), IDENT_INT(2));
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED IN CALL TO P2D");
|
FAILED ("EXCEPTION RAISED IN CALL TO P2D");
|
END; -- (D2)
|
END; -- (D2)
|
|
|
--------------------------------------------------
|
--------------------------------------------------
|
|
|
DECLARE -- (E)
|
DECLARE -- (E)
|
|
|
PROCEDURE PE (I1, I2 : INTEGER) IS
|
PROCEDURE PE (I1, I2 : INTEGER) IS
|
SUBTYPE INT IS INTEGER RANGE 0..10;
|
SUBTYPE INT IS INTEGER RANGE 0..10;
|
TYPE ARR IS ARRAY (1..3) OF INT;
|
TYPE ARR IS ARRAY (1..3) OF INT;
|
TYPE REC (I : INT) IS
|
TYPE REC (I : INT) IS
|
RECORD
|
RECORD
|
A : ARR;
|
A : ARR;
|
END RECORD;
|
END RECORD;
|
|
|
SUBTYPE REC4 IS REC(I1);
|
SUBTYPE REC4 IS REC(I1);
|
|
|
PROCEDURE PE1 (R : REC4 := (3,(1,2,3))) IS
|
PROCEDURE PE1 (R : REC4 := (3,(1,2,3))) IS
|
BEGIN
|
BEGIN
|
FAILED ("BODY OF PE1 EXECUTED");
|
FAILED ("BODY OF PE1 EXECUTED");
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED IN PE1");
|
FAILED ("EXCEPTION RAISED IN PE1");
|
END PE1;
|
END PE1;
|
|
|
BEGIN
|
BEGIN
|
PE1;
|
PE1;
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
NULL;
|
NULL;
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("WRONG EXCEPTION RAISED - PE1");
|
FAILED ("WRONG EXCEPTION RAISED - PE1");
|
END PE;
|
END PE;
|
|
|
BEGIN -- (E)
|
BEGIN -- (E)
|
PE (IDENT_INT(4), IDENT_INT(10));
|
PE (IDENT_INT(4), IDENT_INT(10));
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED ("EXCEPTION RAISED IN CALL TO PE");
|
FAILED ("EXCEPTION RAISED IN CALL TO PE");
|
END; -- (E)
|
END; -- (E)
|
|
|
--------------------------------------------------
|
--------------------------------------------------
|
|
|
RESULT;
|
RESULT;
|
|
|
END C61008A;
|
END C61008A;
|
|
|
