Commit de6cad7c by Arnaud Charlet

[multiple changes]

2012-12-05  Ed Schonberg  <schonberg@adacore.com>

	* par-ch6.adb (P_Return_Object_Declaration): Do not check for
	legality of Aliased keyword.
	* sem_ch6.adb (Analyze_Function_Return): The keyword aliased is
	legal in an extended return statement only if the return type
	is immutably limited.

2012-12-05  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Expand_Interface_Thunk): Simplify
	management of controlling formals.  Required to avoid problems
	with primitives of internally generated base types associated
	with constrained tagged types.

From-SVN: r194201
parent ac2b960f
2012-12-05 Ed Schonberg <schonberg@adacore.com> 2012-12-05 Ed Schonberg <schonberg@adacore.com>
* par-ch6.adb (P_Return_Object_Declaration): Do not check for
legality of Aliased keyword.
* sem_ch6.adb (Analyze_Function_Return): The keyword aliased is
legal in an extended return statement only if the return type
is immutably limited.
2012-12-05 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Expand_Interface_Thunk): Simplify
management of controlling formals. Required to avoid problems
with primitives of internally generated base types associated
with constrained tagged types.
2012-12-05 Ed Schonberg <schonberg@adacore.com>
* sem_eval.adb: Remove spurious warnings. * sem_eval.adb: Remove spurious warnings.
2012-12-05 Ed Schonberg <schonberg@adacore.com> 2012-12-05 Ed Schonberg <schonberg@adacore.com>
......
...@@ -1635,7 +1635,6 @@ package body Exp_Disp is ...@@ -1635,7 +1635,6 @@ package body Exp_Disp is
Formals : constant List_Id := New_List; Formals : constant List_Id := New_List;
Target : constant Entity_Id := Ultimate_Alias (Prim); Target : constant Entity_Id := Ultimate_Alias (Prim);
Controlling_Typ : Entity_Id;
Decl_1 : Node_Id; Decl_1 : Node_Id;
Decl_2 : Node_Id; Decl_2 : Node_Id;
Expr : Node_Id; Expr : Node_Id;
...@@ -1713,8 +1712,6 @@ package body Exp_Disp is ...@@ -1713,8 +1712,6 @@ package body Exp_Disp is
Next_Formal (Formal); Next_Formal (Formal);
end loop; end loop;
Controlling_Typ := Find_Dispatching_Type (Target);
Target_Formal := First_Formal (Target); Target_Formal := First_Formal (Target);
Formal := First (Formals); Formal := First (Formals);
while Present (Formal) loop while Present (Formal) loop
...@@ -1741,7 +1738,7 @@ package body Exp_Disp is ...@@ -1741,7 +1738,7 @@ package body Exp_Disp is
if Ekind (Target_Formal) = E_In_Parameter if Ekind (Target_Formal) = E_In_Parameter
and then Ekind (Etype (Target_Formal)) = E_Anonymous_Access_Type and then Ekind (Etype (Target_Formal)) = E_Anonymous_Access_Type
and then Ftyp = Controlling_Typ and then Is_Controlling_Formal (Target_Formal)
then then
-- Generate: -- Generate:
-- type T is access all <<type of the target formal>> -- type T is access all <<type of the target formal>>
...@@ -1799,7 +1796,7 @@ package body Exp_Disp is ...@@ -1799,7 +1796,7 @@ package body Exp_Disp is
(Defining_Identifier (Decl_2), (Defining_Identifier (Decl_2),
New_Reference_To (Defining_Identifier (Decl_1), Loc))); New_Reference_To (Defining_Identifier (Decl_1), Loc)));
elsif Ftyp = Controlling_Typ then elsif Is_Controlling_Formal (Target_Formal) then
-- Generate: -- Generate:
-- S1 : Storage_Offset := Storage_Offset!(Formal'Address) -- S1 : Storage_Offset := Storage_Offset!(Formal'Address)
......
...@@ -1721,13 +1721,8 @@ package body Ch6 is ...@@ -1721,13 +1721,8 @@ package body Ch6 is
Scan; -- past ALIASED Scan; -- past ALIASED
Set_Aliased_Present (Decl_Node); Set_Aliased_Present (Decl_Node);
if Ada_Version < Ada_2012 then -- The restrictions on the use of aliased in an extended return
Error_Msg_SC -- CODEFIX -- are semantic, not syntactic.
("ALIASED not allowed in extended return in Ada 2012?");
else
Error_Msg_SC -- CODEFIX
("ALIASED not allowed in extended return");
end if;
if Token = Tok_Constant then if Token = Tok_Constant then
Scan; -- past CONSTANT Scan; -- past CONSTANT
......
...@@ -787,6 +787,7 @@ package body Sem_Ch6 is ...@@ -787,6 +787,7 @@ package body Sem_Ch6 is
Analyze_And_Resolve (Expr, R_Type); Analyze_And_Resolve (Expr, R_Type);
Check_Limited_Return (Expr); Check_Limited_Return (Expr);
end if; end if;
-- RETURN only allowed in SPARK as the last statement in function -- RETURN only allowed in SPARK as the last statement in function
...@@ -808,6 +809,7 @@ package body Sem_Ch6 is ...@@ -808,6 +809,7 @@ package body Sem_Ch6 is
declare declare
Obj_Decl : constant Node_Id := Obj_Decl : constant Node_Id :=
Last (Return_Object_Declarations (N)); Last (Return_Object_Declarations (N));
Has_Aliased : constant Boolean := Aliased_Present (Obj_Decl);
HSS : constant Node_Id := Handled_Statement_Sequence (N); HSS : constant Node_Id := Handled_Statement_Sequence (N);
...@@ -842,6 +844,19 @@ package body Sem_Ch6 is ...@@ -842,6 +844,19 @@ package body Sem_Ch6 is
Set_Referenced (Defining_Identifier (Obj_Decl)); Set_Referenced (Defining_Identifier (Obj_Decl));
Check_References (Stm_Entity); Check_References (Stm_Entity);
-- Check RM 6.5 (5.9/3)
if Has_Aliased then
if Ada_Version < Ada_2012 then
Error_Msg_N ("aliased only allowed for limited"
& " return objects in Ada 2012?", N);
elsif not Is_Immutably_Limited_Type (R_Type) then
Error_Msg_N ("aliased only allowed for limited"
& " return objects", N);
end if;
end if;
end; end;
end if; end if;
......
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