From matti.linnanvuori@portalify.com

Created by matti@portalify.com

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, '' );
}

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

From zefram@fysh.org

Matti Linnanvuori wrote​:

eval does not catch die after alarm.

Reducing that complaint down to a minimal test case, it turns out not
to be the case​:

$ /opt/perl-5.10.1/bin/perl -e 'eval { local $SIG{ALRM} = sub { die "Timeout\n" }; alarm 2; sleep 4; alarm 0; }; print "CAUGHT​:$@​"'
CAUGHT​:Timeout

Same result on 5.8.8, 5.12.4, and 5.14.2.

So it looks like your test failure depends on some other aspect of the
test scenario, such as Net​::RabbitMQ (which is what you're invoking in the
alarm-and-eval environment). Possibly related​: if the process there dies
itself, and that's caught by the eval, you'll rescind the dying signal
handler but you'll still have an alarm pending. You ought to run the
"alarm 0" as a scope cleanup action.

-zefram

The RT System itself - Status changed from 'new' to 'open'

From @rjbs

I am closing this bug. Please re-open it if you can provide further evidence of a bug in perl.

Thanks for your report!

From [Unknown Contact. See original ticket]

I am closing this bug. Please re-open it if you can provide further evidence of a bug in perl.

Thanks for your report!

@rjbs - Status changed from 'open' to 'resolved'

From matti.linnanvuori@portalify.com

Hi!

I still think this is a bug. Perl manages to run to the end when run with option -d, but not without​:

pmc-inst-test​:~/routing # perl ack.t
1..7
Timeout
# Looks like your test exited with 4 before it could output anything.
pmc-inst-test​:~/routing # perl -d ack.t

Loading DB routines from perl5db.pl version 1.3
Editor support available.

Enter h or `h h' for help, or `man perldebug' for more help.

1..7
main​::(ack.t​:39)​: my $json_text = '{
main​::(ack.t​:40)​: "timestamp" : 1328020064358,
main​::(ack.t​:41)​: "sender" : "exchange.pmc.cassidian-in",
main​::(ack.t​:42)​: "body" : {
main​::(ack.t​:43)​: "type" : "ack",
main​::(ack.t​:44)​: "version" : 1,
main​::(ack.t​:45)​: "id" : "8f970b1b-f8a3-4c78-aa24-3b8e22056487",
main​::(ack.t​:46)​: "from" : {
main​::(ack.t​:47)​: "type" : "ssi",
main​::(ack.t​:48)​: "address" : "12345"
  DB<1> c
not ok 1 - A message was received
# Failed test 'A message was received'
# at ack.t line 112.
# got​: 'Timeout
# '
# expected​: ''
not ok 2 - A JSON message received
# Failed test 'A JSON message received'
# at ack.t line 115.
# got​: 'malformed JSON string, neither array, object, number, string or atom, at character offset 0 (before "(end of string)") at ack.t line 114.
# '
# expected​: ''
not ok 3 - sender exchange.pmc.router-in
# Failed test 'sender exchange.pmc.router-in'
# at ack.t line 116.
# got​: undef
# expected​: 'exchange.pmc.router-in'
not ok 4 - body the same
# Failed test 'body the same'
# at ack.t line 117.
# Structures begin differing at​:
# $got = undef
# $expected = HASH(0xcc5f68)
Use of uninitialized value $this in pattern match (m//) at ack.t line 118.
at ack.t line 118
  eval '#line 118 ack.t
$test = $this =~ /$usable_regex/ ? 1 : 0
;' called at /usr/lib/perl5/5.10.0/Test/Builder.pm line 1407
  Test​::Builder​::_regex_ok('Test​::Builder=HASH(0xa7c200)', undef, 'Regexp=SCALAR(0xeb9f58)', '=~', 'timestamp an integer') called at /usr/lib/perl5/5.10.0/Test/Builder.pm line 1087
  Test​::Builder​::like('Test​::Builder=HASH(0xa7c200)', undef, 'Regexp=SCALAR(0xeb9f58)', 'timestamp an integer') called at /usr/lib/perl5/5.10.0/Test/More.pm line 421
  Test​::More​::like(undef, 'Regexp=SCALAR(0xeb9f58)', 'timestamp an integer') called at ack.t line 118
not ok 5 - timestamp an integer
# Failed test 'timestamp an integer'
# at ack.t line 118.
# undef
# doesn't match '(?-xism​:^\d+$)'
Use of uninitialized value in numeric ge (>=) at ack.t line 119.
at ack.t line 119
not ok 6 - timestamp greater than or equal to that of before publishing
# Failed test 'timestamp greater than or equal to that of before publishing'
# at ack.t line 119.
Use of uninitialized value in concatenation (.) or string at ack.t line 119.
at ack.t line 119
# < 1333105488895
Use of uninitialized value in numeric le (<=) at ack.t line 123.
at ack.t line 123
ok 7 - timestamp less than or equal to that of now
# Looks like you failed 6 tests of 7.
Debugged program terminated. Use q to quit or R to restart,
  use o inhibit_exit to avoid stopping after program termination,
  h q, h R or h o to get additional info.
  DB<1>

regards, Matti Linnanvuori

@cpansprout - Status changed from 'resolved' to 'open'