Commit 2604ec03 by Arnaud Charlet

[multiple changes]

2010-10-08  Thomas Quinot  <quinot@adacore.com>

	* sem_prag.adb: Minor reformatting.

2010-10-08  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Derived_Type_Declaration): In the private part of an
	instance, it is legal to derive from a non-limited actual when the
	formal type is untagged limited.
	* sem_ch12.adb (Instantiate_Type): For a formal private type, use
	analyzed formal as Generic_Parent_Type, to simplify later checks.

2010-10-08  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Insert_Default): If default value is already a
	raise_constraint_error do not rewrite it as new raise node, to prevent
	infinite loops in the warning removal machinery.

From-SVN: r165156
parent c86ee18a
2010-10-08 Thomas Quinot <quinot@adacore.com>
* sem_prag.adb: Minor reformatting.
2010-10-08 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Derived_Type_Declaration): In the private part of an
instance, it is legal to derive from a non-limited actual when the
formal type is untagged limited.
* sem_ch12.adb (Instantiate_Type): For a formal private type, use
analyzed formal as Generic_Parent_Type, to simplify later checks.
2010-10-08 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Insert_Default): If default value is already a
raise_constraint_error do not rewrite it as new raise node, to prevent
infinite loops in the warning removal machinery.
2010-10-08 Robert Dewar <dewar@adacore.com>
* sem_util.adb, sem_prag.adb: Minor reformatting
......
......@@ -10355,6 +10355,10 @@ package body Sem_Ch12 is
-- parent, but the analyzed formal that includes the interface
-- operations of all its progenitors.
-- Same treatment for formal private types, so we can check whether the
-- type is tagged limited when validating derivations in the private
-- part. (See AI05-096).
if Nkind (Def) = N_Formal_Derived_Type_Definition then
if Present (Interface_List (Def)) then
Set_Generic_Parent_Type (Decl_Node, A_Gen_T);
......@@ -10363,7 +10367,7 @@ package body Sem_Ch12 is
end if;
elsif Nkind (Def) = N_Formal_Private_Type_Definition then
Set_Generic_Parent_Type (Decl_Node, Ancestor);
Set_Generic_Parent_Type (Decl_Node, A_Gen_T);
end if;
-- If the actual is a synchronized type that implements an interface,
......
......@@ -13738,9 +13738,24 @@ package body Sem_Ch3 is
(not Is_Interface (Parent_Type)
or else not Is_Limited_Interface (Parent_Type))
then
Error_Msg_NE
("parent type& of limited type must be limited",
N, Parent_Type);
-- AI05-0096 : a derivation in the private part of an instance is
-- legal if the generic formal is untagged limited, and the actual
-- is non-limited.
if Is_Generic_Actual_Type (Parent_Type)
and then In_Private_Part (Current_Scope)
and then
not Is_Tagged_Type
(Generic_Parent_Type (Parent (Parent_Type)))
then
null;
else
Error_Msg_NE
("parent type& of limited type must be limited",
N, Parent_Type);
end if;
end if;
end if;
end Derived_Type_Declaration;
......
......@@ -8074,9 +8074,9 @@ package body Sem_Prag is
return;
end if;
-- Ada 2012 (AI05-0030): Cannot apply the Implementation_kind
-- "By_Protected_Procedure" to the primitive procedure of a
-- task interface.
-- Ada 2012 (AI05-0030): Cannot apply the implementation_kind
-- By_Protected_Procedure to the primitive procedure of a task
-- interface.
if Chars (Arg2) = Name_By_Protected_Procedure
and then Is_Interface (Typ)
......
......@@ -3120,8 +3120,12 @@ package body Sem_Res is
-- If the default expression raises constraint error, then just
-- silently replace it with an N_Raise_Constraint_Error node,
-- since we already gave the warning on the subprogram spec.
-- If node is already a Raise_Constraint_Error leave as is, to
-- prevent loops in the warnings removal machinery.
if Raises_Constraint_Error (Actval) then
if Raises_Constraint_Error (Actval)
and then Nkind (Actval) /= N_Raise_Constraint_Error
then
Rewrite (Actval,
Make_Raise_Constraint_Error (Loc,
Reason => CE_Range_Check_Failed));
......
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