From 8cffe0a186a3e41e707f025a594929a340b5f5ff Mon Sep 17 00:00:00 2001
From: Andrew Grangaard <granny-github@ofb.net>
Date: Sat, 31 Oct 2020 21:07:04 -0700
Subject: [PATCH 1/5] Convert dynamic_methods.t to use subtests

---
 t/mojo/dynamic_methods.t | 29 +++++++++++++++--------------
 1 file changed, 15 insertions(+), 14 deletions(-)

diff --git a/t/mojo/dynamic_methods.t b/t/mojo/dynamic_methods.t
index 891c1461df..248fe8391d 100644
--- a/t/mojo/dynamic_methods.t
+++ b/t/mojo/dynamic_methods.t
@@ -23,21 +23,22 @@ sub BUILD_DYNAMIC {
 
 package main;
 
-# Basics
-my ($t1, $t2) = (Mojo::TestDynamic->new, Mojo::TestDynamic->new);
-Mojo::DynamicMethods::register 'Mojo::TestDynamic', $t1->hashref, 'foo', sub { };
-my $foo = \&Mojo::TestDynamic::_Dynamic::foo;
-my ($called_foo, $dyn_methods);
-Mojo::DynamicMethods::register 'Mojo::TestDynamic', $t1->hashref, 'foo', sub { $called_foo++; $dyn_methods = $_[1] };
-is $foo, \&Mojo::TestDynamic::_Dynamic::foo, 'foo not reinstalled';
-ok !Mojo::TestDynamic->can('foo'), 'dynamic method is hidden';
-ok eval { $t1->foo; 1 }, 'foo called ok';
-cmp_ok $called_foo, '==', 1, 'called dynamic method';
-ok !eval { $t2->foo; 1 }, 'error calling foo on wrong object';
+subtest "Basics" => sub {
+  my ($t1, $t2) = (Mojo::TestDynamic->new, Mojo::TestDynamic->new);
+  Mojo::DynamicMethods::register 'Mojo::TestDynamic', $t1->hashref, 'foo', sub { };
+  my $foo = \&Mojo::TestDynamic::_Dynamic::foo;
+  my ($called_foo, $dyn_methods);
+  Mojo::DynamicMethods::register 'Mojo::TestDynamic', $t1->hashref, 'foo', sub { $called_foo++; $dyn_methods = $_[1] };
+  is $foo, \&Mojo::TestDynamic::_Dynamic::foo, 'foo not reinstalled';
+  ok !Mojo::TestDynamic->can('foo'), 'dynamic method is hidden';
+  ok eval { $t1->foo; 1 }, 'foo called ok';
+  cmp_ok $called_foo, '==', 1, 'called dynamic method';
+  ok !eval { $t2->foo; 1 }, 'error calling foo on wrong object';
 
 # Garbage collection
-undef($t1);
-undef($t2);
-ok(!keys(%$dyn_methods), 'dynamic methods expired');
+  undef($t1);
+  undef($t2);
+  ok(!keys(%$dyn_methods), 'dynamic methods expired');
+};
 
 done_testing;

From 94911243e03a85378ab413f83b1c4c5ab4555eec Mon Sep 17 00:00:00 2001
From: Andrew Grangaard <granny-github@ofb.net>
Date: Sat, 31 Oct 2020 21:07:30 -0700
Subject: [PATCH 2/5] Convert reactor_ev.t to use subtests

---
 t/mojo/reactor_ev.t | 641 ++++++++++++++++++++++++--------------------
 1 file changed, 345 insertions(+), 296 deletions(-)

diff --git a/t/mojo/reactor_ev.t b/t/mojo/reactor_ev.t
index ffd8278ada..297382be5a 100644
--- a/t/mojo/reactor_ev.t
+++ b/t/mojo/reactor_ev.t
@@ -8,307 +8,356 @@ plan skip_all => 'EV 4.32+ required for this test!'                  unless eval
 use IO::Socket::INET;
 use Mojo::Util qw(steady_time);
 
-# Instantiation
+
 use_ok 'Mojo::Reactor::EV';
-my $reactor = Mojo::Reactor::EV->new;
-is ref $reactor, 'Mojo::Reactor::EV', 'right object';
-is ref Mojo::Reactor::EV->new, 'Mojo::Reactor::Poll', 'right object';
-undef $reactor;
-is ref Mojo::Reactor::EV->new, 'Mojo::Reactor::EV', 'right object';
-use_ok 'Mojo::IOLoop';
-$reactor = Mojo::IOLoop->singleton->reactor;
-is ref $reactor, 'Mojo::Reactor::EV', 'right object';
-
-# Make sure it stops automatically when not watching for events
-my $triggered;
-Mojo::IOLoop->next_tick(sub { $triggered++ });
-Mojo::IOLoop->start;
-ok $triggered, 'reactor waited for one event';
-my $time = time;
-Mojo::IOLoop->start;
-Mojo::IOLoop->one_tick;
-ok time < ($time + 10), 'stopped automatically';
-
-# Listen
-my $listen = IO::Socket::INET->new(Listen => 5, LocalAddr => '127.0.0.1');
-my $port   = $listen->sockport;
-my ($readable, $writable);
-$reactor->io($listen => sub { pop() ? $writable++ : $readable++ })->watch($listen, 0, 0)->watch($listen, 1, 1);
-$reactor->timer(0.025 => sub { shift->stop });
-$reactor->start;
-ok !$readable, 'handle is not readable';
-ok !$writable, 'handle is not writable';
-
-# Connect
+my $reactor;
+
+subtest "Instantiation" => sub {
+  $reactor = Mojo::Reactor::EV->new;
+  is ref $reactor, 'Mojo::Reactor::EV', 'right object';
+  is ref Mojo::Reactor::EV->new, 'Mojo::Reactor::Poll', 'right object';
+
+  undef $reactor;
+  is ref Mojo::Reactor::EV->new, 'Mojo::Reactor::EV', 'right object';
+  use_ok 'Mojo::IOLoop';
+
+  $reactor = Mojo::IOLoop->singleton->reactor;
+  is ref $reactor, 'Mojo::Reactor::EV', 'right object';
+};
+
+subtest "Make sure it stops automatically when not watching for events" => sub {
+  my $triggered;
+  Mojo::IOLoop->next_tick(sub { $triggered++ });
+  Mojo::IOLoop->start;
+  ok $triggered, 'reactor waited for one event';
+
+  my $time = time;
+  Mojo::IOLoop->start;
+  Mojo::IOLoop->one_tick;
+  ok time < ($time + 10), 'stopped automatically';
+};
+
+my ($listen,   $port)     = ();
+my ($readable, $writable) = ();
+subtest "Listen" => sub {
+  $listen = IO::Socket::INET->new(Listen => 5, LocalAddr => '127.0.0.1');
+  $port   = $listen->sockport;
+  $reactor->io($listen => sub { pop() ? $writable++ : $readable++ })->watch($listen, 0, 0)->watch($listen, 1, 1);
+  $reactor->timer(0.025 => sub { shift->stop });
+  $reactor->start;
+  ok !$readable, 'handle is not readable';
+  ok !$writable, 'handle is not writable';
+};
+
 my $client = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $port);
-$reactor->timer(1 => sub { shift->stop });
-$reactor->start;
-ok $readable, 'handle is readable';
-ok !$writable, 'handle is not writable';
+subtest "Connect" => sub {
+  $reactor->timer(1 => sub { shift->stop });
+  $reactor->start;
+  ok $readable, 'handle is readable';
+  ok !$writable, 'handle is not writable';
+};
 
-# Accept
 my $server = $listen->accept;
-ok $reactor->remove($listen), 'removed';
-ok !$reactor->remove($listen), 'not removed again';
-($readable, $writable) = ();
-$reactor->io($client => sub { pop() ? $writable++ : $readable++ });
-$reactor->again($reactor->timer(0.025 => sub { shift->stop }));
-$reactor->start;
-ok !$readable, 'handle is not readable';
-ok $writable, 'handle is writable';
-print $client "hello!\n";
-sleep 1;
-ok $reactor->remove($client), 'removed';
-($readable, $writable) = ();
-$reactor->io($server => sub { pop() ? $writable++ : $readable++ });
-$reactor->watch($server, 1, 0);
-$reactor->timer(0.025 => sub { shift->stop });
-$reactor->start;
-ok $readable, 'handle is readable';
-ok !$writable, 'handle is not writable';
-($readable, $writable) = ();
-$reactor->watch($server, 1, 1);
-$reactor->timer(0.025 => sub { shift->stop });
-$reactor->start;
-ok $readable, 'handle is readable';
-ok $writable, 'handle is writable';
-($readable, $writable) = ();
-$reactor->watch($server, 0, 0);
-$reactor->timer(0.025 => sub { shift->stop });
-$reactor->start;
-ok !$readable, 'handle is not readable';
-ok !$writable, 'handle is not writable';
-($readable, $writable) = ();
-$reactor->watch($server, 1, 0);
-$reactor->timer(0.025 => sub { shift->stop });
-$reactor->start;
-ok $readable, 'handle is readable';
-ok !$writable, 'handle is not writable';
-($readable, $writable) = ();
-$reactor->io($server => sub { pop() ? $writable++ : $readable++ });
-$reactor->timer(0.025 => sub { shift->stop });
-$reactor->start;
-ok $readable, 'handle is readable';
-ok $writable, 'handle is writable';
-
-# Timers
+subtest "Accept" => sub {
+  ok $reactor->remove($listen), 'removed';
+  ok !$reactor->remove($listen), 'not removed again';
+
+  ($readable, $writable) = ();
+  $reactor->io($client => sub { pop() ? $writable++ : $readable++ });
+  $reactor->again($reactor->timer(0.025 => sub { shift->stop }));
+  $reactor->start;
+  ok !$readable, 'handle is not readable';
+  ok $writable, 'handle is writable';
+
+  print $client "hello!\n";
+  sleep 1;
+  ok $reactor->remove($client), 'removed';
+
+  ($readable, $writable) = ();
+  $reactor->io($server => sub { pop() ? $writable++ : $readable++ });
+  $reactor->watch($server, 1, 0);
+  $reactor->timer(0.025 => sub { shift->stop });
+  $reactor->start;
+  ok $readable, 'handle is readable';
+  ok !$writable, 'handle is not writable';
+
+  ($readable, $writable) = ();
+  $reactor->watch($server, 1, 1);
+  $reactor->timer(0.025 => sub { shift->stop });
+  $reactor->start;
+  ok $readable, 'handle is readable';
+  ok $writable, 'handle is writable';
+
+  ($readable, $writable) = ();
+  $reactor->watch($server, 0, 0);
+  $reactor->timer(0.025 => sub { shift->stop });
+  $reactor->start;
+  ok !$readable, 'handle is not readable';
+  ok !$writable, 'handle is not writable';
+
+  ($readable, $writable) = ();
+  $reactor->watch($server, 1, 0);
+  $reactor->timer(0.025 => sub { shift->stop });
+  $reactor->start;
+  ok $readable, 'handle is readable';
+  ok !$writable, 'handle is not writable';
+
+  ($readable, $writable) = ();
+  $reactor->io($server => sub { pop() ? $writable++ : $readable++ });
+  $reactor->timer(0.025 => sub { shift->stop });
+  $reactor->start;
+  ok $readable, 'handle is readable';
+  ok $writable, 'handle is writable';
+};
+
 my ($timer, $recurring);
-$reactor->timer(0 => sub { $timer++ });
-ok $reactor->remove($reactor->timer(0 => sub { $timer++ })), 'removed';
-my $id = $reactor->recurring(0 => sub { $recurring++ });
-($readable, $writable) = ();
-$reactor->timer(0.025 => sub { shift->stop });
-$reactor->start;
-ok $readable,  'handle is readable again';
-ok $writable,  'handle is writable again';
-ok $timer,     'timer was triggered';
-ok $recurring, 'recurring was triggered';
-my $done;
-($readable, $writable, $timer, $recurring) = ();
-$reactor->timer(0.025 => sub { $done = shift->is_running });
-$reactor->one_tick while !$done;
-ok $readable, 'handle is readable again';
-ok $writable, 'handle is writable again';
-ok !$timer, 'timer was not triggered';
-ok $recurring, 'recurring was triggered again';
-($readable, $writable, $timer, $recurring) = ();
-$reactor->timer(0.025 => sub { shift->stop });
-$reactor->start;
-ok $readable, 'handle is readable again';
-ok $writable, 'handle is writable again';
-ok !$timer, 'timer was not triggered';
-ok $recurring, 'recurring was triggered again';
-ok $reactor->remove($id), 'removed';
-ok !$reactor->remove($id), 'not removed again';
-($readable, $writable, $timer, $recurring) = ();
-$reactor->timer(0.025 => sub { shift->stop });
-$reactor->start;
-ok $readable, 'handle is readable again';
-ok $writable, 'handle is writable again';
-ok !$timer,     'timer was not triggered';
-ok !$recurring, 'recurring was not triggered again';
-($readable, $writable, $timer, $recurring) = ();
-my $next_tick;
-is $reactor->next_tick(sub { $next_tick++ }), undef, 'returned undef';
-$id = $reactor->recurring(0 => sub { $recurring++ });
-$reactor->timer(0.025 => sub { shift->stop });
-$reactor->start;
-ok $readable, 'handle is readable again';
-ok $writable, 'handle is writable again';
-ok !$timer, 'timer was not triggered';
-ok $recurring, 'recurring was triggered again';
-ok $next_tick, 'next tick was triggered';
-
-# Reset
-$reactor->next_tick(sub { die 'Reset failed' });
-$reactor->reset;
-($readable, $writable, $recurring) = ();
-$reactor->next_tick(sub { shift->stop });
-$reactor->start;
-ok !$readable,  'io event was not triggered again';
-ok !$writable,  'io event was not triggered again';
-ok !$recurring, 'recurring was not triggered again';
-my $reactor2 = Mojo::Reactor::EV->new;
-is ref $reactor2, 'Mojo::Reactor::Poll', 'right object';
-
-# Ordered next_tick
-my $result = [];
-for my $i (1 .. 10) {
-  $reactor->next_tick(sub { push @$result, $i });
-}
-$reactor->start;
-is_deeply $result, [1 .. 10], 'right result';
-
-# Reset while watchers are active
-$writable = undef;
-$reactor->io($_ => sub { ++$writable and shift->reset })->watch($_, 0, 1) for $client, $server;
-$reactor->start;
-is $writable, 1, 'only one handle was writable';
-
-# Concurrent reactors
-$timer = 0;
-$reactor->recurring(0 => sub { $timer++ });
-my $timer2;
-$reactor2->recurring(0 => sub { $timer2++ });
-$reactor->timer(0.025 => sub { shift->stop });
-$reactor->start;
-ok $timer, 'timer was triggered';
-ok !$timer2, 'timer was not triggered';
-$timer = $timer2 = 0;
-$reactor2->timer(0.025 => sub { shift->stop });
-$reactor2->start;
-ok !$timer, 'timer was not triggered';
-ok $timer2, 'timer was triggered';
-$timer = $timer2 = 0;
-$reactor->timer(0.025 => sub { shift->stop });
-$reactor->start;
-ok $timer, 'timer was triggered';
-ok !$timer2, 'timer was not triggered';
-$timer = $timer2 = 0;
-$reactor2->timer(0.025 => sub { shift->stop });
-$reactor2->start;
-ok !$timer, 'timer was not triggered';
-ok $timer2, 'timer was triggered';
-$reactor->reset;
-
-# Restart timer
-my ($single, $pair, $one, $two, $last);
-$reactor->timer(0.025 => sub { $single++ });
-$one = $reactor->timer(
-  0.025 => sub {
-    my $reactor = shift;
-    $last++ if $single && $pair;
-    $pair++ ? $reactor->stop : $reactor->again($two);
-  }
-);
-$two = $reactor->timer(
-  0.025 => sub {
-    my $reactor = shift;
-    $last++ if $single && $pair;
-    $pair++ ? $reactor->stop : $reactor->again($one);
-  }
-);
-$reactor->start;
-is $pair,   2, 'timer pair was triggered';
-ok $single, 'single timer was triggered';
-ok $last,   'timers were triggered in the right order';
-
-# Reset timer
-my $before = steady_time;
-my ($after, $again);
-$one = $reactor->timer(300 => sub { $after = steady_time });
-$two = $reactor->recurring(
-  300 => sub {
-    my $reactor = shift;
-    $reactor->remove($two) if ++$again > 3;
-  }
-);
-$reactor->timer(
-  0.025 => sub {
-    my $reactor = shift;
-    $reactor->again($one, 0.025);
-    $reactor->again($two, 0.025);
-  }
-);
-$reactor->start;
-ok $after, 'timer was triggered';
-ok(($after - $before) < 200, 'less than 200 seconds');
-is $again, 4, 'recurring timer triggered four times';
-
-# Restart inactive timer
-$id = $reactor->timer(0 => sub { });
-ok $reactor->remove($id), 'removed';
-eval { $reactor->again($id) };
-like $@, qr/Timer not active/, 'right error';
-
-# Change inactive I/O watcher
-ok !$reactor->remove($listen), 'not removed again';
-eval { $reactor->watch($listen, 1, 1) };
-like $@, qr!I/O watcher not active!, 'right error';
-
-# Error
-my $err;
-$reactor->unsubscribe('error')->on(
-  error => sub {
-    shift->stop;
-    $err = pop;
-  }
-);
-$reactor->timer(0 => sub { die "works!\n" });
-$reactor->start;
-like $err, qr/works!/, 'right error';
-
-# Reset events
-$reactor->on(error => sub { });
-ok $reactor->has_subscribers('error'), 'has subscribers';
-$reactor->reset;
-ok !$reactor->has_subscribers('error'), 'no subscribers';
-
-# Recursion
-$timer   = undef;
-$reactor = $reactor->new;
-$reactor->timer(0 => sub { ++$timer and shift->one_tick });
-$reactor->one_tick;
-is $timer, 1, 'timer was triggered once';
-
-# Detection
-is(Mojo::Reactor->detect, 'Mojo::Reactor::EV', 'right class');
-
-# Reactor in control
-is ref Mojo::IOLoop->singleton->reactor, 'Mojo::Reactor::EV', 'right object';
-ok !Mojo::IOLoop->is_running, 'loop is not running';
-my ($buffer, $server_err, $server_running, $client_err, $client_running);
-$id = Mojo::IOLoop->server(
-  {address => '127.0.0.1'} => sub {
-    my ($loop, $stream) = @_;
-    $stream->write('test' => sub { shift->write('321') });
-    $server_running = Mojo::IOLoop->is_running;
-    eval { Mojo::IOLoop->start };
-    $server_err = $@;
-  }
-);
-$port = Mojo::IOLoop->acceptor($id)->port;
-Mojo::IOLoop->client(
-  {port => $port} => sub {
-    my ($loop, $err, $stream) = @_;
-    $stream->on(
-      read => sub {
-        my ($stream, $chunk) = @_;
-        $buffer .= $chunk;
-        return unless $buffer eq 'test321';
-        Mojo::IOLoop->singleton->reactor->stop;
-      }
-    );
-    $client_running = Mojo::IOLoop->is_running;
-    eval { Mojo::IOLoop->start };
-    $client_err = $@;
+subtest "Timers" => sub {
+  $reactor->timer(0 => sub { $timer++ });
+  ok $reactor->remove($reactor->timer(0 => sub { $timer++ })), 'removed';
+
+  my $id = $reactor->recurring(0 => sub { $recurring++ });
+  ($readable, $writable) = ();
+  $reactor->timer(0.025 => sub { shift->stop });
+  $reactor->start;
+  ok $readable,  'handle is readable again';
+  ok $writable,  'handle is writable again';
+  ok $timer,     'timer was triggered';
+  ok $recurring, 'recurring was triggered';
+
+  my $done;
+  ($readable, $writable, $timer, $recurring) = ();
+  $reactor->timer(0.025 => sub { $done = shift->is_running });
+  $reactor->one_tick while !$done;
+  ok $readable, 'handle is readable again';
+  ok $writable, 'handle is writable again';
+  ok !$timer, 'timer was not triggered';
+  ok $recurring, 'recurring was triggered again';
+
+  ($readable, $writable, $timer, $recurring) = ();
+  $reactor->timer(0.025 => sub { shift->stop });
+  $reactor->start;
+  ok $readable, 'handle is readable again';
+  ok $writable, 'handle is writable again';
+  ok !$timer, 'timer was not triggered';
+  ok $recurring, 'recurring was triggered again';
+  ok $reactor->remove($id), 'removed';
+  ok !$reactor->remove($id), 'not removed again';
+
+  ($readable, $writable, $timer, $recurring) = ();
+  $reactor->timer(0.025 => sub { shift->stop });
+  $reactor->start;
+  ok $readable, 'handle is readable again';
+  ok $writable, 'handle is writable again';
+  ok !$timer,     'timer was not triggered';
+  ok !$recurring, 'recurring was not triggered again';
+
+  ($readable, $writable, $timer, $recurring) = ();
+  my $next_tick;
+  is $reactor->next_tick(sub { $next_tick++ }), undef, 'returned undef';
+  $id = $reactor->recurring(0 => sub { $recurring++ });
+  $reactor->timer(0.025 => sub { shift->stop });
+  $reactor->start;
+  ok $readable, 'handle is readable again';
+  ok $writable, 'handle is writable again';
+  ok !$timer, 'timer was not triggered';
+  ok $recurring, 'recurring was triggered again';
+  ok $next_tick, 'next tick was triggered';
+};
+
+subtest "Reset" => sub {
+  $reactor->next_tick(sub { die 'Reset failed' });
+  $reactor->reset;
+  ($readable, $writable, $recurring) = ();
+  $reactor->next_tick(sub { shift->stop });
+  $reactor->start;
+  ok !$readable,  'io event was not triggered again';
+  ok !$writable,  'io event was not triggered again';
+  ok !$recurring, 'recurring was not triggered again';
+
+  my $reactor2 = Mojo::Reactor::EV->new;
+  is ref $reactor2, 'Mojo::Reactor::Poll', 'right object';
+};
+
+subtest "Ordered next_tick" => sub {
+  my $result = [];
+  for my $i (1 .. 10) {
+    $reactor->next_tick(sub { push @$result, $i });
   }
-);
-Mojo::IOLoop->singleton->reactor->start;
-ok !Mojo::IOLoop->is_running, 'loop is not running';
-like $server_err,   qr/^Mojo::IOLoop already running/, 'right error';
-like $client_err,   qr/^Mojo::IOLoop already running/, 'right error';
-ok $server_running, 'loop is running';
-ok $client_running, 'loop is running';
+  $reactor->start;
+  is_deeply $result, [1 .. 10], 'right result';
+};
+
+subtest "Reset while watchers are active" => sub {
+  my $writable = undef;
+  $reactor->io($_ => sub { ++$writable and shift->reset })->watch($_, 0, 1) for $client, $server;
+  $reactor->start;
+  is $writable, 1, 'only one handle was writable';
+};
+
+subtest "Concurrent reactors" => sub {
+  my $timer = 0;
+  $reactor->recurring(0 => sub { $timer++ });
+  my $timer2;
+  my $reactor2 = Mojo::Reactor::EV->new;
+  $reactor2->recurring(0 => sub { $timer2++ });
+  $reactor->timer(0.025 => sub { shift->stop });
+  $reactor->start;
+  ok $timer, 'timer was triggered';
+  ok !$timer2, 'timer was not triggered';
+
+  $timer = $timer2 = 0;
+  $reactor2->timer(0.025 => sub { shift->stop });
+  $reactor2->start;
+  ok !$timer, 'timer was not triggered';
+  ok $timer2, 'timer was triggered';
+
+  $timer = $timer2 = 0;
+  $reactor->timer(0.025 => sub { shift->stop });
+  $reactor->start;
+  ok $timer, 'timer was triggered';
+  ok !$timer2, 'timer was not triggered';
+
+  $timer = $timer2 = 0;
+  $reactor2->timer(0.025 => sub { shift->stop });
+  $reactor2->start;
+  ok !$timer, 'timer was not triggered';
+  ok $timer2, 'timer was triggered';
+
+  $reactor->reset;
+};
+
+subtest "Restart timer" => sub {
+  my ($single, $pair, $one, $two, $last);
+  $reactor->timer(0.025 => sub { $single++ });
+  $one = $reactor->timer(
+    0.025 => sub {
+      my $reactor = shift;
+      $last++ if $single && $pair;
+      $pair++ ? $reactor->stop : $reactor->again($two);
+    }
+  );
+  $two = $reactor->timer(
+    0.025 => sub {
+      my $reactor = shift;
+      $last++ if $single && $pair;
+      $pair++ ? $reactor->stop : $reactor->again($one);
+    }
+  );
+  $reactor->start;
+  is $pair,   2, 'timer pair was triggered';
+  ok $single, 'single timer was triggered';
+  ok $last,   'timers were triggered in the right order';
+};
+
+subtest "Reset timer" => sub {
+  my $before = steady_time;
+  my ($after, $again);
+  my ($one,   $two);
+  $one = $reactor->timer(300 => sub { $after = steady_time });
+  $two = $reactor->recurring(
+    300 => sub {
+      my $reactor = shift;
+      $reactor->remove($two) if ++$again > 3;
+    }
+  );
+  $reactor->timer(
+    0.025 => sub {
+      my $reactor = shift;
+      $reactor->again($one, 0.025);
+      $reactor->again($two, 0.025);
+    }
+  );
+  $reactor->start;
+  ok $after, 'timer was triggered';
+  ok(($after - $before) < 200, 'less than 200 seconds');
+  is $again, 4, 'recurring timer triggered four times';
+};
+
+subtest "Restart inactive timer" => sub {
+  my $id = $reactor->timer(0 => sub { });
+  ok $reactor->remove($id), 'removed';
+
+  eval { $reactor->again($id) };
+  like $@, qr/Timer not active/, 'right error';
+};
+
+subtest "Change inactive I/O watcher" => sub {
+  ok !$reactor->remove($listen), 'not removed again';
+
+  eval { $reactor->watch($listen, 1, 1) };
+  like $@, qr!I/O watcher not active!, 'right error';
+};
+
+subtest "Error" => sub {
+  my $err;
+  $reactor->unsubscribe('error')->on(
+    error => sub {
+      shift->stop;
+      $err = pop;
+    }
+  );
+  $reactor->timer(0 => sub { die "works!\n" });
+  $reactor->start;
+  like $err, qr/works!/, 'right error';
+};
+
+subtest "Reset events" => sub {
+  $reactor->on(error => sub { });
+  ok $reactor->has_subscribers('error'), 'has subscribers';
+
+  $reactor->reset;
+  ok !$reactor->has_subscribers('error'), 'no subscribers';
+};
+
+subtest "Recursion" => sub {
+  my $timer = undef;
+  $reactor = $reactor->new;
+  $reactor->timer(0 => sub { ++$timer and shift->one_tick });
+  $reactor->one_tick;
+  is $timer, 1, 'timer was triggered once';
+};
+
+subtest "Detection" => sub {
+  is(Mojo::Reactor->detect, 'Mojo::Reactor::EV', 'right class');
+};
+
+subtest "Reactor in control" => sub {
+  is ref Mojo::IOLoop->singleton->reactor, 'Mojo::Reactor::EV', 'right object';
+  ok !Mojo::IOLoop->is_running, 'loop is not running';
+
+  my ($buffer, $server_err, $server_running, $client_err, $client_running);
+  my $id = Mojo::IOLoop->server(
+    {address => '127.0.0.1'} => sub {
+      my ($loop, $stream) = @_;
+      $stream->write('test' => sub { shift->write('321') });
+      $server_running = Mojo::IOLoop->is_running;
+      eval { Mojo::IOLoop->start };
+      $server_err = $@;
+    }
+  );
+  $port = Mojo::IOLoop->acceptor($id)->port;
+  Mojo::IOLoop->client(
+    {port => $port} => sub {
+      my ($loop, $err, $stream) = @_;
+      $stream->on(
+        read => sub {
+          my ($stream, $chunk) = @_;
+          $buffer .= $chunk;
+          return unless $buffer eq 'test321';
+          Mojo::IOLoop->singleton->reactor->stop;
+        }
+      );
+      $client_running = Mojo::IOLoop->is_running;
+      eval { Mojo::IOLoop->start };
+      $client_err = $@;
+    }
+  );
+  Mojo::IOLoop->singleton->reactor->start;
+  ok !Mojo::IOLoop->is_running, 'loop is not running';
+  like $server_err,   qr/^Mojo::IOLoop already running/, 'right error';
+  like $client_err,   qr/^Mojo::IOLoop already running/, 'right error';
+  ok $server_running, 'loop is running';
+  ok $client_running, 'loop is running';
+};
 
 done_testing();

From 0298602a99e6dc0988e6cd9a150faa8a1866e90a Mon Sep 17 00:00:00 2001
From: Andrew Grangaard <granny-github@ofb.net>
Date: Sat, 31 Oct 2020 21:07:50 -0700
Subject: [PATCH 3/5] Convert user_agent_socks.t to use subtests

---
 t/mojo/user_agent_socks.t | 128 ++++++++++++++++++++------------------
 1 file changed, 67 insertions(+), 61 deletions(-)

diff --git a/t/mojo/user_agent_socks.t b/t/mojo/user_agent_socks.t
index d8a1a19569..e7d4bcd661 100644
--- a/t/mojo/user_agent_socks.t
+++ b/t/mojo/user_agent_socks.t
@@ -99,67 +99,73 @@ Mojo::IOLoop->singleton->reactor->io(
   }
 );
 
-# Failed authentication with SOCKS proxy
 my $ua = Mojo::UserAgent->new(ioloop => Mojo::IOLoop->singleton, insecure => 1);
-$ua->proxy->http("socks://foo:baz\@127.0.0.1:$port");
-my $tx = $ua->get('/');
-ok $tx->error, 'has error';
-
-# Simple request with SOCKS proxy
-$ua->proxy->http("socks://foo:bar\@127.0.0.1:$port");
-$tx = $ua->get('/');
-ok !$tx->error,      'no error';
-ok !$tx->kept_alive, 'kept connection not alive';
-ok $tx->keep_alive, 'keep connection alive';
-is $tx->res->code, 200, 'right status';
-is $tx->req->headers->proxy_authorization, undef, 'no "Proxy-Authorization" value';
-is $tx->res->body, $last, 'right content';
-isnt(Mojo::IOLoop->stream($tx->connection)->handle->sockport, $last, 'different ports');
-
-# Keep alive request with SOCKS proxy
-my $before = $last;
-$tx = $ua->get('/');
-ok !$tx->error, 'no error';
-ok $tx->kept_alive, 'kept connection alive';
-ok $tx->keep_alive, 'keep connection alive';
-is $tx->res->code, 200, 'right status';
-is $tx->res->body, $last, 'right content';
-is $before, $last, 'same port';
-isnt(Mojo::IOLoop->stream($tx->connection)->handle->sockport, $last, 'different ports');
-
-# WebSocket with SOCKS proxy
-my ($result, $id);
-$ua->websocket(
-  '/echo' => sub {
-    my ($ua, $tx) = @_;
-    $id = $tx->connection;
-    $tx->on(message => sub { $result = pop; Mojo::IOLoop->stop });
-    $tx->send('test');
-  }
-);
-Mojo::IOLoop->start;
-is $result, $last, 'right result';
-isnt(Mojo::IOLoop->stream($id)->handle->sockport, $last, 'different ports');
-
-# HTTPS request with SOCKS proxy
-$ua->proxy->https("socks://foo:bar\@127.0.0.1:$port");
-$ua->server->url('https');
-$tx = $ua->get('/secure');
-ok !$tx->error,      'no error';
-ok !$tx->kept_alive, 'kept connection not alive';
-ok $tx->keep_alive, 'keep connection alive';
-is $tx->res->code, 200,           'right status';
-is $tx->res->body, "https:$last", 'right content';
-isnt(Mojo::IOLoop->stream($tx->connection)->handle->sockport, $last, 'different ports');
-
-# Disabled SOCKS proxy
-$ua->server->url('http');
-$ua->proxy->http("socks://foo:baz\@127.0.0.1:$port");
-$tx = $ua->build_tx(GET => '/');
-$tx->req->via_proxy(0);
-$tx = $ua->start($tx);
-ok !$tx->error, 'no error';
-is $tx->res->code, 200, 'right status';
-is $tx->res->body, $tx->local_port, 'right content';
+subtest "Failed authentication with SOCKS proxy" => sub {
+  $ua->proxy->http("socks://foo:baz\@127.0.0.1:$port");
+  my $tx = $ua->get('/');
+  ok $tx->error, 'has error';
+};
+
+subtest "Simple request with SOCKS proxy" => sub {
+  $ua->proxy->http("socks://foo:bar\@127.0.0.1:$port");
+  my $tx = $ua->get('/');
+  ok !$tx->error,      'no error';
+  ok !$tx->kept_alive, 'kept connection not alive';
+  ok $tx->keep_alive, 'keep connection alive';
+  is $tx->res->code, 200, 'right status';
+  is $tx->req->headers->proxy_authorization, undef, 'no "Proxy-Authorization" value';
+  is $tx->res->body, $last, 'right content';
+  isnt(Mojo::IOLoop->stream($tx->connection)->handle->sockport, $last, 'different ports');
+};
+
+subtest "Keep alive request with SOCKS proxy" => sub {
+  my $before = $last;
+  my $tx = $ua->get('/');
+  ok !$tx->error, 'no error';
+  ok $tx->kept_alive, 'kept connection alive';
+  ok $tx->keep_alive, 'keep connection alive';
+  is $tx->res->code, 200, 'right status';
+  is $tx->res->body, $last, 'right content';
+  is $before, $last, 'same port';
+  isnt(Mojo::IOLoop->stream($tx->connection)->handle->sockport, $last, 'different ports');
+};
+
+subtest "WebSocket with SOCKS proxy" => sub {
+  my ($result, $id);
+  $ua->websocket(
+    '/echo' => sub {
+      my ($ua, $tx) = @_;
+      $id = $tx->connection;
+      $tx->on(message => sub { $result = pop; Mojo::IOLoop->stop });
+      $tx->send('test');
+    }
+  );
+  Mojo::IOLoop->start;
+  is $result, $last, 'right result';
+  isnt(Mojo::IOLoop->stream($id)->handle->sockport, $last, 'different ports');
+};
+
+subtest "HTTPS request with SOCKS proxy" => sub {
+  $ua->proxy->https("socks://foo:bar\@127.0.0.1:$port");
+  $ua->server->url('https');
+  my $tx = $ua->get('/secure');
+  ok !$tx->error,      'no error';
+  ok !$tx->kept_alive, 'kept connection not alive';
+  ok $tx->keep_alive, 'keep connection alive';
+  is $tx->res->code, 200,           'right status';
+  is $tx->res->body, "https:$last", 'right content';
+  isnt(Mojo::IOLoop->stream($tx->connection)->handle->sockport, $last, 'different ports');
+};
+
+subtest "Disabled SOCKS proxy" => sub {
+  $ua->server->url('http');
+  $ua->proxy->http("socks://foo:baz\@127.0.0.1:$port");
+  my $tx = $ua->build_tx(GET => '/');
+  $tx->req->via_proxy(0);
+  $tx = $ua->start($tx);
+  ok !$tx->error, 'no error';
+  is $tx->res->code, 200, 'right status';
+  is $tx->res->body, $tx->local_port, 'right content';
+};
 
 done_testing();

From 0634d0b840e6afda31e84730eff6358f10100274 Mon Sep 17 00:00:00 2001
From: Andrew Grangaard <granny-github@ofb.net>
Date: Sat, 31 Oct 2020 21:07:55 -0700
Subject: [PATCH 4/5] Convert websocket.t to use subtests

---
 t/mojo/websocket.t | 698 +++++++++++++++++++++++----------------------
 1 file changed, 359 insertions(+), 339 deletions(-)

diff --git a/t/mojo/websocket.t b/t/mojo/websocket.t
index 17fb483d1d..e29edf9b3b 100644
--- a/t/mojo/websocket.t
+++ b/t/mojo/websocket.t
@@ -10,11 +10,10 @@ use Mojo::Transaction::WebSocket;
 use Mojo::UserAgent;
 use Mojolicious::Lite;
 
-# Max WebSocket size
-{
+subtest "Max WebSocket size" => sub {
   local $ENV{MOJO_MAX_WEBSOCKET_SIZE} = 1024;
   is(Mojo::Transaction::WebSocket->new->max_websocket_size, 1024, 'right value');
-}
+};
 
 # Silence
 app->log->level('debug')->unsubscribe('message');
@@ -118,343 +117,364 @@ websocket '/timeout' => sub {
   shift->inactivity_timeout(0.25)->on(finish => sub { shift->stash->{finished}++ });
 };
 
-# URL for WebSocket
 my $ua  = app->ua;
-my $res = $ua->get('/link')->result;
-is $res->code,   200,                        'right status';
-like $res->body, qr!ws://127\.0\.0\.1:\d+/!, 'right content';
-
-# Plain HTTP request
-$res = $ua->get('/early_start')->res;
-is $res->code,   404,                'right status';
-like $res->body, qr/Page not found/, 'right content';
-
-# Plain WebSocket
-my ($stash, $result);
-app->plugins->once(before_dispatch => sub { $stash = shift->stash });
-$ua->websocket(
-  '/' => sub {
-    my ($ua, $tx) = @_;
-    $tx->on(finish  => sub { Mojo::IOLoop->stop });
-    $tx->on(message => sub { shift->finish; $result = shift });
-    $tx->send('test1');
-  }
-);
-Mojo::IOLoop->start;
-Mojo::IOLoop->one_tick until $stash->{finished};
-is $stash->{finished}, 1, 'finish event has been emitted once';
-like $result, qr!test1test2ws://127\.0\.0\.1:\d+/!, 'right result';
-
-# Failed WebSocket connection
-my ($code, $body, $ws);
-$ua->websocket(
-  '/something/else' => sub {
-    my ($ua, $tx) = @_;
-    $ws   = $tx->is_websocket;
-    $code = $tx->res->code;
-    $body = $tx->res->body;
-    Mojo::IOLoop->stop;
-  }
-);
-Mojo::IOLoop->start;
-ok !$ws, 'not a WebSocket';
-is $code, 200, 'right status';
-ok $body =~ /^(\d+)failed!$/ && $1 == 30, 'right content';
-
-# Server directly sends a message
-$result = '';
-my ($established, $status, $msg);
-$ua->websocket(
-  '/early_start' => sub {
-    my ($ua, $tx) = @_;
-    $established = $tx->established;
-    $tx->on(
-      finish => sub {
-        my ($tx, $code, $reason) = @_;
-        ($status, $msg) = ($code, $reason);
-        Mojo::IOLoop->stop;
-      }
-    );
-    $tx->on(
-      message => sub {
-        my ($tx, $msg) = @_;
-        $result .= $msg;
-        $tx->send('test2');
-      }
-    );
-  }
-);
-Mojo::IOLoop->start;
-ok $established, 'connection established';
-is $status,      1000,               'right status';
-is $msg,         'I ♥ Mojolicious!', 'right message';
-is $result,      'test0test2test1',  'right result';
-
-# WebSocket connection gets closed very fast
-$status = undef;
-$ua->websocket(
-  '/early_finish' => sub {
-    my ($ua, $tx) = @_;
-    $tx->on(finish => sub { $status = [@_[1, 2]]; Mojo::IOLoop->stop });
-  }
-);
-Mojo::IOLoop->start;
-is $status->[0], 4000,     'right status';
-is $status->[1], 'kaboom', 'right message';
-
-# Connection denied
-($stash, $code, $ws) = ();
-app->plugins->once(before_dispatch => sub { $stash = shift->stash });
-$ua->websocket(
-  '/denied' => sub {
-    my ($ua, $tx) = @_;
-    $ws   = $tx->is_websocket;
-    $code = $tx->res->code;
-    Mojo::IOLoop->stop;
-  }
-);
-Mojo::IOLoop->start;
-Mojo::IOLoop->one_tick until $stash->{finished};
-is $stash->{handshake}, 1, 'finish event has been emitted once for handshake';
-is $stash->{finished},  1, 'finish event has been emitted once';
-ok !$ws, 'not a WebSocket';
-is $code, 403, 'right status';
-
-# Subrequests
-($stash, $code, $result) = ();
-app->plugins->once(before_dispatch => sub { $stash = shift->stash });
-$ua->websocket(
-  '/subreq' => sub {
-    my ($ua, $tx) = @_;
-    $code = $tx->res->code;
-    $tx->on(message => sub { $result .= pop });
-    $tx->on(finish  => sub { Mojo::IOLoop->stop });
-  }
-);
-Mojo::IOLoop->start;
-Mojo::IOLoop->one_tick until $stash->{finished};
-is $stash->{finished}, 1, 'finish event has been emitted once';
-is $code,   101,          'right status';
-is $result, 'test0test1', 'right result';
-
-# Concurrent subrequests
-my $delay = Mojo::IOLoop->delay;
-($code, $result) = ();
-my ($code2, $result2);
-my $end = $delay->begin;
-$ua->websocket(
-  '/subreq' => sub {
-    my ($ua, $tx) = @_;
-    $code = $tx->res->code;
-    $tx->on(
-      message => sub {
-        my ($tx, $msg) = @_;
-        $result .= $msg;
-        $tx->finish if $msg eq 'test1';
-      }
-    );
-    $tx->on(finish => sub { $end->() });
-  }
-);
-my $end2 = $delay->begin;
-$ua->websocket(
-  '/subreq' => sub {
-    my ($ua, $tx) = @_;
-    $code2 = $tx->res->code;
-    $tx->on(message => sub { $result2 .= pop });
-    $tx->on(finish  => sub { $end2->() });
-  }
-);
-$delay->wait;
-is $code,    101,          'right status';
-is $result,  'test0test1', 'right result';
-is $code2,   101,          'right status';
-is $result2, 'test0test1', 'right result';
-
-# Client-side drain callback
-$result = '';
-my ($drain, $counter);
-$ua->websocket(
-  '/echo' => sub {
-    my ($ua, $tx) = @_;
-    $tx->on(finish => sub { Mojo::IOLoop->stop });
-    $tx->on(
-      message => sub {
-        my ($tx, $msg) = @_;
-        $result .= $msg;
-        $tx->finish if ++$counter == 2;
-      }
-    );
-    $tx->send(
-      'hi!' => sub {
-        shift->send('there!');
-        $drain += @{Mojo::IOLoop->stream($tx->connection)->subscribers('drain')};
-      }
-    );
-  }
-);
-Mojo::IOLoop->start;
-is $result, 'hi!there!', 'right result';
-is $drain,  1,           'no leaking subscribers';
-
-# Server-side drain callback
-$result  = '';
-$counter = 0;
-$ua->websocket(
-  '/double_echo' => sub {
-    my ($ua, $tx) = @_;
-    $tx->on(finish => sub { Mojo::IOLoop->stop });
-    $tx->on(
-      message => sub {
-        my ($tx, $msg) = @_;
-        $result .= $msg;
-        $tx->finish if ++$counter == 2;
-      }
-    );
-    $tx->send('hi!');
-  }
-);
-Mojo::IOLoop->start;
-is $result, 'hi!hi!', 'right result';
-
-# Sending objects
-$result = undef;
-$ua->websocket(
-  '/trim' => sub {
-    my ($ua, $tx) = @_;
-    $tx->on(finish  => sub { Mojo::IOLoop->stop });
-    $tx->on(message => sub { shift->finish; $result = shift });
-    $tx->send(b(' foo bar '));
-  }
-);
-Mojo::IOLoop->start;
-is $result, 'foo bar', 'right result';
-
-# Promises
-$result = undef;
-$ua->websocket_p('/trim')->then(sub {
-  my $tx      = shift;
-  my $promise = Mojo::Promise->new;
-  $tx->on(finish  => sub { $promise->resolve });
-  $tx->on(message => sub { shift->finish; $result = pop });
-  $tx->send(' also works! ');
-  return $promise;
-})->wait;
-is $result, 'also works!', 'right result';
-$result = undef;
-$ua->websocket_p('/foo')->then(sub { $result = 'test failed' })->catch(sub { $result = shift })->wait;
-is $result, 'WebSocket handshake failed', 'right result';
-$result = undef;
-$ua->websocket_p($ua->server->url->to_abs->scheme('wsss'))->then(sub { $result = 'test failed' })
+subtest "URL for WebSocket" => sub {
+  my $res = $ua->get('/link')->result;
+  is $res->code,   200,                        'right status';
+  like $res->body, qr!ws://127\.0\.0\.1:\d+/!, 'right content';
+};
+
+subtest "Plain HTTP request" => sub {
+  my $res = $ua->get('/early_start')->res;
+  is $res->code,   404,                'right status';
+  like $res->body, qr/Page not found/, 'right content';
+};
+
+subtest "Plain WebSocket" => sub {
+  my ($stash, $result);
+  app->plugins->once(before_dispatch => sub { $stash = shift->stash });
+  $ua->websocket(
+    '/' => sub {
+      my ($ua, $tx) = @_;
+      $tx->on(finish  => sub { Mojo::IOLoop->stop });
+      $tx->on(message => sub { shift->finish; $result = shift });
+      $tx->send('test1');
+    }
+  );
+  Mojo::IOLoop->start;
+  Mojo::IOLoop->one_tick until $stash->{finished};
+  is $stash->{finished}, 1, 'finish event has been emitted once';
+  like $result, qr!test1test2ws://127\.0\.0\.1:\d+/!, 'right result';
+};
+
+subtest "Failed WebSocket connection" => sub {
+  my ($code, $body, $ws);
+  $ua->websocket(
+    '/something/else' => sub {
+      my ($ua, $tx) = @_;
+      $ws   = $tx->is_websocket;
+      $code = $tx->res->code;
+      $body = $tx->res->body;
+      Mojo::IOLoop->stop;
+    }
+  );
+  Mojo::IOLoop->start;
+  ok !$ws, 'not a WebSocket';
+  is $code, 200, 'right status';
+  ok $body =~ /^(\d+)failed!$/ && $1 == 30, 'right content';
+};
+
+subtest "Server directly sends a message" => sub {
+  my $result = '';
+  my ($established, $status, $msg);
+  $ua->websocket(
+    '/early_start' => sub {
+      my ($ua, $tx) = @_;
+      $established = $tx->established;
+      $tx->on(
+        finish => sub {
+          my ($tx, $code, $reason) = @_;
+          ($status, $msg) = ($code, $reason);
+          Mojo::IOLoop->stop;
+        }
+      );
+      $tx->on(
+        message => sub {
+          my ($tx, $msg) = @_;
+          $result .= $msg;
+          $tx->send('test2');
+        }
+      );
+    }
+  );
+  Mojo::IOLoop->start;
+  ok $established, 'connection established';
+  is $status,      1000,               'right status';
+  is $msg,         'I ♥ Mojolicious!', 'right message';
+  is $result,      'test0test2test1',  'right result';
+};
+
+subtest "WebSocket connection gets closed very fast" => sub {
+  my $status = undef;
+  $ua->websocket(
+    '/early_finish' => sub {
+      my ($ua, $tx) = @_;
+      $tx->on(finish => sub { $status = [@_[1, 2]]; Mojo::IOLoop->stop });
+    }
+  );
+  Mojo::IOLoop->start;
+  is $status->[0], 4000,     'right status';
+  is $status->[1], 'kaboom', 'right message';
+};
+
+subtest "Connection denied" => sub {
+  my ($stash, $code, $ws) = ();
+  app->plugins->once(before_dispatch => sub { $stash = shift->stash });
+  $ua->websocket(
+    '/denied' => sub {
+      my ($ua, $tx) = @_;
+      $ws   = $tx->is_websocket;
+      $code = $tx->res->code;
+      Mojo::IOLoop->stop;
+    }
+  );
+  Mojo::IOLoop->start;
+  Mojo::IOLoop->one_tick until $stash->{finished};
+  is $stash->{handshake}, 1, 'finish event has been emitted once for handshake';
+  is $stash->{finished},  1, 'finish event has been emitted once';
+  ok !$ws, 'not a WebSocket';
+  is $code, 403, 'right status';
+};
+
+subtest "Subrequests" => sub {
+  my ($stash, $code, $result) = ();
+  app->plugins->once(before_dispatch => sub { $stash = shift->stash });
+  $ua->websocket(
+    '/subreq' => sub {
+      my ($ua, $tx) = @_;
+      $code = $tx->res->code;
+      $tx->on(message => sub { $result .= pop });
+      $tx->on(finish  => sub { Mojo::IOLoop->stop });
+    }
+  );
+  Mojo::IOLoop->start;
+  Mojo::IOLoop->one_tick until $stash->{finished};
+  is $stash->{finished}, 1, 'finish event has been emitted once';
+  is $code,   101,          'right status';
+  is $result, 'test0test1', 'right result';
+};
+
+subtest "Concurrent subrequests" => sub {
+  my $delay = Mojo::IOLoop->delay;
+  my ($code, $result) = ();
+  my ($code2, $result2);
+  my $end = $delay->begin;
+  $ua->websocket(
+    '/subreq' => sub {
+      my ($ua, $tx) = @_;
+      $code = $tx->res->code;
+      $tx->on(
+        message => sub {
+          my ($tx, $msg) = @_;
+          $result .= $msg;
+          $tx->finish if $msg eq 'test1';
+        }
+      );
+      $tx->on(finish => sub { $end->() });
+    }
+  );
+  my $end2 = $delay->begin;
+  $ua->websocket(
+    '/subreq' => sub {
+      my ($ua, $tx) = @_;
+      $code2 = $tx->res->code;
+      $tx->on(message => sub { $result2 .= pop });
+      $tx->on(finish  => sub { $end2->() });
+    }
+  );
+  $delay->wait;
+  is $code,    101,          'right status';
+  is $result,  'test0test1', 'right result';
+  is $code2,   101,          'right status';
+  is $result2, 'test0test1', 'right result';
+};
+
+subtest "Client-side drain callback" => sub {
+  my $result = '';
+  my ($drain, $counter);
+  $ua->websocket(
+    '/echo' => sub {
+      my ($ua, $tx) = @_;
+      $tx->on(finish => sub { Mojo::IOLoop->stop });
+      $tx->on(
+        message => sub {
+          my ($tx, $msg) = @_;
+          $result .= $msg;
+          $tx->finish if ++$counter == 2;
+        }
+      );
+      $tx->send(
+        'hi!' => sub {
+          shift->send('there!');
+          $drain += @{Mojo::IOLoop->stream($tx->connection)->subscribers('drain')};
+        }
+      );
+    }
+  );
+  Mojo::IOLoop->start;
+  is $result, 'hi!there!', 'right result';
+  is $drain,  1,           'no leaking subscribers';
+};
+
+subtest "Server-side drain callback" => sub {
+  my $result  = '';
+  my $counter = 0;
+  $ua->websocket(
+    '/double_echo' => sub {
+      my ($ua, $tx) = @_;
+      $tx->on(finish => sub { Mojo::IOLoop->stop });
+      $tx->on(
+        message => sub {
+          my ($tx, $msg) = @_;
+          $result .= $msg;
+          $tx->finish if ++$counter == 2;
+        }
+      );
+      $tx->send('hi!');
+    }
+  );
+  Mojo::IOLoop->start;
+  is $result, 'hi!hi!', 'right result';
+};
+
+subtest "Sending objects" => sub {
+  my $result = undef;
+  $ua->websocket(
+    '/trim' => sub {
+      my ($ua, $tx) = @_;
+      $tx->on(finish  => sub { Mojo::IOLoop->stop });
+      $tx->on(message => sub { shift->finish; $result = shift });
+      $tx->send(b(' foo bar '));
+    }
+  );
+  Mojo::IOLoop->start;
+  is $result, 'foo bar', 'right result';
+};
+
+subtest "Promises" => sub {
+  my $result = undef;
+  $ua->websocket_p('/trim')->then(sub {
+      my $tx      = shift;
+      my $promise = Mojo::Promise->new;
+      $tx->on(finish  => sub { $promise->resolve });
+      $tx->on(message => sub { shift->finish; $result = pop });
+      $tx->send(' also works! ');
+      return $promise;
+    })->wait;
+  is $result, 'also works!', 'right result';
+  $result = undef;
+  $ua->websocket_p('/foo')->then(sub { $result = 'test failed' })->catch(sub { $result = shift })->wait;
+  is $result, 'WebSocket handshake failed', 'right result';
+  $result = undef;
+  $ua->websocket_p($ua->server->url->to_abs->scheme('wsss'))->then(sub { $result = 'test failed' })
   ->catch(sub { $result = shift })->wait;
-is $result, 'Unsupported protocol: wsss', 'right result';
-
-# Dies
-($ws, $code, $msg) = ();
-my $finished;
-$ua->websocket(
-  '/dead' => sub {
-    my ($ua, $tx) = @_;
-    $finished = $tx->is_finished;
-    $ws       = $tx->is_websocket;
-    $code     = $tx->res->code;
-    $msg      = $tx->res->message;
-    Mojo::IOLoop->stop;
-  }
-);
-Mojo::IOLoop->start;
-ok $finished, 'transaction is finished';
-ok !$ws, 'not a websocket';
-is $code, 500,                     'right status';
-is $msg,  'Internal Server Error', 'right message';
-
-# Forbidden
-($ws, $code, $msg) = ();
-$ua->websocket(
-  '/foo' => sub {
-    my ($ua, $tx) = @_;
-    $ws   = $tx->is_websocket;
-    $code = $tx->res->code;
-    $msg  = $tx->res->message;
-    Mojo::IOLoop->stop;
-  }
-);
-Mojo::IOLoop->start;
-ok !$ws, 'not a websocket';
-is $code, 403,            'right status';
-is $msg,  "i'm a teapot", 'right message';
-
-# Connection close
-$status = undef;
-$ua->websocket(
-  '/close' => sub {
-    my ($ua, $tx) = @_;
-    $tx->on(finish => sub { $status = pop; Mojo::IOLoop->stop });
-    $tx->send('test1');
-  }
-);
-Mojo::IOLoop->start;
-is $status, 1006, 'right status';
-
-# Unsupported protocol
-my $error;
-$ua->websocket(
-  'wsss://example.com' => sub {
-    my ($ua, $tx) = @_;
-    $error = $tx->error;
-    Mojo::IOLoop->stop;
-  }
-);
-Mojo::IOLoop->start;
-is $error->{message}, 'Unsupported protocol: wsss', 'right error';
-
-# 16-bit length
-$result = undef;
-$ua->websocket(
-  '/echo' => sub {
-    my ($ua, $tx) = @_;
-    $tx->on(finish  => sub { Mojo::IOLoop->stop });
-    $tx->on(message => sub { shift->finish; $result = shift });
-    $tx->send('hi!' x 100);
-  }
-);
-Mojo::IOLoop->start;
-is $result, 'hi!' x 100, 'right result';
-
-# Timeout
-my $log = '';
-$msg   = app->log->on(message => sub { $log .= pop });
-$stash = undef;
-app->plugins->once(before_dispatch => sub { $stash = shift->stash });
-$ua->websocket(
-  '/timeout' => sub {
-    pop->on(finish => sub { Mojo::IOLoop->stop });
-  }
-);
-Mojo::IOLoop->start;
-Mojo::IOLoop->one_tick until $stash->{finished};
-is $stash->{finished}, 1, 'finish event has been emitted once';
-like $log, qr/Inactivity timeout/, 'right log message';
-app->log->unsubscribe(message => $msg);
-
-# Ping/pong
-my $pong;
-$ua->websocket(
-  '/echo' => sub {
-    my ($ua, $tx) = @_;
-    $tx->on(
-      frame => sub {
-        my ($tx, $frame) = @_;
-        return unless $frame->[4] == 10;
-        $pong = $frame->[5];
-        $tx->finish;
-      }
-    );
-    $tx->on(finish => sub { Mojo::IOLoop->stop });
-    $tx->send([1, 0, 0, 0, 9, 'test']);
-  }
-);
-Mojo::IOLoop->start;
-is $pong, 'test', 'received pong with payload';
+  is $result, 'Unsupported protocol: wsss', 'right result';
+};
+
+subtest "Dies" => sub {
+  my ($ws, $code, $msg) = ();
+  my $finished;
+  $ua->websocket(
+    '/dead' => sub {
+      my ($ua, $tx) = @_;
+      $finished = $tx->is_finished;
+      $ws       = $tx->is_websocket;
+      $code     = $tx->res->code;
+      $msg      = $tx->res->message;
+      Mojo::IOLoop->stop;
+    }
+  );
+  Mojo::IOLoop->start;
+  ok $finished, 'transaction is finished';
+  ok !$ws, 'not a websocket';
+  is $code, 500,                     'right status';
+  is $msg,  'Internal Server Error', 'right message';
+};
+
+subtest "Forbidden" => sub {
+  my ($ws, $code, $msg) = ();
+  $ua->websocket(
+    '/foo' => sub {
+      my ($ua, $tx) = @_;
+      $ws   = $tx->is_websocket;
+      $code = $tx->res->code;
+      $msg  = $tx->res->message;
+      Mojo::IOLoop->stop;
+    }
+  );
+  Mojo::IOLoop->start;
+  ok !$ws, 'not a websocket';
+  is $code, 403,            'right status';
+  is $msg,  "i'm a teapot", 'right message';
+};
+
+subtest "Connection close" => sub {
+  my $status = undef;
+  $ua->websocket(
+    '/close' => sub {
+      my ($ua, $tx) = @_;
+      $tx->on(finish => sub { $status = pop; Mojo::IOLoop->stop });
+      $tx->send('test1');
+    }
+  );
+  Mojo::IOLoop->start;
+  is $status, 1006, 'right status';
+};
+
+subtest "Unsupported protocol" => sub {
+  my $error;
+  $ua->websocket(
+    'wsss://example.com' => sub {
+      my ($ua, $tx) = @_;
+      $error = $tx->error;
+      Mojo::IOLoop->stop;
+    }
+  );
+  Mojo::IOLoop->start;
+  is $error->{message}, 'Unsupported protocol: wsss', 'right error';
+};
+
+subtest "16-bit length" => sub {
+  my $result = undef;
+  $ua->websocket(
+    '/echo' => sub {
+      my ($ua, $tx) = @_;
+      $tx->on(finish  => sub { Mojo::IOLoop->stop });
+      $tx->on(message => sub { shift->finish; $result = shift });
+      $tx->send('hi!' x 100);
+    }
+  );
+  Mojo::IOLoop->start;
+  is $result, 'hi!' x 100, 'right result';
+};
+
+subtest "Timeout" => sub {
+  my $log = '';
+  my $msg   = app->log->on(message => sub { $log .= pop });
+  my $stash = undef;
+  app->plugins->once(before_dispatch => sub { $stash = shift->stash });
+  $ua->websocket(
+    '/timeout' => sub {
+      pop->on(finish => sub { Mojo::IOLoop->stop });
+    }
+  );
+  Mojo::IOLoop->start;
+  Mojo::IOLoop->one_tick until $stash->{finished};
+  is $stash->{finished}, 1, 'finish event has been emitted once';
+  like $log, qr/Inactivity timeout/, 'right log message';
+
+  app->log->unsubscribe(message => $msg);
+};
+
+subtest "Ping/pong" => sub {
+  my $pong;
+  $ua->websocket(
+    '/echo' => sub {
+      my ($ua, $tx) = @_;
+      $tx->on(
+        frame => sub {
+          my ($tx, $frame) = @_;
+          return unless $frame->[4] == 10;
+          $pong = $frame->[5];
+          $tx->finish;
+        }
+      );
+      $tx->on(finish => sub { Mojo::IOLoop->stop });
+      $tx->send([1, 0, 0, 0, 9, 'test']);
+    }
+  );
+  Mojo::IOLoop->start;
+  is $pong, 'test', 'received pong with payload';
+};
 
 done_testing();

From 8eea9f374d810b4abdb367c9e74f644c63b6294c Mon Sep 17 00:00:00 2001
From: Andrew Grangaard <granny-github@ofb.net>
Date: Sat, 31 Oct 2020 21:08:05 -0700
Subject: [PATCH 5/5] Convert websocket_frames.t to use subtests

---
 t/mojo/websocket_frames.t | 586 +++++++++++++++++++++-----------------
 1 file changed, 317 insertions(+), 269 deletions(-)

diff --git a/t/mojo/websocket_frames.t b/t/mojo/websocket_frames.t
index acd1872281..9bb0ffe4a1 100644
--- a/t/mojo/websocket_frames.t
+++ b/t/mojo/websocket_frames.t
@@ -4,274 +4,322 @@ use Test::More;
 use Mojo::Transaction::WebSocket;
 use Mojo::WebSocket qw(WS_BINARY WS_CLOSE WS_CONTINUATION WS_PING WS_PONG WS_TEXT), qw(build_frame parse_frame);
 
-# Simple text frame roundtrip
-my $bytes = build_frame 0, 1, 0, 0, 0, WS_TEXT, 'whatever';
-is $bytes, "\x81\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
-my $frame = parse_frame \(my $dummy = $bytes), 262144;
-is $frame->[0], 1,          'fin flag is set';
-is $frame->[1], 0,          'rsv1 flag is not set';
-is $frame->[2], 0,          'rsv2 flag is not set';
-is $frame->[3], 0,          'rsv3 flag is not set';
-is $frame->[4], 1,          'text frame';
-is $frame->[5], 'whatever', 'right payload';
-is build_frame(0, 1, 0, 0, 0, 1, 'whatever'), $bytes, 'frames are equal';
-
-# Simple ping frame roundtrip
-$bytes = build_frame 0, 1, 0, 0, 0, WS_PING, 'whatever';
-is $bytes, "\x89\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,          'fin flag is set';
-is $frame->[1], 0,          'rsv1 flag is not set';
-is $frame->[2], 0,          'rsv2 flag is not set';
-is $frame->[3], 0,          'rsv3 flag is not set';
-is $frame->[4], 9,          'ping frame';
-is $frame->[5], 'whatever', 'right payload';
-is build_frame(0, 1, 0, 0, 0, 9, 'whatever'), $bytes, 'frames are equal';
-
-# Simple pong frame roundtrip
-$bytes = build_frame 0, 1, 0, 0, 0, WS_PONG, 'whatever';
-is $bytes, "\x8a\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,          'fin flag is set';
-is $frame->[1], 0,          'rsv1 flag is not set';
-is $frame->[2], 0,          'rsv2 flag is not set';
-is $frame->[3], 0,          'rsv3 flag is not set';
-is $frame->[4], 10,         'pong frame';
-is $frame->[5], 'whatever', 'right payload';
-is build_frame(0, 1, 0, 0, 0, 10, 'whatever'), $bytes, 'frames are equal';
-
-# Simple text frame roundtrip with all flags set
-$bytes = build_frame 0, 1, 1, 1, 1, 1, 'whatever';
-is $bytes, "\xf1\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,          'fin flag is set';
-is $frame->[1], 1,          'rsv1 flag is set';
-is $frame->[2], 1,          'rsv2 flag is set';
-is $frame->[3], 1,          'rsv3 flag is set';
-is $frame->[4], 1,          'text frame';
-is $frame->[5], 'whatever', 'right payload';
-is build_frame(0, 1, 1, 1, 1, 1, 'whatever'), $bytes, 'frames are equal';
-
-# Simple text frame roundtrip without FIN bit
-$bytes = build_frame 0, 0, 0, 0, 0, 1, 'whatever';
-is $bytes, "\x01\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 0,          'fin flag is not set';
-is $frame->[1], 0,          'rsv1 flag is not set';
-is $frame->[2], 0,          'rsv2 flag is not set';
-is $frame->[3], 0,          'rsv3 flag is not set';
-is $frame->[4], 1,          'text frame';
-is $frame->[5], 'whatever', 'right payload';
-is build_frame(0, 0, 0, 0, 0, 1, 'whatever'), $bytes, 'frames are equal';
-
-# Simple text frame roundtrip with RSV1 flags set
-$bytes = build_frame(0, 1, 1, 0, 0, 1, 'whatever');
-is $bytes, "\xc1\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,          'fin flag is set';
-is $frame->[1], 1,          'rsv1 flag is set';
-is $frame->[2], 0,          'rsv2 flag is not set';
-is $frame->[3], 0,          'rsv3 flag is not set';
-is $frame->[4], 1,          'text frame';
-is $frame->[5], 'whatever', 'right payload';
-is build_frame(0, 1, 1, 0, 0, 1, 'whatever'), $bytes, 'frames are equal';
-
-# Simple continuation frame roundtrip with RSV2 flags set
-$bytes = build_frame(0, 1, 0, 1, 0, WS_CONTINUATION, 'whatever');
-is $bytes, "\xa0\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,          'fin flag is set';
-is $frame->[1], 0,          'rsv1 flag is not set';
-is $frame->[2], 1,          'rsv2 flag is set';
-is $frame->[3], 0,          'rsv3 flag is not set';
-is $frame->[4], 0,          'continuation frame';
-is $frame->[5], 'whatever', 'right payload';
-is build_frame(0, 1, 0, 1, 0, 0, 'whatever'), $bytes, 'frames are equal';
-
-# Simple text frame roundtrip with RSV3 flags set
-$bytes = build_frame(0, 1, 0, 0, 1, 1, 'whatever');
-is $bytes, "\x91\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,          'fin flag is set';
-is $frame->[1], 0,          'rsv1 flag is not set';
-is $frame->[2], 0,          'rsv2 flag is not set';
-is $frame->[3], 1,          'rsv3 flag is set';
-is $frame->[4], 1,          'text frame';
-is $frame->[5], 'whatever', 'right payload';
-is build_frame(0, 1, 0, 0, 1, 1, 'whatever'), $bytes, 'frames are equal';
-
-# Simple binary frame roundtrip
-$bytes = build_frame(0, 1, 0, 0, 0, WS_BINARY, 'works');
-is $bytes, "\x82\x05\x77\x6f\x72\x6b\x73", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,       'fin flag is set';
-is $frame->[1], 0,       'rsv1 flag is not set';
-is $frame->[2], 0,       'rsv2 flag is not set';
-is $frame->[3], 0,       'rsv3 flag is not set';
-is $frame->[4], 2,       'binary frame';
-is $frame->[5], 'works', 'right payload';
-is $bytes = build_frame(0, 1, 0, 0, 0, 2, 'works'), $bytes, 'frames are equal';
-
-# Masked text frame roundtrip
-$bytes = build_frame 1, 1, 0, 0, 0, 1, 'also works';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,            'fin flag is set';
-is $frame->[1], 0,            'rsv1 flag is not set';
-is $frame->[2], 0,            'rsv2 flag is not set';
-is $frame->[3], 0,            'rsv3 flag is not set';
-is $frame->[4], 1,            'text frame';
-is $frame->[5], 'also works', 'right payload';
-isnt(build_frame(0, 1, 0, 0, 0, 2, 'also works'), $bytes, 'frames are not equal');
-
-# Masked binary frame roundtrip
-$bytes = build_frame(1, 1, 0, 0, 0, 2, 'just works');
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,            'fin flag is set';
-is $frame->[1], 0,            'rsv1 flag is not set';
-is $frame->[2], 0,            'rsv2 flag is not set';
-is $frame->[3], 0,            'rsv3 flag is not set';
-is $frame->[4], 2,            'binary frame';
-is $frame->[5], 'just works', 'right payload';
-isnt(build_frame(0, 1, 0, 0, 0, 2, 'just works'), $bytes, 'frames are not equal');
-
-# One-character text frame roundtrip
-$bytes = build_frame(0, 1, 0, 0, 0, 1, 'a');
-is $bytes, "\x81\x01\x61", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,   'fin flag is set';
-is $frame->[1], 0,   'rsv1 flag is not set';
-is $frame->[2], 0,   'rsv2 flag is not set';
-is $frame->[3], 0,   'rsv3 flag is not set';
-is $frame->[4], 1,   'text frame';
-is $frame->[5], 'a', 'right payload';
-is build_frame(0, 1, 0, 0, 0, 1, 'a'), $bytes, 'frames are equal';
-
-# One-byte binary frame roundtrip
-$bytes = build_frame(0, 1, 0, 0, 0, 2, 'a');
-is $bytes, "\x82\x01\x61", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,   'fin flag is set';
-is $frame->[1], 0,   'rsv1 flag is not set';
-is $frame->[2], 0,   'rsv2 flag is not set';
-is $frame->[3], 0,   'rsv3 flag is not set';
-is $frame->[4], 2,   'binary frame';
-is $frame->[5], 'a', 'right payload';
-is $bytes = build_frame(0, 1, 0, 0, 0, 2, 'a'), $bytes, 'frames are equal';
-
-# 16-bit text frame roundtrip
-$bytes = build_frame(0, 1, 0, 0, 0, 1, 'hi' x 10000);
-is $bytes, "\x81\x7e\x4e\x20" . ("\x68\x69" x 10000), 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1, 'fin flag is set';
-is $frame->[1], 0, 'rsv1 flag is not set';
-is $frame->[2], 0, 'rsv2 flag is not set';
-is $frame->[3], 0, 'rsv3 flag is not set';
-is $frame->[4], 1, 'text frame';
-is $frame->[5], 'hi' x 10000, 'right payload';
-is build_frame(0, 1, 0, 0, 0, 1, 'hi' x 10000), $bytes, 'frames are equal';
-
-# 64-bit text frame roundtrip
-$bytes = build_frame(0, 1, 0, 0, 0, 1, 'hi' x 200000);
-is $bytes, "\x81\x7f\x00\x00\x00\x00\x00\x06\x1a\x80" . ("\x68\x69" x 200000), 'right frame';
-$frame = parse_frame \($dummy = $bytes), 500000;
-is $frame->[0], 1, 'fin flag is set';
-is $frame->[1], 0, 'rsv1 flag is not set';
-is $frame->[2], 0, 'rsv2 flag is not set';
-is $frame->[3], 0, 'rsv3 flag is not set';
-is $frame->[4], 1, 'text frame';
-is $frame->[5], 'hi' x 200000, 'right payload';
-is build_frame(0, 1, 0, 0, 0, 1, 'hi' x 200000), $bytes, 'frames are equal';
-
-# Empty text frame roundtrip
-$bytes = build_frame(0, 1, 0, 0, 0, 1, '');
-is $bytes, "\x81\x00", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,  'fin flag is set';
-is $frame->[1], 0,  'rsv1 flag is not set';
-is $frame->[2], 0,  'rsv2 flag is not set';
-is $frame->[3], 0,  'rsv3 flag is not set';
-is $frame->[4], 1,  'text frame';
-is $frame->[5], '', 'no payload';
-is build_frame(0, 1, 0, 0, 0, 1, ''), $bytes, 'frames are equal';
-
-# Empty close frame roundtrip
-$bytes = build_frame(0, 1, 0, 0, 0, WS_CLOSE, '');
-is $bytes, "\x88\x00", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,  'fin flag is set';
-is $frame->[1], 0,  'rsv1 flag is not set';
-is $frame->[2], 0,  'rsv2 flag is not set';
-is $frame->[3], 0,  'rsv3 flag is not set';
-is $frame->[4], 8,  'close frame';
-is $frame->[5], '', 'no payload';
-is build_frame(0, 1, 0, 0, 0, 8, ''), $bytes, 'frames are equal';
-
-# Masked empty binary frame roundtrip
-$bytes = build_frame(1, 1, 0, 0, 0, 2, '');
-$frame = parse_frame \($dummy = $bytes), 262144;
-is $frame->[0], 1,  'fin flag is set';
-is $frame->[1], 0,  'rsv1 flag is not set';
-is $frame->[2], 0,  'rsv2 flag is not set';
-is $frame->[3], 0,  'rsv3 flag is not set';
-is $frame->[4], 2,  'binary frame';
-is $frame->[5], '', 'no payload';
-isnt(build_frame(0, 1, 0, 0, 0, 2, ''), $bytes, 'frames are not equal');
-
-# Size limit
-$bytes = build_frame(0, 1, 0, 0, 0, WS_BINARY, 'works');
-is $bytes, "\x82\x05\x77\x6f\x72\x6b\x73", 'right frame';
-$frame = parse_frame \($dummy = $bytes), 4;
-ok $frame, 'true';
-ok !ref $frame, 'not a reference';
-
-# Incomplete frame
-is parse_frame(\($dummy = "\x82\x05\x77\x6f\x72\x6b"), 262144), undef, 'incomplete frame';
-
-# Fragmented message
-my $fragmented = Mojo::Transaction::WebSocket->new;
-my $text;
-$fragmented->on(text => sub { $text = pop });
-$fragmented->parse_message([0, 0, 0, 0, WS_TEXT, 'wo']);
-ok !$text, 'text event has not been emitted yet';
-$fragmented->parse_message([0, 0, 0, 0, WS_CONTINUATION, 'r']);
-ok !$text, 'text event has not been emitted yet';
-$fragmented->parse_message([1, 0, 0, 0, WS_CONTINUATION, 'ks!']);
-is $text, 'works!', 'right payload';
-
-# Compressed binary message
-my $compressed = Mojo::Transaction::WebSocket->new({compressed => 1});
-$frame = $compressed->build_message({binary => 'just works'});
-is $frame->[0], 1, 'fin flag is set';
-is $frame->[1], 1, 'rsv1 flag is set';
-is $frame->[2], 0, 'rsv2 flag is not set';
-is $frame->[3], 0, 'rsv3 flag is not set';
-is $frame->[4], WS_BINARY, 'binary frame';
-ok $frame->[5], 'has payload';
-my $payload = $compressed->build_message({binary => 'just works'})->[5];
-isnt $frame->[5], $payload, 'different payload';
-ok length $frame->[5] > length $payload, 'payload is smaller';
-my $uncompressed = Mojo::Transaction::WebSocket->new;
-my $frame2       = $uncompressed->build_message({binary => 'just works'});
-is $frame2->[0],  1, 'fin flag is set';
-is $frame2->[1],  0, 'rsv1 flag is not set';
-is $frame2->[2],  0, 'rsv2 flag is not set';
-is $frame2->[3],  0, 'rsv3 flag is not set';
-is $frame2->[4],  WS_BINARY, 'binary frame';
-ok $frame2->[5],  'has payload';
-isnt $frame->[5], $frame2->[5], 'different payload';
-is $frame2->[5],  $uncompressed->build_message({binary => 'just works'})->[5], 'same payload';
-
-# Compressed fragmented message
-my $fragmented_compressed = Mojo::Transaction::WebSocket->new({compressed => 1});
-$text = undef;
-$fragmented_compressed->on(message => sub { $text = pop });
-my $compressed_payload = $fragmented_compressed->build_message({text => 'just works'})->[5];
-ok !$text, 'message event has not been emitted yet';
-$fragmented_compressed->parse_message([0, 1, 0, 0, WS_TEXT, substr($compressed_payload, 0, 3)]);
-ok !$text, 'message event has not been emitted yet';
-$fragmented_compressed->parse_message([0, 0, 0, 0, WS_CONTINUATION, substr($compressed_payload, 3, 3)]);
-ok !$text, 'message event has not been emitted yet';
-$fragmented_compressed->parse_message([1, 0, 0, 0, WS_CONTINUATION, substr($compressed_payload, 6)]);
-is $text, 'just works', 'decoded correctly';
+my $dummy;
+
+subtest "Simple text frame roundtrip" => sub {
+  my $bytes = build_frame 0, 1, 0, 0, 0, WS_TEXT, 'whatever';
+  is $bytes, "\x81\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
+
+  my $frame = parse_frame \(my $dummy = $bytes), 262144;
+  is $frame->[0], 1,          'fin flag is set';
+  is $frame->[1], 0,          'rsv1 flag is not set';
+  is $frame->[2], 0,          'rsv2 flag is not set';
+  is $frame->[3], 0,          'rsv3 flag is not set';
+  is $frame->[4], 1,          'text frame';
+  is $frame->[5], 'whatever', 'right payload';
+  is build_frame(0, 1, 0, 0, 0, 1, 'whatever'), $bytes, 'frames are equal';
+};
+
+subtest "Simple ping frame roundtrip" => sub {
+  my $bytes = build_frame 0, 1, 0, 0, 0, WS_PING, 'whatever';
+  is $bytes, "\x89\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,          'fin flag is set';
+  is $frame->[1], 0,          'rsv1 flag is not set';
+  is $frame->[2], 0,          'rsv2 flag is not set';
+  is $frame->[3], 0,          'rsv3 flag is not set';
+  is $frame->[4], 9,          'ping frame';
+  is $frame->[5], 'whatever', 'right payload';
+  is build_frame(0, 1, 0, 0, 0, 9, 'whatever'), $bytes, 'frames are equal';
+};
+
+subtest "Simple pong frame roundtrip" => sub {
+  my $bytes = build_frame 0, 1, 0, 0, 0, WS_PONG, 'whatever';
+  is $bytes, "\x8a\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,          'fin flag is set';
+  is $frame->[1], 0,          'rsv1 flag is not set';
+  is $frame->[2], 0,          'rsv2 flag is not set';
+  is $frame->[3], 0,          'rsv3 flag is not set';
+  is $frame->[4], 10,         'pong frame';
+  is $frame->[5], 'whatever', 'right payload';
+  is build_frame(0, 1, 0, 0, 0, 10, 'whatever'), $bytes, 'frames are equal';
+};
+
+subtest "Simple text frame roundtrip with all flags set" => sub {
+  my $bytes = build_frame 0, 1, 1, 1, 1, 1, 'whatever';
+  is $bytes, "\xf1\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,          'fin flag is set';
+  is $frame->[1], 1,          'rsv1 flag is set';
+  is $frame->[2], 1,          'rsv2 flag is set';
+  is $frame->[3], 1,          'rsv3 flag is set';
+  is $frame->[4], 1,          'text frame';
+  is $frame->[5], 'whatever', 'right payload';
+  is build_frame(0, 1, 1, 1, 1, 1, 'whatever'), $bytes, 'frames are equal';
+};
+
+subtest "Simple text frame roundtrip without FIN bit" => sub {
+  my $bytes = build_frame 0, 0, 0, 0, 0, 1, 'whatever';
+  is $bytes, "\x01\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 0,          'fin flag is not set';
+  is $frame->[1], 0,          'rsv1 flag is not set';
+  is $frame->[2], 0,          'rsv2 flag is not set';
+  is $frame->[3], 0,          'rsv3 flag is not set';
+  is $frame->[4], 1,          'text frame';
+  is $frame->[5], 'whatever', 'right payload';
+  is build_frame(0, 0, 0, 0, 0, 1, 'whatever'), $bytes, 'frames are equal';
+};
+
+subtest "Simple text frame roundtrip with RSV1 flags set" => sub {
+  my $bytes = build_frame(0, 1, 1, 0, 0, 1, 'whatever');
+  is $bytes, "\xc1\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,          'fin flag is set';
+  is $frame->[1], 1,          'rsv1 flag is set';
+  is $frame->[2], 0,          'rsv2 flag is not set';
+  is $frame->[3], 0,          'rsv3 flag is not set';
+  is $frame->[4], 1,          'text frame';
+  is $frame->[5], 'whatever', 'right payload';
+  is build_frame(0, 1, 1, 0, 0, 1, 'whatever'), $bytes, 'frames are equal';
+};
+
+subtest "Simple continuation frame roundtrip with RSV2 flags set" => sub {
+  my $bytes = build_frame(0, 1, 0, 1, 0, WS_CONTINUATION, 'whatever');
+  is $bytes, "\xa0\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+
+  is $frame->[0], 1,          'fin flag is set';
+  is $frame->[1], 0,          'rsv1 flag is not set';
+  is $frame->[2], 1,          'rsv2 flag is set';
+  is $frame->[3], 0,          'rsv3 flag is not set';
+  is $frame->[4], 0,          'continuation frame';
+  is $frame->[5], 'whatever', 'right payload';
+  is build_frame(0, 1, 0, 1, 0, 0, 'whatever'), $bytes, 'frames are equal';
+};
+
+subtest "Simple text frame roundtrip with RSV3 flags set" => sub {
+  my $bytes = build_frame(0, 1, 0, 0, 1, 1, 'whatever');
+  is $bytes, "\x91\x08\x77\x68\x61\x74\x65\x76\x65\x72", 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,          'fin flag is set';
+  is $frame->[1], 0,          'rsv1 flag is not set';
+  is $frame->[2], 0,          'rsv2 flag is not set';
+  is $frame->[3], 1,          'rsv3 flag is set';
+  is $frame->[4], 1,          'text frame';
+  is $frame->[5], 'whatever', 'right payload';
+  is build_frame(0, 1, 0, 0, 1, 1, 'whatever'), $bytes, 'frames are equal';
+};
+
+subtest "Simple binary frame roundtrip" => sub {
+  my $bytes = build_frame(0, 1, 0, 0, 0, WS_BINARY, 'works');
+  is $bytes, "\x82\x05\x77\x6f\x72\x6b\x73", 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,       'fin flag is set';
+  is $frame->[1], 0,       'rsv1 flag is not set';
+  is $frame->[2], 0,       'rsv2 flag is not set';
+  is $frame->[3], 0,       'rsv3 flag is not set';
+  is $frame->[4], 2,       'binary frame';
+  is $frame->[5], 'works', 'right payload';
+  is $bytes = build_frame(0, 1, 0, 0, 0, 2, 'works'), $bytes, 'frames are equal';
+};
+
+subtest "Masked text frame roundtrip" => sub {
+  my $bytes = build_frame 1, 1, 0, 0, 0, 1, 'also works';
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,            'fin flag is set';
+  is $frame->[1], 0,            'rsv1 flag is not set';
+  is $frame->[2], 0,            'rsv2 flag is not set';
+  is $frame->[3], 0,            'rsv3 flag is not set';
+  is $frame->[4], 1,            'text frame';
+  is $frame->[5], 'also works', 'right payload';
+  isnt(build_frame(0, 1, 0, 0, 0, 2, 'also works'), $bytes, 'frames are not equal');
+};
+
+subtest "Masked binary frame roundtrip" => sub {
+  my $bytes = build_frame(1, 1, 0, 0, 0, 2, 'just works');
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,            'fin flag is set';
+  is $frame->[1], 0,            'rsv1 flag is not set';
+  is $frame->[2], 0,            'rsv2 flag is not set';
+  is $frame->[3], 0,            'rsv3 flag is not set';
+  is $frame->[4], 2,            'binary frame';
+  is $frame->[5], 'just works', 'right payload';
+  isnt(build_frame(0, 1, 0, 0, 0, 2, 'just works'), $bytes, 'frames are not equal');
+};
+
+subtest "One-character text frame roundtrip" => sub {
+  my $bytes = build_frame(0, 1, 0, 0, 0, 1, 'a');
+  is $bytes, "\x81\x01\x61", 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,   'fin flag is set';
+  is $frame->[1], 0,   'rsv1 flag is not set';
+  is $frame->[2], 0,   'rsv2 flag is not set';
+  is $frame->[3], 0,   'rsv3 flag is not set';
+  is $frame->[4], 1,   'text frame';
+  is $frame->[5], 'a', 'right payload';
+  is build_frame(0, 1, 0, 0, 0, 1, 'a'), $bytes, 'frames are equal';
+};
+
+subtest "One-byte binary frame roundtrip" => sub {
+  my $bytes = build_frame(0, 1, 0, 0, 0, 2, 'a');
+  is $bytes, "\x82\x01\x61", 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,   'fin flag is set';
+  is $frame->[1], 0,   'rsv1 flag is not set';
+  is $frame->[2], 0,   'rsv2 flag is not set';
+  is $frame->[3], 0,   'rsv3 flag is not set';
+  is $frame->[4], 2,   'binary frame';
+  is $frame->[5], 'a', 'right payload';
+  is $bytes = build_frame(0, 1, 0, 0, 0, 2, 'a'), $bytes, 'frames are equal';
+};
+
+subtest "16-bit text frame roundtrip" => sub {
+  my $bytes = build_frame(0, 1, 0, 0, 0, 1, 'hi' x 10000);
+  is $bytes, "\x81\x7e\x4e\x20" . ("\x68\x69" x 10000), 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1, 'fin flag is set';
+  is $frame->[1], 0, 'rsv1 flag is not set';
+  is $frame->[2], 0, 'rsv2 flag is not set';
+  is $frame->[3], 0, 'rsv3 flag is not set';
+  is $frame->[4], 1, 'text frame';
+  is $frame->[5], 'hi' x 10000, 'right payload';
+  is build_frame(0, 1, 0, 0, 0, 1, 'hi' x 10000), $bytes, 'frames are equal';
+};
+
+subtest "64-bit text frame roundtrip" => sub {
+  my $bytes = build_frame(0, 1, 0, 0, 0, 1, 'hi' x 200000);
+  is $bytes, "\x81\x7f\x00\x00\x00\x00\x00\x06\x1a\x80" . ("\x68\x69" x 200000), 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 500000;
+  is $frame->[0], 1, 'fin flag is set';
+  is $frame->[1], 0, 'rsv1 flag is not set';
+  is $frame->[2], 0, 'rsv2 flag is not set';
+  is $frame->[3], 0, 'rsv3 flag is not set';
+  is $frame->[4], 1, 'text frame';
+  is $frame->[5], 'hi' x 200000, 'right payload';
+  is build_frame(0, 1, 0, 0, 0, 1, 'hi' x 200000), $bytes, 'frames are equal';
+};
+
+subtest "Empty text frame roundtrip" => sub {
+  my $bytes = build_frame(0, 1, 0, 0, 0, 1, '');
+  is $bytes, "\x81\x00", 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,  'fin flag is set';
+  is $frame->[1], 0,  'rsv1 flag is not set';
+  is $frame->[2], 0,  'rsv2 flag is not set';
+  is $frame->[3], 0,  'rsv3 flag is not set';
+  is $frame->[4], 1,  'text frame';
+  is $frame->[5], '', 'no payload';
+  is build_frame(0, 1, 0, 0, 0, 1, ''), $bytes, 'frames are equal';
+};
+
+subtest "Empty close frame roundtrip" => sub {
+  my $bytes = build_frame(0, 1, 0, 0, 0, WS_CLOSE, '');
+  is $bytes, "\x88\x00", 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,  'fin flag is set';
+  is $frame->[1], 0,  'rsv1 flag is not set';
+  is $frame->[2], 0,  'rsv2 flag is not set';
+  is $frame->[3], 0,  'rsv3 flag is not set';
+  is $frame->[4], 8,  'close frame';
+  is $frame->[5], '', 'no payload';
+  is build_frame(0, 1, 0, 0, 0, 8, ''), $bytes, 'frames are equal';
+};
+
+subtest "Masked empty binary frame roundtrip" => sub {
+  my $bytes = build_frame(1, 1, 0, 0, 0, 2, '');
+  my $frame = parse_frame \($dummy = $bytes), 262144;
+  is $frame->[0], 1,  'fin flag is set';
+  is $frame->[1], 0,  'rsv1 flag is not set';
+  is $frame->[2], 0,  'rsv2 flag is not set';
+  is $frame->[3], 0,  'rsv3 flag is not set';
+  is $frame->[4], 2,  'binary frame';
+  is $frame->[5], '', 'no payload';
+  isnt(build_frame(0, 1, 0, 0, 0, 2, ''), $bytes, 'frames are not equal');
+};
+
+subtest "Size limit" => sub {
+  my $bytes = build_frame(0, 1, 0, 0, 0, WS_BINARY, 'works');
+  is $bytes, "\x82\x05\x77\x6f\x72\x6b\x73", 'right frame';
+
+  my $frame = parse_frame \($dummy = $bytes), 4;
+  ok $frame, 'true';
+  ok !ref $frame, 'not a reference';
+};
+
+subtest "Incomplete frame" => sub {
+  is parse_frame(\($dummy = "\x82\x05\x77\x6f\x72\x6b"), 262144), undef, 'incomplete frame';
+};
+
+subtest "Fragmented message" => sub {
+  my $fragmented = Mojo::Transaction::WebSocket->new;
+  my $text;
+  $fragmented->on(text => sub { $text = pop });
+  $fragmented->parse_message([0, 0, 0, 0, WS_TEXT, 'wo']);
+  ok !$text, 'text event has not been emitted yet';
+
+  $fragmented->parse_message([0, 0, 0, 0, WS_CONTINUATION, 'r']);
+  ok !$text, 'text event has not been emitted yet';
+
+  $fragmented->parse_message([1, 0, 0, 0, WS_CONTINUATION, 'ks!']);
+  is $text, 'works!', 'right payload';
+};
+
+subtest "Compressed binary message" => sub {
+  my $compressed = Mojo::Transaction::WebSocket->new({compressed => 1});
+  my $frame = $compressed->build_message({binary => 'just works'});
+  is $frame->[0], 1, 'fin flag is set';
+  is $frame->[1], 1, 'rsv1 flag is set';
+  is $frame->[2], 0, 'rsv2 flag is not set';
+  is $frame->[3], 0, 'rsv3 flag is not set';
+  is $frame->[4], WS_BINARY, 'binary frame';
+  ok $frame->[5], 'has payload';
+
+  my $payload = $compressed->build_message({binary => 'just works'})->[5];
+  isnt $frame->[5], $payload, 'different payload';
+  ok length $frame->[5] > length $payload, 'payload is smaller';
+
+  my $uncompressed = Mojo::Transaction::WebSocket->new;
+  my $frame2       = $uncompressed->build_message({binary => 'just works'});
+  is $frame2->[0],  1, 'fin flag is set';
+  is $frame2->[1],  0, 'rsv1 flag is not set';
+  is $frame2->[2],  0, 'rsv2 flag is not set';
+  is $frame2->[3],  0, 'rsv3 flag is not set';
+  is $frame2->[4],  WS_BINARY, 'binary frame';
+  ok $frame2->[5],  'has payload';
+  isnt $frame->[5], $frame2->[5], 'different payload';
+  is $frame2->[5],  $uncompressed->build_message({binary => 'just works'})->[5], 'same payload';
+};
+
+subtest "Compressed fragmented message" => sub {
+  my $fragmented_compressed = Mojo::Transaction::WebSocket->new({compressed => 1});
+  my $text = undef;
+  $fragmented_compressed->on(message => sub { $text = pop });
+  my $compressed_payload = $fragmented_compressed->build_message({text => 'just works'})->[5];
+  ok !$text, 'message event has not been emitted yet';
+
+  $fragmented_compressed->parse_message([0, 1, 0, 0, WS_TEXT, substr($compressed_payload, 0, 3)]);
+  ok !$text, 'message event has not been emitted yet';
+
+  $fragmented_compressed->parse_message([0, 0, 0, 0, WS_CONTINUATION, substr($compressed_payload, 3, 3)]);
+  ok !$text, 'message event has not been emitted yet';
+
+  $fragmented_compressed->parse_message([1, 0, 0, 0, WS_CONTINUATION, substr($compressed_payload, 6)]);
+  is $text, 'just works', 'decoded correctly';
+};
 
 done_testing();