[gcc r13-289] [Ada] Properly reject unsupported address specifications

[gcc r13-289] [Ada] Properly reject unsupported address specifications

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:88e9690610c421a7ece2331828b9799755d7ddba

commit r13-289-g88e9690610c421a7ece2331828b9799755d7ddba
Author: Steve Baird <baird@adacore.com>
Date:   Mon Jan 24 16:46:58 2022 -0800

    [Ada] Properly reject unsupported address specifications
    
    In the case of an object declaration with an indefinite nominal subtype
    (roughly speaking, that's an object that takes its bounds,
    discriminants, and/or tag from its explicit initial value), GNAT does
    not support address specifications unless the size of the object is
    known at compile time.  In some cases, such unsupported address
    specifications were not properly rejected. This could lead to either an
    internal error during compilation or (in the class-wide case) to a
    warning accompanied by raising Program_Error at run time.
    
    gcc/ada/
    
            * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Replace
            the existing check for an address specification for an object of
            a class-wide type with a more general check which rejects either
            the class-wide case or the case where the FE would (if the
            address specification were accepted) build a malformed
            tree (specifically, an object renaming declaration with a
            specified address). In the case where the check fails, reject
            the construct at compile time instead of generating an
            unconditional raise of Program_Error.
            * doc/gnat_rm/representation_clauses_and_pragmas.rst: Update
            documentation to reflect these changes.
            * gnat_rm.texi: Regenerate.

Diff:
---
 .../gnat_rm/representation_clauses_and_pragmas.rst | 17 ++++++--
 gcc/ada/gnat_rm.texi                               | 17 ++++++--
 gcc/ada/sem_ch13.adb                               | 51 ++++++++++++++++------
 3 files changed, 66 insertions(+), 19 deletions(-)

diff --git a/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst b/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst
index f755fc1cf52..3bb579b4ba0 100644
--- a/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst
+++ b/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst
@@ -1585,9 +1585,20 @@ check Alignment_Check is suppressed, or if
 ``pragma Restrictions (No_Elaboration_Code)`` is in effect. It is also
 suppressed by default on non-strict alignment machines (such as the x86).
 
-Finally, GNAT does not permit overlaying of objects of class-wide types. In
-most cases, the compiler can detect an attempt at such overlays and will
-generate a warning at compile time and a Program_Error exception at run time.
+In some cases, GNAT does not support an address specification (using either
+form of aspect specification syntax) for the declaration of an object that has
+an indefinite nominal subtype. An object declaration has an indefinite
+nominal subtype if it takes its bounds (for an array type), discriminant
+values (for a discriminated type whose discriminants lack defaults), or tag
+(for a class-wide type) from its initial value, as in
+
+.. code-block:: ada
+
+    X : String := Some_Function_Call;
+    -- String has no constraint, so bounds for X come from function call
+
+This restriction does not apply if the size of the object's initial value is
+known at compile time and the type of the object is not class-wide.
 
 .. index:: Export
 
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 814b4d34cef..388528b3439 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -20176,9 +20176,20 @@ check Alignment_Check is suppressed, or if
 @code{pragma Restrictions (No_Elaboration_Code)} is in effect. It is also
 suppressed by default on non-strict alignment machines (such as the x86).
 
-Finally, GNAT does not permit overlaying of objects of class-wide types. In
-most cases, the compiler can detect an attempt at such overlays and will
-generate a warning at compile time and a Program_Error exception at run time.
+In some cases, GNAT does not support an address specification (using either
+form of aspect specification syntax) for the declaration of an object that has
+an indefinite nominal subtype. An object declaration has an indefinite
+nominal subtype if it takes its bounds (for an array type), discriminant
+values (for a discriminated type whose discriminants lack defaults), or tag
+(for a class-wide type) from its initial value, as in
+
+@example
+X : String := Some_Function_Call;
+-- String has no constraint, so bounds for X come from function call
+@end example
+
+This restriction does not apply if the size of the object’s initial value is
+known at compile time and the type of the object is not class-wide.
 
 @geindex Export
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index cf1943889b3..3cac123b134 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6550,22 +6550,47 @@ package body Sem_Ch13 is
                     ("\?j?use interrupt procedure instead", N);
                end if;
 
-            --  Case of an address clause for a class-wide object, which is
-            --  considered erroneous.
-
-            elsif Is_Class_Wide_Type (Etype (U_Ent)) then
-               Error_Msg_NE
-                 ("??class-wide object & must not be overlaid", Nam, U_Ent);
-               Error_Msg_N
-                 ("\??Program_Error will be raised at run time", Nam);
-               Insert_Action (Declaration_Node (U_Ent),
-                 Make_Raise_Program_Error (Loc,
-                   Reason => PE_Overlaid_Controlled_Object));
-               return;
-
             --  Case of address clause for an object
 
             elsif Ekind (U_Ent) in E_Constant | E_Variable then
+
+               --  Disallow case of an address clause for an object of an
+               --  indefinite subtype which takes its bounds/discriminant/tag
+               --  from its initial value. Without this, we get a Gigi
+               --  assertion failure for things like
+               --    X : String := Some_Function (...) with Address => ...;
+               --  where the result subtype of the function is unconstrained.
+               --
+               --  We want to reject two cases: the class-wide case, and the
+               --  case where the FE conjures up a renaming declaration and
+               --  would then otherwise generate an address specification for
+               --  that renaming (which is a malformed tree, which is why Gigi
+               --  complains).
+
+               if Is_Class_Wide_Type (Etype (U_Ent)) then
+                  Error_Msg_N
+                    ("address specification not supported for class-wide " &
+                     "object declaration", Nam);
+                  return;
+               elsif Is_Constr_Subt_For_U_Nominal (Etype (U_Ent))
+                 and then
+                   Nkind (Parent (U_Ent)) = N_Object_Renaming_Declaration
+               then
+                  --  Confirm accuracy of " and dynamic size" message text
+                  --  before including it. We want to include that text when
+                  --  it is correct because it may be useful to the reader.
+                  --  The case where we omit that part of the message text
+                  --  might be dead code, but let's not rely on that.
+
+                  Error_Msg_N
+                    ("address specification not supported for object " &
+                     "declaration with indefinite nominal subtype" &
+                     (if Size_Known_At_Compile_Time (Etype (U_Ent))
+                      then ""
+                      else " and dynamic size"), Nam);
+                  return;
+               end if;
+
                declare
                   Expr  : constant Node_Id := Expression (N);
                   O_Ent : Entity_Id;