From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 14 Feb 2012 22:13:30 +0000 (+0100)
Subject: Remove all uses of Scope::Guard from the tests, use our own version
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bbf6a9a5d39cbf1c9d22cccd298ae95ac0fef694;p=dbsrgits%2FDBIx-Class.git

Remove all uses of Scope::Guard from the tests, use our own version

A deferred constraints rework several commits later will remove all remaining
uses from lib/ and as such we will lose the dep entirely
---

diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index 58e9e6a..98da93c 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -21,6 +21,8 @@ BEGIN {
 
     HAS_ITHREADS => $Config{useithreads} ? 1 : 0,
 
+    UNSTABLE_DOLLARAT => ( "$]" < 5.013002 ) ? 1 : 0,
+
     DBICTEST => $INC{"DBICTest/Util.pm"} ? 1 : 0,
 
     # During 5.13 dev cycle HELEMs started to leak on copy
@@ -70,7 +72,8 @@ use base 'Exporter';
 our @EXPORT_OK = qw(
   sigwarn_silencer modver_gt_or_eq modver_gt_or_eq_and_lt
   fail_on_internal_wantarray fail_on_internal_call
-  refdesc refcount hrefaddr is_exception detected_reinvoked_destructor
+  refdesc refcount hrefaddr
+  scope_guard is_exception detected_reinvoked_destructor
   quote_sub qsub perlstring serialize deep_clone
   UNRESOLVABLE_CONDITION
 );
@@ -116,6 +119,32 @@ sub serialize ($) {
   nfreeze($_[0]);
 }
 
+sub scope_guard (&) {
+  croak 'Calling scope_guard() in void context makes no sense'
+    if ! defined wantarray;
+
+  # no direct blessing of coderefs - DESTROY is buggy on those
+  bless [ $_[0] ], 'DBIx::Class::_Util::ScopeGuard';
+}
+{
+  package #
+    DBIx::Class::_Util::ScopeGuard;
+
+  sub DESTROY {
+    &DBIx::Class::_Util::detected_reinvoked_destructor;
+
+    local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
+
+    eval {
+      $_[0]->[0]->();
+      1;
+    } or do {
+      Carp::cluck "Execution of scope guard $_[0] resulted in the non-trappable exception:\n\n$@";
+    };
+  }
+}
+
+
 sub is_exception ($) {
   my $e = $_[0];
 
diff --git a/t/749sqlanywhere.t b/t/749sqlanywhere.t
index 396e103..a52b5bd 100644
--- a/t/749sqlanywhere.t
+++ b/t/749sqlanywhere.t
@@ -3,9 +3,9 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
-use Scope::Guard ();
 use Try::Tiny;
 use DBIx::Class::Optional::Dependencies ();
+use DBIx::Class::_Util 'scope_guard';
 use lib qw(t/lib);
 use DBICTest;
 
@@ -48,7 +48,7 @@ foreach my $info (@info) {
     auto_savepoint => 1
   });
 
-  my $guard = Scope::Guard->new(sub{ cleanup($schema) });
+  my $guard = scope_guard { cleanup($schema) };
 
   my $dbh = $schema->storage->dbh;
 
diff --git a/t/750firebird.t b/t/750firebird.t
index 1066132..45dd895 100644
--- a/t/750firebird.t
+++ b/t/750firebird.t
@@ -4,7 +4,7 @@ use warnings;
 use Test::More;
 use Test::Exception;
 use DBIx::Class::Optional::Dependencies ();
-use Scope::Guard ();
+use DBIx::Class::_Util 'scope_guard';
 use List::Util 'shuffle';
 use Try::Tiny;
 use lib qw(t/lib);
@@ -53,7 +53,7 @@ for my $prefix (shuffle keys %$env2optdep) { SKIP: {
   });
   my $dbh = $schema->storage->dbh;
 
-  my $sg = Scope::Guard->new(sub { cleanup($schema) });
+  my $sg = scope_guard { cleanup($schema) };
 
   eval { $dbh->do(q[DROP TABLE "artist"]) };
   $dbh->do(<<EOF);
diff --git a/t/751msaccess.t b/t/751msaccess.t
index bf4cdac..dfd5816 100644
--- a/t/751msaccess.t
+++ b/t/751msaccess.t
@@ -3,9 +3,9 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
-use Scope::Guard ();
 use Try::Tiny;
 use DBIx::Class::Optional::Dependencies ();
+use DBIx::Class::_Util 'scope_guard';
 use lib qw(t/lib);
 use DBICTest;
 
@@ -62,7 +62,7 @@ foreach my $info (@info) {
     LongReadLen => $maxloblen,
   });
 
-  my $guard = Scope::Guard->new(sub { cleanup($schema) });
+  my $guard = scope_guard { cleanup($schema) };
 
   my $dbh = $schema->storage->dbh;
 
diff --git a/t/icdt/engine_specific/firebird.t b/t/icdt/engine_specific/firebird.t
index ffe6852..05ef381 100644
--- a/t/icdt/engine_specific/firebird.t
+++ b/t/icdt/engine_specific/firebird.t
@@ -4,9 +4,9 @@ use strict;
 use warnings;
 
 use Test::More;
+use DBIx::Class::_Util 'scope_guard';
 use lib qw(t/lib);
 use DBICTest;
-use Scope::Guard ();
 
 my $env2optdep = {
   DBICTEST_FIREBIRD => 'test_rdbms_firebird',
@@ -42,7 +42,7 @@ for my $prefix (keys %$env2optdep) { SKIP: {
     on_connect_call => [ 'datetime_setup' ],
   });
 
-  my $sg = Scope::Guard->new(sub { cleanup($schema) } );
+  my $sg = scope_guard { cleanup($schema) };
 
   eval { $schema->storage->dbh->do('DROP TABLE "event"') };
   $schema->storage->dbh->do(<<'SQL');
diff --git a/t/icdt/engine_specific/informix.t b/t/icdt/engine_specific/informix.t
index c82274b..4a6231c 100644
--- a/t/icdt/engine_specific/informix.t
+++ b/t/icdt/engine_specific/informix.t
@@ -4,9 +4,9 @@ use strict;
 use warnings;
 
 use Test::More;
+use DBIx::Class::_Util 'scope_guard';
 use lib qw(t/lib);
 use DBICTest;
-use Scope::Guard ();
 
 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_INFORMIX_${_}" } qw/DSN USER PASS/};
 my $schema;
@@ -16,7 +16,7 @@ my $schema;
     on_connect_call => [ 'datetime_setup' ],
   });
 
-  my $sg = Scope::Guard->new(sub { cleanup($schema) } );
+  my $sg = scope_guard { cleanup($schema) };
 
   eval { $schema->storage->dbh->do('DROP TABLE event') };
   $schema->storage->dbh->do(<<'SQL');
diff --git a/t/icdt/engine_specific/msaccess.t b/t/icdt/engine_specific/msaccess.t
index ed5830f..9e647fb 100644
--- a/t/icdt/engine_specific/msaccess.t
+++ b/t/icdt/engine_specific/msaccess.t
@@ -4,8 +4,8 @@ use strict;
 use warnings;
 
 use Test::More;
-use Scope::Guard ();
 use Try::Tiny;
+use DBIx::Class::_Util 'scope_guard';
 use lib qw(t/lib);
 use DBICTest;
 
@@ -36,7 +36,7 @@ for my $connect_info (@connect_info) {
     quote_names => 1,
   });
 
-  my $guard = Scope::Guard->new(sub { cleanup($schema) });
+  my $guard = scope_guard { cleanup($schema) };
 
   try { local $^W = 0; $schema->storage->dbh->do('DROP TABLE track') };
   $schema->storage->dbh->do(<<"SQL");
diff --git a/t/icdt/engine_specific/mssql.t b/t/icdt/engine_specific/mssql.t
index 523530a..e65a994 100644
--- a/t/icdt/engine_specific/mssql.t
+++ b/t/icdt/engine_specific/mssql.t
@@ -5,8 +5,8 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
-use Scope::Guard ();
 use Try::Tiny;
+use DBIx::Class::_Util 'scope_guard';
 use lib qw(t/lib);
 use DBICTest;
 
@@ -52,7 +52,7 @@ for my $connect_info (@connect_info) {
     }
   }
 
-  my $guard = Scope::Guard->new(sub{ cleanup($schema) });
+  my $guard = scope_guard { cleanup($schema) };
 
   # $^W because DBD::ADO is a piece of crap
   try { local $^W = 0; $schema->storage->dbh->do("DROP TABLE track") };
diff --git a/t/icdt/engine_specific/sqlanywhere.t b/t/icdt/engine_specific/sqlanywhere.t
index f186f93..0bac9dc 100644
--- a/t/icdt/engine_specific/sqlanywhere.t
+++ b/t/icdt/engine_specific/sqlanywhere.t
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 
 use Test::More;
-use Scope::Guard ();
+use DBIx::Class::_Util 'scope_guard';
 use lib qw(t/lib);
 use DBICTest;
 
@@ -38,7 +38,7 @@ foreach my $info (@info) {
     on_connect_call => 'datetime_setup',
   });
 
-  my $sg = Scope::Guard->new(sub { cleanup($schema) } );
+  my $sg = scope_guard { cleanup($schema) };
 
   eval { $schema->storage->dbh->do('DROP TABLE event') };
   $schema->storage->dbh->do(<<"SQL");
diff --git a/t/icdt/engine_specific/sybase.t b/t/icdt/engine_specific/sybase.t
index 5f6efc8..c63944e 100644
--- a/t/icdt/engine_specific/sybase.t
+++ b/t/icdt/engine_specific/sybase.t
@@ -5,8 +5,7 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
-use Scope::Guard ();
-use Try::Tiny;
+use DBIx::Class::_Util 'scope_guard';
 use lib qw(t/lib);
 use DBICTest;
 
@@ -30,7 +29,7 @@ for my $storage_type (@storage_types) {
     on_connect_call => 'datetime_setup',
   });
 
-  my $guard = Scope::Guard->new(sub { cleanup($schema) } );
+  my $guard = scope_guard { cleanup($schema) };
 
   $schema->storage->ensure_connected;
 
diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
index ff046a7..2d5e238 100644
--- a/t/lib/DBICTest.pm
+++ b/t/lib/DBICTest.pm
@@ -7,13 +7,12 @@ use warnings;
 use DBICTest::Util qw( local_umask await_flock dbg DEBUG_TEST_CONCURRENCY_LOCKS );
 use DBICTest::Schema;
 use DBICTest::Util::LeakTracer qw/populate_weakregistry assert_empty_weakregistry/;
-use DBIx::Class::_Util 'detected_reinvoked_destructor';
+use DBIx::Class::_Util qw( detected_reinvoked_destructor scope_guard );
 use Carp;
 use Path::Class::File ();
 use File::Spec;
 use Fcntl qw/:DEFAULT :flock/;
 use Config;
-use Scope::Guard ();
 
 =head1 NAME
 
@@ -405,7 +404,7 @@ sub deploy_schema {
 
     my $guard;
     if ( ($ENV{TRAVIS}||'') eq 'true' and my $old_dbg = $schema->storage->debug ) {
-      $guard = Scope::Guard->new(sub { $schema->storage->debug($old_dbg) });
+      $guard = scope_guard { $schema->storage->debug($old_dbg) };
       $schema->storage->debug(0);
     }
 
@@ -439,7 +438,7 @@ sub populate_schema {
 
     my $guard;
     if ( ($ENV{TRAVIS}||'') eq 'true' and my $old_dbg = $schema->storage->debug ) {
-      $guard = Scope::Guard->new(sub { $schema->storage->debug($old_dbg) });
+      $guard = scope_guard { $schema->storage->debug($old_dbg) };
       $schema->storage->debug(0);
     }
 
diff --git a/t/lib/DBICTest/BaseSchema.pm b/t/lib/DBICTest/BaseSchema.pm
index 27cdcd7..1ff5e98 100644
--- a/t/lib/DBICTest/BaseSchema.pm
+++ b/t/lib/DBICTest/BaseSchema.pm
@@ -7,7 +7,7 @@ use base qw(DBICTest::Base DBIx::Class::Schema);
 
 use Fcntl qw(:DEFAULT :seek :flock);
 use Time::HiRes 'sleep';
-use Scope::Guard ();
+use DBIx::Class::_Util 'scope_guard';
 use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry);
 use DBICTest::Util qw( local_umask await_flock dbg DEBUG_TEST_CONCURRENCY_LOCKS );
 use namespace::clean;
@@ -31,9 +31,9 @@ sub capture_executed_sql_bind {
     qw(debugcb debugobj debug)
   };
 
-  my $sg = Scope::Guard->new(sub {
+  my $sg = scope_guard {
     $self->storage->$_ ( $orig_states->{$_} ) for keys %$orig_states;
-  });
+  };
 
   $self->storage->debugcb(undef);
   $self->storage->debugobj( my $tracer_obj = DBICTest::SQLTracerObj->new );
diff --git a/t/lib/DBICTest/Util.pm b/t/lib/DBICTest/Util.pm
index 74ba068..f747210 100644
--- a/t/lib/DBICTest/Util.pm
+++ b/t/lib/DBICTest/Util.pm
@@ -24,10 +24,10 @@ use constant DEBUG_TEST_CONCURRENCY_LOCKS =>
 ;
 
 use Config;
-use Carp 'confess';
+use Carp qw(cluck confess croak);
 use Fcntl ':flock';
 use Scalar::Util qw(blessed refaddr);
-use DBIx::Class::_Util;
+use DBIx::Class::_Util 'scope_guard';
 
 use base 'Exporter';
 our @EXPORT_OK = qw(
@@ -90,27 +90,26 @@ sub await_flock ($$) {
   return $res;
 }
 
-sub local_umask {
+
+sub local_umask ($) {
   return unless defined $Config{d_umask};
 
-  die 'Calling local_umask() in void context makes no sense'
+  croak 'Calling local_umask() in void context makes no sense'
     if ! defined wantarray;
 
-  my $old_umask = umask(shift());
+  my $old_umask = umask($_[0]);
   die "Setting umask failed: $!" unless defined $old_umask;
 
-  return bless \$old_umask, 'DBICTest::Util::UmaskGuard';
-}
-{
-  package DBICTest::Util::UmaskGuard;
-  sub DESTROY {
-    &DBIx::Class::_Util::detected_reinvoked_destructor;
-
-    local ($@, $!);
-    eval { defined (umask ${$_[0]}) or die };
-    warn ( "Unable to reset old umask ${$_[0]}: " . ($!||'Unknown error') )
-      if ($@ || $!);
-  }
+  scope_guard(sub {
+    local ($@, $!, $?);
+
+    eval {
+      defined(umask $old_umask) or die "nope";
+      1;
+    } or cluck (
+      "Unable to reset old umask '$old_umask': " . ($! || 'Unknown error')
+    );
+  });
 }
 
 sub stacktrace {
diff --git a/t/resultset/update_delete.t b/t/resultset/update_delete.t
index f49fb0e..30e3797 100644
--- a/t/resultset/update_delete.t
+++ b/t/resultset/update_delete.t
@@ -10,6 +10,8 @@ use Test::Exception;
 # and that's a whole another bag of dicks
 BEGIN { $ENV{DBIC_SHUFFLE_UNORDERED_RESULTSETS} = 0 }
 
+use DBIx::Class::_Util 'scope_guard';
+
 use DBICTest::Schema::CD;
 BEGIN {
   # the default scalarref table name will not work well for this test
@@ -142,9 +144,9 @@ $schema->is_executed_sql_bind( sub {
 $schema->is_executed_sql_bind( sub {
 
   my $orig_umi = $schema->storage->_use_multicolumn_in;
-  my $sg = Scope::Guard->new(sub {
+  my $sg = scope_guard {
     $schema->storage->_use_multicolumn_in($orig_umi);
-  });
+  };
 
   $schema->storage->_use_multicolumn_in(1);
 
diff --git a/t/storage/savepoints.t b/t/storage/savepoints.t
index 3da77f1..b0f3858 100644
--- a/t/storage/savepoints.t
+++ b/t/storage/savepoints.t
@@ -3,7 +3,7 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
-use DBIx::Class::_Util qw(modver_gt_or_eq sigwarn_silencer);
+use DBIx::Class::_Util qw(modver_gt_or_eq sigwarn_silencer scope_guard);
 
 use lib qw(t/lib);
 use DBICTest;
@@ -76,9 +76,9 @@ for ('', keys %$env2optdep) { SKIP: {
     { $_ => $schema->storage->$_ }
     qw(debugcb debugobj debug)
   };
-  my $sg = Scope::Guard->new(sub {
+  my $sg = scope_guard {
     $schema->storage->$_ ( $orig_states->{$_} ) for keys %$orig_states;
-  });
+  };
   $schema->storage->debugobj (my $stats = DBICTest::SVPTracerObj->new);
   $schema->storage->debug (1);