Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c9/c95085b.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 -- C95085B.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 UNDER APPROPRIATE CIRCUMSTANCES
26 -- WITH RESPECT TO PARAMETERS OF RECORD TYPES IN ENTRY CALLS. SUBTESTS
27 -- INVOLVE ACTUAL RECORD PARAMETERS WHOSE CONSTRAINT VALUES ARE NOT
28 -- EQUAL TO THE CONSTRAINTS ON THEIR CORRESPONDING FORMAL PARAMETERS:
29 -- (A) IN PARAMETER, STATIC AGGREGATE.
30 -- (B) IN PARAMETER, DYNAMIC AGGREGATE.
31 -- (C) IN PARAMETER, VARIABLE.
32 -- (D) IN OUT PARAMETER, EXCEPTION RAISED ON CALL.
33 -- (E) OUT PARAMETER, EXCEPTION RAISED ON CALL.
34
35 -- JWC 10/25/85
36
37 WITH REPORT; USE REPORT;
38 PROCEDURE C95085B IS
39
40 SUBTYPE INT IS INTEGER RANGE 0..10;
41
42 TYPE REC (N : INT := 0) IS
43 RECORD
44 A : STRING (1..N);
45 END RECORD;
46
47 SUBTYPE SREC IS REC(N=>3);
48
49 BEGIN
50
51 TEST ("C95085B", "CHECK RAISING OF CONSTRAINT_ERROR FOR " &
52 "PARAMETERS OF RECORD TYPES");
53
54 DECLARE
55
56 TASK TSK1 IS
57 ENTRY E (R : IN SREC);
58 END TSK1;
59
60 TASK BODY TSK1 IS
61 BEGIN
62 LOOP
63 BEGIN
64 SELECT
65 ACCEPT E (R : IN SREC) DO
66 FAILED ("EXCEPTION NOT RAISED ON " &
67 "CALL TO TSK1");
68 END E;
69 OR
70 TERMINATE;
71 END SELECT;
72 EXCEPTION
73 WHEN OTHERS =>
74 FAILED ("EXCEPTION RAISED IN TSK1");
75 END;
76 END LOOP;
77 END TSK1;
78
79 BEGIN
80
81 BEGIN -- (A)
82 TSK1.E ((2,"AA"));
83 FAILED ("EXCEPTION NOT RAISED IN SUBTEST (A)");
84 EXCEPTION
85 WHEN CONSTRAINT_ERROR =>
86 NULL;
87 WHEN OTHERS =>
88 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (A)");
89 END; -- (A)
90
91 BEGIN -- (B)
92 TSK1.E ((IDENT_INT(2), "AA"));
93 FAILED ("EXCEPTION NOT RAISED IN SUBTEST (B)");
94 EXCEPTION
95 WHEN CONSTRAINT_ERROR =>
96 NULL;
97 WHEN OTHERS =>
98 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (B)");
99 END; -- (B)
100
101 DECLARE -- (C)
102 R : REC := (IDENT_INT(2), "AA");
103 BEGIN -- (C)
104 TSK1.E (R);
105 FAILED ("EXCEPTION NOT RAISED IN SUBTEST (C)");
106 EXCEPTION
107 WHEN CONSTRAINT_ERROR =>
108 NULL;
109 WHEN OTHERS =>
110 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (C)");
111 END; -- (C)
112
113 END;
114
115 DECLARE -- (D)
116
117 R : REC := (IDENT_INT(2), "AA");
118
119 TASK TSK2 IS
120 ENTRY E (R : IN OUT SREC);
121 END TSK2;
122
123 TASK BODY TSK2 IS
124 BEGIN
125 SELECT
126 ACCEPT E (R : IN OUT SREC) DO
127 FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
128 "TSK2");
129 END E;
130 OR
131 TERMINATE;
132 END SELECT;
133 EXCEPTION
134 WHEN OTHERS =>
135 FAILED ("EXCEPTION RAISED IN TSK2");
136 END TSK2;
137
138 BEGIN -- (D)
139 TSK2.E (R);
140 FAILED ("EXCEPTION NOT RAISED IN SUBTEST (D)");
141 EXCEPTION
142 WHEN CONSTRAINT_ERROR =>
143 NULL;
144 WHEN OTHERS =>
145 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (D)");
146 END; -- (D)
147
148 DECLARE -- (E)
149
150 R : REC;
151
152 TASK TSK3 IS
153 ENTRY E (R : OUT SREC);
154 END TSK3;
155
156 TASK BODY TSK3 IS
157 BEGIN
158 SELECT
159 ACCEPT E (R : OUT SREC) DO
160 FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
161 "TSK3");
162 END E;
163 OR
164 TERMINATE;
165 END SELECT;
166 EXCEPTION
167 WHEN OTHERS =>
168 FAILED ("EXCEPTION RAISED IN TSK3");
169 END TSK3;
170
171 BEGIN -- (E)
172 TSK3.E (R);
173 FAILED ("EXCEPTION NOT RAISED IN SUBTEST (E)");
174 EXCEPTION
175 WHEN CONSTRAINT_ERROR =>
176 NULL;
177 WHEN OTHERS =>
178 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (E)");
179 END; -- (E)
180
181 RESULT;
182
183 END C95085B;