From: Arnaud Charlet Date: Tue, 2 May 2017 08:57:44 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a6354842df32417f55a9635e98f7e00bd412e13a;p=gcc.git [multiple changes] 2017-05-02 Hristian Kirtchev * sem_ch6.adb (Analyze_Null_Procedure): Revert previous change. 2017-05-02 Justin Squirek * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 38b35fd7b02..f11110e01c0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2017-05-02 Hristian Kirtchev + + * sem_ch6.adb (Analyze_Null_Procedure): Revert previous change. + +2017-05-02 Justin Squirek + + * 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 * exp_ch3.adb (Build_Initialization_Call): Generate a null diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 8a94f3f0b44..3952789f762 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 760487ffb88..61e4f86c6ca 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index c9f296a9eb7..5a40ed97630 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index ba28eda23d7..ff0a3e85f3a 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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; -------------------------------