[multiple changes]

2016-04-21  Eric Botcazou  <ebotcazou@adacore.com>

	* gnatlink.adb (Gnatlink): Robustify detection of Windows target.
	* alloc.ads: Minor comment fixes.
	* einfo.ads: Fix typo.

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

	* exp_aggr.adb (Component_Not_OK_For_Backend): Redo previous
	changes to handle all cases of components depending on the
	discriminant, not just string literals.

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

	* sem_ch3.adb (Analyze_Subtype_Declaration): If the subtype
	declaration is the generated declaration for a generic actual,
	inherit predicates from the actual if it is a predicated subtype.

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

	* exp_ch6.adb (Rewrite_Function_Call_For_C): If the function is
	inherited and its result is controlling,  introduce a conversion
	on the actual for the corresponding procedure call, to avoid
	spurious type errors.

2016-04-21  Jerome Lambourg  <lambourg@adacore.com>

	* krunch.adb (Krunch): Fix krunching of i-vxworks.

From-SVN: r235317
This commit is contained in:
Arnaud Charlet 2016-04-21 10:57:30 +02:00
parent d74716b313
commit 9b7924dd17
8 changed files with 102 additions and 18 deletions

View File

@ -1,3 +1,32 @@
2016-04-21 Eric Botcazou <ebotcazou@adacore.com>
* gnatlink.adb (Gnatlink): Robustify detection of Windows target.
* alloc.ads: Minor comment fixes.
* einfo.ads: Fix typo.
2016-04-21 Arnaud Charlet <charlet@adacore.com>
* exp_aggr.adb (Component_Not_OK_For_Backend): Redo previous
changes to handle all cases of components depending on the
discriminant, not just string literals.
2016-04-21 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Analyze_Subtype_Declaration): If the subtype
declaration is the generated declaration for a generic actual,
inherit predicates from the actual if it is a predicated subtype.
2016-04-21 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb (Rewrite_Function_Call_For_C): If the function is
inherited and its result is controlling, introduce a conversion
on the actual for the corresponding procedure call, to avoid
spurious type errors.
2016-04-21 Jerome Lambourg <lambourg@adacore.com>
* krunch.adb (Krunch): Fix krunching of i-vxworks.
2016-04-21 Gary Dismukes <dismukes@adacore.com>
* exp_aggr.adb: Minor reformatting and code cleanup.

View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, 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- --
@ -30,14 +30,14 @@
------------------------------------------------------------------------------
-- This package contains definitions for initial sizes and growth increments
-- for the various dynamic arrays used for principle compiler data strcutures.
-- for the various dynamic arrays used for the main compiler data structures.
-- The indicated initial size is allocated for the start of each file, and
-- the increment factor is a percentage used to increase the table size when
-- it needs expanding (e.g. a value of 100 = 100% increase = double)
-- Note: the initial values here are multiplied by Table_Factor, as set
-- by the -gnatTnn switch. This variable is defined in Opt, as is the
-- default value for the table factor.
-- Note: the initial values here are multiplied by Table_Factor as set by the
-- -gnatTnn switch. This variable is defined in Opt, as is the default value
-- for the table factor.
package Alloc is

View File

@ -4170,9 +4170,9 @@ package Einfo is
-- of the predicate function. This is the original expression given as
-- the predicate except that occurrences of the type are replaced by
-- occurrences of the formal parameter of the predicate function (note
-- that the spec of this function including this formal parameter name)
-- is available from the Subprograms_For_Type field (it can be accessed
-- as Predicate_Function (typ). Also, in the case where a predicate is
-- that the spec of this function including this formal parameter name
-- is available from the Subprograms_For_Type field; it can be accessed
-- as Predicate_Function (typ)). Also, in the case where a predicate is
-- inherited, the expression is of the form:
--
-- xxxPredicate (typ2 (ent)) AND THEN expression

View File

@ -5918,6 +5918,10 @@ package body Exp_Aggr is
-- semantics of Ada complicate the analysis and lead to anomalies in
-- the gcc back-end if the aggregate is not expanded into assignments.
function Has_Per_Object_Constraint (L : List_Id) return Boolean;
-- Return True if any element of L has Has_Per_Object_Constraint set.
-- L should be the Choices component of an N_Component_Association.
function Has_Visible_Private_Ancestor (Id : E) return Boolean;
-- If any ancestor of the current type is private, the aggregate
-- cannot be built in place. We cannot rely on Has_Private_Ancestor,
@ -6024,7 +6028,8 @@ package body Exp_Aggr is
return True;
elsif Modify_Tree_For_C
and then Ekind (Etype (Expr_Q)) = E_String_Literal_Subtype
and then Nkind (C) = N_Component_Association
and then Has_Per_Object_Constraint (Choices (C))
then
Static_Components := False;
return True;
@ -6051,6 +6056,24 @@ package body Exp_Aggr is
return False;
end Component_Not_OK_For_Backend;
-------------------------------
-- Has_Per_Object_Constraint --
-------------------------------
function Has_Per_Object_Constraint (L : List_Id) return Boolean is
N : Node_Id := First (L);
begin
while Present (N) loop
if Has_Per_Object_Constraint (Associated_Node (N)) then
return True;
end if;
Next (N);
end loop;
return False;
end Has_Per_Object_Constraint;
-----------------------------------
-- Has_Visible_Private_Ancestor --
-----------------------------------

View File

@ -8432,11 +8432,13 @@ package body Exp_Ch6 is
-- Local variables
Func_Id : constant Entity_Id := Ultimate_Alias (Entity (Name (N)));
Orig_Func : constant Entity_Id := Entity (Name (N));
Func_Id : constant Entity_Id := Ultimate_Alias (Orig_Func);
Par : constant Node_Id := Parent (N);
Proc_Id : constant Entity_Id := Rewritten_For_C_Proc_Id (Func_Id);
Loc : constant Source_Ptr := Sloc (Par);
Actuals : List_Id;
Last_Actual : Node_Id;
Last_Formal : Entity_Id;
-- Start of processing for Rewrite_Function_Call_For_C
@ -8467,12 +8469,23 @@ package body Exp_Ch6 is
-- Proc_Call (..., LHS);
-- If function is inherited, a conversion may be necessary.
if Nkind (Par) = N_Assignment_Statement then
Last_Actual := Name (Par);
if not Comes_From_Source (Orig_Func)
and then Etype (Orig_Func) /= Etype (Func_Id)
then
Last_Actual :=
Unchecked_Convert_To (Etype (Func_Id), Last_Actual);
end if;
Append_To (Actuals,
Make_Parameter_Association (Loc,
Selector_Name =>
Make_Identifier (Loc, Chars (Last_Formal)),
Explicit_Actual_Parameter => Name (Par)));
Explicit_Actual_Parameter => Last_Actual));
Rewrite (Par,
Make_Procedure_Call_Statement (Loc,

View File

@ -154,6 +154,8 @@ procedure Gnatlink is
Base_Command_Name : String_Access;
Target_Debuggable_Suffix : String_Access;
Tname : Temp_File_Name;
Tname_FD : File_Descriptor := Invalid_FD;
-- Temporary file used by linker to pass list of object files on
@ -1646,12 +1648,14 @@ begin
Write_Header;
Target_Debuggable_Suffix := Get_Target_Debuggable_Suffix;
-- If no output name specified, then use the base name of .ali file name
if Output_File_Name = null then
Output_File_Name :=
new String'(Base_Name (Ali_File_Name.all)
& Get_Target_Debuggable_Suffix.all);
& Target_Debuggable_Suffix.all);
end if;
Linker_Options.Increment_Last;
@ -1711,12 +1715,9 @@ begin
FN (J) := Csets.Fold_Lower (FN (J));
end loop;
-- For now we detect windows by an output executable name ending with
-- the suffix .exe.
-- For now we detect Windows by its executable suffix of .exe
if FN'Length > 5
and then FN (FN'Last - 3 .. FN'Last) = ".exe"
then
if Target_Debuggable_Suffix.all = ".exe" then
Check_File_Name ("install");
Check_File_Name ("setup");
Check_File_Name ("update");

View File

@ -106,7 +106,7 @@ begin
or else (Curlen = 13 and then Buffer (3 .. 13) = "definitions")
or else (Curlen = 9 and then Buffer (3 .. 9) = "fortran")
or else (Curlen = 16 and then Buffer (3 .. 16) = "packed_decimal")
or else (Curlen > 9 and then Buffer (3 .. 9) = "vxworks")
or else (Curlen > 8 and then Buffer (3 .. 9) = "vxworks")
then
Krlen := 8;
else

View File

@ -5063,6 +5063,24 @@ package body Sem_Ch3 is
Set_Is_Generic_Actual_Type (Id, Is_Generic_Actual_Type (T));
end if;
-- 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)
and then Present (Predicate_Function (T))
then
Set_Subprograms_For_Type (Id, Subprograms_For_Type (T));
if Has_Static_Predicate (T) then
Set_Static_Discrete_Predicate (Id,
Static_Discrete_Predicate (T));
end if;
end if;
-- Remaining processing depends on characteristics of base type
T := Etype (Id);
Set_Is_Immediately_Visible (Id, True);