From: Gary Dismukes <dismu...@adacore.com>
The compiler incorrectly treats an overriding private subprogram that
should not be visible outside a package (because it only overrides in
the private part) as a possible interpretation for a call using prefixed
notation outside of the package. This can result in an ambiguity if there
is another subprogram with the same name but a different profile declared
in the visible part of the package, or can result in resolving to the
private operation in cases where it shouldn't resolve. This happens due
to the compiler improperly concluding that the private overriding subprogram
overrides an inherited subprogram in the package visible part, even though
the only inherited subprogram is in the private part, as a result of
a misuse of the Overridden_Operation field, which, contrary to what
its name suggests, actually refers to operations of the parent type,
rather than to the operations derived from the parent's operations.
gcc/ada/ChangeLog:
* einfo.ads: Document new field Overridden_Inherited_Operation and
list it as a field for the entity kinds that it applies to.
* gen_il-fields.ads (type Opt_Field_Enum): Add new literal
Overridden_Inherited_Operation to the type.
* gen_il-gen-gen_entities.adb: Add Overridden_Inherited_Operation as
a field of entities of kinds E_Enumeration_Literal and Subprogram_Kind.
* sem_ch4.adb (Is_Callable_Private_Overriding): Change name (was
Is_Private_Overriding). Replace Is_Hidden test on Overridden_Operation
with test of Is_Hidden on the new field Overridden_Inherited_Operation.
* sem_ch6.adb (New_Overloaded_Entity): Set the new field
Overridden_Inherited_Operation on an operation derived from
an interface to refer to the inherited operation of a private
extension that's overridden by the derived operation. Also set
that field in the more common cases of an explicit subprogram
that overrides, to refer to the inherited subprogram that is
overridden. (Contrary to its name, the Overridden_Operation
field of the overriding subprogram, which is also set in these
places, refers to the *parent* subprogram from which the inherited
subprogram is derived.) Also, remove a redundant Present (Alias (S))
test in an if_statement and the dead "else" part of that statement.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/einfo.ads | 18 +++++-
gcc/ada/gen_il-fields.ads | 1 +
gcc/ada/gen_il-gen-gen_entities.adb | 2 +
gcc/ada/sem_ch4.adb | 34 +++++++----
gcc/ada/sem_ch6.adb | 87 ++++++++++++++++++++---------
5 files changed, 103 insertions(+), 39 deletions(-)
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index ba79fe4aa86..c4aa98ee4f3 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3940,9 +3940,21 @@ package Einfo is
-- Defined in constants and variables. Set if there is an address clause
-- that causes the entity to overlay a constant object.
+-- Overridden_Inherited_Operation
+-- Defined in subprograms and enumeration literals. When set on a
+-- subprogram S, indicates an inherited subprogram that S overrides.
+-- In the case of a privately declared explicit subprogram E that
+-- overrides a private inherited subprogram, and the inherited
+-- subprogram itself overrides another inherited subprogram declared
+-- for a private extension, the field on E will reference the subprogram
+-- inherited by the private extension. This field is used for properly
+-- handling visibility for such privately declared subprograms. This
+-- field is always Empty for enumeration literal entities.
+
-- Overridden_Operation
-- Defined in subprograms. For overriding operations, points to the
--- user-defined parent subprogram that is being overridden.
+-- user-defined parent subprogram from which the inherited subprogram
+-- that is being overridden is derived.
-- Package_Instantiation
-- Defined in packages and generic packages. When defined, this field
@@ -5413,6 +5425,7 @@ package Einfo is
-- Enumeration_Pos
-- Enumeration_Rep
-- Alias
+ -- Overridden_Inherited_Operation
-- Enumeration_Rep_Expr
-- Interface_Name $$$
-- Renamed_Object $$$
@@ -5502,6 +5515,7 @@ package Einfo is
-- Subps_Index (non-generic case only)
-- Interface_Alias
-- LSP_Subprogram (non-generic case only)
+ -- Overridden_Inherited_Operation
-- Overridden_Operation
-- Wrapped_Entity (non-generic case only)
-- Extra_Formals
@@ -5705,6 +5719,7 @@ package Einfo is
-- Extra_Accessibility_Of_Result
-- Last_Entity
-- Subps_Index
+ -- Overridden_Inherited_Operation
-- Overridden_Operation
-- Linker_Section_Pragma
-- Contract
@@ -5858,6 +5873,7 @@ package Einfo is
-- Subps_Index (non-generic case only)
-- Interface_Alias
-- LSP_Subprogram (non-generic case only)
+ -- Overridden_Inherited_Operation
-- Overridden_Operation (never for init proc)
-- Wrapped_Entity (non-generic case only)
-- Extra_Formals
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index 2d16e12805b..9b4adee1d46 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -850,6 +850,7 @@ package Gen_IL.Fields is
Original_Protected_Subprogram,
Original_Record_Component,
Overlays_Constant,
+ Overridden_Inherited_Operation,
Overridden_Operation,
Package_Instantiation,
Packed_Array_Impl_Type,
diff --git a/gcc/ada/gen_il-gen-gen_entities.adb
b/gcc/ada/gen_il-gen-gen_entities.adb
index 8cbed8a5989..b2970e6c2bf 100644
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -953,6 +953,7 @@ begin -- Gen_IL.Gen.Gen_Entities
Sm (Enumeration_Rep_Expr, Node_Id),
Sm (Esize, Uint),
Sm (Alignment, Unat),
+ Sm (Overridden_Inherited_Operation, Node_Id),
Sm (Interface_Name, Node_Id)));
Ab (Subprogram_Kind, Overloadable_Kind,
@@ -981,6 +982,7 @@ begin -- Gen_IL.Gen.Gen_Entities
Sm (Is_Machine_Code_Subprogram, Flag),
Sm (Last_Entity, Node_Id),
Sm (Linker_Section_Pragma, Node_Id),
+ Sm (Overridden_Inherited_Operation, Node_Id),
Sm (Overridden_Operation, Node_Id),
Sm (Protected_Body_Subprogram, Node_Id),
Sm (No_Raise, Flag),
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 56dc7c6355c..22a04e3ba9b 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -10406,11 +10406,14 @@ package body Sem_Ch4 is
-- may be candidates, so that Try_Primitive_Operations can examine
-- them if no real primitive is found.
- function Is_Private_Overriding (Op : Entity_Id) return Boolean;
+ function Is_Callable_Private_Overriding
+ (Op : Entity_Id) return Boolean;
-- An operation that overrides an inherited operation in the private
-- part of its package may be hidden, but if the inherited operation
- -- is visible a direct call to it will dispatch to the private one,
- -- which is therefore a valid candidate.
+ -- that it overrides is visible, then a direct call to it will
+ -- dispatch to the private one, which is therefore a valid candidate.
+ -- Returns True if the operation can be called from outside the
+ -- enclosing package.
function Names_Match
(Obj_Type : Entity_Id;
@@ -10581,11 +10584,13 @@ package body Sem_Ch4 is
return Op_List;
end Extended_Primitive_Ops;
- ---------------------------
- -- Is_Private_Overriding --
- ---------------------------
+ ------------------------------------
+ -- Is_Callable_Private_Overriding --
+ ------------------------------------
- function Is_Private_Overriding (Op : Entity_Id) return Boolean is
+ function Is_Callable_Private_Overriding
+ (Op : Entity_Id) return Boolean
+ is
Visible_Op : Entity_Id;
begin
@@ -10607,7 +10612,10 @@ package body Sem_Ch4 is
-- have found what we're looking for.
if not Is_Hidden (Visible_Op)
- or else not Is_Hidden (Overridden_Operation (Op))
+ or else
+ (Present (Overridden_Inherited_Operation (Op))
+ and then not Is_Hidden
+ (Overridden_Inherited_Operation (Op)))
then
return True;
end if;
@@ -10617,7 +10625,7 @@ package body Sem_Ch4 is
end loop;
return False;
- end Is_Private_Overriding;
+ end Is_Callable_Private_Overriding;
-----------------
-- Names_Match --
@@ -10760,13 +10768,15 @@ package body Sem_Ch4 is
-- Do not consider hidden primitives unless the type is in an
-- open scope or we are within an instance, where visibility
- -- is known to be correct, or else if this is an overriding
- -- operation in the private part for an inherited operation.
+ -- is known to be correct, or else if this is an operation
+ -- declared in the private part that overrides a visible
+ -- inherited operation.
or else (Is_Hidden (Prim_Op)
and then not Is_Immediately_Visible (Obj_Type)
and then not In_Instance
- and then not Is_Private_Overriding (Prim_Op))
+ and then
+ not Is_Callable_Private_Overriding (Prim_Op))
then
goto Continue;
end if;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 48dcf8e4f1b..8af980fe0c3 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -12133,36 +12133,51 @@ package body Sem_Ch6 is
and then Present (Find_Dispatching_Type (Alias (S)))
and then Is_Interface (Find_Dispatching_Type (Alias (S)))
then
- -- For private types, when the full-view is processed we propagate to
- -- the full view the non-overridden entities whose attribute "alias"
- -- references an interface primitive. These entities were added by
- -- Derive_Subprograms to ensure that interface primitives are
- -- covered.
+ declare
+ Private_Operation_Exported_By_Visible_Part : constant Boolean :=
+ Is_Package_Or_Generic_Package (Current_Scope)
+ and then In_Private_Part (Current_Scope)
+ and then Parent_Kind (E) = N_Private_Extension_Declaration
+ and then Nkind (Parent (S)) = N_Full_Type_Declaration
+ and then Full_View (Defining_Identifier (Parent (E)))
+ = Defining_Identifier (Parent (S));
- -- Inside_Freeze_Actions is non zero when S corresponds with an
- -- internal entity that links an interface primitive with its
- -- covering primitive through attribute Interface_Alias (see
- -- Add_Internal_Interface_Entities).
+ begin
+ -- For private types, when the full view is processed we propagate
+ -- to the full view the nonoverridden entities whose attribute
+ -- "alias" references an interface primitive. These entities were
+ -- added by Derive_Subprograms to ensure that interface primitives
+ -- are covered.
- if Inside_Freezing_Actions = 0
- and then Is_Package_Or_Generic_Package (Current_Scope)
- and then In_Private_Part (Current_Scope)
- and then Parent_Kind (E) = N_Private_Extension_Declaration
- and then Nkind (Parent (S)) = N_Full_Type_Declaration
- and then Full_View (Defining_Identifier (Parent (E)))
- = Defining_Identifier (Parent (S))
- and then Alias (E) = Alias (S)
- then
- Check_Operation_From_Private_View (S, E);
- Set_Is_Dispatching_Operation (S);
+ -- Inside_Freeze_Actions is nonzero when S corresponds to an
+ -- internal entity that links an interface primitive with its
+ -- covering primitive through attribute Interface_Alias (see
+ -- Add_Internal_Interface_Entities).
- -- Common case
+ if Inside_Freezing_Actions = 0
+ and then Private_Operation_Exported_By_Visible_Part
+ and then Alias (E) = Alias (S)
+ then
+ Check_Operation_From_Private_View (S, E);
+ Set_Is_Dispatching_Operation (S);
- else
- Enter_Overloaded_Entity (S);
- Check_Dispatching_Operation (S, Empty);
- Check_For_Primitive_Subprogram (Is_Primitive_Subp);
- end if;
+ -- Common case
+
+ else
+ Enter_Overloaded_Entity (S);
+ Check_Dispatching_Operation (S, Empty);
+ Check_For_Primitive_Subprogram (Is_Primitive_Subp);
+ end if;
+
+ if Private_Operation_Exported_By_Visible_Part
+ and then Type_Conformant (E, S)
+ then
+ -- Record the actual inherited subprogram that's being
+ -- overridden.
+
+ Set_Overridden_Inherited_Operation (S, E);
+ end if;
+ end;
return;
end if;
@@ -12601,6 +12616,26 @@ package body Sem_Ch6 is
and then not Is_Dispatch_Table_Wrapper (S)))
then
Set_Overridden_Operation (S, Alias (E));
+
+ -- Record the actual inherited subprogram that's being
+ -- overridden. In the case where a subprogram declared
+ -- in a private part overrides an inherited subprogram
+ -- that itself is also declared in the private part,
+ -- and that subprogram in turns overrides a subprogram
+ -- declared in a package visible part (inherited via
+ -- a private extension), we record the visible subprogram
+ -- as the overridden one, so that we can determine
+ -- visibility properly for prefixed calls to the
+ -- subprogram made from outside the package. (See
+ -- Try_Primitive_Operation in Sem_Ch4.)
+
+ if Present (Overridden_Inherited_Operation (E)) then
+ Set_Overridden_Inherited_Operation
+ (S, Overridden_Inherited_Operation (E));
+ else
+ Set_Overridden_Inherited_Operation (S, E);
+ end if;
+
Inherit_Subprogram_Contract (S, Alias (E));
Set_Is_Ada_2022_Only (S, Is_Ada_2022_Only (Alias (E)));
--
2.43.0
