[fpc-pascal] exceptions

[Rainer Stratmann]

Shrinked down example of the program.
Rainer

program serverclient;

uses
     baseunix ,
     sockets,
     crt;

const port_program = 12021;

procedure memclr( p : pointer ; len : longint );
var x : longint;
begin
 for x := 1 to len do begin
  byte( p^ ) := 0;
  inc( p );
 end;
end;

procedure setsockaddr( var sa : tsockaddr ; adr : string ; port : longint );
begin
 memclr( @sa , sizeof( sa ) );
 sa.sin_family := AF_INET;
 sa.sin_addr   := strtonetaddr( adr );
 sa.sin_port   := htons( port );
end;

procedure setnonblockingsocket( s : integer );
var  arg : longint;
begin
  arg := fpfcntl( s , F_GETFL );
  if arg >= 0 then begin
   arg := arg or O_NONBLOCK;
   fpfcntl( s , F_SETFL , arg );
  end;
end;

procedure ip_client( ipadress : string );
var
 inetaddr_client_remote : tsockaddr;
 c_socket : integer;
 c : longint;
begin
 setsockaddr( inetaddr_client_remote , ipadress , port_program );
 c_socket := fpsocket( PF_INET , SOCK_STREAM , 0 );
 if c_socket >= 0 then begin
   writeln( 'open socket' );
   setnonblockingsocket( c_socket ); // nonblocking connect call

   repeat
     c := fpconnect( c_socket , @inetaddr_client_remote , 
sizeof( inetaddr_client_remote ) );
   until c = 0;
   writeln( 'connected' );

   crt.delay( 1000 );

   closesocket( c_socket );
   writeln( 'closed' );
 end;
end;

procedure ip_server;
var
  inetaddr_server_bind   : tsockaddr;
  inetaddr_server_accept : tsockaddr;
  alength : integer;
  l : longint;
  c : byte = 0;
  s_socket     : integer;
  s_acc_socket : integer;
  s_bind       : longint;
  s_listen     : longint;
begin
    clrscr;
    s_socket := fpsocket( PF_INET , SOCK_STREAM , 0 );
    if s_socket <> -1 then begin
      setnonblockingsocket( s_socket );
      setsockaddr( inetaddr_server_bind , '' , port_program );
      s_bind := fpbind( s_socket , @inetaddr_server_bind , 
sizeof( inetaddr_server_bind ) );
      if s_bind <> -1 then begin
        s_listen := fplisten( s_socket , 0 ); // socket , warteschlange
        if s_listen = 0 then begin
          alength := sizeof( inetaddr_server_accept );
          repeat
            // wait for incoming connection
            s_acc_socket := fpaccept( s_socket , @inetaddr_server_accept , 
@alength );
            write( '.' );
            delay( 300 ); // little delay
          until ( s_acc_socket >= 0 ) or keypressed;
          if s_acc_socket >= 0 then begin
            repeat

              // Exception
              l := fpsend( s_acc_socket , @c , sizeof( c ) , 0 );
              // Exception

              write( '*' ); // <- this does NOT making the exception
              delay( 300 ); // little delay
            until keypressed;
            closesocket( s_acc_socket );
          end;
        end;
      end;
    end;
end;

const
 server = true;
// server = false;

begin
  if server then ip_server
            else ip_client ( '192.168.178.21' ); // ip address of the server
end.




Am Mittwoch, 27. Mai 2009 20:53 schrieb Jonas Maebe:
> On 27 May 2009, at 19:24, Rainer Stratmann wrote:
> > Am Mittwoch, 27. Mai 2009 11:45 schrieb Vincent Snijders:
> >> Rainer Stratmann schreef:
> >>> Am Dienstag, 26. Mai 2009 22:27 schrieb Jonas Maebe:
> >>>> Well, as I said: it does not raise any exceptions.
> >>>
> >>> Would it be possible to catch that exception?
> >>> With the try except block?
> >>> Are other functions existing to catch linux exceptions?
> >>
> >> No, you cannot catch exception that are not raised.
> >
> > What does 'raised' exactly mean?
>
> http://www.freepascal.org/docs-html/ref/refse73.html
>
> Please provide a compilable sample that demonstrates the problem you
> are having. I'm guessing you can "solve" it by adding the sysutils
> unit to your uses clause (because currently you're probably getting a
> plain run time error, and using the sysutils unit means that it will
> be converted into an exception that you can catch), but that would
> just be a hack. You probably also would have to put the try/catch
> around the next debugging writeln, and not around the send() call to
> catch the exception (because send() does not cause any inoutres
> checks, but writeln() does)
>
> I really have no idea how the error result of send() could end up in
> inoutres though (which is, I think, the only way that could cause the
> RTL to produce a run time error in response to a failed send() call).
> There are variants of the socket routines that work on text files and
> that do set inoutres, but send() is not one of them.
>
> So please, provide source code (even if some hack seems to solve the
> problem) so we don't have to send 10 more mails guessing about what
> you might be doing and what might be going wrong.
>
>
> Jonas
> _______________________________________________
> fpc-pascal maillist  -  fpc-pascal at lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal