Split out the computation of Returns_By_Ref, to make subsequent changes
easier. General cleanups.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_util.ads, sem_util.adb (Compute_Returns_By_Ref): New
procedure to compute Returns_By_Ref, to avoid some code
duplication. This will likely change soon, so it's good to have
the code in one place.
(CW_Or_Has_Controlled_Part): Move here from Exp_Ch7, because
it's called by Compute_Returns_By_Ref, and this is a better
place for it anyway.
(Needs_Finalization): Fix comment to be vague instead of wrong.
* exp_ch6.adb (Expand_N_Subprogram_Body, Freeze_Subprogram):
Call Compute_Returns_By_Ref.
* sem_ch6.adb (Check_Delayed_Subprogram): Call
Compute_Returns_By_Ref.
* exp_ch7.ads, exp_ch7.adb (CW_Or_Has_Controlled_Part): Move to
Sem_Util.
(Has_New_Controlled_Component): Remove unused function.diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6431,18 +6431,7 @@ package body Exp_Ch6 is
-- Returns_By_Ref flag is normally set when the subprogram is frozen but
-- subprograms with no specs are not frozen.
- declare
- Typ : constant Entity_Id := Etype (Spec_Id);
- Utyp : constant Entity_Id := Underlying_Type (Typ);
-
- begin
- if Is_Limited_View (Typ) then
- Set_Returns_By_Ref (Spec_Id);
-
- elsif Present (Utyp) and then CW_Or_Has_Controlled_Part (Utyp) then
- Set_Returns_By_Ref (Spec_Id);
- end if;
- end;
+ Compute_Returns_By_Ref (Spec_Id);
-- For a procedure, we add a return for all possible syntactic ends of
-- the subprogram.
@@ -7851,18 +7840,7 @@ package body Exp_Ch6 is
-- of the normal semantic analysis of the spec since the underlying
-- returned type may not be known yet (for private types).
- declare
- Typ : constant Entity_Id := Etype (Subp);
- Utyp : constant Entity_Id := Underlying_Type (Typ);
-
- begin
- if Is_Limited_View (Typ) then
- Set_Returns_By_Ref (Subp);
-
- elsif Present (Utyp) and then CW_Or_Has_Controlled_Part (Utyp) then
- Set_Returns_By_Ref (Subp);
- end if;
- end;
+ Compute_Returns_By_Ref (Subp);
-- Wnen freezing a null procedure, analyze its delayed aspects now
-- because we may not have reached the end of the declarative list when
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -5118,15 +5118,6 @@ package body Exp_Ch7 is
end if;
end Convert_View;
- -------------------------------
- -- CW_Or_Has_Controlled_Part --
- -------------------------------
-
- function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean is
- begin
- return Is_Class_Wide_Type (T) or else Needs_Finalization (T);
- end CW_Or_Has_Controlled_Part;
-
------------------------
-- Enclosing_Function --
------------------------
@@ -6130,37 +6121,6 @@ package body Exp_Ch7 is
return Empty;
end Find_Transient_Context;
- ----------------------------------
- -- Has_New_Controlled_Component --
- ----------------------------------
-
- function Has_New_Controlled_Component (E : Entity_Id) return Boolean is
- Comp : Entity_Id;
-
- begin
- if not Is_Tagged_Type (E) then
- return Has_Controlled_Component (E);
- elsif not Is_Derived_Type (E) then
- return Has_Controlled_Component (E);
- end if;
-
- Comp := First_Component (E);
- while Present (Comp) loop
- if Chars (Comp) = Name_uParent then
- null;
-
- elsif Scope (Original_Record_Component (Comp)) = E
- and then Needs_Finalization (Etype (Comp))
- then
- return True;
- end if;
-
- Next_Component (Comp);
- end loop;
-
- return False;
- end Has_New_Controlled_Component;
-
---------------------------------
-- Has_Simple_Protected_Object --
---------------------------------
diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads
--- a/gcc/ada/exp_ch7.ads
+++ b/gcc/ada/exp_ch7.ads
@@ -153,17 +153,6 @@ package Exp_Ch7 is
-- triggered by an abort, E_Id denotes the defining identifier of a local
-- exception occurrence, Raised_Id is the entity of a local boolean flag.
- function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean;
- -- True if T is a class-wide type, or if it has controlled parts ("part"
- -- means T or any of its subcomponents). Same as Needs_Finalization, except
- -- when pragma Restrictions (No_Finalization) applies, in which case we
- -- know that class-wide objects do not contain controlled parts.
-
- function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
- -- E is a type entity. Give the same result as Has_Controlled_Component
- -- except for tagged extensions where the result is True only if the
- -- latest extension contains a controlled component.
-
function Make_Adjust_Call
(Obj_Ref : Node_Id;
Typ : Entity_Id;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -36,7 +36,6 @@ with Errout; use Errout;
with Expander; use Expander;
with Exp_Ch3; use Exp_Ch3;
with Exp_Ch6; use Exp_Ch6;
-with Exp_Ch7; use Exp_Ch7;
with Exp_Ch9; use Exp_Ch9;
with Exp_Dbug; use Exp_Dbug;
with Exp_Tss; use Exp_Tss;
@@ -6748,18 +6747,7 @@ package body Sem_Ch6 is
-- may not be known yet (for private types).
if not Has_Delayed_Freeze (Designator) and then Expander_Active then
- declare
- Typ : constant Entity_Id := Etype (Designator);
- Utyp : constant Entity_Id := Underlying_Type (Typ);
-
- begin
- if Is_Limited_View (Typ) then
- Set_Returns_By_Ref (Designator);
-
- elsif Present (Utyp) and then CW_Or_Has_Controlled_Part (Utyp) then
- Set_Returns_By_Ref (Designator);
- end if;
- end;
+ Compute_Returns_By_Ref (Designator);
end if;
end Check_Delayed_Subprogram;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6672,6 +6672,23 @@ package body Sem_Util is
return N;
end Compile_Time_Constraint_Error;
+ ----------------------------
+ -- Compute_Returns_By_Ref --
+ ----------------------------
+
+ procedure Compute_Returns_By_Ref (Func : Entity_Id) is
+ Typ : constant Entity_Id := Etype (Func);
+ Utyp : constant Entity_Id := Underlying_Type (Typ);
+
+ begin
+ if Is_Limited_View (Typ) then
+ Set_Returns_By_Ref (Func);
+
+ elsif Present (Utyp) and then CW_Or_Has_Controlled_Part (Utyp) then
+ Set_Returns_By_Ref (Func);
+ end if;
+ end Compute_Returns_By_Ref;
+
--------------------------------
-- Collect_Types_In_Hierarchy --
--------------------------------
@@ -7072,6 +7089,15 @@ package body Sem_Util is
end if;
end Current_Subprogram;
+ -------------------------------
+ -- CW_Or_Has_Controlled_Part --
+ -------------------------------
+
+ function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean is
+ begin
+ return Is_Class_Wide_Type (T) or else Needs_Finalization (T);
+ end CW_Or_Has_Controlled_Part;
+
-------------------------------
-- Deepest_Type_Access_Level --
-------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -582,6 +582,9 @@ package Sem_Util is
-- emitted immediately after the main message (and before output of any
-- message indicating that Constraint_Error will be raised).
+ procedure Compute_Returns_By_Ref (Func : Entity_Id);
+ -- Set the Returns_By_Ref flag on Func if appropriate
+
generic
with function Predicate (Typ : Entity_Id) return Boolean;
function Collect_Types_In_Hierarchy
@@ -653,6 +656,12 @@ package Sem_Util is
-- Current_Scope is returned. The returned value is Empty if this is called
-- from a library package which is not within any subprogram.
+ function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean;
+ -- True if T is a class-wide type, or if it has controlled parts ("part"
+ -- means T or any of its subcomponents). Same as Needs_Finalization, except
+ -- when pragma Restrictions (No_Finalization) applies, in which case we
+ -- know that class-wide objects do not contain controlled parts.
+
function Deepest_Type_Access_Level (Typ : Entity_Id) return Uint;
-- Same as Type_Access_Level, except that if the type is the type of an Ada
-- 2012 stand-alone object of an anonymous access type, then return the
@@ -2556,8 +2565,7 @@ package Sem_Util is
-- entity E. If no such instance exits, return Empty.
function Needs_Finalization (Typ : Entity_Id) return Boolean;
- -- Determine whether type Typ is controlled and thus requires finalization
- -- actions.
+ -- True if Typ requires finalization actions
function Needs_One_Actual (E : Entity_Id) return Boolean;
-- Returns True if a function has defaults for all but its first formal,
