From: Ronan Desplanques <[email protected]>
gcc/ada/ChangeLog:
* sem_util.adb, sem_util.ads (Partially_Visible_Subcomponent): Move
to right spot.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_util.adb | 186 +++++++++++++++++++++----------------------
gcc/ada/sem_util.ads | 20 ++---
2 files changed, 103 insertions(+), 103 deletions(-)
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 0f576a3941c..89060c31acd 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -26981,6 +26981,99 @@ package body Sem_Util is
return Empty;
end Param_Entity;
+ ------------------------------------
+ -- Partially_Visible_Subcomponent --
+ ------------------------------------
+
+ function Partially_Visible_Subcomponent
+ (Type_Id : Entity_Id) return Entity_Id
+ is
+ Ancestor : constant Entity_Id := Base_Type (Type_Id);
+
+ function Trace_Components
+ (T : Entity_Id;
+ Check : Boolean) return Entity_Id;
+ -- Recursive function that does the work, and checks against circular
+ -- definition for each subcomponent type.
+
+ ----------------------
+ -- Trace_Components --
+ ----------------------
+
+ function Trace_Components
+ (T : Entity_Id;
+ Check : Boolean) return Entity_Id
+ is
+ Btype : constant Entity_Id := Base_Type (T);
+ Component : Entity_Id;
+ P : Entity_Id;
+ Candidate : Entity_Id := Empty;
+
+ begin
+ if Check and then Btype = Ancestor then
+ Error_Msg_N ("circular type definition", Type_Id);
+ return Any_Type;
+ end if;
+
+ if Is_Private_Type (Btype) and then not Is_Generic_Type (Btype) then
+ if Present (Full_View (Btype))
+ and then Is_Record_Type (Full_View (Btype))
+ and then not Is_Frozen (Btype)
+ then
+ -- To indicate that the ancestor depends on a private type, the
+ -- current Btype is sufficient. However, to check for circular
+ -- definition we must recurse on the full view.
+
+ Candidate := Trace_Components (Full_View (Btype), True);
+
+ if Candidate = Any_Type then
+ return Any_Type;
+ else
+ return Btype;
+ end if;
+
+ else
+ return Btype;
+ end if;
+
+ elsif Is_Array_Type (Btype) then
+ return Trace_Components (Component_Type (Btype), True);
+
+ elsif Is_Record_Type (Btype) then
+ Component := First_Entity (Btype);
+ while Present (Component)
+ and then Comes_From_Source (Component)
+ loop
+ -- Skip anonymous types generated by constrained components
+
+ if not Is_Type (Component) then
+ P := Trace_Components (Etype (Component), True);
+
+ if Present (P) then
+ if P = Any_Type then
+ return P;
+ else
+ Candidate := P;
+ end if;
+ end if;
+ end if;
+
+ Next_Entity (Component);
+ end loop;
+
+ return Candidate;
+
+ else
+ return Empty;
+ end if;
+ end Trace_Components;
+
+ -- Start of processing for Private_Component
+
+ begin
+ return Trace_Components (Type_Id, False);
+ end Partially_Visible_Subcomponent;
+
----------------------
-- Policy_In_Effect --
----------------------
@@ -27241,99 +27334,6 @@ package body Sem_Util is
end if;
end Predicate_Tests_On_Arguments;
- ------------------------------------
- -- Partially_Visible_Subcomponent --
- ------------------------------------
-
- function Partially_Visible_Subcomponent
- (Type_Id : Entity_Id) return Entity_Id
- is
- Ancestor : constant Entity_Id := Base_Type (Type_Id);
-
- function Trace_Components
- (T : Entity_Id;
- Check : Boolean) return Entity_Id;
- -- Recursive function that does the work, and checks against circular
- -- definition for each subcomponent type.
-
- ----------------------
- -- Trace_Components --
- ----------------------
-
- function Trace_Components
- (T : Entity_Id;
- Check : Boolean) return Entity_Id
- is
- Btype : constant Entity_Id := Base_Type (T);
- Component : Entity_Id;
- P : Entity_Id;
- Candidate : Entity_Id := Empty;
-
- begin
- if Check and then Btype = Ancestor then
- Error_Msg_N ("circular type definition", Type_Id);
- return Any_Type;
- end if;
-
- if Is_Private_Type (Btype) and then not Is_Generic_Type (Btype) then
- if Present (Full_View (Btype))
- and then Is_Record_Type (Full_View (Btype))
- and then not Is_Frozen (Btype)
- then
- -- To indicate that the ancestor depends on a private type, the
- -- current Btype is sufficient. However, to check for circular
- -- definition we must recurse on the full view.
-
- Candidate := Trace_Components (Full_View (Btype), True);
-
- if Candidate = Any_Type then
- return Any_Type;
- else
- return Btype;
- end if;
-
- else
- return Btype;
- end if;
-
- elsif Is_Array_Type (Btype) then
- return Trace_Components (Component_Type (Btype), True);
-
- elsif Is_Record_Type (Btype) then
- Component := First_Entity (Btype);
- while Present (Component)
- and then Comes_From_Source (Component)
- loop
- -- Skip anonymous types generated by constrained components
-
- if not Is_Type (Component) then
- P := Trace_Components (Etype (Component), True);
-
- if Present (P) then
- if P = Any_Type then
- return P;
- else
- Candidate := P;
- end if;
- end if;
- end if;
-
- Next_Entity (Component);
- end loop;
-
- return Candidate;
-
- else
- return Empty;
- end if;
- end Trace_Components;
-
- -- Start of processing for Private_Component
-
- begin
- return Trace_Components (Type_Id, False);
- end Partially_Visible_Subcomponent;
-
---------------------------
-- Primitive_Names_Match --
---------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 98a7ae8be51..df7296d527f 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -3041,6 +3041,16 @@ package Sem_Util is
-- of the corresponding formal entity, otherwise returns Empty. Also
-- handles the case of references to renamings of formals.
+ function Partially_Visible_Subcomponent
+ (Type_Id : Entity_Id) return Entity_Id;
+ -- If there exist any subcomponents of Type_Id whose types are currently
+ -- only partially visible, returns one such subcomponent. Otherwise returns
+ -- Empty. Used to enforce the rules on visibility of operations on
+ -- composite types, that depend on the full view of the subcomponent types.
+ --
+ -- We say that a type is "partially visible" when it has a partial view
+ -- that is currently visible but no full view that is currently visible.
+
function Policy_In_Effect
(Policy : Name_Id;
Level : Name_Id := No_Name)
@@ -3093,16 +3103,6 @@ package Sem_Util is
-- with a special name to avoid being overridden (i.e. return true in case
-- of entities with names "nameP" and "name" or vice versa).
- function Partially_Visible_Subcomponent
- (Type_Id : Entity_Id) return Entity_Id;
- -- If there exist any subcomponents of Type_Id whose types are currently
- -- only partially visible, returns one such subcomponent. Otherwise returns
- -- Empty. Used to enforce the rules on visibility of operations on
- -- composite types, that depend on the full view of the subcomponent types.
- --
- -- We say that a type is "partially visible" when it has a partial view
- -- that is currently visible but no full view that is currently visible.
-
procedure Process_End_Label
(N : Node_Id;
Typ : Character;
--
2.53.0
