| -- C37405A.ADA |
| |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- These rights include rights to use, duplicate, release or disclose the |
| -- released technical data and computer software in whole or in part, in |
| -- any manner and for any purpose whatsoever, and to have or permit others |
| -- to do so. |
| -- |
| -- DISCLAIMER |
| -- |
| -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR |
| -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED |
| -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE |
| -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE |
| -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A |
| -- PARTICULAR PURPOSE OF SAID MATERIAL. |
| --* |
| -- CHECK THAT WHEN ASSIGNING TO A CONSTRAINED OR UNCONSTRAINED |
| -- OBJECT OR FORMAL PARAMETER OF A TYPE DECLARED WITH DEFAULT |
| -- DISCRIMINANTS, THE ASSIGNMENT DOES NOT CHANGE THE 'CONSTRAINED |
| -- ATTRIBUTE VALUE ASSOCIATED WITH THE OBJECT OR PARAMETER. |
| |
| -- ASL 7/21/81 |
| -- TBN 1/20/86 RENAMED FROM C37209A.ADA AND REVISED THE ASSIGNMENTS |
| -- OF CONSTRAINED AND UNCONSTRAINED OBJECTS TO ARRAY AND |
| -- RECORD COMPONENTS. |
| |
| WITH REPORT; USE REPORT; |
| PROCEDURE C37405A IS |
| |
| TYPE REC(DISC : INTEGER := 25) IS |
| RECORD |
| COMP : INTEGER; |
| END RECORD; |
| |
| SUBTYPE CONSTR IS REC(10); |
| SUBTYPE UNCONSTR IS REC; |
| |
| TYPE REC_C IS |
| RECORD |
| COMP: CONSTR; |
| END RECORD; |
| |
| TYPE REC_U IS |
| RECORD |
| COMP: UNCONSTR; |
| END RECORD; |
| |
| C1,C2 : CONSTR; |
| U1,U2 : UNCONSTR; |
| -- C2 AND U2 ARE NOT PASSED TO EITHER PROC1 OR PROC2. |
| |
| ARR_C : ARRAY (1..5) OF CONSTR; |
| ARR_U : ARRAY (1..5) OF UNCONSTR; |
| |
| REC_COMP_C : REC_C; |
| REC_COMP_U : REC_U; |
| |
| PROCEDURE PROC11(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS |
| BEGIN |
| PARM := C2; |
| IF IDENT_BOOL(B) /= PARM'CONSTRAINED THEN |
| FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " & |
| "ASSIGNMENT - 1"); |
| END IF; |
| END PROC11; |
| |
| PROCEDURE PROC12(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS |
| BEGIN |
| PARM := U2; |
| IF B /= PARM'CONSTRAINED THEN |
| FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " & |
| "ASSIGNMENT - 2"); |
| END IF; |
| END PROC12; |
| |
| PROCEDURE PROC1(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS |
| BEGIN |
| IF B /= PARM'CONSTRAINED THEN |
| FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " & |
| "PASSING PARAMETER"); |
| END IF; |
| |
| PROC11(PARM, B); |
| |
| PROC12(PARM, B); |
| |
| END PROC1; |
| |
| PROCEDURE PROC2(PARM : IN OUT CONSTR) IS |
| BEGIN |
| COMMENT ("CALLING PROC1 FROM PROC2"); -- IN CASE TEST FAILS. |
| PROC1(PARM,TRUE); |
| PARM := U2; |
| IF NOT PARM'CONSTRAINED THEN |
| FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " & |
| "ASSIGNMENT - 3"); |
| END IF; |
| END PROC2; |
| BEGIN |
| TEST("C37405A", "'CONSTRAINED ATTRIBUTE OF OBJECTS, FORMAL " & |
| "PARAMETERS CANNOT BE CHANGED BY ASSIGNMENT"); |
| |
| C2 := (DISC => IDENT_INT(10), COMP => 3); |
| U2 := (DISC => IDENT_INT(10), COMP => 4); |
| |
| ARR_C := (1..5 => U2); |
| ARR_U := (1..5 => C2); |
| |
| REC_COMP_C := (COMP => U2); |
| REC_COMP_U := (COMP => C2); |
| |
| C1 := U2; |
| U1 := C2; |
| |
| IF U1'CONSTRAINED OR NOT C1'CONSTRAINED THEN |
| FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 4"); |
| END IF; |
| |
| IF ARR_U(3)'CONSTRAINED OR NOT ARR_C(4)'CONSTRAINED THEN |
| FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 5"); |
| END IF; |
| |
| IF REC_COMP_U.COMP'CONSTRAINED |
| OR NOT REC_COMP_C.COMP'CONSTRAINED THEN |
| FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 6"); |
| END IF; |
| |
| COMMENT("CALLING PROC1 DIRECTLY"); |
| PROC1(C1,TRUE); |
| PROC2(C1); |
| |
| COMMENT("CALLING PROC1 DIRECTLY"); |
| PROC1(U1,FALSE); |
| PROC2(U1); |
| |
| COMMENT("CALLING PROC1 DIRECTLY"); |
| PROC1(ARR_C(4), TRUE); |
| PROC2(ARR_C(5)); |
| |
| COMMENT("CALLING PROC1 DIRECTLY"); |
| PROC1(ARR_U(2), FALSE); |
| PROC2(ARR_U(3)); |
| |
| COMMENT("CALLING PROC1 DIRECTLY"); |
| PROC1(REC_COMP_C.COMP, TRUE); |
| PROC2(REC_COMP_C.COMP); |
| |
| COMMENT("CALLING PROC1 DIRECTLY"); |
| PROC1(REC_COMP_U.COMP, FALSE); |
| PROC2(REC_COMP_U.COMP); |
| |
| RESULT; |
| END C37405A; |