From 58ef3d309c306a09b552c035c0aa31c788eb1a3e Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Tue, 20 Oct 2015 12:16:37 +0000 Subject: [PATCH] sem_ch13.adb (Analyze_One_Aspect, [...]): If expander is not active... 2015-10-20 Ed Schonberg * 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 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/sem_ch13.adb | 6 +++++- gcc/ada/sem_prag.adb | 18 ++++++++++++++++-- 3 files changed, 31 insertions(+), 3 deletions(-) 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 + + * 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 * 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 '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); -- 2.30.2