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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log


-- C37402A.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 WHEN A FORMAL PARAMETER OF A SUBPROGRAM, ENTRY, OR 
-- GENERIC UNIT HAS AN UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT 
-- HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN APPLIED TO FORMAL 
-- PARAMETERS OF MODE IN AND HAS THE VALUE OF THE ACTUAL PARAMETER 
-- FOR THE OTHER MODES.
 
-- R.WILLIAMS 9/1/86
 
WITH REPORT; USE REPORT;
PROCEDURE C37402A IS
 
BEGIN
     TEST ( "C37402A", "CHECK THAT WHEN A FORMAL PARAMETER OF A " &
                       "SUBPROGRAM, ENTRY, OR GENERIC UNIT HAS AN " &
                       "UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT " &
                       "HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN " &
                       "APPLIED TO FORMAL PARAMETERS OF MODE IN " &
                       "AND HAS THE VALUE OF THE ACTUAL PARAMETER " &
                       "FOR THE OTHER MODES" );
 
 
     DECLARE
 
          SUBTYPE INT IS INTEGER RANGE 1 .. 5;
 
          TYPE MATRIX IS ARRAY (INT RANGE <>, INT RANGE <>)
               OF INTEGER;
 
          TYPE SQUARE (SIDE : INT := 1) IS
               RECORD
                    MAT : MATRIX (1 .. SIDE, 1 .. SIDE);
               END RECORD;
 
          SC : CONSTANT SQUARE := (2, ((0, 0), (0, 0)));
 
          AC : SQUARE (2) := (2, ((1, 2), (3, 4)));
          AU : SQUARE     := (SIDE => 1, MAT => (1 => (1 => 1)));
 
          BC : SQUARE (2) := AC;
          BU : SQUARE     := AU;
 
          CC : SQUARE (2);
          CU : SQUARE;
 
          PROCEDURE P (CON, IN_CON : IN     SQUARE;
                       INOUT_CON   : IN OUT SQUARE;
                       OUT_CON     : OUT    SQUARE;
                       IN_UNC      : IN     SQUARE;
                       INOUT_UNC   : IN OUT SQUARE;
                       OUT_UNC     : OUT    SQUARE) IS
 
          BEGIN
               IF CON'CONSTRAINED THEN
                    NULL;
               ELSE
                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
                             "OF IN MODE - 1" );
               END IF;
 
               IF IN_CON'CONSTRAINED THEN
                    NULL;
               ELSE
                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
                             "OF IN MODE - 2" );
               END IF;
 
               IF IN_UNC'CONSTRAINED THEN
                    NULL;
               ELSE
                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
                             "OF IN MODE - 3" );
               END IF;
 
               IF INOUT_CON'CONSTRAINED THEN
                    NULL;
               ELSE
                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
                             "CONSTRAINED OBJECT OF IN OUT MODE - 1" );
               END IF;
 
               IF OUT_CON'CONSTRAINED THEN
                    NULL;
               ELSE
                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
                             "CONSTRAINED OBJECT OF OUT MODE - 1" );
               END IF;
 
               IF INOUT_UNC'CONSTRAINED THEN
                    FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
                             "UNCONSTRAINED OBJECT OF IN OUT MODE " &
                             "- 1" );
               END IF;
 
               IF OUT_UNC'CONSTRAINED THEN
                    FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
                             "UNCONSTRAINED OBJECT OF OUT MODE - 1" );
               END IF;
 
               OUT_CON := (2, ((1, 2), (3, 4)));
               OUT_UNC := (2, ((1, 2), (3, 4)));
          END P;
 
          TASK T IS
               ENTRY Q (CON, IN_CON : IN     SQUARE;
                        INOUT_CON   : IN OUT SQUARE;
                        OUT_CON     : OUT    SQUARE;
                        IN_UNC      : IN     SQUARE;
                        INOUT_UNC   : IN OUT SQUARE;
                        OUT_UNC     : OUT    SQUARE);
          END T;
 
          TASK BODY T IS
          BEGIN
               ACCEPT Q (CON, IN_CON : IN     SQUARE;
                         INOUT_CON   : IN OUT SQUARE;
                         OUT_CON     : OUT    SQUARE;
                         IN_UNC      : IN     SQUARE;
                         INOUT_UNC   : IN OUT SQUARE;
                         OUT_UNC     : OUT    SQUARE) DO
                    BEGIN
                         IF CON'CONSTRAINED THEN
                              NULL;
                         ELSE
                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
                                       "OBJECT OF IN MODE - 4" );
                         END IF;
 
                         IF IN_CON'CONSTRAINED THEN
                              NULL;
                         ELSE
                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
                                       "OBJECT OF IN MODE - 5" );
                         END IF;
 
                         IF IN_UNC'CONSTRAINED THEN
                              NULL;
                         ELSE
                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
                                       "OBJECT OF IN MODE - 6" );
                         END IF;
 
                         IF INOUT_CON'CONSTRAINED THEN
                              NULL;
                         ELSE
                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
                                       "CONSTRAINED OBJECT OF " &
                                       "IN OUT MODE - 2" );
                         END IF;
 
                         IF OUT_CON'CONSTRAINED THEN
                              NULL;
                         ELSE
                              FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
                                       "CONSTRAINED OBJECT OF " &
                                       "OUT MODE - 2" );
                         END IF;
 
                         IF INOUT_UNC'CONSTRAINED THEN
                              FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
                                       "UNCONSTRAINED OBJECT OF " &
                                       "IN OUT MODE - 2" );
                         END IF;
 
                         IF OUT_UNC'CONSTRAINED THEN
                              FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
                                       "UNCONSTRAINED OBJECT OF " &
                                       "OUT MODE - 2" );
                         END IF;
 
                         OUT_CON := (2, ((1, 2), (3, 4)));
                         OUT_UNC := (2, ((1, 2), (3, 4)));
                    END;
               END Q;
          END T;
 
          GENERIC
               CON, IN_CON : IN     SQUARE;
               INOUT_CON   : IN OUT SQUARE;
               IN_UNC      : IN     SQUARE;
               INOUT_UNC   : IN OUT SQUARE;
          PACKAGE R IS END R;
 
          PACKAGE BODY R IS
          BEGIN
               IF CON'CONSTRAINED THEN
                    NULL;
               ELSE
                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
                             "OF IN MODE - 7" );
               END IF;
 
               IF IN_CON'CONSTRAINED THEN
                    NULL;
               ELSE
                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
                             "OF IN MODE - 8" );
               END IF;
 
               IF IN_UNC'CONSTRAINED THEN
                    NULL;
               ELSE
                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &
                             "OF IN MODE - 9" );
               END IF;
 
               IF INOUT_CON'CONSTRAINED THEN
                    NULL;
               ELSE
                    FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &
                             "CONSTRAINED OBJECT OF IN OUT MODE - 3" );
               END IF;
 
               IF INOUT_UNC'CONSTRAINED THEN
                    FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &
                             "UNCONSTRAINED OBJECT OF IN OUT MODE " &
                             "- 3" );
               END IF;
 
          END R;
 
          PACKAGE S IS NEW R (SC, AC, BC, AU, BU);
 
     BEGIN
          P (SC, AC, BC, CC, AU, BU, CU);
          T.Q (SC, AC, BC, CC, AU, BU, CU);
     END;
 
     RESULT;
END C37402A;

Browse

Tools

Subversion Repositories openrisc

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

Line No.	Rev	Author	Line
1	720	jeremybenn	`-- C37402A.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 WHEN A FORMAL PARAMETER OF A SUBPROGRAM, ENTRY, OR`
26			`-- GENERIC UNIT HAS AN UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT`
27			`-- HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN APPLIED TO FORMAL`
28			`-- PARAMETERS OF MODE IN AND HAS THE VALUE OF THE ACTUAL PARAMETER`
29			`-- FOR THE OTHER MODES.`
30
31			`-- R.WILLIAMS 9/1/86`
32
33			`WITH REPORT; USE REPORT;`
34			`PROCEDURE C37402A IS`
35
36			`BEGIN`
37			`TEST ( "C37402A", "CHECK THAT WHEN A FORMAL PARAMETER OF A " &`
38			`"SUBPROGRAM, ENTRY, OR GENERIC UNIT HAS AN " &`
39			`"UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT " &`
40			`"HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN " &`
41			`"APPLIED TO FORMAL PARAMETERS OF MODE IN " &`
42			`"AND HAS THE VALUE OF THE ACTUAL PARAMETER " &`
43			`"FOR THE OTHER MODES" );`
44
45
46			`DECLARE`
47
48			`SUBTYPE INT IS INTEGER RANGE 1 .. 5;`
49
50			`TYPE MATRIX IS ARRAY (INT RANGE <>, INT RANGE <>)`
51			`OF INTEGER;`
52
53			`TYPE SQUARE (SIDE : INT := 1) IS`
54			`RECORD`
55			`MAT : MATRIX (1 .. SIDE, 1 .. SIDE);`
56			`END RECORD;`
57
58			`SC : CONSTANT SQUARE := (2, ((0, 0), (0, 0)));`
59
60			`AC : SQUARE (2) := (2, ((1, 2), (3, 4)));`
61			`AU : SQUARE := (SIDE => 1, MAT => (1 => (1 => 1)));`
62
63			`BC : SQUARE (2) := AC;`
64			`BU : SQUARE := AU;`
65
66			`CC : SQUARE (2);`
67			`CU : SQUARE;`
68
69			`PROCEDURE P (CON, IN_CON : IN SQUARE;`
70			`INOUT_CON : IN OUT SQUARE;`
71			`OUT_CON : OUT SQUARE;`
72			`IN_UNC : IN SQUARE;`
73			`INOUT_UNC : IN OUT SQUARE;`
74			`OUT_UNC : OUT SQUARE) IS`
75
76			`BEGIN`
77			`IF CON'CONSTRAINED THEN`
78			`NULL;`
79			`ELSE`
80			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &`
81			`"OF IN MODE - 1" );`
82			`END IF;`
83
84			`IF IN_CON'CONSTRAINED THEN`
85			`NULL;`
86			`ELSE`
87			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &`
88			`"OF IN MODE - 2" );`
89			`END IF;`
90
91			`IF IN_UNC'CONSTRAINED THEN`
92			`NULL;`
93			`ELSE`
94			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &`
95			`"OF IN MODE - 3" );`
96			`END IF;`
97
98			`IF INOUT_CON'CONSTRAINED THEN`
99			`NULL;`
100			`ELSE`
101			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &`
102			`"CONSTRAINED OBJECT OF IN OUT MODE - 1" );`
103			`END IF;`
104
105			`IF OUT_CON'CONSTRAINED THEN`
106			`NULL;`
107			`ELSE`
108			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &`
109			`"CONSTRAINED OBJECT OF OUT MODE - 1" );`
110			`END IF;`
111
112			`IF INOUT_UNC'CONSTRAINED THEN`
113			`FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &`
114			`"UNCONSTRAINED OBJECT OF IN OUT MODE " &`
115			`"- 1" );`
116			`END IF;`
117
118			`IF OUT_UNC'CONSTRAINED THEN`
119			`FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &`
120			`"UNCONSTRAINED OBJECT OF OUT MODE - 1" );`
121			`END IF;`
122
123			`OUT_CON := (2, ((1, 2), (3, 4)));`
124			`OUT_UNC := (2, ((1, 2), (3, 4)));`
125			`END P;`
126
127			`TASK T IS`
128			`ENTRY Q (CON, IN_CON : IN SQUARE;`
129			`INOUT_CON : IN OUT SQUARE;`
130			`OUT_CON : OUT SQUARE;`
131			`IN_UNC : IN SQUARE;`
132			`INOUT_UNC : IN OUT SQUARE;`
133			`OUT_UNC : OUT SQUARE);`
134			`END T;`
135
136			`TASK BODY T IS`
137			`BEGIN`
138			`ACCEPT Q (CON, IN_CON : IN SQUARE;`
139			`INOUT_CON : IN OUT SQUARE;`
140			`OUT_CON : OUT SQUARE;`
141			`IN_UNC : IN SQUARE;`
142			`INOUT_UNC : IN OUT SQUARE;`
143			`OUT_UNC : OUT SQUARE) DO`
144			`BEGIN`
145			`IF CON'CONSTRAINED THEN`
146			`NULL;`
147			`ELSE`
148			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &`
149			`"OBJECT OF IN MODE - 4" );`
150			`END IF;`
151
152			`IF IN_CON'CONSTRAINED THEN`
153			`NULL;`
154			`ELSE`
155			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &`
156			`"OBJECT OF IN MODE - 5" );`
157			`END IF;`
158
159			`IF IN_UNC'CONSTRAINED THEN`
160			`NULL;`
161			`ELSE`
162			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &`
163			`"OBJECT OF IN MODE - 6" );`
164			`END IF;`
165
166			`IF INOUT_CON'CONSTRAINED THEN`
167			`NULL;`
168			`ELSE`
169			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &`
170			`"CONSTRAINED OBJECT OF " &`
171			`"IN OUT MODE - 2" );`
172			`END IF;`
173
174			`IF OUT_CON'CONSTRAINED THEN`
175			`NULL;`
176			`ELSE`
177			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &`
178			`"CONSTRAINED OBJECT OF " &`
179			`"OUT MODE - 2" );`
180			`END IF;`
181
182			`IF INOUT_UNC'CONSTRAINED THEN`
183			`FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &`
184			`"UNCONSTRAINED OBJECT OF " &`
185			`"IN OUT MODE - 2" );`
186			`END IF;`
187
188			`IF OUT_UNC'CONSTRAINED THEN`
189			`FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &`
190			`"UNCONSTRAINED OBJECT OF " &`
191			`"OUT MODE - 2" );`
192			`END IF;`
193
194			`OUT_CON := (2, ((1, 2), (3, 4)));`
195			`OUT_UNC := (2, ((1, 2), (3, 4)));`
196			`END;`
197			`END Q;`
198			`END T;`
199
200			`GENERIC`
201			`CON, IN_CON : IN SQUARE;`
202			`INOUT_CON : IN OUT SQUARE;`
203			`IN_UNC : IN SQUARE;`
204			`INOUT_UNC : IN OUT SQUARE;`
205			`PACKAGE R IS END R;`
206
207			`PACKAGE BODY R IS`
208			`BEGIN`
209			`IF CON'CONSTRAINED THEN`
210			`NULL;`
211			`ELSE`
212			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &`
213			`"OF IN MODE - 7" );`
214			`END IF;`
215
216			`IF IN_CON'CONSTRAINED THEN`
217			`NULL;`
218			`ELSE`
219			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &`
220			`"OF IN MODE - 8" );`
221			`END IF;`
222
223			`IF IN_UNC'CONSTRAINED THEN`
224			`NULL;`
225			`ELSE`
226			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " &`
227			`"OF IN MODE - 9" );`
228			`END IF;`
229
230			`IF INOUT_CON'CONSTRAINED THEN`
231			`NULL;`
232			`ELSE`
233			`FAILED ( "'CONSTRAINED IS 'FALSE' FOR " &`
234			`"CONSTRAINED OBJECT OF IN OUT MODE - 3" );`
235			`END IF;`
236
237			`IF INOUT_UNC'CONSTRAINED THEN`
238			`FAILED ( "'CONSTRAINED IS 'TRUE' FOR " &`
239			`"UNCONSTRAINED OBJECT OF IN OUT MODE " &`
240			`"- 3" );`
241			`END IF;`
242
243			`END R;`
244
245			`PACKAGE S IS NEW R (SC, AC, BC, AU, BU);`
246
247			`BEGIN`
248			`P (SC, AC, BC, CC, AU, BU, CU);`
249			`T.Q (SC, AC, BC, CC, AU, BU, CU);`
250			`END;`
251
252			`RESULT;`
253			`END C37402A;`