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