Test engine: experimental change to avoid busy port problems.

tests/support/server.tcl

@@ -141,6 +141,18 @@ proc tags {tags code} {
     uplevel 1 $code
     set ::tags [lrange $::tags 0 end-[llength $tags]]
 }
+
+# Write the configuration in the dictionary 'config' in the specified
+# file name.
+proc create_server_config_file {filename config} {
+    set fp [open $filename w+]
+    foreach directive [dict keys $config] {
+        puts -nonewline $fp "$directive "
+        puts $fp [dict get $config $directive]
+    }
+    close $fp
+}
+
 proc start_server {options {code undefined}} {
     # If we are running against an external server, we just push the
     # host/port pair in the stack the first time
@@ -222,16 +234,18 @@ proc start_server {options {code undefined}} {
 
     # write new configuration to temporary file
     set config_file [tmpfile redis.conf]
-    set fp [open $config_file w+]
+    create_server_config_file $config_file $config
-    foreach directive [dict keys $config] {
-        puts -nonewline $fp "$directive "
-        puts $fp [dict get $config $directive]
-    }
-    close $fp
 
     set stdout [format "%s/%s" [dict get $config "dir"] "stdout"]
     set stderr [format "%s/%s" [dict get $config "dir"] "stderr"]
 
+    # We need a loop here to retry with different ports.
+    set server_started 0
+    while {$server_started == 0} {
+        if {$::verbose} {
+            puts -nonewline "=== ($tags) Starting server ${::host}:${::port} "
+        }
+
         send_data_packet $::test_server_fd "server-spawning" "port $::port"
 
         if {$::valgrind} {
@@ -249,8 +263,43 @@ proc start_server {options {code undefined}} {
         # ugly but tries to be as fast as possible...
         if {$::valgrind} {set retrynum 1000} else {set retrynum 100}
 
-    if {$::verbose} {
+        # Wait for actual startup
-        puts -nonewline "=== ($tags) Starting server ${::host}:${::port} "
+        set checkperiod 100; # Milliseconds
+        set maxiter [expr {120*1000/100}] ; # Wait up to 2 minutes.
+        set port_busy 0
+        while {![info exists _pid]} {
+            regexp {PID:\s(\d+)} [exec cat $stdout] _ _pid
+            after $checkperiod
+            incr maxiter -1
+            if {$maxiter == 0} {
+                start_server_error $config_file "No PID detected in log $stdout"
+                puts "--- LOG CONTENT ---"
+                puts [exec cat $stdout]
+                puts "-------------------"
+                break
+            }
+
+            # Check if the port is actually busy and the server failed
+            # for this reason.
+            if {[regexp {Could not create server TCP} [exec cat $stdout]]} {
+                set port_busy 1
+                break
+            }
+        }
+
+        # Sometimes we have to try a different port, even if we checked
+        # for availability. Other test clients may grab the port before we
+        # are able to do it for example.
+        if {$port_busy} {
+            puts "Port $::port was already busy, trying another port..."
+            set ::port [find_available_port [expr {$::port+1}]]
+            if {$::tls} {
+                dict set config "tls-port" $::port
+            } else {
+                dict set config port $::port
+            }
+            create_server_config_file $config_file $config
+            continue; # Try again
         }
 
         if {$code ne "undefined"} {
@@ -269,21 +318,7 @@ proc start_server {options {code undefined}} {
             start_server_error $config_file $err
             return
         }
-
+        set server_started 1
-    # Wait for actual startup
-    set checkperiod 100; # Milliseconds
-    set maxiter [expr {120*1000/100}] ; # Wait up to 2 minutes.
-    while {![info exists _pid]} {
-        regexp {PID:\s(\d+)} [exec cat $stdout] _ _pid
-        after $checkperiod
-        incr maxiter -1
-        if {$maxiter == 0} {
-            start_server_error $config_file "No PID detected in log $stdout"
-            puts "--- LOG CONTENT ---"
-            puts [exec cat $stdout]
-            puts "-------------------"
-            break
-        }
     }
 
     # setup properties to be able to initialize a client object