[multiple changes]

2014-10-17  Vincent Celier  <celier@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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

3 files changed, 113 insertions, 126 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 45f4f31..7773970 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2014-10-17  Vincent Celier  <celier@adacore.com>
+
+	* 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  <schonberg@adacore.com>
+
+	* 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  <dewar@adacore.com>
 
 	* sem_ch3.adb, a-strsea.adb: Minor reformatting.
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index 095c2d1..56d116e 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 277b7ef..3b84679 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;