This patch fixes a rare visibility bug in instantiations. A selected component
that resolves to a prefixed call in a generic unit may accidentally resolve to
a selected component with a different selector in an instance, when both a
primitive operation with a single parameter and a record component are
homographs. The fix constists in labelling the node in the generic (and thus in
the copy of the node in the instance) so that it is always resolved as a call.
As a consequence, in an instance body a selected component is known to be legal
without having to examine the current visibility of the selector name.
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-01-06 Ed Schonberg <schonb...@adacore.com>
* sinfo.ads, sinfo.adb (Has_Prefixed_Call): New flag to indicate
that a selected component within a generic unit has been resolved
as a prefixed call with local references.
* sem_ch3.adb (Is_Visible_Component): In an instance body a selected
component is always visible.
* sem_ch4.adb (Analyze_Selected_Component): If the node is a
prefixed call in an instance, do not look for visible components
of the type.
* sem_ch12.adb (Reset_Entity): If a selected component has resolved
to a prefixed call, mark the node accordingly when prefix and
selector are local references.
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb (revision 182950)
+++ sem_ch12.adb (working copy)
@@ -12676,6 +12676,7 @@
Save_Entity_Descendants (N);
else
+ Set_Is_Prefixed_Call (Parent (N));
Set_Associated_Node (N, Empty);
Set_Etype (N, Empty);
end if;
@@ -12683,10 +12684,13 @@
-- In Ada 2005, X.F may be a call to a primitive operation,
-- rewritten as F (X). This rewriting will be done again in an
-- instance, so keep the original node. Global entities will be
- -- captured as for other constructs.
+ -- captured as for other constructs. Indicate that this must
+ -- resolve as a call, to prevent accidental overloading in the
+ -- instance, if both a component and a primitive operation appear
+ -- as candidates.
else
- null;
+ Set_Is_Prefixed_Call (Parent (N));
end if;
-- Entity is local. Reset in generic unit, so that node is resolved
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 182950)
+++ sem_ch3.adb (working copy)
@@ -16300,35 +16300,12 @@
then
return True;
- -- If we are in the body of an instantiation, the component is visible
- -- if the parent type is non-private, or in an enclosing scope. The
- -- scope stack is not present when analyzing an instance body, so we
- -- must inspect the chain of scopes explicitly.
+ -- In the body of an instantiation, no need to check for the visibility
+ -- of a component.
elsif In_Instance_Body then
- if not Is_Private_Type (Scope (C)) then
- return True;
+ return True;
- else
- declare
- S : Entity_Id;
-
- begin
- S := Current_Scope;
- while Present (S)
- and then S /= Standard_Standard
- loop
- if S = Type_Scope then
- return True;
- end if;
-
- S := Scope (S);
- end loop;
-
- return False;
- end;
- end if;
-
-- If the component has been declared in an ancestor which is currently
-- a private type, then it is not visible. The same applies if the
-- component's containing type is not in an open scope and the original
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 182950)
+++ sem_ch4.adb (working copy)
@@ -3858,8 +3858,10 @@
elsif Is_Record_Type (Prefix_Type) then
-- Find component with given name
+ -- In an instance, if the node is known as a prefixed call, do
+ -- not examine components whose visibility may be accidental.
- while Present (Comp) loop
+ while Present (Comp) and then not Is_Prefixed_Call (N) loop
if Chars (Comp) = Chars (Sel)
and then Is_Visible_Component (Comp)
then
Index: sinfo.adb
===================================================================
--- sinfo.adb (revision 182950)
+++ sinfo.adb (working copy)
@@ -1838,6 +1838,14 @@
return Flag13 (N);
end Is_Power_Of_2_For_Shift;
+ function Is_Prefixed_Call
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Selected_Component);
+ return Flag17 (N);
+ end Is_Prefixed_Call;
+
function Is_Protected_Subprogram_Body
(N : Node_Id) return Boolean is
begin
@@ -4910,6 +4918,14 @@
Set_Flag13 (N, Val);
end Set_Is_Power_Of_2_For_Shift;
+ procedure Set_Is_Prefixed_Call
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Selected_Component);
+ Set_Flag17 (N, Val);
+ end Set_Is_Prefixed_Call;
+
procedure Set_Is_Protected_Subprogram_Body
(N : Node_Id; Val : Boolean := True) is
begin
Index: sinfo.ads
===================================================================
--- sinfo.ads (revision 182950)
+++ sinfo.ads (working copy)
@@ -1335,6 +1335,12 @@
-- conditions holds, and the flag is set, then the division or
-- multiplication can be (and is) converted to a shift.
+ -- Is_Prefixed_Call (Flag17-Sem)
+ -- This flag is set in a selected component within a generic unit, if
+ -- it resolves to a prefixed call to a primitive operation. The flag
+ -- is used to prevent accidental overloadings in an instance, when a
+ -- primitive operation and a private record component may be homographs.
+
-- Is_Protected_Subprogram_Body (Flag7-Sem)
-- A flag set in a Subprogram_Body block to indicate that it is the
-- implementation of a protected subprogram. Such a body needs cleanup
@@ -3249,6 +3255,7 @@
-- Associated_Node (Node4-Sem)
-- Do_Discriminant_Check (Flag13-Sem)
-- Is_In_Discriminant_Check (Flag11-Sem)
+ -- Is_Prefixed_Call (Flag17-Sem)
-- Atomic_Sync_Required (Flag14-Sem)
-- plus fields for expression
@@ -8653,6 +8660,9 @@
function Is_Power_Of_2_For_Shift
(N : Node_Id) return Boolean; -- Flag13
+ function Is_Prefixed_Call
+ (N : Node_Id) return Boolean; -- Flag17
+
function Is_Protected_Subprogram_Body
(N : Node_Id) return Boolean; -- Flag7
@@ -9631,6 +9641,9 @@
procedure Set_Is_Power_Of_2_For_Shift
(N : Node_Id; Val : Boolean := True); -- Flag13
+ procedure Set_Is_Prefixed_Call
+ (N : Node_Id; Val : Boolean := True); -- Flag17
+
procedure Set_Is_Protected_Subprogram_Body
(N : Node_Id; Val : Boolean := True); -- Flag7
@@ -11971,6 +11984,7 @@
pragma Inline (Is_Null_Loop);
pragma Inline (Is_Overloaded);
pragma Inline (Is_Power_Of_2_For_Shift);
+ pragma Inline (Is_Prefixed_Call);
pragma Inline (Is_Protected_Subprogram_Body);
pragma Inline (Is_Static_Coextension);
pragma Inline (Is_Static_Expression);
@@ -12293,6 +12307,7 @@
pragma Inline (Set_Is_Null_Loop);
pragma Inline (Set_Is_Overloaded);
pragma Inline (Set_Is_Power_Of_2_For_Shift);
+ pragma Inline (Set_Is_Prefixed_Call);
pragma Inline (Set_Is_Protected_Subprogram_Body);
pragma Inline (Set_Has_Self_Reference);
pragma Inline (Set_Is_Static_Coextension);
