A common programming error is to assume that a predefined operator is visible
when its operand type is in scope. The compiler in that case indicates that a
use clause would make the operation legal. However, the type maybe only in scope
indirectly, through other visible units, in which case the error message is
incomplete, because a use_clause will not be sufficient to make the operator
visible. THis patch recognizes this case, and specializes the error message
accordingly.
Compiling user.adb below must yield:
user.adb:5:11:
operator for type "E" defined at typ.ads:2 is not directly visible
user.adb:5:11: add with_clause and use_clause for "Typ"
---
with Cst; use Cst;
procedure User is
begin
if Get = C then
null;
end if;
end;
---
package Typ is
type E is range 0 .. 10;
end;
---
with Typ; use Typ;
package Cst is
C : constant E := 0;
function Get return E;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-01 Ed Schonberg <schonb...@adacore.com>
* sem_ch4.adb (Operator_Check): improve error message when both a
with_clause and a use_clause are needed to make operator usage legal.
* sem_util.ads, sem_util.adb (Unit_Is_Visible): new predicate to
determine whether a compilation unit is visible within an other,
either through a with_clause in the current unit, or a with_clause in
its library unit or one one of its parents.
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 177030)
+++ sem_util.adb (working copy)
@@ -11533,6 +11533,109 @@ package body Sem_Util is
return N;
end Unit_Declaration_Node;
+ ---------------------
+ -- Unit_Is_Visible --
+ ---------------------
+
+ function Unit_Is_Visible (U : Entity_Id) return Boolean is
+ Curr : constant Node_Id := Cunit (Current_Sem_Unit);
+ Curr_Entity : constant Entity_Id := Cunit_Entity (Current_Sem_Unit);
+
+ function Unit_In_Parent_Context (Par_Unit : Node_Id) return Boolean;
+ -- For a child unit, check whether unit appears in a with_clause
+ -- of a parent.
+
+ function Unit_In_Context (Comp_Unit : Node_Id) return Boolean;
+ -- Scan the context clause of one compilation unit looking for a
+ -- with_clause for the unit in question.
+
+ ----------------------------
+ -- Unit_In_Parent_Context --
+ ----------------------------
+
+ function Unit_In_Parent_Context (Par_Unit : Node_Id) return Boolean
+ is
+ begin
+ if Unit_In_Context (Par_Unit) then
+ return True;
+
+ elsif Is_Child_Unit (Defining_Entity (Unit (Par_Unit))) then
+ return Unit_In_Parent_Context (Parent_Spec (Unit (Par_Unit)));
+
+ else
+ return False;
+ end if;
+ end Unit_In_Parent_Context;
+
+ ---------------------
+ -- Unit_In_Context --
+ ---------------------
+
+ function Unit_In_Context (Comp_Unit : Node_Id) return Boolean is
+ Clause : Node_Id;
+
+ begin
+ Clause := First (Context_Items (Comp_Unit));
+ while Present (Clause) loop
+ if Nkind (Clause) = N_With_Clause then
+ if Library_Unit (Clause) = U then
+ return True;
+
+ -- The with_clause may denote a renaming of the unit we are
+ -- looking for, eg. Text_IO which renames Ada.Text_IO.
+
+ elsif
+ Renamed_Entity (Entity (Name (Clause)))
+ = Defining_Entity (Unit (U))
+ then
+ return True;
+ end if;
+ end if;
+
+ Next (Clause);
+ end loop;
+ return False;
+ end Unit_In_Context;
+
+ begin
+
+ -- The currrent unit is directly visible.
+
+ if Curr = U then
+ return True;
+
+ elsif Unit_In_Context (Curr) then
+ return True;
+
+ -- If the current unit is a body, check the context of the spec.
+
+ elsif Nkind (Unit (Curr)) = N_Package_Body
+ or else
+ (Nkind (Unit (Curr)) = N_Subprogram_Body
+ and then not Acts_As_Spec (Unit (Curr)))
+ then
+
+ if Unit_In_Context (Library_Unit (Curr)) then
+ return True;
+ end if;
+ end if;
+
+ -- If the spec is a child unit, examine the parents.
+
+ if Is_Child_Unit (Curr_Entity) then
+ if Nkind (Unit (Curr)) in N_Unit_Body then
+ return
+ Unit_In_Parent_Context
+ (Parent_Spec (Unit (Library_Unit (Curr))));
+ else
+ return Unit_In_Parent_Context (Parent_Spec (Unit (Curr)));
+ end if;
+
+ else
+ return False;
+ end if;
+ end Unit_Is_Visible;
+
------------------------------
-- Universal_Interpretation --
------------------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 177027)
+++ sem_util.ads (working copy)
@@ -1316,6 +1316,11 @@ package Sem_Util is
-- it returns the subprogram, task or protected body node for it. The unit
-- may be a child unit with any number of ancestors.
+ function Unit_Is_Visible (U : Entity_Id) return Boolean;
+ -- Determine whether a compilation unit is visible in the current context,
+ -- because there is a with_clause that makes the unit available. Used to
+ -- provide better messages on common visiblity errors on operators.
+
function Universal_Interpretation (Opnd : Node_Id) return Entity_Id;
-- Yields Universal_Integer or Universal_Real if this is a candidate
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 177031)
+++ sem_ch4.adb (working copy)
@@ -3222,8 +3222,8 @@ package body Sem_Ch4 is
if Present (Loop_Parameter_Specification (N)) then
Iterator :=
Make_Iteration_Scheme (Loc,
- Loop_Parameter_Specification =>
- Loop_Parameter_Specification (N));
+ Loop_Parameter_Specification =>
+ Loop_Parameter_Specification (N));
else
Iterator :=
Make_Iteration_Scheme (Loc,
@@ -5687,8 +5687,22 @@ package body Sem_Ch4 is
Error_Msg_NE -- CODEFIX
("operator for} is not directly visible!",
N, First_Subtype (Candidate_Type));
- Error_Msg_N -- CODEFIX
- ("use clause would make operation legal!", N);
+
+ declare
+ U : constant Node_Id :=
+ Cunit (Get_Source_Unit (Candidate_Type));
+
+ begin
+ if Unit_Is_Visible (U) then
+ Error_Msg_N -- CODEFIX
+ ("use clause would make operation legal!", N);
+
+ else
+ Error_Msg_NE -- CODEFIX
+ ("add with_clause and use_clause for&!",
+ N, Defining_Entity (Unit (U)));
+ end if;
+ end;
return;
-- If either operand is a junk operand (e.g. package name), then
