[sf-perl] conditional "no warnings 'threads'"

[David Christensen]

On 2020-08-01 00:10, David Christensen wrote:
> sanfrancisco-pm:

> sub foo
> {
>      if ($test_mode) {
>      no warnings 'threads';
> 
>      $thr = threads->create(
>          sub { die "hello, world!" }
>      );
>      } else {
>      $thr = threads->create(
>          sub { die "hello, world!" }
>      );
>      }
> }

"no warnings 'threads'" seemed overly broad, and was bugging me.


So, I came up with another approach -- use an eval-apply design pattern 
inside the child thread.  The inner code becomes an expression and fits 
into a ternary conditional.  Child errors are saved into a shared lookup 
table.  All exception messages should be caught (except those that crash 
Perl?).  Expected exception messages will pass test cases and unexpected 
messages will fail test cases:


2020-08-01 18:59:02 dpchrist at tinkywinky ~/sandbox/perl
$ cat thread-exception-eval.pl
#!perl

use strict;
use warnings;
use threads;

use Data::Dumper;
use Test::More;

our $test_mode;
our %tid_ee :shared;

sub bar { die @_ };

sub foo
{
     threads->create(
	sub {
	    my $f = shift;
     	    my $r = $test_mode
     		  ? eval { $f->(@_) }
		  : $f->(@_);
	    $tid_ee{threads->tid} = $@;
	    return $r;
	},
        	@_
     );
}

my $thr;

ok $thr = foo(\&bar, "hello, world!"), __FILE__ . __LINE__;	#  1
is $thr->join, undef, __FILE__ . __LINE__;			#  2
like $thr->error, qr/hello/, __FILE__ . __LINE__;		#  3
is $tid_ee{$thr}, undef, __FILE__ . __LINE__;			#  4

$test_mode = 1;

ok $thr = foo(\&bar, "hello, world!"), __FILE__ . __LINE__;	#  5
is $thr->join, undef, __FILE__ . __LINE__;			#  6
is $thr->error, undef, __FILE__ . __LINE__;			#  7
like $tid_ee{$thr->tid}, qr/hello/, __FILE__ . __LINE__;	#  8

ok $thr = foo(\&bar,"goodbye, cruel world!"),__FILE__.__LINE__;	#  9
is $thr->join, undef, __FILE__ . __LINE__;			# 10
is $thr->error, undef, __FILE__ . __LINE__;			# 11
like $tid_ee{$thr->tid}, qr/hello/, __FILE__ . __LINE__;	# 12

done_testing;

2020-08-01 18:59:50 dpchrist at tinkywinky ~/sandbox/perl
$ perl thread-exception-eval.pl
Thread 1 terminated abnormally: hello, world! at 
thread-exception-eval.pl line 13.
ok 1 - thread-exception-eval.pl32
ok 2 - thread-exception-eval.pl33
ok 3 - thread-exception-eval.pl34
ok 4 - thread-exception-eval.pl35
ok 5 - thread-exception-eval.pl39
ok 6 - thread-exception-eval.pl40
ok 7 - thread-exception-eval.pl41
ok 8 - thread-exception-eval.pl42
ok 9 - thread-exception-eval.pl44
ok 10 - thread-exception-eval.pl45
ok 11 - thread-exception-eval.pl46
not ok 12 - thread-exception-eval.pl47
#   Failed test 'thread-exception-eval.pl47'
#   at thread-exception-eval.pl line 47.
#                   'goodbye, cruel world! at thread-exception-eval.pl 
line 13.
# '
#     doesn't match '(?^:hello)'
1..12
# Looks like you failed 1 test of 12.


David