1-- C38102E.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-- CHECK THAT AN INCOMPLETE TYPE CAN BE REDECLARED AS A DERIVED GENERIC 26-- FORMAL TYPE. 27 28-- AH 8/15/86 29-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X. 30-- DNT 11/28/95 CHANGED TO FLAG1 := F4. 31 32WITH REPORT; USE REPORT; 33PROCEDURE C38102E IS 34 TYPE RAINBOW IS (RED, ORANGE, YELLOW, GREEN, BLUE, INDIGO, VIOLET); 35 TYPE T_FLOAT IS DIGITS 5 RANGE -4.0 .. 4.0; 36 TYPE T_FIXED IS DELTA 0.01 RANGE 0.0 .. 1.5; 37 SUBTYPE P1 IS INTEGER; 38 TYPE P2 IS RANGE 0 .. 10; 39 TYPE P3 IS ARRAY (P2) OF INTEGER; 40 TYPE P4 IS ARRAY (P2, P2) OF INTEGER; 41 42 F1, F2 : BOOLEAN; 43 44 GENERIC 45 TYPE G1 IS (<>); 46 TYPE G2 IS RANGE <>; 47 FUNCTION G_DISCRETE RETURN BOOLEAN; 48 49 FUNCTION G_DISCRETE RETURN BOOLEAN IS 50 TYPE INC1; 51 TYPE INC2; 52 TYPE F1 IS NEW G1; 53 TYPE INC1 IS NEW G1; 54 TYPE INC2 IS NEW G2; 55 56 OBJ1_0 : INC1; 57 OBJ1_1 : INC1; 58 OBJ2_0 : INC2; 59 OBJ2_1 : INC2; 60 OBJ3 : F1; 61 62 RESULT_VALUE1 : BOOLEAN := FALSE; 63 RESULT_VALUE2 : BOOLEAN := FALSE; 64 BEGIN 65 OBJ3 := F1'LAST; 66 OBJ3 := F1'PRED(OBJ3); 67 IF INC1(OBJ3) = INC1'PRED(INC1'LAST) THEN 68 RESULT_VALUE1 := TRUE; 69 END IF; 70 OBJ2_0 := INC2'FIRST; 71 OBJ2_1 := INC2'LAST; 72 IF (OBJ2_0 + OBJ2_1) = (INC2'SUCC(OBJ2_0) + 73 INC2'PRED(OBJ2_1)) THEN 74 RESULT_VALUE2 := TRUE; 75 END IF; 76 77 RETURN (RESULT_VALUE1 AND RESULT_VALUE2); 78 END G_DISCRETE; 79 80 GENERIC 81 TYPE G3 IS DIGITS <>; 82 TYPE G4 IS DELTA <>; 83 PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN); 84 85 PROCEDURE REALS (FLAG1, FLAG2 : OUT BOOLEAN) IS 86 F1, F2, F3, F4, F5, F6, F7, F8 : BOOLEAN; 87 TYPE INC3; 88 TYPE INC4; 89 TYPE P1 IS NEW G3; 90 TYPE P2 IS NEW G4; 91 TYPE INC3 IS NEW G3; 92 TYPE INC4 IS NEW G4; 93 BEGIN 94 F4 := P1'LAST = P1(INC3'LAST) AND P1'FIRST = P1(INC3'FIRST); 95 96 F5 := P2'FORE = INC4'FORE; 97 F6 := P2'AFT = INC4'AFT; 98 F7 := ABS(P2'LAST - P2'FIRST) = P2(ABS(INC4'LAST - 99 INC4'FIRST)); 100 F8 := INC4(P2'LAST / P2'LAST) = INC4(INC4'LAST / INC4'LAST); 101 102 FLAG1 := F4; 103 FLAG2 := F5 AND F6 AND F7 AND F8; 104 END REALS; 105 106 GENERIC 107 TYPE ITEM IS PRIVATE; 108 TYPE INDEX IS RANGE <>; 109 TYPE G5 IS ARRAY (INDEX) OF ITEM; 110 TYPE G6 IS ARRAY (INDEX, INDEX) OF ITEM; 111 PACKAGE DIMENSIONS IS 112 TYPE INC5; 113 TYPE INC6; 114 TYPE D1 IS NEW G5; 115 TYPE D2 IS NEW G6; 116 TYPE INC5 IS NEW G5; 117 TYPE INC6 IS NEW G6; 118 FUNCTION CHECK RETURN BOOLEAN; 119 END DIMENSIONS; 120 121 PACKAGE BODY DIMENSIONS IS 122 FUNCTION CHECK RETURN BOOLEAN IS 123 A1 : INC5; 124 A2 : INC6; 125 DIM1 : D1; 126 DIM2 : D2; 127 F1, F2 : BOOLEAN; 128 BEGIN 129 F1 := A1(INDEX'FIRST)'SIZE = DIM1(INDEX'FIRST)'SIZE; 130 F2 := A2(INDEX'FIRST, INDEX'LAST)'SIZE = 131 DIM2(INDEX'FIRST, INDEX'LAST)'SIZE; 132 133 RETURN (F1 AND F2); 134 END CHECK; 135 END DIMENSIONS; 136 137 PROCEDURE PROC IS NEW REALS (G3 => T_FLOAT, G4 => T_FIXED); 138 FUNCTION DISCRETE IS NEW G_DISCRETE (G1 => RAINBOW, G2 => P2); 139 PACKAGE PKG IS NEW DIMENSIONS (ITEM => P1, INDEX => P2, G5 => P3, 140 G6 => P4); 141 142 USE PKG; 143BEGIN 144 TEST ("C38102E", "INCOMPLETE TYPES CAN BE DERIVED GENERIC " & 145 "FORMAL TYPES"); 146 147 IF NOT DISCRETE THEN 148 FAILED ("INTEGER AND ENUMERATED TYPES NOT DERIVED"); 149 END IF; 150 151 PROC (F1, F2); 152 IF (NOT F1) THEN 153 FAILED ("FLOAT TYPES NOT DERIVED"); 154 END IF; 155 IF (NOT F2) THEN 156 FAILED ("FIXED TYPES NOT DERIVED"); 157 END IF; 158 159 IF NOT CHECK THEN 160 FAILED ("ONE AND TWO DIMENSIONAL ARRAY TYPES NOT DERIVED"); 161 END IF; 162 163 RESULT; 164END C38102E; 165