1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184
|
use 5.20.0;
use Test::More;
use Test::Synopsis::Expectation;
use Time::localtime;
use feature qw/postderef signatures/;
no warnings qw/experimental::postderef experimental::signatures/;
require_ok('Software::Copyright::Statement');
synopsis_ok('lib/Software/Copyright/Statement.pm') unless $ENV{AUTOPKGTEST_TMP};
sub new_st($str) {
return Software::Copyright::Statement->new($str);
}
subtest "blank statement" => sub {
my $statement = new_st('');
is("$statement", '', "check simplified statement");
is($statement->name, undef, "check simplified statement name");
is($statement->email, undef, "check simplified statement email");
};
subtest "just a name" => sub {
my $statement = new_st('Marcel <marcel@example.com>');
is("$statement", 'Marcel <marcel@example.com>', "check simplified statement");
is($statement->name, 'Marcel', "check simplified statement name");
is($statement->email, 'marcel@example.com', "check simplified statement email");
};
subtest "O'name" => sub {
my $statement = new_st(q!Tony O'Dell!);
is($statement->name, "Tony O'Dell", "check simplified statement name");
};
subtest "single statement" => sub {
my $statement = new_st('2014,2015-2022 Marcel <marcel@example.com>');
is("$statement", '2014-2022, Marcel <marcel@example.com>', "check simplified statement");
};
subtest "just a number" => sub {
my $statement = new_st('2021');
is($statement->name, undef, "check statement without name");
is("$statement", '2021', "check statement string without name");
};
subtest "combined owners" => sub {
my $owner_str = "Blaine Bublitz, Eric Schoffstall and other contributors";
my $str = "2014, 2015, $owner_str";
my $owner = new_st($str);
is("$owner", $str, "check statement string");
is($owner->name, undef, "check owner name");
is($owner->record, "Blaine Bublitz, Eric Schoffstall and other contributors", "check owner record");
};
subtest "combined owners and email" => sub {
my $owner_str = 'Blaine Bublitz <blaine.bublitz@gmail.com>,'
. ' Eric Schoffstall <yo@contra.io> and other contributors';
my $str = '2013-2018, '.$owner_str;
my $owner = new_st($str);
is("$owner", $str, "check statement string");
is($owner->name, undef, "check owner name");
is($owner->record, $owner_str, "check owner record");
is($owner->email, undef, "check owner email");
};
subtest "compare statements" => sub {
my $one = new_st('2022 Thierry');
my $other = new_st('2014,2015-2022 Marcel <marcel@example.com>');
is($one cmp $one, 0, "check cmp equal");
is($one cmp $other, 1, "check cmp equal");
is($other cmp $one, -1, "check cmp equal");
};
subtest "merge record" => sub {
my $statement = new_st('2014,2015-2020 Marcel');
$statement->merge(new_st('2004-06 Marcel'));
is("$statement", '2004-2006, 2014-2020, Marcel', "check simplified statement");
$statement->merge(new_st('2007-08 Marcel'));
is("$statement", '2004-2008, 2014-2020, Marcel', "check statement after year merge");
$statement->merge(new_st('2021, Marcel'));
is("$statement", '2004-2008, 2014-2021, Marcel', "check statement after 2021 year merge");
# add email
$statement->merge(new_st('Marcel <marcel@bad.com>'));
is("$statement", '2004-2008, 2014-2021, Marcel <marcel@bad.com>', "merge bad email address");
# fix email
$statement->merge(new_st('2022, Marcel <marcel@example.com>'));
is("$statement", '2004-2008, 2014-2022, Marcel <marcel@example.com>', "fix email");
};
subtest "add years" => sub {
my $statement = new_st('2022, Marcel <marcel@example.com>');
$statement->add_years(2010);
is("$statement", '2010, 2022, Marcel <marcel@example.com>', "added year");
};
subtest "handle garbage" => sub {
my $statement = new_st('(c)**b <= a and (c+1)**b > a');
# garbage in, garbage out
is($statement.'',"b <= a and (c+1)**b > a","handle C code with (c)");
};
subtest "handle No Copyright given by licensecheck" => sub {
my $statement = new_st('*No copyright*');
is($statement.'',"","handle No Copyright given by licensecheck");
};
subtest "contains record" => sub {
my $statement = new_st('2015-2020 Marcel');
my @tests = (
['2014, Marcel', 0 ],
['2015, Marcel', 1 ],
['2015-2019, Marcel', 1 ],
['2015-2019, Yves', 0 ],
);
foreach my $t (@tests) {
my ($str, $expect) = $t->@*;
is($statement->contains(new_st($str)), $expect, "check $str");
}
};
subtest "clean copyright" => sub {
my $current_year = localtime->year() + 1900;
my @tests = (
[
'(c) 2006-present Philipp Lehman,',
"2006-$current_year, Philipp Lehman"
],
[
# see https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1033406
'2022 -01-17:16:26:37 -- Version 1.3 André Hilbig, mail@andrehilbig.de',
'2022, Version 1.3 André Hilbig, mail@andrehilbig.de',
],
[
'Uwe Lueck 2012-11-06',
'2012, Uwe Lueck'
],
[
'2003 - 2004 - 2006 Alphonse',
'2003-2006, Alphonse'
],
[
'(C) Werenfried Spit 04-10-90',
'1990, Werenfried Spit'
],
[
'(c) 2003--2005 Alexej Kryukov <basileia@yandex.ru>.',
'2003-2005, Alexej Kryukov <basileia@yandex.ru>.',
],
[
# see https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1052168
'@copyright{} 2001--2023 Free Software Foundation, Inc.',
'2001-2023, Free Software Foundation, Inc.',
],
[
'protection under copyright law or other applicable laws.'
],
);
foreach my $t (@tests) {
my ($str, $expect) = $t->@*;
is(new_st($str), $expect // $str, "check «$str»");
}
};
done_testing;
|