Alt-Devel-GlobalDestruction-XS-Inline

 view release on metacpan or  search on metacpan

inc/Inline.pm  view on Meta::CPAN

    return unless @_;
    &create_config_file(), return 1 if $_[0] eq '_CONFIG_';
    goto &maker_utils if $_[0] =~ /^(install|makedist|makeppd)$/i;

    my $control = shift;

    if (uc $control eq uc 'with') {
        return handle_with($pkg, @_);
    }
    elsif (uc $control eq uc 'Config') {
        return handle_global_config($pkg, @_);
    }
    elsif (exists $shortcuts{uc($control)}) {
        handle_shortcuts($pkg, $control, @_);
        $version_requested = $CONFIG{$pkg}{template}{PRINT_VERSION};
        return;
    }
    elsif ($control =~ /^\S+$/ and $control !~ /\n/) {
        my $language_id = $control;
        my $option = shift || '';
        my @config = @_;

inc/Inline.pm  view on Meta::CPAN

    my $o = shift;

    return if $o->{CONFIG}{_INSTALL_};

    my ($pkg, $module) = @{$o->{API}}{qw(pkg module)};
    croak M42_usage_loader() unless $o->{INLINE}{ILSM_type} eq 'compiled';

    require DynaLoader;
    @Inline::ISA = qw(DynaLoader);

    my $global = $o->{CONFIG}{GLOBAL_LOAD} ? '0x01' : '0x00';
    my $version = $o->{API}{version} || '0.00';

    eval <<END;
        package $pkg;
        push \@$ {pkg}::ISA, qw($module)
          unless \$module eq "$pkg";
        local \$$ {module}::VERSION = '$version';

        package $module;
        push \@$ {module}::ISA, qw(Exporter DynaLoader);
        sub dl_load_flags { $global }
        ${module}::->bootstrap;
END
    croak M43_error_bootstrap($module, $@) if $@;
}

#==============================================================================
# Create file that satisfies the Makefile dependency for this object
#==============================================================================

sub satisfy_makefile_dep {

inc/Inline.pm  view on Meta::CPAN

       print INLINE "*** AUTOGENERATED by Inline.pm ***\n\n";
       print INLINE "This file satisfies the make dependency for ";
       print INLINE "$o->{API}{module}\n";
       close INLINE;
       return;
}

#==============================================================================
# Process the config options that apply to all Inline sections
#==============================================================================
sub handle_global_config {
    my $pkg = shift;
    while (@_) {
        my ($key, $value) = (uc shift, shift);
        croak M02_usage() if $key =~ /[\s\n]/;
        if ($key =~ /^(ENABLE|DISABLE)$/) {
            ($key, $value) = (uc $value, $key eq 'ENABLE' ? 1 : 0);
        }
        croak M47_invalid_config_option($key)
          unless defined $default_config->{$key};
        $CONFIG{$pkg}{template}{$key} = $value;

inc/Inline/denter.pm  view on Meta::CPAN

sub undent {
    local $/ = "\n";
    my ($o, $text) = @_;
    my ($comma) = $o->{comma};
    my $package = caller;
    $package = caller(1) if $package eq 'Inline::denter';
    %{$o->{xref}} = ();
    @{$o->{objects}} = ();
    @{$o->{context}} = ();
    my $glob = '';
    chomp $text;
    @{$o->{lines}} = split $/, $text;
    $o->{level} = 0;
    $o->{line} ||= 1;
    $o->_setup_line;
    while (not $o->{done}) {
        if ($o->{level} == 0 and
            $o->{content} =~ /^(\w+)\s*$comma\s*(.*)$/) {
            $o->{content} = $2;
            no strict 'refs';

lib/Devel/GlobalDestruction/XS.c  view on Meta::CPAN

I32 in_global_destruction() {
    return PL_dirty;
}

t/01_basic.t  view on Meta::CPAN

our $had_error;

sub ok ($$) {
  $had_error++, print "not " if !$_[0];
  print "ok";
  print " - $_[1]" if defined $_[1];
  print "\n";
}

END {
  ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), 'Not yet in GD while in END block 2' )
}

ok( eval "use Devel::GlobalDestruction::XS; 1", "use Devel::GlobalDestruction::XS" );

# ok( defined prototype \&Devel::GlobalDestruction::XS::in_global_destruction, "defined prototype" );

# ok( prototype \&Devel::GlobalDestruction::XS::in_global_destruction eq "", "empty prototype" );

ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), "Runtime is not GD" );

our $sg1 = Test::Scope::Guard->new(sub { ok( Devel::GlobalDestruction::XS::in_global_destruction(), "Final cleanup object destruction properly in GD" ) });

END {
  ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), 'Not yet in GD while in END block 1' )
}

our $sg2 = Test::Scope::Guard->new(sub { ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), "Object destruction in END not considered GD" ) });
END { undef $sg2 }

t/03_minusc.t  view on Meta::CPAN

  require B;
  B::minus_c();

  print "1..3\n";
  ok( $^C, "Test properly running under minus-c" );
}

use Devel::GlobalDestruction::XS;

BEGIN {
    ok !Devel::GlobalDestruction::XS::in_global_destruction(), "BEGIN is not GD with -c";
}

our $foo;
BEGIN {
  $foo = Test::Scope::Guard->new( sub {
    ok( Devel::GlobalDestruction::XS::in_global_destruction(), "Final cleanup object destruction properly in GD" ) or do {
      require POSIX;
      POSIX::_exit(1);
    };
  });
}

t/04_phases.t  view on Meta::CPAN

sub ok ($$) {
  $had_error++, print "not " if !$_[0];
  print "ok";
  print " - $_[1]" if defined $_[1];
  print "\n";
  !!$_[0]
}

use Devel::GlobalDestruction::XS;

sub check_not_global {
  my $phase = shift;
  ok !Devel::GlobalDestruction::XS::in_global_destruction(), "$phase is not GD";
  Test::Scope::Guard->new( sub {
    ok( !Devel::GlobalDestruction::XS::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') }

t/05_thread_clone.t  view on Meta::CPAN

  $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::XS;

our $cloner = Test::Thread::Clone->new(sub {
    ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), "CLONE is not GD" );
    my $guard = Test::Scope::Guard->new(sub {
        ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), "DESTROY during CLONE is not GD");
    });
});
our $global = Test::Scope::Guard->new(sub {
    ok( Devel::GlobalDestruction::XS::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;