[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:
parent
d74716b313
commit
9b7924dd17
@ -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.
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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 --
|
||||
-----------------------------------
|
||||
|
@ -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,
|
||||
|
@ -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");
|
||||
|
@ -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
|
||||
|
@ -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);
|
||||
|
Loading…
Reference in New Issue
Block a user