1-- C85014B.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 THE BASE TYPE OF THE FORMAL PARAMETER AND THE RESULT 27-- TYPE ARE USED TO DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING 28-- RENAMED. 29 30-- HISTORY: 31-- JET 03/24/88 CREATED ORIGINAL TEST. 32 33WITH REPORT; USE REPORT; 34PROCEDURE C85014B IS 35 36 TYPE INT IS NEW INTEGER; 37 SUBTYPE SUBINT0 IS INT RANGE 0..INT'LAST; 38 SUBTYPE SUBINT1 IS INT RANGE 1..INT'LAST; 39 40 TASK TYPE T1 IS 41 ENTRY ENTER (I1: IN OUT INTEGER); 42 ENTRY STOP; 43 END T1; 44 45 TASK TYPE T2 IS 46 ENTRY ENTER (I1: IN OUT INT); 47 ENTRY STOP; 48 END T2; 49 50 TASK1 : T1; 51 TASK2 : T2; 52 53 FUNCTION F RETURN T1 IS 54 BEGIN 55 RETURN TASK1; 56 END F; 57 58 FUNCTION F RETURN T2 IS 59 BEGIN 60 RETURN TASK2; 61 END F; 62 63 PROCEDURE PROC (I1: IN OUT INTEGER) IS 64 BEGIN 65 I1 := I1 + 1; 66 END PROC; 67 68 PROCEDURE PROC (I1: IN OUT INT) IS 69 BEGIN 70 I1 := I1 + 2; 71 END PROC; 72 73 FUNCTION FUNK (I1: INTEGER) RETURN INTEGER IS 74 BEGIN 75 RETURN I1 + 1; 76 END FUNK; 77 78 FUNCTION FUNK (I1: INTEGER) RETURN INT IS 79 BEGIN 80 RETURN INT(I1) + 2; 81 END FUNK; 82 83 FUNCTION FUNKX (N : NATURAL) RETURN POSITIVE IS 84 BEGIN 85 RETURN N + 1; 86 END FUNKX; 87 88 FUNCTION FUNKX (N : SUBINT0) RETURN SUBINT1 IS 89 BEGIN 90 RETURN N + 2; 91 END FUNKX; 92 93 TASK BODY T1 IS 94 ACCEPTING_ENTRIES : BOOLEAN := TRUE; 95 BEGIN 96 WHILE ACCEPTING_ENTRIES LOOP 97 SELECT 98 ACCEPT ENTER (I1 : IN OUT INTEGER) DO 99 I1 := I1 + 1; 100 END ENTER; 101 OR 102 ACCEPT STOP DO 103 ACCEPTING_ENTRIES := FALSE; 104 END STOP; 105 END SELECT; 106 END LOOP; 107 END T1; 108 109 TASK BODY T2 IS 110 ACCEPTING_ENTRIES : BOOLEAN := TRUE; 111 BEGIN 112 WHILE ACCEPTING_ENTRIES LOOP 113 SELECT 114 ACCEPT ENTER (I1 : IN OUT INT) DO 115 I1 := I1 + 2; 116 END ENTER; 117 OR 118 ACCEPT STOP DO 119 ACCEPTING_ENTRIES := FALSE; 120 END STOP; 121 END SELECT; 122 END LOOP; 123 END T2; 124 125BEGIN 126 TEST ("C85014B", "CHECK THAT THE BASE TYPE OF THE FORMAL " & 127 "PARAMETER AND THE RESULT TYPE ARE USED TO " & 128 "DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING " & 129 "RENAMED"); 130 131 DECLARE 132 PROCEDURE PROC1 (J1: IN OUT INTEGER) RENAMES PROC; 133 PROCEDURE PROC2 (J1: IN OUT INT) RENAMES PROC; 134 135 FUNCTION FUNK1 (J1: INTEGER) RETURN INTEGER RENAMES FUNK; 136 FUNCTION FUNK2 (J1: INTEGER) RETURN INT RENAMES FUNK; 137 138 PROCEDURE ENTRY1 (J1: IN OUT INTEGER) RENAMES F.ENTER; 139 PROCEDURE ENTRY2 (J1: IN OUT INT) RENAMES F.ENTER; 140 141 FUNCTION FUNK3 (J1: POSITIVE) RETURN NATURAL RENAMES FUNKX; 142 FUNCTION FUNK4 (J1: SUBINT1) RETURN SUBINT0 RENAMES FUNKX; 143 144 K1 : INTEGER := 0; 145 K2 : INT := 0; 146 BEGIN 147 PROC1(K1); 148 IF K1 /= IDENT_INT(1) THEN 149 FAILED("INCORRECT RETURN VALUE FROM PROC1"); 150 END IF; 151 152 K1 := FUNK1(K1); 153 IF K1 /= IDENT_INT(2) THEN 154 FAILED("INCORRECT RETURN VALUE FROM FUNK1"); 155 END IF; 156 157 ENTRY1(K1); 158 IF K1 /= IDENT_INT(3) THEN 159 FAILED("INCORRECT RETURN VALUE FROM ENTRY1"); 160 END IF; 161 162 K1 := FUNK3(K1); 163 IF K1 /= IDENT_INT(4) THEN 164 FAILED("INCORRECT RETURN VALUE FROM FUNK3"); 165 END IF; 166 167 PROC2(K2); 168 IF INTEGER(K2) /= IDENT_INT(2) THEN 169 FAILED("INCORRECT RETURN VALUE FROM PROC2"); 170 END IF; 171 172 K2 := FUNK2(INTEGER(K2)); 173 IF INTEGER(K2) /= IDENT_INT(4) THEN 174 FAILED("INCORRECT RETURN VALUE FROM FUNK2"); 175 END IF; 176 177 ENTRY2(K2); 178 IF INTEGER(K2) /= IDENT_INT(6) THEN 179 FAILED("INCORRECT RETURN VALUE FROM ENTRY2"); 180 END IF; 181 182 K2 := FUNK4(K2); 183 IF INTEGER(K2) /= IDENT_INT(8) THEN 184 FAILED("INCORRECT RETURN VALUE FROM FUNK4"); 185 END IF; 186 END; 187 188 TASK1.STOP; 189 TASK2.STOP; 190 191 RESULT; 192END C85014B; 193