[Ada] Crash when an exception handler is executed with -gnatdk

gcc/ada/

	* sem_ch5.adb (Analyze_Loop_Parameter_Specification): Propagate
	exception when switch -gnatdk is used and no previous errors are
	present.
	* sem_eval.adb (Compile_Time_Known_Value, Is_In_Range):
	Likewise.
	* sem_warn.adb (Operand_Has_Warnings_Suppressed): Likewise.

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 36633cb198a932b95ad0608b917051707faa30b9..8cce5dfe296a6ac06cfad68b93443eabf82619b9 100644 (file)
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -26,6 +26,7 @@
 with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
+with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Errout;   use Errout;
 with Expander; use Expander;
@@ -3302,7 +3303,13 @@ package body Sem_Ch5 is
          --  the warning is perfectly acceptable.
 
          exception
-            when others => null;
+            when others =>
+               --  With debug flag K we will get an exception unless an error
+               --  has already occurred (useful for debugging).
+
+               if Debug_Flag_K then
+                  Check_Error_Detected;
+               end if;
          end;
       end if;
 

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 66710a452fa2a28263dd4b78a125e47148f06963..206331674450fe3a5f8c56cf6ab2bd600e359bff 100644 (file)
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -1848,6 +1848,13 @@ package body Sem_Eval is
 
    exception
       when others =>
+         --  With debug flag K we will get an exception unless an error has
+         --  already occurred (useful for debugging).
+
+         if Debug_Flag_K then
+            Check_Error_Detected;
+         end if;
+
          return False;
    end Compile_Time_Known_Value;
 
@@ -4962,14 +4969,14 @@ package body Sem_Eval is
 
    exception
       when others =>
-
-         --  Debug flag K disables this behavior (useful for debugging)
+         --  With debug flag K we will get an exception unless an error has
+         --  already occurred (useful for debugging).
 
          if Debug_Flag_K then
-            raise;
-         else
-            return False;
+            Check_Error_Detected;
          end if;
+
+         return False;
    end In_Subrange_Of;
 
    -----------------

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 97d8a944f56da2c994868d180a29bd33bbeb5407..3c7f5d5d70265e2e5517d1b9539c02f768c51e4b 100644 (file)
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -2993,6 +2993,13 @@ package body Sem_Warn is
 
    exception
       when others =>
+         --  With debug flag K we will get an exception unless an error has
+         --  already occurred (useful for debugging).
+
+         if Debug_Flag_K then
+            Check_Error_Detected;
+         end if;
+
          return False;
    end Operand_Has_Warnings_Suppressed;