1-- C45614C.DEP 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-- OBJECTIVE: 26-- CHECK THAT CONSTRAINT_ERROR IS RAISED BY PREDEFINED 27-- LONG_INTEGER "**" IF THE SECOND OPERAND HAS A NEGATIVE 28-- VALUE. 29 30-- APPLICABILITY CRITERIA: 31-- IN ORDER FOR THIS TEST TO BE NOT-APPLICABLE THE COMPILER 32-- MUST REJECT THE USE OF "LONG_INTEGER" AS AN UNDECLARED 33-- IDENTIFIER. 34 35-- HISTORY: 36-- HT 10/07/86 CREATED ORIGINAL TEST. 37-- JET 08/06/87 REMOVED BUG FROM FUNCTION IDENT (X). 38 39WITH REPORT; USE REPORT; 40PROCEDURE C45614C IS 41 42 FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS 43 BEGIN 44 RETURN LONG_INTEGER (IDENT_INT (INTEGER (X))); 45 END IDENT; 46 47BEGIN 48 49 TEST ("C45614C", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " & 50 "PREDEFINED LONG_INTEGER ""**"" IF THE SECOND " & 51 "OPERAND HAS A NEGATIVE VALUE"); 52 53 DECLARE 54 A : INTEGER := -2; 55 B : LONG_INTEGER := 3; 56 INT : LONG_INTEGER := 0; 57 BEGIN 58 INT := IDENT(B ** IDENT_INT(A)); 59 FAILED ("NO EXCEPTION FOR '3**(-2)'"); 60 61 EXCEPTION 62 WHEN CONSTRAINT_ERROR => 63 NULL; 64 WHEN OTHERS => 65 FAILED ("WRONG EXCEPTION RAISED FOR '3**(-2)'"); 66 END; 67 68 DECLARE 69 A : INTEGER := -3; 70 B : LONG_INTEGER := -5; 71 INT : LONG_INTEGER := 0; 72 BEGIN 73 INT := IDENT(B ** IDENT_INT(A)); 74 FAILED ("NO EXCEPTION FOR '(-5)**(-3)'"); 75 76 EXCEPTION 77 WHEN CONSTRAINT_ERROR => 78 NULL; 79 WHEN OTHERS => 80 FAILED ("WRONG EXCEPTION RAISED FOR '(-5)**(-3)'"); 81 END; 82 83 DECLARE 84 B : LONG_INTEGER := 0; 85 INT : LONG_INTEGER := 0; 86 BEGIN 87 INT := IDENT(B ** IDENT_INT(-3)); 88 FAILED ("NO EXCEPTION FOR '0**(-3)"); 89 90 EXCEPTION 91 WHEN CONSTRAINT_ERROR => 92 NULL; 93 WHEN OTHERS => 94 FAILED ("WRONG EXCEPTION RAISED FOR '0**(-3)'"); 95 END; 96 97 DECLARE 98 INT : LONG_INTEGER := 0; 99 BEGIN 100 INT := IDENT(-10 ** IDENT_INT(-2)); 101 FAILED ("NO EXCEPTION FOR '(-10)**(-2)'"); 102 103 EXCEPTION 104 WHEN CONSTRAINT_ERROR => 105 NULL; 106 WHEN OTHERS => 107 FAILED ("WRONG EXCEPTION RAISED FOR '(-10)**(-2)'"); 108 END; 109 110 DECLARE 111 INT : LONG_INTEGER := 0; 112 BEGIN 113 INT := IDENT(6 ** IDENT_INT(-4)); 114 FAILED ("NO EXCEPTION FOR '6**(-4)'"); 115 116 EXCEPTION 117 WHEN CONSTRAINT_ERROR => 118 NULL; 119 WHEN OTHERS => 120 FAILED ("WRONG EXCEPTION RAISED FOR '6**(-4)'"); 121 END; 122 123 RESULT; 124 125END C45614C; 126