summaryrefslogtreecommitdiffstats
path: root/scripts/t
diff options
context:
space:
mode:
authorRohan McGovern <rohan.mcgovern@nokia.com>2012-03-01 10:19:48 +1000
committerQt by Nokia <qt-info@nokia.com>2012-03-01 06:55:17 +0100
commitc5806efaf6462996eecc4db782d54eea19825339 (patch)
tree21f3ef07a12c0872fb9790f87aea8a009f106068 /scripts/t
parentd278aa42ad818e9ffff6d751e1311d2d4ae5fe52 (diff)
Make perl-syntax-check, perl-critic-check only check files in git
Previously these were searching for all perl files under the qtqa directory, even those which were not checked in to git. This was annoying as this could potentially include generated code or ad-hoc test scripts never intended to be added to git. Change-Id: I52d0fbc699b014a5e03507c59d9ecb91db13ee2c Reviewed-by: Kalle Lehtonen <kalle.ju.lehtonen@nokia.com> Reviewed-by: Toby Tomkins <toby.tomkins@nokia.com>
Diffstat (limited to 'scripts/t')
-rw-r--r--scripts/t/10-perl-syntax-check.t6
-rw-r--r--scripts/t/20-perl-critic-check.t9
-rw-r--r--scripts/t/QtQA/PerlChecks.pm114
3 files changed, 126 insertions, 3 deletions
diff --git a/scripts/t/10-perl-syntax-check.t b/scripts/t/10-perl-syntax-check.t
index 72305859..c726a38e 100644
--- a/scripts/t/10-perl-syntax-check.t
+++ b/scripts/t/10-perl-syntax-check.t
@@ -18,9 +18,11 @@ use Cwd qw( abs_path );
use File::Spec qw();
use FindBin qw();
use IO::CaptureOutput qw( qxy );
-use Perl::Critic::Utils qw( all_perl_files );
use Test::More;
+use lib $FindBin::Bin;
+use QtQA::PerlChecks;
+
# Returns a true-ish value if a particular syntax error should be permitted.
#
# The value returned is suitable for use as a skip reason to the `skip' method
@@ -97,7 +99,7 @@ sub main
my $base = abs_path(File::Spec->catfile($FindBin::Bin, '..'));
chdir($base);
- foreach my $file (all_perl_files($base)) {
+ foreach my $file (QtQA::PerlChecks::all_perl_files_in_git( )) {
syntax_check_one_perl( $file );
}
diff --git a/scripts/t/20-perl-critic-check.t b/scripts/t/20-perl-critic-check.t
index 266b1b49..6c714843 100644
--- a/scripts/t/20-perl-critic-check.t
+++ b/scripts/t/20-perl-critic-check.t
@@ -14,17 +14,24 @@ checks of all perl scripts and modules within this repo.
=cut
+use autodie;
use Cwd qw( abs_path );
use File::Spec::Functions qw( catfile );
use FindBin qw();
use Test::Perl::Critic qw( -severity stern );
use Test::More;
+use lib $FindBin::Bin;
+use QtQA::PerlChecks;
sub main
{
my $base = abs_path( catfile( $FindBin::Bin, '..' ) );
- all_critic_ok( $base );
+ chdir( $base );
+
+ foreach my $file (QtQA::PerlChecks::all_perl_files_in_git( )) {
+ critic_ok( $file );
+ }
done_testing( );
return;
diff --git a/scripts/t/QtQA/PerlChecks.pm b/scripts/t/QtQA/PerlChecks.pm
new file mode 100644
index 00000000..0d48e408
--- /dev/null
+++ b/scripts/t/QtQA/PerlChecks.pm
@@ -0,0 +1,114 @@
+#############################################################################
+##
+## Copyright (C) 2012 Nokia Corporation and/or its subsidiary(-ies).
+## Contact: http://www.qt-project.org/
+##
+## This file is part of the Quality Assurance module of the Qt Toolkit.
+##
+## $QT_BEGIN_LICENSE:LGPL$
+## GNU Lesser General Public License Usage
+## This file may be used under the terms of the GNU Lesser General Public
+## License version 2.1 as published by the Free Software Foundation and
+## appearing in the file LICENSE.LGPL included in the packaging of this
+## file. Please review the following information to ensure the GNU Lesser
+## General Public License version 2.1 requirements will be met:
+## http://www.gnu.org/licenses/old-licenses/lgpl-2.1.html.
+##
+## In addition, as a special exception, Nokia gives you certain additional
+## rights. These rights are described in the Nokia Qt LGPL Exception
+## version 1.1, included in the file LGPL_EXCEPTION.txt in this package.
+##
+## GNU General Public License Usage
+## Alternatively, this file may be used under the terms of the GNU General
+## Public License version 3.0 as published by the Free Software Foundation
+## and appearing in the file LICENSE.GPL included in the packaging of this
+## file. Please review the following information to ensure the GNU General
+## Public License version 3.0 requirements will be met:
+## http://www.gnu.org/copyleft/gpl.html.
+##
+## Other Usage
+## Alternatively, this file may be used in accordance with the terms and
+## conditions contained in a signed written agreement between you and Nokia.
+##
+##
+##
+##
+##
+##
+## $QT_END_LICENSE$
+##
+#############################################################################
+
+package QtQA::PerlChecks;
+use strict;
+use warnings;
+
+use Exporter;
+our @ISA = qw( Exporter );
+our @EXPORT_OK = qw( all_files_in_git all_perl_files_in_git );
+
+use File::chdir;
+use File::Spec::Functions;
+use List::MoreUtils qw( apply );
+use Perl::Critic::Utils qw( all_perl_files );
+use Test::More;
+
+# Helper for tests in this directory to find perl files for testing.
+
+# Returns a list of all files known to git under the given $path (or '.' if unset)
+# It is considered a failure if there are no files known to git.
+sub all_files_in_git
+{
+ my ($path) = @_;
+
+ if (!$path) {
+ $path = '.';
+ }
+
+ # Do everything from $path, so we get filenames relative to that
+ local $CWD = $path;
+
+ # Find all the files known to git
+ my @out =
+ apply { canonpath } # make paths canonical ...
+ apply { chomp } # strip all newlines ...
+ qx( git ls-files );
+
+ # Get files in a reliable order
+ @out = sort @out;
+
+ is( $?, 0, 'git ls-files ran ok' );
+ ok( @out, 'git ls-files found some files' );
+
+ return @out;
+}
+
+# Returns a list of all perl files known to git under the given $path.
+# See Perl::Critic::Utils all_perl_files for documentation on what
+# "perl files" means.
+# May return an empty list if there are no perl files.
+sub all_perl_files_in_git
+{
+ my ($path) = @_;
+
+ if (!$path) {
+ $path = '.';
+ }
+
+ # Do everything from $path, so we get filenames relative to that
+ local $CWD = $path;
+
+ # Find all the git files ...
+ my %all_git_files = map { $_ => 1 } all_files_in_git( '.' );
+
+ # Then return only those perl files which are also in git
+ my @out = grep { $all_git_files{ $_ } } all_perl_files( '.' );
+
+ # Get files in a reliable order
+ @out = sort @out;
+
+ return @out;
+}
+
+1;
+