From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00, T_FILL_THIS_FORM_SHORT autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII X-Google-Thread: 103376,1b5461f2b5a9bccb,start X-Google-Attributes: gid103376,public X-Google-ArrivalTime: 2002-06-10 17:00:38 PST Path: archiver1.google.com!postnews1.google.com!not-for-mail From: anh_vo@udlp.com (Anh_Vo) Newsgroups: comp.lang.ada Subject: Possible bug / need confirmation Date: 10 Jun 2002 17:00:36 -0700 Organization: http://groups.google.com/ Message-ID: <5a59d6a9.0206101600.63f1e042@posting.google.com> NNTP-Posting-Host: 65.168.132.64 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 8bit X-Trace: posting.google.com 1023753636 9185 127.0.0.1 (11 Jun 2002 00:00:36 GMT) X-Complaints-To: groups-abuse@google.com NNTP-Posting-Date: 11 Jun 2002 00:00:36 GMT Xref: archiver1.google.com comp.lang.ada:25712 Date: 2002-06-11T00:00:36+00:00 List-Id: The codes below causes Program_Error, EXCEPTION_ACCESS_VIOLATION, under Windows 2K and Constrain_Error, SIGSEGV, under Solaris when compiled with GNAT-3.14p. Any one having GNAT 3.15 or later, please check if this problem has been corrected. In addition, the exact error message are included also. If confirmed, I will submit a bug report. Thanks in advance for your help. Anh Vo gcc -c phone.adb +===========================GNAT BUG DETECTED==============================+ | 3.14p (20010503) (sparc-sun-solaris2.5.1) Constraint_Error SIGSEGV | | Error detected at phone.adb:113:57 | | Please submit bug report by email to report@gnat.com. | | Include the entire contents of this bug box in the report. | | Include the exact gcc or gnatmake command that you entered. | | Also include sources listed below in gnatchop format | | (concatenated together with no headers between files). | | (use plain ASCII or MIME attachment). | | See gnatinfo.txt for full info on procedure for submitting bugs. | +==========================================================================+ Please include these source files with error report phone.adb sockets.ads sockets-stream_io.ads GNAT 3.14p (20010503) Copyright 1992-2001 Free Software Foundation, Inc. Compiling: c:\ada_95\bugs\gnat\3.14\phone.adb (source file time stamp: 2002-06-10 23:30:46) +===========================GNAT BUG DETECTED==============================+ | 3.14p (20010503) (i586-pc-mingw32msv) Program_Error EXCEPTION_ACCESS_VIOLATION| | Error detected at c:\ada_95\bugs\gnat\3.14\phone.adb:113:57 | | Please submit bug report by email to report@gnat.com. | | Include the entire contents of this bug box in the report. | | Include the exact gcc or gnatmake command that you entered. | | Also include sources listed below in gnatchop format | | (concatenated together with no headers between files). | | (use plain ASCII or MIME attachment). | | See gnatinfo.txt for full info on procedure for submitting bugs. | +==========================================================================+ Please include these source files with error report c:\ada_95\bugs\gnat\3.14\phone.adb c:\ada_95\bugs\gnat\3.14\sockets.ads c:\ada_95\bugs\gnat\3.14\sockets-stream_io.ads ----------------------------------------------------------------------------- -- -- -- ADASOCKETS COMPONENTS -- -- -- -- S O C K E T S -- -- -- -- S p e c -- -- -- -- $ReleaseVersion: 0.1.6 $ -- -- -- -- Copyright (C) 1998-2000 -- -- �cole Nationale Sup�rieure des T�l�communications -- -- -- -- AdaSockets is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by -- -- the Free Software Foundation; either version 2, or (at your option) -- -- any later version. AdaSockets is distributed in the hope that it -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- See the GNU General Public License for more details. You should -- -- have received a copy of the GNU General Public License distributed -- -- with AdaSockets; see file COPYING. If not, write to the Free -- -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- -- 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from -- -- this unit, or you link this unit with other files to produce an -- -- executable, this unit does not by itself cause the resulting -- -- executable to be covered by the GNU General Public License. This -- -- exception does not however invalidate any other reasons why the -- -- executable file might be covered by the GNU Public License. -- -- -- -- The main repository for this software is located at: -- -- http://www.infres.enst.fr/ANC/ -- -- -- -- If you have any question, please send a mail to -- -- Samuel Tardieu -- -- -- ----------------------------------------------------------------------------- with Ada.Streams; with Interfaces.C; package Sockets is type Socket_FD is tagged private; -- A socket type Socket_Domain is (AF_INET); -- AF_INET: Internet sockets (yes, should be PF_INET, but they hold the -- same value) type Socket_Type is (SOCK_STREAM, SOCK_DGRAM); -- SOCK_STREAM: Stream mode (TCP) -- SOCK_DGRAM: Datagram mode (UDP, Multicast) procedure Socket (Sock : out Socket_FD; Domain : in Socket_Domain := AF_INET; Typ : in Socket_Type := SOCK_STREAM); -- Create a socket of the given mode Connection_Refused : exception; procedure Connect (Socket : in Socket_FD; Host : in String; Port : in Positive); -- Connect a socket on a given host/port. Raise Connection_Refused if -- the connection has not been accepted by the other end. procedure Bind (Socket : in Socket_FD; Port : in Natural; Host : in String := ""); -- Bind a socket on a given port. Using 0 for the port will tell the -- OS to allocate a non-privileged free port. The port can be later -- retrieved using Get_Sock_Port on the bound socket. -- If Host is not the empty string, it is used to designate the interface -- to bind on. procedure Listen (Socket : in Socket_FD; Queue_Size : in Positive := 5); -- Create a socket's listen queue type Socket_Level is (SOL_SOCKET, IPPROTO_IP); type Socket_Option is (SO_REUSEADDR, IP_MULTICAST_TTL, IP_ADD_MEMBERSHIP, IP_DROP_MEMBERSHIP, IP_MULTICAST_LOOP); procedure Setsockopt (Socket : in Socket_FD'Class; Level : in Socket_Level := SOL_SOCKET; Optname : in Socket_Option; Optval : in Integer); -- Set a socket option generic Level : Socket_Level; Optname : Socket_Option; type Opt_Type is private; procedure Customized_Setsockopt (Socket : in Socket_FD'Class; Optval : in Opt_Type); -- Low level control on setsockopt procedure Accept_Socket (Socket : in Socket_FD; New_Socket : out Socket_FD); -- Accept a connection on a socket Connection_Closed : exception; procedure Send (Socket : in Socket_FD; Data : in Ada.Streams.Stream_Element_Array); -- Send data on a socket. Raise Connection_Closed if the socket -- has been closed. function Receive (Socket : Socket_FD; Max : Ada.Streams.Stream_Element_Count := 4096) return Ada.Streams.Stream_Element_Array; -- Receive data from a socket. May raise Connection_Closed procedure Receive (Socket : in Socket_FD'Class; Data : out Ada.Streams.Stream_Element_Array); -- Get data from a socket. Raise Connection_Closed if the socket has -- been closed before the end of the array. procedure Receive_Some (Socket : in Socket_FD'Class; Data : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset); -- Get some data from a socket. The index of the last element will -- be placed in Last. type Shutdown_Type is (Receive, Send, Both); procedure Shutdown (Socket : in out Socket_FD; How : in Shutdown_Type := Both); -- Close a previously opened socket procedure Socketpair (Read_End : out Socket_FD; Write_End : out Socket_FD; Domain : in Socket_Domain := AF_INET; Typ : in Socket_Type := SOCK_STREAM); -- Create a socketpair. function Get_FD (Socket : in Socket_FD) return Interfaces.C.int; -- Get a socket's FD field --------------------------------- -- String-oriented subprograms -- --------------------------------- procedure Put (Socket : in Socket_FD'Class; Str : in String); -- Send a string on the socket procedure New_Line (Socket : in Socket_FD'Class; Count : in Natural := 1); -- Send CR/LF sequences on the socket procedure Put_Line (Socket : in Socket_FD'Class; Str : in String); -- Send a string + CR/LF on the socket function Get (Socket : Socket_FD'Class) return String; -- Get a string from the socket function Get_Line (Socket : Socket_FD'Class) return String; -- Get a full line from the socket. CR is ignored and LF is considered -- as an end-of-line marker. private type Shutdown_Array is array (Receive .. Send) of Boolean; type Socket_FD is tagged record FD : Interfaces.C.int; Shutdown : Shutdown_Array; end record; end Sockets; ----------------------------------------------------------------------------- -- -- -- ADASOCKETS COMPONENTS -- -- -- -- S O C K E T S . S T R E A M _ I O -- -- -- -- S p e c -- -- -- -- $ReleaseVersion: 0.1.0 $ -- -- -- -- Copyright (C) 1998-2000 -- -- �cole Nationale Sup�rieure des T�l�communications -- -- -- -- AdaSockets is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by -- -- the Free Software Foundation; either version 2, or (at your option) -- -- any later version. AdaSockets is distributed in the hope that it -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- See the GNU General Public License for more details. You should -- -- have received a copy of the GNU General Public License distributed -- -- with AdaSockets; see file COPYING. If not, write to the Free -- -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- -- 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from -- -- this unit, or you link this unit with other files to produce an -- -- executable, this unit does not by itself cause the resulting -- -- executable to be covered by the GNU General Public License. This -- -- exception does not however invalidate any other reasons why the -- -- executable file might be covered by the GNU Public License. -- -- -- -- The main repository for this software is located at: -- -- http://www.infres.enst.fr/ANC/ -- -- -- -- If you have any question, please send a mail to -- -- Samuel Tardieu -- -- -- ----------------------------------------------------------------------------- with Ada.Streams; package Sockets.Stream_IO is type Socket_Stream_Type is new Ada.Streams.Root_Stream_Type with private; procedure Initialize (Stream : in out Socket_Stream_Type; FD : in Socket_FD); -- Initialize must be called with an opened socket as parameter before -- being used as a stream. procedure Read (Stream : in out Socket_Stream_Type; Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset); procedure Write (Stream : in out Socket_Stream_Type; Item : in Ada.Streams.Stream_Element_Array); private type Socket_Stream_Type is new Ada.Streams.Root_Stream_Type with record FD : Socket_FD; end record; end Sockets.Stream_IO; ----------------------------------------------------------------------------- -- -- -- ADASOCKETS COMPONENTS -- -- -- -- S T R E A M _ S E N D E R -- -- -- -- B o d y -- -- -- -- $ReleaseVersion: 0.1.0 $ -- -- -- -- Copyright (C) 1998-2000 -- -- cole Nationale Sup rieure des T l communications -- -- -- -- AdaSockets is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by -- -- the Free Software Foundation; either version 2, or (at your option) -- -- any later version. AdaSockets is distributed in the hope that it -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- See the GNU General Public License for more details. You should -- -- have received a copy of the GNU General Public License distributed -- -- with AdaSockets; see file COPYING. If not, write to the Free -- -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- -- 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from -- -- this unit, or you link this unit with other files to produce an -- -- executable, this unit does not by itself cause the resulting -- -- executable to be covered by the GNU General Public License. This -- -- exception does not however invalidate any other reasons why the -- -- executable file might be covered by the GNU Public License. -- -- -- -- The main repository for this software is located at: -- -- http://www.infres.enst.fr/ANC/ -- -- -- -- If you have any question, please send a mail to -- -- Samuel Tardieu -- -- -- -- 25 May 2001 - Anh Vo -- -- -- -- Based on Stream_Listener from Samuel Tardieu -- -- It allowed two people to communicate if the host name and the ip -- -- address of the communicators are known. -- -- -- ----------------------------------------------------------------------------- with Ada.Command_Line; use Ada.Command_Line; with Ada.Exceptions; use Ada.Exceptions; with Ada.Text_IO; use Ada.Text_IO; with Sockets.Stream_IO; use Sockets, Sockets.Stream_IO; with Ada.Characters.Handling; with Ada.Strings.Unbounded; procedure Phone is -- Usage: stream_sender remotehost remoteport -- Example: stream_sender localhost 5000 use Ada; use Text_Io; use Command_Line; use Characters.Handling; use Strings.Unbounded; Outgoing_Socket : Socket_FD; Stream : aliased Socket_Stream_Type; Line : String (1 .. 200); Last : Natural; Goodbye_Msg : constant String := "goodbye"; Goodbye_Ack : constant String := "byebye"; Msg_Received : Unbounded_String; task Receiver is entry Start_Receive (Msg : out Unbounded_String); end Receiver; task body Receiver is begin loop select accept Start_Receive (Msg : out Unbounded_String) do Msg := To_Unbounded_String (String'Input (Stream'Access)); -- Put_Line ("Acknowledged Message received: " & To_String (Msg)); end Start_Receive; or terminate; end select; end loop; end Receiver; begin -- Phone body -- if Argument_Count /= 2 then Raise_Exception (Constraint_Error'Identity, "Usage: " & Command_Name & " remotehost remoteport"); end if; Socket (Outgoing_Socket, AF_INET, SOCK_STREAM); Connect (Outgoing_Socket, Argument (1), Positive'Value (Argument (2))); Initialize (Stream, Outgoing_Socket); Forever: loop Put ("Type a message -> "); Flush; Get_Line (Line, Last); select String'Output (Stream'Access, Line (Line'First .. Last)); if To_Lower (Line (Line'First .. Last)) = To_Lower (Goodbye_Msg) or else To_Lower (Line (Line'First .. Last)) = To_Lower ("Quit") or else To_Lower (Line (Line'First .. Last)) = To_Lower ("Exit") or else To_Lower (Line (Line'First .. Last)) = To_Lower ("Bye") then Put_Line ("Acknowledged Message received: " & String'Input (Stream'Access)); exit Forever; end if; then abort delay 20.0; Receiver.Start_Receive (Msg_Received); Put_Line ("Last message received: " & To_String (Msg_Received)); exit; end select; select delay 20.0; Put_Line ("Phone is inactive for 20 seconds. Hand up."); String'Output (Stream'Access, "You do not respond for 20 seconds. I give up!"); String'Output (Stream'Access, Goodbye_Msg); exit; then abort Receiver.Start_Receive (Msg_Received); declare Message : constant String := To_String (Msg_Received); begin Put_Line ("Message received: " & Message); if To_Lower (Message) = To_Lower ("Goodbye") or else To_Lower (Message) = To_Lower ("Bye") or else To_Lower (Message) = To_Lower ("Quit") or else To_Lower (Message) = To_Lower ("Exit") then String'Output (Stream'Access, Goodbye_Ack); return; end if; end; end select; end loop Forever; begin Shutdown (Outgoing_Socket, Both); exception when Connection_Closed => null; -- expected if other side dropped out end; exception when Error : others => Put_Line ("Communication problem with the reason of: " & Exceptions.Exception_Information (Error)); Put_Line ("Run again."); end Phone;