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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c95087d.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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