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/] [c9/] [c95071a.ada] - Blame information for rev 12

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner
-- C95071A.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 OBJECTS DESIGNATED BY IN PARAMETERS OF ACCESS TYPES CAN
26
-- BE USED AS THE TARGET OF AN ASSIGNMENT STATEMENT AND AS AN ACTUAL
27
-- PARAMETER OF ANY MODE.  SUBTESTS ARE:
28
--        (A) INTEGER ACCESS TYPE.
29
--        (B) ARRAY ACCESS TYPE.
30
--        (C) RECORD ACCESS TYPE.
31
 
32
-- JWC 7/11/85
33
 
34
WITH REPORT; USE REPORT;
35
PROCEDURE C95071A IS
36
 
37
BEGIN
38
 
39
     TEST ("C95071A", "CHECK THAT COMPONENTS OF ACCESS IN PARAMETERS " &
40
                      "MAY BE USED IN ASSIGNMENT CONTEXTS");
41
 
42
     --------------------------------------------------
43
 
44
     DECLARE   -- (A)
45
 
46
          TYPE PTRINT IS ACCESS INTEGER;
47
          PI : PTRINT;
48
 
49
          TASK TA IS
50
               ENTRY EA (PI : IN PTRINT);
51
          END TA;
52
 
53
          TASK BODY TA IS
54
          BEGIN
55
               ACCEPT EA (PI : IN PTRINT) DO
56
                    DECLARE
57
                         TASK TA1 IS
58
                              ENTRY EA1 (I : OUT INTEGER);
59
                              ENTRY EA2 (I : IN OUT INTEGER);
60
                         END TA1;
61
 
62
                         TASK BODY TA1 IS
63
                         BEGIN
64
                              ACCEPT EA1 (I : OUT INTEGER) DO
65
                                   I := 7;
66
                              END EA1;
67
 
68
                              ACCEPT EA2 (I : IN OUT INTEGER) DO
69
                                   I := I + 1;
70
                              END EA2;
71
                         END TA1;
72
 
73
                    BEGIN
74
                         TA1.EA1 (PI.ALL);
75
                         TA1.EA2 (PI.ALL);
76
                         PI.ALL := PI.ALL + 1;
77
                         IF (PI.ALL /= 9) THEN
78
                              FAILED ("ASSIGNMENT TO COMPONENT OF " &
79
                                      "INTEGER ACCESS PARAMETER " &
80
                                      "FAILED");
81
                         END IF;
82
                    END;
83
               END EA;
84
          END TA;
85
 
86
     BEGIN     -- (A)
87
 
88
          PI := NEW INTEGER'(0);
89
          TA.EA (PI);
90
 
91
     END;      -- (A)
92
 
93
     ---------------------------------------------
94
 
95
     DECLARE   -- (B)
96
 
97
          TYPE TBL IS ARRAY (1..3) OF INTEGER;
98
          TYPE PTRTBL IS ACCESS TBL;
99
          PT : PTRTBL;
100
 
101
          TASK TB IS
102
               ENTRY EB (PT : IN PTRTBL);
103
          END TB;
104
 
105
          TASK BODY TB IS
106
          BEGIN
107
               ACCEPT EB (PT : IN PTRTBL) DO
108
                    DECLARE
109
                         TASK TB1 IS
110
                              ENTRY EB1 (T : OUT TBL);
111
                              ENTRY EB2 (T : IN OUT TBL);
112
                              ENTRY EB3 (I : OUT INTEGER);
113
                              ENTRY EB4 (I : IN OUT INTEGER);
114
                         END TB1;
115
 
116
                         TASK BODY TB1 IS
117
                         BEGIN
118
                              ACCEPT EB1 (T : OUT TBL) DO
119
                                   T := (1,2,3);
120
                              END EB1;
121
 
122
                              ACCEPT EB2 (T : IN OUT TBL) DO
123
                                   T(3) := T(3) - 1;
124
                              END EB2;
125
 
126
                              ACCEPT EB3 (I : OUT INTEGER) DO
127
                                   I := 7;
128
                              END EB3;
129
 
130
                              ACCEPT EB4 (I : IN OUT INTEGER) DO
131
                                   I := I + 1;
132
                              END EB4;
133
                         END TB1;
134
 
135
                    BEGIN
136
                         TB1.EB1 (PT.ALL);         -- (1,2,3)
137
                         TB1.EB2 (PT.ALL);         -- (1,2,2)
138
                         TB1.EB3 (PT(2));          -- (1,7,2)
139
                         TB1.EB4 (PT(1));          -- (2,7,2)
140
                         PT(3) := PT(3) + 7;      -- (2,7,9)
141
                         IF (PT.ALL /= (2,7,9)) THEN
142
                              FAILED ("ASSIGNMENT TO COMPONENT OF " &
143
                                      "ARRAY ACCESS PARAMETER FAILED");
144
                         END IF;
145
                    END;
146
               END EB;
147
          END TB;
148
 
149
     BEGIN     -- (B)
150
 
151
          PT := NEW TBL'(0,0,0);
152
          TB.EB (PT);
153
 
154
     END;      -- (B)
155
 
156
     ---------------------------------------------
157
 
158
     DECLARE   -- (C)
159
 
160
          TYPE REC IS
161
               RECORD
162
                    I1   : INTEGER;
163
                    I2   : INTEGER;
164
                    I3   : INTEGER;
165
               END RECORD;
166
 
167
          TYPE PTRREC IS ACCESS REC;
168
          PR : PTRREC;
169
 
170
          TASK TC IS
171
               ENTRY EC (PR : IN PTRREC);
172
          END TC;
173
 
174
          TASK BODY TC IS
175
          BEGIN
176
               ACCEPT EC (PR : IN PTRREC) DO
177
                    DECLARE
178
                         TASK TC1 IS
179
                              ENTRY EC1 (R : OUT REC);
180
                              ENTRY EC2 (R : IN OUT REC);
181
                              ENTRY EC3 (I : OUT INTEGER);
182
                              ENTRY EC4 (I : IN OUT INTEGER);
183
                         END TC1;
184
 
185
                         TASK BODY TC1 IS
186
                         BEGIN
187
                              ACCEPT EC1 (R : OUT REC) DO
188
                                   R := (1,2,3);
189
                              END EC1;
190
 
191
                              ACCEPT EC2 (R : IN OUT REC) DO
192
                                   R.I3 := R.I3 - 1;
193
                              END EC2;
194
 
195
                              ACCEPT EC3 (I : OUT INTEGER) DO
196
                                   I := 7;
197
                              END  EC3;
198
 
199
                              ACCEPT EC4 (I : IN OUT INTEGER) DO
200
                                   I := I + 1;
201
                              END EC4;
202
                         END TC1;
203
 
204
                    BEGIN
205
                         TC1.EC1 (PR.ALL);         -- (1,2,3)
206
                         TC1.EC2 (PR.ALL);         -- (1,2,2)
207
                         TC1.EC3 (PR.I2);          -- (1,7,2)
208
                         TC1.EC4 (PR.I1);          -- (2,7,2)
209
                         PR.I3 := PR.I3 + 7;       -- (2,7,9)
210
                         IF (PR.ALL /= (2,7,9)) THEN
211
                              FAILED ("ASSIGNMENT TO COMPONENT OF " &
212
                                      "RECORD ACCESS PARAMETER " &
213
                                      "FAILED");
214
                         END IF;
215
                    END;
216
               END EC;
217
          END TC;
218
 
219
     BEGIN     -- (C)
220
 
221
          PR := NEW REC'(0,0,0);
222
          TC.EC (PR);
223
 
224
     END;      -- (C)
225
 
226
     ---------------------------------------------
227
 
228
     RESULT;
229
 
230
END C95071A;

powered by: WebSVN 2.1.0

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