view release on metacpan or  search on metacpan

inc/Devel/CheckLib.pm  view on Meta::CPAN

sub assert_lib {
    my %args = @_;
    my (@libs, @libpaths, @headers, @incpaths);

    # FIXME: these four just SCREAM "refactor" at me
    @libs = (ref($args{lib}) ? @{$args{lib}} : $args{lib}) 
        if $args{lib};
    @libpaths = (ref($args{libpath}) ? @{$args{libpath}} : $args{libpath}) 
        if $args{libpath};
    @headers = (ref($args{header}) ? @{$args{header}} : $args{header}) 
        if $args{header};
    @incpaths = (ref($args{incpath}) ? @{$args{incpath}} : $args{incpath}) 
        if $args{incpath};
    my $analyze_binary = $args{analyze_binary};

    my @argv = @ARGV;
    push @argv, _parse_line('\s+', 0, $ENV{PERL_MM_OPT}||'');

    # work-a-like for Makefile.PL's LIBS and INC arguments
    # if given as command-line argument, append to %args
    for my $arg (@argv) {
        for my $mm_attr_key (qw(LIBS INC)) {
            if (my ($mm_attr_value) = $arg =~ /\A $mm_attr_key = (.*)/x) {
            # it is tempting to put some \s* into the expression, but the
            # MM command-line parser only accepts LIBS etc. followed by =,
            # so we should not be any more lenient with whitespace than that
                $args{$mm_attr_key} .= " $mm_attr_value";
            }
        }
    }

    # using special form of split to trim whitespace
    if(defined($args{LIBS})) {
        foreach my $arg (split(' ', $args{LIBS})) {
            die("LIBS argument badly-formed: $arg\n") unless($arg =~ /^-[lLR]/);
            push @{$arg =~ /^-l/ ? \@libs : \@libpaths}, substr($arg, 2);
        }
    }
    if(defined($args{INC})) {
        foreach my $arg (split(' ', $args{INC})) {
            die("INC argument badly-formed: $arg\n") unless($arg =~ /^-I/);
            push @incpaths, substr($arg, 2);
        }
    }

    my ($cc, $ld) = _findcc($args{debug}, $args{ccflags}, $args{ldflags});
    my @missing;
    my @wrongresult;
    my @wronganalysis;
    my @use_headers;

    # first figure out which headers we can't find ...
    for my $header (@headers) {
        push @use_headers, $header;
        my($ch, $cfile) = File::Temp::tempfile(
            'assertlibXXXXXXXX', SUFFIX => '.c'
        );
        my $ofile = $cfile;
        $ofile =~ s/\.c$/$Config{_o}/;
        print $ch qq{#include <$_>\n} for @use_headers;
        print $ch qq{int main(void) { return 0; }\n};
        close($ch);
        my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe};
        my @sys_cmd;
        # FIXME: re-factor - almost identical code later when linking
        if ( $Config{cc} eq 'cl' ) {                 # Microsoft compiler
            require Win32;
            @sys_cmd = (
                @$cc,
                $cfile,
                "/Fe$exefile",
                (map { '/I'.Win32::GetShortPathName($_) } @incpaths),
		"/link",
		@$ld,
		split(' ', $Config{libs}),
            );
        } elsif($Config{cc} =~ /bcc32(\.exe)?/) {    # Borland
            @sys_cmd = (
                @$cc,
                @$ld,
                (map { "-I$_" } @incpaths),
                "-o$exefile",
                $cfile
            );
        } else { # Unix-ish: gcc, Sun, AIX (gcc, cc), ...
            @sys_cmd = (
                @$cc,
                @$ld,
                $cfile,
                (map { "-I$_" } @incpaths),
                "-o", "$exefile"
            );
        }
        warn "# @sys_cmd\n" if $args{debug};
        my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd);
        push @missing, $header if $rv != 0 || ! -x $exefile;
        _cleanup_exe($exefile);
        unlink $cfile;
    }

    # now do each library in turn with headers
    my($ch, $cfile) = File::Temp::tempfile(
        'assertlibXXXXXXXX', SUFFIX => '.c'
    );
    my $ofile = $cfile;
    $ofile =~ s/\.c$/$Config{_o}/;
    print $ch qq{#include <$_>\n} foreach (@headers);
    print $ch "int main(int argc, char *argv[]) { ".($args{function} || 'return 0;')." }\n";
    close($ch);
    for my $lib ( @libs ) {
        my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe};
        my @sys_cmd;
        if ( $Config{cc} eq 'cl' ) {                 # Microsoft compiler
            require Win32;
            my @libpath = map { 
                q{/libpath:} . Win32::GetShortPathName($_)
            } @libpaths; 
            # this is horribly sensitive to the order of arguments
            @sys_cmd = (
                @$cc,
                $cfile,
                "${lib}.lib",
                "/Fe$exefile", 
                (map { '/I'.Win32::GetShortPathName($_) } @incpaths),
                "/link",
                @$ld,
                split(' ', $Config{libs}),
                (map {'/libpath:'.Win32::GetShortPathName($_)} @libpaths),
            );
        } elsif($Config{cc} eq 'CC/DECC') {          # VMS
        } elsif($Config{cc} =~ /bcc32(\.exe)?/) {    # Borland
            @sys_cmd = (
                @$cc,
                @$ld,
                "-o$exefile",
                (map { "-I$_" } @incpaths),
                (map { "-L$_" } @libpaths),
                "-l$lib",
                $cfile);
        } else {                                     # Unix-ish
                                                     # gcc, Sun, AIX (gcc, cc)
            @sys_cmd = (
                @$cc,
                @$ld,
                $cfile,
                "-o", "$exefile",
                (map { "-I$_" } @incpaths),
                (map { "-L$_" } @libpaths),
                "-l$lib",
            );
        }
        warn "# @sys_cmd\n" if $args{debug};
        local $ENV{LD_RUN_PATH} = join(":", @libpaths).":".$ENV{LD_RUN_PATH} unless $^O eq 'MSWin32';
        local $ENV{PATH} = join(";", @libpaths).";".$ENV{PATH} if $^O eq 'MSWin32';
        my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd);
        if ($rv != 0 || ! -x $exefile) {
            push @missing, $lib;
        }
        else {
            my $absexefile = File::Spec->rel2abs($exefile);
            $absexefile = '"'.$absexefile.'"' if $absexefile =~ m/\s/;
            if (system($absexefile) != 0) {
                push @wrongresult, $lib;
            }
            else {
                if ($analyze_binary) {
                    push @wronganalysis, $lib if !$analyze_binary->($lib, $exefile)
                }