Skip to content

R
riscv-gcc-1
Commit d56e7acd by Arnaud Charlet
Options

[multiple changes] 

2009-11-30  Robert Dewar  <dewar@adacore.com>

	* bcheck.adb, gnatlink.adb, make.adb, makeutl.adb, osint.adb,
	osint.ads, prj-ext.adb, sem_case.adb: Minor reformatting
	* g-alleve.adb: Minor code reorganization (use conditional expressions)

2009-11-30  Matthew Heaney  <heaney@adacore.com>

	* a-crbtgo.adb (Delete_Fixup): Changed always-true predicates to
	assertions.

2009-11-30  Thomas Quinot  <quinot@adacore.com>

	* a-tasatt.adb, s-crtl.ads, s-taprop-dummy.adb (System.CRTL.malloc32,
	System.CRTL.realloc32): Remove VMS-specific routines.
	(Ada.Task_Attributes.Reference): Remove unreachable code.
	(System.Task_Primitives.Operations.Initialize, dummy version):
	Use plain Program_Error rather than call to
	System.Error_Reporting.Shutdown.

From-SVN: r154762
parent f1b20d27
Showing with 113 additions and 72 deletions
gcc/ada/ChangeLog
2009-11-30 Robert Dewar <dewar@adacore.com>
* bcheck.adb, gnatlink.adb, make.adb, makeutl.adb, osint.adb,
osint.ads, prj-ext.adb, sem_case.adb: Minor reformatting
* g-alleve.adb: Minor code reorganization (use conditional expressions)
2009-11-30 Matthew Heaney <heaney@adacore.com>
* a-crbtgo.adb (Delete_Fixup): Changed always-true predicates to
assertions.
2009-11-30 Thomas Quinot <quinot@adacore.com>
* a-tasatt.adb, s-crtl.ads, s-taprop-dummy.adb (System.CRTL.malloc32,
System.CRTL.realloc32): Remove VMS-specific routines.
(Ada.Task_Attributes.Reference): Remove unreachable code.
(System.Task_Primitives.Operations.Initialize, dummy version):
Use plain Program_Error rather than call to
System.Error_Reporting.Shutdown.
2009-11-30 Thomas Quinot <quinot@adacore.com>
* s-oscons-tmplt.c, xoscons.adb: Add new constants in preparation for
......
gcc/ada/a-crbtgo.adb
......@@ -171,10 +171,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
if Right (W) = null
or else Color (Right (W)) = Black
then
if Left (W) /= null then
Set_Color (Left (W), Black);
end if;
pragma Assert (Left (W) /= null);
Set_Color (Left (W), Black);
Set_Color (W, Red);
Right_Rotate (Tree, W);
W := Right (Parent (X));
......@@ -208,10 +206,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
else
if Left (W) = null or else Color (Left (W)) = Black then
if Right (W) /= null then
Set_Color (Right (W), Black);
end if;
pragma Assert (Right (W) /= null);
Set_Color (Right (W), Black);
Set_Color (W, Red);
Left_Rotate (Tree, W);
W := Left (Parent (X));
......
gcc/ada/bcheck.adb
......@@ -191,6 +191,7 @@ package body Bcheck is
else
ALI_Path_Id :=
Osint.Full_Lib_File_Name (ALIs.Table (A).Afile);
if Osint.Is_Readonly_Library (ALI_Path_Id) then
if Tolerate_Consistency_Errors then
Error_Msg ("?{ should be recompiled");
......
gcc/ada/gnatlink.adb
......@@ -2148,11 +2148,10 @@ begin
if Linker_Path = Gcc_Path and then VM_Target = No_VM then
-- For systems where the default is to link statically
-- with libgcc, if gcc is not called with
-- -shared-libgcc, call it with -static-libgcc, as
-- there are some platforms where one of these two
-- switches is compulsory to link.
-- For systems where the default is to link statically with
-- libgcc, if gcc is not called with -shared-libgcc, call it
-- with -static-libgcc, as there are some platforms where one
-- of these two switches is compulsory to link.
if Shared_Libgcc_Default = 'T'
and then not Shared_Libgcc_Seen
......
gcc/ada/makeutl.adb
......@@ -329,8 +329,8 @@ package body Makeutl is
end if;
return Normalize_Pathname
(Exec (Exec'First .. Path_Last - 4),
Resolve_Links => Opt.Follow_Links_For_Dirs)
(Exec (Exec'First .. Path_Last - 4),
Resolve_Links => Opt.Follow_Links_For_Dirs)
& Directory_Separator;
end Get_Install_Dir;
......
gcc/ada/osint.adb
......@@ -80,8 +80,8 @@ package body Osint is
-- Appends Suffix to Name and returns the new name
function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type;
-- Convert OS format time to GNAT format time stamp.
-- Returns Empty_Time_Stamp if T is Invalid_Time
-- Convert OS format time to GNAT format time stamp. If T is Invalid_Time,
-- then returns Empty_Time_Stamp.
function Executable_Prefix return String_Ptr;
-- Returns the name of the root directory where the executable is stored.
......@@ -91,8 +91,8 @@ package body Osint is
-- "/foo/bar/". Return "" if location is not recognized as described above.
function Update_Path (Path : String_Ptr) return String_Ptr;
-- Update the specified path to replace the prefix with the location
-- where GNAT is installed. See the file prefix.c in GCC for details.
-- Update the specified path to replace the prefix with the location where
-- GNAT is installed. See the file prefix.c in GCC for details.
procedure Locate_File
(N : File_Name_Type;
......@@ -106,9 +106,11 @@ package body Osint is
-- if T = Source, Dir is an index into the Src_Search_Directories table.
-- Returns the File_Name_Type of the full file name if file found, or
-- No_File if not found.
--
-- On exit, Found is set to the file that was found, and Attr to a cache of
-- its attributes (at least those that have been computed so far). Reusing
-- the cache will save some system calls.
--
-- Attr is always reset in this call to Unknown_Attributes, even in case of
-- failure
......@@ -239,8 +241,9 @@ package body Osint is
File : File_Name_Type;
Attr : aliased File_Attributes;
end record;
No_File_Info_Cache : constant File_Info_Cache :=
(No_File, Unknown_Attributes);
(No_File, Unknown_Attributes);
package File_Name_Hash_Table is new GNAT.HTable.Simple_HTable (
Header_Num => File_Hash_Num,
......@@ -584,13 +587,13 @@ package body Osint is
declare
Norm : String_Ptr := Normalize_Directory_Name (Dir);
begin
begin
-- Do nothing if the directory is already in the list. This saves
-- system calls and avoid unneeded work
for D in Lib_Search_Directories.First ..
Lib_Search_Directories.Last
Lib_Search_Directories.Last
loop
if Lib_Search_Directories.Table (D).all = Norm.all then
Free (Norm);
......@@ -1002,10 +1005,13 @@ package body Osint is
-----------------
function File_Length
(Name : C_File_Name; Attr : access File_Attributes) return Long_Integer
(Name : C_File_Name;
Attr : access File_Attributes) return Long_Integer
is
function Internal
(F : Integer; N : C_File_Name; A : System.Address) return Long_Integer;
(F : Integer;
N : C_File_Name;
A : System.Address) return Long_Integer;
pragma Import (C, Internal, "__gnat_file_length_attr");
begin
return Internal (-1, Name, Attr.all'Address);
......@@ -1016,7 +1022,8 @@ package body Osint is
---------------------
function File_Time_Stamp
(Name : C_File_Name; Attr : access File_Attributes) return OS_Time
(Name : C_File_Name;
Attr : access File_Attributes) return OS_Time
is
function Internal (N : C_File_Name; A : System.Address) return OS_Time;
pragma Import (C, Internal, "__gnat_file_time_name_attr");
......@@ -1036,13 +1043,13 @@ package body Osint is
Get_Name_String (Name);
-- File_Time_Stamp will always return Invalid_Time if the file does not
-- exist, and OS_Time_To_GNAT_Time will convert this value to
-- Empty_Time_Stamp. Therefore we do not need to first test whether the
-- file actually exists, which saves a system call.
-- File_Time_Stamp will always return Invalid_Time if the file does
-- not exist, and OS_Time_To_GNAT_Time will convert this value to
-- Empty_Time_Stamp. Therefore we do not need to first test whether
-- the file actually exists, which saves a system call.
return OS_Time_To_GNAT_Time
(File_Time_Stamp (Name_Buffer (1 .. Name_Len)));
(File_Time_Stamp (Name_Buffer (1 .. Name_Len)));
end File_Stamp;
function File_Stamp (Name : Path_Name_Type) return Time_Stamp_Type is
......@@ -1084,9 +1091,9 @@ package body Osint is
begin
-- If we are looking for a config file, look only in the current
-- directory, i.e. return input argument unchanged. Also look
-- only in the current directory if we are looking for a .dg
-- file (happens in -gnatD mode).
-- directory, i.e. return input argument unchanged. Also look only in
-- the curren directory if we are looking for a .dg file (happens in
-- -gnatD mode).
if T = Config
or else (Debug_Generated_Code
......@@ -2392,10 +2399,13 @@ package body Osint is
if Opt.Check_Object_Consistency then
-- On most systems, this does not result in an extra system call
Current_Full_Lib_Stamp := OS_Time_To_GNAT_Time
(File_Time_Stamp (Name_Buffer'Address, Lib_File_Attr));
Current_Full_Lib_Stamp :=
OS_Time_To_GNAT_Time
(File_Time_Stamp (Name_Buffer'Address, Lib_File_Attr));
-- ??? One system call here
Current_Full_Obj_Stamp := File_Stamp (Current_Full_Obj_Name);
if Current_Full_Obj_Stamp (1) = ' ' then
......@@ -2710,6 +2720,7 @@ package body Osint is
is
File : File_Name_Type;
Attr : aliased File_Attributes;
begin
if not File_Cache_Enabled then
Find_File (N, T, File, Attr'Access);
......@@ -2722,8 +2733,9 @@ package body Osint is
else
Get_Name_String (File);
Name_Buffer (Name_Len + 1) := ASCII.NUL;
return OS_Time_To_GNAT_Time
(File_Time_Stamp (Name_Buffer'Address, Attr'Access));
return
OS_Time_To_GNAT_Time
(File_Time_Stamp (Name_Buffer'Address, Attr'Access));
end if;
end Smart_File_Stamp;
......@@ -2757,8 +2769,10 @@ package body Osint is
begin
if not File_Cache_Enabled then
Find_File (N, T, Info.File, Info.Attr'Access);
else
Info := File_Name_Hash_Table.Get (N);
if Info.File = No_File then
Find_File (N, T, Info.File, Info.Attr'Access);
File_Name_Hash_Table.Set (N, Info);
......@@ -2801,8 +2815,7 @@ package body Osint is
if Is_Directory_Separator (Name_Buffer (J)) then
-- Return the part of Name that follows this last directory
-- separator.
-- Return part of Name that follows this last directory separator
Name_Buffer (1 .. Name_Len - J) := Name_Buffer (J + 1 .. Name_Len);
Name_Len := Name_Len - J;
......@@ -2849,7 +2862,7 @@ package body Osint is
Prefix_Flag : Integer) return Address;
pragma Import (C, To_Canonical_Dir_Spec, "__gnat_to_canonical_dir_spec");
C_Host_Dir : String (1 .. Host_Dir'Length + 1);
C_Host_Dir : String (1 .. Host_Dir'Length + 1);
Canonical_Dir_Addr : Address;
Canonical_Dir_Len : Integer;
......@@ -2862,6 +2875,7 @@ package body Osint is
else
Canonical_Dir_Addr := To_Canonical_Dir_Spec (C_Host_Dir'Address, 0);
end if;
Canonical_Dir_Len := C_String_Length (Canonical_Dir_Addr);
if Canonical_Dir_Len = 0 then
......
gcc/ada/osint.ads
......@@ -30,8 +30,8 @@ with Namet; use Namet;
with Types; use Types;
with System.Storage_Elements;
with System.OS_Lib; use System.OS_Lib;
with System; use System;
with System.OS_Lib; use System.OS_Lib;
with System; use System;
pragma Elaborate_All (System.OS_Lib);
-- For the call to function Get_Target_Object_Suffix in the private part
......@@ -234,10 +234,12 @@ package Osint is
---------------------
-- File attributes --
---------------------
-- The following subprograms offer services similar to those found in
-- System.OS_Lib, but with the ability to extra multiple information from
-- a single system call, depending on the system. This can result in fewer
-- system calls when reused.
-- In all these subprograms, the requested value is either read from the
-- File_Attributes parameter (resulting in no system call), or computed
-- from the disk and then cached in the File_Attributes parameter (possibly
......@@ -249,27 +251,35 @@ package Osint is
-- This must be initialized to Unknown_Attributes prior to the first call.
function Is_Directory
(Name : C_File_Name; Attr : access File_Attributes) return Boolean;
(Name : C_File_Name;
Attr : access File_Attributes) return Boolean;
function Is_Regular_File
(Name : C_File_Name; Attr : access File_Attributes) return Boolean;
(Name : C_File_Name;
Attr : access File_Attributes) return Boolean;
function Is_Symbolic_Link
(Name : C_File_Name; Attr : access File_Attributes) return Boolean;
(Name : C_File_Name;
Attr : access File_Attributes) return Boolean;
-- Return the type of the file,
function File_Length
(Name : C_File_Name; Attr : access File_Attributes) return Long_Integer;
(Name : C_File_Name;
Attr : access File_Attributes) return Long_Integer;
-- Return the length (number of bytes) of the file
function File_Time_Stamp
(Name : C_File_Name; Attr : access File_Attributes) return OS_Time;
(Name : C_File_Name;
Attr : access File_Attributes) return OS_Time;
-- Return the time stamp of the file
function Is_Readable_File
(Name : C_File_Name; Attr : access File_Attributes) return Boolean;
(Name : C_File_Name;
Attr : access File_Attributes) return Boolean;
function Is_Executable_File
(Name : C_File_Name; Attr : access File_Attributes) return Boolean;
(Name : C_File_Name;
Attr : access File_Attributes) return Boolean;
function Is_Writable_File
(Name : C_File_Name; Attr : access File_Attributes) return Boolean;
(Name : C_File_Name;
Attr : access File_Attributes) return Boolean;
-- Return the access rights for the file
-------------------------
......@@ -436,6 +446,7 @@ package Osint is
-- The source file directory lookup penalty is incurred every single time
-- the routines are called unless you have previously called
-- Source_File_Data (Cache => True). See below.
--
-- The procedural version also returns some file attributes for the ALI
-- file (to save on system calls later on).
......@@ -468,11 +479,11 @@ package Osint is
-- Representation of Library Information --
-------------------------------------------
-- Associated with each compiled source file is library information,
-- a string of bytes whose exact format is described in the body of
-- Lib.Writ. Compiling a source file generates this library information
-- for the compiled unit, and access the library information for units
-- that were compiled previously on which the unit being compiled depends.
-- Associated with each compiled source file is library information, a
-- string of bytes whose exact format is described in the body of Lib.Writ.
-- Compiling a source file generates this library information for the
-- compiled unit, and access the library information for units that were
-- compiled previously on which the unit being compiled depends.
-- How this information is stored is up to the implementation of this
-- package. At the interface level, this information is simply associated
......@@ -524,15 +535,14 @@ package Osint is
-- include any directory information. The implementation is responsible
-- for searching for the file in appropriate directories.
--
-- If Opt.Check_Object_Consistency is set to True then this routine
-- checks whether the object file corresponding to the Lib_File is
-- consistent with it. The object file is inconsistent if the object
-- does not exist or if it has an older time stamp than Lib_File.
-- This check is not performed when the Lib_File is "locked" (i.e.
-- read/only) because in this case the object file may be buried
-- in a library. In case of inconsistencies Read_Library_Info
-- behaves as if it did not find Lib_File (namely if Fatal_Err is
-- False, null is returned).
-- If Opt.Check_Object_Consistency is set to True then this routine checks
-- whether the object file corresponding to the Lib_File is consistent with
-- it. The object file is inconsistent if the object does not exist or if
-- it has an older time stamp than Lib_File. This check is not performed
-- when the Lib_File is "locked" (i.e. read/only) because in this case the
-- object file may be buried in a library. In case of inconsistencies
-- Read_Library_Info behaves as if it did not find Lib_File (namely if
-- Fatal_Err is False, null is returned).
function Read_Library_Info_From_Full
(Full_Lib_File : File_Name_Type;
......@@ -726,7 +736,7 @@ private
type File_Attributes is
array (1 .. File_Attributes_Size)
of System.Storage_Elements.Storage_Element;
of System.Storage_Elements.Storage_Element;
for File_Attributes'Alignment use Standard'Maximum_Alignment;
Unknown_Attributes : constant File_Attributes := (others => 0);
......
gcc/ada/prj-ext.adb
......@@ -213,9 +213,9 @@ package body Prj.Ext is
declare
New_Dir : constant String :=
Normalize_Pathname
(Name_Buffer (First .. Last),
Resolve_Links => Opt.Follow_Links_For_Dirs);
Normalize_Pathname
(Name_Buffer (First .. Last),
Resolve_Links => Opt.Follow_Links_For_Dirs);
begin
-- If the absolute path was resolved and is different from
......
gcc/ada/sem_case.adb
......@@ -239,8 +239,9 @@ package body Sem_Case is
" alternatives must cover base type", Expr, Expr);
else
Error_Msg_N ("subtype of expression is not static," &
" alternatives must cover base type!", Expr);
Error_Msg_N
("subtype of expression is not static,"
& " alternatives must cover base type!", Expr);
end if;
-- Otherwise the expression is not static, even if the bounds of the
......@@ -249,8 +250,8 @@ package body Sem_Case is
elsif not Is_Entity_Name (Expr) then
Error_Msg_N
("subtype of expression is not static, " &
"alternatives must cover base type!", Expr);
("subtype of expression is not static, "
& "alternatives must cover base type!", Expr);
end if;
end Explain_Non_Static_Bound;
......
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