1-- CC3106B.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 THE FORMAL PARAMETER DENOTES THE ACTUAL
26--     IN AN INSTANTIATION.
27
28-- HISTORY:
29--     LDC 06/20/88  CREATED ORIGINAL TEST
30--     EDWARD V. BERARD, 10 AUGUST 1990  ADDED CHECKS FOR MULTI-
31--                                       DIMENSIONAL ARRAYS
32
33WITH REPORT ;
34
35PROCEDURE CC3106B IS
36
37BEGIN  -- CC3106B
38
39    REPORT.TEST("CC3106B","CHECK THAT THE FORMAL PARAMETER DENOTES " &
40                "THE ACTUAL IN AN INSTANTIATION");
41
42    LOCAL_BLOCK:
43
44    DECLARE
45
46        SUBTYPE SM_INT IS INTEGER RANGE 0..15 ;
47        TYPE PCK_BOL IS ARRAY (5..18) OF BOOLEAN ;
48        PRAGMA PACK(PCK_BOL) ;
49
50        SHORT_START : CONSTANT := -100 ;
51        SHORT_END   : CONSTANT := 100 ;
52        TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
53
54        SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
55
56        TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
57                            SEP, OCT, NOV, DEC) ;
58
59        SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
60
61        TYPE DAY_TYPE IS RANGE 1 .. 31 ;
62        TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
63        TYPE DATE IS RECORD
64            MONTH : MONTH_TYPE ;
65            DAY   : DAY_TYPE ;
66            YEAR  : YEAR_TYPE ;
67        END RECORD ;
68
69        TODAY         : DATE := (MONTH => AUG,
70                                 DAY   => 8,
71                                 YEAR  => 1990) ;
72
73        FIRST_DATE    : DATE := (DAY   => 6,
74                                 MONTH => JUN,
75                                 YEAR  => 1967) ;
76
77        WALL_DATE     : DATE := (MONTH => NOV,
78                                 DAY   => 9,
79                                 YEAR  => 1989) ;
80
81        SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
82
83        TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
84                                         FIRST_HALF,
85                                         FIRST_FIVE) OF DATE ;
86
87        TD_ARRAY : THREE_DIMENSIONAL := (THREE_DIMENSIONAL'RANGE =>
88                                        (THREE_DIMENSIONAL'RANGE (2) =>
89                                        (THREE_DIMENSIONAL'RANGE (3) =>
90                                          TODAY))) ;
91
92        TASK TYPE TSK IS
93            ENTRY ENT_1;
94            ENTRY ENT_2;
95            ENTRY ENT_3;
96        END TSK;
97
98        GENERIC
99
100            TYPE GEN_TYPE IS (<>);
101            GEN_BOLARR         : IN OUT PCK_BOL;
102            GEN_TYP            : IN OUT GEN_TYPE;
103            GEN_TSK            : IN OUT TSK;
104            TEST_VALUE         : IN DATE ;
105            TEST_CUBE          : IN OUT THREE_DIMENSIONAL ;
106
107        PACKAGE P IS
108               PROCEDURE GEN_PROC1 ;
109               PROCEDURE GEN_PROC2 ;
110               PROCEDURE GEN_PROC3 ;
111               PROCEDURE ARRAY_TEST ;
112        END P;
113
114        ACT_BOLARR : PCK_BOL := (OTHERS => FALSE);
115        SI         : SM_INT := 0 ;
116        T          : TSK;
117
118        PACKAGE BODY P IS
119
120            PROCEDURE GEN_PROC1 IS
121            BEGIN  -- GEN_PROC1
122                GEN_BOLARR(14) := REPORT.IDENT_BOOL(TRUE);
123                GEN_TYP := GEN_TYPE'VAL(4);
124                IF ACT_BOLARR(14) /= TRUE OR SI /= REPORT.IDENT_INT(4)
125                   THEN
126                    REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
127                                  "INSTANTIATED VALUES");
128                END IF;
129            END GEN_PROC1;
130
131            PROCEDURE GEN_PROC2 IS
132            BEGIN  -- GEN_PROC2
133                IF GEN_BOLARR(9) /= REPORT.IDENT_BOOL(TRUE) OR
134                      GEN_TYPE'POS(GEN_TYP) /= REPORT.IDENT_INT(2) THEN
135                    REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
136                                  "VALUES ASSIGNED IN THE MAIN " &
137                                  "PROCEDURE");
138                END IF;
139                GEN_BOLARR(18) := TRUE;
140                GEN_TYP := GEN_TYPE'VAL(9);
141            END GEN_PROC2;
142
143            PROCEDURE GEN_PROC3 IS
144            BEGIN  -- GEN_PROC3
145                GEN_TSK.ENT_2;
146            END GEN_PROC3 ;
147
148            PROCEDURE ARRAY_TEST IS
149            BEGIN  -- ARRAY_TEST
150
151                TEST_CUBE (0, JUN, 'C') := TEST_VALUE ;
152
153                IF (TD_ARRAY (0, JUN, 'C')  /= TEST_VALUE) OR
154                      (TEST_CUBE (-5, MAR, 'A') /= WALL_DATE) THEN
155                    REPORT.FAILED ("MULTI-DIMENSIONAL ARRAY VALUES ARE " &
156                                   "DIFFERENT THAN THE VALUES ASSIGNED " &
157                                   "IN THE MAIN AND ARRAY_TEST PROCEDURES.") ;
158                END IF ;
159
160            END ARRAY_TEST ;
161
162        END P ;
163
164        TASK BODY TSK IS
165        BEGIN  -- TSK
166            ACCEPT ENT_1 DO
167                REPORT.COMMENT("TASK ENTRY 1 WAS CALLED");
168            END;
169            ACCEPT ENT_2 DO
170                REPORT.COMMENT("TASK ENTRY 2 WAS CALLED");
171            END;
172            ACCEPT ENT_3 DO
173                REPORT.COMMENT("TASK ENTRY 3 WAS CALLED");
174            END;
175        END TSK;
176
177        PACKAGE INSTA1 IS NEW P (GEN_TYPE       => SM_INT,
178                                 GEN_BOLARR     => ACT_BOLARR,
179                                 GEN_TYP        => SI,
180                                 GEN_TSK        => T,
181                                 TEST_VALUE     => FIRST_DATE,
182                                 TEST_CUBE      => TD_ARRAY) ;
183
184    BEGIN  -- LOCAL_BLOCK
185
186        INSTA1.GEN_PROC1;
187        ACT_BOLARR(9) := TRUE;
188        SI := 2;
189        INSTA1.GEN_PROC2;
190        IF ACT_BOLARR(18) /= REPORT.IDENT_BOOL(TRUE) OR
191              SI /= REPORT.IDENT_INT(9) THEN
192            REPORT.FAILED("VALUES ARE DIFFERENT THAN VALUES " &
193                          "ASSIGNED IN THE GENERIC PROCEDURE");
194        END IF;
195
196        T.ENT_1;
197        INSTA1.GEN_PROC3;
198        T.ENT_3;
199
200        TD_ARRAY (-5, MAR, 'A') := WALL_DATE ;
201        INSTA1.ARRAY_TEST ;
202
203     END LOCAL_BLOCK;
204
205     REPORT.RESULT;
206
207END CC3106B ;
208