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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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