OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxa/] [cxa8003.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- 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
 
50
with Direct_IO;
51
with Report;
52
 
53
procedure 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
 
210
exception
211
  when Incomplete =>
212
    Report.Result;
213
 
214
end CXA8003;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.