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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c47002d.ada] - Blame information for rev 149

Go to most recent revision | Details | Compare with Previous | View Log


-- C47002D.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 VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS 
-- THE OPERANDS OF QUALIFIED EXPRESSIONS.
-- THIS TEST IS FOR PRIVATE AND LIMITED PRIVATE TYPES.
 
-- RJW 7/23/86
 
WITH REPORT; USE REPORT;
PROCEDURE C47002D IS
 
BEGIN
 
     TEST( "C47002D", "CHECK THAT VALUES HAVING PRIVATE AND LIMITED " &
                      "PRIVATE TYPES CAN BE WRITTEN AS THE OPERANDS " &
                      "OF QUALIFIED EXPRESSIONS" );
 
     DECLARE -- PRIVATE TYPES.
 
          TYPE RESULTS IS (P1, P2, P3, P4, P5);
 
          PACKAGE PKG1 IS
               TYPE PINT IS PRIVATE;
               TYPE PCHAR IS PRIVATE;
               TYPE PARR IS PRIVATE;
               TYPE PREC (D : INTEGER) IS PRIVATE;
               TYPE PACC IS PRIVATE;
 
               FUNCTION F RETURN PINT;
               FUNCTION F RETURN PCHAR;
               FUNCTION F RETURN PARR;
               FUNCTION F RETURN PREC;
               FUNCTION F RETURN PACC;
 
          PRIVATE
               TYPE PINT IS NEW INTEGER;
               TYPE PCHAR IS NEW CHARACTER;
               TYPE PARR IS ARRAY (1 .. 2) OF NATURAL;
 
               TYPE PREC (D : INTEGER) IS
                    RECORD
                         NULL;
                    END RECORD;
 
               TYPE PACC IS ACCESS PREC;
 
          END PKG1;
 
          PACKAGE BODY PKG1 IS
               FUNCTION F RETURN PINT IS
               BEGIN
                    RETURN 1;
               END F;
 
               FUNCTION F RETURN PCHAR IS
               BEGIN
                    RETURN 'B';
               END F;
 
               FUNCTION F RETURN PARR IS
               BEGIN
                    RETURN PARR'(OTHERS => 3);
               END F;
 
               FUNCTION F RETURN PREC IS
               BEGIN
                    RETURN PREC'(D => 4);
               END F;
 
               FUNCTION F RETURN PACC IS
               BEGIN
                    RETURN NEW PREC'(F);
               END F;
 
          END PKG1;
 
          PACKAGE PKG2 IS END PKG2;
 
          PACKAGE BODY PKG2 IS
               USE PKG1;
 
               FUNCTION CHECK (P : PINT) RETURN RESULTS IS
               BEGIN
                    RETURN  P1;
               END CHECK;
 
               FUNCTION CHECK (P : PCHAR) RETURN RESULTS IS
               BEGIN
                    RETURN  P2;
               END CHECK;
 
               FUNCTION CHECK (P : PARR) RETURN RESULTS IS
               BEGIN
                    RETURN  P3;
               END CHECK;
 
               FUNCTION CHECK (P : PREC) RETURN RESULTS IS
               BEGIN
                    RETURN  P4;
               END CHECK;
 
               FUNCTION CHECK (P : PACC) RETURN RESULTS IS
               BEGIN
                    RETURN  P5;
               END CHECK;
 
          BEGIN
               IF CHECK (PINT'(F)) /= P1 THEN
                    FAILED ( "INCORRECT RESULTS FOR TYPE PINT" );
               END IF;
 
               IF CHECK (PCHAR'(F)) /= P2 THEN
                    FAILED ( "INCORRECT RESULTS FOR TYPE PCHAR" );
               END IF;
 
               IF CHECK (PARR'(F)) /= P3 THEN
                    FAILED ( "INCORRECT RESULTS FOR TYPE PARR" );
               END IF;
 
               IF CHECK (PREC'(F)) /= P4 THEN
                    FAILED ( "INCORRECT RESULTS FOR TYPE PREC" );
               END IF;
 
               IF CHECK (PACC'(F)) /= P5 THEN
                    FAILED ( "INCORRECT RESULTS FOR TYPE PACC" );
               END IF;
 
          END PKG2;
 
     BEGIN
          NULL;
     END;
 
     DECLARE -- LIMITED PRIVATE TYPES.
 
          TYPE RESULTS IS (LP1, LP2, LP3, LP4, LP5);
 
          PACKAGE PKG1 IS
               TYPE LPINT IS LIMITED PRIVATE;
               TYPE LPCHAR IS LIMITED PRIVATE;
               TYPE LPARR IS LIMITED PRIVATE;
               TYPE LPREC (D : INTEGER) IS LIMITED PRIVATE;
               TYPE LPACC IS LIMITED PRIVATE;
 
               FUNCTION F RETURN LPINT;
               FUNCTION F RETURN LPCHAR;
               FUNCTION F RETURN LPARR;
               FUNCTION F RETURN LPREC;
               FUNCTION F RETURN LPACC;
 
          PRIVATE
               TYPE LPINT IS NEW INTEGER;
               TYPE LPCHAR IS NEW CHARACTER;
               TYPE LPARR IS ARRAY (1 .. 2) OF NATURAL;
 
               TYPE LPREC (D : INTEGER) IS
                    RECORD
                         NULL;
                    END RECORD;
 
               TYPE LPACC IS ACCESS LPREC;
 
          END PKG1;
 
          PACKAGE BODY PKG1 IS
               FUNCTION F RETURN LPINT IS
               BEGIN
                    RETURN 1;
               END F;
 
               FUNCTION F RETURN LPCHAR IS
               BEGIN
                    RETURN 'B';
               END F;
 
               FUNCTION F RETURN LPARR IS
               BEGIN
                    RETURN LPARR'(OTHERS => 3);
               END F;
 
               FUNCTION F RETURN LPREC IS
               BEGIN
                    RETURN LPREC'(D => 4);
               END F;
 
               FUNCTION F RETURN LPACC IS
               BEGIN
                    RETURN NEW LPREC'(F);
               END F;
 
          END PKG1;
 
          PACKAGE PKG2 IS END PKG2;
 
          PACKAGE BODY PKG2 IS
               USE PKG1;
 
               FUNCTION CHECK (LP : LPINT) RETURN RESULTS IS
               BEGIN
                    RETURN  LP1;
               END CHECK;
 
               FUNCTION CHECK (LP : LPCHAR) RETURN RESULTS IS
               BEGIN
                    RETURN  LP2;
               END CHECK;
 
               FUNCTION CHECK (LP : LPARR) RETURN RESULTS IS
               BEGIN
                    RETURN  LP3;
               END CHECK;
 
               FUNCTION CHECK (LP : LPREC) RETURN RESULTS IS
               BEGIN
                    RETURN  LP4;
               END CHECK;
 
               FUNCTION CHECK (LP : LPACC) RETURN RESULTS IS
               BEGIN
                    RETURN  LP5;
               END CHECK;
 
          BEGIN
               IF CHECK (LPINT'(F)) /= LP1 THEN
                    FAILED ( "INCORRECT RESULTS FOR TYPE LPINT" );
               END IF;
 
               IF CHECK (LPCHAR'(F)) /= LP2 THEN
                    FAILED ( "INCORRECT RESULTS FOR TYPE LPCHAR" );
               END IF;
 
               IF CHECK (LPARR'(F)) /= LP3 THEN
                    FAILED ( "INCORRECT RESULTS FOR TYPE LPARR" );
               END IF;
 
               IF CHECK (LPREC'(F)) /= LP4 THEN
                    FAILED ( "INCORRECT RESULTS FOR TYPE LPREC" );
               END IF;
 
               IF CHECK (LPACC'(F)) /= LP5 THEN
                    FAILED ( "INCORRECT RESULTS FOR TYPE LPACC" );
               END IF;
 
          END PKG2;
 
     BEGIN
          NULL;
     END;
 
     RESULT;
END C47002D;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c47002d.ada] - Blame information for rev 149

Line No.	Rev	Author	Line
1	149	jeremybenn	`-- C47002D.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 VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS`
26			`-- THE OPERANDS OF QUALIFIED EXPRESSIONS.`
27			`-- THIS TEST IS FOR PRIVATE AND LIMITED PRIVATE TYPES.`
28
29			`-- RJW 7/23/86`
30
31			`WITH REPORT; USE REPORT;`
32			`PROCEDURE C47002D IS`
33
34			`BEGIN`
35
36			`TEST( "C47002D", "CHECK THAT VALUES HAVING PRIVATE AND LIMITED " &`
37			`"PRIVATE TYPES CAN BE WRITTEN AS THE OPERANDS " &`
38			`"OF QUALIFIED EXPRESSIONS" );`
39
40			`DECLARE -- PRIVATE TYPES.`
41
42			`TYPE RESULTS IS (P1, P2, P3, P4, P5);`
43
44			`PACKAGE PKG1 IS`
45			`TYPE PINT IS PRIVATE;`
46			`TYPE PCHAR IS PRIVATE;`
47			`TYPE PARR IS PRIVATE;`
48			`TYPE PREC (D : INTEGER) IS PRIVATE;`
49			`TYPE PACC IS PRIVATE;`
50
51			`FUNCTION F RETURN PINT;`
52			`FUNCTION F RETURN PCHAR;`
53			`FUNCTION F RETURN PARR;`
54			`FUNCTION F RETURN PREC;`
55			`FUNCTION F RETURN PACC;`
56
57			`PRIVATE`
58			`TYPE PINT IS NEW INTEGER;`
59			`TYPE PCHAR IS NEW CHARACTER;`
60			`TYPE PARR IS ARRAY (1 .. 2) OF NATURAL;`
61
62			`TYPE PREC (D : INTEGER) IS`
63			`RECORD`
64			`NULL;`
65			`END RECORD;`
66
67			`TYPE PACC IS ACCESS PREC;`
68
69			`END PKG1;`
70
71			`PACKAGE BODY PKG1 IS`
72			`FUNCTION F RETURN PINT IS`
73			`BEGIN`
74			`RETURN 1;`
75			`END F;`
76
77			`FUNCTION F RETURN PCHAR IS`
78			`BEGIN`
79			`RETURN 'B';`
80			`END F;`
81
82			`FUNCTION F RETURN PARR IS`
83			`BEGIN`
84			`RETURN PARR'(OTHERS => 3);`
85			`END F;`
86
87			`FUNCTION F RETURN PREC IS`
88			`BEGIN`
89			`RETURN PREC'(D => 4);`
90			`END F;`
91
92			`FUNCTION F RETURN PACC IS`
93			`BEGIN`
94			`RETURN NEW PREC'(F);`
95			`END F;`
96
97			`END PKG1;`
98
99			`PACKAGE PKG2 IS END PKG2;`
100
101			`PACKAGE BODY PKG2 IS`
102			`USE PKG1;`
103
104			`FUNCTION CHECK (P : PINT) RETURN RESULTS IS`
105			`BEGIN`
106			`RETURN P1;`
107			`END CHECK;`
108
109			`FUNCTION CHECK (P : PCHAR) RETURN RESULTS IS`
110			`BEGIN`
111			`RETURN P2;`
112			`END CHECK;`
113
114			`FUNCTION CHECK (P : PARR) RETURN RESULTS IS`
115			`BEGIN`
116			`RETURN P3;`
117			`END CHECK;`
118
119			`FUNCTION CHECK (P : PREC) RETURN RESULTS IS`
120			`BEGIN`
121			`RETURN P4;`
122			`END CHECK;`
123
124			`FUNCTION CHECK (P : PACC) RETURN RESULTS IS`
125			`BEGIN`
126			`RETURN P5;`
127			`END CHECK;`
128
129			`BEGIN`
130			`IF CHECK (PINT'(F)) /= P1 THEN`
131			`FAILED ( "INCORRECT RESULTS FOR TYPE PINT" );`
132			`END IF;`
133
134			`IF CHECK (PCHAR'(F)) /= P2 THEN`
135			`FAILED ( "INCORRECT RESULTS FOR TYPE PCHAR" );`
136			`END IF;`
137
138			`IF CHECK (PARR'(F)) /= P3 THEN`
139			`FAILED ( "INCORRECT RESULTS FOR TYPE PARR" );`
140			`END IF;`
141
142			`IF CHECK (PREC'(F)) /= P4 THEN`
143			`FAILED ( "INCORRECT RESULTS FOR TYPE PREC" );`
144			`END IF;`
145
146			`IF CHECK (PACC'(F)) /= P5 THEN`
147			`FAILED ( "INCORRECT RESULTS FOR TYPE PACC" );`
148			`END IF;`
149
150			`END PKG2;`
151
152			`BEGIN`
153			`NULL;`
154			`END;`
155
156			`DECLARE -- LIMITED PRIVATE TYPES.`
157
158			`TYPE RESULTS IS (LP1, LP2, LP3, LP4, LP5);`
159
160			`PACKAGE PKG1 IS`
161			`TYPE LPINT IS LIMITED PRIVATE;`
162			`TYPE LPCHAR IS LIMITED PRIVATE;`
163			`TYPE LPARR IS LIMITED PRIVATE;`
164			`TYPE LPREC (D : INTEGER) IS LIMITED PRIVATE;`
165			`TYPE LPACC IS LIMITED PRIVATE;`
166
167			`FUNCTION F RETURN LPINT;`
168			`FUNCTION F RETURN LPCHAR;`
169			`FUNCTION F RETURN LPARR;`
170			`FUNCTION F RETURN LPREC;`
171			`FUNCTION F RETURN LPACC;`
172
173			`PRIVATE`
174			`TYPE LPINT IS NEW INTEGER;`
175			`TYPE LPCHAR IS NEW CHARACTER;`
176			`TYPE LPARR IS ARRAY (1 .. 2) OF NATURAL;`
177
178			`TYPE LPREC (D : INTEGER) IS`
179			`RECORD`
180			`NULL;`
181			`END RECORD;`
182
183			`TYPE LPACC IS ACCESS LPREC;`
184
185			`END PKG1;`
186
187			`PACKAGE BODY PKG1 IS`
188			`FUNCTION F RETURN LPINT IS`
189			`BEGIN`
190			`RETURN 1;`
191			`END F;`
192
193			`FUNCTION F RETURN LPCHAR IS`
194			`BEGIN`
195			`RETURN 'B';`
196			`END F;`
197
198			`FUNCTION F RETURN LPARR IS`
199			`BEGIN`
200			`RETURN LPARR'(OTHERS => 3);`
201			`END F;`
202
203			`FUNCTION F RETURN LPREC IS`
204			`BEGIN`
205			`RETURN LPREC'(D => 4);`
206			`END F;`
207
208			`FUNCTION F RETURN LPACC IS`
209			`BEGIN`
210			`RETURN NEW LPREC'(F);`
211			`END F;`
212
213			`END PKG1;`
214
215			`PACKAGE PKG2 IS END PKG2;`
216
217			`PACKAGE BODY PKG2 IS`
218			`USE PKG1;`
219
220			`FUNCTION CHECK (LP : LPINT) RETURN RESULTS IS`
221			`BEGIN`
222			`RETURN LP1;`
223			`END CHECK;`
224
225			`FUNCTION CHECK (LP : LPCHAR) RETURN RESULTS IS`
226			`BEGIN`
227			`RETURN LP2;`
228			`END CHECK;`
229
230			`FUNCTION CHECK (LP : LPARR) RETURN RESULTS IS`
231			`BEGIN`
232			`RETURN LP3;`
233			`END CHECK;`
234
235			`FUNCTION CHECK (LP : LPREC) RETURN RESULTS IS`
236			`BEGIN`
237			`RETURN LP4;`
238			`END CHECK;`
239
240			`FUNCTION CHECK (LP : LPACC) RETURN RESULTS IS`
241			`BEGIN`
242			`RETURN LP5;`
243			`END CHECK;`
244
245			`BEGIN`
246			`IF CHECK (LPINT'(F)) /= LP1 THEN`
247			`FAILED ( "INCORRECT RESULTS FOR TYPE LPINT" );`
248			`END IF;`
249
250			`IF CHECK (LPCHAR'(F)) /= LP2 THEN`
251			`FAILED ( "INCORRECT RESULTS FOR TYPE LPCHAR" );`
252			`END IF;`
253
254			`IF CHECK (LPARR'(F)) /= LP3 THEN`
255			`FAILED ( "INCORRECT RESULTS FOR TYPE LPARR" );`
256			`END IF;`
257
258			`IF CHECK (LPREC'(F)) /= LP4 THEN`
259			`FAILED ( "INCORRECT RESULTS FOR TYPE LPREC" );`
260			`END IF;`
261
262			`IF CHECK (LPACC'(F)) /= LP5 THEN`
263			`FAILED ( "INCORRECT RESULTS FOR TYPE LPACC" );`
264			`END IF;`
265
266			`END PKG2;`
267
268			`BEGIN`
269			`NULL;`
270			`END;`
271
272			`RESULT;`
273			`END C47002D;`