[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:
parent
97ac2d62fa
commit
a6354842df
5 changed files with 47 additions and 13 deletions
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
-------------------------------
|
||||
|
|
Loading…
Add table
Reference in a new issue