From patchwork Mon Jun 21 15:24:37 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56326 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 44F85B6F10 for ; Tue, 22 Jun 2010 01:24:49 +1000 (EST) Received: (qmail 30393 invoked by alias); 21 Jun 2010 15:24:47 -0000 Received: (qmail 30375 invoked by uid 22791); 21 Jun 2010 15:24:45 -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, 21 Jun 2010 15:24:38 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 5C530CB029C; Mon, 21 Jun 2010 17:24:37 +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 KZ64akjXWGv6; Mon, 21 Jun 2010 17:24:37 +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 49E81CB0299; Mon, 21 Jun 2010 17:24:37 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 413C4D9A01; Mon, 21 Jun 2010 17:24:37 +0200 (CEST) Date: Mon, 21 Jun 2010 17:24:37 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Ambiguous universal arithmetic expressions in conversions Message-ID: <20100621152437.GA19727@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 expression of the form P."+" (1, 2) is ambiguous if package P contains more than one integer type declaration. In most cases the context inposes a type on the expression, but if the expression appears within a type conversion there is no available context and the expression must be rejected. Compiling pack1.ads must yield: pack1.ads:12:29: ambiguous operation pack1.ads:12:29: possible interpretation (inherited) at line 4 pack1.ads:12:29: possible interpretation (inherited) at line 5 package Pack1 is package P is type T1 is new Integer; type T2 is new Float; type T3 is new Float; private type T4 is new Integer; end P; V1 : Integer := Integer (P."+" (1, 2)); -- OK, only one candidate V2 : Float := Float (P."+" (1, 2)); -- OK, only one candidate V3 : Float := Float (P."+" (1.0, 2.0)); -- Error, ambiguous end; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-21 Ed Schonberg * sem_eval.adb (Test_Ambiguous_Operator): New procedure to check whether a universal arithmetic expression in a conversion, which is rewritten from a function call with an expanded name, is ambiguous. Index: sem_eval.adb =================================================================== --- sem_eval.adb (revision 161073) +++ sem_eval.adb (working copy) @@ -180,6 +180,13 @@ package body Sem_Eval is -- used for producing the result of the static evaluation of the -- logical operators + procedure Test_Ambiguous_Operator (N : Node_Id); + -- Check whether an arithmetic operation with universal operands which + -- is a rewritten function call with an explicit scope indication is + -- ambiguous: P."+" (1, 2) will be ambiguous if there is more than one + -- visible numeric type declared in P and the context does not impose a + -- type on the result (e.g. in the expression of a type conversion). + procedure Test_Expression_Is_Foldable (N : Node_Id; Op1 : Node_Id; @@ -1458,6 +1465,15 @@ package body Sem_Eval is return; end if; + if (Etype (Right) = Universal_Integer + or else Etype (Right) = Universal_Real) + and then + (Etype (Left) = Universal_Integer + or else Etype (Left) = Universal_Real) + then + Test_Ambiguous_Operator (N); + end if; + -- Fold for cases where both operands are of integer type if Is_Integer_Type (Ltype) and then Is_Integer_Type (Rtype) then @@ -3395,6 +3411,12 @@ package body Sem_Eval is return; end if; + if Etype (Right) = Universal_Integer + or else Etype (Right) = Universal_Real + then + Test_Ambiguous_Operator (N); + end if; + -- Fold for integer case if Is_Integer_Type (Etype (N)) then @@ -4699,6 +4721,78 @@ package body Sem_Eval is end if; end Test; + ----------------------------- + -- Test_Ambiguous_Operator -- + ----------------------------- + + procedure Test_Ambiguous_Operator (N : Node_Id) is + Call : constant Node_Id := Original_Node (N); + Is_Int : constant Boolean := Is_Integer_Type (Etype (N)); + + Is_Fix : constant Boolean := + Nkind (N) in N_Binary_Op + and then Nkind (Right_Opnd (N)) /= Nkind (Left_Opnd (N)); + -- a mixed-mode operation in this context indicates the + -- presence of fixed-point type in the designated package. + + E : Entity_Id; + Pack : Entity_Id; + Typ1 : Entity_Id; + Priv_E : Entity_Id; + + begin + if Nkind (Call) /= N_Function_Call + or else Nkind (Name (Call)) /= N_Expanded_Name + then + return; + + elsif Nkind (Parent (N)) = N_Type_Conversion then + Pack := Entity (Prefix (Name (Call))); + + -- If the prefix is a package declared elsewhere, iterate over + -- its visible entities, otherwise iterate over all declarations + -- in the designated scope. + + if Ekind (Pack) = E_Package + and then not In_Open_Scopes (Pack) + then + Priv_E := First_Private_Entity (Pack); + else + Priv_E := Empty; + end if; + + Typ1 := Empty; + E := First_Entity (Pack); + while Present (E) + and then E /= Priv_E + loop + if Is_Numeric_Type (E) + and then Nkind (Parent (E)) /= N_Subtype_Declaration + and then Comes_From_Source (E) + and then Is_Integer_Type (E) = Is_Int + and then + (Nkind (N) in N_Unary_Op + or else Is_Fixed_Point_Type (E) = Is_Fix) + then + if No (Typ1) then + Typ1 := E; + + else + -- More than one type of the proper class declared in P + + Error_Msg_N ("ambiguous operation", N); + Error_Msg_Sloc := Sloc (Typ1); + Error_Msg_N ("\possible interpretation (inherited)#", N); + Error_Msg_Sloc := Sloc (E); + Error_Msg_N ("\possible interpretation (inherited)#", N); + end if; + end if; + + Next_Entity (E); + end loop; + end if; + end Test_Ambiguous_Operator; + --------------------------------- -- Test_Expression_Is_Foldable -- ---------------------------------