Commit fc475a08 by Arnaud Charlet

[multiple changes]

2009-10-28  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Add_To_Or_Remove_From_List): New name of procedure
	Add_If_Not_In_List to account to the fact that a directory may be
	removed from the list. Only remove directory if Removed is True.

2009-10-28  Gary Dismukes  <dismukes@adacore.com>

	* a-textio.ads, a-textio.ads: Put back function EOF_Char in private
	part. Put back body of function EOF_Char.
	* a-tienau.adb: Remove with of Interfaces.C_Streams and change EOF back
	to EOF_Char.

2009-10-28  Emmanuel Briot  <briot@adacore.com>

	* prj-tree.adb (Free): Fix memory leak.

2009-10-28  Thomas Quinot  <quinot@adacore.com>

	* s-fileio.adb: Minor reformatting

From-SVN: r153661
parent 4d8f8ffe
2009-10-28 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (Add_To_Or_Remove_From_List): New name of procedure
Add_If_Not_In_List to account to the fact that a directory may be
removed from the list. Only remove directory if Removed is True.
2009-10-28 Gary Dismukes <dismukes@adacore.com>
* a-textio.ads, a-textio.ads: Put back function EOF_Char in private
part. Put back body of function EOF_Char.
* a-tienau.adb: Remove with of Interfaces.C_Streams and change EOF back
to EOF_Char.
2009-10-28 Emmanuel Briot <briot@adacore.com>
* prj-tree.adb (Free): Fix memory leak.
2009-10-28 Thomas Quinot <quinot@adacore.com>
* s-fileio.adb: Minor reformatting
2009-10-28 Arnaud Charlet <charlet@adacore.com> 2009-10-28 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Make-lang.in: Update dependencies. * gcc-interface/Make-lang.in: Update dependencies.
......
...@@ -437,6 +437,15 @@ package body Ada.Text_IO is ...@@ -437,6 +437,15 @@ package body Ada.Text_IO is
return End_Of_Page (Current_In); return End_Of_Page (Current_In);
end End_Of_Page; end End_Of_Page;
--------------
-- EOF_Char --
--------------
function EOF_Char return Integer is
begin
return EOF;
end EOF_Char;
----------- -----------
-- Flush -- -- Flush --
----------- -----------
......
...@@ -458,6 +458,12 @@ private ...@@ -458,6 +458,12 @@ private
Current_Err : aliased File_Type := Standard_Err; Current_Err : aliased File_Type := Standard_Err;
-- Current files -- Current files
function EOF_Char return Integer;
-- Returns the system-specific character indicating the end of a text file.
-- This is exported for use by child packages such as Enumeration_Aux to
-- eliminate their needing to depend directly on Interfaces.C_Streams,
-- which is not available in certain target environments (such as AAMP).
procedure Initialize_Standard_Files; procedure Initialize_Standard_Files;
-- Initializes the file control blocks for the standard files. Called from -- Initializes the file control blocks for the standard files. Called from
-- the elaboration routine for this package, and from Reset_Standard_Files -- the elaboration routine for this package, and from Reset_Standard_Files
......
...@@ -32,8 +32,6 @@ ...@@ -32,8 +32,6 @@
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux; with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Characters.Handling; use Ada.Characters.Handling;
with Interfaces.C_Streams; use Interfaces.C_Streams;
-- Note: this package does not yet deal properly with wide characters ??? -- Note: this package does not yet deal properly with wide characters ???
package body Ada.Text_IO.Enumeration_Aux is package body Ada.Text_IO.Enumeration_Aux is
...@@ -100,7 +98,7 @@ package body Ada.Text_IO.Enumeration_Aux is ...@@ -100,7 +98,7 @@ package body Ada.Text_IO.Enumeration_Aux is
Store_Char (File, Character'Pos (To_Upper (C)), Buf, Buflen); Store_Char (File, Character'Pos (To_Upper (C)), Buf, Buflen);
ch := Getc (File); ch := Getc (File);
exit when ch = EOF; exit when ch = EOF_Char;
C := Character'Val (ch); C := Character'Val (ch);
exit when not Is_Letter (C) exit when not Is_Letter (C)
......
...@@ -4708,21 +4708,22 @@ package body Prj.Nmsc is ...@@ -4708,21 +4708,22 @@ package body Prj.Nmsc is
is is
Directory : constant String := Get_Name_String (From); Directory : constant String := Get_Name_String (From);
procedure Add_If_Not_In_List procedure Add_To_Or_Remove_From_List
(Path_Id : Name_Id; (Path_Id : Name_Id;
Display_Path_Id : Name_Id); Display_Path_Id : Name_Id);
-- Add the directory Path_Id to the list of source_dirs if not -- When Removed = False, the directory Path_Id to the list of
-- already in the list. -- source_dirs if not already in the list. When Removed = True,
-- removed directory Path_Id if in the list.
procedure Recursive_Find_Dirs (Path : Name_Id); procedure Recursive_Find_Dirs (Path : Name_Id);
-- Find all the subdirectories (recursively) of Path and add them -- Find all the subdirectories (recursively) of Path and add them
-- to the list of source directories of the project. -- to the list of source directories of the project.
------------------------ --------------------------------
-- Add_If_Not_In_List -- -- Add_To_Or_Remove_From_List --
------------------------ --------------------------------
procedure Add_If_Not_In_List procedure Add_To_Or_Remove_From_List
(Path_Id : Name_Id; (Path_Id : Name_Id;
Display_Path_Id : Name_Id) Display_Path_Id : Name_Id)
is is
...@@ -4794,7 +4795,7 @@ package body Prj.Nmsc is ...@@ -4794,7 +4795,7 @@ package body Prj.Nmsc is
Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) := Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) :=
(Number => Rank, Next => No_Number_List); (Number => Rank, Next => No_Number_List);
elsif List /= Nil_String then elsif Removed and then List /= Nil_String then
-- Remove source dir, if present -- Remove source dir, if present
...@@ -4811,7 +4812,7 @@ package body Prj.Nmsc is ...@@ -4811,7 +4812,7 @@ package body Prj.Nmsc is
Data.Tree.Number_Lists.Table (Rank_List).Next; Data.Tree.Number_Lists.Table (Rank_List).Next;
end if; end if;
end if; end if;
end Add_If_Not_In_List; end Add_To_Or_Remove_From_List;
------------------------- -------------------------
-- Recursive_Find_Dirs -- -- Recursive_Find_Dirs --
...@@ -4857,7 +4858,7 @@ package body Prj.Nmsc is ...@@ -4857,7 +4858,7 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
Add_If_Not_In_List Add_To_Or_Remove_From_List
(Path_Id => Canonical_Path, (Path_Id => Canonical_Path,
Display_Path_Id => Non_Canonical_Path); Display_Path_Id => Non_Canonical_Path);
...@@ -5038,7 +5039,8 @@ package body Prj.Nmsc is ...@@ -5038,7 +5039,8 @@ package body Prj.Nmsc is
Directory => Directory =>
Get_Name_String (Project.Directory.Name), Get_Name_String (Project.Directory.Name),
Resolve_Links => Opt.Follow_Links_For_Dirs, Resolve_Links => Opt.Follow_Links_For_Dirs,
Case_Sensitive => True); Case_Sensitive => True) &
Directory_Separator;
Last_Path : constant Natural := Last_Path : constant Natural :=
Compute_Directory_Last (Path); Compute_Directory_Last (Path);
...@@ -5062,7 +5064,7 @@ package body Prj.Nmsc is ...@@ -5062,7 +5064,7 @@ package body Prj.Nmsc is
(Display_Path'First .. Last_Display_Path)); (Display_Path'First .. Last_Display_Path));
Display_Path_Id := Name_Find; Display_Path_Id := Name_Find;
Add_If_Not_In_List Add_To_Or_Remove_From_List
(Path_Id => Path_Id, (Path_Id => Path_Id,
Display_Path_Id => Display_Path_Id); Display_Path_Id => Display_Path_Id);
end; end;
......
...@@ -23,10 +23,11 @@ ...@@ -23,10 +23,11 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Osint; use Osint; with Osint; use Osint;
with Prj.Err; with Prj.Err;
with Ada.Unchecked_Deallocation;
package body Prj.Tree is package body Prj.Tree is
Node_With_Comments : constant array (Project_Node_Kind) of Boolean := Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
...@@ -1000,6 +1001,7 @@ package body Prj.Tree is ...@@ -1000,6 +1001,7 @@ package body Prj.Tree is
if Proj /= null then if Proj /= null then
Project_Node_Table.Free (Proj.Project_Nodes); Project_Node_Table.Free (Proj.Project_Nodes);
Projects_Htable.Reset (Proj.Projects_HT); Projects_Htable.Reset (Proj.Projects_HT);
Name_To_Name_HTable.Reset (Proj.External_References);
Free (Proj.Project_Path); Free (Proj.Project_Path);
Unchecked_Free (Proj); Unchecked_Free (Proj);
end if; end if;
......
...@@ -223,15 +223,13 @@ package body System.File_IO is ...@@ -223,15 +223,13 @@ package body System.File_IO is
-- Sever the association between the given file and its associated -- Sever the association between the given file and its associated
-- external file. The given file is left closed. Do not perform system -- external file. The given file is left closed. Do not perform system
-- closes on the standard input, output and error files and also do -- closes on the standard input, output and error files and also do not
-- not attempt to close a stream that does not exist (signalled by a -- attempt to close a stream that does not exist (signalled by a null
-- null stream value -- happens in some error situations). -- stream value -- happens in some error situations).
if not File.Is_System_File if not File.Is_System_File and then File.Stream /= NULL_Stream then
and then File.Stream /= NULL_Stream -- Do not do an fclose if this is a shared file and there is at least
then -- one other instance of the stream that is open.
-- Do not do an fclose if this is a shared file and there is
-- at least one other instance of the stream that is open.
if File.Shared_Status = Yes then if File.Shared_Status = Yes then
declare declare
...@@ -240,9 +238,7 @@ package body System.File_IO is ...@@ -240,9 +238,7 @@ package body System.File_IO is
begin begin
P := Open_Files; P := Open_Files;
while P /= null loop while P /= null loop
if P /= File if P /= File and then File.Stream = P.Stream then
and then File.Stream = P.Stream
then
Dup_Strm := True; Dup_Strm := True;
exit; exit;
end if; end if;
...@@ -314,9 +310,9 @@ package body System.File_IO is ...@@ -314,9 +310,9 @@ package body System.File_IO is
begin begin
Close (File_Ptr); Close (File_Ptr);
-- Now unlink the external file. Note that we use the full name -- Now unlink the external file. Note that we use the full name in
-- in this unlink, because the working directory may have changed -- this unlink, because the working directory may have changed since
-- since we did the open, and we want to unlink the right file! -- we did the open, and we want to unlink the right file!
if unlink (Filename'Address) = -1 then if unlink (Filename'Address) = -1 then
raise Use_Error; raise Use_Error;
...@@ -369,8 +365,8 @@ package body System.File_IO is ...@@ -369,8 +365,8 @@ package body System.File_IO is
SSL.Lock_Task.all; SSL.Lock_Task.all;
-- First close all open files (the slightly complex form of this loop -- First close all open files (the slightly complex form of this loop is
-- is required because Close as a side effect nulls out its argument) -- required because Close as a side effect nulls out its argument).
Fptr1 := Open_Files; Fptr1 := Open_Files;
while Fptr1 /= null loop while Fptr1 /= null loop
...@@ -379,9 +375,9 @@ package body System.File_IO is ...@@ -379,9 +375,9 @@ package body System.File_IO is
Fptr1 := Fptr2; Fptr1 := Fptr2;
end loop; end loop;
-- Now unlink all temporary files. We do not bother to free the -- Now unlink all temporary files. We do not bother to free the blocks
-- blocks because we are just about to terminate the program. We -- because we are just about to terminate the program. We also ignore
-- also ignore any errors while attempting these unlink operations. -- any errors while attempting these unlink operations.
while Temp_Files /= null loop while Temp_Files /= null loop
Discard := unlink (Temp_Files.Name'Address); Discard := unlink (Temp_Files.Name'Address);
...@@ -429,20 +425,20 @@ package body System.File_IO is ...@@ -429,20 +425,20 @@ package body System.File_IO is
-- you can reset to earlier points in the file. The caller must use the -- you can reset to earlier points in the file. The caller must use the
-- Append_Set routine to deal with the necessary positioning. -- Append_Set routine to deal with the necessary positioning.
-- Note: in several cases, the fopen mode used allows reading and -- Note: in several cases, the fopen mode used allows reading and writing,
-- writing, but the setting of the Ada mode is more restrictive. For -- but the setting of the Ada mode is more restrictive. For instance,
-- instance, Create in In_File mode uses "w+" which allows writing, -- Create in In_File mode uses "w+" which allows writing, but the Ada mode
-- but the Ada mode In_File will cause any write operations to be -- In_File will cause any write operations to be rejected with Mode_Error
-- rejected with Mode_Error in any case. -- in any case.
-- Note: for the Out_File/Open cases for other than the Direct_IO case, -- Note: for the Out_File/Open cases for other than the Direct_IO case, an
-- an initial call will be made by the caller to first open the file in -- initial call will be made by the caller to first open the file in "r"
-- "r" mode to be sure that it exists. The real open, in "w" mode, will -- mode to be sure that it exists. The real open, in "w" mode, will then
-- then destroy this file. This is peculiar, but that's what Ada semantics -- destroy this file. This is peculiar, but that's what Ada semantics
-- require and the ACVT tests insist on! -- require and the ACATS tests insist on!
-- If text file translation is required, then either b or t is -- If text file translation is required, then either "b" or "t" is appended
-- added to the mode, depending on the setting of Text. -- to the mode, depending on the setting of Text.
procedure Fopen_Mode procedure Fopen_Mode
(Mode : File_Mode; (Mode : File_Mode;
...@@ -594,8 +590,6 @@ package body System.File_IO is ...@@ -594,8 +590,6 @@ package body System.File_IO is
is is
Klen : constant Integer := Keyword'Length; Klen : constant Integer := Keyword'Length;
-- Start of processing for Form_Parameter
begin begin
for J in Form'First + Klen .. Form'Last - 1 loop for J in Form'First + Klen .. Form'Last - 1 loop
if Form (J) = '=' if Form (J) = '='
...@@ -661,6 +655,7 @@ package body System.File_IO is ...@@ -661,6 +655,7 @@ package body System.File_IO is
begin begin
status := setvbuf (File.Stream, Null_Address, IOLBF, Line_Siz); status := setvbuf (File.Stream, Null_Address, IOLBF, Line_Siz);
-- No error checking???
end Make_Line_Buffered; end Make_Line_Buffered;
--------------------- ---------------------
...@@ -673,6 +668,7 @@ package body System.File_IO is ...@@ -673,6 +668,7 @@ package body System.File_IO is
begin begin
status := setvbuf (File.Stream, Null_Address, IONBF, 0); status := setvbuf (File.Stream, Null_Address, IONBF, 0);
-- No error checking???
end Make_Unbuffered; end Make_Unbuffered;
---------- ----------
...@@ -722,7 +718,7 @@ package body System.File_IO is ...@@ -722,7 +718,7 @@ package body System.File_IO is
procedure Tmp_Name (Buffer : Address); procedure Tmp_Name (Buffer : Address);
pragma Import (C, Tmp_Name, "__gnat_tmp_name"); 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 : FILEs := C_Stream;
-- Stream which we open in response to this request -- Stream which we open in response to this request
...@@ -742,9 +738,9 @@ package body System.File_IO is ...@@ -742,9 +738,9 @@ package body System.File_IO is
-- Indicates temporary file case -- Indicates temporary file case
Namelen : constant Integer := max_path_len; Namelen : constant Integer := max_path_len;
-- Length required for file name, not including final ASCII.NUL -- Length required for file name, not including final ASCII.NUL.
-- Note that we used to reference L_tmpnam here, which is not -- Note that we used to reference L_tmpnam here, which is not reliable
-- reliable since __gnat_tmp_name does not always use tmpnam. -- since __gnat_tmp_name does not always use tmpnam.
Namestr : aliased String (1 .. Namelen + 1); Namestr : aliased String (1 .. Namelen + 1);
-- Name as given or temporary file name with ASCII.NUL appended -- Name as given or temporary file name with ASCII.NUL appended
...@@ -900,7 +896,7 @@ package body System.File_IO is ...@@ -900,7 +896,7 @@ package body System.File_IO is
-- Fullname is generated by calling system's full_name. The problem -- Fullname is generated by calling system's full_name. The problem
-- is, full_name does nothing about the casing, so a file name -- is, full_name does nothing about the casing, so a file name
-- comparison may generally speaking not be valid on non-case -- comparison may generally speaking not be valid on non-case-
-- sensitive systems, and in particular we get unexpected failures -- sensitive systems, and in particular we get unexpected failures
-- on Windows/Vista because of this. So we use s-casuti to force -- on Windows/Vista because of this. So we use s-casuti to force
-- the name to lower case. -- the name to lower case.
...@@ -909,8 +905,8 @@ package body System.File_IO is ...@@ -909,8 +905,8 @@ package body System.File_IO is
To_Lower (Fullname (1 .. Full_Name_Len)); To_Lower (Fullname (1 .. Full_Name_Len));
end if; end if;
-- If Shared=None or Shared=Yes, then check for the existence -- If Shared=None or Shared=Yes, then check for the existence of
-- of another file with exactly the same full name. -- another file with exactly the same full name.
if Shared /= No then if Shared /= No then
declare declare
...@@ -1030,8 +1026,8 @@ package body System.File_IO is ...@@ -1030,8 +1026,8 @@ package body System.File_IO is
end if; end if;
-- Stream has been successfully located or opened, so now we are -- Stream has been successfully located or opened, so now we are
-- committed to completing the opening of the file. Allocate block -- committed to completing the opening of the file. Allocate block on
-- on heap and fill in its fields. -- heap and fill in its fields.
File_Ptr := AFCB_Allocate (Dummy_FCB); File_Ptr := AFCB_Allocate (Dummy_FCB);
...@@ -1103,9 +1099,9 @@ package body System.File_IO is ...@@ -1103,9 +1099,9 @@ package body System.File_IO is
Reset (File_Ptr, File.Mode); Reset (File_Ptr, File.Mode);
end Reset; end Reset;
-- The reset with a change in mode is done using freopen, and is -- The reset with a change in mode is done using freopen, and is not
-- not permitted except for regular files (since otherwise there -- permitted except for regular files (since otherwise there is no name for
-- is no name for the freopen, and in any case it seems meaningless) -- the freopen, and in any case it seems meaningless).
procedure Reset (File_Ptr : access AFCB_Ptr; Mode : File_Mode) is procedure Reset (File_Ptr : access AFCB_Ptr; Mode : File_Mode) is
File : AFCB_Ptr renames File_Ptr.all; File : AFCB_Ptr renames File_Ptr.all;
...@@ -1126,17 +1122,17 @@ package body System.File_IO is ...@@ -1126,17 +1122,17 @@ package body System.File_IO is
then then
raise Use_Error; raise Use_Error;
-- For In_File or Inout_File for a regular file, we can just do a -- For In_File or Inout_File for a regular file, we can just do a rewind
-- rewind if the mode is unchanged, which is more efficient than -- if the mode is unchanged, which is more efficient than doing a full
-- doing a full reopen. -- reopen.
elsif Mode = File.Mode elsif Mode = File.Mode
and then Mode <= Inout_File and then Mode <= Inout_File
then then
rewind (File.Stream); rewind (File.Stream);
-- Here the change of mode is permitted, we do it by reopening the -- Here the change of mode is permitted, we do it by reopening the file
-- file in the new mode and replacing the stream with a new stream. -- in the new mode and replacing the stream with a new stream.
else else
Fopen_Mode Fopen_Mode
...@@ -1162,10 +1158,10 @@ package body System.File_IO is ...@@ -1162,10 +1158,10 @@ package body System.File_IO is
procedure Write_Buf (File : AFCB_Ptr; Buf : Address; Siz : size_t) is procedure Write_Buf (File : AFCB_Ptr; Buf : Address; Siz : size_t) is
begin begin
-- Note: for most purposes, the Siz and 1 parameters in the fwrite -- Note: for most purposes, the Siz and 1 parameters in the fwrite call
-- call could be reversed, but on VMS, this is a better choice, since -- could be reversed, but on VMS, this is a better choice, since for
-- for some file formats, reversing the parameters results in records -- some file formats, reversing the parameters results in records of one
-- of one byte each. -- byte each.
SSL.Abort_Defer.all; SSL.Abort_Defer.all;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment