1-- CE3908A.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 GET FOR ENUMERATION TYPES CAN OPERATE ON STRINGS. 27-- CHECK THAT IT RAISES END_ERROR WHEN THE STRING IS NULL OR 28-- EMPTY. CHECK THAT LAST CONTAINS THE INDEX VALUE OF THE LAST 29-- CHARACTER READ FROM THE STRING. 30 31-- HISTORY: 32-- SPS 10/11/82 33-- VKG 01/06/83 34-- JBG 02/22/84 CHANGED TO .ADA TEST 35-- DWC 09/18/87 ADDED CASES WHICH CONTAIN TABS WITH AND WITHOUT 36-- ENUMERATION LITERALS. 37 38WITH REPORT; 39USE REPORT; 40WITH TEXT_IO; 41USE TEXT_IO; 42 43PROCEDURE CE3908A IS 44BEGIN 45 46 TEST ("CE3908A", "CHECK THAT GET FOR ENUMERATION TYPES CAN " & 47 "OPERATE ON STRINGS. CHECK THAT IT RAISES " & 48 "END_ERROR WHEN THE STRING IS NULL OR EMPTY. " & 49 "CHECK THAT LAST CONTAINS THE INDEX VALUE OF " & 50 "THE LAST CHARACTER READ FROM THE STRING"); 51 52 DECLARE 53 TYPE FRUIT IS (APPLE, PEAR, ORANGE, STRAWBERRY); 54 DESSERT : FRUIT; 55 PACKAGE FRUIT_IO IS NEW ENUMERATION_IO (FRUIT); 56 USE FRUIT_IO; 57 L : POSITIVE; 58 BEGIN 59 GET ("APPLE ", DESSERT, L); 60 IF DESSERT /= APPLE THEN 61 FAILED ("ENUMERATION VALUE FROM STRING INCORRECT - 1"); 62 END IF; 63 64 IF L /= IDENT_INT (5) THEN 65 FAILED ("LAST CONTAINS INCORRECT VALUE AFTER GET - 1"); 66 END IF; 67 68 GET ("APPLE", DESSERT, L); 69 IF DESSERT /= APPLE THEN 70 FAILED ("ENUMERATION VALUE FROM STRING INCORRECT - 2"); 71 END IF; 72 73 IF L /= IDENT_INT (5) THEN 74 FAILED ("LAST CONTAINS INCORRECT VALUE AFTER GET - 2"); 75 END IF; 76 77 BEGIN 78 GET (ASCII.HT & "APPLE", DESSERT, L); 79 IF DESSERT /= APPLE THEN 80 FAILED ("ENUMERATION VALUE FROM STRING " & 81 "INCORRECT - 3"); 82 END IF; 83 IF L /= IDENT_INT(6) THEN 84 FAILED ("LAST CONTAINS INCORRECT VALUE AFTER " & 85 "GET - 3"); 86 END IF; 87 EXCEPTION 88 WHEN END_ERROR => 89 FAILED ("GET DID NOT SKIP LEADING TABS"); 90 WHEN OTHERS => 91 FAILED ("WRONG EXCEPTION RAISED - 3"); 92 END; 93 94-- NULL STRING LITERAL. 95 96 BEGIN 97 GET ("", DESSERT, L); 98 FAILED ("END_ERROR NOT RAISED - 4"); 99 EXCEPTION 100 WHEN END_ERROR => 101 IF L /= IDENT_INT(6) THEN 102 FAILED ("LAST CONTAINS INCORRECT VALUE " & 103 "AFTER GET - 4"); 104 END IF; 105 WHEN OTHERS => 106 FAILED ("WRONG EXCEPTION RAISED - 4"); 107 END; 108 109 BEGIN 110 GET (ASCII.HT & "", DESSERT, L); 111 FAILED ("END_ERROR NOT RAISED - 5"); 112 EXCEPTION 113 WHEN END_ERROR => 114 IF L /= IDENT_INT(6) THEN 115 FAILED ("LAST CONTAINS INCORRECT VALUE " & 116 "AFTER GET - 5"); 117 END IF; 118 WHEN OTHERS => 119 FAILED ("WRONG EXCEPTION RAISED - 5"); 120 END; 121 122-- STRING LITERAL WITH BLANKS. 123 124 BEGIN 125 GET(" ", DESSERT, L); 126 FAILED ("END ERROR NOT RAISED - 6"); 127 EXCEPTION 128 WHEN END_ERROR => 129 IF L /= IDENT_INT(6) THEN 130 FAILED ("LAST CONTAINS INCORRECT VALUE " & 131 "AFTER GET - 6"); 132 END IF; 133 WHEN OTHERS => 134 FAILED ("WRONG EXCEPTION RAISED - 6"); 135 END; 136 137 END; 138 139 RESULT; 140END CE3908A; 141