view release on metacpan or  search on metacpan

t/fugu/repl.t  view on Meta::CPAN

	is( guarded( sub { $repl->read_line } ), 'first', 'line one' );
	is( $repl->event, 'line', 'with the event line' );
	is( guarded( sub { $repl->read_line } ), 'second', 'line two' );

	is( output($out_r), '', 'and the plain mode writes no prompt' );
};

subtest 'the plain mode reads a line that arrives in pieces' => sub {
	my ( $repl, $in_w, $out_r ) = repl();

	my $pid = fork // die "fork: $!";
	if ( $pid == 0 ) {
		syswrite $in_w, 'first';
		sleep 0.2;
		syswrite $in_w, " half\n";
		POSIX::_exit(0);
	}

	is( guarded( sub { $repl->read_line } ),
		'first half', 'the pieces join into one line' );
	waitpid $pid, 0;
};

subtest 'the plain mode reports eof' => sub {
	my ( $repl, $in_w, $out_r ) = repl();

	syswrite $in_w, "tail without a newline";
	close $in_w;

	is( guarded( sub { $repl->read_line } ),
		'tail without a newline',
		'an end of file still ends the last line' );
	is( guarded( sub { $repl->read_line } ),
		undef, 'then the input is empty' );
	is( $repl->event, 'eof', 'with the event eof' );
};

subtest 'a watched handle that becomes readable ends the read' => sub {
	pipe my $watch_r, my $watch_w or die "pipe: $!";
	my ( $repl, $in_w, $out_r ) = repl( watch => [$watch_r] );

	syswrite $watch_w, 'wake';
	is( guarded( sub { $repl->read_line } ),
		undef, 'the read ends without a line' );
	is( $repl->event, 'watch', 'with the event watch' );
	ok( $repl->ready_handle == $watch_r,
		'and ready_handle names the handle' );
};

subtest 'a watched handle that closes ends the read' => sub {
	pipe my $watch_r, my $watch_w or die "pipe: $!";
	my ( $repl, $in_w, $out_r ) = repl( watch => [$watch_r] );

	close $watch_w;
	is( guarded( sub { $repl->read_line } ),
		undef, 'the closed peer ends the read' );
	is( $repl->event, 'watch', 'with the event watch' );
	ok( $repl->ready_handle == $watch_r,
		'and ready_handle names the handle' );

	syswrite $in_w, "still alive\n";
	is( guarded( sub { $repl->read_line } ),
		undef, 'a closed handle stays readable' );
	is( $repl->event, 'watch', 'so watch outranks the input' );
};

subtest 'ready_handle answers only after a watch event' => sub {
	my ( $repl, $in_w, $out_r ) = repl();

	syswrite $in_w, "a line\n";
	guarded( sub { $repl->read_line } );
	is( $repl->ready_handle, undef, 'a line event names no handle' );
};

subtest 'display_filter keeps the safe bytes' => sub {
	is( Fugu::REPL::display_filter("plain text 09AZ~"),
		'plain text 09AZ~', 'printable ASCII survives' );
	is( Fugu::REPL::display_filter("one\ttab\nand a line feed\n"),
		"one\ttab\nand a line feed\n",
		'the tab and the line feed survive' );
};

subtest 'display_filter removes DEL and every C1 byte' => sub {
	is( Fugu::REPL::display_filter("a\x7Fb"), 'ab', 'DEL disappears' );
	is( Fugu::REPL::display_filter( 'a' . join( '', map {chr}
					0x80 .. 0x9F ) . 'b' ),
		'ab', 'every raw C1 byte disappears' );
	is( Fugu::REPL::display_filter("a\xC2\x9Bb"),
		'ab', 'a C1 control as a UTF-8 sequence disappears' );
};

subtest 'display_filter keeps a valid UTF-8 sequence whole' => sub {
	is( Fugu::REPL::display_filter("h\xC3\xA9llo"),
		"h\xC3\xA9llo", 'a two-byte sequence survives' );
	is( Fugu::REPL::display_filter("cost \xE2\x82\xAC5"),
		"cost \xE2\x82\xAC5", 'a three-byte sequence survives' );
	is( Fugu::REPL::display_filter("\xF0\x9F\x90\xA1 fugu"),
		"\xF0\x9F\x90\xA1 fugu", 'a four-byte sequence survives' );
};

subtest 'display_filter replaces an invalid byte with one mark' => sub {
	is( Fugu::REPL::display_filter("a\xFFb"), 'a?b',
		'a stray byte becomes one question mark' );
	is( Fugu::REPL::display_filter("tail\xC3"),
		'tail?', 'a cut sequence becomes one question mark' );
	is( Fugu::REPL::display_filter("a\eb\rc"), 'a?b?c',
		'an escape and a carriage return become marks' );
	is( Fugu::REPL::display_filter("\xC3\xA9\xA9"),
		"\xC3\xA9?", 'a lone continuation byte becomes a mark' );
};

subtest 'show writes the filtered bytes' => sub {
	my ( $repl, $in_w, $out_r ) = repl();

	is( $repl->show("safe\x1B[31m"), $repl, 'show returns the object' );
	is( output($out_r), 'safe?[31m', 'and the output is filtered' );
};

subtest 'confirm answers no by default' => sub {
	my ( $repl, $in_w, $out_r ) = repl();