Commit c42aba6b by Arnaud Charlet

[multiple changes]

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.

From-SVN: r235324
parent 2c2870a1
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
......
......@@ -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;
......
......@@ -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;
------------------------
......
......@@ -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;
......
......@@ -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;
......
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment