Devel-GlobalDestruction-0.13/000755 000765 000024 00000000000 12373523370 016404 5ustar00gknopstaff000000 000000 Devel-GlobalDestruction-0.13/Changes000644 000765 000024 00000003506 12373523354 017705 0ustar00gknopstaff000000 000000 0.13 - 2014-08-16 * include README * include minimum perl version 5.6 in metadata 0.12 Fri, 01 Nov 2013 * Fix detection when loaded during global destruction by checking B::main_cv instead of B::main_start * Bump Sub::Exporter::Progressive dependency to fix loading in global destruction 0.11 Wed, 03 Apr 2013 * Fix upgrading from version 0.09 or older 0.10 Tue, 26 Mar 2013 * Rewrite pure-perl implementation in terms of B::main_start (greatly simplifies code) * Fix pure-perl behavior under $^C (RT#78619)) * Separate XS portion into a compiler-optional dependency Devel::GlobalDestruction::XS 0.09 Wed, 08 Aug 2012 * Rewrite completely broken pure-perl GD detection under threads * Fix pure-perl implementation incorrectly reporting GD during END phase 0.08 Tue, 31 Jul 2012 * Switch to Sub::Exporter::Progressive 0.07 Wed, 25 Jul 2012 * Actually detect errors in pure-perl test * Add prototype to pure-perl pre-5.14 version 0.06 Thu, 14 Jun 2012 * De-retardize XS-less behavior under SpeedyCGI * Test suite now works from within space-containing paths 0.05 Thu, 26 Apr 2012 * Pure-perl implementation for situations where neither ${^GLOBAL_PHASE} nor XS are available 0.04 Sun, 03 Jul 2011 11:28:51 +0200 * To detect a perl with ${^GLOBAL_PHASE}, check for the feature itself instead of a specific perl version (doy). * Update the documentation to reflect the use of ${^GLOBAL_PHASE} if available (doy). * Stop depending on Scope::Guard for the tests (doy). * Upgrade ppport.h from version 3.13 to 3.19. 0.03 * Drop the XS code on perl versions recent enough to have ${^GLOBAL_PHASE}. * Drop code to support perls older than 5.6. We've always been depending on 5.6 anyway. + Use XSLoader without a fallback to DynaLoader. + Use our instead of use vars. Devel-GlobalDestruction-0.13/lib/000755 000765 000024 00000000000 12373523370 017152 5ustar00gknopstaff000000 000000 Devel-GlobalDestruction-0.13/maint/000755 000765 000024 00000000000 12373523370 017514 5ustar00gknopstaff000000 000000 Devel-GlobalDestruction-0.13/Makefile.PL000644 000765 000024 00000013321 12372337037 020360 0ustar00gknopstaff000000 000000 use strict; use warnings FATAL => 'all'; use 5.006; my %META = ( name => 'Devel-GlobalDestruction', license => 'perl_5', prereqs => { configure => { requires => { 'ExtUtils::MakeMaker' => 0, 'ExtUtils::CBuilder' => 0.27, } }, runtime => { requires => { 'Sub::Exporter::Progressive' => '0.001011', 'perl' => 5.006, }, }, }, resources => { homepage => 'https://metacpan.org/release/Devel-GlobalDestruction', repository => { url => 'git://git.shadowcat.co.uk/p5sagit/Devel-GlobalDestruction.git', web => 'http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/Devel-GlobalDestruction.git', type => 'git', }, bugtracker => { web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-GlobalDestruction', mailto => 'bug-Devel-GlobalDestruction@rt.cpan.org', }, license => [ 'http://dev.perl.org/licenses/' ], }, no_index => { directory => [ 't', 'xt' ] }, ); my %MM_ARGS = ( PREREQ_PM => { ( (defined ${^GLOBAL_PHASE} or parse_args()->{PUREPERL_ONLY} or !can_xs() ) ? () : ('Devel::GlobalDestruction::XS' => 0) ), }, ); use ExtUtils::MakeMaker; BEGIN { if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } }} use Text::ParseWords; sub parse_args { # copied from EUMM ExtUtils::MakeMaker::parse_args( my $tmp = {}, Text::ParseWords::shellwords($ENV{PERL_MM_OPT} || ''), @ARGV, ); return $tmp->{ARGS} || {}; } if (eval { require Devel::GlobalDestruction } && Devel::GlobalDestruction->VERSION < 0.10) { package MY; no warnings 'once'; *install = sub { my $self = shift; return ' pure_site_install :: $(NOECHO) $(RM_F) ' . $self->quote_literal( $self->catfile('$(DESTINSTALLSITEARCH)', 'Devel', 'GlobalDestruction.pm') ) . "\n" . $self->SUPER::install; }; } # can we locate a (the) C compiler sub can_cc { my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return can_run("@chunks") || (pop(@chunks), next); } return; } # check if we can run some command sub can_run { my ($cmd) = @_; return $cmd if -x $cmd; if (my $found_cmd = MM->maybe_command($cmd)) { return $found_cmd; } require File::Spec; for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder; ExtUtils::CBuilder->VERSION(0.27)"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } ############################################################################## require ExtUtils::MakeMaker; (do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; # have to do this since old EUMM dev releases miss the eval $VERSION line my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; my $mymeta = $eumm_version >= 6.57_02; my $mymeta_broken = $mymeta && $eumm_version < 6.57_07; ($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g; ($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g; $MM_ARGS{LICENSE} = $META{license} if $eumm_version >= 6.30; $MM_ARGS{NO_MYMETA} = 1 if $mymeta_broken; $MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META } unless -f 'META.yml'; for (qw(configure build test runtime)) { my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; my $r = $MM_ARGS{$key} = { %{$META{prereqs}{$_}{requires} || {}}, %{delete $MM_ARGS{$key} || {}}, }; defined $r->{$_} or delete $r->{$_} for keys %$r; } $MM_ARGS{MIN_PERL_VERSION} = delete $MM_ARGS{PREREQ_PM}{perl} || 0; delete $MM_ARGS{MIN_PERL_VERSION} if $eumm_version < 6.47_01; $MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}} if $eumm_version < 6.63_03; $MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}} if $eumm_version < 6.55_01; delete $MM_ARGS{CONFIGURE_REQUIRES} if $eumm_version < 6.51_03; ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS); Devel-GlobalDestruction-0.13/MANIFEST000644 000765 000024 00000000710 12373523370 017533 0ustar00gknopstaff000000 000000 Changes lib/Devel/GlobalDestruction.pm maint/Makefile.PL.include Makefile.PL MANIFEST This list of files t/01_basic.t t/02_thread.t t/03_minusc.t t/04_phases.t t/05_thread_clone.t t/06_load-in-gd.t t/10_pure-perl.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README README file (added by Distar) Devel-GlobalDestruction-0.13/META.json000644 000765 000024 00000003502 12373523370 020025 0ustar00gknopstaff000000 000000 { "abstract" : "Provides function returning the equivalent of C<${^GLOBAL_PHASE} eq 'DESTRUCT'> for older perls.", "author" : [ "Yuval Kogman ", "Florian Ragwitz ", "Jesse Luehrs ", "Peter Rabbitson ", "Arthur Axel 'fREW' Schmidt ", "Elizabeth Mattijsen ", "Greham Knop " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141520", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Devel-GlobalDestruction", "no_index" : { "directory" : [ "t", "xt" ] }, "prereqs" : { "build" : {}, "configure" : { "requires" : { "ExtUtils::CBuilder" : "0.27", "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Sub::Exporter::Progressive" : "0.001011", "perl" : "5.006" } }, "test" : {} }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Devel-GlobalDestruction@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-GlobalDestruction" }, "homepage" : "https://metacpan.org/release/Devel-GlobalDestruction", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://git.shadowcat.co.uk/p5sagit/Devel-GlobalDestruction.git", "web" : "http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/Devel-GlobalDestruction.git" } }, "version" : "0.13" } Devel-GlobalDestruction-0.13/META.yml000644 000765 000024 00000002204 12373523370 017653 0ustar00gknopstaff000000 000000 --- abstract: "Provides function returning the equivalent of C<${^GLOBAL_PHASE} eq 'DESTRUCT'> for older perls." author: - 'Yuval Kogman ' - 'Florian Ragwitz ' - 'Jesse Luehrs ' - 'Peter Rabbitson ' - "Arthur Axel 'fREW' Schmidt " - 'Elizabeth Mattijsen ' - 'Greham Knop ' build_requires: {} configure_requires: ExtUtils::CBuilder: '0.27' ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141520' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Devel-GlobalDestruction no_index: directory: - t - xt requires: Sub::Exporter::Progressive: '0.001011' perl: '5.006' resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-GlobalDestruction homepage: https://metacpan.org/release/Devel-GlobalDestruction license: http://dev.perl.org/licenses/ repository: git://git.shadowcat.co.uk/p5sagit/Devel-GlobalDestruction.git version: '0.13' Devel-GlobalDestruction-0.13/README000644 000765 000024 00000003343 12373523370 017267 0ustar00gknopstaff000000 000000 NAME Devel::GlobalDestruction - Provides function returning the equivalent of "${^GLOBAL_PHASE} eq 'DESTRUCT'" for older perls. SYNOPSIS package Foo; use Devel::GlobalDestruction; use namespace::clean; # to avoid having an "in_global_destruction" method sub DESTROY { return if in_global_destruction; do_something_a_little_tricky(); } DESCRIPTION Perl's global destruction is a little tricky to deal with WRT finalizers because it's not ordered and objects can sometimes disappear. Writing defensive destructors is hard and annoying, and usually if global destruction is happening you only need the destructors that free up non process local resources to actually execute. For these constructors you can avoid the mess by simply bailing out if global destruction is in effect. EXPORTS This module uses Sub::Exporter::Progressive so the exports may be renamed, aliased, etc. if Sub::Exporter is present. in_global_destruction Returns true if the interpreter is in global destruction. In perl 5.14+, this returns "${^GLOBAL_PHASE} eq 'DESTRUCT'", and on earlier perls, detects it using the value of "PL_main_cv" or "PL_dirty". AUTHORS Yuval Kogman Florian Ragwitz Jesse Luehrs Peter Rabbitson Arthur Axel 'fREW' Schmidt Elizabeth Mattijsen Greham Knop COPYRIGHT Copyright (c) 2008 Yuval Kogman. All rights reserved This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Devel-GlobalDestruction-0.13/t/000755 000765 000024 00000000000 12373523370 016647 5ustar00gknopstaff000000 000000 Devel-GlobalDestruction-0.13/t/01_basic.t000644 000765 000024 00000004074 12302165577 020425 0ustar00gknopstaff000000 000000 use strict; use warnings; BEGIN { if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) { unshift @INC, sub { die 'no XS' if $_[1] eq 'Devel/GlobalDestruction/XS.pm'; }; } } BEGIN { package Test::Scope::Guard; sub new { my ($class, $code) = @_; bless [$code], $class; } sub DESTROY { my $self = shift; $self->[0]->() } } print "1..9\n"; our $had_error; # try to ensure this is the last-most END so we capture future tests # running in other ENDs if ($] >= 5.008) { require B; my $reinject_retries = my $max_retry = 5; my $end_worker; $end_worker = sub { my $tail = (B::end_av()->ARRAY)[-1]; if (!defined $tail or $tail == $end_worker) { $? = $had_error || 0; $reinject_retries = 0; } elsif ($reinject_retries--) { push @{B::end_av()->object_2svref}, $end_worker; } else { print STDERR "\n\nSomething is racing with @{[__FILE__]} for final END block definition - can't win after $max_retry iterations :(\n\n"; require POSIX; POSIX::_exit( 255 ); } }; eval 'END { push @{B::end_av()->object_2svref}, $end_worker }'; } # B::end_av isn't available on 5.6, so just use a basic end block else { eval 'END { $? = $had_error || 0 }'; } sub ok ($$) { $had_error++, print "not " if !$_[0]; print "ok"; print " - $_[1]" if defined $_[1]; print "\n"; } END { ok( ! in_global_destruction(), 'Not yet in GD while in END block 2' ) } ok( eval "use Devel::GlobalDestruction; 1", "use Devel::GlobalDestruction" ); ok( defined &in_global_destruction, "exported" ); ok( defined prototype \&in_global_destruction, "defined prototype" ); ok( prototype \&in_global_destruction eq "", "empty prototype" ); ok( ! in_global_destruction(), "Runtime is not GD" ); our $sg1; $sg1 = Test::Scope::Guard->new(sub { ok( in_global_destruction(), "Final cleanup object destruction properly in GD" ) }); END { ok( ! in_global_destruction(), 'Not yet in GD while in END block 1' ) } our $sg2 = Test::Scope::Guard->new(sub { ok( ! in_global_destruction(), "Object destruction in END not considered GD" ) }); END { undef $sg2 } Devel-GlobalDestruction-0.13/t/02_thread.t000644 000765 000024 00000001611 12367641666 020617 0ustar00gknopstaff000000 000000 use Config; BEGIN { unless ($Config{useithreads}) { print "1..0 # SKIP your perl does not support ithreads\n"; exit 0; } } BEGIN { unless (eval { require threads }) { print "1..0 # SKIP threads.pm not installed\n"; exit 0; } } use threads; use threads::shared; our $had_error :shared; END { $? = $had_error||0 } use strict; use warnings; BEGIN { if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) { unshift @INC, sub { die 'no XS' if $_[1] eq 'Devel/GlobalDestruction/XS.pm'; }; } } # load it before spawning a thread, that's the whole point require Devel::GlobalDestruction; sub do_test { # just die so we don't need to deal with testcount skew unless ( ($_[0]||'') eq 'arg' ) { $had_error++; die "Argument passing failed!"; } delete $INC{'t/01_basic.t'}; do 't/01_basic.t'; 1; } threads->create('do_test', 'arg')->join or $had_error++; Devel-GlobalDestruction-0.13/t/03_minusc.t000644 000765 000024 00000001550 12217032374 020631 0ustar00gknopstaff000000 000000 use strict; use warnings; BEGIN { if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) { unshift @INC, sub { die 'no XS' if $_[1] eq 'Devel/GlobalDestruction/XS.pm'; }; } } { package Test::Scope::Guard; sub new { my ($class, $code) = @_; bless [$code], $class; } sub DESTROY { my $self = shift; $self->[0]->() } } sub ok ($$) { print "not " if !$_[0]; print "ok"; print " - $_[1]" if defined $_[1]; print "\n"; !!$_[0] } BEGIN { require B; B::minus_c(); print "1..3\n"; ok( $^C, "Test properly running under minus-c" ); } use Devel::GlobalDestruction; BEGIN { ok !in_global_destruction(), "BEGIN is not GD with -c"; } our $foo; BEGIN { $foo = Test::Scope::Guard->new( sub { ok( in_global_destruction(), "Final cleanup object destruction properly in GD" ) or do { require POSIX; POSIX::_exit(1); }; }); } Devel-GlobalDestruction-0.13/t/04_phases.t000644 000765 000024 00000002203 12217032374 020613 0ustar00gknopstaff000000 000000 use strict; use warnings; BEGIN { if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) { unshift @INC, sub { die 'no XS' if $_[1] eq 'Devel/GlobalDestruction/XS.pm'; }; } } { package Test::Scope::Guard; sub new { my ($class, $code) = @_; bless [$code], $class; } sub DESTROY { my $self = shift; $self->[0]->() } } my $had_error = 0; END { $? = $had_error } sub ok ($$) { $had_error++, print "not " if !$_[0]; print "ok"; print " - $_[1]" if defined $_[1]; print "\n"; !!$_[0] } use Devel::GlobalDestruction; sub check_not_global { my $phase = shift; ok !in_global_destruction(), "$phase is not GD"; Test::Scope::Guard->new( sub { ok( !in_global_destruction(), "DESTROY in $phase still not GD" ); }); } BEGIN { print "1..10\n"; } BEGIN { check_not_global('BEGIN') } BEGIN { if (eval 'UNITCHECK {}; 1') { eval q[ UNITCHECK { check_not_global('UNITCHECK') }; 1 ] or die $@; } else { print "ok # UNITCHECK not supported in perl < 5.10\n" x 2; } } CHECK { check_not_global('CHECK') } sub CLONE { check_not_global('CLONE') }; INIT { check_not_global('INIT') } END { check_not_global('END') } Devel-GlobalDestruction-0.13/t/05_thread_clone.t000644 000765 000024 00000003334 12367641666 022006 0ustar00gknopstaff000000 000000 use strict; use warnings; use Config; BEGIN { unless ($Config{useithreads}) { print "1..0 # SKIP your perl does not support ithreads\n"; exit 0; } } BEGIN { unless (eval { require threads }) { print "1..0 # SKIP threads.pm not installed\n"; exit 0; } } BEGIN { if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) { unshift @INC, sub { die 'no XS' if $_[1] eq 'Devel/GlobalDestruction/XS.pm'; }; } } BEGIN { package Test::Scope::Guard; sub new { my ($class, $code) = @_; bless [$code], $class; } sub DESTROY { my $self = shift; $self->[0]->() } } BEGIN { package Test::Thread::Clone; my @code; sub new { my ($class, $code) = @_; push @code, $code; bless [$code], $class; } sub CLONE { $_->() for @code } } use threads; use threads::shared; print "1..4\n"; our $had_error :shared; END { $? = $had_error||0 } sub ok ($$) { $had_error++, print "not " if !$_[0]; print "ok"; print " - $_[1]" if defined $_[1]; print "\n"; } # load it before spawning a thread, that's the whole point use Devel::GlobalDestruction; our $cloner = Test::Thread::Clone->new(sub { ok( ! in_global_destruction(), "CLONE is not GD" ); my $guard = Test::Scope::Guard->new(sub { ok( ! in_global_destruction(), "DESTROY during CLONE is not GD"); }); }); our $global = Test::Scope::Guard->new(sub { ok( in_global_destruction(), "Final cleanup object destruction properly in GD in " . (threads->tid ? 'thread' : 'main program') ); }); sub do_test { # just die so we don't need to deal with testcount skew unless ( ($_[0]||'') eq 'arg' ) { $had_error++; die "Argument passing failed!"; } # nothing really to do in here 1; } threads->create('do_test', 'arg')->join or $had_error++; Devel-GlobalDestruction-0.13/t/06_load-in-gd.t000644 000765 000024 00000001402 12234750344 021250 0ustar00gknopstaff000000 000000 use strict; use warnings; BEGIN { if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) { unshift @INC, sub { die 'no XS' if $_[1] eq 'Devel/GlobalDestruction/XS.pm'; }; } } { package Test::Scope::Guard; sub new { my ($class, $code) = @_; bless [$code], $class; } sub DESTROY { my $self = shift; $self->[0]->() } } use POSIX qw(_exit); $|++; print "1..3\n"; our $alive = Test::Scope::Guard->new(sub { require Devel::GlobalDestruction; my $gd = Devel::GlobalDestruction::in_global_destruction(); print(($gd ? '' : 'not ') . "ok 3 - global destruct detected when loaded during GD\n"); _exit($gd ? 0 : 1); }); print(($alive ? '' : 'not ') . "ok 1 - alive during runtime\n"); END { print(($alive ? '' : 'not ') . "ok 2 - alive during END\n"); } Devel-GlobalDestruction-0.13/t/10_pure-perl.t000644 000765 000024 00000002024 12217032374 021241 0ustar00gknopstaff000000 000000 use strict; use warnings; use FindBin qw($Bin); use Config; use IPC::Open2; # rerun the tests under the assumption of pure-perl # for the $^X-es $ENV{PERL5LIB} = join ($Config{path_sep}, @INC); $ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST} = 1; my $this_file = quotemeta(__FILE__); opendir(my $dh, $Bin); my @tests = grep { $_ !~ /${this_file}$/ } map { "$Bin/$_" } grep { /\.t$/ } readdir $dh; print "1..@{[ scalar @tests ]}\n"; my $had_error = 0; END { $? = $had_error } sub ok ($$) { $had_error++, print "not " if !$_[0]; print "ok"; print " - $_[1]" if defined $_[1]; print "\n"; } for my $fn (@tests) { # this is cheating, and may even hang here and there (testing on windows passed fine) # if it does - will have to fix it somehow (really *REALLY* don't want to pull # in IPC::Cmd just for a fucking test) # the alternative would be to have an ENV check in each test to force a subtest open2(my $out, my $in, $^X, $fn ); while (my $ln = <$out>) { print " $ln"; } wait; ok (! $?, "Exit $? from: $^X $fn"); } Devel-GlobalDestruction-0.13/maint/Makefile.PL.include000644 000765 000024 00000000731 12372335564 023116 0ustar00gknopstaff000000 000000 BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } use lib 'Distar/lib'; use Distar 0.001; use ExtUtils::MakeMaker 6.57_10 (); author [ 'Yuval Kogman ', 'Florian Ragwitz ', 'Jesse Luehrs ', 'Peter Rabbitson ', 'Arthur Axel \'fREW\' Schmidt ', 'Elizabeth Mattijsen ', 'Greham Knop ', ]; 1; Devel-GlobalDestruction-0.13/lib/Devel/000755 000765 000024 00000000000 12373523370 020211 5ustar00gknopstaff000000 000000 Devel-GlobalDestruction-0.13/lib/Devel/GlobalDestruction.pm000644 000765 000024 00000005327 12373523316 024202 0ustar00gknopstaff000000 000000 package Devel::GlobalDestruction; use strict; use warnings; our $VERSION = '0.13'; use Sub::Exporter::Progressive -setup => { exports => [ qw(in_global_destruction) ], groups => { default => [ -all ] }, }; # we run 5.14+ - everything is in core # if (defined ${^GLOBAL_PHASE}) { eval 'sub in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }; 1' or die $@; } # try to load the xs version if it was compiled # elsif (eval { require Devel::GlobalDestruction::XS; no warnings 'once'; *in_global_destruction = \&Devel::GlobalDestruction::XS::in_global_destruction; 1; }) { # the eval already installed everything, nothing to do } else { # internally, PL_main_cv is set to Nullcv immediately before entering # global destruction and we can use B to detect that. B::main_cv will # only ever be a B::CV or a B::SPECIAL that is a reference to 0 require B; eval 'sub in_global_destruction () { ${B::main_cv()} == 0 }; 1' or die $@; } 1; # keep require happy __END__ =head1 NAME Devel::GlobalDestruction - Provides function returning the equivalent of C<${^GLOBAL_PHASE} eq 'DESTRUCT'> for older perls. =head1 SYNOPSIS package Foo; use Devel::GlobalDestruction; use namespace::clean; # to avoid having an "in_global_destruction" method sub DESTROY { return if in_global_destruction; do_something_a_little_tricky(); } =head1 DESCRIPTION Perl's global destruction is a little tricky to deal with WRT finalizers because it's not ordered and objects can sometimes disappear. Writing defensive destructors is hard and annoying, and usually if global destruction is happening you only need the destructors that free up non process local resources to actually execute. For these constructors you can avoid the mess by simply bailing out if global destruction is in effect. =head1 EXPORTS This module uses L so the exports may be renamed, aliased, etc. if L is present. =over 4 =item in_global_destruction Returns true if the interpreter is in global destruction. In perl 5.14+, this returns C<${^GLOBAL_PHASE} eq 'DESTRUCT'>, and on earlier perls, detects it using the value of C or C. =back =head1 AUTHORS Yuval Kogman Enothingmuch@woobling.orgE Florian Ragwitz Erafl@debian.orgE Jesse Luehrs Edoy@tozt.netE Peter Rabbitson Eribasushi@cpan.orgE Arthur Axel 'fREW' Schmidt Efrioux@gmail.comE Elizabeth Mattijsen Eliz@dijkmat.nlE Greham Knop Ehaarg@haarg.orgE =head1 COPYRIGHT Copyright (c) 2008 Yuval Kogman. All rights reserved This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut