AnyEvent-MCP/t/13_vim_stdio.t

use common::sense;
use Test::More;
use JSON::XS ();
use IPC::Open3 ();
use IO::Select ();
use IO::Socket::INET ();
use POSIX qw(WNOHANG);
use Time::HiRes ();
use File::Temp ();
use File::Path ();
use Symbol ();

my $dir = File::Temp::tempdir (CLEANUP => 1);
File::Path::mkpath (["$dir/home", "$dir/config"], 0, 0700);
local $ENV{HOME} = "$dir/home";
local $ENV{XDG_CONFIG_HOME} = "$dir/config";

sub free_port {
   my $socket = IO::Socket::INET->new (
      LocalAddr => "127.0.0.1", LocalPort => 0,
      Proto => "tcp", Listen => 1,
   ) or die "cannot allocate TCP test port: $!";
   my $port = $socket->sockport;
   close $socket;
   $port
}

sub start_child {
   my ($use_env) = @_;
   my $port = free_port;
   local $ENV{PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL} = $use_env ? "stdio" : "";
   my $err = Symbol::gensym;
   my $pid = IPC::Open3::open3 (my $in, my $out, $err,
      $^X, "-Ilib", "-e",
      'unshift @INC, sub { die "WebSocket must not be loaded\n" if $_[1] =~ m{^AnyEvent/WebSocket/}; return }; do shift @ARGV; die $@ if $@;',
      "bin/mcp-vim", "--bind", "127.0.0.1:$port", ($use_env ? () : ("--stdio")));
   my $old = select $in;
   $| = 1;
   select $old;
   ($pid, $in, $out, $err, $port)
}

sub rpc {
   my ($in, $out, $id, $method, $params) = @_;
   print {$in} JSON::XS::encode_json ({
      jsonrpc => "2.0", id => $id, method => $method, params => $params,
   }), "\n" or die "cannot send JSONL test request: $!";
   return unless IO::Select->new ($out)->can_read (30);
   my $line = <$out>;
   return unless defined $line;
   eval { JSON::XS::decode_json $line }
}

sub wait_exit {
   my ($pid) = @_;
   for (1 .. 1500) {
      my $w = waitpid ($pid, WNOHANG);
      return $? >> 8 if $w == $pid;
      Time::HiRes::sleep (0.02);
   }
   kill TERM => $pid;
   waitpid ($pid, 0);
   -1
}

for my $use_env (0, 1) {
   my $kind = $use_env ? "multibroker environment" : "explicit --stdio";
   my ($pid, $in, $out, $err, $port) = start_child ($use_env);

   my $init = rpc ($in, $out, 1, "initialize", {
      protocolVersion => "2025-11-25",
      capabilities => {}, clientInfo => { name => "stdio-test", version => "0" },
   });

   is $init->{id}, 1, "$kind: JSONL initialize response";
   ok !$init->{error} && $init->{result}{serverInfo},
      "$kind: valid MCP server metadata";

   my $tools = rpc ($in, $out, 2, "tools/list", {});
   is $tools->{id}, 2, "$kind: JSONL tools/list response";
   is_deeply [sort map $_->{name}, @{$tools->{result}{tools} || []}],
      [sort qw(targets state open read-lines grep apply-diff substitute undo redo save set-cursor ex meta-instructions)],
      "$kind: exposes thirteen unprefixed Vim tools including metadata";
   my ($substitute) = grep $_->{name} eq "substitute", @{$tools->{result}{tools} || []};
   ok defined $substitute && index ($substitute->{description}, q{\%^\_.*\%$}) >= 0,
      "$kind: substitute description preserves Vim regex backslashes and end anchor";
   ok !$tools->{error},
      "$kind: tools/list returned without an error";

   # The stdio transport must not prevent the normal Vim/browser TCP listener.
   my $sock;
   for (1 .. 1500) {
      $sock = IO::Socket::INET->new (
         PeerAddr => "127.0.0.1", PeerPort => $port,
         Proto => "tcp", Timeout => 1,
      );
      last if $sock;
      Time::HiRes::sleep (0.02);
   }
   ok $sock, "$kind: TCP listener remains available";
   if ($sock) {
      $sock->autoflush (1);
      print {$sock}
         "POST / HTTP/1.1\r\nHost: localhost\r\n"
         . "Content-Type: application/json\r\nContent-Length: 2\r\n\r\n{}";
      my $response = IO::Select->new ($sock)->can_read (30) ? <$sock> : undef;
      like $response, qr{\AHTTP/1\.1 401\b},
         "$kind: TCP listener still serves authenticated MCP HTTP";
      close $sock;
   } else {
      fail "$kind: HTTP listener response";
   }

   close $in;
   is wait_exit ($pid), 0, "$kind: stdin EOF stops the child cleanly";
   my $extra = <$out>;
   ok !defined $extra, "$kind: no extraneous stdout after final MCP response";
   close $out;
   close $err;
}

done_testing;
Revision:	1.12
Committed:	Sat Oct 24 09:22:21 2026 UTC (21 hours, 41 minutes ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.11:	+3 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	use common::sense;
2			use Test::More;
3			use JSON::XS ();
4			use IPC::Open3 ();
5			use IO::Select ();
6			use IO::Socket::INET ();
7			use POSIX qw(WNOHANG);
8			use Time::HiRes ();
9			use File::Temp ();
10			use File::Path ();
11			use Symbol ();
12
13			my $dir = File::Temp::tempdir (CLEANUP => 1);
14			File::Path::mkpath (["$dir/home", "$dir/config"], 0, 0700);
15			local $ENV{HOME} = "$dir/home";
16			local $ENV{XDG_CONFIG_HOME} = "$dir/config";
17
18			sub free_port {
19			my $socket = IO::Socket::INET->new (
20			LocalAddr => "127.0.0.1", LocalPort => 0,
21			Proto => "tcp", Listen => 1,
22			) or die "cannot allocate TCP test port: $!";
23			my $port = $socket->sockport;
24			close $socket;
25			$port
26			}
27
28			sub start_child {
29			my ($use_env) = @_;
30			my $port = free_port;
31			local $ENV{PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL} = $use_env ? "stdio" : "";
32			my $err = Symbol::gensym;
33			my $pid = IPC::Open3::open3 (my $in, my $out, $err,
34	root	1.12	$^X, "-Ilib", "-e",
35			'unshift @INC, sub { die "WebSocket must not be loaded\n" if $_[1] =~ m{^AnyEvent/WebSocket/}; return }; do shift @ARGV; die $@ if $@;',
36			"bin/mcp-vim", "--bind", "127.0.0.1:$port", ($use_env ? () : ("--stdio")));
37	root	1.1	my $old = select $in;
38			$\| = 1;
39			select $old;
40			($pid, $in, $out, $err, $port)
41			}
42
43			sub rpc {
44			my ($in, $out, $id, $method, $params) = @_;
45			print {$in} JSON::XS::encode_json ({
46			jsonrpc => "2.0", id => $id, method => $method, params => $params,
47			}), "\n" or die "cannot send JSONL test request: $!";
48	root	1.6	return unless IO::Select->new ($out)->can_read (30);
49	root	1.1	my $line = <$out>;
50			return unless defined $line;
51			eval { JSON::XS::decode_json $line }
52			}
53
54			sub wait_exit {
55			my ($pid) = @_;
56	root	1.6	for (1 .. 1500) {
57	root	1.1	my $w = waitpid ($pid, WNOHANG);
58			return $? >> 8 if $w == $pid;
59			Time::HiRes::sleep (0.02);
60			}
61			kill TERM => $pid;
62			waitpid ($pid, 0);
63			-1
64			}
65
66			for my $use_env (0, 1) {
67			my $kind = $use_env ? "multibroker environment" : "explicit --stdio";
68			my ($pid, $in, $out, $err, $port) = start_child ($use_env);
69
70			my $init = rpc ($in, $out, 1, "initialize", {
71			protocolVersion => "2025-11-25",
72			capabilities => {}, clientInfo => { name => "stdio-test", version => "0" },
73			});
74
75			is $init->{id}, 1, "$kind: JSONL initialize response";
76			ok !$init->{error} && $init->{result}{serverInfo},
77			"$kind: valid MCP server metadata";
78
79			my $tools = rpc ($in, $out, 2, "tools/list", {});
80			is $tools->{id}, 2, "$kind: JSONL tools/list response";
81	root	1.3	is_deeply [sort map $_->{name}, @{$tools->{result}{tools} \|\| []}],
82	root	1.11	[sort qw(targets state open read-lines grep apply-diff substitute undo redo save set-cursor ex meta-instructions)],
83			"$kind: exposes thirteen unprefixed Vim tools including metadata";
84	root	1.4	my ($substitute) = grep $_->{name} eq "substitute", @{$tools->{result}{tools} \|\| []};
85			ok defined $substitute && index ($substitute->{description}, q{\%^\_.*\%$}) >= 0,
86			"$kind: substitute description preserves Vim regex backslashes and end anchor";
87	root	1.3	ok !$tools->{error},
88			"$kind: tools/list returned without an error";
89	root	1.1
90			# The stdio transport must not prevent the normal Vim/browser TCP listener.
91			my $sock;
92	root	1.6	for (1 .. 1500) {
93	root	1.1	$sock = IO::Socket::INET->new (
94			PeerAddr => "127.0.0.1", PeerPort => $port,
95			Proto => "tcp", Timeout => 1,
96			);
97			last if $sock;
98			Time::HiRes::sleep (0.02);
99			}
100			ok $sock, "$kind: TCP listener remains available";
101			if ($sock) {
102			$sock->autoflush (1);
103			print {$sock}
104			"POST / HTTP/1.1\r\nHost: localhost\r\n"
105			. "Content-Type: application/json\r\nContent-Length: 2\r\n\r\n{}";
106	root	1.6	my $response = IO::Select->new ($sock)->can_read (30) ? <$sock> : undef;
107	root	1.1	like $response, qr{\AHTTP/1\.1 401\b},
108			"$kind: TCP listener still serves authenticated MCP HTTP";
109			close $sock;
110			} else {
111			fail "$kind: HTTP listener response";
112			}
113
114			close $in;
115			is wait_exit ($pid), 0, "$kind: stdin EOF stops the child cleanly";
116			my $extra = <$out>;
117			ok !defined $extra, "$kind: no extraneous stdout after final MCP response";
118			close $out;
119			close $err;
120			}
121
122			done_testing;