1-- CA1106A.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 WITH CLAUSE FOR A PACKAGE BODY (GENERIC OR
27--     NONGENERIC) OR FOR A GENERIC SUBPROGRAM BODY CAN NAME THE
28--     CORRESPONDING SPECIFICATION, AND A USE CLAUSE CAN ALSO BE
29--     GIVEN.
30
31-- HISTORY:
32--     JET 07/14/88  CREATED ORIGINAL TEST.
33--     PWN 05/25/94  ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
34
35PACKAGE CA1106A_1 IS
36     I : INTEGER := 0;
37     PROCEDURE REQUIRE_BODY;
38END CA1106A_1;
39
40GENERIC
41     TYPE TG IS RANGE <>;
42PACKAGE CA1106A_2 IS
43     J : TG := 0;
44     PROCEDURE REQUIRE_BODY;
45END CA1106A_2;
46
47GENERIC
48     TYPE TG IS RANGE <>;
49FUNCTION CA1106A_3 RETURN TG;
50
51WITH REPORT; USE REPORT;
52WITH CA1106A_1; USE CA1106A_1;
53PRAGMA ELABORATE (REPORT);
54PACKAGE BODY CA1106A_1 IS
55     PROCEDURE REQUIRE_BODY IS
56     BEGIN
57          NULL;
58     END;
59BEGIN
60     I := IDENT_INT(1);
61END CA1106A_1;
62
63WITH REPORT; USE REPORT;
64WITH CA1106A_2;
65PRAGMA ELABORATE (REPORT);
66PACKAGE BODY CA1106A_2 IS
67     PROCEDURE REQUIRE_BODY IS
68     BEGIN
69          NULL;
70     END;
71BEGIN
72     J := TG(IDENT_INT(2));
73END CA1106A_2;
74
75WITH REPORT; USE REPORT;
76WITH CA1106A_3;
77FUNCTION CA1106A_3 RETURN TG IS
78BEGIN
79     RETURN TG(IDENT_INT(3));
80END CA1106A_3;
81
82WITH REPORT; USE REPORT;
83WITH CA1106A_1, CA1106A_2, CA1106A_3;
84USE CA1106A_1;
85PROCEDURE CA1106A IS
86
87     PACKAGE CA1106A_2X IS NEW CA1106A_2 (INTEGER);
88     FUNCTION CA1106A_3X IS NEW CA1106A_3 (INTEGER);
89
90     USE CA1106A_2X;
91
92BEGIN
93     TEST ("CA1106A", "CHECK THAT A WITH CLAUSE FOR A PACKAGE BODY " &
94                      "(GENERIC OR NONGENERIC) OR FOR A GENERIC " &
95                      "SUBPROGRAM BODY CAN NAME THE CORRESPONDING " &
96                      "SPECIFICATION, AND A USE CLAUSE CAN ALSO BE " &
97                      "GIVEN");
98
99     IF I /= 1 THEN
100          FAILED ("INCORRECT VALUE FROM NONGENERIC PACKAGE");
101     END IF;
102
103     IF J /= 2 THEN
104          FAILED ("INCORRECT VALUE FROM GENERIC PACKAGE");
105     END IF;
106
107     IF CA1106A_3X /= 3 THEN
108          FAILED ("INCORRECT VALUE FROM GENERIC SUBPROGRAM");
109     END IF;
110
111     RESULT;
112END CA1106A;
113