1-- CC1207B.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 AN UNCONSTRAINED FORMAL TYPE WITH DISCRIMINANTS IS 27-- ALLOWED AS THE TYPE OF A SUBPROGRAM OR AN ENTRY FORMAL 28-- PARAMETER, AND AS THE TYPE OF A GENERIC FORMAL OBJECT PARAMETER, 29-- AS A GENERIC ACTUAL PARAMETER, AND IN A MEMBERSHIP TEST, IN A 30-- SUBTYPE DECLARATION, IN AN ACCESS TYPE DEFINITION, AND IN A 31-- DERIVED TYPE DEFINITION. 32 33-- HISTORY: 34-- BCB 08/04/88 CREATED ORIGINAL TEST. 35 36WITH REPORT; USE REPORT; 37 38PROCEDURE CC1207B IS 39 40 GENERIC 41 TYPE X (L : INTEGER) IS PRIVATE; 42 PACKAGE PACK IS 43 END PACK; 44 45BEGIN 46 TEST ("CC1207B", "CHECK THAT AN UNCONSTRAINED FORMAL TYPE WITH " & 47 "DISCRIMINANTS IS ALLOWED AS THE TYPE OF A " & 48 "SUBPROGRAM OR AN ENTRY FORMAL PARAMETER, AND " & 49 "AS THE TYPE OF A GENERIC FORMAL OBJECT " & 50 "PARAMETER, AS A GENERIC ACTUAL PARAMETER, AND " & 51 "IN A MEMBERSHIP TEST, IN A SUBTYPE " & 52 "DECLARATION, IN AN ACCESS TYPE DEFINITION, " & 53 "AND IN A DERIVED TYPE DEFINITION"); 54 55 DECLARE 56 TYPE REC (D : INTEGER := 3) IS RECORD 57 NULL; 58 END RECORD; 59 60 GENERIC 61 TYPE R (D : INTEGER) IS PRIVATE; 62 OBJ : R; 63 PACKAGE P IS 64 PROCEDURE S (X : R); 65 66 TASK T IS 67 ENTRY E (Y : R); 68 END T; 69 70 SUBTYPE SUB_R IS R; 71 72 TYPE ACC_R IS ACCESS R; 73 74 TYPE NEW_R IS NEW R; 75 76 BOOL : BOOLEAN := (OBJ IN R); 77 78 SUB_VAR : SUB_R(5); 79 80 ACC_VAR : ACC_R := NEW R(5); 81 82 NEW_VAR : NEW_R(5); 83 84 PACKAGE NEW_PACK IS NEW PACK (R); 85 END P; 86 87 REC_VAR : REC(5) := (D => 5); 88 89 PACKAGE BODY P IS 90 PROCEDURE S (X : R) IS 91 BEGIN 92 IF NOT EQUAL(X.D,5) THEN 93 FAILED ("WRONG DISCRIMINANT VALUE - S"); 94 END IF; 95 END S; 96 97 TASK BODY T IS 98 BEGIN 99 ACCEPT E (Y : R) DO 100 IF NOT EQUAL(Y.D,5) THEN 101 FAILED ("WRONG DISCRIMINANT VALUE - T"); 102 END IF; 103 END E; 104 END T; 105 BEGIN 106 IF NOT EQUAL(OBJ.D,5) THEN 107 FAILED ("IMPROPER DISCRIMINANT VALUE"); 108 END IF; 109 110 S (OBJ); 111 112 T.E (OBJ); 113 114 IF NOT EQUAL(SUB_VAR.D,5) THEN 115 FAILED ("IMPROPER DISCRIMINANT VALUE - SUBTYPE"); 116 END IF; 117 118 IF NOT EQUAL(ACC_VAR.D,5) THEN 119 FAILED ("IMPROPER DISCRIMINANT VALUE - ACCESS"); 120 END IF; 121 122 IF NOT EQUAL(NEW_VAR.D,5) THEN 123 FAILED ("IMPROPER DISCRIMINANT VALUE - DERIVED"); 124 END IF; 125 126 IF NOT BOOL THEN 127 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST"); 128 END IF; 129 END P; 130 131 PACKAGE NEW_P IS NEW P (REC,REC_VAR); 132 133 BEGIN 134 NULL; 135 END; 136 137 RESULT; 138END CC1207B; 139