Mercurial > repos > dereeper > roary_plots
comparison Roary/t/lib/TestHelper.pm @ 0:c47a5f61bc9f draft
Uploaded
author | dereeper |
---|---|
date | Fri, 14 May 2021 20:27:06 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:c47a5f61bc9f |
---|---|
1 package TestHelper; | |
2 use Moose::Role; | |
3 use Test::Most; | |
4 use Data::Dumper; | |
5 use File::Slurper qw(read_lines read_text); | |
6 use Test::Files; | |
7 use Test::Output; | |
8 | |
9 $ENV{PATH} .= ":./bin"; | |
10 | |
11 sub compare_files { | |
12 my ( $actual_file, $expected_file, $comment ) = @_; | |
13 my @actual_lines = sort( read_lines($actual_file) ); | |
14 my @expected_lines = sort( read_lines($expected_file) ); | |
15 is_deeply( \@actual_lines, \@expected_lines, $comment ); | |
16 } | |
17 | |
18 sub compare_groups_files { | |
19 my ( $actual_file, $expected_file, $comment ) = @_; | |
20 my @actual_lines = sort( read_lines($actual_file) ); | |
21 my @expected_lines = sort( read_lines($expected_file) ); | |
22 | |
23 my @actual_sorted_lines; | |
24 for my $line (@actual_lines) { | |
25 my @line_details = split( / /, $line ); | |
26 shift @line_details; | |
27 my @sorted = sort(@line_details); | |
28 push( @actual_sorted_lines, \@sorted ); | |
29 } | |
30 | |
31 my @expected_sorted_lines; | |
32 for my $line (@expected_lines) { | |
33 my @line_details = split( / /, $line ); | |
34 shift @line_details; | |
35 my @sorted = sort(@line_details); | |
36 push( @expected_sorted_lines, \@sorted ); | |
37 } | |
38 is_deeply( \@actual_sorted_lines, \@expected_sorted_lines, $comment ); | |
39 } | |
40 | |
41 | |
42 sub stdout_should_have | |
43 { | |
44 my ( $script_name, $parameters, $expected ) = @_; | |
45 my @input_args = split( " ", $parameters ); | |
46 open OLDERR, '>&STDERR'; | |
47 eval("use $script_name ;"); | |
48 my $returned_values = 0; | |
49 { | |
50 local *STDERR; | |
51 open STDERR, '>/dev/null' or warn "Can't open /dev/null: $!"; | |
52 stdout_like { eval("$script_name->new(args => \\\@input_args, script_name => '$script_name')->run;"); } qr/$expected/, "got expected text $expected for $parameters"; | |
53 close STDERR; | |
54 } | |
55 open STDERR, '>&OLDERR' or die "Can't restore stderr: $!"; | |
56 close OLDERR or die "Can't close OLDERR: $!"; | |
57 } | |
58 | |
59 | |
60 sub stdout_should_not_have | |
61 { | |
62 my ( $script_name, $parameters, $expected ) = @_; | |
63 my @input_args = split( " ", $parameters ); | |
64 open OLDERR, '>&STDERR'; | |
65 eval("use $script_name ;"); | |
66 my $returned_values = 0; | |
67 { | |
68 local *STDERR; | |
69 open STDERR, '>/dev/null' or warn "Can't open /dev/null: $!"; | |
70 stdout_unlike { eval("$script_name->new(args => \\\@input_args, script_name => '$script_name')->run;"); } qr/$expected/, "got expected text $expected for $parameters"; | |
71 close STDERR; | |
72 } | |
73 open STDERR, '>&OLDERR' or die "Can't restore stderr: $!"; | |
74 close OLDERR or die "Can't close OLDERR: $!"; | |
75 } | |
76 | |
77 | |
78 | |
79 sub stderr_should_not_have | |
80 { | |
81 my ( $script_name, $parameters, $expected ) = @_; | |
82 my @input_args = split( " ", $parameters ); | |
83 open OLDOUT, '>&STDOUT'; | |
84 eval("use $script_name ;"); | |
85 my $returned_values = 0; | |
86 { | |
87 local *STDOUT; | |
88 open STDOUT, '>/dev/null' or warn "Can't open /dev/null: $!"; | |
89 stderr_unlike { eval("$script_name->new(args => \\\@input_args, script_name => '$script_name')->run;"); } qr/$expected/, "got expected text $expected for $parameters"; | |
90 close STDOUT; | |
91 } | |
92 open STDOUT, '>&OLDOUT' or die "Can't restore stdout: $!"; | |
93 close OLDOUT or die "Can't close OLDOUT: $!"; | |
94 } | |
95 | |
96 sub stderr_should_have | |
97 { | |
98 my ( $script_name, $parameters, $expected ) = @_; | |
99 my @input_args = split( " ", $parameters ); | |
100 open OLDOUT, '>&STDOUT'; | |
101 eval("use $script_name ;"); | |
102 my $returned_values = 0; | |
103 { | |
104 local *STDOUT; | |
105 open STDOUT, '>/dev/null' or warn "Can't open /dev/null: $!"; | |
106 stderr_like { eval("$script_name->new(args => \\\@input_args, script_name => '$script_name')->run;"); } qr/$expected/, "got expected text $expected for $parameters"; | |
107 close STDOUT; | |
108 } | |
109 open STDOUT, '>&OLDOUT' or die "Can't restore stdout: $!"; | |
110 close OLDOUT or die "Can't close OLDOUT: $!"; | |
111 } | |
112 | |
113 | |
114 sub mock_execute_script_and_check_output { | |
115 my ( $script_name, $scripts_and_expected_files, $columns_to_exclude ) = @_; | |
116 | |
117 system('touch empty_file'); | |
118 | |
119 open OLDOUT, '>&STDOUT'; | |
120 open OLDERR, '>&STDERR'; | |
121 eval("use $script_name ;"); | |
122 my $returned_values = 0; | |
123 { | |
124 local *STDOUT; | |
125 open STDOUT, '>/dev/null' or warn "Can't open /dev/null: $!"; | |
126 local *STDERR; | |
127 open STDERR, '>/dev/null' or warn "Can't open /dev/null: $!"; | |
128 | |
129 for my $script_parameters ( sort keys %$scripts_and_expected_files ) { | |
130 my $full_script = $script_parameters; | |
131 my @input_args = split( " ", $full_script ); | |
132 | |
133 my $cmd = "$script_name->new(args => \\\@input_args, script_name => '$script_name')->run;"; | |
134 eval($cmd); | |
135 warn $@ if $@; | |
136 | |
137 my $actual_output_file_name = $scripts_and_expected_files->{$script_parameters}->[0]; | |
138 my $expected_output_file_name = $scripts_and_expected_files->{$script_parameters}->[1]; | |
139 ok( -e $actual_output_file_name, "Actual output file exists $actual_output_file_name $script_parameters" ); | |
140 if ( defined($columns_to_exclude) ) { | |
141 is( | |
142 _exclude_variable_columns_from_spreadsheet( $actual_output_file_name, $columns_to_exclude ), | |
143 _exclude_variable_columns_from_spreadsheet( $expected_output_file_name, $columns_to_exclude ), | |
144 'Actual and expected match output excluding variable columns' | |
145 ); | |
146 } | |
147 else { | |
148 compare_ok( $actual_output_file_name, $expected_output_file_name, | |
149 "Actual and expected output match for '$script_parameters'" ); | |
150 | |
151 } | |
152 unlink($actual_output_file_name); | |
153 } | |
154 close STDOUT; | |
155 close STDERR; | |
156 } | |
157 | |
158 # Restore stdout. | |
159 open STDOUT, '>&OLDOUT' or die "Can't restore stdout: $!"; | |
160 open STDERR, '>&OLDERR' or die "Can't restore stderr: $!"; | |
161 | |
162 # Avoid leaks by closing the independent copies. | |
163 close OLDOUT or die "Can't close OLDOUT: $!"; | |
164 close OLDERR or die "Can't close OLDERR: $!"; | |
165 unlink('empty_file'); | |
166 } | |
167 | |
168 sub mock_execute_script_and_check_output_sorted_groups { | |
169 my ( $script_name, $scripts_and_expected_files, $columns_to_exclude ) = @_; | |
170 | |
171 system('touch empty_file'); | |
172 | |
173 open OLDOUT, '>&STDOUT'; | |
174 open OLDERR, '>&STDERR'; | |
175 eval("use $script_name ;"); | |
176 my $returned_values = 0; | |
177 { | |
178 local *STDOUT; | |
179 open STDOUT, '>/dev/null' or warn "Can't open /dev/null: $!"; | |
180 local *STDERR; | |
181 open STDERR, '>/dev/null' or warn "Can't open /dev/null: $!"; | |
182 | |
183 for my $script_parameters ( sort keys %$scripts_and_expected_files ) { | |
184 my $full_script = $script_parameters; | |
185 my @input_args = split( " ", $full_script ); | |
186 | |
187 my $cmd = "$script_name->new(args => \\\@input_args, script_name => '$script_name')->run;"; | |
188 eval($cmd); | |
189 warn $@ if $@; | |
190 | |
191 my $actual_output_file_name = $scripts_and_expected_files->{$script_parameters}->[0]; | |
192 | |
193 my $expected_output_file_name = $scripts_and_expected_files->{$script_parameters}->[1]; | |
194 ok( -e $actual_output_file_name, "Actual output file exists $actual_output_file_name $script_parameters" ); | |
195 if ( defined($columns_to_exclude) ) { | |
196 my @actual_content_sorted = | |
197 sort( split( /\n/, _exclude_variable_columns_from_spreadsheet( $actual_output_file_name, $columns_to_exclude ) ) ); | |
198 my @expected_content_sorted = | |
199 sort( split( /\n/, _exclude_variable_columns_from_spreadsheet( $expected_output_file_name, $columns_to_exclude ) ) ); | |
200 is_deeply( \@actual_content_sorted, \@expected_content_sorted, | |
201 'Actual and expected match output excluding variable columns' ); | |
202 } | |
203 else { | |
204 compare_groups_files( $actual_output_file_name, $expected_output_file_name, | |
205 "Actual and expected sorted output match for '$script_parameters'" ); | |
206 } | |
207 unlink($actual_output_file_name); | |
208 } | |
209 close STDOUT; | |
210 close STDERR; | |
211 } | |
212 | |
213 # Restore stdout. | |
214 open STDOUT, '>&OLDOUT' or die "Can't restore stdout: $!"; | |
215 open STDERR, '>&OLDERR' or die "Can't restore stderr: $!"; | |
216 | |
217 # Avoid leaks by closing the independent copies. | |
218 close OLDOUT or die "Can't close OLDOUT: $!"; | |
219 close OLDERR or die "Can't close OLDERR: $!"; | |
220 unlink('empty_file'); | |
221 } | |
222 | |
223 sub mock_execute_script_and_check_output_sorted { | |
224 my ( $script_name, $scripts_and_expected_files, $columns_to_exclude ) = @_; | |
225 | |
226 system('touch empty_file'); | |
227 | |
228 open OLDOUT, '>&STDOUT'; | |
229 open OLDERR, '>&STDERR'; | |
230 eval("use $script_name ;"); | |
231 my $returned_values = 0; | |
232 { | |
233 local *STDOUT; | |
234 open STDOUT, '>/dev/null' or warn "Can't open /dev/null: $!"; | |
235 local *STDERR; | |
236 open STDERR, '>/dev/null' or warn "Can't open /dev/null: $!"; | |
237 | |
238 for my $script_parameters ( sort keys %$scripts_and_expected_files ) { | |
239 my $full_script = $script_parameters; | |
240 my @input_args = split( " ", $full_script ); | |
241 | |
242 my $cmd = "$script_name->new(args => \\\@input_args, script_name => '$script_name')->run;"; | |
243 eval($cmd); | |
244 warn $@ if $@; | |
245 | |
246 my $actual_output_file_name = $scripts_and_expected_files->{$script_parameters}->[0]; | |
247 | |
248 my $expected_output_file_name = $scripts_and_expected_files->{$script_parameters}->[1]; | |
249 ok( -e $actual_output_file_name, "Actual output file exists $actual_output_file_name $script_parameters" ); | |
250 if ( defined($columns_to_exclude) ) { | |
251 my @actual_content_sorted = | |
252 sort( split( /\n/, _exclude_variable_columns_from_spreadsheet( $actual_output_file_name, $columns_to_exclude ) ) ); | |
253 my @expected_content_sorted = | |
254 sort( split( /\n/, _exclude_variable_columns_from_spreadsheet( $expected_output_file_name, $columns_to_exclude ) ) ); | |
255 is_deeply( \@actual_content_sorted, \@expected_content_sorted, | |
256 'Actual and expected match output excluding variable columns' ); | |
257 } | |
258 else { | |
259 compare_groups_files( $actual_output_file_name, $expected_output_file_name, | |
260 "Actual and expected sorted output match for '$script_parameters'" ); | |
261 } | |
262 unlink($actual_output_file_name); | |
263 } | |
264 close STDOUT; | |
265 close STDERR; | |
266 } | |
267 | |
268 # Restore stdout. | |
269 open STDOUT, '>&OLDOUT' or die "Can't restore stdout: $!"; | |
270 open STDERR, '>&OLDERR' or die "Can't restore stderr: $!"; | |
271 | |
272 # Avoid leaks by closing the independent copies. | |
273 close OLDOUT or die "Can't close OLDOUT: $!"; | |
274 close OLDERR or die "Can't close OLDERR: $!"; | |
275 unlink('empty_file'); | |
276 } | |
277 | |
278 sub compare_tab_files_with_variable_coordinates { | |
279 my ( $actual_file, $expected_file ) = @_; | |
280 ok( -e $actual_file, 'File exists' . $actual_file ); | |
281 | |
282 is( | |
283 _filter_coordinates_from_string($actual_file), | |
284 _filter_coordinates_from_string($expected_file), | |
285 'file contents the same for ' . $actual_file | |
286 ); | |
287 } | |
288 | |
289 sub _filter_coordinates_from_string { | |
290 my ($file_name) = @_; | |
291 my $file_contents = read_text($file_name); | |
292 my @lines = split( /\n/, $file_contents ); | |
293 my $modified_file_contents = ''; | |
294 for my $line ( sort @lines ) { | |
295 next if ( $line =~ /(variation|misc_feature|feature)/ ); | |
296 $line =~ s!group_[\d]+!group_XX!gi; | |
297 $modified_file_contents .= $line . "\n"; | |
298 } | |
299 return $modified_file_contents; | |
300 } | |
301 | |
302 sub _exclude_variable_columns_from_spreadsheet { | |
303 my ( $file_name, $columns_to_exclude ) = @_; | |
304 my $file_contents = read_text($file_name); | |
305 my @lines = split( /\n/, $file_contents ); | |
306 my $modified_file_contents = ''; | |
307 | |
308 for ( my $i = 0 ; $i < @lines ; $i++ ) { | |
309 my @cells = split( /,/, $lines[$i] ); | |
310 | |
311 for my $col_number ( @{$columns_to_exclude} ) { | |
312 next unless ( defined( $cells[$col_number] ) ); | |
313 $cells[$col_number] = ''; | |
314 } | |
315 $modified_file_contents .= join( ',', @cells ) . "\n"; | |
316 } | |
317 | |
318 return $modified_file_contents; | |
319 } | |
320 | |
321 no Moose; | |
322 1; | |
323 |