[Ada] Profile mismatch between C and Ada functions

2020-06-18  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* libgnarl/s-osinte__linux.ads, libgnat/g-io.adb,
	libgnat/g-socket.adb, libgnat/g-socthi.adb,
	libgnat/g-socthi.ads, libgnat/g-socthi__vxworks.adb,
	libgnat/g-socthi__vxworks.ads, libgnat/g-sothco.ads,
	libgnat/s-io.adb, libgnat/a-except.adb: Fix function profile
	mismatch with imported C functions.

diff --git a/gcc/ada/libgnarl/s-osinte__linux.ads b/gcc/ada/libgnarl/s-osinte__linux.ads
index e95925b42c67cc6c0b42887dad8df5e5ac19c105..f7af00bf5e286b7b5f0f3a1c9013159d484dcfd3 100644 (file)
--- a/gcc/ada/libgnarl/s-osinte__linux.ads
+++ b/gcc/ada/libgnarl/s-osinte__linux.ads
@@ -278,9 +278,9 @@ package System.OS_Interface is
    PR_GET_NAME : constant := 16;
 
    function prctl
-     (option                 : int;
-      arg2, arg3, arg4, arg5 : unsigned_long := 0) return int;
-   pragma Import (C, prctl);
+     (option : int;
+      arg    : unsigned_long) return int;
+   pragma Import (C_Variadic_1, prctl, "prctl");
 
    -------------
    -- Threads --
@@ -314,6 +314,8 @@ package System.OS_Interface is
    -- Stack --
    -----------
 
+   subtype char_array is Interfaces.C.char_array;
+
    type stack_t is record
       ss_sp    : System.Address;
       ss_flags : int;
@@ -326,13 +328,13 @@ package System.OS_Interface is
       oss : access stack_t) return int;
    pragma Import (C, sigaltstack, "sigaltstack");
 
-   Alternate_Stack : aliased System.Address;
-   pragma Import (C, Alternate_Stack, "__gnat_alternate_stack");
-   --  The alternate signal stack for stack overflows
-
    Alternate_Stack_Size : constant := 16 * 1024;
    --  This must be in keeping with init.c:__gnat_alternate_stack
 
+   Alternate_Stack : aliased char_array (1 .. Alternate_Stack_Size);
+   pragma Import (C, Alternate_Stack, "__gnat_alternate_stack");
+   --  The alternate signal stack for stack overflows
+
    function Get_Stack_Base (thread : pthread_t) return Address;
    pragma Inline (Get_Stack_Base);
    --  This is a dummy procedure to share some GNULLI files
@@ -634,8 +636,6 @@ private
 
    type pid_t is new int;
 
-   subtype char_array is Interfaces.C.char_array;
-
    type pthread_attr_t is record
       Data : char_array (1 .. OS_Constants.PTHREAD_ATTR_SIZE);
    end record;

diff --git a/gcc/ada/libgnat/a-except.adb b/gcc/ada/libgnat/a-except.adb
index 6dcc6c21694214f334f7a98602742e0d32e22909..17f3db6e8bcf47be36dff265bd76a3830244b6e9 100644 (file)
--- a/gcc/ada/libgnat/a-except.adb
+++ b/gcc/ada/libgnat/a-except.adb
@@ -1660,10 +1660,10 @@ package body Ada.Exceptions is
    ---------------
 
    procedure To_Stderr (C : Character) is
-      procedure Put_Char_Stderr (C : Character);
+      procedure Put_Char_Stderr (C : Integer);
       pragma Import (C, Put_Char_Stderr, "put_char_stderr");
    begin
-      Put_Char_Stderr (C);
+      Put_Char_Stderr (Character'Pos (C));
    end To_Stderr;
 
    procedure To_Stderr (S : String) is

diff --git a/gcc/ada/libgnat/g-io.adb b/gcc/ada/libgnat/g-io.adb
index 9c5c17c64860d01e92f28896ba9c4e85f14e1cf0..c2c1ffa14b0ede972a250e711e0fe0144513f3f6 100644 (file)
--- a/gcc/ada/libgnat/g-io.adb
+++ b/gcc/ada/libgnat/g-io.adb
@@ -47,10 +47,10 @@ package body GNAT.IO is
    end Get;
 
    procedure Get (C : out Character) is
-      function Get_Char return Character;
+      function Get_Char return Integer;
       pragma Import (C, Get_Char, "get_char");
    begin
-      C := Get_Char;
+      C := Character'Val (Get_Char);
    end Get;
 
    --------------
@@ -121,16 +121,16 @@ package body GNAT.IO is
    end Put;
 
    procedure Put (File : File_Type; C : Character) is
-      procedure Put_Char (C : Character);
+      procedure Put_Char (C : Integer);
       pragma Import (C, Put_Char, "put_char");
 
-      procedure Put_Char_Stderr (C : Character);
+      procedure Put_Char_Stderr (C : Integer);
       pragma Import (C, Put_Char_Stderr, "put_char_stderr");
 
    begin
       case File is
-         when Stdout => Put_Char (C);
-         when Stderr => Put_Char_Stderr (C);
+         when Stdout => Put_Char (Character'Pos (C));
+         when Stderr => Put_Char_Stderr (Character'Pos (C));
       end case;
    end Put;
 

diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb
index 4c6566b5133a9e81c3cb07ae9dc5a9d8729ef7e7..1b8032c95473eb688c29bfca39d68adf8179340c 100644 (file)
--- a/gcc/ada/libgnat/g-socket.adb
+++ b/gcc/ada/libgnat/g-socket.adb
@@ -1222,7 +1222,7 @@ package body GNAT.Sockets is
       pragma Unreferenced (Family);
 
       HA     : aliased In_Addr_Union (Address.Family);
-      Buflen : constant C.int := Netdb_Buffer_Size;
+      Buflen : constant C.size_t := Netdb_Buffer_Size;
       Buf    : aliased C.char_array (1 .. Netdb_Buffer_Size);
       Res    : aliased Hostent;
       Err    : aliased C.int;
@@ -1277,7 +1277,7 @@ package body GNAT.Sockets is
 
       declare
          HN     : constant C.char_array := C.To_C (Name);
-         Buflen : constant C.int := Netdb_Buffer_Size;
+         Buflen : constant C.size_t := Netdb_Buffer_Size;
          Buf    : aliased C.char_array (1 .. Netdb_Buffer_Size);
          Res    : aliased Hostent;
          Err    : aliased C.int;
@@ -1325,7 +1325,7 @@ package body GNAT.Sockets is
    is
       SN     : constant C.char_array := C.To_C (Name);
       SP     : constant C.char_array := C.To_C (Protocol);
-      Buflen : constant C.int := Netdb_Buffer_Size;
+      Buflen : constant C.size_t := Netdb_Buffer_Size;
       Buf    : aliased C.char_array (1 .. Netdb_Buffer_Size);
       Res    : aliased Servent;
 
@@ -1355,7 +1355,7 @@ package body GNAT.Sockets is
       Protocol : String) return Service_Entry_Type
    is
       SP     : constant C.char_array := C.To_C (Protocol);
-      Buflen : constant C.int := Netdb_Buffer_Size;
+      Buflen : constant C.size_t := Netdb_Buffer_Size;
       Buf    : aliased C.char_array (1 .. Netdb_Buffer_Size);
       Res    : aliased Servent;
 

diff --git a/gcc/ada/libgnat/g-socthi.adb b/gcc/ada/libgnat/g-socthi.adb
index 68c82e2f5de87bff9981524da4f0dfd98b776db4..5d86993eef16b062f2c8df5cb878a6a8b4533a12 100644 (file)
--- a/gcc/ada/libgnat/g-socthi.adb
+++ b/gcc/ada/libgnat/g-socthi.adb
@@ -74,17 +74,17 @@ package body GNAT.Sockets.Thin is
    function Syscall_Recv
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int;
+      Len   : C.size_t;
+      Flags : C.int) return System.CRTL.ssize_t;
    pragma Import (C, Syscall_Recv, "recv");
 
    function Syscall_Recvfrom
      (S       : C.int;
       Msg     : System.Address;
-      Len     : C.int;
+      Len     : C.size_t;
       Flags   : C.int;
       From    : System.Address;
-      Fromlen : not null access C.int) return C.int;
+      Fromlen : not null access C.int) return System.CRTL.ssize_t;
    pragma Import (C, Syscall_Recvfrom, "recvfrom");
 
    function Syscall_Recvmsg
@@ -102,10 +102,10 @@ package body GNAT.Sockets.Thin is
    function Syscall_Sendto
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
+      Len   : C.size_t;
       Flags : C.int;
       To    : System.Address;
-      Tolen : C.int) return C.int;
+      Tolen : C.int) return System.CRTL.ssize_t;
    pragma Import (C, Syscall_Sendto, "sendto");
 
    function Syscall_Socket
@@ -250,14 +250,14 @@ package body GNAT.Sockets.Thin is
    function C_Recv
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
+      Len   : C.size_t;
       Flags : C.int) return C.int
    is
       Res : C.int;
 
    begin
       loop
-         Res := Syscall_Recv (S, Msg, Len, Flags);
+         Res := C.int (Syscall_Recv (S, Msg, Len, Flags));
          exit when SOSC.Thread_Blocking_IO
            or else Res /= Failure
            or else Non_Blocking_Socket (S)
@@ -275,7 +275,7 @@ package body GNAT.Sockets.Thin is
    function C_Recvfrom
      (S       : C.int;
       Msg     : System.Address;
-      Len     : C.int;
+      Len     : C.size_t;
       Flags   : C.int;
       From    : System.Address;
       Fromlen : not null access C.int) return C.int
@@ -284,7 +284,7 @@ package body GNAT.Sockets.Thin is
 
    begin
       loop
-         Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen);
+         Res := C.int (Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen));
          exit when SOSC.Thread_Blocking_IO
            or else Res /= Failure
            or else Non_Blocking_Socket (S)
@@ -350,7 +350,7 @@ package body GNAT.Sockets.Thin is
    function C_Sendto
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
+      Len   : C.size_t;
       Flags : C.int;
       To    : System.Address;
       Tolen : C.int) return C.int
@@ -359,7 +359,7 @@ package body GNAT.Sockets.Thin is
 
    begin
       loop
-         Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
+         Res := C.int (Syscall_Sendto (S, Msg, Len, Flags, To, Tolen));
          exit when SOSC.Thread_Blocking_IO
            or else Res /= Failure
            or else Non_Blocking_Socket (S)

diff --git a/gcc/ada/libgnat/g-socthi.ads b/gcc/ada/libgnat/g-socthi.ads
index 30d6c76250caa91c320638cb7c80841ad24a9227..c6a07ba69086e0b0e6babe25bc9b7b58a6722b7c 100644 (file)
--- a/gcc/ada/libgnat/g-socthi.ads
+++ b/gcc/ada/libgnat/g-socthi.ads
@@ -98,7 +98,7 @@ package GNAT.Sockets.Thin is
 
    function C_Gethostname
      (Name    : System.Address;
-      Namelen : C.int) return C.int;
+      Namelen : C.size_t) return C.int;
 
    function C_Getpeername
      (S       : C.int;
@@ -129,13 +129,13 @@ package GNAT.Sockets.Thin is
    function C_Recv
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
+      Len   : C.size_t;
       Flags : C.int) return C.int;
 
    function C_Recvfrom
      (S       : C.int;
       Msg     : System.Address;
-      Len     : C.int;
+      Len     : C.size_t;
       Flags   : C.int;
       From    : System.Address;
       Fromlen : not null access C.int) return C.int;
@@ -160,7 +160,7 @@ package GNAT.Sockets.Thin is
    function C_Sendto
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
+      Len   : C.size_t;
       Flags : C.int;
       To    : System.Address;
       Tolen : C.int) return C.int;

diff --git a/gcc/ada/libgnat/g-socthi__vxworks.adb b/gcc/ada/libgnat/g-socthi__vxworks.adb
index 19a7c6fb8210f141d11aa57e12c941ffde21956b..548b9d3f623fc4425fb42f16decb9d23fff11b73 100644 (file)
--- a/gcc/ada/libgnat/g-socthi__vxworks.adb
+++ b/gcc/ada/libgnat/g-socthi__vxworks.adb
@@ -78,14 +78,14 @@ package body GNAT.Sockets.Thin is
    function Syscall_Recv
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
+      Len   : C.size_t;
       Flags : C.int) return C.int;
    pragma Import (C, Syscall_Recv, "recv");
 
    function Syscall_Recvfrom
      (S       : C.int;
       Msg     : System.Address;
-      Len     : C.int;
+      Len     : C.size_t;
       Flags   : C.int;
       From    : System.Address;
       Fromlen : not null access C.int) return C.int;
@@ -106,17 +106,17 @@ package body GNAT.Sockets.Thin is
    function Syscall_Send
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
-      Flags : C.int) return C.int;
+      Len   : C.size_t;
+      Flags : C.int) return System.CRTL.ssize_t;
    pragma Import (C, Syscall_Send, "send");
 
    function Syscall_Sendto
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
+      Len   : C.size_t;
       Flags : C.int;
       To    : System.Address;
-      Tolen : C.int) return C.int;
+      Tolen : C.int) return System.CRTL.ssize_t;
    pragma Import (C, Syscall_Sendto, "sendto");
 
    function Syscall_Socket
@@ -252,7 +252,7 @@ package body GNAT.Sockets.Thin is
    function C_Recv
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
+      Len   : C.size_t;
       Flags : C.int) return C.int
    is
       Res : C.int;
@@ -277,7 +277,7 @@ package body GNAT.Sockets.Thin is
    function C_Recvfrom
      (S       : C.int;
       Msg     : System.Address;
-      Len     : C.int;
+      Len     : C.size_t;
       Flags   : C.int;
       From    : System.Address;
       Fromlen : not null access C.int) return C.int
@@ -352,7 +352,7 @@ package body GNAT.Sockets.Thin is
    function C_Sendto
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
+      Len   : C.size_t;
       Flags : C.int;
       To    : System.Address;
       Tolen : C.int) return C.int
@@ -369,12 +369,12 @@ package body GNAT.Sockets.Thin is
             --  support sendto(2) calls on connected sockets with a null
             --  destination address, so use send(2) instead in that case.
 
-            Res := Syscall_Send (S, Msg, Len, Flags);
+            Res := C.int (Syscall_Send (S, Msg, Len, Flags));
 
          --  Normal case where destination address is non-null
 
          else
-            Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
+            Res := C.int (Syscall_Sendto (S, Msg, Len, Flags, To, Tolen));
          end if;
 
          exit when SOSC.Thread_Blocking_IO

diff --git a/gcc/ada/libgnat/g-socthi__vxworks.ads b/gcc/ada/libgnat/g-socthi__vxworks.ads
index b49cc76efffbfc8e3478a90322b520af0aed9f44..704ec0ade533d4be05328718c1fa814101117eac 100644 (file)
--- a/gcc/ada/libgnat/g-socthi__vxworks.ads
+++ b/gcc/ada/libgnat/g-socthi__vxworks.ads
@@ -95,7 +95,7 @@ package GNAT.Sockets.Thin is
 
    function C_Gethostname
      (Name    : System.Address;
-      Namelen : C.int) return C.int;
+      Namelen : C.size_t) return C.int;
 
    function C_Getpeername
      (S       : C.int;
@@ -126,13 +126,13 @@ package GNAT.Sockets.Thin is
    function C_Recv
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
+      Len   : C.size_t;
       Flags : C.int) return C.int;
 
    function C_Recvfrom
      (S       : C.int;
       Msg     : System.Address;
-      Len     : C.int;
+      Len     : C.size_t;
       Flags   : C.int;
       From    : System.Address;
       Fromlen : not null access C.int) return C.int;
@@ -157,7 +157,7 @@ package GNAT.Sockets.Thin is
    function C_Sendto
      (S     : C.int;
       Msg   : System.Address;
-      Len   : C.int;
+      Len   : C.size_t;
       Flags : C.int;
       To    : System.Address;
       Tolen : C.int) return C.int;

diff --git a/gcc/ada/libgnat/g-sothco.ads b/gcc/ada/libgnat/g-sothco.ads
index cc7bccdcb453f26d9ac3247e152aa29fdb9d15ac..e30af189d3aedb726b367ea97338009620829a14 100644 (file)
--- a/gcc/ada/libgnat/g-sothco.ads
+++ b/gcc/ada/libgnat/g-sothco.ads
@@ -281,7 +281,7 @@ package GNAT.Sockets.Thin_Common is
      (Name     : C.char_array;
       Ret      : not null access Hostent;
       Buf      : System.Address;
-      Buflen   : C.int;
+      Buflen   : C.size_t;
       H_Errnop : not null access C.int) return C.int;
 
    function C_Gethostbyaddr
@@ -290,7 +290,7 @@ package GNAT.Sockets.Thin_Common is
       Addr_Type : C.int;
       Ret       : not null access Hostent;
       Buf       : System.Address;
-      Buflen    : C.int;
+      Buflen    : C.size_t;
       H_Errnop  : not null access C.int) return C.int;
 
    function C_Getservbyname
@@ -298,14 +298,14 @@ package GNAT.Sockets.Thin_Common is
       Proto  : C.char_array;
       Ret    : not null access Servent;
       Buf    : System.Address;
-      Buflen : C.int) return C.int;
+      Buflen : C.size_t) return C.int;
 
    function C_Getservbyport
      (Port   : C.int;
       Proto  : C.char_array;
       Ret    : not null access Servent;
       Buf    : System.Address;
-      Buflen : C.int) return C.int;
+      Buflen : C.size_t) return C.int;
 
    Address_Size : constant := Standard'Address_Size;
 

diff --git a/gcc/ada/libgnat/s-io.adb b/gcc/ada/libgnat/s-io.adb
index 608bbe3c99223ebbdbb769a9dfd9499bcaded215..23301e9c88396eff23a6f941cd7a83ca13c1e99e 100644 (file)
--- a/gcc/ada/libgnat/s-io.adb
+++ b/gcc/ada/libgnat/s-io.adb
@@ -65,16 +65,16 @@ package body System.IO is
    end Put;
 
    procedure Put (C : Character) is
-      procedure Put_Char (C : Character);
+      procedure Put_Char (C : Integer);
       pragma Import (C, Put_Char, "put_char");
 
-      procedure Put_Char_Stderr (C : Character);
+      procedure Put_Char_Stderr (C : Integer);
       pragma Import (C, Put_Char_Stderr, "put_char_stderr");
 
    begin
       case Current_Out is
-         when Stdout => Put_Char (C);
-         when Stderr => Put_Char_Stderr (C);
+         when Stdout => Put_Char (Character'Pos (C));
+         when Stderr => Put_Char_Stderr (Character'Pos (C));
       end case;
    end Put;