===================================================================
@@ -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.
===================================================================
@@ -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;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- 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