1-- C58005A.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 FUNCTION IS READY TO RETURN CONTROL TO ITS INVOKER 26-- THE CONSTRAINTS ON THE RETURN VALUES ARE CHECKED, AND THAT 27-- CONSTRAINT ERROR IS THEN RAISED IF AND ONLY IF THE CONSTRAINTS 28-- ARE NOT SATISFIED. 29 30-- THIS TEST CHECKS THAT THE EXCEPTION IS RAISED UNDER THE APPROPRIATE 31-- CONDITIONS; IT ALSO CHECKS THE IDENTITY OF THE EXCEPTION. THE 32-- PRECISE MOMENT AND PLACE THE EXCEPTION IS RAISED IS TESTED 33-- ELSEWHERE. 34 35 36-- RM 05/14/81 37-- SPS 10/26/82 38 39WITH REPORT; 40PROCEDURE C58005A IS 41 42 USE REPORT ; 43 44 INTVAR : INTEGER ; 45 46BEGIN 47 48 TEST( "C58005A" , "CHECK THAT EXCEPTIONS ARE RAISED BY A RETURN" & 49 " STATEMENT IF AND ONLY IF THE CONSTRAINTS ARE" & 50 " VIOLATED" ); 51 52 53 DECLARE 54 SUBTYPE I1 IS INTEGER RANGE -10..90; 55 SUBTYPE I2 IS INTEGER RANGE 1..10; 56 FUNCTION FN1( X : I1 ) 57 RETURN I2 IS 58 BEGIN 59 RETURN 0 ; 60 END FN1 ; 61 62 FUNCTION FN2( X : I1 ) 63 RETURN I2 IS 64 BEGIN 65 RETURN X + IDENT_INT(0) ; 66 END FN2 ; 67 68 FUNCTION FN3( X : I1 ) 69 RETURN I2 IS 70 HUNDRED : INTEGER RANGE -100..100 := IDENT_INT(100) ; 71 BEGIN 72 RETURN HUNDRED - 90 ; 73 END FN3 ; 74 75 BEGIN 76 77 INTVAR := 0 ; 78 79 BEGIN 80 INTVAR := FN1( 0 ) + INTVAR ; -- EXCEPTION. 81 FAILED( "EXCEPTION NOT RAISED - 1" ); 82 EXCEPTION 83 WHEN CONSTRAINT_ERROR => INTVAR := INTVAR + 10 ; 84 WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED - 1" ) ; 85 END ; 86 87 BEGIN 88 INTVAR := FN2( 1 ) + INTVAR ; -- 10+1=11 -- NO EXCEPTION. 89 INTVAR := INTVAR + 100 ; -- 11+100=111 90 EXCEPTION 91 WHEN OTHERS => FAILED( "EXCEPTION RAISED - 2" ) ; 92 END ; 93 94 BEGIN 95 INTVAR := FN2(11 ) + INTVAR ; -- EXCEPTION. 96 FAILED( "EXCEPTION NOT RAISED - 3" ); 97 EXCEPTION 98 WHEN CONSTRAINT_ERROR => INTVAR := INTVAR + 10 ; -- 121 99 WHEN OTHERS => FAILED( "WRONG EXCEPTION RAISED - 3" ) ; 100 END ; 101 102 BEGIN 103 INTVAR := FN3( 0 ) + INTVAR ;--121+10=131 --NO EXCEPTION. 104 INTVAR := INTVAR + 1000 ;-- 131+1000=1131 105 EXCEPTION 106 WHEN OTHERS => FAILED( "EXCEPTION RAISED - 4" ) ; 107 END ; 108 109 110 END ; 111 112 113 IF INTVAR /= 1131 THEN 114 FAILED("WRONG FLOW OF CONTROL" ); 115 END IF; 116 117 118 RESULT ; 119 120 121END C58005A; 122