1-- C35508L.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 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN THE 26-- PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER IS A 27-- BOOLEAN TYPE. 28 29-- RJW 3/24/86 30 31WITH REPORT; USE REPORT; 32 33PROCEDURE C35508L IS 34 35BEGIN 36 TEST ("C35508L", "CHECK THAT 'POS' AND 'VAL' YIELD THE " & 37 "CORRECT RESULTS WHEN THE PREFIX IS A " & 38 "FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER " & 39 "IS A BOOLEAN TYPE" ); 40 41 DECLARE 42 TYPE NEWBOOL IS NEW BOOLEAN; 43 44 GENERIC 45 TYPE BOOL IS (<>); 46 PROCEDURE P (STR : STRING; B : BOOL; I : INTEGER); 47 48 PROCEDURE P (STR : STRING; B : BOOL; I : INTEGER) IS 49 SUBTYPE SBOOL IS BOOL 50 RANGE BOOL'VAL (IDENT_INT(0)) .. BOOL'VAL (IDENT_INT(0)); 51 BEGIN 52 IF BOOL'POS (B) /= I THEN 53 FAILED ( "WRONG " & STR & "'POS FOR " & 54 BOOL'IMAGE (B) & " - 1" ); 55 END IF; 56 IF BOOL'VAL (I) /= B THEN 57 FAILED ( "WRONG " & STR & "'VAL FOR " & 58 INTEGER'IMAGE (I) & " - 1" ); 59 END IF; 60 61 IF SBOOL'POS (B) /= I THEN 62 FAILED ( "WRONG " & STR & "'POS FOR " & 63 BOOL'IMAGE (B) & " - 2" ); 64 END IF; 65 66 IF SBOOL'VAL (I) /= B THEN 67 FAILED ( "WRONG " & STR & "'VAL FOR " & 68 INTEGER'IMAGE (I) & " - 2" ); 69 END IF; 70 END P; 71 72 GENERIC 73 TYPE BOOL IS (<>); 74 PROCEDURE Q (STR : STRING; B : BOOL; I : INTEGER); 75 76 PROCEDURE Q (STR : STRING; B : BOOL; I : INTEGER) IS 77 SUBTYPE SBOOL IS BOOL 78 RANGE BOOL'VAL (IDENT_INT(0)) .. BOOL'VAL (IDENT_INT(0)); 79 BEGIN 80 BEGIN 81 IF BOOL'VAL (I) = B THEN 82 FAILED (STR & "'VAL OF " & INTEGER'IMAGE (I) & 83 " = " & BOOL'IMAGE (B)); 84 END IF; 85 FAILED ( "NO EXCEPTION RAISED FOR " & STR & 86 "'VAL OF " & INTEGER'IMAGE (I) ); 87 EXCEPTION 88 WHEN CONSTRAINT_ERROR => 89 NULL; 90 WHEN OTHERS => 91 FAILED ( "WRONG EXCEPTION RAISED FOR " & STR & 92 "'VAL " & "OF " & 93 INTEGER'IMAGE (I) ); 94 END; 95 96 BEGIN 97 IF SBOOL'VAL (I) = B THEN 98 FAILED (STR & " SBOOL'VAL OF " & 99 INTEGER'IMAGE(I) & " = " & 100 BOOL'IMAGE (B) ); 101 END IF; 102 FAILED( "NO EXCEPTION RAISED FOR VAL OF " & 103 INTEGER'IMAGE (I) & 104 "WITH SBOOL OF " & STR); 105 EXCEPTION 106 WHEN CONSTRAINT_ERROR => 107 NULL; 108 WHEN OTHERS => 109 FAILED ( "WRONG EXCEPTION RAISED FOR " & STR & 110 "'VAL " & "OF " & 111 INTEGER'IMAGE (I) & 112 "WITH SBOOL " ); 113 END; 114 END Q; 115 116 PROCEDURE NP1 IS NEW P ( BOOL => BOOLEAN ); 117 PROCEDURE NP2 IS NEW P ( BOOL => NEWBOOL ); 118 PROCEDURE NQ1 IS NEW Q ( BOOL => BOOLEAN ); 119 PROCEDURE NQ2 IS NEW Q ( BOOL => NEWBOOL ); 120 BEGIN 121 NP1 ( "BOOLEAN", IDENT_BOOL(FALSE) , IDENT_INT(0) ); 122 NP1 ( "BOOLEAN", IDENT_BOOL(TRUE) , IDENT_INT(1) ); 123 NP2 ( "NEWBOOL", FALSE , 0 ); 124 NP2 ( "NEWBOOL", TRUE , 1 ); 125 NQ1 ( "BOOLEAN", IDENT_BOOL(FALSE) , IDENT_INT(-1) ); 126 NQ1 ( "BOOLEAN", IDENT_BOOL(TRUE) , IDENT_INT(2) ); 127 NQ2 ( "NEWBOOL", FALSE , -1 ); 128 NQ2 ( "NEWBOOL", TRUE , 2 ); 129 END; 130 131 RESULT; 132END C35508L; 133