Fix DisjConditions module to be thread-safe for perl >= 5.7.2.

[Ralf Wildenhues]

This patch is the first of a number of steps toward parallel automake
(i.e., letting Perl threads create Makefile.in files concurrently).
It fixes a data structure corruption happening during thread creation.
I'm not sure whether this may be considered a Perl bug/limitation
(after all it is documented that blessed references act as strings
when used as keys in a hash, so it's not that surprising that the
strings are not adjusted to the cloned hash addresses), but now that
I've understood the bug and found a relatively clean fix, I'm not that
worried any more.  :-)

In the patch below, I've omitted the new test files; they would be
boring to read.  Instead, at the end is the 'diff -uw' to their
originals, which shows much clearer the changes over the originals.

Without the CLONE function, the new tests would fare like this:

PASS: Condition-t.pl
 (A1) TRUE vs. TRUE
        Error message 'FOO was already defined in condition TRUE, which 
includes condition TRUE' does not match 'multiply defined'
 (A1) C1_TRUE vs. C1_TRUE
        Error message 'FOO was already defined in condition C1, which includes 
condition C1' does not match 'multiply defined'
FAIL: DisjConditions-t.pl

Applied to master.

Cheers,
Ralf

    Fix DisjConditions module to be thread-safe for perl >= 5.7.2.
    
    Self-hashes of blessed references are not correctly transported
    through thread creation.  This patch fixes that by recreating
    the hashes upon thread creation with a CLONE special subroutine,
    which is automatically invoked by new enough Perl versions.
    * lib/Automake/DisjConditions.pm (CLONE): New special
    subroutine to fix self hashes upon thread creation.
    * lib/Automake/tests/Condition-t.pl: New, sister test to
    Condition.pl, but spawns a new threads after each creation of a
    new condition; skip test if perl is too old or ithreads are not
    available.
    * lib/Automake/tests/DisjConditions-t.pl: Likewise.
    * lib/Automake/tests/Makefile.am (TESTS): Add them.
    
    Signed-off-by: Ralf Wildenhues <address@hidden>

diff --git a/lib/Automake/DisjConditions.pm b/lib/Automake/DisjConditions.pm
index 1f09c0f..ae759e2 100644
--- a/lib/Automake/DisjConditions.pm
+++ b/lib/Automake/DisjConditions.pm
@@ -192,6 +192,26 @@ sub new ($;@)
   return $self;
 }
 
+
+=item C<CLONE>
+
+Internal special subroutine to fix up the self hashes in
+C<%_disjcondition_singletons> upon thread creation.  C<CLONE> is invoked
+automatically with ithreads from Perl 5.7.2 or later, so if you use this
+module with earlier versions of Perl, it is not thread-safe.
+
+=cut
+
+sub CLONE
+{
+  foreach my $self (values %_disjcondition_singletons)
+    {
+      my %h = map { $_ => $_ } @{$self->{'conds'}};
+      $self->{'hash'} = \%h;
+    }
+}
+
+
 =item C<@conds = $set-E<gt>conds>
 
 Return the list of C<Condition> objects involved in C<$set>.
diff --git a/lib/Automake/tests/Makefile.am b/lib/Automake/tests/Makefile.am
index 705f195..529a02f 100644
--- a/lib/Automake/tests/Makefile.am
+++ b/lib/Automake/tests/Makefile.am
@@ -1,6 +1,6 @@
 ## Process this file with automake to create Makefile.in
 
-## Copyright (C) 2002, 2003  Free Software Foundation, Inc.
+## Copyright (C) 2002, 2003, 2008  Free Software Foundation, Inc.
 
 ## This program is free software; you can redistribute it and/or modify
 ## it under the terms of the GNU General Public License as published by
@@ -18,7 +18,9 @@
 TESTS_ENVIRONMENT = $(PERL) -Mstrict -I $(top_srcdir)/lib -w
 TESTS = \
 Condition.pl \
+Condition-t.pl \
 DisjConditions.pl \
+DisjConditions-t.pl \
 Version.pl \
 Wrap.pl
 



--- lib/Automake/tests/Condition.pl     2008-10-18 11:12:03.000000000 +0200
+++ lib/Automake/tests/Condition-t.pl   2008-10-19 19:46:27.000000000 +0200
@@ -1,4 +1,4 @@
-# Copyright (C) 2001, 2002, 2003  Free Software Foundation, Inc.
+# Copyright (C) 2001, 2002, 2003, 2008  Free Software Foundation, Inc.
 #
 # This file is part of GNU Automake.
 #
@@ -15,6 +15,18 @@
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
+BEGIN {
+  use Config;
+  if (eval { require 5.007_002; }      # for CLONE support
+      && $Config{useithreads})
+    {
+      use threads;
+    }
+  else
+    {
+      exit 77;
+    }
+}
 use Automake::Condition qw/TRUE FALSE/;
 
 sub test_basics ()
@@ -32,12 +44,15 @@
   for (@tests)
     {
       my $a = new Automake::Condition @{$_->[0]};
+      return 1
+        if threads->new(sub {
       return 1 if $_->[1] != $a->true;
       return 1 if $_->[1] != ($a == TRUE);
       return 1 if $_->[2] != $a->false;
       return 1 if $_->[2] != ($a == FALSE);
       return 1 if $_->[3] ne $a->string;
       return 1 if $_->[4] ne $a->subst_string;
+       })->join;
     }
   return 0;
 }
@@ -62,19 +77,24 @@
   for my $t (@tests)
     {
       my $a = new Automake::Condition @{$t->[0]};
+      return 1
+        if threads->new(sub {
       for my $u (@{$t->[1]})
        {
          my $b = new Automake::Condition @$u;
+             return threads->new(sub {
          if (! $b->true_when ($a))
            {
              print "`" . $b->string .
                "' not implied by `" . $a->string . "'?\n";
              $failed = 1;
            }
+             })->join;
        }
       for my $u (@{$t->[2]})
        {
          my $b = new Automake::Condition @$u;
+             return threads->new(sub {
          if ($b->true_when ($a))
            {
              print "`" . $b->string .
@@ -82,8 +102,12 @@
              $failed = 1;
            }
 
+               return threads->new(sub {
          return 1 if $b->true_when ($a);
+               })->join;
+             })->join;
        }
+        })->join;
     }
   return $failed;
 }
@@ -147,9 +171,13 @@
     {
       my ($inref, $outref) = @$_;
       my @inconds = map { new Automake::Condition $_ } @$inref;
+      return 1
+        if threads->new(sub {
       my @outconds = map { (new Automake::Condition $_)->string } @$outref;
+         return threads->new(sub {
       my @res =
        map { $_->string } (Automake::Condition::reduce_and (@inconds));
+           return threads->new(sub {
       my $result = join (",", sort @res);
       my $exresult = join (",", @outconds);
 
@@ -160,6 +188,10 @@
              $exresult . '"' . "\n";
          $failed = 1;
        }
+             return $failed;
+           })->join;
+         })->join;
+       })->join;
     }
   return $failed;
 }
@@ -223,9 +255,13 @@
     {
       my ($inref, $outref) = @$_;
       my @inconds = map { new Automake::Condition $_ } @$inref;
+      return 1
+        if threads->new(sub {
       my @outconds = map { (new Automake::Condition $_)->string } @$outref;
+         return threads->new(sub {
       my @res =
        map { $_->string } (Automake::Condition::reduce_or (@inconds));
+           return threads->new(sub {
       my $result = join (",", sort @res);
       my $exresult = join (",", @outconds);
 
@@ -236,6 +272,10 @@
              $exresult . '"' . "\n";
          $failed = 1;
        }
+             return $failed;
+           })->join;
+         })->join;
+       })->join;
     }
   return $failed;
 }


--- lib/Automake/tests/DisjConditions.pl        2008-10-18 11:12:03.000000000 
+0200
+++ lib/Automake/tests/DisjConditions-t.pl      2008-10-19 19:46:33.000000000 
+0200
@@ -15,20 +15,38 @@
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
+BEGIN {
+  use Config;
+  if (eval { require 5.007_002; }      # for CLONE support
+      && $Config{useithreads})
+    {
+      use threads;
+    }
+  else
+    {
+      exit 77;
+    }
+}
 use Automake::Condition qw/TRUE FALSE/;
 use Automake::DisjConditions;
 
 sub test_basics ()
 {
   my $cond = new Automake::Condition "COND1_TRUE", "COND2_FALSE";
+  return threads->new (sub {
   my $other = new Automake::Condition "COND3_FALSE";
+    return threads->new (sub {
   my $set1 = new Automake::DisjConditions $cond, $other;
+      return threads->new (sub {
   my $set2 = new Automake::DisjConditions $other, $cond;
   return 1 unless $set1 == $set2;
   return 1 if $set1->false;
   return 1 if $set1->true;
   return 1 unless (new Automake::DisjConditions)->false;
   return 1 if (new Automake::DisjConditions)->true;
+      })->join;
+    })->join;
+  })->join;
 }
 
 sub build_set (@)
@@ -72,6 +90,8 @@
   for my $t (@tests)
     {
       my $set = build_set @{$t->[0]};
+      return 1
+        if threads->new(sub {
       my $res = build_set @{$t->[1]};
       my $inv = $set->invert;
       if ($inv != $res)
@@ -80,6 +100,8 @@
            . $inv->string . ' != ' . $res->string . "\n";
          return 1;
        }
+         return 0
+       })-> join;
     }
   return 0;
 }
@@ -215,10 +237,14 @@
   for my $t (@tests)
     {
       my $set = build_set @{$t->[0]};
+      return 1
+       if threads->new(sub {
       my $res = build_set @{$t->[1]};
+         return threads->new(sub {
 
       # Make sure simplify() yields the expected result.
       my $sim = $set->simplify;
+           return threads->new(sub {
       if ($sim != $res)
        {
          print " (S1) " . $set->string . "\n\t"
@@ -228,6 +254,7 @@
 
       # Make sure simplify() is idempotent.
       my $sim2 = $sim->simplify;
+             return threads->new(sub {
       if ($sim2 != $sim)
        {
          print " (S2) " . $sim->string . "\n\t"
@@ -238,13 +265,21 @@
       # Also exercise invert() while we are at it.
 
       my $inv1 = $set->invert->simplify;
+               return threads->new(sub {
       my $inv2 = $sim->invert->simplify;
+                 return threads->new(sub {
       if ($inv1 != $inv2)
        {
          print " (S3) " . $set->string . ", " . $sim->string . "\n\t"
-           . $inv1->string . ' != ' . $inv2->string . "\n";
+                         . $inv1->string . ' -= ' . $inv2->string . "\n";
          return 1;
        }
+                 })->join;
+               })->join;
+             })->join;
+           })->join;
+         })->join;
+       })->join;
     }
 
   return 0;
@@ -298,17 +333,26 @@
   for my $t (@tests)
     {
       my $t1 = build_set @{$t->[0]};
+      return 1
+        if threads->new(sub {
       my $t2 = new Automake::Condition @{$t->[1]};
+         return threads->new(sub {
       my $t3 = build_set @{$t->[2]};
+           return threads->new(sub {
 
       # Make sure sub_conditions() yields the expected result.
       my $s = $t1->sub_conditions ($t2);
+             threads->new(sub {
       if ($s != $t3)
        {
          print " (SC) " . $t1->string . "\n\t"
            . $s->string . ' != ' . $t3->string . "\n";
          return 1;
        }
+             })->join;
+           })->join;
+         })->join;
+       })->join;
     }
 }
 
@@ -337,12 +381,17 @@
                ["C1_FALSE", "C2_TRUE"],
                '']);
 
+  my $failed = 0;
   for my $t (@tests)
     {
       my $t1 = build_set @{$t->[0]};
+      $failed = 1
+        if threads->new(sub {
       my $t2 = new Automake::Condition @{$t->[1]};
       my $t3 = $t->[2];
+         return threads->new(sub {
       my ($ans, $cond) = $t1->ambiguous_p ("FOO", $t2);
+           return threads->new(sub {
       if ($t3 && $ans !~ /FOO.*$t3/)
        {
          print " (A1) " . $t1->string . " vs. " . $t2->string . "\n\t"
@@ -355,8 +404,11 @@
            . "Unexpected error message: $ans\n";
          return 1;
        }
+           })->join;
+         })->join;
+       })->join;
     }
-  return 0;
+  return $failed;
 }
 
 exit (test_basics