sem_res.adb (Rewrite_Renamed_Operator): Do not rewrite the renamed operator when...

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bb7253679417738eef3b340d7c22ddd19f930b90..186e332963d75e7c23306d95a1b39dd0b1cc5501 100644 (file)
--- 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 e8495c79eefa935d8c5fc25e4b789756f22f84ec..23ce8279b3f2e166c524ba9b85dff7ab5278750b 100644 (file)
--- 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 d0479cf318842cb0d96318e665d178c1873ef7d7..a808c02db59012ebc9718a56bcef520bc23069f3 100644 (file)
--- 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 4575077fead00bac55b23773fdfc35c3ebb5d9f8..84a436ceb78656b95ada640663e56b486c2b07e2 100644 (file)
--- 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.