OSDN Git Service

2009-11-30 Thomas Quinot <quinot@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 09:31:28 +0000 (09:31 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 09:31:28 +0000 (09:31 +0000)
* s-commun.adb, s-commun.ads: New internal support unit,
allowing code sharing between GNAT.Sockets and
GNAT.Serial_Communication.
* g-sercom.ads, g-sercom-mingw.adb, g-sercom-linux.adb,
g-socket.adb (GNAT.Sockets.Last_Index): Move to System.Communication.
(GNAT.Serial_Communication.Read): Handle correctly the case where no
data was read, and Buffer'First = Stream_Element_Offset'First.
* Makefile.rtl: Add entry for s-commun
* g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
g-socthi-vxworks.ads, g-stseme.adb, g-socthi-mingw.ads,
g-socthi.adb, g-socthi.ads (GNAT.Sockets.Thin.Socket_Error_Message):
Reimplement in terms of System.CRTL.strerror.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154758 138bc75d-0d04-0410-961f-82ee72b054a4

16 files changed:
gcc/ada/ChangeLog
gcc/ada/Makefile.rtl
gcc/ada/g-sercom-linux.adb
gcc/ada/g-sercom-mingw.adb
gcc/ada/g-sercom.ads
gcc/ada/g-socket.adb
gcc/ada/g-socthi-mingw.ads
gcc/ada/g-socthi-vms.adb
gcc/ada/g-socthi-vms.ads
gcc/ada/g-socthi-vxworks.adb
gcc/ada/g-socthi-vxworks.ads
gcc/ada/g-socthi.adb
gcc/ada/g-socthi.ads
gcc/ada/g-stseme.adb [new file with mode: 0644]
gcc/ada/s-commun.adb [new file with mode: 0644]
gcc/ada/s-commun.ads [new file with mode: 0644]

index 298dda2..ec4250c 100644 (file)
@@ -1,3 +1,18 @@
+2009-11-30  Thomas Quinot  <quinot@adacore.com>
+
+       * s-commun.adb, s-commun.ads: New internal support unit,
+       allowing code sharing between GNAT.Sockets and
+       GNAT.Serial_Communication.
+       * g-sercom.ads, g-sercom-mingw.adb, g-sercom-linux.adb,
+       g-socket.adb (GNAT.Sockets.Last_Index): Move to System.Communication.
+       (GNAT.Serial_Communication.Read): Handle correctly the case where no
+       data was read, and Buffer'First = Stream_Element_Offset'First.
+       * Makefile.rtl: Add entry for s-commun
+       * g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
+       g-socthi-vxworks.ads, g-stseme.adb, g-socthi-mingw.ads,
+       g-socthi.adb, g-socthi.ads (GNAT.Sockets.Thin.Socket_Error_Message):
+       Reimplement in terms of System.CRTL.strerror.
+
 2009-11-26  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/utils.c (copy_type): Unshare the language-specific data
index 4f26f15..d03c67d 100644 (file)
@@ -421,6 +421,7 @@ GNATRTL_NONTASKING_OBJS= \
   s-caun32$(objext) \
   s-caun64$(objext) \
   s-chepoo$(objext) \
+  s-commun$(objext) \
   s-conca2$(objext) \
   s-conca3$(objext) \
   s-conca4$(objext) \
index 1be595a..c25d5e8 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                    Copyright (C) 2007-2008, AdaCore                      --
+--                    Copyright (C) 2007-2009, AdaCore                      --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -37,7 +37,9 @@ with Ada.Streams;                use Ada.Streams;
 with Ada;                        use Ada;
 with Ada.Unchecked_Deallocation;
 
-with System.CRTL; use System, System.CRTL;
+with System;               use System;
+with System.Communication; use System.Communication;
+with System.CRTL;          use System.CRTL;
 
 with GNAT.OS_Lib; use GNAT.OS_Lib;
 
@@ -167,11 +169,10 @@ package body GNAT.Serial_Communications is
       Res := read (Integer (Port.H.all), Buffer'Address, Len);
 
       if Res = -1 then
-         Last := 0;
          Raise_Error ("read failed");
-      else
-         Last := Buffer'First + Stream_Element_Offset (Res) - 1;
       end if;
+
+      Last := Last_Index (Buffer'First, C.int (Res));
    end Read;
 
    ---------
index 03bd6ab..e503411 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                    Copyright (C) 2007-2008, AdaCore                      --
+--                    Copyright (C) 2007-2009, AdaCore                      --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
 
 with Ada.Unchecked_Deallocation; use Ada;
 with Ada.Streams;                use Ada.Streams;
-with System.Win32.Ext;           use System, System.Win32, System.Win32.Ext;
+
+with System;               use System;
+with System.Communication; use System.Communication;
+with System.Win32;         use System.Win32;
+with System.Win32.Ext;     use System.Win32.Ext;
 
 package body GNAT.Serial_Communications is
 
@@ -158,7 +162,7 @@ package body GNAT.Serial_Communications is
          Raise_Error ("read error");
       end if;
 
-      Last := Buffer'First - 1 + Stream_Element_Offset (Read_Last);
+      Last := Last_Index (Buffer'First, C.int (Read_Last));
    end Read;
 
    ---------
index 8b4c559..5adeebe 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                    Copyright (C) 2007-2008, AdaCore                      --
+--                    Copyright (C) 2007-2009, AdaCore                      --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -91,7 +91,9 @@ package GNAT.Serial_Communications is
       Buffer : out Ada.Streams.Stream_Element_Array;
       Last   : out Ada.Streams.Stream_Element_Offset);
    --  Read a set of bytes, put result into Buffer and set Last accordingly.
-   --  Last is set to 0 if no byte has been read.
+   --  Last is set to Buffer'First - 1 if no byte has been read, unless
+   --  Buffer'First = Stream_Element_Offset'First, in which case Last is
+   --  set to Stream_Element_Offset'Last instead.
 
    overriding procedure Write
      (Port   : in out Serial_Port;
index 7741dc0..5cf623a 100644 (file)
@@ -46,7 +46,8 @@ with GNAT.Sockets.Linker_Options;
 pragma Warnings (Off, GNAT.Sockets.Linker_Options);
 --  Need to include pragma Linker_Options which is platform dependent
 
-with System; use System;
+with System;               use System;
+with System.Communication; use System.Communication;
 
 package body GNAT.Sockets is
 
@@ -249,14 +250,6 @@ package body GNAT.Sockets is
    function Err_Code_Image (E : Integer) return String;
    --  Return the value of E surrounded with brackets
 
-   function Last_Index
-     (First : Stream_Element_Offset;
-      Count : C.int) return Stream_Element_Offset;
-   --  Compute the Last OUT parameter for the various Receive_Socket
-   --  subprograms: returns First + Count - 1, except for the case
-   --  where First = Stream_Element_Offset'First and Res = 0, in which
-   --  case Stream_Element_Offset'Last is returned instead.
-
    procedure Initialize (X : in out Sockets_Library_Controller);
    procedure Finalize   (X : in out Sockets_Library_Controller);
 
@@ -1416,22 +1409,6 @@ package body GNAT.Sockets is
         and then Is_Socket_In_Set (Item.Set'Access, C.int (Socket)) /= 0;
    end Is_Set;
 
-   ----------------
-   -- Last_Index --
-   ----------------
-
-   function Last_Index
-     (First : Stream_Element_Offset;
-      Count : C.int) return Stream_Element_Offset
-   is
-   begin
-      if First = Stream_Element_Offset'First and then Count = 0 then
-         return Stream_Element_Offset'Last;
-      else
-         return First + Stream_Element_Offset (Count - 1);
-      end if;
-   end Last_Index;
-
    -------------------
    -- Listen_Socket --
    -------------------
index 8ec0561..6d851e1 100644 (file)
@@ -184,9 +184,6 @@ package GNAT.Sockets.Thin is
       Typ      : C.int;
       Protocol : C.int) return C.int;
 
-   function C_Strerror
-     (Errnum : C.int) return C.Strings.chars_ptr;
-
    function C_System
      (Command : System.Address) return C.int;
 
@@ -241,7 +238,6 @@ private
    pragma Import (Stdcall, C_Setsockopt, "setsockopt");
    pragma Import (Stdcall, C_Shutdown, "shutdown");
    pragma Import (Stdcall, C_Socket, "socket");
-   pragma Import (C, C_Strerror, "strerror");
    pragma Import (C, C_System, "_system");
    pragma Import (Stdcall, Socket_Errno, "WSAGetLastError");
    pragma Import (Stdcall, Set_Socket_Errno, "WSASetLastError");
index cb2b211..b9e23ec 100644 (file)
@@ -473,19 +473,6 @@ package body GNAT.Sockets.Thin is
 
    function Socket_Error_Message
      (Errno : Integer) return C.Strings.chars_ptr
-   is
-      use type Interfaces.C.Strings.chars_ptr;
-
-      C_Msg : C.Strings.chars_ptr;
-
-   begin
-      C_Msg := C_Strerror (C.int (Errno));
-
-      if C_Msg = C.Strings.Null_Ptr then
-         return Unknown_System_Error;
-      else
-         return C_Msg;
-      end if;
-   end Socket_Error_Message;
+   is separate;
 
 end GNAT.Sockets.Thin;
index 3032b0e..a1bb487 100644 (file)
@@ -187,9 +187,6 @@ package GNAT.Sockets.Thin is
       Typ      : C.int;
       Protocol : C.int) return C.int;
 
-   function C_Strerror
-     (Errnum : C.int) return C.Strings.chars_ptr;
-
    function C_System
      (Command : System.Address) return C.int;
 
@@ -255,7 +252,6 @@ private
    pragma Import (C, C_Select,        "DECC$SELECT");
    pragma Import (C, C_Setsockopt,    "DECC$SETSOCKOPT");
    pragma Import (C, C_Shutdown,      "DECC$SHUTDOWN");
-   pragma Import (C, C_Strerror,      "DECC$STRERROR");
    pragma Import (C, C_System,        "DECC$SYSTEM");
 
    pragma Import (C, Nonreentrant_Gethostbyname, "DECC$GETHOSTBYNAME");
index 96d0cfc..e6a8ee6 100644 (file)
@@ -489,20 +489,6 @@ package body GNAT.Sockets.Thin is
 
    function Socket_Error_Message
      (Errno : Integer) return C.Strings.chars_ptr
-   is
-      use type Interfaces.C.Strings.chars_ptr;
-
-      C_Msg : C.Strings.chars_ptr;
-
-   begin
-      C_Msg := C_Strerror (C.int (Errno));
-
-      if C_Msg = C.Strings.Null_Ptr then
-         return Unknown_System_Error;
-
-      else
-         return C_Msg;
-      end if;
-   end Socket_Error_Message;
+   is separate;
 
 end GNAT.Sockets.Thin;
index 08fac05..4f92b3a 100644 (file)
@@ -185,9 +185,6 @@ package GNAT.Sockets.Thin is
       Typ      : C.int;
       Protocol : C.int) return C.int;
 
-   function C_Strerror
-     (Errnum : C.int) return C.Strings.chars_ptr;
-
    function C_System
      (Command : System.Address) return C.int;
 
@@ -232,6 +229,5 @@ private
    pragma Import (C, C_Select, "select");
    pragma Import (C, C_Setsockopt, "setsockopt");
    pragma Import (C, C_Shutdown, "shutdown");
-   pragma Import (C, C_Strerror, "strerror");
    pragma Import (C, C_System, "system");
 end GNAT.Sockets.Thin;
index b232378..ca79763 100644 (file)
@@ -494,19 +494,6 @@ package body GNAT.Sockets.Thin is
 
    function Socket_Error_Message
      (Errno : Integer) return C.Strings.chars_ptr
-   is
-      use type Interfaces.C.Strings.chars_ptr;
-
-      C_Msg : C.Strings.chars_ptr;
-
-   begin
-      C_Msg := C_Strerror (C.int (Errno));
-
-      if C_Msg = C.Strings.Null_Ptr then
-         return Unknown_System_Error;
-      else
-         return C_Msg;
-      end if;
-   end Socket_Error_Message;
+   is separate;
 
 end GNAT.Sockets.Thin;
index eb690c5..1f103e8 100644 (file)
@@ -186,9 +186,6 @@ package GNAT.Sockets.Thin is
       Typ      : C.int;
       Protocol : C.int) return C.int;
 
-   function C_Strerror
-     (Errnum : C.int) return C.Strings.chars_ptr;
-
    function C_System
      (Command : System.Address) return C.int;
 
@@ -257,7 +254,6 @@ private
    pragma Import (C, C_Select, "select");
    pragma Import (C, C_Setsockopt, "setsockopt");
    pragma Import (C, C_Shutdown, "shutdown");
-   pragma Import (C, C_Strerror, "strerror");
    pragma Import (C, C_System, "system");
 
    pragma Import (C, Nonreentrant_Gethostbyname, "gethostbyname");
diff --git a/gcc/ada/g-stseme.adb b/gcc/ada/g-stseme.adb
new file mode 100644 (file)
index 0000000..b09af1d
--- /dev/null
@@ -0,0 +1,64 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                  GNAT.SOCKETS.THIN.SOCKET_ERROR_MESSAGE                  --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 2007-2009, AdaCore                     --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the default implementation of this unit, using the standard C
+--  library's strerror(3) function. It is used on all platforms except Windows,
+--  since on that platform socket errno values are distinct from the system
+--  ones: there is a specific variant of this function in g-socthi-mingw.adb.
+
+with Ada.Unchecked_Conversion;
+with System.CRTL;
+
+separate (GNAT.Sockets.Thin)
+function Socket_Error_Message
+  (Errno : Integer) return C.Strings.chars_ptr
+is
+   use type Interfaces.C.Strings.chars_ptr;
+
+   pragma Warnings (Off);
+   function To_Chars_Ptr is
+     new Ada.Unchecked_Conversion
+       (System.Address, Interfaces.C.Strings.chars_ptr);
+   --  On VMS, the compiler warns because System.Address is 64 bits, but
+   --  chars_ptr is 32 bits. It should be safe, though, because strerror
+   --  will return a 32-bit pointer.
+   pragma Warnings (On);
+
+   C_Msg : C.Strings.chars_ptr;
+
+begin
+   C_Msg := To_Chars_Ptr (System.CRTL.strerror (Errno));
+   if C_Msg = C.Strings.Null_Ptr then
+      return Unknown_System_Error;
+   else
+      return C_Msg;
+   end if;
+end Socket_Error_Message;
diff --git a/gcc/ada/s-commun.adb b/gcc/ada/s-commun.adb
new file mode 100644 (file)
index 0000000..79d74ec
--- /dev/null
@@ -0,0 +1,53 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                 S Y S T E M . C O M M U N I C A T I O N                  --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 2001-2009, AdaCore                     --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body System.Communication is
+
+   subtype SEO is Ada.Streams.Stream_Element_Offset;
+
+   ----------------
+   -- Last_Index --
+   ----------------
+
+   function Last_Index
+     (First : Ada.Streams.Stream_Element_Offset;
+      Count : C.int) return Ada.Streams.Stream_Element_Offset
+   is
+      use type Ada.Streams.Stream_Element_Offset;
+   begin
+      if First = SEO'First and then Count = 0 then
+         return SEO'Last;
+      else
+         return First + SEO (Count - 1);
+      end if;
+   end Last_Index;
+
+end System.Communication;
diff --git a/gcc/ada/s-commun.ads b/gcc/ada/s-commun.ads
new file mode 100644 (file)
index 0000000..84f6665
--- /dev/null
@@ -0,0 +1,51 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                 S Y S T E M . C O M M U N I C A T I O N                  --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                     Copyright (C) 2001-2009, AdaCore                     --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Common support unit for GNAT.Sockets and GNAT.Serial_Communication
+
+with Ada.Streams;
+with Interfaces.C;
+
+package System.Communication is
+
+   package C renames Interfaces.C;
+
+   use type C.int;
+
+   function Last_Index
+     (First : Ada.Streams.Stream_Element_Offset;
+      Count : C.int) return Ada.Streams.Stream_Element_Offset;
+   --  Compute the Last OUT parameter for the various Read / Receive
+   --  subprograms: returns First + Count - 1, except for the case
+   --  where First = Stream_Element_Offset'First and Res = 0, in which
+   --  case Stream_Element_Offset'Last is returned instead.
+
+end System.Communication;