2016-04-21 Ed Schonberg <schonberg@adacore.com>

	* sem_ch3.adb (Analyze_Subtype_Declaration): A subtype
	declaration with no aspects, whose subtype_mark is a subtype
	with predicates, inherits the list of subprograms for the type.

2016-04-21  Arnaud Charlet  <charlet@adacore.com>

	* exp_aggr.adb (Has_Per_Object_Constraint): Refine previous
	change.

2016-04-21  Thomas Quinot  <quinot@adacore.com>

	* g-socket.adb (Raise_Host_Error): Include additional Name parameter.

2016-04-21  Ed Schonberg  <schonberg@adacore.com>

	* lib-writ.adb (Write_ALI): Do not record in ali file units
	that are present in the files table but not analyzed. These
	units are present because they appear in the context of units
	named in limited_with clauses, and the unit being compiled does
	not depend semantically on them.

2016-04-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Simplify code to
	create the procedure body for an function returning an array type,
	when generating C code. Reuse the subprogram body rather than
	creating a new one, both as an efficiency measure and because
	in an instance the body may contain global references that must
	be preserved.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@235324 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 115 insertions, 47 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b89c2fac533..45175a3cd3c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,35 @@
+2016-04-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Analyze_Subtype_Declaration): A subtype
+	declaration with no aspects, whose subtype_mark is a subtype
+	with predicates, inherits the list of subprograms for the type.
+
+2016-04-21  Arnaud Charlet  <charlet@adacore.com>
+
+	* exp_aggr.adb (Has_Per_Object_Constraint): Refine previous
+	change.
+
+2016-04-21  Thomas Quinot  <quinot@adacore.com>
+
+	* g-socket.adb (Raise_Host_Error): Include additional Name parameter.
+
+2016-04-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* lib-writ.adb (Write_ALI): Do not record in ali file units
+	that are present in the files table but not analyzed. These
+	units are present because they appear in the context of units
+	named in limited_with clauses, and the unit being compiled does
+	not depend semantically on them.
+
+2016-04-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Simplify code to
+	create the procedure body for an function returning an array type,
+	when generating C code. Reuse the subprogram body rather than
+	creating a new one, both as an efficiency measure and because
+	in an instance the body may contain global references that must
+	be preserved.
+
 2016-04-21  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_ch3.adb, exp_attr.adb, exp_ch6.adb, exp_aggr.adb: Minor
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 75359fc029d..c6b6210fd28 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6092,7 +6092,10 @@ package body Exp_Aggr is
          N : Node_Id := First (L);
       begin
          while Present (N) loop
-            if Has_Per_Object_Constraint (Associated_Node (N)) then
+            if Is_Entity_Name (N)
+              and then Present (Entity (N))
+              and then Has_Per_Object_Constraint (Entity (N))
+            then
                return True;
             end if;
 
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index 59430081c2c..2baa4f7315e 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2001-2014, AdaCore                     --
+--                     Copyright (C) 2001-2016, 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- --
@@ -185,9 +185,10 @@ package body GNAT.Sockets is
    --  Raise Socket_Error with an exception message describing the error code
    --  from errno.
 
-   procedure Raise_Host_Error (H_Error : Integer);
+   procedure Raise_Host_Error (H_Error : Integer; Name : String);
    --  Raise Host_Error exception with message describing error code (note
-   --  hstrerror seems to be obsolete) from h_errno.
+   --  hstrerror seems to be obsolete) from h_errno. Name is the name
+   --  or address that was being looked up.
 
    procedure Narrow (Item : in out Socket_Set_Type);
    --  Update Last as it may be greater than the real last socket
@@ -973,7 +974,7 @@ package body GNAT.Sockets is
                              Res'Access, Buf'Address, Buflen, Err'Access) /= 0
       then
          Netdb_Unlock;
-         Raise_Host_Error (Integer (Err));
+         Raise_Host_Error (Integer (Err), Image (Address));
       end if;
 
       begin
@@ -1015,7 +1016,7 @@ package body GNAT.Sockets is
            (HN, Res'Access, Buf'Address, Buflen, Err'Access) /= 0
          then
             Netdb_Unlock;
-            Raise_Host_Error (Integer (Err));
+            Raise_Host_Error (Integer (Err), Name);
          end if;
 
          return H : constant Host_Entry_Type :=
@@ -1700,11 +1701,12 @@ package body GNAT.Sockets is
    -- Raise_Host_Error --
    ----------------------
 
-   procedure Raise_Host_Error (H_Error : Integer) is
+   procedure Raise_Host_Error (H_Error : Integer; Name : String) is
    begin
       raise Host_Error with
         Err_Code_Image (H_Error)
-          & Host_Error_Messages.Host_Error_Message (H_Error);
+          & Host_Error_Messages.Host_Error_Message (H_Error)
+          & ": " & Name;
    end Raise_Host_Error;
 
    ------------------------
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index b65892ae3b6..34f3628388a 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-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- --
@@ -155,8 +155,9 @@ package body Lib.Writ is
         OA_Setting        => 'O',
         SPARK_Mode_Pragma => Empty);
 
-      --  Parse system.ads so that the checksum is set right
-      --  Style checks are not applied.
+      --  Parse system.ads so that the checksum is set right,
+      --  Style checks are not applied. The Ekind is set to ensure
+      --  that this reference is always present in the ali file.
 
       declare
          Save_Mindex : constant Nat := Multiple_Unit_Index;
@@ -166,6 +167,7 @@ package body Lib.Writ is
          Style_Check := False;
          Initialize_Scanner (Units.Last, System_Source_File_Index);
          Discard_List (Par (Configuration_Pragmas => False));
+         Set_Ekind (Cunit_Entity (Units.Last),  E_Package);
          Style_Check := Save_Style;
          Multiple_Unit_Index := Save_Mindex;
       end;
@@ -1429,6 +1431,17 @@ package body Lib.Writ is
             Units.Table (Unum).Dependency_Num := J;
             Sind := Units.Table (Unum).Source_Index;
 
+            --  The dependency table also contains units that appear in the
+            --  context of a unit loaded through a limited_with clause. These
+            --  units are never analyzed, and thus the main unit does not
+            --  really have a dependency on them.
+
+            if Present (Cunit_Entity (Unum))
+              and then Ekind (Cunit_Entity (Unum)) = E_Void
+            then
+               goto Next_Unit;
+            end if;
+
             Write_Info_Initiate ('D');
             Write_Info_Char (' ');
 
@@ -1452,6 +1465,18 @@ package body Lib.Writ is
                Write_Info_Char (' ');
                Write_Info_Str (Get_Hex_String (Source_Checksum (Sind)));
 
+               --  If the dependency comes from a limited_with clause,
+               --  record limited_checksum.
+               --  Disable for now, until full checksum changes are checked.
+
+               --  if Present (Cunit_Entity (Unum))
+               --    and then From_Limited_With (Cunit_Entity (Unum))
+               --  then
+               --     Write_Info_Char (' ');
+               --     Write_Info_Char ('Y');
+               --     Write_Info_Str (Get_Hex_String (Limited_Chk_Sum (Sind)));
+               --  end if;
+
                --  If subunit, add unit name, omitting the %b at the end
 
                if Present (Cunit (Unum)) then
@@ -1492,6 +1517,9 @@ package body Lib.Writ is
             end if;
 
             Write_Info_EOL;
+
+         <<Next_Unit>>
+            null;
          end loop;
       end;
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 611edbaf5ba..096ba39bcdd 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5066,16 +5066,23 @@ package body Sem_Ch3 is
       --  If this is a subtype declaration for an actual in an instance,
       --  inherit static and dynamic predicates if any.
 
-      if In_Instance
-        and then not Comes_From_Source (N)
-        and then Has_Predicates (T)
+      --  If declaration has no aspect specifications, inherit predicate
+      --  info as well.  Unclear how to handle the case of both specified
+      --  and inherited predicates ??? Other inherited aspects, such as
+      --  invariants, should be OK, but the combination with later pragmas
+      --  may also require special merging.
+
+      if Has_Predicates (T)
         and then Present (Predicate_Function (T))
-      then
-         --  ??? This is dangerous, it may clobber the invariant procedure
 
+         and then
+           ((In_Instance and then not Comes_From_Source (N))
+              or else No (Aspect_Specifications (N)))
+      then
          Set_Subprograms_For_Type (Id, Subprograms_For_Type (T));
 
          if Has_Static_Predicate (T) then
+            Set_Has_Static_Predicate (Id);
             Set_Static_Discrete_Predicate (Id, Static_Discrete_Predicate (T));
          end if;
       end if;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index fe1c898bd18..0263a4efc61 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -3064,7 +3064,6 @@ package body Sem_Ch6 is
       --  Local variables
 
       Save_Ghost_Mode   : constant Ghost_Mode_Type := Ghost_Mode;
-      Cloned_Body_For_C : Node_Id := Empty;
 
    --  Start of processing for Analyze_Subprogram_Body_Helper
 
@@ -3301,6 +3300,33 @@ package body Sem_Ch6 is
          Spec_Id := Build_Private_Protected_Declaration (N);
       end if;
 
+      --  If we are generating C and this is a function returning a constrained
+      --  array type for which we must create a procedure with an extra out
+      --  parameter, build and analyze the body now.  The procedure declaration
+      --  has already been created. We reuse the source body of the function,
+      --  because in an instance it may contain global references that cannot
+      --  be reanalyzed. The source function itself is not used any further,
+      --  so we mark it as having a completion.
+
+      if Expander_Active
+        and then Modify_Tree_For_C
+        and then Present (Spec_Id)
+        and then Ekind (Spec_Id) = E_Function
+        and then Rewritten_For_C (Spec_Id)
+      then
+         Set_Has_Completion (Spec_Id);
+
+         Rewrite (N, Build_Procedure_Body_Form (Spec_Id, N));
+         Analyze (N);
+
+         --  The entity for the created procedure must remain invisible,
+         --  so it does not participate in resolution of subsequent
+         --  references to the function.
+
+         Set_Is_Immediately_Visible (Corresponding_Spec (N), False);
+         return;
+      end if;
+
       --  If a separate spec is present, then deal with freezing issues
 
       if Present (Spec_Id) then
@@ -3677,21 +3703,6 @@ package body Sem_Ch6 is
          return;
       end if;
 
-      --  If we are generating C and this is a function returning a constrained
-      --  array type for which we must create a procedure with an extra out
-      --  parameter then clone the body before it is analyzed. Needed to ensure
-      --  that the body of the built procedure does not have any reference to
-      --  the body of the function.
-
-      if Expander_Active
-        and then Modify_Tree_For_C
-        and then Present (Spec_Id)
-        and then Ekind (Spec_Id) = E_Function
-        and then Rewritten_For_C (Spec_Id)
-      then
-         Cloned_Body_For_C := Copy_Separate_Tree (N);
-      end if;
-
       --  Handle frontend inlining
 
       --  Note: Normally we don't do any inlining if expansion is off, since
@@ -4133,21 +4144,6 @@ package body Sem_Ch6 is
          end if;
       end;
 
-      --  When generating C code, transform a function that returns a
-      --  constrained array type into a procedure with an out parameter
-      --  that carries the return value.
-
-      if Present (Cloned_Body_For_C) then
-         Rewrite (N, Build_Procedure_Body_Form (Spec_Id, Cloned_Body_For_C));
-         Analyze (N);
-
-         --  The entity for the created procedure must remain invisible, so it
-         --  does not participate in resolution of subsequent references to the
-         --  function.
-
-         Set_Is_Immediately_Visible (Corresponding_Spec (N), False);
-      end if;
-
       Ghost_Mode := Save_Ghost_Mode;
    end Analyze_Subprogram_Body_Helper;