1-- C64103D.ADA
2
3--                             Grant of Unlimited Rights
4--
5--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7--     unlimited rights in the software and documentation contained herein.
8--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9--     this public release, the Government intends to confer upon all
10--     recipients unlimited rights  equal to those held by the Government.
11--     These rights include rights to use, duplicate, release or disclose the
12--     released technical data and computer software in whole or in part, in
13--     any manner and for any purpose whatsoever, and to have or permit others
14--     to do so.
15--
16--                                    DISCLAIMER
17--
18--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23--     PARTICULAR PURPOSE OF SAID MATERIAL.
24--*
25-- CHECK THAT THE APPROPRIATE EXCEPTION IS RAISED FOR TYPE CONVERSIONS
26-- ON OUT ARRAY PARAMETERS.  IN PARTICULAR:
27--   (A) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN THE ACTUAL
28--       COMPONENT'S CONSTRAINTS DIFFER FROM THE FORMAL COMPONENT'S
29--       CONSTRAINTS.
30--   (B) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO
31--       AN UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
32--       OUTSIDE OF A FORMAL INDEX SUBTYPE.
33--   (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A
34--       CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER
35--       DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL.
36--   (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN
37--       UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
38--       OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL.
39
40-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
41-- ***       remove incompatibilities associated with the transition   -- 9X
42-- ***       to Ada 9X.                                                -- 9X
43-- ***                                                                 -- 9X
44
45-- CPP 07/19/84
46-- EG  10/29/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
47--               AI-00387.
48-- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
49-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
50
51WITH SYSTEM;
52WITH REPORT;  USE REPORT;
53PROCEDURE C64103D IS
54
55     BEGIN
56     TEST ("C64103D", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " &
57           "TYPE CONVERSIONS OF OUT ARRAY PARAMETERS");
58
59     -----------------------------------------------
60
61     DECLARE   -- (A)
62     BEGIN     -- (A)
63
64          DECLARE
65               TYPE SUBINT IS RANGE 0..8;
66               TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
67               A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE);
68
69               PROCEDURE P2 (X : OUT ARRAY_TYPE) IS
70               BEGIN
71                    NULL;
72               END P2;
73          BEGIN
74               P2 (ARRAY_TYPE (A0));                  -- OK.
75          EXCEPTION
76               WHEN OTHERS =>
77                    FAILED ("EXCEPTION RAISED -P2 (A)");
78          END;
79
80     END; -- (A)
81
82     -----------------------------------------------
83
84     DECLARE   -- (B)
85
86          TYPE SUBINT IS RANGE 0..8;
87          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
88          TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
89          A1 : AR1 (-1..7) := (-1..7 => TRUE);
90          A2 : AR1 (1..9) := (1..9 => TRUE);
91
92          PROCEDURE P1 (X : OUT ARRAY_TYPE) IS
93          BEGIN
94               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
95          END P1;
96
97     BEGIN     -- (B)
98
99          BEGIN
100               COMMENT ("CALL TO P1 (B) ON A1");
101               P1 (ARRAY_TYPE (A1));
102          EXCEPTION
103               WHEN CONSTRAINT_ERROR =>
104                    NULL;
105               WHEN OTHERS =>
106                    FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
107          END;
108
109          BEGIN
110               COMMENT ("CALL TO P1 (B) ON A2");
111               P1 (ARRAY_TYPE (A2));
112          EXCEPTION
113               WHEN CONSTRAINT_ERROR =>
114                    NULL;
115               WHEN OTHERS =>
116                    FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
117          END;
118
119     END; -- (B)
120
121     -----------------------------------------------
122
123     DECLARE   -- (C)
124     BEGIN     -- (C)
125
126          DECLARE
127               TYPE INDEX1 IS RANGE 1..3;
128               TYPE INDEX2 IS RANGE 1..4;
129               TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN;
130               A0 : AR_TYPE := (1..3 => (1..4 => FALSE));
131
132               TYPE I1 IS RANGE 1..4;
133               TYPE I2 IS RANGE 1..3;
134               TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN;
135
136               PROCEDURE P1 (X : OUT ARRAY_TYPE) IS
137               BEGIN
138                    FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)");
139               END P1;
140          BEGIN
141               P1 (ARRAY_TYPE (A0));
142          EXCEPTION
143               WHEN CONSTRAINT_ERROR =>
144                    NULL;
145               WHEN OTHERS =>
146                    FAILED ("WRONG EXCEPTION RAISED -P1 (C)");
147          END;
148
149     END; -- (C)
150
151     -----------------------------------------------
152
153     DECLARE   -- (D)
154     BEGIN     -- (D)
155
156          DECLARE
157               TYPE SM_INT IS RANGE 0..2;
158               TYPE LG_INT IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT;
159               TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN;
160               TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN;
161               A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) :=
162                    (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE);
163
164               PROCEDURE P1 (X : OUT AR_SMALL) IS
165               BEGIN
166                    FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)");
167               END P1;
168          BEGIN
169               IF LG_INT (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN
170                    P1 (AR_SMALL (A0));
171               ELSE
172                    COMMENT ("NOT APPLICABLE -P1 (D)");
173               END IF;
174          EXCEPTION
175               WHEN CONSTRAINT_ERROR =>
176                    COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)");
177               WHEN OTHERS =>
178                    FAILED ("WRONG EXCEPTION RAISED - P1 (D)");
179          END;
180
181     END; -- (D)
182
183     -----------------------------------------------
184
185     RESULT;
186
187END C64103D;
188