File: suite.pm

package info (click to toggle)
mariadb-10.0 10.0.32-0%2Bdeb8u1
  • links: PTS, VCS
  • area: main
  • in suites: jessie
  • size: 476,064 kB
  • sloc: cpp: 1,400,131; ansic: 832,140; perl: 54,391; sh: 41,304; pascal: 32,365; yacc: 14,921; xml: 5,257; sql: 4,667; cs: 4,647; makefile: 4,555; ruby: 4,465; python: 2,292; lex: 1,427; java: 941; asm: 295; awk: 54; php: 22; sed: 16
file content (53 lines) | stat: -rw-r--r-- 1,283 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
package My::Suite::CTest;
use Cwd;

@ISA = qw(My::Suite);

sub list_cases {
  my ($self) = @_;
  keys %{$self->{ctests}}
}

sub start_test {
  my ($self, $tinfo)= @_;
  my $args;
  my $path;
  my $cmd = $self->{ctests}->{$tinfo->{shortname}};

  if ($cmd =~ /[ "'><%!*?]/) {
    ($path, $args) = ('/bin/sh', [ '-c', $cmd ])
  } else {
    ($path, $args) = ($cmd, , [ ])
  }


  my $oldpwd=getcwd();
  chdir $::opt_vardir;
  my $proc=My::SafeProcess->new
           (
            name          => $tinfo->{shortname},
            path          => $path,
            args          => \$args,
            append        => 1,
            output        => $::path_current_testlog,
            error         => $::path_current_testlog,
           );
  chdir $oldpwd;
  $proc;
}

{ 
  return "Not run for embedded server" if $::opt_embedded_server;
  return "Not configured to run ctest" unless -f "../CTestTestfile.cmake";
  my ($ctest_vs)= $opt_vs_config ? "--build-config $opt_vs_config" : "";
  my (@ctest_list)= `cd .. && ctest $opt_vs_config --show-only --verbose`;
  return "No ctest" if $?;

  my ($command, %tests);
  for (@ctest_list) {
    chomp;
    $command= $' if /^\d+: Test command: +/;
    $tests{$'}=$command if /^ +Test +#\d+: +/;
  }
  bless { ctests => { %tests } };
}