OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c460009.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C460009.A
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
--
26
-- OBJECTIVE:
27
--     Check that Constraint_Error is raised in cases of null arrays when:
28
--     1.  an assignment is made to a null array if the length of each
29
--         dimension of the operand does not match the length of
30
--         the corresponding dimension of the target subtype.
31
--     2.  an array actual parameter does not match the length of
32
--         corresponding dimensions of the formal in out parameter where
33
--         the actual parameter has the form of a type conversion.
34
--     3.  an array actual parameter does not match the length of
35
--         corresponding dimensions of the formal out parameter where
36
--         the actual parameter has the form of a type conversion.
37
--
38
-- TEST DESCRIPTION:
39
--      This transition test creates examples where array of null ranges
40
--      raises Constraint_Error if any of the lengths mismatch.
41
--
42
--      Inspired by C52103S.ADA, C64105E.ADA, and C64105F.ADA.
43
--
44
--
45
-- CHANGE HISTORY:
46
--      21 Mar 96   SAIC    Initial version for ACVC 2.1.
47
--      21 Sep 96   SAIC    ACVC 2.1: Added new case.
48
--
49
--!
50
 
51
with Report;
52
 
53
procedure C460009 is
54
 
55
   subtype Int is Integer range 1 .. 3;
56
 
57
begin
58
 
59
   Report.Test("C460009","Check that Constraint_Error is raised in "  &
60
               "cases of null arrays if any of the lengths mismatch " &
61
               "in assignments and parameter passing");
62
 
63
   ---------------------------------------------------------------------------
64
   declare
65
 
66
      type Arr_Int1 is array (Int range <>) of Integer;
67
      Arr_Obj1 : Arr_Int1 (2 .. Report.Ident_Int(1));     -- null array object
68
 
69
   begin
70
 
71
      -- Same lengths, no Constraint_Error raised.
72
      Arr_Obj1 := (Report.Ident_Int(3) .. 2 => Report.Ident_Int(1));
73
 
74
      Report.Comment ("Dead assignment prevention in Arr_Obj1 => " &
75
                       Integer'Image (Arr_Obj1'Last));
76
 
77
   exception
78
 
79
      when Constraint_Error =>
80
        Report.Failed ("Arr_Obj1 - Constraint_Error exception raised");
81
      when others           =>
82
        Report.Failed ("Arr_Obj1 - others exception raised");
83
 
84
   end;
85
 
86
   ---------------------------------------------------------------------------
87
   declare
88
 
89
      type Arr_Int2 is array (Int range <>, Int range <>) of Integer;
90
      Arr_Obj2 : Arr_Int2 (1 .. Report.Ident_Int(2),
91
                           Report.Ident_Int(3) .. Report.Ident_Int(2));
92
                                                           -- null array object
93
   begin
94
 
95
      -- Same lengths, no Constraint_Error raised.
96
      Arr_Obj2 := Arr_Int2'(Report.Ident_Int(2) .. 3 =>
97
                  (Report.Ident_Int(2) .. Report.Ident_Int(1) =>
98
                   Report.Ident_Int(1)));
99
 
100
      Report.Comment ("Dead assignment prevention in Arr_Obj2 => " &
101
                       Integer'Image (Arr_Obj2'Last));
102
 
103
   exception
104
 
105
      when Constraint_Error =>
106
        Report.Failed ("Arr_Obj2 - Constraint_Error exception raised");
107
      when others           =>
108
        Report.Failed ("Arr_Obj2 - others exception raised");
109
 
110
   end;
111
 
112
   ---------------------------------------------------------------------------
113
   declare
114
 
115
      type Arr_Int3 is array (Int range <>, Int range <>) of Integer;
116
      Arr_Obj3 : Arr_Int3 (1 .. Report.Ident_Int(2),
117
                           Report.Ident_Int(3) .. Report.Ident_Int(2));
118
                                                           -- null array object
119
 
120
   begin
121
 
122
      -- Lengths mismatch, Constraint_Error raised.
123
      Arr_Obj3 := Arr_Int3'(Report.Ident_Int(3) .. 2 =>
124
                  (Report.Ident_Int(1) .. Report.Ident_Int(3) =>
125
                   Report.Ident_Int(1)));
126
 
127
      Report.Comment ("Dead assignment prevention in Arr_Obj3 => " &
128
                       Integer'Image (Arr_Obj3'Last));
129
 
130
      Report.Failed ("Constraint_Error not raised in Arr_Obj3");
131
 
132
   exception
133
 
134
      when Constraint_Error => null;      -- exception expected.
135
      when others           =>
136
        Report.Failed ("Arr_Obj3 - others exception raised");
137
 
138
   end;
139
 
140
   ---------------------------------------------------------------------------
141
   declare
142
 
143
      type Arr_Int4 is array (Int range <>, Int range <>, Int range <>) of
144
        Integer;
145
      Arr_Obj4 : Arr_Int4 (1 .. Report.Ident_Int(2),
146
                           Report.Ident_Int(1) .. Report.Ident_Int(3),
147
                           Report.Ident_Int(3) .. Report.Ident_Int(2));
148
                                                           -- null array object
149
   begin
150
 
151
      -- Lengths mismatch, Constraint_Error raised.
152
      Arr_Obj4 := Arr_Int4'(Report.Ident_Int(1) .. 3 =>
153
                  (Report.Ident_Int(1) .. Report.Ident_Int(2) =>
154
                   (Report.Ident_Int(3) .. Report.Ident_Int(2) =>
155
                   Report.Ident_Int(1))));
156
 
157
      Report.Comment ("Dead assignment prevention in Arr_Obj4 => " &
158
                       Integer'Image (Arr_Obj4'Last));
159
 
160
      Report.Failed ("Constraint_Error not raised in Arr_Obj4");
161
 
162
   exception
163
 
164
      when Constraint_Error => null;      -- exception expected.
165
      when others           =>
166
        Report.Failed ("Arr_Obj4 - others exception raised");
167
 
168
   end;
169
 
170
   ---------------------------------------------------------------------------
171
   declare
172
 
173
      type Arr_Int5 is array (Int range <>) of Integer;
174
      Arr_Obj5 : Arr_Int5 (2 .. Report.Ident_Int(1));     -- null array object
175
 
176
   begin
177
 
178
      -- Only lengths of two null ranges are different, no Constraint_Error
179
      -- raised.
180
      Arr_Obj5 := (Report.Ident_Int(3) .. 1 => Report.Ident_Int(1));
181
 
182
      Report.Comment ("Dead assignment prevention in Arr_Obj5 => " &
183
                       Integer'Image (Arr_Obj5'Last));
184
 
185
   exception
186
 
187
      when Constraint_Error =>
188
        Report.Failed ("Arr_Obj5 - Constraint_Error exception raised");
189
      when others           =>
190
        Report.Failed ("Arr_Obj5 - others exception raised");
191
 
192
   end;
193
 
194
   ---------------------------------------------------------------------------
195
   declare
196
      subtype Str is String (Report.Ident_Int(5) .. 4);
197
                                                            -- null string
198
      Str_Obj : Str;
199
 
200
   begin
201
 
202
      -- Same lengths, no Constraint_Error raised.
203
      Str_Obj := (Report.Ident_Int(1) .. 0 => 'Z');
204
      Str_Obj(2 .. 1) := "";
205
      Str_Obj(4 .. 2) := (others => 'X');
206
      Str_Obj(Report.Ident_Int(6) .. 3) := "";
207
      Str_Obj(Report.Ident_Int(0) .. Report.Ident_Int(-1)) := (others => 'Y');
208
 
209
   exception
210
 
211
      when Constraint_Error =>
212
        Report.Failed ("Str_Obj - Constraint_Error exception raised");
213
      when others           =>
214
        Report.Failed ("Str_Obj - others exception raised");
215
 
216
   end;
217
 
218
   ---------------------------------------------------------------------------
219
   declare
220
 
221
      type Arr_Char5 is array (Int range <>, Int range <>) of Character;
222
      subtype Formal is Arr_Char5
223
        (Report.Ident_Int(2) .. 0, 1 .. Report.Ident_Int(3));
224
      Arr_Obj5 : Arr_Char5 (Report.Ident_Int(2) .. Report.Ident_Int(1),
225
                            Report.Ident_Int(1) .. Report.Ident_Int(2))
226
               := (Report.Ident_Int(2) .. Report.Ident_Int(1) =>
227
                  (Report.Ident_Int(1) .. Report.Ident_Int(2) => ' '));
228
 
229
      procedure Proc5 (P : in out Formal) is
230
      begin
231
         Report.Failed ("No exception raised in Proc5");
232
 
233
      exception
234
 
235
         when Constraint_Error =>
236
           Report.Failed ("Constraint_Error exception raised in Proc5");
237
         when others           =>
238
           Report.Failed ("Others exception raised in Proc5");
239
      end;
240
 
241
   begin
242
 
243
      -- Lengths mismatch in the type conversion, Constraint_Error raised.
244
      Proc5 (Formal(Arr_Obj5));
245
 
246
      Report.Failed ("Constraint_Error not raised in the call Proc5");
247
 
248
   exception
249
 
250
      when Constraint_Error => null;      -- exception expected.
251
      when others           =>
252
        Report.Failed ("Arr_Obj5 - others exception raised");
253
 
254
   end;
255
 
256
   ---------------------------------------------------------------------------
257
   declare
258
 
259
      type Formal is array
260
        (Report.Ident_Int(1) .. 3, 3 .. Report.Ident_Int(1)) of Character;
261
 
262
      type Actual is array
263
        (Report.Ident_Int(5) .. 3, 3 .. Report.Ident_Int(5)) of Character;
264
 
265
      Arr_Obj6 : Actual := (5 .. 3 => (3 .. 5 => ' '));
266
 
267
      procedure Proc6 (P : in out Formal) is
268
      begin
269
         Report.Failed ("No exception raised in Proc6");
270
 
271
      exception
272
 
273
         when Constraint_Error =>
274
           Report.Failed ("Constraint_Error exception raised in Proc6");
275
         when others           =>
276
           Report.Failed ("Others exception raised in Proc6");
277
      end;
278
 
279
   begin
280
 
281
      -- Lengths mismatch in the type conversion, Constraint_Error raised.
282
      Proc6 (Formal(Arr_Obj6));
283
 
284
      Report.Failed ("Constraint_Error not raised in the call Proc6");
285
 
286
   exception
287
 
288
      when Constraint_Error => null;      -- exception expected.
289
      when others           =>
290
        Report.Failed ("Arr_Obj6 - others exception raised");
291
 
292
   end;
293
 
294
   ---------------------------------------------------------------------------
295
   declare
296
 
297
      type Formal is array (Int range <>, Int range <>) of Character;
298
      type Actual is array (Positive range 5 .. 2,
299
                            Positive range 1 .. 3) of Character;
300
 
301
      Arr_Obj7 : Actual := (5 .. 2 => (1 .. 3 => ' '));
302
 
303
      procedure Proc7 (P : in out Formal) is
304
      begin
305
         if P'Last /= 2 and P'Last(2) /= 3 then
306
            Report.Failed ("Wrong bounds passed for Arr_Obj7");
307
         end if;
308
 
309
         -- Lengths mismatch, Constraint_Error raised.
310
         P := (1 .. 3 => (3 .. 0 => ' '));
311
 
312
         Report.Comment ("Dead assignment prevention in Proc7 => " &
313
                          Integer'Image (P'Last));
314
 
315
         Report.Failed ("No exception raised in Proc7");
316
 
317
      exception
318
 
319
         when Constraint_Error => null;      -- exception expected.
320
         when others           =>
321
           Report.Failed ("Others exception raised in Proc7");
322
      end;
323
 
324
   begin
325
 
326
      -- Same lengths, no Constraint_Error raised.
327
      Proc7 (Formal(Arr_Obj7));
328
 
329
      if Arr_Obj7'Last /= 2 and Arr_Obj7'Last(2) /= 3 then
330
         Report.Failed ("Bounds changed for Arr_Obj7");
331
      end if;
332
 
333
   exception
334
 
335
      when Constraint_Error =>
336
        Report.Failed ("Constraint_Error exception raised after call Proc7");
337
      when others           =>
338
        Report.Failed ("Arr_Obj7 - others exception raised");
339
 
340
   end;
341
 
342
   ---------------------------------------------------------------------------
343
   declare
344
 
345
      type Arr_Char8 is array (Int range <>, Int range <>) of Character;
346
      subtype Formal is Arr_Char8
347
        (Report.Ident_Int(2) .. 0, 1 .. Report.Ident_Int(3));
348
      Arr_Obj8 : Arr_Char8 (Report.Ident_Int(2) .. Report.Ident_Int(1),
349
                            Report.Ident_Int(1) .. Report.Ident_Int(2));
350
 
351
      procedure Proc8 (P : out Formal) is
352
      begin
353
         Report.Failed ("No exception raised in Proc8");
354
 
355
      exception
356
 
357
         when Constraint_Error =>
358
           Report.Failed ("Constraint_Error exception raised in Proc8");
359
         when others           =>
360
           Report.Failed ("Others exception raised in Proc8");
361
      end;
362
 
363
   begin
364
 
365
      -- Lengths mismatch in the type conversion, Constraint_Error raised.
366
      Proc8 (Formal(Arr_Obj8));
367
 
368
      Report.Failed ("Constraint_Error not raised in the call Proc8");
369
 
370
   exception
371
 
372
      when Constraint_Error => null;      -- exception expected.
373
      when others           =>
374
        Report.Failed ("Arr_Obj8 - others exception raised");
375
 
376
   end;
377
 
378
   ---------------------------------------------------------------------------
379
   declare
380
 
381
      type Formal is array
382
        (Report.Ident_Int(1) .. 3, 3 .. Report.Ident_Int(1)) of Character;
383
 
384
      type Actual is array
385
        (Report.Ident_Int(5) .. 3, 3 .. Report.Ident_Int(5)) of Character;
386
 
387
      Arr_Obj9 : Actual;
388
 
389
      procedure Proc9 (P : out Formal) is
390
      begin
391
         Report.Failed ("No exception raised in Proc9");
392
 
393
      exception
394
 
395
         when Constraint_Error =>
396
           Report.Failed ("Constraint_Error exception raised in Proc9");
397
         when others           =>
398
           Report.Failed ("Others exception raised in Proc9");
399
      end;
400
 
401
   begin
402
 
403
      -- Lengths mismatch in the type conversion, Constraint_Error raised.
404
      Proc9 (Formal(Arr_Obj9));
405
 
406
      Report.Failed ("Constraint_Error not raised in the call Proc9");
407
 
408
   exception
409
 
410
      when Constraint_Error => null;      -- exception expected.
411
      when others           =>
412
        Report.Failed ("Arr_Obj9 - others exception raised");
413
 
414
   end;
415
 
416
   ---------------------------------------------------------------------------
417
   declare
418
 
419
      type Formal is array (Int range <>, Int range <>) of Character;
420
      type Actual is array (Positive range 5 .. 2,
421
                            Positive range 1 .. 3) of Character;
422
 
423
      Arr_Obj10 : Actual;
424
 
425
      procedure Proc10 (P : out Formal) is
426
      begin
427
         if P'Last /= 2 and P'Last(2) /= 3 then
428
            Report.Failed ("Wrong bounds passed for Arr_Obj10");
429
         end if;
430
 
431
         -- Lengths mismatch, Constraint_Error raised.
432
         P := (1 .. 3 => (3 .. 1 => ' '));
433
 
434
         Report.Comment ("Dead assignment prevention in Proc10 => " &
435
                          Integer'Image (P'Last));
436
 
437
         Report.Failed ("No exception raised in Proc10");
438
 
439
      exception
440
 
441
         when Constraint_Error => null;      -- exception expected.
442
         when others           =>
443
           Report.Failed ("Others exception raised in Proc10");
444
      end;
445
 
446
   begin
447
 
448
      -- Same lengths, no Constraint_Error raised.
449
      Proc10 (Formal(Arr_Obj10));
450
 
451
      if Arr_Obj10'Last /= 2 and Arr_Obj10'Last(2) /= 3 then
452
         Report.Failed ("Bounds changed for Arr_Obj10");
453
      end if;
454
 
455
   exception
456
 
457
      when Constraint_Error =>
458
        Report.Failed ("Constraint_Error exception raised after call Proc10");
459
      when others           =>
460
        Report.Failed ("Arr_Obj10 - others exception raised");
461
 
462
   end;
463
 
464
   ---------------------------------------------------------------------------
465
   Report.Result;
466
 
467
end C460009;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.