1-- C85013A.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:
26
27--   A) A SUBPROGRAM OR ENTRY CAN BE RENAMED WITH:
28--        A1) DIFFERENT PARAMETER NAMES;
29--        A2) DIFFERENT DEFAULT VALUES;
30--        A3) DIFFERENT PARAMETERS HAVING DEFAULT VALUES;
31--      AND THAT THE NEW NAMES/DEFAULTS ARE USED WHEN THE NEW NAME
32--      IS USED IN A CALL.
33
34--   B) FORMAL PARAMETER CONSTRAINTS FOR THE NEW NAME ARE IGNORED IN
35--      FAVOR OF THE CONSTRAINTS ASSOCIATED WITH THE RENAMED ENTITY.
36
37-- EG  02/22/84
38
39WITH REPORT;
40
41PROCEDURE C85013A IS
42
43     USE REPORT;
44
45BEGIN
46
47     TEST("C85013A","CHECK THAT A SUBPROGRAM CAN BE RENAMED AND " &
48                    "THAT THE NEW NAMES/DEFAULTS ARE USED WITH "  &
49                    "THE CONSTRAINTS ASSOCIATED WITH THE RENAMED" &
50                    " ENTITY");
51
52     DECLARE
53
54          TYPE TA IS ARRAY(1 .. 5) OF INTEGER;
55
56          FUNCTION PROC1 (A : INTEGER := 1;
57                          B : TA := (1 .. 5 => 1)) RETURN INTEGER;
58          FUNCTION PROCA (C : INTEGER := 1;
59                          D : TA := (1 .. 5 => 1)) RETURN INTEGER
60                          RENAMES PROC1;
61          FUNCTION PROCB (B : INTEGER := 1;
62                          A : TA := (1 .. 5 => 1)) RETURN INTEGER
63                          RENAMES PROC1;
64          FUNCTION PROCC (A : INTEGER := 2;
65                          B : TA := (1, 2, 3, 4, 5)) RETURN INTEGER
66                          RENAMES PROC1;
67          FUNCTION PROCD (C : INTEGER := 2;
68                          D : TA := (1, 2, 3, 4, 5))RETURN INTEGER
69                          RENAMES PROC1;
70
71          FUNCTION PROC1 (A : INTEGER := 1;
72                          B : TA := (1 .. 5 => 1)) RETURN INTEGER IS
73          BEGIN
74               FOR I IN 1 .. 5 LOOP
75                    IF A = B(I) THEN
76                         RETURN I;
77                    END IF;
78               END LOOP;
79               RETURN 0;
80          END PROC1;
81
82     BEGIN
83
84          IF PROC1 /= 1 THEN
85               FAILED ("CASE A : PARAMETERS NOT PROPERLY INITIALIZED");
86          END IF;
87          IF PROC1(A => 2) /= 0 THEN
88               FAILED ("CASE A : INCORRECT RESULT");
89          END IF;
90          IF PROCA /= 1 THEN
91               FAILED ("CASE A1 : INCORRECT RESULT (DEFAULT)");
92          END IF;
93          IF PROCA(D => (5, 4, 3, 2, 1)) /= 5 THEN
94               FAILED ("CASE A1 : INCORRECT RESULT");
95          END IF;
96          IF PROCB /= 1 THEN
97               FAILED ("CASE A1 : INCORRECT RESULT (DEFAULT)");
98          END IF;
99          IF PROCB(A => (5, 4, 3, 2, 1), B => 2) /= 4 THEN
100               FAILED ("CASE A1 : INCORRECT RESULT ");
101          END IF;
102          IF PROCC /= 2 THEN
103               FAILED ("CASE A2 : INCORRECT RESULT (DEFAULT)");
104          END IF;
105          IF PROCC(3) /= 3 THEN
106               FAILED ("CASE A2 : INCORRECT RESULT ");
107          END IF;
108          IF PROCD /= 2 THEN
109               FAILED ("CASE A2 : INCORRECT RESULT (DEFAULT)");
110          END IF;
111          IF PROCD(4) /= 4 THEN
112               FAILED ("CASE A2 : INCORRECT RESULT ");
113          END IF;
114
115     END;
116
117     DECLARE
118
119          TYPE TA IS ARRAY (INTEGER RANGE <>) OF INTEGER;
120          SUBTYPE STA1 IS TA(1 .. 5);
121          SUBTYPE STA2 IS TA(11 .. 15);
122
123          PROCEDURE PROC1 (A : STA1;
124                           ID : STRING);
125          PROCEDURE PROC2 (A : STA2;
126                           ID : STRING) RENAMES PROC1;
127
128          PROCEDURE PROC1 (A : STA1;
129                           ID : STRING) IS
130          BEGIN
131               IF A'FIRST /= IDENT_INT(1) THEN
132                    FAILED ("CASE B : INCORRECT LOWER BOUND " &
133                            "GENERATED BY " & ID);
134               END IF;
135               IF A'LAST /= IDENT_INT(5) THEN
136                    FAILED ("CASE B : INCORRECT UPPER BOUND " &
137                            "GENERATED BY " & ID);
138               END IF;
139          END PROC1;
140
141     BEGIN
142
143          PROC1 ((1, 2, 3, 4, 5),"PROC1");
144          PROC2 ((6, 7, 8, 9, 10),"PROC2");
145
146     END;
147
148     RESULT;
149
150END C85013A;
151