1-- C35508P.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-- OBJECTIVE: 26-- CHECK THAT 'FIRST' AND 'LAST' YIELD THE CORRECT RESULTS WHEN THE 27-- PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL PARAMETER 28-- IS A BOOLEAN TYPE. 29 30-- HISTORY: 31-- RJW 03/19/86 CREATED ORIGINAL TEST. 32-- DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS. 33 34WITH REPORT; USE REPORT; 35 36PROCEDURE C35508P IS 37 38BEGIN 39 TEST ("C35508P", "CHECK THAT 'FIRST' AND 'LAST' YIELD THE " & 40 "CORRECT RESULTS WHEN THE PREFIX IS A " & 41 "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " & 42 "PARAMETER IS A BOOLEAN TYPE" ); 43 DECLARE 44 SUBTYPE TBOOL IS BOOLEAN 45 RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE); 46 SUBTYPE FBOOL IS BOOLEAN 47 RANGE IDENT_BOOL(FALSE) .. IDENT_BOOL(FALSE); 48 SUBTYPE NOBOOL IS BOOLEAN 49 RANGE IDENT_BOOL(TRUE) .. IDENT_BOOL(FALSE); 50 TYPE NEWBOOL IS NEW BOOLEAN; 51 52 GENERIC 53 TYPE BOOL IS (<>); 54 F, L : BOOL; 55 PROCEDURE P ( STR : STRING ); 56 57 PROCEDURE P ( STR : STRING ) IS 58 BEGIN 59 IF BOOL'FIRST /= F THEN 60 FAILED ( "WRONG VALUE FOR " & STR & "'FIRST" ); 61 END IF; 62 IF BOOL'LAST /= L THEN 63 FAILED ( "WRONG VALUE FOR " & STR & "'LAST" ); 64 END IF; 65 END P; 66 67 GENERIC 68 TYPE BOOL IS (<>); 69 PROCEDURE Q; 70 71 PROCEDURE Q IS 72 BEGIN 73 IF BOOL'FIRST /= BOOL'VAL (IDENT_INT(1)) THEN 74 FAILED ( "WRONG 'FIRST FOR NOBOOL" ); 75 END IF; 76 IF BOOL'LAST /= BOOL'VAL (IDENT_INT(0)) THEN 77 FAILED ( "WRONG 'LAST FOR NOBOOL" ); 78 END IF; 79 END Q; 80 81 GENERIC 82 TYPE BOOL IS (<>); 83 F, L : BOOL; 84 PROCEDURE R; 85 86 PROCEDURE R IS 87 SUBTYPE SBOOL IS BOOL 88 RANGE BOOL'VAL (0) .. BOOL'VAL (1); 89 BEGIN 90 IF SBOOL'FIRST /= F THEN 91 FAILED ( "WRONG VALUE FOR BOOLEAN'FIRST AS " & 92 "SUBTYPE " ); 93 END IF; 94 IF SBOOL'LAST /= L THEN 95 FAILED ( "WRONG VALUE FOR BOOLEAN'LAST AS " & 96 "SUBTYPE" ); 97 END IF; 98 END R; 99 100 PROCEDURE P1 IS NEW P 101 ( BOOL => BOOLEAN, F => IDENT_BOOL(FALSE), 102 L => IDENT_BOOL(TRUE) ); 103 104 PROCEDURE P2 IS NEW P 105 ( BOOL => TBOOL, F => IDENT_BOOL(TRUE), 106 L => IDENT_BOOL(TRUE) ); 107 108 PROCEDURE P3 IS NEW P 109 ( BOOL => FBOOL, F => IDENT_BOOL(FALSE), 110 L => IDENT_BOOL(FALSE) ); 111 112 PROCEDURE P4 IS NEW P 113 (BOOL => NEWBOOL, F => FALSE, L => TRUE ); 114 115 PROCEDURE Q1 IS NEW Q 116 ( BOOL => NOBOOL ); 117 118 PROCEDURE R1 IS NEW R 119 ( BOOL => BOOLEAN, F => FALSE, L => TRUE ); 120 121 BEGIN 122 P1 ( "BOOLEAN" ); 123 P2 ( "TBOOL" ); 124 P3 ( "FBOOL" ); 125 P4 ( "NEWBOOL" ); 126 Q1; 127 R1; 128 END; 129 130 RESULT; 131END C35508P; 132