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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c95086b.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C95086B.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
--   BEFORE AN ENTRY CALL, WHEN AN IN OR IN OUT ACTUAL ACCESS
27
--   PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS DIFFERENT
28
--   FROM THE FORMAL PARAMETER.
29
--
30
--   SUBTESTS ARE:
31
--       (A) IN MODE, STATIC ONE DIMENSIONAL BOUNDS.
32
--       (B) IN OUT MODE, DYNAMIC RECORD DISCRIMINANTS.
33
--       (C) CASE (A), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
34
--       (D) CASE (B), BUT ACTUAL PARAMETER IS A TYPE CONVERSION.
35
 
36
-- RJW 1/27/86
37
 
38
WITH REPORT; USE REPORT;
39
PROCEDURE C95086B IS
40
 
41
BEGIN
42
     TEST ( "C95086B", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
43
            "BEFORE AN ENTRY CALL, WHEN AN IN OR IN OUT ACTUAL " &
44
            "ACCESS PARAMETER HAS VALUE NULL, BUT WITH CONSTRAINTS " &
45
            "DIFFERENT FROM THE FORMAL PARAMETER" );
46
 
47
     --------------------------------------------------
48
 
49
     DECLARE -- (A)
50
 
51
          TYPE E IS (E1, E2, E3, E4);
52
          TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
53
 
54
          TYPE A IS ACCESS T;
55
          SUBTYPE SA IS A (E2..E4);
56
          V : A (E1..E2) := NULL;
57
 
58
          TASK T1 IS
59
               ENTRY P (X : SA);
60
          END T1;
61
 
62
          TASK BODY T1 IS
63
          BEGIN
64
               ACCEPT P (X : SA);
65
          EXCEPTION
66
               WHEN OTHERS =>
67
                    FAILED ( "EXCEPTION RAISED IN TASK - (A)" );
68
          END T1;
69
 
70
     BEGIN -- (A)
71
 
72
          T1.P (V);
73
 
74
     EXCEPTION
75
          WHEN OTHERS =>
76
               FAILED ( "EXCEPTION RAISED - (A)" );
77
     END; -- (A)
78
 
79
     --------------------------------------------------
80
 
81
     DECLARE -- (B)
82
 
83
          TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
84
 
85
          TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
86
               RECORD
87
                    I : INTEGER;
88
                    CASE B IS
89
                         WHEN FALSE =>
90
                              J : INTEGER;
91
                         WHEN TRUE =>
92
                              A : ARR ('A' .. C);
93
                    END CASE;
94
               END RECORD;
95
 
96
          TYPE A IS ACCESS T;
97
          SUBTYPE SA IS A (TRUE, 'C');
98
          V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
99
 
100
          TASK T1 IS
101
               ENTRY P (X : IN OUT SA);
102
          END T1;
103
 
104
          TASK BODY T1 IS
105
          BEGIN
106
               ACCEPT P (X : IN OUT SA) DO
107
                    NULL;
108
               END P;
109
          EXCEPTION
110
               WHEN OTHERS =>
111
                    FAILED ( "EXCEPTION RAISED IN TASK - (B)" );
112
          END T1;
113
 
114
     BEGIN -- (B)
115
 
116
          T1.P (V);
117
 
118
     EXCEPTION
119
          WHEN OTHERS =>
120
               FAILED ( "EXCEPTION RAISED - (B)" );
121
     END; -- (B)
122
 
123
     --------------------------------------------------
124
 
125
     DECLARE -- (C)
126
 
127
          TYPE E IS (E1, E2, E3, E4);
128
          TYPE T IS ARRAY (E RANGE <>) OF INTEGER;
129
 
130
          TYPE A IS ACCESS T;
131
          SUBTYPE SA IS A (E2..E4);
132
          V : A (E1..E2) := NULL;
133
 
134
          TASK T1 IS
135
               ENTRY P (X : SA);
136
          END T1;
137
 
138
          TASK BODY T1 IS
139
          BEGIN
140
               ACCEPT P (X : SA) DO
141
                    NULL;
142
               END P;
143
          EXCEPTION
144
               WHEN OTHERS =>
145
                    FAILED ( "EXCEPTION RAISED IN TASK - (C)" );
146
          END T1;
147
 
148
     BEGIN -- (C)
149
 
150
          T1.P (SA(V));
151
 
152
     EXCEPTION
153
          WHEN OTHERS =>
154
               FAILED ( "EXCEPTION RAISED - (C)" );
155
     END; -- (C)
156
 
157
     --------------------------------------------------
158
 
159
     DECLARE -- (D)
160
 
161
          TYPE ARR IS ARRAY (CHARACTER RANGE <>) OF INTEGER;
162
 
163
          TYPE T (B : BOOLEAN := FALSE; C : CHARACTER := 'A') IS
164
               RECORD
165
                    I : INTEGER;
166
                    CASE B IS
167
                         WHEN FALSE =>
168
                              J : INTEGER;
169
                         WHEN TRUE =>
170
                              A : ARR ('A' .. C);
171
                    END CASE;
172
               END RECORD;
173
 
174
          TYPE A IS ACCESS T;
175
          SUBTYPE SA IS A (TRUE, 'C');
176
          V : A (IDENT_BOOL(FALSE), IDENT_CHAR('B')) := NULL;
177
 
178
          TASK T1 IS
179
               ENTRY P (X : IN OUT SA);
180
          END T1;
181
 
182
          TASK BODY T1 IS
183
          BEGIN
184
               ACCEPT P (X : IN OUT SA);
185
          EXCEPTION
186
               WHEN OTHERS =>
187
                    FAILED ( "EXCEPTION RAISED IN TASK - (D)" );
188
          END T1;
189
 
190
     BEGIN -- (D)
191
 
192
          T1.P (SA(V));
193
 
194
     EXCEPTION
195
          WHEN OTHERS =>
196
               FAILED ( "EXCEPTION RAISED - (D)" );
197
     END; -- (D)
198
 
199
     --------------------------------------------------
200
 
201
     RESULT;
202
END C95086B;

powered by: WebSVN 2.1.0

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