From: anh_vo@udlp.com (Anh_Vo)
Subject: Possible bug / need confirmation
Date: 10 Jun 2002 17:00:36 -0700
Date: 2002-06-11T00:00:36+00:00 [thread overview]
Message-ID: <5a59d6a9.0206101600.63f1e042@posting.google.com> (raw)
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 <sam@inf.enst.fr>
--
--
--
-----------------------------------------------------------------------------
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 <sam@inf.enst.fr>
--
--
--
-----------------------------------------------------------------------------
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 <sam@inf.enst.fr>
--
--
--
-- 25 May 2001 - Anh Vo <anh_vo@udlp.com>
--
--
--
-- 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;
next reply other threads:[~2002-06-11 0:00 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2002-06-11 0:00 Anh_Vo [this message]
2002-06-11 5:36 ` Possible bug / need confirmation Simon Wright
2002-06-11 20:21 ` Anh_Vo
2002-06-11 20:39 ` Simon Wright
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox