From patchwork Mon Jun 14 12:40:20 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 55523 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 6B8311007D1 for ; Mon, 14 Jun 2010 22:40:24 +1000 (EST) Received: (qmail 5886 invoked by alias); 14 Jun 2010 12:40:18 -0000 Received: (qmail 5876 invoked by uid 22791); 14 Jun 2010 12:40:15 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 14 Jun 2010 12:40:10 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id D4BC6CB02C2; Mon, 14 Jun 2010 14:40:13 +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 JNnNrDVJhQ5t; Mon, 14 Jun 2010 14:40:13 +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 BC6BACB0219; Mon, 14 Jun 2010 14:40:13 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id E28BDD9B31; Mon, 14 Jun 2010 14:40:20 +0200 (CEST) Date: Mon, 14 Jun 2010 14:40:20 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Use_Type and operators that are primitive in more than one type Message-ID: <20100614124020.GA10532@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 An operator may be a primitive operation of more than one untagged type. When exiting the scope of a use_type clause, we must examine the use-visibility of all formal types before resetting the visbility of the operator itself. The following must compile quietly: with Types; package Ops is use type Types.Long_T; procedure Mult_G; end Ops; --- package body Ops is function Log (From : in Types.Long_64_T) return Integer is use type Types.Long_64_T; begin return 1; end Log; procedure Mult_G is Res1 : Types.Long_64_T; X : Types.Long_T; Res2 : Types.Long_64_T := Res1 / X; begin null; end Mult_G; end Ops; --- package Types is type Long_T is range -(2**31) .. (2**31) - 1; type Long_64_T is new Long_Long_Integer; function "/" (Left : Long_64_T; Right : Long_T) return Long_64_T; end Types; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-14 Ed Schonberg * sem_ch8.adb (End_Use_Type): Before indicating that an operator is not use-visible, check whether it is a primitive for more than one type. Index: sem_ch8.adb =================================================================== --- sem_ch8.adb (revision 160728) +++ sem_ch8.adb (working copy) @@ -3426,33 +3426,47 @@ package body Sem_Ch8 is ------------------ procedure End_Use_Type (N : Node_Id) is + Elmt : Elmt_Id; Id : Entity_Id; Op_List : Elist_Id; - Elmt : Elmt_Id; + Op : Entity_Id; T : Entity_Id; + function May_Be_Used_Primitive_Of (T : Entity_Id) return Boolean; + -- An operator may be primitive in several types, if they are declared + -- in the same scope as the operator. To determine the use-visiblity of + -- the operator in such cases we must examine all types in the profile. + + ------------------------------ + -- May_Be_Used_Primitive_Of -- + ------------------------------ + + function May_Be_Used_Primitive_Of (T : Entity_Id) return Boolean is + begin + return Scope (Op) = Scope (T) + and then (In_Use (T) or else Is_Potentially_Use_Visible (T)); + end May_Be_Used_Primitive_Of; + + -- Start of processing for End_Use_Type + begin Id := First (Subtype_Marks (N)); while Present (Id) loop - -- A call to rtsfind may occur while analyzing a use_type clause, + -- A call to Rtsfind may occur while analyzing a use_type clause, -- in which case the type marks are not resolved yet, and there is -- nothing to remove. - if not Is_Entity_Name (Id) - or else No (Entity (Id)) - then + if not Is_Entity_Name (Id) or else No (Entity (Id)) then goto Continue; end if; T := Entity (Id); - if T = Any_Type - or else From_With_Type (T) - then + if T = Any_Type or else From_With_Type (T) then null; - -- Note that the use_Type clause may mention a subtype of the type + -- Note that the use_type clause may mention a subtype of the type -- whose primitive operations have been made visible. Here as -- elsewhere, it is the base type that matters for visibility. @@ -3468,8 +3482,30 @@ package body Sem_Ch8 is Elmt := First_Elmt (Op_List); while Present (Elmt) loop - if Nkind (Node (Elmt)) = N_Defining_Operator_Symbol then - Set_Is_Potentially_Use_Visible (Node (Elmt), False); + Op := Node (Elmt); + + if Nkind (Op) = N_Defining_Operator_Symbol then + declare + T_First : constant Entity_Id := + Base_Type (Etype (First_Formal (Op))); + T_Res : constant Entity_Id := Base_Type (Etype (Op)); + T_Next : Entity_Id; + + begin + if Present (Next_Formal (First_Formal (Op))) then + T_Next := + Base_Type (Etype (Next_Formal (First_Formal (Op)))); + else + T_Next := T_First; + end if; + + if not May_Be_Used_Primitive_Of (T_First) + and then not May_Be_Used_Primitive_Of (T_Next) + and then not May_Be_Used_Primitive_Of (T_Res) + then + Set_Is_Potentially_Use_Visible (Op, False); + end if; + end; end if; Next_Elmt (Elmt);