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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C34009D.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
-- OBJECTIVE:
26
--     CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
27
--     (IMPLICITLY) FOR DERIVED NON-LIMITED PRIVATE TYPES WITH
28
--     DISCRIMINANTS.
29
 
30
-- HISTORY:
31
--     JRK 08/31/87  CREATED ORIGINAL TEST.
32
--     WMC 03/13/92  REVISED TYPE'SIZE CHECKS.
33
--     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
34
 
35
WITH SYSTEM; USE SYSTEM;
36
WITH REPORT; USE REPORT;
37
 
38
PROCEDURE C34009D IS
39
 
40
     PACKAGE PKG IS
41
 
42
          MAX_LEN : CONSTANT := 10;
43
 
44
          SUBTYPE LENGTH IS NATURAL RANGE 0 .. MAX_LEN;
45
 
46
          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS PRIVATE;
47
 
48
          FUNCTION CREATE ( B : BOOLEAN;
49
                            L : LENGTH;
50
                            I : INTEGER;
51
                            S : STRING;
52
                            J : INTEGER;
53
                            F : FLOAT;
54
                            X : PARENT  -- TO RESOLVE OVERLOADING.
55
                          ) RETURN PARENT;
56
 
57
          FUNCTION CON ( B : BOOLEAN;
58
                         L : LENGTH;
59
                         I : INTEGER;
60
                         S : STRING;
61
                         J : INTEGER
62
                       ) RETURN PARENT;
63
 
64
          FUNCTION CON ( B : BOOLEAN;
65
                         L : LENGTH;
66
                         I : INTEGER;
67
                         F : FLOAT
68
                       ) RETURN PARENT;
69
 
70
     PRIVATE
71
 
72
          TYPE PARENT (B : BOOLEAN := TRUE; L : LENGTH := 1) IS
73
               RECORD
74
                    I : INTEGER;
75
                    CASE B IS
76
                         WHEN TRUE =>
77
                              S : STRING (1 .. L);
78
                              J : INTEGER;
79
                         WHEN FALSE =>
80
                              F : FLOAT := 5.0;
81
                    END CASE;
82
               END RECORD;
83
 
84
     END PKG;
85
 
86
     USE PKG;
87
 
88
     TYPE T IS NEW PARENT (IDENT_BOOL (TRUE), IDENT_INT (3));
89
 
90
     X : T;
91
     W : PARENT;
92
     B : BOOLEAN := FALSE;
93
 
94
     PROCEDURE A (X : ADDRESS) IS
95
     BEGIN
96
          B := IDENT_BOOL (TRUE);
97
     END A;
98
 
99
     PACKAGE BODY PKG IS
100
 
101
          FUNCTION CREATE
102
             ( B : BOOLEAN;
103
               L : LENGTH;
104
               I : INTEGER;
105
               S : STRING;
106
               J : INTEGER;
107
               F : FLOAT;
108
               X : PARENT
109
             ) RETURN PARENT
110
          IS
111
          BEGIN
112
               CASE B IS
113
                    WHEN TRUE =>
114
                         RETURN (TRUE, L, I, S, J);
115
                    WHEN FALSE =>
116
                         RETURN (FALSE, L, I, F);
117
               END CASE;
118
          END CREATE;
119
 
120
          FUNCTION CON
121
             ( B : BOOLEAN;
122
               L : LENGTH;
123
               I : INTEGER;
124
               S : STRING;
125
               J : INTEGER
126
             ) RETURN PARENT
127
          IS
128
          BEGIN
129
               RETURN (TRUE, L, I, S, J);
130
          END CON;
131
 
132
          FUNCTION CON
133
             ( B : BOOLEAN;
134
               L : LENGTH;
135
               I : INTEGER;
136
               F : FLOAT
137
             ) RETURN PARENT
138
          IS
139
          BEGIN
140
               RETURN (FALSE, L, I, F);
141
          END CON;
142
 
143
     END PKG;
144
 
145
BEGIN
146
     TEST ("C34009D", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
147
                      "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
148
                      "NON-LIMITED PRIVATE TYPES WITH DISCRIMINANTS");
149
 
150
     X := CON (TRUE, 3, 2, "AAA", 2);
151
     W := CON (TRUE, 3, 2, "AAA", 2);
152
 
153
     IF EQUAL (3, 3) THEN
154
          X := CON (TRUE, 3, 1, "ABC", 4);
155
     END IF;
156
     IF X /= CON (TRUE, 3, 1, "ABC", 4) THEN
157
          FAILED ("INCORRECT :=");
158
     END IF;
159
 
160
     IF T'(X) /= CON (TRUE, 3, 1, "ABC", 4) THEN
161
          FAILED ("INCORRECT QUALIFICATION");
162
     END IF;
163
 
164
     IF T (X) /= CON (TRUE, 3, 1, "ABC", 4) THEN
165
          FAILED ("INCORRECT SELF CONVERSION");
166
     END IF;
167
 
168
     IF EQUAL (3, 3) THEN
169
          W := CON (TRUE, 3, 1, "ABC", 4);
170
     END IF;
171
     IF T (W) /= CON (TRUE, 3, 1, "ABC", 4) THEN
172
          FAILED ("INCORRECT CONVERSION FROM PARENT");
173
     END IF;
174
 
175
     IF PARENT (X) /= CON (TRUE, 3, 1, "ABC", 4) OR
176
        PARENT (CREATE (FALSE, 2, 3, "XX", 5, 6.0, X)) /=
177
        CON (FALSE, 2, 3, 6.0) THEN
178
          FAILED ("INCORRECT CONVERSION TO PARENT");
179
     END IF;
180
 
181
     IF X.B /= TRUE OR X.L /= 3 OR
182
        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . B /= FALSE OR
183
        CREATE (FALSE, 2, 3, "XX", 5, 6.0, X) . L /= 2 THEN
184
          FAILED ("INCORRECT SELECTION (DISCRIMINANT)");
185
     END IF;
186
 
187
     IF X = CON (TRUE, 3, 1, "ABC", 5) OR
188
        X = CON (FALSE, 2, 3, 6.0) THEN
189
          FAILED ("INCORRECT =");
190
     END IF;
191
 
192
     IF X /= CON (TRUE, 3, 1, "ABC", 4) OR
193
        NOT (X /= CON (FALSE, 2, 3, 6.0)) THEN
194
          FAILED ("INCORRECT /=");
195
     END IF;
196
 
197
     IF NOT (X IN T) OR CON (FALSE, 2, 3, 6.0) IN T THEN
198
          FAILED ("INCORRECT ""IN""");
199
     END IF;
200
 
201
     IF X NOT IN T OR NOT (CON (FALSE, 2, 3, 6.0) NOT IN T) THEN
202
          FAILED ("INCORRECT ""NOT IN""");
203
     END IF;
204
 
205
     B := FALSE;
206
     A (X'ADDRESS);
207
     IF NOT B THEN
208
          FAILED ("INCORRECT 'ADDRESS");
209
     END IF;
210
 
211
     IF NOT X'CONSTRAINED THEN
212
          FAILED ("INCORRECT OBJECT'CONSTRAINED");
213
     END IF;
214
 
215
     IF T'SIZE <= 0 THEN
216
          FAILED ("INCORRECT TYPE'SIZE");
217
     END IF;
218
 
219
     IF X'SIZE   < T'SIZE OR
220
        X.B'SIZE < BOOLEAN'SIZE OR
221
        X.L'SIZE < LENGTH'SIZE THEN
222
          FAILED ("INCORRECT OBJECT'SIZE");
223
     END IF;
224
 
225
     RESULT;
226
END C34009D;

powered by: WebSVN 2.1.0

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