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