From: Eric Botcazou <[email protected]>
The root cause is that a subprogram declared in the body is incorrectly
considered as a primitive operation of a type declared in a package spec.
gcc/ada/ChangeLog:
* einfo.ads (In_Package_Body): Update description.
(In_Private_Part): Likewise.
* sem_ch3.adb (Analyze_Object_Declaration): Compute In_Package_Body
along with In_Private_Part for the object if its scope is a package.
* sem_ch6.adb (Analyze_Expression_Function): Do not compute
In_Private_Part here.
(Enter_Overloaded_Entity): Compute In_Package_Body & In_Private_Part
for the entity if its scope is a package.
* sem_util.adb (Collect_Primitive_Operations): Skip the subprograms
declared in the body for types declared in a package specification.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/einfo.ads | 21 ++++++++++++---------
gcc/ada/sem_ch3.adb | 9 ++++-----
gcc/ada/sem_ch6.adb | 11 ++++++++---
gcc/ada/sem_util.adb | 2 +-
4 files changed, 25 insertions(+), 18 deletions(-)
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index b1ec7f885e7..85fca2c2b2c 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2294,17 +2294,20 @@ package Einfo is
-- to multiple subprogram entities).
-- In_Package_Body
--- Defined in package entities. Set on the entity that denotes the
--- package (the defining occurrence of the package declaration) while
--- analyzing and expanding the package body. Reset on completion of
--- analysis/expansion.
+-- Defined in all entities. Can be set only in package entities, objects
+-- and overloadable entities. For package entities, this flag is set to
+-- indicate that the body of the package is being analyzed. The flag is
+-- reset at the end of the package body. For objects and overloadable
+-- entities, indicates that the declaration of the entity occurs in the
+-- body of a package.
-- In_Private_Part
--- Defined in all entities. Can be set only in package entities and
--- objects. For package entities, this flag is set to indicate that the
--- private part of the package is being analyzed. The flag is reset at
--- the end of the package declaration. For objects it indicates that the
--- declaration of the object occurs in the private part of a package.
+-- Defined in all entities. Can be set only in package entities, objects
+-- and overloadable entities. For package entities, this flag is set to
+-- indicate that the private part of the package is being analyzed. The
+-- flag is reset at the end of the package declaration. For objects and
+-- overloadable entities, indicates that the declaration of the entity
+-- occurs in the private part of a package.
-- Incomplete_Actuals
-- Defined on package entities that are instances. Indicates the actuals
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index db71829d7f4..710d09a4192 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5473,12 +5473,11 @@ package body Sem_Ch3 is
Check_Eliminated (Id);
- -- Deal with setting In_Private_Part flag if in private part
+ -- Deal with setting In_Package_Body and In_Private_Part flags
- if Ekind (Scope (Id)) = E_Package
- and then In_Private_Part (Scope (Id))
- then
- Set_In_Private_Part (Id);
+ if Ekind (Scope (Id)) = E_Package then
+ Set_In_Package_Body (Id, In_Package_Body (Scope (Id)));
+ Set_In_Private_Part (Id, In_Private_Part (Scope (Id)));
end if;
<<Leave>>
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 18a77b980be..dc9dd449ab8 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -535,8 +535,6 @@ package body Sem_Ch6 is
Def_Id := Defining_Entity (N);
Set_Is_Inlined (Def_Id);
- Set_In_Private_Part (Def_Id, In_Private_Part (Scope (Def_Id)));
-
Typ := Etype (Def_Id);
-- Propagate the results of the resolution of the specification of
@@ -9723,7 +9721,14 @@ package body Sem_Ch6 is
if Is_Inherited_Operation (S) then
Append_Inherited_Subprogram (S);
else
- Append_Entity (S, Current_Scope);
+ Append_Entity (S, Scope (S));
+ end if;
+
+ -- Deal with setting In_Package_Body and In_Private_Part flags
+
+ if Ekind (Scope (S)) = E_Package then
+ Set_In_Package_Body (S, In_Package_Body (Scope (S)));
+ Set_In_Private_Part (S, In_Private_Part (Scope (S)));
end if;
Set_Public_Status (S);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 486c31ee171..6d1647f96cd 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5892,7 +5892,7 @@ package body Sem_Util is
-- predefined "=" operator.
if Is_Overloadable (Id)
- and then (Is_Type_In_Pkg
+ and then ((Is_Type_In_Pkg and then not In_Package_Body (Id))
or else Is_Primitive (Id)
or else not Comes_From_Source (Id))
--
2.53.0
