1
2
3
4
5
6
7
8
9
10
11
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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
#! perl
use strict;
use warnings;
use Test::More 0.89;
use Config;
plan(skip_all => 'No dynamic linking') if not $Config{usedl};
use Cwd 'getcwd';
use ExtUtils::Builder::Planner 0.007;
use File::Basename qw/basename dirname/;
use File::Spec::Functions qw/catfile/;
use File::Temp 'tempdir';
my $olddir = getcwd;
my $dir = tempdir(CLEANUP => 1);
chdir $dir;
my $planner = ExtUtils::Builder::Planner->new;
$planner->load_extension('ExtUtils::Builder::AutoDetect::C', undef,
profile => '@Perl', type => 'loadable-object',
);
mkdir 't';
my $source_file = File::Spec->catfile('t', 'compilet.c');
{
open my $fh, '>', $source_file or die "Can't create $source_file: $!";
my $content = <<END;
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
XS(exported) {
#ifdef dVAR
dVAR;
#endif
dXSARGS;
PERL_UNUSED_VAR(cv); /* -W */
PERL_UNUSED_VAR(items); /* -W */
XSRETURN_IV(42);
}
#ifndef XS_EXTERNAL
#define XS_EXTERNAL(foo) XS(foo)
#endif
XS_EXTERNAL(boot_compilet) {
#ifdef dVAR
dVAR;
#endif
dXSARGS;
PERL_UNUSED_VAR(cv); /* -W */
PERL_UNUSED_VAR(items); /* -W */
newXS("main::exported", exported, __FILE__);
}
END
print $fh $content or die "Can't write to $source_file: $!";
close $fh or die "Can't close $source_file: $!";
}
ok(-e $source_file, "source file '$source_file' created");
my $object_file = catfile(dirname($source_file), basename($source_file, '.c') . $Config{obj_ext});
$planner->compile($source_file, $object_file);
my $lib_file = catfile(dirname($source_file), basename($object_file, $Config{obj_ext}) . ".$Config{dlext}");
$planner->link([$object_file], $lib_file, dl_name => 'compilet');
my $plan = $planner->materialize;
ok $plan;
ok eval { $plan->run($lib_file, logger => \¬e); 1 } or diag "Got exception: $@";
ok(-e $object_file, "object file $object_file has been created");
ok(-e $lib_file, "lib file $lib_file has been created");
require DynaLoader;
my $libref = DynaLoader::dl_load_file($lib_file, 0);
ok($libref, 'libref is defined');
my $symref = DynaLoader::dl_find_symbol($libref, "boot_compilet");
ok($symref, 'symref is defined');
my $boot_compilet = DynaLoader::dl_install_xsub("boot_compilet", $symref, $source_file);
is(eval { boot_compilet(); 1 }, 1, 'compilet lives');
is(eval { exported() }, 42, 'exported returns 42');
END {
for ($source_file, $object_file, $lib_file) {
next if not defined;
1 while unlink;
}
if ($^O eq 'VMS') {
1 while unlink 'COMPILET.LIS';
1 while unlink 'COMPILET.OPT';
}
}
chdir $olddir;
done_testing;
|
