1-- C37402A.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 WHEN A FORMAL PARAMETER OF A SUBPROGRAM, ENTRY, OR 26-- GENERIC UNIT HAS AN UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT 27-- HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN APPLIED TO FORMAL 28-- PARAMETERS OF MODE IN AND HAS THE VALUE OF THE ACTUAL PARAMETER 29-- FOR THE OTHER MODES. 30 31-- R.WILLIAMS 9/1/86 32 33WITH REPORT; USE REPORT; 34PROCEDURE C37402A IS 35 36BEGIN 37 TEST ( "C37402A", "CHECK THAT WHEN A FORMAL PARAMETER OF A " & 38 "SUBPROGRAM, ENTRY, OR GENERIC UNIT HAS AN " & 39 "UNCONSTRAINED TYPE WITH DISCRIMINANTS THAT " & 40 "HAVE DEFAULTS, 'CONSTRAINED IS 'TRUE' WHEN " & 41 "APPLIED TO FORMAL PARAMETERS OF MODE IN " & 42 "AND HAS THE VALUE OF THE ACTUAL PARAMETER " & 43 "FOR THE OTHER MODES" ); 44 45 46 DECLARE 47 48 SUBTYPE INT IS INTEGER RANGE 1 .. 5; 49 50 TYPE MATRIX IS ARRAY (INT RANGE <>, INT RANGE <>) 51 OF INTEGER; 52 53 TYPE SQUARE (SIDE : INT := 1) IS 54 RECORD 55 MAT : MATRIX (1 .. SIDE, 1 .. SIDE); 56 END RECORD; 57 58 SC : CONSTANT SQUARE := (2, ((0, 0), (0, 0))); 59 60 AC : SQUARE (2) := (2, ((1, 2), (3, 4))); 61 AU : SQUARE := (SIDE => 1, MAT => (1 => (1 => 1))); 62 63 BC : SQUARE (2) := AC; 64 BU : SQUARE := AU; 65 66 CC : SQUARE (2); 67 CU : SQUARE; 68 69 PROCEDURE P (CON, IN_CON : IN SQUARE; 70 INOUT_CON : IN OUT SQUARE; 71 OUT_CON : OUT SQUARE; 72 IN_UNC : IN SQUARE; 73 INOUT_UNC : IN OUT SQUARE; 74 OUT_UNC : OUT SQUARE) IS 75 76 BEGIN 77 IF CON'CONSTRAINED THEN 78 NULL; 79 ELSE 80 FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " & 81 "OF IN MODE - 1" ); 82 END IF; 83 84 IF IN_CON'CONSTRAINED THEN 85 NULL; 86 ELSE 87 FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " & 88 "OF IN MODE - 2" ); 89 END IF; 90 91 IF IN_UNC'CONSTRAINED THEN 92 NULL; 93 ELSE 94 FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " & 95 "OF IN MODE - 3" ); 96 END IF; 97 98 IF INOUT_CON'CONSTRAINED THEN 99 NULL; 100 ELSE 101 FAILED ( "'CONSTRAINED IS 'FALSE' FOR " & 102 "CONSTRAINED OBJECT OF IN OUT MODE - 1" ); 103 END IF; 104 105 IF OUT_CON'CONSTRAINED THEN 106 NULL; 107 ELSE 108 FAILED ( "'CONSTRAINED IS 'FALSE' FOR " & 109 "CONSTRAINED OBJECT OF OUT MODE - 1" ); 110 END IF; 111 112 IF INOUT_UNC'CONSTRAINED THEN 113 FAILED ( "'CONSTRAINED IS 'TRUE' FOR " & 114 "UNCONSTRAINED OBJECT OF IN OUT MODE " & 115 "- 1" ); 116 END IF; 117 118 IF OUT_UNC'CONSTRAINED THEN 119 FAILED ( "'CONSTRAINED IS 'TRUE' FOR " & 120 "UNCONSTRAINED OBJECT OF OUT MODE - 1" ); 121 END IF; 122 123 OUT_CON := (2, ((1, 2), (3, 4))); 124 OUT_UNC := (2, ((1, 2), (3, 4))); 125 END P; 126 127 TASK T IS 128 ENTRY Q (CON, IN_CON : IN SQUARE; 129 INOUT_CON : IN OUT SQUARE; 130 OUT_CON : OUT SQUARE; 131 IN_UNC : IN SQUARE; 132 INOUT_UNC : IN OUT SQUARE; 133 OUT_UNC : OUT SQUARE); 134 END T; 135 136 TASK BODY T IS 137 BEGIN 138 ACCEPT Q (CON, IN_CON : IN SQUARE; 139 INOUT_CON : IN OUT SQUARE; 140 OUT_CON : OUT SQUARE; 141 IN_UNC : IN SQUARE; 142 INOUT_UNC : IN OUT SQUARE; 143 OUT_UNC : OUT SQUARE) DO 144 BEGIN 145 IF CON'CONSTRAINED THEN 146 NULL; 147 ELSE 148 FAILED ( "'CONSTRAINED IS 'FALSE' FOR " & 149 "OBJECT OF IN MODE - 4" ); 150 END IF; 151 152 IF IN_CON'CONSTRAINED THEN 153 NULL; 154 ELSE 155 FAILED ( "'CONSTRAINED IS 'FALSE' FOR " & 156 "OBJECT OF IN MODE - 5" ); 157 END IF; 158 159 IF IN_UNC'CONSTRAINED THEN 160 NULL; 161 ELSE 162 FAILED ( "'CONSTRAINED IS 'FALSE' FOR " & 163 "OBJECT OF IN MODE - 6" ); 164 END IF; 165 166 IF INOUT_CON'CONSTRAINED THEN 167 NULL; 168 ELSE 169 FAILED ( "'CONSTRAINED IS 'FALSE' FOR " & 170 "CONSTRAINED OBJECT OF " & 171 "IN OUT MODE - 2" ); 172 END IF; 173 174 IF OUT_CON'CONSTRAINED THEN 175 NULL; 176 ELSE 177 FAILED ( "'CONSTRAINED IS 'FALSE' FOR " & 178 "CONSTRAINED OBJECT OF " & 179 "OUT MODE - 2" ); 180 END IF; 181 182 IF INOUT_UNC'CONSTRAINED THEN 183 FAILED ( "'CONSTRAINED IS 'TRUE' FOR " & 184 "UNCONSTRAINED OBJECT OF " & 185 "IN OUT MODE - 2" ); 186 END IF; 187 188 IF OUT_UNC'CONSTRAINED THEN 189 FAILED ( "'CONSTRAINED IS 'TRUE' FOR " & 190 "UNCONSTRAINED OBJECT OF " & 191 "OUT MODE - 2" ); 192 END IF; 193 194 OUT_CON := (2, ((1, 2), (3, 4))); 195 OUT_UNC := (2, ((1, 2), (3, 4))); 196 END; 197 END Q; 198 END T; 199 200 GENERIC 201 CON, IN_CON : IN SQUARE; 202 INOUT_CON : IN OUT SQUARE; 203 IN_UNC : IN SQUARE; 204 INOUT_UNC : IN OUT SQUARE; 205 PACKAGE R IS END R; 206 207 PACKAGE BODY R IS 208 BEGIN 209 IF CON'CONSTRAINED THEN 210 NULL; 211 ELSE 212 FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " & 213 "OF IN MODE - 7" ); 214 END IF; 215 216 IF IN_CON'CONSTRAINED THEN 217 NULL; 218 ELSE 219 FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " & 220 "OF IN MODE - 8" ); 221 END IF; 222 223 IF IN_UNC'CONSTRAINED THEN 224 NULL; 225 ELSE 226 FAILED ( "'CONSTRAINED IS 'FALSE' FOR OBJECT " & 227 "OF IN MODE - 9" ); 228 END IF; 229 230 IF INOUT_CON'CONSTRAINED THEN 231 NULL; 232 ELSE 233 FAILED ( "'CONSTRAINED IS 'FALSE' FOR " & 234 "CONSTRAINED OBJECT OF IN OUT MODE - 3" ); 235 END IF; 236 237 IF INOUT_UNC'CONSTRAINED THEN 238 FAILED ( "'CONSTRAINED IS 'TRUE' FOR " & 239 "UNCONSTRAINED OBJECT OF IN OUT MODE " & 240 "- 3" ); 241 END IF; 242 243 END R; 244 245 PACKAGE S IS NEW R (SC, AC, BC, AU, BU); 246 247 BEGIN 248 P (SC, AC, BC, CC, AU, BU, CU); 249 T.Q (SC, AC, BC, CC, AU, BU, CU); 250 END; 251 252 RESULT; 253END C37402A; 254