sem_ch13.adb (Analyze_One_Aspect, [...]): If expander is not active...

2015-10-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_One_Aspect, case
	Aspect_Disable_Controlled): If expander is not active, pre-analyze
	expression anyway for ASIS and other tools use.
	* sem_prag.adb (Build_Generic_Class_Condition): Handle properly
	anonymous access types in parameter specifications. Make the
	formal type a formal derived type of the controlling type of
	the subprogram.

From-SVN: r229064

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3461bd862591f8a595053202ca68941506604c3b..5ee17ba0c634f336b8cd74a8576b20f78e9183f4 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2015-10-20  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch13.adb (Analyze_One_Aspect, case
+       Aspect_Disable_Controlled): If expander is not active, pre-analyze
+       expression anyway for ASIS and other tools use.
+       * sem_prag.adb (Build_Generic_Class_Condition): Handle properly
+       anonymous access types in parameter specifications. Make the
+       formal type a formal derived type of the controlling type of
+       the subprogram.
+
 2015-10-20  Tristan Gingold  <gingold@adacore.com>
 
        * s-rident.ads: No_Task_At_Interrupt_Priority: New restriction.

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 7b5e1b84a151948eb98b8d95c12bbf9371fc1b00..f3fd5f42154ca13f87846713c82a1ef2dc2e9ffc 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -3273,7 +3273,8 @@ package body Sem_Ch13 is
                      --  to disable controlled types, because typical usage is
                      --  "Disable_Controlled => not <some_check>'Enabled", and
                      --  the value of Enabled is not known until we see a
-                     --  particular instance.
+                     --  particular instance. In such a context, we just need
+                     --  to preanalyze the expression for legality.
 
                      if Expander_Active then
                         Analyze_And_Resolve (Expr, Standard_Boolean);
@@ -3283,6 +3284,9 @@ package body Sem_Ch13 is
                         then
                            Set_Disable_Controlled (E);
                         end if;
+
+                     elsif Serious_Errors_Detected = 0 then
+                        Preanalyze_And_Resolve (Expr, Standard_Boolean);
                      end if;
 
                      goto Continue;

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 46fbbe406fbf05656840251da858038e1c126622..149c7798bcf17493196c6c3a7b712381a60fce06 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -25177,6 +25177,7 @@ package body Sem_Prag is
       New_Form : List_Id;
       New_Typ  : Entity_Id;
       Par_Typ  : Entity_Id;
+      Root_Typ : Entity_Id;
       Spec     : Node_Id;
 
    --  Start of processing for Build_Generic_Class_Pre
@@ -25207,6 +25208,8 @@ package body Sem_Prag is
          Append_Elmt (New_F, Map);
 
          if Is_Controlling_Formal (F) then
+            Root_Typ := Etype (F);
+
             if Is_Access_Type (Etype (F)) then
                New_Typ :=
                  Make_Defining_Identifier (Loc,
@@ -25241,10 +25244,19 @@ package body Sem_Prag is
                          New_Occurrence_Of (Etype (Etype (F)), Loc),
                        Attribute_Name => Name_Class)));
             else
+               --  If it is an anonymous access type, create a similar type
+               --  definition.
+
+               if Ekind (Etype (F)) = E_Anonymous_Access_Type then
+                  Par_Typ := New_Copy_Tree (Parameter_Type (Parent (F)));
+               else
+                  Par_Typ := New_Occurrence_Of (Etype (F), Loc);
+               end if;
+
                Append_To (New_Form,
                  Make_Parameter_Specification (Loc,
                    Defining_Identifier => New_F,
-                   Parameter_Type      => New_Occurrence_Of (Etype (F), Loc)));
+                   Parameter_Type      => Par_Typ));
             end if;
          end if;
 
@@ -25271,7 +25283,9 @@ package body Sem_Prag is
             Make_Formal_Type_Declaration (Loc,
               Defining_Identifier    => New_Typ,
               Formal_Type_Definition =>
-                Make_Formal_Private_Type_Definition (Loc))));
+                Make_Formal_Derived_Type_Definition (Loc,
+                  Subtype_Mark    => New_Occurrence_Of (Root_Typ, Loc),
+                  Private_Present => True))));
 
       Preanalyze (New_Expr);
       Map_Formals (New_Expr);