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

Message ID 20200706113855.GA135503@adacore.com
State New
Headers show
Series
  • [Ada] Crash when an exception handler is executed with -gnatdk
Related show

Commit Message

Pierre-Marie de Rodat July 6, 2020, 11:38 a.m.
In few routines we expect exceptions and handle them by falling back to
an appropriate safe value (e.g. in Compile_Time_Known_Value we fall back
to False and merely skip some optimizations). This is especially
important while processing code with previous errors.

However, this behaviour prevents us from detecting a genuinely bad
handling of a legal code. With this patch we can use -gnatdk switch to
get a bugbox when exception occurs without previous errors.

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

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.

Patch

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
--- 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
--- 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
--- 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;