1-- C47006A.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-- WHEN THE TYPE MARK IN A QUALIFIED EXPRESSION DENOTES A FIXED POINT 26-- TYPE, CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN THE VALUE OF THE 27-- OPERAND DOES NOT LIE WITHIN THE RANGE OF THE TYPE MARK. 28 29-- RJW 7/23/86 30 31WITH REPORT; USE REPORT; 32PROCEDURE C47006A IS 33 34 TYPE FIXED IS DELTA 0.5 RANGE -5.0 .. 5.0; 35 36BEGIN 37 38 TEST( "C47006A", "WHEN THE TYPE MARK IN A QUALIFIED " & 39 "EXPRESSION DENOTES A FIXED POINT TYPE, " & 40 "CHECK THAT CONSTRAINT_ERROR IS RAISED " & 41 "WHEN THE VALUE OF THE OPERAND DOES NOT LIE " & 42 "WITHIN THE RANGE OF THE TYPE MARK" ); 43 44 DECLARE 45 46 SUBTYPE SFIXED IS FIXED RANGE -2.0 .. 2.0; 47 48 FUNCTION IDENT (X : FIXED) RETURN FIXED IS 49 BEGIN 50 IF EQUAL (3, 3) THEN 51 RETURN X; 52 ELSE 53 RETURN 0.0; 54 END IF; 55 END IDENT; 56 57 BEGIN 58 IF SFIXED'(IDENT (-5.0)) = -2.0 THEN 59 FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " & 60 "SUBTYPE SFIXED - 1"); 61 ELSE 62 FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " & 63 "SUBTYPE SFIXED - 2"); 64 END IF; 65 EXCEPTION 66 WHEN CONSTRAINT_ERROR => 67 NULL; 68 WHEN OTHERS => 69 FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " & 70 "OF SUBTYPE SFIXED" ); 71 END; 72 73 DECLARE 74 75 TYPE NFIX IS NEW FIXED; 76 SUBTYPE SNFIX IS NFIX RANGE -2.0 .. 2.0; 77 78 FUNCTION IDENT (X : NFIX) RETURN NFIX IS 79 BEGIN 80 RETURN NFIX (IDENT_INT (INTEGER (X))); 81 END IDENT; 82 83 BEGIN 84 IF SNFIX'(IDENT (-5.0)) = -2.0 THEN 85 FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " & 86 "SUBTYPE SNFIX - 1"); 87 ELSE 88 FAILED ( "NO EXCEPTION RAISED FOR VALUE OUTSIDE OF " & 89 "SUBTYPE SNFIX - 2"); 90 END IF; 91 EXCEPTION 92 WHEN CONSTRAINT_ERROR => 93 NULL; 94 WHEN OTHERS => 95 FAILED ( "WRONG EXCEPTION RAISED FOR VALUE OUTSIDE " & 96 "OF SUBTYPE SNFIX" ); 97 END; 98 99 RESULT; 100END C47006A; 101