1use strict;
2use warnings;
3
4BEGIN {
5    use Config;
6    if (! $Config{'useithreads'}) {
7        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
8        exit(0);
9    }
10    if ($] >= 5.027000) {
11        print("1..0 # SKIP 'unique' attribute no longer exists\n");
12        exit(0);
13    }
14}
15
16use ExtUtils::testlib;
17
18use threads;
19
20BEGIN {
21    if (! eval 'use threads::shared; 1') {
22        print("1..0 # SKIP threads::shared not available\n");
23        exit(0);
24    }
25
26    $| = 1;
27    print("1..6\n") ;           ### Number of tests that will be run ###
28}
29
30print("ok 1 - Loaded\n");
31
32### Start of Testing ###
33
34no warnings 'deprecated';       # Suppress warnings related to :unique
35
36my $test :shared = 2;
37
38# bugid 24383 - :unique hashes weren't being made readonly on interpreter
39# clone; check that they are.
40
41our $unique_scalar : unique;
42our @unique_array : unique;
43our %unique_hash : unique;
44threads->create(sub {
45        lock($test);
46        my $TODO = ":unique needs to be re-implemented in a non-broken way";
47        eval { $unique_scalar = 1 };
48        print $@ =~ /read-only/
49          ? '' : 'not ', "ok $test # TODO $TODO - unique_scalar\n";
50        $test++;
51        eval { $unique_array[0] = 1 };
52        print $@ =~ /read-only/
53          ? '' : 'not ', "ok $test # TODO $TODO - unique_array\n";
54        $test++;
55        if ($] >= 5.008003 && $^O ne 'MSWin32') {
56            eval { $unique_hash{abc} = 1 };
57            print $@ =~ /disallowed/
58              ? '' : 'not ', "ok $test # TODO $TODO - unique_hash\n";
59        } else {
60            print("ok $test # SKIP $TODO - unique_hash\n");
61        }
62        $test++;
63    })->join;
64
65# bugid #24940 :unique should fail on my and sub declarations
66
67for my $decl ('my $x : unique', 'sub foo : unique') {
68    {
69        lock($test);
70        if ($] >= 5.008005) {
71            eval $decl;
72            print $@ =~ /^The 'unique' attribute may only be applied to 'our' variables/
73                    ? '' : 'not ', "ok $test - $decl\n";
74        } else {
75            print("ok $test # SKIP $decl\n");
76        }
77        $test++;
78    }
79}
80
81
82