From patchwork Mon Aug 1 13:35:19 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 107737 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 00528B6FF5 for ; Mon, 1 Aug 2011 23:36:14 +1000 (EST) Received: (qmail 3722 invoked by alias); 1 Aug 2011 13:36:10 -0000 Received: (qmail 3293 invoked by uid 22791); 1 Aug 2011 13:36:07 -0000 X-SWARE-Spam-Status: No, hits=-2.2 required=5.0 tests=AWL, BAYES_00, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (194.98.77.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 01 Aug 2011 13:35:52 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 53485CB0255; Mon, 1 Aug 2011 15:35:51 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id LLhe4PYNhQ6P; Mon, 1 Aug 2011 15:35:41 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 53259CB0283; Mon, 1 Aug 2011 15:35:16 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 405D9245243; Mon, 1 Aug 2011 15:35:19 +0200 (CEST) Date: Mon, 1 Aug 2011 15:35:19 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Improved error message on invisible operator Message-ID: <20110801133519.GA24431@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 * 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