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

[yary]

Good idea, to check for expected warnings only.

This is reminding me of modules to help test warnings, looks like
https://metacpan.org/pod/Test::Warnings is the one to use these days.

Wonder what is out there to ease the eval/die testing, maybe
https://metacpan.org/pod/Test::Exception ?

-y


On Sat, Aug 1, 2020 at 10:12 PM David Christensen <dpchrist at holgerdanske.com>
wrote:

> 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
> _______________________________________________
> SanFrancisco-pm mailing list
> SanFrancisco-pm at pm.org
> https://mail.pm.org/mailman/listinfo/sanfrancisco-pm
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.pm.org/pipermail/sanfrancisco-pm/attachments/20200802/f518e24b/attachment-0001.html>