[gcc r12-602] [Ada] Fix type mismatch warnings during LTO bootstrap #2

[gcc r12-602] [Ada] Fix type mismatch warnings during LTO bootstrap #2

[Pierre-Marie de Rodat]

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

commit r12-602-gd6de75d526bf5958fe9e66195dc0bf1c458e9b06
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Tue Feb 16 09:00:11 2021 +0100

    [Ada] Fix type mismatch warnings during LTO bootstrap #2
    
    gcc/ada/
    
            * init.c (__gnat_raise_program_error): Fix parameter type.
            (Raise_From_Signal_Handler): Likewise and mark as no-return.
            * raise-gcc.c (__gnat_others_value): Fix type.
            (__gnat_all_others_value): Likewise.
            (__gnat_unhandled_others_value): Likewise.
            * seh_init.c (Raise_From_Signal_Handler): Fix parameter type.
            * libgnat/a-except.ads (Raise_From_Signal_Handler): Use convention C
            and new symbol name, move declaration to...
            (Raise_From_Controlled_Operation): Minor tweak.
            * libgnat/a-except.adb (Raise_From_Signal_Handler): ...here.
            * libgnat/a-exexpr.adb (bool): New C compatible boolean type.
            (Is_Handled_By_Others): Use it as return type for the function.

Diff:
---
 gcc/ada/init.c               | 15 +++++++--------
 gcc/ada/libgnat/a-except.adb | 17 +++++++++++++++++
 gcc/ada/libgnat/a-except.ads | 21 +--------------------
 gcc/ada/libgnat/a-exexpr.adb | 13 +++++++------
 gcc/ada/raise-gcc.c          | 14 +++++++-------
 gcc/ada/seh_init.c           |  4 ++--
 6 files changed, 41 insertions(+), 43 deletions(-)

diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index 88a62fd8fa5..08ff8d78b1e 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -78,7 +78,7 @@
 extern "C" {
 #endif
 
-extern void __gnat_raise_program_error (const char *, int);
+extern void __gnat_raise_program_error (const void *, int);
 
 /* Addresses of exception data blocks for predefined exceptions.  Tasking_Error
    is not used in this unit, and the abort signal is only used on IRIX.
@@ -89,17 +89,16 @@ extern struct Exception_Data program_error;
 extern struct Exception_Data storage_error;
 
 /* For the Cert run time we use the regular raise exception routine because
-   Raise_From_Signal_Handler is not available.  */
+   __gnat_raise_from_signal_handler is not available.  */
 #ifdef CERT
-#define Raise_From_Signal_Handler \
-                      __gnat_raise_exception
-extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
+#define Raise_From_Signal_Handler __gnat_raise_exception
 #else
-#define Raise_From_Signal_Handler \
-                      ada__exceptions__raise_from_signal_handler
-extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
+#define Raise_From_Signal_Handler __gnat_raise_from_signal_handler
 #endif
 
+extern void Raise_From_Signal_Handler (struct Exception_Data *, const void *)
+  ATTRIBUTE_NORETURN;
+
 /* Global values computed by the binder.  Note that these variables are
    declared here, not in the binder file, to avoid having unresolved
    references in the shared libgnat.  */
diff --git a/gcc/ada/libgnat/a-except.adb b/gcc/ada/libgnat/a-except.adb
index b47702d0e3c..c332afad0f8 100644
--- a/gcc/ada/libgnat/a-except.adb
+++ b/gcc/ada/libgnat/a-except.adb
@@ -279,6 +279,23 @@ package body Ada.Exceptions is
    pragma No_Return (Raise_Exception_No_Defer);
    --  Similar to Raise_Exception, but with no abort deferral
 
+   procedure Raise_From_Signal_Handler
+     (E : Exception_Id;
+      M : System.Address);
+   pragma Export
+     (C, Raise_From_Signal_Handler, "__gnat_raise_from_signal_handler");
+   pragma No_Return (Raise_From_Signal_Handler);
+   --  This routine is used to raise an exception from a signal handler. The
+   --  signal handler has already stored the machine state (i.e. the state that
+   --  corresponds to the location at which the signal was raised). E is the
+   --  Exception_Id specifying what exception is being raised, and M is a
+   --  pointer to a null-terminated string which is the message to be raised.
+   --  Note that this routine never returns, so it is permissible to simply
+   --  jump to this routine, rather than call it. This may be appropriate for
+   --  systems where the right way to get out of signal handler is to alter the
+   --  PC value in the machine state or in some other way ask the operating
+   --  system to return here rather than to the original location.
+
    procedure Raise_With_Msg (E : Exception_Id);
    pragma No_Return (Raise_With_Msg);
    pragma Export (C, Raise_With_Msg, "__gnat_raise_with_msg");
diff --git a/gcc/ada/libgnat/a-except.ads b/gcc/ada/libgnat/a-except.ads
index 2fab1f14081..2b27adb6ca1 100644
--- a/gcc/ada/libgnat/a-except.ads
+++ b/gcc/ada/libgnat/a-except.ads
@@ -184,26 +184,7 @@ private
    --  Raise_Exception_Always if it can determine this is the case. The Export
    --  allows this routine to be accessed from Pure units.
 
-   procedure Raise_From_Signal_Handler
-     (E : Exception_Id;
-      M : System.Address);
-   pragma Export
-     (Ada, Raise_From_Signal_Handler,
-           "ada__exceptions__raise_from_signal_handler");
-   pragma No_Return (Raise_From_Signal_Handler);
-   --  This routine is used to raise an exception from a signal handler. The
-   --  signal handler has already stored the machine state (i.e. the state that
-   --  corresponds to the location at which the signal was raised). E is the
-   --  Exception_Id specifying what exception is being raised, and M is a
-   --  pointer to a null-terminated string which is the message to be raised.
-   --  Note that this routine never returns, so it is permissible to simply
-   --  jump to this routine, rather than call it. This may be appropriate for
-   --  systems where the right way to get out of signal handler is to alter the
-   --  PC value in the machine state or in some other way ask the operating
-   --  system to return here rather than to the original location.
-
-   procedure Raise_From_Controlled_Operation
-     (X : Ada.Exceptions.Exception_Occurrence);
+   procedure Raise_From_Controlled_Operation (X : Exception_Occurrence);
    pragma No_Return (Raise_From_Controlled_Operation);
    pragma Export
      (Ada, Raise_From_Controlled_Operation,
diff --git a/gcc/ada/libgnat/a-exexpr.adb b/gcc/ada/libgnat/a-exexpr.adb
index 45d39cc5dcc..f79a499639e 100644
--- a/gcc/ada/libgnat/a-exexpr.adb
+++ b/gcc/ada/libgnat/a-exexpr.adb
@@ -91,6 +91,9 @@ package body Exception_Propagation is
 
    use Exception_Traces;
 
+   type bool is new Boolean;
+   pragma Convention (C, bool);
+
    Foreign_Exception : aliased System.Standard_Library.Exception_Data;
    pragma Import (Ada, Foreign_Exception,
                   "system__exceptions__foreign_exception");
@@ -277,7 +280,7 @@ package body Exception_Propagation is
    --  painful and error prone. These subprograms could be moved to a more
    --  widely visible location if need be.
 
-   function Is_Handled_By_Others (E : Exception_Data_Ptr) return Boolean;
+   function Is_Handled_By_Others (E : Exception_Data_Ptr) return bool;
    pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others");
    pragma Warnings (Off, Is_Handled_By_Others);
 
@@ -685,9 +688,7 @@ package body Exception_Propagation is
    -- Foreign_Data_For --
    ----------------------
 
-   function Foreign_Data_For
-     (E : SSL.Exception_Data_Ptr) return Address
-   is
+   function Foreign_Data_For (E : SSL.Exception_Data_Ptr) return Address is
    begin
       return E.Foreign_Data;
    end Foreign_Data_For;
@@ -696,9 +697,9 @@ package body Exception_Propagation is
    -- Is_Handled_By_Others --
    --------------------------
 
-   function Is_Handled_By_Others (E : SSL.Exception_Data_Ptr) return Boolean is
+   function Is_Handled_By_Others (E : SSL.Exception_Data_Ptr) return bool is
    begin
-      return not E.all.Not_Handled_By_Others;
+      return not bool (E.all.Not_Handled_By_Others);
    end Is_Handled_By_Others;
 
    ------------------
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index 9e09ffa065f..6a50a516c96 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -542,17 +542,17 @@ typedef struct
   /* ABI header, maximally aligned. */
 } _GNAT_Exception;
 
-/* The two constants below are specific ttype identifiers for special
+/* The three constants below are specific ttype identifiers for special
    exception ids.  Their type should match what a-exexpr exports.  */
 
-extern const int __gnat_others_value;
-#define GNAT_OTHERS      ((_Unwind_Ptr) &__gnat_others_value)
+extern const char __gnat_others_value;
+#define GNAT_OTHERS ((_Unwind_Ptr) &__gnat_others_value)
 
-extern const int __gnat_all_others_value;
-#define GNAT_ALL_OTHERS  ((_Unwind_Ptr) &__gnat_all_others_value)
+extern const char __gnat_all_others_value;
+#define GNAT_ALL_OTHERS ((_Unwind_Ptr) &__gnat_all_others_value)
 
-extern const int __gnat_unhandled_others_value;
-#define GNAT_UNHANDLED_OTHERS  ((_Unwind_Ptr) &__gnat_unhandled_others_value)
+extern const char __gnat_unhandled_others_value;
+#define GNAT_UNHANDLED_OTHERS ((_Unwind_Ptr) &__gnat_unhandled_others_value)
 
 /* Describe the useful region data associated with an unwind context.  */
 
diff --git a/gcc/ada/seh_init.c b/gcc/ada/seh_init.c
index 3ddbfbe0c89..6d169a9ee5c 100644
--- a/gcc/ada/seh_init.c
+++ b/gcc/ada/seh_init.c
@@ -64,8 +64,8 @@ extern struct Exception_Data storage_error;
 extern struct Exception_Data tasking_error;
 extern struct Exception_Data _abort_signal;
 
-#define Raise_From_Signal_Handler ada__exceptions__raise_from_signal_handler
-extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *)
+#define Raise_From_Signal_Handler __gnat_raise_from_signal_handler
+extern void Raise_From_Signal_Handler (struct Exception_Data *, const void *)
   ATTRIBUTE_NORETURN;