1-- C34014H.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 DERIVED SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE 27-- UNDER APPROPRIATE CIRCUMSTANCES. 28 29-- CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE 30-- PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT DECLARATION OF A 31-- HOMOGRAPHIC SUBPROGRAM IN THE VISIBLE PART. 32 33-- HISTORY: 34-- JRK 09/16/87 CREATED ORIGINAL TEST. 35 36WITH REPORT; USE REPORT; 37 38PROCEDURE C34014H IS 39 40 PACKAGE P IS 41 TYPE T IS RANGE -100 .. 100; 42 FUNCTION F RETURN T; 43 END P; 44 USE P; 45 46 PACKAGE BODY P IS 47 FUNCTION F RETURN T IS 48 BEGIN 49 RETURN T (IDENT_INT (1)); 50 END F; 51 END P; 52 53BEGIN 54 TEST ("C34014H", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " & 55 "AND FURTHER DERIVABLE UNDER APPROPRIATE " & 56 "CIRCUMSTANCES. CHECK WHEN THE DERIVED " & 57 "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " & 58 "PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT " & 59 "DECLARATION OF A HOMOGRAPHIC SUBPROGRAM IN " & 60 "THE VISIBLE PART"); 61 62 ----------------------------------------------------------------- 63 64 COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION"); 65 66 DECLARE 67 68 PACKAGE Q IS 69 TYPE QT IS PRIVATE; 70 C2 : CONSTANT QT; 71 FUNCTION F RETURN QT; 72 TYPE QR1 IS 73 RECORD 74 C : QT := F; 75 END RECORD; 76 PRIVATE 77 TYPE QT IS NEW T; 78 C2 : CONSTANT QT := 2; 79 TYPE QR2 IS 80 RECORD 81 C : QT := F; 82 END RECORD; 83 TYPE QS IS NEW QT; 84 END Q; 85 USE Q; 86 87 PACKAGE BODY Q IS 88 FUNCTION F RETURN QT IS 89 BEGIN 90 RETURN QT (IDENT_INT (2)); 91 END F; 92 93 PACKAGE R IS 94 X : QR1; 95 Y : QR2; 96 Z : QS := F; 97 END R; 98 USE R; 99 BEGIN 100 IF X.C /= 2 THEN 101 FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " & 102 "DECL - 1"); 103 END IF; 104 105 IF Y.C /= 2 THEN 106 FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " & 107 "DECL - 2"); 108 END IF; 109 110 IF Z /= 2 THEN 111 FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG " & 112 "DECL - 1"); 113 END IF; 114 END Q; 115 116 PACKAGE R IS 117 Y : QT := F; 118 TYPE RT IS NEW QT; 119 Z : RT := F; 120 END R; 121 USE R; 122 123 BEGIN 124 IF Y /= C2 THEN 125 FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 3"); 126 END IF; 127 128 IF Z /= RT (C2) THEN 129 FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2"); 130 END IF; 131 END; 132 133 ----------------------------------------------------------------- 134 135 COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING"); 136 137 DECLARE 138 139 PACKAGE Q IS 140 TYPE QT IS PRIVATE; 141 C2 : CONSTANT QT; 142 FUNCTION G RETURN QT; 143 FUNCTION F RETURN QT RENAMES G; 144 TYPE QR1 IS 145 RECORD 146 C : QT := F; 147 END RECORD; 148 PRIVATE 149 TYPE QT IS NEW T; 150 C2 : CONSTANT QT := 2; 151 TYPE QR2 IS 152 RECORD 153 C : QT := F; 154 END RECORD; 155 TYPE QS IS NEW QT; 156 END Q; 157 USE Q; 158 159 PACKAGE BODY Q IS 160 FUNCTION G RETURN QT IS 161 BEGIN 162 RETURN QT (IDENT_INT (2)); 163 END G; 164 165 PACKAGE R IS 166 X : QR1; 167 Y : QR2; 168 Z : QS := F; 169 END R; 170 USE R; 171 BEGIN 172 IF X.C /= 2 THEN 173 FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " & 174 "1"); 175 END IF; 176 177 IF Y.C /= 2 THEN 178 FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " & 179 "2"); 180 END IF; 181 182 IF Z /= 2 THEN 183 FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - " & 184 "1"); 185 END IF; 186 END Q; 187 188 PACKAGE R IS 189 Y : QT := F; 190 TYPE RT IS NEW QT; 191 Z : RT := F; 192 END R; 193 USE R; 194 195 BEGIN 196 IF Y /= C2 THEN 197 FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - 3"); 198 END IF; 199 200 IF Z /= RT (C2) THEN 201 FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - 2"); 202 END IF; 203 END; 204 205 ----------------------------------------------------------------- 206 207 RESULT; 208END C34014H; 209