diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 22 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 203 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 41 | ||||
| -rw-r--r-- | gcc/ada/switch-m.adb | 14 |
6 files changed, 162 insertions, 125 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1cada03..7e6bc3a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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> * gcc-interface/Make-lang.in (ada/misc.o): Use $(OPTIONS_H) diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 4abd1f5..a92542f 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -198,7 +198,7 @@ package body Debug is -- dj -- dk -- dl - -- dm + -- dm Display the number of maximum simultaneous compilations -- dn Do not delete temp files created by gnatmake -- do -- dp Prints the contents of the Q used by Make.Compile_Sources diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 372c38b..f7404c5 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -319,6 +319,42 @@ procedure GNATCmd is Status : Integer; 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 -- Check if there is at least one argument that is not a switch or if -- there is a -files= switch. @@ -363,11 +399,13 @@ procedure GNATCmd is if Add_Sources then -- 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 The_Command = Pretty or else - The_Command = Metric + The_Command = Metric or else + The_Command = Stack then Tempdir.Create_Temp_File (FD, Temp_File_Name); Last_Switches.Increment_Last; @@ -377,7 +415,6 @@ procedure GNATCmd is declare Proj : Project_List; - File : String_Access; begin -- Gnatstack needs to add the .ci file for the binder generated @@ -396,40 +433,33 @@ procedure GNATCmd is Main := Proj.Project.Mains; while Main /= Nil_String loop - File := - new String' - (Get_Name_String - (Proj.Project.Object_Directory.Name) & - B_Start.all & - MLib.Fil.Ext_To - (Get_Name_String - (Project_Tree.String_Elements.Table - (Main).Value), - "ci")); + Add_To_Response_File + (Get_Name_String + (Proj.Project.Object_Directory.Name) & + B_Start.all & + MLib.Fil.Ext_To + (Get_Name_String + (Project_Tree.String_Elements.Table + (Main).Value), + "ci")); -- When looking for the .ci file for a binder -- 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 (File.all) + if not Is_Regular_File (Name_Buffer (1 .. Name_Len)) and then B_Start.all /= "b__" then - File := - new String' - (Get_Name_String - (Proj.Project.Object_Directory.Name) & - "b__" & - MLib.Fil.Ext_To - (Get_Name_String - (Project_Tree.String_Elements.Table - (Main).Value), - "ci")); - end if; - - if Is_Regular_File (File.all) then - Last_Switches.Increment_Last; - Last_Switches.Table (Last_Switches.Last) := File; + Add_To_Response_File + (Get_Name_String + (Proj.Project.Object_Directory.Name) & + "b__" & + MLib.Fil.Ext_To + (Get_Name_String + (Project_Tree.String_Elements.Table + (Main).Value), + "ci")); end if; Main := @@ -442,30 +472,27 @@ procedure GNATCmd is -- files that contains the initialization and -- finalization of the library. - File := - new String' - (Get_Name_String - (Proj.Project.Object_Directory.Name) & - B_Start.all & - Get_Name_String (Proj.Project.Library_Name) & - ".ci"); + Add_To_Response_File + (Get_Name_String + (Proj.Project.Object_Directory.Name) & + B_Start.all & + Get_Name_String (Proj.Project.Library_Name) & + ".ci"); - if not Is_Regular_File (File.all) and then - B_Start.all /= "b__" - then - File := - new String' - (Get_Name_String - (Proj.Project.Object_Directory.Name) & - "b__" & - Get_Name_String - (Proj.Project.Library_Name) & - ".ci"); - end if; + -- When looking for the .ci file for a binder + -- generated file, look for both b~xxx and b__xxx + -- as gprbuild always uses b__ as the prefix of + -- such files. - if Is_Regular_File (File.all) then - Last_Switches.Increment_Last; - Last_Switches.Table (Last_Switches.Last) := File; + if not Is_Regular_File (Name_Buffer (1 .. Name_Len)) + and then B_Start.all /= "b__" + then + Add_To_Response_File + (Get_Name_String + (Proj.Project.Object_Directory.Name) & + "b__" & + Get_Name_String (Proj.Project.Library_Name) & + ".ci"); end if; end if; end; @@ -574,20 +601,14 @@ procedure GNATCmd is end if; if not Subunit then - File := - new String' - (Get_Name_String - (Unit.File_Names - (Impl).Project. Object_Directory.Name) & - MLib.Fil.Ext_To - (Get_Name_String - (Unit.File_Names (Impl).Display_File), - "ci")); - - if Is_Regular_File (File.all) then - Last_Switches.Increment_Last; - Last_Switches.Table (Last_Switches.Last) := File; - end if; + Add_To_Response_File + (Get_Name_String + (Unit.File_Names + (Impl).Project. Object_Directory.Name) & + MLib.Fil.Ext_To + (Get_Name_String + (Unit.File_Names (Impl).Display_File), + "ci")); end if; end if; @@ -599,20 +620,14 @@ procedure GNATCmd is if Check_Project (Unit.File_Names (Spec).Project, Project) then - File := - new String' - (Get_Name_String - (Unit.File_Names - (Spec).Project. Object_Directory.Name) & - Dir_Separator & - MLib.Fil.Ext_To - (Get_Name_String (Unit.File_Names (Spec).File), - "ci")); - - if Is_Regular_File (File.all) then - Last_Switches.Increment_Last; - Last_Switches.Table (Last_Switches.Last) := File; - end if; + Add_To_Response_File + (Get_Name_String + (Unit.File_Names + (Spec).Project. Object_Directory.Name) & + Dir_Separator & + MLib.Fil.Ext_To + (Get_Name_String (Unit.File_Names (Spec).File), + "ci")); end if; end if; @@ -627,30 +642,12 @@ procedure GNATCmd is (Unit.File_Names (Kind).Project, Project) and then not Unit.File_Names (Kind).Locally_Removed then - Name_Len := 0; - Add_Char_To_Name_Buffer ('"'); - Add_Str_To_Name_Buffer - (Get_Name_String - (Unit.File_Names (Kind).Path.Display_Name)); - Add_Char_To_Name_Buffer ('"'); - - 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; + Add_To_Response_File + ("""" & + Get_Name_String + (Unit.File_Names (Kind).Path.Display_Name) & + """", + Check_File => False); end if; end loop; end if; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 4f09513..9835164 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -5321,6 +5321,11 @@ package body Make is Saved_Maximum_Processes := Maximum_Processes; 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 -- of compilations processed, for each possible project. diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index befcb16..b3a906e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -8569,7 +8569,6 @@ package body Sem_Ch6 is -- Now set the kind (mode) of each formal Param_Spec := First (T); - while Present (Param_Spec) loop Formal := Defining_Identifier (Param_Spec); Set_Formal_Mode (Formal); @@ -8791,7 +8790,7 @@ package body Sem_Ch6 is if Pragma_Name (Prag) = Name_Precondition and then Class_Present (Prag) then - Inherited_Precond := Grab_PPC; + Inherited_Precond := Grab_PPC (Inherited (J)); -- 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 -- ... - declare - New_Msg : constant Node_Id := - Get_Pragma_Arg - (Last - (Pragma_Argument_Associations - (Inherited_Precond))); - Old_Msg : constant Node_Id := - Get_Pragma_Arg - (Last - (Pragma_Argument_Associations - (Precond))); - begin - Start_String (Strval (Old_Msg)); - Store_String_Chars (ASCII.LF & " also "); - Store_String_Chars (Strval (New_Msg)); - Set_Strval (Old_Msg, End_String); - end; + -- Skip this if exception locations are suppressed + + if not Exception_Locations_Suppressed then + declare + New_Msg : constant Node_Id := + Get_Pragma_Arg + (Last + (Pragma_Argument_Associations + (Inherited_Precond))); + Old_Msg : constant Node_Id := + Get_Pragma_Arg + (Last + (Pragma_Argument_Associations + (Precond))); + begin + Start_String (Strval (Old_Msg)); + 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; diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb index ce2f7452..9576d52 100644 --- a/gcc/ada/switch-m.adb +++ b/gcc/ada/switch-m.adb @@ -31,6 +31,8 @@ with Prj; use Prj; with Prj.Env; use Prj.Env; with Table; +with System.Multiprocessors; use System.Multiprocessors; + package body Switch.M is package Normalized_Switches is new Table.Table @@ -751,14 +753,22 @@ package body Switch.M is Ptr := Ptr + 1; declare - Max_Proc : Pos; + Max_Proc : Nat; begin - Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C); + Scan_Nat (Switch_Chars, Max, Ptr, Max_Proc, C); if Ptr <= Max then Bad_Switch (Switch_Chars); 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); end if; end; |