Mercurial > repos > cpt > cpt_psm_prep

comparison lib/CPT/GenerateTests.pm @ 1:d724f34e671d draft default tip

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:50:07 +0000
parents
children
comparison
equal deleted inserted replaced
0:e4de0a0e90c8 1:d724f34e671d
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