1-- C35503E.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 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULTS WHEN 27-- THE PREFIX IS A GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL 28-- PARAMETER IS AN INTEGER TYPE. 29-- SUBTESTS ARE : 30-- PART (A). TESTS FOR 'IMAGE'. 31-- PART (B). TESTS FOR 'VALUE'. 32 33-- HISTORY: 34-- RJW 03/17/86 CREATED ORIGINAL TEST. 35-- DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS. 36 37WITH REPORT; USE REPORT; 38 39PROCEDURE C35503E IS 40 41BEGIN 42 TEST ("C35503E", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD THE " & 43 "CORRECT RESULTS WHEN THE PREFIX IS A " & 44 "GENERIC FORMAL DISCRETE TYPE WHOSE ACTUAL " & 45 "PARAMETER IS AN INTEGER TYPE" ); 46-- PART (A). 47 48 DECLARE 49 TYPE NEWINT IS NEW INTEGER RANGE -2000 .. 2000; 50 51 GENERIC 52 TYPE INT IS (<>); 53 PROCEDURE P (I1 : INT; STR : STRING ); 54 55 PROCEDURE P (I1 : INT; STR : STRING) IS 56 SUBTYPE SUBINT IS INT 57 RANGE INT'VAL (IDENT_INT(-1000)) .. 58 INT'VAL (IDENT_INT(1000)); 59 BEGIN 60 61 IF INT'IMAGE (I1) /= STR THEN 62 FAILED ( "INCORRECT INT'IMAGE OF " & STR ); 63 END IF; 64 IF INT'IMAGE (I1)'FIRST /= 1 THEN 65 FAILED ( "INCORRECT LOWER BOUND FOR INT'IMAGE OF " & 66 STR ); 67 END IF; 68 69 IF SUBINT'IMAGE (I1) /= STR THEN 70 FAILED ( "INCORRECT SUBINT'IMAGE OF " & STR ); 71 END IF; 72 IF SUBINT'IMAGE (I1)'FIRST /= 1 THEN 73 FAILED ( "INCORRECT LOWER BOUND FOR SUBINT'IMAGE " & 74 "OF " & STR ); 75 END IF; 76 77 END P; 78 79 PROCEDURE PROC1 IS NEW P (INTEGER); 80 PROCEDURE PROC2 IS NEW P (NEWINT); 81 82 BEGIN 83 PROC1 (-500, "-500"); 84 PROC2 (0, " 0"); 85 PROC2 (99," 99"); 86 END; 87 88----------------------------------------------------------------------- 89 90-- PART (B). 91 92 DECLARE 93 TYPE NEWINT IS NEW INTEGER; 94 95 GENERIC 96 TYPE INT IS (<>); 97 PROCEDURE P (STR : STRING; I1 : INT ); 98 99 PROCEDURE P (STR : STRING; I1 : INT) IS 100 SUBTYPE SUBINT IS INT 101 RANGE INT'VAL (IDENT_INT(0)) .. 102 INT'VAL (IDENT_INT(10)); 103 104 BEGIN 105 BEGIN 106 IF INT'VALUE (STR) /= I1 THEN 107 FAILED ( "INCORRECT INT'VALUE OF """ & 108 STR & """"); 109 END IF; 110 EXCEPTION 111 WHEN OTHERS => 112 FAILED ( "EXCEPTION RAISED INT'VALUE OF """ & 113 STR & """"); 114 END; 115 BEGIN 116 IF SUBINT'VALUE (STR) /= I1 THEN 117 FAILED ( "INCORRECT SUBINT'VALUE OF """ & 118 STR & """"); 119 END IF; 120 EXCEPTION 121 WHEN OTHERS => 122 FAILED ( "EXCEPTION RAISED SUBINT'VALUE " & 123 "OF """ & STR & """"); 124 END; 125 END P; 126 127 PROCEDURE PROC1 IS NEW P (INTEGER); 128 PROCEDURE PROC2 IS NEW P (NEWINT); 129 130 BEGIN 131 PROC1 ("-500" , -500); 132 PROC2 (" -001E2 " , -100); 133 PROC1 ("3_45" , 345); 134 PROC2 ("-2#1111_1111#" , -255); 135 PROC1 ("16#FF#" , 255); 136 PROC2 ("-016#0FF#" , -255); 137 PROC1 ("2#1110_0000# " , 224); 138 PROC2 ("-16#E#E1" , -224); 139 140 END; 141 142 DECLARE 143 TYPE NEWINT IS NEW INTEGER; 144 145 GENERIC 146 TYPE INT IS (<>); 147 PROCEDURE P (STR1 : STRING; I1 : INT; STR2 : STRING); 148 149 PROCEDURE P (STR1 : STRING; I1 : INT; STR2 : STRING) IS 150 SUBTYPE SUBINT IS INT 151 RANGE INT'VAL (IDENT_INT(0)) .. 152 INT'VAL (IDENT_INT(10)); 153 154 BEGIN 155 BEGIN 156 IF INT'VALUE (STR1) = I1 THEN 157 FAILED ( "NO EXCEPTION RAISED - INT'VALUE " & 158 "WITH " & STR2 & " - EQUAL"); 159 ELSE 160 FAILED ( "NO EXCEPTION RAISED " & 161 "- INT'VALUE WITH " & 162 STR2 & " - NOT EQUAL" ); 163 END IF; 164 EXCEPTION 165 WHEN CONSTRAINT_ERROR => 166 NULL; 167 WHEN OTHERS => 168 FAILED ( "WRONG EXCEPTION RAISED - " & 169 "INT'VALUE WITH " & STR2 ); 170 END; 171 BEGIN 172 IF SUBINT'VALUE (STR1) = I1 THEN 173 FAILED ( "NO EXCEPTION RAISED - " & 174 "SUBINT'VALUE WITH " & STR2 175 & " - EQUAL" ); 176 ELSE 177 FAILED ( "NO EXCEPTION RAISED - " & 178 "SUBINT'VALUE WITH " & 179 STR2 & " - NOT EQUAL" ); 180 END IF; 181 EXCEPTION 182 WHEN CONSTRAINT_ERROR => 183 NULL; 184 WHEN OTHERS => 185 FAILED ( "WRONG EXCEPTION RAISED - " & 186 "SUBINT'VALUE WITH " & STR2 ); 187 END; 188 END P; 189 190 PROCEDURE PROC1 IS NEW P (INTEGER); 191 PROCEDURE PROC2 IS NEW P (NEWINT); 192 193 BEGIN 194 PROC1 ("1.0" , 1, "DECIMAL POINT"); 195 PROC1 (ASCII.HT & "244", 244, "LEADING 'HT'" ); 196 PROC2 ("244" & ASCII.HT, 244, "TRAILING 'HT'" ); 197 PROC1 ("2__44" , 244, "CONSECUTIVE '_'" ); 198 PROC2 ("_244" , 244, "LEADING '_'" ); 199 PROC1 ("244_" , 244, "TRAILING '_'" ); 200 PROC2 ("244_E1" , 2440, "'_' BEFORE 'E'" ); 201 PROC1 ("244E_1" , 2440, "'_' FOLLOWING 'E'" ); 202 PROC2 ("244_e1" , 2440, "'_' BEFORE 'e'" ); 203 PROC1 ("16#_FF#" , 255, "'_' IN BASED LITERAL" ); 204 PROC2 ("1E-0" , 0, "NEGATIVE EXPONENT" ); 205 PROC1 ("244." , 244, "TRAILING '.'" ); 206 PROC2 ("8#811#" , 0, "DIGITS OUTSIDE OF RANGE" ); 207 PROC1 ("1#000#" , 0, "BASE LESS THAN 2" ); 208 PROC2 ("17#0#" , 0, "BASE GREATER THAN 16" ); 209 END; 210 211 RESULT; 212END C35503E; 213