aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorBob Duff <duff@adacore.com>2022-05-25 11:51:52 -0400
committerPierre-Marie de Rodat <derodat@adacore.com>2022-07-04 07:45:56 +0000
commit3319015b0a498ed1050d6910f75430a6fc401f50 (patch)
tree6fd43b44b2e5cd783ca893ed67c19599a9e15069 /gcc/ada
parent02e41e69d4762937f6ba927059e22abf84801b32 (diff)
downloadgcc-3319015b0a498ed1050d6910f75430a6fc401f50.zip
gcc-3319015b0a498ed1050d6910f75430a6fc401f50.tar.gz
gcc-3319015b0a498ed1050d6910f75430a6fc401f50.tar.bz2
[Ada] Fix missing error on 'Access of constrained array
For X'Access, the designated subtype of the access type must statically match the nominal subtype of X. This patch fixes a bug where the error was not detected when there is an unrelated declaration of the form "Y : T := X;", where T is an unconstrained array subtype. gcc/ada/ * exp_util.adb (Expand_Subtype_From_Expr): Generate a new subtype when Is_Constr_Subt_For_UN_Aliased is True, so the Is_Constr_Subt_For_U_Nominal flag will not be set on the preexisting subtype. * sem_attr.adb, sem_ch3.adb: Minor.
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/exp_util.adb15
-rw-r--r--gcc/ada/sem_attr.adb4
-rw-r--r--gcc/ada/sem_ch3.adb2
3 files changed, 14 insertions, 7 deletions
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 0f19318..2a7afd4 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -113,7 +113,7 @@ package body Exp_Util is
(Header_Num => Type_Map_Header,
Key => Entity_Id,
Element => Node_Or_Entity_Id,
- No_element => Empty,
+ No_Element => Empty,
Hash => Type_Map_Hash,
Equal => "=");
@@ -5730,8 +5730,17 @@ package body Exp_Util is
or else not Is_Array_Type (Exp_Typ)
or else not Aliased_Present (N))
then
- if Is_Itype (Exp_Typ) then
+ if Is_Itype (Exp_Typ)
+ -- If Exp_Typ was created for a previous declaration whose nominal
+ -- subtype is unconstrained, and that declaration is aliased,
+ -- we need to generate a new subtype, because otherwise the
+ -- Is_Constr_Subt_For_U_Nominal flag will be set on the wrong
+ -- subtype, causing failure to detect non-statically-matching
+ -- subtypes on 'Access of the previously-declared object.
+
+ and then not Is_Constr_Subt_For_UN_Aliased (Exp_Typ)
+ then
-- Within an initialization procedure, a selected component
-- denotes a component of the enclosing record, and it appears as
-- an actual in a call to its own initialization procedure. If
@@ -5770,7 +5779,7 @@ package body Exp_Util is
-- This type is marked as an itype even though it has an explicit
-- declaration since otherwise Is_Generic_Actual_Type can get
-- set, resulting in the generation of spurious errors. (See
- -- sem_ch8.Analyze_Package_Renaming and sem_type.covers)
+ -- sem_ch8.Analyze_Package_Renaming and Sem_Type.Covers.)
Set_Is_Itype (T);
Set_Associated_Node_For_Itype (T, Exp);
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index e6e06f6..ab6c2c6 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -11632,9 +11632,7 @@ package body Sem_Attr is
end if;
end if;
- if (Attr_Id = Attribute_Access
- or else
- Attr_Id = Attribute_Unchecked_Access)
+ if Attr_Id in Attribute_Access | Attribute_Unchecked_Access
and then (Ekind (Btyp) = E_General_Access_Type
or else Ekind (Btyp) = E_Anonymous_Access_Type)
then
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 3bbb788..84971e3 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -18276,7 +18276,7 @@ package body Sem_Ch3 is
begin
-- If the parent is a component_definition node we climb to the
- -- component_declaration node
+ -- component_declaration node.
if Nkind (P) = N_Component_Definition then
P := Parent (P);