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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c45112a.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C45112A.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 THE BOUNDS OF THE RESULT OF A LOGICAL ARRAY OPERATION 
26
-- ARE THE BOUNDS OF THE LEFT OPERAND.
27
 
28
-- RJW 2/3/86
29
 
30
WITH REPORT; USE REPORT;
31
 
32
PROCEDURE C45112A IS
33
 
34
     TYPE ARR IS ARRAY(INTEGER RANGE <>) OF BOOLEAN;
35
     A1 : ARR(IDENT_INT(3) .. IDENT_INT(4)) := (TRUE, FALSE);
36
     A2 : ARR(IDENT_INT(1) .. IDENT_INT(2)) := (TRUE, FALSE);
37
     SUBTYPE CARR IS ARR (IDENT_INT (A1'FIRST) .. IDENT_INT (A1'LAST));
38
 
39
     PROCEDURE CHECK (X : ARR; N1, N2 : STRING) IS
40
     BEGIN
41
          IF X'FIRST /= A1'FIRST OR X'LAST /= A1'LAST THEN
42
               FAILED ( "WRONG BOUNDS FOR " & N1 & " FOR " & N2 );
43
          END IF;
44
     END CHECK;
45
 
46
BEGIN
47
 
48
     TEST ( "C45112A", "CHECK THE BOUNDS OF THE RESULT OF LOGICAL " &
49
                       "ARRAY OPERATIONS" );
50
 
51
     BEGIN
52
          DECLARE
53
               AAND : CONSTANT ARR := A1 AND A2;
54
               AOR  : CONSTANT ARR := A1 OR A2;
55
               AXOR : CONSTANT ARR := A1 XOR A2;
56
          BEGIN
57
               CHECK (AAND, "INITIALIZATION OF CONSTANT ARRAY ",
58
                            "'AND'" );
59
 
60
               CHECK (AOR, "INITIALIZATION OF CONSTANT ARRAY ",
61
                            "'OR'" );
62
 
63
               CHECK (AXOR, "INITIALIZATION OF CONSTANT ARRAY ",
64
                            "'XOR'" );
65
          END;
66
     EXCEPTION
67
          WHEN CONSTRAINT_ERROR =>
68
               FAILED ( "CONSTRAINT_ERROR RAISED DURING " &
69
                        "INTIALIZATIONS" );
70
          WHEN OTHERS =>
71
               FAILED ( "OTHER EXCEPTION RAISED DURING " &
72
                        "INITIALIZATIONS" );
73
     END;
74
 
75
     DECLARE
76
          PROCEDURE PROC (A : ARR; STR : STRING) IS
77
          BEGIN
78
               CHECK (A, "FORMAL PARAMETER FOR CONSTRAINED ARRAY",
79
                      STR);
80
          END PROC;
81
     BEGIN
82
          PROC ((A1 AND A2), "'AND'" );
83
          PROC ((A1 OR A2), "'OR'" );
84
          PROC ((A1 XOR A2), "'XOR'" );
85
     EXCEPTION
86
          WHEN OTHERS =>
87
               FAILED ( "EXCEPTION RAISED DURING TEST FOR FORMAL " &
88
                        "PARAMETERS" );
89
     END;
90
 
91
     DECLARE
92
          FUNCTION FUNCAND RETURN ARR IS
93
          BEGIN
94
               RETURN A1 AND A2;
95
          END FUNCAND;
96
 
97
          FUNCTION FUNCOR RETURN ARR IS
98
          BEGIN
99
               RETURN A1 OR A2;
100
          END FUNCOR;
101
 
102
          FUNCTION FUNCXOR RETURN ARR IS
103
          BEGIN
104
               RETURN A1 XOR A2;
105
          END FUNCXOR;
106
 
107
     BEGIN
108
          CHECK (FUNCAND, "RETURN STATEMENT", "'AND'");
109
          CHECK (FUNCOR, "RETURN STATEMENT", "'OR'");
110
          CHECK (FUNCXOR, "RETURN STATEMENT", "'XOR'");
111
 
112
     EXCEPTION
113
          WHEN OTHERS =>
114
               FAILED ( "EXCEPTION RAISED DURING TEST FOR RETURN " &
115
                        "FROM FUNCTION" );
116
     END;
117
 
118
     BEGIN
119
          DECLARE
120
               GENERIC
121
                   X : IN ARR;
122
               PACKAGE PKG IS
123
                    FUNCTION G RETURN ARR;
124
               END PKG;
125
 
126
               PACKAGE BODY PKG IS
127
                    FUNCTION G RETURN ARR IS
128
                    BEGIN
129
                         RETURN X;
130
                    END G;
131
               END PKG;
132
 
133
               PACKAGE PAND IS NEW PKG(X => A1 AND A2);
134
               PACKAGE POR IS NEW PKG(X => A1 OR A2);
135
               PACKAGE PXOR IS NEW PKG(X => A1 XOR A2);
136
          BEGIN
137
               CHECK (PAND.G, "GENERIC FORMAL PARAMETER", "'AND'");
138
               CHECK (POR.G, "GENERIC FORMAL PARAMETER", "'OR'");
139
               CHECK (PXOR.G, "GENERIC FORMAL PARAMMETER", "'XOR'");
140
          END;
141
     EXCEPTION
142
          WHEN OTHERS =>
143
               FAILED ( "EXCEPTION RAISED DURING GENERIC " &
144
                        "INSTANTIATION" );
145
     END;
146
 
147
     DECLARE
148
          TYPE ACC IS ACCESS ARR;
149
          AC : ACC;
150
 
151
     BEGIN
152
          AC :=  NEW ARR'(A1 AND A2);
153
          CHECK (AC.ALL, "ALLOCATION", "'AND'");
154
          AC :=  NEW ARR'(A1 OR A2);
155
          CHECK (AC.ALL, "ALLOCATION", "'OR'");
156
          AC :=  NEW ARR'(A1 XOR A2);
157
          CHECK (AC.ALL, "ALLOCATION", "'XOR'");
158
     EXCEPTION
159
          WHEN OTHERS =>
160
               FAILED ( "EXCEPTION RAISED ON ALLOCATION" );
161
     END;
162
 
163
     BEGIN
164
          CHECK (CARR' (A1 AND A2), "QUALIFIED EXPRESSION", "'AND'");
165
          CHECK (CARR' (A1 OR A2), "QUALIFIED EXPRESSION", "'OR'");
166
          CHECK (CARR' (A1 XOR A2), "QUALIFIED EXPRESSION", "'XOR'");
167
     EXCEPTION
168
          WHEN OTHERS =>
169
               FAILED ( "EXCEPTION RAISED ON QUALIFIED EXPRESSION" );
170
     END;
171
 
172
     DECLARE
173
          TYPE REC IS
174
               RECORD
175
                    RCA : CARR;
176
               END RECORD;
177
          R1 : REC;
178
 
179
     BEGIN
180
          R1 := (RCA => (A1 AND A2));
181
          CHECK (R1.RCA, "AGGREGATE", "'AND'");
182
          R1 := (RCA => (A1 OR A2));
183
          CHECK (R1.RCA, "AGGREGATE", "'OR'");
184
          R1 := (RCA => (A1 XOR A2));
185
          CHECK (R1.RCA, "AGGREGATE", "'XOR'");
186
     EXCEPTION
187
          WHEN OTHERS =>
188
               FAILED ( "EXCEPTION RAISED ON AGGREGATE" );
189
     END;
190
 
191
     BEGIN
192
          DECLARE
193
               TYPE RECDEF IS
194
                    RECORD
195
                         RCDF1 : CARR := A1 AND A2;
196
                         RCDF2 : CARR := A1 OR A2;
197
                         RCDF3 : CARR := A1 XOR A2;
198
                    END RECORD;
199
               RD : RECDEF;
200
          BEGIN
201
               CHECK (RD.RCDF1, "DEFAULT RECORD", "'AND'");
202
               CHECK (RD.RCDF2, "DEFAULT RECORD", "'OR'");
203
               CHECK (RD.RCDF3, "DEFAULT RECORD", "'XOR'");
204
          EXCEPTION
205
               WHEN OTHERS =>
206
                    FAILED ( "EXCEPTION RAISED ON DEFAULT RECORD" );
207
          END;
208
     EXCEPTION
209
          WHEN OTHERS =>
210
               FAILED ( "EXCEPTION RAISED DURING INITIALIZATION OF " &
211
                        "DEFAULT RECORD" );
212
     END;
213
 
214
     DECLARE
215
          PROCEDURE PDEF (X : CARR := A1 AND A2;
216
                          Y : CARR := A1 OR A2;
217
                          Z : CARR := A1 XOR A2 ) IS
218
          BEGIN
219
               CHECK (X, "DEFAULT PARAMETER", "'AND'");
220
               CHECK (Y, "DEFAULT PARAMETER", "'OR'");
221
               CHECK (Z, "DEFAULT PARAMETER", "'XOR'");
222
          END PDEF;
223
 
224
     BEGIN
225
          PDEF;
226
     EXCEPTION
227
          WHEN OTHERS =>
228
               FAILED ( "EXCEPTION RAISED ON DEFAULT PARM" );
229
     END;
230
 
231
     RESULT;
232
 
233
END C45112A;

powered by: WebSVN 2.1.0

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