From e4d0ba933dea478a327f39bc42758294ee802f30 Mon Sep 17 00:00:00 2001
From: Yossi Gottlieb <yossigo@gmail.com>
Date: Sun, 17 Jan 2021 15:48:48 +0200
Subject: [PATCH] Add io-thread daily CI tests. (#8232)

This adds basic coverage to IO threads by running the cluster and few selected Redis test suite tests with the IO threads enabled.

Also provides some necessary additional improvements to the test suite:

* Add --config to sentinel/cluster tests for arbitrary configuration.
* Fix --tags whitelisting which was broken.
* Add a `network` tag to some tests that are more network intensive. This is work in progress and more tests should be properly tagged in the future.
---
 .github/workflows/daily.yml           | 17 ++++++++
 tests/instances.tcl                   |  9 +++++
 tests/integration/rdb.tcl             |  4 ++
 tests/integration/redis-benchmark.tcl |  2 +-
 tests/integration/replication-4.tcl   |  2 +-
 tests/integration/replication.tcl     |  2 +-
 tests/support/server.tcl              | 56 ++++++++++++++++++++-------
 tests/unit/limits.tcl                 |  2 +-
 tests/unit/pause.tcl                  |  2 +-
 tests/unit/protocol.tcl               |  2 +-
 tests/unit/pubsub.tcl                 |  2 +-
 tests/unit/scan.tcl                   |  2 +-
 tests/unit/tracking.tcl               |  2 +-
 tests/unit/wait.tcl                   |  2 +-
 14 files changed, 81 insertions(+), 25 deletions(-)

diff --git a/.github/workflows/daily.yml b/.github/workflows/daily.yml
index 028c44e0c..cfbf24f87 100644
--- a/.github/workflows/daily.yml
+++ b/.github/workflows/daily.yml
@@ -99,6 +99,23 @@ jobs:
         ./runtest-cluster --tls
         ./runtest-cluster
 
+  test-ubuntu-io-threads:
+    runs-on: ubuntu-latest
+    if: github.repository == 'redis/redis'
+    timeout-minutes: 14400
+    steps:
+    - uses: actions/checkout@v2
+    - name: make
+      run: |
+        make
+    - name: test
+      run: |
+        sudo apt-get install tcl8.5 tcl-tls
+        ./runtest --config io-threads 4 --config io-threads-do-reads yes --accurate --verbose --tags network
+    - name: cluster tests
+      run: |
+        ./runtest-cluster --config io-threads 4 --config io-threads-do-reads yes
+
   test-valgrind:
     runs-on: ubuntu-latest
     if: github.repository == 'redis/redis'
diff --git a/tests/instances.tcl b/tests/instances.tcl
index a9cc01008..18eb1a402 100644
--- a/tests/instances.tcl
+++ b/tests/instances.tcl
@@ -24,6 +24,7 @@ set ::simulate_error 0
 set ::failed 0
 set ::sentinel_instances {}
 set ::redis_instances {}
+set ::global_config {}
 set ::sentinel_base_port 20000
 set ::redis_base_port 30000
 set ::redis_port_count 1024
@@ -92,6 +93,9 @@ proc spawn_instance {type base_port count {conf {}}} {
         foreach directive $conf {
             puts $cfg $directive
         }
+        dict for {name val} $::global_config {
+            puts $cfg "$name $val"
+        }
         close $cfg
 
         # Finally exec it and remember the pid for later cleanup.
@@ -239,6 +243,10 @@ proc parse_options {} {
                 -certfile "$::tlsdir/client.crt" \
                 -keyfile "$::tlsdir/client.key"
             set ::tls 1
+        } elseif {$opt eq {--config}} {
+            set val2 [lindex $::argv [expr $j+2]]
+            dict set ::global_config $val $val2
+            incr j 2
         } elseif {$opt eq "--help"} {
             puts "--single <pattern>      Only runs tests specified by pattern."
             puts "--dont-clean            Keep log files on exit."
@@ -246,6 +254,7 @@ proc parse_options {} {
             puts "--fail                  Simulate a test failure."
             puts "--valgrind              Run with valgrind."
             puts "--tls                   Run tests in TLS mode."
+            puts "--config <k> <v>        Extra config argument(s)."
             puts "--help                  Shows this help."
             exit 0
         } else {
diff --git a/tests/integration/rdb.tcl b/tests/integration/rdb.tcl
index 99495b2b7..a89221197 100644
--- a/tests/integration/rdb.tcl
+++ b/tests/integration/rdb.tcl
@@ -1,3 +1,5 @@
+tags {"rdb"} {
+
 set server_path [tmpdir "server.rdb-encoding-test"]
 
 # Copy RDB with different encodings in server path
@@ -289,3 +291,5 @@ start_server {overrides {save ""}} {
     }
 }
 } ;# system_name
+
+} ;# tags
diff --git a/tests/integration/redis-benchmark.tcl b/tests/integration/redis-benchmark.tcl
index 5a4f09952..3684d7c3b 100644
--- a/tests/integration/redis-benchmark.tcl
+++ b/tests/integration/redis-benchmark.tcl
@@ -5,7 +5,7 @@ proc cmdstat {cmd} {
     return [cmdrstat $cmd r]
 }
 
-start_server {tags {"benchmark"}} {
+start_server {tags {"benchmark network"}} {
     start_server {} {
         set master_host [srv 0 host]
         set master_port [srv 0 port]
diff --git a/tests/integration/replication-4.tcl b/tests/integration/replication-4.tcl
index 8071c4f97..c867001b8 100644
--- a/tests/integration/replication-4.tcl
+++ b/tests/integration/replication-4.tcl
@@ -1,4 +1,4 @@
-start_server {tags {"repl"}} {
+start_server {tags {"repl network"}} {
     start_server {} {
 
         set master [srv -1 client]
diff --git a/tests/integration/replication.tcl b/tests/integration/replication.tcl
index 6c437ba71..8d09c68c1 100644
--- a/tests/integration/replication.tcl
+++ b/tests/integration/replication.tcl
@@ -5,7 +5,7 @@ proc log_file_matches {log pattern} {
     string match $pattern $content
 }
 
-start_server {tags {"repl"}} {
+start_server {tags {"repl network"}} {
     set slave [srv 0 client]
     set slave_host [srv 0 host]
     set slave_port [srv 0 port]
diff --git a/tests/support/server.tcl b/tests/support/server.tcl
index 77ba31d84..0d36d46be 100644
--- a/tests/support/server.tcl
+++ b/tests/support/server.tcl
@@ -152,20 +152,48 @@ proc server_is_up {host port retrynum} {
     return 0
 }
 
+# Check if current ::tags match requested tags. If ::allowtags are used,
+# there must be some intersection. If ::denytags are used, no intersection
+# is allowed. Returns 1 if tags are acceptable or 0 otherwise, in which
+# case err_return names a return variable for the message to be logged.
+proc tags_acceptable {err_return} {
+    upvar $err_return err
+
+    # If tags are whitelisted, make sure there's match
+    if {[llength $::allowtags] > 0} {
+        set matched 0
+        foreach tag $::allowtags {
+            if {[lsearch $::tags $tag] >= 0} {
+                incr matched
+            }
+        }
+        if {$matched < 1} {
+            set err "Tag: none of the tags allowed"
+            return 0
+        }
+    }
+
+    foreach tag $::denytags {
+        if {[lsearch $::tags $tag] >= 0} {
+            set err "Tag: $tag denied"
+            return 0
+        }
+    }
+
+    return 1
+}
+
 # doesn't really belong here, but highly coupled to code in start_server
 proc tags {tags code} {
     # If we 'tags' contain multiple tags, quoted and seperated by spaces,
     # we want to get rid of the quotes in order to have a proper list
     set tags [string map { \" "" } $tags]
     set ::tags [concat $::tags $tags]
-    # We skip unwanted tags
-    foreach tag $::denytags {
-        if {[lsearch $::tags $tag] >= 0} {
-            incr ::num_aborted
-            send_data_packet $::test_server_fd ignore "Tag: $tag"
-            set ::tags [lrange $::tags 0 end-[llength $tags]]
-            return
-        }
+    if {![tags_acceptable err]} {
+        incr ::num_aborted
+        send_data_packet $::test_server_fd ignore $err
+        set ::tags [lrange $::tags 0 end-[llength $tags]]
+        return
     }
     uplevel 1 $code
     set ::tags [lrange $::tags 0 end-[llength $tags]]
@@ -267,13 +295,11 @@ proc start_server {options {code undefined}} {
     }
 
     # We skip unwanted tags
-    foreach tag $::denytags {
-        if {[lsearch $::tags $tag] >= 0} {
-            incr ::num_aborted
-            send_data_packet $::test_server_fd ignore "Tag: $tag"
-            set ::tags [lrange $::tags 0 end-[llength $tags]]
-            return
-        }
+    if {![tags_acceptable err]} {
+        incr ::num_aborted
+        send_data_packet $::test_server_fd ignore $err
+        set ::tags [lrange $::tags 0 end-[llength $tags]]
+        return
     }
 
     # If we are running against an external server, we just push the
diff --git a/tests/unit/limits.tcl b/tests/unit/limits.tcl
index 38ba76208..51122e8f5 100644
--- a/tests/unit/limits.tcl
+++ b/tests/unit/limits.tcl
@@ -1,4 +1,4 @@
-start_server {tags {"limits"} overrides {maxclients 10}} {
+start_server {tags {"limits network"} overrides {maxclients 10}} {
     if {$::tls} {
         set expected_code "*I/O error*"
     } else {
diff --git a/tests/unit/pause.tcl b/tests/unit/pause.tcl
index 9f5cfd607..67b684d36 100644
--- a/tests/unit/pause.tcl
+++ b/tests/unit/pause.tcl
@@ -1,4 +1,4 @@
-start_server {tags {"pause"}} {
+start_server {tags {"pause network"}} {
     test "Test read commands are not blocked by client pause" {
         r client PAUSE 100000000 WRITE
         set rd [redis_deferring_client]
diff --git a/tests/unit/protocol.tcl b/tests/unit/protocol.tcl
index 4dfdc6f59..442c23de6 100644
--- a/tests/unit/protocol.tcl
+++ b/tests/unit/protocol.tcl
@@ -1,4 +1,4 @@
-start_server {tags {"protocol"}} {
+start_server {tags {"protocol network"}} {
     test "Handle an empty query" {
         reconnect
         r write "\r\n"
diff --git a/tests/unit/pubsub.tcl b/tests/unit/pubsub.tcl
index 9c7a43bf0..966565ae1 100644
--- a/tests/unit/pubsub.tcl
+++ b/tests/unit/pubsub.tcl
@@ -1,4 +1,4 @@
-start_server {tags {"pubsub"}} {
+start_server {tags {"pubsub network"}} {
     proc __consume_subscribe_messages {client type channels} {
         set numsub -1
         set counts {}
diff --git a/tests/unit/scan.tcl b/tests/unit/scan.tcl
index 9f9ff4df2..3981a2234 100644
--- a/tests/unit/scan.tcl
+++ b/tests/unit/scan.tcl
@@ -1,4 +1,4 @@
-start_server {tags {"scan"}} {
+start_server {tags {"scan network"}} {
     test "SCAN basic" {
         r flushdb
         r debug populate 1000
diff --git a/tests/unit/tracking.tcl b/tests/unit/tracking.tcl
index 88cf9dc42..7aaca47ca 100644
--- a/tests/unit/tracking.tcl
+++ b/tests/unit/tracking.tcl
@@ -1,4 +1,4 @@
-start_server {tags {"tracking"}} {
+start_server {tags {"tracking network"}} {
     # Create a deferred client we'll use to redirect invalidation
     # messages to.
     set rd_redirection [redis_deferring_client]
diff --git a/tests/unit/wait.tcl b/tests/unit/wait.tcl
index 0a4965c20..78c3d8202 100644
--- a/tests/unit/wait.tcl
+++ b/tests/unit/wait.tcl
@@ -1,6 +1,6 @@
 source tests/support/cli.tcl
 
-start_server {tags {"wait"}} {
+start_server {tags {"wait network"}} {
 start_server {} {
     set slave [srv 0 client]
     set slave_host [srv 0 host]