-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
with Ada.Finalization; use Ada.Finalization;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
+with Interfaces.C;
with Interfaces.C_Streams; use Interfaces.C_Streams;
+
+with System.CRTL;
+with System.Case_Util; use System.Case_Util;
+with System.OS_Constants;
+with System.OS_Lib;
with System.Soft_Links;
-with Unchecked_Deallocation;
+
+with Ada.Unchecked_Deallocation;
package body System.File_IO is
package SSL renames System.Soft_Links;
+ use type Interfaces.C.int;
+ use type System.CRTL.size_t;
+
----------------------
-- Global Variables --
----------------------
type Temp_File_Record_Ptr is access all Temp_File_Record;
type Temp_File_Record is record
- Name : String (1 .. L_tmpnam + 1);
+ Name : String (1 .. max_path_len + 1);
Next : Temp_File_Record_Ptr;
end record;
-- One of these is allocated for each temporary file created
-- a controlled type introduced for this purpose.
procedure Finalize (V : in out File_IO_Clean_Up_Type);
- -- This is the finalize operation that is used to do the cleanup.
+ -- This is the finalize operation that is used to do the cleanup
File_IO_Clean_Up_Object : File_IO_Clean_Up_Type;
pragma Warnings (Off, File_IO_Clean_Up_Object);
-- environment task is finalized.
text_translation_required : Boolean;
+ for text_translation_required'Size use Character'Size;
pragma Import
(C, text_translation_required, "__gnat_text_translation_required");
- -- If true, add appropriate suffix to control string for Open.
+ -- If true, add appropriate suffix to control string for Open
+
+ function Get_Case_Sensitive return Integer;
+ pragma Import (C, Get_Case_Sensitive,
+ "__gnat_get_file_names_case_sensitive");
+ File_Names_Case_Sensitive : constant Boolean := Get_Case_Sensitive /= 0;
+ -- Set to indicate whether the operating system convention is for file
+ -- names to be case sensitive (e.g., in Unix, set True), or non case
+ -- sensitive (e.g., in OS/2, set False).
-----------------------
-- Local Subprograms --
-----------------------
- procedure Free_String is new Unchecked_Deallocation (String, Pstring);
+ procedure Free_String is new Ada.Unchecked_Deallocation (String, Pstring);
subtype Fopen_String is String (1 .. 4);
-- Holds open string (longest is "w+b" & nul)
-- Close --
-----------
- procedure Close (File : in out AFCB_Ptr) is
+ procedure Close (File_Ptr : access AFCB_Ptr) is
Close_Status : int := 0;
Dup_Strm : Boolean := False;
+ File : AFCB_Ptr renames File_Ptr.all;
begin
- Check_File_Open (File);
- AFCB_Close (File);
-
-- Take a task lock, to protect the global data value Open_Files
SSL.Lock_Task.all;
+ Check_File_Open (File);
+ AFCB_Close (File);
+
-- Sever the association between the given file and its associated
-- external file. The given file is left closed. Do not perform system
-- closes on the standard input, output and error files and also do
-- Delete --
------------
- procedure Delete (File : in out AFCB_Ptr) is
+ procedure Delete (File_Ptr : access AFCB_Ptr) is
+ File : AFCB_Ptr renames File_Ptr.all;
begin
Check_File_Open (File);
Filename : aliased constant String := File.Name.all;
begin
- Close (File);
+ Close (File_Ptr);
-- Now unlink the external file. Note that we use the full name
-- in this unlink, because the working directory may have changed
procedure Finalize (V : in out File_IO_Clean_Up_Type) is
pragma Warnings (Off, V);
- Fptr1 : AFCB_Ptr;
+ Fptr1 : aliased AFCB_Ptr;
Fptr2 : AFCB_Ptr;
Discard : int;
Fptr1 := Open_Files;
while Fptr1 /= null loop
Fptr2 := Fptr1.Next;
- Close (Fptr1);
+ Close (Fptr1'Access);
Fptr1 := Fptr2;
end loop;
Amethod : Character;
Fopstr : out Fopen_String)
is
- Fptr : Positive;
+ Fptr : Positive;
begin
case Mode is
-- Form --
----------
- function Form (File : in AFCB_Ptr) return String is
+ function Form (File : AFCB_Ptr) return String is
begin
if File = null then
raise Status_Error;
return Boolean
is
V1, V2 : Natural;
+ pragma Unreferenced (V2);
begin
Form_Parameter (Form, Keyword, V1, V2);
-- Is_Open --
-------------
- function Is_Open (File : in AFCB_Ptr) return Boolean is
+ function Is_Open (File : AFCB_Ptr) return Boolean is
begin
- return (File /= null);
+ -- We return True if the file is open, and the underlying file stream is
+ -- usable. In particular on Windows an application linked with -mwindows
+ -- option set does not have a console attached. In this case standard
+ -- files (Current_Output, Current_Error, Current_Input) are not created.
+ -- We want Is_Open (Current_Output) to return False in this case.
+
+ return File /= null and then fileno (File.Stream) /= -1;
end Is_Open;
-------------------
-- Mode --
----------
- function Mode (File : in AFCB_Ptr) return File_Mode is
+ function Mode (File : AFCB_Ptr) return File_Mode is
begin
if File = null then
raise Status_Error;
-- Name --
----------
- function Name (File : in AFCB_Ptr) return String is
+ function Name (File : AFCB_Ptr) return String is
begin
if File = null then
raise Status_Error;
procedure Open
(File_Ptr : in out AFCB_Ptr;
- Dummy_FCB : in AFCB'Class;
+ Dummy_FCB : AFCB'Class;
Mode : File_Mode;
Name : String;
Form : String;
procedure Tmp_Name (Buffer : Address);
pragma Import (C, Tmp_Name, "__gnat_tmp_name");
- -- set buffer (a String address) with a temporary filename.
+ -- set buffer (a String address) with a temporary filename
Stream : FILEs := C_Stream;
-- Stream which we open in response to this request
Full_Name_Len : Integer;
-- Length of name actually stored in Fullname
+ Encoding : System.CRTL.Filename_Encoding;
+ -- Filename encoding specified into the form parameter
+
begin
if File_Ptr /= null then
raise Status_Error;
end if;
end;
+ -- Acquire setting of shared parameter
+
+ declare
+ V1, V2 : Natural;
+
+ begin
+ Form_Parameter (Formstr, "encoding", V1, V2);
+
+ if V1 = 0 then
+ Encoding := System.CRTL.UTF8;
+
+ elsif Formstr (V1 .. V2) = "utf8" then
+ Encoding := System.CRTL.UTF8;
+
+ elsif Formstr (V1 .. V2) = "8bits" then
+ Encoding := System.CRTL.ASCII_8bits;
+
+ else
+ raise Use_Error;
+ end if;
+ end;
+
-- If we were given a stream (call from xxx.C_Streams.Open), then set
- -- full name to null and that is all we have to do in this case so
- -- skip to end of processing.
+ -- the full name to the given one, and skip to end of processing.
if Stream /= NULL_Stream then
- Fullname (1) := ASCII.Nul;
- Full_Name_Len := 1;
+ Full_Name_Len := Name'Length + 1;
+ Fullname (1 .. Full_Name_Len - 1) := Name;
+ Fullname (Full_Name_Len) := ASCII.NUL;
-- Normal case of Open or Create
else
- -- If temporary file case, get temporary file name and add
- -- to the list of temporary files to be deleted on exit.
+ -- If temporary file case, get temporary file name and add to the
+ -- list of temporary files to be deleted on exit.
if Tempfile then
if not Creat then
-- Normal case of non-null name given
else
+ if Name'Length > Namelen then
+ raise Name_Error;
+ end if;
+
Namestr (1 .. Name'Length) := Name;
Namestr (Name'Length + 1) := ASCII.NUL;
end if;
- -- Get full name in accordance with the advice of RM A.8.2(22).
+ -- Get full name in accordance with the advice of RM A.8.2(22)
full_name (Namestr'Address, Fullname'Address);
Full_Name_Len := Full_Name_Len + 1;
end loop;
+ -- Fullname is generated by calling system's full_name. The problem
+ -- is, full_name does nothing about the casing, so a file name
+ -- comparison may generally speaking not be valid on non-case
+ -- sensitive systems, and in particular we get unexpected failures
+ -- on Windows/Vista because of this. So we use s-casuti to force
+ -- the name to lower case.
+
+ if not File_Names_Case_Sensitive then
+ To_Lower (Fullname (1 .. Full_Name_Len));
+ end if;
+
-- If Shared=None or Shared=Yes, then check for the existence
-- of another file with exactly the same full name.
if Fullname (1 .. Full_Name_Len) = P.Name.all then
-- If we get a match, and either file has Shared=None,
- -- then raise Use_Error, since we don't allow two
- -- files of the same name to be opened unless they
- -- specify the required sharing mode.
+ -- then raise Use_Error, since we don't allow two files
+ -- of the same name to be opened unless they specify the
+ -- required sharing mode.
if Shared = None
or else P.Shared_Status = None
Stream := P.Stream;
exit;
- -- Otherwise one of the files has Shared=Yes and one
- -- has Shared=No. If the current file has Shared=No
- -- then all is well but we don't want to share any
- -- other file's stream. If the current file has
- -- Shared=Yes, we would like to share a stream, but
- -- not from a file that has Shared=No, so in either
- -- case we just keep going on the search.
+ -- Otherwise one of the files has Shared=Yes and one has
+ -- Shared=No. If the current file has Shared=No then all
+ -- is well but we don't want to share any other file's
+ -- stream. If the current file has Shared=Yes, we would
+ -- like to share a stream, but not from a file that has
+ -- Shared=No, so either way, we just continue the search.
else
null;
if Stream = NULL_Stream then
Fopen_Mode (Mode, Text, Creat, Amethod, Fopstr);
- -- A special case, if we are opening (OPEN case) a file and
- -- the mode returned by Fopen_Mode is not "r" or "r+", then
- -- we first make sure that the file exists as required by
- -- Ada semantics.
+ -- A special case, if we are opening (OPEN case) a file and the
+ -- mode returned by Fopen_Mode is not "r" or "r+", then we first
+ -- make sure that the file exists as required by Ada semantics.
- if Creat = False and then Fopstr (1) /= 'r' then
+ if not Creat and then Fopstr (1) /= 'r' then
if file_exists (Namestr'Address) = 0 then
raise Name_Error;
end if;
end if;
- -- Now open the file. Note that we use the name as given
- -- in the original Open call for this purpose, since that
- -- seems the clearest implementation of the intent. It
- -- would presumably work to use the full name here, but
- -- if there is any difference, then we should use the
- -- name used in the call.
+ -- Now open the file. Note that we use the name as given in the
+ -- original Open call for this purpose, since that seems the
+ -- clearest implementation of the intent. It would presumably
+ -- work to use the full name here, but if there is any difference,
+ -- then we should use the name used in the call.
- -- Note: for a corresponding delete, we will use the
- -- full name, since by the time of the delete, the
- -- current working directory may have changed and
- -- we do not want to delete a different file!
+ -- Note: for a corresponding delete, we will use the full name,
+ -- since by the time of the delete, the current working directory
+ -- may have changed and we do not want to delete a different file!
- Stream := fopen (Namestr'Address, Fopstr'Address);
+ Stream := fopen (Namestr'Address, Fopstr'Address, Encoding);
if Stream = NULL_Stream then
- if file_exists (Namestr'Address) = 0 then
+
+ -- Raise Name_Error if trying to open a non-existent file.
+ -- Otherwise raise Use_Error.
+
+ -- Should we raise Device_Error for ENOSPC???
+
+ if System.OS_Lib.Errno = System.OS_Constants.ENOENT then
raise Name_Error;
else
raise Use_Error;
File_Ptr := AFCB_Allocate (Dummy_FCB);
- File_Ptr.Is_Regular_File := (is_regular_file
- (fileno (Stream)) /= 0);
+ File_Ptr.Is_Regular_File := (is_regular_file (fileno (Stream)) /= 0);
File_Ptr.Is_System_File := False;
File_Ptr.Is_Text_File := Text;
File_Ptr.Shared_Status := Shared;
File_Ptr.Access_Method := Amethod;
File_Ptr.Stream := Stream;
File_Ptr.Form := new String'(Formstr);
- File_Ptr.Name := new String'(Fullname
- (1 .. Full_Name_Len));
+ File_Ptr.Name := new String'(Fullname (1 .. Full_Name_Len));
File_Ptr.Mode := Mode;
File_Ptr.Is_Temporary_File := Tempfile;
+ File_Ptr.Encoding := Encoding;
Chain_File (File_Ptr);
Append_Set (File_Ptr);
procedure Read_Buf
(File : AFCB_Ptr;
Buf : Address;
- Siz : in Interfaces.C_Streams.size_t;
+ Siz : Interfaces.C_Streams.size_t;
Count : out Interfaces.C_Streams.size_t)
is
begin
-- Reset --
-----------
- -- The reset which does not change the mode simply does a rewind.
+ -- The reset which does not change the mode simply does a rewind
- procedure Reset (File : in out AFCB_Ptr) is
+ procedure Reset (File_Ptr : access AFCB_Ptr) is
+ File : AFCB_Ptr renames File_Ptr.all;
begin
Check_File_Open (File);
- Reset (File, File.Mode);
+ Reset (File_Ptr, File.Mode);
end Reset;
-- The reset with a change in mode is done using freopen, and is
-- not permitted except for regular files (since otherwise there
-- is no name for the freopen, and in any case it seems meaningless)
- procedure Reset (File : in out AFCB_Ptr; Mode : in File_Mode) is
+ procedure Reset (File_Ptr : access AFCB_Ptr; Mode : File_Mode) is
+ File : AFCB_Ptr renames File_Ptr.all;
Fopstr : aliased Fopen_String;
begin
Check_File_Open (File);
- -- Change of mode not allowed for shared file or file with no name
- -- or file that is not a regular file, or for a system file.
+ -- Change of mode not allowed for shared file or file with no name or
+ -- file that is not a regular file, or for a system file. Note that we
+ -- allow the "change" of mode if it is not in fact doing a change.
- if File.Shared_Status = Yes
- or else File.Name'Length <= 1
- or else File.Is_System_File
- or else (not File.Is_Regular_File)
+ if Mode /= File.Mode
+ and then (File.Shared_Status = Yes
+ or else File.Name'Length <= 1
+ or else File.Is_System_File
+ or else not File.Is_Regular_File)
then
raise Use_Error;
Fopen_Mode
(Mode, File.Is_Text_File, False, File.Access_Method, Fopstr);
- File.Stream :=
- freopen (File.Name.all'Address, Fopstr'Address, File.Stream);
+ File.Stream := freopen
+ (File.Name.all'Address, Fopstr'Address, File.Stream, File.Encoding);
if File.Stream = NULL_Stream then
- Close (File);
+ Close (File_Ptr);
raise Use_Error;
else
OSDN Git Service
