diff mbox

[Ada] Improved error message on invisible operator

Message ID 20110801133519.GA24431@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Aug. 1, 2011, 1:35 p.m. UTC
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  <schonberg@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.
diff mbox

Patch

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