[multiple changes]

2017-01-20  Yannick Moy  <moy@adacore.com>

	* inline.adb (Expand_Inlined_Call): Keep more
	precise type of actual for inlining whenever possible. In
	particular, do not switch to the formal type in GNATprove mode in
	some case where the GNAT backend might require it for visibility.

2017-01-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Check_Non_Overridable_Aspects): An inherited
	aspect Implicit_Dereference can be inherited by a full view if
	the partial view has no discriminants, because there is no way
	to apply the aspect to the partial view.
	(Build_Derived_Record_Type): If derived type renames discriminants
	of the parent, the new discriminant inherits the aspect from
	the old one.
	* sem_ch4.adb (Analyze_Call): Handle properly a parameterless
	call through an access discriminant designating a subprogram.
	* sem_ch5.adb (Analyze_Assignment): (Analyze_Call): Handle
	properly a parameterless call through an access discriminant on
	the left-hand side of an assignment.
	* sem_res.adb (resolve): If an interpreation involves a
	discriminant with an implicit dereference and the expression is an
	entity, resolution takes place later in the appropriate routine.
	* sem_ch13.adb (Analyze_Aspect_Implicit_Dereference): Recognize
	access discriminants that designate a subprogram type.

2017-01-20  Pascal Obry  <obry@adacore.com>

	* a-locale.adb, a-locale.ads: Update Ada.Locales for RM 2012 COR:1:2016

From-SVN: r244698

9 files changed, 115 insertions, 26 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 428648a..252efc5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,36 @@
 2017-01-20  Yannick Moy  <moy@adacore.com>
 
+	* inline.adb (Expand_Inlined_Call): Keep more
+	precise type of actual for inlining whenever possible. In
+	particular, do not switch to the formal type in GNATprove mode in
+	some case where the GNAT backend might require it for visibility.
+
+2017-01-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Check_Non_Overridable_Aspects): An inherited
+	aspect Implicit_Dereference can be inherited by a full view if
+	the partial view has no discriminants, because there is no way
+	to apply the aspect to the partial view.
+	(Build_Derived_Record_Type): If derived type renames discriminants
+	of the parent, the new discriminant inherits the aspect from
+	the old one.
+	* sem_ch4.adb (Analyze_Call): Handle properly a parameterless
+	call through an access discriminant designating a subprogram.
+	* sem_ch5.adb (Analyze_Assignment): (Analyze_Call): Handle
+	properly a parameterless call through an access discriminant on
+	the left-hand side of an assignment.
+	* sem_res.adb (resolve): If an interpreation involves a
+	discriminant with an implicit dereference and the expression is an
+	entity, resolution takes place later in the appropriate routine.
+	* sem_ch13.adb (Analyze_Aspect_Implicit_Dereference): Recognize
+	access discriminants that designate a subprogram type.
+
+2017-01-20  Pascal Obry  <obry@adacore.com>
+
+	* a-locale.adb, a-locale.ads: Update Ada.Locales for RM 2012 COR:1:2016
+
+2017-01-20  Yannick Moy  <moy@adacore.com>
+
 	* sem_ch10.adb (Check_No_Elab_Code_All): Do not issue an error
 	on implicitly with'ed units in GNATprove mode.
 	* sinfo.ads (Implicit_With): Document use of flag for implicitly
diff --git a/gcc/ada/a-locale.adb b/gcc/ada/a-locale.adb
index d56970c..60ad079 100644
--- a/gcc/ada/a-locale.adb
+++ b/gcc/ada/a-locale.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---            Copyright (C) 2010, Free Software Foundation, Inc.            --
+--          Copyright (C) 2010-2016, 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- --
@@ -33,8 +33,7 @@ with System; use System;
 
 package body Ada.Locales is
 
-   type Lower_4 is array (1 .. 4) of Character range 'a' .. 'z';
-   type Upper_4 is array (1 .. 4) of Character range 'A' .. 'Z';
+   type Str_4 is new String (1 .. 4);
 
    --------------
    -- Language --
@@ -43,7 +42,7 @@ package body Ada.Locales is
    function Language return Language_Code is
       procedure C_Get_Language_Code (P : Address);
       pragma Import (C, C_Get_Language_Code);
-      F : Lower_4;
+      F : Str_4;
    begin
       C_Get_Language_Code (F'Address);
       return Language_Code (F (1 .. 3));
@@ -56,7 +55,7 @@ package body Ada.Locales is
    function Country return Country_Code is
       procedure C_Get_Country_Code (P : Address);
       pragma Import (C, C_Get_Country_Code);
-      F : Upper_4;
+      F : Str_4;
    begin
       C_Get_Country_Code (F'Address);
       return Country_Code (F (1 .. 2));
diff --git a/gcc/ada/a-locale.ads b/gcc/ada/a-locale.ads
index 629f367..132c883 100644
--- a/gcc/ada/a-locale.ads
+++ b/gcc/ada/a-locale.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2010, Free Software Foundation, Inc.            --
+--          Copyright (C) 2010-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT.  In accordance with the copyright of that document, you can freely --
@@ -19,8 +19,13 @@ package Ada.Locales is
    pragma Preelaborate (Locales);
    pragma Remote_Types (Locales);
 
-   type Language_Code is array (1 .. 3) of Character range 'a' .. 'z';
-   type Country_Code  is array (1 .. 2) of Character range 'A' .. 'Z';
+   type Language_Code is new String (1 .. 3)
+      with Dynamic_Predicate =>
+         (for all E of Language_Code => E in 'a' .. 'z');
+
+   type Country_Code is new String (1 .. 2)
+      with Dynamic_Predicate =>
+         (for all E of Country_Code => E in 'A' .. 'Z');
 
    Language_Unknown : constant Language_Code := "und";
    Country_Unknown  : constant Country_Code := "ZZ";
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 9fb47ef..f1afe32 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -3087,8 +3087,10 @@ package body Inline is
 
          elsif Base_Type (Etype (F)) = Base_Type (Etype (A))
            and then Etype (F) /= Base_Type (Etype (F))
+           and then Is_Constrained (Etype (F))
          then
             Temp_Typ := Etype (F);
+
          else
             Temp_Typ := Etype (A);
          end if;
@@ -3150,7 +3152,15 @@ package body Inline is
                    Subtype_Mark => New_Occurrence_Of (Etype (F), Loc),
                    Expression   => Relocate_Node (Expression (A)));
 
-            elsif Etype (F) /= Etype (A) then
+            --  In GNATprove mode, keep the most precise type of the actual
+            --  for the temporary variable. Otherwise, the AST may contain
+            --  unexpected assignment statements to a temporary variable of
+            --  unconstrained type renaming a local variable of constrained
+            --  type, which is not expected by GNATprove.
+
+            elsif Etype (F) /= Etype (A)
+              and then not GNATprove_Mode
+            then
                New_A := Unchecked_Convert_To (Etype (F), Relocate_Node (A));
                Temp_Typ := Etype (F);
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 55aea49..8f1ce7d 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1808,11 +1808,17 @@ package body Sem_Ch13 is
                     ("aspect must name a discriminant of current type", Expr);
 
                else
+
+                  --  Discriminant type be an anonymous access type or an
+                  --  anonymous access to subprogram.
+                  --  Missing synchronized types???
+
                   Disc := First_Discriminant (E);
                   while Present (Disc) loop
                      if Chars (Expr) = Chars (Disc)
-                       and then Ekind (Etype (Disc)) =
-                                  E_Anonymous_Access_Type
+                       and then Ekind_In (Etype (Disc),
+                                  E_Anonymous_Access_Type,
+                                  E_Anonymous_Access_Subprogram_Type)
                      then
                         Set_Has_Implicit_Dereference (E);
                         Set_Has_Implicit_Dereference (Disc);
@@ -8684,7 +8690,7 @@ package body Sem_Ch13 is
                         Expression => Expr))));
 
             --  If declaration has not been analyzed yet, Insert declaration
-            --  before freeze node.  Insert body itself after freeze node.
+            --  before freeze node. Insert body itself after freeze node.
 
             if not Analyzed (FDecl) then
                Insert_Before_And_Analyze (N, FDecl);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 68b7323..93b80a8 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2836,6 +2836,8 @@ package body Sem_Ch3 is
          then
             if
               not Has_Aspect_Spec (Prev_Aspects, Name_Implicit_Dereference)
+                and then Present
+                  (Discriminant_Specifications (Original_Node (Parent (Prev))))
             then
                Error_Msg_N
                  ("type does not inherit implicit dereference", Prev);
@@ -8973,6 +8975,9 @@ package body Sem_Ch3 is
 
       --  STEP 5a: Copy the parent record declaration for untagged types
 
+      Set_Has_Implicit_Dereference
+        (Derived_Type, Has_Implicit_Dereference (Parent_Type));
+
       if not Is_Tagged then
 
          --  Discriminant_Constraint (Derived_Type) has been properly
@@ -9015,8 +9020,6 @@ package body Sem_Ch3 is
             Set_Stored_Constraint
               (Derived_Type, Expand_To_Stored_Constraint (Parent_Type, Discs));
             Replace_Components (Derived_Type, New_Decl);
-            Set_Has_Implicit_Dereference
-              (Derived_Type, Has_Implicit_Dereference (Parent_Type));
          end if;
 
          --  Insert the new derived type declaration
@@ -9635,12 +9638,19 @@ package body Sem_Ch3 is
             --  If any of the discriminant constraints is given by a
             --  discriminant and we are in a derived type declaration we
             --  have a discriminant renaming. Establish link between new
-            --  and old discriminant.
+            --  and old discriminant. The new discriminant has an implicit
+            --  dereference if the old one does.
 
             if Denotes_Discriminant (Discr_Expr (J)) then
                if Derived_Def then
-                  Set_Corresponding_Discriminant
-                    (Entity (Discr_Expr (J)), Discr);
+                  declare
+                     New_Discr : constant Entity_Id := Entity (Discr_Expr (J));
+
+                  begin
+                     Set_Corresponding_Discriminant (New_Discr, Discr);
+                     Set_Has_Implicit_Dereference (New_Discr,
+                       Has_Implicit_Dereference (Discr));
+                  end;
                end if;
 
             --  Force the evaluation of non-discriminant expressions.
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 56da406..8ae620c 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -913,6 +913,7 @@ package body Sem_Ch4 is
    --  the type-checking is similar to that of other calls.
 
    procedure Analyze_Call (N : Node_Id) is
+      Loc     : constant Source_Ptr := Sloc (N);
       Actuals : constant List_Id := Parameter_Associations (N);
       Nam     : Node_Id;
       X       : Interp_Index;
@@ -1310,17 +1311,32 @@ package body Sem_Ch4 is
 
             --  If the interpretation succeeds, mark the proper type of the
             --  prefix (any valid candidate will do). If not, remove the
-            --  candidate interpretation. This only needs to be done for
-            --  overloaded protected operations, for other entities disambi-
-            --  guation is done directly in Resolve.
+            --  candidate interpretation. If this is a parameterless call
+            --  on an anonymous access to subprogram, X is a variable with
+            --  an access discriminant D, the entity in the interpretation is
+            --  D, so rewrite X as X.D.all.
 
             if Success then
                if Deref
                  and then Nkind (Parent (N)) /= N_Explicit_Dereference
                then
-                  Set_Entity (Nam, It.Nam);
-                  Insert_Explicit_Dereference (Nam);
-                  Set_Etype (Nam, Nam_Ent);
+                  if Ekind (It.Nam) = E_Discriminant
+                    and then Has_Implicit_Dereference (It.Nam)
+                  then
+                     Rewrite (Name (N),
+                       Make_Explicit_Dereference (Loc,
+                         Prefix => Make_Selected_Component (Loc,
+                           Prefix        =>
+                             (New_Occurrence_Of (Entity (Nam), Loc)),
+                           Selector_Name => New_Occurrence_Of (It.Nam, Loc))));
+                     Analyze (N);
+                     return;
+
+                  else
+                     Set_Entity (Nam, It.Nam);
+                     Insert_Explicit_Dereference (Nam);
+                     Set_Etype (Nam, Nam_Ent);
+                  end if;
 
                else
                   Set_Etype (Nam, It.Typ);
@@ -7981,10 +7997,12 @@ package body Sem_Ch4 is
 
       if not Is_Overloaded (Func_Name) then
          Func := Entity (Func_Name);
+
          Indexing :=
            Make_Function_Call (Loc,
              Name                   => New_Occurrence_Of (Func, Loc),
              Parameter_Associations => Assoc);
+
          Set_Parent (Indexing, Parent (N));
          Set_Generalized_Indexing (N, Indexing);
          Analyze (Indexing);
@@ -8009,7 +8027,6 @@ package body Sem_Ch4 is
              Name                   =>
                Make_Identifier (Loc, Chars (Func_Name)),
              Parameter_Associations => Assoc);
-
          Set_Parent (Indexing, Parent (N));
          Set_Generalized_Indexing (N, Indexing);
          Set_Etype (N, Any_Type);
@@ -8024,7 +8041,7 @@ package body Sem_Ch4 is
             Get_First_Interp (Func_Name, I, It);
             Set_Etype (Indexing, Any_Type);
 
-            --  Analyze eacn candidae function with the given actuals
+            --  Analyze each candidate function with the given actuals
 
             while Present (It.Nam) loop
                Analyze_One_Call (Indexing, It.Nam, False, Success);
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 0a72320..6962262 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -330,6 +330,14 @@ package body Sem_Ch5 is
                then
                   null;
 
+               --  This may be a call to a parameterless function through an
+               --  implicit dereference, so discard interpretation as well.
+
+               elsif Is_Entity_Name (Lhs)
+                 and then Has_Implicit_Dereference (It.Typ)
+               then
+                  null;
+
                elsif Has_Compatible_Type (Rhs, It.Typ) then
                   if T1 /= Any_Type then
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 3728482..062a839 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -2469,6 +2469,7 @@ package body Sem_Res is
                                   N_Attribute_Reference,
                                   N_And_Then,
                                   N_Indexed_Component,
+                                  N_Identifier,
                                   N_Or_Else,
                                   N_Range,
                                   N_Selected_Component,
@@ -2626,7 +2627,9 @@ package body Sem_Res is
                            --  replaced by the appropriate call during late
                            --  expansion.
 
-                           if not Box_Present (Elmt) then
+                           if Nkind (Elmt) /= N_Iterated_Component_Association
+                             and then not Box_Present (Elmt)
+                           then
                               Check_Elmt (Expression (Elmt));
                            end if;