From: Piotr Trojanek <trojanek@adacore.com>
Date: Wed, 6 May 2020 16:40:22 +0000 (+0200)
Subject: [Ada] Crash when an exception handler is executed with -gnatdk
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a34da56b26df1db73c20d36ae753173999bd46da;p=gcc.git

[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 36633cb198a..8cce5dfe296 100644
--- 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 66710a452fa..20633167445 100644
--- 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 97d8a944f56..3c7f5d5d702 100644
--- 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;