Merge from trunk revision 104c05c5284b7822d770ee51a7d91946c7e56d50.

1 files changed, 160 insertions, 183 deletions

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index b5275a8..9e337f9 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1999-2020, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2021, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -23,31 +23,35 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Atree;    use Atree;
-with Debug;    use Debug;
-with Einfo;    use Einfo;
-with Errout;   use Errout;
-with Exp_Code; use Exp_Code;
-with Lib;      use Lib;
-with Lib.Xref; use Lib.Xref;
-with Namet;    use Namet;
-with Nlists;   use Nlists;
-with Opt;      use Opt;
-with Par_SCO;  use Par_SCO;
-with Rtsfind;  use Rtsfind;
-with Sem;      use Sem;
-with Sem_Ch8;  use Sem_Ch8;
-with Sem_Aux;  use Sem_Aux;
-with Sem_Eval; use Sem_Eval;
-with Sem_Prag; use Sem_Prag;
-with Sem_Util; use Sem_Util;
-with Sinfo;    use Sinfo;
-with Sinput;   use Sinput;
-with Snames;   use Snames;
-with Stand;    use Stand;
-with Stringt;  use Stringt;
-with Tbuild;   use Tbuild;
-with Uintp;    use Uintp;
+with Atree;          use Atree;
+with Debug;          use Debug;
+with Einfo;          use Einfo;
+with Einfo.Entities; use Einfo.Entities;
+with Einfo.Utils;    use Einfo.Utils;
+with Errout;         use Errout;
+with Exp_Code;       use Exp_Code;
+with Lib;            use Lib;
+with Lib.Xref;       use Lib.Xref;
+with Namet;          use Namet;
+with Nlists;         use Nlists;
+with Opt;            use Opt;
+with Par_SCO;        use Par_SCO;
+with Rtsfind;        use Rtsfind;
+with Sem;            use Sem;
+with Sem_Ch8;        use Sem_Ch8;
+with Sem_Aux;        use Sem_Aux;
+with Sem_Eval;       use Sem_Eval;
+with Sem_Prag;       use Sem_Prag;
+with Sem_Util;       use Sem_Util;
+with Sinfo;          use Sinfo;
+with Sinfo.Nodes;    use Sinfo.Nodes;
+with Sinfo.Utils;    use Sinfo.Utils;
+with Sinput;         use Sinput;
+with Snames;         use Snames;
+with Stand;          use Stand;
+with Stringt;        use Stringt;
+with Tbuild;         use Tbuild;
+with Uintp;          use Uintp;
 
 package body Sem_Warn is
 
@@ -1176,7 +1180,8 @@ package body Sem_Warn is
                --  Case of an unassigned variable
 
                --  First gather any Unset_Reference indication for E1. In the
-               --  case of a parameter, it is the Spec_Entity that is relevant.
+               --  case of an 'out' parameter, it is the Spec_Entity that is
+               --  relevant.
 
                if Ekind (E1) = E_Out_Parameter
                  and then Present (Spec_Entity (E1))
@@ -1215,8 +1220,8 @@ package body Sem_Warn is
                --  the wanted effect is included in Never_Set_In_Source.
 
                elsif Warn_On_Constant
-                 and then (Ekind (E1) = E_Variable
-                            and then Has_Initial_Value (E1))
+                 and then Ekind (E1) = E_Variable
+                 and then Has_Initial_Value (E1)
                  and then Never_Set_In_Source_Check_Spec (E1)
                  and then not Generic_Package_Spec_Entity (E1)
                then
@@ -1294,9 +1299,9 @@ package body Sem_Warn is
                  --  never referenced, since again it seems odd to rely on
                  --  default initialization to set an out parameter value.
 
-                and then (Is_Access_Type (E1T)
-                           or else Ekind (E1) = E_Out_Parameter
-                           or else not Is_Fully_Initialized_Type (E1T))
+                 and then (Is_Access_Type (E1T)
+                             or else Ekind (E1) = E_Out_Parameter
+                             or else not Is_Fully_Initialized_Type (E1T))
                then
                   --  Do not output complaint about never being assigned a
                   --  value if a pragma Unmodified applies to the variable
@@ -1350,9 +1355,11 @@ package body Sem_Warn is
                      --  Suppress warning if composite type contains any access
                      --  component, since the logical effect of modifying a
                      --  parameter may be achieved by modifying a referenced
-                     --  object.
+                     --  object. This rationale does not apply to private
+                     --  types, so we warn in that case.
 
                      elsif Is_Composite_Type (E1T)
+                       and then not Is_Private_Type (E1T)
                        and then Has_Access_Values (E1T)
                      then
                         null;
@@ -1523,6 +1530,17 @@ package body Sem_Warn is
                         --  uninitialized component to get a better message.
 
                      elsif Nkind (Parent (UR)) = N_Selected_Component then
+                        --  Suppress possibly superfluous warning if component
+                        --  is known to exist and is partially initialized.
+
+                        if not Has_Discriminants (Etype (E1))
+                          and then
+                            Is_Partially_Initialized_Type
+                              (Etype (Parent (UR)), False)
+                        then
+                           goto Continue;
+                        end if;
+
                         Error_Msg_Node_2 := Selector_Name (Parent (UR));
 
                         if not Comes_From_Source (Parent (UR)) then
@@ -2297,7 +2315,7 @@ package body Sem_Warn is
 
          procedure Check_Inner_Package (Pack : Entity_Id) is
             E  : Entity_Id;
-            Un : constant Node_Id := Sinfo.Unit (Cnode);
+            Un : constant Node_Id := Sinfo.Nodes.Unit (Cnode);
 
             function Check_Use_Clause (N : Node_Id) return Traverse_Result;
             --  If N is a use_clause for Pack, emit warning
@@ -3015,7 +3033,7 @@ package body Sem_Warn is
       --  if we have seen the address of the subprogram being taken, or if the
       --  subprogram is used as a generic actual (in the latter cases the
       --  context may force use of IN OUT, even if the parameter is not
-      --  modifies for this particular case.
+      --  modified for this particular case.
 
       -----------------------
       -- No_Warn_On_In_Out --
@@ -3075,7 +3093,7 @@ package body Sem_Warn is
             --  Here we generate the warning
 
             else
-               --  If -gnatwk is set then output message that we could be IN
+               --  If -gnatwk is set then output message that it could be IN
 
                if not Is_Trivial_Subprogram (Scope (E1)) then
                   if Warn_On_Constant then
@@ -3651,6 +3669,9 @@ package body Sem_Warn is
    ---------------------------------
 
    procedure Warn_On_Overlapping_Actuals (Subp : Entity_Id; N : Node_Id) is
+      function Explicitly_By_Reference (Formal_Id : Entity_Id) return Boolean;
+      --  Returns True iff the type of Formal_Id is explicitly by-reference
+
       function Refer_Same_Object
         (Act1 : Node_Id;
          Act2 : Node_Id) return Boolean;
@@ -3662,6 +3683,24 @@ package body Sem_Warn is
       --  object_name is known to refer to the same object as the other name
       --  (RM 6.4.1(6.11/3))
 
+      -----------------------------
+      -- Explicitly_By_Reference --
+      -----------------------------
+
+      function Explicitly_By_Reference
+        (Formal_Id : Entity_Id)
+         return Boolean
+      is
+         Typ : constant Entity_Id := Underlying_Type (Etype (Formal_Id));
+      begin
+         if Present (Typ) then
+            return Is_By_Reference_Type (Typ)
+              or else Convention (Typ) = Convention_Ada_Pass_By_Reference;
+         else
+            return False;
+         end if;
+      end Explicitly_By_Reference;
+
       -----------------------
       -- Refer_Same_Object --
       -----------------------
@@ -3678,24 +3717,22 @@ 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;
 
    --  Start of processing for Warn_On_Overlapping_Actuals
 
    begin
+      --  Exclude calls rewritten as enumeration literals
 
-      if Ada_Version < Ada_2012 and then not Warn_On_Overlap then
+      if Nkind (N) not in N_Subprogram_Call | N_Entry_Call_Statement then
          return;
-      end if;
 
-      --  Exclude calls rewritten as enumeration literals
+      --  Guard against previous errors
 
-      if Nkind (N) not in N_Subprogram_Call
-        and then Nkind (N) /= N_Entry_Call_Statement
-      then
+      elsif Error_Posted (N) then
          return;
       end if;
 
@@ -3726,175 +3763,115 @@ package body Sem_Warn is
       Form1 := First_Formal (Subp);
       Act1  := First_Actual (N);
       while Present (Form1) and then Present (Act1) loop
-         if Is_Generic_Type (Etype (Act1)) then
-            return;
-         end if;
-
-         --  One of the formals must be either (in)-out or composite.
-         --  The other must be (in)-out.
-
-         if Is_Elementary_Type (Etype (Act1))
-           and then Ekind (Form1) = E_In_Parameter
-         then
-            null;
-
-         else
-            Form2 := Next_Formal (Form1);
-            Act2  := Next_Actual (Act1);
-            while Present (Form2) and then Present (Act2) loop
-               if Refer_Same_Object (Act1, Act2) then
-                  if Is_Generic_Type (Etype (Act2)) then
-                     return;
-                  end if;
 
-                  --  First case : two writable elementary parameters
-                  --  that overlap.
+         Form2 := Next_Formal (Form1);
+         Act2  := Next_Actual (Act1);
+         while Present (Form2) and then Present (Act2) 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)
+            --  Ignore formals of generic types; they will be examined when
+            --  instantiated.
 
-                  --  Second case : two composite parameters that overlap,
-                  --  one of which is writable.
+            if Is_Generic_Type (Etype (Form1))
+              or else Is_Generic_Type (Etype (Form2))
+            then
+               null;
 
-                    or else (Is_Composite_Type (Etype (Form1))
-                     and then Is_Composite_Type (Etype (Form2))
-                     and then (Ekind (Form1) /= E_In_Parameter
-                       or else Ekind (Form2) /= E_In_Parameter))
+            elsif Refer_Same_Object (Act1, Act2) then
 
-                  --  Third case : an elementary writable parameter that
-                  --  overlaps a composite one.
+               --  Case 1: two writable elementary parameters that overlap
 
-                    or else (Is_Elementary_Type (Etype (Form1))
-                     and then Ekind (Form1) /= E_In_Parameter
-                     and then Is_Composite_Type (Etype (Form2)))
+               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)
 
-                   or else (Is_Elementary_Type (Etype (Form2))
-                     and then Ekind (Form2) /= E_In_Parameter
-                     and then Is_Composite_Type (Etype (Form1)))
-                  then
+               --  Case 2: two composite parameters that overlap, one of
+               --  which is writable.
 
-                  --  Guard against previous errors
+                 or else (Is_Composite_Type (Etype (Form1))
+                  and then Is_Composite_Type (Etype (Form2))
+                  and then (Ekind (Form1) /= E_In_Parameter
+                    or else Ekind (Form2) /= E_In_Parameter))
 
-                     if Error_Posted (N)
-                       or else No (Etype (Act1))
-                       or else No (Etype (Act2))
-                     then
-                        null;
+               --  Case 3: an elementary writable parameter that overlaps
+               --  a composite one.
 
-                     --  If the actual is a function call in prefix notation,
-                     --  there is no real overlap.
+                 or else (Is_Elementary_Type (Etype (Form1))
+                  and then Ekind (Form1) /= E_In_Parameter
+                  and then Is_Composite_Type (Etype (Form2)))
 
-                     elsif Nkind (Act2) = N_Function_Call then
-                        null;
-
-                     --  If type is explicitly not by-copy, assume that
-                     --  aliasing is intended.
-
-                     elsif
-                       Present (Underlying_Type (Etype (Form1)))
-                         and then
-                           (Is_By_Reference_Type
-                             (Underlying_Type (Etype (Form1)))
-                             or else
-                               Convention (Underlying_Type (Etype (Form1))) =
-                                            Convention_Ada_Pass_By_Reference)
-                     then
-                        null;
-
-                     --  Under Ada 2012 we only report warnings on overlapping
-                     --  arrays and record types if switch is set.
-
-                     elsif Ada_Version >= Ada_2012
-                       and then not Is_Elementary_Type (Etype (Form1))
-                       and then not Warn_On_Overlap
-                     then
-                        null;
+                or else (Is_Elementary_Type (Etype (Form2))
+                  and then Ekind (Form2) /= E_In_Parameter
+                  and then Is_Composite_Type (Etype (Form1)))
+               then
 
-                     --  Here we may need to issue overlap message
+                  --  Guard against previous errors
 
-                     else
-                        Error_Msg_Warn :=
+                  if No (Etype (Act1))
+                    or else No (Etype (Act2))
+                  then
+                     null;
 
-                          --  Overlap checking is an error only in Ada 2012.
-                          --  For earlier versions of Ada, this is a warning.
+                  --  If type is explicitly by-reference, then it is not
+                  --  covered by the legality rule, which only applies to
+                  --  elementary types. Actually, the aliasing is most
+                  --  likely intended, so don't emit a warning either.
 
-                          Ada_Version < Ada_2012
+                  elsif Explicitly_By_Reference (Form1)
+                    or else Explicitly_By_Reference (Form2)
+                  then
+                     null;
 
-                          --  Overlap is only illegal in Ada 2012 in the case
-                          --  of elementary types (passed by copy). For other
-                          --  types we always have a warning in all versions.
-                          --  This is clarified by AI12-0216.
+                  --  We only report warnings on overlapping arrays and record
+                  --  types if switch is set.
 
-                          or else not
-                           (Is_Elementary_Type (Etype (Form1))
-                            and then Is_Elementary_Type (Etype (Form2)))
+                  elsif not Warn_On_Overlap
+                    and then not (Is_Elementary_Type (Etype (Form1))
+                                    and then
+                                  Is_Elementary_Type (Etype (Form2)))
+                  then
+                     null;
 
-                          --  debug flag -gnatd.E changes the error to a
-                          --  warning even in Ada 2012 mode.
+                  --  Here we may need to issue overlap message
 
-                          or else Error_To_Warning;
+                  else
+                     Error_Msg_Warn :=
 
-                        if Is_Elementary_Type (Etype (Act1))
-                          and then Ekind (Form2) = E_In_Parameter
-                        then
-                           null;  --  No real aliasing
+                       --  Overlap checking is an error only in Ada 2012. For
+                       --  earlier versions of Ada, this is a warning.
 
-                        elsif Is_Elementary_Type (Etype (Act2))
-                          and then Ekind (Form2) = E_In_Parameter
-                        then
-                           null;  --  Ditto
+                       Ada_Version < Ada_2012
 
-                        --  If the call was written in prefix notation, and
-                        --  thus its prefix before rewriting was a selected
-                        --  component, count only visible actuals in call.
+                       --  Overlap is only illegal since Ada 2012 and only for
+                       --  elementary types (passed by copy). For other types
+                       --  we always have a warning in all versions. This is
+                       --  clarified by AI12-0216.
 
-                        elsif Is_Entity_Name (First_Actual (N))
-                          and then Nkind (Original_Node (N)) = Nkind (N)
-                          and then Nkind (Name (Original_Node (N))) =
-                                                        N_Selected_Component
-                          and then
-                            Is_Entity_Name (Prefix (Name (Original_Node (N))))
-                          and then
-                            Entity (Prefix (Name (Original_Node (N)))) =
-                              Entity (First_Actual (N))
-                        then
-                           if Act1 = First_Actual (N) then
-                              Error_Msg_FE
-                                ("<I<`IN OUT` prefix overlaps with "
-                                 & "actual for&", Act1, Form2);
+                       or else not
+                        (Is_Elementary_Type (Etype (Form1))
+                         and then Is_Elementary_Type (Etype (Form2)))
 
-                           else
-                              --  For greater clarity, give name of formal
+                       --  debug flag -gnatd.E changes the error to a warning
+                       --  even in Ada 2012 mode.
 
-                              Error_Msg_Node_2 := Form2;
-                              Error_Msg_FE
-                                ("<I<writable actual for & overlaps with "
-                                 & "actual for&", Act1, Form2);
-                           end if;
+                       or else Error_To_Warning;
 
-                        else
-                           --  For greater clarity, give name of formal
+                     --  For greater clarity, give name of formal
 
-                           Error_Msg_Node_2 := Form2;
+                     Error_Msg_Node_2 := Form2;
 
-                           --  This is one of the messages
+                     --  This is one of the messages
 
-                           Error_Msg_FE
-                             ("<I<writable actual for & overlaps with "
-                              & "actual for&", Act1, Form1);
-                        end if;
-                     end if;
+                     Error_Msg_FE
+                       ("<I<writable actual for & overlaps with actual for &",
+                        Act1, Form1);
                   end if;
-
-                  return;
                end if;
+            end if;
 
-               Next_Formal (Form2);
-               Next_Actual (Act2);
-            end loop;
-         end if;
+            Next_Formal (Form2);
+            Next_Actual (Act2);
+         end loop;
 
          Next_Formal (Form1);
          Next_Actual (Act1);