1--C37404B.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 FALSE FOR VARIABLES THAT HAVE 27-- DISCRIMINANTS WITH DEFAULT VALUES. 28 29-- HISTORY: 30-- LDC 06/08/88 CREATED ORIGINAL TEST. 31 32WITH REPORT; USE REPORT; 33PROCEDURE C37404B IS 34 35 SUBTYPE INT IS INTEGER RANGE 1 .. 10; 36 37 TYPE REC_DEF(A : INT := 5) IS 38 RECORD 39 I : INT := 1; 40 END RECORD; 41 42 SUBTYPE REC_DEF_SUB IS REC_DEF; 43 44 TYPE REC_DEF_ARR IS ARRAY (INTEGER RANGE -8..7) OF REC_DEF; 45 TYPE REC_DEF_SARR IS ARRAY (INTEGER RANGE -8..7) OF REC_DEF_SUB; 46 47 PACKAGE PRI_PACK IS 48 TYPE REC_DEF_PRI(A : INTEGER := 5) IS PRIVATE; 49 TYPE REC_DEF_LIM_PRI(A : INTEGER := 5) IS LIMITED PRIVATE; 50 51 PRIVATE 52 53 TYPE REC_DEF_PRI(A : INTEGER := 5) IS 54 RECORD 55 I : INTEGER := 1; 56 END RECORD; 57 58 TYPE REC_DEF_LIM_PRI(A : INTEGER := 5) IS 59 RECORD 60 I : INTEGER := 1; 61 END RECORD; 62 63 END PRI_PACK; 64 USE PRI_PACK; 65 66 A : REC_DEF; 67 B : REC_DEF_SUB; 68 C : ARRAY (0..15) OF REC_DEF; 69 D : ARRAY (0..15) OF REC_DEF_SUB; 70 E : REC_DEF_ARR; 71 F : REC_DEF_SARR; 72 G : REC_DEF_PRI; 73 H : REC_DEF_LIM_PRI; 74 75 Z : REC_DEF; 76 77 PROCEDURE SUBPROG(REC : OUT REC_DEF) IS 78 79 BEGIN 80 IF REC'CONSTRAINED THEN 81 FAILED("'CONSTRAINED TRUE FOR SUBPROGRAM OUT " & 82 "PARAMETER INSIDE THE SUBPROGRAM"); 83 END IF; 84 END SUBPROG; 85 86BEGIN 87 TEST("C37404B", "CHECK THAT 'CONSTRAINED IS FALSE FOR VARIABLES" & 88 " THAT HAVE DISCRIMINANTS WITH DEFAULT VALUES."); 89 90 IF A'CONSTRAINED THEN 91 FAILED("'CONSTRAINED TRUE FOR RECORD COMPONENT"); 92 END IF; 93 94 IF B'CONSTRAINED THEN 95 FAILED("'CONSTRAINED TRUE FOR SUBTYPE"); 96 END IF; 97 98 IF C(1)'CONSTRAINED THEN 99 FAILED("'CONSTRAINED TRUE FOR ARRAY TYPE"); 100 END IF; 101 102 IF D(1)'CONSTRAINED THEN 103 FAILED("'CONSTRAINED TRUE FOR ARRAY OF SUBTYPE"); 104 END IF; 105 106 IF E(1)'CONSTRAINED THEN 107 FAILED("'CONSTRAINED TRUE FOR ARRAY TYPE"); 108 END IF; 109 110 IF F(1)'CONSTRAINED THEN 111 FAILED("'CONSTRAINED TRUE FOR ARRAY OF SUBTYPE"); 112 END IF; 113 114 IF G'CONSTRAINED THEN 115 FAILED("'CONSTRAINED TRUE FOR PRIVATE TYPE"); 116 END IF; 117 118 IF H'CONSTRAINED THEN 119 FAILED("'CONSTRAINED TRUE FOR LIMITED PRIVATE TYPE"); 120 END IF; 121 122 SUBPROG(Z); 123 IF Z'CONSTRAINED THEN 124 FAILED("'CONSTRAINED TRUE FOR SUBPROGRAM OUT PARAMETER " & 125 "AFTER THE CALL"); 126 END IF; 127 128 IF IDENT_INT(A.I) /= 1 OR 129 IDENT_INT(B.I) /= 1 OR 130 IDENT_INT(C(1).I) /= 1 OR 131 IDENT_INT(D(1).I) /= 1 OR 132 IDENT_INT(E(1).I) /= 1 OR 133 IDENT_INT(F(1).I) /= 1 OR 134 IDENT_INT(Z.I) /= 1 OR 135 IDENT_INT(A.A) /= 5 OR 136 IDENT_INT(B.A) /= 5 OR 137 IDENT_INT(C(1).A) /= 5 OR 138 IDENT_INT(D(1).A) /= 5 OR 139 IDENT_INT(E(1).A) /= 5 OR 140 IDENT_INT(F(1).A) /= 5 OR 141 IDENT_INT(G.A) /= 5 OR 142 IDENT_INT(H.A) /= 5 OR 143 IDENT_INT(Z.A) /= 5 THEN 144 FAILED("INCORRECT INITIALIZATION VALUES"); 145 END IF; 146 147 RESULT; 148END C37404B; 149