[multiple changes]

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

	* sem_ch7.adb (Entity_Table_Size): Change to nearest prime number.

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

	* sem_warn.adb: Minor refactoring.

2017-09-06  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads, einfo.adb (Get_Classwwide_Pragma): New utility,
	to retrieve the inherited classwide precondition/postcondition
	of a subprogram.
	* freeze.adb (Freeze_Entity): Use Get_Classwide_Pragma when
	freezing a subprogram, to complete the generation of the
	corresponding checking code.

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

	* inline.adb (Analyze_Inlined_Bodies): Remove restriction on
	loading of parent body with a with clause for the main unit.
	* gcc-interface/decl.c (defer_limited_with_list): Document
	new usage.
	(gnat_to_gnu_entity) <E_Access_Type>: Handle
	completed Taft Amendment types declared in external units like
	types from limited with clauses.  Adjust final processing of
	defer_limited_with_list accordingly.

2017-09-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Is_Controlled_Indexing): New routine.
	(Is_Displace_Call): Use routine Strip to remove indirections.
	(Is_Displacement_Of_Object_Or_Function_Result): Code clean up. Add a
	missing case of controlled generalized indexing.
	(Is_Source_Object): Use routine Strip to remove indirections.
	(Strip): New routine.

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

	* sysdep.c (__gnat_has_cap_sys_nice): If HAVE_CAPABILITY is defined,
	we include the proper header. Otherwise, we just declare the necessary
	things from the capabilities library. This is so we can build on
	machines without that library, while still enabling that library.
	At run time, we're using weak symbols, so __gnat_has_cap_sys_nice will
	simply return 0 if the library is not present, or not included
	in the link.

2017-09-06  Pierre-Marie de Rodat  <derodat@adacore.com>

	* exp_dbug.adb (Debug_Renaming_Declaration): Do not create an encoding
	for renamings that involve function calls in prefix form.

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

	* sem_ch3.adb (Analyze_Subtype_Declaration):
	Set Has_Delayed_Freeze on a subtype of an incomplete type.

2017-09-06  Pierre-Marie de Rodat  <derodat@adacore.com>

	* par_sco.adb (Extend_Statement_Sequence): When the accept statement
	has no parameter specification and no entry index, use the entry name
	as the end of the generated SCO statement.

From-SVN: r251785

gcc/ada/ChangeLog

+2017-09-06  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sem_ch7.adb (Entity_Table_Size): Change to nearest prime number.
+
+2017-09-06  Yannick Moy  <moy@adacore.com>
+
+	* sem_warn.adb: Minor refactoring.
+
+2017-09-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* einfo.ads, einfo.adb (Get_Classwwide_Pragma): New utility,
+	to retrieve the inherited classwide precondition/postcondition
+	of a subprogram.
+	* freeze.adb (Freeze_Entity): Use Get_Classwide_Pragma when
+	freezing a subprogram, to complete the generation of the
+	corresponding checking code.
+
+2017-09-06  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* inline.adb (Analyze_Inlined_Bodies): Remove restriction on
+	loading of parent body with a with clause for the main unit.
+	* gcc-interface/decl.c (defer_limited_with_list): Document
+	new usage.
+	(gnat_to_gnu_entity) <E_Access_Type>: Handle
+	completed Taft Amendment types declared in external units like
+	types from limited with clauses.  Adjust final processing of
+	defer_limited_with_list accordingly.
+
+2017-09-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_util.adb (Is_Controlled_Indexing): New routine.
+	(Is_Displace_Call): Use routine Strip to remove indirections.
+	(Is_Displacement_Of_Object_Or_Function_Result): Code clean up. Add a
+	missing case of controlled generalized indexing.
+	(Is_Source_Object): Use routine Strip to remove indirections.
+	(Strip): New routine.
+
+2017-09-06  Bob Duff  <duff@adacore.com>
+
+	* sysdep.c (__gnat_has_cap_sys_nice): If HAVE_CAPABILITY is defined,
+	we include the proper header. Otherwise, we just declare the necessary
+	things from the capabilities library. This is so we can build on
+	machines without that library, while still enabling that library.
+	At run time, we're using weak symbols, so __gnat_has_cap_sys_nice will
+	simply return 0 if the library is not present, or not included
+	in the link.
+
+2017-09-06  Pierre-Marie de Rodat  <derodat@adacore.com>
+
+	* exp_dbug.adb (Debug_Renaming_Declaration): Do not create an encoding
+	for renamings that involve function calls in prefix form.
+
+2017-09-06  Bob Duff  <duff@adacore.com>
+
+	* sem_ch3.adb (Analyze_Subtype_Declaration):
+	Set Has_Delayed_Freeze on a subtype of an incomplete type.
+
+2017-09-06  Pierre-Marie de Rodat  <derodat@adacore.com>
+
+	* par_sco.adb (Extend_Statement_Sequence): When the accept statement
+	has no parameter specification and no entry index, use the entry name
+	as the end of the generated SCO statement.
+
 2017-09-06  Steve Baird  <baird@adacore.com>
 
 	* exp_util.adb (Side_Effect_Free): For CodePeer (only) treat

gcc/ada/einfo.adb

@@ -7481,6 +7481,39 @@ package body Einfo is
       return Empty;
    end Get_Pragma;
 
+   --------------------------
+   -- Get_Classwide_Pragma --
+   --------------------------
+
+   function Get_Classwide_Pragma
+     (E  : Entity_Id;
+      Id : Pragma_Id) return Node_Id
+    is
+      Item  : Node_Id;
+      Items : Node_Id;
+
+   begin
+      Items := Contract (E);
+      if No (Items) then
+         return Empty;
+      end if;
+
+      Item := Pre_Post_Conditions (Items);
+
+      while Present (Item) loop
+         if Nkind (Item) = N_Pragma
+           and then Get_Pragma_Id (Pragma_Name_Unmapped (Item)) = Id
+           and then Class_Present (Item)
+         then
+            return Item;
+         else
+            Item := Next_Pragma (Item);
+         end if;
+      end loop;
+
+      return Empty;
+   end Get_Classwide_Pragma;
+
    --------------------------------------
    -- Get_Record_Representation_Clause --
    --------------------------------------

gcc/ada/einfo.ads

@@ -8295,6 +8295,12 @@ package Einfo is
    --    Test_Case
    --    Volatile_Function
 
+   function Get_Classwide_Pragma
+     (E  : Entity_Id;
+      Id : Pragma_Id) return Node_Id;
+   --  Examine Rep_Item chain to locate a classwide pre- or postcondition
+   --  of a primitive operation. Returns Empty if not present.
+
    function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id;
    --  Searches the Rep_Item chain for a given entity E, for a record
    --  representation clause, and if found, returns it. Returns Empty

gcc/ada/exp_dbug.adb

@@ -426,11 +426,20 @@ package body Exp_Dbug is
 
             when N_Selected_Component =>
                declare
-                  First_Bit : constant Uint :=
-                                Normalized_First_Bit
-                                  (Entity (Selector_Name (Ren)));
+                  Sel_Id    : constant Entity_Id :=
+                                Entity (Selector_Name (Ren));
+                  First_Bit : Uint;
 
                begin
+                  --  If the renaming involves a call to a primitive function,
+                  --  we are out of the scope of renaming encodings. We will
+                  --  very likely create a variable to hold the renamed value
+                  --  anyway, so the renaming entity will be available in
+                  --  debuggers.
+
+                  exit when not Ekind_In (Sel_Id, E_Component, E_Discriminant);
+
+                  First_Bit := Normalized_First_Bit (Sel_Id);
                   Enable :=
                     Enable
                       or else Is_Packed

gcc/ada/exp_util.adb

@@ -7590,22 +7590,28 @@ package body Exp_Util is
      (Obj_Id : Entity_Id) return Boolean
    is
       function Is_Controlled_Function_Call (N : Node_Id) return Boolean;
-      --  Determine if particular node denotes a controlled function call. The
-      --  call may have been heavily expanded.
+      --  Determine whether node N denotes a controlled function call
+
+      function Is_Controlled_Indexing (N : Node_Id) return Boolean;
+      --  Determine whether node N denotes a generalized indexing form which
+      --  involves a controlled result.
 
       function Is_Displace_Call (N : Node_Id) return Boolean;
-      --  Determine whether a particular node is a call to Ada.Tags.Displace.
-      --  The call might be nested within other actions such as conversions.
+      --  Determine whether node N denotes a call to Ada.Tags.Displace
 
       function Is_Source_Object (N : Node_Id) return Boolean;
       --  Determine whether a particular node denotes a source object
 
+      function Strip (N : Node_Id) return Node_Id;
+      --  Examine arbitrary node N by stripping various indirections and return
+      --  the "real" node.
+
       ---------------------------------
       -- Is_Controlled_Function_Call --
       ---------------------------------
 
       function Is_Controlled_Function_Call (N : Node_Id) return Boolean is
-         Expr : Node_Id := Original_Node (N);
+         Expr : Node_Id;
 
       begin
          --  When a function call appears in Object.Operation format, the
@@ -7617,6 +7623,7 @@ package body Exp_Util is
          --    Obj.Func (Formal => Actual) N_Function_Call, whose Name is an
          --                                N_Selected_Component
 
+         Expr := Original_Node (N);
          loop
             if Nkind (Expr) = N_Function_Call then
                Expr := Name (Expr);
@@ -7643,31 +7650,28 @@ package body Exp_Util is
              and then Needs_Finalization (Etype (Entity (Expr)));
       end Is_Controlled_Function_Call;
 
+      ----------------------------
+      -- Is_Controlled_Indexing --
+      ----------------------------
+
+      function Is_Controlled_Indexing (N : Node_Id) return Boolean is
+         Expr : constant Node_Id := Original_Node (N);
+
+      begin
+         return
+           Nkind (Expr) = N_Indexed_Component
+             and then Present (Generalized_Indexing (Expr))
+             and then Needs_Finalization (Etype (Expr));
+      end Is_Controlled_Indexing;
+
       ----------------------
       -- Is_Displace_Call --
       ----------------------
 
       function Is_Displace_Call (N : Node_Id) return Boolean is
-         Call : Node_Id;
+         Call : constant Node_Id := Strip (N);
 
       begin
-         --  Strip various actions which may precede a call to Displace
-
-         Call := N;
-         loop
-            if Nkind (Call) = N_Explicit_Dereference then
-               Call := Prefix (Call);
-
-            elsif Nkind_In (Call, N_Type_Conversion,
-                                  N_Unchecked_Type_Conversion)
-            then
-               Call := Expression (Call);
-
-            else
-               exit;
-            end if;
-         end loop;
-
          return
            Present (Call)
              and then Nkind (Call) = N_Function_Call
@@ -7679,38 +7683,48 @@ package body Exp_Util is
       ----------------------
 
       function Is_Source_Object (N : Node_Id) return Boolean is
-         Obj : Node_Id;
+         Obj : constant Node_Id := Strip (N);
 
       begin
-         --  Strip various actions which may be associated with the object
+         return
+           Present (Obj)
+             and then Comes_From_Source (Obj)
+             and then Nkind (Obj) in N_Has_Entity
+             and then Is_Object (Entity (Obj));
+      end Is_Source_Object;
+
+      -----------
+      -- Strip --
+      -----------
+
+      function Strip (N : Node_Id) return Node_Id is
+         Result : Node_Id;
 
-         Obj := N;
+      begin
+         Result := N;
          loop
-            if Nkind (Obj) = N_Explicit_Dereference then
-               Obj := Prefix (Obj);
+            if Nkind (Result) = N_Explicit_Dereference then
+               Result := Prefix (Result);
 
-            elsif Nkind_In (Obj, N_Type_Conversion,
-                                 N_Unchecked_Type_Conversion)
+            elsif Nkind_In (Result, N_Type_Conversion,
+                                    N_Unchecked_Type_Conversion)
             then
-               Obj := Expression (Obj);
+               Result := Expression (Result);
 
             else
                exit;
             end if;
          end loop;
 
-         return
-           Present (Obj)
-             and then Nkind (Obj) in N_Has_Entity
-             and then Is_Object (Entity (Obj))
-             and then Comes_From_Source (Obj);
-      end Is_Source_Object;
+         return Result;
+      end Strip;
 
       --  Local variables
 
-      Decl      : constant Node_Id   := Parent (Obj_Id);
+      Obj_Decl  : constant Node_Id   := Declaration_Node (Obj_Id);
       Obj_Typ   : constant Entity_Id := Base_Type (Etype (Obj_Id));
-      Orig_Decl : constant Node_Id   := Original_Node (Decl);
+      Orig_Decl : constant Node_Id   := Original_Node (Obj_Decl);
+      Orig_Expr : Node_Id;
 
    --  Start of processing for Is_Displacement_Of_Object_Or_Function_Result
 
@@ -7719,34 +7733,52 @@ package body Exp_Util is
 
       --     Obj : CW_Type := Function_Call (...);
 
-      --  rewritten into:
+      --  is rewritten into:
 
-      --     Tmp : ... := Function_Call (...)'reference;
-      --     Obj : CW_Type renames (... Ada.Tags.Displace (Tmp));
+      --     Temp : ... := Function_Call (...)'reference;
+      --     Obj  : CW_Type renames (... Ada.Tags.Displace (Temp));
 
       --  where the return type of the function and the class-wide type require
       --  dispatch table pointer displacement.
 
       --  Case 2:
 
+      --     Obj : CW_Type := Container (...);
+
+      --  is rewritten into:
+
+      --     Temp : ... := Function_Call (Container, ...)'reference;
+      --     Obj  : CW_Type renames (... Ada.Tags.Displace (Temp));
+
+      --  where the container element type and the class-wide type require
+      --  dispatch table pointer dispacement.
+
+      --  Case 3:
+
       --     Obj : CW_Type := Src_Obj;
 
-      --  rewritten into:
+      --  is rewritten into:
 
       --     Obj : CW_Type renames (... Ada.Tags.Displace (Src_Obj));
 
       --  where the type of the source object and the class-wide type require
       --  dispatch table pointer displacement.
 
-      return
-        Nkind (Decl) = N_Object_Renaming_Declaration
-          and then Nkind (Orig_Decl) = N_Object_Declaration
-          and then Comes_From_Source (Orig_Decl)
-          and then Is_Class_Wide_Type (Obj_Typ)
-          and then Is_Displace_Call (Renamed_Object (Obj_Id))
-          and then
-            (Is_Controlled_Function_Call (Expression (Orig_Decl))
-              or else Is_Source_Object (Expression (Orig_Decl)));
+      if Nkind (Obj_Decl) = N_Object_Renaming_Declaration
+        and then Is_Class_Wide_Type (Obj_Typ)
+        and then Is_Displace_Call (Renamed_Object (Obj_Id))
+        and then Nkind (Orig_Decl) = N_Object_Declaration
+        and then Comes_From_Source (Orig_Decl)
+      then
+         Orig_Expr := Expression (Orig_Decl);
+
+         return
+           Is_Controlled_Function_Call (Orig_Expr)
+             or else Is_Controlled_Indexing (Orig_Expr)
+             or else Is_Source_Object (Orig_Expr);
+      end if;
+
+      return False;
    end Is_Displacement_Of_Object_Or_Function_Result;
 
    ------------------------------

gcc/ada/freeze.adb

@@ -1418,8 +1418,8 @@ package body Freeze is
          New_Prag : Node_Id;
 
       begin
-         A_Pre := Get_Pragma (Par_Prim, Pragma_Precondition);
-         if Present (A_Pre) and then Class_Present (A_Pre) then
+         A_Pre := Get_Classwide_Pragma (Par_Prim, Pragma_Precondition);
+         if Present (A_Pre) then
             New_Prag := New_Copy_Tree (A_Pre);
             Build_Class_Wide_Expression
               (Prag          => New_Prag,
@@ -1436,9 +1436,9 @@ package body Freeze is
             end if;
          end if;
 
-         A_Post := Get_Pragma (Par_Prim, Pragma_Postcondition);
+         A_Post := Get_Classwide_Pragma (Par_Prim, Pragma_Postcondition);
 
-         if Present (A_Post) and then Class_Present (A_Post) then
+         if Present (A_Post) then
             New_Prag := New_Copy_Tree (A_Post);
             Build_Class_Wide_Expression
               (Prag           => New_Prag,

gcc/ada/par_sco.adb

@@ -1483,6 +1483,8 @@ package body Par_SCO is
                   To_Node := Last (Parameter_Specifications (N));
                elsif Present (Entry_Index (N)) then
                   To_Node := Entry_Index (N);
+               else
+                  To_Node := Entry_Direct_Name (N);
                end if;
 
             when N_Case_Statement =>

gcc/ada/sem_ch3.adb

@@ -5707,6 +5707,27 @@ package body Sem_Ch3 is
          Conditional_Delay (Id, T);
       end if;
 
+      --  If we have a subtype of an incomplete type whose full type is a
+      --  derived numeric type, we need to have a freeze node for the subtype.
+      --  Otherwise gigi will complain while computing the (static) bounds of
+      --  the subtype.
+
+      if Is_Itype (T)
+        and then Is_Elementary_Type (Id)
+        and then Etype (Id) /= Id
+      then
+         declare
+            Partial : constant Entity_Id :=
+              Incomplete_Or_Partial_View (First_Subtype (Id));
+         begin
+            if Present (Partial)
+              and then Ekind (Partial) = E_Incomplete_Type
+            then
+               Set_Has_Delayed_Freeze (Id);
+            end if;
+         end;
+      end if;
+
       --  Check that Constraint_Error is raised for a scalar subtype indication
       --  when the lower or upper bound of a non-null range lies outside the
       --  range of the type mark.

gcc/ada/sem_ch7.adb

@@ -193,7 +193,7 @@ package body Sem_Ch7 is
    -- Analyze_Package_Body_Helper Data and Subprograms --
    ------------------------------------------------------
 
-   Entity_Table_Size : constant := 4096;
+   Entity_Table_Size : constant := 4093;
    --  Number of headers in hash table
 
    subtype Entity_Header_Num is Integer range 0 .. Entity_Table_Size - 1;

gcc/ada/sem_warn.adb

@@ -1388,15 +1388,18 @@ package body Sem_Warn is
                   --  an expression with actions.
 
                   UR := Original_Node (UR);
-                  while Nkind_In (UR, N_Attribute_Reference,
-                                      N_Expression_With_Actions,
+                  loop
+                     if Nkind_In (UR, N_Expression_With_Actions,
                                       N_Qualified_Expression,
                                       N_Type_Conversion)
-                  loop
-                     if Nkind (UR) = N_Attribute_Reference then
+                     then
+                        UR := Expression (UR);
+
+                     elsif Nkind (UR) = N_Attribute_Reference then
                         UR := Prefix (UR);
+
                      else
-                        UR := Expression (UR);
+                        exit;
                      end if;
                   end loop;
 

gcc/ada/sysdep.c

@@ -921,16 +921,40 @@ __gnat_is_file_not_found_error (int errno_val) {
 
 #if defined (__linux__)
 
-/* HAVE_CAPABILITY is defined if sys/capability.h exists on the system where
-   this is being compiled.
+/* Note well: If this code is modified, it should be tested by hand,
+   because automated testing doesn't exercise it.
+*/
+
+/* HAVE_CAPABILITY is supposed to be defined if sys/capability.h exists on the
+   system where this is being compiled. If this macro is defined, we #include
+   the header. Otherwise we have the relevant declarations textually here.
 */
 
 #if defined (HAVE_CAPABILITY)
 #include <sys/capability.h>
+#else
 
-/* Note well: If this code is modified, it should be tested by hand,
-   because automated testing doesn't exercise it.
-*/
+/* HAVE_CAPABILITY is not defined, so sys/capability.h does might not exist. */
+
+typedef struct _cap_struct *cap_t;
+typedef enum {
+    CAP_CLEAR=0,
+    CAP_SET=1
+} cap_flag_value_t;
+#define CAP_SYS_NICE         23
+typedef enum {
+    CAP_EFFECTIVE=0,                        /* Specifies the effective flag */
+    CAP_PERMITTED=1,                        /* Specifies the permitted flag */
+    CAP_INHERITABLE=2                     /* Specifies the inheritable flag */
+} cap_flag_t;
+
+typedef int cap_value_t;
+
+extern cap_t   cap_get_proc(void);
+extern int     cap_get_flag(cap_t, cap_value_t, cap_flag_t, cap_flag_value_t *);
+extern int     cap_free(void *);
+
+#endif
 
 /* __gnat_has_cap_sys_nice returns 1 if the current process has the
    CAP_SYS_NICE capability. This capability is necessary to use the
@@ -945,9 +969,12 @@ __gnat_is_file_not_found_error (int errno_val) {
    symbols will be 0, and __gnat_has_cap_sys_nice will return 0.
 */
 
-static cap_t cap_get_proc_weak() __attribute__ ((weakref ("cap_get_proc")));
-static int cap_get_flag_weak() __attribute__ ((weakref ("cap_get_flag")));
-static int cap_free_weak() __attribute__ ((weakref ("cap_free")));
+static cap_t cap_get_proc_weak(void)
+  __attribute__ ((weakref ("cap_get_proc")));
+static int cap_get_flag_weak(cap_t, cap_value_t, cap_flag_t, cap_flag_value_t *)
+  __attribute__ ((weakref ("cap_get_flag")));
+static int cap_free_weak(void *)
+  __attribute__ ((weakref ("cap_free")));
 
 int
 __gnat_has_cap_sys_nice () {
@@ -957,11 +984,11 @@ __gnat_has_cap_sys_nice () {
     return 0;
 
   cap_t caps = cap_get_proc_weak();
-  cap_flag_value_t value;
-
   if (caps == NULL)
     return 0;
 
+  cap_flag_value_t value;
+
   if (cap_get_flag_weak(caps, CAP_SYS_NICE, CAP_EFFECTIVE, &value) == -1)
     return 0;
 
@@ -973,20 +1000,6 @@ __gnat_has_cap_sys_nice () {
 
   return 0;
 }
-
-#else
-
-/* HAVE_CAPABILITY is not defined, so sys/capability.h does not exist, so
-   simply indicate that the current process does not have the CAP_SYS_NICE
-   capability.
-*/
-
-int
-__gnat_has_cap_sys_nice () {
-  return 0;
-}
-
-#endif
 #endif
 
 #ifdef __ANDROID__