1-- C74402A.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 A SUBPROGRAM PARAMETER OF A LIMITED TYPE MAY HAVE A
26-- DEFAULT EXPRESSION, EVEN IF THE SUBPROGRAM IS DECLARED OUTSIDE
27-- THE PACKAGE THAT DECLARES THE LIMITED TYPE.
28-- (SEE ALSO 6.4.2/T1 FOR TESTS OF OTHER LIMITED TYPES.)
29
30-- DSJ 5/6/83
31-- SPS 10/24/83
32
33WITH REPORT;
34PROCEDURE C74402A IS
35
36     USE REPORT;
37
38BEGIN
39
40     TEST("C74402A", "CHECK THAT A SUBPROGRAM PARAMETER OF A LIMITED " &
41                     "TYPE MAY HAVE A DEFAULT EXPRESSION, EVEN IF "    &
42                     "THE SUBPROGRAM IS DECLARED OUTSIDE THE PACKAGE " &
43                     "THAT DECLARES THE LIMITED TYPE");
44
45     DECLARE
46
47          PACKAGE PACK1 IS
48
49               TYPE LP1 IS LIMITED PRIVATE;
50               TYPE LP2 IS ARRAY (1 .. 2) OF LP1;
51               TYPE LP3 IS
52                    RECORD
53                         C1, C2 : LP2;
54                    END RECORD;
55
56               FUNCTION F1 RETURN LP1;
57               FUNCTION F2 RETURN LP2;
58               FUNCTION F3 RETURN LP3;
59
60               PROCEDURE G1 (X : LP1 := F1);      -- LEGAL
61               PROCEDURE G2 (X : LP2 := F2);      -- LEGAL
62               PROCEDURE G3 (X : LP3 := F3);      -- LEGAL
63
64          PRIVATE
65
66               TYPE LP1 IS NEW INTEGER;
67
68          END PACK1;
69
70          PACKAGE BODY PACK1 IS
71
72               FUNCTION F1 RETURN LP1 IS
73               BEGIN
74                    RETURN LP1'(1);
75               END F1;
76
77               FUNCTION F2 RETURN LP2 IS
78               BEGIN
79                    RETURN LP2'(2,3);
80               END F2;
81
82               FUNCTION F3 RETURN LP3 IS
83               BEGIN
84                    RETURN LP3'((4,5),(6,7));
85               END F3;
86
87               PROCEDURE G1 (X : LP1 := F1) IS
88               BEGIN
89                    IF X /= LP1'(1) THEN
90                         FAILED("WRONG DEFAULT VALUE - LP1");
91                    END IF;
92               END G1;
93
94               PROCEDURE G2 (X : LP2 := F2) IS
95               BEGIN
96                    IF X /= LP2'(2,3) THEN
97                         FAILED("WRONG DEFAULT VALUE - LP2");
98                    END IF;
99               END G2;
100
101               PROCEDURE G3 (X : LP3 := F3) IS
102               BEGIN
103                    IF X /= LP3'((4,5),(6,7)) THEN
104                         FAILED("WRONG DEFAULT VALUE - LP3");
105                    END IF;
106               END G3;
107
108          BEGIN
109
110               G1;            -- LEGAL, DEFAULT USED
111               G2;            -- LEGAL, DEFAULT USED
112               G3;            -- LEGAL, DEFAULT USED
113
114               G1(F1);        -- LEGAL
115               G2(F2);        -- LEGAL
116               G3(F3);        -- LEGAL
117
118          END PACK1;
119
120          USE PACK1;
121
122          PROCEDURE G4 (X : LP1 := F1) IS
123          BEGIN
124               G1;            -- LEGAL, DEFAULT USED
125               G1(X);
126          END G4;
127
128          PROCEDURE G5 (X : LP2 := F2) IS
129          BEGIN
130               G2;            -- LEGAL, DEFAULT USED
131               G2(X);
132          END G5;
133
134          PROCEDURE G6 (X : LP3 := F3) IS
135          BEGIN
136               G3;            -- DEFAULT USED
137               G3(X);
138          END G6;
139
140     BEGIN
141
142          G4;                 -- LEGAL, DEFAULT USED
143          G5;                 -- LEGAL, DEFAULT USED
144          G6;                 -- LEGAL, DEFAULT USED
145
146          G4(F1);             -- LEGAL
147          G5(F2);             -- LEGAL
148          G6(F3);             -- LEGAL
149
150     END;
151
152     RESULT;
153
154END C74402A;
155