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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
package Helper;
use strict;
# compatible use warnings
BEGIN{ if (not $] < 5.006) { require warnings; warnings->import } }
use Config;
use Cwd;
use Exporter;
use IO::File;
use File::Spec::Functions qw/catfile canonpath splitdir/;
use File::Temp qw/tempdir/;
use vars qw/@EXPORT @ISA/;
@ISA = qw/Exporter/;
@EXPORT = qw(
create_testlib
find_compiler
find_binary
);
my $orig_wd = cwd;
BEGIN { require Devel::CheckLib; } # for _quiet_system()
sub _quiet_system {
goto &Devel::CheckLib::_quiet_system;
}
#--------------------------------------------------------------------------#
# create_testlib( 'bazbam' )
#
# takes a library name and compiles a simple library with two functions,
# foo() (which returns 0) and libversion() (which returns 42), in a temp
# directory and returns the temp directory. Returns undef if something
# went wrong
#--------------------------------------------------------------------------#
sub create_testlib {
my ($libname) = (@_);
return unless $libname;
my $tempdir = tempdir(CLEANUP => 1, TEMPLATE => "Devel-Assert-testlib-XXXXXXXX");
chdir $tempdir;
my $code_fh = IO::File->new("${libname}.c", ">");
print {$code_fh} "int libversion() { return 42; }\nint foo() { return 0; }\n";
$code_fh->close;
my $cc = (split(/\s+/, $Config{cc}))[0];
my $gccv = $Config{gccversion};
my $rv =
$cc eq 'gcc' ? _gcc_lib( $libname ) :
$cc eq 'cc' ? _gcc_lib( $libname ) :
$cc eq 'cl' ? _cl_lib( $libname ) :
$gccv ? _gcc_lib( $libname ) :
undef ;
chdir $orig_wd;
return $rv ? canonpath($tempdir) : undef;
}
sub _gcc_lib {
my ($libname) = @_;
my $cc = find_compiler() or return;
my $ar = find_binary('ar') or return;
my $ranlib = find_binary('ranlib') or return;
my $ccflags = $Config{ccflags};
my $libfile = "lib${libname}.a";
_quiet_system(qq{"$cc" $ccflags -c ${libname}.c}) and return;
_quiet_system($ar, 'rc', $libfile, "${libname}$Config{_o}") and return;
_quiet_system($ranlib, $libfile) and return;
return -f $libfile
}
sub _cl_lib {
my ($libname) = @_;
my $cc = find_compiler() or return;
my $ar = find_binary('lib') or return;
_quiet_system($cc, '/c', "${libname}.c") and return;
_quiet_system($ar, "${libname}$Config{_o}") and return;
return -f "${libname}.lib";
}
#--------------------------------------------------------------------------#
# find_binary, find_compiler
#
# Returns absolute path to an executable file in $ENV{PATH} or undef
# if it can't be found. find_binary() takes a program argument;
# find_compiler takes no arguments and just returns the path to $Config{cc}
#--------------------------------------------------------------------------#
sub find_binary {
my ($program) = @_;
if ($Config{_exe} && $program !~ /$Config{_exe}$/) {
$program .= $Config{_exe};
}
return $program if -x $program;
my @search_paths = split /$Config{path_sep}/, $ENV{PATH};
my @lib_search_paths = map lib_to_bin($_), split /$Config{path_sep}/, $ENV{LIBRARY_PATH}||'';
for my $path ( @search_paths, @lib_search_paths ) {
my $binary = catfile( $path, $program );
return $binary if -x $binary;
}
return;
}
sub lib_to_bin {
my ( $lib_dir ) = @_;
my @parts = splitdir $lib_dir;
pop @parts;
push @parts, 'bin';
my $bin_dir = catfile(@parts);
return $bin_dir;
}
sub find_compiler {
my $result = find_binary($Config{cc});
return $result if($result);
# sometimes $Config{cc} isn't very clean eg it can be 'cc -q32' on AIX
return find_binary((split(/\s+/, $Config{cc}))[0])
if($Config{cc} =~ /\s/);
undef;
}
1; # must be true
|
