diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2016-04-20 09:22:59 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2016-04-20 09:22:59 +0000 |
commit | acd4c1ed02193d95458699900f352becde5de342 (patch) | |
tree | 8dc786e9321efcb09b44d818d2d73acd1760555c | |
parent | b2ff4e1fddca0b032ec844b1ad07db0df798e2ec (diff) | |
download | gcc-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/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 10 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 45 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 8 |
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. |