1-- C34014P.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 OPERATOR IS VISIBLE AND FURTHER DERIVABLE 27-- UNDER APPROPRIATE CIRCUMSTANCES. 28 29-- CHECK WHEN THE DERIVED OPERATOR IS IMPLICITLY DECLARED IN THE 30-- VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC OPERATOR IS LATER 31-- DECLARED EXPLICITLY IN THE PRIVATE PART. 32 33-- HISTORY: 34-- JRK 09/22/87 CREATED ORIGINAL TEST. 35-- GJD 11/15/95 REMOVED ADA 83 INCOMPATIBILITIES. 36-- PWN 04/11/96 Restored subtests in Ada95 legal format. 37 38WITH REPORT; USE REPORT; 39 40PROCEDURE C34014P IS 41 42 PACKAGE P IS 43 TYPE T IS RANGE -100 .. 100; 44 FUNCTION "+" (X : T) RETURN T; 45 END P; 46 USE P; 47 48 PACKAGE BODY P IS 49 FUNCTION "+" (X : T) RETURN T IS 50 BEGIN 51 RETURN X + T (IDENT_INT (1)); 52 END "+"; 53 END P; 54 55BEGIN 56 TEST ("C34014P", "CHECK THAT A DERIVED OPERATOR IS VISIBLE " & 57 "AND FURTHER DERIVABLE UNDER APPROPRIATE " & 58 "CIRCUMSTANCES. CHECK WHEN THE DERIVED " & 59 "OPERATOR IS IMPLICITLY DECLARED IN THE " & 60 "VISIBLE PART OF A PACKAGE AND A HOMOGRAPHIC " & 61 "OPERATOR IS LATER DECLARED EXPLICITLY IN " & 62 "THE PRIVATE PART"); 63 64 ----------------------------------------------------------------- 65 66 COMMENT ("NEW OPERATOR DECLARED BY SUBPROGRAM DECLARATION"); 67 68 DECLARE 69 70 PACKAGE Q IS 71 TYPE QT IS NEW T; 72 X : QT := +0; 73 PRIVATE 74 FUNCTION "+" (Y : QT) RETURN QT; 75 TYPE QR IS 76 RECORD 77 C : QT := +0; 78 END RECORD; 79 TYPE QS IS NEW QT; 80 END Q; 81 USE Q; 82 83 PACKAGE BODY Q IS 84 FUNCTION "+" (Y : QT) RETURN QT IS 85 BEGIN 86 RETURN Y + QT (IDENT_INT (2)); 87 END "+"; 88 89 PACKAGE R IS 90 Y : QR; 91 Z : QS := +0; 92 END R; 93 USE R; 94 BEGIN 95 IF X /= 1 THEN 96 FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG " & 97 "DECL - 1"); 98 END IF; 99 100 IF Y.C /= 2 THEN 101 FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " & 102 "DECL"); 103 END IF; 104 105 IF Z /= 2 THEN 106 FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG " & 107 "DECL - 1"); 108 END IF; 109 END Q; 110 111 PACKAGE R IS 112 Y : QT := +0; 113 TYPE RT IS NEW QT; 114 Z : RT := +0; 115 END R; 116 USE R; 117 118 BEGIN 119 IF Y /= 1 THEN 120 FAILED ("OLD OPERATOR NOT VISIBLE - SUBPROG DECL - 2"); 121 END IF; 122 123 IF Z /= 1 THEN 124 FAILED ("OLD OPERATOR NOT DERIVED - SUBPROG DECL - 2"); 125 END IF; 126 END; 127 128 ----------------------------------------------------------------- 129 130 COMMENT ("NEW OPERATOR DECLARED BY RENAMING"); 131 132 DECLARE 133 134 PACKAGE Q IS 135 TYPE QT IS NEW T; 136 X : QT := +0; 137 PRIVATE 138 FUNCTION G (X : QT) RETURN QT; 139 FUNCTION "+" (Y : QT) RETURN QT RENAMES G; 140 TYPE QR IS 141 RECORD 142 C : QT := +0; 143 END RECORD; 144 TYPE QS IS NEW QT; 145 END Q; 146 USE Q; 147 148 PACKAGE BODY Q IS 149 FUNCTION G (X : QT) RETURN QT IS 150 BEGIN 151 RETURN X + QT (IDENT_INT (2)); 152 END G; 153 154 PACKAGE R IS 155 Y : QR; 156 Z : QS := +0; 157 END R; 158 USE R; 159 BEGIN 160 IF X /= 1 THEN 161 FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - " & 162 "1"); 163 END IF; 164 165 IF Y.C /= 2 THEN 166 FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING"); 167 END IF; 168 169 IF Z /= 2 THEN 170 FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - " & 171 "1"); 172 END IF; 173 END Q; 174 175 PACKAGE R IS 176 Y : QT := +0; 177 TYPE RT IS NEW QT; 178 Z : RT := +0; 179 END R; 180 USE R; 181 182 BEGIN 183 IF Y /= 1 THEN 184 FAILED ("OLD OPERATOR NOT VISIBLE - RENAMING - 2"); 185 END IF; 186 187 IF Z /= 1 THEN 188 FAILED ("OLD OPERATOR NOT DERIVED - RENAMING - 2"); 189 END IF; 190 END; 191 192 ----------------------------------------------------------------- 193 194 COMMENT ("NEW OPERATOR DECLARED BY GENERIC INSTANTIATION"); 195 196 DECLARE 197 198 GENERIC 199 TYPE T IS RANGE <>; 200 FUNCTION G (Y : T) RETURN T; 201 202 FUNCTION G (Y : T) RETURN T IS 203 BEGIN 204 RETURN Y + T (IDENT_INT (2)); 205 END G; 206 207 PACKAGE Q IS 208 TYPE QT IS NEW T; 209 X : QT := +0; 210 PRIVATE 211 FUNCTION "+" IS NEW G (QT); 212 W : QT := +0; 213 TYPE QS IS NEW QT; 214 Z : QS := +0; 215 END Q; 216 USE Q; 217 218 PACKAGE BODY Q IS 219 BEGIN 220 IF X /= 1 THEN 221 FAILED ("OLD OPERATOR NOT VISIBLE - " & 222 "INSTANTIATION - 1"); 223 END IF; 224 225 IF W /= 2 THEN 226 FAILED ("NEW OPERATOR NOT VISIBLE - " & 227 "INSTANTIATION"); 228 END IF; 229 230 IF Z /= 2 THEN 231 FAILED ("OLD OPERATOR NOT DERIVED - " & 232 "INSTANTIATION - 1"); 233 END IF; 234 END Q; 235 236 PACKAGE R IS 237 Y : QT := +0; 238 TYPE RT IS NEW QT; 239 Z : RT := +0; 240 END R; 241 USE R; 242 243 BEGIN 244 IF Y /= 1 THEN 245 FAILED ("OLD OPERATOR NOT VISIBLE - INSTANTIATION - " & 246 "2"); 247 END IF; 248 249 IF Z /= 1 THEN 250 FAILED ("OLD OPERATOR NOT DERIVED - INSTANTIATION - " & 251 "2"); 252 END IF; 253 END; 254 255 ----------------------------------------------------------------- 256 257 RESULT; 258END C34014P; 259