1-- C52008B.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 A RECORD VARIABLE DECLARED WITH A SPECIFIED 27-- DISCRIMINANT CONSTRAINT CANNOT HAVE A DISCRIMINANT VALUE ALTERED 28-- BY ASSIGNMENT. ASSIGNING AN ENTIRE RECORD VALUE WITH A 29-- DIFFERENT DISCRIMINANT VALUE SHOULD RAISE CONSTRAINT_ERROR AND 30-- LEAVE THE TARGET VARIABLE UNALTERED. THIS TEST USES NON-STATIC 31-- DISCRIMINANT VALUES. 32 33-- HISTORY: 34-- ASL 6/25/81 CREATED ORIGINAL TEST 35-- JRK 11/18/82 36-- RJW 8/17/89 ADDED SUBTYPE 'SUBINT'. 37 38WITH REPORT; 39PROCEDURE C52008B IS 40 41 USE REPORT; 42 43 TYPE REC1(D1,D2 : INTEGER) IS 44 RECORD 45 COMP1 : STRING(D1..D2); 46 END RECORD; 47 48 TYPE AR_REC1 IS ARRAY (NATURAL RANGE <>) OF REC1(IDENT_INT(3), 49 IDENT_INT(5)); 50 51 SUBTYPE SUBINT IS INTEGER RANGE -128 .. 127; 52 53 TYPE REC2(D1,D2,D3,D4 : SUBINT := 0) IS 54 RECORD 55 COMP1 : STRING(1..D1); 56 COMP2 : STRING(D2..D3); 57 COMP5 : AR_REC1(1..D4); 58 COMP6 : REC1(D3,D4); 59 END RECORD; 60 61 STR : STRING(IDENT_INT(3)..IDENT_INT(5)) := "ZZZ"; 62 63 R1A : REC1(IDENT_INT(3),IDENT_INT(5)) := (3,5,STR); 64 R1C : REC1(5,6) := (5,6,COMP1 => (5..6 => 'K')); 65 66 Q,R : REC2(IDENT_INT(2),IDENT_INT(3),IDENT_INT(5),IDENT_INT(6)); 67 TEMP : REC2(2,3,5,6); 68 69 W : REC2(1,4,6,8); 70 OK : BOOLEAN := FALSE; 71 72 73BEGIN 74 75 TEST ("C52008B", "CANNOT ASSIGN RECORD VARIABLE WITH SPECIFIED " & 76 "DISCRIMINANT VALUE A VALUE WITH A DIFFERENT " & 77 "(DYNAMIC) DISCRIMINANT VALUE"); 78 79 BEGIN 80 R1A := (IDENT_INT(3),5,"XYZ"); 81 82 R := (IDENT_INT(2),IDENT_INT(3),IDENT_INT(5),IDENT_INT(6), 83 "AB", 84 STR, 85 (1..6 => R1A), 86 R1C); 87 88 TEMP := R; 89 Q := TEMP; 90 R.COMP1 := "YY"; 91 OK := TRUE; 92 W := R; 93 FAILED ("ASSIGNMENT MADE USING INCORRECT DISCRIMINANT " & 94 "VALUES"); 95 EXCEPTION 96 WHEN CONSTRAINT_ERROR => 97 IF NOT OK 98 OR Q /= TEMP 99 OR R = TEMP 100 OR R = Q 101 OR W.D4 /= 8 THEN 102 FAILED ("LEGITIMATE ASSIGNMENT FAILED"); 103 END IF; 104 WHEN OTHERS => 105 FAILED ("WRONG EXCEPTION"); 106 END; 107 108 RESULT; 109 110END C52008B; 111