|
0
|
1 package CPT::GenerateTests;
|
|
|
2 use Moose;
|
|
|
3 use strict;
|
|
|
4 use warnings;
|
|
|
5 use autodie;
|
|
|
6
|
|
|
7
|
|
|
8 sub gen {
|
|
|
9 my ( $self, @tests ) = @_;
|
|
|
10
|
|
|
11 my $test_count = 0;
|
|
|
12
|
|
|
13 # Header
|
|
|
14 my @outtext = (
|
|
|
15 '#!/usr/bin/env perl',
|
|
|
16 'use strict;',
|
|
|
17 'use warnings;',
|
|
|
18 'use Test::More tests => 0;',
|
|
|
19 'use IPC::Run3 qw(run3);',
|
|
|
20 '',
|
|
|
21 'my ( @base, @cmd, $in, $out, $err );',
|
|
|
22 '',
|
|
|
23 sprintf("%s = ('perl', '%s');", '@base', $0),
|
|
|
24 'my %result_files = (',
|
|
|
25 );
|
|
|
26 my %test_names;
|
|
|
27 # Loop across tests
|
|
|
28 foreach my $test_ref(@tests){
|
|
|
29 my %test = %{$test_ref};
|
|
|
30 my %params = %{$test{params}};
|
|
|
31 my $command_line = "";
|
|
|
32 foreach(sort(keys(%params))){
|
|
|
33 $command_line .= "--$_ $params{$_} ";
|
|
|
34 }
|
|
|
35 my %outputs = %{$test{outputs}};
|
|
|
36
|
|
|
37 $test_names{$test{test_name}}++;
|
|
|
38 if($test_names{$test{test_name}} > 1){
|
|
|
39 printf STDERR "Duplicate test found: %s. This will cause fewer tests to be run than expected\n", $test{test_name};
|
|
|
40 }
|
|
|
41 push(@outtext, sprintf(' "%s" => {', $test{test_name}));
|
|
|
42 push(@outtext, sprintf(' command_line => "%s",', $command_line));
|
|
|
43 push(@outtext, ' outputs => {');
|
|
|
44
|
|
|
45 foreach my $key(keys %outputs){
|
|
|
46 push(@outtext, sprintf(' "%s" => ["%s", "%s"],', $key, @{$outputs{$key}}));
|
|
|
47 # Add another test
|
|
|
48 $test_count++;
|
|
|
49 $test_count++;
|
|
|
50 }
|
|
|
51 push(@outtext, ' },');
|
|
|
52 push(@outtext, ' },');
|
|
|
53 };
|
|
|
54 push(@outtext, ');');
|
|
|
55 push(@outtext,'');
|
|
|
56
|
|
|
57 push(@outtext, 'foreach ( keys(%result_files) ) {');
|
|
|
58 push(@outtext, ' # run with the command line');
|
|
|
59 push(@outtext, ' my @cmd1 = ( @base, split( / /, $result_files{$_}{command_line} ) );');
|
|
|
60 push(@outtext, ' run3 \@cmd1, \$in, \$out, \$err;');
|
|
|
61 push(@outtext, ' if($err){ print STDERR "Exec STDERR: $err"; }');
|
|
|
62 push(@outtext, ' if($out){ print STDERR "Exec STDOUT $out"; }');
|
|
|
63 push(@outtext, ' # and now compare files');
|
|
|
64 push(@outtext, ' foreach my $file_cmp ( keys( %{$result_files{$_}{outputs}} ) ) {');
|
|
|
65 push(@outtext, ' my ($gen, $static) = @{$result_files{$_}{outputs}{$file_cmp}};');
|
|
|
66 push(@outtext, ' my @diff = ( "diff", $gen, $static );');
|
|
|
67 push(@outtext, ' my ($in_g, $out_g, $err_g);');
|
|
|
68 push(@outtext, ' run3 \@diff, \$in_g, \$out_g, \$err_g;');
|
|
|
69 push(@outtext, ' if($err_g) { print STDERR "err_g $err_g\n"; }');
|
|
|
70 push(@outtext, ' if($out_g) { print STDOUT "out_g $out_g\n"; }');
|
|
|
71 push(@outtext, ' chomp $out_g;');
|
|
|
72 push(@outtext, ' is( -e $gen, 1, "[$_] Output file must exist"); ');
|
|
|
73 push(@outtext, ' is( length($out_g), 0, "[$_] Checking validity of output \'$file_cmp\'" );');
|
|
|
74 push(@outtext, ' unlink $gen;');
|
|
|
75 push(@outtext, ' }');
|
|
|
76 push(@outtext, '}');
|
|
|
77
|
|
|
78 # Update test counts
|
|
|
79 $outtext[3] = "use Test::More tests => $test_count;";
|
|
|
80 if($test_count == 0){
|
|
|
81 return $self->gen_empty();
|
|
|
82 }
|
|
|
83
|
|
|
84 return join("\n", @outtext);
|
|
|
85 }
|
|
|
86
|
|
|
87 sub gen_empty {
|
|
|
88 my ( $self ) = @_;
|
|
|
89
|
|
|
90 my $test_count = 0;
|
|
|
91
|
|
|
92 my @outtext = (
|
|
|
93 '#!/usr/bin/env perl',
|
|
|
94 'use strict;',
|
|
|
95 'use warnings;',
|
|
|
96 'use Test::More skip_all => "No tests defined for ' . $0 .'"',
|
|
|
97 );
|
|
|
98 return join("\n", @outtext);
|
|
|
99 }
|
|
|
100
|
|
|
101
|
|
|
102 no Moose;
|
|
|
103 1;
|
|
|
104
|
|
|
105 __END__
|
|
|
106
|
|
|
107 =pod
|
|
|
108
|
|
|
109 =encoding UTF-8
|
|
|
110
|
|
|
111 =head1 NAME
|
|
|
112
|
|
|
113 CPT::GenerateTests
|
|
|
114
|
|
|
115 =head1 VERSION
|
|
|
116
|
|
|
117 version 1.99.4
|
|
|
118
|
|
|
119 =head2 gen
|
|
|
120
|
|
|
121 require CPT::GenerateTests;
|
|
|
122 my $tgen = CPT::GenerateTests->new();
|
|
|
123 $tgen->gen(
|
|
|
124 {
|
|
|
125 test_name => "Default",
|
|
|
126 params => {
|
|
|
127 'file' => 't/test-files/aa.gbk',
|
|
|
128 'chromosome' => 'test',
|
|
|
129 'color' => 'red',
|
|
|
130 'intensity' => 'vvvvl',
|
|
|
131 },
|
|
|
132 outputs => {
|
|
|
133 'result_name' => ['circos_k.txt', 'test-data/circos_k.txt'],
|
|
|
134 }
|
|
|
135 },
|
|
|
136 );
|
|
|
137 exit 1;
|
|
|
138
|
|
|
139 =head1 AUTHOR
|
|
|
140
|
|
|
141 Eric Rasche <rasche.eric@yandex.ru>
|
|
|
142
|
|
|
143 =head1 COPYRIGHT AND LICENSE
|
|
|
144
|
|
|
145 This software is Copyright (c) 2014 by Eric Rasche.
|
|
|
146
|
|
|
147 This is free software, licensed under:
|
|
|
148
|
|
|
149 The GNU General Public License, Version 3, June 2007
|
|
|
150
|
|
|
151 =cut
|
