This is what I have currently in my tree. It helps to build vlc
and new graphics/digikam (after tweaking KDE3, not committed yet)
at least. Anyone willing to move from GNU libtool is invited to
test this.
Comments on the code are also welcome, of course.
--
zhuk@
Index: Makefile
===================================================================
RCS file: /cvs/src/usr.bin/libtool/Makefile,v
retrieving revision 1.6
diff -u -p -r1.6 Makefile
--- Makefile 13 Jul 2012 11:56:12 -0000 1.6
+++ Makefile 19 Jan 2014 14:24:32 -0000
@@ -20,6 +20,7 @@ PACKAGES= \
LT/Mode/Link/Library.pm \
LT/Program.pm \
LT/Trace.pm \
+ LT/UList.pm \
LT/Util.pm
LIBBASE=/usr/libdata/perl5
Index: LT/Archive.pm
===================================================================
RCS file: /cvs/src/usr.bin/libtool/LT/Archive.pm,v
retrieving revision 1.5
diff -u -p -r1.5 Archive.pm
--- LT/Archive.pm 9 Nov 2012 10:51:47 -0000 1.5
+++ LT/Archive.pm 19 Jan 2014 14:24:32 -0000
@@ -22,6 +22,7 @@ use feature qw(say switch state);
package LT::Archive;
use LT::Trace;
use LT::Exec;
+use LT::UList;
use LT::Util;
use File::Path;
@@ -58,6 +59,7 @@ sub get_symbollist
tsay {"generating symbol list in file: $filepath"};
tsay {"object list is @$objlist" };
my $symbols = [];
+ tie (@$symbols, 'LT::UList');
open(my $sh, '-|', 'nm', '--', @$objlist) or
die "Error running nm on object list @$objlist\n";
my $c = 0;
@@ -73,10 +75,8 @@ sub get_symbollist
}
$c++;
}
- $symbols = reverse_zap_duplicates_ref($symbols);
- @$symbols = sort @$symbols;
open(my $fh, '>', $filepath) or die "Cannot open $filepath\n";
- print $fh map { "$_\n" } @$symbols;
+ print $fh map { "$_\n" } sort @$symbols;
}
1;
Index: LT/LaFile.pm
===================================================================
RCS file: /cvs/src/usr.bin/libtool/LT/LaFile.pm,v
retrieving revision 1.19
diff -u -p -r1.19 LaFile.pm
--- LT/LaFile.pm 13 Jul 2012 13:45:34 -0000 1.19
+++ LT/LaFile.pm 19 Jan 2014 14:24:32 -0000
@@ -128,14 +128,11 @@ sub find
{
my ($self, $l, $dirs) = @_;
- # sort dir search order by priority
- # XXX not fully correct yet
- my @sdirs = sort { $dirs->{$b} <=> $dirs->{$a} } keys %$dirs;
# search in cwd as well
- unshift @sdirs, '.';
+ unshift @$dirs, '.';
tsay {"searching .la for $l"};
- tsay {"search path= ", join(':', @sdirs)};
- foreach my $d (@sdirs) {
+ tsay {"search path= ", join(':', @$dirs)};
+ foreach my $d (@$dirs) {
foreach my $la_candidate ("$d/lib$l.la", "$d/$l.la") {
if (-f $la_candidate) {
tsay {"found $la_candidate"};
Index: LT/Library.pm
===================================================================
RCS file: /cvs/src/usr.bin/libtool/LT/Library.pm,v
retrieving revision 1.8
diff -u -p -r1.8 Library.pm
--- LT/Library.pm 13 Jul 2012 11:56:12 -0000 1.8
+++ LT/Library.pm 19 Jan 2014 14:24:32 -0000
@@ -95,17 +95,12 @@ sub resolve_library
"points to nonexistent file ", $libfile, " !"};
}
} else {
- # otherwise, search the filesystem
- # sort dir search order by priority
- # XXX not fully correct yet
- my @sdirs = sort { $dirs->{$b} <=> $dirs->{$a} } keys %$dirs;
# search in .libs when priority is high
- map { $_ = "$_/$ltdir" if (exists $dirs->{$_} && $dirs->{$_} >
3) } @sdirs;
- push @sdirs, $gp->libsearchdirs if $gp;
+ push @$dirs, $gp->libsearchdirs if $gp;
tsay {"searching for $libtofind"};
- tsay {"search path= ", join(':', @sdirs)};
+ tsay {"search path= ", join(':', @$dirs)};
tsay {"search type= ", $shared ? 'shared' : 'static'};
- foreach my $sd (@sdirs) {
+ foreach my $sd (@$dirs) {
if ($shared) {
# select correct library by sorting by version
number only
my $bestlib = $self->findbest($sd, $libtofind);
Index: LT/UList.pm
===================================================================
RCS file: LT/UList.pm
diff -N LT/UList.pm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ LT/UList.pm 19 Jan 2014 14:24:32 -0000
@@ -0,0 +1,199 @@
+# ex:ts=8 sw=4:
+# $OpenBSD$
+#
+# Copyright (c) 2013 Vadim Zhukov <z...@openbsd.org>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+use strict;
+use warnings;
+use feature qw(say);
+
+# Hash that preserves order of adding items and avoids duplicates.
+# Also, some additional restrictions are applied to make sure
+# the usage of this list is straightforward.
+
+package LT::UList;
+require Tie::Array;
+
+our @ISA = qw(Tie::Array);
+
+sub _translate_num_key($$;$) {
+ if ($_[1] < 0) {
+ $_[1] = @{$_[0]} - (-$_[1]);
+ die "invalid index" if $_[1] < 1;
+ } else {
+ $_[1] += 1;
+ }
+ die "invalid index" if $_[1] - int($_[2] // 0) >= @{$_[0]};
+}
+
+# Given we have successfully added N directories:
+# self->[0] = { directory => 1 }
+# self->[1 .. N] = directories in the order of addition, represented as
0..N-1
+
+sub TIEARRAY {
+ my $class = shift;
+ my $self = bless [ {} ], $class;
+ $self->PUSH(@_);
+ return $self;
+}
+
+# Unfortunately, exists() checks for the value being integer even in the
+# case we have EXISTS() outta there. So if you really need to check the
+# presence of particular item, call the method below on the reference
+# returned by tie() or tied() instead.
+sub exists { return exists $_[0]->[0]->{$_[1]}; }
+
+sub FETCHSIZE { return scalar(@{$_[0]}) - 1; }
+
+# not needed
+sub STORE { die "unimplemented and should not be used"; }
+sub DELETE { die "unimplemented and should not be used"; }
+sub EXTEND { }
+
+sub FETCH
+{
+ my ($self, $key) = (shift, shift);
+
+ # ignore?
+ die "undef given instead of directory or index" unless defined $key;
+
+ $self->_translate_num_key($key);
+ return $self->[$key];
+}
+
+sub STORESIZE
+{
+ my ($self, $newsz) = (shift, shift() + 2);
+ my $sz = @$self;
+
+ if ($newsz > $sz) {
+ # XXX any better way to grow?
+ $self->[$newsz - 1] = undef;
+ } elsif ($newsz < $sz) {
+ $self->POP() for $newsz .. $sz - 1;
+ }
+}
+
+sub PUSH
+{
+ my $self = shift;
+ for (@_) {
+ next if exists $self->[0]->{$_};
+ $self->[0]->{$_} = @$self;
+ push(@$self, $_);
+ }
+}
+
+sub POP
+{
+ my $self = shift;
+ return undef if @$self < 2;
+ my $key = pop @$self;
+ delete $self->[0]->{$key};
+ return $key;
+}
+
+sub SHIFT
+{
+ my $self = shift;
+ return undef if @$self < 2;
+ my $key = splice(@$self, 1, 1);
+ delete $self->[0]->{$key};
+ return $key;
+}
+
+sub UNSHIFT
+{
+ my $self = shift;
+ $self->SPLICE(0, 0, @_);
+}
+
+sub SPLICE
+{
+ my $self = shift;
+
+ my $offset = shift // 0;
+ $self->_translate_num_key($offset, 1);
+ my $maxrm = @$self - $offset;
+
+ my $length = shift;
+ if (defined $length) {
+ $length = $maxrm - (-$length) if $length < 0;
+ $length = $maxrm if $length > $maxrm;
+ } else {
+ $length = $maxrm;
+ }
+
+ # do not ever dream of adding items here
+ my @ret = splice(@$self, $offset, $length);
+
+ for (@ret) {
+ delete $self->[0]->{$_};
+ }
+ for ($offset .. scalar(@$self) - 1) {
+ $self->[0]->{$self->[$_]} -= $length;
+ }
+
+ return @ret unless scalar(@_);
+
+ if ($length == $maxrm) {
+ # simply add items to the end
+ $self->PUSH(@_);
+ return @ret;
+ }
+
+ my $newpos = $offset;
+ for (@_) {
+ my $index = $self->[0]->{$_};
+ if (defined $index) {
+ if ($index < $offset) {
+ # skip current item totally
+ continue;
+ } elsif ($index == $offset) {
+ # skip adding but act as if added
+ $self->[0]->{$_} += $newpos - $offset;
+ $newpos++;
+ next;
+ }
+ splice(@$self, $index, 1);
+ }
+ splice(@$self, $newpos, 0, $_);
+ $self->[0]->{$_} = $newpos++;
+ }
+ for ($newpos .. scalar(@$self) - 1) {
+ $self->[0]->{$self->[$_]} += $newpos - $offset;
+ }
+ return @ret;
+}
+
+
+=head1 test
+package main;
+
+my $r = ['/path0', '/path1'];
+tie(@$r, 'LT::UList');
+#push(@$r, '/path0');
+#push(@$r, '/path1');
+push(@$r, '/path2');
+push(@$r, '/path3');
+push(@$r, '/path4');
+push(@$r, '/path3');
+push(@$r, '/path1');
+push(@$r, '/path5');
+say "spliced: ".join(", ", splice(@$r, 2, 2, '/pathAdd1', '/pathAdd2',
'/pathAdd1'));
+#say "a: ".join(", ", @a);
+say "r: ".join(", ", @$r);
+#say "r2: ".join(", ", @$r2);
+=cut
Index: LT/Util.pm
===================================================================
RCS file: /cvs/src/usr.bin/libtool/LT/Util.pm,v
retrieving revision 1.5
diff -u -p -r1.5 Util.pm
--- LT/Util.pm 10 Jul 2012 12:24:45 -0000 1.5
+++ LT/Util.pm 19 Jan 2014 14:24:32 -0000
@@ -20,27 +20,12 @@ use warnings;
package LT::Util;
require Exporter;
our @ISA = qw(Exporter);
-our @EXPORT = qw(reverse_zap_duplicates_ref abs_dir $ltdir $version shortdie);
+our @EXPORT = qw(abs_dir $ltdir $version shortdie);
use File::Basename;
use Cwd;
our $ltdir = '.libs';
our $version = '1.5.26'; # pretend to be this version of libtool
-
-# walk a list from back to front, removing any duplicates
-# this should make sure a library's dependencies are behind the library itself
-sub reverse_zap_duplicates_ref
-{
- my $arglist = shift;
- my $h = {};
- my $r = [];
- for my $el (reverse @$arglist) {
- next if defined $h->{$el};
- unshift @$r, $el;
- $h->{$el} = 1;
- }
- return $r;
-}
sub abs_dir
{
Index: LT/Mode/Link.pm
===================================================================
RCS file: /cvs/src/usr.bin/libtool/LT/Mode/Link.pm,v
retrieving revision 1.24
diff -u -p -r1.24 Link.pm
--- LT/Mode/Link.pm 10 Jan 2013 21:34:29 -0000 1.24
+++ LT/Mode/Link.pm 19 Jan 2014 14:24:32 -0000
@@ -21,23 +21,20 @@ use feature qw(say);
# supplement OSConfig with stuff needed.
package LT::OSConfig;
+require LT::UList;
+
+my $search_dir_obj = tie(my @search_dir_list, 'LT::UList');
-my ($search_dir_hash, $search_dir_list);
sub fillup_search_dirs
{
- return if defined $search_dir_list;
- $search_dir_list = [];
- $search_dir_hash = {};
+ return if @search_dir_list;
open(my $fh, '-|', '/sbin/ldconfig -r');
if (!defined $fh) {
die "Can't run ldconfig\n";
}
while (<$fh>) {
if (m/^\s*search directories:\s*(.*?)\s*$/o) {
- foreach my $d (split(/\:/o, $1)) {
- push @$search_dir_list, $d;
- $search_dir_hash->{$d} = 1;
- }
+ push @search_dir_list, split(/\:/o, $1);
last;
}
}
@@ -48,14 +45,14 @@ sub search_dirs
{
my $self = shift;
$self->fillup_search_dirs;
- return @$search_dir_list;
+ return @search_dir_list;
}
sub is_search_dir
{
my ($self, $dir) = @_;
$self->fillup_search_dirs;
- return $search_dir_hash->{$dir};
+ return $search_dir_obj->exists($dir);
}
@@ -120,12 +117,11 @@ sub run
my $noshared = $ltconfig->noshared;
my $cmd;
- my $libdirs = []; # list of libdirs
- my $libs = LT::Library::Stash->new; # libraries
- my $dirs = {}; # paths to find libraries
- # put a priority in the dir hash
- # always look here
- $dirs->{'/usr/lib'} = 3;
+ my $libdirs = []; # list of libdirs
+ tie (@$libdirs, 'LT::UList');
+ my $libs = LT::Library::Stash->new; # libraries
+ my $dirs = []; # paths to find libraries
+ tie (@$dirs, 'LT::UList', '/usr/lib'); # always look here
$gp->handle_permuted_options(
'all-static',
@@ -202,6 +198,7 @@ sub run
tsay {"sobjs = @sobjs"};
my $deplibs = []; # list of dependent libraries (both -L and -l
flags)
+ tie (@$deplibs, 'LT::UList');
my $parser = LT::Parser->new(\@ARGV);
if ($linkmode == PROGRAM) {
@@ -227,8 +224,8 @@ sub run
tsay {"hoping for real objects in ARGV..."};
}
}
- my $RPdirs = [];
- @$RPdirs = (@Ropts, @RPopts, $gp->Rresolved);
+ tie(my @temp, 'LT::UList', @Ropts, @RPopts, $gp->Rresolved);
+ my $RPdirs = \@temp;
$program->{RPdirs} = $RPdirs;
$program->link($ltprog, $ltconfig, $dirs, $libs, $deplibs,
$libdirs, $parser, $gp);
@@ -326,9 +323,7 @@ sub run
map { $_ = "-R$_" } @Ropts;
unshift @$deplibs, @Ropts if @Ropts;
tsay {"deplibs = @$deplibs"};
- my $finaldeplibs = reverse_zap_duplicates_ref($deplibs);
- tsay {"finaldeplibs = @$finaldeplibs"};
- $lainfo->set('dependency_libs', "@$finaldeplibs");
+ $lainfo->set('dependency_libs', "@$deplibs");
if (@RPopts) {
if (@RPopts > 1) {
tsay {"more than 1 -rpath option given, ",
@@ -343,7 +338,7 @@ sub run
}
my $lai = "$odir/$ltdir/$ofile".'i';
if ($shared) {
- my $pdeplibs = process_deplibs($finaldeplibs);
+ my $pdeplibs = process_deplibs($deplibs);
if (defined $pdeplibs) {
$lainfo->set('dependency_libs', "@$pdeplibs");
}
@@ -430,8 +425,7 @@ sub process_deplibs
# XXX improve checks when adding to deplibs
say "warning: $lf dropped from deplibs";
} else {
- $lf = $libdir.'/'.$lafile;
- push @$result, $lf;
+ push @$result, $libdir.'/'.$lafile;
}
} else {
push @$result, $lf;
@@ -443,6 +437,7 @@ sub process_deplibs
package LT::Parser;
use File::Basename;
use Cwd qw(abs_path);
+use LT::UList;
use LT::Util;
use LT::Trace;
@@ -452,18 +447,16 @@ sub build_cache
{
my ($self, $lainfo, $level) = @_;
my $o = $lainfo->{cached} = {
- deplibs => [], libdirs => [], result => []};
+ deplibs => [], libdirs => [], result => [] };
+ tie @{$o->{deplibs}}, 'LT::UList';
+ tie @{$o->{libdirs}}, 'LT::UList';
+ tie @{$o->{result}}, 'LT::UList';
$self->internal_resolve_la($o, $lainfo->deplib_list,
$level+1);
push(@{$o->{deplibs}}, @{$lainfo->deplib_list});
if ($lainfo->{libdir} ne '') {
push(@{$o->{libdirs}}, $lainfo->{libdir});
}
- for my $e (qw(deplibs libdirs result)) {
- if (@{$o->{$e}} > 50) {
- $o->{$e} = reverse_zap_duplicates_ref($o->{$e});
- }
- }
}
sub internal_resolve_la
@@ -539,12 +532,11 @@ sub internal_parse_linkargs1
# first read all directories where we can search libraries
foreach my $_ (@$args) {
if (m/^-L(.*)/) {
- if (!exists $dirs->{$1}) {
- $dirs->{$1} = 1;
- tsay {" adding $_ to deplibs"}
- if $level == 0;
- push @$deplibs, $_;
- }
+ push @$dirs, $1;
+ # XXX could not be adding actually, this is UList
+ tsay {" adding $_ to deplibs"}
+ if $level == 0;
+ push @$deplibs, $_;
}
}
foreach my $_ (@$args) {
@@ -597,12 +589,12 @@ sub internal_parse_linkargs1
$libs, \@largs, $level+1) if @largs;
} elsif (m/(\S+\/)*(\S+)\.a$/) {
(my $key = $2) =~ s/^lib//;
- $dirs->{abs_dir($_)} = 1;
+ push(@$dirs, abs_dir($_));
$libs->create($key)->{fullpath} = $_;
push(@$result, $_);
} elsif (m/(\S+\/)*(\S+)\.la$/) {
(my $key = $2) =~ s/^lib//;
- $dirs->{abs_dir($_)} = 1;
+ push(@$dirs, abs_dir($_));
my $fulla = abs_path($_);
require LT::LaFile;
my $lainfo = LT::LaFile->parse($fulla);
@@ -618,7 +610,7 @@ sub internal_parse_linkargs1
push(@$deplibs, $fulla) if $libdir ne '';
} elsif (m/(\S+\/)*(\S+)\.so(\.\d+){2}/) {
(my $key = $2) =~ s/^lib//;
- $dirs->{abs_dir($_)} = 1;
+ push(@$dirs, abs_dir($_));
$libs->create($key);
# not really normal argument
# -lfoo should be used instead, so convert it
@@ -667,9 +659,7 @@ sub parse_linkargs2
} elsif ($_ eq '-pthread') {
$self->{pthread} = 1;
} elsif (m/^-L(.*)/) {
- if (!exists $dirs->{$1}) {
- $dirs->{$1} = 1;
- }
+ push(@$dirs, $1);
} elsif (m/^-R(.*)/) {
# -R options originating from .la resolution
# those from @ARGV are in @Ropts
@@ -686,7 +676,7 @@ sub parse_linkargs2
} elsif (m/(\S+\/)*(\S+)\.la$/) {
(my $key = $2) =~ s/^lib//;
my $d = abs_dir($_);
- $dirs->{$d} = 1;
+ push(@$dirs, $d);
my $fulla = abs_path($_);
require LT::LaFile;
my $lainfo = LT::LaFile->parse($fulla);
@@ -751,12 +741,12 @@ sub create_symlinks
next if !defined $f;
next if $f =~ m/\.a$/;
my $libnames = [];
+ tie (@$libnames, 'LT::UList');
if (defined $l->{lafile}) {
require LT::LaFile;
my $lainfo = LT::LaFile->parse($l->{lafile});
my $librarynames = $lainfo->stringize('library_names');
- @$libnames = split /\s/, $librarynames;
- $libnames = reverse_zap_duplicates_ref($libnames);
+ push @$libnames, split(/\s/, $librarynames);
} else {
push @$libnames, basename($f);
}
@@ -780,13 +770,12 @@ sub common1
$parser->resolve_la($deplibs, $libdirs);
my $orderedlibs = [];
+ tie(@$orderedlibs, 'LT::UList');
my $staticlibs = [];
my $args = $parser->parse_linkargs2($gp, $orderedlibs, $staticlibs,
$dirs,
$libs);
tsay {"staticlibs = \n", join("\n", @$staticlibs)};
tsay {"orderedlibs = @$orderedlibs"};
- $orderedlibs = reverse_zap_duplicates_ref($orderedlibs);
- tsay {"final orderedlibs = @$orderedlibs"};
return ($staticlibs, $orderedlibs, $args);
}
Index: LT/Mode/Link/Program.pm
===================================================================
RCS file: /cvs/src/usr.bin/libtool/LT/Mode/Link/Program.pm,v
retrieving revision 1.3
diff -u -p -r1.3 Program.pm
--- LT/Mode/Link/Program.pm 9 Nov 2012 10:55:01 -0000 1.3
+++ LT/Mode/Link/Program.pm 19 Jan 2014 14:24:32 -0000
@@ -68,7 +68,6 @@ sub link
$dst = ($odir eq '.') ? $fname : "$odir/$fname";
}
- $libdirs = reverse_zap_duplicates_ref($libdirs);
my $rpath_link = {};
# add libdirs to rpath if they are not in standard lib path
for my $l (@$libdirs) {
@@ -78,7 +77,6 @@ sub link
push @$RPdirs, $l;
}
}
- $RPdirs = reverse_zap_duplicates_ref($RPdirs);
foreach my $k (keys %$libs) {
tprint {"key = $k - "};
my $r = ref($libs->{$k});
