From 64a7bc13d614b1f396e0712203813b5c1bba51a5 Mon Sep 17 00:00:00 2001
From: Pierre Muller <pierre@freepascal.org>
Date: Sun, 10 Sep 2023 11:11:31 +0000
Subject: [PATCH] Try several ports before failing

---
 tests/tbs/tb0524.pp | 180 +++++++++++++++++++++++++++++++++-----------
 1 file changed, 134 insertions(+), 46 deletions(-)

diff --git a/tests/tbs/tb0524.pp b/tests/tbs/tb0524.pp
index c01247957c..e7806a4a3a 100644
--- a/tests/tbs/tb0524.pp
+++ b/tests/tbs/tb0524.pp
@@ -4,8 +4,15 @@ program tb0524;
 uses sockets,baseunix,sysutils;
 
 
-const port=6667;
+const default_port=6667;
    textfile = 'tb0524.txt';
+{$ifdef debug}
+   verbose = true;
+{$else}
+   verbose = false;
+{$endif}
+var
+   used_port : word;
 
 procedure reset_textfile;
 var
@@ -32,13 +39,43 @@ function server_failed : boolean;
 var
   f : text;
   st : string;
+  retry : boolean;
 begin
   server_failed:=false;
   assign(f,textfile);
-  reset(f);
-  readln(f,st);
-  if pos('Server startup failed',st)=1 then
-    server_failed:=true;
+  retry:=true;
+  while retry do
+    begin
+      reset(f);
+      readln(f,st);
+      if pos('Server startup failed',st)=1 then
+        begin
+          server_failed:=true;
+          exit;
+        end;
+      if pos('port=',st)=1 then
+        begin
+          val(copy(st,length('port=')+1,length(st)),used_port);
+          writeln('Server started at port ',used_port);
+          retry:=false;
+        end
+      else
+        begin
+          sleep(1000);
+          retry:=true;
+        end;
+      close(f);
+    end;
+end;
+
+procedure write_server_port(used_port : word);
+var
+  f : text;
+begin
+  assign(f,textfile);
+  rewrite(f);
+  writeln(f,'port=',used_port);
+  writeln('Using port ',used_port);
   close(f);
 end;
 
@@ -50,7 +87,11 @@ var s,t:string;
     len:longInt;
     sin,sout:text;
     i:byte;
-
+    port : word;
+    server_started : boolean;
+    attempt_count : longint;
+const
+    max_attempt_count = 50;
 begin
    reset_textfile;
    lsock:=fpsocket(af_inet,sock_stream,0);
@@ -60,46 +101,84 @@ begin
        stop(1);
      end;
 
-  with saddr do
+  port:=default_port-1;
+  attempt_count:=0;
+  server_started:=false;
+  while (attempt_count<max_attempt_count) and not server_started do
     begin
-      sin_family:=af_inet;
-      sin_port:=ntobe(word(6667));
-      sin_addr:=NoAddress;
-   end;
+      inc(port);
+      if verbose then
+        writeln('Trying to use port ',port,' to start the server');
+      inc(attempt_count);
+      with saddr do
+        begin
+          sin_family:=af_inet;
+          sin_port:=ntobe(port);
+          sin_addr:=NoAddress;
+       end;
 
-  if  fpbind(lsock,@saddr,sizeof(saddr))<>0 then
-    begin
-      writeln('bind call error:',socketerror);
-      stop(1);
+      if fpbind(lsock,@saddr,sizeof(saddr))<>0 then
+        if attempt_count<max_attempt_count then
+          begin
+            writeln('bind call error:',socketerror);
+            continue;
+          end
+        else
+          begin
+            writeln('bind call error:',socketerror);
+            stop(1);
+          end;
+      if verbose then
+        writeln('fpbind OK for port ',port);
+
+      if fplisten(lsock,1)<>0 then
+        if attempt_count<max_attempt_count then
+          begin
+            writeln('listen call error:',socketerror);
+            continue;
+          end
+        else
+          begin
+            writeln('listen call error:',socketerror);
+            stop(1);
+         end;
+      if verbose then
+        writeln('fplisten OK for port ',port);
+      write_server_port(port);
+      server_started:=true;
+
+      len:=sizeof(saddr);
+      usock:=fpaccept(lsock,@saddr,@len);
+      if usock=-1 then
+        if attempt_count<max_attempt_count then
+          begin
+            writeln('accept call error:',SocketError);
+            continue;
+          end
+        else
+          begin
+            writeln('accept call error:',SocketError);
+            stop(1);
+          end;
+      if verbose then
+        writeln('fpaccept OK for port ',port);
+      sock2text(usock,sin,sout);
+
+      reset(sin);
+      rewrite(sout);
+      repeat
+        readln(sin,s);
+        t:='';
+        for i:=length(s) downto 1 do
+          t:=t+s[i];
+        writeln(sout,t);
+      until eof(sin);
+      close(sin);
+      close(sout);
+      fpshutdown(usock,2);
     end;
-
-  if  fplisten(lsock,1)<>0 then
-    begin
-      writeln('listen call error:',socketerror);
-      stop(1);
-    end;
-
-  len:=sizeof(saddr);
-  usock:=fpaccept(lsock,@saddr,@len);
-  if usock=-1 then
-    begin
-      writeln('accept call error:',SocketError);
-      stop(1);
-    end;
-  sock2text(usock,sin,sout);
-
-  reset(sin);
-  rewrite(sout);
-  repeat
-    readln(sin,s);
-    t:='';
-    for i:=length(s) downto 1 do
-      t:=t+s[i];
-    writeln(sout,t);
-  until eof(sin);
-  close(sin);
-  close(sout);
-  fpshutdown(usock,2);
+   if verbose then
+     writeln('Server at port ',port,' ending without error');
 end;
 
 procedure do_client;
@@ -112,7 +191,7 @@ var s:sizeint;
 begin
    s:=fpsocket(af_inet,sock_stream,0);
    saddr.sin_family:=af_inet;
-   saddr.sin_port:=htons(port);
+   saddr.sin_port:=htons(used_port);
    saddr.sin_addr.s_addr:=hosttonet($7f000001); {127.0.0.1}
    if not connect(s,saddr,sin,sout) then
      begin
@@ -122,17 +201,26 @@ begin
    writeln(sout,'abcd');
    readln(sin,str);
    if str<>'dcba' then
-     halt(1);
+     begin
+       writeln('Expecting dcba, but got ',str);
+       halt(1);
+     end;
    writeln(sout,'1234');
    readln(sin,str);
    if str<>'4321' then
-     halt(1);
+     begin
+       writeln('Expecting 4321, but got ',str);
+       halt(1);
+     end;
    close(sin);
    close(sout);
    fpshutdown(s,2);
+   if verbose then
+     writeln('Client at port ',used_port,' ending without error');
 end;
 
 begin
+  used_port:=default_port;
   if fpfork=0 then
     do_server
   else