* sem_ch3.adb:

	(Analyze_Number_Declaration): Handle error expression.
	(Signed_Integer_Type_Declaration): Handle error bound.
	(Analyze_Subtype_Indication): Handle error range.

	* sem_util.adb (Get_Index_Bounds): Check for Error.

From-SVN: r46508

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b94b7516cdcf79c6195678e2826268d325098ae4..36efe38570b946ce3bddc141f2667bdfd4df8642 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2001-10-25  Robert Dewar <dewar@gnat.com>
+
+       * sem_ch3.adb:
+       (Analyze_Number_Declaration): Handle error expression.
+       (Signed_Integer_Type_Declaration): Handle error bound.
+       (Analyze_Subtype_Indication): Handle error range.
+       
+       * sem_util.adb (Get_Index_Bounds): Check for Error.
+
 2001-10-25  Robert Dewar <dewar@gnat.com>
 
        * restrict.adb (Set_No_Run_Time_Mode): Set Discard_Names as default 

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index dd9b6b07e737185c3c17fe916a2ebcb4b9453ee6..127637bd86230129bacf23864773bb6e42b61350 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.1354 $
+--                            $Revision$
 --                                                                          --
 --          Copyright (C) 1992-2001, Free Software Foundation, Inc.         --
 --                                                                          --
@@ -1147,6 +1147,17 @@ package body Sem_Ch3 is
 
       Set_Is_Pure (Id, Is_Pure (Current_Scope));
 
+      --  Process expression, replacing error by integer zero, to avoid
+      --  cascaded errors or aborts further along in the processing
+
+      --  Replace Error by integer zero, which seems least likely to
+      --  cause cascaded errors.
+
+      if E = Error then
+         Rewrite (E, Make_Integer_Literal (Sloc (E), Uint_0));
+         Set_Error_Posted (E);
+      end if;
+
       Analyze (E);
 
       --  Verify that the expression is static and numeric. If
@@ -2302,8 +2313,14 @@ package body Sem_Ch3 is
 
    begin
       Analyze (T);
-      Analyze (R);
-      Set_Etype (N, Etype (R));
+
+      if R /= Error then
+         Analyze (R);
+         Set_Etype (N, Etype (R));
+      else
+         Set_Error_Posted (R);
+         Set_Error_Posted (T);
+      end if;
    end Analyze_Subtype_Indication;
 
    ------------------------------
@@ -12062,42 +12079,53 @@ package body Sem_Ch3 is
 
       Lo := Low_Bound (Def);
       Hi := High_Bound (Def);
-      Analyze_And_Resolve (Lo, Any_Integer);
-      Analyze_And_Resolve (Hi, Any_Integer);
 
-      Check_Bound (Lo);
-      Check_Bound (Hi);
+      --  Arbitrarily use Integer as the type if either bound had an error
 
-      if Errs then
-         Hi := Type_High_Bound (Standard_Long_Long_Integer);
-         Lo := Type_Low_Bound (Standard_Long_Long_Integer);
-      end if;
+      if Hi = Error or else Lo = Error then
+         Base_Typ := Any_Integer;
+         Set_Error_Posted (T, True);
 
-      --  Find type to derive from
+      --  Here both bounds are OK expressions
 
-      Lo_Val := Expr_Value (Lo);
-      Hi_Val := Expr_Value (Hi);
+      else
+         Analyze_And_Resolve (Lo, Any_Integer);
+         Analyze_And_Resolve (Hi, Any_Integer);
 
-      if Can_Derive_From (Standard_Short_Short_Integer) then
-         Base_Typ := Base_Type (Standard_Short_Short_Integer);
+         Check_Bound (Lo);
+         Check_Bound (Hi);
 
-      elsif Can_Derive_From (Standard_Short_Integer) then
-         Base_Typ := Base_Type (Standard_Short_Integer);
+         if Errs then
+            Hi := Type_High_Bound (Standard_Long_Long_Integer);
+            Lo := Type_Low_Bound (Standard_Long_Long_Integer);
+         end if;
 
-      elsif Can_Derive_From (Standard_Integer) then
-         Base_Typ := Base_Type (Standard_Integer);
+         --  Find type to derive from
 
-      elsif Can_Derive_From (Standard_Long_Integer) then
-         Base_Typ := Base_Type (Standard_Long_Integer);
+         Lo_Val := Expr_Value (Lo);
+         Hi_Val := Expr_Value (Hi);
 
-      elsif Can_Derive_From (Standard_Long_Long_Integer) then
-         Base_Typ := Base_Type (Standard_Long_Long_Integer);
+         if Can_Derive_From (Standard_Short_Short_Integer) then
+            Base_Typ := Base_Type (Standard_Short_Short_Integer);
 
-      else
-         Base_Typ := Base_Type (Standard_Long_Long_Integer);
-         Error_Msg_N ("integer type definition bounds out of range", Def);
-         Hi := Type_High_Bound (Standard_Long_Long_Integer);
-         Lo := Type_Low_Bound (Standard_Long_Long_Integer);
+         elsif Can_Derive_From (Standard_Short_Integer) then
+            Base_Typ := Base_Type (Standard_Short_Integer);
+
+         elsif Can_Derive_From (Standard_Integer) then
+            Base_Typ := Base_Type (Standard_Integer);
+
+         elsif Can_Derive_From (Standard_Long_Integer) then
+            Base_Typ := Base_Type (Standard_Long_Integer);
+
+         elsif Can_Derive_From (Standard_Long_Long_Integer) then
+            Base_Typ := Base_Type (Standard_Long_Long_Integer);
+
+         else
+            Base_Typ := Base_Type (Standard_Long_Long_Integer);
+            Error_Msg_N ("integer type definition bounds out of range", Def);
+            Hi := Type_High_Bound (Standard_Long_Long_Integer);
+            Lo := Type_Low_Bound (Standard_Long_Long_Integer);
+         end if;
       end if;
 
       --  Complete both implicit base and declared first subtype entities

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c2474720fb38ab3a01970d9229b17628c570c19d..da2b6ce6378b67130ad96e59a5db4c6425f116c1 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.541 $
+--                            $Revision$
 --                                                                          --
 --          Copyright (C) 1992-2001, Free Software Foundation, Inc.         --
 --                                                                          --
@@ -2169,6 +2169,7 @@ package body Sem_Util is
 
    procedure Get_Index_Bounds (N : Node_Id; L, H : out Node_Id) is
       Kind : constant Node_Kind := Nkind (N);
+      R    : Node_Id;
 
    begin
       if Kind = N_Range then
@@ -2176,8 +2177,17 @@ package body Sem_Util is
          H := High_Bound (N);
 
       elsif Kind = N_Subtype_Indication then
-         L := Low_Bound  (Range_Expression (Constraint (N)));
-         H := High_Bound (Range_Expression (Constraint (N)));
+         R := Range_Expression (Constraint (N));
+
+         if R = Error then
+            L := Error;
+            H := Error;
+            return;
+
+         else
+            L := Low_Bound  (Range_Expression (Constraint (N)));
+            H := High_Bound (Range_Expression (Constraint (N)));
+         end if;
 
       elsif Is_Entity_Name (N) and then Is_Type (Entity (N)) then
          if Error_Posted (Scalar_Range (Entity (N))) then
@@ -2198,7 +2208,6 @@ package body Sem_Util is
          L := N;
          H := N;
       end if;
-
    end Get_Index_Bounds;
 
    ------------------------