From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x42c.google.com (mail-wr1-x42c.google.com [IPv6:2a00:1450:4864:20::42c]) by sourceware.org (Postfix) with ESMTPS id 509763858C56 for ; Tue, 7 May 2024 08:00:14 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 509763858C56 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 509763858C56 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::42c ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1715068822; cv=none; b=V6V6zWlzBOtMA06skEyRB6j59x42LKroB3FnaIASnhbZgvHwEi61ESNV7iHLCbJNKQf2aMRjHcHfY2f5NwgzhwTbBgUmK8sfxfZNYkMOJaFdiR3BbmAq8JVvTOCDI2j1ahw7vUSwOcEjY1HwoszobHAglVffKgCCnNz7+pf8afs= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1715068822; c=relaxed/simple; bh=R5Rvj8HPHAMO1f+RpiJUxadgQEz0bnePJcME/7t4kpI=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=NwWtTJ04AV5ItNbmnOLOF+FxqZRRZ+/0PuEeYSn2pF94LMIL4vh/Yc8Pf9l5xgm6R6vw7qD2iKMXAsWaEmNw7WQIaeBVUUwg19IT5nMBfV7+C761QWHB1G6e5IIkCAV04QYjlcFRmNdga74eCApPkVBEO7Nqb1uPWZNGNNGu/4Y= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x42c.google.com with SMTP id ffacd0b85a97d-34d7b0dac54so1539356f8f.0 for ; Tue, 07 May 2024 01:00:14 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1715068813; x=1715673613; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=69Ky44IuaQBZHmmivl5oqODxu2af/k53wJf6RhjnAMU=; b=lGP3iKLRuz6J/PEkM/HydRglOJoc1G6mZ318msFtp5N+OBBUciPAL6AxtHMSbgD9Bd QrnkVVbd0fArX1i38yD+XGlUaTkZsCUtLWb66vY7VDeW86SBjzvE+ZL98hlrp3f6nAmt sJsjs1uB2U4AENnOL6JsjvRyIDHPN8ZWbKc8wj87QESxoxtJVD9dLwQfZlGd56T3k/5Q b46CAEFe8UHxAjbszTr0E8Va8hjnUQqQQn/vRPlnyOM+nN5ZcSwqxB1GdOQfwKsa2nlS lUKvJpVOiGk3aXG55AjXf9OLkNL6xXvjmFBfzTcdY/ZOKkHWcA36PgViYlOfjJxqLnZM 4Ovg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1715068813; x=1715673613; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=69Ky44IuaQBZHmmivl5oqODxu2af/k53wJf6RhjnAMU=; b=qyT/gVhvbDoiiAsuTiK0laV+NO0bJ34AY2P/IAsga3rlkvQQ66OwOQNmi4fNtkxUm/ LKt6TfMmf27NyLuxexDfagsYX9xAheN0OfrMEB7OEoDUGowrS7sTF938Zl5W3GXHw9H2 SdmUm+2ip4ddPoM7cK/1S+m2jBrFsKPU5wp99ADuOHyLrNDDRkzjriGRWV9YIuD+ZpMa wdqYQi3y1elIBx0kTfh9kGj/4PSX8GtySUo7UrRewqZm7hsB6DRx1Y3i3wIlc+zt/n0p su5F5MJFeJfDIl/A2LMEraCPp4dOdlxoOpsEKzehgoqcvh0H+jRnZGl+nKmRaE1pBV8f o0cA== X-Gm-Message-State: AOJu0YwmUoyVgw7SNyvxN/bRlt9AEMs9NRqYJ4pQ7D9Lcl6dLQJXvGWh U0nGP6/f4EVfN8qk4eK8wCGfOX1pZBrPcy2ELVGkMtnmIhQq3IK9t94QZ/WvsZsa9GokvZIU9x8 = X-Google-Smtp-Source: AGHT+IERv/6B4pbUF9hK8BI0/biHt+8x03a2OM9BoqdOOhRwRxYWnhAaxzC2tyRM27QVb+xhemBaAw== X-Received: by 2002:a5d:4b0d:0:b0:34d:8ed4:ca3b with SMTP id v13-20020a5d4b0d000000b0034d8ed4ca3bmr1532360wrq.0.1715068813014; Tue, 07 May 2024 01:00:13 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:11a6:1c9d:5099:b1e8]) by smtp.gmail.com with ESMTPSA id h4-20020adff4c4000000b0034cee43238fsm12300344wrp.27.2024.05.07.01.00.12 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 07 May 2024 01:00:12 -0700 (PDT) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Fix LTO type mismatches in GNAT.Sockets.Thin Date: Tue, 7 May 2024 10:00:11 +0200 Message-ID: <20240507080011.37124-1-poulhies@adacore.com> X-Mailer: git-send-email 2.43.2 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-13.2 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,GIT_PATCH_0,KAM_ASCII_DIVIDERS,RCVD_IN_DNSWL_NONE,SPF_HELO_NONE,SPF_PASS,TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: From: Eric Botcazou The default implementation of GNAT.Sockets.Thin is mainly used on Linux and the socklen_t type used in various routines of the BSD sockets C API is a typedef for unsigned int there, so importing it as Interface.C.int will be flagged as a type mismatch during LTO compilation. gcc/ada/ * libgnat/g-socthi.ads (C_Bind): Turn into inline function. (C_Getpeername): Likewise. (C_Getsockname): Likewise. (C_Getsockopt): Likewise. (C_Setsockopt): Likewise. (Nonreentrant_Gethostbyaddr): Likewise. * libgnat/g-socthi.adb (Syscall_Accept): Adjust profile. (Syscall_Connect): Likewise. (Syscall_Recvfrom): Likewise. (Syscall_Sendto): Likewise. (C_Bind): New function. (C_Accept): Adjust to above change for profiles. (C_Connect): Likewise. (C_Getpeername): New function. (C_Getsockname): Likewise. (C_Getsockopt): Likewise. (C_Recvfrom): Adjust to above change for profiles. (C_Setsockopt): New function. (Nonreentrant_Gethostbyaddr): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/g-socthi.adb | 176 ++++++++++++++++++++++++++++++++--- gcc/ada/libgnat/g-socthi.ads | 12 +-- 2 files changed, 170 insertions(+), 18 deletions(-) diff --git a/gcc/ada/libgnat/g-socthi.adb b/gcc/ada/libgnat/g-socthi.adb index dce2717cda3..f8ddcc7fca6 100644 --- a/gcc/ada/libgnat/g-socthi.adb +++ b/gcc/ada/libgnat/g-socthi.adb @@ -62,13 +62,13 @@ package body GNAT.Sockets.Thin is function Syscall_Accept (S : C.int; Addr : System.Address; - Addrlen : not null access C.int) return C.int; + Addrlen : not null access C.unsigned) return C.int; pragma Import (C, Syscall_Accept, "accept"); function Syscall_Connect (S : C.int; Name : System.Address; - Namelen : C.int) return C.int; + Namelen : C.unsigned) return C.int; pragma Import (C, Syscall_Connect, "connect"); function Syscall_Recv @@ -84,7 +84,7 @@ package body GNAT.Sockets.Thin is Len : C.size_t; Flags : C.int; From : System.Address; - Fromlen : not null access C.int) return System.CRTL.ssize_t; + Fromlen : not null access C.unsigned) return System.CRTL.ssize_t; pragma Import (C, Syscall_Recvfrom, "recvfrom"); function Syscall_Recvmsg @@ -105,7 +105,7 @@ package body GNAT.Sockets.Thin is Len : C.size_t; Flags : C.int; To : System.Address; - Tolen : C.int) return System.CRTL.ssize_t; + Tolen : C.unsigned) return System.CRTL.ssize_t; pragma Import (C, Syscall_Sendto, "sendto"); function Syscall_Socket @@ -125,6 +125,25 @@ package body GNAT.Sockets.Thin is function Non_Blocking_Socket (S : C.int) return Boolean; procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean); + ------------ + -- C_Bind -- + ------------ + + function C_Bind + (S : C.int; + Name : System.Address; + Namelen : C.int) return C.int + is + function Bind + (S : C.int; + Name : System.Address; + Namelen : C.unsigned) return C.int + with Import, Convention => C, External_Name => "bind"; + + begin + return Bind (S, Name, C.unsigned (Namelen)); + end C_Bind; + -------------- -- C_Accept -- -------------- @@ -134,15 +153,18 @@ package body GNAT.Sockets.Thin is Addr : System.Address; Addrlen : not null access C.int) return C.int is - R : C.int; - Val : aliased C.int := 1; + R : C.int; + U_Addrlen : aliased C.unsigned; + Val : aliased C.int := 1; Discard : C.int; pragma Warnings (Off, Discard); begin + U_Addrlen := C.unsigned (Addrlen.all); + loop - R := Syscall_Accept (S, Addr, Addrlen); + R := Syscall_Accept (S, Addr, U_Addrlen'Unchecked_Access); exit when SOSC.Thread_Blocking_IO or else R /= Failure or else Non_Blocking_Socket (S) @@ -150,6 +172,8 @@ package body GNAT.Sockets.Thin is delay Quantum; end loop; + Addrlen.all := C.int (U_Addrlen); + if not SOSC.Thread_Blocking_IO and then R /= Failure then @@ -177,7 +201,7 @@ package body GNAT.Sockets.Thin is Res : C.int; begin - Res := Syscall_Connect (S, Name, Namelen); + Res := Syscall_Connect (S, Name, C.unsigned (Namelen)); if SOSC.Thread_Blocking_IO or else Res /= Failure @@ -215,7 +239,7 @@ package body GNAT.Sockets.Thin is end loop; end; - Res := Syscall_Connect (S, Name, Namelen); + Res := Syscall_Connect (S, Name, C.unsigned (Namelen)); if Res = Failure and then Errno = SOSC.EISCONN @@ -226,6 +250,85 @@ package body GNAT.Sockets.Thin is end if; end C_Connect; + ------------------- + -- C_Getpeername -- + ------------------- + + function C_Getpeername + (S : C.int; + Name : System.Address; + Namelen : not null access C.int) return C.int + is + function Getpeername + (S : C.int; + Name : System.Address; + Namelen : not null access C.unsigned) return C.int + with Import, Convention => C, External_Name => "getpeername"; + + U_Namelen : aliased C.unsigned; + Val : C.int; + + begin + U_Namelen := C.unsigned (Namelen.all); + Val := Getpeername (S, Name, U_Namelen'Unchecked_Access); + Namelen.all := C.int (U_Namelen); + return Val; + end C_Getpeername; + + ------------------- + -- C_Getsockname -- + ------------------- + + function C_Getsockname + (S : C.int; + Name : System.Address; + Namelen : not null access C.int) return C.int + is + function Getsockname + (S : C.int; + Name : System.Address; + Namelen : not null access C.unsigned) return C.int + with Import, Convention => C, External_Name => "getsockname"; + + U_Namelen : aliased C.unsigned; + Val : C.int; + + begin + U_Namelen := C.unsigned (Namelen.all); + Val := Getsockname (S, Name, U_Namelen'Unchecked_Access); + Namelen.all := C.int (U_Namelen); + return Val; + end C_Getsockname; + + ------------------- + -- C_Getsockopt -- + ------------------- + + function C_Getsockopt + (S : C.int; + Level : C.int; + Optname : C.int; + Optval : System.Address; + Optlen : not null access C.int) return C.int + is + function Getsockopt + (S : C.int; + Level : C.int; + Optname : C.int; + Optval : System.Address; + Optlen : not null access C.unsigned) return C.int + with Import, Convention => C, External_Name => "getsockopt"; + + U_Optlen : aliased C.unsigned; + Val : C.int; + + begin + U_Optlen := C.unsigned (Optlen.all); + Val := Getsockopt (S, Level, Optname, Optval, U_Optlen'Unchecked_Access); + Optlen.all := C.int (U_Optlen); + return Val; + end C_Getsockopt; + ------------------ -- Socket_Ioctl -- ------------------ @@ -282,11 +385,15 @@ package body GNAT.Sockets.Thin is From : System.Address; Fromlen : not null access C.int) return C.int is - Res : C.int; + Res : C.int; + U_Fromlen : aliased C.unsigned; begin + U_Fromlen := C.unsigned (Fromlen.all); + loop - Res := C.int (Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen)); + Res := C.int (Syscall_Recvfrom (S, Msg, Len, Flags, From, + U_Fromlen'Unchecked_Access)); exit when SOSC.Thread_Blocking_IO or else Res /= Failure or else Non_Blocking_Socket (S) @@ -294,6 +401,8 @@ package body GNAT.Sockets.Thin is delay Quantum; end loop; + Fromlen.all := C.int (U_Fromlen); + return Res; end C_Recvfrom; @@ -361,7 +470,8 @@ package body GNAT.Sockets.Thin is begin loop - Res := C.int (Syscall_Sendto (S, Msg, Len, Flags, To, Tolen)); + Res := C.int (Syscall_Sendto (S, Msg, Len, Flags, To, + C.unsigned (Tolen))); exit when SOSC.Thread_Blocking_IO or else Res /= Failure or else Non_Blocking_Socket (S) @@ -372,6 +482,29 @@ package body GNAT.Sockets.Thin is return Res; end C_Sendto; + ------------------ + -- C_Setsockopt -- + ------------------ + + function C_Setsockopt + (S : C.int; + Level : C.int; + Optname : C.int; + Optval : System.Address; + Optlen : C.int) return C.int + is + function Setsockopt + (S : C.int; + Level : C.int; + Optname : C.int; + Optval : System.Address; + Optlen : C.unsigned) return C.int + with Import, Convention => C, External_Name => "setsockopt"; + + begin + return Setsockopt (S, Level, Optname, Optval, C.unsigned (Optlen)); + end C_Setsockopt; + -------------- -- C_Socket -- -------------- @@ -457,6 +590,25 @@ package body GNAT.Sockets.Thin is Task_Lock.Unlock; end Set_Non_Blocking_Socket; + -------------------------------- + -- Nonreentrant_Gethostbyaddr -- + -------------------------------- + + function Nonreentrant_Gethostbyaddr + (Addr : System.Address; + Addr_Len : C.int; + Addr_Type : C.int) return Hostent_Access + is + function Gethostbyaddr + (Addr : System.Address; + Addr_Len : C.unsigned; + Addr_Type : C.int) return Hostent_Access + with Import, Convention => C, External_Name => "gethostbyaddr"; + + begin + return Gethostbyaddr (Addr, C.unsigned (Addr_Len), Addr_Type); + end Nonreentrant_Gethostbyaddr; + -------------------- -- Signalling_Fds -- -------------------- diff --git a/gcc/ada/libgnat/g-socthi.ads b/gcc/ada/libgnat/g-socthi.ads index ef53e0414b0..b759c7e1eb1 100644 --- a/gcc/ada/libgnat/g-socthi.ads +++ b/gcc/ada/libgnat/g-socthi.ads @@ -249,21 +249,21 @@ package GNAT.Sockets.Thin is procedure Finalize; private - pragma Import (C, C_Bind, "bind"); + pragma Inline (C_Bind); pragma Import (C, C_Close, "close"); pragma Import (C, C_Gethostname, "gethostname"); - pragma Import (C, C_Getpeername, "getpeername"); - pragma Import (C, C_Getsockname, "getsockname"); - pragma Import (C, C_Getsockopt, "getsockopt"); + pragma Inline (C_Getpeername); + pragma Inline (C_Getsockname); + pragma Inline (C_Getsockopt); pragma Import (C, C_Listen, "listen"); pragma Import (C, C_Select, "select"); - pragma Import (C, C_Setsockopt, "setsockopt"); + pragma Inline (C_Setsockopt); pragma Import (C, C_Shutdown, "shutdown"); pragma Import (C, C_Socketpair, "socketpair"); pragma Import (C, C_System, "system"); pragma Import (C, Nonreentrant_Gethostbyname, "gethostbyname"); - pragma Import (C, Nonreentrant_Gethostbyaddr, "gethostbyaddr"); + pragma Inline (Nonreentrant_Gethostbyaddr); pragma Import (C, Nonreentrant_Getservbyname, "getservbyname"); pragma Import (C, Nonreentrant_Getservbyport, "getservbyport"); -- 2.43.2