From: Arnaud Charlet Date: Fri, 17 Oct 2014 08:49:10 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c3ed5e9eaf279c24b3fb69bf261f4abef67aad04;p=gcc.git [multiple changes] 2014-10-17 Vincent Celier * prj-conf.adb (Get_Config_Switches): In CodePeer mode, do not take into account any compiler command from package IDE. 2014-10-17 Ed Schonberg * sem_ch12.adb (Build_Function_Wrapper): The formals of the wrapper must have the same identifiers as those of the formal subprogram, because calls within the generic may use named associations. From-SVN: r216376 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 45f4f31f798..7773970e4c7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2014-10-17 Vincent Celier + + * prj-conf.adb (Get_Config_Switches): In CodePeer mode, do + not take into account any compiler command from package IDE. + +2014-10-17 Ed Schonberg + + * sem_ch12.adb (Build_Function_Wrapper): The formals of the + wrapper must have the same identifiers as those of the formal + subprogram, because calls within the generic may use named + associations. + 2014-10-17 Robert Dewar * sem_ch3.adb, a-strsea.adb: Minor reformatting. diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 095c2d1c020..56d116ec75b 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -172,7 +172,7 @@ package body Prj.Conf is begin if Config_File = Empty_Node then - -- Create a dummy config file is none was found + -- Create a dummy config file if none was found Name_Len := Auto_Cgpr'Length; Name_Buffer (1 .. Name_Len) := Auto_Cgpr; @@ -587,7 +587,7 @@ package body Prj.Conf is or else (Tgt_Name /= No_Name and then (Length_Of_Name (Tgt_Name) = 0 - or else Target = Get_Name_String (Tgt_Name))); + or else Target = Get_Name_String (Tgt_Name))); if not OK then if Autoconf_Specified then @@ -980,7 +980,7 @@ package body Prj.Conf is end if; -- Get the config switches. This should be done only now, as some - -- runtimes may have been found if the Builder switches. + -- runtimes may have been found in the Builder switches. Config_Switches := Get_Config_Switches; @@ -1082,12 +1082,11 @@ package body Prj.Conf is Write_Eol; elsif not Quiet_Output then + -- Display no message if we are creating auto.cgpr, unless in - -- verbose mode + -- verbose mode. - if Config_File_Name'Length > 0 - or else Verbose_Mode - then + if Config_File_Name'Length > 0 or else Verbose_Mode then Write_Str ("creating "); Write_Str (Simple_Name (Args (3).all)); Write_Eol; @@ -1300,11 +1299,14 @@ package body Prj.Conf is Config_Command : constant String := "--config=" & Get_Name_String (Name); - Runtime_Name : constant String := - Runtime_Name_For (Name); + Runtime_Name : constant String := Runtime_Name_For (Name); begin - if Variable = Nil_Variable_Value + -- In CodePeer mode, we do not take into account any compiler + -- command from the package IDE. + + if CodePeer_Mode + or else Variable = Nil_Variable_Value or else Length_Of_Name (Variable.Value) = 0 then Result (Count) := @@ -1321,14 +1323,14 @@ package body Prj.Conf is if Is_Absolute_Path (Compiler_Command) then Result (Count) := new String' - (Config_Command & ",," & Runtime_Name & "," & - Containing_Directory (Compiler_Command) & "," & - Simple_Name (Compiler_Command)); + (Config_Command & ",," & Runtime_Name & "," + & Containing_Directory (Compiler_Command) & "," + & Simple_Name (Compiler_Command)); else Result (Count) := new String' - (Config_Command & ",," & Runtime_Name & ",," & - Compiler_Command); + (Config_Command & ",," & Runtime_Name & ",," + & Compiler_Command); end if; end; end if; @@ -1350,20 +1352,14 @@ package body Prj.Conf is begin Variable := - Value_Of - (Name_Source_Dirs, - Project.Decl.Attributes, - Shared); + Value_Of (Name_Source_Dirs, Project.Decl.Attributes, Shared); if Variable = Nil_Variable_Value or else Variable.Default or else Variable.Values /= Nil_String then Variable := - Value_Of - (Name_Source_Files, - Project.Decl.Attributes, - Shared); + Value_Of (Name_Source_Files, Project.Decl.Attributes, Shared); return Variable = Nil_Variable_Value or else Variable.Default or else Variable.Values /= Nil_String; @@ -1373,9 +1369,13 @@ package body Prj.Conf is end if; end Might_Have_Sources; + -- Local Variables + Success : Boolean; Config_Project_Node : Project_Node_Id := Empty_Node; + -- Start of processing for Get_Or_Create_Configuration_File + begin pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path)); @@ -1472,9 +1472,7 @@ package body Prj.Conf is On_New_Tree_Loaded => null); end if; - if Config_Project_Node = Empty_Node - or else Config = No_Project - then + if Config_Project_Node = Empty_Node or else Config = No_Project then Raise_Invalid_Config ("processing of configuration project """ & Config_File_Path.all & """ failed"); @@ -1606,7 +1604,6 @@ package body Prj.Conf is Implicit_Project => Implicit_Project); if User_Project_Node = Empty_Node then - User_Project_Node := Empty_Node; return; end if; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 277b7eff469..3b84679534a 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1032,11 +1032,11 @@ package body Sem_Ch12 is Decl : Node_Id; Func_Name : Node_Id; Func : Entity_Id; - N_Parms : Natural; Parm_Type : Node_Id; Profile : List_Id := New_List; Spec : Node_Id; - F : Entity_Id; + Act_F : Entity_Id; + Form_F : Entity_Id; New_F : Entity_Id; begin @@ -1057,19 +1057,20 @@ package body Sem_Ch12 is Profile := New_List; if Present (Actual) then - F := First_Formal (Entity (Actual)); + Act_F := First_Formal (Entity (Actual)); else - F := First_Formal (Formal); + Act_F := Empty; end if; - N_Parms := 0; - while Present (F) loop + Form_F := First_Formal (Formal); + while Present (Form_F) loop -- Create new formal for profile of wrapper, and add a reference - -- to it in the list of actuals for the enclosing call. + -- to it in the list of actuals for the enclosing call. The name + -- must be that of the formal in the formal subprogram, because + -- calls to it in the generic body may use named associations. - New_F := Make_Temporary - (Loc, Character'Val (Character'Pos ('A') + N_Parms)); + New_F := Make_Defining_Identifier (Loc, Chars (Form_F)); if No (Actual) then @@ -1077,32 +1078,35 @@ package body Sem_Ch12 is -- attribute, because the class-wide type is not retrievable by -- visbility. - if Is_Class_Wide_Type (Etype (F)) then + if Is_Class_Wide_Type (Etype (Form_F)) then Parm_Type := Make_Attribute_Reference (Loc, Attribute_Name => Name_Class, Prefix => - Make_Identifier (Loc, Chars (Etype (Etype (F))))); + Make_Identifier (Loc, Chars (Etype (Etype (Form_F))))); else Parm_Type := - Make_Identifier (Loc, Chars (Etype (Etype (F)))); + Make_Identifier (Loc, Chars (Etype (Etype (Form_F)))); end if; -- If actual is present, use the type of its own formal else - Parm_Type := New_Occurrence_Of (Etype (F), Loc); + Parm_Type := New_Occurrence_Of (Etype (Act_F), Loc); end if; Append_To (Profile, Make_Parameter_Specification (Loc, - Defining_Identifier => New_F, - Parameter_Type => Parm_Type)); + Defining_Identifier => New_F, + Parameter_Type => Parm_Type)); Append_To (Actuals, New_Occurrence_Of (New_F, Loc)); - Next_Formal (F); - N_Parms := N_Parms + 1; + Next_Formal (Form_F); + + if Present (Act_F) then + Next_Formal (Act_F); + end if; end loop; Spec := @@ -1111,6 +1115,7 @@ package body Sem_Ch12 is Parameter_Specifications => Profile, Result_Definition => Make_Identifier (Loc, Chars (Etype (Formal)))); + Decl := Make_Expression_Function (Loc, Specification => Spec, @@ -2465,11 +2470,8 @@ package body Sem_Ch12 is Set_Ekind (Id, K); Set_Etype (Id, T); - if (Is_Array_Type (T) - and then not Is_Constrained (T)) - or else - (Ekind (T) = E_Record_Type - and then Has_Discriminants (T)) + if (Is_Array_Type (T) and then not Is_Constrained (T)) + or else (Ekind (T) = E_Record_Type and then Has_Discriminants (T)) then declare Non_Freezing_Ref : constant Node_Id := @@ -4036,17 +4038,17 @@ package body Sem_Ch12 is Needs_Body := (Unit_Requires_Body (Gen_Unit) - or else Enclosing_Body_Present - or else Present (Corresponding_Body (Gen_Decl))) - and then (Is_In_Main_Unit (N) or else Might_Inline_Subp) - and then not Is_Actual_Pack - and then not Inline_Now - and then (Operating_Mode = Generate_Code + or else Enclosing_Body_Present + or else Present (Corresponding_Body (Gen_Decl))) + and then (Is_In_Main_Unit (N) or else Might_Inline_Subp) + and then not Is_Actual_Pack + and then not Inline_Now + and then (Operating_Mode = Generate_Code - -- Need comment for this check ??? + -- Need comment for this check ??? - or else (Operating_Mode = Check_Semantics - and then (ASIS_Mode or GNATprove_Mode))); + or else (Operating_Mode = Check_Semantics + and then (ASIS_Mode or GNATprove_Mode))); -- If front_end_inlining is enabled, do not instantiate body if -- within a generic context. @@ -4452,14 +4454,13 @@ package body Sem_Ch12 is exit when Scope_Stack.Last - Num_Scopes + 1 = Scope_Stack.First or else Scope_Stack.Table - (Scope_Stack.Last - Num_Scopes).Entity - = Scope (S); + (Scope_Stack.Last - Num_Scopes).Entity = Scope (S); end loop; exit when Is_Generic_Instance (S) and then (In_Package_Body (S) - or else Ekind (S) = E_Procedure - or else Ekind (S) = E_Function); + or else Ekind (S) = E_Procedure + or else Ekind (S) = E_Function); S := Scope (S); end loop; @@ -4498,8 +4499,7 @@ package body Sem_Ch12 is loop if Is_Generic_Instance (S) and then (In_Package_Body (S) - or else Ekind (S) = E_Procedure - or else Ekind (S) = E_Function) + or else Ekind_In (S, E_Procedure, E_Function)) then -- We still have to remove the entities of the enclosing -- instance from direct visibility. @@ -4559,6 +4559,7 @@ package body Sem_Ch12 is S := Scope (S); end loop; + pragma Assert (Num_Inner < Num_Scopes); Push_Scope (Standard_Standard); @@ -4668,8 +4669,7 @@ package body Sem_Ch12 is Set_Is_Generic_Instance (Inst, True); if In_Package_Body (Inst) - or else Ekind (S) = E_Procedure - or else Ekind (S) = E_Function + or else Ekind_In (S, E_Procedure, E_Function) then E := First_Entity (Instances (J)); while Present (E) loop @@ -5042,9 +5042,8 @@ package body Sem_Ch12 is -- If renaming, get original unit if Present (Renamed_Object (Gen_Unit)) - and then (Ekind (Renamed_Object (Gen_Unit)) = E_Generic_Procedure - or else - Ekind (Renamed_Object (Gen_Unit)) = E_Generic_Function) + and then Ekind_In (Renamed_Object (Gen_Unit), E_Generic_Procedure, + E_Generic_Function) then Gen_Unit := Renamed_Object (Gen_Unit); Set_Is_Instantiated (Gen_Unit); @@ -5998,9 +5997,7 @@ package body Sem_Ch12 is -- If the formal package is declared with a box, or if the formal -- parameter is defaulted, it is visible in the body. - elsif Is_Formal_Box - or else Is_Visible_Formal (E) - then + elsif Is_Formal_Box or else Is_Visible_Formal (E) then Set_Is_Hidden (E, False); end if; @@ -6284,7 +6281,7 @@ package body Sem_Ch12 is if Is_Child_Unit (E) and then not Comes_From_Source (Entity (Prefix (Gen_Id))) and then (not In_Instance - or else Nkind (Parent (Parent (Gen_Id))) = + or else Nkind (Parent (Parent (Gen_Id))) = N_Compilation_Unit) then Error_Msg_N @@ -10031,15 +10028,13 @@ package body Sem_Ch12 is -- access type. if Ada_Version < Ada_2005 - or else - Ekind (Base_Type (Ftyp)) /= - E_Anonymous_Access_Type - or else - Ekind (Base_Type (Etype (Actual))) /= - E_Anonymous_Access_Type + or else Ekind (Base_Type (Ftyp)) /= + E_Anonymous_Access_Type + or else Ekind (Base_Type (Etype (Actual))) /= + E_Anonymous_Access_Type then - Error_Msg_NE ("type of actual does not match type of&", - Actual, Gen_Obj); + Error_Msg_NE + ("type of actual does not match type of&", Actual, Gen_Obj); end if; end if; @@ -10048,19 +10043,16 @@ package body Sem_Ch12 is -- Check for instantiation of atomic/volatile actual for -- non-atomic/volatile formal (RM C.6 (12)). - if Is_Atomic_Object (Actual) - and then not Is_Atomic (Orig_Ftyp) - then + if Is_Atomic_Object (Actual) and then not Is_Atomic (Orig_Ftyp) then Error_Msg_N - ("cannot instantiate non-atomic formal object " & - "with atomic actual", Actual); + ("cannot instantiate non-atomic formal object " + & "with atomic actual", Actual); - elsif Is_Volatile_Object (Actual) - and then not Is_Volatile (Orig_Ftyp) + elsif Is_Volatile_Object (Actual) and then not Is_Volatile (Orig_Ftyp) then Error_Msg_N - ("cannot instantiate non-volatile formal object " & - "with volatile actual", Actual); + ("cannot instantiate non-volatile formal object " + & "with volatile actual", Actual); end if; -- Formal in-parameter @@ -11257,9 +11249,10 @@ package body Sem_Ch12 is if Subtypes_Match (Component_Type (A_Gen_T), Component_Type (Act_T)) - or else Subtypes_Match - (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T), - Component_Type (Act_T)) + or else + Subtypes_Match + (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T), + Component_Type (Act_T)) then null; else @@ -11514,12 +11507,10 @@ package body Sem_Ch12 is elsif Is_Constrained (Act_T) then if Ekind (Ancestor) = E_Access_Type - or else - (not Is_Constrained (A_Gen_T) - and then Is_Composite_Type (A_Gen_T)) + or else (not Is_Constrained (A_Gen_T) + and then Is_Composite_Type (A_Gen_T)) then - Error_Msg_N - ("actual subtype must be unconstrained", Actual); + Error_Msg_N ("actual subtype must be unconstrained", Actual); Abandon_Instantiation (Actual); end if; @@ -11958,14 +11949,11 @@ package body Sem_Ch12 is Actual, Gen_T); elsif Is_Limited_Type (Act_T) /= Is_Limited_Type (A_Gen_T) - or else - Is_Task_Interface (A_Gen_T) /= Is_Task_Interface (Act_T) - or else - Is_Protected_Interface (A_Gen_T) /= - Is_Protected_Interface (Act_T) - or else - Is_Synchronized_Interface (A_Gen_T) /= - Is_Synchronized_Interface (Act_T) + or else Is_Task_Interface (A_Gen_T) /= Is_Task_Interface (Act_T) + or else Is_Protected_Interface (A_Gen_T) /= + Is_Protected_Interface (Act_T) + or else Is_Synchronized_Interface (A_Gen_T) /= + Is_Synchronized_Interface (Act_T) then Error_Msg_NE ("actual for interface& does not match (RM 12.5.5(4))", @@ -12041,15 +12029,13 @@ package body Sem_Ch12 is if Is_Unchecked_Union (Base_Type (Act_T)) then if not Has_Discriminants (A_Gen_T) - or else - (Is_Derived_Type (A_Gen_T) - and then - Is_Unchecked_Union (A_Gen_T)) + or else (Is_Derived_Type (A_Gen_T) + and then Is_Unchecked_Union (A_Gen_T)) then null; else - Error_Msg_N ("unchecked union cannot be the actual for a" & - " discriminated formal type", Act_T); + Error_Msg_N ("unchecked union cannot be the actual for a " + & "discriminated formal type", Act_T); end if; end if; @@ -12068,8 +12054,7 @@ package body Sem_Ch12 is if Ekind (Act_T) = E_Incomplete_Type or else (Is_Class_Wide_Type (Act_T) - and then - Ekind (Root_Type (Act_T)) = E_Incomplete_Type) + and then Ekind (Root_Type (Act_T)) = E_Incomplete_Type) then -- If the formal is an incomplete type, the actual can be -- incomplete as well. @@ -12452,7 +12437,7 @@ package body Sem_Ch12 is if not In_Same_Source_Unit (N, Spec) or else Nkind (Unit (Comp_Unit)) = N_Package_Declaration or else (Nkind (Unit (Comp_Unit)) = N_Package_Body - and then not Is_In_Main_Unit (Spec)) + and then not Is_In_Main_Unit (Spec)) then -- Find body of parent of spec, and analyze it. A special case arises -- when the parent is an instantiation, that is to say when we are @@ -13622,7 +13607,7 @@ package body Sem_Ch12 is elsif Nkind (N) = N_Op_Concat and then Is_Generic_Type (Etype (N2)) and then (Base_Type (Etype (Right_Opnd (N2))) = Etype (N2) - or else + or else Base_Type (Etype (Left_Opnd (N2))) = Etype (N2)) and then Is_Intrinsic_Subprogram (E) then @@ -13915,9 +13900,7 @@ package body Sem_Ch12 is end if; elsif D in List_Range then - if D = Union_Id (No_List) - or else Is_Empty_List (List_Id (D)) - then + if D = Union_Id (No_List) or else Is_Empty_List (List_Id (D)) then null; else @@ -14169,10 +14152,7 @@ package body Sem_Ch12 is end if; end if; - if No (N2) - or else No (Typ) - or else not Is_Global (Typ) - then + if No (N2) or else No (Typ) or else not Is_Global (Typ) then Set_Associated_Node (N, Empty); -- If the aggregate is an actual in a call, it has been @@ -14438,9 +14418,7 @@ package body Sem_Ch12 is OK : Boolean; begin - if No (T) - or else T = Any_Id - then + if No (T) or else T = Any_Id then return; end if;