sem_res.adb (Rewrite_Renamed_Operator): Do not rewrite the renamed operator when the associated node appears within a...

2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Rewrite_Renamed_Operator): Do not rewrite the
	renamed operator when the associated node appears within a
	pre/postcondition.
	* sem_util.ads, sem_util.adb (In_Pre_Post_Condition): New routine.

From-SVN: r235249
This commit is contained in:
Hristian Kirtchev 2016-04-20 09:22:59 +00:00 committed by Arnaud Charlet
parent 9a476d752d
commit d566e90a16
4 changed files with 63 additions and 7 deletions

View File

@ -1,3 +1,10 @@
2016-04-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_res.adb (Rewrite_Renamed_Operator): Do not rewrite the
renamed operator when the associated node appears within a
pre/postcondition.
* sem_util.ads, sem_util.adb (In_Pre_Post_Condition): New routine.
2016-04-20 Yannick Moy <moy@adacore.com>
* osint.adb (Relocate_Path): Fix test when Path is shorter than Prefix.

View File

@ -11122,8 +11122,10 @@ package body Sem_Res is
-- Do not perform this transformation within a pre/postcondition,
-- because the expression will be re-analyzed, and the transformation
-- might affect the visibility of the operator, e.g. in an instance.
-- Note that fully analyzed and expanded pre/postconditions appear as
-- pragma Check equivalents.
if In_Assertion_Expr > 0 then
if In_Pre_Post_Condition (N) then
return;
end if;
@ -11145,7 +11147,7 @@ package body Sem_Res is
Generate_Reference (Op, N);
if Is_Binary then
Set_Left_Opnd (Op_Node, Left_Opnd (N));
Set_Left_Opnd (Op_Node, Left_Opnd (N));
end if;
Rewrite (N, Op_Node);
@ -11154,9 +11156,7 @@ package body Sem_Res is
-- that the operator is applied to the full view. This is done in the
-- routines that resolve intrinsic operators.
if Is_Intrinsic_Subprogram (Op)
and then Is_Private_Type (Typ)
then
if Is_Intrinsic_Subprogram (Op) and then Is_Private_Type (Typ) then
case Nkind (N) is
when N_Op_Add | N_Op_Subtract | N_Op_Multiply | N_Op_Divide |
N_Op_Expon | N_Op_Mod | N_Op_Rem =>

View File

@ -10474,6 +10474,51 @@ package body Sem_Util is
end loop;
end In_Pragma_Expression;
---------------------------
-- In_Pre_Post_Condition --
---------------------------
function In_Pre_Post_Condition (N : Node_Id) return Boolean is
Par : Node_Id;
Prag : Node_Id := Empty;
Prag_Id : Pragma_Id;
begin
-- Climb the parent chain looking for an enclosing pragma
Par := N;
while Present (Par) loop
if Nkind (Par) = N_Pragma then
Prag := Par;
exit;
-- Prevent the search from going too far
elsif Is_Body_Or_Package_Declaration (Par) then
exit;
end if;
Par := Parent (Par);
end loop;
if Present (Prag) then
Prag_Id := Get_Pragma_Id (Prag);
return
Prag_Id = Pragma_Post
or else Prag_Id = Pragma_Post_Class
or else Prag_Id = Pragma_Postcondition
or else Prag_Id = Pragma_Pre
or else Prag_Id = Pragma_Pre_Class
or else Prag_Id = Pragma_Precondition;
-- Otherwise the node is not enclosed by a pre/postcondition pragma
else
return False;
end if;
end In_Pre_Post_Condition;
-------------------------------------
-- In_Reverse_Storage_Order_Object --
-------------------------------------

View File

@ -1152,8 +1152,8 @@ package Sem_Util is
-- Returns true if the Typ_Ent implements interface Iface_Ent
function In_Assertion_Expression_Pragma (N : Node_Id) return Boolean;
-- Determine whether an arbitrary node appears in a pragma that acts as an
-- assertion expression. See Sem_Prag for the list of qualifying pragmas.
-- Returns True if node N appears within a pragma that acts as an assertion
-- expression. See Sem_Prag for the list of qualifying pragmas.
function In_Instance return Boolean;
-- Returns True if the current scope is within a generic instance
@ -1179,6 +1179,10 @@ package Sem_Util is
function In_Pragma_Expression (N : Node_Id; Nam : Name_Id) return Boolean;
-- Returns true if the expression N occurs within a pragma with name Nam
function In_Pre_Post_Condition (N : Node_Id) return Boolean;
-- Returns True if node N appears within a pre/postcondition pragma. Note
-- the pragma Check equivalents are NOT considered.
function In_Reverse_Storage_Order_Object (N : Node_Id) return Boolean;
-- Returns True if N denotes a component or subcomponent in a record or
-- array that has Reverse_Storage_Order.