[libapp-stacktrace-perl] 03/05: Wait til the script has advanced far enough before getting a stacktrace

[Axel Beckert]

This is an automated email from the git hooks/post-receive script.

abe pushed a commit to annotated tag v0.03
in repository libapp-stacktrace-perl.

commit 208c1c635c24ac6d3af21e0145029691fb001bd1
Author: Josh ben Jore <jjore at cpan.org>
Date:   Thu Jun 16 05:51:22 2011 -0700

    Wait til the script has advanced far enough before getting a stacktrace
---
 t/unthreaded.t | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/t/unthreaded.t b/t/unthreaded.t
index 1133f99..2fc1389 100644
--- a/t/unthreaded.t
+++ b/t/unthreaded.t
@@ -75,6 +75,9 @@ close $pstack_rd;
 close $pstack_wr1;
 sysread $pstack_rd1, $_, 1;
 
+my ( $script_rd, $script_wr );
+pipe( $script_rd, $script_wr );
+
 $SIG{CHLD} = sub { exit };
 my $script_ppid = $$;
 my $script_pid = fork;
@@ -82,6 +85,8 @@ if (!defined $pstack_pid) {
     die "Can't fork: $!";
 }
 elsif ($script_pid) {
+    sysread $script_rd, $_, 1;
+
     require App::Stacktrace;
     open STDOUT, '>&=' . fileno( $pstack_wr );
     open STDERR, '>&=' . fileno( $pstack_wr );
@@ -102,6 +107,7 @@ sub foo {
         foo( $v );
     }
     else {
+        syswrite $script_wr, '.';
         while (1) {
             my $pstack_ppid_alive = kill 0, $pstack_ppid;
             my $script_ppid_alive = kill 0, $script_ppid;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libapp-stacktrace-perl.git