1-- CA2009F0M.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--     CHECK THAT A GENERIC SUBPROGRAM SUBUNIT CAN BE SPECIFIED AND
27--     INSTANTIATED.  IN THIS TEST, SOME SUBUNIT BODIES ARE
28--     IN SEPARATE FILES.
29
30-- APPLICABILITY CRITERIA:
31--     THIS TEST MUST RUN AND REPORT "PASSED" FOR ALL ADA 95 IMPLEMENTATIONS.
32
33-- SEPARATE FILES ARE:
34--     CA2009F0M  THE MAIN PROCEDURE, WITH SUBUNIT BODIES FOR
35--                     PROC2 AND FUNC2.
36--     CA2009F1   A SUBUNIT PROCEDURE BODY (PROC1).
37--     CA2009F2   A SUBUNIT FUNCTION BODY  (FUNC1).
38
39-- HISTORY:
40--     BHS 08/01/84  CREATED ORIGINAL TEST.
41--     PWB 02/19/86  ADDED "SOME" TO FIRST COMMENT.
42--     BCB 01/05/88  MODIFIED HEADER.
43--     EDS 08/04/98  REMOVE CONTROL Z AT END OF FILE.
44--     RLB 09/13/99  UPDATED APPLICABILITY CRITERIA FOR ADA 95.
45--     RLB 09/15/99  REMOVED JUNK COMMENT.
46
47WITH REPORT;
48USE REPORT;
49PROCEDURE CA2009F0M IS
50
51     INT1 : INTEGER := 1;
52     INT2 : INTEGER := 2;
53     INT3 : INTEGER := 3;
54     INT4 : INTEGER := 4;
55
56
57     GENERIC
58          TYPE ELEM IS PRIVATE;
59          PCON1 : IN ELEM;
60          PVAR1 : IN OUT ELEM;
61     PROCEDURE PROC1;
62
63     GENERIC
64          TYPE ELEM IS PRIVATE;
65          PCON2 : IN ELEM;
66          PVAR2 : IN OUT ELEM;
67     PROCEDURE PROC2;
68
69     GENERIC
70          TYPE OBJ IS PRIVATE;
71          FCON1 : IN OBJ;
72          FVAR1 : IN OUT OBJ;
73     FUNCTION FUNC1 RETURN OBJ;
74
75     GENERIC
76          TYPE OBJ IS PRIVATE;
77          FCON2 : IN OBJ;
78          FVAR2 : IN OUT OBJ;
79     FUNCTION FUNC2 RETURN OBJ;
80
81
82     PROCEDURE PROC1 IS SEPARATE;
83     PROCEDURE PROC2 IS SEPARATE;
84     FUNCTION FUNC1 RETURN OBJ IS SEPARATE;
85     FUNCTION FUNC2 RETURN OBJ IS SEPARATE;
86
87
88     PROCEDURE NI_PROC1 IS NEW PROC1 (INTEGER, 2, INT1);
89     PROCEDURE NI_PROC2 IS NEW PROC2 (INTEGER, 3, INT2);
90     FUNCTION NI_FUNC1 IS NEW FUNC1 (INTEGER, 4, INT3);
91     FUNCTION NI_FUNC2 IS NEW FUNC2 (INTEGER, 5, INT4);
92
93
94BEGIN
95
96     TEST ("CA2009F", "SPECIFICATION AND INSTANTIATION " &
97                      "OF GENERIC SUBPROGRAM SUBUNITS");
98
99     NI_PROC1;
100     IF INT1 /= 2 THEN
101          FAILED ("INCORRECT INSTANTIATION - NI_PROC1");
102     END IF;
103
104     NI_PROC2;
105     IF INT2 /= 3 THEN
106          FAILED ("INCORRECT INSTANTIATION - NI_PROC2");
107     END IF;
108
109     IF NI_FUNC1 /= 4 THEN
110          FAILED ("INCORRECT INSTANTIATION - NI_FUNC1");
111     END IF;
112
113     IF NI_FUNC2 /= 5 THEN
114          FAILED ("INCORRECT INSTANTIATION - NI_FUNC2");
115     END IF;
116
117
118     RESULT;
119
120END CA2009F0M;
121
122
123SEPARATE (CA2009F0M)
124PROCEDURE PROC2 IS
125BEGIN
126     PVAR2 := PCON2;
127END PROC2;
128
129SEPARATE (CA2009F0M)
130FUNCTION FUNC2 RETURN OBJ IS
131BEGIN
132     FVAR2 := FCON2;
133     RETURN FVAR2;
134END FUNC2;
135