1-- C37217C.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 WHETHER THE OPTIONAL COMPATIBILITY CHECK IS 27-- PERFORMED WHEN A DISCRIMINANT CONSTRAINT IS GIVEN FOR AN ACCESS 28-- TYPE - WHEN THERE IS A "LOOP" IN THE DESIGNATED TYPE'S FULL 29-- DECLARATION. 30 31-- HISTORY: 32-- DHH 08/04/88 CREATED ORIGINAL TEST. 33 34WITH REPORT; USE REPORT; 35PROCEDURE C37217C IS 36 37BEGIN --C37217C BODY 38 TEST ("C37217C", "CHECK WHETHER THE OPTIONAL COMPATIBILITY " & 39 "CHECK IS PERFORMED WHEN A DISCRIMINANT " & 40 "CONSTRAINT IS GIVEN FOR AN ACCESS TYPE " & 41 "- WHEN THERE IS A ""LOOP"" IN THE DESIGNATED " & 42 "TYPE'S FULL DECLARATION"); 43 44 BEGIN 45 DECLARE 46 TYPE R1(D1 : INTEGER); 47 TYPE R2(D2 : INTEGER); 48 TYPE R3(D3 : POSITIVE); 49 50 TYPE ACC_R1 IS ACCESS R1; 51 TYPE ACC_R2 IS ACCESS R2; 52 TYPE ACC_R3 IS ACCESS R3; 53 54 TYPE R1(D1 : INTEGER) IS 55 RECORD 56 C1 : ACC_R2(D1); 57 END RECORD; 58 59 TYPE R2(D2 : INTEGER) IS 60 RECORD 61 C2 : ACC_R3(D2); 62 END RECORD; 63 64 TYPE R3(D3 : POSITIVE) IS 65 RECORD 66 C3 : ACC_R1(D3); 67 END RECORD; 68 69 X1 : ACC_R1(IDENT_INT(0)); 70 71 BEGIN 72 COMMENT("OPTIONAL COMPATIBILITY CHECK NOT PERFORMED"); 73 74 X1 := NEW R1'(D1 =>IDENT_INT(0), 75 C1 => NEW R2'(D2 => IDENT_INT(0), 76 C2 => NEW R3(IDENT_INT(0)))); 77 78 FAILED("CONSTRAINT_ERROR NOT RAISED"); 79 80 IF IDENT_INT(X1.C1.C2.D3) /= IDENT_INT(0) THEN 81 COMMENT("THIS LINE SHOULD NOT PRINT OUT"); 82 END IF; 83 EXCEPTION 84 WHEN CONSTRAINT_ERROR => 85 NULL; 86 WHEN OTHERS => 87 FAILED("UNEXPECTED EXCEPTION RAISED IN " & 88 "VARIABLE USE - LOOPED"); 89 END; 90 EXCEPTION 91 WHEN CONSTRAINT_ERROR => 92 COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED"); 93 WHEN OTHERS => 94 FAILED("UNEXPECTED EXCEPTION RAISED IN " & 95 "VARIABLE DECLARATION - LOOPED"); 96 END; 97 98 RESULT; 99 100END C37217C; -- BODY 101