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/] [cd/] [cd2a23e.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CD2A23E.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 WHEN A SIZE SPECIFICATION AND AN ENUMERATION
27
--     REPRESENTATION CLAUSE ARE GIVEN FOR AN ENUMERATION TYPE,
28
--     THEN SUCH A TYPE CAN BE PASSED AS AN ACTUAL PARAMETER TO A
29
--     GENERIC PROCEDURE.
30
 
31
-- HISTORY:
32
--     JET 08/18/87 CREATED ORIGINAL TEST.
33
--     DHH 04/18/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
34
--                  OPERATORS ON 'SIZE TESTS, AND ADDED CHECK ON
35
--                  REPRESENTATION CLAUSE.
36
--     BCB 03/05/90 ADDED CALL TO LENGTH_CHECK TO VERIFY THAT THE SIZE
37
--                  SPECIFICATION IS OBEYED.
38
--     LDC 10/03/90 ADDED EXCEPTION HANDER FOR CHECK OF 'SUCC, 'PRED,
39
--                  ADDED CASES FOR >=, /=, ASSIGNMENT, QUALIFICATION, 
40
--                  AND EXPLICIT CONVERSION.
41
--     WMC 03/27/92 ELIMINATED TEST REDUNDANCIES.
42
 
43
 
44
WITH REPORT; USE REPORT;
45
WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
46
PROCEDURE CD2A23E IS
47
 
48
     TYPE BASIC_ENUM IS (ZERO, ONE, TWO);
49
     BASIC_SIZE : CONSTANT := 8;
50
 
51
     FOR BASIC_ENUM USE (ZERO => 3, ONE => 4, TWO => 5);
52
     FOR BASIC_ENUM'SIZE USE BASIC_SIZE;
53
 
54
BEGIN
55
     TEST ("CD2A23E", "CHECK THAT WHEN A SIZE SPECIFICATION AND AN " &
56
                      "ENUMERATION REPRESENTATION CLAUSE ARE " &
57
                      "GIVEN FOR AN ENUMERATION TYPE, " &
58
                      "THEN SUCH A TYPE CAN BE " &
59
                      "PASSED AS AN ACTUAL PARAMETER TO A GENERIC " &
60
                      "PROCEDURE");
61
 
62
     DECLARE -- TYPE DECLARATION GIVEN WITHIN GENERIC PROCEDURE.
63
 
64
          GENERIC
65
               TYPE GPARM IS (<>);
66
          PROCEDURE GENPROC (C0, C1, C2: GPARM);
67
 
68
          PROCEDURE GENPROC (C0, C1, C2: GPARM) IS
69
 
70
               SUBTYPE CHECK_TYPE IS GPARM;
71
 
72
               C3 : GPARM;
73
 
74
               CHECKVAR : CHECK_TYPE;
75
 
76
               FUNCTION IDENT (CH : CHECK_TYPE) RETURN CHECK_TYPE IS
77
               BEGIN
78
                    IF EQUAL (3, 3) THEN
79
                         RETURN CH;
80
                    ELSE
81
                         RETURN C1;
82
                    END IF;
83
               END IDENT;
84
 
85
               PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (CHECK_TYPE);
86
 
87
 
88
          BEGIN -- GENPROC.
89
 
90
               CHECK_1 (C0, BASIC_SIZE, "CHECK_TYPE");
91
 
92
               CHECKVAR := IDENT (C0);
93
 
94
               CHECK_1 (CHECKVAR, CHECK_TYPE'SIZE, "CHECK_TYPE");
95
 
96
               IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
97
                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
98
               END IF;
99
 
100
               IF C0'SIZE < IDENT_INT (BASIC_SIZE) THEN
101
                    FAILED ("INCORRECT VALUE FOR C0'SIZE");
102
               END IF;
103
 
104
               IF NOT ((IDENT(C0) <  IDENT (C1)) AND
105
                       (IDENT(C2) >  IDENT (C1)) AND
106
                       (IDENT(C1) <= IDENT (C1)) AND
107
                       (IDENT(C2) =  IDENT (C2))) THEN
108
                    FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
109
                            "OPERATORS");
110
               END IF;
111
 
112
               IF CHECK_TYPE'FIRST /= IDENT (C0) THEN
113
                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'FIRST");
114
               END IF;
115
 
116
               IF CHECK_TYPE'POS (C0) /= IDENT_INT (0) OR
117
                  CHECK_TYPE'POS (C1) /= IDENT_INT (1) OR
118
                  CHECK_TYPE'POS (C2) /= IDENT_INT (2) THEN
119
                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'POS");
120
               END IF;
121
 
122
               IF CHECK_TYPE'SUCC (C0) /= IDENT (C1) OR
123
                  CHECK_TYPE'SUCC (C1) /= IDENT (C2) THEN
124
                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SUCC");
125
               END IF;
126
 
127
               BEGIN
128
                    IF CHECK_TYPE'SUCC (IDENT(C2)) /= IDENT (C1) THEN
129
                         FAILED ("CONSTRAINT ERROR NOT RAISED FOR " &
130
                                 "CHECK_TYPE'SUCC");
131
                    END IF;
132
               EXCEPTION
133
                    WHEN CONSTRAINT_ERROR =>
134
                         IF 3 /= IDENT_INT(3) THEN
135
                              COMMENT ("DON'T OPTIMIZE EXCEPTION -1");
136
                         END IF;
137
                    WHEN OTHERS =>
138
                         FAILED ("WRONG EXCEPTION RAISED FOR " &
139
                                 "CHECK_TYPE'SUCC");
140
               END;
141
 
142
               BEGIN
143
                    IF CHECK_TYPE'PRED(IDENT(C0)) /= IDENT (C1) THEN
144
                        FAILED ("CONSTRAINT ERROR NOT RAISED FOR " &
145
                                 "CHECK_TYPE'PRED");
146
                    END IF;
147
               EXCEPTION
148
                    WHEN CONSTRAINT_ERROR =>
149
                         IF 3 /= IDENT_INT(3) THEN
150
                              COMMENT ("DON'T OPTIMIZE EXCEPTION -2");
151
                         END IF;
152
                    WHEN OTHERS =>
153
                         FAILED ("WRONG EXCEPTION RAISED FOR " &
154
                                 "CHECK_TYPE'PRED");
155
               END;
156
 
157
               IF CHECK_TYPE'PRED (C1) /= IDENT (C0) OR
158
                  CHECK_TYPE'PRED (C2) /= IDENT (C1) THEN
159
                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'PRED");
160
               END IF;
161
 
162
               IF CHECK_TYPE'IMAGE (C0) /= IDENT_STR ("ZERO") OR
163
                  CHECK_TYPE'IMAGE (C1) /= IDENT_STR ("ONE")  OR
164
                  CHECK_TYPE'IMAGE (C2) /= IDENT_STR ("TWO")  THEN
165
                    FAILED ("INCORRECT VALUE FOR CHECK_TYPE'IMAGE");
166
               END IF;
167
 
168
               CHECKVAR := CHECK_TYPE'VALUE ("ONE");
169
               C3 := GPARM(CHECKVAR);
170
               IF C3 /= IDENT(C1) THEN
171
                    FAILED ("INCORRECT VALUE FOR CONVERSION");
172
               END IF;
173
 
174
               CHECK_1 (IDENT(C0), BASIC_SIZE, "CHECK_ENUM");
175
 
176
 
177
               IF CHECK_TYPE'(C2) /= IDENT(C2) THEN
178
                    FAILED ("INCORRECT VALUE FOR QUALIFICATION");
179
               END IF;
180
 
181
               C3 := CHECK_TYPE'VALUE ("TWO");
182
               IF C3 /= IDENT(C2) THEN
183
                    FAILED ("INCORRECT VALUE FOR ASSIGNMENT");
184
               END IF;
185
 
186
          END GENPROC;
187
 
188
          PROCEDURE NEWPROC IS NEW GENPROC (BASIC_ENUM);
189
 
190
     BEGIN
191
 
192
          NEWPROC (ZERO, ONE, TWO);
193
 
194
     END;
195
 
196
     RESULT;
197
 
198
END CD2A23E;

powered by: WebSVN 2.1.0

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