OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c95087c.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C95087C.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 ASSIGNMENTS TO ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
26 
--    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
27 
--    CONSTRAINTS RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER IS
28 
--    CONSTRAINED AND THE CONSTRAINT VALUES OF THE OBJECT BEING
29 
--    ASSIGNED TO DO NOT SATISFY THOSE OF THE ACTUAL PARAMETER.
30 
 
31 
--    SUBTESTS ARE:
32 
--        (A) CONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
33 
--        (B) CONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
34 
--        (C) CONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
35 
 
36 
-- RJW  1/15/86
37 
 
38 
WITH REPORT; USE REPORT;
39 
PROCEDURE C95087C IS
40 
 
41 
BEGIN
42 
 
43 
     TEST ( "C95087C", "CHECK ASSIGNMENTS TO ENTRY FORMAL " &
44 
                       "PARAMETERS OF UNCONSTRAINED TYPES " &
45 
                       "(WITH DEFAULTS)" );
46 
 
47 
     --------------------------------------------------
48 
 
49 
     DECLARE  -- (A)
50 
 
51 
          PACKAGE PKG IS
52 
 
53 
               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
54 
 
55 
               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
56 
                    RECORD
57 
                         INTFLD   : INTRANGE;
58 
                         STRFLD   : STRING(1..CONSTRAINT);
59 
                    END RECORD;
60 
 
61 
               REC91,REC92,REC93  : RECTYPE(9);
62 
               REC_OOPS           : RECTYPE(4);
63 
 
64 
               TASK T IS
65 
                    ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
66 
                             REC3 : OUT RECTYPE);
67 
               END T;
68 
 
69 
          END PKG;
70 
 
71 
          PACKAGE BODY PKG IS
72 
 
73 
               TASK BODY T IS
74 
               BEGIN
75 
                    ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
76 
                              REC3 : OUT RECTYPE) DO
77 
 
78 
                         IF (NOT REC1'CONSTRAINED) OR
79 
                            (REC1.CONSTRAINT /= IDENT_INT(9)) THEN
80 
                              FAILED ( "CONSTRAINT ON RECORD TYPE " &
81 
                                       "IN PARAMETER NOT RECOGNIZED" );
82 
                         END IF;
83 
 
84 
                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
85 
                              REC2 := REC_OOPS;
86 
                              FAILED ( "CONSTRAINT_ERROR NOT " &
87 
                                       "RAISED - A.1" );
88 
                         EXCEPTION
89 
                              WHEN CONSTRAINT_ERROR =>
90 
                                   NULL;
91 
                              WHEN OTHERS =>
92 
                                   FAILED ( "WRONG EXCEPTION " &
93 
                                            "RAISED - A.1" );
94 
                         END;
95 
 
96 
                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
97 
                              REC3 := REC_OOPS;
98 
                              FAILED ( "CONSTRAINT_ERROR NOT " &
99 
                                       "RAISED - A.2" );
100 
                         EXCEPTION
101 
                              WHEN CONSTRAINT_ERROR =>
102 
                                   NULL;
103 
                              WHEN OTHERS =>
104 
                                   FAILED ( "WRONG EXCEPTION " &
105 
                                            "RAISED - A.2" );
106 
                         END;
107 
 
108 
                    END E;
109 
               END T;
110 
 
111 
          BEGIN
112 
 
113 
               REC91 := (9, 9, "123456789");
114 
               REC92 := REC91;
115 
               REC93 := REC91;
116 
 
117 
               REC_OOPS := (4, 4, "OOPS");
118 
 
119 
          END PKG;
120 
 
121 
     BEGIN  -- (A)
122 
 
123 
          PKG.T.E (PKG.REC91, PKG.REC92, PKG.REC93);
124 
 
125 
     END;   -- (A)
126 
 
127 
     --------------------------------------------------
128 
 
129 
     DECLARE  -- (B)
130 
 
131 
          PACKAGE PKG IS
132 
 
133 
               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
134 
 
135 
               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
136 
 
137 
               TASK T IS
138 
                    ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
139 
                             REC3 : OUT RECTYPE);
140 
               END T;
141 
 
142 
          PRIVATE
143 
 
144 
               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
145 
                    RECORD
146 
                         INTFLD   : INTRANGE;
147 
                         STRFLD   : STRING(1..CONSTRAINT);
148 
                    END RECORD;
149 
          END PKG;
150 
 
151 
          REC91, REC92, REC93  : PKG.RECTYPE(9);
152 
          REC_OOPS             : PKG.RECTYPE(4);
153 
 
154 
          PACKAGE BODY PKG IS
155 
 
156 
               TASK BODY T IS
157 
               BEGIN
158 
                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
159 
                               REC3 : OUT RECTYPE) DO
160 
 
161 
                         IF (NOT REC1'CONSTRAINED) OR
162 
                            (REC1.CONSTRAINT /= IDENT_INT(9)) THEN
163 
                              FAILED ( "CONSTRAINT ON PRIVATE TYPE " &
164 
                                       "IN PARAMETER NOT RECOGNIZED" );
165 
                         END IF;
166 
 
167 
                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
168 
                              REC2 := REC_OOPS;
169 
                              FAILED ( "CONSTRAINT_ERROR NOT " &
170 
                                       "RAISED - B.1" );
171 
                         EXCEPTION
172 
                              WHEN CONSTRAINT_ERROR =>
173 
                                   NULL;
174 
                              WHEN OTHERS =>
175 
                                   FAILED ( "WRONG EXCEPTION " &
176 
                                            "RAISED - B.1" );
177 
                         END;
178 
 
179 
                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
180 
                              REC3 := REC_OOPS;
181 
                              FAILED ( "CONSTRAINT_ERROR NOT " &
182 
                                       "RAISED - B.2" );
183 
                         EXCEPTION
184 
                              WHEN CONSTRAINT_ERROR =>
185 
                                   NULL;
186 
                              WHEN OTHERS =>
187 
                                   FAILED ( "WRONG EXCEPTION " &
188 
                                            "RAISED - B.2" );
189 
                         END;
190 
 
191 
                    END E;
192 
              END T;
193 
 
194 
          BEGIN
195 
 
196 
               REC91 := (9, 9, "123456789");
197 
               REC92 := REC91;
198 
               REC93 := REC91;
199 
 
200 
               REC_OOPS := (4, 4, "OOPS");
201 
 
202 
          END PKG;
203 
 
204 
     BEGIN  -- (B)
205 
 
206 
          PKG.T.E (REC91, REC92, REC93);
207 
 
208 
     END;   -- (B)
209 
 
210 
     --------------------------------------------------
211 
 
212 
     DECLARE  -- (C)
213 
 
214 
          PACKAGE PKG IS
215 
 
216 
               SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
217 
 
218 
               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
219 
                    LIMITED PRIVATE;
220 
 
221 
               TASK T IS
222 
                    ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
223 
                             REC3 : OUT RECTYPE);
224 
               END T;
225 
 
226 
          PRIVATE
227 
 
228 
               TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
229 
                    RECORD
230 
                         INTFLD   : INTRANGE;
231 
                         STRFLD   : STRING(1..CONSTRAINT);
232 
                    END RECORD;
233 
          END PKG;
234 
 
235 
          REC91,REC92,REC93  : PKG.RECTYPE(9);
236 
          REC_OOPS           : PKG.RECTYPE(4);
237 
 
238 
          PACKAGE BODY PKG IS
239 
 
240 
               TASK BODY T IS
241 
               BEGIN
242 
                    ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
243 
                              REC3 : OUT RECTYPE) DO
244 
 
245 
                         IF (NOT REC1'CONSTRAINED) OR
246 
                            (REC1.CONSTRAINT /= 9) THEN
247 
                              FAILED ( "CONSTRAINT ON LIMITED " &
248 
                                       "PRIVATE TYPE IN PARAMETER " &
249 
                                       "NOT RECOGNIZED" );
250 
                         END IF;
251 
 
252 
                         BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
253 
                              REC2 := REC_OOPS;
254 
                              FAILED ( "CONSTRAINT_ERROR NOT " &
255 
                                       "RAISED - C.1" );
256 
                         EXCEPTION
257 
                              WHEN CONSTRAINT_ERROR =>
258 
                                   NULL;
259 
                              WHEN OTHERS =>
260 
                                   FAILED ( "WRONG EXCEPTION " &
261 
                                            "RAISED - C.1" );
262 
                         END;
263 
 
264 
                         BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
265 
                              REC3 := REC_OOPS;
266 
                              FAILED ( "CONSTRAINT_ERROR NOT RAISED " &
267 
                                       "- C.2" );
268 
                         EXCEPTION
269 
                              WHEN CONSTRAINT_ERROR =>
270 
                                   NULL;
271 
                              WHEN OTHERS =>
272 
                                   FAILED ( "WRONG EXCEPTION " &
273 
                                            "RAISED - C.2" );
274 
                         END;
275 
 
276 
                    END E;
277 
               END T;
278 
 
279 
          BEGIN
280 
 
281 
               REC91 := (9, 9, "123456789");
282 
               REC92 := REC91;
283 
               REC93 := REC91;
284 
 
285 
               REC_OOPS := (4, 4, "OOPS");
286 
 
287 
          END PKG;
288 
 
289 
     BEGIN  -- (C)
290 
 
291 
          PKG.T.E (REC91, REC92, REC93);
292 
 
293 
     END;   -- (C)
294 
 
295 
     --------------------------------------------------
296 
 
297 
     RESULT;
298 
 
299 
END C95087C;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.