1-- C43212C.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 CONSTRAINT_ERROR IS RAISED IF ALL SUBAGGREGATES FOR
26-- A PARTICULAR DIMENSION DO NOT HAVE THE SAME BOUNDS.
27-- ADDITIONAL CASES FOR THE THIRD DIMENSION AND FOR THE NULL ARRAYS.
28
29-- PK  02/21/84
30-- EG  05/30/84
31
32WITH REPORT;
33USE REPORT;
34
35PROCEDURE C43212C IS
36
37     SUBTYPE INT IS INTEGER RANGE 1 .. 3;
38
39BEGIN
40
41     TEST("C43212C","CHECK THAT CONSTRAINT_ERROR IS RAISED IF ALL " &
42                    "SUBAGGREGATES FOR A PARTICULAR DIMENSION DO "  &
43                    "NOT HAVE THE SAME BOUNDS");
44
45     DECLARE
46          TYPE A3 IS ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>)
47                         OF INTEGER;
48     BEGIN
49          IF A3'(((IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)),
50                      (1 .. IDENT_INT(2) => IDENT_INT(1))),
51                     ((IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)),
52                      (IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1))))
53            =
54             A3'(((IDENT_INT(1) .. IDENT_INT(2) => IDENT_INT(1)),
55                      (1 .. IDENT_INT(2) => IDENT_INT(1))),
56                     ((IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1)),
57                      (IDENT_INT(2) .. IDENT_INT(3) => IDENT_INT(1))))
58          THEN
59                FAILED ("A3 - EXCEPTION NOT RAISED, ARRAYS EQUAL");
60          END IF;
61          FAILED ("A3 - EXCEPTION NOT RAISED, ARRAYS NOT EQUAL");
62
63     EXCEPTION
64
65          WHEN CONSTRAINT_ERROR => NULL;
66          WHEN OTHERS =>
67               FAILED ("A3 - WRONG EXCEPTION RAISED");
68
69     END;
70
71     DECLARE
72
73          TYPE B3 IS ARRAY(INT RANGE <>, INT RANGE <>, INT RANGE <>)
74                         OF INTEGER;
75
76     BEGIN
77
78          IF B3'(((IDENT_INT(2) .. IDENT_INT(1) => IDENT_INT(1)),
79                      (2 .. IDENT_INT(1) => IDENT_INT(1))),
80                     ((IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)),
81                      (IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1))))
82            =
83             B3'(((IDENT_INT(2) .. IDENT_INT(1) => IDENT_INT(1)),
84                      (2 .. IDENT_INT(1) => IDENT_INT(1))),
85                     ((IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1)),
86                      (IDENT_INT(3) .. IDENT_INT(1) => IDENT_INT(1))))
87          THEN
88                FAILED ("B3 - EXCEPTION NOT RAISED, ARRAYS EQUAL");
89          END IF;
90          FAILED ("B3 - EXCEPTION NOT RAISED, ARRAYS NOT EQUAL");
91
92     EXCEPTION
93
94          WHEN CONSTRAINT_ERROR => NULL;
95          WHEN OTHERS =>
96                FAILED ("B3 - WRONG EXCEPTION RAISED");
97
98     END;
99
100     RESULT;
101
102END C43212C;
103