[multiple changes]

2014-10-31  Eric Botcazou  <ebotcazou@adacore.com>

	* inline.adb (Check_And_Split_Unconstrained_Function): Do not
	test for the presence of nested subprograms.

2014-10-31  Ed Schonberg  <schonberg@adacore.com>

	* aspects.ads, aspects.adb: Add aspect Default_Storage_Pool.
	* sem_ch13.adb (Analyze_One_Aspect): Generate pragma for aspect
	Default_Storage_Pool.

From-SVN: r216959
This commit is contained in:
Arnaud Charlet 2014-10-31 12:09:39 +01:00
parent 88f7d2d148
commit 2ef051289c
5 changed files with 33 additions and 38 deletions

View File

@ -1,3 +1,14 @@
2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
* inline.adb (Check_And_Split_Unconstrained_Function): Do not
test for the presence of nested subprograms.
2014-10-31 Ed Schonberg <schonberg@adacore.com>
* aspects.ads, aspects.adb: Add aspect Default_Storage_Pool.
* sem_ch13.adb (Analyze_One_Aspect): Generate pragma for aspect
Default_Storage_Pool.
2014-10-31 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch6.adb: Remove obsolete comment.

View File

@ -511,6 +511,7 @@ package body Aspects is
Aspect_Default_Component_Value => Aspect_Default_Component_Value,
Aspect_Default_Initial_Condition => Aspect_Default_Initial_Condition,
Aspect_Default_Iterator => Aspect_Default_Iterator,
Aspect_Default_Storage_Pool => Aspect_Default_Storage_Pool,
Aspect_Default_Value => Aspect_Default_Value,
Aspect_Depends => Aspect_Depends,
Aspect_Dimension => Aspect_Dimension,

View File

@ -88,6 +88,7 @@ package Aspects is
Aspect_Default_Component_Value,
Aspect_Default_Initial_Condition, -- GNAT
Aspect_Default_Iterator,
Aspect_Default_Storage_Pool,
Aspect_Default_Value,
Aspect_Depends, -- GNAT
Aspect_Dimension, -- GNAT
@ -314,6 +315,7 @@ package Aspects is
Aspect_Default_Component_Value => Expression,
Aspect_Default_Initial_Condition => Optional_Expression,
Aspect_Default_Iterator => Name,
Aspect_Default_Storage_Pool => Expression,
Aspect_Default_Value => Expression,
Aspect_Depends => Expression,
Aspect_Dimension => Expression,
@ -401,6 +403,7 @@ package Aspects is
Aspect_Default_Component_Value => Name_Default_Component_Value,
Aspect_Default_Initial_Condition => Name_Default_Initial_Condition,
Aspect_Default_Iterator => Name_Default_Iterator,
Aspect_Default_Storage_Pool => Name_Default_Storage_Pool,
Aspect_Default_Value => Name_Default_Value,
Aspect_Depends => Name_Depends,
Aspect_Dimension => Name_Dimension,
@ -616,6 +619,7 @@ package Aspects is
Aspect_Constant_Indexing => Always_Delay,
Aspect_CPU => Always_Delay,
Aspect_Default_Iterator => Always_Delay,
Aspect_Default_Storage_Pool => Always_Delay,
Aspect_Default_Value => Always_Delay,
Aspect_Default_Component_Value => Always_Delay,
Aspect_Discard_Names => Always_Delay,

View File

@ -1894,44 +1894,6 @@ package body Inline is
return;
end if;
-- Do not inline any subprogram that contains nested subprograms,
-- since the backend inlining circuit seems to generate uninitialized
-- references in this case. We know this happens in the case of front
-- end ZCX support, but it also appears it can happen in other cases
-- as well. The backend often rejects attempts to inline in the case
-- of nested procedures anyway, so little if anything is lost by this.
-- Note that this is test is for the benefit of the back-end. There
-- is a separate test for front-end inlining that also rejects nested
-- subprograms.
-- Do not do this test if errors have been detected, because in some
-- error cases, this code blows up, and we don't need it anyway if
-- there have been errors, since we won't get to the linker anyway.
declare
P_Ent : Node_Id;
begin
P_Ent := Body_Id;
loop
P_Ent := Scope (P_Ent);
exit when No (P_Ent) or else P_Ent = Standard_Standard;
if Is_Subprogram (P_Ent) then
Set_Is_Inlined (P_Ent, False);
if Comes_From_Source (P_Ent)
and then (Has_Pragma_Inline (P_Ent))
then
Cannot_Inline
("cannot inline& (nested subprogram)?", N, P_Ent,
Is_Serious => True);
return;
end if;
end if;
end loop;
end;
-- No action needed in stubs since the attribute Body_To_Inline
-- is not available

View File

@ -2236,6 +2236,20 @@ package body Sem_Ch13 is
Insert_Pragma (Aitem);
goto Continue;
-- Default_Storage_Pool
when Aspect_Default_Storage_Pool =>
Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Expression => Relocate_Node (Expr))),
Pragma_Name =>
Name_Default_Storage_Pool);
Decorate (Aspect, Aitem);
Insert_Pragma (Aitem);
goto Continue;
-- Depends
-- Aspect Depends is never delayed because it is equivalent to
@ -8693,6 +8707,9 @@ package body Sem_Ch13 is
when Aspect_Default_Component_Value =>
T := Component_Type (Entity (ASN));
when Aspect_Default_Storage_Pool =>
T := Class_Wide_Type (RTE (RE_Root_Storage_Pool));
-- Default_Value is resolved with the type entity in question
when Aspect_Default_Value =>