1-- CC1018A.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 FORMAL OUT PARAMETER OF A GENERIC FORMAL SUBPROGRAM CAN
26-- HAVE A FORMAL LIMITED TYPE AND AN ARRAY TYPE WITH LIMITED COMPONENTS.
27
28-- AH  10/3/86
29
30WITH REPORT; USE REPORT;
31PROCEDURE CC1018A IS
32     TYPE INT IS RANGE 1..10;
33     TYPE ARR IS ARRAY (INTEGER RANGE <>) OF INT;
34     INT_OBJ : INT := 4;
35     ARR_OBJ : ARR(1..5) := (2, 8, 2, 8, 2);
36
37     GENERIC
38          TYPE GLP IS LIMITED PRIVATE;
39          TYPE GARR IS ARRAY (INTEGER RANGE <>) OF GLP;
40          LP_OBJ : IN OUT GLP;
41          GA_OBJ : IN OUT GARR;
42          WITH PROCEDURE P (X : OUT GLP; Y : OUT GARR);
43          WITH FUNCTION SAME (LEFT, RIGHT : GLP) RETURN BOOLEAN;
44     PROCEDURE GEN_PROC;
45
46     PROCEDURE GET_VALUES (X1 : OUT INT; Y1 : OUT ARR) IS
47     BEGIN
48          X1 := 4;
49          Y1 := (2, 8, 2, 8, 2);
50     END GET_VALUES;
51
52     FUNCTION SAME_VALUE (LEFT, RIGHT : INT) RETURN BOOLEAN IS
53     BEGIN
54          RETURN LEFT = RIGHT;
55     END SAME_VALUE;
56
57     PROCEDURE GEN_PROC IS
58          LP : GLP;
59          A : GARR(1..5);
60     BEGIN
61          P(LP, A);
62          IF NOT SAME(LP, LP_OBJ) THEN
63               FAILED ("LIMITED PRIVATE TYPE HAS INCORRECT VALUE");
64          END IF;
65
66          FOR INDEX IN A'RANGE LOOP
67               IF NOT SAME(A(INDEX), GA_OBJ(INDEX)) THEN
68                    FAILED ("LIMITED PRIVATE TYPE COMPONENT " &
69                            "HAS INCORRECT VALUE");
70               END IF;
71          END LOOP;
72     END GEN_PROC;
73
74     PROCEDURE TEST_LP IS NEW GEN_PROC(INT, ARR, INT_OBJ, ARR_OBJ,
75                                       GET_VALUES, SAME_VALUE);
76
77BEGIN
78     TEST ("CC1018A", "A GENERIC FORMAL SUBPROGRAM OUT PRARAMETER " &
79                      "CAN HAVE A LIMITED TYPE");
80     TEST_LP;
81
82     RESULT;
83END CC1018A;
84