1-- CC3203A.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 A GENERIC FORMAL LIMITED/NON LIMITED PRIVATE TYPE HAS 26-- DISCRIMINANTS, THE ACTUAL PARAMETER CAN HAVE DEFAULT DISCRIMINANT 27-- VALUES. 28 29-- SPS 7/9/82 30 31WITH REPORT; 32USE REPORT; 33 34PROCEDURE CC3203A IS 35BEGIN 36 TEST ("CC3203A", "CHECK DEFAULT VALUES FOR LIMITED/" & 37 "NON LIMITED GENERIC FORMAL PRIVATE TYPES"); 38 DECLARE 39 SD : INTEGER := IDENT_INT(0); 40 41 FUNCTION INIT_RC (X: INTEGER) RETURN INTEGER; 42 43 TYPE REC (D : INTEGER := 3) IS 44 RECORD NULL; END RECORD; 45 46 TYPE RC(C : INTEGER := INIT_RC (1)) IS 47 RECORD NULL; END RECORD; 48 49 GENERIC 50 TYPE PV(X : INTEGER) IS PRIVATE; 51 TYPE LP(X : INTEGER) IS LIMITED PRIVATE; 52 PACKAGE PACK IS 53 SUBTYPE NPV IS PV; 54 SUBTYPE NLP IS LP; 55 END PACK; 56 57 FUNCTION INIT_RC (X: INTEGER) RETURN INTEGER IS 58 BEGIN 59 SD := SD + X; 60 RETURN SD; 61 END INIT_RC; 62 63 PACKAGE P1 IS NEW PACK (REC, RC); 64 65 PACKAGE P2 IS 66 P1VP : P1.NPV; 67 P1VL : P1.NLP; 68 P1VL2 : P1.NLP; 69 END P2; 70 USE P2; 71 BEGIN 72 73 IF P1VP.D /= IDENT_INT(3) THEN 74 FAILED ("DEFAULT DISCRIMINANT VALUE WRONG"); 75 END IF; 76 77 IF P1VL.C /= 1 THEN 78 FAILED ("DID NOT EVALUATE DEFAULT DISCRIMINANT"); 79 END IF; 80 81 IF P1VL2.C /= IDENT_INT(2) THEN 82 FAILED ("DID NOT EVALUATE DEFAULT DISCRIMINANT " & 83 "WHEN NEEDED"); 84 END IF; 85 END; 86 87 RESULT; 88 89END CC3203A; 90