[Ada] Incorrect discriminant check on call to access to subprogram

gcc/ada/

	* exp_ch6.adb: Fix typo in comment.
	* sem_ch3.adb (Access_Subprogram_Declaration): Add missing call
	to Create_Extra_Formals. Remove obsolete bootstrap check.
	* sem_eval.adb (Eval_Selected_Component): Simplify a
	selected_component on an aggregate.

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 2cd40e42f47a2a5a1355cfa63cbc48657d175d34..6b1465695d44714c6f359a96d346bd2757989e2d 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -3801,7 +3801,7 @@ package body Exp_Ch6 is
                   --  is internally generated code that manipulates addresses,
                   --  e.g. when building interface tables. No check should
                   --  occur in this case, and the discriminated object is not
-                  --  directly a hand.
+                  --  directly at hand.
 
                   if not Comes_From_Source (Actual)
                     and then Nkind (Actual) = N_Unchecked_Type_Conversion

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index d796c47454c2f44c29824a673f34dcd1fe02cbbd..41e1e4958fcc3449890a0640778e2c3b8e50dee7 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -840,13 +840,6 @@ package body Sem_Ch3 is
       --  the corresponding semantic routine
 
       if Present (Access_To_Subprogram_Definition (N)) then
-
-         --  Compiler runtime units are compiled in Ada 2005 mode when building
-         --  the runtime library but must also be compilable in Ada 95 mode
-         --  (when bootstrapping the compiler).
-
-         Check_Compiler_Unit ("anonymous access to subprogram", N);
-
          Access_Subprogram_Declaration
            (T_Name => Anon_Type,
             T_Def  => Access_To_Subprogram_Definition (N));
@@ -1312,6 +1305,8 @@ package body Sem_Ch3 is
       Set_Can_Never_Be_Null (T_Name, Null_Exclusion_Present (T_Def));
 
       Check_Restriction (No_Access_Subprograms, T_Def);
+
+      Create_Extra_Formals (Desig_Type);
    end Access_Subprogram_Declaration;
 
    ----------------------------

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 8d47589df73c10af47c3616e06644419d50f0e3a..263b9fdd530b13f54dca8b675c2a836a262640df 100644 (file)
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -3830,6 +3830,11 @@ package body Sem_Eval is
    -----------------------------
 
    procedure Eval_Selected_Component (N : Node_Id) is
+      Node : Node_Id;
+      Comp : Node_Id;
+      C    : Node_Id;
+      Nam  : Name_Id;
+
    begin
       --  If an attribute reference or a LHS, nothing to do.
       --  Also do not fold if N is an [in] out subprogram parameter.
@@ -3839,7 +3844,36 @@ package body Sem_Eval is
         and then Is_LHS (N) = No
         and then not Is_Actual_Out_Or_In_Out_Parameter (N)
       then
-         Fold (N);
+         --  Simplify a selected_component on an aggregate by extracting
+         --  the field directly.
+
+         Node := Prefix (N);
+
+         while Nkind (Node) = N_Qualified_Expression loop
+            Node := Expression (Node);
+         end loop;
+
+         if Nkind (Node) = N_Aggregate then
+            Comp := First (Component_Associations (Node));
+            Nam  := Chars (Selector_Name (N));
+
+            while Present (Comp) loop
+               C := First (Choices (Comp));
+
+               while Present (C) loop
+                  if Chars (C) = Nam then
+                     Rewrite (N, Relocate_Node (Expression (Comp)));
+                     return;
+                  end if;
+
+                  Next (C);
+               end loop;
+
+               Next (Comp);
+            end loop;
+         else
+            Fold (N);
+         end if;
       end if;
    end Eval_Selected_Component;