xref: /openbsd-src/gnu/usr.bin/perl/t/re/user_prop_race_thr.t (revision f3efcd0145415b7d44d9da97e0ad5c21b186ac61)
1*f3efcd01Safresh1#!perl
2*f3efcd01Safresh1use strict;
3*f3efcd01Safresh1use warnings;
4*f3efcd01Safresh1
5*f3efcd01Safresh1require './test.pl';
6*f3efcd01Safresh1skip_all_without_config('useithreads');
7*f3efcd01Safresh1skip_all_if_miniperl("no dynamic loading on miniperl, no threads");
8*f3efcd01Safresh1
9*f3efcd01Safresh1plan(3);
10*f3efcd01Safresh1
11*f3efcd01Safresh1require threads;
12*f3efcd01Safresh1
13*f3efcd01Safresh1{
14*f3efcd01Safresh1    fresh_perl_is('
15*f3efcd01Safresh1        use threads;
16*f3efcd01Safresh1        use strict;
17*f3efcd01Safresh1        use warnings;
18*f3efcd01Safresh1
19*f3efcd01Safresh1        sub main::IsA {
20*f3efcd01Safresh1            use feature "state";
21*f3efcd01Safresh1
22*f3efcd01Safresh1            state $upper_char = ord "A";
23*f3efcd01Safresh1            state $lower_char = ord "a";
24*f3efcd01Safresh1
25*f3efcd01Safresh1            return sprintf "%x", $lower_char++ if shift;
26*f3efcd01Safresh1            return sprintf "%x", $upper_char++;
27*f3efcd01Safresh1        }
28*f3efcd01Safresh1
29*f3efcd01Safresh1        my @threads = map +threads->create(sub {
30*f3efcd01Safresh1            sleep 0.1;
31*f3efcd01Safresh1
32*f3efcd01Safresh1            for (1..2500) {
33*f3efcd01Safresh1                return 0 unless eval "qq(A) =~ qr/\\\p{main::IsA}/";
34*f3efcd01Safresh1                return 0 unless eval "qq(a) =~ qr/\\\p{main::IsA}/i";
35*f3efcd01Safresh1            }
36*f3efcd01Safresh1
37*f3efcd01Safresh1            return 1;
38*f3efcd01Safresh1        }), (0..1);
39*f3efcd01Safresh1        my $success  = $threads[0]->join;
40*f3efcd01Safresh1           $success += $threads[1]->join;
41*f3efcd01Safresh1        print $success;',
42*f3efcd01Safresh1    2,
43*f3efcd01Safresh1    {},
44*f3efcd01Safresh1    "Simultaneous threads worked");
45*f3efcd01Safresh1
46*f3efcd01Safresh1}
47*f3efcd01Safresh1
48*f3efcd01Safresh1{
49*f3efcd01Safresh1    fresh_perl_is('
50*f3efcd01Safresh1        use threads;
51*f3efcd01Safresh1        use strict;
52*f3efcd01Safresh1        use warnings;
53*f3efcd01Safresh1
54*f3efcd01Safresh1        sub InLongSleep {
55*f3efcd01Safresh1            use feature "state";
56*f3efcd01Safresh1
57*f3efcd01Safresh1            state $which = 0;
58*f3efcd01Safresh1
59*f3efcd01Safresh1            sleep(60) unless $which++;
60*f3efcd01Safresh1            return "0042";
61*f3efcd01Safresh1        }
62*f3efcd01Safresh1
63*f3efcd01Safresh1        sub InQuick {
64*f3efcd01Safresh1            return sprintf "%x", ord("C");
65*f3efcd01Safresh1        }
66*f3efcd01Safresh1
67*f3efcd01Safresh1        my $thread0 = threads->create(sub {
68*f3efcd01Safresh1
69*f3efcd01Safresh1            my $a = \'\p{InLongSleep}\';
70*f3efcd01Safresh1            qr/$a/;
71*f3efcd01Safresh1
72*f3efcd01Safresh1            return 1;
73*f3efcd01Safresh1        });
74*f3efcd01Safresh1        my $thread1 = threads->create(sub {
75*f3efcd01Safresh1            sleep 1;
76*f3efcd01Safresh1
77*f3efcd01Safresh1            my $c = \'\p{InQuick}\';
78*f3efcd01Safresh1            return "C" =~ /$c/;
79*f3efcd01Safresh1        });
80*f3efcd01Safresh1        print $thread1->join;
81*f3efcd01Safresh1        $thread0->detach();',
82*f3efcd01Safresh1    1,
83*f3efcd01Safresh1    {},
84*f3efcd01Safresh1    "One thread hung on a defn doesn't impinge on other's other defns");
85*f3efcd01Safresh1}
86*f3efcd01Safresh1
87*f3efcd01Safresh1{
88*f3efcd01Safresh1    fresh_perl_like('
89*f3efcd01Safresh1        use threads;
90*f3efcd01Safresh1        use strict;
91*f3efcd01Safresh1        use warnings;
92*f3efcd01Safresh1
93*f3efcd01Safresh1        sub InLongSleep {
94*f3efcd01Safresh1            use feature "state";
95*f3efcd01Safresh1
96*f3efcd01Safresh1            state $which = 0;
97*f3efcd01Safresh1
98*f3efcd01Safresh1            sleep(25) unless $which++;
99*f3efcd01Safresh1            return "0042";
100*f3efcd01Safresh1        }
101*f3efcd01Safresh1
102*f3efcd01Safresh1        my @threads = map +threads->create(sub {
103*f3efcd01Safresh1            sleep 1;
104*f3efcd01Safresh1
105*f3efcd01Safresh1            my $a = \'\p{InLongSleep}\';
106*f3efcd01Safresh1            qr/$a/;
107*f3efcd01Safresh1
108*f3efcd01Safresh1            return 1;
109*f3efcd01Safresh1        }), (0..1);
110*f3efcd01Safresh1        $threads[1]->join;
111*f3efcd01Safresh1        $threads[0]->detach();',
112*f3efcd01Safresh1    qr/Thread \d+ terminated abnormally: Timeout waiting for another thread to define "InLongSleep" in regex/,
113*f3efcd01Safresh1    {},
114*f3efcd01Safresh1    "One thread hung on a definition doesn't delay another indefinitely");
115*f3efcd01Safresh1}
116*f3efcd01Safresh1
117*f3efcd01Safresh11;
118