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 |
