1-- 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
37WITH REPORT ;
38
39PROCEDURE 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
218BEGIN  -- 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
288END C36205L ;
289