summaryrefslogtreecommitdiff
path: root/dist/threads-shared/t
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2012-10-02 16:11:17 -0700
committerFather Chrysostomos <sprout@cpan.org>2012-10-02 16:11:17 -0700
commit9095cc4a20b2690cb271de143285b4f1d66237de (patch)
tree3e7bdd3f8456c39d562b18388fc7681741fedae4 /dist/threads-shared/t
parent34bd199a87daedeaeadd8e9ef48032c8307eaa94 (diff)
downloadperl-9095cc4a20b2690cb271de143285b4f1d66237de.tar.gz
Revert "Upgrade to threads::shared 1.42"
This reverts commit 34bd199a87daedeaeadd8e9ef48032c8307eaa94.
Diffstat (limited to 'dist/threads-shared/t')
-rw-r--r--dist/threads-shared/t/dualvar.t436
1 files changed, 50 insertions, 386 deletions
diff --git a/dist/threads-shared/t/dualvar.t b/dist/threads-shared/t/dualvar.t
index 11d2cf46f3..ef6fc177b5 100644
--- a/dist/threads-shared/t/dualvar.t
+++ b/dist/threads-shared/t/dualvar.t
@@ -11,419 +11,83 @@ BEGIN {
use ExtUtils::testlib;
-BEGIN {
- $| = 1;
- print("1..219\n"); ### Number of tests that will be run ###
-}
-
-use threads;
-use threads::shared;
-use Scalar::Util qw(dualvar);
-
-my $TEST = 1;
-
sub ok {
- my ($ok, $name) = @_;
+ my ($id, $ok, $name) = @_;
# You have to do it this way or VMS will get confused.
if ($ok) {
- print("ok $TEST - $name\n");
- } else {
- print("not ok $TEST - $name\n");
- printf("# Failed test at line %d\n", (caller(1))[2]);
+ print("ok $id - $name\n");
+ }
+ else {
+ print("not ok $id - $name\n");
+ printf("# Failed test at line %d\n", (caller)[2]);
}
- $TEST++;
-}
-
-sub ok_iv
-{
- my ($var, $iv) = @_;
- ok($var == $iv, 'IV number preserved');
- ok($var eq $iv, 'String preserved');
-}
-
-sub ok_nv
-{
- my ($var, $nv) = @_;
- ok($var == $nv, 'NV number preserved');
- ok($var eq $nv, 'String preserved');
-}
-
-sub ok_uv
-{
- my ($var, $uv) = @_;
- ok($var == $uv, 'UV number preserved');
- ok($var > 0, 'UV number preserved');
- ok($var eq $uv, 'String preserved');
-}
-
-### Start of Testing ###
-
-my $iv = dualvar(42, 'Fourty-Two');
-my $nv = dualvar(3.14, 'PI');
-my $bits = ($Config{'use64bitint'}) ? 63 : 31;
-my $uv = dualvar(1<<$bits, 'Large unsigned int');
-
-print("# Shared scalar assignment using shared_clone()\n");
-
-my $siv :shared = shared_clone($iv);
-my $snv :shared = shared_clone($nv);
-my $suv :shared = shared_clone($uv);
-
-ok_iv($siv, $iv);
-ok_nv($snv, $nv);
-ok_uv($suv, $uv);
-
-{
- print("# Shared array initialization\n");
-
- my @ary :shared = ($iv, $nv, $uv);
-
- ok_iv($ary[0], $iv);
- ok_nv($ary[1], $nv);
- ok_uv($ary[2], $uv);
-}
-
-{
- print("# Shared array list assignment\n");
-
- my @ary :shared;
- @ary = ($iv, $nv, $uv);
-
- ok_iv($ary[0], $iv);
- ok_nv($ary[1], $nv);
- ok_uv($ary[2], $uv);
-}
-
-{
- print("# Shared array element assignment\n");
-
- my @ary :shared;
- $ary[0] = $iv;
- $ary[1] = $nv;
- $ary[2] = $uv;
-
- ok_iv($ary[0], $iv);
- ok_nv($ary[1], $nv);
- ok_uv($ary[2], $uv);
-}
-
-{
- print("# Shared array initialization - shared scalars\n");
-
- my @ary :shared = ($siv, $snv, $suv);
-
- ok_iv($ary[0], $iv);
- ok_nv($ary[1], $nv);
- ok_uv($ary[2], $uv);
-}
-
-{
- print("# Shared array list assignment - shared scalars\n");
-
- my @ary :shared;
- @ary = ($siv, $snv, $suv);
-
- ok_iv($ary[0], $iv);
- ok_nv($ary[1], $nv);
- ok_uv($ary[2], $uv);
-}
-
-{
- print("# Shared array element assignment - shared scalars\n");
-
- # FAILS
-
- my @ary :shared;
- $ary[0] = $siv;
- $ary[1] = $snv;
- $ary[2] = $suv;
-
- ok_iv($ary[0], $iv);
- ok_nv($ary[1], $nv);
- ok_uv($ary[2], $uv);
-}
-
-{
- print("# Shared hash initialization\n");
-
- my %hsh :shared = (
- 'iv' => $iv,
- 'nv' => $nv,
- 'uv' => $uv,
- );
-
- ok_iv($hsh{'iv'}, $iv);
- ok_nv($hsh{'nv'}, $nv);
- ok_uv($hsh{'uv'}, $uv);
-}
-
-{
- print("# Shared hash assignment\n");
-
- my %hsh :shared;
- %hsh = (
- 'iv' => $iv,
- 'nv' => $nv,
- 'uv' => $uv,
- );
-
- ok_iv($hsh{'iv'}, $iv);
- ok_nv($hsh{'nv'}, $nv);
- ok_uv($hsh{'uv'}, $uv);
-}
-
-{
- print("# Shared hash element assignment\n");
-
- my %hsh :shared;
- $hsh{'iv'} = $iv;
- $hsh{'nv'} = $nv;
- $hsh{'uv'} = $uv;
-
- ok_iv($hsh{'iv'}, $iv);
- ok_nv($hsh{'nv'}, $nv);
- ok_uv($hsh{'uv'}, $uv);
-}
-
-{
- print("# Shared hash initialization - shared scalars\n");
-
- my %hsh :shared = (
- 'iv' => $siv,
- 'nv' => $snv,
- 'uv' => $suv,
- );
-
- ok_iv($hsh{'iv'}, $iv);
- ok_nv($hsh{'nv'}, $nv);
- ok_uv($hsh{'uv'}, $uv);
-}
-
-{
- print("# Shared hash assignment - shared scalars\n");
-
- my %hsh :shared;
- %hsh = (
- 'iv' => $siv,
- 'nv' => $snv,
- 'uv' => $suv,
- );
-
- ok_iv($hsh{'iv'}, $iv);
- ok_nv($hsh{'nv'}, $nv);
- ok_uv($hsh{'uv'}, $uv);
-}
-
-{
- print("# Shared hash element assignment - shared scalars\n");
-
- my %hsh :shared;
- $hsh{'iv'} = $siv;
- $hsh{'nv'} = $snv;
- $hsh{'uv'} = $suv;
-
- ok_iv($hsh{'iv'}, $iv);
- ok_nv($hsh{'nv'}, $nv);
- ok_uv($hsh{'uv'}, $uv);
-}
-
-{
- print("# Shared array push\n");
-
- my @ary :shared;
- push(@ary, $iv, $nv, $uv);
-
- ok_iv($ary[0], $iv);
- ok_nv($ary[1], $nv);
- ok_uv($ary[2], $uv);
-
- print("# Shared array pop\n");
-
- my $xuv = pop(@ary);
- my $xnv = pop(@ary);
- my $xiv = pop(@ary);
-
- ok_iv($xiv, $iv);
- ok_nv($xnv, $nv);
- ok_uv($xuv, $uv);
-
- print("# Shared array unshift\n");
-
- unshift(@ary, $iv, $nv, $uv);
-
- ok_iv($ary[0], $iv);
- ok_nv($ary[1], $nv);
- ok_uv($ary[2], $uv);
-
- print("# Shared array shift\n");
-
- $xiv = shift(@ary);
- $xnv = shift(@ary);
- $xuv = shift(@ary);
-
- ok_iv($xiv, $iv);
- ok_nv($xnv, $nv);
- ok_uv($xuv, $uv);
-}
-
-{
- print("# Shared array push - shared scalars\n");
-
- my @ary :shared;
- push(@ary, $siv, $snv, $suv);
-
- ok_iv($ary[0], $iv);
- ok_nv($ary[1], $nv);
- ok_uv($ary[2], $uv);
-
- print("# Shared array pop - shared scalars\n");
-
- my $xuv = pop(@ary);
- my $xnv = pop(@ary);
- my $xiv = pop(@ary);
-
- ok_iv($xiv, $iv);
- ok_nv($xnv, $nv);
- ok_uv($xuv, $uv);
-
- print("# Shared array unshift - shared scalars\n");
-
- unshift(@ary, $siv, $snv, $suv);
-
- ok_iv($ary[0], $iv);
- ok_nv($ary[1], $nv);
- ok_uv($ary[2], $uv);
-
- print("# Shared array shift - shared scalars\n");
-
- $xiv = shift(@ary);
- $xnv = shift(@ary);
- $xuv = shift(@ary);
-
- ok_iv($xiv, $iv);
- ok_nv($xnv, $nv);
- ok_uv($xuv, $uv);
-}
-
-{
- print("# Shared hash delete\n");
-
- my %hsh :shared = (
- 'iv' => $iv,
- 'nv' => $nv,
- 'uv' => $uv,
- );
-
- ok_iv(delete($hsh{'iv'}), $iv);
- ok_nv(delete($hsh{'nv'}), $nv);
- ok_uv(delete($hsh{'uv'}), $uv);
-}
-
-{
- print("# Shared hash delete - shared scalars\n");
-
- my %hsh :shared = (
- 'iv' => $siv,
- 'nv' => $snv,
- 'uv' => $suv,
- );
-
- ok_iv(delete($hsh{'iv'}), $iv);
- ok_nv(delete($hsh{'nv'}), $nv);
- ok_uv(delete($hsh{'uv'}), $uv);
+ return ($ok);
}
-{
- print("# Shared array copy to non-shared array\n");
-
- my @ary :shared = ($iv, $nv, $uv);
- my @nsa = @ary;
-
- ok_iv($nsa[0], $iv);
- ok_nv($nsa[1], $nv);
- ok_uv($nsa[2], $uv);
-
- print("# Shared array copy using shared_clone()\n");
-
- my $copy :shared = shared_clone(\@nsa);
-
- ok_iv($$copy[0], $iv);
- ok_nv($$copy[1], $nv);
- ok_uv($$copy[2], $uv);
+BEGIN {
+ $| = 1;
+ print("1..19\n"); ### Number of tests that will be run ###
}
-{
- print("# Shared array copy to non-shared array - shared scalars\n");
-
- my @ary :shared = ($siv, $snv, $suv);
- my @nsa = @ary;
-
- ok_iv($nsa[0], $iv);
- ok_nv($nsa[1], $nv);
- ok_uv($nsa[2], $uv);
-
- print("# Shared array copy using shared_clone()\n");
-
- my $copy :shared = shared_clone(\@nsa);
-
- ok_iv($$copy[0], $iv);
- ok_nv($$copy[1], $nv);
- ok_uv($$copy[2], $uv);
-}
+use Scalar::Util qw(dualvar);
-{
- print("# Shared hash copy to non-shared hash\n");
+use threads;
+use threads::shared;
- my %hsh :shared = (
- 'iv' => $iv,
- 'nv' => $nv,
- 'uv' => $uv,
- );
- my %nsh = %hsh;
+ok(1, 1, 'Loaded');
- ok_iv($nsh{'iv'}, $iv);
- ok_nv($nsh{'nv'}, $nv);
- ok_uv($nsh{'uv'}, $uv);
+### Start of Testing ###
- print("# Shared hash copy using shared_clone()\n");
+my $dv = dualvar(42, 'Fourty-Two');
+my $pi = dualvar(3.14, 'PI');
- my $copy :shared = shared_clone(\%nsh);
+my @a :shared;
- ok_iv($$copy{'iv'}, $iv);
- ok_nv($$copy{'nv'}, $nv);
- ok_uv($$copy{'uv'}, $uv);
-}
+# Individual assignment
+# Verify that dualvar preserved during individual element assignment
+$a[0] = $dv;
+$a[1] = $pi;
-{
- print("# Shared hash copy to non-shared hash - shared scalars\n");
+ok(2, $a[0] == 42, 'IV number preserved');
+ok(3, $a[0] eq 'Fourty-Two', 'string preserved');
+ok(4, $a[1] == 3.14, 'NV number preserved');
+ok(5, $a[1] eq 'PI', 'string preserved');
- my %hsh :shared = (
- 'iv' => $siv,
- 'nv' => $snv,
- 'uv' => $suv,
- );
- my %nsh = %hsh;
+#-- List initializer
+# Verify that dualvar preserved during initialization
+my @a2 :shared = ($dv, $pi);
- ok_iv($nsh{'iv'}, $iv);
- ok_nv($nsh{'nv'}, $nv);
- ok_uv($nsh{'uv'}, $uv);
+ok(6, $a2[0] == 42, 'IV number preserved');
+ok(7, $a2[0] eq 'Fourty-Two', 'string preserved');
+ok(8, $a2[1] == 3.14, 'NV number preserved');
+ok(9, $a2[1] eq 'PI', 'string preserved');
- print("# Shared hash copy using shared_clone()\n");
+#-- List assignment
+# Verify that dualvar preserved during list assignment
+my @a3 :shared = (0, 0);
+@a3 = ($dv, $pi);
- my $copy :shared = shared_clone(\%nsh);
+ok(10, $a3[0] == 42, 'IV number preserved');
+ok(11, $a3[0] eq 'Fourty-Two', 'string preserved');
+ok(12, $a3[1] == 3.14, 'NV number preserved');
+ok(13, $a3[1] eq 'PI', 'string preserved');
- ok_iv($$copy{'iv'}, $iv);
- ok_nv($$copy{'nv'}, $nv);
- ok_uv($$copy{'uv'}, $uv);
-}
+# Back to non-shared
+# Verify that entries are still dualvar when leaving the array
+my @nsa = @a3;
+ok(14, $nsa[0] == 42, 'IV number preserved');
+ok(15, $nsa[0] eq 'Fourty-Two', 'string preserved');
+ok(16, $nsa[1] == 3.14, 'NV number preserved');
+ok(17, $nsa[1] eq 'PI', 'string preserved');
# $! behaves like a dualvar, but is really implemented as a tied SV.
# As a result sharing $! directly only propagates the string value.
# However, we can create a dualvar from it.
$! = 1;
my $ss :shared = dualvar($!,$!);
-ok_iv($ss, $!);
+ok(18, $ss == 1, 'IV number preserved');
+ok(19, $ss eq $!, 'string preserved');
exit(0);