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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c6/] [c64201c.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C64201C.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 INITIALIZATION OF IN PARAMETERS OF A COMPOSITE
26
--   TYPE HAVING AT LEAST ONE COMPONENT (INCLUDING COMPONENTS
27
--   OF COMPONENTS) OF A TASK TYPE IS PERMITTED.
28
--  (SEE ALSO 7.4.4/T2 FOR TESTS OF LIMITED PRIVATE TYPES.)
29
 
30
-- CVP 5/14/81
31
-- ABW 7/1/82
32
-- BHS 7/9/84
33
 
34
WITH REPORT;
35
USE REPORT;
36
PROCEDURE C64201C IS
37
 
38
 
39
     GLOBAL : INTEGER := 10;
40
 
41
 
42
     TASK TYPE T IS
43
          ENTRY E (X : IN OUT INTEGER);
44
     END;
45
 
46
     TYPE REC_T IS
47
          RECORD
48
               TT : T;
49
               BB : BOOLEAN := TRUE;
50
          END RECORD;
51
 
52
     TYPE REC_REC_T IS
53
          RECORD
54
               RR : REC_T;
55
          END RECORD;
56
 
57
     TYPE ARR_T IS ARRAY (1 .. 2) OF T;
58
 
59
     TYPE ARR_REC_T IS ARRAY (1 .. 2) OF REC_T;
60
 
61
     RT1, RT2   : REC_T;
62
     RRT1, RRT2 : REC_REC_T;
63
     AT1, AT2   : ARR_T;
64
     ART1, ART2 : ARR_REC_T;
65
 
66
 
67
     TASK BODY T IS
68
     BEGIN
69
          ACCEPT E (X : IN OUT INTEGER) DO
70
               X := X - 1;
71
          END E;
72
          ACCEPT E (X : IN OUT INTEGER) DO
73
               X := X + 1;
74
          END E;
75
     END T;
76
 
77
 
78
     PROCEDURE PROC1A (P1X : REC_T := RT1) IS
79
     BEGIN
80
          IF P1X.BB THEN                 -- EXPECT RT2 PASSED.
81
               FAILED( "RECORD OF TASK NOT PASSED, DEFAULT EMPLOYED" );
82
          END IF;
83
     END PROC1A;
84
 
85
     PROCEDURE PROC1B (P1X : REC_T := RT1) IS
86
     BEGIN
87
          IF NOT P1X.BB THEN             -- EXPECT DEFAULT USED.
88
               FAILED( "DEFAULT RECORD OF TASK NOT EMPLOYED" );
89
          END IF;
90
     END PROC1B;
91
 
92
 
93
     PROCEDURE PROC2A (P2X : REC_REC_T := RRT1) IS
94
     BEGIN
95
          IF P2X.RR.BB THEN             -- EXPECT RRT2 PASSED.
96
               FAILED( "RECORD OF RECORD OF TASK NOT PASSED, " &
97
                       "DEFAULT EMPLOYED" );
98
          END IF;
99
     END PROC2A;
100
 
101
     PROCEDURE PROC2B (P2X : REC_REC_T := RRT1) IS
102
     BEGIN
103
          IF NOT P2X.RR.BB THEN         -- EXPECT DEFAULT USED.
104
               FAILED( "DEFAULT RECORD OF RECORD OF TASK " &
105
                       "NOT EMPLOYED" );
106
          END IF;
107
     END PROC2B;
108
 
109
 
110
     PROCEDURE PROC3 (P3X : ARR_T := AT1) IS
111
     BEGIN
112
          P3X(1).E (X => GLOBAL);        -- CALL TO AT2(1).E,
113
                                         -- GLOBAL => GLOBAL - 1.
114
     END PROC3;
115
 
116
     PROCEDURE PROC4 (P4X : ARR_T := AT1) IS
117
     BEGIN
118
          P4X(1).E (X => GLOBAL);     -- CALL TO DEFAULT AT1(1).E,
119
                                      -- GLOBAL => GLOBAL - 1.
120
          IF GLOBAL /= IDENT_INT(8) THEN
121
               FAILED( "ARRAY OF TASKS NOT PASSED " &
122
                       "CORRECTLY IN PROC3" );
123
          END IF;
124
     END PROC4;
125
 
126
     PROCEDURE PROC5 (P5X : ARR_REC_T := ART1) IS
127
     BEGIN
128
          P5X(1).TT.E (X => GLOBAL);      -- CALL TO ART2(1).TT.E,
129
                                          -- GLOBAL => GLOBAL - 1.
130
     END PROC5;
131
 
132
     PROCEDURE PROC6 (P6X : ARR_REC_T := ART1) IS
133
     BEGIN
134
          P6X(1).TT.E (X => GLOBAL);      -- CALL DEFAULT ART1(1).TT.E,
135
                                          -- GLOBAL => GLOBAL - 1.
136
          IF GLOBAL /= IDENT_INT(8) THEN
137
               FAILED( "ARRAY OF RECORDS OF TASKS NOT " &
138
                       "PASSED IN PROC5" );
139
          END IF;
140
     END PROC6;
141
 
142
     PROCEDURE TERM (TSK : T; NUM : CHARACTER) IS
143
     BEGIN
144
          IF NOT TSK'TERMINATED THEN
145
               ABORT TSK;
146
               COMMENT ("ABORTING TASK " & NUM);
147
          END IF;
148
     END TERM;
149
 
150
 
151
BEGIN
152
 
153
     TEST( "C64201C" , "CHECK THAT INITIALIZATION OF IN " &
154
                       "PARAMETERS OF A COMPOSITE TYPE " &
155
                       "IS PERMITTED" );
156
 
157
     RT2.BB := FALSE;
158
     RRT2.RR.BB := FALSE;
159
 
160
     PROC1A(RT2);                               -- NO ENTRY CALL
161
     PROC1B;                                    -- NO ENTRY CALL
162
     PROC2A(RRT2);                              -- NO ENTRY CALL
163
     PROC2B;                                    -- NO ENTRY CALL
164
 
165
     PROC3(AT2);                                -- CALL AT2(1).E
166
     IF GLOBAL /= 9 THEN
167
          FAILED ("INCORRECT GLOBAL VALUE AFTER PROC3");
168
     ELSE
169
          PROC4;                                -- CALL AT1(1).E
170
     END IF;
171
 
172
     GLOBAL := 10;
173
     PROC5(ART2);                              -- CALL ART2(1).TT.E
174
     IF GLOBAL /= 9 THEN
175
          FAILED ("INCORRECT GLOBAL VALUE AFTER PROC5");
176
     ELSE
177
          PROC6;                               -- CALL ART1(1).TT.E
178
     END IF;
179
 
180
-- MAKE SURE ALL TASKS TERMINATED
181
     TERM (RT1.TT, '1');
182
     TERM (RT2.TT, '2');
183
     TERM (RRT1.RR.TT, '3');
184
     TERM (RRT2.RR.TT, '4');
185
     TERM (AT1(1), '5');
186
     TERM (AT2(1), '6');
187
     TERM (AT1(2), '7');
188
     TERM (AT2(2), '8');
189
     TERM (ART1(1).TT, '9');
190
     TERM (ART2(1).TT, 'A');
191
     TERM (ART1(2).TT, 'B');
192
     TERM (ART2(2).TT, 'C');
193
 
194
     RESULT;
195
 
196
END C64201C;

powered by: WebSVN 2.1.0

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