1-- C34014U.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-- PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT DECLARATION OF A 31-- HOMOGRAPHIC OPERATOR IN THE VISIBLE PART. 32 33-- HISTORY: 34-- JRK 09/23/87 CREATED ORIGINAL TEST. 35 36WITH REPORT; USE REPORT; 37 38PROCEDURE C34014U 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 ("C34014U", "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 "PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT " & 59 "DECLARATION OF A HOMOGRAPHIC OPERATOR IN " & 60 "THE 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 PRIVATE; 70 C0 : CONSTANT QT; 71 C2 : CONSTANT QT; 72 FUNCTION "+" (Y : QT) RETURN QT; 73 TYPE QR1 IS 74 RECORD 75 C : QT := +C0; 76 END RECORD; 77 PRIVATE 78 TYPE QT IS NEW T; 79 C0 : CONSTANT QT := 0; 80 C2 : CONSTANT QT := 2; 81 TYPE QR2 IS 82 RECORD 83 C : QT := +0; 84 END RECORD; 85 TYPE QS IS NEW QT; 86 END Q; 87 USE Q; 88 89 PACKAGE BODY Q IS 90 FUNCTION "+" (Y : QT) RETURN QT IS 91 BEGIN 92 RETURN Y + QT (IDENT_INT (2)); 93 END "+"; 94 95 PACKAGE R IS 96 X : QR1; 97 Y : QR2; 98 Z : QS := +0; 99 END R; 100 USE R; 101 BEGIN 102 IF X.C /= 2 THEN 103 FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " & 104 "DECL - 1"); 105 END IF; 106 107 IF Y.C /= 2 THEN 108 FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG " & 109 "DECL - 2"); 110 END IF; 111 112 IF Z /= 2 THEN 113 FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG " & 114 "DECL - 1"); 115 END IF; 116 END Q; 117 118 PACKAGE R IS 119 Y : QT := +C0; 120 TYPE RT IS NEW QT; 121 Z : RT := +RT(C0); 122 END R; 123 USE R; 124 125 BEGIN 126 IF Y /= C2 THEN 127 FAILED ("NEW OPERATOR NOT VISIBLE - SUBPROG DECL - 3"); 128 END IF; 129 130 IF Z /= RT (C2) THEN 131 FAILED ("NEW OPERATOR NOT DERIVED - SUBPROG DECL - 2"); 132 END IF; 133 END; 134 135 ----------------------------------------------------------------- 136 137 COMMENT ("NEW OPERATOR DECLARED BY RENAMING"); 138 139 DECLARE 140 141 PACKAGE Q IS 142 TYPE QT IS PRIVATE; 143 C0 : CONSTANT QT; 144 C2 : CONSTANT QT; 145 FUNCTION G (X : QT) RETURN QT; 146 FUNCTION "+" (Y : QT) RETURN QT RENAMES G; 147 TYPE QR1 IS 148 RECORD 149 C : QT := +C0; 150 END RECORD; 151 PRIVATE 152 TYPE QT IS NEW T; 153 C0 : CONSTANT QT := 0; 154 C2 : CONSTANT QT := 2; 155 TYPE QR2 IS 156 RECORD 157 C : QT := +0; 158 END RECORD; 159 TYPE QS IS NEW QT; 160 END Q; 161 USE Q; 162 163 PACKAGE BODY Q IS 164 FUNCTION G (X : QT) RETURN QT IS 165 BEGIN 166 RETURN X + QT (IDENT_INT (2)); 167 END G; 168 169 PACKAGE R IS 170 X : QR1; 171 Y : QR2; 172 Z : QS := +0; 173 END R; 174 USE R; 175 BEGIN 176 IF X.C /= 2 THEN 177 FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - " & 178 "1"); 179 END IF; 180 181 IF Y.C /= 2 THEN 182 FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - " & 183 "2"); 184 END IF; 185 186 IF Z /= 2 THEN 187 FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - " & 188 "1"); 189 END IF; 190 END Q; 191 192 PACKAGE R IS 193 Y : QT := +C0; 194 TYPE RT IS NEW QT; 195 Z : RT := +RT(C0); 196 END R; 197 USE R; 198 199 BEGIN 200 IF Y /= C2 THEN 201 FAILED ("NEW OPERATOR NOT VISIBLE - RENAMING - 3"); 202 END IF; 203 204 IF Z /= RT (C2) THEN 205 FAILED ("NEW OPERATOR NOT DERIVED - RENAMING - 2"); 206 END IF; 207 END; 208 209 ----------------------------------------------------------------- 210 211 RESULT; 212END C34014U; 213