Commit 58ef3d30 by Ed Schonberg Committed by Arnaud Charlet

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
parent 6bf8c157
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.
......
......@@ -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;
......
......@@ -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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment