1--C37404A.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 'CONSTRAINED IS TRUE FOR VARIABLES DECLARED WITH A 27-- CONSTRAINED TYPE, FOR CONSTANT OBJECTS (EVEN IF NOT DECLARED 28-- WITH A CONSTRAINED TYPE), AND DESIGNATED OBJECTS. 29 30-- HISTORY: 31-- DHH 02/25/88 CREATED ORIGINAL TEST. 32 33WITH REPORT; USE REPORT; 34PROCEDURE C37404A IS 35 36 SUBTYPE INT IS INTEGER RANGE 1 .. 10; 37 TYPE REC(A : INT) IS 38 RECORD 39 I : INT; 40 END RECORD; 41 42 TYPE ACC_REC IS ACCESS REC(4); 43 TYPE ACC_REC1 IS ACCESS REC; 44 SUBTYPE REC4 IS REC(4); 45 SUBTYPE REC5 IS REC; 46 47 TYPE REC_DEF(A : INT := 5) IS 48 RECORD 49 I : INT := 1; 50 END RECORD; 51 52 TYPE ACC_DEF IS ACCESS REC_DEF(4); 53 TYPE ACC_DEF1 IS ACCESS REC_DEF; 54 SUBTYPE REC6 IS REC_DEF(6); 55 SUBTYPE REC7 IS REC_DEF; 56 57 A : REC4 := (A => 4, I => 1); -- CONSTRAINED. 58 B : REC5(4) := (A => 4, I => 1); -- CONSTRAINED. 59 C : REC6; -- CONSTRAINED. 60 D : REC7(6); -- CONSTRAINED. 61 E : ACC_REC1(4); -- CONSTRAINED. 62 F : ACC_DEF1(4); -- CONSTRAINED. 63 G : ACC_REC1; -- UNCONSTRAINED. 64 H : ACC_DEF1; -- UNCONSTRAINED. 65 66 R : REC(5) := (A => 5, I => 1); -- CONSTRAINED. 67 T : REC_DEF(5); -- CONSTRAINED. 68 U : ACC_REC; -- CONSTRAINED. 69 V : ACC_DEF; -- CONSTRAINED. 70 W : CONSTANT REC(5) := (A => 5, I => 1); -- CONSTANT. 71 X : CONSTANT REC := (A => 5, I => 1); -- CONSTANT. 72 Y : CONSTANT REC_DEF(5) := (A => 5, I => 1); -- CONSTANT. 73 Z : CONSTANT REC_DEF := (A => 5, I => 1); -- CONSTANT. 74 75BEGIN 76 TEST("C37404A", "CHECK THAT 'CONSTRAINED IS TRUE FOR VARIABLES " & 77 "DECLARED WITH A CONSTRAINED TYPE, FOR " & 78 "CONSTANT OBJECTS (EVEN IF NOT DECLARED WITH A " & 79 "CONSTRAINED TYPE), AND DESIGNATED OBJECTS"); 80 81 U := NEW REC(4); 82 V := NEW REC_DEF(4); 83 E := NEW REC(4); 84 F := NEW REC_DEF(4); 85 G := NEW REC(4); -- CONSTRAINED. 86 H := NEW REC_DEF(4); -- CONSTRAINED. 87 88 IF NOT A'CONSTRAINED THEN 89 FAILED("'CONSTRAINED NOT TRUE FOR SUBTYPE1"); 90 END IF; 91 92 IF NOT B'CONSTRAINED THEN 93 FAILED("'CONSTRAINED NOT TRUE FOR SUBTYPE2"); 94 END IF; 95 96 IF NOT C'CONSTRAINED THEN 97 FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT SUBTYPE1"); 98 END IF; 99 100 IF NOT D'CONSTRAINED THEN 101 FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT SUBTYPE2"); 102 END IF; 103 104 IF NOT R'CONSTRAINED THEN 105 FAILED("'CONSTRAINED NOT TRUE FOR RECORD COMPONENT"); 106 END IF; 107 108 IF NOT T'CONSTRAINED THEN 109 FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT VARIABLE"); 110 END IF; 111 112 IF NOT E.ALL'CONSTRAINED THEN 113 FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 1"); 114 END IF; 115 116 IF NOT F.ALL'CONSTRAINED THEN 117 FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 1"); 118 END IF; 119 120 IF NOT G.ALL'CONSTRAINED THEN 121 FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 2"); 122 END IF; 123 124 IF NOT H.ALL'CONSTRAINED THEN 125 FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 2"); 126 END IF; 127 128 IF NOT U.ALL'CONSTRAINED THEN 129 FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 3"); 130 END IF; 131 132 IF NOT V.ALL'CONSTRAINED THEN 133 FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 3"); 134 END IF; 135 136 IF NOT W'CONSTRAINED THEN 137 FAILED("'CONSTRAINED NOT TRUE FOR CONSTANT, CONSTRAINED"); 138 END IF; 139 140 IF NOT X'CONSTRAINED THEN 141 FAILED("'CONSTRAINED NOT TRUE FOR CONSTANT, UNCONSTRAINED"); 142 END IF; 143 144 IF NOT Y'CONSTRAINED THEN 145 FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT CONSTANT, " & 146 "CONSTRAINED"); 147 END IF; 148 149 IF NOT Z'CONSTRAINED THEN 150 FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT CONSTANT, " & 151 "UNCONSTRAINED"); 152 END IF; 153 154 IF IDENT_INT(T.I) /= 1 OR 155 IDENT_INT(C.I) /= 1 OR 156 IDENT_INT(D.I) /= 1 OR 157 IDENT_INT(W.A) /= 5 OR 158 IDENT_INT(X.A) /= 5 OR 159 IDENT_INT(Y.A) /= 5 OR 160 IDENT_INT(Z.I) /= 1 OR 161 IDENT_INT(A.I) /= 1 OR 162 IDENT_INT(B.I) /= 1 OR 163 IDENT_BOOL(R.I /= 1) THEN 164 FAILED("INCORRECT INITIALIZATION VALUES"); 165 END IF; 166 167 RESULT; 168END C37404A; 169