1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- S Y S T E M . F I L E _ I O --
9 -- Copyright (C) 1992-2020, 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;
36 with Interfaces.C_Streams; use Interfaces.C_Streams;
38 with System.Case_Util; use System.Case_Util;
41 with System.Soft_Links;
43 package body System.File_IO is
45 use System.File_Control_Block;
47 package SSL renames System.Soft_Links;
51 ----------------------
52 -- Global Variables --
53 ----------------------
55 Open_Files : AFCB_Ptr;
56 -- This points to a list of AFCB's for all open files. This is a doubly
57 -- linked list, with the Prev pointer of the first entry, and the Next
58 -- pointer of the last entry containing null. Note that this global
59 -- variable must be properly protected to provide thread safety.
61 type Temp_File_Record;
62 type Temp_File_Record_Ptr is access all Temp_File_Record;
64 type Temp_File_Record is record
66 Next : aliased Temp_File_Record_Ptr;
67 Name : String (1 .. max_path_len + 1);
69 -- One of these is allocated for each temporary file created
71 Temp_Files : aliased Temp_File_Record_Ptr;
72 -- Points to list of names of temporary files. Note that this global
73 -- variable must be properly protected to provide thread safety.
75 procedure Free is new Ada.Unchecked_Deallocation
76 (Temp_File_Record, Temp_File_Record_Ptr);
78 type File_IO_Clean_Up_Type is new Limited_Controlled with null record;
79 -- The closing of all open files and deletion of temporary files is an
80 -- action that takes place at the end of execution of the main program.
81 -- This action is implemented using a library level object that gets
82 -- finalized at the end of program execution. Note that the type is
83 -- limited, in order to stop the compiler optimizing away the declaration
84 -- which would be allowed in the non-limited case.
86 procedure Finalize (V : in out File_IO_Clean_Up_Type);
87 -- This is the finalize operation that is used to do the cleanup
89 File_IO_Clean_Up_Object : File_IO_Clean_Up_Type;
90 pragma Warnings (Off, File_IO_Clean_Up_Object);
91 -- This is the single object of the type that triggers the finalization
92 -- call. Since it is at the library level, this happens just before the
93 -- environment task is finalized.
95 text_translation_required : Boolean;
96 for text_translation_required'Size use Character'Size;
98 (C, text_translation_required, "__gnat_text_translation_required");
99 -- If true, add appropriate suffix to control string for Open
101 -----------------------
102 -- Local Subprograms --
103 -----------------------
105 procedure Free_String is new Ada.Unchecked_Deallocation (String, Pstring);
107 subtype Fopen_String is String (1 .. 4);
108 -- Holds open string (longest is "w+b" & nul)
116 Fopstr : out Fopen_String);
117 -- Determines proper open mode for a file to be opened in the given Ada
118 -- mode. Namestr is the NUL-terminated file name. Text is true for a text
119 -- file and false otherwise, and Creat is true for a create call, and False
120 -- for an open call. The value stored in Fopstr is a nul-terminated string
121 -- suitable for a call to fopen or freopen. Amethod is the character
122 -- designating the access method from the Access_Method field of the FCB.
124 function Errno_Message
126 Errno : Integer := OS_Lib.Errno) return String;
127 -- Return Errno_Message for Errno, with file name prepended
129 procedure Raise_Device_Error
131 Errno : Integer := OS_Lib.Errno);
132 pragma No_Return (Raise_Device_Error);
133 -- Clear error indication on File and raise Device_Error with an exception
134 -- message providing errno information.
140 procedure Append_Set (File : AFCB_Ptr) is
142 if File.Mode = Append_File then
143 if fseek (File.Stream, 0, SEEK_END) /= 0 then
144 Raise_Device_Error (File);
153 procedure Chain_File (File : AFCB_Ptr) is
155 -- Take a task lock, to protect the global data value Open_Files
159 -- Do the chaining operation locked
161 File.Next := Open_Files;
165 if File.Next /= null then
166 File.Next.Prev := File;
177 ---------------------
178 -- Check_File_Open --
179 ---------------------
181 procedure Check_File_Open (File : AFCB_Ptr) is
184 raise Status_Error with "file not open";
188 -----------------------
189 -- Check_Read_Status --
190 -----------------------
192 procedure Check_Read_Status (File : AFCB_Ptr) is
195 raise Status_Error with "file not open";
196 elsif File.Mode not in Read_File_Mode then
197 raise Mode_Error with "file not readable";
199 end Check_Read_Status;
201 ------------------------
202 -- Check_Write_Status --
203 ------------------------
205 procedure Check_Write_Status (File : AFCB_Ptr) is
208 raise Status_Error with "file not open";
209 elsif File.Mode = In_File then
210 raise Mode_Error with "file not writable";
212 end Check_Write_Status;
218 procedure Close (File_Ptr : access AFCB_Ptr) is
219 Close_Status : int := 0;
220 Dup_Strm : Boolean := False;
221 Errno : Integer := 0;
223 File : AFCB_Ptr renames File_Ptr.all;
226 -- Take a task lock, to protect the global variables Open_Files and
227 -- Temp_Files, and the chains they point to.
231 Check_File_Open (File);
234 -- Sever the association between the given file and its associated
235 -- external file. The given file is left closed. Do not perform system
236 -- closes on the standard input, output and error files and also do not
237 -- attempt to close a stream that does not exist (signalled by a null
238 -- stream value -- happens in some error situations).
240 if not File.Is_System_File and then File.Stream /= NULL_Stream then
242 -- Do not do an fclose if this is a shared file and there is at least
243 -- one other instance of the stream that is open.
245 if File.Shared_Status = Yes then
252 if P /= File and then File.Stream = P.Stream then
262 -- Do the fclose unless this was a duplicate in the shared case
265 Close_Status := fclose (File.Stream);
267 if Close_Status /= 0 then
268 Errno := OS_Lib.Errno;
273 -- Dechain file from list of open files and then free the storage
275 if File.Prev = null then
276 Open_Files := File.Next;
278 File.Prev.Next := File.Next;
281 if File.Next /= null then
282 File.Next.Prev := File.Prev;
285 -- If it's a temp file, remove the corresponding record from Temp_Files,
286 -- and delete the file. There are unlikely to be large numbers of temp
287 -- files open, so a linear search is sufficiently efficient. Note that
288 -- we don't need to check for end of list, because the file must be
289 -- somewhere on the list. Note that as for Finalize, we ignore any
290 -- errors while attempting the unlink operation.
292 if File.Is_Temporary_File then
294 Temp : access Temp_File_Record_Ptr := Temp_Files'Access;
295 -- Note the double indirection here
298 New_Temp : Temp_File_Record_Ptr;
301 while Temp.all.all.File /= File loop
302 Temp := Temp.all.all.Next'Access;
305 Discard := unlink (Temp.all.all.Name'Address);
306 New_Temp := Temp.all.all.Next;
308 Temp.all := New_Temp;
312 -- Deallocate some parts of the file structure that were kept in heap
313 -- storage with the exception of system files (standard input, output
314 -- and error) since they had some information allocated in the stack.
316 if not File.Is_System_File then
317 Free_String (File.Name);
318 Free_String (File.Form);
324 if Close_Status /= 0 then
325 Raise_Device_Error (null, Errno);
340 procedure Delete (File_Ptr : access AFCB_Ptr) is
341 File : AFCB_Ptr renames File_Ptr.all;
344 Check_File_Open (File);
346 if not File.Is_Regular_File then
347 raise Use_Error with "cannot delete non-regular file";
351 Filename : aliased constant String := File.Name.all;
352 Is_Temporary_File : constant Boolean := File.Is_Temporary_File;
357 -- Now unlink the external file. Note that we use the full name in
358 -- this unlink, because the working directory may have changed since
359 -- we did the open, and we want to unlink the right file. However, if
360 -- it's a temporary file, then closing it already unlinked it.
362 if not Is_Temporary_File then
363 if unlink (Filename'Address) = -1 then
364 raise Use_Error with OS_Lib.Errno_Message;
374 function End_Of_File (File : AFCB_Ptr) return Boolean is
376 Check_File_Open (File);
378 if feof (File.Stream) /= 0 then
382 Check_Read_Status (File);
384 if ungetc (fgetc (File.Stream), File.Stream) = EOF then
385 clearerr (File.Stream);
397 function Errno_Message
399 Errno : Integer := OS_Lib.Errno) return String
402 return Name & ": " & OS_Lib.Errno_Message (Err => Errno);
409 procedure Finalize (V : in out File_IO_Clean_Up_Type) is
410 pragma Warnings (Off, V);
412 Fptr1 : aliased AFCB_Ptr;
418 -- Take a lock to protect global Open_Files data structure
422 -- First close all open files (the slightly complex form of this loop is
423 -- required because Close nulls out its argument).
426 while Fptr1 /= null loop
428 Close (Fptr1'Access);
432 -- Now unlink all temporary files. We do not bother to free the blocks
433 -- because we are just about to terminate the program. We also ignore
434 -- any errors while attempting these unlink operations.
436 while Temp_Files /= null loop
437 Discard := unlink (Temp_Files.Name'Address);
438 Temp_Files := Temp_Files.Next;
453 procedure Flush (File : AFCB_Ptr) is
455 Check_Write_Status (File);
457 if fflush (File.Stream) /= 0 then
458 Raise_Device_Error (File);
466 -- The fopen mode to be used is shown by the following table:
469 -- Append_File "r+" "w+"
471 -- Out_File (Direct_IO, Stream_IO) "r+" [*] "w"
472 -- Out_File (others) "w" "w"
473 -- Inout_File "r+" "w+"
475 -- [*] Except that for Out_File, if the file exists and is a fifo (i.e. a
476 -- named pipe), we use "w" instead of "r+". This is necessary to make a
477 -- write to the fifo block until a reader is ready.
479 -- Note: we do not use "a" or "a+" for Append_File, since this would not
480 -- work in the case of stream files, where even if in append file mode,
481 -- you can reset to earlier points in the file. The caller must use the
482 -- Append_Set routine to deal with the necessary positioning.
484 -- Note: in several cases, the fopen mode used allows reading and writing,
485 -- but the setting of the Ada mode is more restrictive. For instance,
486 -- Create in In_File mode uses "w+" which allows writing, but the Ada mode
487 -- In_File will cause any write operations to be rejected with Mode_Error
490 -- Note: for the Out_File/Open cases for other than the Direct_IO case, an
491 -- initial call will be made by the caller to first open the file in "r"
492 -- mode to be sure that it exists. The real open, in "w" mode, will then
493 -- destroy this file. This is peculiar, but that's what Ada semantics
494 -- require and the ACATS tests insist on.
496 -- If text file translation is required, then either "b" or "t" is appended
497 -- to the mode, depending on the setting of Text.
505 Fopstr : out Fopen_String)
509 function is_fifo (Path : Address) return Integer;
510 pragma Import (C, is_fifo, "__gnat_is_fifo");
525 if Amethod in 'D' | 'S'
527 and then is_fifo (Namestr'Address) = 0
540 Fopstr (1) := (if Creat then 'w' else 'r');
545 -- If text_translation_required is true then we need to append either a
546 -- "t" or "b" to the string to get the right mode.
548 if text_translation_required then
549 Fopstr (Fptr) := (if Text then 't' else 'b');
553 Fopstr (Fptr) := ASCII.NUL;
560 function Form (File : AFCB_Ptr) return String is
563 raise Status_Error with "Form: file not open";
565 return File.Form.all (1 .. File.Form'Length - 1);
573 function Form_Boolean
576 Default : Boolean) return Boolean
579 pragma Unreferenced (V2);
582 Form_Parameter (Form, Keyword, V1, V2);
586 elsif Form (V1) = 'y' then
588 elsif Form (V1) = 'n' then
591 raise Use_Error with "invalid Form";
599 function Form_Integer
602 Default : Integer) return Integer
608 Form_Parameter (Form, Keyword, V1, V2);
616 for J in V1 .. V2 loop
617 if Form (J) not in '0' .. '9' then
618 raise Use_Error with "invalid Form";
620 V := V * 10 + Character'Pos (Form (J)) - Character'Pos ('0');
624 raise Use_Error with "invalid Form";
636 procedure Form_Parameter
642 Klen : constant Integer := Keyword'Length;
645 for J in Form'First + Klen .. Form'Last - 1 loop
647 and then Form (J - Klen .. J - 1) = Keyword
651 while Form (Stop + 1) /= ASCII.NUL
652 and then Form (Stop + 1) /= ','
669 function Is_Open (File : AFCB_Ptr) return Boolean is
671 -- We return True if the file is open, and the underlying file stream is
672 -- usable. In particular on Windows an application linked with -mwindows
673 -- option set does not have a console attached. In this case standard
674 -- files (Current_Output, Current_Error, Current_Input) are not created.
675 -- We want Is_Open (Current_Output) to return False in this case.
677 return File /= null and then fileno (File.Stream) /= -1;
684 procedure Make_Buffered
686 Buf_Siz : Interfaces.C_Streams.size_t)
689 pragma Unreferenced (status);
692 status := setvbuf (File.Stream, Null_Address, IOFBF, Buf_Siz);
695 ------------------------
696 -- Make_Line_Buffered --
697 ------------------------
699 procedure Make_Line_Buffered
701 Line_Siz : Interfaces.C_Streams.size_t)
704 pragma Unreferenced (status);
707 status := setvbuf (File.Stream, Null_Address, IOLBF, Line_Siz);
708 -- No error checking???
709 end Make_Line_Buffered;
711 ---------------------
712 -- Make_Unbuffered --
713 ---------------------
715 procedure Make_Unbuffered (File : AFCB_Ptr) is
717 pragma Unreferenced (status);
720 status := setvbuf (File.Stream, Null_Address, IONBF, 0);
721 -- No error checking???
728 function Mode (File : AFCB_Ptr) return File_Mode is
731 raise Status_Error with "Mode: file not open";
741 function Name (File : AFCB_Ptr) return String is
744 raise Status_Error with "Name: file not open";
746 return File.Name.all (1 .. File.Name'Length - 1);
755 (File_Ptr : in out AFCB_Ptr;
756 Dummy_FCB : AFCB'Class;
763 C_Stream : FILEs := NULL_Stream)
765 pragma Warnings (Off, Dummy_FCB);
766 -- Yes we know this is never assigned a value. That's intended, since
767 -- all we ever use of this value is the tag for dispatching purposes.
769 procedure Tmp_Name (Buffer : Address);
770 pragma Import (C, Tmp_Name, "__gnat_tmp_name");
771 -- Set buffer (a String address) with a temporary filename
773 function Get_Case_Sensitive return Integer;
774 pragma Import (C, Get_Case_Sensitive,
775 "__gnat_get_file_names_case_sensitive");
777 procedure Record_AFCB;
778 -- Create and record new AFCB into the runtime, note that the
779 -- implementation uses the variables below which corresponds to the
780 -- status of the opened file.
782 File_Names_Case_Sensitive : constant Boolean := Get_Case_Sensitive /= 0;
783 -- Set to indicate whether the operating system convention is for file
784 -- names to be case sensitive (e.g., in Unix, set True), or not case
785 -- sensitive (e.g., in Windows, set False). Declared locally to avoid
786 -- breaking the Preelaborate rule that disallows function calls at the
789 Stream : FILEs := C_Stream;
790 -- Stream which we open in response to this request
792 Shared : Shared_Status_Type;
793 -- Setting of Shared_Status field for file
795 Fopstr : aliased Fopen_String;
796 -- Mode string used in fopen call
798 Formstr : aliased String (1 .. Form'Length + 1);
799 -- Form string with ASCII.NUL appended, folded to lower case
801 Text_Encoding : Content_Encoding;
803 Tempfile : constant Boolean := Name = "";
804 -- Indicates temporary file case, which is indicated by an empty file
807 Namelen : constant Integer := max_path_len;
808 -- Length required for file name, not including final ASCII.NUL.
809 -- Note that we used to reference L_tmpnam here, which is not reliable
810 -- since __gnat_tmp_name does not always use tmpnam.
812 Namestr : aliased String (1 .. Namelen + 1);
813 -- Name as given or temporary file name with ASCII.NUL appended
815 Fullname : aliased String (1 .. max_path_len + 1);
816 -- Full name (as required for Name function, and as stored in the
817 -- control block in the Name field) with ASCII.NUL appended.
819 Full_Name_Len : Integer;
820 -- Length of name actually stored in Fullname
822 Encoding : CRTL.Filename_Encoding;
823 -- Filename encoding specified into the form parameter
829 procedure Record_AFCB is
831 File_Ptr := AFCB_Allocate (Dummy_FCB);
833 -- Note that we cannot use an aggregate here as File_Ptr is a
834 -- class-wide access to a limited type (Root_Stream_Type).
836 File_Ptr.Is_Regular_File := is_regular_file (fileno (Stream)) /= 0;
837 File_Ptr.Is_System_File := False;
838 File_Ptr.Text_Encoding := Text_Encoding;
839 File_Ptr.Shared_Status := Shared;
840 File_Ptr.Access_Method := Amethod;
841 File_Ptr.Stream := Stream;
842 File_Ptr.Form := new String'(Formstr);
843 File_Ptr.Name := new String'(Fullname
844 (1 .. Full_Name_Len));
845 File_Ptr.Mode := Mode;
846 File_Ptr.Is_Temporary_File := Tempfile;
847 File_Ptr.Encoding := Encoding;
849 Chain_File (File_Ptr);
850 Append_Set (File_Ptr);
853 -- Start of processing for Open
856 if File_Ptr /= null then
857 raise Status_Error with "file already open";
860 -- Acquire form string, setting required NUL terminator
862 Formstr (1 .. Form'Length) := Form;
863 Formstr (Formstr'Last) := ASCII.NUL;
865 -- Convert form string to lower case
867 for J in Formstr'Range loop
868 if Formstr (J) in 'A' .. 'Z' then
869 Formstr (J) := Character'Val (Character'Pos (Formstr (J)) + 32);
873 -- Acquire setting of shared parameter
879 Form_Parameter (Formstr, "shared", V1, V2);
883 elsif Formstr (V1 .. V2) = "yes" then
885 elsif Formstr (V1 .. V2) = "no" then
888 raise Use_Error with "invalid Form";
892 -- Acquire setting of encoding parameter
898 Form_Parameter (Formstr, "encoding", V1, V2);
901 Encoding := CRTL.Unspecified;
902 elsif Formstr (V1 .. V2) = "utf8" then
903 Encoding := CRTL.UTF8;
904 elsif Formstr (V1 .. V2) = "8bits" then
905 Encoding := CRTL.ASCII_8bits;
907 raise Use_Error with "invalid Form";
911 -- Acquire setting of text_translation parameter. Only needed if this is
912 -- a [Wide_[Wide_]]Text_IO file, in which case we default to True, but
913 -- if the Form says Text_Translation=No, we use binary mode, so new-line
914 -- will be just LF, even on Windows.
917 Text_Encoding := Default_Text;
919 Text_Encoding := None;
922 if Text_Encoding in Text_Content_Encoding then
927 Form_Parameter (Formstr, "text_translation", V1, V2);
931 elsif Formstr (V1 .. V2) = "no" then
932 Text_Encoding := None;
933 elsif Formstr (V1 .. V2) = "text"
934 or else Formstr (V1 .. V2) = "yes"
936 Text_Encoding := Interfaces.C_Streams.Text;
937 elsif Formstr (V1 .. V2) = "wtext" then
938 Text_Encoding := Wtext;
939 elsif Formstr (V1 .. V2) = "u8text" then
940 Text_Encoding := U8text;
941 elsif Formstr (V1 .. V2) = "u16text" then
942 Text_Encoding := U16text;
944 raise Use_Error with "invalid Form";
949 -- If we were given a stream (call from xxx.C_Streams.Open), then set
950 -- the full name to the given one, and skip to end of processing.
952 if Stream /= NULL_Stream then
953 Full_Name_Len := Name'Length + 1;
954 Fullname (1 .. Full_Name_Len - 1) := Name;
955 Fullname (Full_Name_Len) := ASCII.NUL;
957 -- Normal case of Open or Create
960 -- If temporary file case, get temporary file name and add to the
961 -- list of temporary files to be deleted on exit.
965 raise Name_Error with "opening temp file without creating it";
968 Tmp_Name (Namestr'Address);
970 if Namestr (1) = ASCII.NUL then
971 raise Use_Error with "invalid temp file name";
974 -- Normal case of non-empty name given (i.e. not a temp file)
977 if Name'Length > Namelen then
978 raise Name_Error with "file name too long";
981 Namestr (1 .. Name'Length) := Name;
982 Namestr (Name'Length + 1) := ASCII.NUL;
985 -- Get full name in accordance with the advice of RM A.8.2(22)
987 full_name (Namestr'Address, Fullname'Address);
989 if Fullname (1) = ASCII.NUL then
990 raise Use_Error with Errno_Message (Name);
994 while Full_Name_Len < Fullname'Last
995 and then Fullname (Full_Name_Len) /= ASCII.NUL
997 Full_Name_Len := Full_Name_Len + 1;
1000 -- Fullname is generated by calling system's full_name. The problem
1001 -- is, full_name does nothing about the casing, so a file name
1002 -- comparison may generally speaking not be valid on non-case-
1003 -- sensitive systems, and in particular we get unexpected failures
1004 -- on Windows/Vista because of this. So we use s-casuti to force
1005 -- the name to lower case.
1007 if not File_Names_Case_Sensitive then
1008 To_Lower (Fullname (1 .. Full_Name_Len));
1011 -- If Shared=None or Shared=Yes, then check for the existence of
1012 -- another file with exactly the same full name.
1014 if Shared /= No then
1019 -- Take a task lock to protect Open_Files
1023 -- Search list of open files
1026 while P /= null loop
1027 if Fullname (1 .. Full_Name_Len) = P.Name.all then
1029 -- If we get a match, and either file has Shared=None,
1030 -- then raise Use_Error, since we don't allow two files
1031 -- of the same name to be opened unless they specify the
1032 -- required sharing mode.
1035 or else P.Shared_Status = None
1037 raise Use_Error with "reopening shared file";
1039 -- If both files have Shared=Yes, then we acquire the
1040 -- stream from the located file to use as our stream.
1043 and then P.Shared_Status = Yes
1048 pragma Assert (not Tempfile);
1052 -- Otherwise one of the files has Shared=Yes and one has
1053 -- Shared=No. If the current file has Shared=No then all
1054 -- is well but we don't want to share any other file's
1055 -- stream. If the current file has Shared=Yes, we would
1056 -- like to share a stream, but not from a file that has
1057 -- Shared=No, so either way, we just continue the search.
1067 SSL.Unlock_Task.all;
1071 SSL.Unlock_Task.all;
1076 -- Open specified file if we did not find an existing stream,
1077 -- otherwise we just return as there is nothing more to be done.
1079 if Stream /= NULL_Stream then
1084 (Namestr => Namestr,
1086 Text => Text_Encoding in Text_Content_Encoding,
1091 -- A special case, if we are opening (OPEN case) a file and the
1092 -- mode returned by Fopen_Mode is not "r" or "r+", then we first
1093 -- make sure that the file exists as required by Ada semantics.
1095 if not Creat and then Fopstr (1) /= 'r' then
1096 if file_exists (Namestr'Address) = 0 then
1097 raise Name_Error with Errno_Message (Name);
1101 -- Now open the file. Note that we use the name as given in the
1102 -- original Open call for this purpose, since that seems the
1103 -- clearest implementation of the intent. It would presumably
1104 -- work to use the full name here, but if there is any difference,
1105 -- then we should use the name used in the call.
1107 -- Note: for a corresponding delete, we will use the full name,
1108 -- since by the time of the delete, the current working directory
1109 -- may have changed and we do not want to delete a different file.
1112 fopen (Namestr'Address, Fopstr'Address, Encoding);
1114 if Stream = NULL_Stream then
1116 -- Raise Name_Error if trying to open a non-existent file.
1117 -- Otherwise raise Use_Error.
1119 -- Should we raise Device_Error for ENOSPC???
1122 function Is_File_Not_Found_Error
1123 (Errno_Value : Integer) return Integer;
1125 (C, Is_File_Not_Found_Error,
1126 "__gnat_is_file_not_found_error");
1127 -- Non-zero when the given errno value indicates a non-
1130 Errno : constant Integer := OS_Lib.Errno;
1131 Message : constant String := Errno_Message (Name, Errno);
1134 if Is_File_Not_Found_Error (Errno) /= 0 then
1135 raise Name_Error with Message;
1137 raise Use_Error with Message;
1144 -- Stream has been successfully located or opened, so now we are
1145 -- committed to completing the opening of the file. Allocate block on
1146 -- heap and fill in its fields.
1151 -- Chain to temp file list, ensuring thread safety with a lock
1156 new Temp_File_Record'
1157 (File => File_Ptr, Name => Namestr, Next => Temp_Files);
1158 SSL.Unlock_Task.all;
1162 SSL.Unlock_Task.all;
1168 ------------------------
1169 -- Raise_Device_Error --
1170 ------------------------
1172 procedure Raise_Device_Error
1174 Errno : Integer := OS_Lib.Errno)
1177 -- Clear error status so that the same error is not reported twice
1179 if File /= null then
1180 clearerr (File.Stream);
1183 raise Device_Error with OS_Lib.Errno_Message (Err => Errno);
1184 end Raise_Device_Error;
1190 procedure Read_Buf (File : AFCB_Ptr; Buf : Address; Siz : size_t) is
1194 Nread := fread (Buf, 1, Siz, File.Stream);
1199 elsif ferror (File.Stream) /= 0 then
1200 Raise_Device_Error (File);
1202 elsif Nread = 0 then
1205 else -- 0 < Nread < Siz
1206 raise Data_Error with "not enough data read";
1213 Siz : Interfaces.C_Streams.size_t;
1214 Count : out Interfaces.C_Streams.size_t)
1217 Count := fread (Buf, 1, Siz, File.Stream);
1219 if Count = 0 and then ferror (File.Stream) /= 0 then
1220 Raise_Device_Error (File);
1228 -- The reset which does not change the mode simply does a rewind
1230 procedure Reset (File_Ptr : access AFCB_Ptr) is
1231 File : AFCB_Ptr renames File_Ptr.all;
1233 Check_File_Open (File);
1234 Reset (File_Ptr, File.Mode);
1237 -- The reset with a change in mode is done using freopen, and is not
1238 -- permitted except for regular files (since otherwise there is no name for
1239 -- the freopen, and in any case it seems meaningless).
1241 procedure Reset (File_Ptr : access AFCB_Ptr; Mode : File_Mode) is
1242 File : AFCB_Ptr renames File_Ptr.all;
1243 Fopstr : aliased Fopen_String;
1246 Check_File_Open (File);
1248 -- Change of mode not allowed for shared file or file with no name or
1249 -- file that is not a regular file, or for a system file. Note that we
1250 -- allow the "change" of mode if it is not in fact doing a change.
1252 if Mode /= File.Mode then
1253 if File.Shared_Status = Yes then
1254 raise Use_Error with "cannot change mode of shared file";
1255 elsif File.Name'Length <= 1 then
1256 raise Use_Error with "cannot change mode of temp file";
1257 elsif File.Is_System_File then
1258 raise Use_Error with "cannot change mode of system file";
1259 elsif not File.Is_Regular_File then
1260 raise Use_Error with "cannot change mode of non-regular file";
1264 -- For In_File or Inout_File for a regular file, we can just do a rewind
1265 -- if the mode is unchanged, which is more efficient than doing a full
1269 and then Mode in Read_File_Mode
1271 rewind (File.Stream);
1273 -- Here the change of mode is permitted, we do it by reopening the file
1274 -- in the new mode and replacing the stream with a new stream.
1278 (Namestr => File.Name.all,
1280 Text => File.Text_Encoding in Text_Content_Encoding,
1282 Amethod => File.Access_Method,
1285 File.Stream := freopen
1286 (File.Name.all'Address, Fopstr'Address, File.Stream,
1289 if File.Stream = NULL_Stream then
1303 procedure Write_Buf (File : AFCB_Ptr; Buf : Address; Siz : size_t) is
1305 -- Note: for most purposes, the Siz and 1 parameters in the fwrite call
1306 -- could be reversed, but we have encountered systems where this is a
1307 -- better choice, since for some file formats, reversing the parameters
1308 -- results in records of one byte each.
1310 SSL.Abort_Defer.all;
1312 if fwrite (Buf, Siz, 1, File.Stream) /= 1 then
1314 SSL.Abort_Undefer.all;
1315 Raise_Device_Error (File);
1319 SSL.Abort_Undefer.all;