xref: /openbsd-src/gnu/usr.bin/perl/dist/threads-shared/t/sv_simple.t (revision b39c515898423c8d899e35282f4b395f7cad3298)
1*b39c5158Smillertuse strict;
2*b39c5158Smillertuse warnings;
3*b39c5158Smillert
4*b39c5158SmillertBEGIN {
5*b39c5158Smillert    use Config;
6*b39c5158Smillert    if (! $Config{'useithreads'}) {
7*b39c5158Smillert        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
8*b39c5158Smillert        exit(0);
9*b39c5158Smillert    }
10*b39c5158Smillert}
11*b39c5158Smillert
12*b39c5158Smillertuse ExtUtils::testlib;
13*b39c5158Smillert
14*b39c5158Smillertsub ok {
15*b39c5158Smillert    my ($id, $ok, $name) = @_;
16*b39c5158Smillert
17*b39c5158Smillert    # You have to do it this way or VMS will get confused.
18*b39c5158Smillert    if ($ok) {
19*b39c5158Smillert        print("ok $id - $name\n");
20*b39c5158Smillert    } else {
21*b39c5158Smillert        print("not ok $id - $name\n");
22*b39c5158Smillert        printf("# Failed test at line %d\n", (caller)[2]);
23*b39c5158Smillert    }
24*b39c5158Smillert
25*b39c5158Smillert    return ($ok);
26*b39c5158Smillert}
27*b39c5158Smillert
28*b39c5158SmillertBEGIN {
29*b39c5158Smillert    $| = 1;
30*b39c5158Smillert    print("1..11\n");   ### Number of tests that will be run ###
31*b39c5158Smillert};
32*b39c5158Smillert
33*b39c5158Smillertuse threads;
34*b39c5158Smillertuse threads::shared;
35*b39c5158Smillertok(1, 1, 'Loaded');
36*b39c5158Smillert
37*b39c5158Smillert### Start of Testing ###
38*b39c5158Smillert
39*b39c5158Smillertmy $test = "bar";
40*b39c5158Smillertshare($test);
41*b39c5158Smillertok(2,$test eq "bar","Test magic share fetch");
42*b39c5158Smillert$test = "foo";
43*b39c5158Smillertok(3,$test eq "foo","Test magic share assign");
44*b39c5158Smillertmy $c = threads::shared::_refcnt($test);
45*b39c5158Smillertthreads->create(
46*b39c5158Smillert                sub {
47*b39c5158Smillert                    ok(4, $test eq "foo","Test magic share fetch after thread");
48*b39c5158Smillert                    $test = "baz";
49*b39c5158Smillert                    ok(5,threads::shared::_refcnt($test) > $c, "Check that threadcount is correct");
50*b39c5158Smillert                    })->join();
51*b39c5158Smillertok(6,$test eq "baz","Test that value has changed in another thread");
52*b39c5158Smillertok(7,threads::shared::_refcnt($test) == $c,"Check thrcnt is down properly");
53*b39c5158Smillert$test = "barbar";
54*b39c5158Smillertok(8, length($test) == 6, "Check length code");
55*b39c5158Smillertthreads->create(sub { $test = "barbarbar" })->join;
56*b39c5158Smillertok(9, length($test) == 9, "Check length code after different thread modified it");
57*b39c5158Smillertthreads->create(sub { undef($test)})->join();
58*b39c5158Smillertok(10, !defined($test), "Check undef value");
59*b39c5158Smillert
60*b39c5158Smillertok(11, is_shared($test), "Check for sharing");
61*b39c5158Smillert
62*b39c5158Smillertexit(0);
63*b39c5158Smillert
64*b39c5158Smillert# EOF
65