1-- C52103X.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
26--    MORE SPECIFICALLY, TEST THAT ARRAY ASSIGNMENTS WITH MATCHING
27--    LENGTHS DO NOT CAUSE  CONSTRAINT_ERROR  TO BE RAISED AND
28--    ARE PERFORMED CORRECTLY.
29--    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
30--    ARE TREATED ELSEWHERE.)
31
32-- THIS IS A SPECIAL CASE IN
33
34--    DIVISION  C :  NON-NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
35--                   STATICALLY
36
37-- WHICH TREATS ARRAYS OF LENGTH GREATER THAN  INTEGER'LAST .
38--    AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH
39--    COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE
40--    CONSTRAINT_ERROR TO BE RAISED.
41
42-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
43-- ***       remove incompatibilities associated with the transition   -- 9X
44-- ***       to Ada 9X.                                                -- 9X
45-- ***                                                                 -- 9X
46
47-- RM  07/31/81
48-- SPS 10/26/82
49-- JBG 06/15/83
50-- EG  11/02/84
51-- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
52--               AI-00387.
53-- JRK 06/24/86  FIXED COMMENTS ABOUT NUMERIC_ERROR/CONSTRAINT_ERROR.
54-- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
55
56WITH REPORT;
57PROCEDURE  C52103X  IS
58
59     USE  REPORT ;
60
61BEGIN
62
63     TEST( "C52103X" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE " &
64                       "ASSIGNMENTS, THE LENGTHS MUST MATCH; ALSO " &
65                       "CHECK WHETHER CONSTRAINT_ERROR " &
66                       "OR STORAGE_ERROR ARE RAISED FOR LARGE ARRAYS" );
67
68     -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
69     --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
70     --
71     --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
72     --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
73
74
75     -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
76     --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
77     --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
78     --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
79     --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
80     --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
81     --    INTEGER , CHARACTER , BOOLEAN .)
82
83
84     -------------------------------------------------------------------
85
86     --    (4) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
87     --        WERE DEFINED WITHOUT EVER USING THE "BOX" SYMBOL
88     --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
89     --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
90
91CONSTR_ERR:         -- THIS BLOCK CATCHES CONSTRAINT_ERROR
92                    -- FOR THE TYPE DECLARATION.
93     BEGIN
94
95DCL_ARR:  DECLARE   -- THIS BLOCK DECLARES THE ARRAY TYPE
96
97               TYPE  TA42  IS  ARRAY(
98                    INTEGER RANGE IDENT_INT(-2)..IDENT_INT(INTEGER'LAST)
99                                    )  OF BOOLEAN ;
100               -- CONSTRAINT_ERROR MAY BE RAISED BY THE
101               -- ARRAY TYPE DECLARATION.
102               PRAGMA PACK (TA42);
103
104               SUBTYPE  TA41  IS  TA42 ;
105
106          BEGIN
107
108               COMMENT ("NO CONSTRAINT_ERROR FOR TYPE " &
109                        "WITH 'LENGTH = INTEGER'LAST + 3");
110
111OBJ_DCL:       DECLARE   -- THIS BLOCK DECLARES TWO BOOLEAN ARRAYS THAT
112                         -- HAVE INTEGER'LAST + 3 COMPONENTS;
113                         -- STORAGE_ERROR MAY BE RAISED.
114                    ARR41  :  TA41 ;
115                    ARR42  :  TA42 ;
116
117               BEGIN
118
119               COMMENT ("NO STORAGE_ERROR OR CONSTRAINT_ERROR RAISED " &
120                        "WHEN ALLOCATING TWO BIG BOOLEAN ARRAYS");
121               -- INITIALIZATION OF RHS ARRAY:
122
123               -- ONLY A SHORT INITIAL SEGMENT IS INITIALIZED,
124               -- SINCE A COMPLETE INITIALIZATION MIGHT TAKE TOO LONG
125               -- AND THE EXECUTION MIGHT BE ABORTED BEFORE THE LENGTH
126               -- COMPARISON OF THE ARRAY ASSIGNMENT IS ATTEMPTED.
127
128NO_EXCP:       BEGIN     -- NO EXCEPTION SHOULD OCCUR HERE.
129                    FOR  I  IN  IDENT_INT(-2)..IDENT_INT(2)  LOOP
130                         ARR41(I)  :=  FALSE  ;  -- VALUES ARE:: FTFFT
131                    END LOOP;
132
133                    ARR41(-1) := TRUE ;
134
135                    ARR41( 2) := TRUE ;          -- RHS IS: F T F F T
136
137
138                    -- INITIALIZATION OF UNUSED COMPONENT OF LHS ARRAY:
139
140                    ARR42( -2 )  :=  TRUE ;
141
142               EXCEPTION
143
144                    WHEN CONSTRAINT_ERROR =>
145                         FAILED ("CONSTRAINT_ERROR RAISED WHEN " &
146                                 "ASSIGNING TO ARRAY COMPONENTS");
147                    WHEN OTHERS =>
148                         FAILED ("OTHER EXCEPTION RAISED - 1");
149
150               END NO_EXCP;
151
152DO_SLICE:      BEGIN
153                    -- SLICE ASSIGNMENT:
154
155                    ARR42(  IDENT_INT(-1)..IDENT_INT(INTEGER'LAST  )) :=
156                         ARR41(
157                            IDENT_INT(-2)..IDENT_INT(INTEGER'LAST-1)) ;
158
159                    COMMENT ("NO EXCEPTION RAISED DURING SLICE " &
160                             "ASSIGNMENT");
161
162                    -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
163
164     CHK_SLICE:     BEGIN
165                         FOR  I  IN  IDENT_INT(-1)..IDENT_INT(2)  LOOP
166
167                              IF  ARR42( I )  /=  FALSE  AND  I /= 0
168                              THEN
169                                   FAILED( "SLICE ASSIGNMENT NOT " &
170                                           "CORRECT (VALUES)" );
171                              ELSIF  ARR42( I ) /= TRUE  AND  I  = 0
172                              THEN
173                                   FAILED( "SLICE ASSIGNMENT NOT " &
174                                           "CORRECT (VALUES)" );
175                              END IF;
176
177                         END LOOP;
178
179                         IF  ARR42( -2 )  /=  TRUE
180                         THEN
181                              FAILED( "SLICE ASSIGNMENT NOT CORRECT " &
182                                      "(SLIDING)" );
183                         END IF;
184
185                    EXCEPTION
186
187                         WHEN OTHERS =>
188                              FAILED ("SOME EXCEPTION RAISED - 2");
189
190                    END CHK_SLICE;
191
192               EXCEPTION
193
194                    WHEN CONSTRAINT_ERROR =>
195                         COMMENT ("CONSTRAINT_ERROR RAISED DURING " &
196                                  "SLICE ASSIGNMENT");
197                    WHEN STORAGE_ERROR =>
198                         COMMENT ("STORAGE_ERROR RAISED DURING SLICE " &
199                                  "ASSIGNMENT");
200                    WHEN OTHERS =>
201                         FAILED ("SOME EXCEPTION DURING SLICE " &
202                                 "ASSIGNMENT");
203               END DO_SLICE;
204
205          END OBJ_DCL;
206
207          EXCEPTION
208
209               WHEN STORAGE_ERROR =>
210                    COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING " &
211                             "TWO PACKED BOOLEAN ARRAYS WITH " &
212                             "INTEGER'LAST + 3 COMPONENTS");
213               WHEN CONSTRAINT_ERROR =>
214                    COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING " &
215                             "TWO PACKED BOOLEAN ARRAYS WITH " &
216                             "INTEGER'LAST + 3 COMPONENTS");
217               WHEN OTHERS =>
218                    FAILED ("SOME EXCEPTION RAISED - 3");
219
220          END DCL_ARR;
221
222     EXCEPTION
223
224
225          WHEN CONSTRAINT_ERROR =>
226               COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " &
227                        "ARRAY TYPE WITH INTEGER'LAST + 3 COMPONENTS");
228
229          WHEN STORAGE_ERROR =>
230               FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION");
231
232          WHEN OTHERS =>
233               FAILED ("OTHER EXCEPTION RAISED - 4");
234
235     END CONSTR_ERR;
236
237
238     RESULT ;
239
240
241END C52103X;
242