[med-svn] samtools 17/26: Adds tests for usage message for samtools and all subcommands

[Charles Plessy]

This is an automated email from the git hooks/post-receive script.

plessy pushed a commit to branch debian/unstable
in repository samtools.

commit eabd608689d76e8e97c975f2bf07a2f59d12f638
Author: Joshua Randall <joshua.randall at sanger.ac.uk>
Date:   Wed Dec 4 02:54:24 2013 +0000

    Adds tests for usage message for samtools and all subcommands
    
    Parses usage output into sections and looks for usage, version, and commands sections
    using regexes.
    
    Dispatches a further usage test for each subcommand reported by `samtools`
    
    Verifies that subcommand usage lines mention `samtools subcommand` where subcommand
    is the name of the subcommand (this test is not run if the regex 'not.*implemented'
    is found anywhere in the subcommand output -- it seems reasonable enough that not
    yet implemented subcommands would not have usage messages)
    
    N.B. this currently fails on 4 subcommands - these need fixing and these
    tests should tell us when they are fixed.
---
 test/test.pl | 88 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 88 insertions(+)

diff --git a/test/test.pl b/test/test.pl
index 003adcf..e0159d2 100755
--- a/test/test.pl
+++ b/test/test.pl
@@ -13,6 +13,7 @@ my $opts = parse_params();
 test_bgzip($opts);
 test_faidx($opts);
 test_mpileup($opts);
+test_usage($opts, cmd=>'samtools');
 
 print "\nNumber of tests:\n";
 printf "    total   .. %d\n", $$opts{nok}+$$opts{nfailed};
@@ -333,3 +334,90 @@ sub test_mpileup
     test_cmd($opts,out=>'dat/mpileup.out.3',cmd=>"$$opts{bin}/samtools mpileup -B --ff 0x14 -f $$opts{tmp}/mpileup.ref.fa.gz -r17:1050-1060 $$opts{tmp}/mpileup.1.bam 2>/dev/null | grep -v mpileup");
 }
 
+sub test_usage
+{
+    my ($opts,%args) = @_;
+
+    my $test = "test_usage";
+    print "$test:\n";
+    print "\t$args{cmd}\n";
+    
+    my $command = $args{cmd};
+    my $commandpath = $$opts{bin}."/".$command;
+    my ($ret,$out) = _cmd("$commandpath 2>&1");
+    if ( $out =~ m/\/bin\/bash.*no.*such/i ) { failed($opts,$test,"could not run $commandpath: $out"); return; }
+
+    my @sections = ($out =~ m/(^[A-Za-z]+.*?)(?:(?=^[A-Za-z]+:)|\z)/msg);
+    
+    my $have_usage = 0;
+    my $have_version = 0;
+    my $have_subcommands = 0;
+    my $usage = "";
+    my @subcommands = ();
+    foreach my $section (@sections) {
+	if ( $section =~ m/^usage/i ) {
+	    $have_usage = 1;
+	    $section =~ s/^[[:word:]]+[[:punct:][:space:]]*//;
+	    $usage = $section;
+	} elsif ( $section =~ m/^version/i ) {
+	    $have_version = 1;
+	} elsif ( $section =~ m/^command/i ) {
+	    $have_subcommands = 1;
+	    $section =~ s/^[[:word:]]+[[:punct:]]?[[:space:]]*//;
+	    $section =~ s/^[[:space:]]+//mg;
+	    $section =~ s/^[[:punct:]]+.*?\n//msg;
+	    @subcommands = ($section =~ m/^([[:word:]]+)[[:space:]].*/mg);
+	}
+    }
+    
+    if ( !$have_usage ) { failed($opts,$test,"did not have Usage:"); return; }
+    if ( !$have_version ) { failed($opts,$test,"did not have Version:"); return; }
+    if ( !$have_subcommands ) { failed($opts,$test,"did not have Commands:"); return; }
+
+    if ( !($usage =~ m/$command/) ) { failed($opts,$test,"usage did not mention $command"); return; } 
+    
+    if ( scalar(@subcommands) < 1 ) { failed($opts,$test,"could not parse subcommands"); return; }
+    print "\t$command has subcommands: ".join(", ", @subcommands)."\n";
+
+    passed($opts,$test);
+    
+    # now test subcommand usage as well
+    foreach my $subcommand (@subcommands) {
+	test_usage_subcommand($opts,%args,subcmd=>$subcommand);
+    }
+}
+
+sub test_usage_subcommand
+{
+    my ($opts,%args) = @_;
+
+    my $test = "test_usage_subcommand";
+    print "$test:\n";
+    print "\t$args{cmd} $args{subcmd}\n";
+
+    my $command = $args{cmd};
+    my $subcommand = $args{subcmd};
+    my $commandpath = $$opts{bin}."/".$command;
+    my ($ret,$out) = _cmd("$commandpath $subcommand 2>&1");
+    if ( $out =~ m/\/bin\/bash.*no.*such/i ) { failed($opts,$test,"could not run $commandpath $subcommand: $out"); return; }
+
+    if ( $out =~ m/not.*implemented/is ) { passed($opts,$test,"subcommand indicates it is not implemented"); return; }
+
+    my @sections = ($out =~ m/(^[A-Za-z]+.*?)(?:(?=^[A-Za-z]+:)|\z)/msg);
+    
+    my $have_usage = 0;
+    my $usage = "";
+    foreach my $section (@sections) {
+	if ( $section =~ m/^usage/i ) {
+	    $have_usage = 1;
+	    $section =~ s/^[[:word:]]+[[:punct:]]?[[:space:]]*//;
+	    $usage = $section;
+	}
+    }
+    
+    if ( !$have_usage ) { failed($opts,$test,"did not have Usage:"); return; }
+
+    if ( !($usage =~ m/$command[[:space:]]+$subcommand/) ) { failed($opts,$test,"usage did not mention $command $subcommand"); return; } 
+    
+    passed($opts,$test);
+}

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/samtools.git