--- a/gcc/ada/exp_ch5.adb	Thu Oct 25 07:37:49 2018 +0900
+++ b/gcc/ada/exp_ch5.adb	Thu Feb 13 11:34:05 2020 +0900
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2018, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2019, 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- --
@@ -114,6 +114,28 @@
    --  Auxiliary declarations are inserted before node N using the standard
    --  Insert_Actions mechanism.
 
+   function Expand_Assign_Array_Bitfield
+     (N      : Node_Id;
+      Larray : Entity_Id;
+      Rarray : Entity_Id;
+      L_Type : Entity_Id;
+      R_Type : Entity_Id;
+      Rev    : Boolean) return Node_Id;
+   --  Alternative to Expand_Assign_Array_Loop for packed bitfields. Generates
+   --  a call to the System.Bitfields.Copy_Bitfield, which is more efficient
+   --  than copying component-by-component.
+
+   function Expand_Assign_Array_Loop_Or_Bitfield
+     (N      : Node_Id;
+      Larray : Entity_Id;
+      Rarray : Entity_Id;
+      L_Type : Entity_Id;
+      R_Type : Entity_Id;
+      Ndim   : Pos;
+      Rev    : Boolean) return Node_Id;
+   --  Calls either Expand_Assign_Array_Loop or Expand_Assign_Array_Bitfield as
+   --  appropriate.
+
    procedure Expand_Assign_Record (N : Node_Id);
    --  N is an assignment of an untagged record value. This routine handles
    --  the case where the assignment must be made component by component,
@@ -314,6 +336,10 @@
 
       Crep : constant Boolean := Change_Of_Representation (N);
 
+      pragma Assert
+        (Crep
+          or else Is_Bit_Packed_Array (L_Type) = Is_Bit_Packed_Array (R_Type));
+
       Larray  : Node_Id;
       Rarray  : Node_Id;
 
@@ -939,7 +965,7 @@
 
             else
                Rewrite (N,
-                 Expand_Assign_Array_Loop
+                 Expand_Assign_Array_Loop_Or_Bitfield
                    (N, Larray, Rarray, L_Type, R_Type, Ndim,
                     Rev => not Forwards_OK (N)));
             end if;
@@ -1039,8 +1065,8 @@
                end if;
 
                --  Reset the Analyzed flag, because the bounds of the index
-               --  type itself may be universal, and must must be reanalyzed
-               --  to acquire the proper type for the back end.
+               --  type itself may be universal, and must be reanalyzed to
+               --  acquire the proper type for the back end.
 
                Set_Analyzed (Cleft_Lo, False);
                Set_Analyzed (Cright_Lo, False);
@@ -1092,12 +1118,12 @@
                    Condition => Condition,
 
                    Then_Statements => New_List (
-                     Expand_Assign_Array_Loop
+                     Expand_Assign_Array_Loop_Or_Bitfield
                       (N, Larray, Rarray, L_Type, R_Type, Ndim,
                        Rev => False)),
 
                    Else_Statements => New_List (
-                     Expand_Assign_Array_Loop
+                     Expand_Assign_Array_Loop_Or_Bitfield
                       (N, Larray, Rarray, L_Type, R_Type, Ndim,
                        Rev => True))));
             end if;
@@ -1320,6 +1346,158 @@
       return Assign;
    end Expand_Assign_Array_Loop;
 
+   ----------------------------------
+   -- Expand_Assign_Array_Bitfield --
+   ----------------------------------
+
+   function Expand_Assign_Array_Bitfield
+     (N      : Node_Id;
+      Larray : Entity_Id;
+      Rarray : Entity_Id;
+      L_Type : Entity_Id;
+      R_Type : Entity_Id;
+      Rev    : Boolean) return Node_Id
+   is
+      pragma Assert (not Rev);
+      --  Reverse copying is not yet supported by Copy_Bitfield.
+
+      pragma Assert (not Change_Of_Representation (N));
+      --  This won't work, for example, to copy a packed array to an unpacked
+      --  array.
+
+      Loc  : constant Source_Ptr := Sloc (N);
+
+      L_Index_Typ : constant Node_Id := Etype (First_Index (L_Type));
+      R_Index_Typ : constant Node_Id := Etype (First_Index (R_Type));
+      Left_Lo  : constant Node_Id := Type_Low_Bound  (L_Index_Typ);
+      Right_Lo : constant Node_Id := Type_Low_Bound  (R_Index_Typ);
+
+      L_Addr : constant Node_Id :=
+        Make_Attribute_Reference (Loc,
+          Prefix =>
+            Make_Indexed_Component (Loc,
+              Prefix =>
+                Duplicate_Subexpr (Larray, True),
+              Expressions => New_List (New_Copy_Tree (Left_Lo))),
+          Attribute_Name => Name_Address);
+
+      L_Bit : constant Node_Id :=
+        Make_Attribute_Reference (Loc,
+          Prefix =>
+            Make_Indexed_Component (Loc,
+              Prefix =>
+                Duplicate_Subexpr (Larray, True),
+              Expressions => New_List (New_Copy_Tree (Left_Lo))),
+          Attribute_Name => Name_Bit);
+
+      R_Addr : constant Node_Id :=
+        Make_Attribute_Reference (Loc,
+          Prefix =>
+            Make_Indexed_Component (Loc,
+              Prefix =>
+                Duplicate_Subexpr (Rarray, True),
+              Expressions => New_List (New_Copy_Tree (Right_Lo))),
+          Attribute_Name => Name_Address);
+
+      R_Bit : constant Node_Id :=
+        Make_Attribute_Reference (Loc,
+          Prefix =>
+            Make_Indexed_Component (Loc,
+              Prefix =>
+                Duplicate_Subexpr (Rarray, True),
+              Expressions => New_List (New_Copy_Tree (Right_Lo))),
+          Attribute_Name => Name_Bit);
+
+      --  Compute the Size of the bitfield
+
+      --  Note that the length check has already been done, so we can use the
+      --  size of either L or R; they are equal. We can't use 'Size here,
+      --  because sometimes bit fields get copied into a temp, and the 'Size
+      --  ends up being the size of the temp (e.g. an 8-bit temp containing
+      --  a 4-bit bit field).
+
+      Size : constant Node_Id :=
+        Make_Op_Multiply (Loc,
+          Make_Attribute_Reference (Loc,
+            Prefix =>
+              Duplicate_Subexpr (Name (N), True),
+            Attribute_Name => Name_Length),
+          Make_Attribute_Reference (Loc,
+            Prefix =>
+              Duplicate_Subexpr (Name (N), True),
+            Attribute_Name => Name_Component_Size));
+
+   begin
+      return Make_Procedure_Call_Statement (Loc,
+        Name => New_Occurrence_Of (RTE (RE_Copy_Bitfield), Loc),
+        Parameter_Associations => New_List (
+          R_Addr, R_Bit, L_Addr, L_Bit, Size));
+   end Expand_Assign_Array_Bitfield;
+
+   ------------------------------------------
+   -- Expand_Assign_Array_Loop_Or_Bitfield --
+   ------------------------------------------
+
+   function Expand_Assign_Array_Loop_Or_Bitfield
+     (N      : Node_Id;
+      Larray : Entity_Id;
+      Rarray : Entity_Id;
+      L_Type : Entity_Id;
+      R_Type : Entity_Id;
+      Ndim   : Pos;
+      Rev    : Boolean) return Node_Id
+   is
+      Slices : constant Boolean :=
+        Nkind (Name (N)) = N_Slice or else Nkind (Expression (N)) = N_Slice;
+      L_Prefix_Comp : constant Boolean :=
+        --  True if the left-hand side is a slice of a component or slice
+        Nkind (Name (N)) = N_Slice
+        and then Nkind_In (Prefix (Name (N)),
+                           N_Selected_Component,
+                           N_Indexed_Component,
+                           N_Slice);
+      R_Prefix_Comp : constant Boolean :=
+        --  Likewise for the right-hand side
+        Nkind (Expression (N)) = N_Slice
+        and then Nkind_In (Prefix (Expression (N)),
+                           N_Selected_Component,
+                           N_Indexed_Component,
+                           N_Slice);
+   begin
+      --  Determine whether 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.
+
+      if Is_Bit_Packed_Array (L_Type)
+        and then Is_Bit_Packed_Array (R_Type)
+        and then not Reverse_Storage_Order (L_Type)
+        and then not Reverse_Storage_Order (R_Type)
+        and then Ndim = 1
+        and then not Rev
+        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 RTE_Available (RE_Copy_Bitfield)
+      then
+         return Expand_Assign_Array_Bitfield
+           (N, Larray, Rarray, L_Type, R_Type, Rev);
+      else
+         return Expand_Assign_Array_Loop
+           (N, Larray, Rarray, L_Type, R_Type, Ndim, Rev);
+      end if;
+   end Expand_Assign_Array_Loop_Or_Bitfield;
+
    --------------------------
    -- Expand_Assign_Record --
    --------------------------
@@ -2021,15 +2199,21 @@
 
       if not Suppress_Assignment_Checks (N) then
 
-         --  First deal with generation of range check if required
-
-         if Do_Range_Check (Rhs) then
-            Generate_Range_Check (Rhs, Typ, CE_Range_Check_Failed);
+         --  First deal with generation of range check if required,
+         --  and then predicate checks if the type carries a predicate.
+         --  If the Rhs is an expression these tests may have been applied
+         --  already. This is the case if the RHS is a type conversion.
+         --  Other such redundant checks could be removed ???
+
+         if Nkind (Rhs) /= N_Type_Conversion
+           or else Entity (Subtype_Mark (Rhs)) /= Typ
+         then
+            if Do_Range_Check (Rhs) then
+               Generate_Range_Check (Rhs, Typ, CE_Range_Check_Failed);
+            end if;
+
+            Apply_Predicate_Check (Rhs, Typ);
          end if;
-
-         --  Then generate predicate check if required
-
-         Apply_Predicate_Check (Rhs, Typ);
       end if;
 
       --  Check for a special case where a high level transformation is
@@ -2225,14 +2409,23 @@
       --  checking. Convert Lhs as well, otherwise the actual subtype might
       --  not be constructible. If the discriminants have defaults the type
       --  is unconstrained and there is nothing to check.
-
-      elsif Has_Unknown_Discriminants (Base_Type (Etype (Lhs)))
-        and then Has_Discriminants (Typ)
-        and then not Has_Defaulted_Discriminants (Typ)
-      then
-         Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs));
-         Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs));
-         Apply_Discriminant_Check (Rhs, Typ, Lhs);
+      --  Ditto if a private type with unknown discriminants has a full view
+      --  that is an unconstrained array, in which case a length check is
+      --  needed.
+
+      elsif Has_Unknown_Discriminants (Base_Type (Etype (Lhs))) then
+         if Has_Discriminants (Typ)
+           and then not Has_Defaulted_Discriminants (Typ)
+         then
+            Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs));
+            Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs));
+            Apply_Discriminant_Check (Rhs, Typ, Lhs);
+
+         elsif Is_Array_Type (Typ) and then Is_Constrained (Typ)  then
+            Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs));
+            Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs));
+            Apply_Length_Check (Rhs, Typ);
+         end if;
 
       --  In the access type case, we need the same discriminant check, and
       --  also range checks if we have an access to constrained array.
@@ -2850,13 +3043,14 @@
    -----------------------------
 
    procedure Expand_N_Case_Statement (N : Node_Id) is
-      Loc    : constant Source_Ptr := Sloc (N);
-      Expr   : constant Node_Id    := Expression (N);
-      Alt    : Node_Id;
-      Len    : Nat;
-      Cond   : Node_Id;
-      Choice : Node_Id;
-      Chlist : List_Id;
+      Loc            : constant Source_Ptr := Sloc (N);
+      Expr           : constant Node_Id    := Expression (N);
+      From_Cond_Expr : constant Boolean    := From_Conditional_Expression (N);
+      Alt            : Node_Id;
+      Len            : Nat;
+      Cond           : Node_Id;
+      Choice         : Node_Id;
+      Chlist         : List_Id;
 
    begin
       --  Check for the situation where we know at compile time which branch
@@ -3067,7 +3261,15 @@
                    Condition => Cond,
                    Then_Statements => Then_Stms,
                    Else_Statements => Else_Stms));
+
+               --  The rewritten if statement needs to inherit whether the
+               --  case statement was expanded from a conditional expression,
+               --  for proper handling of nested controlled objects.
+
+               Set_From_Conditional_Expression (N, From_Cond_Expr);
+
                Analyze (N);
+
                return;
             end if;
          end if;
@@ -3304,7 +3506,7 @@
                 Declarations => New_List (Elmt_Decl),
                 Handled_Statement_Sequence =>
                   Make_Handled_Sequence_Of_Statements (Loc,
-                    Statements =>  Stats))));
+                    Statements => Stats))));
 
       else
          Elmt_Ref :=
@@ -3330,7 +3532,7 @@
              Declarations               => New_List (Elmt_Decl),
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
-                 Statements =>  New_List (New_Loop)));
+                 Statements => New_List (New_Loop)));
       end if;
 
       --  The element is only modified in expanded code, so it appears as
@@ -3919,7 +4121,7 @@
    --      --  Default_Iterator aspect of Vector. This increments Lock,
    --      --  disallowing tampering with cursors. Unfortunately, it does not
    --      --  increment Busy. The result of Iterate is Limited_Controlled;
-   --      --  finalization will decrement Lock.  This is a build-in-place
+   --      --  finalization will decrement Lock. This is a build-in-place
    --      --  dispatching call to Iterate.
 
    --      Cur : Cursor := First (Iter); -- or Last