Skip to content

R
riscv-gcc-1
Commit 8fde064e by Arnaud Charlet
Options

[multiple changes] 

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* 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.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_Concatenation): Wrap expansion in
	Expressions_With_Actions.

2013-04-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Base_Types_Match): For an actual type in an
	instance, the base type may itself be a subtype, so find true
	base type to determine compatibility.

From-SVN: r197745
parent 354c3840
Showing with 236 additions and 144 deletions
gcc/ada/ChangeLog
2013-04-11 Robert Dewar <dewar@adacore.com>
* 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.
2013-04-11 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_Concatenation): Wrap expansion in
Expressions_With_Actions.
2013-04-11 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Base_Types_Match): For an actual type in an
instance, the base type may itself be a subtype, so find true
base type to determine compatibility.
2013-04-11 Robert Dewar <dewar@adacore.com>
* s-osprim-mingw.adb, sem_ch3.adb, sem_prag.adb, sem_util.adb.
makeutl.adb, sem_ch8.adb: Minor reformatting.
......
gcc/ada/errout.ads
......@@ -242,7 +242,7 @@ package Errout is
-- 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.
......
gcc/ada/exp_ch4.adb
......@@ -3017,6 +3017,8 @@ package body Exp_Ch4 is
-- Start of processing for Expand_Concatenate
-- Kirtchev
begin
-- Choose an appropriate computational type
......@@ -3233,7 +3235,6 @@ package body Exp_Ch4 is
Prefix =>
Duplicate_Subexpr (Opnd, Name_Req => True),
Attribute_Name => Name_First);
Set_Parent (Opnd_Low_Bound (NN), Opnd);
-- Capture last operand bounds if result could be null
......@@ -3244,7 +3245,6 @@ package body Exp_Ch4 is
Prefix =>
Duplicate_Subexpr (Opnd, Name_Req => True),
Attribute_Name => Name_First));
Set_Parent (Last_Opnd_Low_Bound, Opnd);
Last_Opnd_High_Bound :=
Convert_To (Ityp,
......@@ -3252,7 +3252,6 @@ package body Exp_Ch4 is
Prefix =>
Duplicate_Subexpr (Opnd, Name_Req => True),
Attribute_Name => Name_Last));
Set_Parent (Last_Opnd_High_Bound, Opnd);
end if;
-- Capture length of operand in entity
......@@ -5182,6 +5181,10 @@ package body Exp_Ch4 is
Desig_Typ := Obj_Typ;
end if;
-- Kirtchev J730-020
Desig_Typ := Base_Type (Desig_Typ);
-- Generate:
-- Ann : access [all] <Desig_Typ>;
......@@ -6721,6 +6724,8 @@ package body Exp_Ch4 is
-- Node which is to be replaced by the result of concatenating the nodes
-- in the list Opnds.
-- Kirtchev
begin
-- Ensure validity of both operands
......@@ -6748,7 +6753,6 @@ package body Exp_Ch4 is
-- Now Cnode is the deepest concatenation, and its parents are the
-- concatenation nodes above, so now we process bottom up, doing the
-- operations. We gather a string that is as long as possible up to five
-- operands.
-- The outer loop runs more than once if more than one concatenation
......@@ -6768,7 +6772,27 @@ package body Exp_Ch4 is
Append (Right_Opnd (Cnode), Opnds);
end loop Inner;
Expand_Concatenate (Cnode, Opnds);
-- Wrap the node to concatenate into an expression actions node to
-- keep it nicely packaged. This is useful in the case of an assert
-- pragma with a concatenation where we want to be able to delete
-- the concatenation and all its expansion stuff.
declare
Cnod : constant Node_Id := Relocate_Node (Cnode);
Typ : constant Entity_Id := Base_Type (Etype (Cnode));
begin
-- Note: use Rewrite rather than Replace here, so that for example
-- Why_Not_Static can find the original concatenation node OK!
Rewrite (Cnode,
Make_Expression_With_Actions (Sloc (Cnode),
Actions => New_List (Make_Null_Statement (Sloc (Cnode))),
Expression => Cnod));
Expand_Concatenate (Cnod, Opnds);
Analyze_And_Resolve (Cnode, Typ);
end;
exit Outer when Cnode = N;
Cnode := Parent (Cnode);
......
gcc/ada/sem_ch6.adb
......@@ -362,9 +362,7 @@ package body Sem_Ch6 is
Analyze (New_Body);
Set_Is_Inlined (Prev);
elsif Present (Prev)
and then Comes_From_Source (Prev)
then
elsif Present (Prev) and then Comes_From_Source (Prev) then
Set_Has_Completion (Prev, False);
-- For navigation purposes, indicate that the function is a body
......@@ -1410,11 +1408,9 @@ package body Sem_Ch6 is
-- function, the context will select the operation whose type is Void.
elsif Nkind (P) = N_Selected_Component
and then (Ekind (Entity (Selector_Name (P))) = E_Entry
or else
Ekind (Entity (Selector_Name (P))) = E_Procedure
or else
Ekind (Entity (Selector_Name (P))) = E_Function)
and then Ekind_In (Entity (Selector_Name (P)), E_Entry,
E_Procedure,
E_Function)
then
Analyze_Call_And_Resolve;
......@@ -1685,9 +1681,7 @@ package body Sem_Ch6 is
-- Unconstrained array as result is not allowed in SPARK
if Is_Array_Type (Typ)
and then not Is_Constrained (Typ)
then
if Is_Array_Type (Typ) and then not Is_Constrained (Typ) then
Check_SPARK_Restriction
("returning an unconstrained array is not allowed",
Result_Definition (N));
......@@ -1703,9 +1697,7 @@ package body Sem_Ch6 is
-- right before this, because they don't get applied to types that
-- do not come from source.
if Is_Access_Type (Typ)
and then Null_Exclusion_Present (N)
then
if Is_Access_Type (Typ) and then Null_Exclusion_Present (N) then
Set_Etype (Designator,
Create_Null_Excluding_Itype
(T => Typ,
......@@ -1752,8 +1744,7 @@ package body Sem_Ch6 is
elsif Ekind (Typ) = E_Incomplete_Type
or else (Is_Class_Wide_Type (Typ)
and then
Ekind (Root_Type (Typ)) = E_Incomplete_Type)
and then Ekind (Root_Type (Typ)) = E_Incomplete_Type)
then
-- AI05-0151: Tagged incomplete types are allowed in all formal
-- parts. Untagged incomplete types are not allowed in bodies.
......@@ -2025,8 +2016,8 @@ package body Sem_Ch6 is
and then Pragma_Name (N) = Name_Inline))
and then
Chars
(Expression (First (Pragma_Argument_Associations (N))))
= Chars (Body_Id);
(Expression (First (Pragma_Argument_Associations (N)))) =
Chars (Body_Id);
end Is_Inline_Pragma;
-- Start of processing for Check_Inline_Pragma
......@@ -2490,9 +2481,7 @@ package body Sem_Ch6 is
-- part of the context of one of its subunits. No need to redo the
-- analysis.
elsif Prev_Id = Body_Id
and then Has_Completion (Body_Id)
then
elsif Prev_Id = Body_Id and then Has_Completion (Body_Id) then
return;
else
......@@ -2821,9 +2810,7 @@ package body Sem_Ch6 is
-- is the limited view of a class-wide type and the non-limited view is
-- available, update the return type accordingly.
if Ada_Version >= Ada_2005
and then Comes_From_Source (N)
then
if Ada_Version >= Ada_2005 and then Comes_From_Source (N) then
declare
Etyp : Entity_Id;
Rtyp : Entity_Id;
......@@ -2834,9 +2821,7 @@ package body Sem_Ch6 is
if Ekind (Rtyp) = E_Anonymous_Access_Type then
Etyp := Directly_Designated_Type (Rtyp);
if Is_Class_Wide_Type (Etyp)
and then From_With_Type (Etyp)
then
if Is_Class_Wide_Type (Etyp) and then From_With_Type (Etyp) then
Set_Directly_Designated_Type
(Etype (Current_Scope), Available_View (Etyp));
end if;
......@@ -3401,10 +3386,9 @@ package body Sem_Ch6 is
Set_Kill_Elaboration_Checks (Designator);
end if;
if Scop /= Standard_Standard
and then not Is_Child_Unit (Designator)
then
if Scop /= Standard_Standard and then not Is_Child_Unit (Designator) then
Set_Categorization_From_Scope (Designator, Scop);
else
-- For a compilation unit, check for library-unit pragmas
......@@ -5493,10 +5477,9 @@ package body Sem_Ch6 is
if Ada_Version >= Ada_2005
and then Ekind (Etype (Old_Type)) = E_Anonymous_Access_Type
and then
(Can_Never_Be_Null (Old_Type)
/= Can_Never_Be_Null (New_Type)
or else Is_Access_Constant (Etype (Old_Type))
/= Is_Access_Constant (Etype (New_Type)))
(Can_Never_Be_Null (Old_Type) /= Can_Never_Be_Null (New_Type)
or else Is_Access_Constant (Etype (Old_Type)) /=
Is_Access_Constant (Etype (New_Type)))
then
Conformance_Error ("\return type does not match!", New_Id);
return;
......@@ -5519,7 +5502,6 @@ package body Sem_Ch6 is
if Ctype >= Subtype_Conformant then
if Convention (Old_Id) /= Convention (New_Id) then
if not Is_Frozen (New_Id) then
null;
......@@ -6116,17 +6098,13 @@ package body Sem_Ch6 is
-- done for delayed_freeze subprograms because the underlying
-- returned type may not be known yet (for private types)
if not Has_Delayed_Freeze (Designator)
and then Expander_Active
then
if not Has_Delayed_Freeze (Designator) and then Expander_Active then
declare
Typ : constant Entity_Id := Etype (Designator);
Utyp : constant Entity_Id := Underlying_Type (Typ);
begin
if Is_Immutably_Limited_Type (Typ) then
Set_Returns_By_Ref (Designator);
elsif Present (Utyp) and then CW_Or_Has_Controlled_Part (Utyp) then
Set_Returns_By_Ref (Designator);
end if;
......@@ -6678,9 +6656,7 @@ package body Sem_Ch6 is
-- sequences (which were the original sequences of statements in
-- the exception handlers) and check them.
if Nkind (Last_Stm) = N_Label
and then Exception_Junk (Last_Stm)
then
if Nkind (Last_Stm) = N_Label and then Exception_Junk (Last_Stm) then
Stm := Last_Stm;
loop
Prev (Stm);
......@@ -7511,11 +7487,14 @@ package body Sem_Ch6 is
----------------------
function Base_Types_Match (T1, T2 : Entity_Id) return Boolean is
BT1 : constant Entity_Id := Base_Type (T1);
BT2 : constant Entity_Id := Base_Type (T2);
begin
if T1 = T2 then
return True;
elsif Base_Type (T1) = Base_Type (T2) then
elsif BT1 = BT2 then
-- The following is too permissive. A more precise test should
-- check that the generic actual is an ancestor subtype of the
......@@ -7528,6 +7507,16 @@ package body Sem_Ch6 is
or else not Is_Generic_Actual_Type (T2)
or else Scope (T1) /= Scope (T2);
-- If T2 is a generic actual type it is declared as the subtype of
-- the actual. If that actual is itself a subtype we need to use
-- its own base type to check for compatibility.
elsif Ekind (BT2) = Ekind (T2) and then BT1 = Base_Type (BT2) then
return True;
elsif Ekind (BT1) = Ekind (T1) and then BT2 = Base_Type (BT1) then
return True;
else
return False;
end if;
......@@ -7572,14 +7561,10 @@ package body Sem_Ch6 is
-- access-to-class-wide type in a formal. Both entities designate the
-- same type.
if From_With_Type (T1)
and then T2 = Available_View (T1)
then
if From_With_Type (T1) and then T2 = Available_View (T1) then
return True;
elsif From_With_Type (T2)
and then T1 = Available_View (T2)
then
elsif From_With_Type (T2) and then T1 = Available_View (T2) then
return True;
elsif From_With_Type (T1)
......@@ -7596,10 +7581,9 @@ package body Sem_Ch6 is
-- Start of processing for Conforming_Types
begin
-- The context is an instance association for a formal
-- access-to-subprogram type; the formal parameter types require
-- mapping because they may denote other formal parameters of the
-- generic unit.
-- The context is an instance association for a formal access-to-
-- subprogram type; the formal parameter types require mapping because
-- they may denote other formal parameters of the generic unit.
if Get_Inst then
Type_1 := Get_Instance_Of (T1);
......@@ -7645,9 +7629,8 @@ package body Sem_Ch6 is
Are_Anonymous_Access_To_Subprogram_Types :=
Ekind (Type_1) = Ekind (Type_2)
and then
(Ekind (Type_1) = E_Anonymous_Access_Subprogram_Type
or else
Ekind (Type_1) = E_Anonymous_Access_Protected_Subprogram_Type);
Ekind_In (Type_1, E_Anonymous_Access_Subprogram_Type,
E_Anonymous_Access_Protected_Subprogram_Type);
-- Test anonymous access type case. For this case, static subtype
-- matching is required for mode conformance (RM 6.3.1(15)). We check
......@@ -7657,7 +7640,10 @@ package body Sem_Ch6 is
if (Ekind (Base_Type (Type_1)) = E_Anonymous_Access_Type
and then
Ekind (Base_Type (Type_2)) = E_Anonymous_Access_Type)
or else Are_Anonymous_Access_To_Subprogram_Types -- Ada 2005 (AI-254)
-- Ada 2005 (AI-254)
or else Are_Anonymous_Access_To_Subprogram_Types
then
declare
Desig_1 : Entity_Id;
......@@ -7826,8 +7812,8 @@ package body Sem_Ch6 is
-- Start of processing for Create_Extra_Formals
begin
-- We never generate extra formals if expansion is not active
-- because we don't need them unless we are generating code.
-- We never generate extra formals if expansion is not active because we
-- don't need them unless we are generating code.
if not Expander_Active then
return;
......@@ -7852,9 +7838,7 @@ package body Sem_Ch6 is
-- situation may arise for subprogram types created as part of
-- dispatching calls (see Expand_Dispatching_Call)
if Present (Last_Extra) and then
Present (Extra_Formal (Last_Extra))
then
if Present (Last_Extra) and then Present (Extra_Formal (Last_Extra)) then
return;
end if;
......@@ -8093,9 +8077,7 @@ package body Sem_Ch6 is
-- Chain new entity if front of homonym in current scope, so that
-- homonyms are contiguous.
if Present (E)
and then E /= C_E
then
if Present (E) and then E /= C_E then
while Homonym (C_E) /= E loop
C_E := Homonym (C_E);
end loop;
......@@ -8606,14 +8588,10 @@ package body Sem_Ch6 is
return Nkind (Selector_Name (E1)) = N_Character_Literal
and then Chars (E2) = Chars (Selector_Name (E1));
elsif Nkind (E1) in N_Op
and then Nkind (E2) = N_Function_Call
then
elsif Nkind (E1) in N_Op and then Nkind (E2) = N_Function_Call then
return FCO (E1, E2);
elsif Nkind (E2) in N_Op
and then Nkind (E1) = N_Function_Call
then
elsif Nkind (E2) in N_Op and then Nkind (E1) = N_Function_Call then
return FCO (E2, E1);
-- Otherwise we must have the same syntactic entity
......@@ -9615,12 +9593,8 @@ package body Sem_Ch6 is
("abstract subprograms must be visible "
& "(RM 3.9.3(10))!", S);
elsif Ekind (S) = E_Function
and then not Is_Overriding
then
if Is_Tagged_Type (T)
and then T = Base_Type (Etype (S))
then
elsif Ekind (S) = E_Function and then not Is_Overriding then
if Is_Tagged_Type (T) and then T = Base_Type (Etype (S)) then
Error_Msg_N
("private function with tagged result must"
& " override visible-part function", S);
......@@ -10059,13 +10033,12 @@ package body Sem_Ch6 is
-- routine must be of mode "out", "in out" or
-- access-to-variable.
if (Ekind (Candidate) = E_Entry
or else Ekind (Candidate) = E_Procedure)
if Ekind_In (Candidate, E_Entry, E_Procedure)
and then Is_Protected_Type (Typ)
and then Ekind (Formal) /= E_In_Out_Parameter
and then Ekind (Formal) /= E_Out_Parameter
and then Nkind (Parameter_Type (Parent (Formal)))
/= N_Access_Definition
and then Nkind (Parameter_Type (Parent (Formal))) /=
N_Access_Definition
then
null;
......@@ -10453,9 +10426,7 @@ package body Sem_Ch6 is
begin
Prev := First_Entity (Current_Scope);
while Present (Prev)
and then Next_Entity (Prev) /= E
loop
while Present (Prev) and then Next_Entity (Prev) /= E loop
Next_Entity (Prev);
end loop;
......@@ -10798,8 +10769,7 @@ package body Sem_Ch6 is
end if;
return
Ekind (Desig) = E_Incomplete_Type
and then From_With_Type (Desig);
Ekind (Desig) = E_Incomplete_Type and then From_With_Type (Desig);
end Designates_From_With_Type;
---------------------------
......@@ -12515,9 +12485,7 @@ package body Sem_Ch6 is
-- If this is an empty initialization procedure, no need to create
-- actual subtypes (small optimization).
if Ekind (Subp) = E_Procedure
and then Is_Null_Init_Proc (Subp)
then
if Ekind (Subp) = E_Procedure and then Is_Null_Init_Proc (Subp) then
return;
end if;
......
gcc/ada/sem_eval.adb
......@@ -5495,8 +5495,8 @@ package body Sem_Eval is
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 @@ package body Sem_Eval is
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 @@ package body Sem_Eval is
-- 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 @@ package body Sem_Eval is
null;
elsif Ekind (E) = E_Constant then
if not Is_Static_Expression (Constant_Value (E)) then
-- 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);
("\& 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 @@ package body Sem_Eval is
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 @@ package body Sem_Eval is
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,30 +5660,36 @@ package body Sem_Eval is
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 @@ package body Sem_Eval is
-- 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,13 +5760,17 @@ package body Sem_Eval is
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;
......
gcc/ada/sem_eval.ads
......@@ -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 @@ package Sem_Eval is
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment