OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2010-10-12  Robert Dewar  <dewar@adacore.com>

	* sem_ch6.adb (Process_PPCs): Fix error in inheriting Pre'Class when no
	exception messages are generated.
	(Process_PPCs): Fix error in inheriting Pre'Class.

2010-10-12  Jose Ruiz  <ruiz@adacore.com>

	* gnatcmd.adb: Use response file for GNATstack.
	(Check_Files): Pass the list of .ci files for GNATstack using a response
	file to avoid problems with command line length.
	Factor out the code handling response file into a new procedure named
	Add_To_Response_File.

2010-10-12  Vincent Celier  <celier@adacore.com>

	* debug.adb: For gnatmake, document the meaning of -dm
	* make.adb (Gnatmake): If -dm is used, indicate the maximum number of
	simultaneous compilations.
	* switch-m.adb (Scan_Make_Switches): Allow -j0, meaning as many
	simultaneous compilations as the number of processors.

From-SVN: r165367
This commit is contained in:
Arnaud Charlet 2010-10-12 14:23:32 +02:00
parent cf3e104199
commit 3c971dccec
6 changed files with 162 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/ada/ChangeLog
View File

@ -1,3 +1,25 @@
2010-10-12 Robert Dewar <dewar@adacore.com>
* sem_ch6.adb (Process_PPCs): Fix error in inheriting Pre'Class when no
exception messages are generated.
(Process_PPCs): Fix error in inheriting Pre'Class.
2010-10-12 Jose Ruiz <ruiz@adacore.com>
* gnatcmd.adb: Use response file for GNATstack.
(Check_Files): Pass the list of .ci files for GNATstack using a response
file to avoid problems with command line length.
Factor out the code handling response file into a new procedure named
Add_To_Response_File.
2010-10-12 Vincent Celier <celier@adacore.com>
* debug.adb: For gnatmake, document the meaning of -dm
* make.adb (Gnatmake): If -dm is used, indicate the maximum number of
simultaneous compilations.
* switch-m.adb (Scan_Make_Switches): Allow -j0, meaning as many
simultaneous compilations as the number of processors.
2010-10-12 Joseph Myers <joseph@codesourcery.com> 2010-10-12 Joseph Myers <joseph@codesourcery.com>
* gcc-interface/Make-lang.in (ada/misc.o): Use $(OPTIONS_H) * gcc-interface/Make-lang.in (ada/misc.o): Use $(OPTIONS_H)

2
gcc/ada/debug.adb
View File

@ -198,7 +198,7 @@ package body Debug is
-- dj -- dj
-- dk -- dk
-- dl -- dl
-- dm -- dm Display the number of maximum simultaneous compilations
-- dn Do not delete temp files created by gnatmake -- dn Do not delete temp files created by gnatmake
-- do -- do
-- dp Prints the contents of the Q used by Make.Compile_Sources -- dp Prints the contents of the Q used by Make.Compile_Sources

203
gcc/ada/gnatcmd.adb
View File

@ -319,6 +319,42 @@ procedure GNATCmd is
Status : Integer; Status : Integer;
Success : Boolean; Success : Boolean;
procedure Add_To_Response_File
(File_Name : String; Check_File : Boolean := True);
-- Include the file name passed as parameter in the response file for
-- the tool being called. If the response file can not be written then
-- the file name is passed in the parameter list of the tool. If the
-- Check_File parameter is True then the procedure verifies the
-- existence of the file before adding it to the response file.
procedure Add_To_Response_File
(File_Name : String; Check_File : Boolean := True)
is
begin
Name_Len := 0;
Add_Str_To_Name_Buffer (File_Name);
if not Check_File or else
Is_Regular_File (Name_Buffer (1 .. Name_Len))
then
if FD /= Invalid_FD then
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := ASCII.LF;
Status := Write (FD, Name_Buffer (1)'Address, Name_Len);
if Status /= Name_Len then
Osint.Fail ("disk full");
end if;
else
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(File_Name);
end if;
end if;
end Add_To_Response_File;
begin begin
-- Check if there is at least one argument that is not a switch or if -- Check if there is at least one argument that is not a switch or if
-- there is a -files= switch. -- there is a -files= switch.
@ -363,11 +399,13 @@ procedure GNATCmd is
if Add_Sources then if Add_Sources then
-- For gnatcheck, gnatpp, and gnatmetric, create a temporary file -- For gnatcheck, gnatpp, and gnatmetric, create a temporary file
-- and put the list of sources in it. -- and put the list of sources in it. For gnatstack create a
-- temporary file with the list of .ci files.
if The_Command = Check or else if The_Command = Check or else
The_Command = Pretty or else The_Command = Pretty or else
The_Command = Metric The_Command = Metric or else
The_Command = Stack
then then
Tempdir.Create_Temp_File (FD, Temp_File_Name); Tempdir.Create_Temp_File (FD, Temp_File_Name);
Last_Switches.Increment_Last; Last_Switches.Increment_Last;
@ -377,7 +415,6 @@ procedure GNATCmd is
declare declare
Proj : Project_List; Proj : Project_List;
File : String_Access;
begin begin
-- Gnatstack needs to add the .ci file for the binder generated -- Gnatstack needs to add the .ci file for the binder generated
@ -396,40 +433,33 @@ procedure GNATCmd is
Main := Proj.Project.Mains; Main := Proj.Project.Mains;
while Main /= Nil_String loop while Main /= Nil_String loop
File := Add_To_Response_File
new String' (Get_Name_String
(Get_Name_String (Proj.Project.Object_Directory.Name) &
(Proj.Project.Object_Directory.Name) & B_Start.all &
B_Start.all & MLib.Fil.Ext_To
MLib.Fil.Ext_To (Get_Name_String
(Get_Name_String (Project_Tree.String_Elements.Table
(Project_Tree.String_Elements.Table (Main).Value),
(Main).Value), "ci"));
"ci"));
-- When looking for the .ci file for a binder -- When looking for the .ci file for a binder
-- generated file, look for both b~xxx and b__xxx -- generated file, look for both b~xxx and b__xxx
-- as gprbuild always uses b__ as the prefix of -- as gprbuild always uses b__ as the prefix of
-- such files. -- such files.
if not Is_Regular_File (File.all) if not Is_Regular_File (Name_Buffer (1 .. Name_Len))
and then B_Start.all /= "b__" and then B_Start.all /= "b__"
then then
File := Add_To_Response_File
new String' (Get_Name_String
(Get_Name_String (Proj.Project.Object_Directory.Name) &
(Proj.Project.Object_Directory.Name) & "b__" &
"b__" & MLib.Fil.Ext_To
MLib.Fil.Ext_To (Get_Name_String
(Get_Name_String (Project_Tree.String_Elements.Table
(Project_Tree.String_Elements.Table (Main).Value),
(Main).Value), "ci"));
"ci"));
end if;
if Is_Regular_File (File.all) then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) := File;
end if; end if;
Main := Main :=
@ -442,30 +472,27 @@ procedure GNATCmd is
-- files that contains the initialization and -- files that contains the initialization and
-- finalization of the library. -- finalization of the library.
File := Add_To_Response_File
new String' (Get_Name_String
(Get_Name_String (Proj.Project.Object_Directory.Name) &
(Proj.Project.Object_Directory.Name) & B_Start.all &
B_Start.all & Get_Name_String (Proj.Project.Library_Name) &
Get_Name_String (Proj.Project.Library_Name) & ".ci");
".ci");
if not Is_Regular_File (File.all) and then -- When looking for the .ci file for a binder
B_Start.all /= "b__" -- generated file, look for both b~xxx and b__xxx
-- as gprbuild always uses b__ as the prefix of
-- such files.
if not Is_Regular_File (Name_Buffer (1 .. Name_Len))
and then B_Start.all /= "b__"
then then
File := Add_To_Response_File
new String' (Get_Name_String
(Get_Name_String (Proj.Project.Object_Directory.Name) &
(Proj.Project.Object_Directory.Name) & "b__" &
"b__" & Get_Name_String (Proj.Project.Library_Name) &
Get_Name_String ".ci");
(Proj.Project.Library_Name) &
".ci");
end if;
if Is_Regular_File (File.all) then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) := File;
end if; end if;
end if; end if;
end; end;
@ -574,20 +601,14 @@ procedure GNATCmd is
end if; end if;
if not Subunit then if not Subunit then
File := Add_To_Response_File
new String' (Get_Name_String
(Get_Name_String (Unit.File_Names
(Unit.File_Names (Impl).Project. Object_Directory.Name) &
(Impl).Project. Object_Directory.Name) & MLib.Fil.Ext_To
MLib.Fil.Ext_To (Get_Name_String
(Get_Name_String (Unit.File_Names (Impl).Display_File),
(Unit.File_Names (Impl).Display_File), "ci"));
"ci"));
if Is_Regular_File (File.all) then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) := File;
end if;
end if; end if;
end if; end if;
@ -599,20 +620,14 @@ procedure GNATCmd is
if Check_Project if Check_Project
(Unit.File_Names (Spec).Project, Project) (Unit.File_Names (Spec).Project, Project)
then then
File := Add_To_Response_File
new String' (Get_Name_String
(Get_Name_String (Unit.File_Names
(Unit.File_Names (Spec).Project. Object_Directory.Name) &
(Spec).Project. Object_Directory.Name) & Dir_Separator &
Dir_Separator & MLib.Fil.Ext_To
MLib.Fil.Ext_To (Get_Name_String (Unit.File_Names (Spec).File),
(Get_Name_String (Unit.File_Names (Spec).File), "ci"));
"ci"));
if Is_Regular_File (File.all) then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) := File;
end if;
end if; end if;
end if; end if;
@ -627,30 +642,12 @@ procedure GNATCmd is
(Unit.File_Names (Kind).Project, Project) (Unit.File_Names (Kind).Project, Project)
and then not Unit.File_Names (Kind).Locally_Removed and then not Unit.File_Names (Kind).Locally_Removed
then then
Name_Len := 0; Add_To_Response_File
Add_Char_To_Name_Buffer ('"'); ("""" &
Add_Str_To_Name_Buffer Get_Name_String
(Get_Name_String (Unit.File_Names (Kind).Path.Display_Name) &
(Unit.File_Names (Kind).Path.Display_Name)); """",
Add_Char_To_Name_Buffer ('"'); Check_File => False);
if FD /= Invalid_FD then
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := ASCII.LF;
Status :=
Write (FD, Name_Buffer (1)'Address, Name_Len);
if Status /= Name_Len then
Osint.Fail ("disk full");
end if;
else
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(Get_Name_String
(Unit.File_Names
(Kind).Path.Display_Name));
end if;
end if; end if;
end loop; end loop;
end if; end if;

5
gcc/ada/make.adb
View File

@ -5321,6 +5321,11 @@ package body Make is
Saved_Maximum_Processes := Maximum_Processes; Saved_Maximum_Processes := Maximum_Processes;
end if; end if;
if Debug.Debug_Flag_M then
Write_Line ("Maximum number of simultaneous compilations =" &
Saved_Maximum_Processes'Img);
end if;
-- Allocate as many temporary mapping file names as the maximum number -- Allocate as many temporary mapping file names as the maximum number
-- of compilations processed, for each possible project. -- of compilations processed, for each possible project.

41
gcc/ada/sem_ch6.adb
View File

@ -8569,7 +8569,6 @@ package body Sem_Ch6 is
-- Now set the kind (mode) of each formal -- Now set the kind (mode) of each formal
Param_Spec := First (T); Param_Spec := First (T);
while Present (Param_Spec) loop while Present (Param_Spec) loop
Formal := Defining_Identifier (Param_Spec); Formal := Defining_Identifier (Param_Spec);
Set_Formal_Mode (Formal); Set_Formal_Mode (Formal);
@ -8791,7 +8790,7 @@ package body Sem_Ch6 is
if Pragma_Name (Prag) = Name_Precondition if Pragma_Name (Prag) = Name_Precondition
and then Class_Present (Prag) and then Class_Present (Prag)
then then
Inherited_Precond := Grab_PPC; Inherited_Precond := Grab_PPC (Inherited (J));
-- No precondition so far, so establish this as the first -- No precondition so far, so establish this as the first
@ -8838,23 +8837,27 @@ package body Sem_Ch6 is
-- also failed inherited precondition from bla -- also failed inherited precondition from bla
-- ... -- ...
declare -- Skip this if exception locations are suppressed
New_Msg : constant Node_Id :=
Get_Pragma_Arg if not Exception_Locations_Suppressed then
(Last declare
(Pragma_Argument_Associations New_Msg : constant Node_Id :=
(Inherited_Precond))); Get_Pragma_Arg
Old_Msg : constant Node_Id := (Last
Get_Pragma_Arg (Pragma_Argument_Associations
(Last (Inherited_Precond)));
(Pragma_Argument_Associations Old_Msg : constant Node_Id :=
(Precond))); Get_Pragma_Arg
begin (Last
Start_String (Strval (Old_Msg)); (Pragma_Argument_Associations
Store_String_Chars (ASCII.LF & " also "); (Precond)));
Store_String_Chars (Strval (New_Msg)); begin
Set_Strval (Old_Msg, End_String); Start_String (Strval (Old_Msg));
end; Store_String_Chars (ASCII.LF & " also ");
Store_String_Chars (Strval (New_Msg));
Set_Strval (Old_Msg, End_String);
end;
end if;
end if; end if;
end if; end if;

14
gcc/ada/switch-m.adb
View File

@ -31,6 +31,8 @@ with Prj; use Prj;
with Prj.Env; use Prj.Env; with Prj.Env; use Prj.Env;
with Table; with Table;
with System.Multiprocessors; use System.Multiprocessors;
package body Switch.M is package body Switch.M is
package Normalized_Switches is new Table.Table package Normalized_Switches is new Table.Table
@ -751,14 +753,22 @@ package body Switch.M is
Ptr := Ptr + 1; Ptr := Ptr + 1;
declare declare
Max_Proc : Pos; Max_Proc : Nat;
begin begin
Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C); Scan_Nat (Switch_Chars, Max, Ptr, Max_Proc, C);
if Ptr <= Max then if Ptr <= Max then
Bad_Switch (Switch_Chars); Bad_Switch (Switch_Chars);
else else
if Max_Proc = 0 then
Max_Proc := Nat (Number_Of_CPUs);
if Max_Proc = 0 then
Max_Proc := 1;
end if;
end if;
Maximum_Processes := Positive (Max_Proc); Maximum_Processes := Positive (Max_Proc);
end if; end if;
end; end;