Attachment 3743 Details for Bug 20451 – ld_shared_wrapper.pl

ld_shared_wrapper.pl

ld_shared_wrapper.pl (text/plain), 2.90 KB, created by Sergey Vlasov on 2009-08-17 12:50:07 MSD

(hide)

Description:

Filename:

MIME Type:

Creator: Sergey Vlasov

Created: 2009-08-17 12:50:07 MSD

Size: 2.90 KB

patch

obsolete

>#!/usr/bin/perl
>#
># $(LD_SHARED_CXX) wrapper for wxGTK to handle symbol versioning
>#
>
>use File::Temp;
>use strict;
>use warnings;
>
>scalar(@ARGV) > 0 or die "no arguments";
>
>my @ld_args_1;
>my @ld_args_2 = @ARGV;
>while (scalar(@ld_args_2) and $ld_args_2[0] ne '-o') {
>	push @ld_args_1, shift(@ld_args_2);
>}
>scalar(@ld_args_2) >= 2 or die "missing '-o <file>' option";
>push @ld_args_1, shift(@ld_args_2);	# '-o'
>my $orig_output_file = shift(@ld_args_2);
>
>my $tmpdir = File::Temp->newdir();
>
>my $orig_version_script;
>my $tmp_version_script = "$orig_output_file.versions";
>my @final_ld_args_2 = @ld_args_2;
>for (@final_ld_args_2) {
>	/^-Wl,--version-script,(.*)$/ && do {
>		$orig_version_script = $1;
>		$_ = "-Wl,--version-script,$tmp_version_script";
>		last;
>	}
>}
>
>if (not defined $orig_version_script) {
>	exit(verbose_system(@ld_args_1, $orig_output_file, @ld_args_2));
>}
>
># First link attempt, writing to a temporary file
>my $tmp_lib = "$tmpdir/tmp.so";
>my $rc = verbose_system(@ld_args_1, $tmp_lib, @ld_args_2);
>exit($rc) if $rc != 0;
>
># Read global symbols from the link result
>my %symbols;
>open(my $nm_output, '-|', 'nm', '-D', '--defined-only', $tmp_lib)
>	or die "get nm output: $!";
>while (<$nm_output>) {
>	chomp;
>	/^[[:xdigit:]]*\s+[[:upper:]]\s+(\S+)$/ && do {
>		$symbols{$1} = 1;
>	}
>}
>close($nm_output)
>	or die $! ? "error closing nm output: $!"
>		: "nm: exited with status $?";
>
># Using global symbol list, expand symbol patterns in version script
>open(my $vs_in, '<', $orig_version_script)
>	or die "open '$orig_version_script': $!";
>open(my $vs_out, '>', $tmp_version_script)
>	or die "open '$tmp_version_script': $!";
>while (<$vs_in>) {
>	chomp;
>	/^\s*([^[:space:]#{};]+);\s*$/ && do {
>		expand_symbol($vs_out, $_, $1);
>		next;
>	};
>	print $vs_out "$_\n";
>}
>close($vs_out) or die "error closing '$tmp_version_script': $!";
>close($vs_in) or die "error closing '$orig_version_script': $!";
>
># Final link, using the modified version script
>exit(verbose_system(@ld_args_1, $orig_output_file, @final_ld_args_2));
>
>
>
>sub expand_symbol
>{
>	my ($vs_out, $line, $glob) = @_;
>
>	# Keep '*' as is
>	if ($glob eq '*') {
>		print $vs_out "$line\n";
>		return;
>	}
>
>	# Convert shell pattern to regexp (currently only '*' is handled).
>	if ($glob =~ /[^[:alnum:]_*]/) {
>		die "unable to handle symbol pattern '$glob'";
>	}
>	my $re = $glob;
>	$re =~ s/\*/.*/g;
>	if ($re eq $glob) {
>		# exact match - keep as is
>		print $vs_out "$line\n";
>		return;
>	}
>	$re = qr/^$re$/;
>
>	my $first = 1;
>	for my $sym (grep { m/$re/ } keys %symbols) {
>		if ($first) {
>			$first = 0;
>			print $vs_out "##$line\n";
>		}
>		print $vs_out "\t$sym;\n";
>		delete $symbols{$sym};
>	}
>	if ($first) {
>		# Keep unmatched patterns to avoid empty sections
>		print $vs_out "$line\n";
>	} else {
>		print $vs_out "\n";
>	}
>}
>
>sub verbose_system
>{
>	print "+ " . join(' ', @_) . "\n";
>	my $rc = system { $_[0] } @_;
>	if ($rc == -1) {
>		die "system: $!";
>	}
>	elsif ($rc & 127) {
>		return ($rc & 127) | 128;
>	}
>	return $rc >> 8;
>}

Actions: View

Attachments on bug 20451: 3743 | 3744