From 3c0ae05d9edbf9f3c28e6458c41ec32a77337e38 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 6 Sep 2017 12:19:44 +0200 Subject: [PATCH] [multiple changes] 2017-09-06 Ed Schonberg * sem_warn.adb (Warn_On_Overlapping_Actuals): Refine previous fix and preserve older GNAT warning on overlapping actuals that are not elementary types. 2017-09-06 Justin Squirek * sem_attr.adb: Comment correction. From-SVN: r251771 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/sem_attr.adb | 3 ++- gcc/ada/sem_warn.adb | 49 +++++++++++++++++++++++++++++++++++-------------- 3 files changed, 47 insertions(+), 15 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a8264d6..5e6d0af 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2017-09-06 Ed Schonberg + + * sem_warn.adb (Warn_On_Overlapping_Actuals): Refine previous + fix and preserve older GNAT warning on overlapping actuals that + are not elementary types. + +2017-09-06 Justin Squirek + + * sem_attr.adb: Comment correction. + 2017-09-06 Gary Dismukes * sem_util.adb: Minor reformatting. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 87dc50f..436c359 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -364,7 +364,8 @@ package body Sem_Attr is -- Check that P is an object reference procedure Check_Object_Reference_Image (Str_Typ : Entity_Id); - -- Verify that the prefix of an image attribute.... ??? + -- Verify that the prefix of an image attribute is an object reference + -- and set the Etype of the prefix to that specified by Str_Typ. procedure Check_PolyORB_Attribute; -- Validity checking for PolyORB/DSA attribute diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index c181072..962e919 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -3608,10 +3608,14 @@ package body Sem_Warn is -- Local variables - Act1 : Node_Id; - Act2 : Node_Id; - Form1 : Entity_Id; - Form2 : Entity_Id; + Act1 : Node_Id; + Act2 : Node_Id; + Form1 : Entity_Id; + Form2 : Entity_Id; + Warn_Only : Boolean; + -- GNAT warns on overlapping in-out parameters even when there + -- sre no two in-out parameters of an elementary type, as stated in + -- RM 6.5.1 (17/2). -- Start of processing for Warn_On_Overlapping_Actuals @@ -3621,6 +3625,29 @@ package body Sem_Warn is return; end if; + -- The call is illegal only if there are at least two in-out + -- parameters of the same elementary type. + + Warn_Only := True; + Form1 := First_Formal (Subp); + while Present (Form1) loop + Form2 := Next_Formal (Form1); + while Present (Form2) loop + if Is_Elementary_Type (Etype (Form1)) + and then Is_Elementary_Type (Etype (Form2)) + and then Ekind (Form1) /= E_In_Parameter + and then Ekind (Form2) /= E_In_Parameter + then + Warn_Only := False; + exit; + end if; + + Next_Formal (Form2); + end loop; + + Next_Formal (Form1); + end loop; + -- Exclude calls rewritten as enumeration literals if Nkind (N) not in N_Subprogram_Call @@ -3684,14 +3711,6 @@ package body Sem_Warn is then null; - -- If the types of the formals are different there can - -- be no aliasing (even though there might be overlap - -- through address clauses, which must be intentional). - - elsif Base_Type (Etype (Form1)) /= Base_Type (Etype (Form2)) - then - null; - -- Here we may need to issue overlap message else @@ -3708,10 +3727,12 @@ package body Sem_Warn is or else not Is_Elementary_Type (Etype (Form1)) - -- Finally, debug flag -gnatd.E changes the error to a + -- debug flag -gnatd.E changes the error to a -- warning even in Ada 2012 mode. - or else Error_To_Warning; + or else Error_To_Warning + + or else Warn_Only; declare Act : Node_Id; -- 2.7.4