===================================================================
@@ -10474,6 +10474,51 @@
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 --
-------------------------------------
===================================================================
@@ -1152,8 +1152,8 @@
-- 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 @@
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.
===================================================================
@@ -11122,8 +11122,10 @@
-- 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 @@
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 @@
-- 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 =>
This patch ensures that intrinsic operators that act as generic actuals are properly resolved and rewritten in the instance when the context is a fully analyzed and expanded pre/postcondition. Prior to this change the rewriting guard was too restrictive and led to erroneous resolution. ------------ -- Source -- ------------ -- g.ads generic with function "<" (L, R : Integer) return Boolean; package G is function Foo (L, R : Integer) return Boolean is (L < R) with Post => Foo'Result = (L < R); end G; -- main.adb with G; procedure Main is package I is new G (">"); Result : constant Boolean := I.Foo (1, 2); begin null; end Main; Tested on x86_64-pc-linux-gnu, committed on trunk 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.