+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
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;
-- --
-- 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- --
-- 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
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
(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 :=
-- 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;
------------------------
-- --
-- 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- --
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;
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;
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 (' ');
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
end if;
Write_Info_EOL;
+
+ <<Next_Unit>>
+ null;
end loop;
end;
-- 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;
-- 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
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
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
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;
projects / gcc.git / commitdiff