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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C64105C.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 NOT RAISED FOR ACCESS PARAMETERS
26 
--   IN THE FOLLOWING CIRCUMSTANCES:
27 
--       (1)
28 
--       (2) AFTER THE CALL, WHEN AN IN OUT OR OUT FORMAL
29 
--           ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS
30 
--           DIFFERENT CONSTRAINTS.
31 
--       (3)
32 
--   SUBTESTS ARE:
33 
--       (C) CASE 2, IN OUT MODE, STATIC PRIVATE DISCRIMINANT.
34 
--       (D) CASE 2, OUT MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
35 
--       (E) SAME AS (C), WITH TYPE CONVERSION.
36 
--       (F) SAME AS (D), WITH TYPE CONVERSION.
37 
 
38 
-- JRK 3/20/81
39 
-- SPS 10/26/82
40 
-- CPP 8/8/84
41 
 
42 
WITH REPORT;
43 
PROCEDURE C64105C IS
44 
 
45 
     USE REPORT;
46 
 
47 
BEGIN
48 
     TEST ("C64105C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
49 
           "AFTER THE CALL, WHEN AN IN OUT OR OUT FORMAL " &
50 
           "ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS " &
51 
           "DIFFERENT CONSTRAINTS" );
52 
 
53 
     --------------------------------------------------
54 
 
55 
     DECLARE -- (C)
56 
 
57 
          PACKAGE PKG IS
58 
               TYPE E IS (E1, E2);
59 
               TYPE T (D : E := E1) IS PRIVATE;
60 
          PRIVATE
61 
               TYPE T (D : E := E1) IS
62 
                    RECORD
63 
                         I : INTEGER;
64 
                         CASE D IS
65 
                              WHEN E1 =>
66 
                                   B : BOOLEAN;
67 
                              WHEN E2 =>
68 
                                   C : CHARACTER;
69 
                         END CASE;
70 
                    END RECORD;
71 
          END PKG;
72 
          USE PKG;
73 
 
74 
          TYPE A IS ACCESS T;
75 
          SUBTYPE SA IS A(E2);
76 
          V : A (E1) := NULL;
77 
          ENTERED : BOOLEAN := FALSE;
78 
 
79 
          PROCEDURE P (X : IN OUT SA) IS
80 
          BEGIN
81 
               ENTERED := TRUE;
82 
               X := NULL;
83 
          EXCEPTION
84 
               WHEN OTHERS =>
85 
                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
86 
          END P;
87 
 
88 
     BEGIN -- (C)
89 
 
90 
          P (V);
91 
 
92 
     EXCEPTION
93 
          WHEN CONSTRAINT_ERROR =>
94 
               IF NOT ENTERED THEN
95 
                    FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
96 
               ELSE
97 
                    FAILED ("EXCEPTION RAISED ON RETURN - (C)");
98 
               END IF;
99 
          WHEN OTHERS =>
100 
               FAILED ("EXCEPTION RAISED - (C)");
101 
     END; -- (C)
102 
 
103 
     --------------------------------------------------
104 
 
105 
     DECLARE -- (D)
106 
 
107 
          TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
108 
                    INTEGER;
109 
 
110 
          TYPE A IS ACCESS T;
111 
          SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
112 
          V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
113 
                 IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
114 
          ENTERED : BOOLEAN := FALSE;
115 
 
116 
          PROCEDURE P (X : OUT SA) IS
117 
          BEGIN
118 
               ENTERED := TRUE;
119 
               X := NULL;
120 
          EXCEPTION
121 
               WHEN OTHERS =>
122 
                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
123 
          END P;
124 
 
125 
     BEGIN -- (D)
126 
 
127 
          P (V);
128 
 
129 
     EXCEPTION
130 
          WHEN CONSTRAINT_ERROR =>
131 
               IF NOT ENTERED THEN
132 
                    FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
133 
               ELSE
134 
                    FAILED ("EXCEPTION RAISED ON RETURN - (D)");
135 
               END IF;
136 
          WHEN OTHERS =>
137 
               FAILED ("EXCEPTION RAISED - (D)");
138 
     END; -- (D)
139 
 
140 
     --------------------------------------------------
141 
 
142 
     DECLARE -- (E)
143 
 
144 
          PACKAGE PKG IS
145 
               TYPE E IS (E1, E2);
146 
               TYPE T (D : E := E1) IS PRIVATE;
147 
          PRIVATE
148 
               TYPE T (D : E := E1) IS
149 
                    RECORD
150 
                         I : INTEGER;
151 
                         CASE D IS
152 
                              WHEN E1 =>
153 
                                   B : BOOLEAN;
154 
                              WHEN E2 =>
155 
                                   C : CHARACTER;
156 
                         END CASE;
157 
                    END RECORD;
158 
          END PKG;
159 
          USE PKG;
160 
 
161 
          TYPE A IS ACCESS T;
162 
          SUBTYPE SA IS A(E2);
163 
          V : A (E1) := NULL;
164 
          ENTERED : BOOLEAN := FALSE;
165 
 
166 
          PROCEDURE P (X : IN OUT SA) IS
167 
          BEGIN
168 
               ENTERED := TRUE;
169 
               X := NULL;
170 
          EXCEPTION
171 
               WHEN OTHERS =>
172 
                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (C)");
173 
          END P;
174 
 
175 
     BEGIN -- (E)
176 
 
177 
          P (SA(V));
178 
 
179 
     EXCEPTION
180 
          WHEN CONSTRAINT_ERROR =>
181 
               IF NOT ENTERED THEN
182 
                    FAILED ("EXCEPTION RAISED BEFORE CALL - (E)");
183 
               ELSE
184 
                    FAILED ("EXCEPTION RAISED ON RETURN - (E)");
185 
               END IF;
186 
          WHEN OTHERS =>
187 
               FAILED ("EXCEPTION RAISED - (E)");
188 
     END; -- (E)
189 
 
190 
     --------------------------------------------------
191 
 
192 
     DECLARE -- (F)
193 
 
194 
          TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
195 
                    INTEGER;
196 
 
197 
          TYPE A IS ACCESS T;
198 
          SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
199 
          V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
200 
                 IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
201 
          ENTERED : BOOLEAN := FALSE;
202 
 
203 
          PROCEDURE P (X : OUT SA) IS
204 
          BEGIN
205 
               ENTERED := TRUE;
206 
               X := NULL;
207 
          EXCEPTION
208 
               WHEN OTHERS =>
209 
                    FAILED ("EXCEPTION RAISED IN PROCEDURE - (D)");
210 
          END P;
211 
 
212 
     BEGIN -- (D)
213 
 
214 
          P (SA(V));
215 
 
216 
     EXCEPTION
217 
          WHEN CONSTRAINT_ERROR =>
218 
               IF NOT ENTERED THEN
219 
                    FAILED ("EXCEPTION RAISED BEFORE CALL - (F)");
220 
               ELSE
221 
                    FAILED ("EXCEPTION RAISED ON RETURN - (F)");
222 
               END IF;
223 
          WHEN OTHERS =>
224 
               FAILED ("EXCEPTION RAISED - (F)");
225 
     END; -- (F)
226 
 
227 
     --------------------------------------------------
228 
 
229 
     RESULT;
230 
END C64105C;

powered by: WebSVN 2.1.0

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