1-- REPBODY.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-- 26-- HISTORY: 27-- DCB 04/27/80 28-- JRK 6/10/80 29-- JRK 11/12/80 30-- JRK 8/6/81 31-- JRK 10/27/82 32-- JRK 6/1/84 33-- JRK 11/18/85 ADDED PRAGMA ELABORATE. 34-- PWB 07/29/87 ADDED STATUS ACTION_REQUIRED AND 35-- PROCEDURE SPECIAL_ACTION. 36-- TBN 08/20/87 ADDED FUNCTION LEGAL_FILE_NAME. 37-- BCB 05/17/90 MODIFIED TO ALLOW OUTPUT TO DIRECT_IO FILE. 38-- ADDED TIME-STAMP. 39-- LDC 05/17/90 REMOVED OUTPUT TO DIRECT_IO FILE. 40-- WMC 08/11/92 UPDATED ACVC VERSION STRING TO "9X BASIC". 41-- DTN 07/05/92 UPDATED ACVC VERSION STRING TO 42-- "ACVC 2.0 JULY 6 1993 DRAFT". 43-- WMC 01/24/94 MODIFIED LEGAL_FILE_NAME TO ALLOW FIVE POSSIBLE 44-- FILE NAMES (INCREASED RANGE OF TYPE FILE_NUM TO 1..5). 45-- WMC 11/06/94 UPDATED ACVC VERSION STRING TO 46-- "ACVC 2.0 NOVEMBER 6 1994 DRAFT". 47-- DTN 12/04/94 UPDATED ACVC VERSION STRING TO 48-- "ACVC 2.0". 49-- KAS 06/19/95 ADDED FUNCTION IDENT_WIDE_CHAR. 50-- KAS 06/19/95 ADDED FUNCTION IDENT_WIDE_STR. 51-- DTN 11/21/95 UPDATED ACVC VERSION STRING TO 52-- "ACVC 2.0.1". 53-- DTN 12/14/95 UPDATED ACVC VERSION STRING TO 54-- "ACVC 2.1". 55-- EDS 12/17/97 UPDATED ACVC VERSION STRING TO 56-- "2.2". 57-- RLB 3/16/00 UPDATED ACATS VERSION STRING TO "2.3". 58-- CHANGED VARIOUS STRINGS TO READ "ACATS". 59-- RLB 3/22/01 UPDATED ACATS VERSION STRING TO "2.4". 60-- RLB 3/29/01 UPDATED ACATS VERSION STRING TO "2.5". 61 62WITH TEXT_IO, CALENDAR; 63USE TEXT_IO, CALENDAR; 64PRAGMA ELABORATE (TEXT_IO, CALENDAR); 65 66PACKAGE BODY REPORT IS 67 68 TYPE STATUS IS (PASS, FAIL, DOES_NOT_APPLY, ACTION_REQUIRED, 69 UNKNOWN); 70 71 TYPE TIME_INTEGER IS RANGE 0 .. 86_400; 72 73 TEST_STATUS : STATUS := FAIL; 74 75 MAX_NAME_LEN : CONSTANT := 15; -- MAXIMUM TEST NAME LENGTH. 76 TEST_NAME : STRING (1..MAX_NAME_LEN); 77 78 NO_NAME : CONSTANT STRING (1..7) := "NO_NAME"; 79 TEST_NAME_LEN : INTEGER RANGE 0..MAX_NAME_LEN := 0; 80 81 82 83 ACATS_VERSION : CONSTANT STRING := "2.5"; 84 -- VERSION OF ACATS BEING RUN (X.XX). 85 86 PROCEDURE PUT_MSG (MSG : STRING) IS 87 -- WRITE MESSAGE. LONG MESSAGES ARE FOLDED (AND INDENTED). 88 MAX_LEN : CONSTANT INTEGER RANGE 50..150 := 72; -- MAXIMUM 89 -- OUTPUT LINE LENGTH. 90 INDENT : CONSTANT INTEGER := TEST_NAME_LEN + 9; -- AMOUNT TO 91 -- INDENT CONTINUATION LINES. 92 I : INTEGER := 0; -- CURRENT INDENTATION. 93 M : INTEGER := MSG'FIRST; -- START OF MESSAGE SLICE. 94 N : INTEGER; -- END OF MESSAGE SLICE. 95 BEGIN 96 LOOP 97 IF I + (MSG'LAST-M+1) > MAX_LEN THEN 98 N := M + (MAX_LEN-I) - 1; 99 IF MSG (N) /= ' ' THEN 100 WHILE N >= M AND THEN MSG (N+1) /= ' ' LOOP 101 N := N - 1; 102 END LOOP; 103 IF N < M THEN 104 N := M + (MAX_LEN-I) - 1; 105 END IF; 106 END IF; 107 ELSE N := MSG'LAST; 108 END IF; 109 SET_COL (STANDARD_OUTPUT, TEXT_IO.COUNT (I+1)); 110 PUT_LINE (STANDARD_OUTPUT, MSG (M..N)); 111 I := INDENT; 112 M := N + 1; 113 WHILE M <= MSG'LAST AND THEN MSG (M) = ' ' LOOP 114 M := M + 1; 115 END LOOP; 116 EXIT WHEN M > MSG'LAST; 117 END LOOP; 118 END PUT_MSG; 119 120 FUNCTION TIME_STAMP RETURN STRING IS 121 TIME_NOW : CALENDAR.TIME; 122 YEAR, 123 MONTH, 124 DAY, 125 HOUR, 126 MINUTE, 127 SECOND : TIME_INTEGER := 1; 128 129 FUNCTION CONVERT (NUMBER : TIME_INTEGER) RETURN STRING IS 130 STR : STRING (1..2) := (OTHERS => '0'); 131 DEC_DIGIT : CONSTANT STRING := "0123456789"; 132 NUM : TIME_INTEGER := NUMBER; 133 BEGIN 134 IF NUM = 0 THEN 135 RETURN STR; 136 ELSE 137 NUM := NUM MOD 100; 138 STR (2) := DEC_DIGIT (INTEGER (NUM MOD 10 + 1)); 139 NUM := NUM / 10; 140 STR (1) := DEC_DIGIT (INTEGER (NUM + 1)); 141 RETURN STR; 142 END IF; 143 END CONVERT; 144 BEGIN 145 TIME_NOW := CALENDAR.CLOCK; 146 SPLIT (TIME_NOW, YEAR_NUMBER (YEAR), MONTH_NUMBER (MONTH), 147 DAY_NUMBER (DAY), DAY_DURATION (SECOND)); 148 HOUR := SECOND / 3600; 149 SECOND := SECOND MOD 3600; 150 MINUTE := SECOND / 60; 151 SECOND := SECOND MOD 60; 152 RETURN (CONVERT (TIME_INTEGER (YEAR)) & "-" & 153 CONVERT (TIME_INTEGER (MONTH)) & "-" & 154 CONVERT (TIME_INTEGER (DAY)) & " " & 155 CONVERT (TIME_INTEGER (HOUR)) & ":" & 156 CONVERT (TIME_INTEGER (MINUTE)) & ":" & 157 CONVERT (TIME_INTEGER (SECOND))); 158 END TIME_STAMP; 159 160 PROCEDURE TEST (NAME : STRING; DESCR : STRING) IS 161 BEGIN 162 TEST_STATUS := PASS; 163 IF NAME'LENGTH <= MAX_NAME_LEN THEN 164 TEST_NAME_LEN := NAME'LENGTH; 165 ELSE TEST_NAME_LEN := MAX_NAME_LEN; 166 END IF; 167 TEST_NAME (1..TEST_NAME_LEN) := 168 NAME (NAME'FIRST .. NAME'FIRST+TEST_NAME_LEN-1); 169 170 PUT_MSG (""); 171 PUT_MSG (",.,. " & TEST_NAME (1..TEST_NAME_LEN) & " " & 172 "ACATS " & ACATS_VERSION & " " & TIME_STAMP); 173 PUT_MSG ("---- " & TEST_NAME (1..TEST_NAME_LEN) & " " & 174 DESCR & "."); 175 END TEST; 176 177 PROCEDURE COMMENT (DESCR : STRING) IS 178 BEGIN 179 PUT_MSG (" - " & TEST_NAME (1..TEST_NAME_LEN) & " " & 180 DESCR & "."); 181 END COMMENT; 182 183 PROCEDURE FAILED (DESCR : STRING) IS 184 BEGIN 185 TEST_STATUS := FAIL; 186 PUT_MSG (" * " & TEST_NAME (1..TEST_NAME_LEN) & " " & 187 DESCR & "."); 188 END FAILED; 189 190 PROCEDURE NOT_APPLICABLE (DESCR : STRING) IS 191 BEGIN 192 IF TEST_STATUS = PASS OR TEST_STATUS = ACTION_REQUIRED THEN 193 TEST_STATUS := DOES_NOT_APPLY; 194 END IF; 195 PUT_MSG (" + " & TEST_NAME (1..TEST_NAME_LEN) & " " & 196 DESCR & "."); 197 END NOT_APPLICABLE; 198 199 PROCEDURE SPECIAL_ACTION (DESCR : STRING) IS 200 BEGIN 201 IF TEST_STATUS = PASS THEN 202 TEST_STATUS := ACTION_REQUIRED; 203 END IF; 204 PUT_MSG (" ! " & TEST_NAME (1..TEST_NAME_LEN) & " " & 205 DESCR & "."); 206 END SPECIAL_ACTION; 207 208 PROCEDURE RESULT IS 209 BEGIN 210 CASE TEST_STATUS IS 211 WHEN PASS => 212 PUT_MSG ("==== " & TEST_NAME (1..TEST_NAME_LEN) & 213 " PASSED ============================."); 214 WHEN DOES_NOT_APPLY => 215 PUT_MSG ("++++ " & TEST_NAME (1..TEST_NAME_LEN) & 216 " NOT-APPLICABLE ++++++++++++++++++++."); 217 WHEN ACTION_REQUIRED => 218 PUT_MSG ("!!!! " & TEST_NAME (1..TEST_NAME_LEN) & 219 " TENTATIVELY PASSED !!!!!!!!!!!!!!!!."); 220 PUT_MSG ("!!!! " & (1..TEST_NAME_LEN => ' ') & 221 " SEE '!' COMMENTS FOR SPECIAL NOTES!!"); 222 WHEN OTHERS => 223 PUT_MSG ("**** " & TEST_NAME (1..TEST_NAME_LEN) & 224 " FAILED ****************************."); 225 END CASE; 226 TEST_STATUS := FAIL; 227 TEST_NAME_LEN := NO_NAME'LENGTH; 228 TEST_NAME (1..TEST_NAME_LEN) := NO_NAME; 229 END RESULT; 230 231 FUNCTION IDENT_INT (X : INTEGER) RETURN INTEGER IS 232 BEGIN 233 IF EQUAL (X, X) THEN -- ALWAYS EQUAL. 234 RETURN X; -- ALWAYS EXECUTED. 235 END IF; 236 RETURN 0; -- NEVER EXECUTED. 237 END IDENT_INT; 238 239 FUNCTION IDENT_CHAR (X : CHARACTER) RETURN CHARACTER IS 240 BEGIN 241 IF EQUAL (CHARACTER'POS(X), CHARACTER'POS(X)) THEN -- ALWAYS 242 -- EQUAL. 243 RETURN X; -- ALWAYS EXECUTED. 244 END IF; 245 RETURN '0'; -- NEVER EXECUTED. 246 END IDENT_CHAR; 247 248 FUNCTION IDENT_WIDE_CHAR (X : WIDE_CHARACTER) RETURN WIDE_CHARACTER IS 249 BEGIN 250 IF EQUAL (WIDE_CHARACTER'POS(X), WIDE_CHARACTER'POS(X)) THEN 251 -- ALWAYS EQUAL. 252 RETURN X; -- ALWAYS EXECUTED. 253 END IF; 254 RETURN '0'; -- NEVER EXECUTED. 255 END IDENT_WIDE_CHAR; 256 257 FUNCTION IDENT_BOOL (X : BOOLEAN) RETURN BOOLEAN IS 258 BEGIN 259 IF EQUAL (BOOLEAN'POS(X), BOOLEAN'POS(X)) THEN -- ALWAYS 260 -- EQUAL. 261 RETURN X; -- ALWAYS EXECUTED. 262 END IF; 263 RETURN FALSE; -- NEVER EXECUTED. 264 END IDENT_BOOL; 265 266 FUNCTION IDENT_STR (X : STRING) RETURN STRING IS 267 BEGIN 268 IF EQUAL (X'LENGTH, X'LENGTH) THEN -- ALWAYS EQUAL. 269 RETURN X; -- ALWAYS EXECUTED. 270 END IF; 271 RETURN ""; -- NEVER EXECUTED. 272 END IDENT_STR; 273 274 FUNCTION IDENT_WIDE_STR (X : WIDE_STRING) RETURN WIDE_STRING IS 275 BEGIN 276 IF EQUAL (X'LENGTH, X'LENGTH) THEN -- ALWAYS EQUAL. 277 RETURN X; -- ALWAYS EXECUTED. 278 END IF; 279 RETURN ""; -- NEVER EXECUTED. 280 END IDENT_WIDE_STR; 281 282 FUNCTION EQUAL (X, Y : INTEGER) RETURN BOOLEAN IS 283 REC_LIMIT : CONSTANT INTEGER RANGE 1..100 := 3; -- RECURSION 284 -- LIMIT. 285 Z : BOOLEAN; -- RESULT. 286 BEGIN 287 IF X < 0 THEN 288 IF Y < 0 THEN 289 Z := EQUAL (-X, -Y); 290 ELSE Z := FALSE; 291 END IF; 292 ELSIF X > REC_LIMIT THEN 293 Z := EQUAL (REC_LIMIT, Y-X+REC_LIMIT); 294 ELSIF X > 0 THEN 295 Z := EQUAL (X-1, Y-1); 296 ELSE Z := Y = 0; 297 END IF; 298 RETURN Z; 299 EXCEPTION 300 WHEN OTHERS => 301 RETURN X = Y; 302 END EQUAL; 303 304 FUNCTION LEGAL_FILE_NAME (X : FILE_NUM := 1; 305 NAM : STRING := "") 306 RETURN STRING IS 307 SUFFIX : STRING (2..6); 308 BEGIN 309 IF NAM = "" THEN 310 SUFFIX := TEST_NAME(3..7); 311 ELSE 312 SUFFIX := NAM(3..7); 313 END IF; 314 315 CASE X IS 316 WHEN 1 => RETURN ('X' & SUFFIX); 317 WHEN 2 => RETURN ('Y' & SUFFIX); 318 WHEN 3 => RETURN ('Z' & SUFFIX); 319 WHEN 4 => RETURN ('V' & SUFFIX); 320 WHEN 5 => RETURN ('W' & SUFFIX); 321 END CASE; 322 END LEGAL_FILE_NAME; 323 324BEGIN 325 326 TEST_NAME_LEN := NO_NAME'LENGTH; 327 TEST_NAME (1..TEST_NAME_LEN) := NO_NAME; 328 329END REPORT; 330