1-- CB4002A.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 EXCEPTIONS RAISED DURING ELABORATION OF THE 26-- DECLARATIVE PART OF A SUBPROGRAM ARE PROPAGATED TO THE 27-- CALLER, FOR CONSTRAINT_ERROR CAUSED BY INITIALIZATION, 28-- AND CONSTRAINT ELABORATION, AND FOR FUNCTION EVALUATIONS 29-- RAISING CONSTRAINT_ERROR AND A PROGRAMMER-DEFINED EXCEPTION. 30 31-- DAT 4/13/81 32-- SPS 3/28/83 33 34WITH REPORT; USE REPORT; 35 36PROCEDURE CB4002A IS 37BEGIN 38 TEST("CB4002A", "EXCEPTIONS IN SUBPROGRAM DECLARATIVE_PARTS" 39 & " ARE PROPAGATED TO CALLER"); 40 41 DECLARE 42 SUBTYPE I5 IS INTEGER RANGE -5 .. 5; 43 44 E : EXCEPTION; 45 46 FUNCTION RAISE_IT (I : I5) RETURN INTEGER IS 47 J : INTEGER RANGE 0 .. 1 := I; 48 BEGIN 49 IF I = 0 THEN 50 RAISE CONSTRAINT_ERROR; 51 ELSIF I = 1 THEN 52 RAISE E; 53 END IF; 54 FAILED ("EXCEPTION NOT RAISED 0"); 55 RETURN J; 56 EXCEPTION 57 WHEN OTHERS => 58 IF I NOT IN 0 .. 1 THEN 59 FAILED ("WRONG HANDLER 0"); 60 RETURN 0; 61 ELSE 62 RAISE; 63 END IF; 64 END RAISE_IT; 65 66 PROCEDURE P1 (P : INTEGER) IS 67 Q : INTEGER := RAISE_IT (P); 68 BEGIN 69 FAILED ("EXCEPTION NOT RAISED 1"); 70 EXCEPTION 71 WHEN OTHERS => 72 FAILED ("WRONG HANDLER 1"); 73 END P1; 74 75 PROCEDURE P2 (P : INTEGER) IS 76 Q : I5 RANGE 0 .. P := 1; 77 BEGIN 78 IF P = 0 OR P > 5 THEN 79 FAILED ("EXCEPTION NOT RAISED 2"); 80 END IF; 81 END P2; 82 83 BEGIN 84 85 BEGIN 86 P1(-1); 87 FAILED ("EXCEPTION NOT RAISED 2A"); 88 EXCEPTION 89 WHEN CONSTRAINT_ERROR => NULL; 90 END; 91 92 BEGIN 93 P1(0); 94 FAILED ("EXCEPTION NOT RAISED 3"); 95 EXCEPTION 96 WHEN CONSTRAINT_ERROR => NULL; 97 END; 98 99 BEGIN 100 P1(1); 101 FAILED ("EXCEPTION NOT RAISED 4"); 102 EXCEPTION 103 WHEN E => NULL; 104 END; 105 106 BEGIN 107 P2(0); 108 FAILED ("EXCEPTION NOT RAISED 5"); 109 EXCEPTION 110 WHEN CONSTRAINT_ERROR => NULL; 111 END; 112 113 BEGIN 114 P2(6); 115 FAILED ("EXCEPTION NOT RAISED 6"); 116 EXCEPTION 117 WHEN CONSTRAINT_ERROR => NULL; 118 END; 119 120 EXCEPTION 121 WHEN OTHERS => FAILED ("WRONG EXCEPTION OR HANDLER"); 122 END; 123 124 RESULT; 125EXCEPTION 126 WHEN OTHERS => FAILED ("WRONG HANDLER FOR SURE"); RESULT; 127END CB4002A; 128