aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@gcc.gnu.org>2020-03-11 10:47:34 +0100
committerEric Botcazou <ebotcazou@gcc.gnu.org>2020-03-11 10:56:10 +0100
commita5aac267e64c578d55e6e269fa9e331f0d01da98 (patch)
treecfa7841585ac1b78580e5dc396b43b4b81f6419c /gcc
parent42bc589e87a326282be2156ddeb18588677c645d (diff)
downloadgcc-a5aac267e64c578d55e6e269fa9e331f0d01da98.zip
gcc-a5aac267e64c578d55e6e269fa9e331f0d01da98.tar.gz
gcc-a5aac267e64c578d55e6e269fa9e331f0d01da98.tar.bz2
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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog5
-rw-r--r--gcc/ada/gcc-interface/decl.c9
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/subpools1.adb82
4 files changed, 99 insertions, 1 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 64b2572..9df3840 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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__]:
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 871a309..80dfc55 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -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
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index af94cb4..f43da84 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
diff --git a/gcc/testsuite/gnat.dg/subpools1.adb b/gcc/testsuite/gnat.dg/subpools1.adb
new file mode 100644
index 0000000..b38a4ca
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/subpools1.adb
@@ -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;