Skip to content

Commit f577a9e

Browse files
author
Eric Botcazou
committed
Ada: Fix assertion failure on problematic container aggregate
This is an assertion failure on code using a container aggregate in the primitives referenced by the Aggregate aspect, which cannot work. gcc/ada/ PR ada/120665 * sem_aggr.adb (Resolve_Container_Aggregate): Use robust guards. gcc/testsuite/ * gnat.dg/specs/aggr8.ads: New test.
1 parent fba2f08 commit f577a9e

File tree

2 files changed

+20
-4
lines changed

2 files changed

+20
-4
lines changed

gcc/ada/sem_aggr.adb

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -4054,8 +4054,8 @@ package body Sem_Aggr is
40544054

40554055
if Present (Add_Unnamed_Subp)
40564056
and then No (New_Indexed_Subp)
4057-
and then Present (Etype (Add_Unnamed_Subp))
4058-
and then Etype (Add_Unnamed_Subp) /= Any_Type
4057+
and then Present (Entity (Add_Unnamed_Subp))
4058+
and then Entity (Add_Unnamed_Subp) /= Any_Id
40594059
then
40604060
declare
40614061
Elmt_Type : constant Entity_Id :=
@@ -4101,7 +4101,8 @@ package body Sem_Aggr is
41014101
end;
41024102

41034103
elsif Present (Add_Named_Subp)
4104-
and then Etype (Add_Named_Subp) /= Any_Type
4104+
and then Present (Entity (Add_Named_Subp))
4105+
and then Entity (Add_Named_Subp) /= Any_Id
41054106
then
41064107
declare
41074108
-- Retrieves types of container, key, and element from the
@@ -4155,7 +4156,8 @@ package body Sem_Aggr is
41554156
end;
41564157

41574158
elsif Present (Assign_Indexed_Subp)
4158-
and then Etype (Assign_Indexed_Subp) /= Any_Type
4159+
and then Present (Entity (Assign_Indexed_Subp))
4160+
and then Entity (Assign_Indexed_Subp) /= Any_Id
41594161
then
41604162
-- Indexed Aggregate. Positional or indexed component
41614163
-- can be present, but not both. Choices must be static

gcc/testsuite/gnat.dg/specs/aggr8.ads

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
-- PR ada/120665
2+
-- { dg-do compile }
3+
-- { dg-options "-gnat2022" }
4+
5+
package Aggr8 is
6+
7+
type T is null record
8+
with Aggregate => (Empty => Empty, Add_Named => Add_Named);
9+
10+
function Empty return T is ([]); -- { dg-warning "empty|infinite" }
11+
12+
procedure Add_Named (this : in out T; k : Integer; v : Integer) is null;
13+
14+
end Aggr8;

0 commit comments

Comments
 (0)