procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2011-09-01  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, s-taprop-linux.adb, gnatls.adb: Minor reformatting.

2011-09-01  Jose Ruiz  <ruiz@adacore.com>

	* adaint.h (__gnat_cpu_free): Fix the name of this profile.
	* adaint.c (__gnat_cpu_alloc, __gnat_cpu_alloc_size, __gnat_cpu_free,
	__gnat_cpu_zero, __gnat_cpu_set): Create version of these subprograms
	specific for systems where their glibc version does not define the
	routines to handle dynamically allocated CPU sets.

2011-09-01  Vincent Celier  <celier@adacore.com>

	* prj-proc.adb, prj.ads, prj-nmsc.adb, prj-util.adb, prj-util.ads,
	prj-env.adb: Implement inheritance of naming exceptions in extending
	projects.

From-SVN: r178418
This commit is contained in:
Arnaud Charlet 2011-09-01 15:55:43 +02:00
parent d7386a7a07
commit 9f55bc6268
12 changed files with 269 additions and 136 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
gcc/ada/ChangeLog
View file

@ -1,3 +1,21 @@
2011-09-01 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, s-taprop-linux.adb, gnatls.adb: Minor reformatting.
2011-09-01 Jose Ruiz <ruiz@adacore.com>
* adaint.h (__gnat_cpu_free): Fix the name of this profile.
* adaint.c (__gnat_cpu_alloc, __gnat_cpu_alloc_size, __gnat_cpu_free,
__gnat_cpu_zero, __gnat_cpu_set): Create version of these subprograms
specific for systems where their glibc version does not define the
routines to handle dynamically allocated CPU sets.
2011-09-01 Vincent Celier <celier@adacore.com>
* prj-proc.adb, prj.ads, prj-nmsc.adb, prj-util.adb, prj-util.ads,
prj-env.adb: Implement inheritance of naming exceptions in extending
projects.
2011-09-01 Romain Berrendonner <berrendo@adacore.com>
* gnatls.adb: Display simple message instead of content of

39
gcc/ada/adaint.c
View file

@ -3790,6 +3790,14 @@ void *__gnat_lwp_self (void)
#include <sched.h>
/* glibc versions earlier than 2.7 do not define the routines to handle
dynamically allocated CPU sets. For these targets, we use the static
versions. */
#ifdef CPU_ALLOC
/* Dynamic cpu sets */
cpu_set_t *__gnat_cpu_alloc (size_t count)
{
return CPU_ALLOC (count);
@ -3816,6 +3824,37 @@ void __gnat_cpu_set (int cpu, size_t count, cpu_set_t *set)
CPU by a 0, so we need to adjust. */
CPU_SET_S (cpu - 1, count, set);
}
#else
/* Static cpu sets */
cpu_set_t *__gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED)
{
return (cpu_set_t *) xmalloc (sizeof (cpu_set_t));
}
size_t __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED)
{
return sizeof (cpu_set_t);
}
void __gnat_cpu_free (cpu_set_t *set)
{
free (set);
}
void __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
{
CPU_ZERO (set);
}
void __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
{
/* Ada handles CPU numbers starting from 1, while C identifies the first
CPU by a 0, so we need to adjust. */
CPU_SET (cpu - 1, set);
}
#endif
#ifdef __cplusplus

2
gcc/ada/adaint.h
View file

@ -254,7 +254,7 @@ extern void *__gnat_lwp_self (void);
extern cpu_set_t *__gnat_cpu_alloc (size_t);
extern size_t __gnat_cpu_alloc_size (size_t);
extern void __gnat_cpu_set_free (cpu_set_t *);
extern void __gnat_cpu_free (cpu_set_t *);
extern void __gnat_cpu_zero (size_t, cpu_set_t *);
extern void __gnat_cpu_set (int, size_t, cpu_set_t *);
#endif

1
gcc/ada/gnatls.adb
View file

@ -829,6 +829,7 @@ procedure Gnatls is
& " GNAT Tracker at http://www.adacore.com/"
& " for license terms.");
Write_Eol;
when others =>
Write_Str ("Please refer to file COPYING in your distribution"
& " for license terms.");

4
gcc/ada/prj-env.adb
View file

@ -529,7 +529,7 @@ package body Prj.Env is
if not Source.Locally_Removed
and then Source.Unit /= null
and then
(Source.Index >= 1 or else Source.Naming_Exception)
(Source.Index >= 1 or else Source.Naming_Exception /= No)
then
Put (Source);
end if;
@ -1344,6 +1344,7 @@ package body Prj.Env is
while Unit /= null loop
if Unit.File_Names (Spec) /= null
and then not Unit.File_Names (Spec).Locally_Removed
and then Unit.File_Names (Spec).File /= No_File
and then
(Namet.Get_Name_String
@ -1368,6 +1369,7 @@ package body Prj.Env is
elsif Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).File /= No_File
and then not Unit.File_Names (Impl).Locally_Removed
and then
(Namet.Get_Name_String
(Unit.File_Names (Impl).File) = Original_Name

188
gcc/ada/prj-nmsc.adb
View file

@ -252,13 +252,13 @@ package body Prj.Nmsc is
Kind : Source_Kind;
File_Name : File_Name_Type;
Display_File : File_Name_Type;
Naming_Exception : Boolean := False;
Path : Path_Information := No_Path_Information;
Alternate_Languages : Language_List := null;
Unit : Name_Id := No_Name;
Index : Int := 0;
Locally_Removed : Boolean := False;
Location : Source_Ptr := No_Location);
Naming_Exception : Naming_Exception_Type := No;
Path : Path_Information := No_Path_Information;
Alternate_Languages : Language_List := null;
Unit : Name_Id := No_Name;
Index : Int := 0;
Locally_Removed : Boolean := False;
Location : Source_Ptr := No_Location);
-- Add a new source to the different lists: list of all sources in the
-- project tree, list of source of a project and list of sources of a
-- language. If Path is specified, the file is also added to
@ -628,13 +628,13 @@ package body Prj.Nmsc is
Kind : Source_Kind;
File_Name : File_Name_Type;
Display_File : File_Name_Type;
Naming_Exception : Boolean := False;
Path : Path_Information := No_Path_Information;
Alternate_Languages : Language_List := null;
Unit : Name_Id := No_Name;
Index : Int := 0;
Locally_Removed : Boolean := False;
Location : Source_Ptr := No_Location)
Naming_Exception : Naming_Exception_Type := No;
Path : Path_Information := No_Path_Information;
Alternate_Languages : Language_List := null;
Unit : Name_Id := No_Name;
Index : Int := 0;
Locally_Removed : Boolean := False;
Location : Source_Ptr := No_Location)
is
Config : constant Language_Config := Lang_Id.Config;
UData : Unit_Index;
@ -725,7 +725,7 @@ package body Prj.Nmsc is
-- file name in unrelated projects.
elsif Is_Extending (Project, Source.Project) then
if not Locally_Removed then
if not Locally_Removed and then Naming_Exception /= Inherited then
Source_To_Replace := Source;
end if;
@ -854,14 +854,19 @@ package body Prj.Nmsc is
if UData = No_Unit_Index then
UData := new Unit_Data;
UData.Name := Unit;
Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
if Naming_Exception /= Inherited then
Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
end if;
end if;
Id.Unit := UData;
-- Note that this updates Unit information as well
Override_Kind (Id, Kind);
if Naming_Exception /= Inherited then
Override_Kind (Id, Kind);
end if;
end if;
if Path /= No_Path_Information then
@ -2329,7 +2334,7 @@ package body Prj.Nmsc is
when Name_Runtime_Source_Dir =>
-- Attribute Runtime_Library_Dir (<language>)
-- Attribute Runtime_Source_Dir (<language>)
Lang_Index.Config.Runtime_Source_Dir :=
Element.Value.Value;
@ -3714,7 +3719,7 @@ package body Prj.Nmsc is
Kind => Kind,
File_Name => File_Name,
Display_File => File_Name_Type (Element.Value),
Naming_Exception => True,
Naming_Exception => Yes,
Location => Element.Location);
else
@ -3760,6 +3765,8 @@ package body Prj.Nmsc is
File_Name : File_Name_Type;
Source : Source_Id;
Naming_Exception : Naming_Exception_Type;
begin
case Kind is
when Impl | Sep =>
@ -3787,7 +3794,7 @@ package body Prj.Nmsc is
if Exceptions = No_Array_Element then
Exceptions :=
Value_Of
(Name_Spec,
(Name_Specification,
In_Arrays => Naming.Decl.Arrays,
Shared => Shared);
end if;
@ -3795,6 +3802,13 @@ package body Prj.Nmsc is
while Exceptions /= No_Array_Element loop
Element := Shared.Array_Elements.Table (Exceptions);
if Element.Restricted then
Naming_Exception := Inherited;
else
Naming_Exception := Yes;
end if;
File_Name := Canonical_Case_File_Name (Element.Value.Value);
Get_Name_String (Element.Index);
@ -3827,7 +3841,7 @@ package body Prj.Nmsc is
Unit => Unit,
Index => Index,
Location => Element.Value.Location,
Naming_Exception => True);
Naming_Exception => Naming_Exception);
end if;
Exceptions := Element.Next;
@ -6326,7 +6340,7 @@ package body Prj.Nmsc is
Source := Prj.Element (Iter);
exit Source_Loop when Source = No_Source;
if Source.Naming_Exception then
if Source.Naming_Exception /= No then
NL := Source_Names_Htable.Get
(Project.Source_Names, Source.File);
@ -6383,51 +6397,54 @@ package body Prj.Nmsc is
-- the same file has received the full path, so we need to
-- propagate it.
if Source.Naming_Exception
and then Source.Path = No_Path_Information
then
if Source.Unit /= No_Unit_Index then
Found := False;
if Source.Path = No_Path_Information then
if Source.Naming_Exception = Yes then
if Source.Unit /= No_Unit_Index then
Found := False;
if Source.Index /= 0 then -- Only multi-unit files
declare
S : Source_Id :=
Source_Files_Htable.Get
(Data.Tree.Source_Files_HT, Source.File);
begin
while S /= null loop
if S.Path /= No_Path_Information then
Source.Path := S.Path;
Found := True;
if Source.Index /= 0 then -- Only multi-unit files
declare
S : Source_Id :=
Source_Files_Htable.Get
(Data.Tree.Source_Files_HT, Source.File);
begin
while S /= null loop
if S.Path /= No_Path_Information then
Source.Path := S.Path;
Found := True;
if Current_Verbosity = High then
Debug_Output
("setting full path for "
& Get_Name_String (Source.File)
& " at" & Source.Index'Img
& " to "
& Get_Name_String (Source.Path.Name));
if Current_Verbosity = High then
Debug_Output
("setting full path for "
& Get_Name_String (Source.File)
& " at" & Source.Index'Img
& " to "
& Get_Name_String (Source.Path.Name));
end if;
exit;
end if;
exit;
end if;
S := S.Next_With_File_Name;
end loop;
end;
end if;
S := S.Next_With_File_Name;
end loop;
end;
if not Found then
Error_Msg_Name_1 := Name_Id (Source.Display_File);
Error_Msg_Name_2 := Source.Unit.Name;
Error_Or_Warning
(Data.Flags, Data.Flags.Missing_Source_Files,
"source file %% for unit %% not found",
No_Location, Project.Project);
end if;
end if;
if not Found then
Error_Msg_Name_1 := Name_Id (Source.Display_File);
Error_Msg_Name_2 := Source.Unit.Name;
Error_Or_Warning
(Data.Flags, Data.Flags.Missing_Source_Files,
"source file %% for unit %% not found",
No_Location, Project.Project);
if Source.Path = No_Path_Information then
Remove_Source (Data.Tree, Source, No_Source);
end if;
end if;
if Source.Path = No_Path_Information then
elsif Source.Naming_Exception = Inherited then
Remove_Source (Data.Tree, Source, No_Source);
end if;
end if;
@ -6660,6 +6677,8 @@ package body Prj.Nmsc is
-- If we had another file referencing the same unit (for instance it
-- was in an extended project), that source file is in fact invisible
-- from now on, and in particular doesn't belong to the same unit.
-- If the source is an inherited naming exception, then it may not
-- really exist: the source potentially replaced is left untouched.
if Source.Unit.File_Names (Source.Kind) /= Source then
Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
@ -6773,6 +6792,50 @@ package body Prj.Nmsc is
Override_Kind (Name_Loc.Source, Sep);
end if;
end if;
-- If this is an inherited naming exception, make sure that
-- the naming exception it replaces is no longer a source.
if Name_Loc.Source.Naming_Exception = Inherited then
declare
Proj : Project_Id := Name_Loc.Source.Project.Extends;
Iter : Source_Iterator;
Src : Source_Id;
begin
while Proj /= No_Project loop
Iter := For_Each_Source (Data.Tree, Proj);
Src := Prj.Element (Iter);
while Src /= No_Source loop
if Src.File = Name_Loc.Source.File then
Src.Replaced_By := Name_Loc.Source;
exit;
end if;
Next (Iter);
Src := Prj.Element (Iter);
end loop;
Proj := Proj.Extends;
end loop;
end;
if Name_Loc.Source.Unit /= No_Unit_Index then
if Name_Loc.Source.Kind = Spec then
Name_Loc.Source.Unit.File_Names (Spec) :=
Name_Loc.Source;
elsif Name_Loc.Source.Kind = Impl then
Name_Loc.Source.Unit.File_Names (Impl) :=
Name_Loc.Source;
end if;
Units_Htable.Set
(Data.Tree.Units_HT,
Name_Loc.Source.Unit.Name,
Name_Loc.Source.Unit);
end if;
end if;
end if;
end if;
end if;
@ -6825,7 +6888,15 @@ package body Prj.Nmsc is
Name_Loc.Source := Source;
Source_Names_Htable.Set
(Project.Source_Names, File_Name, Name_Loc);
end if;
-- if Source /= No_Source and then Source.Unit /= No_Unit_Index then
-- Units_Htable.Set
-- (Data.Tree.Units_HT,
-- Source.Unit.Name,
-- Source.Unit);
-- end if;
end if;
end if;
@ -7518,6 +7589,7 @@ package body Prj.Nmsc is
if Source /= No_Source
and then Source.Path /= Src.Path
and then Src.Project = Source.Project
then
Error_Msg_File_1 := Src.File;
Error_Msg_File_2 := Source.File;

102
gcc/ada/prj-proc.adb
View file

@ -398,69 +398,62 @@ package body Prj.Proc is
Arr := Shared.Arrays.Table (A1);
A1 := Arr.Next;
if not Restricted
or else
(Arr.Name /= Snames.Name_Body and then
Arr.Name /= Snames.Name_Spec and then
Arr.Name /= Snames.Name_Implementation and then
Arr.Name /= Snames.Name_Specification)
then
-- Remove the Next component
Arr.Next := No_Array;
Array_Table.Increment_Last (Shared.Arrays);
-- Create new Array declaration
if To.Arrays = No_Array then
To.Arrays := Array_Table.Last (Shared.Arrays);
else
Shared.Arrays.Table (A2).Next :=
Array_Table.Last (Shared.Arrays);
end if;
A2 := Array_Table.Last (Shared.Arrays);
-- Don't store the array as its first element has not been set yet
-- Copy the array elements of the array
E1 := Arr.Value;
Arr.Value := No_Array_Element;
while E1 /= No_Array_Element loop
-- Copy the array element
Elm := Shared.Array_Elements.Table (E1);
E1 := Elm.Next;
-- Remove the Next component
Arr.Next := No_Array;
Array_Table.Increment_Last (Shared.Arrays);
Elm.Next := No_Array_Element;
-- Create new Array declaration
Elm.Restricted := Restricted;
-- Change the location
if To.Arrays = No_Array then
To.Arrays := Array_Table.Last (Shared.Arrays);
Elm.Value.Location := New_Loc;
Array_Element_Table.Increment_Last (Shared.Array_Elements);
-- Create new array element
if Arr.Value = No_Array_Element then
Arr.Value :=
Array_Element_Table.Last (Shared.Array_Elements);
else
Shared.Arrays.Table (A2).Next :=
Array_Table.Last (Shared.Arrays);
Shared.Array_Elements.Table (E2).Next :=
Array_Element_Table.Last (Shared.Array_Elements);
end if;
A2 := Array_Table.Last (Shared.Arrays);
E2 := Array_Element_Table.Last (Shared.Array_Elements);
Shared.Array_Elements.Table (E2) := Elm;
end loop;
-- Don't store the array as its first element has not been set yet
-- Finally, store the new array
-- Copy the array elements of the array
E1 := Arr.Value;
Arr.Value := No_Array_Element;
while E1 /= No_Array_Element loop
-- Copy the array element
Elm := Shared.Array_Elements.Table (E1);
E1 := Elm.Next;
-- Remove the Next component
Elm.Next := No_Array_Element;
-- Change the location
Elm.Value.Location := New_Loc;
Array_Element_Table.Increment_Last (Shared.Array_Elements);
-- Create new array element
if Arr.Value = No_Array_Element then
Arr.Value :=
Array_Element_Table.Last (Shared.Array_Elements);
else
Shared.Array_Elements.Table (E2).Next :=
Array_Element_Table.Last (Shared.Array_Elements);
end if;
E2 := Array_Element_Table.Last (Shared.Array_Elements);
Shared.Array_Elements.Table (E2) := Elm;
end loop;
-- Finally, store the new array
Shared.Arrays.Table (A2) := Arr;
end if;
Shared.Arrays.Table (A2) := Arr;
end loop;
end Copy_Package_Declarations;
@ -1940,6 +1933,7 @@ package body Prj.Proc is
Shared.Array_Elements.Table
(Elem) :=
(Index => Index_Name,
Restricted => False,
Src_Index => Source_Index,
Index_Case_Sensitive =>
not Case_Insensitive (Current, Node_Tree),

14
gcc/ada/prj-util.adb
View file

@ -757,8 +757,11 @@ package body Prj.Util is
elsif Name_Buffer (1 .. 2) = "I=" then
Info.Info.Index := Int'Value (Name_Buffer (3 .. Name_Len));
elsif Name_Buffer (1 .. Name_Len) = "N=T" then
Info.Info.Naming_Exception := True;
elsif Name_Buffer (1 .. Name_Len) = "N=Y" then
Info.Info.Naming_Exception := Yes;
elsif Name_Buffer (1 .. Name_Len) = "N=I" then
Info.Info.Naming_Exception := Inherited;
else
Report_Error;
@ -1116,8 +1119,11 @@ package body Prj.Util is
-- Naming exception ("N=T");
if Source.Naming_Exception then
Put_Line (File, "N=T");
if Source.Naming_Exception = Yes then
Put_Line (File, "N=Y");
elsif Source.Naming_Exception = Inherited then
Put_Line (File, "N=I");
end if;
-- Empty line to indicate end of info on this source

2
gcc/ada/prj-util.ads
View file

@ -210,7 +210,7 @@ package Prj.Util is
Path_Name : Name_Id;
Unit_Name : Name_Id := No_Name;
Index : Int := 0;
Naming_Exception : Boolean := False;
Naming_Exception : Naming_Exception_Type := No;
end record;
-- Data read from a source info file for a single source

15
gcc/ada/prj.ads
View file

@ -187,6 +187,7 @@ package Prj is
No_Array_Element : constant Array_Element_Id := 0;
type Array_Element is record
Index : Name_Id;
Restricted : Boolean := False;
Src_Index : Int := 0;
Index_Case_Sensitive : Boolean := True;
Value : Variable_Value;
@ -679,6 +680,8 @@ package Prj is
-- corresponding to an Ada file). In general, these are dependencies that
-- cannot be computed automatically by the builder.
type Naming_Exception_Type is (No, Yes, Inherited);
-- Structure to define source data
type Source_Data is record
@ -791,7 +794,7 @@ package Prj is
Switches_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Switches file time stamp
Naming_Exception : Boolean := False;
Naming_Exception : Naming_Exception_Type := No;
-- True if the source has an exceptional name
Duplicate_Unit : Boolean := False;
@ -840,7 +843,7 @@ package Prj is
Switches => No_File,
Switches_Path => No_Path,
Switches_TS => Empty_Time_Stamp,
Naming_Exception => False,
Naming_Exception => No,
Duplicate_Unit => False,
Next_In_Lang => No_Source,
Next_With_File_Name => No_Source,
@ -864,14 +867,6 @@ package Prj is
Equal => "=");
-- Mapping of source paths to source ids
package Unit_Sources_Htable is new Simple_HTable
(Header_Num => Header_Num,
Element => Source_Id,
No_Element => No_Source,
Key => Name_Id,
Hash => Hash,
Equal => "=");
type Lib_Kind is (Static, Dynamic, Relocatable);
type Policy is (Autonomous, Compliant, Controlled, Restricted, Direct);

11
gcc/ada/s-taprop-linux.adb
View file

@ -870,7 +870,8 @@ package body System.Task_Primitives.Operations is
elsif T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then
declare
CPUs : constant size_t :=
Interfaces.C.size_t (System.Multiprocessors.Number_Of_CPUs);
Interfaces.C.size_t
(System.Multiprocessors.Number_Of_CPUs);
CPU_Set : constant cpu_set_t_ptr := CPU_ALLOC (CPUs);
Size : constant size_t := CPU_ALLOC_SIZE (CPUs);
@ -909,7 +910,8 @@ package body System.Task_Primitives.Operations is
then
declare
CPUs : constant size_t :=
Interfaces.C.size_t (System.Multiprocessors.Number_Of_CPUs);
Interfaces.C.size_t
(System.Multiprocessors.Number_Of_CPUs);
CPU_Set : constant cpu_set_t_ptr := CPU_ALLOC (CPUs);
Size : constant size_t := CPU_ALLOC_SIZE (CPUs);
@ -943,6 +945,7 @@ package body System.Task_Primitives.Operations is
Attributes'Access,
Thread_Body_Access (Wrapper),
To_Address (T));
pragma Assert
(Result = 0 or else Result = EAGAIN or else Result = ENOMEM);
@ -985,6 +988,7 @@ package body System.Task_Primitives.Operations is
if T.Known_Tasks_Index /= -1 then
Known_Tasks (T.Known_Tasks_Index) := null;
end if;
SC.Invalidate_Stack_Cache (T.Common.Compiler_Data.Pri_Stack_Info'Access);
Free (Tmp);
@ -1403,7 +1407,8 @@ package body System.Task_Primitives.Operations is
then
declare
CPUs : constant size_t :=
Interfaces.C.size_t (System.Multiprocessors.Number_Of_CPUs);
Interfaces.C.size_t
(System.Multiprocessors.Number_Of_CPUs);
CPU_Set : cpu_set_t_ptr := null;
Size : constant size_t := CPU_ALLOC_SIZE (CPUs);

9
gcc/ada/sem_ch3.adb
View file

@ -15761,7 +15761,7 @@ package body Sem_Ch3 is
Set_Anonymous_Type (New_C);
elsif (Is_Private_Type (Derived_Base)
and then not Is_Generic_Type (Derived_Base))
and then not Is_Generic_Type (Derived_Base))
or else (Is_Empty_Elmt_List (Discs)
and then not Expander_Active)
then
@ -15784,9 +15784,10 @@ package body Sem_Ch3 is
-- type T_2 is new Pack_1.T_1 with ...;
-- end Pack_2;
Set_Etype (New_C,
Constrain_Component_Type
(Old_C, Derived_Base, N, Parent_Base, Discs));
Set_Etype
(New_C,
Constrain_Component_Type
(Old_C, Derived_Base, N, Parent_Base, Discs));
end if;
end if;