https://gcc.gnu.org/g:5339c2165f24f3523fe822c493bf9b1559b5460e
commit r15-4158-g5339c2165f24f3523fe822c493bf9b1559b5460e
Author: Ronan Desplanques <desplanq...@adacore.com>
Date: Tue Sep 10 11:40:43 2024 +0200
ada: Add mechanism to test internal error machinery
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.
Diff:
---
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 ca47afc65eaa..8b953b3e8778 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 d1acc3c4921e..90f9c72e7260 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 0d00b89d8e47..b706896073f3 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,
