https://gcc.gnu.org/g:0c08ca5287e25d19186001b8e677390b7a169d9e

commit r17-1293-g0c08ca5287e25d19186001b8e677390b7a169d9e
Author: Mathias Aparicio <[email protected]>
Date:   Wed Apr 1 15:25:14 2026 +0200

    ada: Improve error message for premature record freezing
    
    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.

Diff:
---
 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 2b9ef460c362..5a694c99d632 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 7feaa6b9879d..fb587ee09191 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;
-
-            Next_Component (Component);
-         end loop;
+         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;
 
-         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 5f345273023d..e3349a1b595b 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"

Reply via email to