From: Mathias Aparicio <[email protected]>
When a record is frozen it must be completely defined. This requires that
all of its components' types must also be completely defined
ARM 3.11.1 (8).
Before this patch, if a record was frozen while one of its components
was of a private type, the compiler complained that the record had a
private component, although privacy was not the root issue.
Now, the compiler states the actual problem directly: the type is not
completely defined.
gcc/ada/ChangeLog:
* freeze.adb (Check_And_Freeze_Type): Emit a more precise error
message when a component's frozen record is incompletely defined
instead of printing private component error.
* sem_util.ads (Incompletely_Defined): New function that
traverses recursively a type and returns the first incompletely
defined component or itself if it is incompletely defined.
* sem_util.adb (Incompletely_Defined): Likewise.
(Is_Incompletely_Defined): Refactor to a test of the new
Incompletely_Defined function for equality with Empty.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/freeze.adb | 2 +-
gcc/ada/sem_util.adb | 70 ++++++++++++++++++++++++++++++--------------
gcc/ada/sem_util.ads | 12 ++++++++
3 files changed, 61 insertions(+), 23 deletions(-)
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 2b9ef460c36..5a694c99d63 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -9422,7 +9422,7 @@ package body Freeze is
if Is_Incompletely_Defined (Typ)
and then not Is_Private_Type (Typ)
then
- Error_Msg_NE ("\\type& has private component", N, Typ);
+ Error_Msg_NE ("\\type& is not completely defined", N, Typ);
end if;
Explain_Error;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 7feaa6b9879..fb587ee0919 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -18628,14 +18628,23 @@ package body Sem_Util is
-----------------------------
function Is_Incompletely_Defined (Type_Id : Entity_Id) return Boolean is
+ begin
+ return Present (Not_Fully_Declared_Part (Type_Id));
+ end Is_Incompletely_Defined;
+
+ -----------------------------
+ -- Not_Fully_Declared_Part --
+ -----------------------------
+
+ function Not_Fully_Declared_Part
+ (Type_Id : Entity_Id) return Entity_Id
+ is
Btype : Entity_Id := Base_Type (Type_Id);
Component : Entity_Id;
-
begin
- if Error_Posted (Type_Id)
- or else Error_Posted (Btype)
+ if Error_Posted (Type_Id) or else Error_Posted (Btype)
then
- return False;
+ return Empty;
end if;
if Is_Class_Wide_Type (Btype) then
@@ -18648,43 +18657,60 @@ package body Sem_Util is
begin
if No (UT) then
if No (Full_View (Btype)) then
- return not Is_Generic_Type (Btype)
- and then
- not Is_Generic_Type (Root_Type (Btype));
+ if not Is_Generic_Type (Btype)
+ and then
+ not Is_Generic_Type (Root_Type (Btype))
+ then
+ return Btype;
+ end if;
else
- return not Is_Generic_Type (Root_Type (Full_View (Btype)));
+ if not Is_Generic_Type (Root_Type (Full_View (Btype))) then
+ return Btype;
+ end if;
end if;
else
- return
- not Is_Frozen (UT) and then Is_Incompletely_Defined (UT);
+ if not Is_Frozen (UT) then
+ return Not_Fully_Declared_Part (UT);
+ end if;
end if;
+ return Empty;
end;
elsif Is_Array_Type (Btype) then
- return Is_Incompletely_Defined (Component_Type (Btype));
+ return Not_Fully_Declared_Part (Component_Type (Btype));
elsif Is_Record_Type (Btype) then
Component := First_Component (Btype);
- while Present (Component) loop
- if Is_Incompletely_Defined (Etype (Component)) then
- return True;
- end if;
+ declare
+ Inc_par : Entity_Id;
+ begin
+ while Present (Component) loop
+ Inc_par :=
+ Not_Fully_Declared_Part (Etype (Component));
+ if Present (Inc_par) then
+ if Is_Type (Inc_par) then
+ return Component;
+ else
+ return Inc_par;
+ end if;
+ end if;
- Next_Component (Component);
- end loop;
-
- return False;
+ Next_Component (Component);
+ end loop;
+ return Empty;
+ end;
elsif Is_Protected_Type (Btype)
and then Present (Corresponding_Record_Type (Btype))
then
return
- Is_Incompletely_Defined (Corresponding_Record_Type (Btype));
+ Not_Fully_Declared_Part
+ (Corresponding_Record_Type (Btype));
else
- return False;
+ return Empty;
end if;
- end Is_Incompletely_Defined;
+ end Not_Fully_Declared_Part;
---------------------------
-- Is_Independent_Object --
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 5f345273023..e3349a1b595 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2255,6 +2255,18 @@ package Sem_Util is
-- Returns True if N appears within the context clause of a unit, and False
-- for any other placement.
+ function Not_Fully_Declared_Part
+ (Type_Id : Entity_Id) return Entity_Id;
+ -- Given a type, returns the reason it is not "completely defined".
+ -- We say that a type is "completely defined" at a place that is after
+ -- its full type definition (if it has one) and after all of its
+ -- subcomponent types are completely defined (RM 3.11.1 (8)).
+ -- If the return value is not Empty, Type_Id is incompletely defined
+ -- and the returned value points to the responsible subcomponent.
+ --
+ -- Used to enforce the rules on type freezing (RM 13.14), which require
+ -- that a type must be completely defined before it is frozen.
+
function Is_Incompletely_Defined (Type_Id : Entity_Id) return Boolean;
-- Returns True iff Type_Id is incompletely defined. See RM 3.11.1 (8) for
-- the definition of "completely defined". Note that "incompletely defined"
--
2.53.0
