From patchwork Thu Jun 17 12:27:05 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56031 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id A8EC61007D2 for ; Thu, 17 Jun 2010 22:27:16 +1000 (EST) Received: (qmail 6851 invoked by alias); 17 Jun 2010 12:27:12 -0000 Received: (qmail 6625 invoked by uid 22791); 17 Jun 2010 12:26:59 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, TW_CV, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 17 Jun 2010 12:26:50 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 0C9E7CB02A9; Thu, 17 Jun 2010 14:26:56 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id yq2hNBseWU4E; Thu, 17 Jun 2010 14:26:55 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id EA043CB02A7; Thu, 17 Jun 2010 14:26:55 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id F1560D9AB0; Thu, 17 Jun 2010 14:27:05 +0200 (CEST) Date: Thu, 17 Jun 2010 14:27:05 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Fix interface to a couple of POSIX functions Message-ID: <20100617122705.GA9204@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This changes the interface to the POSIX 'read' and 'write' functions implemented in s-crtl.ads to match the POSIX specs. No functional changes. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-17 Eric Botcazou * s-crtl.ads (ssize_t): New type. (read): Fix signature. (write): Likewise. * g-socthi.ads: Add 'with System.CRTL' clause. Remove ssize_t and 'use type' directive for C.size_t, add one for System.CRTL.ssize_t. (C_Recvmsg): Replace ssize_t with System.CRTL.ssize_t. (C_Sendmsg): Likewise. * g-socthi.adb (Syscall_Recvmsg): Likewise. (Syscall_Sendmsg): Likewise. (C_Recvmsg): Likewise. (C_Sendmsg): Likewise. * g-socthi-mingw.ads: Add 'with System.CRTL' clause. Remove ssize_t and 'use type' directive for C.size_t, add one for System.CRTL.ssize_t. (C_Recvmsg): Replace ssize_t with System.CRTL.ssize_t. (C_Sendmsg): Likewise. * g-socthi-mingw.adb (C_Recvmsg): Likewise. (C_Sendmsg): Likewise. * g-socthi-vms.ads: Add 'with System.CRTL' clause. Remove ssize_t and 'use type' directive for C.size_t, add one for System.CRTL.ssize_t. (C_Recvmsg): Replace ssize_t with System.CRTL.ssize_t. (C_Sendmsg): Likewise. * g-socthi-vms.adb (C_Recvmsg): Likewise. (C_Sendmsg): Likewise. * g-socthi-vxworks.ads Add 'with System.CRTL' clause. Remove ssize_t and 'use type' directive for C.size_t, add one for System.CRTL.ssize_t. (C_Recvmsg): Replace ssize_t with System.CRTL.ssize_t. (C_Sendmsg): Likewise. * g-socthi-vxworks.adb (C_Recvmsg): Likewise. (C_Sendmsg): Likewise. * g-sercom-linux.adb (Read): Use correct types to call 'read'. (Write): Likewise to call 'write'. * s-os_lib.adb (Read): Use correct type to call System.CRTL.read. (Write): Use correct type to call System.CRTL.write. * s-tasdeb.adb (Write): Likewise. Index: s-crtl.ads =================================================================== --- s-crtl.ads (revision 160834) +++ s-crtl.ads (working copy) @@ -59,6 +59,9 @@ package System.CRTL is type size_t is mod 2 ** Standard'Address_Size; + type ssize_t is range -(2 ** (Standard'Address_Size - 1)) + .. +(2 ** (Standard'Address_Size - 1)) - 1; + type Filename_Encoding is (UTF8, ASCII_8bits, Unspecified); for Filename_Encoding use (UTF8 => 0, ASCII_8bits => 1, Unspecified => 2); pragma Convention (C, Filename_Encoding); @@ -187,10 +190,10 @@ package System.CRTL is function close (fd : int) return int; pragma Import (C, close, "close"); - function read (fd : int; buffer : chars; nbytes : int) return int; + function read (fd : int; buffer : chars; count : size_t) return ssize_t; pragma Import (C, read, "read"); - function write (fd : int; buffer : chars; nbytes : int) return int; + function write (fd : int; buffer : chars; count : size_t) return ssize_t; pragma Import (C, write, "write"); end System.CRTL; Index: g-sercom-linux.adb =================================================================== --- g-sercom-linux.adb (revision 160834) +++ g-sercom-linux.adb (working copy) @@ -158,8 +158,8 @@ package body GNAT.Serial_Communications Buffer : out Stream_Element_Array; Last : out Stream_Element_Offset) is - Len : constant int := Buffer'Length; - Res : int; + Len : constant size_t := Buffer'Length; + Res : ssize_t; begin if Port.H = null then @@ -264,8 +264,8 @@ package body GNAT.Serial_Communications (Port : in out Serial_Port; Buffer : Stream_Element_Array) is - Len : constant int := Buffer'Length; - Res : int; + Len : constant size_t := Buffer'Length; + Res : ssize_t; begin if Port.H = null then @@ -273,11 +273,12 @@ package body GNAT.Serial_Communications end if; Res := write (int (Port.H.all), Buffer'Address, Len); - pragma Assert (Res = Len); if Res = -1 then Raise_Error ("write failed"); end if; + + pragma Assert (size_t (Res) = Len); end Write; ----------- Index: g-socthi-vms.adb =================================================================== --- g-socthi-vms.adb (revision 160834) +++ g-socthi-vms.adb (working copy) @@ -292,7 +292,7 @@ package body GNAT.Sockets.Thin is function C_Recvmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t + Flags : C.int) return System.CRTL.ssize_t is Res : C.int; @@ -314,7 +314,7 @@ package body GNAT.Sockets.Thin is GNAT_Msg := Msghdr (VMS_Msg); - return ssize_t (Res); + return System.CRTL.ssize_t (Res); end C_Recvmsg; --------------- @@ -324,7 +324,7 @@ package body GNAT.Sockets.Thin is function C_Sendmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t + Flags : C.int) return System.CRTL.ssize_t is Res : C.int; @@ -346,7 +346,7 @@ package body GNAT.Sockets.Thin is GNAT_Msg := Msghdr (VMS_Msg); - return ssize_t (Res); + return System.CRTL.ssize_t (Res); end C_Sendmsg; -------------- Index: g-socthi-vms.ads =================================================================== --- g-socthi-vms.ads (revision 160834) +++ g-socthi-vms.ads (working copy) @@ -43,6 +43,7 @@ with GNAT.OS_Lib; with GNAT.Sockets.Thin_Common; with System; +with System.CRTL; package GNAT.Sockets.Thin is @@ -52,10 +53,7 @@ package GNAT.Sockets.Thin is package C renames Interfaces.C; - use type C.size_t; - type ssize_t is range -(2 ** (C.size_t'Size - 1)) - .. +(2 ** (C.size_t'Size - 1) - 1); - -- Signed type of the same size as size_t + use type System.CRTL.ssize_t; function Socket_Errno return Integer renames GNAT.OS_Lib.Errno; -- Returns last socket error number @@ -149,7 +147,7 @@ package GNAT.Sockets.Thin is function C_Recvmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t; + Flags : C.int) return System.CRTL.ssize_t; function C_Select (Nfds : C.int; @@ -161,7 +159,7 @@ package GNAT.Sockets.Thin is function C_Sendmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t; + Flags : C.int) return System.CRTL.ssize_t; function C_Sendto (S : C.int; Index: g-socthi-vxworks.adb =================================================================== --- g-socthi-vxworks.adb (revision 160834) +++ g-socthi-vxworks.adb (working copy) @@ -309,7 +309,7 @@ package body GNAT.Sockets.Thin is function C_Recvmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t + Flags : C.int) return System.CRTL.ssize_t is Res : C.int; @@ -323,7 +323,7 @@ package body GNAT.Sockets.Thin is delay Quantum; end loop; - return ssize_t (Res); + return System.CRTL.ssize_t (Res); end C_Recvmsg; --------------- @@ -333,7 +333,7 @@ package body GNAT.Sockets.Thin is function C_Sendmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t + Flags : C.int) return System.CRTL.ssize_t is Res : C.int; @@ -347,7 +347,7 @@ package body GNAT.Sockets.Thin is delay Quantum; end loop; - return ssize_t (Res); + return System.CRTL.ssize_t (Res); end C_Sendmsg; -------------- Index: g-socthi-vxworks.ads =================================================================== --- g-socthi-vxworks.ads (revision 160834) +++ g-socthi-vxworks.ads (working copy) @@ -43,6 +43,7 @@ with GNAT.OS_Lib; with GNAT.Sockets.Thin_Common; with System; +with System.CRTL; package GNAT.Sockets.Thin is @@ -50,10 +51,7 @@ package GNAT.Sockets.Thin is package C renames Interfaces.C; - use type C.size_t; - type ssize_t is range -(2 ** (C.size_t'Size - 1)) - .. +(2 ** (C.size_t'Size - 1) - 1); - -- Signed type of the same size as size_t + use type System.CRTL.ssize_t; function Socket_Errno return Integer renames GNAT.OS_Lib.Errno; -- Returns last socket error number @@ -147,7 +145,7 @@ package GNAT.Sockets.Thin is function C_Recvmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t; + Flags : C.int) return System.CRTL.ssize_t; function C_Select (Nfds : C.int; @@ -159,7 +157,7 @@ package GNAT.Sockets.Thin is function C_Sendmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t; + Flags : C.int) return System.CRTL.ssize_t; function C_Sendto (S : C.int; Index: g-socthi-mingw.adb =================================================================== --- g-socthi-mingw.adb (revision 160834) +++ g-socthi-mingw.adb (working copy) @@ -269,7 +269,7 @@ package body GNAT.Sockets.Thin is function C_Recvmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t + Flags : C.int) return System.CRTL.ssize_t is Res : C.int; Count : C.int := 0; @@ -287,19 +287,20 @@ package body GNAT.Sockets.Thin is -- not available in all versions of Windows. So, we use C_Recv instead. for J in Iovec'Range loop - Res := C_Recv - (S, - Iovec (J).Base.all'Address, - C.int (Iovec (J).Length), - Flags); + Res := + C_Recv + (S, + Iovec (J).Base.all'Address, + C.int (Iovec (J).Length), + Flags); if Res < 0 then - return ssize_t (Res); + return System.CRTL.ssize_t (Res); else Count := Count + Res; end if; end loop; - return ssize_t (Count); + return System.CRTL.ssize_t (Count); end C_Recvmsg; -------------- @@ -369,10 +370,11 @@ package body GNAT.Sockets.Thin is -- Check out-of-band data - Length := C_Recvfrom - (S, Buffer'Address, 1, Flag, - From => System.Null_Address, - Fromlen => Fromlen'Unchecked_Access); + Length := + C_Recvfrom + (S, Buffer'Address, 1, Flag, + From => System.Null_Address, + Fromlen => Fromlen'Unchecked_Access); -- Is Fromlen necessary if From is Null_Address??? -- If the signal is not an out-of-band data, then it @@ -404,7 +406,7 @@ package body GNAT.Sockets.Thin is function C_Sendmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t + Flags : C.int) return System.CRTL.ssize_t is Res : C.int; Count : C.int := 0; @@ -423,21 +425,23 @@ package body GNAT.Sockets.Thin is -- instead. for J in Iovec'Range loop - Res := C_Sendto - (S, - Iovec (J).Base.all'Address, - C.int (Iovec (J).Length), - Flags => Flags, - To => MH.Msg_Name, - Tolen => C.int (MH.Msg_Namelen)); + Res := + C_Sendto + (S, + Iovec (J).Base.all'Address, + C.int (Iovec (J).Length), + Flags => Flags, + To => MH.Msg_Name, + Tolen => C.int (MH.Msg_Namelen)); if Res < 0 then - return ssize_t (Res); + return System.CRTL.ssize_t (Res); else Count := Count + Res; end if; end loop; - return ssize_t (Count); + + return System.CRTL.ssize_t (Count); end C_Sendmsg; -------------- Index: g-socthi-mingw.ads =================================================================== --- g-socthi-mingw.ads (revision 160834) +++ g-socthi-mingw.ads (working copy) @@ -42,6 +42,7 @@ with Interfaces.C.Strings; with GNAT.Sockets.Thin_Common; with System; +with System.CRTL; package GNAT.Sockets.Thin is @@ -49,10 +50,7 @@ package GNAT.Sockets.Thin is package C renames Interfaces.C; - use type C.size_t; - type ssize_t is range -(2 ** (C.size_t'Size - 1)) - .. +(2 ** (C.size_t'Size - 1) - 1); - -- Signed type of the same size as size_t + use type System.CRTL.ssize_t; function Socket_Errno return Integer; -- Returns last socket error number @@ -146,7 +144,7 @@ package GNAT.Sockets.Thin is function C_Recvmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t; + Flags : C.int) return System.CRTL.ssize_t; function C_Select (Nfds : C.int; @@ -158,7 +156,7 @@ package GNAT.Sockets.Thin is function C_Sendmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t; + Flags : C.int) return System.CRTL.ssize_t; function C_Sendto (S : C.int; Index: g-socthi.adb =================================================================== --- g-socthi.adb (revision 160834) +++ g-socthi.adb (working copy) @@ -95,13 +95,13 @@ package body GNAT.Sockets.Thin is function Syscall_Recvmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t; + Flags : C.int) return System.CRTL.ssize_t; pragma Import (C, Syscall_Recvmsg, "recvmsg"); function Syscall_Sendmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t; + Flags : C.int) return System.CRTL.ssize_t; pragma Import (C, Syscall_Sendmsg, "sendmsg"); function Syscall_Sendto @@ -307,15 +307,15 @@ package body GNAT.Sockets.Thin is function C_Recvmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t + Flags : C.int) return System.CRTL.ssize_t is - Res : ssize_t; + Res : System.CRTL.ssize_t; begin loop Res := Syscall_Recvmsg (S, Msg, Flags); exit when SOSC.Thread_Blocking_IO - or else Res /= ssize_t (Failure) + or else Res /= System.CRTL.ssize_t (Failure) or else Non_Blocking_Socket (S) or else Errno /= SOSC.EWOULDBLOCK; delay Quantum; @@ -331,15 +331,15 @@ package body GNAT.Sockets.Thin is function C_Sendmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t + Flags : C.int) return System.CRTL.ssize_t is - Res : ssize_t; + Res : System.CRTL.ssize_t; begin loop Res := Syscall_Sendmsg (S, Msg, Flags); exit when SOSC.Thread_Blocking_IO - or else Res /= ssize_t (Failure) + or else Res /= System.CRTL.ssize_t (Failure) or else Non_Blocking_Socket (S) or else Errno /= SOSC.EWOULDBLOCK; delay Quantum; Index: g-socthi.ads =================================================================== --- g-socthi.ads (revision 160834) +++ g-socthi.ads (working copy) @@ -43,6 +43,7 @@ with GNAT.OS_Lib; with GNAT.Sockets.Thin_Common; with System; +with System.CRTL; package GNAT.Sockets.Thin is @@ -54,10 +55,7 @@ package GNAT.Sockets.Thin is package C renames Interfaces.C; - use type C.size_t; - type ssize_t is range -(2 ** (C.size_t'Size - 1)) - .. +(2 ** (C.size_t'Size - 1) - 1); - -- Signed type of the same size as size_t + use type System.CRTL.ssize_t; function Socket_Errno return Integer renames GNAT.OS_Lib.Errno; -- Returns last socket error number @@ -148,7 +146,7 @@ package GNAT.Sockets.Thin is function C_Recvmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t; + Flags : C.int) return System.CRTL.ssize_t; function C_Select (Nfds : C.int; @@ -160,7 +158,7 @@ package GNAT.Sockets.Thin is function C_Sendmsg (S : C.int; Msg : System.Address; - Flags : C.int) return ssize_t; + Flags : C.int) return System.CRTL.ssize_t; function C_Sendto (S : C.int; Index: s-tasdeb.adb =================================================================== --- s-tasdeb.adb (revision 160834) +++ s-tasdeb.adb (working copy) @@ -362,10 +362,11 @@ package body System.Tasking.Debug is ----------- procedure Write (Fd : Integer; S : String; Count : Integer) is - Discard : Integer; + Discard : System.CRTL.ssize_t; pragma Unreferenced (Discard); begin - Discard := System.CRTL.write (Fd, S (S'First)'Address, Count); + Discard := System.CRTL.write (Fd, S (S'First)'Address, + System.CRTL.size_t (Count)); -- Is it really right to ignore write errors here ??? end Write; Index: s-os_lib.adb =================================================================== --- s-os_lib.adb (revision 160834) +++ s-os_lib.adb (working copy) @@ -2309,8 +2309,11 @@ package body System.OS_Lib is N : Integer) return Integer is begin - return Integer (System.CRTL.read - (System.CRTL.int (FD), System.CRTL.chars (A), System.CRTL.int (N))); + return + Integer (System.CRTL.read + (System.CRTL.int (FD), + System.CRTL.chars (A), + System.CRTL.size_t (N))); end Read; ----------------- @@ -2718,8 +2721,11 @@ package body System.OS_Lib is N : Integer) return Integer is begin - return Integer (System.CRTL.write - (System.CRTL.int (FD), System.CRTL.chars (A), System.CRTL.int (N))); + return + Integer (System.CRTL.write + (System.CRTL.int (FD), + System.CRTL.chars (A), + System.CRTL.size_t (N))); end Write; end System.OS_Lib;