1-- C37405A.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 ASSIGNING TO A CONSTRAINED OR UNCONSTRAINED 26-- OBJECT OR FORMAL PARAMETER OF A TYPE DECLARED WITH DEFAULT 27-- DISCRIMINANTS, THE ASSIGNMENT DOES NOT CHANGE THE 'CONSTRAINED 28-- ATTRIBUTE VALUE ASSOCIATED WITH THE OBJECT OR PARAMETER. 29 30-- ASL 7/21/81 31-- TBN 1/20/86 RENAMED FROM C37209A.ADA AND REVISED THE ASSIGNMENTS 32-- OF CONSTRAINED AND UNCONSTRAINED OBJECTS TO ARRAY AND 33-- RECORD COMPONENTS. 34 35WITH REPORT; USE REPORT; 36PROCEDURE C37405A IS 37 38 TYPE REC(DISC : INTEGER := 25) IS 39 RECORD 40 COMP : INTEGER; 41 END RECORD; 42 43 SUBTYPE CONSTR IS REC(10); 44 SUBTYPE UNCONSTR IS REC; 45 46 TYPE REC_C IS 47 RECORD 48 COMP: CONSTR; 49 END RECORD; 50 51 TYPE REC_U IS 52 RECORD 53 COMP: UNCONSTR; 54 END RECORD; 55 56 C1,C2 : CONSTR; 57 U1,U2 : UNCONSTR; 58-- C2 AND U2 ARE NOT PASSED TO EITHER PROC1 OR PROC2. 59 60 ARR_C : ARRAY (1..5) OF CONSTR; 61 ARR_U : ARRAY (1..5) OF UNCONSTR; 62 63 REC_COMP_C : REC_C; 64 REC_COMP_U : REC_U; 65 66 PROCEDURE PROC11(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS 67 BEGIN 68 PARM := C2; 69 IF IDENT_BOOL(B) /= PARM'CONSTRAINED THEN 70 FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " & 71 "ASSIGNMENT - 1"); 72 END IF; 73 END PROC11; 74 75 PROCEDURE PROC12(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS 76 BEGIN 77 PARM := U2; 78 IF B /= PARM'CONSTRAINED THEN 79 FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " & 80 "ASSIGNMENT - 2"); 81 END IF; 82 END PROC12; 83 84 PROCEDURE PROC1(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS 85 BEGIN 86 IF B /= PARM'CONSTRAINED THEN 87 FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " & 88 "PASSING PARAMETER"); 89 END IF; 90 91 PROC11(PARM, B); 92 93 PROC12(PARM, B); 94 95 END PROC1; 96 97 PROCEDURE PROC2(PARM : IN OUT CONSTR) IS 98 BEGIN 99 COMMENT ("CALLING PROC1 FROM PROC2"); -- IN CASE TEST FAILS. 100 PROC1(PARM,TRUE); 101 PARM := U2; 102 IF NOT PARM'CONSTRAINED THEN 103 FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " & 104 "ASSIGNMENT - 3"); 105 END IF; 106 END PROC2; 107BEGIN 108 TEST("C37405A", "'CONSTRAINED ATTRIBUTE OF OBJECTS, FORMAL " & 109 "PARAMETERS CANNOT BE CHANGED BY ASSIGNMENT"); 110 111 C2 := (DISC => IDENT_INT(10), COMP => 3); 112 U2 := (DISC => IDENT_INT(10), COMP => 4); 113 114 ARR_C := (1..5 => U2); 115 ARR_U := (1..5 => C2); 116 117 REC_COMP_C := (COMP => U2); 118 REC_COMP_U := (COMP => C2); 119 120 C1 := U2; 121 U1 := C2; 122 123 IF U1'CONSTRAINED OR NOT C1'CONSTRAINED THEN 124 FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 4"); 125 END IF; 126 127 IF ARR_U(3)'CONSTRAINED OR NOT ARR_C(4)'CONSTRAINED THEN 128 FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 5"); 129 END IF; 130 131 IF REC_COMP_U.COMP'CONSTRAINED 132 OR NOT REC_COMP_C.COMP'CONSTRAINED THEN 133 FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 6"); 134 END IF; 135 136 COMMENT("CALLING PROC1 DIRECTLY"); 137 PROC1(C1,TRUE); 138 PROC2(C1); 139 140 COMMENT("CALLING PROC1 DIRECTLY"); 141 PROC1(U1,FALSE); 142 PROC2(U1); 143 144 COMMENT("CALLING PROC1 DIRECTLY"); 145 PROC1(ARR_C(4), TRUE); 146 PROC2(ARR_C(5)); 147 148 COMMENT("CALLING PROC1 DIRECTLY"); 149 PROC1(ARR_U(2), FALSE); 150 PROC2(ARR_U(3)); 151 152 COMMENT("CALLING PROC1 DIRECTLY"); 153 PROC1(REC_COMP_C.COMP, TRUE); 154 PROC2(REC_COMP_C.COMP); 155 156 COMMENT("CALLING PROC1 DIRECTLY"); 157 PROC1(REC_COMP_U.COMP, FALSE); 158 PROC2(REC_COMP_U.COMP); 159 160 RESULT; 161END C37405A; 162