Alt-Devel-GlobalDestruction-XS-Inline

 view release on metacpan or  search on metacpan

inc/Inline.pm  view on Meta::CPAN

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
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

520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
    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

557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
       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

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
 
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

1
2
3
I32 in_global_destruction() {
    return PL_dirty;
}

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

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
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

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
  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

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
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

40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
  $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;