1-- C43210A.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 A NON-AGGREGATE EXPRESSION IN A NAMED COMPONENT
26-- ASSOCIATION IS EVALUATED ONCE FOR EACH COMPONENT SPECIFIED
27-- BY THE ASSOCIATION.
28
29-- EG  02/02/84
30
31WITH REPORT;
32
33PROCEDURE C43210A IS
34
35     USE REPORT;
36
37BEGIN
38
39     TEST("C43210A", "CHECK THAT A NON-AGGREGATE IN A NAMED "   &
40                     "COMPONENT ASSOCIATION IS EVALUATED ONCE " &
41                     "FOR EACH COMPONENT SPECIFIED BY THE "     &
42                     "ASSOCIATION");
43
44     DECLARE
45
46          TYPE T1 IS ARRAY(1 .. 10) OF INTEGER;
47          TYPE T2 IS ARRAY(1 .. 8, 1 .. 2) OF INTEGER;
48          TYPE T3 IS ARRAY(1 .. 2, 1 .. 8) OF INTEGER;
49          TYPE T4 IS ARRAY(1 .. 8, 1 .. 8) OF INTEGER;
50
51          A1 : T1;
52          A2 : T2;
53          A3 : T3;
54          A4 : T4;
55          CC : INTEGER;
56
57          FUNCTION CALC (A : INTEGER) RETURN INTEGER IS
58          BEGIN
59               CC := CC + 1;
60               RETURN IDENT_INT(A);
61          END CALC;
62
63          PROCEDURE CHECK (A : STRING; B : INTEGER) IS
64          BEGIN
65               IF CC /= B THEN
66                    FAILED ("CASE " & A & " : INCORRECT NUMBER OF " &
67                            "EVALUATIONS. NUMBER OF EVALUATIONS "   &
68                            "SHOULD BE " & INTEGER'IMAGE(B) &
69                            ", BUT IS " & INTEGER'IMAGE(CC));
70               END IF;
71          END CHECK;
72
73     BEGIN
74
75CASE_A :  BEGIN
76
77               CC := 0;
78               A1 := T1'(4 .. 5 => CALC(2), 6 .. 8 => CALC(4),
79                         OTHERS => 5);
80               CHECK ("A", 5);
81
82          END CASE_A;
83
84CASE_B :  BEGIN
85
86               CC := 0;
87               A1 := T1'(1 | 4 .. 6 | 3 | 2 => CALC(-1), OTHERS => -2);
88               CHECK ("B", 6);
89
90          END CASE_B;
91
92CASE_C :  BEGIN
93
94               CC := 0;
95               A1 := T1'(1 | 3 | 5 | 7 .. 9 => -1, OTHERS => CALC(-2));
96               CHECK ("C", 4);
97
98          END CASE_C;
99
100CASE_D :  BEGIN
101
102               CC := 0;
103               A2 := T2'(4 .. 6 | 8 | 2 .. 3 => (1 .. 2 => CALC(1)),
104                         OTHERS => (1 .. 2 => -1));
105               CHECK ("D", 12);
106
107          END CASE_D;
108
109CASE_E : BEGIN
110
111               CC := 0;
112               A3 := T3'(1 .. 2 => (2 | 4 | 6 .. 8 => CALC(-1),
113                                    OTHERS => -2));
114               CHECK ("E", 10);
115
116          END CASE_E;
117
118CASE_F :  BEGIN
119
120               CC := 0;
121               A4 := T4'(7 .. 8 | 3 .. 5 =>
122                          (1 | 2 | 4 | 6 .. 8 => CALC(1), OTHERS => -2),
123                         OTHERS => (OTHERS => -2));
124               CHECK ("F", 30);
125
126          END CASE_F;
127
128CASE_G :  BEGIN
129
130               CC := 0;
131               A4 := T4'(5 .. 8 | 3 | 1 => (7 | 1 .. 5 | 8 => -1,
132                                            OTHERS => CALC(-2)),
133                         OTHERS => (OTHERS => CALC(-2)));
134               CHECK ("G", 22);
135
136          END CASE_G;
137
138     END;
139
140     RESULT;
141
142END C43210A;
143