[multiple changes]

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_aux.adb (Nearest_Ancestor): Use original node of type
	declaration to locate nearest ancestor, because derived
	type declarations for record types are rewritten as record
	declarations.
	* sem_ch13.adb (Add_Call): Use an unchecked conversion to handle
	properly derivations that are completions of private types.
	(Add_Predicates): If type is private, examine rep. items of full
	view, which may include inherited predicates.
	(Build_Predicate_Functions): Ditto.

2017-04-25  Javier Miranda  <miranda@adacore.com>

	* sem_util.adb (New_Copy_Tree.Visit_Entity): Extend previous change
	to generate new entities for subtype declarations located in
	Expression_With_Action nodes.

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_elab.adb (Check_A_Call): Remove
	local variables Is_DIC_Proc and Issue_In_SPARK. Verify the
	need for Elaborate_All when SPARK elaboration checks are
	required. Update the checks for instances, variables, and calls
	to Default_Initial_Condition procedures.

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* aspects.ads, aspects.adb: Make the GNAT-specific pragma No_Inline
	into a boolean aspect, in analogy with the Ada aspect No_Return.

From-SVN: r247219

7 files changed, 108 insertions, 62 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 28499f6..158542c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,34 @@
+2017-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aux.adb (Nearest_Ancestor): Use original node of type
+	declaration to locate nearest ancestor, because derived
+	type declarations for record types are rewritten as record
+	declarations.
+	* sem_ch13.adb (Add_Call): Use an unchecked conversion to handle
+	properly derivations that are completions of private types.
+	(Add_Predicates): If type is private, examine rep. items of full
+	view, which may include inherited predicates.
+	(Build_Predicate_Functions): Ditto.
+
+2017-04-25  Javier Miranda  <miranda@adacore.com>
+
+	* sem_util.adb (New_Copy_Tree.Visit_Entity): Extend previous change
+	to generate new entities for subtype declarations located in
+	Expression_With_Action nodes.
+
+2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_elab.adb (Check_A_Call): Remove
+	local variables Is_DIC_Proc and Issue_In_SPARK. Verify the
+	need for Elaborate_All when SPARK elaboration checks are
+	required. Update the checks for instances, variables, and calls
+	to Default_Initial_Condition procedures.
+
+2017-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* aspects.ads, aspects.adb: Make the GNAT-specific pragma No_Inline
+	into a boolean aspect, in analogy with the Ada aspect No_Return.
+
 2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_ch6.adb, sem_ch13.adb, sem_ch6.adb: Minor reformatting.
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index 49eddf4..d5ec072 100644
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2010-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 2010-2017, 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- --
@@ -570,6 +570,7 @@ package body Aspects is
     Aspect_Machine_Radix                => Aspect_Machine_Radix,
     Aspect_Max_Queue_Length             => Aspect_Max_Queue_Length,
     Aspect_No_Elaboration_Code_All      => Aspect_No_Elaboration_Code_All,
+    Aspect_No_Inline                    => Aspect_No_Inline,
     Aspect_No_Return                    => Aspect_No_Return,
     Aspect_No_Tagged_Streams            => Aspect_No_Tagged_Streams,
     Aspect_Obsolescent                  => Aspect_Obsolescent,
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 586d35f..f3c3136 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2010-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 2010-2017, 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- --
@@ -189,6 +189,7 @@ package Aspects is
       Aspect_Inline_Always,                 -- GNAT
       Aspect_Interrupt_Handler,
       Aspect_Lock_Free,                     -- GNAT
+      Aspect_No_Inline,                     -- GNAT
       Aspect_No_Return,
       Aspect_No_Tagged_Streams,             -- GNAT
       Aspect_Pack,
@@ -468,6 +469,7 @@ package Aspects is
       Aspect_Machine_Radix                => Name_Machine_Radix,
       Aspect_Max_Queue_Length             => Name_Max_Queue_Length,
       Aspect_No_Elaboration_Code_All      => Name_No_Elaboration_Code_All,
+      Aspect_No_Inline                    => Name_No_Inline,
       Aspect_No_Return                    => Name_No_Return,
       Aspect_No_Tagged_Streams            => Name_No_Tagged_Streams,
       Aspect_Object_Size                  => Name_Object_Size,
@@ -677,6 +679,7 @@ package Aspects is
       Aspect_Link_Name                    => Always_Delay,
       Aspect_Linker_Section               => Always_Delay,
       Aspect_Lock_Free                    => Always_Delay,
+      Aspect_No_Inline                    => Always_Delay,
       Aspect_No_Return                    => Always_Delay,
       Aspect_Output                       => Always_Delay,
       Aspect_Persistent_BSS               => Always_Delay,
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 0ba4598..1aa22e8 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -1295,7 +1295,10 @@ package body Sem_Aux is
    ----------------------
 
    function Nearest_Ancestor (Typ : Entity_Id) return Entity_Id is
-      D : constant Node_Id := Declaration_Node (Typ);
+      D : constant Node_Id := Original_Node (Declaration_Node (Typ));
+      --  We use the original node of the declaration, because derived
+      --  types from record subtypes are rewritten as record declarations,
+      --  and it is the original declaration that carries the ancestor.
 
    begin
       --  If we have a subtype declaration, get the ancestor subtype
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index add5680..ea7b3f4 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -8309,11 +8309,15 @@ package body Sem_Ch13 is
          if Present (T) and then Present (Predicate_Function (T)) then
             Set_Has_Predicates (Typ);
 
-            --  Build the call to the predicate function of T
+            --  Build the call to the predicate function of T. The type may be
+            --  derived, so use an unchecked conversion for the actual.
 
             Exp :=
               Make_Predicate_Call
-                (T, Convert_To (T, Make_Identifier (Loc, Object_Name)));
+                (Typ  => T,
+                 Expr =>
+                   Unchecked_Convert_To (T,
+                     Make_Identifier (Loc, Object_Name)));
 
             --  "and"-in the call to evolving expression
 
@@ -8456,6 +8460,14 @@ package body Sem_Ch13 is
 
       begin
          Ritem := First_Rep_Item (Typ);
+
+         --  If the type is private, check whether full view has inherited
+         --  predicates.
+
+         if Is_Private_Type (Typ) and then No (Ritem) then
+            Ritem := First_Rep_Item (Full_View (Typ));
+         end if;
+
          while Present (Ritem) loop
             if Nkind (Ritem) = N_Pragma
               and then Pragma_Name (Ritem) = Name_Predicate
@@ -8562,8 +8574,16 @@ package body Sem_Ch13 is
       --  ones for the current type, as required by AI12-0071-1.
 
       declare
-         Atyp : constant Entity_Id := Nearest_Ancestor (Typ);
+         Atyp : Entity_Id;
       begin
+         Atyp := Nearest_Ancestor (Typ);
+
+         --  The type may be private but the full view may inherit predicates
+
+         if No (Atyp) and then Is_Private_Type (Typ) then
+            Atyp := Nearest_Ancestor (Full_View (Typ));
+         end if;
+
          if Present (Atyp) then
             Add_Call (Atyp);
          end if;
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 89b21a0..b4102ed 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2017, 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- --
@@ -629,7 +629,18 @@ package body Sem_Elab is
          return W_Scope;
       end Find_W_Scope;
 
-      --  Locals
+      --  Local variables
+
+      Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation;
+      --  Indicates if we have instantiation case
+
+      Loc : constant Source_Ptr := Sloc (N);
+
+      SPARK_Elab_Errors : constant Boolean :=
+                            SPARK_Mode = On
+                              and then Dynamic_Elaboration_Checks;
+      --  Flag set when an entity is called or a variable is read during SPARK
+      --  dynamic elaboration.
 
       Variable_Case : constant Boolean :=
                         Nkind (N) in N_Has_Entity
@@ -637,10 +648,17 @@ package body Sem_Elab is
                           and then Ekind (Entity (N)) = E_Variable;
       --  Indicates if we have variable reference case
 
-      Loc : constant Source_Ptr := Sloc (N);
-
-      Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation;
-      --  Indicates if we have instantiation case
+      W_Scope : constant Entity_Id := Find_W_Scope;
+      --  Top-level scope of directly called entity for subprogram. This
+      --  differs from E_Scope in the case where renamings or derivations
+      --  are involved, since it does not follow these links. W_Scope is
+      --  generally in a visible unit, and it is this scope that may require
+      --  an Elaborate_All. However, there are some cases (initialization
+      --  calls and calls involving object notation) where W_Scope might not
+      --  be in the context of the current unit, and there is an intermediate
+      --  package that is, in which case the Elaborate_All has to be placed
+      --  on this intermediate package. These special cases are handled in
+      --  Set_Elaboration_Constraint.
 
       Ent                  : Entity_Id;
       Callee_Unit_Internal : Boolean;
@@ -667,26 +685,6 @@ package body Sem_Elab is
       --  non-visible unit. This is the scope that is to be investigated to
       --  see whether an elaboration check is required.
 
-      Is_DIC_Proc : Boolean := False;
-      --  Flag set when the call denotes the Default_Initial_Condition
-      --  procedure of a private type that wraps a nontrivial assertion
-      --  expression.
-
-      Issue_In_SPARK : Boolean;
-      --  Flag set when a source entity is called during elaboration in SPARK
-
-      W_Scope : constant Entity_Id := Find_W_Scope;
-      --  Top-level scope of directly called entity for subprogram. This
-      --  differs from E_Scope in the case where renamings or derivations
-      --  are involved, since it does not follow these links. W_Scope is
-      --  generally in a visible unit, and it is this scope that may require
-      --  an Elaborate_All. However, there are some cases (initialization
-      --  calls and calls involving object notation) where W_Scope might not
-      --  be in the context of the current unit, and there is an intermediate
-      --  package that is, in which case the Elaborate_All has to be placed
-      --  on this intermediate package. These special cases are handled in
-      --  Set_Elaboration_Constraint.
-
    --  Start of processing for Check_A_Call
 
    begin
@@ -1019,33 +1017,19 @@ package body Sem_Elab is
          return;
       end if;
 
-      Is_DIC_Proc := Is_Nontrivial_DIC_Procedure (Ent);
-
-      --  Elaboration issues in SPARK are reported only for source constructs
-      --  and for nontrivial Default_Initial_Condition procedures. The latter
-      --  must be checked because the default initialization of an object of a
-      --  private type triggers the evaluation of the Default_Initial_Condition
-      --  expression, which in turn may have side effects.
-
-      Issue_In_SPARK :=
-        SPARK_Mode = On
-          and then Dynamic_Elaboration_Checks
-          and then (Comes_From_Source (Ent) or Is_DIC_Proc);
-
       --  Now check if an Elaborate_All (or dynamic check) is needed
 
-      if not Suppress_Elaboration_Warnings (Ent)
+      if (Elab_Info_Messages or Elab_Warnings or SPARK_Elab_Errors)
+        and then Generate_Warnings
+        and then not Suppress_Elaboration_Warnings (Ent)
         and then not Elaboration_Checks_Suppressed (Ent)
         and then not Suppress_Elaboration_Warnings (E_Scope)
         and then not Elaboration_Checks_Suppressed (E_Scope)
-        and then ((Elab_Warnings or Elab_Info_Messages)
-                    or else SPARK_Mode = On)
-        and then Generate_Warnings
       then
          --  Instantiation case
 
          if Inst_Case then
-            if Issue_In_SPARK then
+            if Comes_From_Source (Ent) and then SPARK_Elab_Errors then
                Error_Msg_NE
                  ("instantiation of & during elaboration in SPARK", N, Ent);
             else
@@ -1063,9 +1047,11 @@ package body Sem_Elab is
 
          --  Variable reference in SPARK mode
 
-         elsif Variable_Case and Issue_In_SPARK then
-            Error_Msg_NE
-              ("reference to & during elaboration in SPARK", N, Ent);
+         elsif Variable_Case then
+            if Comes_From_Source (Ent) and then SPARK_Elab_Errors then
+               Error_Msg_NE
+                 ("reference to & during elaboration in SPARK", N, Ent);
+            end if;
 
          --  Subprogram call case
 
@@ -1079,14 +1065,14 @@ package body Sem_Elab is
                   "info: implicit call to & during elaboration?$?",
                   Ent);
 
-            elsif Issue_In_SPARK then
+            elsif SPARK_Elab_Errors then
 
                --  Emit a specialized error message when the elaboration of an
                --  object of a private type evaluates the expression of pragma
                --  Default_Initial_Condition. This prevents the internal name
                --  of the procedure from appearing in the error message.
 
-               if Is_DIC_Proc then
+               if Is_Nontrivial_DIC_Procedure (Ent) then
                   Error_Msg_N
                     ("call to Default_Initial_Condition during elaboration in "
                      & "SPARK", N);
@@ -1108,7 +1094,7 @@ package body Sem_Elab is
          --  Case of Elaborate_All not present and required, for SPARK this
          --  is an error, so give an error message.
 
-         if Issue_In_SPARK then
+         if SPARK_Elab_Errors then
             Error_Msg_NE -- CODEFIX
               ("\Elaborate_All pragma required for&", N, W_Scope);
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 7f80ba6..42e1601 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -17120,10 +17120,12 @@ package body Sem_Util is
          pragma Assert (not Is_Itype (Old_Entity));
          pragma Assert (Nkind (Old_Entity) in N_Entity);
 
-         --  Restrict entity creation to variable declarations. There is no
-         --  need to create variables declared in inner scopes.
+         --  Restrict entity creation to declarations of constants, variables
+         --  and subtypes. There is no need to duplicate entities declared in
+         --  inner scopes.
 
-         if not Ekind_In (Old_Entity, E_Constant, E_Variable)
+         if (not Ekind_In (Old_Entity, E_Constant, E_Variable)
+              and then Nkind (Parent (Old_Entity)) /= N_Subtype_Declaration)
            or else EWA_Inner_Scope_Level > 0
          then
             return;