Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c7/c72002a.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- C72002A.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 -- OBJECTIVE:
26 -- CHECK THAT THE DECLARATIVE ITEMS IN A PACKAGE SPECIFICATION ARE
27 -- ELABORATED IN THE ORDER DECLARED.
28
29 -- HISTORY:
30 -- DHH 03/09/88 CREATED ORIGINAL TEST.
31
32 WITH REPORT; USE REPORT;
33 PROCEDURE C72002A IS
34
35 A : INTEGER := 0;
36 TYPE ORDER_ARRAY IS ARRAY(1 .. 14) OF INTEGER;
37 OBJECT_ARRAY : ORDER_ARRAY;
38 TYPE REAL IS DIGITS 4;
39 TYPE ENUM IS (RED,YELLOW,BLUE);
40
41 TYPE ARR IS ARRAY(1 ..2) OF BOOLEAN;
42 D : ARR := (TRUE, TRUE);
43 E : ARR := (FALSE, FALSE);
44
45 TYPE REC IS
46 RECORD
47 I : INTEGER;
48 END RECORD;
49 B : REC := (I => IDENT_INT(1));
50 C : REC := (I => IDENT_INT(2));
51
52 FUNCTION GIVEN_ORDER(X : INTEGER) RETURN INTEGER IS
53 Y : INTEGER;
54 BEGIN
55 Y := X + 1;
56 RETURN Y;
57 END GIVEN_ORDER;
58
59 FUNCTION BOOL(X : INTEGER) RETURN BOOLEAN IS
60 BEGIN
61 IF X = IDENT_INT(1) THEN
62 A := GIVEN_ORDER(A);
63 OBJECT_ARRAY(X) := A;
64 RETURN TRUE;
65 ELSIF X = IDENT_INT(8) THEN
66 A := GIVEN_ORDER(A);
67 OBJECT_ARRAY(X) := A;
68 RETURN FALSE;
69 END IF;
70 END BOOL;
71
72 FUNCTION INT(X : INTEGER) RETURN INTEGER IS
73 BEGIN
74 IF X = IDENT_INT(2) THEN
75 A := GIVEN_ORDER(A);
76 OBJECT_ARRAY(X) := A;
77 RETURN IDENT_INT(1);
78 ELSIF X = IDENT_INT(9) THEN
79 A := GIVEN_ORDER(A);
80 OBJECT_ARRAY(X) := A;
81 RETURN IDENT_INT(2);
82 END IF;
83 END INT;
84
85 FUNCTION FLOAT(X : INTEGER) RETURN REAL IS
86 BEGIN
87 IF X = IDENT_INT(3) THEN
88 A := GIVEN_ORDER(A);
89 OBJECT_ARRAY(X) := A;
90 RETURN 1.0;
91 ELSIF X = IDENT_INT(10) THEN
92 A := GIVEN_ORDER(A);
93 OBJECT_ARRAY(X) := A;
94 RETURN 2.0;
95 END IF;
96 END FLOAT;
97
98 FUNCTION CHAR(X : INTEGER) RETURN CHARACTER IS
99 BEGIN
100 IF X = IDENT_INT(4) THEN
101 A := GIVEN_ORDER(A);
102 OBJECT_ARRAY(X) := A;
103 RETURN 'A';
104 ELSIF X = IDENT_INT(11) THEN
105 A := GIVEN_ORDER(A);
106 OBJECT_ARRAY(X) := A;
107 RETURN 'Z';
108 END IF;
109 END CHAR;
110
111 FUNCTION ENUMR(X : INTEGER) RETURN ENUM IS
112 BEGIN
113 IF X = IDENT_INT(5) THEN
114 A := GIVEN_ORDER(A);
115 OBJECT_ARRAY(X) := A;
116 RETURN RED;
117 ELSIF X = IDENT_INT(12) THEN
118 A := GIVEN_ORDER(A);
119 OBJECT_ARRAY(X) := A;
120 RETURN YELLOW;
121 END IF;
122 END ENUMR;
123
124 FUNCTION ARRY(X : INTEGER) RETURN ARR IS
125 BEGIN
126 IF X = IDENT_INT(6) THEN
127 A := GIVEN_ORDER(A);
128 OBJECT_ARRAY(X) := A;
129 RETURN D;
130 ELSIF X = IDENT_INT(13) THEN
131 A := GIVEN_ORDER(A);
132 OBJECT_ARRAY(X) := A;
133 RETURN E;
134 END IF;
135 END ARRY;
136
137 FUNCTION RECOR(X : INTEGER) RETURN REC IS
138 BEGIN
139 IF X = IDENT_INT(7) THEN
140 A := GIVEN_ORDER(A);
141 OBJECT_ARRAY(X) := A;
142 RETURN B;
143 ELSIF X = IDENT_INT(14) THEN
144 A := GIVEN_ORDER(A);
145 OBJECT_ARRAY(X) := A;
146 RETURN C;
147 END IF;
148 END RECOR;
149
150 PACKAGE PACK IS
151 A : BOOLEAN := BOOL(1);
152 B : INTEGER := INT(2);
153 C : REAL := FLOAT(3);
154 D : CHARACTER := CHAR(4);
155 E : ENUM := ENUMR(5);
156 F : ARR := ARRY(6);
157 G : REC := RECOR(7);
158 H : BOOLEAN := BOOL(8);
159 I : INTEGER := INT(9);
160 J : REAL := FLOAT(10);
161 K : CHARACTER := CHAR(11);
162 L : ENUM := ENUMR(12);
163 M : ARR := ARRY(13);
164 N : REC := RECOR(14);
165 END PACK;
166
167 BEGIN
168 TEST("C72002A", "CHECK THAT THE DECLARATIVE ITEMS IN A PACKAGE " &
169 "SPECIFICATION ARE ELABORATED IN THE ORDER " &
170 "DECLARED");
171
172 IF OBJECT_ARRAY(1) /= IDENT_INT(1) THEN
173 FAILED("BOOLEAN 1 ELABORATED OUT OF ORDER");
174 END IF;
175
176 IF OBJECT_ARRAY(2) /= IDENT_INT(2) THEN
177 FAILED("INTEGER 1 ELABORATED OUT OF ORDER");
178 END IF;
179
180 IF OBJECT_ARRAY(3) /= IDENT_INT(3) THEN
181 FAILED("REAL 1 ELABORATED OUT OF ORDER");
182 END IF;
183
184 IF OBJECT_ARRAY(4) /= IDENT_INT(4) THEN
185 FAILED("CHARACTER 1 ELABORATED OUT OF ORDER");
186 END IF;
187
188 IF OBJECT_ARRAY(5) /= IDENT_INT(5) THEN
189 FAILED("ENUMERATION 1 ELABORATED OUT OF ORDER");
190 END IF;
191
192 IF OBJECT_ARRAY(6) /= IDENT_INT(6) THEN
193 FAILED("ARRAY 1 ELABORATED OUT OF ORDER");
194 END IF;
195
196 IF OBJECT_ARRAY(7) /= IDENT_INT(7) THEN
197 FAILED("RECORD 1 ELABORATED OUT OF ORDER");
198 END IF;
199
200 IF OBJECT_ARRAY(8) /= IDENT_INT(8) THEN
201 FAILED("BOOLEAN 2 ELABORATED OUT OF ORDER");
202 END IF;
203
204 IF OBJECT_ARRAY(9) /= IDENT_INT(9) THEN
205 FAILED("INTEGER 2 ELABORATED OUT OF ORDER");
206 END IF;
207
208 IF OBJECT_ARRAY(10) /= IDENT_INT(10) THEN
209 FAILED("REAL 2 ELABORATED OUT OF ORDER");
210 END IF;
211
212 IF OBJECT_ARRAY(11) /= IDENT_INT(11) THEN
213 FAILED("CHARACTER 2 ELABORATED OUT OF ORDER");
214 END IF;
215
216 IF OBJECT_ARRAY(12) /= IDENT_INT(12) THEN
217 FAILED("ENUMERATION 2 ELABORATED OUT OF ORDER");
218 END IF;
219
220 IF OBJECT_ARRAY(13) /= IDENT_INT(13) THEN
221 FAILED("ARRAY 2 ELABORATED OUT OF ORDER");
222 END IF;
223
224 IF OBJECT_ARRAY(14) /= IDENT_INT(14) THEN
225 FAILED("RECORD 2 ELABORATED OUT OF ORDER");
226 END IF;
227
228 RESULT;
229 END C72002A;