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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c41307d.ada] - Blame information for rev 12

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner
-- C41307D.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 L.R IS ALLOWED INSIDE A PACKAGE, GENERIC PACKAGE,
26
-- SUBPROGRAM, GENERIC SUBPROGRAM, TASK, BLOCK, LOOP, OR AN ACCEPT
27
-- STATEMENT NAMED L, IF R IS DECLARED INSIDE THE UNIT.
28
 
29
-- TBN 12/15/86
30
 
31
WITH REPORT; USE REPORT;
32
PROCEDURE C41307D IS
33
 
34
BEGIN
35
     TEST ("C41307D", "CHECK THAT L.R IS ALLOWED INSIDE A PACKAGE, " &
36
                      "GENERIC PACKAGE, SUBPROGRAM, GENERIC " &
37
                      "SUBPROGRAM, TASK, BLOCK, LOOP, OR AN ACCEPT " &
38
                      "STATEMENT NAMED L, IF R IS DECLARED INSIDE " &
39
                      "THE UNIT");
40
     DECLARE
41
          PACKAGE L IS
42
               R : INTEGER := 5;
43
               A : INTEGER := L.R;
44
          END L;
45
 
46
          PACKAGE BODY L IS
47
               B : INTEGER := L.R + 1;
48
          BEGIN
49
               IF IDENT_INT(A) /= 5 OR IDENT_INT(B) /= 6 THEN
50
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
51
               END IF;
52
          END L;
53
 
54
          GENERIC
55
               S : INTEGER;
56
          PACKAGE M IS
57
               X : INTEGER := M.S;
58
          END M;
59
 
60
          PACKAGE BODY M IS
61
               Y : INTEGER := M.S + 1;
62
          BEGIN
63
               IF IDENT_INT(X) /= 2 OR
64
                  IDENT_INT(Y) /= 3 OR
65
                  IDENT_INT(M.X) /= 2 THEN
66
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
67
               END IF;
68
          END M;
69
 
70
          PACKAGE Q IS NEW M(2);
71
     BEGIN
72
          IF IDENT_INT(Q.X) /= 2 THEN
73
               FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
74
          END IF;
75
     END;
76
     -------------------------------------------------------------------
77
 
78
     DECLARE
79
          CH : CHARACTER := '6';
80
 
81
          PROCEDURE L (R : IN OUT CHARACTER) IS
82
               A : CHARACTER := L.R;
83
          BEGIN
84
               IF IDENT_CHAR(L.A) /= '6' THEN
85
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
86
               END IF;
87
               L.R := IDENT_CHAR('7');
88
          END L;
89
 
90
          GENERIC
91
               S : CHARACTER;
92
          PROCEDURE M;
93
 
94
          PROCEDURE M IS
95
               T : CHARACTER := M.S;
96
          BEGIN
97
               IF IDENT_CHAR(T) /= '3' OR IDENT_CHAR(M.S) /= '3' THEN
98
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
99
               END IF;
100
          END M;
101
 
102
          PROCEDURE P1 IS NEW M('3');
103
 
104
     BEGIN
105
          L (CH);
106
          IF CH /= IDENT_CHAR('7') THEN
107
               FAILED ("INCORRECT RESULTS RETURNED FROM PROCEDURE - 6");
108
          END IF;
109
          P1;
110
     END;
111
     -------------------------------------------------------------------
112
 
113
     DECLARE
114
          INT : INTEGER := 3;
115
 
116
          FUNCTION L (R : INTEGER) RETURN INTEGER IS
117
               A : INTEGER := L.R;
118
          BEGIN
119
               IF IDENT_INT(L.A) /= IDENT_INT(3) THEN
120
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
121
               END IF;
122
               RETURN IDENT_INT(4);
123
          END L;
124
 
125
          GENERIC
126
               S : INTEGER;
127
          FUNCTION M RETURN INTEGER;
128
 
129
          FUNCTION M RETURN INTEGER IS
130
               T : INTEGER := M.S;
131
          BEGIN
132
               IF IDENT_INT(M.T) /= 4 OR M.S /= IDENT_INT(4) THEN
133
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
134
               END IF;
135
               RETURN IDENT_INT(1);
136
          END M;
137
 
138
          FUNCTION F1 IS NEW M(4);
139
 
140
     BEGIN
141
          IF L(INT) /= 4 OR F1 /= 1 THEN
142
               FAILED ("INCORRECT RESULTS RETURNED FROM FUNCTION - 9");
143
          END IF;
144
     END;
145
     -------------------------------------------------------------------
146
 
147
     DECLARE
148
          TASK L IS
149
               ENTRY E (A : INTEGER);
150
          END L;
151
 
152
          TASK TYPE M IS
153
               ENTRY E1 (A : INTEGER);
154
          END M;
155
 
156
          T1 : M;
157
 
158
          TASK BODY L IS
159
               X : INTEGER := IDENT_INT(1);
160
               R : INTEGER RENAMES X;
161
               Y : INTEGER := L.R;
162
          BEGIN
163
               X := X + L.R;
164
               IF X /= IDENT_INT(2) OR Y /= IDENT_INT(1) THEN
165
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - " &
166
                            "10");
167
               END IF;
168
          END L;
169
 
170
          TASK BODY M IS
171
               X : INTEGER := IDENT_INT(2);
172
               R : INTEGER RENAMES X;
173
               Y : INTEGER := M.R;
174
          BEGIN
175
               ACCEPT E1 (A : INTEGER) DO
176
                    X := X + M.R;
177
                    IF X /= IDENT_INT(4) OR Y /= IDENT_INT(2) THEN
178
                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
179
                                 "NAME - 11");
180
                    END IF;
181
                    IF E1.A /= IDENT_INT(3) THEN
182
                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
183
                                 "NAME - 12");
184
                    END IF;
185
               END E1;
186
          END M;
187
     BEGIN
188
          T1.E1 (3);
189
     END;
190
     -------------------------------------------------------------------
191
 
192
     DECLARE
193
          TASK T IS
194
               ENTRY G (1..2) (A : INTEGER);
195
          END T;
196
 
197
          TASK BODY T IS
198
          BEGIN
199
               ACCEPT G (1) (A : INTEGER) DO
200
                    IF G.A /= IDENT_INT(2) THEN
201
                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
202
                                 "NAME - 13");
203
                    END IF;
204
                    BLK:
205
                         DECLARE
206
                              B : INTEGER := 7;
207
                         BEGIN
208
                              IF T.BLK.B /= IDENT_INT(7) THEN
209
                                   FAILED ("INCORRECT RESULTS FROM " &
210
                                           "EXPANDED NAME - 14");
211
                              END IF;
212
                         END BLK;
213
               END G;
214
               ACCEPT G (2) (A : INTEGER) DO
215
                    IF G.A /= IDENT_INT(1) THEN
216
                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
217
                                 "NAME - 15");
218
                    END IF;
219
               END G;
220
          END T;
221
     BEGIN
222
          T.G (1) (2);
223
          T.G (2) (1);
224
     END;
225
     -------------------------------------------------------------------
226
 
227
     SWAP:
228
          DECLARE
229
               VAR : CHARACTER := '*';
230
               RENAME_VAR : CHARACTER RENAMES VAR;
231
               NEW_VAR : CHARACTER;
232
          BEGIN
233
               IF EQUAL (3, 3) THEN
234
                    NEW_VAR := SWAP.RENAME_VAR;
235
               END IF;
236
               IF NEW_VAR /= IDENT_CHAR('*') THEN
237
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - " &
238
                            "16");
239
               END IF;
240
               LP:  FOR I IN 1..2 LOOP
241
                         IF SWAP.LP.I = IDENT_INT(2) OR
242
                            LP.I = IDENT_INT(1) THEN
243
                              GOTO SWAP.LAB1;
244
                         END IF;
245
                         NEW_VAR := IDENT_CHAR('+');
246
                         <<LAB1>>
247
                         NEW_VAR := IDENT_CHAR('-');
248
                    END LOOP LP;
249
               IF NEW_VAR /= IDENT_CHAR('-') THEN
250
                    FAILED ("INCORRECT RESULTS FROM FOR LOOP - 17");
251
               END IF;
252
          END SWAP;
253
 
254
     RESULT;
255
END C41307D;

powered by: WebSVN 2.1.0

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