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