From: Ed Schonberg <schonberg@adacore.com>
Date: Tue, 20 Oct 2015 12:16:37 +0000 (+0000)
Subject: sem_ch13.adb (Analyze_One_Aspect, [...]): If expander is not active...
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=58ef3d309c306a09b552c035c0aa31c788eb1a3e;p=gcc.git

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 3461bd86259..5ee17ba0c63 100644
--- 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 7b5e1b84a15..f3fd5f42154 100644
--- 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 46fbbe406fb..149c7798bcf 100644
--- 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);