1-- C45631C.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 FOR TYPE LONG_INTEGER 'ABS A' EQUALS A IF A IS 27-- POSITIVE AND EQUALS -A IF A IS NEGATIVE. 28 29-- APPLICABILITY CRITERIA: 30-- THIS TEST IS APPLICABLE TO THOSE IMPLEMENTATIONS WHICH SUPPORT 31-- LONG_INTEGER. 32 33-- IF "LONG_INTEGER" IS NOT SUPPORTED, THEN THE DECLARATION OF 34-- "CHECK_LONG" MUST BE REJECTED. 35 36-- HISTORY: 37-- RJW 02/26/86 CREATED ORIGINAL TEST. 38-- DHH 01/13/88 ADDED APPLICABILITY CRITERIA AND STANDARD HEADER. 39 40WITH REPORT; USE REPORT; 41 42PROCEDURE C45631C IS 43 44 CHECK_LONG : LONG_INTEGER; -- N/A => ERROR. 45 46 FUNCTION IDENT (X : LONG_INTEGER) RETURN LONG_INTEGER IS 47 BEGIN 48 IF X >= LONG_INTEGER (INTEGER'FIRST) AND 49 X <= LONG_INTEGER (INTEGER'LAST) THEN 50 RETURN LONG_INTEGER (IDENT_INT (INTEGER (X))); 51 ELSIF EQUAL (3, 3) THEN 52 RETURN X; 53 END IF; 54 RETURN 0; 55 END IDENT; 56 57BEGIN 58 59 TEST ( "C45631C", "CHECK THAT FOR TYPE LONG_INTEGER 'ABS A' " & 60 "EQUALS A IF A IS POSITIVE AND EQUALS -A IF " & 61 "A IS NEGATIVE" ); 62 63 DECLARE 64 65 P : LONG_INTEGER := IDENT (1); 66 N : LONG_INTEGER := IDENT (-1); 67 Z : LONG_INTEGER := IDENT (0); 68 BEGIN 69 70 IF ABS P = P THEN 71 NULL; 72 ELSE 73 FAILED ( "'ABS' TEST FOR P - 1" ); 74 END IF; 75 76 IF ABS N = -N THEN 77 NULL; 78 ELSE 79 FAILED ( "'ABS' TEST FOR N - 1" ); 80 END IF; 81 82 IF ABS Z = Z THEN 83 NULL; 84 ELSE 85 FAILED ( "'ABS TEST FOR Z - 1" ); 86 END IF; 87 88 IF ABS (Z) = -Z THEN 89 NULL; 90 ELSE 91 FAILED ( "'ABS TEST FOR Z - 2"); 92 END IF; 93 94 IF "ABS" (RIGHT => P) = P THEN 95 NULL; 96 ELSE 97 FAILED ( "'ABS' TEST FOR P - 2" ); 98 END IF; 99 100 IF "ABS" (N) = -N THEN 101 NULL; 102 ELSE 103 FAILED ( "'ABS' TEST FOR N - 2 " ); 104 END IF; 105 106 IF "ABS" (Z) = Z THEN 107 NULL; 108 ELSE 109 FAILED ( "'ABS' TEST FOR Z - 3" ); 110 END IF; 111 112 IF ABS (IDENT (-LONG_INTEGER'LAST)) = LONG_INTEGER'LAST 113 THEN 114 NULL; 115 ELSE 116 FAILED ( "'ABS' TEST FOR -LONG_INTEGER'LAST" ); 117 END IF; 118 END; 119 120 RESULT; 121 122END C45631C; 123