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/] [c3/] [c37211e.ada] - Blame information for rev 309

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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