This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade DB_File from version 1.841 to 1.842
authorSteve Hay <steve.m.hay@googlemail.com>
Mon, 16 Jul 2018 07:47:01 +0000 (08:47 +0100)
committerSteve Hay <steve.m.hay@googlemail.com>
Mon, 16 Jul 2018 07:47:01 +0000 (08:47 +0100)
MANIFEST
Porting/Maintainers.pl
cpan/DB_File/DB_File.pm
cpan/DB_File/DB_File.xs
cpan/DB_File/t/db-btree.t
cpan/DB_File/t/db-hash.t
cpan/DB_File/t/db-recno.t
cpan/DB_File/t/db-threads.t [new file with mode: 0644]

index 95fa539..aa76ccb 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -463,6 +463,7 @@ cpan/DB_File/Makefile.PL    Berkeley DB extension makefile writer
 cpan/DB_File/t/db-btree.t      See if DB_File works
 cpan/DB_File/t/db-hash.t       See if DB_File works
 cpan/DB_File/t/db-recno.t      See if DB_File works
+cpan/DB_File/t/db-threads.t    See if DB_File works
 cpan/DB_File/typemap           Berkeley DB extension interface types
 cpan/DB_File/version.c         Berkeley DB extension interface version check
 cpan/Digest/Digest.pm          Digest extensions
index f2d37fa..cede233 100755 (executable)
@@ -332,7 +332,7 @@ use File::Glob qw(:case);
     },
 
     'DB_File' => {
-        'DISTRIBUTION' => 'PMQS/DB_File-1.841.tar.gz',
+        'DISTRIBUTION' => 'PMQS/DB_File-1.842.tar.gz',
         'FILES'        => q[cpan/DB_File],
         'EXCLUDED'     => [
             qr{^patches/},
index 7a0051c..983741a 100644 (file)
@@ -2,7 +2,7 @@
 #
 # Written by Paul Marquess (pmqs@cpan.org)
 #
-#     Copyright (c) 1995-2016 Paul Marquess. All rights reserved.
+#     Copyright (c) 1995-2018 Paul Marquess. All rights reserved.
 #     This program is free software; you can redistribute it and/or
 #     modify it under the same terms as Perl itself.
 
@@ -162,8 +162,10 @@ our ($VERSION, @ISA, @EXPORT, $AUTOLOAD, $DB_BTREE, $DB_HASH, $DB_RECNO);
 our ($db_version, $use_XSLoader, $splice_end_array_no_length, $splice_end_array, $Error);
 use Carp;
 
+# Module not thread safe, so don't clone
+sub CLONE_SKIP { 1 } 
 
-$VERSION = "1.841" ;
+$VERSION = "1.842" ;
 $VERSION = eval $VERSION; # needed for dev releases
 
 {
index 04c8f74..6e6e154 100644 (file)
@@ -6,7 +6,7 @@
 
  All comments/suggestions/problems are welcome
 
-     Copyright (c) 1995-2016 Paul Marquess. All rights reserved.
+     Copyright (c) 1995-2018 Paul Marquess. All rights reserved.
      This program is free software; you can redistribute it and/or
      modify it under the same terms as Perl itself.
 
index 4e2968e..4ff405e 100644 (file)
@@ -31,6 +31,7 @@ EOM
 
 use DB_File; 
 use Fcntl;
+use File::Temp qw(tempdir) ;
 
 print "1..197\n";
 
@@ -125,6 +126,9 @@ my $db185mode =  ($DB_File::db_version == 1 && ! $DB_File::db_185_compat) ;
 my $null_keys_allowed = ($DB_File::db_ver < 2.004010 
                                || $DB_File::db_ver >= 3.1 );
 
+my $TEMPDIR = tempdir( CLEANUP => 1 );
+chdir $TEMPDIR;
+
 my $Dfile = "dbbtree.tmp";
 unlink $Dfile;
 
index f4c8f95..97b77fc 100644 (file)
@@ -3,6 +3,7 @@
 use warnings;
 use strict;
 use Config;
+use File::Temp qw(tempdir) ;
  
 BEGIN {
     if(-d "lib" && -f "TEST") {
@@ -82,6 +83,8 @@ sub safeUntie
     return $no_inner;
 }
 
+my $TEMPDIR = tempdir( CLEANUP => 1 );
+chdir $TEMPDIR;
 
 my $Dfile = "dbhash.tmp";
 my $Dfile2 = "dbhash2.tmp";
@@ -132,7 +135,7 @@ ok(14, $@ =~ /^DB_File::HASHINFO::FETCH - Unknown element 'fred' at/ );
 # Now check the interface to HASH
 my ($X, %h);
 ok(15, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-die "Could not tie: $!" unless $X;
+die "Could not tie: $!" unless defined $X;
 
 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
    $blksize,$blocks) = stat($Dfile);
index bd198dc..18b7e9e 100644 (file)
@@ -14,6 +14,8 @@ BEGIN {
 
 use DB_File; 
 use Fcntl;
+use File::Temp qw(tempdir) ;
+
 our ($dbh, $Dfile, $bad_ones, $FA);
 
 # full tied array support started in Perl 5.004_57
@@ -147,6 +149,9 @@ my $total_tests = 181 ;
 $total_tests += $splice_tests if $FA ;
 print "1..$total_tests\n";   
 
+my $TEMPDIR = tempdir( CLEANUP => 1 );
+chdir $TEMPDIR;
+
 $Dfile = "recno.tmp";
 unlink $Dfile ;
 
diff --git a/cpan/DB_File/t/db-threads.t b/cpan/DB_File/t/db-threads.t
new file mode 100644 (file)
index 0000000..f9bce95
--- /dev/null
@@ -0,0 +1,53 @@
+#!./perl 
+
+use warnings;
+use strict;
+use Config;
+use Fcntl;
+use Test::More;
+use DB_File;
+use File::Temp qw(tempdir) ;
+
+if (-d "lib" && -f "TEST") {
+    if ($Config{'extensions'} !~ /\bDB_File\b/ ) {
+        plan skip_all => 'DB_File was not built';
+    }
+}
+plan skip_all => 'Threads are disabled'
+    unless $Config{usethreads};
+
+plan skip_all => 'Thread test needs Perl 5.8.7 or greater'
+    unless $] >= 5.008007;
+
+plan tests => 7;
+
+# Check DBM back-ends do not destroy objects from then-spawned threads.
+# RT#61912.
+use_ok('threads');
+
+my $TEMPDIR = tempdir( CLEANUP => 1 );
+chdir $TEMPDIR;
+
+my %h;
+unlink <threads*>;
+
+my $db = tie %h, 'DB_File', 'threads', O_RDWR|O_CREAT, 0640;
+isa_ok($db, 'DB_File');
+
+for (1 .. 2) {
+    ok(threads->create(
+        sub {
+            $SIG{'__WARN__'} = sub { fail(shift) }; # debugging perl panics
+                # report it by spurious TAP line
+            1;
+        }), "Thread $_ created");
+}
+for (threads->list) {
+    is($_->join, 1, "A thread exited successfully");
+}
+
+pass("Tied object survived exiting threads");
+
+undef $db;
+untie %h;
+unlink <threads*>;