From d4ebcb4b4a36d463472d8169e84c751fef30115d Mon Sep 17 00:00:00 2001 From: Richard Ipsum Date: Wed, 19 Aug 2015 15:49:46 +0000 Subject: Add cpan test script This script is helpful for ensuring regressions haven't been introduced, naturally it's relying on CPAN which can change over time, but it's still useful to be able to check that the modules you could import before applying a patch can still be imported afterwards. Change-Id: I58ccadf08a3ad58a1c4aa8d3c730ced5e39426de --- run_cpan_test_imports.pl | 86 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 86 insertions(+) create mode 100755 run_cpan_test_imports.pl diff --git a/run_cpan_test_imports.pl b/run_cpan_test_imports.pl new file mode 100755 index 0000000..2643f97 --- /dev/null +++ b/run_cpan_test_imports.pl @@ -0,0 +1,86 @@ +#!/usr/bin/env perl +# +# This script is helpful for ensuring regressions haven't been introduced, +# naturally it's relying on CPAN which can change over time, +# but it's still useful to be able to check that the modules +# you could import before applying a patch can still be imported afterwards. +# +# Copyright © 2015 Codethink Limited +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; version 2 of the License. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use 5.020; +use warnings; +use strict; +use English; +use autodie; + +use File::Path qw(remove_tree); +use IO::Async::Loop; +use IO::Async::Process; + +my $argc = @ARGV; + +unless ($argc == 1) { + say STDERR "usage: $PROGRAM_NAME IMPORT_TOOL_PATH"; + exit 1; +} + +my $import_tool = File::Spec->rel2abs($ARGV[0]); + +my $ok = 1; + +my @modules = qw(IO::Async DBI CGI CGI::Carp Data::Dumper Net::SCP + Mail::Sendmail CGI::Cookie Net::FTP Date::Simple + LWP::UserAgent WWW::Mechanize XML::Simple Net::Telnet + Text::CSV Log::Log4perl HTML::TreeBuilder Moose Moo + SOAP::Lite Spreadsheet::WriteExcel + Spreadsheet::ParseExcel YAML::LibYAML); + +mkdir 'test_results' unless (-d 'test_results'); +chdir 'test_results'; + +my $i = 1; +my $numof_modules = @modules; +for my $module (@modules) { + say "Running test for $module ($i/$numof_modules)"; + remove_tree($module); + mkdir $module; + + my @args = [$import_tool, 'cpan', $module, "--log=importlog_$module"]; + + my $loop = IO::Async::Loop->new; + my $process = IO::Async::Process->new(command => @args, + setup => [chdir => $module], + on_finish => sub { $loop->stop }); + $loop->add($process); + $loop->run; + $i++; +} + +for my $module (@modules) { + my @expected_stratum_path = glob "$module/definitions/strata/*.morph"; + + unless (@expected_stratum_path) { + say "no stratum for $module"; + $ok = 0; + } +} + +if ($ok) { + say 'Looks ok'; +} +else { + exit 1; +} -- cgit v1.2.1