File: 50-threads.t

package info (click to toggle)
libautovivification-perl 0.18-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 440 kB
  • sloc: perl: 3,573; ansic: 1,507; makefile: 8
file content (72 lines) | stat: -rw-r--r-- 1,598 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
#!perl

use strict;
use warnings;

use lib 't/lib';
use VPIT::TestHelpers (
 threads => [ 'autovivification' => 'autovivification::A_THREADSAFE()' ],
);

use Test::Leaner;

my $threads = 10;
my $runs    = 2;

{
 no autovivification;

 sub try {
  my $tid = threads->tid();

  for my $run (1 .. $runs) {
   {
    my $x;
    my $y = $x->{foo};
    is $x, undef, "fetch does not autovivify at thread $tid run $run";
   }
   {
    my $x;
    my $y = exists $x->{foo};
    is $x, undef, "exists does not autovivify at thread $tid run $run";
   }
   {
    my $x;
    my $y = delete $x->{foo};
    is $x, undef, "delete does not autovivify at thread $tid run $run";
   }

SKIP:
   {
    skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3 * 2
                                                           unless "$]" >= 5.010;
    {
     my $x;
     eval 'my $y = $x->{foo}';
     is $@, '',    "fetch in eval does not croak at thread $tid run $run";
     is $x, undef, "fetch in eval does not autovivify at thread $tid run $run";
    }
    {
     my $x;
     eval 'my $y = exists $x->{foo}';
     is $@, '',    "exists in eval does not croak at thread $tid run $run";
     is $x, undef, "exists in eval does not autovivify at thread $tid run $run";
    }
    {
     my $x;
     eval 'my $y = delete $x->{foo}';
     is $@, '',    "delete in eval does not croak at thread $tid run $run";
     is $x, undef, "delete in eval does not autovivify at thread $tid run $run";
    }
   }
  }
 }
}

my @threads = map spawn(\&try), 1 .. $threads;

$_->join for @threads;

pass 'done';

done_testing;