+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.
+
2011-08-01 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_N_Iterator_Loop): handle properly an iterator
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,
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
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 --
------------------------------
-- 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
projects / gcc.git / commitdiff