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

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C36205L.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
--      FOR GENERIC PROCEDURES, CHECK THAT ATTRIBUTES GIVE THE
27
--      CORRECT VALUES FOR UNCONSTRAINED FORMAL PARAMETERS.
28
--      BASIC CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS PASSED AS
29
--      PARAMETERS TO GENERIC PROCEDURES
30
 
31
-- HISTORY
32
--      EDWARD V. BERARD, 9 AUGUST 1990
33
--      DAS   8 OCT 1990   ADDED OUT MODE PARAMETER TO GENERIC
34
--                         PROCEDURE TEST_PROCEDURE AND FORMAL
35
--                         GENERIC PARAMETER COMPONENT_VALUE.
36
 
37
WITH REPORT ;
38
 
39
PROCEDURE C36205L IS
40
 
41
     SHORT_START : CONSTANT := -100 ;
42
     SHORT_END   : CONSTANT := 100 ;
43
     TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
44
     SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ;
45
 
46
     MEDIUM_START    : CONSTANT := 1 ;
47
     MEDIUM_END      : CONSTANT := 100 ;
48
     TYPE MEDIUM_RANGE IS RANGE MEDIUM_START .. MEDIUM_END ;
49
     MEDIUM_LENGTH : CONSTANT NATURAL := (MEDIUM_END - MEDIUM_START
50
                                          + 1) ;
51
 
52
     TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
53
                         SEP, OCT, NOV, DEC) ;
54
     TYPE DAY_TYPE IS RANGE 1 .. 31 ;
55
     TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
56
     TYPE DATE IS RECORD
57
          MONTH : MONTH_TYPE ;
58
          DAY   : DAY_TYPE ;
59
          YEAR  : YEAR_TYPE ;
60
     END RECORD ;
61
 
62
     TODAY : DATE := (MONTH => AUG,
63
                      DAY   => 9,
64
                      YEAR  => 1990) ;
65
 
66
     SUBTYPE SHORT_STRING IS STRING (1 ..5) ;
67
 
68
     DEFAULT_STRING : SHORT_STRING := "ABCDE" ;
69
 
70
     TYPE FIRST_TEMPLATE IS ARRAY (SHORT_RANGE RANGE <>,
71
                                   MEDIUM_RANGE RANGE <>) OF DATE ;
72
 
73
     TYPE SECOND_TEMPLATE IS ARRAY (MONTH_TYPE RANGE <>,
74
                                    DAY_TYPE RANGE <>) OF SHORT_STRING ;
75
 
76
     TYPE THIRD_TEMPLATE IS ARRAY (CHARACTER RANGE <>,
77
                                   BOOLEAN RANGE <>) OF DAY_TYPE ;
78
 
79
     FIRST_ARRAY      : FIRST_TEMPLATE (-10 .. 10, 27 .. 35)
80
                            := (-10 .. 10 =>
81
                               (27 .. 35 => TODAY)) ;
82
     SECOND_ARRAY     : SECOND_TEMPLATE (JAN .. JUN, 1 .. 25)
83
                            := (JAN .. JUN =>
84
                               (1 .. 25 => DEFAULT_STRING)) ;
85
     THIRD_ARRAY      : THIRD_TEMPLATE ('A' .. 'Z', FALSE .. TRUE)
86
                            := ('A' .. 'Z' =>
87
                               (FALSE .. TRUE => DAY_TYPE (9))) ;
88
 
89
     FOURTH_ARRAY    : FIRST_TEMPLATE (0 .. 27, 75 .. 100)
90
                            := (0 .. 27 =>
91
                               (75 .. 100 => TODAY)) ;
92
     FIFTH_ARRAY     : SECOND_TEMPLATE (JUL .. OCT, 6 .. 10)
93
                            := (JUL .. OCT =>
94
                               (6 .. 10 => DEFAULT_STRING)) ;
95
     SIXTH_ARRAY      : THIRD_TEMPLATE ('X' .. 'Z', TRUE .. TRUE)
96
                            := ('X' .. 'Z' =>
97
                               (TRUE .. TRUE => DAY_TYPE (31))) ;
98
 
99
     GENERIC
100
 
101
          TYPE FIRST_INDEX IS (<>) ;
102
          TYPE SECOND_INDEX IS (<>) ;
103
          TYPE COMPONENT_TYPE IS PRIVATE ;
104
          TYPE UNCONSTRAINED_ARRAY IS ARRAY (FIRST_INDEX RANGE <>,
105
                    SECOND_INDEX RANGE <>) OF COMPONENT_TYPE ;
106
          COMPONENT_VALUE: IN  COMPONENT_TYPE;
107
 
108
     PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
109
                               FFIFS        : IN FIRST_INDEX ;
110
                               FFILS        : IN FIRST_INDEX ;
111
                               FSIFS        : IN SECOND_INDEX ;
112
                               FSILS        : IN SECOND_INDEX ;
113
                               FFLEN        : IN NATURAL ;
114
                               FSLEN        : IN NATURAL ;
115
                               FFIRT        : IN FIRST_INDEX ;
116
                               FSIRT        : IN SECOND_INDEX ;
117
                               SECOND       : OUT UNCONSTRAINED_ARRAY ;
118
                               SFIFS        : IN FIRST_INDEX ;
119
                               SFILS        : IN FIRST_INDEX ;
120
                               SSIFS        : IN SECOND_INDEX ;
121
                               SSILS        : IN SECOND_INDEX ;
122
                               SFLEN        : IN NATURAL ;
123
                               SSLEN        : IN NATURAL ;
124
                               SFIRT        : IN FIRST_INDEX ;
125
                               SSIRT        : IN SECOND_INDEX ;
126
                               REMARKS      : IN STRING) ;
127
 
128
     PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
129
                               FFIFS        : IN FIRST_INDEX ;
130
                               FFILS        : IN FIRST_INDEX ;
131
                               FSIFS        : IN SECOND_INDEX ;
132
                               FSILS        : IN SECOND_INDEX ;
133
                               FFLEN        : IN NATURAL ;
134
                               FSLEN        : IN NATURAL ;
135
                               FFIRT        : IN FIRST_INDEX ;
136
                               FSIRT        : IN SECOND_INDEX ;
137
                               SECOND       : OUT UNCONSTRAINED_ARRAY ;
138
                               SFIFS        : IN FIRST_INDEX ;
139
                               SFILS        : IN FIRST_INDEX ;
140
                               SSIFS        : IN SECOND_INDEX ;
141
                               SSILS        : IN SECOND_INDEX ;
142
                               SFLEN        : IN NATURAL ;
143
                               SSLEN        : IN NATURAL ;
144
                               SFIRT        : IN FIRST_INDEX ;
145
                               SSIRT        : IN SECOND_INDEX ;
146
                               REMARKS      : IN STRING) IS
147
 
148
     BEGIN -- TEST_PROCEDURE
149
 
150
          IF (FIRST'FIRST /= FFIFS) OR
151
             (FIRST'FIRST (1) /= FFIFS) OR
152
             (FIRST'FIRST (2) /= FSIFS) OR
153
             (SECOND'FIRST /= SFIFS) OR
154
             (SECOND'FIRST (1) /= SFIFS) OR
155
             (SECOND'FIRST (2) /= SSIFS) THEN
156
               REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
157
          END IF ;
158
 
159
          IF (FIRST'LAST /= FFILS) OR
160
             (FIRST'LAST (1) /= FFILS) OR
161
             (FIRST'LAST (2) /= FSILS) OR
162
             (SECOND'LAST /= SFILS) OR
163
             (SECOND'LAST (1) /= SFILS) OR
164
             (SECOND'LAST (2) /= SSILS) THEN
165
               REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
166
          END IF ;
167
 
168
          IF (FIRST'LENGTH /= FFLEN) OR
169
             (FIRST'LENGTH (1) /= FFLEN) OR
170
             (FIRST'LENGTH (2) /= FSLEN) OR
171
             (SECOND'LENGTH /= SFLEN) OR
172
             (SECOND'LENGTH (1) /= SFLEN) OR
173
             (SECOND'LENGTH (2) /= SSLEN) THEN
174
               REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
175
          END IF ;
176
 
177
          IF (FFIRT NOT IN FIRST'RANGE (1)) OR
178
             (FFIRT NOT IN FIRST'RANGE) OR
179
             (SFIRT NOT IN SECOND'RANGE (1)) OR
180
             (SFIRT NOT IN SECOND'RANGE) OR
181
             (FSIRT NOT IN FIRST'RANGE (2)) OR
182
             (SSIRT NOT IN SECOND'RANGE (2)) THEN
183
               REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE " &
184
                              "ATTRIBUTE.  " & REMARKS) ;
185
          END IF ;
186
 
187
          -- ASSIGN VALUES TO THE ARRAY PARAMETER OF MODE OUT
188
          FOR I IN SECOND'RANGE(1) LOOP
189
               FOR J IN SECOND'RANGE(2) LOOP
190
                    SECOND(I, J) := COMPONENT_VALUE;
191
               END LOOP;
192
          END LOOP;
193
 
194
     END TEST_PROCEDURE ;
195
 
196
     PROCEDURE FIRST_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
197
          FIRST_INDEX           => SHORT_RANGE,
198
          SECOND_INDEX          => MEDIUM_RANGE,
199
          COMPONENT_TYPE        => DATE,
200
          UNCONSTRAINED_ARRAY   => FIRST_TEMPLATE,
201
          COMPONENT_VALUE       => TODAY) ;
202
 
203
     PROCEDURE SECOND_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
204
          FIRST_INDEX           => MONTH_TYPE,
205
          SECOND_INDEX          => DAY_TYPE,
206
          COMPONENT_TYPE        => SHORT_STRING,
207
          UNCONSTRAINED_ARRAY   => SECOND_TEMPLATE,
208
          COMPONENT_VALUE       => DEFAULT_STRING) ;
209
 
210
     PROCEDURE THIRD_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
211
          FIRST_INDEX           => CHARACTER,
212
          SECOND_INDEX          => BOOLEAN,
213
          COMPONENT_TYPE        => DAY_TYPE,
214
          UNCONSTRAINED_ARRAY   => THIRD_TEMPLATE,
215
          COMPONENT_VALUE       => DAY_TYPE'FIRST) ;
216
 
217
 
218
BEGIN  -- C36205L
219
 
220
      REPORT.TEST ( "C36205L","FOR GENERIC PROCEDURES, CHECK THAT " &
221
                    "ATTRIBUTES GIVE THE CORRECT VALUES FOR " &
222
                    "UNCONSTRAINED FORMAL PARAMETERS.  BASIC " &
223
                    "CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS " &
224
                    "PASSED AS PARAMETERS TO GENERIC PROCEDURES");
225
 
226
     FIRST_TEST_PROCEDURE (FIRST        => FIRST_ARRAY,
227
                           FFIFS        => -10,
228
                           FFILS        => 10,
229
                           FSIFS        => 27,
230
                           FSILS        => 35,
231
                           FFLEN        => 21,
232
                           FSLEN        => 9,
233
                           FFIRT        => 0,
234
                           FSIRT        => 29,
235
                           SECOND       => FOURTH_ARRAY,
236
                           SFIFS        => 0,
237
                           SFILS        => 27,
238
                           SSIFS        => 75,
239
                           SSILS        => 100,
240
                           SFLEN        => 28,
241
                           SSLEN        => 26,
242
                           SFIRT        => 5,
243
                           SSIRT        => 100,
244
                           REMARKS      => "FIRST_TEST_PROCEDURE") ;
245
 
246
     SECOND_TEST_PROCEDURE (FIRST        => SECOND_ARRAY,
247
                            FFIFS        => JAN,
248
                            FFILS        => JUN,
249
                            FSIFS        => 1,
250
                            FSILS        => 25,
251
                            FFLEN        => 6,
252
                            FSLEN        => 25,
253
                            FFIRT        => MAR,
254
                            FSIRT        => 17,
255
                            SECOND       => FIFTH_ARRAY,
256
                            SFIFS        => JUL,
257
                            SFILS        => OCT,
258
                            SSIFS        => 6,
259
                            SSILS        => 10,
260
                            SFLEN        => 4,
261
                            SSLEN        => 5,
262
                            SFIRT        => JUL,
263
                            SSIRT        => 6,
264
                            REMARKS      => "SECOND_TEST_PROCEDURE") ;
265
 
266
     THIRD_TEST_PROCEDURE (FIRST        => THIRD_ARRAY,
267
                           FFIFS        => 'A',
268
                           FFILS        => 'Z',
269
                           FSIFS        => FALSE,
270
                           FSILS        => TRUE,
271
                           FFLEN        => 26,
272
                           FSLEN        => 2,
273
                           FFIRT        => 'T',
274
                           FSIRT        => TRUE,
275
                           SECOND       => SIXTH_ARRAY,
276
                           SFIFS        => 'X',
277
                           SFILS        => 'Z',
278
                           SSIFS        => TRUE,
279
                           SSILS        => TRUE,
280
                           SFLEN        => 3,
281
                           SSLEN        => 1,
282
                           SFIRT        => 'Z',
283
                           SSIRT        => TRUE,
284
                           REMARKS      => "THIRD_TEST_PROCEDURE") ;
285
 
286
      REPORT.RESULT ;
287
 
288
END C36205L ;

powered by: WebSVN 2.1.0

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