1-- CXA8003.A
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-- OBJECTIVE:
27--      Check that Append_File mode has not been added to package Direct_IO.
28--
29-- TEST DESCRIPTION:
30--      This test uses a procedure to change the mode of an existing Direct_IO
31--      file.  The file descriptor is passed as a parameter, along with a
32--      numeric indicator for the new mode.  Based on the numeric parameter,
33--      a Direct_IO.Reset is performed using a File_Mode'Value transformation
34--      of a string constant into a File_Mode value.  An attempt to reset a
35--      Direct_IO file to mode Append_File should cause an Constraint_Error
36--      to be raised, as Append_File mode has not been added to Direct_IO in
37--      Ada 9X.
38--
39-- APPLICABILITY CRITERIA:
40--      This test is applicable to all implementations supporting Direct_IO
41--      files.
42--
43--
44-- CHANGE HISTORY:
45--      06 Dec 94   SAIC    ACVC 2.0
46--      19 Feb 97   PWB.CTA Allowed for non-support of Reset for certain
47--                  modes.
48--!
49
50with Direct_IO;
51with Report;
52
53procedure CXA8003 is
54   Incomplete : exception;
55      begin
56
57         Report.Test ("CXA8003", "Check that Append_File mode has not " &
58                                 "been added to package Direct_IO");
59
60         Test_for_Direct_IO_Support:
61         declare
62
63            subtype String_Data_Type    is String (1 .. 20);
64            type    Numeric_Data_Type   is range 1 .. 512;
65            type    Composite_Data_Type is array (1 .. 3) of String_Data_Type;
66
67            type File_Data_Type is record
68               Data_Field_1 : String_Data_Type;
69               Data_Field_2 : Numeric_Data_Type;
70               Data_Field_3 : Composite_Data_Type;
71            end record;
72
73            package Dir_IO is new Direct_IO (File_Data_Type);
74
75            Data_File    : Dir_IO.File_Type;
76            Dir_Filename : constant String := Report.Legal_File_Name;
77
78         begin
79
80            -- An application creates a text file with mode Out_File.
81            -- Use_Error will be raised if Direct_IO operations or external
82            -- files are not supported.
83
84            Dir_IO.Create (Data_File,
85                           Dir_IO.Out_File,
86                           Dir_Filename);
87
88            Change_File_Mode:
89            declare
90
91               TC_Append_Test_Executed : Boolean := False;
92
93               type Mode_Selection_Type is ( A, I, IO, O );
94
95
96               procedure Change_Mode (File : in out Dir_IO.File_Type;
97                                      To   : in     Mode_Selection_Type) is
98               begin
99                  case To is
100                     when A  =>
101                        TC_Append_Test_Executed := True;
102                        Dir_IO.Reset
103                          (File, Dir_IO.File_Mode'Value("Append_File"));
104                     when I  =>
105                        begin
106                          Dir_IO.Reset
107                            (File, Dir_IO.File_Mode'Value("In_File"));
108                        exception
109                          when Dir_IO.Use_Error =>
110                            Report.Not_Applicable
111                              ("Reset to In_File not supported: Direct_IO");
112                            raise Incomplete;
113                        end;
114                     when IO =>
115                        begin
116                          Dir_IO.Reset
117                            (File, Dir_IO.File_Mode'Value("Inout_File"));
118                        exception
119                          when Dir_IO.Use_Error =>
120                            Report.Not_Applicable
121                              ("Reset to InOut_File not supported: Direct_IO");
122                            raise Incomplete;
123                        end;
124                     when O  =>
125                       begin
126                         Dir_IO.Reset
127                           (File, Dir_IO.File_Mode'Value("Out_File"));
128                        exception
129                          when Dir_IO.Use_Error =>
130                            Report.Not_Applicable
131                              ("Reset to Out_File not supported: Direct_IO");
132                            raise Incomplete;
133                        end;
134                  end case;
135               end Change_Mode;
136
137
138            begin
139
140              -- At some point in the processing, the application may call a
141              -- procedure to change the mode of the file (perhaps for
142              -- additional data entry, data verification, etc.).  It is at
143              -- this point that a use of Append_File mode for a Direct_IO
144              -- file would cause an exception.
145
146               for I in reverse Mode_Selection_Type loop
147                  Change_Mode (Data_File, I);
148                  Report.Comment
149                    ("Mode changed to " &
150                     Dir_IO.File_Mode'Image (Dir_IO.Mode (Data_File)));
151               end loop;
152
153               Report.Failed("No error raised on change to Append_File mode");
154
155            exception
156
157               -- A handler has been provided in the application, which
158               -- handles the constraint error, allowing processing to
159               -- continue.
160
161               when Constraint_Error =>
162
163                  if TC_Append_Test_Executed then
164                     Report.Comment ("Constraint_Error correctly raised on " &
165                                     "attempted Append_File mode selection " &
166                                     "for a Direct_IO file");
167                  else
168                     Report.Failed ("Append test was not executed");
169                  end if;
170
171               when Incomplete => raise;
172
173               when others  => Report.Failed ("Unexpected exception raised");
174
175            end Change_File_Mode;
176
177            Final_Block:
178            begin
179              if Dir_IO.Is_Open (Data_File) then
180                 Dir_IO.Delete (Data_File);
181              else
182                 Dir_IO.Open (Data_File, Dir_IO.In_File, Dir_Filename);
183                 Dir_IO.Delete (Data_File);
184              end if;
185            exception
186              when others =>
187                Report.Failed ("Delete not properly supported: Direct_IO");
188            end Final_Block;
189
190         exception
191
192            -- Since Use_Error or Name_Error can be raised if, for the
193            -- specified mode, the environment does not support Direct_IO
194            -- operations, the following handlers are included:
195
196            when Dir_IO.Name_Error =>
197               Report.Not_Applicable("Name_Error raised on Direct IO Create");
198
199            when Dir_IO.Use_Error  =>
200               Report.Not_Applicable("Use_Error raised on Direct IO Create");
201
202            when others            =>
203               Report.Failed
204                 ("Unexpected exception raised on Direct IO Create");
205
206         end Test_for_Direct_IO_Support;
207
208         Report.Result;
209
210exception
211  when Incomplete =>
212    Report.Result;
213
214end CXA8003;
215