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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C95087B.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 ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
26
--   RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT DEFAULT
27
--   CONSTRAINTS RAISE CONSTRAINT_ERROR IF AN ATTEMPT IS MADE TO CHANGE
28
--   THE CONSTRAINT OF THE ACTUAL PARAMETER.
29
--   SUBTESTS ARE:
30
--        (A) RECORD TYPE.
31
--        (B) PRIVATE TYPE.
32
--        (C) LIMITED PRIVATE TYPE.
33
 
34
-- RJW  1/10/86
35
 
36
WITH REPORT; USE REPORT;
37
PROCEDURE C95087B IS
38
 
39
BEGIN
40
 
41
     TEST ( "C95087B", "CHECK ASSIGNMENT TO ENTRY FORMAL PARAMETERS " &
42
                       "OF UNCONSTRAINED TYPE (WITH NO DEFAULT)" );
43
 
44
     --------------------------------------------------
45
 
46
     DECLARE  -- (A)
47
 
48
          PACKAGE PKG IS
49
 
50
               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
51
                    RECORD
52
                         INTFIELD  : INTEGER;
53
                         STRFIELD  : STRING (1..CONSTRAINT);
54
                    END RECORD;
55
 
56
               TASK T IS
57
                    ENTRY E (REC9 : OUT RECTYPE;
58
                             REC6 : IN OUT RECTYPE);
59
               END T;
60
 
61
          END PKG;
62
 
63
          REC9 : PKG.RECTYPE(IDENT_INT(9))    :=
64
                 (IDENT_INT(9), 9, "123456789");
65
          REC6 : PKG.RECTYPE(IDENT_INT(6))    :=
66
                 (IDENT_INT(6), 5, "AEIOUY");
67
 
68
          PACKAGE BODY PKG IS
69
 
70
               TASK BODY T IS
71
 
72
                    REC4 : CONSTANT RECTYPE(IDENT_INT(4)) :=
73
                           (IDENT_INT(4), 4, "OOPS");
74
 
75
               BEGIN
76
                    ACCEPT E (REC9 : OUT RECTYPE;
77
                              REC6 : IN OUT RECTYPE) DO
78
 
79
                         BEGIN  -- (A.1)
80
                              REC9 := REC6;
81
                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
82
                                      "- A.1");
83
                         EXCEPTION
84
                              WHEN CONSTRAINT_ERROR =>
85
                                   NULL;
86
                              WHEN OTHERS =>
87
                                   FAILED ("WRONG EXCEPTION RAISED " &
88
                                           "- A.1");
89
                         END;   -- (A.1)
90
 
91
                         BEGIN  -- (A.2)
92
                              REC6 := REC4;
93
                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
94
                                      "- A.2");
95
                         EXCEPTION
96
                              WHEN CONSTRAINT_ERROR =>
97
                                   NULL;
98
                              WHEN OTHERS =>
99
                                   FAILED ("WRONG EXCEPTION RAISED " &
100
                                           "- A.2");
101
                         END;   -- (A.2)
102
 
103
                         REC9 := (IDENT_INT(9), 9, "987654321");
104
 
105
                    END E;
106
               END T;
107
          END PKG;
108
 
109
     BEGIN  -- (A)
110
 
111
          PKG.T.E (REC9, REC6);
112
 
113
          IF REC9.STRFIELD /= IDENT_STR("987654321") THEN
114
               FAILED ("ASSIGNMENT TO REC9 FAILED - (A)");
115
          END IF;
116
 
117
     END;   -- (A)
118
 
119
     --------------------------------------------------
120
 
121
     DECLARE  -- (B)
122
 
123
          PACKAGE PKG IS
124
 
125
               TYPE RECTYPE (CONSTRAINT : INTEGER) IS PRIVATE;
126
 
127
               TASK T IS
128
                    ENTRY  E (REC9 : OUT RECTYPE;
129
                              REC6 : IN OUT RECTYPE);
130
               END T;
131
 
132
          PRIVATE
133
               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
134
                    RECORD
135
                         INTFIELD  : INTEGER;
136
                         STRFIELD  : STRING (1..CONSTRAINT);
137
                    END RECORD;
138
          END PKG;
139
 
140
          REC9 : PKG.RECTYPE(9);
141
          REC6 : PKG.RECTYPE(6);
142
 
143
          PACKAGE BODY PKG IS
144
 
145
               TASK BODY T IS
146
 
147
                    REC4 : CONSTANT RECTYPE(4) := (4, 4, "OOPS");
148
 
149
               BEGIN
150
                    ACCEPT E (REC9 : OUT RECTYPE;
151
                              REC6 : IN OUT RECTYPE) DO
152
 
153
                         BEGIN  -- (B.1)
154
                              REC9 := REC6;
155
                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
156
                                      "- B.1");
157
                         EXCEPTION
158
                              WHEN CONSTRAINT_ERROR =>
159
                                   NULL;
160
                              WHEN OTHERS =>
161
                                   FAILED ("WRONG EXCEPTION RAISED " &
162
                                           "- B.1");
163
                         END;   -- (B.1)
164
 
165
                         BEGIN  -- (B.2)
166
                              REC6 := REC4;
167
                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
168
                                      "- B.2");
169
                         EXCEPTION
170
                              WHEN CONSTRAINT_ERROR =>
171
                                   NULL;
172
                              WHEN OTHERS =>
173
                                   FAILED ("WRONG EXCEPTION RAISED " &
174
                                           "- B.2");
175
                         END;   -- (B.2)
176
 
177
                    END E;
178
               END T;
179
 
180
          BEGIN
181
               REC9 := (9, 9, "123456789");
182
               REC6 := (6, 5, "AEIOUY");
183
          END PKG;
184
 
185
     BEGIN  -- (B)
186
 
187
          PKG.T.E (REC9, REC6);
188
 
189
     END;   -- (B)
190
 
191
     --------------------------------------------------
192
 
193
     DECLARE  -- (C)
194
 
195
          PACKAGE PKG IS
196
 
197
               TYPE RECTYPE (CONSTRAINT : INTEGER) IS LIMITED PRIVATE;
198
 
199
               TASK T IS
200
                    ENTRY  E (REC9 : OUT RECTYPE;
201
                              REC6 : IN OUT RECTYPE);
202
               END T;
203
 
204
          PRIVATE
205
               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
206
                    RECORD
207
                         INTFIELD  : INTEGER;
208
                         STRFIELD  : STRING (1..CONSTRAINT);
209
                    END RECORD;
210
          END PKG;
211
 
212
          REC6 : PKG.RECTYPE(IDENT_INT(6));
213
          REC9 : PKG.RECTYPE(IDENT_INT(9));
214
 
215
          PACKAGE BODY PKG IS
216
 
217
               TASK BODY T IS
218
 
219
                    REC4 : CONSTANT RECTYPE(4) := (4, 4, "OOPS");
220
 
221
               BEGIN
222
                    ACCEPT E (REC9 : OUT RECTYPE;
223
                              REC6 : IN OUT RECTYPE) DO
224
 
225
                         BEGIN  -- (C.1)
226
                              REC9 := REC6;
227
                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
228
                                      "- C.1");
229
                         EXCEPTION
230
                              WHEN CONSTRAINT_ERROR =>
231
                                   NULL;
232
                              WHEN OTHERS =>
233
                                   FAILED ("WRONG EXCEPTION RAISED " &
234
                                           "- C.1");
235
                         END;   -- (C.1)
236
 
237
                         BEGIN  -- (C.2)
238
                              REC6 := REC4;
239
                              FAILED ("CONSTRAINT_ERROR NOT RAISED " &
240
                                      "- C.2");
241
                         EXCEPTION
242
                              WHEN CONSTRAINT_ERROR =>
243
                                   NULL;
244
                              WHEN OTHERS =>
245
                                   FAILED ("WRONG EXCEPTION RAISED " &
246
                                           "- C.2");
247
                         END;   -- (C.2)
248
 
249
                    END E;
250
               END T;
251
 
252
          BEGIN
253
               REC6 := (6, 5, "AEIOUY");
254
               REC9 := (9, 9, "123456789");
255
          END PKG;
256
 
257
     BEGIN  -- (C)
258
 
259
          PKG.T.E (REC9, REC6);
260
 
261
     END;   -- (C)
262
 
263
     --------------------------------------------------
264
 
265
     RESULT;
266
 
267
END C95087B;

powered by: WebSVN 2.1.0

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