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


-- C41307D.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 L.R IS ALLOWED INSIDE A PACKAGE, GENERIC PACKAGE,
-- SUBPROGRAM, GENERIC SUBPROGRAM, TASK, BLOCK, LOOP, OR AN ACCEPT
-- STATEMENT NAMED L, IF R IS DECLARED INSIDE THE UNIT.
 
-- TBN 12/15/86
 
WITH REPORT; USE REPORT;
PROCEDURE C41307D IS
 
BEGIN
     TEST ("C41307D", "CHECK THAT L.R IS ALLOWED INSIDE A PACKAGE, " &
                      "GENERIC PACKAGE, SUBPROGRAM, GENERIC " &
                      "SUBPROGRAM, TASK, BLOCK, LOOP, OR AN ACCEPT " &
                      "STATEMENT NAMED L, IF R IS DECLARED INSIDE " &
                      "THE UNIT");
     DECLARE
          PACKAGE L IS
               R : INTEGER := 5;
               A : INTEGER := L.R;
          END L;
 
          PACKAGE BODY L IS
               B : INTEGER := L.R + 1;
          BEGIN
               IF IDENT_INT(A) /= 5 OR IDENT_INT(B) /= 6 THEN
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 1");
               END IF;
          END L;
 
          GENERIC
               S : INTEGER;
          PACKAGE M IS
               X : INTEGER := M.S;
          END M;
 
          PACKAGE BODY M IS
               Y : INTEGER := M.S + 1;
          BEGIN
               IF IDENT_INT(X) /= 2 OR
                  IDENT_INT(Y) /= 3 OR
                  IDENT_INT(M.X) /= 2 THEN
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 2");
               END IF;
          END M;
 
          PACKAGE Q IS NEW M(2);
     BEGIN
          IF IDENT_INT(Q.X) /= 2 THEN
               FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 3");
          END IF;
     END;
     -------------------------------------------------------------------
 
     DECLARE
          CH : CHARACTER := '6';
 
          PROCEDURE L (R : IN OUT CHARACTER) IS
               A : CHARACTER := L.R;
          BEGIN
               IF IDENT_CHAR(L.A) /= '6' THEN
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 4");
               END IF;
               L.R := IDENT_CHAR('7');
          END L;
 
          GENERIC
               S : CHARACTER;
          PROCEDURE M;
 
          PROCEDURE M IS
               T : CHARACTER := M.S;
          BEGIN
               IF IDENT_CHAR(T) /= '3' OR IDENT_CHAR(M.S) /= '3' THEN
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 5");
               END IF;
          END M;
 
          PROCEDURE P1 IS NEW M('3');
 
     BEGIN
          L (CH);
          IF CH /= IDENT_CHAR('7') THEN
               FAILED ("INCORRECT RESULTS RETURNED FROM PROCEDURE - 6");
          END IF;
          P1;
     END;
     -------------------------------------------------------------------
 
     DECLARE
          INT : INTEGER := 3;
 
          FUNCTION L (R : INTEGER) RETURN INTEGER IS
               A : INTEGER := L.R;
          BEGIN
               IF IDENT_INT(L.A) /= IDENT_INT(3) THEN
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 7");
               END IF;
               RETURN IDENT_INT(4);
          END L;
 
          GENERIC
               S : INTEGER;
          FUNCTION M RETURN INTEGER;
 
          FUNCTION M RETURN INTEGER IS
               T : INTEGER := M.S;
          BEGIN
               IF IDENT_INT(M.T) /= 4 OR M.S /= IDENT_INT(4) THEN
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - 8");
               END IF;
               RETURN IDENT_INT(1);
          END M;
 
          FUNCTION F1 IS NEW M(4);
 
     BEGIN
          IF L(INT) /= 4 OR F1 /= 1 THEN
               FAILED ("INCORRECT RESULTS RETURNED FROM FUNCTION - 9");
          END IF;
     END;
     -------------------------------------------------------------------
 
     DECLARE
          TASK L IS
               ENTRY E (A : INTEGER);
          END L;
 
          TASK TYPE M IS
               ENTRY E1 (A : INTEGER);
          END M;
 
          T1 : M;
 
          TASK BODY L IS
               X : INTEGER := IDENT_INT(1);
               R : INTEGER RENAMES X;
               Y : INTEGER := L.R;
          BEGIN
               X := X + L.R;
               IF X /= IDENT_INT(2) OR Y /= IDENT_INT(1) THEN
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - " &
                            "10");
               END IF;
          END L;
 
          TASK BODY M IS
               X : INTEGER := IDENT_INT(2);
               R : INTEGER RENAMES X;
               Y : INTEGER := M.R;
          BEGIN
               ACCEPT E1 (A : INTEGER) DO
                    X := X + M.R;
                    IF X /= IDENT_INT(4) OR Y /= IDENT_INT(2) THEN
                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
                                 "NAME - 11");
                    END IF;
                    IF E1.A /= IDENT_INT(3) THEN
                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
                                 "NAME - 12");
                    END IF;
               END E1;
          END M;
     BEGIN
          T1.E1 (3);
     END;
     -------------------------------------------------------------------
 
     DECLARE
          TASK T IS
               ENTRY G (1..2) (A : INTEGER);
          END T;
 
          TASK BODY T IS
          BEGIN
               ACCEPT G (1) (A : INTEGER) DO
                    IF G.A /= IDENT_INT(2) THEN
                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
                                 "NAME - 13");
                    END IF;
                    BLK:
                         DECLARE
                              B : INTEGER := 7;
                         BEGIN
                              IF T.BLK.B /= IDENT_INT(7) THEN
                                   FAILED ("INCORRECT RESULTS FROM " &
                                           "EXPANDED NAME - 14");
                              END IF;
                         END BLK;
               END G;
               ACCEPT G (2) (A : INTEGER) DO
                    IF G.A /= IDENT_INT(1) THEN
                         FAILED ("INCORRECT RESULTS FROM EXPANDED " &
                                 "NAME - 15");
                    END IF;
               END G;
          END T;
     BEGIN
          T.G (1) (2);
          T.G (2) (1);
     END;
     -------------------------------------------------------------------
 
     SWAP:
          DECLARE
               VAR : CHARACTER := '*';
               RENAME_VAR : CHARACTER RENAMES VAR;
               NEW_VAR : CHARACTER;
          BEGIN
               IF EQUAL (3, 3) THEN
                    NEW_VAR := SWAP.RENAME_VAR;
               END IF;
               IF NEW_VAR /= IDENT_CHAR('*') THEN
                    FAILED ("INCORRECT RESULTS FROM EXPANDED NAME - " &
                            "16");
               END IF;
               LP:  FOR I IN 1..2 LOOP
                         IF SWAP.LP.I = IDENT_INT(2) OR
                            LP.I = IDENT_INT(1) THEN
                              GOTO SWAP.LAB1;
                         END IF;
                         NEW_VAR := IDENT_CHAR('+');
                         <<LAB1>>
                         NEW_VAR := IDENT_CHAR('-');
                    END LOOP LP;
               IF NEW_VAR /= IDENT_CHAR('-') THEN
                    FAILED ("INCORRECT RESULTS FROM FOR LOOP - 17");
               END IF;
          END SWAP;
 
     RESULT;
END C41307D;

Browse

Tools

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

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;`