1-- C35508E.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 THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT 27-- RESULTS WHEN THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE 28-- ACTUAL ARGUMENT IS A BOOLEAN TYPE. 29 30-- SUBTESTS ARE: 31-- (A). TESTS FOR IMAGE. 32-- (B). TESTS FOR VALUE. 33 34-- HISTORY: 35-- RJW 03/19/86 CREATED ORIGINAL TEST. 36-- DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS. 37 38WITH REPORT; USE REPORT; 39 40PROCEDURE C35508E IS 41 42BEGIN 43 44 TEST( "C35508E" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " & 45 "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " & 46 "PREFIX IS A GENERIC FORMAL DISCRETE TYPE " & 47 "WHOSE ACTUAL ARGUMENT IS A BOOLEAN TYPE" ); 48-- PART (A). 49 50 DECLARE 51 TYPE NEWBOOL IS NEW BOOLEAN; 52 53 GENERIC 54 TYPE BOOL IS (<>); 55 PROCEDURE P (B : BOOL; STR : STRING ); 56 57 PROCEDURE P (B : BOOL; STR : STRING) IS 58 SUBTYPE SUBBOOL IS BOOL 59 RANGE BOOL'VAL (IDENT_INT(0)) .. 60 BOOL'VAL (IDENT_INT(0)); 61 BEGIN 62 63 IF BOOL'IMAGE (B) /= STR THEN 64 FAILED ( "INCORRECT BOOL'IMAGE OF " & STR ); 65 END IF; 66 IF BOOL'IMAGE (B)'FIRST /= 1 THEN 67 FAILED ( "INCORRECT BOOL'FIRST FOR " & STR ); 68 END IF; 69 70 IF SUBBOOL'IMAGE (B) /= STR THEN 71 FAILED ( "INCORRECT SUBBOOL'IMAGE OF " & STR ); 72 END IF; 73 IF SUBBOOL'IMAGE (B)'FIRST /= 1 THEN 74 FAILED ( "INCORRECT SUBBOOL'FIRST FOR " & STR ); 75 END IF; 76 END P; 77 78 PROCEDURE NP1 IS NEW P ( BOOLEAN ); 79 PROCEDURE NP2 IS NEW P ( NEWBOOL ); 80 BEGIN 81 NP1 ( TRUE, "TRUE" ); 82 NP2 ( FALSE, "FALSE" ); 83 84 END; 85 86----------------------------------------------------------------------- 87 88-- PART (B). 89 90 DECLARE 91 TYPE NEWBOOL IS NEW BOOLEAN; 92 93 GENERIC 94 TYPE BOOL IS (<>); 95 PROCEDURE P (STR : STRING; B : BOOL ); 96 97 PROCEDURE P (STR : STRING; B : BOOL) IS 98 SUBTYPE SUBBOOL IS BOOL 99 RANGE BOOL'VAL (IDENT_INT(0)) .. 100 BOOL'VAL (IDENT_INT(0)); 101 102 BEGIN 103 BEGIN 104 IF BOOL'VALUE (STR) /= B THEN 105 FAILED ( "INCORRECT BOOL'VALUE OF """ & 106 STR & """" ); 107 END IF; 108 EXCEPTION 109 WHEN OTHERS => 110 FAILED ( "EXCEPTION RAISED BOOL'VALUE OF """ & 111 STR & """" ); 112 END; 113 BEGIN 114 IF SUBBOOL'VALUE (STR) /= B THEN 115 FAILED ( "INCORRECT SUBBOOL'VALUE OF """ & 116 STR & """" ); 117 END IF; 118 EXCEPTION 119 WHEN OTHERS => 120 FAILED ( "EXCEPTION RAISED SUBBOOL'VALUE " & 121 "OF """ & STR & """" ); 122 END; 123 END P; 124 125 PROCEDURE NP1 IS NEW P ( BOOLEAN ); 126 PROCEDURE NP2 IS NEW P ( NEWBOOL ); 127 128 BEGIN 129 NP1 ( "TRUE", TRUE ); 130 NP2 ( "FALSE", FALSE ); 131 NP2 ( "true", TRUE ); 132 NP1 ( "false", FALSE ); 133 NP1 ( " TRUE", TRUE ); 134 NP2 ( "FALSE ", FALSE ); 135 END; 136 137 DECLARE 138 GENERIC 139 TYPE BOOL IS (<>); 140 PROCEDURE P (STR1 : STRING; B : BOOL; STR2 : STRING); 141 142 PROCEDURE P (STR1 : STRING; B : BOOL; STR2 : STRING) IS 143 SUBTYPE SUBBOOL IS BOOL 144 RANGE BOOL'VAL (IDENT_INT(0)) .. 145 BOOL'VAL (IDENT_INT(0)); 146 147 BEGIN 148 BEGIN 149 IF BOOL'VALUE (STR1) = B THEN 150 FAILED ( "NO EXCEPTION RAISED - " & 151 "BOOL'VALUE WITH " & STR2 & 152 "- EQUAL " ); 153 ELSE 154 FAILED ( "NO EXCEPTION RAISED - " & 155 "BOOL'VALUE WITH " & STR2 & 156 " - NOT EQUAL" ); 157 END IF; 158 EXCEPTION 159 WHEN CONSTRAINT_ERROR => 160 NULL; 161 WHEN OTHERS => 162 FAILED ( "WRONG EXCEPTION RAISED - " & 163 "BOOL'VALUE WITH " & STR2 ); 164 END; 165 BEGIN 166 IF SUBBOOL'VALUE (STR1) /= B THEN 167 FAILED ( "NO EXCEPTION RAISED - " & 168 "SUBBOOL'VALUE WITH " & 169 STR2 & " - EQUAL"); 170 ELSE 171 FAILED ( "NO EXCEPTION RAISED - " & 172 "SUBBOOL'VALUE WITH " & 173 STR2 & " - NOT EQUAL"); 174 END IF; 175 EXCEPTION 176 WHEN CONSTRAINT_ERROR => 177 NULL; 178 WHEN OTHERS => 179 FAILED ( "WRONG EXCEPTION RAISED - " & 180 "SUBBOOL'VALUE WITH " & STR2 ); 181 END; 182 END P; 183 184 PROCEDURE NP IS NEW P ( BOOLEAN ); 185 BEGIN 186 NP ( "MAYBE", TRUE, "NON-BOOLEAN VALUE"); 187 NP ( ASCII.HT & "TRUE", TRUE, "LEADING 'HT'" ); 188 NP ( "FALSE" & ASCII.HT , FALSE, "TRAILING 'HT'" ); 189 END; 190 191 RESULT; 192END C35508E; 193