summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2016-04-20 09:22:59 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2016-04-20 09:22:59 +0000
commitacd4c1ed02193d95458699900f352becde5de342 (patch)
tree8dc786e9321efcb09b44d818d2d73acd1760555c
parentb2ff4e1fddca0b032ec844b1ad07db0df798e2ec (diff)
downloadgcc-acd4c1ed02193d95458699900f352becde5de342.tar.gz
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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@235249 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/ada/ChangeLog7
-rw-r--r--gcc/ada/sem_res.adb10
-rw-r--r--gcc/ada/sem_util.adb45
-rw-r--r--gcc/ada/sem_util.ads8
4 files changed, 63 insertions, 7 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bb725367941..186e332963d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index e8495c79eef..23ce8279b3f 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -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 =>
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index d0479cf3188..a808c02db59 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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 --
-------------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 4575077fead..84a436ceb78 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -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.