From a6a27f56f2df1a9da3d46aea1fca6e33a89e3f61 Mon Sep 17 00:00:00 2001
From: "debing.sun" <debing.sun@redis.com>
Date: Mon, 30 Mar 2026 19:50:47 +0800
Subject: [PATCH] Test tcp deadlock fixes (#14946)

This fix follows #14667 and #14886

Several tests pipelined large numbers of commands on deferring clients
without draining replies. That can fill buffers and stall progress.

Fix by draining replies every 500 pipelined requests to avoid TCP
stalls.

---------

Co-authored-by: oranagra <oran@redislabs.com>
---
 .../cluster/tests/17-diskless-load-swapdb.tcl |  9 +++++---
 tests/helpers/gen_write_load.tcl              | 23 +++++++++++++++++--
 tests/unit/memefficiency.tcl                  | 13 +++++++----
 tests/unit/type/set.tcl                       | 10 +++++++-
 4 files changed, 44 insertions(+), 11 deletions(-)

diff --git a/tests/cluster/tests/17-diskless-load-swapdb.tcl b/tests/cluster/tests/17-diskless-load-swapdb.tcl
index cb81b9fdb..b25db3930 100644
--- a/tests/cluster/tests/17-diskless-load-swapdb.tcl
+++ b/tests/cluster/tests/17-diskless-load-swapdb.tcl
@@ -54,9 +54,12 @@ test "Main db not affected when fail to diskless load" {
     set rd [redis_deferring_client redis $master_id]
     for {set j 0} {$j < $num} {incr j} {
         $rd set $j $value
-    }
-    for {set j 0} {$j < $num} {incr j} {
-        $rd read
+
+        if {($j + 1) % 500 == 0} {
+            for {set i 0} {$i < 500} {incr i} {
+                $rd read
+            }
+        }
     }
 
     # Start the replica again
diff --git a/tests/helpers/gen_write_load.tcl b/tests/helpers/gen_write_load.tcl
index 7b4975c61..60d954e5d 100644
--- a/tests/helpers/gen_write_load.tcl
+++ b/tests/helpers/gen_write_load.tcl
@@ -22,13 +22,18 @@ proc gen_write_load {host port seconds tls {key ""} {size 0} {sleep 0}} {
     set start_time [clock seconds]
     set r [redis $host $port 1 $tls]
     $r client setname LOAD_HANDLER
-    catch {$r select 9} ;# select 9 will fail in cluster mode
+    $r read
+    catch {
+        $r select 9
+        $r read
+    } ;# select 9 will fail in cluster mode
 
     # fixed size value
     if {$size != 0} {
         set value [string repeat "x" $size]
     }
 
+    set count 0
     while 1 {
         if {$size == 0} {
             set value [expr rand()]
@@ -39,13 +44,27 @@ proc gen_write_load {host port seconds tls {key ""} {size 0} {sleep 0}} {
         } else {
             $r set $key $value
         }
+        
+        incr count
+        if {$count % 500 == 0} {
+            for {set i 0} {$i < 500} {incr i} {
+                $r read
+            }
+        }
+
         if {[clock seconds]-$start_time > $seconds} {
-            exit 0
+            break
         }
         if {$sleep ne 0} {
             after $sleep
         }
     }
+    
+    # Read remaining replies
+    for {set i 0} {$i < $count} {incr i} {
+        $r read
+    }
+    exit 0
 }
 
 gen_write_load [lindex $argv 0] [lindex $argv 1] [lindex $argv 2] [lindex $argv 3] [lindex $argv 4] [lindex $argv 5] [lindex $argv 6]
diff --git a/tests/unit/memefficiency.tcl b/tests/unit/memefficiency.tcl
index 6be0ed69d..0ab12c6c7 100644
--- a/tests/unit/memefficiency.tcl
+++ b/tests/unit/memefficiency.tcl
@@ -24,9 +24,12 @@ proc test_memory_efficiency {range} {
         incr written [string length $key]
         incr written [string length $val]
         incr written 2 ;# A separator is the minimum to store key-value data.
-    }
-    for {set j 0} {$j < 10000} {incr j} {
-        $rd read ; # Discard replies
+        
+        if {($j + 1) % 500 == 0} {
+            for {set i 0} {$i < 500} {incr i} {
+                $rd read ; # Discard replies
+            }
+        }
     }
 
     set current_mem [s used_memory]
@@ -352,7 +355,7 @@ run_solo {defrag} {
             # create big keys with 10k items
             # Use batching to avoid TCP deadlock
             set rd [redis_deferring_client]
-            set batch_size 1000
+            set batch_size 100
             for {set j 0} {$j < 10000} {incr j} {
                 $rd hset bighash $j [concat "asdfasdfasdf" $j]
                 $rd lpush biglist [concat "asdfasdfasdf" $j]
@@ -937,7 +940,7 @@ run_solo {defrag} {
                 $rd lpush biglist2 $val
 
                 incr count
-                discard_replies_every $rd $count 10000 20000
+                discard_replies_every $rd $count 1000 2000
             }
 
             # create some fragmentation
diff --git a/tests/unit/type/set.tcl b/tests/unit/type/set.tcl
index ae315844d..5c3805643 100644
--- a/tests/unit/type/set.tcl
+++ b/tests/unit/type/set.tcl
@@ -1027,10 +1027,18 @@ foreach type {single multiple single_multiple} {
             }
         }
         r deferred 1
+        set count 0
         foreach m $members {
             r srem $myset $m
+            incr count
+            if {$count == 500} {
+                for {set i 0} {$i < 500} {incr i} {
+                    r read
+                }
+                set count 0
+            }
         }
-        foreach m $members {
+        for {set i 0} {$i < $count} {incr i} {
             r read
         }
         r deferred 0