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/] [c95072b.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn 
-- C95072B.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 PRIVATE TYPES IMPLEMENTED AS SCALAR OR ACCESS TYPES ARE
26 
-- PASSED BY COPY FOR ALL MODES.
27 
-- SUBTESTS ARE:
28 
--   (A)  PRIVATE SCALAR PARAMETERS TO ENTRIES.
29 
--   (B)  PRIVATE ACCESS PARAMETERS TO ENTRIES.
30 
 
31 
-- JWC 7/22/85
32 
 
33 
WITH REPORT; USE REPORT;
34 
PROCEDURE C95072B IS
35 
 
36 
BEGIN
37 
     TEST("C95072B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
38 
                     "PARAMETERS ARE COPIED");
39 
 
40 
     ---------------------------------------------------
41 
 
42 
     DECLARE  -- (A)
43 
 
44 
          PACKAGE SCALAR_PKG IS
45 
 
46 
               TYPE T IS PRIVATE;
47 
               C0 : CONSTANT T;
48 
               C1 : CONSTANT T;
49 
               C10 : CONSTANT T;
50 
               C100 : CONSTANT T;
51 
 
52 
               FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T;
53 
               FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER;
54 
 
55 
          PRIVATE
56 
 
57 
               TYPE T IS NEW INTEGER;
58 
               C0 : CONSTANT T := 0;
59 
               C1 : CONSTANT T := 1;
60 
               C10 : CONSTANT T := 10;
61 
               C100 : CONSTANT T := 100;
62 
 
63 
          END SCALAR_PKG;
64 
 
65 
          PACKAGE BODY SCALAR_PKG IS
66 
 
67 
               FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T IS
68 
               BEGIN
69 
                    RETURN T (INTEGER(OLD) + INTEGER(INCREMENT));
70 
               END "+";
71 
 
72 
               FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER IS
73 
               BEGIN
74 
                    RETURN INTEGER (OLD_PRIVATE);
75 
               END CONVERT;
76 
 
77 
          END SCALAR_PKG;
78 
 
79 
          USE SCALAR_PKG;
80 
 
81 
     BEGIN  -- (A)
82 
 
83 
          DECLARE  -- (A1)
84 
 
85 
               I : T;
86 
               E : EXCEPTION;
87 
 
88 
               TASK TA IS
89 
                    ENTRY EA (EI : IN T; EO : OUT T;
90 
                              EIO : IN OUT T);
91 
               END TA;
92 
 
93 
               TASK BODY TA IS
94 
 
95 
                    TEMP : T;
96 
 
97 
               BEGIN
98 
 
99 
                    ACCEPT EA (EI : IN T; EO : OUT T;
100 
                               EIO : IN OUT T) DO
101 
 
102 
                         TEMP := EI;    -- SAVE VALUE OF EI AT ACCEPT.
103 
 
104 
                         EO := C10;
105 
                         IF EI /= TEMP THEN
106 
                              FAILED ("ASSIGNMENT TO PRIVATE " &
107 
                                      "(SCALAR) OUT PARAMETER " &
108 
                                      "CHANGES THE VALUE OF INPUT " &
109 
                                      "PARAMETER");
110 
                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
111 
                         END IF;
112 
 
113 
                         EIO := EIO + C100;
114 
                         IF EI /= TEMP THEN
115 
                              FAILED ("ASSIGNMENT TO PRIVATE " &
116 
                                      "(SCALAR) IN OUT PARAMETER " &
117 
                                      "CHANGES THE VALUE OF INPUT " &
118 
                                      "PARAMETER");
119 
                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
120 
                         END IF;
121 
 
122 
                         I := I + C1;
123 
                         IF EI /= TEMP THEN
124 
                              FAILED ("ASSIGNMENT TO PRIVATE " &
125 
                                      "(SCALAR) ACTUAL PARAMETER " &
126 
                                      "CHANGES THE VALUE OF " &
127 
                                      "INPUT PARAMETER");
128 
                         END IF;
129 
 
130 
                         RAISE E;              -- CHECK EXCEPTION
131 
                                               -- HANDLING.
132 
                    END EA;
133 
 
134 
               EXCEPTION
135 
                    WHEN OTHERS => NULL;
136 
               END TA;
137 
 
138 
          BEGIN    -- (A1)
139 
 
140 
               I := C0;  -- INITIALIZE I SO VARIOUS CASES CAN BE
141 
                         -- DETECTED.
142 
               TA.EA (I, I, I);
143 
               FAILED ("EXCEPTION NOT RAISED - A");
144 
 
145 
          EXCEPTION
146 
               WHEN E =>
147 
                    IF I /= C1 THEN
148 
                         CASE CONVERT (I) IS
149 
                              WHEN 11 =>
150 
                                   FAILED ("OUT ACTUAL PRIVATE " &
151 
                                           "(SCALAR) PARAMETER " &
152 
                                           "CHANGED GLOBAL VALUE");
153 
                              WHEN 101 =>
154 
                                   FAILED ("IN OUT ACTUAL PRIVATE " &
155 
                                           "(SCALAR) PARAMETER " &
156 
                                           "CHANGED GLOBAL VALUE");
157 
                              WHEN 111 =>
158 
                                   FAILED ("OUT AND IN OUT ACTUAL " &
159 
                                           "PRIVATE (SCALAR) " &
160 
                                           "PARAMETER CHANGED " &
161 
                                           "GLOBAL VALUE");
162 
                              WHEN OTHERS =>
163 
                                   FAILED ("UNDETERMINED CHANGE TO " &
164 
                                           "GLOBAL VALUE");
165 
                         END CASE;
166 
                    END IF;
167 
               WHEN OTHERS =>
168 
                    FAILED ("WRONG EXCEPTION RAISED - A");
169 
          END;  -- (A1)
170 
 
171 
     END;  -- (A)
172 
 
173 
     ---------------------------------------------------
174 
 
175 
     DECLARE  -- (B)
176 
 
177 
          PACKAGE ACCESS_PKG IS
178 
 
179 
               TYPE T IS PRIVATE;
180 
               C_NULL : CONSTANT T;
181 
               C1 : CONSTANT T;
182 
               C10 : CONSTANT T;
183 
               C100 : CONSTANT T;
184 
               C101 : CONSTANT T;
185 
 
186 
          PRIVATE
187 
 
188 
               TYPE T IS ACCESS INTEGER;
189 
               C_NULL : CONSTANT T := NULL;
190 
               C1 : CONSTANT T := NEW INTEGER'(1);
191 
               C10 : CONSTANT T := NEW INTEGER'(10);
192 
               C100 : CONSTANT T := NEW INTEGER'(100);
193 
               C101 : CONSTANT T := NEW INTEGER'(101);
194 
 
195 
          END ACCESS_PKG;
196 
 
197 
          USE ACCESS_PKG;
198 
 
199 
     BEGIN    -- (B)
200 
 
201 
          DECLARE  -- (B1)
202 
 
203 
               I : T;
204 
               E : EXCEPTION;
205 
 
206 
               TASK TB IS
207 
                    ENTRY EB (EI : IN T; EO : OUT T;
208 
                              EIO : IN OUT T);
209 
               END TB;
210 
 
211 
               TASK BODY TB IS
212 
 
213 
                    TEMP : T;
214 
 
215 
               BEGIN
216 
 
217 
                    ACCEPT EB (EI : IN T; EO : OUT T;
218 
                               EIO : IN OUT T) DO
219 
 
220 
                         TEMP := EI;  -- SAVE VALUE OF EI AT ACCEPT.
221 
 
222 
                         I := C101;
223 
                         IF EI /= TEMP THEN
224 
                              FAILED ("ASSIGNMENT TO PRIVATE " &
225 
                                      "(ACCESS) ACTUAL VARIABLE " &
226 
                                      "CHANGES THE VALUE OF INPUT " &
227 
                                      "PARAMETER");
228 
                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
229 
                         END IF;
230 
 
231 
                         EO := C1;
232 
                         IF EI /= TEMP THEN
233 
                              FAILED ("ASSIGNMENT TO PRIVATE " &
234 
                                      "(ACCESS) OUT PARAMETER " &
235 
                                      "CHANGES THE VALUE OF INPUT " &
236 
                                      "PARAMETER");
237 
                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
238 
                         END IF;
239 
 
240 
                         EIO := C10;
241 
                         IF EI /= TEMP THEN
242 
                              FAILED ("ASSIGNMENT TO PRIVATE " &
243 
                                      "(ACCESS) IN OUT PARAMETER " &
244 
                                      "CHANGES THE VALUE OF INPUT " &
245 
                                      "PARAMETER");
246 
                         END IF;
247 
 
248 
                         RAISE E;                 -- CHECK EXCEPTION
249 
                                                  -- HANDLING.
250 
                    END EB;
251 
 
252 
               EXCEPTION
253 
                    WHEN OTHERS => NULL;
254 
               END TB;
255 
 
256 
          BEGIN     -- (B1)
257 
 
258 
               I := C100;
259 
               TB.EB (I, I, I);
260 
               FAILED ("EXCEPTION NOT RAISED - B");
261 
 
262 
          EXCEPTION
263 
               WHEN E =>
264 
                    IF I /= C101 THEN
265 
                         FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
266 
                                 "PARAMETER VALUE CHANGED DESPITE " &
267 
                                 "RAISED EXCEPTION");
268 
                    END IF;
269 
               WHEN OTHERS =>
270 
                    FAILED ("WRONG EXCEPTION RAISED - B");
271 
          END;  -- (B1)
272 
 
273 
     END;  -- (B)
274 
 
275 
     ---------------------------------------------------
276 
 
277 
     RESULT;
278 
END C95072B;

powered by: WebSVN 2.1.0

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