[multiple changes]

2017-05-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb (Analyze_Null_Procedure): Revert previous change.

2017-05-02  Justin Squirek  <squirek@adacore.com>

	* sem_ch4.adb (Analyze_Case_Expression): Add check for valid
	expression (Analyze_If_Expression): Add check for valid condition
	* sem_eval.adb (Eval_Case_Expression): Add check for error posted
	on case-expression
	* sem_res.adb (Resolve_If_Expression): Add check for valid
	condition and then-expression.

From-SVN: r247477
This commit is contained in:
Arnaud Charlet 2017-05-02 10:57:44 +02:00
parent 97ac2d62fa
commit a6354842df
5 changed files with 47 additions and 13 deletions

View file

@ -1,3 +1,16 @@
2017-05-02 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch6.adb (Analyze_Null_Procedure): Revert previous change.
2017-05-02 Justin Squirek <squirek@adacore.com>
* sem_ch4.adb (Analyze_Case_Expression): Add check for valid
expression (Analyze_If_Expression): Add check for valid condition
* sem_eval.adb (Eval_Case_Expression): Add check for error posted
on case-expression
* sem_res.adb (Resolve_If_Expression): Add check for valid
condition and then-expression.
2017-05-02 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Build_Initialization_Call): Generate a null

View file

@ -1560,6 +1560,10 @@ package body Sem_Ch4 is
-- Get our initial type from the first expression for which we got some
-- useful type information from the expression.
if No (FirstX) then
return;
end if;
if not Is_Overloaded (FirstX) then
Set_Etype (N, Etype (FirstX));
@ -2212,23 +2216,28 @@ package body Sem_Ch4 is
procedure Analyze_If_Expression (N : Node_Id) is
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
Then_Expr : Node_Id;
Else_Expr : Node_Id;
begin
-- Defend against error of missing expressions from previous error
if No (Condition) then
Check_Error_Detected;
return;
end if;
Then_Expr := Next (Condition);
if No (Then_Expr) then
Check_Error_Detected;
return;
end if;
Else_Expr := Next (Then_Expr);
if Comes_From_Source (N) then
Check_SPARK_05_Restriction ("if expression is not allowed", N);
end if;
Else_Expr := Next (Then_Expr);
if Comes_From_Source (N) then
Check_Compiler_Unit ("if expression", N);
end if;

View file

@ -1450,12 +1450,6 @@ package body Sem_Ch6 is
Is_Completion := False;
-- Link the body to the null procedure spec
if Nkind (N) = N_Subprogram_Declaration then
Set_Corresponding_Body (N, Defining_Entity (Null_Body));
end if;
-- Null procedures are always inlined, but generic formal subprograms
-- which appear as such in the internal instance of formal packages,
-- need no completion and are not marked Inline.
@ -1463,6 +1457,7 @@ package body Sem_Ch6 is
if Expander_Active
and then Nkind (N) /= N_Formal_Concrete_Subprogram_Declaration
then
Set_Corresponding_Body (N, Defining_Entity (Null_Body));
Set_Body_To_Inline (N, Null_Body);
Set_Is_Inlined (Designator);
end if;

View file

@ -2158,7 +2158,9 @@ package body Sem_Eval is
begin
Set_Is_Static_Expression (N, False);
if not Is_Static_Expression (Expression (N)) then
if Error_Posted (Expression (N))
or else not Is_Static_Expression (Expression (N))
then
Check_Non_Static_Context (Expression (N));
return;
end if;

View file

@ -8241,12 +8241,24 @@ package body Sem_Res is
procedure Resolve_If_Expression (N : Node_Id; Typ : Entity_Id) is
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : Node_Id := Next (Then_Expr);
Then_Expr : Node_Id;
Else_Expr : Node_Id;
Else_Typ : Entity_Id;
Then_Typ : Entity_Id;
begin
-- Defend against malformed expressions
if No (Condition) then
return;
end if;
Then_Expr := Next (Condition);
if No (Then_Expr) then
return;
end if;
Else_Expr := Next (Then_Expr);
Resolve (Condition, Any_Boolean);
Resolve (Then_Expr, Typ);
Then_Typ := Etype (Then_Expr);
@ -8311,7 +8323,10 @@ package body Sem_Res is
end if;
Set_Etype (N, Typ);
Eval_If_Expression (N);
if not Error_Posted (N) then
Eval_If_Expression (N);
end if;
end Resolve_If_Expression;
-------------------------------