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

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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