mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-11 01:30:55 +08:00
Fix internal error on locally-defined subpools
If the type is derived in the current compilation unit, and Allocate is not overridden on derivation (as is typically the case with Root_Storage_Pool_With_Subpools), the entity for Allocate of the derived type is an alias for System.Storage_Pools.Subpools.Allocate. The main assertion in gnat_to_gnu_entity fails in this case, since this is not a definition and Is_Public is false (since the entity is nested in the same compilation unit). 2020-03-11 Richard Wai <richard@annexi-strayline.com> * gcc-interface/decl.c (gnat_to_gnu_entity): Also test Is_Public on the Alias of the entitiy, if is present, in the main assertion.
This commit is contained in:
parent
42bc589e87
commit
a5aac267e6
@ -1,3 +1,8 @@
|
||||
2020-03-11 Richard Wai <richard@annexi-strayline.com>
|
||||
|
||||
* gcc-interface/decl.c (gnat_to_gnu_entity): Also test Is_Public on
|
||||
the Alias of the entitiy, if is present, in the main assertion.
|
||||
|
||||
2020-02-06 Alexandre Oliva <oliva@adacore.com>
|
||||
|
||||
* raise-gcc.c (personality_body) [__ARM_EABI_UNWINDER__]:
|
||||
|
@ -446,7 +446,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
|
||||
|
||||
/* If we get here, it means we have not yet done anything with this entity.
|
||||
If we are not defining it, it must be a type or an entity that is defined
|
||||
elsewhere or externally, otherwise we should have defined it already. */
|
||||
elsewhere or externally, otherwise we should have defined it already.
|
||||
|
||||
One exception is for an entity, typically an inherited operation, which is
|
||||
a local alias for the parent's operation. It is neither defined, since it
|
||||
is an inherited operation, nor public, since it is declared in the current
|
||||
compilation unit, so we test Is_Public on the Alias entity instead. */
|
||||
gcc_assert (definition
|
||||
|| is_type
|
||||
|| kind == E_Discriminant
|
||||
@ -454,6 +459,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
|
||||
|| kind == E_Label
|
||||
|| (kind == E_Constant && Present (Full_View (gnat_entity)))
|
||||
|| Is_Public (gnat_entity)
|
||||
|| (Present (Alias (gnat_entity))
|
||||
&& Is_Public (Alias (gnat_entity)))
|
||||
|| type_annotate_only);
|
||||
|
||||
/* Get the name of the entity and set up the line number and filename of
|
||||
|
@ -1,3 +1,7 @@
|
||||
2020-03-11 Richard Wai <richard@annexi-strayline.com>
|
||||
|
||||
* gnat.dg/subpools1.adb: New test.
|
||||
|
||||
2020-03-11 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR target/94121
|
||||
|
82
gcc/testsuite/gnat.dg/subpools1.adb
Normal file
82
gcc/testsuite/gnat.dg/subpools1.adb
Normal file
@ -0,0 +1,82 @@
|
||||
-- { dg-do compile }
|
||||
|
||||
with System.Storage_Elements;
|
||||
with System.Storage_Pools.Subpools;
|
||||
|
||||
procedure Subpools1 is
|
||||
|
||||
use System.Storage_Pools.Subpools;
|
||||
|
||||
package Local_Pools is
|
||||
|
||||
use System.Storage_Elements;
|
||||
|
||||
type Local_Pool is new Root_Storage_Pool_With_Subpools with null record;
|
||||
|
||||
overriding
|
||||
function Create_Subpool (Pool: in out Local_Pool)
|
||||
return not null Subpool_Handle;
|
||||
|
||||
overriding
|
||||
procedure Allocate_From_Subpool
|
||||
(Pool : in out Local_Pool;
|
||||
Storage_Address : out System.Address;
|
||||
Size_In_Storage_Elements: in Storage_Count;
|
||||
Alignment : in Storage_Count;
|
||||
Subpool : in not null Subpool_Handle);
|
||||
|
||||
overriding
|
||||
procedure Deallocate_Subpool
|
||||
(Pool : in out Local_Pool;
|
||||
Subpool: in out Subpool_Handle) is null;
|
||||
|
||||
end Local_Pools;
|
||||
|
||||
package body Local_Pools is
|
||||
|
||||
type Local_Subpool is new Root_Subpool with null record;
|
||||
|
||||
Dummy_Subpool: aliased Local_Subpool;
|
||||
|
||||
overriding
|
||||
function Create_Subpool (Pool: in out Local_Pool)
|
||||
return not null Subpool_Handle
|
||||
is
|
||||
begin
|
||||
return Result: not null Subpool_Handle
|
||||
:= Dummy_Subpool'Unchecked_Access
|
||||
do
|
||||
Set_Pool_Of_Subpool (Result, Pool);
|
||||
end return;
|
||||
end;
|
||||
|
||||
overriding
|
||||
procedure Allocate_From_Subpool
|
||||
(Pool : in out Local_Pool;
|
||||
Storage_Address : out System.Address;
|
||||
Size_In_Storage_Elements: in Storage_Count;
|
||||
Alignment : in Storage_Count;
|
||||
Subpool : in not null Subpool_Handle)
|
||||
is
|
||||
type Storage_Array_Access is access Storage_Array;
|
||||
|
||||
New_Alloc: Storage_Array_Access
|
||||
:= new Storage_Array (1 .. Size_In_Storage_Elements + Alignment);
|
||||
begin
|
||||
for SE of New_Alloc.all loop
|
||||
Storage_Address := SE'Address;
|
||||
exit when Storage_Address mod Alignment = 0;
|
||||
end loop;
|
||||
end;
|
||||
|
||||
end Local_Pools;
|
||||
|
||||
A_Pool: Local_Pools.Local_Pool;
|
||||
|
||||
type Integer_Access is access Integer with Storage_Pool => A_Pool;
|
||||
|
||||
X: Integer_Access := new Integer;
|
||||
|
||||
begin
|
||||
null;
|
||||
end;
|
Loading…
x
Reference in New Issue
Block a user