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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CC3601A.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 PREDEFINED OPERATORS MAY BE PASSED AS ACTUAL
26
-- GENERIC SUBPROGRAM PARAMETERS (CHECKS FOR "=" AND "/=" ARE IN
27
-- CC3601C).
28
 
29
-- R.WILLIAMS 10/9/86
30
-- JRL        11/15/95 Added unknown discriminant part to all formal
31
--                     private types.
32
 
33
 
34
WITH REPORT; USE REPORT;
35
PROCEDURE CC3601A IS
36
 
37
     GENERIC
38
          TYPE T (<>) IS PRIVATE;
39
          V, V1 : T;
40
          KIND : STRING;
41
          WITH FUNCTION F1 (X : IN T) RETURN T;
42
     PACKAGE GP1 IS
43
          R : BOOLEAN := F1 (V) = V1;
44
     END GP1;
45
 
46
     PACKAGE BODY GP1 IS
47
     BEGIN
48
          IF NOT (IDENT_BOOL(R)) THEN
49
               FAILED ( "INCORRECT VALUE FOR UNARY OP - " & KIND);
50
          END IF;
51
     END GP1;
52
 
53
     GENERIC
54
          TYPE T (<>) IS PRIVATE;
55
          V, V1, V2 : IN T;
56
          KIND : STRING;
57
          WITH FUNCTION F1 (P1 : IN T; P2 : IN T) RETURN T;
58
     PACKAGE GP2 IS
59
          R : BOOLEAN := V /= F1 (V1, V2);
60
     END GP2;
61
 
62
     PACKAGE BODY GP2 IS
63
     BEGIN
64
          IF IDENT_BOOL (R) THEN
65
               FAILED ( "INCORRECT VALUE FOR BINARY OP - " & KIND);
66
          END IF;
67
     END GP2;
68
 
69
 
70
     GENERIC
71
          TYPE T1 (<>) IS PRIVATE;
72
          TYPE T2 (<>) IS PRIVATE;
73
          V1 : T1;
74
          V2 : T2;
75
          KIND : STRING;
76
          WITH FUNCTION F1 (X : IN T1) RETURN T2;
77
     PACKAGE GP3 IS
78
          R : BOOLEAN := F1 (V1) = V2;
79
     END GP3;
80
 
81
     PACKAGE BODY GP3 IS
82
     BEGIN
83
          IF NOT (IDENT_BOOL(R)) THEN
84
               FAILED ( "INCORRECT VALUE FOR OP - " & KIND);
85
          END IF;
86
     END GP3;
87
 
88
BEGIN
89
     TEST ( "CC3601A", "CHECK THAT PREDEFINED OPERATORS MAY BE " &
90
                       "PASSED AS ACTUAL GENERIC SUBPROGRAM " &
91
                       "PARAMETERS" );
92
 
93
 
94
     BEGIN -- CHECKS WITH RELATIONAL OPERATORS AND LOGICAL OPERATORS AS
95
           -- ACTUAL PARAMETERS.
96
 
97
          FOR I1 IN BOOLEAN LOOP
98
 
99
               FOR I2 IN BOOLEAN LOOP
100
                    COMMENT ( "B1 = " & BOOLEAN'IMAGE (I1) & " AND " &
101
                              "B2 = " & BOOLEAN'IMAGE (I2) );
102
                    DECLARE
103
                         B1 : BOOLEAN := IDENT_BOOL (I1);
104
                         B2 : BOOLEAN := IDENT_BOOL (I2);
105
 
106
                         PACKAGE P1 IS
107
                              NEW GP1 (BOOLEAN, NOT B2, B2,
108
                                       """NOT"" - 1", "NOT");
109
                         PACKAGE P2 IS
110
                              NEW GP2 (BOOLEAN, B1 OR B2, B1, B2,
111
                                       "OR", "OR");
112
                         PACKAGE P3 IS
113
                              NEW GP2 (BOOLEAN, B1 AND B2, B2, B1,
114
                                       "AND", "AND");
115
                         PACKAGE P4 IS
116
                              NEW GP2 (BOOLEAN, B1 /= B2, B1, B2,
117
                                       "XOR", "XOR");
118
                         PACKAGE P5 IS
119
                              NEW GP2 (BOOLEAN, B1 < B2, B1, B2,
120
                                       "<", "<");
121
                         PACKAGE P6 IS
122
                              NEW GP2 (BOOLEAN, B1 <= B2, B1, B2,
123
                                       "<=", "<=");
124
                         PACKAGE P7 IS
125
                              NEW GP2 (BOOLEAN, B1 > B2, B1, B2,
126
                                       ">", ">");
127
                         PACKAGE P8 IS
128
                              NEW GP2 (BOOLEAN, B1 >= B2, B1, B2,
129
                                       ">=", ">=");
130
 
131
                         TYPE AB IS ARRAY (BOOLEAN RANGE <> )
132
                              OF BOOLEAN;
133
                         AB1 : AB (BOOLEAN) := (B1, B2);
134
                         AB2 : AB (BOOLEAN) := (B2, B1);
135
                         T : AB (B1 .. B2) := (B1 .. B2 => TRUE);
136
                         F : AB (B1 .. B2) := (B1 .. B2 => FALSE);
137
                         VB1 : AB (B1 .. B1) := (B1 => B2);
138
                         VB2 : AB (B2 .. B2) := (B2 => B1);
139
 
140
                         PACKAGE P9 IS
141
                              NEW GP1 (AB, AB1, NOT AB1,
142
                                       """NOT"" - 2", "NOT");
143
                         PACKAGE P10 IS
144
                              NEW GP1 (AB, T, F,
145
                                       """NOT"" - 3", "NOT");
146
                         PACKAGE P11 IS
147
                              NEW GP1 (AB, VB2, (B2 => NOT B1),
148
                                       """NOT"" - 4", "NOT");
149
                         PACKAGE P12 IS
150
                              NEW GP2 (AB, AB1 AND AB2, AB1, AB2,
151
                                       "AND", "AND");
152
                    BEGIN
153
                         NULL;
154
                    END;
155
               END LOOP;
156
          END LOOP;
157
     END;
158
 
159
     DECLARE -- CHECKS WITH ADDING AND MULTIPLYING OPERATORS, "**", 
160
             -- AND "ABS".
161
 
162
          PACKAGE P1 IS NEW GP1 (INTEGER, -4, -4, """+"" - 1", "+");
163
 
164
          PACKAGE P2 IS NEW GP1 (FLOAT, 4.0, 4.0, """+"" - 2", "+");
165
 
166
          PACKAGE P3 IS NEW GP1 (DURATION, -4.0, -4.0, """+"" - 3",
167
                                 "+");
168
          PACKAGE P4 IS NEW GP1 (INTEGER, -4, 4, """-"" - 1", "-");
169
 
170
          PACKAGE P5 IS NEW GP1 (FLOAT, 0.0, 0.0, """-"" - 2", "-");
171
 
172
          PACKAGE P6 IS NEW GP1 (DURATION, 1.0, -1.0, """-"" - 3",
173
                                 "-");
174
          PACKAGE P7 IS NEW GP2 (INTEGER, 6, 1, 5, """+"" - 1", "+");
175
 
176
          PACKAGE P8 IS NEW GP2 (FLOAT, 6.0, 1.0, 5.0, """+"" - 2",
177
                                 "+");
178
          PACKAGE P9 IS NEW GP2 (DURATION, 6.0, 1.0, 5.0, """+"" - 3",
179
                                 "+");
180
          PACKAGE P10 IS NEW GP2 (INTEGER, 1, 6, 5, """-"" - 1",
181
                                  "-" );
182
          PACKAGE P11 IS NEW GP2 (DURATION, 11.0, 6.0,-5.0,
183
                                  """-"" - 2", "-");
184
          PACKAGE P12 IS NEW GP2 (FLOAT, 1.0, 6.0, 5.0, """-"" - 3",
185
                                  "-");
186
 
187
          SUBTYPE SUBINT IS INTEGER RANGE 0 .. 2;
188
          TYPE STR IS ARRAY (SUBINT RANGE <>) OF CHARACTER;
189
          VSTR : STR (0 .. 1) := "AB";
190
 
191
          PACKAGE P13 IS NEW GP2 (STR, VSTR (0 .. 0) &
192
                                      VSTR (1 .. 1),
193
                                      VSTR (0 .. 0),
194
                                      VSTR (1 .. 1), """&"" - 1", "&");
195
 
196
          PACKAGE P14 IS NEW GP2 (STR, VSTR (1 .. 1) &
197
                                      VSTR (0 .. 0),
198
                                      VSTR (1 .. 1),
199
                                      VSTR (0 .. 0), """&"" - 2", "&");
200
 
201
          PACKAGE P15 IS NEW GP2 (INTEGER, 0, -1, 0, """*"" - 1", "*");
202
 
203
          PACKAGE P16 IS NEW GP2 (FLOAT, 6.0, 3.0, 2.0, """*"" - 2",
204
                                  "*");
205
          PACKAGE P17 IS NEW GP2 (INTEGER, 0, 0, 6, """/"" - 1", "/");
206
 
207
          PACKAGE P18 IS NEW GP2 (FLOAT, 3.0, 6.0, 2.0, """/"" - 2",
208
                                  "/");
209
          PACKAGE P19 IS NEW GP2 (INTEGER, -1, -11, 5, "REM", "REM");
210
 
211
          PACKAGE P20 IS NEW GP2 (INTEGER, 4, -11, 5, "MOD", "MOD");
212
 
213
          PACKAGE P21 IS NEW GP1 (INTEGER, 5, 5, """ABS"" - 1", "ABS");
214
 
215
          PACKAGE P22 IS NEW GP1 (FLOAT, -5.0, 5.0, """ABS"" - 2",
216
                                  "ABS");
217
 
218
          PACKAGE P23 IS NEW GP1 (DURATION, 0.0, 0.0, """ABS"" - 3",
219
                                  "ABS");
220
 
221
          PACKAGE P24 IS NEW GP2 (INTEGER, 9, 3, 2, """**"" - 1",
222
                                  "**");
223
 
224
          PACKAGE P25 IS NEW GP2 (INTEGER, 1, 5, 0, """**"" - 2",
225
                                  "**");
226
 
227
     BEGIN
228
          NULL;
229
     END;
230
 
231
     DECLARE -- CHECKS WITH ATTRIBUTES.
232
 
233
          TYPE WEEKDAY IS (MON, TUES, WED, THUR, FRI);
234
 
235
          PACKAGE P1 IS NEW GP1 (WEEKDAY, TUES, WED, "WEEKDAY'SUCC",
236
                                 WEEKDAY'SUCC);
237
 
238
          PACKAGE P2 IS NEW GP1 (WEEKDAY, TUES, MON, "WEEKDAY'PRED",
239
                                 WEEKDAY'PRED);
240
 
241
          PACKAGE P3 IS NEW GP3 (WEEKDAY, STRING, THUR, "THUR",
242
                                 "WEEKDAY'IMAGE", WEEKDAY'IMAGE);
243
 
244
          PACKAGE P4 IS NEW GP3 (STRING, WEEKDAY, "FRI", FRI,
245
                                 "WEEKDAY'VALUE", WEEKDAY'VALUE);
246
     BEGIN
247
          NULL;
248
     END;
249
 
250
     RESULT;
251
END CC3601A;

powered by: WebSVN 2.1.0

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