Merge branch 'master' into devel/sphinx

6 files changed, 147 insertions, 68 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index db4ac0d..be8371d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2022-09-29  Ronan Desplanques  <desplanques@adacore.com>
+
+	* einfo.ads: remove documentation duplicate
+
+2022-09-29  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* contracts.adb (Build_Subprogram_Contract_Wrapper): Put back the
+	extended return statement if the result type is built-in-place.
+	* sem_attr.adb (Analyze_Attribute_Old_Result): Also expect an
+	extended return statement.
+
+2022-09-29  Bob Duff  <duff@adacore.com>
+
+	* exp_ch5.adb
+	(Expand_Assign_Array_Loop_Or_Bitfield): Make the checks for
+	volatile and independent objects more precise.
+
+2022-09-29  Piotr Trojanek  <trojanek@adacore.com>
+
+	* sem_util.adb (Collect_Visible_States): Ignore package renamings.
+
 2022-09-26  Ghjuvan Lacambre  <lacambre@adacore.com>
 
 	* doc/gnat_rm/implementation_defined_attributes.rst: Rename Valid_Image.
diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index dd573d3..a300d73 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -30,6 +30,7 @@ with Einfo.Entities; use Einfo.Entities;
 with Einfo.Utils;    use Einfo.Utils;
 with Elists;         use Elists;
 with Errout;         use Errout;
+with Exp_Ch6;        use Exp_Ch6;
 with Exp_Prag;       use Exp_Prag;
 with Exp_Tss;        use Exp_Tss;
 with Exp_Util;       use Exp_Util;
@@ -1609,7 +1610,7 @@ package body Contracts is
       --  preserving the result for the purpose of evaluating postconditions,
       --  contracts, type invariants, etc.
 
-      --  In the case of a function, generate:
+      --  In the case of a regular function, generate:
       --
       --  function Original_Func (X : in out Integer) return Typ is
       --     <prologue renamings>
@@ -1641,7 +1642,27 @@ package body Contracts is
       --  Note that an extended return statement does not yield the same result
       --  because the copy of the return object is not elided by GNAT for now.
 
-      --  Or, in the case of a procedure:
+      --  Or else, in the case of a BIP function, generate:
+
+      --  function Original_Func (X : in out Integer) return Typ is
+      --     <prologue renamings>
+      --     <preconditions>
+      --
+      --     function _Wrapped_Statements return Typ is
+      --        <original declarations>
+      --     begin
+      --        <original statements>
+      --     end;
+      --
+      --  begin
+      --     return
+      --        Result_Obj : constant Typ := _Wrapped_Statements
+      --     do
+      --        <postconditions statments>
+      --     end return;
+      --  end;
+
+      --  Or else, in the case of a procedure, generate:
       --
       --  procedure Original_Proc (X : in out Integer) is
       --     <prologue renamings>
@@ -1657,7 +1678,6 @@ package body Contracts is
       --     _Wrapped_Statements;
       --     <postconditions statments>
       --  end;
-      --
 
       --  Create Identifier
 
@@ -1716,6 +1736,26 @@ package body Contracts is
          Set_Statements
            (Handled_Statement_Sequence (Body_Decl), Stmts);
 
+      --  Generate the post-execution statements and the extended return
+      --  when the subprogram being wrapped is a BIP function.
+
+      elsif Is_Build_In_Place_Result_Type (Ret_Type) then
+         Set_Statements (Handled_Statement_Sequence (Body_Decl), New_List (
+           Make_Extended_Return_Statement (Loc,
+             Return_Object_Declarations => New_List (
+                Make_Object_Declaration (Loc,
+                  Defining_Identifier => Result,
+                  Constant_Present    => True,
+                  Object_Definition   =>
+                    New_Occurrence_Of (Ret_Type, Loc),
+                  Expression          =>
+                    Make_Function_Call (Loc,
+                      Name                   =>
+                        New_Occurrence_Of (Wrapper_Id, Loc)))),
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 Statements => Stmts))));
+
       --  Declare a renaming of the result of the call to the wrapper and
       --  append a return of the result of the call when the subprogram is
       --  a function, after manually removing the side effects. Note that
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 7ac8cf6..e350f13 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -222,10 +222,9 @@ package Einfo is
 --  on the actions triggered by a freeze node, which include the construction
 --  of initialization procedures and dispatch tables.
 
---  b) The presence of a freeze node on an entity is used by the back end to
---  defer elaboration of the entity until its freeze node is seen. In the
---  absence of an explicit freeze node, an entity is frozen (and elaborated)
---  at the point of declaration.
+--  b) The flag is used by the back end to defer elaboration of the entity
+--  until its freeze node is seen. In the absence of an explicit freeze node,
+--  an entity is frozen (and elaborated) at the point of declaration.
 
 --  For object declarations, the flag is set when an address clause for the
 --  object is encountered. Legality checks on the address expression only take
@@ -4825,39 +4824,6 @@ package Einfo is
 
 --  The front-end does not store explicitly the fact that Z renames X.
 
---------------------------------------
--- Delayed Freezing and Elaboration --
---------------------------------------
-
---  The flag Has_Delayed_Freeze indicates that an entity carries an explicit
---  freeze node, which appears later in the expanded tree.
-
---  a) The flag is used by the front-end to trigger expansion actions
---  which include the generation of that freeze node. Typically this happens at
---  the end of the current compilation unit, or before the first subprogram
---  body is encountered in the current unit. See files freeze and exp_ch13 for
---  details on the actions triggered by a freeze node, which include the
---  construction of initialization procedures and dispatch tables.
-
---  b) The flag is used by the backend to defer elaboration of the entity until
---  its freeze node is seen. In the absence of an explicit freeze node, an
---  entity is frozen (and elaborated) at the point of declaration.
-
---  For object declarations, the flag is set when an address clause for the
---  object is encountered. Legality checks on the address expression only
---  take place at the freeze point of the object.
-
---  Most types have an explicit freeze node, because they cannot be elaborated
---  until all representation and operational items that apply to them have been
---  analyzed. Private types and incomplete types have the flag set as well, as
---  do task and protected types.
-
---  Implicit base types created for type derivations, as well as classwide
---  types created for all tagged types, have the flag set.
-
---  If a subprogram has an access parameter whose designated type is incomplete
---  the subprogram has the flag set.
-
 ------------------
 -- Access Kinds --
 ------------------
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 2e14c97..209741c 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -1594,35 +1594,86 @@ package body Exp_Ch5 is
       Rev    : Boolean) return Node_Id
    is
 
+      function Volatile_Or_Independent
+        (Exp : Node_Id; Typ : Entity_Id) return Boolean;
+      --  Exp is an expression of type Typ, or if there is no expression
+      --  involved, Exp is Empty. True if there are any volatile or independent
+      --  objects that should disable the optimization. We check the object
+      --  itself, all subcomponents, and if Exp is a slice of a component or
+      --  slice, we check the prefix and its type.
+      --
+      --  We disable the optimization when there are relevant volatile or
+      --  independent objects, because Copy_Bitfield can read and write bits
+      --  that are not part of the objects being copied.
+
+      -----------------------------
+      -- Volatile_Or_Independent --
+      -----------------------------
+
+      function Volatile_Or_Independent
+        (Exp : Node_Id; Typ : Entity_Id) return Boolean
+      is
+      begin
+         --  Initially, Exp is the left- or right-hand side. In recursive
+         --  calls, Exp is Empty if we're just checking a component type, and
+         --  Exp is the prefix if we're checking the prefix of a slice.
+
+         if Present (Exp)
+           and then (Is_Volatile_Object_Ref (Exp)
+                       or else Is_Independent_Object (Exp))
+         then
+            return True;
+         end if;
+
+         if Has_Volatile_Components (Typ)
+           or else Has_Independent_Components (Typ)
+         then
+            return True;
+         end if;
+
+         if Is_Array_Type (Typ) then
+            return Volatile_Or_Independent (Empty, Component_Type (Typ));
+         elsif Is_Record_Type (Typ) then
+            declare
+               Comp : Entity_Id := First_Component (Typ);
+            begin
+               while Present (Comp) loop
+                  if Volatile_Or_Independent (Empty, Comp) then
+                     return True;
+                  end if;
+
+                  Next_Component (Comp);
+               end loop;
+            end;
+         end if;
+
+         if Nkind (Exp) = N_Slice
+           and then Nkind (Prefix (Exp)) in
+                      N_Selected_Component | N_Indexed_Component | N_Slice
+         then
+            if Volatile_Or_Independent (Prefix (Exp), Etype (Prefix (Exp)))
+            then
+               return True;
+            end if;
+         end if;
+
+         return False;
+      end Volatile_Or_Independent;
+
       L : constant Node_Id := Name (N);
       R : constant Node_Id := Expression (N);
       --  Left- and right-hand sides of the assignment statement
 
       Slices : constant Boolean :=
         Nkind (L) = N_Slice or else Nkind (R) = N_Slice;
-      L_Prefix_Comp : constant Boolean :=
-        --  True if the left-hand side is a slice of a component or slice
-        Nkind (L) = N_Slice
-          and then Nkind (Prefix (L)) in
-                     N_Selected_Component | N_Indexed_Component | N_Slice;
-      R_Prefix_Comp : constant Boolean :=
-        --  Likewise for the right-hand side
-        Nkind (R) = N_Slice
-          and then Nkind (Prefix (R)) in
-                     N_Selected_Component | N_Indexed_Component | N_Slice;
+
+   --  Start of processing for Expand_Assign_Array_Loop_Or_Bitfield
 
    begin
       --  Determine whether Copy_Bitfield or Fast_Copy_Bitfield is appropriate
       --  (will work, and will be more efficient than component-by-component
       --  copy). Copy_Bitfield doesn't work for reversed storage orders. It is
-      --  efficient for slices of bit-packed arrays. Copy_Bitfield can read and
-      --  write bits that are not part of the objects being copied, so we don't
-      --  want to use it if there are volatile or independent components. If
-      --  the Prefix of the slice is a component or slice, then it might be a
-      --  part of an object with some other volatile or independent components,
-      --  so we disable the optimization in that case as well. We could
-      --  complicate this code by actually looking for such volatile and
-      --  independent components.
+      --  efficient for slices of bit-packed arrays.
 
       if Is_Bit_Packed_Array (L_Type)
         and then Is_Bit_Packed_Array (R_Type)
@@ -1630,12 +1681,8 @@ package body Exp_Ch5 is
         and then not Reverse_Storage_Order (R_Type)
         and then Ndim = 1
         and then Slices
-        and then not Has_Volatile_Component (L_Type)
-        and then not Has_Volatile_Component (R_Type)
-        and then not Has_Independent_Components (L_Type)
-        and then not Has_Independent_Components (R_Type)
-        and then not L_Prefix_Comp
-        and then not R_Prefix_Comp
+        and then not Volatile_Or_Independent (L, L_Type)
+        and then not Volatile_Or_Independent (R, R_Type)
       then
          --  Here if Copy_Bitfield can work (except for the Rev test below).
          --  Determine whether to call Fast_Copy_Bitfield instead. If we
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 0c88be7..d27d956 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1454,10 +1454,12 @@ package body Sem_Attr is
             Subp_Decl := Find_Related_Declaration_Or_Body (Prag);
          end if;
 
-         --  'Old objects appear in block statements as part of the expansion
-         --  of contract wrappers.
+         --  'Old objects appear in block and extended return statements as
+         --  part of the expansion of contract wrappers.
 
-         if Nkind (Subp_Decl) = N_Block_Statement then
+         if Nkind (Subp_Decl) in N_Block_Statement
+                               | N_Extended_Return_Statement
+         then
             Subp_Decl := Parent (Parent (Subp_Decl));
          end if;
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 9ae082c..25e886e 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6018,8 +6018,11 @@ package body Sem_Util is
                Append_New_Elmt (Item_Id, States);
 
             --  Recursively gather the visible states of a nested package
+            --  except for nested package renamings.
 
-            elsif Ekind (Item_Id) = E_Package then
+            elsif Ekind (Item_Id) = E_Package
+              and then No (Renamed_Entity (Item_Id))
+            then
                Collect_Visible_States (Item_Id, States);
             end if;