[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 38b35fd..f11110e 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 8a94f3f..3952789 100644 (file)
--- 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 760487f..61e4f86 100644 (file)
--- 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 c9f296a..5a40ed9 100644 (file)
--- 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 ba28eda..ff0a3e8 100644 (file)
--- 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;
 
    -------------------------------