From: Arnaud Charlet Date: Fri, 18 Jun 2010 13:01:07 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.6.0~6351 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=aaf31e160cbe50a70b0dfa71436e3ab1d9b75afd;p=thirdparty%2Fgcc.git [multiple changes] 2010-06-18 Pascal Obry * make.adb, prj-nmsc.adb: Fix source filenames casing in debug output. 2010-06-18 Vincent Celier * gnatcmd.adb: For gnatcheck, add -gnatec= switch for a global configuration pragmas file and, if -U is not used, for a local one. 2010-06-18 Ed Schonberg * sem_elim.adb (Check_Eliminated): Use full information on entity name when it is given in the pragma by a selected component. (Check_For_Eliminated_Subprogram): Do no emit error if within a instance body that is itself within a generic unit. * sem_ch12.adb (Analyze_Subprogram_Instance): If the subprogram is eliminated, mark as well the anonymous subprogram that is its alias and appears within the wrapper package. From-SVN: r160986 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f177911e9da8..27f345aeaaf9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2010-06-18 Pascal Obry + + * make.adb, prj-nmsc.adb: Fix source filenames casing in debug output. + +2010-06-18 Vincent Celier + + * gnatcmd.adb: For gnatcheck, add -gnatec= switch for a global + configuration pragmas file and, if -U is not used, for a local one. + +2010-06-18 Ed Schonberg + + * sem_elim.adb (Check_Eliminated): Use full information on entity name + when it is given in the pragma by a selected component. + (Check_For_Eliminated_Subprogram): Do no emit error if within a + instance body that is itself within a generic unit. + * sem_ch12.adb (Analyze_Subprogram_Instance): If the subprogram is + eliminated, mark as well the anonymous subprogram that is its alias + and appears within the wrapper package. + 2010-06-18 Bob Duff * g-pehage.ads, g-pehage.adb (Produce): Clean up some of the code. diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 57371aa7d174..793c6c9c92ca 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -122,6 +122,7 @@ procedure GNATCmd is Naming_String : constant SA := new String'("naming"); Binder_String : constant SA := new String'("binder"); + Builder_String : constant SA := new String'("builder"); Compiler_String : constant SA := new String'("compiler"); Check_String : constant SA := new String'("check"); Synchronize_String : constant SA := new String'("synchronize"); @@ -139,7 +140,8 @@ procedure GNATCmd is new String_List'((Naming_String, Binder_String)); Packages_To_Check_By_Check : constant String_List_Access := - new String_List'((Naming_String, Check_String, Compiler_String)); + new String_List' + ((Naming_String, Builder_String, Check_String, Compiler_String)); Packages_To_Check_By_Sync : constant String_List_Access := new String_List'((Naming_String, Synchronize_String, Compiler_String)); @@ -363,7 +365,7 @@ procedure GNATCmd is 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. if The_Command = Check or else @@ -2198,6 +2200,87 @@ begin Add_To_Carg_Switches (new String'("-gnatem=" & Get_Name_String (M_File))); end if; + + -- For gnatcheck, also indicate a global configuration pragmas + -- file and, if -U is not used, a local one. + + if The_Command = Check then + declare + Pkg : constant Prj.Package_Id := + Prj.Util.Value_Of + (Name => Name_Builder, + In_Packages => Project.Decl.Packages, + In_Tree => Project_Tree); + Variable : Variable_Value := + Prj.Util.Value_Of + (Name => No_Name, + Attribute_Or_Array_Name => + Name_Global_Configuration_Pragmas, + In_Package => Pkg, + In_Tree => Project_Tree); + + begin + if (Variable = Nil_Variable_Value or else + Length_Of_Name (Variable.Value) = 0) + and then Pkg /= No_Package + then + Variable := + Prj.Util.Value_Of + (Name => Name_Ada, + Attribute_Or_Array_Name => Name_Global_Config_File, + In_Package => Pkg, + In_Tree => Project_Tree); + end if; + + if Variable /= Nil_Variable_Value and then + Length_Of_Name (Variable.Value) /= 0 + then + Add_To_Carg_Switches + (new String' + ("-gnatec=" & Get_Name_String (Variable.Value))); + end if; + end; + + if not All_Projects then + declare + Pkg : constant Prj.Package_Id := + Prj.Util.Value_Of + (Name => Name_Compiler, + In_Packages => Project.Decl.Packages, + In_Tree => Project_Tree); + Variable : Variable_Value := + Prj.Util.Value_Of + (Name => No_Name, + Attribute_Or_Array_Name => + Name_Local_Configuration_Pragmas, + In_Package => Pkg, + In_Tree => Project_Tree); + + begin + if (Variable = Nil_Variable_Value or else + Length_Of_Name (Variable.Value) = 0) + and then Pkg /= No_Package + then + Variable := + Prj.Util.Value_Of + (Name => Name_Ada, + Attribute_Or_Array_Name => + Name_Local_Config_File, + In_Package => Pkg, + In_Tree => Project_Tree); + end if; + + if Variable /= Nil_Variable_Value and then + Length_Of_Name (Variable.Value) /= 0 + then + Add_To_Carg_Switches + (new String' + ("-gnatec=" & + Get_Name_String (Variable.Value))); + end if; + end; + end if; + end if; end; end if; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 3af872f29f02..bd67136acf0c 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1395,7 +1395,7 @@ package body Make is if Project_Of_Current_Object_Directory /= Project then Project_Of_Current_Object_Directory := Project; - Object_Directory := Project.Object_Directory.Name; + Object_Directory := Project.Object_Directory.Display_Name; -- Set the working directory to the object directory of the actual -- project. @@ -6078,7 +6078,7 @@ package body Make is exception when others => - -- Delete the temporary mapping file, if one was created. + -- Delete the temporary mapping file, if one was created if Mapping_Path /= No_Path then Delete_Temporary_File (Project_Tree, Mapping_Path); diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 0e8c041b9b95..df0cf822615e 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -703,7 +703,7 @@ package body Prj.Nmsc is if Current_Verbosity = High then Write_Str ("Adding source File: "); - Write_Str (Get_Name_String (File_Name)); + Write_Str (Get_Name_String (Display_File)); if Index /= 0 then Write_Str (" at" & Index'Img); @@ -813,8 +813,8 @@ package body Prj.Nmsc is ----------- procedure Check - (Project : Project_Id; - Data : in out Tree_Processing_Data) + (Project : Project_Id; + Data : in out Tree_Processing_Data) is Specs : Array_Element_Id; Bodies : Array_Element_Id; @@ -4883,7 +4883,7 @@ package body Prj.Nmsc is if not Removed and then List = Nil_String then if Current_Verbosity = High then Write_Str (" Adding Source Dir="); - Write_Line (Get_Name_String (Path_Id)); + Write_Line (Get_Name_String (Display_Path_Id)); end if; String_Element_Table.Increment_Last (Data.Tree.String_Elements); @@ -6845,7 +6845,9 @@ package body Prj.Nmsc is begin if Current_Verbosity = High then - Write_Attr ("Source_Dir", Source_Directory); + Write_Attr + ("Source_Dir", + Source_Directory (Source_Directory'First .. Dir_Last)); Write_Line (Num_Nod.Number'Img); end if; @@ -7382,7 +7384,7 @@ package body Prj.Nmsc is while Current /= Nil_String loop Element := In_Tree.String_Elements.Table (Current); Write_Str (" "); - Write_Line (Get_Name_String (Element.Value)); + Write_Line (Get_Name_String (Element.Display_Value)); Current := Element.Next; end loop; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 4c98f39f2074..cfb08c8f0ef7 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -4005,11 +4005,14 @@ package body Sem_Ch12 is -- If the instance is a child unit, mark the Id accordingly. Mark -- the anonymous entity as well, which is the real subprogram and -- which is used when the instance appears in a context clause. + -- Similarly, propagate the Is_Eliminated flag to handle properly + -- nested eliminated subprograms. Set_Is_Child_Unit (Act_Decl_Id, Is_Child_Unit (Defining_Entity (N))); Set_Is_Child_Unit (Anon_Id, Is_Child_Unit (Defining_Entity (N))); New_Overloaded_Entity (Act_Decl_Id); Check_Eliminated (Act_Decl_Id); + Set_Is_Eliminated (Anon_Id, Is_Eliminated (Act_Decl_Id)); -- In compilation unit case, kill elaboration checks on the -- instantiation, since they are never needed -- the body is diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb index bb42159b99ea..9917b1f35118 100644 --- a/gcc/ada/sem_elim.adb +++ b/gcc/ada/sem_elim.adb @@ -29,6 +29,7 @@ with Errout; use Errout; with Lib; use Lib; with Namet; use Namet; with Nlists; use Nlists; +with Opt; use Opt; with Sem; use Sem; with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; @@ -287,7 +288,8 @@ package body Sem_Elim is goto Continue; end if; - -- Find enclosing unit + -- Find enclosing unit, and verify that its name and those of its + -- parents match. Scop := Cunit_Entity (Current_Sem_Unit); @@ -329,9 +331,6 @@ package body Sem_Elim is end if; Scop := Scope (Scop); - while Ekind (Scop) = E_Block loop - Scop := Scope (Scop); - end loop; if Scop /= Standard_Standard and then J = 1 then goto Continue; @@ -342,8 +341,60 @@ package body Sem_Elim is goto Continue; end if; - -- Check for case of given entity is a library level subprogram - -- and we have the single parameter Eliminate case, a match! + if Present (Elmt.Entity_Node) + and then Elmt.Entity_Scope /= null + then + + -- Check that names of enclosing scopes match. + -- Skip blocks and wrapper package of subprogram instances, + -- which do not appear in the pragma. + + Scop := Scope (E); + + for J in reverse Elmt.Entity_Scope'Range loop + while Ekind (Scop) = E_Block + or else + (Ekind (Scop) = E_Package + and then Is_Wrapper_Package (Scop)) + loop + Scop := Scope (Scop); + end loop; + + if Elmt.Entity_Scope (J) /= Chars (Scop) then + if Ekind (Scop) /= E_Protected_Type + or else Comes_From_Source (Scop) + then + goto Continue; + + -- For simple protected declarations, retrieve the source + -- name of the object, which appeared in the Eliminate + -- pragma. + + else + declare + Decl : constant Node_Id := + Original_Node (Parent (Scop)); + + begin + if Elmt.Entity_Scope (J) /= + Chars (Defining_Identifier (Decl)) + then + if J > 0 then + null; + end if; + goto Continue; + end if; + end; + end if; + + end if; + + Scop := Scope (Scop); + end loop; + end if; + + -- If given entity is a library level subprogram and pragma had a + -- single parameter, a match! if Is_Compilation_Unit (E) and then Is_Subprogram (E) @@ -672,7 +723,15 @@ package body Sem_Elim is Enclosing_Subp := Enclosing_Subprogram (Enclosing_Subp); end loop; - Eliminate_Error_Msg (N, Ultimate_Subp); + -- Emit error, unless we are within an instance body and + -- the expander is disabled, which indicates an instance + -- within an enclosing generic. + + if In_Instance_Body and then not Expander_Active then + null; + else + Eliminate_Error_Msg (N, Ultimate_Subp); + end if; end if; end Check_For_Eliminated_Subprogram;