]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Fix constraint-related legality checks in extended return statements
authorPiotr Trojanek <trojanek@adacore.com>
Tue, 10 Jun 2025 14:29:30 +0000 (16:29 +0200)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Thu, 3 Jul 2025 08:16:26 +0000 (10:16 +0200)
Legality checks in extended return statements were (almost) literally
implementing the RM rules, but the when analyzing the return object declaration
we replace the nominal subtype of that object with its constrained subtype.
(It is a bit odd to have such an expansion activity in analysis, but we already
rely on this particular expansion in quite a few places).

gcc/ada/ChangeLog:

* sem_ch3.adb (Check_Return_Subtype_Indication): Use the nominal
subtype of a return object; literally implement the RM rule about
elementary types; check for static subtype compatibility both when
the subtype is given as a subtype mark and a subtype indication.

gcc/ada/sem_ch3.adb

index b4342af134e6041ae2b43b81e8c32e2ba7e261a7..0afc65da52c3e880204ddbbebe32be2c23900079 100644 (file)
@@ -4163,7 +4163,7 @@ package body Sem_Ch3 is
 
       procedure Check_Return_Subtype_Indication (Obj_Decl : Node_Id) is
          Obj_Id  : constant Entity_Id := Defining_Identifier (Obj_Decl);
-         Obj_Typ : constant Entity_Id := Etype (Obj_Id);
+         Obj_Typ : Entity_Id := Etype (Obj_Id);
          Func_Id : constant Entity_Id := Return_Applies_To (Scope (Obj_Id));
          R_Typ   : constant Entity_Id := Etype (Func_Id);
          Indic   : constant Node_Id   :=
@@ -4199,6 +4199,15 @@ package body Sem_Ch3 is
             return;
          end if;
 
+         --  The return object type could have been rewritten into a
+         --  constrained type, so for the legality checks that follow we need
+         --  to recover the nominal unconstrained type.
+
+         if Is_Constr_Subt_For_U_Nominal (Obj_Typ) then
+            Obj_Typ := Etype (Obj_Typ);
+            pragma Assert (not Is_Constrained (Obj_Typ));
+         end if;
+
          --  "return access T" case; check that the return statement also has
          --  "access T", and that the subtypes statically match:
          --   if this is an access to subprogram the signatures must match.
@@ -4267,7 +4276,7 @@ package body Sem_Ch3 is
 
             --  AI05-103: for elementary types, subtypes must statically match
 
-            if Is_Constrained (R_Typ) or else Is_Access_Type (R_Typ) then
+            if Is_Elementary_Type (R_Typ) then
                if not Subtypes_Statically_Match (Obj_Typ, R_Typ) then
                   Error_No_Match (Indic);
                end if;
@@ -4283,8 +4292,7 @@ package body Sem_Ch3 is
             --  code is expanded on the basis of the base type (see subprogram
             --  Stream_Base_Type).
 
-            elsif Nkind (Indic) = N_Subtype_Indication
-              and then not Subtypes_Statically_Compatible (Obj_Typ, R_Typ)
+            elsif not Subtypes_Statically_Compatible (Obj_Typ, R_Typ)
               and then not Is_TSS (Func_Id, TSS_Stream_Input)
             then
                Error_Msg_N