[gcc r13-3739] ada: Fixed elaboration of CUDA programs.

[gcc r13-3739] ada: Fixed elaboration of CUDA programs.

[Marc Poulhi?s]

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

commit r13-3739-gb86ff061234ff42934bc08c5dc1ba041724eba22
Author: Quentin Ochem <ochem@adacore.com>
Date:   Fri Oct 14 06:30:04 2022 -0400

    ada: Fixed elaboration of CUDA programs.
    
    The names of imported / exported symbols were not consistent
    between the device and the host when compiling for CUDA.
    
    Remove the function Device_Ada_Final_Link_Name as it is no
    longer referenced.
    
    gcc/ada/
    
            * bindgen.adb: fixed the way the device init and final symbols are
            computed, re-using the normal way these symbols would be computed
            with a __device_ prefix. Also fixed the "is null;" procedure on
            the host side which are not Ada 95, replaced with a procedure
            raising an exception as it should never be called. Remove the
            unused function Device_Ada_Final_Link_Name.
    
    Co-authored-by: Steve Baird <baird@adacore.com>

Diff:
---
 gcc/ada/bindgen.adb | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index b942985b2e8..e72cdf81227 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -131,8 +131,6 @@ package body Bindgen is
 
    function Device_Ada_Init_Link_Name return String
      is (Device_Link_Name (Suffix => "init"));
-   function Device_Ada_Final_Link_Name return String
-     is (Device_Link_Name (Suffix => "final"));
 
    ----------------------------------
    -- Interface_State Pragma Table --
@@ -1357,11 +1355,6 @@ package body Bindgen is
       WBI ("   pragma Export (C, " & Device_Ada_Init_Subp_Name &
              ", Link_Name => """ & Device_Ada_Init_Link_Name & """);");
 
-      --  It would be nice to declare a real body that raises P_E, but
-      --  generating a subprogram body at the right point is harder
-      --  than generating a null procedure here.
-      WBI ("   procedure " & Device_Ada_Init_Subp_Name & " is null;");
-
       --  C-string declaration for adainit
       WBI ("   " & Adainit_String_Obj_Name
             & " : Interfaces.C.Strings.Chars_Ptr;");
@@ -2673,7 +2666,8 @@ package body Bindgen is
       WBI ("   procedure " & Ada_Init_Name.all & ";");
       if Enable_CUDA_Device_Expansion then
          WBI ("   pragma Export (C, " & Ada_Init_Name.all &
-                ", Link_Name => """ & Device_Ada_Init_Link_Name & """);");
+                ", Link_Name => """ & Device_Link_Name_Prefix
+                & Ada_Init_Name.all & """);");
          WBI ("   pragma CUDA_Global (" & Ada_Init_Name.all & ");");
       else
          WBI ("   pragma Export (C, " & Ada_Init_Name.all & ", """ &
@@ -2692,7 +2686,8 @@ package body Bindgen is
          WBI ("   procedure " & Ada_Final_Name.all & ";");
          if Enable_CUDA_Device_Expansion then
             WBI ("   pragma Export (C, " & Ada_Final_Name.all &
-                   ", Link_Name => """ & Device_Ada_Final_Link_Name & """);");
+                   ", Link_Name => """ & Device_Link_Name_Prefix &
+                   Ada_Final_Name.all & """);");
             WBI ("   pragma CUDA_Global (" & Ada_Final_Name.all & ");");
          else
             WBI ("   pragma Export (C, " & Ada_Final_Name.all & ", """ &
@@ -2922,6 +2917,13 @@ package body Bindgen is
 
       Gen_Adainit (Elab_Order);
 
+      if Enable_CUDA_Expansion then
+         WBI ("   procedure " & Device_Ada_Init_Subp_Name & " is");
+         WBI ("   begin");
+         WBI ("      raise Program_Error;");
+         WBI ("   end " & Device_Ada_Init_Subp_Name & ";");
+      end if;
+
       if Bind_Main_Program then
          Gen_Main;
       end if;