Patchwork [Ada] Error recovery for illformed conditional expression

login
register
mail settings
Submitter Arnaud Charlet
Date June 22, 2010, 8:49 a.m.
Message ID <20100622084931.GA3282@adacore.com>
Download mbox | patch
Permalink /patch/56415/
State New
Headers show

Comments

Arnaud Charlet - June 22, 2010, 8:49 a.m.
This patch adds a couple of defenses against conditional expressions
with malformed then part causing trouble later on in -gnatq mode or if
the tree is listed with -gnatG.

The following should compile without a "compilation abandoned" message
using options -gnatGX:

function staticifCE (x : integer) return integer is
begin
    return (if x > x then return 0 else return x);
end;

generating the output:

function staticifce (x : integer) return integer is
begin
   return (if x > x then );
end staticifce;

staticifce.adb:3:27: reserved word "return" cannot be used as identifier

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-06-22  Robert Dewar  <dewar@adacore.com>

	* sem_ch4.adb (Analyze_Conditional_Expression): Defend against
	malformed tree.
	* sprint.adb (Sprint_Node_Actual, case N_Conditional_Expression): Ditto.

Patch

Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb	(revision 161073)
+++ sem_ch4.adb	(working copy)
@@ -1385,9 +1385,17 @@  package body Sem_Ch4 is
    procedure Analyze_Conditional_Expression (N : Node_Id) is
       Condition : constant Node_Id := First (Expressions (N));
       Then_Expr : constant Node_Id := Next (Condition);
-      Else_Expr : constant Node_Id := Next (Then_Expr);
+      Else_Expr : Node_Id;
 
    begin
+      --  Defend against error of missing expressions from previous error
+
+      if No (Then_Expr) then
+         return;
+      end if;
+
+      Else_Expr := Next (Then_Expr);
+
       if Comes_From_Source (N) then
          Check_Compiler_Unit (N);
       end if;
Index: sprint.adb
===================================================================
--- sprint.adb	(revision 161073)
+++ sprint.adb	(working copy)
@@ -1251,14 +1251,20 @@  package body Sprint is
             declare
                Condition : constant Node_Id := First (Expressions (Node));
                Then_Expr : constant Node_Id := Next (Condition);
-               Else_Expr : constant Node_Id := Next (Then_Expr);
+
             begin
                Write_Str_With_Col_Check_Sloc ("(if ");
                Sprint_Node (Condition);
                Write_Str_With_Col_Check (" then ");
-               Sprint_Node (Then_Expr);
-               Write_Str_With_Col_Check (" else ");
-               Sprint_Node (Else_Expr);
+
+               --  Defense against junk here!
+
+               if Present (Then_Expr) then
+                  Sprint_Node (Then_Expr);
+                  Write_Str_With_Col_Check (" else ");
+                  Sprint_Node (Next (Then_Expr));
+               end if;
+
                Write_Char (')');
             end;