Perlbot/perlbuut
1
0
Fork 0
mirror of https://github.com/perlbot/perlbuut synced 2025-06-07 10:35:41 -04:00
Code Issues Releases Wiki Activity

Merge pull request #25 from perlbot/refactor-tests

Browse source 
Refactor tests, use lib::relative to correctly find things, and add a…
This commit is contained in:
Ryan Voots 2020-10-30 15:26:59 -07:00 • committed by GitHub
commit cef088bf52
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
6 changed files with 104 additions and 50 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
cpanfile
View file

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

32
t/core-plugin.t
View file

@ -4,36 +4,10 @@ use strict;
use warnings;
use utf8;
use Test::More;
use Test::Differences qw/ eq_or_diff /;
use Capture::Tiny qw/capture/;
use lib '.';
my $sub = require plugins::core;
use lib::relative './lib', '../lib', '..';
use t::simple_plugin;
sub make_said
{
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 );
}
load_plugin("core");
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");

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();

37
t/unicode-plugin.t
View file

@ -3,34 +3,29 @@
use strict;
use warnings;
use utf8;
use Test::More tests => 4;
use Test::Differences qw/ eq_or_diff /;
use lib '.';
use plugins::unicode;
use Test::More;
use lib::relative './lib', '../lib', '..';
use t::simple_plugin;
use Encode qw/encode/;
sub check
{
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 );
}
load_plugin("unicode");
# TEST*2
check(
"perl",
[
"U+0070 (70): LATIN SMALL LETTER P [p]",
"U+0065 (65): LATIN SMALL LETTER E [e]",
"U+0072 (72): LATIN SMALL LETTER R [r]",
"U+006C (6c): LATIN SMALL LETTER L [l]",
],
"U+0070 (70): LATIN SMALL LETTER P [p] ".
"U+0065 (65): LATIN SMALL LETTER E [e] ".
"U+0072 (72): LATIN SMALL LETTER R [r] ".
"U+006C (6c): LATIN SMALL LETTER L [l]\n",
[1],
"ascii"
);
# TEST*2
check( "💟", [ "U+1F49F (f0 9f 92 9f): HEART DECORATION [💟]", ],
"emoji", );
check(
"💟",
encode("utf8", "U+1F49F (f0 9f 92 9f): HEART DECORATION [💟]\n"),
[1],
"emoji" );
done_testing();