[perl #111300] eval does not catch die after alarm

# New Ticket Created by  Matti Linnanvuori 
# Please include the string:  [perl #111300]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org:443/rt3/Ticket/Display.html?id=111300 >


To: perlbug@perl.org
Subject: eval does not catch die after alarm
Cc: feedback@suse.de
Reply-To: matti@portalify.com
Message-Id: <5.10.0_22050_1329987027@pmc-inst-test>

This is a bug report for perl from matti@portalify.com,
generated with the help of perlbug 1.36 running under perl 5.10.0.


-----------------------------------------------------------------
[Please enter your report here]

eval does not catch die after alarm. I expected eval block to catch a die but it did not.

prove -v ack.t 
ack.t .. 
1..7
Timeout
# Looks like your test exited with 4 before it could output anything.
Dubious, test returned 4 (wstat 1024, 0x400)
Failed 7/7 subtests 

Test Summary Report
-------------------
ack.t (Wstat: 1024 Tests: 0 Failed: 0)
  Non-zero exit status: 4
  Parse errors: Bad plan.  You planned 7 tests but ran 0.
Files=1, Tests=0,  8 wallclock secs ( 0.01 usr  0.01 sys +  0.03 cusr  0.00 csys =  0.05 CPU)
Result: FAIL

#!/usr/bin/perl -w

=pod

=head1 ack.t

 Test 1: publishes an Ack JSON message in exchange.pmc.router-in.
 Test 1 expected result: a message is published to exchange.pmc.sf-in in 8 seconds.
 Test 2: decode the message as JSON.
 Test 2 expected result: a JSON message received.
 Test 3: check the sender field.
 Test 3 expected result: the field has value "exchange.pmc.router-in".
 Test 4: check the body field.
 Test 4 expected result: the body field is the same as in the message in test 1.
 Test 5: check the timestamp.
 Test 5 expected result: the timestamp is an integer.
 Test 6: check that the timestamp is equal or greater than milliseconds before test 1.
 Test 6 expected result: the timestamp is equal or greater than milliseconds before test 1.
 Test 7: check that the timestamp is less or equal to milliseconds now.
 Test 7 expected result: the timestamp is less or equal to milliseconds now.

=cut

use strict;

use Net::RabbitMQ;
use Test::More tests => 7;
use JSON;
use Time::HiRes qw(gettimeofday);

use constant ROUTER_EXCHANGE => 'exchange.pmc.router-in';
use constant SF_EXCHANGE     => 'exchange.pmc.sf-in';
use constant QUEUE           => 'queue.test.sf-in';

sub timestamp {
    return int( gettimeofday() * 1000 );
}

my $json_text = '{
"timestamp" : 1328020064358,
"sender" : "exchange.pmc.cassidian-in",
"body" : {
"type" : "ack",
"version" : 1,
"id" : "8f970b1b-f8a3-4c78-aa24-3b8e22056487",
"from" : {
"type" : "ssi",
"address" : "12345"
},
"ack_type" : "transient_failure",
"description" : "Failed individual delivery",
"auxiliary" : {
"timestamp" : 1328096877185,
"tcs_error_code" : 32
}
}
}';

my $mq = Net::RabbitMQ->new();

$mq->connect( "localhost", { user => "guest", password => "guest" } );
$mq->channel_open(1);
$mq->exchange_declare(
    1,
    SF_EXCHANGE,
    {
        exchange_type => 'direct',
        passive       => 0,
        durable       => 1,
        auto_delete   => 0
    }
);
$mq->queue_declare(
    1, QUEUE,
    {
        passive     => 0,
        durable     => 1,
        exclusive   => 0,
        auto_delete => 0
    }
);
$mq->queue_bind( 1, QUEUE, SF_EXCHANGE, '' );
$mq->purge( 1, QUEUE );
$mq->consume( 1, QUEUE );

my $before = timestamp();

$mq->publish(
    1, '',
    $json_text,
    {

        # Options
        exchange => ROUTER_EXCHANGE
    },
    {

        # Props
        content_encoding => "UTF-8",
        content_type     => "application/json"
    }
);

my $sent = decode_json($json_text);
my $message;
eval {
    local $SIG{ALRM} = sub { die "Timeout\n" };
    alarm 8;
    $message = $mq->recv();
    alarm 0;
};
is( $@, '', 'A message was received' );
my $json;
eval { $json = decode_json( $message->{'body'} ); };
is( $@, '', 'A JSON message received' );
is( $json->{'sender'}, ROUTER_EXCHANGE, 'sender ' . ROUTER_EXCHANGE );
is_deeply( $json->{'body'}, $sent->{'body'}, 'body the same' );
like( $json->{'timestamp'}, qr/^\d+$/, "timestamp an integer" );
ok( $json->{'timestamp'} >= $before,
    'timestamp greater than or equal to that of before publishing' )
  or diag("$json->{'timestamp'} < $before");
my $now = timestamp();
ok( $json->{'timestamp'} <= $now,
    'timestamp less than or equal to that of now' )
  or diag("$json->{'timestamp'} > $now");

END {
    $mq->queue_unbind( 1, QUEUE, SF_EXCHANGE, '' );
}


[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=medium
---
This perlbug was built using Perl 5.10.0 - Thu May  6 06:51:46 UTC 2010
It is being executed now by  Perl 5.10.0 - Thu May  6 06:45:06 UTC 2010.

Site configuration information for perl 5.10.0:

Configured by abuild at Thu May  6 06:45:06 UTC 2010.

Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.6.32, archname=x86_64-linux-thread-multi
    uname='linux knorr 2.6.32 #1 smp 2010-04-12 12:31:11 +0200 x86_64 x86_64 x86_64 gnulinux '
    config_args='-ds -e -Dprefix=/usr -Dvendorprefix=/usr -Dinstallusrbinperl -Dusethreads -Di_db -Di_dbm -Di_ndbm -Di_gdbm -Duseshrplib=true -Doptimize=-fmessage-length=0 -O2 -Wall -D_FORTIFY_SOURCE=2 -fstack-protector -funwind-tables -fasynchronous-unwind-tables -g -Wall -pipe -Accflags=-DPERL_USE_SAFE_PUTENV'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DPERL_USE_SAFE_PUTENV -DDEBUGGING -fno-strict-aliasing -pipe -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-fmessage-length=0 -O2 -Wall -D_FORTIFY_SOURCE=2 -fstack-protector -funwind-tables -fasynchronous-unwind-tables -g -Wall -pipe',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DPERL_USE_SAFE_PUTENV -DDEBUGGING -fno-strict-aliasing -pipe'
    ccversion='', gccversion='4.3.4 [gcc-4_3-branch revision 152973]', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib64'
    libpth=/lib64 /usr/lib64 /usr/local/lib64
    libs=-lm -ldl -lcrypt -lpthread
    perllibs=-lm -ldl -lcrypt -lpthread
    libc=/lib64/libc-2.11.1.so, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version='2.11.1'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/lib/perl5/5.10.0/x86_64-linux-thread-multi/CORE'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib64'

Locally applied patches:
    

---
@INC for perl 5.10.0:
    /usr/lib/perl5/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/5.10.0
    /usr/lib/perl5/site_perl/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/site_perl/5.10.0
    /usr/lib/perl5/vendor_perl/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.10.0
    /usr/lib/perl5/vendor_perl
    .

---
Environment for perl 5.10.0:
    HOME=/root
    LANG=POSIX
    LANGUAGE (unset)
    LC_CTYPE=en_US.UTF-8
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/sbin:/usr/sbin:/usr/local/sbin:/root/bin:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/X11R6/bin:/usr/games:/usr/lib/mit/bin:/usr/lib/mit/sbin
    PERL_BADLANG (unset)
    SHELL=/bin/bash

• [perl #111300] eval does not catch die after alarm by Ricardo SIGNES via RT
• [perl #111300] eval does not catch die after alarm by Matti Linnanvuori
• Re: [perl #111300] eval does not catch die after alarm by Zefram