1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- S Y S T E M . F I L E _ I O --
9 -- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada
.Finalization
; use Ada
.Finalization
;
33 with Ada
.IO_Exceptions
; use Ada
.IO_Exceptions
;
34 with Ada
.Unchecked_Deallocation
;
37 with Interfaces
.C_Streams
; use Interfaces
.C_Streams
;
39 with System
.Case_Util
; use System
.Case_Util
;
42 with System
.Soft_Links
;
44 package body System
.File_IO
is
46 use System
.File_Control_Block
;
48 package SSL
renames System
.Soft_Links
;
51 use type Interfaces
.C
.int
;
53 ----------------------
54 -- Global Variables --
55 ----------------------
57 Open_Files
: AFCB_Ptr
;
58 -- This points to a list of AFCB's for all open files. This is a doubly
59 -- linked list, with the Prev pointer of the first entry, and the Next
60 -- pointer of the last entry containing null. Note that this global
61 -- variable must be properly protected to provide thread safety.
63 type Temp_File_Record
;
64 type Temp_File_Record_Ptr
is access all Temp_File_Record
;
66 type Temp_File_Record
is record
67 Name
: String (1 .. max_path_len
+ 1);
68 Next
: Temp_File_Record_Ptr
;
70 -- One of these is allocated for each temporary file created
72 Temp_Files
: Temp_File_Record_Ptr
;
73 -- Points to list of names of temporary files. Note that this global
74 -- variable must be properly protected to provide thread safety.
76 type File_IO_Clean_Up_Type
is new Limited_Controlled
with null record;
77 -- The closing of all open files and deletion of temporary files is an
78 -- action that takes place at the end of execution of the main program.
79 -- This action is implemented using a library level object which gets
80 -- finalized at the end of program execution. Note that the type is
81 -- limited, in order to stop the compiler optimizing away the declaration
82 -- which would be allowed in the non-limited case.
84 procedure Finalize
(V
: in out File_IO_Clean_Up_Type
);
85 -- This is the finalize operation that is used to do the cleanup
87 File_IO_Clean_Up_Object
: File_IO_Clean_Up_Type
;
88 pragma Warnings
(Off
, File_IO_Clean_Up_Object
);
89 -- This is the single object of the type that triggers the finalization
90 -- call. Since it is at the library level, this happens just before the
91 -- environment task is finalized.
93 text_translation_required
: Boolean;
94 for text_translation_required
'Size use Character'Size;
96 (C
, text_translation_required
, "__gnat_text_translation_required");
97 -- If true, add appropriate suffix to control string for Open
99 -----------------------
100 -- Local Subprograms --
101 -----------------------
103 procedure Free_String
is new Ada
.Unchecked_Deallocation
(String, Pstring
);
105 subtype Fopen_String
is String (1 .. 4);
106 -- Holds open string (longest is "w+b" & nul)
114 Fopstr
: out Fopen_String
);
115 -- Determines proper open mode for a file to be opened in the given Ada
116 -- mode. Namestr is the NUL-terminated file name. Text is true for a text
117 -- file and false otherwise, and Creat is true for a create call, and False
118 -- for an open call. The value stored in Fopstr is a nul-terminated string
119 -- suitable for a call to fopen or freopen. Amethod is the character
120 -- designating the access method from the Access_Method field of the FCB.
122 function Errno_Message
124 Errno
: Integer := OS_Lib
.Errno
) return String;
125 -- Return Errno_Message for Errno, with file name prepended
127 procedure Raise_Device_Error
129 Errno
: Integer := OS_Lib
.Errno
);
130 pragma No_Return
(Raise_Device_Error
);
131 -- Clear error indication on File and raise Device_Error with an exception
132 -- message providing errno information.
138 procedure Append_Set
(File
: AFCB_Ptr
) is
140 if File
.Mode
= Append_File
then
141 if fseek
(File
.Stream
, 0, SEEK_END
) /= 0 then
142 Raise_Device_Error
(File
);
151 procedure Chain_File
(File
: AFCB_Ptr
) is
153 -- Take a task lock, to protect the global data value Open_Files
157 -- Do the chaining operation locked
159 File
.Next
:= Open_Files
;
163 if File
.Next
/= null then
164 File
.Next
.Prev
:= File
;
175 ---------------------
176 -- Check_File_Open --
177 ---------------------
179 procedure Check_File_Open
(File
: AFCB_Ptr
) is
182 raise Status_Error
with "file not open";
186 -----------------------
187 -- Check_Read_Status --
188 -----------------------
190 procedure Check_Read_Status
(File
: AFCB_Ptr
) is
193 raise Status_Error
with "file not open";
194 elsif File
.Mode
not in Read_File_Mode
then
195 raise Mode_Error
with "file not readable";
197 end Check_Read_Status
;
199 ------------------------
200 -- Check_Write_Status --
201 ------------------------
203 procedure Check_Write_Status
(File
: AFCB_Ptr
) is
206 raise Status_Error
with "file not open";
207 elsif File
.Mode
= In_File
then
208 raise Mode_Error
with "file not writable";
210 end Check_Write_Status
;
216 procedure Close
(File_Ptr
: access AFCB_Ptr
) is
217 Close_Status
: int
:= 0;
218 Dup_Strm
: Boolean := False;
219 Errno
: Integer := 0;
221 File
: AFCB_Ptr
renames File_Ptr
.all;
224 -- Take a task lock, to protect the global data value Open_Files
228 Check_File_Open
(File
);
231 -- Sever the association between the given file and its associated
232 -- external file. The given file is left closed. Do not perform system
233 -- closes on the standard input, output and error files and also do not
234 -- attempt to close a stream that does not exist (signalled by a null
235 -- stream value -- happens in some error situations).
237 if not File
.Is_System_File
and then File
.Stream
/= NULL_Stream
then
239 -- Do not do an fclose if this is a shared file and there is at least
240 -- one other instance of the stream that is open.
242 if File
.Shared_Status
= Yes
then
249 if P
/= File
and then File
.Stream
= P
.Stream
then
259 -- Do the fclose unless this was a duplicate in the shared case
262 Close_Status
:= fclose
(File
.Stream
);
264 if Close_Status
/= 0 then
265 Errno
:= OS_Lib
.Errno
;
270 -- Dechain file from list of open files and then free the storage
272 if File
.Prev
= null then
273 Open_Files
:= File
.Next
;
275 File
.Prev
.Next
:= File
.Next
;
278 if File
.Next
/= null then
279 File
.Next
.Prev
:= File
.Prev
;
282 -- Deallocate some parts of the file structure that were kept in heap
283 -- storage with the exception of system files (standard input, output
284 -- and error) since they had some information allocated in the stack.
286 if not File
.Is_System_File
then
287 Free_String
(File
.Name
);
288 Free_String
(File
.Form
);
294 if Close_Status
/= 0 then
295 Raise_Device_Error
(null, Errno
);
310 procedure Delete
(File_Ptr
: access AFCB_Ptr
) is
311 File
: AFCB_Ptr
renames File_Ptr
.all;
314 Check_File_Open
(File
);
316 if not File
.Is_Regular_File
then
317 raise Use_Error
with "cannot delete non-regular file";
321 Filename
: aliased constant String := File
.Name
.all;
326 -- Now unlink the external file. Note that we use the full name in
327 -- this unlink, because the working directory may have changed since
328 -- we did the open, and we want to unlink the right file.
330 if unlink
(Filename
'Address) = -1 then
331 raise Use_Error
with OS_Lib
.Errno_Message
;
340 function End_Of_File
(File
: AFCB_Ptr
) return Boolean is
342 Check_File_Open
(File
);
344 if feof
(File
.Stream
) /= 0 then
348 Check_Read_Status
(File
);
350 if ungetc
(fgetc
(File
.Stream
), File
.Stream
) = EOF
then
351 clearerr
(File
.Stream
);
363 function Errno_Message
365 Errno
: Integer := OS_Lib
.Errno
) return String
368 return Name
& ": " & OS_Lib
.Errno_Message
(Err
=> Errno
);
375 procedure Finalize
(V
: in out File_IO_Clean_Up_Type
) is
376 pragma Warnings
(Off
, V
);
378 Fptr1
: aliased AFCB_Ptr
;
384 -- Take a lock to protect global Open_Files data structure
388 -- First close all open files (the slightly complex form of this loop is
389 -- required because Close as a side effect nulls out its argument).
392 while Fptr1
/= null loop
394 Close
(Fptr1
'Access);
398 -- Now unlink all temporary files. We do not bother to free the blocks
399 -- because we are just about to terminate the program. We also ignore
400 -- any errors while attempting these unlink operations.
402 while Temp_Files
/= null loop
403 Discard
:= unlink
(Temp_Files
.Name
'Address);
404 Temp_Files
:= Temp_Files
.Next
;
419 procedure Flush
(File
: AFCB_Ptr
) is
421 Check_Write_Status
(File
);
423 if fflush
(File
.Stream
) /= 0 then
424 Raise_Device_Error
(File
);
432 -- The fopen mode to be used is shown by the following table:
435 -- Append_File "r+" "w+"
437 -- Out_File (Direct_IO, Stream_IO) "r+" [*] "w"
438 -- Out_File (others) "w" "w"
439 -- Inout_File "r+" "w+"
441 -- [*] Except that for Out_File, if the file exists and is a fifo (i.e. a
442 -- named pipe), we use "w" instead of "r+". This is necessary to make a
443 -- write to the fifo block until a reader is ready.
445 -- Note: we do not use "a" or "a+" for Append_File, since this would not
446 -- work in the case of stream files, where even if in append file mode,
447 -- you can reset to earlier points in the file. The caller must use the
448 -- Append_Set routine to deal with the necessary positioning.
450 -- Note: in several cases, the fopen mode used allows reading and writing,
451 -- but the setting of the Ada mode is more restrictive. For instance,
452 -- Create in In_File mode uses "w+" which allows writing, but the Ada mode
453 -- In_File will cause any write operations to be rejected with Mode_Error
456 -- Note: for the Out_File/Open cases for other than the Direct_IO case, an
457 -- initial call will be made by the caller to first open the file in "r"
458 -- mode to be sure that it exists. The real open, in "w" mode, will then
459 -- destroy this file. This is peculiar, but that's what Ada semantics
460 -- require and the ACATS tests insist on.
462 -- If text file translation is required, then either "b" or "t" is appended
463 -- to the mode, depending on the setting of Text.
471 Fopstr
: out Fopen_String
)
475 function is_fifo
(Path
: Address
) return Integer;
476 pragma Import
(C
, is_fifo
, "__gnat_is_fifo");
491 if Amethod
in 'D' |
'S'
493 and then is_fifo
(Namestr
'Address) = 0
506 Fopstr
(1) := (if Creat
then 'w' else 'r');
511 -- If text_translation_required is true then we need to append either a
512 -- "t" or "b" to the string to get the right mode.
514 if text_translation_required
then
515 Fopstr
(Fptr
) := (if Text
then 't' else 'b');
519 Fopstr
(Fptr
) := ASCII
.NUL
;
526 function Form
(File
: AFCB_Ptr
) return String is
529 raise Status_Error
with "Form: file not open";
531 return File
.Form
.all (1 .. File
.Form
'Length - 1);
539 function Form_Boolean
542 Default
: Boolean) return Boolean
545 pragma Unreferenced
(V2
);
548 Form_Parameter
(Form
, Keyword
, V1
, V2
);
552 elsif Form
(V1
) = 'y' then
554 elsif Form
(V1
) = 'n' then
557 raise Use_Error
with "invalid Form";
565 function Form_Integer
568 Default
: Integer) return Integer
574 Form_Parameter
(Form
, Keyword
, V1
, V2
);
582 for J
in V1
.. V2
loop
583 if Form
(J
) not in '0' .. '9' then
584 raise Use_Error
with "invalid Form";
586 V
:= V
* 10 + Character'Pos (Form
(J
)) - Character'Pos ('0');
590 raise Use_Error
with "invalid Form";
602 procedure Form_Parameter
608 Klen
: constant Integer := Keyword
'Length;
611 for J
in Form
'First + Klen
.. Form
'Last - 1 loop
613 and then Form
(J
- Klen
.. J
- 1) = Keyword
617 while Form
(Stop
+ 1) /= ASCII
.NUL
618 and then Form
(Stop
+ 1) /= ','
635 function Is_Open
(File
: AFCB_Ptr
) return Boolean is
637 -- We return True if the file is open, and the underlying file stream is
638 -- usable. In particular on Windows an application linked with -mwindows
639 -- option set does not have a console attached. In this case standard
640 -- files (Current_Output, Current_Error, Current_Input) are not created.
641 -- We want Is_Open (Current_Output) to return False in this case.
643 return File
/= null and then fileno
(File
.Stream
) /= -1;
650 procedure Make_Buffered
652 Buf_Siz
: Interfaces
.C_Streams
.size_t
)
655 pragma Unreferenced
(status
);
658 status
:= setvbuf
(File
.Stream
, Null_Address
, IOFBF
, Buf_Siz
);
661 ------------------------
662 -- Make_Line_Buffered --
663 ------------------------
665 procedure Make_Line_Buffered
667 Line_Siz
: Interfaces
.C_Streams
.size_t
)
670 pragma Unreferenced
(status
);
673 status
:= setvbuf
(File
.Stream
, Null_Address
, IOLBF
, Line_Siz
);
674 -- No error checking???
675 end Make_Line_Buffered
;
677 ---------------------
678 -- Make_Unbuffered --
679 ---------------------
681 procedure Make_Unbuffered
(File
: AFCB_Ptr
) is
683 pragma Unreferenced
(status
);
686 status
:= setvbuf
(File
.Stream
, Null_Address
, IONBF
, 0);
687 -- No error checking???
694 function Mode
(File
: AFCB_Ptr
) return File_Mode
is
697 raise Status_Error
with "Mode: file not open";
707 function Name
(File
: AFCB_Ptr
) return String is
710 raise Status_Error
with "Name: file not open";
712 return File
.Name
.all (1 .. File
.Name
'Length - 1);
721 (File_Ptr
: in out AFCB_Ptr
;
722 Dummy_FCB
: AFCB
'Class;
729 C_Stream
: FILEs
:= NULL_Stream
)
731 pragma Warnings
(Off
, Dummy_FCB
);
732 -- Yes we know this is never assigned a value. That's intended, since
733 -- all we ever use of this value is the tag for dispatching purposes.
735 procedure Tmp_Name
(Buffer
: Address
);
736 pragma Import
(C
, Tmp_Name
, "__gnat_tmp_name");
737 -- Set buffer (a String address) with a temporary filename
739 function Get_Case_Sensitive
return Integer;
740 pragma Import
(C
, Get_Case_Sensitive
,
741 "__gnat_get_file_names_case_sensitive");
743 procedure Record_AFCB
;
744 -- Create and record new AFCB into the runtime, note that the
745 -- implementation uses the variables below which corresponds to the
746 -- status of the opened file.
748 File_Names_Case_Sensitive
: constant Boolean := Get_Case_Sensitive
/= 0;
749 -- Set to indicate whether the operating system convention is for file
750 -- names to be case sensitive (e.g., in Unix, set True), or not case
751 -- sensitive (e.g., in Windows, set False). Declared locally to avoid
752 -- breaking the Preelaborate rule that disallows function calls at the
755 Stream
: FILEs
:= C_Stream
;
756 -- Stream which we open in response to this request
758 Shared
: Shared_Status_Type
;
759 -- Setting of Shared_Status field for file
761 Fopstr
: aliased Fopen_String
;
762 -- Mode string used in fopen call
764 Formstr
: aliased String (1 .. Form
'Length + 1);
765 -- Form string with ASCII.NUL appended, folded to lower case
767 Text_Encoding
: Content_Encoding
;
769 Tempfile
: constant Boolean := (Name
'Length = 0);
770 -- Indicates temporary file case
772 Namelen
: constant Integer := max_path_len
;
773 -- Length required for file name, not including final ASCII.NUL.
774 -- Note that we used to reference L_tmpnam here, which is not reliable
775 -- since __gnat_tmp_name does not always use tmpnam.
777 Namestr
: aliased String (1 .. Namelen
+ 1);
778 -- Name as given or temporary file name with ASCII.NUL appended
780 Fullname
: aliased String (1 .. max_path_len
+ 1);
781 -- Full name (as required for Name function, and as stored in the
782 -- control block in the Name field) with ASCII.NUL appended.
784 Full_Name_Len
: Integer;
785 -- Length of name actually stored in Fullname
787 Encoding
: CRTL
.Filename_Encoding
;
788 -- Filename encoding specified into the form parameter
794 procedure Record_AFCB
is
796 File_Ptr
:= AFCB_Allocate
(Dummy_FCB
);
798 -- Note that we cannot use an aggregate here as File_Ptr is a
799 -- class-wide access to a limited type (Root_Stream_Type).
801 File_Ptr
.Is_Regular_File
:= is_regular_file
(fileno
(Stream
)) /= 0;
802 File_Ptr
.Is_System_File
:= False;
803 File_Ptr
.Text_Encoding
:= Text_Encoding
;
804 File_Ptr
.Shared_Status
:= Shared
;
805 File_Ptr
.Access_Method
:= Amethod
;
806 File_Ptr
.Stream
:= Stream
;
807 File_Ptr
.Form
:= new String'(Formstr);
808 File_Ptr.Name := new String'(Fullname
809 (1 .. Full_Name_Len
));
810 File_Ptr
.Mode
:= Mode
;
811 File_Ptr
.Is_Temporary_File
:= Tempfile
;
812 File_Ptr
.Encoding
:= Encoding
;
814 Chain_File
(File_Ptr
);
815 Append_Set
(File_Ptr
);
818 -- Start of processing for Open
821 if File_Ptr
/= null then
822 raise Status_Error
with "file already open";
825 -- Acquire form string, setting required NUL terminator
827 Formstr
(1 .. Form
'Length) := Form
;
828 Formstr
(Formstr
'Last) := ASCII
.NUL
;
830 -- Convert form string to lower case
832 for J
in Formstr
'Range loop
833 if Formstr
(J
) in 'A' .. 'Z' then
834 Formstr
(J
) := Character'Val (Character'Pos (Formstr
(J
)) + 32);
838 -- Acquire setting of shared parameter
844 Form_Parameter
(Formstr
, "shared", V1
, V2
);
848 elsif Formstr
(V1
.. V2
) = "yes" then
850 elsif Formstr
(V1
.. V2
) = "no" then
853 raise Use_Error
with "invalid Form";
857 -- Acquire setting of encoding parameter
863 Form_Parameter
(Formstr
, "encoding", V1
, V2
);
866 Encoding
:= CRTL
.Unspecified
;
867 elsif Formstr
(V1
.. V2
) = "utf8" then
868 Encoding
:= CRTL
.UTF8
;
869 elsif Formstr
(V1
.. V2
) = "8bits" then
870 Encoding
:= CRTL
.ASCII_8bits
;
872 raise Use_Error
with "invalid Form";
876 -- Acquire setting of text_translation parameter. Only needed if this is
877 -- a [Wide_[Wide_]]Text_IO file, in which case we default to True, but
878 -- if the Form says Text_Translation=No, we use binary mode, so new-line
879 -- will be just LF, even on Windows.
882 Text_Encoding
:= Default_Text
;
884 Text_Encoding
:= None
;
887 if Text_Encoding
in Text_Content_Encoding
then
892 Form_Parameter
(Formstr
, "text_translation", V1
, V2
);
896 elsif Formstr
(V1
.. V2
) = "no" then
897 Text_Encoding
:= None
;
898 elsif Formstr
(V1
.. V2
) = "text"
899 or else Formstr
(V1
.. V2
) = "yes"
901 Text_Encoding
:= Interfaces
.C_Streams
.Text
;
902 elsif Formstr
(V1
.. V2
) = "wtext" then
903 Text_Encoding
:= Wtext
;
904 elsif Formstr
(V1
.. V2
) = "u8text" then
905 Text_Encoding
:= U8text
;
906 elsif Formstr
(V1
.. V2
) = "u16text" then
907 Text_Encoding
:= U16text
;
909 raise Use_Error
with "invalid Form";
914 -- If we were given a stream (call from xxx.C_Streams.Open), then set
915 -- the full name to the given one, and skip to end of processing.
917 if Stream
/= NULL_Stream
then
918 Full_Name_Len
:= Name
'Length + 1;
919 Fullname
(1 .. Full_Name_Len
- 1) := Name
;
920 Fullname
(Full_Name_Len
) := ASCII
.NUL
;
922 -- Normal case of Open or Create
925 -- If temporary file case, get temporary file name and add to the
926 -- list of temporary files to be deleted on exit.
930 raise Name_Error
with "opening temp file without creating it";
933 Tmp_Name
(Namestr
'Address);
935 if Namestr
(1) = ASCII
.NUL
then
936 raise Use_Error
with "invalid temp file name";
939 -- Chain to temp file list, ensuring thread safety with a lock
944 new Temp_File_Record
'(Name => Namestr, Next => Temp_Files);
953 -- Normal case of non-null name given
956 if Name'Length > Namelen then
957 raise Name_Error with "file name too long";
960 Namestr (1 .. Name'Length) := Name;
961 Namestr (Name'Length + 1) := ASCII.NUL;
964 -- Get full name in accordance with the advice of RM A.8.2(22)
966 full_name (Namestr'Address, Fullname'Address);
968 if Fullname (1) = ASCII.NUL then
969 raise Use_Error with Errno_Message (Name);
973 while Full_Name_Len < Fullname'Last
974 and then Fullname (Full_Name_Len) /= ASCII.NUL
976 Full_Name_Len := Full_Name_Len + 1;
979 -- Fullname is generated by calling system's full_name. The problem
980 -- is, full_name does nothing about the casing, so a file name
981 -- comparison may generally speaking not be valid on non-case-
982 -- sensitive systems, and in particular we get unexpected failures
983 -- on Windows/Vista because of this. So we use s-casuti to force
984 -- the name to lower case.
986 if not File_Names_Case_Sensitive then
987 To_Lower (Fullname (1 .. Full_Name_Len));
990 -- If Shared=None or Shared=Yes, then check for the existence of
991 -- another file with exactly the same full name.
998 -- Take a task lock to protect Open_Files
1002 -- Search list of open files
1005 while P /= null loop
1006 if Fullname (1 .. Full_Name_Len) = P.Name.all then
1008 -- If we get a match, and either file has Shared=None,
1009 -- then raise Use_Error, since we don't allow two files
1010 -- of the same name to be opened unless they specify the
1011 -- required sharing mode.
1014 or else P.Shared_Status = None
1016 raise Use_Error with "reopening shared file";
1018 -- If both files have Shared=Yes, then we acquire the
1019 -- stream from the located file to use as our stream.
1022 and then P.Shared_Status = Yes
1030 -- Otherwise one of the files has Shared=Yes and one has
1031 -- Shared=No. If the current file has Shared=No then all
1032 -- is well but we don't want to share any other file's
1033 -- stream. If the current file has Shared=Yes, we would
1034 -- like to share a stream, but not from a file that has
1035 -- Shared=No, so either way, we just continue the search.
1045 SSL.Unlock_Task.all;
1049 SSL.Unlock_Task.all;
1054 -- Open specified file if we did not find an existing stream,
1055 -- otherwise we just return as there is nothing more to be done.
1057 if Stream /= NULL_Stream then
1062 (Namestr => Namestr,
1064 Text => Text_Encoding in Text_Content_Encoding,
1069 -- A special case, if we are opening (OPEN case) a file and the
1070 -- mode returned by Fopen_Mode is not "r" or "r+", then we first
1071 -- make sure that the file exists as required by Ada semantics.
1073 if not Creat and then Fopstr (1) /= 'r
' then
1074 if file_exists (Namestr'Address) = 0 then
1075 raise Name_Error with Errno_Message (Name);
1079 -- Now open the file. Note that we use the name as given in the
1080 -- original Open call for this purpose, since that seems the
1081 -- clearest implementation of the intent. It would presumably
1082 -- work to use the full name here, but if there is any difference,
1083 -- then we should use the name used in the call.
1085 -- Note: for a corresponding delete, we will use the full name,
1086 -- since by the time of the delete, the current working directory
1087 -- may have changed and we do not want to delete a different file.
1090 fopen (Namestr'Address, Fopstr'Address, Encoding);
1092 if Stream = NULL_Stream then
1094 -- Raise Name_Error if trying to open a non-existent file.
1095 -- Otherwise raise Use_Error.
1097 -- Should we raise Device_Error for ENOSPC???
1100 function Is_File_Not_Found_Error
1101 (Errno_Value : Integer) return Integer;
1103 (C, Is_File_Not_Found_Error,
1104 "__gnat_is_file_not_found_error");
1105 -- Non-zero when the given errno value indicates a non-
1108 Errno : constant Integer := OS_Lib.Errno;
1109 Message : constant String := Errno_Message (Name, Errno);
1112 if Is_File_Not_Found_Error (Errno) /= 0 then
1113 raise Name_Error with Message;
1115 raise Use_Error with Message;
1122 -- Stream has been successfully located or opened, so now we are
1123 -- committed to completing the opening of the file. Allocate block on
1124 -- heap and fill in its fields.
1129 ------------------------
1130 -- Raise_Device_Error --
1131 ------------------------
1133 procedure Raise_Device_Error
1135 Errno : Integer := OS_Lib.Errno)
1138 -- Clear error status so that the same error is not reported twice
1140 if File /= null then
1141 clearerr (File.Stream);
1144 raise Device_Error with OS_Lib.Errno_Message (Err => Errno);
1145 end Raise_Device_Error;
1151 procedure Read_Buf (File : AFCB_Ptr; Buf : Address; Siz : size_t) is
1155 Nread := fread (Buf, 1, Siz, File.Stream);
1160 elsif ferror (File.Stream) /= 0 then
1161 Raise_Device_Error (File);
1163 elsif Nread = 0 then
1166 else -- 0 < Nread < Siz
1167 raise Data_Error with "not enough data read";
1174 Siz : Interfaces.C_Streams.size_t;
1175 Count : out Interfaces.C_Streams.size_t)
1178 Count := fread (Buf, 1, Siz, File.Stream);
1180 if Count = 0 and then ferror (File.Stream) /= 0 then
1181 Raise_Device_Error (File);
1189 -- The reset which does not change the mode simply does a rewind
1191 procedure Reset (File_Ptr : access AFCB_Ptr) is
1192 File : AFCB_Ptr renames File_Ptr.all;
1194 Check_File_Open (File);
1195 Reset (File_Ptr, File.Mode);
1198 -- The reset with a change in mode is done using freopen, and is not
1199 -- permitted except for regular files (since otherwise there is no name for
1200 -- the freopen, and in any case it seems meaningless).
1202 procedure Reset (File_Ptr : access AFCB_Ptr; Mode : File_Mode) is
1203 File : AFCB_Ptr renames File_Ptr.all;
1204 Fopstr : aliased Fopen_String;
1207 Check_File_Open (File);
1209 -- Change of mode not allowed for shared file or file with no name or
1210 -- file that is not a regular file, or for a system file. Note that we
1211 -- allow the "change" of mode if it is not in fact doing a change.
1213 if Mode /= File.Mode then
1214 if File.Shared_Status = Yes then
1215 raise Use_Error with "cannot change mode of shared file";
1216 elsif File.Name'Length <= 1 then
1217 raise Use_Error with "cannot change mode of temp file";
1218 elsif File.Is_System_File then
1219 raise Use_Error with "cannot change mode of system file";
1220 elsif not File.Is_Regular_File then
1221 raise Use_Error with "cannot change mode of non-regular file";
1225 -- For In_File or Inout_File for a regular file, we can just do a rewind
1226 -- if the mode is unchanged, which is more efficient than doing a full
1230 and then Mode in Read_File_Mode
1232 rewind (File.Stream);
1234 -- Here the change of mode is permitted, we do it by reopening the file
1235 -- in the new mode and replacing the stream with a new stream.
1239 (Namestr => File.Name.all,
1241 Text => File.Text_Encoding in Text_Content_Encoding,
1243 Amethod => File.Access_Method,
1246 File.Stream := freopen
1247 (File.Name.all'Address, Fopstr'Address, File.Stream,
1250 if File.Stream = NULL_Stream then
1264 procedure Write_Buf (File : AFCB_Ptr; Buf : Address; Siz : size_t) is
1266 -- Note: for most purposes, the Siz and 1 parameters in the fwrite call
1267 -- could be reversed, but we have encountered systems where this is a
1268 -- better choice, since for some file formats, reversing the parameters
1269 -- results in records of one byte each.
1271 SSL.Abort_Defer.all;
1273 if fwrite (Buf, Siz, 1, File.Stream) /= 1 then
1275 SSL.Abort_Undefer.all;
1276 Raise_Device_Error (File);
1280 SSL.Abort_Undefer.all;