From: Ronan Desplanques <desplanq...@adacore.com>
This patch adds a pragma that triggers an internal compiler error when
analyzed. It is not externally documented and makes it possible to test
the code that runs when the compiler encounters an internal error.
gcc/ada/ChangeLog:
* snames.ads-tmpl: Add new pragma definition.
* par-prag.adb (Prag): Handle new pragma.
* sem_prag.adb (Analyze_Pragma): Implement new pragma.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/par-prag.adb | 1 +
gcc/ada/sem_prag.adb | 22 ++++++++++++++++++++++
gcc/ada/snames.ads-tmpl | 2 ++
3 files changed, 25 insertions(+)
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index ca47afc65ea..8b953b3e877 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1562,6 +1562,7 @@ begin
| Pragma_Short_Circuit_And_Or
| Pragma_Short_Descriptors
| Pragma_Simple_Storage_Pool_Type
+ | Pragma_Simulate_Internal_Error
| Pragma_Static_Elaboration_Desired
| Pragma_Storage_Size
| Pragma_Storage_Unit
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index d1acc3c4921..90f9c72e726 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -24276,6 +24276,27 @@ package body Sem_Prag is
end if;
end Side_Effects;
+ ------------------------------------
+ -- Pragma_Simulate_Internal_Error --
+ ------------------------------------
+
+ -- pragma Simulate_Internal_Error;
+
+ -- Since the only purpose of this pragma is to write tests for the
+ -- compiler, it is not documented in the GNAT reference manual. The
+ -- effect of the pragma is to cause the compiler to raise an
+ -- exception when it analyzes the pragma.
+
+ when Pragma_Simulate_Internal_Error =>
+ Simulate_Internal_Error : declare
+ Simulated_Internal_Error : exception;
+ begin
+ GNAT_Pragma;
+ Check_Arg_Count (0);
+
+ raise Simulated_Internal_Error;
+ end Simulate_Internal_Error;
+
------------------------------
-- Simple_Storage_Pool_Type --
------------------------------
@@ -33030,6 +33051,7 @@ package body Sem_Prag is
Pragma_Shared_Passive => 0,
Pragma_Short_Circuit_And_Or => 0,
Pragma_Short_Descriptors => 0,
+ Pragma_Simulate_Internal_Error => 0,
Pragma_Simple_Storage_Pool_Type => 0,
Pragma_Source_File_Name => 0,
Pragma_Source_File_Name_Project => 0,
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 0d00b89d8e4..b706896073f 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -680,6 +680,7 @@ package Snames is
Name_Shared_Passive : constant Name_Id := N + $;
Name_Side_Effects : constant Name_Id := N + $; -- GNAT
Name_Simple_Storage_Pool_Type : constant Name_Id := N + $; -- GNAT
+ Name_Simulate_Internal_Error : constant Name_Id := N + $; -- GNAT
Name_Source_Reference : constant Name_Id := N + $; -- GNAT
Name_Static_Elaboration_Desired : constant Name_Id := N + $; -- GNAT
@@ -1952,6 +1953,7 @@ package Snames is
Pragma_Shared_Passive,
Pragma_Side_Effects,
Pragma_Simple_Storage_Pool_Type,
+ Pragma_Simulate_Internal_Error,
Pragma_Source_Reference,
Pragma_Static_Elaboration_Desired,
Pragma_Stream_Convert,
--
2.43.0
