threads - formatting [REVISED]

[p5sagit/p5-mst-13.2.git] / ext / threads / t / problems.t

diff --git a/ext/threads/t/problems.t b/ext/threads/t/problems.t
index 1772bea..747ede7 100644 (file)
--- a/ext/threads/t/problems.t
+++ b/ext/threads/t/problems.t
@@ -7,9 +7,9 @@ BEGIN {
         unshift @INC, '../lib';
     }
     use Config;
-    unless ($Config{'useithreads'}) {
-       print "1..0 # Skip: no useithreads\n";
-       exit 0; 
+    if (! $Config{'useithreads'}) {
+        print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
+        exit(0);
     }
 }
 
@@ -34,56 +34,51 @@ no warnings 'deprecated';       # Suppress warnings related to :unique
 
 use Hash::Util 'lock_keys';
 
-# Note that we can't use  Test::More here, as we would need to
-# call is() from within the DESTROY() function at global destruction time,
-# and parts of Test::* may have already been freed by then
+my $test :shared = 2;
 
-my $test : shared = 2;
-
-sub is($$$) {
+# Note that we can't use Test::More here, as we would need to call is()
+# from within the DESTROY() function at global destruction time, and
+# parts of Test::* may have already been freed by then
+sub is($$$)
+{
     my ($got, $want, $desc) = @_;
     lock($test);
-    unless ($got eq $want) {
-       print "# EXPECTED: $want\n";
-       print "# GOT:      $got\n";
-       print "not ";
+    if ($got ne $want) {
+        print("# EXPECTED: $want\n");
+        print("# GOT:      $got\n");
+        print("not ");
     }
-    print "ok $test - $desc\n";
+    print("ok $test - $desc\n");
     $test++;
 }
 
 
-#
-# This tests for too much destruction
-# which was caused by cloning stashes
-# on join which led to double the dataspace
-#
-#########################
+# This tests for too much destruction which was caused by cloning stashes
+# on join which led to double the dataspace under 5.8.0
 if ($] != 5.008)
-{ 
-    sub Foo::DESTROY { 
-       my $self = shift;
-       my ($package, $file, $line) = caller;
-       is(threads->tid(),$self->{tid},
-               "In destroy[$self->{tid}] it should be correct too" )
+{
+    sub Foo::DESTROY
+    {
+        my $self = shift;
+        my ($package, $file, $line) = caller;
+        is(threads->tid(), $self->{tid}, "In destroy[$self->{tid}] it should be correct too" );
     }
-    my $foo;
-    $foo = bless {tid => 0}, 'Foo';                      
-    my $bar = threads->create(sub { 
-       is(threads->tid(),1, "And tid be 1 here");
-       $foo->{tid} = 1;
-       return $foo;
+
+    my $foo = bless {tid => 0}, 'Foo';
+    my $bar = threads->create(sub {
+        is(threads->tid(), 1, "And tid be 1 here");
+        $foo->{tid} = 1;
+        return ($foo);
     })->join();
     $bar->{tid} = 0;
 }
 
-#
+
 # This tests whether we can call Config::myconfig after threads have been
 # started (interpreter cloned).  5.8.1 and 5.8.2 contained a bug that would
-# disallow that too be done, because an attempt was made to change a variable
-# with the : unique attribute.
-#
-#########################
+# disallow that to be done because an attempt was made to change a variable
+# with the :unique attribute.
+
 {
     lock($test);
     if ($] == 5.008 || $] >= 5.008003) {
@@ -96,24 +91,24 @@ if ($] != 5.008)
     $test++;
 }
 
+
 # bugid 24383 - :unique hashes weren't being made readonly on interpreter
 # clone; check that they are.
 
 our $unique_scalar : unique;
 our @unique_array : unique;
 our %unique_hash : unique;
-threads->create(
-    sub {
+threads->create(sub {
         lock($test);
-       my $TODO = ":unique needs to be re-implemented in a non-broken way";
-       eval { $unique_scalar = 1 };
-       print $@ =~ /read-only/
-         ? '' : 'not ', "ok $test # TODO $TODO unique_scalar\n";
-       $test++;
-       eval { $unique_array[0] = 1 };
-       print $@ =~ /read-only/
-         ? '' : 'not ', "ok $test # TODO $TODO - unique_array\n";
-       $test++;
+        my $TODO = ":unique needs to be re-implemented in a non-broken way";
+        eval { $unique_scalar = 1 };
+        print $@ =~ /read-only/
+          ? '' : 'not ', "ok $test # TODO $TODO - unique_scalar\n";
+        $test++;
+        eval { $unique_array[0] = 1 };
+        print $@ =~ /read-only/
+          ? '' : 'not ', "ok $test # TODO $TODO - unique_array\n";
+        $test++;
         if ($] >= 5.008003 && $^O ne 'MSWin32') {
             eval { $unique_hash{abc} = 1 };
             print $@ =~ /disallowed/
@@ -121,9 +116,8 @@ threads->create(
         } else {
             print("ok $test # Skip $TODO - unique_hash\n");
         }
-       $test++;
-    }
-)->join;
+        $test++;
+    })->join;
 
 # bugid #24940 :unique should fail on my and sub declarations
 
@@ -162,17 +156,17 @@ for my $decl ('my $x : unique', 'sub foo : unique') {
 # Nothing is checking that total keys gets cloned correctly.
 
 my %h = (1,2,3,4);
-is (keys %h, 2, "keys correct in parent");
+is(keys(%h), 2, "keys correct in parent");
 
-my $child = threads->create(sub { return scalar keys %h })->join;
-is ($child, 2, "keys correct in child");
+my $child = threads->create(sub { return (scalar(keys(%h))); })->join;
+is($child, 2, "keys correct in child");
 
-lock_keys (%h);
-delete $h{1};
+lock_keys(%h);
+delete($h{1});
 
-is (keys %h, 1, "keys correct in parent with restricted hash");
+is(keys(%h), 1, "keys correct in parent with restricted hash");
 
-$child = threads->create(sub { return scalar keys %h })->join;
-is ($child, 1, "keys correct in child with restricted hash");
+$child = threads->create(sub { return (scalar(keys(%h))); })->join;
+is($child, 1, "keys correct in child with restricted hash");
 
-1;
+# EOF