Commit 053cf994 by Arnaud Charlet

[multiple changes]

2012-05-15  Thomas Quinot  <quinot@adacore.com>

	* exp_ch4.adb (Has_Inferable_Discriminants): For a qualified
	expression, use correct node for test on the subtype denoted by
	the subtype mark.

2012-05-15  Eric Botcazou  <ebotcazou@adacore.com>

	* inline.adb (Scope_In_Main_Unit): Rename into...
	(In_Main_Unit_Or_Subunit): ...this.  Also return
	true if the subprogram is within a subunit of the
	main unit.
	(Add_Inlined_Body): Adjust for above renaming.
	(Add_Inlined_Subprogram): Likewise.  Pass the subprogram directly.
	(Analyze_Inlined_Bodies): Really set aside inlined subprograms
	not handled by Add_Inlined_Body.

From-SVN: r187528
parent 8a49a499
2012-05-15 Thomas Quinot <quinot@adacore.com>
* exp_ch4.adb (Has_Inferable_Discriminants): For a qualified
expression, use correct node for test on the subtype denoted by
the subtype mark.
2012-05-15 Eric Botcazou <ebotcazou@adacore.com>
* inline.adb (Scope_In_Main_Unit): Rename into...
(In_Main_Unit_Or_Subunit): ...this. Also return
true if the subprogram is within a subunit of the
main unit.
(Add_Inlined_Body): Adjust for above renaming.
(Add_Inlined_Subprogram): Likewise. Pass the subprogram directly.
(Analyze_Inlined_Bodies): Really set aside inlined subprograms
not handled by Add_Inlined_Body.
2012-05-15 Ed Schonberg <schonberg@adacore.com> 2012-05-15 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.adb (Expand_With_Clause): In the context of a generic * sem_ch10.adb (Expand_With_Clause): In the context of a generic
......
...@@ -10105,9 +10105,9 @@ package body Exp_Ch4 is ...@@ -10105,9 +10105,9 @@ package body Exp_Ch4 is
-- mark is a constrained Unchecked_Union subtype. -- mark is a constrained Unchecked_Union subtype.
elsif Nkind (N) = N_Qualified_Expression then elsif Nkind (N) = N_Qualified_Expression then
return Is_Unchecked_Union (Subtype_Mark (N)) return Is_Unchecked_Union (Etype (Subtype_Mark (N)))
and then and then
Is_Constrained (Subtype_Mark (N)); Is_Constrained (Etype (Subtype_Mark (N)));
end if; end if;
......
...@@ -138,8 +138,8 @@ package body Inline is ...@@ -138,8 +138,8 @@ package body Inline is
-- Return the entity node for the unit containing E. Always return -- Return the entity node for the unit containing E. Always return
-- the spec for a package. -- the spec for a package.
function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean; function In_Main_Unit_Or_Subunit (E : Entity_Id) return Boolean;
-- Return True if Scop is in the main unit or its spec -- Return True if E is in the main unit or its spec or in a subunit
procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty); procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty);
-- Make two entries in Inlined table, for an inlined subprogram being -- Make two entries in Inlined table, for an inlined subprogram being
...@@ -341,7 +341,7 @@ package body Inline is ...@@ -341,7 +341,7 @@ package body Inline is
elsif not Is_Inlined (Pack) elsif not Is_Inlined (Pack)
and then Comes_From_Source (E) and then Comes_From_Source (E)
and then not Scope_In_Main_Unit (Pack) and then not In_Main_Unit_Or_Subunit (Pack)
then then
Set_Is_Inlined (Pack); Set_Is_Inlined (Pack);
Inlined_Bodies.Increment_Last; Inlined_Bodies.Increment_Last;
...@@ -433,7 +433,7 @@ package body Inline is ...@@ -433,7 +433,7 @@ package body Inline is
and then (Is_Inlined (Pack) and then (Is_Inlined (Pack)
or else Is_Generic_Instance (Pack) or else Is_Generic_Instance (Pack)
or else Is_Internal (E)) or else Is_Internal (E))
and then not Scope_In_Main_Unit (Pack) and then not In_Main_Unit_Or_Subunit (E)
and then not Is_Nested (E) and then not Is_Nested (E)
and then not Has_Initialized_Type (E) and then not Has_Initialized_Type (E)
then then
...@@ -746,7 +746,7 @@ package body Inline is ...@@ -746,7 +746,7 @@ package body Inline is
-- This means that Add_Inlined_Body added the subprogram to the -- This means that Add_Inlined_Body added the subprogram to the
-- table but wasn't able to handle its code unit. Do nothing. -- table but wasn't able to handle its code unit. Do nothing.
null; Inlined.Table (Index).Processed := True;
elsif Inlined.Table (Index).Main_Call then elsif Inlined.Table (Index).Main_Call then
Pending_Inlined.Increment_Last; Pending_Inlined.Increment_Last;
Pending_Inlined.Table (Pending_Inlined.Last) := Index; Pending_Inlined.Table (Pending_Inlined.Last) := Index;
...@@ -767,9 +767,9 @@ package body Inline is ...@@ -767,9 +767,9 @@ package body Inline is
while S /= No_Succ loop while S /= No_Succ loop
Subp := Successors.Table (S).Subp; Subp := Successors.Table (S).Subp;
Set_Is_Called (Inlined.Table (Subp).Name);
if not Inlined.Table (Subp).Processed then if not Inlined.Table (Subp).Processed then
Set_Is_Called (Inlined.Table (Subp).Name);
Pending_Inlined.Increment_Last; Pending_Inlined.Increment_Last;
Pending_Inlined.Table (Pending_Inlined.Last) := Subp; Pending_Inlined.Table (Pending_Inlined.Last) := Subp;
Inlined.Table (Subp).Processed := True; Inlined.Table (Subp).Processed := True;
...@@ -1156,23 +1156,27 @@ package body Inline is ...@@ -1156,23 +1156,27 @@ package body Inline is
end loop; end loop;
end Remove_Dead_Instance; end Remove_Dead_Instance;
------------------------ -----------------------------
-- Scope_In_Main_Unit -- -- In_Main_Unit_Or_Subunit --
------------------------ -----------------------------
function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean is function In_Main_Unit_Or_Subunit (E : Entity_Id) return Boolean is
Comp : constant Node_Id := Cunit (Get_Code_Unit (Scop)); Comp : Node_Id := Cunit (Get_Code_Unit (E));
begin begin
-- Check whether the scope of the subprogram to inline is within the -- Check whether the subprogram or package to inline is within the main
-- main unit or within its spec. In either case there are no additional -- unit or its spec or within a subunit. In either case there are no
-- bodies to process. If the subprogram appears in a parent of the -- additional bodies to process. If the subprogram appears in a parent
-- current unit, the check on whether inlining is possible is done in -- of the current unit, the check on whether inlining is possible is
-- Analyze_Inlined_Bodies. -- done in Analyze_Inlined_Bodies.
while Nkind (Unit (Comp)) = N_Subunit loop
Comp := Library_Unit (Comp);
end loop;
return return
Comp = Cunit (Main_Unit) Comp = Cunit (Main_Unit)
or else Comp = Library_Unit (Cunit (Main_Unit)); or else Comp = Library_Unit (Cunit (Main_Unit));
end Scope_In_Main_Unit; end In_Main_Unit_Or_Subunit;
end Inline; end Inline;
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