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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log


-- C95072B.ADA
 
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
-- CHECK THAT PRIVATE TYPES IMPLEMENTED AS SCALAR OR ACCESS TYPES ARE
-- PASSED BY COPY FOR ALL MODES.
-- SUBTESTS ARE:
--   (A)  PRIVATE SCALAR PARAMETERS TO ENTRIES.
--   (B)  PRIVATE ACCESS PARAMETERS TO ENTRIES.
 
-- JWC 7/22/85
 
WITH REPORT; USE REPORT;
PROCEDURE C95072B IS
 
BEGIN
     TEST("C95072B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
                     "PARAMETERS ARE COPIED");
 
     ---------------------------------------------------
 
     DECLARE  -- (A)
 
          PACKAGE SCALAR_PKG IS
 
               TYPE T IS PRIVATE;
               C0 : CONSTANT T;
               C1 : CONSTANT T;
               C10 : CONSTANT T;
               C100 : CONSTANT T;
 
               FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T;
               FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER;
 
          PRIVATE
 
               TYPE T IS NEW INTEGER;
               C0 : CONSTANT T := 0;
               C1 : CONSTANT T := 1;
               C10 : CONSTANT T := 10;
               C100 : CONSTANT T := 100;
 
          END SCALAR_PKG;
 
          PACKAGE BODY SCALAR_PKG IS
 
               FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T IS
               BEGIN
                    RETURN T (INTEGER(OLD) + INTEGER(INCREMENT));
               END "+";
 
               FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER IS
               BEGIN
                    RETURN INTEGER (OLD_PRIVATE);
               END CONVERT;
 
          END SCALAR_PKG;
 
          USE SCALAR_PKG;
 
     BEGIN  -- (A)
 
          DECLARE  -- (A1)
 
               I : T;
               E : EXCEPTION;
 
               TASK TA IS
                    ENTRY EA (EI : IN T; EO : OUT T;
                              EIO : IN OUT T);
               END TA;
 
               TASK BODY TA IS
 
                    TEMP : T;
 
               BEGIN
 
                    ACCEPT EA (EI : IN T; EO : OUT T;
                               EIO : IN OUT T) DO
 
                         TEMP := EI;    -- SAVE VALUE OF EI AT ACCEPT.
 
                         EO := C10;
                         IF EI /= TEMP THEN
                              FAILED ("ASSIGNMENT TO PRIVATE " &
                                      "(SCALAR) OUT PARAMETER " &
                                      "CHANGES THE VALUE OF INPUT " &
                                      "PARAMETER");
                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
                         END IF;
 
                         EIO := EIO + C100;
                         IF EI /= TEMP THEN
                              FAILED ("ASSIGNMENT TO PRIVATE " &
                                      "(SCALAR) IN OUT PARAMETER " &
                                      "CHANGES THE VALUE OF INPUT " &
                                      "PARAMETER");
                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
                         END IF;
 
                         I := I + C1;
                         IF EI /= TEMP THEN
                              FAILED ("ASSIGNMENT TO PRIVATE " &
                                      "(SCALAR) ACTUAL PARAMETER " &
                                      "CHANGES THE VALUE OF " &
                                      "INPUT PARAMETER");
                         END IF;
 
                         RAISE E;              -- CHECK EXCEPTION
                                               -- HANDLING.
                    END EA;
 
               EXCEPTION
                    WHEN OTHERS => NULL;
               END TA;
 
          BEGIN    -- (A1)
 
               I := C0;  -- INITIALIZE I SO VARIOUS CASES CAN BE
                         -- DETECTED.
               TA.EA (I, I, I);
               FAILED ("EXCEPTION NOT RAISED - A");
 
          EXCEPTION
               WHEN E =>
                    IF I /= C1 THEN
                         CASE CONVERT (I) IS
                              WHEN 11 =>
                                   FAILED ("OUT ACTUAL PRIVATE " &
                                           "(SCALAR) PARAMETER " &
                                           "CHANGED GLOBAL VALUE");
                              WHEN 101 =>
                                   FAILED ("IN OUT ACTUAL PRIVATE " &
                                           "(SCALAR) PARAMETER " &
                                           "CHANGED GLOBAL VALUE");
                              WHEN 111 =>
                                   FAILED ("OUT AND IN OUT ACTUAL " &
                                           "PRIVATE (SCALAR) " &
                                           "PARAMETER CHANGED " &
                                           "GLOBAL VALUE");
                              WHEN OTHERS =>
                                   FAILED ("UNDETERMINED CHANGE TO " &
                                           "GLOBAL VALUE");
                         END CASE;
                    END IF;
               WHEN OTHERS =>
                    FAILED ("WRONG EXCEPTION RAISED - A");
          END;  -- (A1)
 
     END;  -- (A)
 
     ---------------------------------------------------
 
     DECLARE  -- (B)
 
          PACKAGE ACCESS_PKG IS
 
               TYPE T IS PRIVATE;
               C_NULL : CONSTANT T;
               C1 : CONSTANT T;
               C10 : CONSTANT T;
               C100 : CONSTANT T;
               C101 : CONSTANT T;
 
          PRIVATE
 
               TYPE T IS ACCESS INTEGER;
               C_NULL : CONSTANT T := NULL;
               C1 : CONSTANT T := NEW INTEGER'(1);
               C10 : CONSTANT T := NEW INTEGER'(10);
               C100 : CONSTANT T := NEW INTEGER'(100);
               C101 : CONSTANT T := NEW INTEGER'(101);
 
          END ACCESS_PKG;
 
          USE ACCESS_PKG;
 
     BEGIN    -- (B)
 
          DECLARE  -- (B1)
 
               I : T;
               E : EXCEPTION;
 
               TASK TB IS
                    ENTRY EB (EI : IN T; EO : OUT T;
                              EIO : IN OUT T);
               END TB;
 
               TASK BODY TB IS
 
                    TEMP : T;
 
               BEGIN
 
                    ACCEPT EB (EI : IN T; EO : OUT T;
                               EIO : IN OUT T) DO
 
                         TEMP := EI;  -- SAVE VALUE OF EI AT ACCEPT.
 
                         I := C101;
                         IF EI /= TEMP THEN
                              FAILED ("ASSIGNMENT TO PRIVATE " &
                                      "(ACCESS) ACTUAL VARIABLE " &
                                      "CHANGES THE VALUE OF INPUT " &
                                      "PARAMETER");
                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
                         END IF;
 
                         EO := C1;
                         IF EI /= TEMP THEN
                              FAILED ("ASSIGNMENT TO PRIVATE " &
                                      "(ACCESS) OUT PARAMETER " &
                                      "CHANGES THE VALUE OF INPUT " &
                                      "PARAMETER");
                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
                         END IF;
 
                         EIO := C10;
                         IF EI /= TEMP THEN
                              FAILED ("ASSIGNMENT TO PRIVATE " &
                                      "(ACCESS) IN OUT PARAMETER " &
                                      "CHANGES THE VALUE OF INPUT " &
                                      "PARAMETER");
                         END IF;
 
                         RAISE E;                 -- CHECK EXCEPTION
                                                  -- HANDLING.
                    END EB;
 
               EXCEPTION
                    WHEN OTHERS => NULL;
               END TB;
 
          BEGIN     -- (B1)
 
               I := C100;
               TB.EB (I, I, I);
               FAILED ("EXCEPTION NOT RAISED - B");
 
          EXCEPTION
               WHEN E =>
                    IF I /= C101 THEN
                         FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
                                 "PARAMETER VALUE CHANGED DESPITE " &
                                 "RAISED EXCEPTION");
                    END IF;
               WHEN OTHERS =>
                    FAILED ("WRONG EXCEPTION RAISED - B");
          END;  -- (B1)
 
     END;  -- (B)
 
     ---------------------------------------------------
 
     RESULT;
END C95072B;

Browse

Tools

Subversion Repositories openrisc

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

Line No.	Rev	Author	Line
1	720	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;`