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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C37211A.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 CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT
26 
-- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
27 
-- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE
28 
-- INDICATIONS WHERE THE TYPE MARK DENOTES A RECORD TYPE.
29 
 
30 
-- R.WILLIAMS 8/28/86
31 
-- EDS        7/14/98    AVOID OPTIMIZATION
32 
 
33 
WITH REPORT; USE REPORT;
34 
PROCEDURE C37211A IS
35 
 
36 
     TYPE REC (D : POSITIVE) IS
37 
          RECORD
38 
               NULL;
39 
          END RECORD;
40 
 
41 
BEGIN
42 
     TEST ( "C37211A", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
43 
                       "A DISCRIMINANT CONSTRAINT IF A VALUE " &
44 
                       "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
45 
                       "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
46 
                       "TYPE MARK DENOTES A RECORD TYPE" );
47 
 
48 
     BEGIN
49 
          DECLARE
50 
               SUBTYPE SUBREC IS REC (IDENT_INT (-1));
51 
          BEGIN
52 
               DECLARE
53 
                    SR : SUBREC;
54 
               BEGIN
55 
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
56 
                             "ELABORATION OF SUBTYPE SUBREC " & INTEGER'IMAGE(SR.D));
57 
               END;
58 
          EXCEPTION
59 
               WHEN OTHERS =>
60 
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
61 
                             "OBJECT SR" );
62 
          END;
63 
 
64 
     EXCEPTION
65 
          WHEN CONSTRAINT_ERROR =>
66 
               NULL;
67 
          WHEN OTHERS =>
68 
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
69 
                        "SUBTYPE SUBREC" );
70 
     END;
71 
 
72 
     BEGIN
73 
          DECLARE
74 
               TYPE ARR IS ARRAY (1 .. 10) OF REC (IDENT_INT (-1));
75 
          BEGIN
76 
               DECLARE
77 
                    AR : ARR;
78 
               BEGIN
79 
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
80 
                             "ELABORATION OF TYPE ARR " & INTEGER'IMAGE(AR(1).D));
81 
               END;
82 
          EXCEPTION
83 
               WHEN OTHERS =>
84 
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
85 
                             "OBJECT AR" );
86 
          END;
87 
 
88 
     EXCEPTION
89 
          WHEN CONSTRAINT_ERROR =>
90 
               NULL;
91 
          WHEN OTHERS =>
92 
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
93 
                        "TYPE ARR" );
94 
     END;
95 
 
96 
     BEGIN
97 
          DECLARE
98 
               TYPE REC1 IS
99 
                    RECORD
100 
                         X : REC (IDENT_INT (-1));
101 
                    END RECORD;
102 
 
103 
          BEGIN
104 
               DECLARE
105 
                    R1 : REC1;
106 
               BEGIN
107 
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
108 
                             "ELABORATION OF TYPE REC1 " & INTEGER'IMAGE(R1.X.D));
109 
               END;
110 
          EXCEPTION
111 
               WHEN OTHERS =>
112 
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
113 
                             "OBJECT R1" );
114 
          END;
115 
 
116 
     EXCEPTION
117 
          WHEN CONSTRAINT_ERROR =>
118 
               NULL;
119 
          WHEN OTHERS =>
120 
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
121 
                        "TYPE REC1" );
122 
     END;
123 
 
124 
     BEGIN
125 
          DECLARE
126 
               TYPE ACCREC IS ACCESS REC (IDENT_INT (-1));
127 
          BEGIN
128 
               DECLARE
129 
                    ACR : ACCREC;
130 
               BEGIN
131 
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
132 
                             "ELABORATION OF TYPE ACCREC " & INTEGER'IMAGE(ACR.D));
133 
               END;
134 
          EXCEPTION
135 
               WHEN OTHERS =>
136 
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
137 
                             "OBJECT ACR" );
138 
          END;
139 
 
140 
     EXCEPTION
141 
          WHEN CONSTRAINT_ERROR =>
142 
               NULL;
143 
          WHEN OTHERS =>
144 
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
145 
                        "TYPE ACCREC" );
146 
     END;
147 
 
148 
     BEGIN
149 
          DECLARE
150 
               TYPE NEWREC IS NEW REC (IDENT_INT (-1));
151 
          BEGIN
152 
               DECLARE
153 
                    NR : NEWREC;
154 
               BEGIN
155 
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
156 
                             "ELABORATION OF TYPE NEWREC " & INTEGER'IMAGE(NR.D));
157 
               END;
158 
          EXCEPTION
159 
               WHEN OTHERS =>
160 
                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
161 
                             "OBJECT NR" );
162 
          END;
163 
 
164 
     EXCEPTION
165 
          WHEN CONSTRAINT_ERROR =>
166 
               NULL;
167 
          WHEN OTHERS =>
168 
               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
169 
                        "TYPE NEWREC" );
170 
     END;
171 
 
172 
     BEGIN
173 
          DECLARE
174 
               R : REC (IDENT_INT (-1));
175 
          BEGIN
176 
               FAILED ( "NO EXCEPTION RAISED AT THE DECLARATION OF " &
177 
                        "R " & INTEGER'IMAGE(R.D));
178 
          EXCEPTION
179 
               WHEN OTHERS =>
180 
                    FAILED ( "EXCEPTION RAISED INSIDE BLOCK " &
181 
                             "CONTAINING R" );
182 
          END;
183 
 
184 
     EXCEPTION
185 
          WHEN CONSTRAINT_ERROR =>
186 
               NULL;
187 
          WHEN OTHERS =>
188 
               FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION OF " &
189 
                        "R" );
190 
     END;
191 
 
192 
     BEGIN
193 
          DECLARE
194 
               TYPE REC_NAME IS ACCESS REC;
195 
          BEGIN
196 
               DECLARE
197 
                    RN : REC_NAME := NEW REC (IDENT_INT (-1));
198 
               BEGIN
199 
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
200 
                             "DECLARATION OF OBJECT RN " & INTEGER'IMAGE(RN.D));
201 
               END;
202 
          EXCEPTION
203 
               WHEN CONSTRAINT_ERROR =>
204 
                    NULL;
205 
               WHEN OTHERS =>
206 
                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
207 
                             "OF OBJECT RN" );
208 
          END;
209 
     EXCEPTION
210 
          WHEN OTHERS =>
211 
               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
212 
                        "REC_NAME" );
213 
     END;
214 
 
215 
     BEGIN
216 
          DECLARE
217 
               TYPE BAD_REC (D : POSITIVE := IDENT_INT (-1)) IS
218 
                    RECORD
219 
                         NULL;
220 
                    END RECORD;
221 
          BEGIN
222 
               DECLARE
223 
                    BR : BAD_REC;
224 
               BEGIN
225 
                    FAILED ( "NO EXCEPTION RAISED AT THE " &
226 
                             "DECLARATION OF OBJECT BR " & INTEGER'IMAGE(BR.D));
227 
               END;
228 
          EXCEPTION
229 
               WHEN CONSTRAINT_ERROR =>
230 
                    NULL;
231 
               WHEN OTHERS =>
232 
                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
233 
                             "OF OBJECT BR" );
234 
          END;
235 
     EXCEPTION
236 
          WHEN OTHERS =>
237 
               FAILED ( "EXCEPTION RAISED AT ELABORATION OF TYPE " &
238 
                        "BAD_REC" );
239 
     END;
240 
 
241 
     RESULT;
242 
END C37211A;

powered by: WebSVN 2.1.0

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