[multiple changes]

2017-09-08  Bob Duff  <duff@adacore.com>

	* par-prag.adb, sem_prag.adb, snames.ads-tmpl: Implement pragma
	Ada_2020, along the same lines as the other Ada version pragmas.

2017-09-08  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch12.adb: Minor typo fixes and reformatting.

2017-09-08  Yannick Moy  <moy@adacore.com>

	* sem_aggr.adb (Resolve_Record_Aggregate):
	Rewrite bounds of aggregate subexpressions which may depend on
	discriminants of the enclosing aggregate.

2017-09-08  Yannick Moy  <moy@adacore.com>

	* sem_ch5.adb: Prevent assertion failure on illegal code.

2017-09-08  Yannick Moy  <moy@adacore.com>

	* lib-xref-spark_specific.adb (Add_SPARK_Xrefs.Is_SPARK_Scope): Avoid
	calling Renamed_Entity on an entity which cannot be a renaming.

2017-09-08  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_aggr.adb: Add with & use clause for Urealp.
	(Aggr_Assignment_OK_For_Backend): Accept (almost all)
	elementary types instead of just discrete types.
	* sem_eval.adb (Expr_Value): Deal with N_Null for access types.
	* gcc-interface/trans.c (gnat_to_gnu) <N_Assignment_Statement>:
	Be prepared for the FP zero value in the memset case.  Add small
	guard.

2017-09-08  Eric Botcazou  <ebotcazou@adacore.com>

	* s-htable.adb (Static_HTable.Reset): Use aggregate instead
	of loop.

From-SVN: r251894

12 files changed, 232 insertions, 33 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8467214..784d879 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,42 @@
+2017-09-08  Bob Duff  <duff@adacore.com>
+
+	* par-prag.adb, sem_prag.adb, snames.ads-tmpl: Implement pragma
+	Ada_2020, along the same lines as the other Ada version pragmas.
+
+2017-09-08  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_ch12.adb: Minor typo fixes and reformatting.
+
+2017-09-08  Yannick Moy  <moy@adacore.com>
+
+	* sem_aggr.adb (Resolve_Record_Aggregate):
+	Rewrite bounds of aggregate subexpressions which may depend on
+	discriminants of the enclosing aggregate.
+
+2017-09-08  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch5.adb: Prevent assertion failure on illegal code.
+
+2017-09-08  Yannick Moy  <moy@adacore.com>
+
+	* lib-xref-spark_specific.adb (Add_SPARK_Xrefs.Is_SPARK_Scope): Avoid
+	calling Renamed_Entity on an entity which cannot be a renaming.
+
+2017-09-08  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_aggr.adb: Add with & use clause for Urealp.
+	(Aggr_Assignment_OK_For_Backend): Accept (almost all)
+	elementary types instead of just discrete types.
+	* sem_eval.adb (Expr_Value): Deal with N_Null for access types.
+	* gcc-interface/trans.c (gnat_to_gnu) <N_Assignment_Statement>:
+	Be prepared for the FP zero value in the memset case.  Add small
+	guard.
+
+2017-09-08  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* s-htable.adb (Static_HTable.Reset): Use aggregate instead
+	of loop.
+
 2017-09-08  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_aggr.adb (Expand_Array_Aggregate): Use New_Copy_Tree instead
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 61c6240..04fa866 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -61,6 +61,7 @@ with Stand;    use Stand;
 with Stringt;  use Stringt;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
+with Urealp;   use Urealp;
 
 package body Exp_Aggr is
 
@@ -4894,7 +4895,7 @@ package body Exp_Aggr is
       --    4. The array type has no null ranges (the purpose of this is to
       --       avoid a bogus warning for an out-of-range value).
 
-      --    5. The component type is discrete
+      --    5. The component type is elementary
 
       --    6. The component size is Storage_Unit or the value is of the form
       --       M * (1 + A**1 + A**2 + .. A**(K-1)) where A = 2**(Storage_Unit)
@@ -4970,7 +4971,13 @@ package body Exp_Aggr is
             return False;
          end if;
 
-         if not Is_Discrete_Type (Ctyp) then
+         --  All elementary types are supported except for fat pointers
+         --  because they are not really elementary for the backend.
+
+         if not Is_Elementary_Type (Ctyp)
+           or else (Is_Access_Type (Ctyp)
+                     and then Esize (Ctyp) /= System_Address_Size)
+         then
             return False;
          end if;
 
@@ -4990,6 +4997,14 @@ package body Exp_Aggr is
             return False;
          end if;
 
+         --  The only supported value for floating point is 0.0
+
+         if Is_Floating_Point_Type (Ctyp) then
+            return Expr_Value_R (Expr) = Ureal_0;
+         end if;
+
+         --  For other types, we can look into the value as an integer
+
          Value := Expr_Value (Expr);
 
          if Has_Biased_Representation (Ctyp) then
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 9163eb1..8eff9c3 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -7037,14 +7037,17 @@ gnat_to_gnu (Node_Id gnat_node)
 	  /* Or else, use memset when the conditions are met.  */
 	  else if (use_memset_p)
 	    {
-	      tree value = fold_convert (integer_type_node, gnu_rhs);
+	      tree value
+		= real_zerop (gnu_rhs)
+		  ? integer_zero_node
+		  : fold_convert (integer_type_node, gnu_rhs);
 	      tree to = gnu_lhs;
 	      tree type = TREE_TYPE (to);
 	      tree size
 	        = SUBSTITUTE_PLACEHOLDER_IN_EXPR (TYPE_SIZE_UNIT (type), to);
 	      tree to_ptr = build_fold_addr_expr (to);
 	      tree t = builtin_decl_explicit (BUILT_IN_MEMSET);
-	      if (TREE_CODE (value) == INTEGER_CST)
+	      if (TREE_CODE (value) == INTEGER_CST && !integer_zerop (value))
 		{
 		  tree mask
 		    = build_int_cst (integer_type_node,
diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb
index f210112..8cb2628 100644
--- a/gcc/ada/lib-xref-spark_specific.adb
+++ b/gcc/ada/lib-xref-spark_specific.adb
@@ -538,10 +538,14 @@ package body SPARK_Specific is
       --------------------
 
       function Is_SPARK_Scope (E : Entity_Id) return Boolean is
+         Can_Be_Renamed : constant Boolean :=
+           Present (E)
+             and then (Is_Subprogram_Or_Entry (E)
+                        or else Ekind (E) = E_Package);
       begin
          return Present (E)
            and then not Is_Generic_Unit (E)
-           and then Renamed_Entity (E) = Empty
+           and then (not Can_Be_Renamed or else Renamed_Entity (E) = Empty)
            and then Get_Scope_Num (E) /= No_Scope;
       end Is_SPARK_Scope;
 
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index d0f5539..5ea129a 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -326,14 +326,16 @@ begin
 
    case Prag_Id is
 
+      --  Ada version pragmas must be processed at parse time, because we want
+      --  to set the Ada version properly at parse time to recognize the
+      --  appropriate Ada version syntax. However, pragma Ada_2005 and higher
+      --  have an optional argument; it is only the zero argument form that
+      --  must be processed at parse time.
+
       ------------
       -- Ada_83 --
       ------------
 
-      --  This pragma must be processed at parse time, since we want to set
-      --  the Ada version properly at parse time to recognize the appropriate
-      --  Ada version syntax.
-
       when Pragma_Ada_83 =>
          if not Latest_Ada_Only then
             Ada_Version := Ada_83;
@@ -345,10 +347,6 @@ begin
       -- Ada_95 --
       ------------
 
-      --  This pragma must be processed at parse time, since we want to set
-      --  the Ada version properly at parse time to recognize the appropriate
-      --  Ada version syntax.
-
       when Pragma_Ada_95 =>
          if not Latest_Ada_Only then
             Ada_Version := Ada_95;
@@ -360,11 +358,6 @@ begin
       -- Ada_05/Ada_2005 --
       ---------------------
 
-      --  These pragmas must be processed at parse time, since we want to set
-      --  the Ada version properly at parse time to recognize the appropriate
-      --  Ada version syntax. However, it is only the zero argument form that
-      --  must be processed at parse time.
-
       when Pragma_Ada_05
          | Pragma_Ada_2005
       =>
@@ -378,11 +371,6 @@ begin
       -- Ada_12/Ada_2012 --
       ---------------------
 
-      --  These pragmas must be processed at parse time, since we want to set
-      --  the Ada version properly at parse time to recognize the appropriate
-      --  Ada version syntax. However, it is only the zero argument form that
-      --  must be processed at parse time.
-
       when Pragma_Ada_12
          | Pragma_Ada_2012
       =>
@@ -392,6 +380,17 @@ begin
             Ada_Version_Pragma := Pragma_Node;
          end if;
 
+      --------------
+      -- Ada_2020 --
+      --------------
+
+      when Pragma_Ada_2020 =>
+         if Arg_Count = 0 then
+            Ada_Version := Ada_2020;
+            Ada_Version_Explicit := Ada_2020;
+            Ada_Version_Pragma := Pragma_Node;
+         end if;
+
       ---------------------------
       -- Compiler_Unit_Warning --
       ---------------------------
diff --git a/gcc/ada/s-htable.adb b/gcc/ada/s-htable.adb
index ba956fc..8ad6eaf 100644
--- a/gcc/ada/s-htable.adb
+++ b/gcc/ada/s-htable.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                    Copyright (C) 1995-2016, AdaCore                      --
+--                    Copyright (C) 1995-2017, AdaCore                      --
 --                                                                          --
 -- 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- --
@@ -171,9 +171,9 @@ package body System.HTable is
 
       procedure Reset is
       begin
-         for J in Table'Range loop
-            Table (J) := Null_Ptr;
-         end loop;
+         --  Use an aggregate for efficient reasons
+
+         Table := (others => Null_Ptr);
       end Reset;
 
       ---------
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 7a37bdd..e02913d 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3297,6 +3297,12 @@ package body Sem_Aggr is
       --  Parent pointer of Expr is not set then Expr was produced with a
       --  New_Copy_Tree or some such.
 
+      procedure Rewrite_Range (Root_Type : Entity_Id; Rge : Node_Id);
+      --  Rewrite a range node Rge when its bounds refer to non-stored
+      --  discriminants from Root_Type, to replace them with the stored
+      --  discriminant values. This is required in GNATprove mode, and is
+      --  adopted in all modes to avoid special-casing GNATprove mode.
+
       ---------------------
       -- Add_Association --
       ---------------------
@@ -4011,6 +4017,66 @@ package body Sem_Aggr is
          Add_Association (New_C, New_Expr, New_Assoc_List);
       end Resolve_Aggr_Expr;
 
+      -------------------
+      -- Rewrite_Range --
+      -------------------
+
+      procedure Rewrite_Range (Root_Type : Entity_Id; Rge : Node_Id) is
+
+         procedure Rewrite_Bound
+           (Bound     : Node_Id;
+            Disc      : Entity_Id;
+            Expr_Disc : Node_Id);
+         --  Rewrite a bound of the range Bound, when it is equal to the
+         --  non-stored discriminant Disc, into the stored discriminant
+         --  value Expr_Disc.
+
+         -------------------
+         -- Rewrite_Bound --
+         -------------------
+
+         procedure Rewrite_Bound
+           (Bound     : Node_Id;
+            Disc      : Entity_Id;
+            Expr_Disc : Node_Id)
+         is
+         begin
+            if Nkind (Bound) = N_Identifier
+              and then Entity (Bound) = Disc
+            then
+               Rewrite (Bound, New_Copy_Tree (Expr_Disc));
+            end if;
+         end Rewrite_Bound;
+
+         ---------------------
+         -- Local Variables --
+         ---------------------
+
+         Low, High : Node_Id;
+         Disc      : Entity_Id;
+         Expr_Disc : Elmt_Id;
+
+      --  Start of processing for Rewrite_Range
+
+      begin
+         if Has_Discriminants (Root_Type)
+           and then Nkind (Rge) = N_Range
+         then
+            Low := Low_Bound (Rge);
+            High := High_Bound (Rge);
+
+            Disc := First_Discriminant (Root_Type);
+            Expr_Disc :=
+              First_Elmt (Stored_Constraint (Etype (N)));
+            while Present (Disc) loop
+               Rewrite_Bound (Low, Disc, Node (Expr_Disc));
+               Rewrite_Bound (High, Disc, Node (Expr_Disc));
+               Next_Discriminant (Disc);
+               Next_Elmt (Expr_Disc);
+            end loop;
+         end if;
+      end Rewrite_Range;
+
       --  Local variables
 
       Components : constant Elist_Id := New_Elmt_List;
@@ -4596,6 +4662,43 @@ package body Sem_Aggr is
                        New_Scope => Current_Scope,
                        New_Sloc  => Sloc (N));
 
+                  --  As the type of the copied default expression may refer
+                  --  to discriminants of the record type declaration, these
+                  --  non-stored discriminants need to be rewritten into stored
+                  --  discriminant values for the aggregate. This is required
+                  --  in GNATprove mode, and is adopted in all modes to avoid
+                  --  special-casing GNATprove mode.
+
+                  if Is_Array_Type (Etype (Expr)) then
+                     declare
+                        --  Root record type whose discriminants may be used
+                        --  as bounds in range nodes.
+                        Root_Type : constant Entity_Id := Scope (Component);
+                        Index     : Node_Id;
+
+                     begin
+                        --  Rewrite the range nodes occurring in the indexes
+                        --  and their types.
+
+                        Index := First_Index (Etype (Expr));
+                        while Present (Index) loop
+                           Rewrite_Range (Root_Type, Index);
+                           Rewrite_Range
+                             (Root_Type, Scalar_Range (Etype (Index)));
+                           Next_Index (Index);
+                        end loop;
+
+                        --  Rewrite the range nodes occurring as aggregate
+                        --  bounds.
+
+                        if Nkind (Expr) = N_Aggregate
+                          and then Present (Aggregate_Bounds (Expr))
+                        then
+                           Rewrite_Range (Root_Type, Aggregate_Bounds (Expr));
+                        end if;
+                     end;
+                  end if;
+
                   Add_Association
                     (Component  => Component,
                      Expr       => Expr,
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 9022bae..324ba4d 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -6421,10 +6421,10 @@ package body Sem_Ch12 is
                   Formal_P := Next_Entity (E);
 
                   --  If the instance is within an enclosing instance body
-                  --  there is no need to vertify the legqlity of current
-                  --  formsl psckages because they were legal in the generic
-                  --  body. This optimixation may be applicable elsewhere,
-                  --  and it also removes spurious errors that may arise with
+                  --  there is no need to verify the legality of current formal
+                  --  packages because they were legal in the generic body.
+                  --  This optimization may be applicable elsewhere, and it
+                  --  also removes spurious errors that may arise with
                   --  on-the-fly inlining and confusion between private and
                   --  full views.
 
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 135ecd8..e72dc4b 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2513,7 +2513,10 @@ package body Sem_Ch5 is
                & "iteration", Discrete_Subtype_Definition (N),
                T, Suggest_Static => True);
 
-         elsif Inside_A_Generic and then Is_Generic_Formal (T) then
+         elsif Inside_A_Generic
+           and then Is_Generic_Formal (T)
+           and then Is_Discrete_Type (T)
+         then
             Set_No_Dynamic_Predicate_On_Actual (T);
          end if;
       end Check_Predicate_Use;
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index a3a1a1f..0c6c2ea 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -4199,6 +4199,12 @@ package body Sem_Eval is
          pragma Assert (Is_Fixed_Point_Type (Underlying_Type (Etype (N))));
          Val := Corresponding_Integer_Value (N);
 
+      --  The NULL access value
+
+      elsif Kind = N_Null then
+         pragma Assert (Is_Access_Type (Underlying_Type (Etype (N))));
+         Val := Uint_0;
+
       --  Otherwise must be character literal
 
       else
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 668b760..b1723f1 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -11835,7 +11835,7 @@ package body Sem_Prag is
 
          --  The one argument form is used for managing the transition from Ada
          --  2005 to Ada 2012 in the run-time library. If an entity is marked
-         --  as Ada_201 only, then referencing the entity in any pre-Ada_2012
+         --  as Ada_2012 only, then referencing the entity in any pre-Ada_2012
          --  mode will generate a warning. In addition, in any pre-Ada_2012
          --  mode, a preference rule is established which does not choose
          --  such an entity unless it is unambiguously specified. This avoids
@@ -11883,6 +11883,28 @@ package body Sem_Prag is
             end if;
          end;
 
+         --------------
+         -- Ada_2020 --
+         --------------
+
+         --  pragma Ada_2020;
+
+         --  Note: this pragma also has some specific processing in Par.Prag
+         --  because we want to set the Ada 2020 version mode during parsing.
+
+         when Pragma_Ada_2020 =>
+            GNAT_Pragma;
+
+            Check_Arg_Count (0);
+
+            Check_Valid_Configuration_Pragma;
+
+            --  Now set appropriate Ada mode
+
+            Ada_Version          := Ada_2020;
+            Ada_Version_Explicit := Ada_2020;
+            Ada_Version_Pragma   := N;
+
          ----------------------
          -- All_Calls_Remote --
          ----------------------
@@ -29419,6 +29441,7 @@ package body Sem_Prag is
       Pragma_Ada_2005                       => -1,
       Pragma_Ada_12                         => -1,
       Pragma_Ada_2012                       => -1,
+      Pragma_Ada_2020                       => -1,
       Pragma_All_Calls_Remote               => -1,
       Pragma_Allow_Integer_Address          => -1,
       Pragma_Annotate                       => 93,
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 600c847..717225d 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -388,6 +388,7 @@ package Snames is
    Name_Ada_2005                       : constant Name_Id := N + $; -- GNAT
    Name_Ada_12                         : constant Name_Id := N + $; -- GNAT
    Name_Ada_2012                       : constant Name_Id := N + $; -- GNAT
+   Name_Ada_2020                       : constant Name_Id := N + $; -- GNAT
    Name_Allow_Integer_Address          : constant Name_Id := N + $; -- GNAT
    Name_Annotate                       : constant Name_Id := N + $; -- GNAT
    Name_Assertion_Policy               : constant Name_Id := N + $; -- Ada 05
@@ -1779,6 +1780,9 @@ package Snames is
       Pragma_Ada_2005,
       Pragma_Ada_12,
       Pragma_Ada_2012,
+      Pragma_Ada_2020,
+      --  Note that there is no Pragma_Ada_20. Pragma_Ada_05/12 are for
+      --  compatibility reasons only; the full year names are preferred.
       Pragma_Allow_Integer_Address,
       Pragma_Annotate,
       Pragma_Assertion_Policy,