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/] [c37215b.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C37215B.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 IF
26
--        A DISCRIMINANT CONSTRAINT
27
-- DEPENDS ON A DISCRIMINANT, THE DISCRIMINANT VALUE IS CHECKED FOR
28
-- COMPATIBILITY WHEN THE RECORD TYPE IS:
29
--
30
--   CASE B: USED WITHOUT A CONSTRAINT ONLY IN AN ALLOCATOR OR OBJECT
31
--      DECLARATION.
32
 
33
-- JBG 10/17/86
34
 
35
WITH REPORT; USE REPORT;
36
PROCEDURE C37215B IS
37
 
38
     SUBTYPE SM IS INTEGER RANGE 1..10;
39
 
40
     TYPE REC (D1, D2 : SM) IS
41
          RECORD NULL; END RECORD;
42
 
43
BEGIN
44
     TEST ("C37215B", "CHECK COMPATIBILITY OF DISCRIMINANT EXPRESSIONS"&
45
                      " WHEN CONSTRAINT DEPENDS ON DISCRIMINANT, " &
46
                      "AND DISCRIMINANTS HAVE DEFAULTS");
47
 
48
-- CASE B
49
 
50
     DECLARE
51
          TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
52
               RECORD
53
                    C1 : REC(D3, 1);
54
               END RECORD;
55
     BEGIN
56
          BEGIN
57
               DECLARE
58
                    X : CONS;
59
               BEGIN
60
                    FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 1");
61
                    IF X /= (1, (1, 1)) THEN
62
                         COMMENT ("SHOULDN'T GET HERE");
63
                    END IF;
64
               END;
65
          EXCEPTION
66
               WHEN CONSTRAINT_ERROR =>
67
                    NULL;
68
               WHEN OTHERS =>
69
                    FAILED ("UNEXPECTED EXCEPTION - 1");
70
          END;
71
 
72
          BEGIN
73
               DECLARE
74
                    TYPE ACC_CONS IS ACCESS CONS;
75
                    X : ACC_CONS;
76
               BEGIN
77
                    X := NEW CONS;
78
                    FAILED ("DISCRIMINANT CHECK NOT PERFORMED - 2");
79
                    BEGIN
80
                         IF X.ALL /= (1, (1, 1)) THEN
81
                              COMMENT ("IRRELEVANT");
82
                         END IF;
83
                    END;
84
               EXCEPTION
85
                    WHEN CONSTRAINT_ERROR =>
86
                         NULL;
87
                    WHEN OTHERS =>
88
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
89
               END;
90
          EXCEPTION
91
               WHEN OTHERS =>
92
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 2");
93
          END;
94
 
95
          BEGIN
96
               DECLARE
97
                    SUBTYPE SCONS IS CONS;
98
               BEGIN
99
                    DECLARE
100
                         X : SCONS;
101
                    BEGIN
102
                         FAILED ("DISCRIMINANT CHECK NOT " &
103
                                 "PERFORMED - 3");
104
                         IF X /= (1, (1, 1)) THEN
105
                              COMMENT ("IRRELEVANT");
106
                         END IF;
107
                    END;
108
               EXCEPTION
109
                    WHEN CONSTRAINT_ERROR =>
110
                         NULL;
111
                    WHEN OTHERS =>
112
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
113
               END;
114
          EXCEPTION
115
               WHEN OTHERS =>
116
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 3");
117
          END;
118
 
119
          BEGIN
120
               DECLARE
121
                    TYPE ARR IS ARRAY (1..5) OF CONS;
122
               BEGIN
123
                    DECLARE
124
                         X : ARR;
125
                    BEGIN
126
                         FAILED ("DISCRIMINANT CHECK NOT " &
127
                                 "PERFORMED - 4");
128
                         IF X /= (1..5 => (1, (1, 1))) THEN
129
                              COMMENT ("IRRELEVANT");
130
                         END IF;
131
                    END;
132
               EXCEPTION
133
                    WHEN CONSTRAINT_ERROR =>
134
                         NULL;
135
                    WHEN OTHERS =>
136
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
137
               END;
138
          EXCEPTION
139
               WHEN OTHERS =>
140
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 4");
141
          END;
142
 
143
          BEGIN
144
               DECLARE
145
                    TYPE NREC IS
146
                         RECORD
147
                              C1 : CONS;
148
                         END RECORD;
149
               BEGIN
150
                    DECLARE
151
                         X : NREC;
152
                    BEGIN
153
                         FAILED ("DISCRIMINANT CHECK NOT " &
154
                                 "PERFORMED - 5");
155
                         IF X /= (C1 => (1, (1, 1))) THEN
156
                              COMMENT ("IRRELEVANT");
157
                         END IF;
158
                    END;
159
               EXCEPTION
160
                    WHEN CONSTRAINT_ERROR =>
161
                         NULL;
162
                    WHEN OTHERS =>
163
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
164
               END;
165
          EXCEPTION
166
               WHEN OTHERS =>
167
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 5");
168
          END;
169
 
170
          BEGIN
171
               DECLARE
172
                    TYPE DREC IS NEW CONS;
173
               BEGIN
174
                    DECLARE
175
                         X : DREC;
176
                    BEGIN
177
                         FAILED ("DISCRIMINANT CHECK NOT " &
178
                                 "PERFORMED - 6");
179
                         IF X /= (1, (1, 1)) THEN
180
                              COMMENT ("IRRELEVANT");
181
                         END IF;
182
                    END;
183
               EXCEPTION
184
                    WHEN CONSTRAINT_ERROR =>
185
                         NULL;
186
                    WHEN OTHERS =>
187
                         FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
188
               END;
189
          EXCEPTION
190
               WHEN OTHERS =>
191
                    FAILED ("CONSTRAINT CHECKED TOO SOON - 6");
192
          END;
193
 
194
     END;
195
 
196
     RESULT;
197
 
198
EXCEPTION
199
     WHEN OTHERS =>
200
          FAILED ("CONSTRAINT CHECK DONE TOO EARLY");
201
          RESULT;
202
 
203
END C37215B;

powered by: WebSVN 2.1.0

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