diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 103 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 5 |
4 files changed, 135 insertions, 4 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3b9ede5..364abb5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,14 @@ 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 over an arbitrary expression of an array or container type. * lib-xref.adb: clarify comment. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 086e3a6..af65aea 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 5fcfd6f..689a04f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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 -- ------------------------------ diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index d892a4c..df74a1f 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -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 |