OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [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.