Commit a5aac267 by Eric Botcazou

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.
parent 42bc589e
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
......
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
......
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment