Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cc/cc3601a.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 -- CC3601A.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 PREDEFINED OPERATORS MAY BE PASSED AS ACTUAL
26 -- GENERIC SUBPROGRAM PARAMETERS (CHECKS FOR "=" AND "/=" ARE IN
27 -- CC3601C).
28
29 -- R.WILLIAMS 10/9/86
30 -- JRL 11/15/95 Added unknown discriminant part to all formal
31 -- private types.
32
33
34 WITH REPORT; USE REPORT;
35 PROCEDURE CC3601A IS
36
37 GENERIC
38 TYPE T (<>) IS PRIVATE;
39 V, V1 : T;
40 KIND : STRING;
41 WITH FUNCTION F1 (X : IN T) RETURN T;
42 PACKAGE GP1 IS
43 R : BOOLEAN := F1 (V) = V1;
44 END GP1;
45
46 PACKAGE BODY GP1 IS
47 BEGIN
48 IF NOT (IDENT_BOOL(R)) THEN
49 FAILED ( "INCORRECT VALUE FOR UNARY OP - " & KIND);
50 END IF;
51 END GP1;
52
53 GENERIC
54 TYPE T (<>) IS PRIVATE;
55 V, V1, V2 : IN T;
56 KIND : STRING;
57 WITH FUNCTION F1 (P1 : IN T; P2 : IN T) RETURN T;
58 PACKAGE GP2 IS
59 R : BOOLEAN := V /= F1 (V1, V2);
60 END GP2;
61
62 PACKAGE BODY GP2 IS
63 BEGIN
64 IF IDENT_BOOL (R) THEN
65 FAILED ( "INCORRECT VALUE FOR BINARY OP - " & KIND);
66 END IF;
67 END GP2;
68
69
70 GENERIC
71 TYPE T1 (<>) IS PRIVATE;
72 TYPE T2 (<>) IS PRIVATE;
73 V1 : T1;
74 V2 : T2;
75 KIND : STRING;
76 WITH FUNCTION F1 (X : IN T1) RETURN T2;
77 PACKAGE GP3 IS
78 R : BOOLEAN := F1 (V1) = V2;
79 END GP3;
80
81 PACKAGE BODY GP3 IS
82 BEGIN
83 IF NOT (IDENT_BOOL(R)) THEN
84 FAILED ( "INCORRECT VALUE FOR OP - " & KIND);
85 END IF;
86 END GP3;
87
88 BEGIN
89 TEST ( "CC3601A", "CHECK THAT PREDEFINED OPERATORS MAY BE " &
90 "PASSED AS ACTUAL GENERIC SUBPROGRAM " &
91 "PARAMETERS" );
92
93
94 BEGIN -- CHECKS WITH RELATIONAL OPERATORS AND LOGICAL OPERATORS AS
95 -- ACTUAL PARAMETERS.
96
97 FOR I1 IN BOOLEAN LOOP
98
99 FOR I2 IN BOOLEAN LOOP
100 COMMENT ( "B1 = " & BOOLEAN'IMAGE (I1) & " AND " &
101 "B2 = " & BOOLEAN'IMAGE (I2) );
102 DECLARE
103 B1 : BOOLEAN := IDENT_BOOL (I1);
104 B2 : BOOLEAN := IDENT_BOOL (I2);
105
106 PACKAGE P1 IS
107 NEW GP1 (BOOLEAN, NOT B2, B2,
108 """NOT"" - 1", "NOT");
109 PACKAGE P2 IS
110 NEW GP2 (BOOLEAN, B1 OR B2, B1, B2,
111 "OR", "OR");
112 PACKAGE P3 IS
113 NEW GP2 (BOOLEAN, B1 AND B2, B2, B1,
114 "AND", "AND");
115 PACKAGE P4 IS
116 NEW GP2 (BOOLEAN, B1 /= B2, B1, B2,
117 "XOR", "XOR");
118 PACKAGE P5 IS
119 NEW GP2 (BOOLEAN, B1 < B2, B1, B2,
120 "<", "<");
121 PACKAGE P6 IS
122 NEW GP2 (BOOLEAN, B1 <= B2, B1, B2,
123 "<=", "<=");
124 PACKAGE P7 IS
125 NEW GP2 (BOOLEAN, B1 > B2, B1, B2,
126 ">", ">");
127 PACKAGE P8 IS
128 NEW GP2 (BOOLEAN, B1 >= B2, B1, B2,
129 ">=", ">=");
130
131 TYPE AB IS ARRAY (BOOLEAN RANGE <> )
132 OF BOOLEAN;
133 AB1 : AB (BOOLEAN) := (B1, B2);
134 AB2 : AB (BOOLEAN) := (B2, B1);
135 T : AB (B1 .. B2) := (B1 .. B2 => TRUE);
136 F : AB (B1 .. B2) := (B1 .. B2 => FALSE);
137 VB1 : AB (B1 .. B1) := (B1 => B2);
138 VB2 : AB (B2 .. B2) := (B2 => B1);
139
140 PACKAGE P9 IS
141 NEW GP1 (AB, AB1, NOT AB1,
142 """NOT"" - 2", "NOT");
143 PACKAGE P10 IS
144 NEW GP1 (AB, T, F,
145 """NOT"" - 3", "NOT");
146 PACKAGE P11 IS
147 NEW GP1 (AB, VB2, (B2 => NOT B1),
148 """NOT"" - 4", "NOT");
149 PACKAGE P12 IS
150 NEW GP2 (AB, AB1 AND AB2, AB1, AB2,
151 "AND", "AND");
152 BEGIN
153 NULL;
154 END;
155 END LOOP;
156 END LOOP;
157 END;
158
159 DECLARE -- CHECKS WITH ADDING AND MULTIPLYING OPERATORS, "**",
160 -- AND "ABS".
161
162 PACKAGE P1 IS NEW GP1 (INTEGER, -4, -4, """+"" - 1", "+");
163
164 PACKAGE P2 IS NEW GP1 (FLOAT, 4.0, 4.0, """+"" - 2", "+");
165
166 PACKAGE P3 IS NEW GP1 (DURATION, -4.0, -4.0, """+"" - 3",
167 "+");
168 PACKAGE P4 IS NEW GP1 (INTEGER, -4, 4, """-"" - 1", "-");
169
170 PACKAGE P5 IS NEW GP1 (FLOAT, 0.0, 0.0, """-"" - 2", "-");
171
172 PACKAGE P6 IS NEW GP1 (DURATION, 1.0, -1.0, """-"" - 3",
173 "-");
174 PACKAGE P7 IS NEW GP2 (INTEGER, 6, 1, 5, """+"" - 1", "+");
175
176 PACKAGE P8 IS NEW GP2 (FLOAT, 6.0, 1.0, 5.0, """+"" - 2",
177 "+");
178 PACKAGE P9 IS NEW GP2 (DURATION, 6.0, 1.0, 5.0, """+"" - 3",
179 "+");
180 PACKAGE P10 IS NEW GP2 (INTEGER, 1, 6, 5, """-"" - 1",
181 "-" );
182 PACKAGE P11 IS NEW GP2 (DURATION, 11.0, 6.0,-5.0,
183 """-"" - 2", "-");
184 PACKAGE P12 IS NEW GP2 (FLOAT, 1.0, 6.0, 5.0, """-"" - 3",
185 "-");
186
187 SUBTYPE SUBINT IS INTEGER RANGE 0 .. 2;
188 TYPE STR IS ARRAY (SUBINT RANGE <>) OF CHARACTER;
189 VSTR : STR (0 .. 1) := "AB";
190
191 PACKAGE P13 IS NEW GP2 (STR, VSTR (0 .. 0) &
192 VSTR (1 .. 1),
193 VSTR (0 .. 0),
194 VSTR (1 .. 1), """&"" - 1", "&");
195
196 PACKAGE P14 IS NEW GP2 (STR, VSTR (1 .. 1) &
197 VSTR (0 .. 0),
198 VSTR (1 .. 1),
199 VSTR (0 .. 0), """&"" - 2", "&");
200
201 PACKAGE P15 IS NEW GP2 (INTEGER, 0, -1, 0, """*"" - 1", "*");
202
203 PACKAGE P16 IS NEW GP2 (FLOAT, 6.0, 3.0, 2.0, """*"" - 2",
204 "*");
205 PACKAGE P17 IS NEW GP2 (INTEGER, 0, 0, 6, """/"" - 1", "/");
206
207 PACKAGE P18 IS NEW GP2 (FLOAT, 3.0, 6.0, 2.0, """/"" - 2",
208 "/");
209 PACKAGE P19 IS NEW GP2 (INTEGER, -1, -11, 5, "REM", "REM");
210
211 PACKAGE P20 IS NEW GP2 (INTEGER, 4, -11, 5, "MOD", "MOD");
212
213 PACKAGE P21 IS NEW GP1 (INTEGER, 5, 5, """ABS"" - 1", "ABS");
214
215 PACKAGE P22 IS NEW GP1 (FLOAT, -5.0, 5.0, """ABS"" - 2",
216 "ABS");
217
218 PACKAGE P23 IS NEW GP1 (DURATION, 0.0, 0.0, """ABS"" - 3",
219 "ABS");
220
221 PACKAGE P24 IS NEW GP2 (INTEGER, 9, 3, 2, """**"" - 1",
222 "**");
223
224 PACKAGE P25 IS NEW GP2 (INTEGER, 1, 5, 0, """**"" - 2",
225 "**");
226
227 BEGIN
228 NULL;
229 END;
230
231 DECLARE -- CHECKS WITH ATTRIBUTES.
232
233 TYPE WEEKDAY IS (MON, TUES, WED, THUR, FRI);
234
235 PACKAGE P1 IS NEW GP1 (WEEKDAY, TUES, WED, "WEEKDAY'SUCC",
236 WEEKDAY'SUCC);
237
238 PACKAGE P2 IS NEW GP1 (WEEKDAY, TUES, MON, "WEEKDAY'PRED",
239 WEEKDAY'PRED);
240
241 PACKAGE P3 IS NEW GP3 (WEEKDAY, STRING, THUR, "THUR",
242 "WEEKDAY'IMAGE", WEEKDAY'IMAGE);
243
244 PACKAGE P4 IS NEW GP3 (STRING, WEEKDAY, "FRI", FRI,
245 "WEEKDAY'VALUE", WEEKDAY'VALUE);
246 BEGIN
247 NULL;
248 END;
249
250 RESULT;
251 END CC3601A;