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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CC3123A.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 DEFAULT EXPRESSIONS FOR GENERIC IN PARAMETERS ARE ONLY
26
-- EVALUATED IF THERE ARE NO ACTUAL PARAMETERS.
27
 
28
-- TBN  12/01/86
29
 
30
WITH REPORT; USE REPORT;
31
PROCEDURE CC3123A IS
32
 
33
BEGIN
34
     TEST ("CC3123A", "CHECK THAT DEFAULT EXPRESSIONS FOR GENERIC IN " &
35
                      "PARAMETERS ARE ONLY EVALUATED IF THERE ARE " &
36
                      "NO ACTUAL PARAMETERS");
37
     DECLARE
38
          TYPE ENUM IS (I, II, III);
39
          OBJ_INT : INTEGER := 1;
40
          OBJ_ENUM : ENUM := I;
41
 
42
          GENERIC
43
               GEN_INT : IN INTEGER := IDENT_INT(2);
44
               GEN_BOOL : IN BOOLEAN := IDENT_BOOL(FALSE);
45
               GEN_ENUM : IN ENUM := II;
46
          PACKAGE P IS
47
               PAC_INT : INTEGER := GEN_INT;
48
               PAC_BOOL : BOOLEAN := GEN_BOOL;
49
               PAC_ENUM : ENUM := GEN_ENUM;
50
          END P;
51
 
52
          PACKAGE P1 IS NEW P;
53
          PACKAGE P2 IS
54
               NEW P (IDENT_INT(OBJ_INT), GEN_ENUM => OBJ_ENUM);
55
          PACKAGE P3 IS NEW P (GEN_BOOL => IDENT_BOOL(TRUE));
56
     BEGIN
57
          IF P1.PAC_INT /= 2 OR P1.PAC_BOOL OR P1.PAC_ENUM /= II THEN
58
               FAILED ("DEFAULT VALUES WERE NOT EVALUATED");
59
          END IF;
60
          IF P2.PAC_INT /= 1 OR P2.PAC_BOOL OR P2.PAC_ENUM /= I THEN
61
               FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " &
62
                       "- 1");
63
          END IF;
64
          IF P3.PAC_INT /= 2 OR NOT(P3.PAC_BOOL) OR
65
               P3.PAC_ENUM /= II THEN
66
               FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " &
67
                       "- 2");
68
          END IF;
69
     END;
70
 
71
     -------------------------------------------------------------------
72
     DECLARE
73
          OBJ_INT1 : INTEGER := 3;
74
 
75
          FUNCTION FUNC (X : INTEGER) RETURN INTEGER;
76
 
77
          GENERIC
78
               GEN_INT1 : IN INTEGER := FUNC (1);
79
               GEN_INT2 : IN INTEGER := FUNC (GEN_INT1 + 1);
80
          PROCEDURE PROC;
81
 
82
          PROCEDURE PROC IS
83
               PROC_INT1 : INTEGER := GEN_INT1;
84
               PROC_INT2 : INTEGER := GEN_INT2;
85
          BEGIN
86
               IF PROC_INT1 /= 3 THEN
87
                    FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
88
                            "CORRECTLY - 3");
89
               END IF;
90
               IF PROC_INT2 /= 4 THEN
91
                    FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
92
                            "CORRECTLY - 4");
93
               END IF;
94
          END PROC;
95
 
96
          FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS
97
          BEGIN
98
               IF X /= IDENT_INT(4) THEN
99
                    FAILED ("DEFAULT VALUES WERE NOT EVALUATED " &
100
                            "CORRECTLY - 5");
101
               END IF;
102
               RETURN IDENT_INT(X);
103
          END FUNC;
104
 
105
          PROCEDURE NEW_PROC IS NEW PROC (GEN_INT1 => OBJ_INT1);
106
 
107
     BEGIN
108
          NEW_PROC;
109
     END;
110
 
111
     -------------------------------------------------------------------
112
     DECLARE
113
          TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER;
114
          TYPE REC IS
115
               RECORD
116
                    ANS : BOOLEAN;
117
                    ARA : ARA_TYP;
118
               END RECORD;
119
          TYPE ARA_REC IS ARRAY (1 .. 5) OF REC;
120
 
121
          FUNCTION F (X : INTEGER) RETURN INTEGER;
122
 
123
          OBJ_REC : REC := (FALSE, (3, 4));
124
          OBJ_ARA : ARA_REC := (1 .. 5 => (FALSE, (3, 4)));
125
 
126
          GENERIC
127
               GEN_OBJ1 : IN ARA_TYP := (F(1), 2);
128
               GEN_OBJ2 : IN REC := (TRUE, GEN_OBJ1);
129
               GEN_OBJ3 : IN ARA_REC := (1 .. F(5) => (TRUE, (1, 2)));
130
          FUNCTION FUNC RETURN INTEGER;
131
 
132
          FUNCTION FUNC RETURN INTEGER IS
133
          BEGIN
134
               RETURN IDENT_INT(1);
135
          END FUNC;
136
 
137
          FUNCTION F (X : INTEGER) RETURN INTEGER IS
138
          BEGIN
139
               FAILED ("DEFAULT VALUES WERE EVALUATED - 1");
140
               RETURN IDENT_INT(X);
141
          END F;
142
 
143
          FUNCTION NEW_FUNC IS NEW FUNC ((3, 4), OBJ_REC, OBJ_ARA);
144
 
145
     BEGIN
146
          IF NOT EQUAL (NEW_FUNC, 1) THEN
147
               FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 1");
148
          END IF;
149
     END;
150
 
151
     -------------------------------------------------------------------
152
     DECLARE
153
          SUBTYPE INT IS INTEGER RANGE 1 .. 5;
154
          TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER;
155
          TYPE COLOR IS (RED, WHITE);
156
          TYPE CON_REC (D : INT) IS
157
               RECORD
158
                    A : COLOR;
159
                    B : ARA_TYP;
160
               END RECORD;
161
          TYPE UNCON_OR_CON_REC (D : INT := 2) IS
162
               RECORD
163
                    A : COLOR;
164
                    B : ARA_TYP;
165
               END RECORD;
166
          FUNCTION F (X : COLOR) RETURN COLOR;
167
 
168
          OBJ_CON1 : CON_REC (1) := (1, WHITE, (3, 4));
169
          OBJ_UNCON : UNCON_OR_CON_REC := (2, WHITE, (3, 4));
170
          OBJ_CON2 : UNCON_OR_CON_REC (3) := (3, WHITE, (3, 4));
171
 
172
          GENERIC
173
               GEN_CON1 : IN CON_REC := (2, F(RED), (1, 2));
174
               GEN_UNCON : IN UNCON_OR_CON_REC := (2, F(RED), (1, 2));
175
               GEN_CON2 : IN UNCON_OR_CON_REC := GEN_UNCON;
176
          FUNCTION FUNC RETURN INTEGER;
177
 
178
          FUNCTION FUNC RETURN INTEGER IS
179
          BEGIN
180
               RETURN IDENT_INT(1);
181
          END FUNC;
182
 
183
          FUNCTION F (X : COLOR) RETURN COLOR IS
184
          BEGIN
185
               FAILED ("DEFAULT VALUES WERE EVALUATED - 2");
186
               RETURN WHITE;
187
          END F;
188
 
189
          FUNCTION NEW_FUNC IS NEW FUNC (OBJ_CON1, OBJ_UNCON, OBJ_CON2);
190
 
191
     BEGIN
192
          IF NOT EQUAL (NEW_FUNC, 1) THEN
193
               FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 2");
194
          END IF;
195
     END;
196
 
197
     RESULT;
198
END CC3123A;

powered by: WebSVN 2.1.0

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