From patchwork Thu Apr 11 09:34:45 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 235652 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]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id 5BE5D2C00B1 for ; Thu, 11 Apr 2013 19:34:55 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=ozzCma8bewXihyJBPb2a/EtfBJG6wjy4u5tSPjO3WK1dkeI79U Qg9ljp7pzVD/XqkXRnZgttPtsSn39FS37GISnWIgmNaoXdn8CUvwmCke/Z4ywrJY GUA4yHp6faotCNB6aFgcXuRTymu9C1IhJc2Crwg2yReKxJgb+DeuWuccI= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=/9X/Z8M8OdigDpZh+x65T5VZ/s4=; b=smlQMkgO/mL42MoqtQYj 6HMJbwAnWStCiOUQ7nWvKlyXuPkckxJYK951gv6sl429aZm5QRphiCguAJuikU8C J3fY3+Vp8XAOIvKNVqVbvUkFnUw9c6FeZ+VEf0KPuc8NTPfsj+m/Lf7YhB6lt6OO NQko9SeFVNHal0yDysq7wQs= Received: (qmail 16969 invoked by alias); 11 Apr 2013 09:34:48 -0000 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 Received: (qmail 16958 invoked by uid 89); 11 Apr 2013 09:34:48 -0000 X-Spam-SWARE-Status: No, score=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO autolearn=ham version=3.3.1 Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Thu, 11 Apr 2013 09:34:47 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 6B1DF2EA78; Thu, 11 Apr 2013 05:34:45 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 5VrcXFvMV1OL; Thu, 11 Apr 2013 05:34:45 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 4F7152EA74; Thu, 11 Apr 2013 05:34:45 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 4599C3FF09; Thu, 11 Apr 2013 05:34:45 -0400 (EDT) Date: Thu, 11 Apr 2013 05:34:45 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Improve explanations for non-staticness Message-ID: <20130411093445.GA19983@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) X-Virus-Found: No This patch improves the messages given to explain why expressions are not static (when they are required to be). There are two changes. First such messages are now continuations, which means they work nicely with -gnatj. Second if a string literal comes from aggregates that are never static, the message is now clearer. The following is compiled with -gnatj65. 1. package NonSOthers5 is 2. B : constant String (1 .. 6) := (others => 'A'); 3. DH : constant String (1 .. 8) := B & "BB"; 4. X : Integer; 5. pragma Export (C, X, Link_Name => DH); | >>> argument for pragma "Export" must be a static expression, aggregate (at line 2) is never static 6. Y : Integer; 7. pragma Export (C, Y, Link_Name => B); | >>> argument for pragma "Export" must be a static expression, aggregate (at line 2) is never static 8. Z : Integer; 9. subtype S5 is String (1 .. 5); 10. pragma Export (C, Z, Link_Name => S5'(Others => 'Z')); | >>> argument for pragma "Export" must be a static expression, an aggregate is never static (RM 4.9) 11. end; Tested on x86_64-pc-linux-gnu, committed on trunk 2013-04-11 Robert Dewar * errout.ads: Minor reformatting. * sem_eval.adb (Why_Not_Static): Now issues continuation messages (Why_Not_Static): Test for aggregates behind string literals. * sem_eval.ads (Why_Not_Static): Now issues continuation messages. Index: errout.ads =================================================================== --- errout.ads (revision 197743) +++ errout.ads (working copy) @@ -242,7 +242,7 @@ -- messages starting with the \ insertion character). The effect of the -- use of ! in a parent message automatically applies to all of its -- continuation messages (since we clearly don't want any case in which - -- continuations are separated from the parent message. It is allowable + -- continuations are separated from the main message). It is allowable -- to put ! in continuation messages, and the usual style is to include -- it, since it makes it clear that the continuation is part of an -- unconditional message. Index: sem_eval.adb =================================================================== --- sem_eval.adb (revision 197744) +++ sem_eval.adb (working copy) @@ -5495,8 +5495,8 @@ if Raises_Constraint_Error (Expr) then Error_Msg_N - ("expression raises exception, cannot be static " & - "(RM 4.9(34))!", N); + ("\expression raises exception, cannot be static " & + "(RM 4.9(34))", N); return; end if; @@ -5516,8 +5516,8 @@ and then not Is_RTE (Typ, RE_Bignum) then Error_Msg_N - ("static expression must have scalar or string type " & - "(RM 4.9(2))!", N); + ("\static expression must have scalar or string type " & + "(RM 4.9(2))", N); return; end if; end if; @@ -5525,6 +5525,9 @@ -- If we got through those checks, test particular node kind case Nkind (N) is + + -- Entity name + when N_Expanded_Name | N_Identifier | N_Operator_Symbol => E := Entity (N); @@ -5532,30 +5535,84 @@ null; elsif Ekind (E) = E_Constant then - if not Is_Static_Expression (Constant_Value (E)) then - Error_Msg_NE - ("& is not a static constant (RM 4.9(5))!", N, E); - end if; + -- One case we can give a metter message is when we have a + -- string literal created by concatenating an aggregate with + -- an others expression. + + Entity_Case : declare + CV : constant Node_Id := Constant_Value (E); + CO : constant Node_Id := Original_Node (CV); + + function Is_Aggregate (N : Node_Id) return Boolean; + -- See if node N came from an others aggregate, if so + -- return True and set Error_Msg_Sloc to aggregate. + + ------------------ + -- Is_Aggregate -- + ------------------ + + function Is_Aggregate (N : Node_Id) return Boolean is + begin + if Nkind (Original_Node (N)) = N_Aggregate then + Error_Msg_Sloc := Sloc (Original_Node (N)); + return True; + elsif Is_Entity_Name (N) + and then Ekind (Entity (N)) = E_Constant + and then + Nkind (Original_Node (Constant_Value (Entity (N)))) = + N_Aggregate + then + Error_Msg_Sloc := + Sloc (Original_Node (Constant_Value (Entity (N)))); + return True; + else + return False; + end if; + end Is_Aggregate; + + -- Start of processing for Entity_Case + + begin + if Is_Aggregate (CV) + or else (Nkind (CO) = N_Op_Concat + and then (Is_Aggregate (Left_Opnd (CO)) + or else + Is_Aggregate (Right_Opnd (CO)))) + then + Error_Msg_N ("\aggregate (#) is never static", N); + + elsif not Is_Static_Expression (CV) then + Error_Msg_NE + ("\& is not a static constant (RM 4.9(5))", N, E); + end if; + end Entity_Case; + else Error_Msg_NE - ("& is not static constant or named number " & - "(RM 4.9(5))!", N, E); + ("\& is not static constant or named number " + & "(RM 4.9(5))", N, E); end if; + -- Binary operator + when N_Binary_Op | N_Short_Circuit | N_Membership_Test => if Nkind (N) in N_Op_Shift then Error_Msg_N - ("shift functions are never static (RM 4.9(6,18))!", N); + ("\shift functions are never static (RM 4.9(6,18))", N); else Why_Not_Static (Left_Opnd (N)); Why_Not_Static (Right_Opnd (N)); end if; + -- Unary operator + when N_Unary_Op => Why_Not_Static (Right_Opnd (N)); + -- Attribute reference + when N_Attribute_Reference => Why_Not_Static_List (Expressions (N)); @@ -5569,8 +5626,8 @@ if Attribute_Name (N) = Name_Size then Error_Msg_N - ("size attribute is only static for static scalar type " & - "(RM 4.9(7,8))", N); + ("\size attribute is only static for static scalar type " + & "(RM 4.9(7,8))", N); -- Flag array cases @@ -5582,15 +5639,15 @@ Attribute_Name (N) /= Name_Length then Error_Msg_N - ("static array attribute must be Length, First, or Last " & - "(RM 4.9(8))!", N); + ("\static array attribute must be Length, First, or Last " + & "(RM 4.9(8))", N); -- Since we know the expression is not-static (we already -- tested for this, must mean array is not static). else Error_Msg_N - ("prefix is non-static array (RM 4.9(8))!", Prefix (N)); + ("\prefix is non-static array (RM 4.9(8))", Prefix (N)); end if; return; @@ -5603,31 +5660,37 @@ Is_Generic_Type (E) then Error_Msg_N - ("attribute of generic type is never static " & - "(RM 4.9(7,8))!", N); + ("\attribute of generic type is never static " + & "(RM 4.9(7,8))", N); elsif Is_Static_Subtype (E) then null; elsif Is_Scalar_Type (E) then Error_Msg_N - ("prefix type for attribute is not static scalar subtype " & - "(RM 4.9(7))!", N); + ("\prefix type for attribute is not static scalar subtype " + & "(RM 4.9(7))", N); else Error_Msg_N - ("static attribute must apply to array/scalar type " & - "(RM 4.9(7,8))!", N); + ("\static attribute must apply to array/scalar type " + & "(RM 4.9(7,8))", N); end if; + -- String literal + when N_String_Literal => Error_Msg_N - ("subtype of string literal is non-static (RM 4.9(4))!", N); + ("\subtype of string literal is non-static (RM 4.9(4))", N); + -- Explicit dereference + when N_Explicit_Dereference => Error_Msg_N - ("explicit dereference is never static (RM 4.9)!", N); + ("\explicit dereference is never static (RM 4.9)", N); + -- Function call + when N_Function_Call => Why_Not_Static_List (Parameter_Associations (N)); @@ -5636,44 +5699,59 @@ -- scalar arithmetic operation. if not Is_RTE (Typ, RE_Bignum) then - Error_Msg_N ("non-static function call (RM 4.9(6,18))!", N); + Error_Msg_N ("\non-static function call (RM 4.9(6,18))", N); end if; + -- Parameter assocation (test actual parameter) + when N_Parameter_Association => Why_Not_Static (Explicit_Actual_Parameter (N)); + -- Indexed component + when N_Indexed_Component => - Error_Msg_N - ("indexed component is never static (RM 4.9)!", N); + Error_Msg_N ("\indexed component is never static (RM 4.9)", N); + -- Procedure call + when N_Procedure_Call_Statement => - Error_Msg_N - ("procedure call is never static (RM 4.9)!", N); + Error_Msg_N ("\procedure call is never static (RM 4.9)", N); + -- Qualified expression (test expression) + when N_Qualified_Expression => Why_Not_Static (Expression (N)); + -- Aggregate + when N_Aggregate | N_Extension_Aggregate => - Error_Msg_N - ("an aggregate is never static (RM 4.9)!", N); + Error_Msg_N ("\an aggregate is never static (RM 4.9)", N); + -- Range + when N_Range => Why_Not_Static (Low_Bound (N)); Why_Not_Static (High_Bound (N)); + -- Range constraint, test range expression + when N_Range_Constraint => Why_Not_Static (Range_Expression (N)); + -- Subtype indication, test constraint + when N_Subtype_Indication => Why_Not_Static (Constraint (N)); + -- Selected component + when N_Selected_Component => - Error_Msg_N - ("selected component is never static (RM 4.9)!", N); + Error_Msg_N ("\selected component is never static (RM 4.9)", N); + -- Slice + when N_Slice => - Error_Msg_N - ("slice is never static (RM 4.9)!", N); + Error_Msg_N ("\slice is never static (RM 4.9)", N); when N_Type_Conversion => Why_Not_Static (Expression (N)); @@ -5682,14 +5760,18 @@ or else not Is_Static_Subtype (Entity (Subtype_Mark (N))) then Error_Msg_N - ("static conversion requires static scalar subtype result " & - "(RM 4.9(9))!", N); + ("\static conversion requires static scalar subtype result " + & "(RM 4.9(9))", N); end if; + -- Unchecked type conversion + when N_Unchecked_Type_Conversion => Error_Msg_N - ("unchecked type conversion is never static (RM 4.9)!", N); + ("\unchecked type conversion is never static (RM 4.9)", N); + -- All other cases, no reason to give + when others => null; Index: sem_eval.ads =================================================================== --- sem_eval.ads (revision 197743) +++ sem_eval.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -417,17 +417,17 @@ procedure Why_Not_Static (Expr : Node_Id); -- This procedure may be called after generating an error message that - -- complains that something is non-static. If it finds good reasons, it - -- generates one or more error messages pointing the appropriate offending - -- component of the expression. If no good reasons can be figured out, then - -- no messages are generated. The expectation here is that the caller has - -- already issued a message complaining that the expression is non-static. - -- Note that this message should be placed using Error_Msg_F or - -- Error_Msg_FE, so that it will sort before any messages placed by this - -- call. Note that it is fine to call Why_Not_Static with something that is - -- not an expression, and usually this has no effect, but in some cases - -- (N_Parameter_Association or N_Range), it makes sense for the internal - -- recursive calls. + -- complains that something is non-static. If it finds good reasons, + -- it generates one or more continuation error messages pointing the + -- appropriate offending component of the expression. If no good reasons + -- can be figured out, then no messages are generated. The expectation here + -- is that the caller has already issued a message complaining that the + -- expression is non-static. Note that this message should be placed using + -- Error_Msg_F or Error_Msg_FE, so that it will sort before any messages + -- placed by this call. Note that it is fine to call Why_Not_Static with + -- something that is not an expression, and usually this has no effect, but + -- in some cases (N_Parameter_Association or N_Range), it makes sense for + -- the internal recursive calls. procedure Initialize; -- Initializes the internal data structures. Must be called before each