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/] [c61010a.ada] - Blame information for rev 149

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

Line No. Rev Author Line
1 149 jeremybenn
-- C61010A.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 AN IN OR IN OUT FORMAL PARAMETER CAN BE DECLARED WITH A
26
-- LIMITED PRIVATE TYPE OR A LIMITED COMPOSITE TYPE.
27
 
28
-- DAS  1/22/81
29
-- JRK  1/20/84  TOTALLY REVISED.
30
 
31
WITH REPORT; USE REPORT;
32
PROCEDURE C61010A IS
33
 
34
     PACKAGE PKG IS
35
 
36
          TYPE ITYPE IS LIMITED PRIVATE;
37
 
38
          PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
39
 
40
          PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
41
                                  M : STRING);
42
 
43
          PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER);
44
 
45
          SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
46
          TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
47
 
48
          PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
49
                                S : STRING; M : STRING);
50
 
51
          PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
52
                                   I : INTEGER; S : STRING;
53
                                   M : STRING);
54
 
55
          PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;
56
                            S : STRING);
57
 
58
     PRIVATE
59
 
60
          TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
61
 
62
          TYPE VRTYPE (C : INT_0_20 := 20) IS
63
               RECORD
64
                    I : INTEGER;
65
                    S : STRING (1 .. C);
66
               END RECORD;
67
 
68
     END PKG;
69
 
70
     USE PKG;
71
 
72
     I1 : ITYPE;
73
 
74
     TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
75
 
76
     A1 : ATYPE;
77
 
78
     VR1 : VRTYPE;
79
 
80
     D : CONSTANT INT_0_20 := 10;
81
 
82
     TYPE RTYPE IS
83
          RECORD
84
               J : ITYPE;
85
               R : VRTYPE (D);
86
          END RECORD;
87
 
88
     R1 : RTYPE;
89
 
90
     PACKAGE BODY PKG IS
91
 
92
          PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS
93
          BEGIN
94
               IF INTEGER (X) /= V THEN
95
                    FAILED ("WRONG SCALAR VALUE - " & M);
96
               END IF;
97
          END LOOK_IN_I;
98
 
99
          PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
100
                                  M : STRING) IS
101
          BEGIN
102
               IF INTEGER (X) /= V THEN
103
                    FAILED ("WRONG SCALAR VALUE - " & M);
104
               END IF;
105
          END LOOK_INOUT_I;
106
 
107
          PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER) IS
108
          BEGIN
109
               X := ITYPE (IDENT_INT (V));
110
          END SET_I;
111
 
112
          PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
113
                                S : STRING; M : STRING) IS
114
          BEGIN
115
               IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN
116
                    FAILED ("WRONG COMPOSITE VALUE - " & M);
117
               END IF;
118
          END LOOK_IN_VR;
119
 
120
          PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
121
                                   I : INTEGER; S : STRING;
122
                                   M : STRING) IS
123
          BEGIN
124
               IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN
125
                    FAILED ("WRONG COMPOSITE VALUE - " & M);
126
               END IF;
127
          END LOOK_INOUT_VR;
128
 
129
          PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;
130
                            S : STRING) IS
131
          BEGIN
132
               X := (IDENT_INT(C), IDENT_INT(I), IDENT_STR(S));
133
          END SET_VR;
134
 
135
     BEGIN
136
          I1 := ITYPE (IDENT_INT(2));
137
 
138
          FOR I IN A1'RANGE LOOP
139
               A1 (I) := ITYPE (3 + IDENT_INT(I));
140
          END LOOP;
141
 
142
          VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
143
 
144
          R1.J := ITYPE (IDENT_INT(6));
145
          R1.R := (IDENT_INT(D), IDENT_INT(19),
146
                   IDENT_STR("ABCDEFGHIJ"));
147
     END PKG;
148
 
149
     PROCEDURE CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS
150
     BEGIN
151
          LOOK_IN_I (X, V, M);
152
     END CHECK_IN_I;
153
 
154
     PROCEDURE CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
155
                              NV : INTEGER; M : STRING) IS
156
     BEGIN
157
          LOOK_INOUT_I (X, OV, M & " - A");
158
          SET_I (X, NV);
159
          LOOK_INOUT_I (X, NV, M & " - B");
160
          LOOK_IN_I (X, NV, M & " - C");
161
     END CHECK_INOUT_I;
162
 
163
     PROCEDURE CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) IS
164
     BEGIN
165
          FOR I IN X'RANGE LOOP
166
               LOOK_IN_I (X(I), V+I, M & " -" & INTEGER'IMAGE (I));
167
          END LOOP;
168
     END CHECK_IN_A;
169
 
170
     PROCEDURE CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
171
                              NV : INTEGER; M : STRING) IS
172
     BEGIN
173
          FOR I IN X'RANGE LOOP
174
               LOOK_INOUT_I (X(I), OV+I, M & " - A" &
175
                                         INTEGER'IMAGE (I));
176
               SET_I (X(I), NV+I);
177
               LOOK_INOUT_I (X(I), NV+I, M & " - B" &
178
                                         INTEGER'IMAGE (I));
179
               LOOK_IN_I (X(I), NV+I, M & " - C" & INTEGER'IMAGE (I));
180
          END LOOP;
181
     END CHECK_INOUT_A;
182
 
183
     PROCEDURE CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
184
                            S : STRING; M : STRING) IS
185
     BEGIN
186
          LOOK_IN_VR (X, C, I, S, M);
187
     END CHECK_IN_VR;
188
 
189
     PROCEDURE CHECK_INOUT_VR (X : IN OUT VRTYPE;
190
                               OC : INTEGER; OI : INTEGER; OS : STRING;
191
                               NC : INTEGER; NI : INTEGER; NS : STRING;
192
                               M : STRING) IS
193
     BEGIN
194
          LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");
195
          SET_VR (X, NC, NI, NS);
196
          LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");
197
          LOOK_IN_VR (X, NC, NI, NS, M & " - C");
198
     END CHECK_INOUT_VR;
199
 
200
     PROCEDURE CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
201
                           I : INTEGER; S : STRING; M : STRING) IS
202
     BEGIN
203
          LOOK_IN_I (X.J, J, M & " - A");
204
          LOOK_IN_VR (X.R, C, I, S, M & " - B");
205
     END CHECK_IN_R;
206
 
207
     PROCEDURE CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
208
                              OC : INTEGER; OI : INTEGER; OS : STRING;
209
                              NJ : INTEGER;
210
                              NC : INTEGER; NI : INTEGER; NS : STRING;
211
                              M : STRING) IS
212
     BEGIN
213
          LOOK_INOUT_I (X.J, OJ, M & " - A");
214
          LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
215
          SET_I (X.J, NJ);
216
          SET_VR (X.R, NC, NI, NS);
217
          LOOK_INOUT_I (X.J, NJ, M & " - C");
218
          LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");
219
          LOOK_IN_I (X.J, NJ, M & " - E");
220
          LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");
221
     END CHECK_INOUT_R;
222
 
223
BEGIN
224
     TEST ("C61010A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
225
                      "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
226
 
227
     CHECK_IN_I (I1, 2, "IN I");
228
 
229
     CHECK_INOUT_I (I1, 2, 5, "INOUT I");
230
 
231
     CHECK_IN_A (A1, 3, "IN A");
232
 
233
     CHECK_INOUT_A (A1, 3, 17, "INOUT A");
234
 
235
     CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
236
 
237
     CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
238
                     "INOUT VR");
239
 
240
     CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
241
 
242
     CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5, "ZYXWVUTSRQ",
243
                    "INOUT R");
244
 
245
     RESULT;
246
END C61010A;

powered by: WebSVN 2.1.0

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