1-- CC3233A.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 PRIVATE OR LIMITED PRIVATE FORMAL TYPE DENOTES ITS 27-- ACTUAL PARAMETER, A FIXED POINT TYPE AND OPERATIONS OF THE FORMAL 28-- TYPE ARE IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL 29-- TYPE. 30 31-- HISTORY: 32-- TBN 09/15/88 CREATED ORIGINAL TEST. 33-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X. 34 35WITH REPORT; USE REPORT; 36PROCEDURE CC3233A IS 37 38 TYPE FIXED IS DELTA 0.125 RANGE 0.0 .. 10.0; 39 40 GENERIC 41 TYPE T IS PRIVATE; 42 PACKAGE P IS 43 SUBTYPE SUB_T IS T; 44 PAC_VAR : T; 45 END P; 46 47 GENERIC 48 TYPE T IS LIMITED PRIVATE; 49 PACKAGE LP IS 50 SUBTYPE SUB_T IS T; 51 PAC_VAR : T; 52 END LP; 53 54 FUNCTION IDENT_FIX (X : FIXED) RETURN FIXED IS 55 BEGIN 56 IF EQUAL (3, 3) THEN 57 RETURN X; 58 ELSE 59 RETURN (0.0); 60 END IF; 61 END IDENT_FIX; 62 63BEGIN 64 TEST ("CC3233A", "CHECK THAT A PRIVATE OR LIMITED PRIVATE " & 65 "FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, A " & 66 "FIXED POINT TYPE AND OPERATIONS OF THE FORMAL " & 67 "TYPE ARE IDENTIFIED WITH CORRESPONDING " & 68 "OPERATIONS OF THE ACTUAL TYPE"); 69 70 DECLARE -- PRIVATE TYPE. 71 OBJ_INT : INTEGER := 1; 72 OBJ_FIX : FIXED := 1.0; 73 74 PACKAGE P1 IS NEW P (FIXED); 75 USE P1; 76 77 TYPE NEW_T IS NEW SUB_T; 78 OBJ_NEWT : NEW_T; 79 BEGIN 80 PAC_VAR := SUB_T'(1.0); 81 IF PAC_VAR /= OBJ_FIX THEN 82 FAILED ("INCORRECT RESULTS - 1"); 83 END IF; 84 OBJ_FIX := IDENT_FIX (PAC_VAR) + IDENT_FIX (OBJ_FIX); 85 IF OBJ_FIX <= PAC_VAR THEN 86 FAILED ("INCORRECT RESULTS - 2"); 87 END IF; 88 PAC_VAR := OBJ_INT * OBJ_FIX; 89 IF PAC_VAR NOT IN FIXED THEN 90 FAILED ("INCORRECT RESULTS - 3"); 91 END IF; 92 IF OBJ_FIX NOT IN SUB_T THEN 93 FAILED ("INCORRECT RESULTS - 4"); 94 END IF; 95 IF SUB_T'DELTA /= 0.125 THEN 96 FAILED ("INCORRECT RESULTS - 5"); 97 END IF; 98 OBJ_NEWT := 1.0; 99 OBJ_NEWT := OBJ_NEWT - 1.0; 100 IF OBJ_NEWT NOT IN NEW_T THEN 101 FAILED ("INCORRECT RESULTS - 6"); 102 END IF; 103 IF NEW_T'DELTA /= 0.125 THEN 104 FAILED ("INCORRECT RESULTS - 7"); 105 END IF; 106 OBJ_NEWT := NEW_T'SMALL + 1.0; 107 OBJ_FIX := 1.0; 108 OBJ_FIX := FIXED (OBJ_FIX * OBJ_FIX); 109 IF OBJ_FIX /= 1.0 THEN 110 FAILED ("INCORRECT RESULTS - 8"); 111 END IF; 112 OBJ_FIX := 1.0; 113 OBJ_FIX := SUB_T (OBJ_FIX / OBJ_FIX); 114 IF OBJ_FIX /= 1.0 THEN 115 FAILED ("INCORRECT RESULTS - 9"); 116 END IF; 117 IF FIXED'SMALL /= NEW_T'SMALL THEN 118 FAILED ("INCORRECT RESULTS - 10"); 119 END IF; 120 END; 121 122 DECLARE -- LIMITED PRIVATE TYPE. 123 OBJ_INT : INTEGER := 1; 124 OBJ_FIX : FIXED := 1.0; 125 126 PACKAGE P1 IS NEW LP (FIXED); 127 USE P1; 128 129 TYPE NEW_T IS NEW SUB_T; 130 OBJ_NEWT : NEW_T; 131 BEGIN 132 PAC_VAR := SUB_T'(1.0); 133 IF PAC_VAR /= OBJ_FIX THEN 134 FAILED ("INCORRECT RESULTS - 1"); 135 END IF; 136 OBJ_FIX := IDENT_FIX (PAC_VAR) + IDENT_FIX (OBJ_FIX); 137 IF OBJ_FIX <= PAC_VAR THEN 138 FAILED ("INCORRECT RESULTS - 2"); 139 END IF; 140 PAC_VAR := OBJ_INT * OBJ_FIX; 141 IF PAC_VAR NOT IN FIXED THEN 142 FAILED ("INCORRECT RESULTS - 3"); 143 END IF; 144 IF OBJ_FIX NOT IN SUB_T THEN 145 FAILED ("INCORRECT RESULTS - 4"); 146 END IF; 147 IF SUB_T'DELTA /= 0.125 THEN 148 FAILED ("INCORRECT RESULTS - 5"); 149 END IF; 150 OBJ_NEWT := 1.0; 151 OBJ_NEWT := OBJ_NEWT - 1.0; 152 IF OBJ_NEWT NOT IN NEW_T THEN 153 FAILED ("INCORRECT RESULTS - 6"); 154 END IF; 155 IF NEW_T'DELTA /= 0.125 THEN 156 FAILED ("INCORRECT RESULTS - 7"); 157 END IF; 158 OBJ_NEWT := NEW_T'SMALL + 1.0; 159 OBJ_FIX := 1.0; 160 OBJ_FIX := FIXED (OBJ_FIX * OBJ_FIX); 161 IF OBJ_FIX /= 1.0 THEN 162 FAILED ("INCORRECT RESULTS - 8"); 163 END IF; 164 OBJ_FIX := 1.0; 165 OBJ_FIX := SUB_T (OBJ_FIX / OBJ_FIX); 166 IF OBJ_FIX /= 1.0 THEN 167 FAILED ("INCORRECT RESULTS - 9"); 168 END IF; 169 IF FIXED'SMALL /= NEW_T'SMALL THEN 170 FAILED ("INCORRECT RESULTS - 10"); 171 END IF; 172 END; 173 174 RESULT; 175END CC3233A; 176