Commit 9fcbf8ed authored by Yadd's avatar Yadd
Browse files

Import autopkgtests (#1110)

parent 860c32e2
Test-Command: ./debian/tests/runner build-deps
Depends: @, @builddeps@, pkg-perl-autopkgtest, libmouse-perl
Test-Command: ./debian/tests/runner runtime-deps
Depends: @, pkg-perl-autopkgtest, libmouse-perl
Test-Command: ./debian/tests/runner runtime-deps-and-recommends
Depends: @, pkg-perl-autopkgtest, libmouse-perl
Restrictions: needs-recommends
#Test-Command: ./debian/tests/runner heavy-deps
#Depends: @, pkg-perl-autopkgtest, pkg-perl-autopkgtest-heavy, libmouse-perl
#!/bin/sh
set -e
cleanup() {
cd $PDIR
#Clean up after smoke-setup
cleanup_file=debian/tests/pkg-perl/smoke-cleanup
if [ -x $cleanup_file ]
then
( export TDIR; $cleanup_file )
fi
rm -rf $TDIR
}
TEMP=${ADTTMP:-${TMPDIR:-/tmp}}
TDIR=$(mktemp -d $TEMP/smokeXXXXXX)
PDIR=`pwd`
trap cleanup EXIT
file_list=debian/tests/pkg-perl/smoke-files
if [ ! -r $file_list ]; then
# backward compatibility squared for now
file_list=debian/tests/pkg-perl/test-files
fi
if [ ! -r $file_list ]; then
# backward compatibility for now
file_list=debian/tests/test-files
fi
export AUTOMATED_TESTING=1
export NONINTERACTIVE_TESTING=1
# overridable with smoke-env
PKG_PERL_PROVE_ARGS="--merge"
env_list=debian/tests/pkg-perl/smoke-env
if [ ! -r $env_list ]; then
env_list=debian/tests/pkg-perl/env-smoke
fi
if [ -r $env_list ]; then
eval $(sed '/^ *\(#\|$\)/d; s/^/export /' $env_list)
fi
for dir in common handler portal manager; do
TDIR2=${TDIR}/lemonldap-ng-$dir
mkdir -p $TDIR2/blib/lib \
$TDIR2/blib/arch \
$TDIR2/lib/Debian/pkgperl \
$TDIR2/blib/lib/Debian/pkgperl
cp -a lemonldap-ng-$dir/t $TDIR2/
cat <<'EOF' > $TDIR2/lib/Debian/pkgperl/Foobar.pm
package Debian::pkgperl::Foobar;
our $VERSION = '0.01';
1;
__END__
=head1 NAME
Debian::pkgperl::Foobar - dummy module for test checkers
=cut
EOF
cp $TDIR2/lib/Debian/pkgperl/Foobar.pm $TDIR2/blib/lib/Debian/pkgperl
if [ ! -e $TDIR2/MANIFEST ]; then
cat <<'EOF' > $TDIR2/MANIFEST
lib/Debian/pkgperl/Foobar.pm
EOF
fi
if [ ! -e $TDIR2/MANIFEST.SKIP ]; then
cp /dev/null $TDIR2/MANIFEST.SKIP
fi
done
# Missing file
cp lemonldap-ng-common/lemonldap-ng.ini ${TDIR}/lemonldap-ng-common
# Test that have no interest
rm -f $TDIR/*/t/99-pod.t \
$TDIR/lemonldap-ng-manager/t/03-HTML-forms.t \
$TDIR/lemonldap-ng-manager/t/20-test-coverage.t \
$TDIR/lemonldap-ng-manager/t/80-attributes.t \
$TDIR/lemonldap-ng-manager/t/90-translations.t
for INI in $(find $TDIR/lemonldap-ng-* -name lemonldap-ng.ini); do
echo "Change $INI logLevel to debug" >&2
perl -pi -e 's/^logLevel\s*=\s*\w+$/logLevel=debug/' $INI
done
for dir in common handler portal manager; do
TDIR2=${TDIR}/lemonldap-ng-$dir
# this is intended to be a last resort, please use it responsibly
setup_file=debian/tests/pkg-perl/smoke-setup
if [ -x $setup_file ]
then
( export TDIR2; $setup_file )
# Evaluate skip list a second time since smoke-setup might have
# generated some of the to-be-skipped files.
if [ -r $skip_list ]; then
egrep -v '^ *(#|$)' $skip_list | while read file; do
rm -f $TDIR2/$file
done
fi
fi
tests_file=$(pwd)/debian/tests/pkg-perl/smoke-tests
cd $TDIR2
if [ -r $tests_file ]; then
test_targets=$(eval ls -d $(egrep -v '^#' $tests_file) 2>/dev/null || true)
fi
if command -v xvfb-run >/dev/null
then
XVFB="xvfb-run -a"
else
XVFB=
fi
test_targets=$(ls -d t/*.t 2>/dev/null || true)
if [ ! -n "$test_targets" ]; then
echo 'Nothing to prove, skipping.'
else
$XVFB prove -I"$TDIR2" --blib --verbose $PKG_PERL_PROVE_ARGS $test_targets 2>&1
fi
cd -
done
#!/usr/bin/perl -w
use strict;
use Test::More;
use Getopt::Std;
sub usage {
my $exit = shift;
$exit = 0 if !defined $exit;
print "Usage: $0 [ package ] ...\n";
print "\tpackages are read from debian/control if not given as arguments\n";
exit $exit;
}
my %opts;
getopts('h', \%opts)
or usage();
usage(0) if $opts{h};
sub getpackages {
my @p;
my $c = "debian/control";
-f $c or BAIL_OUT("no packages listed and $c not found");
open(C, '<', $c) or BAIL_OUT("opening $c for reading failed:$!");
while (<C>) {
chomp;
/^\s*Package:\s+(\S+)/ and push @p, $1;
}
close C or BAIL_OUT("closing $c failed: $!");
return @p;
}
sub readskip {
my $skip = "debian/tests/pkg-perl/syntax-skip";
$skip = "debian/tests/pkg-perl/skip-syntax" if ! -r $skip;
-r $skip or return ();
open (S, '<', $skip)
or BAIL_OUT("$skip exists but can't be read");
my @ret;
while (<S>) {
chomp;
next if !/\S/;
next if /^\s*#/;
push @ret, qr/\Q$_\E/;
}
close S;
return @ret;
}
my @packages = @ARGV ? @ARGV : getpackages();
usage() if !@packages;
plan tests => 4 * scalar @packages;
my @to_skip = readskip();
for my $package (@packages) {
SKIP: {
ok(!system(qq(dpkg-query --list "$package" >/dev/null 2>&1)),
"Package $package is known to dpkg");
skip "$package not installed", 3 if $?;
my @status_info = qx{dpkg-query --status "$package"};
ok(@status_info, "Got status information for package $package");
skip "$package has Suggestions and no explicit skip list", 2
if grep /^Suggests:/, @status_info and ! @to_skip;
my @files = qx{dpkg-query --listfiles "$package" 2>/dev/null};
ok(@files, "Got file list for package $package");
skip "nothing to test", 1 if !@files;
my @pms;
F: for (@files) {
chomp;
next if !/\.pm$/;
for my $skip_re (@to_skip) {
note "skipping $_", next F if /$skip_re/;
}
my $oninc = 0;
for my $incdir (@INC) {
$oninc++, last if /^\Q$incdir/;
}
next if !$oninc;
push @pms, $_;
}
skip "no perl modules to test in $package", 1 if !@pms;
subtest "all modules in $package pass the syntax check" => sub {
plan tests => scalar @pms;
for (@pms) {
my @out = grep !/syntax OK/, qx($^X -wc $_ 2>&1);
note(@out) if @out;
ok(!$?, "$^X -wc $_ exited successfully");
}
}
}
}
#!/usr/bin/perl -w
use strict;
use Test::More;
use Getopt::Std;
use CPAN::Meta;
sub usage {
my $exit = shift;
$exit = 0 if !defined $exit;
print "Usage: $0 [ Some::Module] ...\n";
print "\tthe perl module is guessed from META.{json,yml} if not given as argument\n";
exit $exit;
}
my %opts;
getopts('h', \%opts)
or usage();
usage(0) if $opts{h};
sub getmodule {
my $module;
my $conffile = "debian/tests/pkg-perl/use-name";
$conffile = "debian/tests/pkg-perl/module-name" if ! -e $conffile; # backcompat
$conffile = "debian/tests/module-name" if ! -e $conffile; # backcompat squared
if ( -f $conffile ) {
open(M, "<", $conffile)
or BAIL_OUT("$conffile exists but can't be read");
while (<M>) {
chomp;
next if /^\s*#/;
/(\S+)/ and $module = $1, last;
}
close M;
BAIL_OUT("can't find a module name in $conffile")
if !defined $module;
return $module;
}
my $meta;
my $dist;
eval { $meta = CPAN::Meta->load_file('META.json') };
eval { $meta = CPAN::Meta->load_file('META.yml' ) } if !$meta;
plan skip_all => "can't guess package from META.json or META.yml"
if !$meta;
$dist = $meta->name;
$module = $dist;
$module =~ s,-,::,g;
my $file = "$dist.pm";
$file =~ s,-,/,g;
my $basefile = $file;
$basefile =~ s,.*/,,;
( -f $basefile ) or (-f "lib/$file") or plan skip_all => "$basefile or lib/$file not found";
return $module;
}
my @modules = @ARGV ? @ARGV : getmodule();
usage() if !@modules;
plan tests => 2 * scalar @modules;
for my $mod (@modules) {
my $cmd = qq($^X -w -M"$mod" -e 1 2>&1);
my @out = qx($cmd);
note(@out) if @out;
ok(!$?, "$cmd exited successfully");
ok(!@out, "$cmd produced no output");
}
#!/bin/sh
BASE=debian/tests/lib
TYPE=$1
[ -n "$TYPE" ] || exit 1
TESTDIR=${BASE}/${TYPE}.d
[ -d "$TESTDIR" ] || exit 1
SKIPLIST=debian/tests/pkg-perl/SKIP
SKIPTMP=$(mktemp)
if [ -f "$SKIPLIST" ]; then
grep -v '^ *#' "$SKIPLIST" |grep -v '^ *$' > "$SKIPTMP"
fi
EXITCODE=0
for T in $(run-parts --list --regex '(^[a-z0-9.]+$)' ${TESTDIR} | \
grep -v -F -f "$SKIPTMP") ; do
if echo "$T" | grep -q '\.t$'
then
prove --norc -v "$T"
RET=$?
if [ $EXITCODE = 0 ]; then EXITCODE=$RET; fi
else
"$T"
RET=$?
if [ $EXITCODE = 0 ]; then EXITCODE=$RET; fi
fi
done
rm -f "$SKIPTMP"
exit $EXITCODE
.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
.\" Automatically generated by Pod::Man 4.07 (Pod::Simple 3.32)
.\"
.\" Standard preamble:
.\" ========================================================================
......@@ -46,7 +46,7 @@
.ie \n(.g .ds Aq \(aq
.el .ds Aq '
.\"
.\" If the F register is turned on, we'll generate index entries on stderr for
.\" If the F register is >0, we'll generate index entries on stderr for
.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
.\" entries marked with X<> in POD. Of course, you'll have to process the
.\" output yourself in some meaningful fashion.
......@@ -54,20 +54,16 @@
.\" Avoid warning from groff about undefined register 'F'.
.de IX
..
.nr rF 0
.if \n(.g .if rF .nr rF 1
.if (\n(rF:(\n(.g==0)) \{
. if \nF \{
. de IX
. tm Index:\\$1\t\\n%\t"\\$2"
.if !\nF .nr F 0
.if \nF>0 \{\
. de IX
. tm Index:\\$1\t\\n%\t"\\$2"
..
. if !\nF==2 \{
. nr % 0
. nr F 2
. \}
. if !\nF==2 \{\
. nr % 0
. nr F 2
. \}
.\}
.rr rF
.\"
.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
.\" Fear. Run. Save yourself. No user-serviceable parts.
......@@ -133,7 +129,7 @@
.\" ========================================================================
.\"
.IX Title "llng-fastcgi-server 1"
.TH llng-fastcgi-server 1 "2016-07-01" "perl v5.22.2" "User Contributed Perl Documentation"
.TH llng-fastcgi-server 1 "2016-11-12" "perl v5.24.1" "User Contributed Perl Documentation"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
......
......@@ -121,8 +121,11 @@ sub jsonResponse {
my ( $self, $path, $query ) = @_;
my $res = $self->_get( $path, $query )
or die "PSGI lib has refused my get, aborting";
die "PSGI lib does not return a 200 code, aborting"
unless ( $res->[0] == 200 );
unless ( $res->[0] == 200 ) {
require Data::Dumper;
print STDERR "Result dump :\n" . Data::Dumper::Dumper($res);
die "Manager lib does not return a 200 code, aborting";
}
my $href = from_json( $res->[2]->[0] ) or die 'Response is not JSON';
return $href;
}
......@@ -131,8 +134,11 @@ sub jsonPostResponse {
my ( $self, $path, $query, $body, $type, $len ) = @_;
my $res = $self->_post( $path, $query, $body, $type, $len )
or die "PSGI lib has refused my post, aborting";
die "PSGI lib does not return a 200 code, aborting"
unless ( $res->[0] == 200 );
unless ( $res->[0] == 200 ) {
require Data::Dumper;
print STDERR "Result dump :\n" . Data::Dumper::Dumper($res);
die "Manager lib does not return a 200 code, aborting";
}
my $href = from_json( $res->[2]->[0] ) or die 'Response is not JSON';
return $href;
}
......@@ -141,8 +147,11 @@ sub jsonPutResponse {
my ( $self, $path, $query, $body, $type, $len ) = @_;
my $res = $self->_put( $path, $query, $body, $type, $len )
or die "PSGI lib has refused my put, aborting";
die "PSGI lib does not return a 200 code, aborting"
unless ( $res->[0] == 200 );
unless ( $res->[0] == 200 ) {
require Data::Dumper;
print STDERR "Result dump :\n" . Data::Dumper::Dumper($res);
die "Manager lib does not return a 200 code, aborting";
}
my $href = from_json( $res->[2]->[0] ) or die 'Response is not JSON';
return $href;
}
......
......@@ -138,7 +138,7 @@ sub followPath {
return $self->$sub( $req, @$path );
}
else {
$self->lmLog( 'Bad request received (' . $req->path . ')', 'warn' );
$self->lmLog( 'Bad request received (' . $req->path . ')', 'error' );
return $self->sendError( $req, 'Bad request', 400 );
}
}
......
......@@ -11,7 +11,8 @@ our $count = 1;
$Data::Dumper::Deparse = 1;
my $module;
our $sessionId = 'f5eec18ebb9bc96352595e2d8ce962e8ecf7af7c9a98cb9a43f9cd181cf4b545';
our $sessionId =
'f5eec18ebb9bc96352595e2d8ce962e8ecf7af7c9a98cb9a43f9cd181cf4b545';
our $file = "t/sessions/$sessionId";
sub init {
......@@ -22,7 +23,8 @@ sub init {
}
ok( $client = Lemonldap::NG::Handler::PSGI::Cli::Lib->new(),
'Client object' );
count(2);
ok( $client->app, 'App object' ) or explain( $client, '->app...' );
count(3);
open F, ">$file"
or die $!;
my $now = time;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment