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 --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index ca47afc65eaa723c9a69a3083a31205c2a99b7c7..8b953b3e87783c2c213dd1140604d91e3699ddc7 100644 (file)
--- 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 d1acc3c4921e808ec20dafed4f4bcb10f0d7f81c..90f9c72e7260a4f607e9c2d50cf91b7e20de0874 100644 (file)
--- 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 0d00b89d8e47e6f06c96275364c8e7b776a5d789..b706896073f3122108208ebb3f236c6b7733eae2 100644 (file)
--- 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,