Mercurial > repos > cpt > cpt_psm_recombine

comparison lib/CPT/GenerateTests.pm @ 1:97ef96676b48 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload commit 94b0cd1fff0826c6db3e7dc0c91c0c5a8be8bb0c
author cpt
date Mon, 05 Jun 2023 02:51:26 +0000
parents
children
comparison
equal deleted inserted replaced
0:b18e8268bf4e 1:97ef96676b48
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