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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CC3019B2M.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 INSTANTIATIONS OF UNITS WITHIN GENERIC UNITS, E.G.,
26
--  TO SUPPORT ITERATORS. THIS TEST SPECIFICALLY CHECKS THAT A
27
--  NESTING LEVEL OF 2 IS SUPPORTED FOR GENERICS.
28
--
29
--  *** THIS IS THE MAIN PROGRAM. IT MUST BE COMPILED AFTER THE
30
--  *** SOURCE CODE IN FILES CC3019B0.ADA AND CC3019B1.ADA HAVE
31
--  *** BEEN COMPILED.
32
--
33
-- HISTORY:
34
--         EDWARD V. BERARD, 31 AUGUST 1990
35
 
36
WITH REPORT ;
37
WITH CC3019B1_STACK_CLASS ;
38
 
39
PROCEDURE CC3019B2M IS
40
 
41
     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
42
                         SEP, OCT, NOV, DEC) ;
43
     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
44
     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
45
     TYPE DATE IS RECORD
46
          MONTH : MONTH_TYPE ;
47
          DAY   : DAY_TYPE ;
48
          YEAR  : YEAR_TYPE ;
49
     END RECORD ;
50
 
51
     STORE_DATE     : DATE ;
52
 
53
     TODAY        : DATE := (MONTH => AUG,
54
                             DAY   => 31,
55
                             YEAR  => 1990) ;
56
 
57
     FIRST_DATE   : DATE := (MONTH => JUN,
58
                             DAY   => 4,
59
                             YEAR  => 1967) ;
60
 
61
     BIRTH_DATE   : DATE := (MONTH => OCT,
62
                             DAY   => 3,
63
                             YEAR  => 1949) ;
64
 
65
     WALL_DATE    : DATE := (MONTH => NOV,
66
                             DAY   => 9,
67
                             YEAR  => 1989) ;
68
 
69
     PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
70
                       TO_THIS_DATE              : IN OUT DATE) ;
71
 
72
     FUNCTION IS_EQUAL (LEFT  : IN DATE ;
73
                        RIGHT : IN DATE) RETURN BOOLEAN ;
74
 
75
     PACKAGE DATE_STACK IS
76
          NEW CC3019B1_STACK_CLASS (ELEMENT => DATE,
77
                                    ASSIGN  => ASSIGN,
78
                                    "="     => IS_EQUAL) ;
79
 
80
     FIRST_DATE_STACK    : DATE_STACK.STACK ;
81
     SECOND_DATE_STACK   : DATE_STACK.STACK ;
82
     THIRD_DATE_STACK    : DATE_STACK.STACK ;
83
 
84
     FUNCTION "=" (LEFT  : IN DATE_STACK.STACK ;
85
                   RIGHT : IN DATE_STACK.STACK) RETURN BOOLEAN
86
                   RENAMES DATE_STACK."=" ;
87
 
88
     PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE    : IN OUT DATE ;
89
                       TO_THIS_DATE              : IN OUT DATE) IS
90
 
91
     BEGIN -- ASSIGN
92
 
93
          TO_THIS_DATE := THE_VALUE_OF_THIS_DATE ;
94
 
95
     END ASSIGN ;
96
 
97
     FUNCTION IS_EQUAL (LEFT  : IN DATE ;
98
                        RIGHT : IN DATE) RETURN BOOLEAN IS
99
 
100
     BEGIN -- IS_EQUAL
101
 
102
          RETURN (LEFT.MONTH = RIGHT.MONTH) AND
103
                 (LEFT.DAY = RIGHT.DAY) AND
104
                 (LEFT.YEAR = RIGHT.YEAR) ;
105
 
106
     END IS_EQUAL ;
107
 
108
BEGIN  -- CC3019B2M
109
 
110
     REPORT.TEST ("CC3019B2M",
111
                  "CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC " &
112
                  "UNITS, E.G., TO SUPPORT ITERATORS. THIS TEST " &
113
                  "SPECIFICALLY CHECKS THAT A NESTING LEVEL OF " &
114
                  "2 IS SUPPORTED FOR GENERICS.") ;
115
 
116
     DATE_STACK.CLEAR (THIS_STACK => FIRST_DATE_STACK) ;
117
     IF DATE_STACK.NUMBER_OF_ELEMENTS
118
        (ON_THIS_STACK => FIRST_DATE_STACK) /= 0 THEN
119
          REPORT.FAILED (
120
               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 1") ;
121
     END IF ;
122
 
123
     DATE_STACK.PUSH (THIS_ELEMENT     => TODAY,
124
                      ON_TO_THIS_STACK => FIRST_DATE_STACK) ;
125
     IF DATE_STACK.NUMBER_OF_ELEMENTS
126
        (ON_THIS_STACK => FIRST_DATE_STACK) /= 1 THEN
127
          REPORT.FAILED (
128
               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 2") ;
129
     END IF ;
130
 
131
     DATE_STACK.PUSH (THIS_ELEMENT     => FIRST_DATE,
132
                      ON_TO_THIS_STACK => FIRST_DATE_STACK) ;
133
     IF DATE_STACK.NUMBER_OF_ELEMENTS
134
        (ON_THIS_STACK => FIRST_DATE_STACK) /= 2 THEN
135
          REPORT.FAILED (
136
               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 3") ;
137
     END IF ;
138
 
139
     DATE_STACK.PUSH (THIS_ELEMENT     => BIRTH_DATE,
140
                      ON_TO_THIS_STACK => FIRST_DATE_STACK) ;
141
     IF DATE_STACK.NUMBER_OF_ELEMENTS
142
        (ON_THIS_STACK => FIRST_DATE_STACK) /= 3 THEN
143
          REPORT.FAILED (
144
               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 4") ;
145
     END IF ;
146
 
147
     DATE_STACK.POP (THIS_ELEMENT   => STORE_DATE,
148
                           OFF_THIS_STACK => FIRST_DATE_STACK) ;
149
     IF DATE_STACK.NUMBER_OF_ELEMENTS
150
        (ON_THIS_STACK => FIRST_DATE_STACK) /= 2 THEN
151
          REPORT.FAILED (
152
               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 5") ;
153
     END IF ;
154
 
155
     IF STORE_DATE /= BIRTH_DATE THEN
156
          REPORT.FAILED (
157
               "IMPROPER VALUE REMOVED FROM STACK - 1") ;
158
     END IF ;
159
 
160
     DATE_STACK.CLEAR (THIS_STACK => SECOND_DATE_STACK) ;
161
     IF DATE_STACK.NUMBER_OF_ELEMENTS
162
        (ON_THIS_STACK => SECOND_DATE_STACK) /= 0 THEN
163
          REPORT.FAILED (
164
               "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 6") ;
165
     END IF ;
166
 
167
     DATE_STACK.COPY (THIS_STACK    => FIRST_DATE_STACK,
168
                      TO_THIS_STACK => SECOND_DATE_STACK) ;
169
 
170
     IF FIRST_DATE_STACK /= SECOND_DATE_STACK THEN
171
          REPORT.FAILED (
172
               "PROBLEMS WITH COPY OR TEST FOR EQUALITY") ;
173
     END IF ;
174
 
175
     DATE_STACK.POP (THIS_ELEMENT   => STORE_DATE,
176
                     OFF_THIS_STACK => SECOND_DATE_STACK) ;
177
     DATE_STACK.PUSH (THIS_ELEMENT     => WALL_DATE,
178
                      ON_TO_THIS_STACK => SECOND_DATE_STACK) ;
179
     IF FIRST_DATE_STACK = SECOND_DATE_STACK THEN
180
          REPORT.FAILED (
181
               "PROBLEMS WITH POP OR TEST FOR EQUALITY") ;
182
     END IF ;
183
 
184
     UNDERFLOW_EXCEPTION_TEST:
185
 
186
     BEGIN  -- UNDERFLOW_EXCEPTION_TEST
187
 
188
          DATE_STACK.CLEAR (THIS_STACK => THIRD_DATE_STACK) ;
189
          DATE_STACK.POP (THIS_ELEMENT      => STORE_DATE,
190
                          OFF_THIS_STACK    => THIRD_DATE_STACK) ;
191
          REPORT.FAILED ("UNDERFLOW EXCEPTION NOT RAISED") ;
192
 
193
     EXCEPTION
194
 
195
          WHEN DATE_STACK.UNDERFLOW => NULL ;  -- CORRECT EXCEPTION
196
                                               -- RAISED
197
          WHEN OTHERS =>
198
               REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
199
                              "UNDERFLOW EXCEPTION TEST") ;
200
 
201
     END UNDERFLOW_EXCEPTION_TEST ;
202
 
203
     OVERFLOW_EXCEPTION_TEST:
204
 
205
     BEGIN  -- OVERFLOW_EXCEPTION_TEST
206
 
207
          DATE_STACK.CLEAR (THIS_STACK => THIRD_DATE_STACK) ;
208
          FOR INDEX IN 1 .. 10 LOOP
209
               DATE_STACK.PUSH ( THIS_ELEMENT     => TODAY,
210
                                 ON_TO_THIS_STACK => THIRD_DATE_STACK) ;
211
          END LOOP ;
212
 
213
          DATE_STACK.PUSH (THIS_ELEMENT     => TODAY,
214
                           ON_TO_THIS_STACK => THIRD_DATE_STACK) ;
215
          REPORT.FAILED ("OVERFLOW EXCEPTION NOT RAISED") ;
216
 
217
     EXCEPTION
218
 
219
          WHEN DATE_STACK.OVERFLOW => NULL ;  -- CORRECT EXCEPTION
220
                                              -- RAISED
221
          WHEN OTHERS =>
222
               REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
223
                              "OVERFLOW EXCEPTION TEST") ;
224
 
225
     END OVERFLOW_EXCEPTION_TEST ;
226
 
227
     LOCAL_BLOCK:
228
 
229
     DECLARE
230
 
231
          TYPE DATE_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF DATE ;
232
 
233
          FIRST_DATE_TABLE : DATE_TABLE ;
234
 
235
          TABLE_INDEX : POSITIVE := 1 ;
236
 
237
          PROCEDURE SHOW_DATES (THIS_DATE : IN  DATE ;
238
                                CONTINUE  : OUT BOOLEAN) ;
239
 
240
          PROCEDURE STORE_DATES (THIS_DATE : IN DATE ;
241
                                 CONTINUE  : OUT BOOLEAN) ;
242
 
243
          PROCEDURE SHOW_DATE_ITERATE IS NEW
244
               DATE_STACK.ITERATE (PROCESS => SHOW_DATES) ;
245
 
246
          PROCEDURE STORE_DATE_ITERATE IS NEW
247
               DATE_STACK.ITERATE (PROCESS => STORE_DATES) ;
248
 
249
          PROCEDURE SHOW_DATES (THIS_DATE : IN  DATE ;
250
                                CONTINUE  : OUT BOOLEAN) IS
251
          BEGIN  -- SHOW_DATES
252
 
253
                REPORT.COMMENT ("THE MONTH IS " &
254
                           MONTH_TYPE'IMAGE (THIS_DATE.MONTH)) ;
255
                REPORT.COMMENT ("THE DAY IS " &
256
                           DAY_TYPE'IMAGE (THIS_DATE.DAY)) ;
257
                REPORT.COMMENT ("THE YEAR IS " &
258
                           YEAR_TYPE'IMAGE (THIS_DATE.YEAR)) ;
259
 
260
                CONTINUE := TRUE ;
261
 
262
          END SHOW_DATES ;
263
 
264
          PROCEDURE STORE_DATES (THIS_DATE : IN  DATE ;
265
                                       CONTINUE  : OUT BOOLEAN) IS
266
          BEGIN  -- STORE_DATES
267
 
268
                FIRST_DATE_TABLE (TABLE_INDEX) := THIS_DATE ;
269
                TABLE_INDEX := TABLE_INDEX + 1 ;
270
 
271
                CONTINUE := TRUE ;
272
 
273
          END STORE_DATES ;
274
 
275
     BEGIN  -- LOCAL_BLOCK
276
 
277
          REPORT.COMMENT ("CONTENTS OF THE FIRST STACK") ;
278
          SHOW_DATE_ITERATE (OVER_THIS_STACK => FIRST_DATE_STACK) ;
279
 
280
          REPORT.COMMENT ("CONTENTS OF THE SECOND STACK") ;
281
          SHOW_DATE_ITERATE (OVER_THIS_STACK => SECOND_DATE_STACK) ;
282
 
283
          STORE_DATE_ITERATE (OVER_THIS_STACK => FIRST_DATE_STACK) ;
284
          IF (FIRST_DATE_TABLE (1) /= TODAY) OR
285
               (FIRST_DATE_TABLE (2) /= FIRST_DATE) THEN
286
                     REPORT.FAILED ("PROBLEMS WITH ITERATION - 1") ;
287
          END IF ;
288
 
289
          TABLE_INDEX := 1 ;
290
          STORE_DATE_ITERATE (OVER_THIS_STACK => SECOND_DATE_STACK) ;
291
          IF (FIRST_DATE_TABLE (1) /= TODAY) OR
292
               (FIRST_DATE_TABLE (2) /= WALL_DATE) THEN
293
                     REPORT.FAILED ("PROBLEMS WITH ITERATION - 2") ;
294
          END IF ;
295
 
296
     END LOCAL_BLOCK ;
297
 
298
     REPORT.RESULT ;
299
 
300
END CC3019B2M ;

powered by: WebSVN 2.1.0

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