1-- CC3016C.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 AN INSTANCE OF A GENERIC PACKAGE MUST DECLARE A
26--  PACKAGE. CHECK THAT THE STATEMENTS IN AN INSTANTIATED GENERIC
27--  PACKAGE BODY ARE EXECUTED AFTER THE ELABORATION OF THE
28--  DECLARATIONS (IN SPEC AND IN BODY).
29
30-- HISTORY:
31--         EDWARD V. BERARD, 8 AUGUST 1990
32
33WITH REPORT;
34
35PROCEDURE  CC3016C  IS
36
37    GENERIC
38
39        TYPE SOME_TYPE IS PRIVATE ;
40        FIRST_INITIAL_VALUE  : IN SOME_TYPE ;
41        SECOND_INITIAL_VALUE : IN SOME_TYPE ;
42        WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
43                               RESULT : OUT SOME_TYPE) ;
44        WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
45                                      RESULT : OUT SOME_TYPE) ;
46        WITH PROCEDURE THIRD_CHANGE (FIRST  : IN SOME_TYPE ;
47                                     RESULT : OUT SOME_TYPE) ;
48        FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
49        SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
50        THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
51        FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
52        FIFTH_EXPECTED_RESULT     : IN SOME_TYPE ;
53        SIXTH_EXPECTED_RESULT     : IN SOME_TYPE ;
54
55    PACKAGE OUTER IS
56
57        VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
58
59        FUNCTION INNER_VARIABLE RETURN SOME_TYPE ;
60
61        GENERIC
62
63            INITIAL_VALUE : IN SOME_TYPE ;
64            WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
65                                   RESULT : OUT SOME_TYPE) ;
66            WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
67                                          RESULT : OUT SOME_TYPE) ;
68            FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
69            SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
70            THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
71            FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
72
73        PACKAGE INNER  IS
74            VARIABLE : SOME_TYPE := INITIAL_VALUE ;
75        END INNER ;
76
77    END OUTER ;
78
79
80    PACKAGE BODY OUTER IS
81
82        ANOTHER_VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
83
84        PACKAGE BODY  INNER  IS
85            ANOTHER_VARIABLE : SOME_TYPE := INITIAL_VALUE ;
86        BEGIN  -- INNER
87
88            CHANGE (FIRST  => VARIABLE,
89                    RESULT => VARIABLE) ;
90            CHANGE (FIRST  => ANOTHER_VARIABLE,
91                    RESULT => ANOTHER_VARIABLE) ;
92            OUTER.SECOND_CHANGE (FIRST  => OUTER.VARIABLE,
93                                 RESULT => OUTER.VARIABLE) ;
94            OUTER.CHANGE (FIRST  => OUTER.ANOTHER_VARIABLE,
95                          RESULT => OUTER.ANOTHER_VARIABLE) ;
96
97            IF (VARIABLE /= FIRST_EXPECTED_RESULT) OR
98               (ANOTHER_VARIABLE /= SECOND_EXPECTED_RESULT) OR
99               (OUTER.VARIABLE
100                       /= THIRD_EXPECTED_RESULT) OR
101               (OUTER.ANOTHER_VARIABLE
102                       /= FOURTH_EXPECTED_RESULT) THEN
103                    REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF INNER") ;
104            END IF;
105
106        END INNER ;
107
108        PACKAGE NEW_INNER IS NEW INNER
109            (INITIAL_VALUE          => SECOND_INITIAL_VALUE,
110             CHANGE                 => CHANGE,
111             SECOND_CHANGE          => THIRD_CHANGE,
112             FIRST_EXPECTED_RESULT  => FIRST_EXPECTED_RESULT,
113             SECOND_EXPECTED_RESULT => SECOND_EXPECTED_RESULT,
114             THIRD_EXPECTED_RESULT  => THIRD_EXPECTED_RESULT,
115             FOURTH_EXPECTED_RESULT => FOURTH_EXPECTED_RESULT) ;
116
117        FUNCTION INNER_VARIABLE RETURN SOME_TYPE IS
118        BEGIN
119            RETURN NEW_INNER.VARIABLE ;
120        END INNER_VARIABLE ;
121
122    BEGIN  -- OUTER
123
124        SECOND_CHANGE (FIRST  => VARIABLE,
125                       RESULT => VARIABLE) ;
126        SECOND_CHANGE (FIRST  => ANOTHER_VARIABLE,
127                       RESULT => ANOTHER_VARIABLE) ;
128
129        IF (VARIABLE /= FIFTH_EXPECTED_RESULT) OR
130           (ANOTHER_VARIABLE /= SIXTH_EXPECTED_RESULT) OR
131           (NEW_INNER.VARIABLE /= FIRST_EXPECTED_RESULT) THEN
132            REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF OUTER") ;
133        END IF;
134
135    END OUTER ;
136
137    PROCEDURE DOUBLE (THIS_VALUE          : IN  INTEGER;
138                      GIVING_THIS_RESULT  : OUT INTEGER) IS
139    BEGIN -- DOUBLE
140        GIVING_THIS_RESULT := 2 * THIS_VALUE ;
141    END DOUBLE ;
142
143    PROCEDURE ADD_20 (TO_THIS_VALUE      : IN  INTEGER;
144                      GIVING_THIS_RESULT : OUT INTEGER) IS
145    BEGIN -- ADD_20
146        GIVING_THIS_RESULT := TO_THIS_VALUE + 20 ;
147    END ADD_20 ;
148
149    PROCEDURE TIMES_FIVE (THIS_VALUE          : IN  INTEGER;
150                          GIVING_THIS_RESULT  : OUT INTEGER) IS
151    BEGIN -- TIMES_FIVE
152        GIVING_THIS_RESULT := 5 * THIS_VALUE ;
153    END TIMES_FIVE ;
154
155BEGIN -- CC3016C
156
157    REPORT.TEST ("CC3016C" , "CHECK THAT AN INSTANCE OF A GENERIC PACKAGE " &
158                 "MUST DECLARE A PACKAGE. CHECK THAT THE STATEMENTS IN AN " &
159                 "INSTANTIATED GENERIC PACKAGE BODY ARE EXECUTED AFTER THE " &
160                 "ELABORATION OF THE DECLARATIONS (IN SPEC AND IN BODY).") ;
161
162    LOCAL_BLOCK:
163
164    DECLARE
165
166        PACKAGE NEW_OUTER IS NEW OUTER
167            (SOME_TYPE                 => INTEGER,
168            FIRST_INITIAL_VALUE        => 7,
169            SECOND_INITIAL_VALUE       => 11,
170            CHANGE                     => DOUBLE,
171            SECOND_CHANGE              => ADD_20,
172            THIRD_CHANGE               => TIMES_FIVE,
173            FIRST_EXPECTED_RESULT      => 22,
174            SECOND_EXPECTED_RESULT     => 22,
175            THIRD_EXPECTED_RESULT      => 27,
176            FOURTH_EXPECTED_RESULT     => 14,
177            FIFTH_EXPECTED_RESULT      => 47,
178            SIXTH_EXPECTED_RESULT      => 34) ;
179
180    BEGIN  -- LOCAL_BLOCK
181
182        IF (NEW_OUTER.VARIABLE /= 47) OR
183           (NEW_OUTER.INNER_VARIABLE /= 22) THEN
184            REPORT.FAILED("ASSIGNED VALUES INCORRECT - " &
185                          "BODY OF MAIN PROGRAM") ;
186        END IF;
187
188    END LOCAL_BLOCK ;
189
190    REPORT.RESULT;
191
192END CC3016C;
193