1-- CE3906C.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 PUT FOR ENUMERATION TYPES OUTPUTS THE ENUMERATION 27-- LITERAL WITH NO TRAILING OR PRECEDING BLANKS WHEN WIDTH IS 28-- NOT SPECIFIED OR IS SPECIFIED TO BE LESS THAN OR EQUAL TO THE 29-- LENGTH OF THE STRING. CHECK THAT WHEN WIDTH IS SPECIFIED TO 30-- BE GREATER THAN THE LENGTH OF THE STRING, TRAILING BLANKS ARE 31-- OUTPUT. 32 33-- APPLICABILITY CRITERIA: 34-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT 35-- TEXT FILES. 36 37-- HISTORY: 38-- SPS 10/08/82 39-- SPS 01/03/83 40-- VKG 01/07/83 41-- JBG 02/22/84 CHANGED TO .ADA TEST. 42-- TBN 11/10/86 REVISED TEST TO OUTPUT A NON_APPLICABLE 43-- RESULT WHEN FILES ARE NOT SUPPORTED. 44-- DWC 09/18/87 REMOVED CALL TO CHECKFILE. CLOSED AND REOPENED 45-- FILE AND CHECKED CONTENTS OF FILE USING 46-- ENUMERATION_IO GETS. 47 48WITH REPORT; 49USE REPORT; 50WITH TEXT_IO; 51USE TEXT_IO; 52 53PROCEDURE CE3906C IS 54 INCOMPLETE : EXCEPTION; 55 56BEGIN 57 58 TEST ("CE3906C", "CHECK THAT ENUMERATION_IO PUT OUTPUTS " & 59 "ENUMERATION LITERALS CORRECTLY WITH AND " & 60 "WITHOUT WIDTH PARAMETERS"); 61 62 DECLARE 63 FT : FILE_TYPE; 64 TYPE MOOD IS (ANGRY, HAPPY, BORED, SAD); 65 X : MOOD := BORED; 66 PACKAGE MOOD_IO IS NEW ENUMERATION_IO (MOOD); 67 CH : CHARACTER; 68 USE MOOD_IO; 69 BEGIN 70 71 BEGIN 72 CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); 73 EXCEPTION 74 WHEN USE_ERROR => 75 NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & 76 "WITH OUT_FILE MODE"); 77 RAISE INCOMPLETE; 78 WHEN NAME_ERROR => 79 NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & 80 "WITH OUT_FILE MODE"); 81 RAISE INCOMPLETE; 82 END; 83 84 DEFAULT_WIDTH := FIELD(IDENT_INT(5)); 85 86 IF DEFAULT_WIDTH /= FIELD(IDENT_INT(5)) THEN 87 FAILED ("DEFAULT_WIDTH NOT SET CORRECTLY"); 88 END IF; 89 90 PUT (FT, X, 3); -- BORED 91 X := HAPPY; 92 NEW_LINE(FT); 93 PUT (FILE => FT, ITEM => X, WIDTH => 5); -- HAPPY 94 NEW_LINE (FT); 95 PUT (FT, SAD, 5); -- SAD 96 DEFAULT_WIDTH := FIELD(IDENT_INT(6)); 97 PUT (FT, X); -- HAPPY 98 PUT (FT, SAD, 3); -- SAD 99 NEW_LINE(FT); 100 DEFAULT_WIDTH := FIELD(IDENT_INT(2)); 101 PUT (FT, SAD); -- SAD 102 103 CLOSE (FT); 104 105 BEGIN 106 OPEN (FT, IN_FILE, LEGAL_FILE_NAME); 107 EXCEPTION 108 WHEN USE_ERROR => 109 NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN FOR " & 110 "IN_FILE MODE"); 111 RAISE INCOMPLETE; 112 END; 113 114 GET (FT, X); 115 IF X /= BORED THEN 116 FAILED ("BORED NOT READ CORRECTLY"); 117 END IF; 118 119 GET (FT, X); 120 IF X /= HAPPY THEN 121 FAILED ("HAPPY NOT READ CORRECTLY - 1"); 122 END IF; 123 124 SKIP_LINE (FT); 125 126 GET (FT, X); 127 IF X /= SAD THEN 128 FAILED ("SAD NOT READ CORRECTLY - 1"); 129 END IF; 130 131 GET (FT, CH); 132 IF CH /= ' ' THEN 133 FAILED ("BLANKS NOT POSITIONED CORRECTLY - 1"); 134 END IF; 135 136 GET (FT, CH); 137 IF CH /= ' ' THEN 138 FAILED ("BLANKS NOT POSITIONED CORRECTLY - 2"); 139 END IF; 140 141 GET (FT, X); 142 IF X /= HAPPY THEN 143 FAILED ("HAPPY NOT READ CORRECTLY - 2"); 144 END IF; 145 146 GET (FT, CH); 147 IF CH /= ' ' THEN 148 FAILED ("BLANKS NOT POSITIONED CORRECTLY - 3"); 149 END IF; 150 151 GET (FT, X); 152 IF X /= SAD THEN 153 FAILED ("SAD NOT READ CORRECTLY - 2"); 154 END IF; 155 156 SKIP_LINE (FT); 157 158 GET (FT, X); 159 IF X /= SAD THEN 160 FAILED ("SAD NOT READ CORRECTLY - 3"); 161 END IF; 162 163 BEGIN 164 DELETE (FT); 165 EXCEPTION 166 WHEN USE_ERROR => 167 NULL; 168 END; 169 170 EXCEPTION 171 WHEN INCOMPLETE => 172 NULL; 173 END; 174 175 RESULT; 176 177END CE3906C; 178