1
0
Fork 0
mirror of https://github.com/perlbot/perlbuut synced 2025-06-07 10:35:41 -04:00

Refactor tests, use lib::relative to correctly find things, and add a quote plugin test

This commit is contained in:
Ryan Voots 2020-10-30 15:05:04 -07:00
parent eaebbef9f3
commit ec29915d74
6 changed files with 103 additions and 50 deletions

View file

@ -31,6 +31,7 @@ requires "JSON::MaybeXS";
requires "JSON::MaybeXS"; requires "JSON::MaybeXS";
requires "JSON::MaybeXS"; requires "JSON::MaybeXS";
requires "lib"; requires "lib";
requires "lib::relative";
requires "List::Util"; requires "List::Util";
requires "List::Util"; requires "List::Util";
requires "LWP::Simple"; requires "LWP::Simple";

View file

@ -4,36 +4,10 @@ use strict;
use warnings; use warnings;
use utf8; use utf8;
use Test::More; use Test::More;
use Test::Differences qw/ eq_or_diff /; use lib::relative './lib', '../lib', '..';
use Capture::Tiny qw/capture/; use t::simple_plugin;
use lib '.';
my $sub = require plugins::core;
sub make_said load_plugin("core");
{
my ($body, $who, $server, $channel) = @_;
my @args = split /\s+/, $body;
my $said = {
body => $body,
recommended_args => \@args,
};
}
sub check
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ( $body, $want, $res, $blurb ) = @_;
my $said = make_said($body);
my ($out, $err, @result) = capture {
$sub->( $said );
};
return eq_or_diff( $err, "", "no errors" )
&& eq_or_diff(\@result, $res, "Result is correct")
&& eq_or_diff( $out, $want, $blurb );
}
check("", "usage: core Module::Here", ["handled"], "usage help"); check("", "usage: core Module::Here", ["handled"], "usage help");
check("CGI", "CGI Added to perl core as of 5.004 and deprecated in 5.019007", ["handled"], "deprecated"); check("CGI", "CGI Added to perl core as of 5.004 and deprecated in 5.019007", ["handled"], "deprecated");

35
t/lib/t/common.pm Normal file
View file

@ -0,0 +1,35 @@
package t::common;
use strict;
use warnings;
use utf8;
use parent 'Exporter';
our @EXPORT=qw/load_plugin make_said/;
# This doesn't let us test multiple plugins at a time, which might be needed for the compose plugin
# This can be fixed later
our $plugin;
sub load_plugin {
my $name = shift;
my $fullname = "plugins/$name.pm";
$plugin = require $fullname;
}
sub make_said
{
my ($body, $who, $server, $channel) = @_;
# TODO make this fill out a lot more of the said object
my @args = split /\s+/, $body;
my $said = {
body => $body,
recommended_args => \@args,
};
}
1;

29
t/lib/t/simple_plugin.pm Normal file
View file

@ -0,0 +1,29 @@
package t::simple_plugin;
use strict;
use warnings;
use utf8;
use parent 'Exporter';
use t::common;
our @EXPORT=qw/load_plugin make_said check/;
use Test::Differences qw/ eq_or_diff /;
use Capture::Tiny qw/capture/;
sub check
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ( $body, $want, $res, $blurb ) = @_;
my $said = make_said($body);
my ($out, $err, @result) = capture {
$t::common::plugin->( $said );
};
return eq_or_diff( $err, "", "no errors" )
&& eq_or_diff(\@result, $res, "Result is correct")
&& eq_or_diff( $out, $want, $blurb );
}
1;

20
t/quote-plugin.t Normal file
View file

@ -0,0 +1,20 @@
#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Test::More;
use lib::relative './lib', '../lib', '..';
use t::simple_plugin;
load_plugin("quote");
check("", "", [], "do nothing");
check('d TESTING HERE', q{"TESTING HERE"}, [1], 'quote d simple');
check('c TESTING HERE', q{TESTING HERE}, [1], 'quote d simple');
check(qq{d "TESTING \nHERE"}, q{"\\x22TESTING \\x0aHERE\\x22"}, [1], 'quote d complex');
check(qq{c "TESTING \nHERE"}, q{\\x22TESTING \\x0aHERE\\x22}, [1], 'quote c complex');
check(qq{e "TESTING \nHERE"}, q{\\x22TESTING\\x20\\x0aHERE\\x22}, [1], 'quote e complex');
check(qq{f "TESTING \nHERE"}, q{"\\x22TESTING\\x20\\x0aHERE\\x22"}, [1], 'quote f complex');
check('h TESTING HERE', q{54455354494e472048455245}, [1], 'quote h');
done_testing();

View file

@ -3,34 +3,28 @@
use strict; use strict;
use warnings; use warnings;
use utf8; use utf8;
use Test::More tests => 4; use Test::More;
use Test::Differences qw/ eq_or_diff /; use lib::relative './lib', '../lib', '..';
use lib '.'; use t::simple_plugin;
use plugins::unicode; use Encode qw/encode/;
sub check load_plugin("unicode");
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ( $body, $want, $blurb ) = @_;
my ( $err, $out ) = unip( map speng($_), split " ", $body );
return eq_or_diff( $err, [], "no errors" )
&& eq_or_diff( $out, $want, $blurb );
}
# TEST*2 # TEST*2
check( check(
"perl", "perl",
[ "U+0070 (70): LATIN SMALL LETTER P [p] ".
"U+0070 (70): LATIN SMALL LETTER P [p]", "U+0065 (65): LATIN SMALL LETTER E [e] ".
"U+0065 (65): LATIN SMALL LETTER E [e]", "U+0072 (72): LATIN SMALL LETTER R [r] ".
"U+0072 (72): LATIN SMALL LETTER R [r]", "U+006C (6c): LATIN SMALL LETTER L [l]\n",
"U+006C (6c): LATIN SMALL LETTER L [l]", [1],
],
"ascii" "ascii"
); );
# TEST*2 # TEST*2
check( "💟", [ "U+1F49F (f0 9f 92 9f): HEART DECORATION [💟]", ], check(
"emoji", ); "💟",
encode("utf8", "U+1F49F (f0 9f 92 9f): HEART DECORATION [💟]\n"),
[1],
"emoji" );