diff options
Diffstat (limited to 'src/test/perl/TestLib.pm')
| -rw-r--r-- | src/test/perl/TestLib.pm | 37 |
1 files changed, 37 insertions, 0 deletions
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm index 458b8013796..c0e636cfa1d 100644 --- a/src/test/perl/TestLib.pm +++ b/src/test/perl/TestLib.pm @@ -860,6 +860,43 @@ sub command_checks_all =pod +=item pump_until(proc, timeout, stream, untl) + +# Pump until string is matched, or timeout occurs + +=cut + +sub pump_until +{ + my ($proc, $timeout, $stream, $untl) = @_; + $proc->pump_nb(); + while (1) + { + last if $$stream =~ /$untl/; + if ($timeout->is_expired) + { + diag("aborting wait: program timed out"); + diag("stream contents: >>", $$stream, "<<"); + diag("pattern searched for: ", $untl); + + return 0; + } + if (not $proc->pumpable()) + { + diag("aborting wait: program died"); + diag("stream contents: >>", $$stream, "<<"); + diag("pattern searched for: ", $untl); + + return 0; + } + $proc->pump(); + } + return 1; + +} + +=pod + =back =cut |