annotate cpt_psm_recombine/lib/CPT/GenerateTests.pm @ 0:b18e8268bf4e draft

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