[gcc/devel/gccgo] [Ada] Crash when an exception handler is executed with -gnatdk

[Ian Lance Taylor]

https://gcc.gnu.org/g:a34da56b26df1db73c20d36ae753173999bd46da

commit a34da56b26df1db73c20d36ae753173999bd46da
Author: Piotr Trojanek <trojanek@adacore.com>
Date:   Wed May 6 18:40:22 2020 +0200

    [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:
---
 gcc/ada/sem_ch5.adb  |  9 ++++++++-
 gcc/ada/sem_eval.adb | 17 ++++++++++++-----
 gcc/ada/sem_warn.adb |  7 +++++++
 3 files changed, 27 insertions(+), 6 deletions(-)

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;