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.
Tested on x86_64-pc-linux-gnu, committed on trunk
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 --git a/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst b/gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst
--- 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
--- 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
--- 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;
