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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C37003A.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 MULTIPLE COMPONENT DECLARATIONS ARE TREATED AS A SERIES
26
-- OF SINGLE COMNENT DECLARATIONS, I.E., THE COMPONENTS ALL HAVE THE
27
-- SAME TYPE AND ANY EXPRESSION USED IN CONSTRAINTS OR INITIALIZATIONS
28
-- IS EVALUATED ONCE FOR EACH COMPONENT.
29
 
30
-- DAT 3/30/81
31
-- SPS 10/26/82
32
-- JWC 10/23/85  RENAMED FROM C37013A-AB.ADA.
33
--               ADDED TEST TO ENSURE THAT ANY EXPRESSION USED
34
--               IN A CONSTRAINT IS EVALUATED ONCE FOR EACH
35
--               COMPONENT.
36
-- JRK 11/15/85  ADDED INITIALIZATION EVALUATION CHECKS.
37
 
38
WITH REPORT; USE REPORT;
39
 
40
PROCEDURE C37003A IS
41
 
42
     X : INTEGER := 0;
43
 
44
     FUNCTION F RETURN INTEGER IS
45
     BEGIN
46
          X := X + 1;
47
          RETURN X;
48
     END F;
49
 
50
     PROCEDURE RESET IS
51
     BEGIN
52
          X := 0;
53
     END RESET;
54
 
55
BEGIN
56
     TEST ("C37003A", "CHECK THAT MULTIPLE COMPONENT DECLARATIONS " &
57
                      "ARE TREATED AS A SERIES OF SINGLE COMPONENT " &
58
                      "DECLARATIONS");
59
 
60
     DECLARE
61
 
62
          TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
63
 
64
          TYPE REC1 IS RECORD
65
               A1, A2 : ARR (1 .. F) := (OTHERS => F);
66
          END RECORD;
67
 
68
          R1 : REC1 := (OTHERS => (OTHERS => 1));
69
          Y : INTEGER := X;
70
          R1A : REC1;
71
 
72
     BEGIN
73
 
74
          IF R1.A1 = R1.A2 THEN        -- TEST TO SEE IF THE COMPONENTS
75
               NULL;                   -- ARE OF THE SAME TYPE.
76
          END IF;
77
 
78
          IF Y /= 2 THEN
79
               FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
80
                       "FOR ARRAYS");
81
          END IF;
82
 
83
          IF X /= 5 THEN
84
               FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED FOR " &
85
                       "EACH ARRAY COMPONENT");
86
          END IF;
87
 
88
          RESET;
89
 
90
     END;
91
 
92
     DECLARE
93
 
94
          TYPE REC2 IS RECORD
95
               I1, I2 : INTEGER RANGE 1 .. F := F * IDENT_INT(0) + 1;
96
          END RECORD;
97
 
98
          R2 : REC2 := (OTHERS => 1);
99
          Y : INTEGER := X;
100
          R2A : REC2;
101
 
102
     BEGIN
103
 
104
          IF R2.I1 = R2.I2 THEN        -- TEST TO SEE IF THE COMPONENTS
105
               NULL;                   -- ARE OF THE SAME TYPE.
106
          END IF;
107
 
108
          IF Y /= 2 THEN
109
               FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
110
                       "FOR SCALARS");
111
          END IF;
112
 
113
          IF X /= 4 THEN
114
               FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED FOR " &
115
                       "EACH SCALAR COMPONENT");
116
          END IF;
117
 
118
          RESET;
119
 
120
     END;
121
 
122
     DECLARE
123
 
124
          TYPE REC3X (DSC : INTEGER) IS RECORD
125
               NULL;
126
          END RECORD;
127
 
128
          TYPE REC3Y IS RECORD
129
               I : INTEGER;
130
          END RECORD;
131
 
132
          TYPE REC3 IS RECORD
133
               RX1, RX2 : REC3X (F);
134
               RY1, RY2 : REC3Y := (I => F);
135
          END RECORD;
136
 
137
          R3 : REC3 := ((DSC => 1), (DSC => 2), (I => 0), (I => 0));
138
          Y : INTEGER := X;
139
          R3A : REC3;
140
 
141
     BEGIN
142
 
143
          IF R3.RX1 = R3.RX2 THEN       -- TEST TO SEE IF THE COMPONENTS
144
               NULL;                    -- ARE OF THE SAME TYPE.
145
          END IF;
146
 
147
          IF Y /= 2 THEN
148
               FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
149
                       "FOR RECORDS");
150
          END IF;
151
 
152
          IF X /= 4 THEN
153
               FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " &
154
                       "FOR EACH RECORD COMPONENT");
155
          END IF;
156
 
157
          RESET;
158
 
159
     END;
160
 
161
     DECLARE
162
 
163
          TYPE REC4X (DSC : INTEGER) IS RECORD
164
               NULL;
165
          END RECORD;
166
 
167
          TYPE ACR IS ACCESS REC4X;
168
          TYPE ACI IS ACCESS INTEGER;
169
 
170
          TYPE REC4 IS RECORD
171
               AC1, AC2 : ACR (F);
172
               AC3, AC4 : ACI := NEW INTEGER'(F);
173
          END RECORD;
174
 
175
          R4 : REC4 := (NULL, NULL, NULL, NULL);
176
          Y : INTEGER := X;
177
          R4A : REC4;
178
 
179
     BEGIN
180
 
181
          IF R4.AC1 = R4.AC2 THEN       -- TEST TO SEE IF THE COMPONENTS
182
               NULL;                    -- ARE OF THE SAME TYPE.
183
          END IF;
184
 
185
          IF Y /= 2 THEN
186
               FAILED ("CONSTRAINT EXPRESSION NOT EVALUATED TWICE " &
187
                       "FOR ACCESS");
188
          END IF;
189
 
190
          IF X /= 4 THEN
191
               FAILED ("INITIALIZATION EXPRESSION NOT EVALUATED " &
192
                       "FOR EACH ACCESS COMPONENT");
193
          END IF;
194
 
195
     END;
196
 
197
     RESULT;
198
END C37003A;

powered by: WebSVN 2.1.0

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