1-- C34018A.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 CALLS OF DERIVED SUBPROGRAMS CHECK CONSTRAINTS OF THE 26-- PARENT SUBPROGRAM, NOT THE CONSTRAINTS OF THE DERIVED SUBTYPE. 27 28-- JBG 11/15/85 29-- JRK 2/12/86 CORRECTED ERROR: RESOLVED AMBIGUOUS CALL G(41) TO 30-- TYPE NEW_INT. 31-- EDS 7/16/98 AVOID OPTIMIZATION 32 33WITH REPORT; USE REPORT; 34PROCEDURE C34018A IS 35 36 PACKAGE P IS 37 TYPE INT IS RANGE 1..100; 38 SUBTYPE INT_50 IS INT RANGE 1..50; 39 SUBTYPE INT_51 IS INT RANGE 51..100; 40 41 FUNCTION "+" (L, R : INT) RETURN INT; 42 FUNCTION G (X : INT_50) RETURN INT_51; 43 44 TYPE STR IS ARRAY (1..10) OF CHARACTER; 45 FUNCTION F (X : STR) RETURN STR; 46 END P; 47 48 USE P; 49 50 TYPE NEW_STR IS NEW P.STR; 51 TYPE NEW_INT IS NEW P.INT RANGE 51..90; 52 53 PACKAGE BODY P IS 54 55 FUNCTION "+" (L, R : INT) RETURN INT IS 56 BEGIN 57 RETURN INT(INTEGER(L) + INTEGER(R)); 58 END "+"; 59 60 FUNCTION G (X : INT_50) RETURN INT_51 IS 61 BEGIN 62 RETURN X + 10; 63 END G; 64 65 FUNCTION F (X : STR) RETURN STR IS 66 BEGIN 67 RETURN X; 68 END F; 69 70 END P; 71 72BEGIN 73 74 TEST ("C34018A", "CHECK CONSTRAINTS PROCESSED CORRECTLY FOR " & 75 "CALLS OF DERIVED SUBPROGRAMS"); 76 77 DECLARE 78 79 Y : NEW_STR := F("1234567890"); -- UNAMBIGUOUS. 80 81 BEGIN 82 IF Y /= "1234567890" THEN 83 FAILED ("DERIVED F"); 84 END IF; 85 END; 86 87 DECLARE 88 89 A : INT := 51; 90 B : NEW_INT := NEW_INT(IDENT_INT(90)); 91 92 BEGIN 93 94 BEGIN 95 A := A + 0; 96 FAILED ("NO EXCEPTION - A + 0 = " & INT'IMAGE(A) ); --Use A 97 EXCEPTION 98 WHEN CONSTRAINT_ERROR => 99 NULL; 100 WHEN OTHERS => 101 FAILED ("UNEXPECTED EXCEPTION - 1"); 102 END; 103 104 BEGIN 105 IF B + 2 /= 92 THEN -- 92 IN INT. 106 FAILED ("WRONG RESULT - B + 2"); 107 END IF; 108 EXCEPTION 109 WHEN CONSTRAINT_ERROR => 110 FAILED ("WRONG CONSTRAINT FOR DERIVED ""+"""); 111 WHEN OTHERS => 112 FAILED ("UNEXPECTED EXCEPTION - 2"); 113 END; 114 115 BEGIN 116 IF B + 14 > 90 THEN -- 104 NOT IN INT. 117 FAILED ("NO EXCEPTION RAISED FOR DERIVED ""+"""); 118 END IF; 119 EXCEPTION 120 WHEN CONSTRAINT_ERROR => 121 NULL; 122 WHEN OTHERS => 123 FAILED ("UNEXPECTED EXCEPTION - 3"); 124 END; 125 126 127 BEGIN 128 IF G(B) > 90 THEN -- 90 NOT IN INT_50. 129 FAILED ("NO EXCEPTION RAISED FOR DERIVED G"); 130 END IF; 131 EXCEPTION 132 WHEN CONSTRAINT_ERROR => 133 NULL; 134 WHEN OTHERS => 135 FAILED ("UNEXPECTED EXCEPTION - 4"); 136 END; 137 138 BEGIN 139 IF C34018A.G(41) /= 51 THEN -- 41 CONVERTED TO 140 -- NEW_INT'BASE. 141 -- 41 IN INT_50. 142 -- 51 IN INT_51. 143 FAILED ("WRONG RESULT - G(41)"); 144 END IF; 145 EXCEPTION 146 WHEN CONSTRAINT_ERROR => 147 FAILED ("C_E RAISED FOR LITERAL ARGUMENT"); 148 WHEN OTHERS => 149 FAILED ("UNEXPECTED EXCEPTION - 5"); 150 END; 151 END; 152 153 RESULT; 154END C34018A; 155