In cases of dispatching operations with names Initialize, Adjust, and Finalize
that will override an inherited procedure at the point of the full type but
not at their point of declaration, the compiler was not properly flagging
an overriding_indicator on such a procedure as illegal, because procedures with
such names are treated specially when privately inherited. The inherited parent
operations shouldn't be visible, but when they come from a controlled type
they're visibly inherited because there's currently a dependence on being
able to find them when generating implicit controlled calls. We add a test
for the case of having a controlled parent, so that at least in noncontrolled
cases an operation with a name such as Initialize will be privately inherited
and a homographic overriding procedure won't override the inherited procedure
at the point of its declaration. This ensures that legality of overriding_
indicators is checked properly in that case.
The test below should produce the following errors when parent-overriding_child
is compiled:
$ gcc -c -gnatj70 parent-overriding_child.adb
parent-overriding_child.ads:11:04: subprogram "Private_Primitive" is
not overriding
parent-overriding_child.ads:14:04: subprogram "Initialize" is not
overriding
parent-overriding_child.ads:17:04: subprogram "Adjust" is not
overriding
parent-overriding_child.ads:20:04: subprogram "Finalize" is not
overriding
----
package Parent is
type TT is tagged private;
procedure Visible_Primitive (X : TT);
private
type TT is tagged null record;
procedure Private_Primitive (X : TT);
procedure Initialize (X : in out TT);
procedure Adjust (X : in out TT);
procedure Finalize (X : in out TT);
procedure Other_Primitive (X : TT);
end Parent;
package Parent.Overriding_Child is
type NTT is new TT with private;
private
overriding
procedure Visible_Primitive (X : NTT); -- OK (overridden procedure visible)
overriding
procedure Private_Primitive (X : NTT); -- ERROR (too early)
overriding
procedure Initialize (X : in out NTT); -- ERROR (too early)
overriding
procedure Adjust (X : in out NTT); -- ERROR (too early)
overriding
procedure Finalize (X : in out NTT); -- ERROR (too early)
type NTT is new TT with null record;
overriding
procedure Other_Primitive (X : NTT); -- OK (overridden procedure visible)
end Parent.Overriding_Child;
package body Parent.Overriding_Child is
overriding
procedure Visible_Primitive (X : NTT) is
begin
null;
end Visible_Primitive;
overriding
procedure Private_Primitive (X : NTT) is
begin
null;
end Private_Primitive;
overriding
procedure Initialize (X : in out NTT) is
begin
null;
end Initialize;
overriding
procedure Adjust (X : in out NTT) is
begin
null;
end Adjust;
overriding
procedure Finalize (X : in out NTT) is
begin
null;
end Finalize;
overriding
procedure Other_Primitive (X : NTT) is
begin
null;
end Other_Primitive;
end Parent.Overriding_Child;
Tested on x86_64-pc-linux-gnu, committed on trunk
2016-10-12 Gary Dismukes <[email protected]>
* sem_ch3.adb (Derive_Subprogram): Add test
for Is_Controlled of Parent_Type when determining whether an
inherited subprogram with one of the special names Initialize,
Adjust, or Finalize should be derived with its normal name even
when inherited as a private operation (which would normally
result in the inherited operation having a special "hidden" name).
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 241026)
+++ sem_ch3.adb (working copy)
@@ -14757,9 +14757,10 @@
or else Is_Internal (Parent_Subp)
or else Is_Private_Overriding
or else Is_Internal_Name (Chars (Parent_Subp))
- or else Nam_In (Chars (Parent_Subp), Name_Initialize,
- Name_Adjust,
- Name_Finalize)
+ or else (Is_Controlled (Parent_Type)
+ and then Nam_In (Chars (Parent_Subp), Name_Initialize,
+ Name_Adjust,
+ Name_Finalize))
then
Set_Derived_Name;
