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