NetCube-Systems-Austria/kumquat-buildroot
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

utils/scancpan: add generation of test

Browse Source 
This commit extends the scancpan script to automatically generate a
test for the Perl module, either if the Perl module uses native
library, or if it has more than one dependency.

Signed-off-by: Francois Perrad <francois.perrad@gadz.org>
Signed-off-by: Thomas Petazzoni <thomas.petazzoni@bootlin.com>
This commit is contained in:
Francois Perrad 2018-11-24 10:07:16 +01:00 committed by Thomas Petazzoni
parent e729bf722b
commit 65a42f26c8
1 changed files with 67 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
utils/scancpan
View File

@ -575,6 +575,32 @@ sub find_license_files {
return @license_files; return @license_files;
} }
sub want_test {
my ($distname) = @_;
return 1 if $need_dlopen{$distname} && scalar @{$deps_runtime{$distname}} > 1;
}
sub get_dependencies {
my ($distname) = @_;
my %dep = map { $_ => 1 } @{$deps_runtime{$distname}};
for my $direct (@{$deps_runtime{$distname}}) {
for (get_dependencies( $direct )) {
$dep{$_} = 1;
}
}
return keys %dep;
}
sub get_indirect_dependencies {
my ($distname) = @_;
my %indirect;
my %direct = map { $_ => 1 } @{$deps_runtime{$distname}};
for my $dep (get_dependencies( $distname )) {
$indirect{$dep} = 1 unless exists $direct{$dep};
}
return keys %indirect;
}
sub fetch { sub fetch {
my ($name, $need_target, $need_host, $top) = @_; my ($name, $need_target, $need_host, $top) = @_;
$need_target{$name} = $need_target if $need_target; $need_target{$name} = $need_target if $need_target;
@ -688,6 +714,7 @@ while (my ($distname, $dist) = each %dist) {
my $mkname = $dirname . q{/} . $fsname . q{.mk}; my $mkname = $dirname . q{/} . $fsname . q{.mk};
my $hashname = $dirname . q{/} . $fsname . q{.hash}; my $hashname = $dirname . q{/} . $fsname . q{.hash};
my $brname = brname( $fsname ); my $brname = brname( $fsname );
my $testname = q{support/testing/tests/package/test_} . lc $brname . q{.py};
unless (-d $dirname) { unless (-d $dirname) {
mkdir $dirname; mkdir $dirname;
$new_pkgs = 1; $new_pkgs = 1;
@ -779,6 +806,46 @@ while (my ($distname, $dist) = each %dist) {
} }
close $fh; close $fh;
} }
if (want_test( $distname ) && ($force || !-f $testname)) {
my $classname = $distname;
$classname =~ s|-||g;
my $modname = $distname;
$modname =~ s|-|::|g;
my @indirect = (get_indirect_dependencies( $distname ));
say qq{write ${testname}} unless $quiet;
open my $fh, q{>}, $testname;
say {$fh} qq{from tests.package.test_perl import TestPerlBase};
say {$fh} qq{};
say {$fh} qq{};
say {$fh} qq{class TestPerl${classname}(TestPerlBase):};
say {$fh} qq{ """};
say {$fh} qq{ package:};
say {$fh} qq{ ${distname}};
say {$fh} qq{ direct dependencies:};
foreach my $dep (sort @{$deps_runtime{$distname}}) {
my $mark = want_test( $dep ) ? q{ *} : q{};
say {$fh} qq{ ${dep}${mark}};
}
if (scalar @indirect > 0) {
say {$fh} qq{ indirect dependencies:};
foreach my $dep (sort @indirect) {
my $mark = want_test( $dep ) ? q{ *} : q{};
say {$fh} qq{ ${dep}${mark}};
}
}
say {$fh} qq{ """};
say {$fh} qq{};
say {$fh} qq{ config = TestPerlBase.config + \\};
say {$fh} qq{ """};
say {$fh} qq{ BR2_PACKAGE_PERL=y};
say {$fh} qq{ BR2_PACKAGE_${brname}=y};
say {$fh} qq{ """};
say {$fh} qq{};
say {$fh} qq{ def test_run(self):};
say {$fh} qq{ self.login()};
say {$fh} qq{ self.module_test("${modname}")};
close $fh;
}
} }
if ($new_pkgs) { if ($new_pkgs) {