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