One Level Up Top Level

test/lib/Test/ktap.pm - ktap

Data types defined

Source code

  1. # Copyright (C) Yichun Zhang (agentzh)

  3. package Test::ktap;

  5. use Test::Base -Base;
  6. use POSIX ();
  7. use IPC::Run ();

  9. our @EXPORT = qw( run_tests );

  11. ‌sub run_tests () {
  12.     for my $block (Test::Base::blocks()) {
  13.         run_test($block);
  14.     }
  15. }

  17. ‌sub bail_out (@) {
  18.     Test::More::BAIL_OUT(@_);
  19. }

  21. ‌sub parse_cmd ($) {
  22.     my $cmd = shift;
  23.     my @cmd;
  24.     while (1) {
  25.         if ($cmd =~ /\G\s*"(.*?)"/gmsc) {
  26.             push @cmd, $1;

  28.         } elsif ($cmd =~ /\G\s*'(.*?)'/gmsc) {
  29.             push @cmd, $1;

  31.         } elsif ($cmd =~ /\G\s*(\S+)/gmsc) {
  32.             push @cmd, $1;

  34.         } else {
  35.             last;
  36.         }
  37.     }
  38.     return @cmd;
  39. }

  41. ‌sub run_test ($) {
  42.     my $block = shift;
  43.     my $name = $block->name;

  45.     my $timeout = $block->timeout() || 10;
  46.     my $opts = $block->opts;
  47.     my $args = $block->args;

  49.     my $cmd = "./ktap";

  51.     if (defined $opts) {
  52.         $cmd .= " $opts";
  53.     }

  55.     my $kpfile;
  56.     if (defined $block->src) {
  57.         $kpfile = POSIX::tmpnam() . ".kp";
  58.         open my $out, ">$kpfile" or
  59.             bail_out("cannot open $kpfile for writing: $!");
  60.         print $out ($block->src);
  61.         close $out;
  62.         $cmd .= " $kpfile"
  63.     }

  65.     if (defined $args) {
  66.         $cmd .= " $args";
  67.     }

  69.     #warn "CMD: $cmd\n";

  71.     my @cmd = parse_cmd($cmd);

  73.     my ($out, $err);

  75.     eval {
  76.         IPC::Run::run(\@cmd, \undef, \$out, \$err,
  77.                       IPC::Run::timeout($timeout));
  78.     };
  79.     if ($@) {
  80.         # timed out
  81.         if ($@ =~ /timeout/) {
  82.             if (!defined $block->expect_timeout) {
  83.                 fail("$name: ktap process timed out");
  84.             }
  85.     } else {
  86.             fail("$name: failed to run command [$cmd]: $@");
  87.         }
  88.     }

  90.     my $ret = ($? >> 8);

  92.     if (defined $kpfile) {
  93.         unlink $kpfile;
  94.     }

  96.     if (defined $block->out) {
  97.         is $out, $block->out, "$name - stdout eq okay";
  98.     }

  100.     my $regex = $block->out_like;
  101.     if (defined $regex) {
  102.         if (!ref $regex) {
  103.             $regex = qr/$regex/ms;
  104.         }
  105.         like $out, $regex, "$name - stdout like okay";
  106.     }

  108.     if (defined $block->err) {
  109.         is $err, $block->err, "$name - stderr eq okay";
  110.     }

  112.     $regex = $block->err_like;
  113.     if (defined $regex) {
  114.         if (!ref $regex) {
  115.             $regex = qr/$regex/ms;
  116.         }
  117.         like $err, $regex, "$name - stderr like okay";
  118.     }

  120.     my $exp_ret = $block->ret;
  121.     if (!defined $exp_ret) {
  122.         $exp_ret = 0;
  123.     }
  124.     is $ret, $exp_ret, "$name - exit code okay";
  125. }

  127. 1;
  128. # vi: et

One Level Up Top Level