Patchwork [Ada] Add some defenses against junk code

login
register
mail settings
Submitter Arnaud Charlet
Date Sept. 10, 2010, 1:12 p.m.
Message ID <20100910131229.GA28707@adacore.com>
Download mbox | patch
Permalink /patch/64389/
State New
Headers show

Comments

Arnaud Charlet - Sept. 10, 2010, 1:12 p.m.
This patch adds some defenses against junk code, avoiding crashes

The following tests compile with syntax errors instead of crashing

with ATower; use ATower;
package TowersOfHanoi is
   type TowersRange is (left, middle, right);
   type TowersPool is array (TowersRange) of Tower;
   type TowersBoard is
      record
         pool : TowersPool := (left =>
                     Tower'(empty => false,
                            top   => Disc'Last,
                            buf   => (Disc'First .. Disc'Last)));
      end record;
end TowersOfHanoi;

package ATower is
   type Disc is new Natural range 0 .. 3;
   type TowerBuffer is array (Disc) of Disc;
   type Tower is
      record
         empty : Boolean := true;
         top   : Disc := Disc'First;
         buf   : TowerBuffer;
      end record;
   emptyTower : constant Tower :=
         (empty => true,
          top   => Disc'First,
          buf   => (others => Disc'First));
   procedure push(tower : in out ATower.Tower; val : Integer);
   procedure pop(tower : in out ATower.Tower);
   function top(tower : ATower.Tower) return Integer;
   function isEmpty(tower : ATower.Tower) return Boolean;
   underflow : exception; -- Stack underflow
   overflow  : exception; -- Stack overflow
end ATower;

package Toto is
   type Disc is new Natural range (0 .. 3);
end Toto;

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

2010-09-10  Robert Dewar  <dewar@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): Defend against previous
	errors.
	* freeze.adb (Check_Unsigned_Type): Ditto.
	* sem_aggr.adb (Resolve_Aggr_Expr): Ditto.
	* sem_ch3.adb (Convert_Scalar_Bounds): Ditto.
	(Set_Scalar_Range_For_Subtype): Ditto.
	* sem_eval.adb (Subtypes_Statically_Match): Ditto.

Patch

Index: sem_aggr.adb
===================================================================
--- sem_aggr.adb	(revision 164167)
+++ sem_aggr.adb	(working copy)
@@ -1411,6 +1411,14 @@  package body Sem_Aggr is
          --  Set to False if resolution of the expression failed
 
       begin
+         --  Defend against previous errors
+
+         if Nkind (Expr) = N_Error
+           or else Error_Posted (Expr)
+         then
+            return True;
+         end if;
+
          --  If the array type against which we are resolving the aggregate
          --  has several dimensions, the expressions nested inside the
          --  aggregate must be further aggregates (or strings).
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 164167)
+++ sem_ch3.adb	(working copy)
@@ -11252,6 +11252,12 @@  package body Sem_Ch3 is
       Rng : Node_Id;
 
    begin
+      --  Defend against previous errors
+
+      if No (Scalar_Range (Derived_Type)) then
+         return;
+      end if;
+
       Lo := Build_Scalar_Bound
               (Type_Low_Bound (Derived_Type),
                Parent_Type, Implicit_Base);
@@ -18294,6 +18300,12 @@  package body Sem_Ch3 is
       Kind : constant Entity_Kind :=  Ekind (Def_Id);
 
    begin
+      --  Defend against previous error
+
+      if Nkind (R) = N_Error then
+         return;
+      end if;
+
       Set_Scalar_Range (Def_Id, R);
 
       --  We need to link the range into the tree before resolving it so
Index: freeze.adb
===================================================================
--- freeze.adb	(revision 164167)
+++ freeze.adb	(working copy)
@@ -1089,7 +1089,9 @@  package body Freeze is
 
       --  Do not attempt to analyze case where range was in error
 
-      if Error_Posted (Scalar_Range (E)) then
+      if No (Scalar_Range (E))
+        or else Error_Posted (Scalar_Range (E))
+      then
          return;
       end if;
 
Index: sem_eval.adb
===================================================================
--- sem_eval.adb	(revision 164167)
+++ sem_eval.adb	(working copy)
@@ -4680,9 +4680,9 @@  package body Sem_Eval is
          --  If there was an error in either range, then just assume the types
          --  statically match to avoid further junk errors.
 
-         if Error_Posted (Scalar_Range (T1))
-              or else
-            Error_Posted (Scalar_Range (T2))
+         if No (Scalar_Range (T1)) or else No (Scalar_Range (T2))
+           or else Error_Posted (Scalar_Range (T1))
+           or else Error_Posted (Scalar_Range (T2))
          then
             return True;
          end if;
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb	(revision 164167)
+++ exp_ch3.adb	(working copy)
@@ -4994,7 +4994,10 @@  package body Exp_Ch3 is
                  and then No_Initialization (Expr)
                then
                   null;
-               else
+
+               --  Otherwise apply a constraint check now if no prev error
+
+               elsif Nkind (Expr) /= N_Error then
                   Apply_Constraint_Check (Expr, Typ);
 
                   --  If the expression has been marked as requiring a range