aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteve Baird <baird@adacore.com>2022-01-24 16:46:58 -0800
committerPierre-Marie de Rodat <derodat@adacore.com>2022-05-11 08:53:17 +0000
commit88e9690610c421a7ece2331828b9799755d7ddba (patch)
treea459437b4cc50bb31c1f5ed96c5034cebed0a04a
parentc48a779f64c68f73f50c5993c818ead9faf8d013 (diff)
downloadgcc-88e9690610c421a7ece2331828b9799755d7ddba.zip
gcc-88e9690610c421a7ece2331828b9799755d7ddba.tar.gz
gcc-88e9690610c421a7ece2331828b9799755d7ddba.tar.bz2
[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.
-rw-r--r--gcc/ada/doc/gnat_rm/representation_clauses_and_pragmas.rst17
-rw-r--r--gcc/ada/gnat_rm.texi17
-rw-r--r--gcc/ada/sem_ch13.adb51
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 f755fc1..3bb579b 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 814b4d3..388528b 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 cf19438..3cac123 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;