diff options
| author | Kevin Ryde <user42@zip.com.au> | 2006-04-16 23:37:40 +0000 |
|---|---|---|
| committer | Kevin Ryde <user42@zip.com.au> | 2006-04-16 23:37:40 +0000 |
| commit | 6e7d5622eebd416d95e487cc358ee19d0a22c762 (patch) | |
| tree | 405ef9b19ae23d270bf990aa994fe7497d506a36 | |
| parent | 1b09b607dd1096ab572afe0667e8602560622624 (diff) | |
| download | guile-6e7d5622eebd416d95e487cc358ee19d0a22c762.tar.gz | |
merge from 1.8 branch
155 files changed, 625 insertions, 9380 deletions
diff --git a/benchmark-suite/guile-benchmark b/benchmark-suite/guile-benchmark index 4d3649dad..c4c6f23de 100755 --- a/benchmark-suite/guile-benchmark +++ b/benchmark-suite/guile-benchmark @@ -5,7 +5,7 @@ ;;;; guile-benchmark --- run the Guile benchmark suite ;;;; Adapted from code by Jim Blandy <jimb@red-bean.com> --- May 1999 ;;;; -;;;; Copyright (C) 2002 Free Software Foundation, Inc. +;;;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/benchmark-suite/lib.scm b/benchmark-suite/lib.scm index a2c1f879a..65491d735 100644 --- a/benchmark-suite/lib.scm +++ b/benchmark-suite/lib.scm @@ -1,5 +1,5 @@ ;;;; benchmark-suite/lib.scm --- generic support for benchmarking -;;;; Copyright (C) 2002 Free Software Foundation, Inc. +;;;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/emacs/gud-guile.el b/emacs/gud-guile.el index 036194663..bd1b0ff26 100644 --- a/emacs/gud-guile.el +++ b/emacs/gud-guile.el @@ -1,6 +1,6 @@ ;;; gud-guile.el --- Support for debugging guile internals -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/emacs/guile-c.el b/emacs/guile-c.el index af74b81e0..b23ddd30f 100644 --- a/emacs/guile-c.el +++ b/emacs/guile-c.el @@ -1,6 +1,6 @@ ;;; guile-c.el --- Guile C editing commands -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/emacs/guile-scheme.el b/emacs/guile-scheme.el index 5bd9a7c24..a6d8b1f19 100644 --- a/emacs/guile-scheme.el +++ b/emacs/guile-scheme.el @@ -1,6 +1,6 @@ ;;; guile-scheme.el --- Guile Scheme editing mode -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/emacs/multistring.el b/emacs/multistring.el index 25141ac58..ca17a8469 100644 --- a/emacs/multistring.el +++ b/emacs/multistring.el @@ -1,6 +1,6 @@ ;;; multistring.el --- editing multiline strings. -;; Copyright (C) 2000 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2006 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/emacs/patch.el b/emacs/patch.el index 735a5468b..6bcb0876f 100644 --- a/emacs/patch.el +++ b/emacs/patch.el @@ -1,6 +1,6 @@ ;;; patch.el --- mail/apply a patch -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/emacs/ppexpand.el b/emacs/ppexpand.el index 2beb3bff6..7ec3b1c45 100644 --- a/emacs/ppexpand.el +++ b/emacs/ppexpand.el @@ -1,6 +1,6 @@ ;;; ppexpand.el --- temporarily expanding macros in a pretty way. -;; Copyright (C) 2000 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2006 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/emacs/update-changelog.el b/emacs/update-changelog.el index 96db255b2..e0c0a4b11 100644 --- a/emacs/update-changelog.el +++ b/emacs/update-changelog.el @@ -1,6 +1,6 @@ ;;; update-changelog.el --- stitch rcs2log output to ChangeLog -;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/examples/Makefile.am b/examples/Makefile.am index 4b865c9ee..ddea2663c 100644 --- a/examples/Makefile.am +++ b/examples/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 2001 Free Software Foundation, Inc. +## Copyright (C) 2001, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/examples/box-dynamic-module/Makefile.am b/examples/box-dynamic-module/Makefile.am index 9127ee500..bf18f4f66 100644 --- a/examples/box-dynamic-module/Makefile.am +++ b/examples/box-dynamic-module/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 2001 Free Software Foundation, Inc. +## Copyright (C) 2001, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/examples/box-dynamic-module/box.c b/examples/box-dynamic-module/box.c index bb25e5cc9..7d6e2ce5d 100644 --- a/examples/box-dynamic-module/box.c +++ b/examples/box-dynamic-module/box.c @@ -1,6 +1,6 @@ /* examples/box-dynamic-module/box.c * - * Copyright (C) 1998,2001 Free Software Foundation, Inc. + * Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by diff --git a/examples/box-dynamic/Makefile.am b/examples/box-dynamic/Makefile.am index 442af724a..6fa20c59c 100644 --- a/examples/box-dynamic/Makefile.am +++ b/examples/box-dynamic/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 2001 Free Software Foundation, Inc. +## Copyright (C) 2001, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/examples/box-dynamic/box.c b/examples/box-dynamic/box.c index 6f26c8d76..bb9529650 100644 --- a/examples/box-dynamic/box.c +++ b/examples/box-dynamic/box.c @@ -1,6 +1,6 @@ /* examples/box-dynamic/box.c * - * Copyright (C) 1998,2001 Free Software Foundation, Inc. + * Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by diff --git a/examples/box-module/Makefile.am b/examples/box-module/Makefile.am index a1a796e21..4790a296c 100644 --- a/examples/box-module/Makefile.am +++ b/examples/box-module/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 2001 Free Software Foundation, Inc. +## Copyright (C) 2001, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/examples/box-module/box.c b/examples/box-module/box.c index 07d54f0c4..b589b262f 100644 --- a/examples/box-module/box.c +++ b/examples/box-module/box.c @@ -1,6 +1,6 @@ /* examples/box-module/box.c * - * Copyright (C) 1998,2001 Free Software Foundation, Inc. + * Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by diff --git a/examples/box/Makefile.am b/examples/box/Makefile.am index a1a796e21..4790a296c 100644 --- a/examples/box/Makefile.am +++ b/examples/box/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 2001 Free Software Foundation, Inc. +## Copyright (C) 2001, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/examples/box/box.c b/examples/box/box.c index 2dad082cd..e36d650b3 100644 --- a/examples/box/box.c +++ b/examples/box/box.c @@ -1,6 +1,6 @@ /* examples/box/box.c * - * Copyright (C) 1998,2001 Free Software Foundation, Inc. + * Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by diff --git a/examples/compat/compat.h b/examples/compat/compat.h index 839025fd0..7c6d2aa71 100644 --- a/examples/compat/compat.h +++ b/examples/compat/compat.h @@ -2,7 +2,7 @@ #ifndef COMPATH #define COMPATH -/* Copyright (C) 2001, 2002 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2002, 2006 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by diff --git a/examples/modules/Makefile.am b/examples/modules/Makefile.am index 215ba5ddf..80b829b03 100644 --- a/examples/modules/Makefile.am +++ b/examples/modules/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 2001 Free Software Foundation, Inc. +## Copyright (C) 2001, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/examples/safe/Makefile.am b/examples/safe/Makefile.am index 3564e4f23..a2e966296 100644 --- a/examples/safe/Makefile.am +++ b/examples/safe/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 2001 Free Software Foundation, Inc. +## Copyright (C) 2001, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/examples/scripts/Makefile.am b/examples/scripts/Makefile.am index 8d410c052..cd588f543 100644 --- a/examples/scripts/Makefile.am +++ b/examples/scripts/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 2001 Free Software Foundation, Inc. +## Copyright (C) 2001, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/guile-config/Makefile.am b/guile-config/Makefile.am index c6f691e65..be61fcdba 100644 --- a/guile-config/Makefile.am +++ b/guile-config/Makefile.am @@ -1,7 +1,7 @@ ## Process this file with Automake to create Makefile.in ## Jim Blandy <jimb@red-bean.com> --- September 1997 ## -## Copyright (C) 1998, 1999, 2001 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2001, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/guile-config/guile-config.in b/guile-config/guile-config.in index 1ee3215cd..04a4f0575 100644 --- a/guile-config/guile-config.in +++ b/guile-config/guile-config.in @@ -4,7 +4,7 @@ ;;;; guile-config --- utility for linking programs with Guile ;;;; Jim Blandy <jim@red-bean.com> --- September 1997 ;;;; -;;;; Copyright (C) 1998, 2001, 2004, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 1998, 2001, 2004, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/guile-config/guile.m4 b/guile-config/guile.m4 index af0172f7f..fc248843d 100644 --- a/guile-config/guile.m4 +++ b/guile-config/guile.m4 @@ -1,6 +1,6 @@ ## Autoconf macros for working with Guile. ## -## Copyright (C) 1998,2001 Free Software Foundation, Inc. +## Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc. ## ## This library is free software; you can redistribute it and/or ## modify it under the terms of the GNU Lesser General Public diff --git a/guile-config/qthreads.m4 b/guile-config/qthreads.m4 index 0eacc0b3d..8aeba1748 100644 --- a/guile-config/qthreads.m4 +++ b/guile-config/qthreads.m4 @@ -1,7 +1,7 @@ dnl Autoconf macros for configuring the QuickThreads package dnl Jim Blandy <jimb@red-bean.com> --- July 1998 dnl -dnl Copyright (C) 1998, 1999 Free Software Foundation, Inc. +dnl Copyright (C) 1998, 1999, 2006 Free Software Foundation, Inc. dnl dnl This file is part of GUILE. dnl diff --git a/lang/Makefile.am b/lang/Makefile.am index d4019adfc..5c02db63c 100644 --- a/lang/Makefile.am +++ b/lang/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 2000 Free Software Foundation, Inc. +## Copyright (C) 2000, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/lang/elisp/Makefile.am b/lang/elisp/Makefile.am index ece4dcc93..390bf7427 100644 --- a/lang/elisp/Makefile.am +++ b/lang/elisp/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998, 1999, 2000, 2001, 2004 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2004, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/lang/elisp/internals/Makefile.am b/lang/elisp/internals/Makefile.am index 2509212c6..2022a90c3 100644 --- a/lang/elisp/internals/Makefile.am +++ b/lang/elisp/internals/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998, 1999, 2000, 2001, 2004 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2004, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/lang/elisp/primitives/Makefile.am b/lang/elisp/primitives/Makefile.am index eb7bbdbe8..b2f62a50a 100644 --- a/lang/elisp/primitives/Makefile.am +++ b/lang/elisp/primitives/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998, 1999, 2000, 2001, 2004 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2004, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/libguile-ltdl/Makefile.am b/libguile-ltdl/Makefile.am index bc83058f3..e69de29bb 100644 --- a/libguile-ltdl/Makefile.am +++ b/libguile-ltdl/Makefile.am @@ -1,44 +0,0 @@ -## Process this file with Automake to create Makefile.in -## -## Copyright (C) 2002 Free Software Foundation, Inc. -## -## This file is part of GUILE. -## -## GUILE is free software; you can redistribute it and/or modify -## it under the terms of the GNU General Public License as -## published by the Free Software Foundation; either version 2, or -## (at your option) any later version. -## -## GUILE is distributed in the hope that it will be useful, but -## WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public -## License along with GUILE; see the file COPYING. If not, write -## to the Free Software Foundation, Inc., 51 Franklin Street, Fifth -## Floor, Boston, MA 02110-1301 USA - -SUBDIRS = upstream - -AUTOMAKE_OPTIONS = gnu - -## Prevent automake from adding extra -I options -DEFS = @DEFS@ -## Check for headers in $(srcdir)/.., so that #include -## <libguile/MUMBLE.h> will find MUMBLE.h in this dir when we're -## building. -INCLUDES = -I. -I$(srcdir) -I.. -I$(srcdir)/.. - -ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_LONG\).*\"\([^\"]\)*\"/\3/' \ - --regex='/[ \t]*SCM_[G]?DEFINE1?[ \t]*(\([^,]*\),[^,]*/\1/' - -# We don't install this header since no one should be using the lib directly. -EXTRA_HEADERS = guile-ltdl.h raw-ltdl.h -EXTRA_DIST = raw-ltdl.c $(EXTRA_HEADERS) - -lib_LTLIBRARIES = libguile-ltdl.la -libguile_ltdl_la_SOURCES = guile-ltdl.c -#libguile_ltdl_la_DEPENDENCIES = -libguile_ltdl_la_LIBADD = ${LIBADD_DL} -libguile_ltdl_la_LDFLAGS = -version-info 2:0:0 -export-dynamic -no-undefined diff --git a/libguile-ltdl/guile-ltdl.c b/libguile-ltdl/guile-ltdl.c index 89d35afad..e69de29bb 100644 --- a/libguile-ltdl/guile-ltdl.c +++ b/libguile-ltdl/guile-ltdl.c @@ -1,80 +0,0 @@ -/* ltdl.c -- system independent dlopen wrapper - Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. - Originally by Thomas Tanner <tanner@ffii.org> - This file is part of GNU Libtool. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Lesser General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -As a special exception to the GNU Lesser General Public License, -if you distribute this file as part of a program or library that -is built using GNU libtool, you may include it under the same -distribution terms that you use for the rest of that program. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with this library; if not, write to the Free Software -Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -02110-1301 USA - -*/ - -#include "guile-ltdl.h" - -#define lt_dlhandle_struct scm_i_lt_dlhandle_struct -#define SCM_INSERTED_DLSYMLIST_STRUCT_DECL scm_i_lt_dlsymlist_struct - -#define LT_SCOPE static -#define SCMLTXT static -#define SCMLTSTATIC static - -#ifdef __GNUC__ -#define SCM_UNUSED __attribute__ ((unused)) -#else -#define SCM_UNUSED -#endif - -#include "raw-ltdl.h" -#include "raw-ltdl.c" - -void -scm_lt_dlpreload_default (const scm_lt_dlsymlist *preloads) -{ - lt_dlpreload_default(preloads); -} - -int -scm_lt_dlinit (void) -{ - return lt_dlinit (); -} - -scm_lt_dlhandle -scm_lt_dlopenext (const char *filename) -{ - return lt_dlopenext (filename); -} - -scm_lt_ptr -scm_lt_dlsym (scm_lt_dlhandle handle, const char *name) -{ - return lt_dlsym (handle, name); -} - -const char * -scm_lt_dlerror (void) -{ - return lt_dlerror (); -} - -int -scm_lt_dlclose (scm_lt_dlhandle handle) -{ - return lt_dlclose (handle); -} diff --git a/libguile-ltdl/guile-ltdl.h b/libguile-ltdl/guile-ltdl.h index 07fe646be..e69de29bb 100644 --- a/libguile-ltdl/guile-ltdl.h +++ b/libguile-ltdl/guile-ltdl.h @@ -1,40 +0,0 @@ -/* guile-ltdl.h -- dlopen function actually used by guile - Copyright (C) 1998-2000, 2002 Free Software Foundation, Inc. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Lesser General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -As a special exception to the GNU Lesser General Public License, -if you distribute this file as part of a program or library that -is built using GNU libtool, you may include it under the same -distribution terms that you use for the rest of that program. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with this library; if not, write to the Free -Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -02110-1301 USA -*/ - -/* Only include this header file once. */ -#ifndef SCM_LTDL_H -#define SCM_LTDL_H 1 - -typedef struct scm_i_lt_dlhandle_struct *scm_lt_dlhandle; -typedef struct scm_i_lt_dlsymlist_struct scm_lt_dlsymlist; -typedef void * scm_lt_ptr; - -void scm_lt_dlpreload_default (const scm_lt_dlsymlist *preloads); -int scm_lt_dlinit (void); -scm_lt_dlhandle scm_lt_dlopenext (const char *filename); -scm_lt_ptr scm_lt_dlsym (scm_lt_dlhandle handle, const char *name); -const char *scm_lt_dlerror (void); -int scm_lt_dlclose (scm_lt_dlhandle handle); - -#endif /* !SCM_LTDL_H */ diff --git a/libguile-ltdl/raw-ltdl.c b/libguile-ltdl/raw-ltdl.c index 43591ef6b..e69de29bb 100644 --- a/libguile-ltdl/raw-ltdl.c +++ b/libguile-ltdl/raw-ltdl.c @@ -1,4008 +0,0 @@ -/* ltdl.c -- system independent dlopen wrapper - Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. - Originally by Thomas Tanner <tanner@ffii.org> - This file is part of GNU Libtool. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Lesser General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -As a special exception to the GNU Lesser General Public License, -if you distribute this file as part of a program or library that -is built using GNU libtool, you may include it under the same -distribution terms that you use for the rest of that program. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with this library; if not, write to the Free Software -Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -02110-1301 USA - -*/ - -#if HAVE_CONFIG_H -# include <config.h> -#endif - -#if HAVE_UNISTD_H -# include <unistd.h> -#endif - -#if HAVE_STDIO_H -# include <stdio.h> -#endif - -#if HAVE_STDLIB_H -# include <stdlib.h> -#endif - -#if HAVE_STRING_H -# include <string.h> -#else -# if HAVE_STRINGS_H -# include <strings.h> -# endif -#endif - -#if HAVE_CTYPE_H -# include <ctype.h> -#endif - -#if HAVE_MALLOC_H -# include <malloc.h> -#endif - -#if HAVE_MEMORY_H -# include <memory.h> -#endif - -#if HAVE_ERRNO_H -# include <errno.h> -#endif - -#if HAVE_DIRENT_H -# include <dirent.h> -# define LT_D_NAMLEN(dirent) (strlen((dirent)->d_name)) -#else -# define dirent direct -# define LT_D_NAMLEN(dirent) ((dirent)->d_namlen) -# if HAVE_SYS_NDIR_H -# include <sys/ndir.h> -# endif -# if HAVE_SYS_DIR_H -# include <sys/dir.h> -# endif -# if HAVE_NDIR_H -# include <ndir.h> -# endif -#endif - -#if HAVE_ARGZ_H -# include <argz.h> -#endif - -#if HAVE_ASSERT_H -# include <assert.h> -#else -# define assert(arg) ((void) 0) -#endif - -#include "raw-ltdl.h" - -#if WITH_DMALLOC -# include <dmalloc.h> -#endif - - -/* Saves on those hard to debug '\0' typos.... */ -#define LT_EOS_CHAR '\0' - - -/* --- WINDOWS SUPPORT --- */ - - -#ifdef DLL_EXPORT -# define LT_GLOBAL_DATA __declspec(dllexport) -#else -# define LT_GLOBAL_DATA -#endif - -/* fopen() mode flags for reading a text file */ -#undef LT_READTEXT_MODE -#ifdef __WINDOWS__ -# define LT_READTEXT_MODE "rt" -#else -# define LT_READTEXT_MODE "r" -#endif - - - - -/* --- MANIFEST CONSTANTS --- */ - - -/* Standard libltdl search path environment variable name */ -#undef LTDL_SEARCHPATH_VAR -#define LTDL_SEARCHPATH_VAR "LTDL_LIBRARY_PATH" - -/* Standard libtool archive file extension. */ -#undef LTDL_ARCHIVE_EXT -#define LTDL_ARCHIVE_EXT ".la" - -/* max. filename length */ -#ifndef LT_FILENAME_MAX -# define LT_FILENAME_MAX 1024 -#endif - -/* This is the maximum symbol size that won't require malloc/free */ -#undef LT_SYMBOL_LENGTH -#define LT_SYMBOL_LENGTH 128 - -/* This accounts for the _LTX_ separator */ -#undef LT_SYMBOL_OVERHEAD -#define LT_SYMBOL_OVERHEAD 5 - - - - -/* --- MEMORY HANDLING --- */ - - -/* These are the functions used internally. In addition to making - use of the associated function pointers above, they also perform - error handling. */ -static char *lt_estrdup LT_PARAMS((const char *str)); -static lt_ptr lt_emalloc LT_PARAMS((size_t size)); -static lt_ptr lt_erealloc LT_PARAMS((lt_ptr addr, size_t size)); - -#define rpl_realloc realloc - -/* These are the pointers that can be changed by the caller: */ -SCMLTSTATIC lt_ptr (*lt_dlmalloc) LT_PARAMS((size_t size)) - = (lt_ptr (*) LT_PARAMS((size_t))) malloc; -SCMLTSTATIC lt_ptr (*lt_dlrealloc) LT_PARAMS((lt_ptr ptr, size_t size)) - = (lt_ptr (*) LT_PARAMS((lt_ptr, size_t))) rpl_realloc; -SCMLTSTATIC void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)) - = (void (*) LT_PARAMS((lt_ptr))) free; - -/* The following macros reduce the amount of typing needed to cast - assigned memory. */ -#if WITH_DMALLOC - -#define LT_DLMALLOC(tp, n) ((tp *) xmalloc ((n) * sizeof(tp))) -#define LT_DLREALLOC(tp, p, n) ((tp *) xrealloc ((p), (n) * sizeof(tp))) -#define LT_DLFREE(p) \ - LT_STMT_START { if (p) (p) = (xfree (p), (lt_ptr) 0); } LT_STMT_END - -#define LT_EMALLOC(tp, n) ((tp *) xmalloc ((n) * sizeof(tp))) -#define LT_EREALLOC(tp, p, n) ((tp *) xrealloc ((p), (n) * sizeof(tp))) - -#else - -#define LT_DLMALLOC(tp, n) ((tp *) lt_dlmalloc ((n) * sizeof(tp))) -#define LT_DLREALLOC(tp, p, n) ((tp *) rpl_realloc ((p), (n) * sizeof(tp))) -#define LT_DLFREE(p) \ - LT_STMT_START { if (p) (p) = (lt_dlfree (p), (lt_ptr) 0); } LT_STMT_END - -#define LT_EMALLOC(tp, n) ((tp *) lt_emalloc ((n) * sizeof(tp))) -#define LT_EREALLOC(tp, p, n) ((tp *) lt_erealloc ((p), (n) * sizeof(tp))) - -#endif - -#define LT_DLMEM_REASSIGN(p, q) LT_STMT_START { \ - if ((p) != (q)) { if (p) lt_dlfree (p); (p) = (q); (q) = 0; } \ - } LT_STMT_END - - -/* --- REPLACEMENT FUNCTIONS --- */ - - -#undef strdup -#define strdup rpl_strdup - -static char *strdup LT_PARAMS((const char *str)); - -static char * -strdup(str) - const char *str; -{ - char *tmp = NULL; - - if (str) - { - tmp = LT_DLMALLOC (char, 1+ strlen (str)); - if (tmp) - { - strcpy(tmp, str); - } - } - - return tmp; -} - - -#if ! HAVE_STRCMP - -#undef strcmp -#define strcmp rpl_strcmp - -static int strcmp LT_PARAMS((const char *str1, const char *str2)); - -static int -strcmp (str1, str2) - const char *str1; - const char *str2; -{ - if (str1 == str2) - return 0; - if (str1 == NULL) - return -1; - if (str2 == NULL) - return 1; - - for (;*str1 && *str2; ++str1, ++str2) - { - if (*str1 != *str2) - break; - } - - return (int)(*str1 - *str2); -} -#endif - - -#if ! HAVE_STRCHR - -# if HAVE_INDEX -# define strchr index -# else -# define strchr rpl_strchr - -static const char *strchr LT_PARAMS((const char *str, int ch)); - -static const char* -strchr(str, ch) - const char *str; - int ch; -{ - const char *p; - - for (p = str; *p != (char)ch && *p != LT_EOS_CHAR; ++p) - /*NOWORK*/; - - return (*p == (char)ch) ? p : 0; -} - -# endif -#endif /* !HAVE_STRCHR */ - - -#if ! HAVE_STRRCHR - -# if HAVE_RINDEX -# define strrchr rindex -# else -# define strrchr rpl_strrchr - -static const char *strrchr LT_PARAMS((const char *str, int ch)); - -static const char* -strrchr(str, ch) - const char *str; - int ch; -{ - const char *p, *q = NULL; - - for (p = str; *p != LT_EOS_CHAR; ++p) - { - if (*p == (char) ch) - { - q = p; - } - } - - return q; -} - -# endif -#endif - -/* NOTE: Neither bcopy nor the memcpy implementation below can - reliably handle copying in overlapping areas of memory. Use - memmove (for which there is a fallback implmentation below) - if you need that behaviour. */ -#if ! HAVE_MEMCPY - -# if HAVE_BCOPY -# define memcpy(dest, src, size) bcopy (src, dest, size) -# else -# define memcpy rpl_memcpy - -static lt_ptr memcpy LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size)); - -static lt_ptr -memcpy (dest, src, size) - lt_ptr dest; - const lt_ptr src; - size_t size; -{ - size_t i = 0; - - for (i = 0; i < size; ++i) - { - ((char *) dest)[i] = ((char *) src)[i]; - } - - return dest; -} - -# endif /* !HAVE_BCOPY */ -#endif /* !HAVE_MEMCPY */ - -#if ! HAVE_MEMMOVE -# define memmove rpl_memmove - -static lt_ptr memmove LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size)); - -static lt_ptr -memmove (dest, src, size) - lt_ptr dest; - const lt_ptr src; - size_t size; -{ - size_t i; - - if (dest < src) - for (i = 0; i < size; ++i) - { - dest[i] = src[i]; - } - else if (dest > src) - for (i = size -1; i >= 0; --i) - { - dest[i] = src[i]; - } - - return dest; -} - -#endif /* !HAVE_MEMMOVE */ - - -/* According to Alexandre Oliva <oliva@lsd.ic.unicamp.br>, - ``realloc is not entirely portable'' - In any case we want to use the allocator supplied by the user without - burdening them with an lt_dlrealloc function pointer to maintain. - Instead implement our own version (with known boundary conditions) - using lt_dlmalloc and lt_dlfree. */ - - -#if 0 - - /* You can't (re)define realloc unless you also (re)define malloc. - Right now, this code uses the size of the *destination* to decide - how much to copy. That's not right, but you can't know the size - of the source unless you know enough about, or wrote malloc. So - this code is disabled... */ - -static lt_ptr -realloc (ptr, size) - lt_ptr ptr; - size_t size; -{ - if (size == 0) - { - /* For zero or less bytes, free the original memory */ - if (ptr != NULL) - { - lt_dlfree (ptr); - } - - return (lt_ptr) 0; - } - else if (ptr == NULL) - { - /* Allow reallocation of a NULL pointer. */ - return lt_dlmalloc (size); - } - else - { - /* Allocate a new block, copy and free the old block. */ - lt_ptr mem = lt_dlmalloc (size); - - if (mem) - { - memcpy (mem, ptr, size); - lt_dlfree (ptr); - } - - /* Note that the contents of PTR are not damaged if there is - insufficient memory to realloc. */ - return mem; - } -} - -#endif - - -#if ! HAVE_ARGZ_APPEND -# define argz_append rpl_argz_append - -static error_t argz_append LT_PARAMS((char **pargz, size_t *pargz_len, - const char *buf, size_t buf_len)); - -static error_t -argz_append (pargz, pargz_len, buf, buf_len) - char **pargz; - size_t *pargz_len; - const char *buf; - size_t buf_len; -{ - size_t argz_len; - char *argz; - - assert (pargz); - assert (pargz_len); - assert ((*pargz && *pargz_len) || (!*pargz && !*pargz_len)); - - /* If nothing needs to be appended, no more work is required. */ - if (buf_len == 0) - return 0; - - /* Ensure there is enough room to append BUF_LEN. */ - argz_len = *pargz_len + buf_len; - argz = LT_DLREALLOC (char, *pargz, argz_len); - if (!argz) - return ENOMEM; - - /* Copy characters from BUF after terminating '\0' in ARGZ. */ - memcpy (argz + *pargz_len, buf, buf_len); - - /* Assign new values. */ - *pargz = argz; - *pargz_len = argz_len; - - return 0; -} -#endif /* !HAVE_ARGZ_APPEND */ - - -#if ! HAVE_ARGZ_CREATE_SEP -# define argz_create_sep rpl_argz_create_sep - -static error_t argz_create_sep LT_PARAMS((const char *str, int delim, - char **pargz, size_t *pargz_len)); - -static error_t -argz_create_sep (str, delim, pargz, pargz_len) - const char *str; - int delim; - char **pargz; - size_t *pargz_len; -{ - size_t argz_len; - char *argz = NULL; - - assert (str); - assert (pargz); - assert (pargz_len); - - /* Make a copy of STR, but replacing each occurence of - DELIM with '\0'. */ - argz_len = 1+ LT_STRLEN (str); - if (argz_len) - { - const char *p; - char *q; - - argz = LT_DLMALLOC (char, argz_len); - if (!argz) - return ENOMEM; - - for (p = str, q = argz; *p != LT_EOS_CHAR; ++p) - { - if (*p == delim) - { - /* Ignore leading delimiters, and fold consecutive - delimiters in STR into a single '\0' in ARGZ. */ - if ((q > argz) && (q[-1] != LT_EOS_CHAR)) - *q++ = LT_EOS_CHAR; - else - --argz_len; - } - else - *q++ = *p; - } - /* Copy terminating LT_EOS_CHAR. */ - *q = *p; - } - - /* If ARGZ_LEN has shrunk to nothing, release ARGZ's memory. */ - if (!argz_len) - LT_DLFREE (argz); - - /* Assign new values. */ - *pargz = argz; - *pargz_len = argz_len; - - return 0; -} -#endif /* !HAVE_ARGZ_CREATE_SEP */ - - -#if ! HAVE_ARGZ_INSERT -# define argz_insert rpl_argz_insert - -static error_t argz_insert LT_PARAMS((char **pargz, size_t *pargz_len, - char *before, const char *entry)); - -static error_t -argz_insert (pargz, pargz_len, before, entry) - char **pargz; - size_t *pargz_len; - char *before; - const char *entry; -{ - assert (pargz); - assert (pargz_len); - assert (entry && *entry); - - /* No BEFORE address indicates ENTRY should be inserted after the - current last element. */ - if (!before) - return argz_append (pargz, pargz_len, entry, 1+ LT_STRLEN (entry)); - - /* This probably indicates a programmer error, but to preserve - semantics, scan back to the start of an entry if BEFORE points - into the middle of it. */ - while ((before >= *pargz) && (before[-1] != LT_EOS_CHAR)) - --before; - - { - size_t entry_len = 1+ LT_STRLEN (entry); - size_t argz_len = *pargz_len + entry_len; - size_t offset = before - *pargz; - char *argz = LT_DLREALLOC (char, *pargz, argz_len); - - if (!argz) - return ENOMEM; - - /* Make BEFORE point to the equivalent offset in ARGZ that it - used to have in *PARGZ incase realloc() moved the block. */ - before = argz + offset; - - /* Move the ARGZ entries starting at BEFORE up into the new - space at the end -- making room to copy ENTRY into the - resulting gap. */ - memmove (before + entry_len, before, *pargz_len - offset); - memcpy (before, entry, entry_len); - - /* Assign new values. */ - *pargz = argz; - *pargz_len = argz_len; - } - - return 0; -} -#endif /* !HAVE_ARGZ_INSERT */ - - -#if ! HAVE_ARGZ_NEXT -# define argz_next rpl_argz_next - -static char *argz_next LT_PARAMS((char *argz, size_t argz_len, - const char *entry)); - -static char * -argz_next (argz, argz_len, entry) - char *argz; - size_t argz_len; - const char *entry; -{ - assert ((argz && argz_len) || (!argz && !argz_len)); - - if (entry) - { - /* Either ARGZ/ARGZ_LEN is empty, or ENTRY points into an address - within the ARGZ vector. */ - assert ((!argz && !argz_len) - || ((argz <= entry) && (entry < (argz + argz_len)))); - - /* Move to the char immediately after the terminating - '\0' of ENTRY. */ - entry = 1+ strchr (entry, LT_EOS_CHAR); - - /* Return either the new ENTRY, or else NULL if ARGZ is - exhausted. */ - return (entry >= argz + argz_len) ? 0 : (char *) entry; - } - else - { - /* This should probably be flagged as a programmer error, - since starting an argz_next loop with the iterator set - to ARGZ is safer. To preserve semantics, handle the NULL - case by returning the start of ARGZ (if any). */ - if (argz_len > 0) - return argz; - else - return 0; - } -} -#endif /* !HAVE_ARGZ_NEXT */ - - - -#if ! HAVE_ARGZ_STRINGIFY -# define argz_stringify rpl_argz_stringify - -static void argz_stringify LT_PARAMS((char *argz, size_t argz_len, - int sep)); - -static void -argz_stringify (argz, argz_len, sep) - char *argz; - size_t argz_len; - int sep; -{ - assert ((argz && argz_len) || (!argz && !argz_len)); - - if (sep) - { - --argz_len; /* don't stringify the terminating EOS */ - while (--argz_len > 0) - { - if (argz[argz_len] == LT_EOS_CHAR) - argz[argz_len] = sep; - } - } -} -#endif /* !HAVE_ARGZ_STRINGIFY */ - - - - -/* --- TYPE DEFINITIONS -- */ - - -/* This type is used for the array of caller data sets in each handler. */ -typedef struct { - lt_dlcaller_id key; - lt_ptr data; -} lt_caller_data; - - - - -/* --- OPAQUE STRUCTURES DECLARED IN LTDL.H --- */ - - -/* Extract the diagnostic strings from the error table macro in the same - order as the enumerated indices in ltdl.h. */ - -static const char *lt_dlerror_strings[] = - { -#define LT_ERROR(name, diagnostic) (diagnostic), - lt_dlerror_table -#undef LT_ERROR - - 0 - }; - -/* This structure is used for the list of registered loaders. */ -struct lt_dlloader { - struct lt_dlloader *next; - const char *loader_name; /* identifying name for each loader */ - const char *sym_prefix; /* prefix for symbols */ - lt_module_open *module_open; - lt_module_close *module_close; - lt_find_sym *find_sym; - lt_dlloader_exit *dlloader_exit; - lt_user_data dlloader_data; -}; - -struct lt_dlhandle_struct { - struct lt_dlhandle_struct *next; - lt_dlloader *loader; /* dlopening interface */ - lt_dlinfo info; - int depcount; /* number of dependencies */ - lt_dlhandle *deplibs; /* dependencies */ - lt_module module; /* system module handle */ - lt_ptr system; /* system specific data */ - lt_caller_data *caller_data; /* per caller associated data */ - int flags; /* various boolean stats */ -}; - -/* Various boolean flags can be stored in the flags field of an - lt_dlhandle_struct... */ -#define LT_DLGET_FLAG(handle, flag) (((handle)->flags & (flag)) == (flag)) -#define LT_DLSET_FLAG(handle, flag) ((handle)->flags |= (flag)) - -#define LT_DLRESIDENT_FLAG (0x01 << 0) -/* ...add more flags here... */ - -#define LT_DLIS_RESIDENT(handle) LT_DLGET_FLAG(handle, LT_DLRESIDENT_FLAG) - - -#define LT_DLSTRERROR(name) lt_dlerror_strings[LT_CONC(LT_ERROR_,name)] - -static const char objdir[] = LTDL_OBJDIR; -static const char archive_ext[] = LTDL_ARCHIVE_EXT; -#ifdef LTDL_SHLIB_EXT -static const char shlib_ext[] = LTDL_SHLIB_EXT; -#endif -#ifdef LTDL_SYSSEARCHPATH -static const char sys_search_path[] = LTDL_SYSSEARCHPATH; -#endif - - - - -/* --- MUTEX LOCKING --- */ - - -/* Macros to make it easier to run the lock functions only if they have - been registered. The reason for the complicated lock macro is to - ensure that the stored error message from the last error is not - accidentally erased if the current function doesn't generate an - error of its own. */ -#define LT_DLMUTEX_LOCK() LT_STMT_START { \ - if (lt_dlmutex_lock_func) (*lt_dlmutex_lock_func)(); \ - } LT_STMT_END -#define LT_DLMUTEX_UNLOCK() LT_STMT_START { \ - if (lt_dlmutex_unlock_func) (*lt_dlmutex_unlock_func)();\ - } LT_STMT_END -#define LT_DLMUTEX_SETERROR(errormsg) LT_STMT_START { \ - if (lt_dlmutex_seterror_func) \ - (*lt_dlmutex_seterror_func) (errormsg); \ - else lt_dllast_error = (errormsg); } LT_STMT_END -#define LT_DLMUTEX_GETERROR(errormsg) LT_STMT_START { \ - if (lt_dlmutex_seterror_func) \ - (errormsg) = (*lt_dlmutex_geterror_func) (); \ - else (errormsg) = lt_dllast_error; } LT_STMT_END - -/* The mutex functions stored here are global, and are necessarily the - same for all threads that wish to share access to libltdl. */ -static lt_dlmutex_lock *lt_dlmutex_lock_func = NULL; -static lt_dlmutex_unlock *lt_dlmutex_unlock_func = NULL; -static lt_dlmutex_seterror *lt_dlmutex_seterror_func = NULL; -static lt_dlmutex_geterror *lt_dlmutex_geterror_func = NULL; -static const char *lt_dllast_error = NULL; - - -/* Either set or reset the mutex functions. Either all the arguments must - be valid functions, or else all can be NULL to turn off locking entirely. - The registered functions should be manipulating a static global lock - from the lock() and unlock() callbacks, which needs to be reentrant. */ -int -lt_dlmutex_register (lock, unlock, seterror, geterror) - lt_dlmutex_lock *lock; - lt_dlmutex_unlock *unlock; - lt_dlmutex_seterror *seterror; - lt_dlmutex_geterror *geterror; -{ - lt_dlmutex_unlock *old_unlock = unlock; - int errors = 0; - - /* Lock using the old lock() callback, if any. */ - LT_DLMUTEX_LOCK (); - - if ((lock && unlock && seterror && geterror) - || !(lock || unlock || seterror || geterror)) - { - lt_dlmutex_lock_func = lock; - lt_dlmutex_unlock_func = unlock; - lt_dlmutex_geterror_func = geterror; - } - else - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_MUTEX_ARGS)); - ++errors; - } - - /* Use the old unlock() callback we saved earlier, if any. Otherwise - record any errors using internal storage. */ - if (old_unlock) - (*old_unlock) (); - - /* Return the number of errors encountered during the execution of - this function. */ - return errors; -} - - - - -/* --- ERROR HANDLING --- */ - -static const char **user_error_strings = NULL; -static int errorcount = LT_ERROR_MAX; - -int -lt_dladderror (diagnostic) - const char *diagnostic; -{ - int errindex = 0; - int result = -1; - const char **temp = NULL; - - assert (diagnostic); - - LT_DLMUTEX_LOCK (); - - errindex = errorcount - LT_ERROR_MAX; - temp = LT_EREALLOC (const char *, user_error_strings, 1 + errindex); - if (temp) - { - user_error_strings = temp; - user_error_strings[errindex] = diagnostic; - result = errorcount++; - } - - LT_DLMUTEX_UNLOCK (); - - return result; -} - -int -lt_dlseterror (errindex) - int errindex; -{ - int errors = 0; - - LT_DLMUTEX_LOCK (); - - if (errindex >= errorcount || errindex < 0) - { - /* Ack! Error setting the error message! */ - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_ERRORCODE)); - ++errors; - } - else if (errindex < LT_ERROR_MAX) - { - /* No error setting the error message! */ - LT_DLMUTEX_SETERROR (lt_dlerror_strings[errindex]); - } - else - { - /* No error setting the error message! */ - LT_DLMUTEX_SETERROR (user_error_strings[errindex - LT_ERROR_MAX]); - } - - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -static lt_ptr -lt_emalloc (size) - size_t size; -{ - lt_ptr mem = lt_dlmalloc (size); - if (size && !mem) - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); - return mem; -} - -static lt_ptr -lt_erealloc (addr, size) - lt_ptr addr; - size_t size; -{ - lt_ptr mem = realloc (addr, size); - if (size && !mem) - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); - return mem; -} - -static char * -lt_estrdup (str) - const char *str; -{ - char *copy = strdup (str); - if (LT_STRLEN (str) && !copy) - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); - return copy; -} - - - - -/* --- DLOPEN() INTERFACE LOADER --- */ - - -/* The Cygwin dlopen implementation prints a spurious error message to - stderr if its call to LoadLibrary() fails for any reason. We can - mitigate this by not using the Cygwin implementation, and falling - back to our own LoadLibrary() wrapper. */ -#if HAVE_LIBDL && !defined(__CYGWIN__) - -/* dynamic linking with dlopen/dlsym */ - -#if HAVE_DLFCN_H -# include <dlfcn.h> -#endif - -#if HAVE_SYS_DL_H -# include <sys/dl.h> -#endif - -#ifdef RTLD_GLOBAL -# define LT_GLOBAL RTLD_GLOBAL -#else -# ifdef DL_GLOBAL -# define LT_GLOBAL DL_GLOBAL -# endif -#endif /* !RTLD_GLOBAL */ -#ifndef LT_GLOBAL -# define LT_GLOBAL 0 -#endif /* !LT_GLOBAL */ - -/* We may have to define LT_LAZY_OR_NOW in the command line if we - find out it does not work in some platform. */ -#ifndef LT_LAZY_OR_NOW -# ifdef RTLD_LAZY -# define LT_LAZY_OR_NOW RTLD_LAZY -# else -# ifdef DL_LAZY -# define LT_LAZY_OR_NOW DL_LAZY -# endif -# endif /* !RTLD_LAZY */ -#endif -#ifndef LT_LAZY_OR_NOW -# ifdef RTLD_NOW -# define LT_LAZY_OR_NOW RTLD_NOW -# else -# ifdef DL_NOW -# define LT_LAZY_OR_NOW DL_NOW -# endif -# endif /* !RTLD_NOW */ -#endif -#ifndef LT_LAZY_OR_NOW -# define LT_LAZY_OR_NOW 0 -#endif /* !LT_LAZY_OR_NOW */ - -#if HAVE_DLERROR -# define DLERROR(arg) dlerror () -#else -# define DLERROR(arg) LT_DLSTRERROR (arg) -#endif - -static lt_module -sys_dl_open (loader_data, filename) - lt_user_data loader_data; - const char *filename; -{ - lt_module module = dlopen (filename, LT_GLOBAL | LT_LAZY_OR_NOW); - - if (!module) - { - LT_DLMUTEX_SETERROR (DLERROR (CANNOT_OPEN)); - } - - return module; -} - -static int -sys_dl_close (loader_data, module) - lt_user_data loader_data; - lt_module module; -{ - int errors = 0; - - if (dlclose (module) != 0) - { - LT_DLMUTEX_SETERROR (DLERROR (CANNOT_CLOSE)); - ++errors; - } - - return errors; -} - -static lt_ptr -sys_dl_sym (loader_data, module, symbol) - lt_user_data loader_data; - lt_module module; - const char *symbol; -{ - lt_ptr address = dlsym (module, symbol); - - if (!address) - { - LT_DLMUTEX_SETERROR (DLERROR (SYMBOL_NOT_FOUND)); - } - - return address; -} - -static struct lt_user_dlloader sys_dl = - { -# ifdef NEED_USCORE - "_", -# else - 0, -# endif - sys_dl_open, sys_dl_close, sys_dl_sym, 0, 0 }; - - -#endif /* HAVE_LIBDL */ - - - -/* --- SHL_LOAD() INTERFACE LOADER --- */ - -#if HAVE_SHL_LOAD - -/* dynamic linking with shl_load (HP-UX) (comments from gmodule) */ - -#ifdef HAVE_DL_H -# include <dl.h> -#endif - -/* some flags are missing on some systems, so we provide - * harmless defaults. - * - * Mandatory: - * BIND_IMMEDIATE - Resolve symbol references when the library is loaded. - * BIND_DEFERRED - Delay code symbol resolution until actual reference. - * - * Optionally: - * BIND_FIRST - Place the library at the head of the symbol search - * order. - * BIND_NONFATAL - The default BIND_IMMEDIATE behavior is to treat all - * unsatisfied symbols as fatal. This flag allows - * binding of unsatisfied code symbols to be deferred - * until use. - * [Perl: For certain libraries, like DCE, deferred - * binding often causes run time problems. Adding - * BIND_NONFATAL to BIND_IMMEDIATE still allows - * unresolved references in situations like this.] - * BIND_NOSTART - Do not call the initializer for the shared library - * when the library is loaded, nor on a future call to - * shl_unload(). - * BIND_VERBOSE - Print verbose messages concerning possible - * unsatisfied symbols. - * - * hp9000s700/hp9000s800: - * BIND_RESTRICTED - Restrict symbols visible by the library to those - * present at library load time. - * DYNAMIC_PATH - Allow the loader to dynamically search for the - * library specified by the path argument. - */ - -#ifndef DYNAMIC_PATH -# define DYNAMIC_PATH 0 -#endif -#ifndef BIND_RESTRICTED -# define BIND_RESTRICTED 0 -#endif - -#define LT_BIND_FLAGS (BIND_IMMEDIATE | BIND_NONFATAL | DYNAMIC_PATH) - -static lt_module -sys_shl_open (loader_data, filename) - lt_user_data loader_data; - const char *filename; -{ - static shl_t self = (shl_t) 0; - lt_module module = shl_load (filename, LT_BIND_FLAGS, 0L); - - /* Since searching for a symbol against a NULL module handle will also - look in everything else that was already loaded and exported with - the -E compiler flag, we always cache a handle saved before any - modules are loaded. */ - if (!self) - { - lt_ptr address; - shl_findsym (&self, "main", TYPE_UNDEFINED, &address); - } - - if (!filename) - { - module = self; - } - else - { - module = shl_load (filename, LT_BIND_FLAGS, 0L); - - if (!module) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); - } - } - - return module; -} - -static int -sys_shl_close (loader_data, module) - lt_user_data loader_data; - lt_module module; -{ - int errors = 0; - - if (module && (shl_unload ((shl_t) (module)) != 0)) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); - ++errors; - } - - return errors; -} - -static lt_ptr -sys_shl_sym (loader_data, module, symbol) - lt_user_data loader_data; - lt_module module; - const char *symbol; -{ - lt_ptr address = NULL; - - /* sys_shl_open should never return a NULL module handle */ - if (module == (lt_module) 0) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); - } - else if (!shl_findsym((shl_t*) &module, symbol, TYPE_UNDEFINED, &address)) - { - if (!address) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - } - } - - return address; -} - -static struct lt_user_dlloader sys_shl = { - 0, sys_shl_open, sys_shl_close, sys_shl_sym, 0, 0 -}; - -#endif /* HAVE_SHL_LOAD */ - - - - -/* --- LOADLIBRARY() INTERFACE LOADER --- */ - -#ifdef __WINDOWS__ - -/* dynamic linking for Win32 */ - -#include <windows.h> - -/* Forward declaration; required to implement handle search below. */ -static lt_dlhandle handles; - -static lt_module -sys_wll_open (loader_data, filename) - lt_user_data loader_data; - const char *filename; -{ - lt_dlhandle cur; - lt_module module = NULL; - char *searchname = NULL; - char *ext; - char self_name_buf[MAX_PATH]; - - if (!filename) - { - /* Get the name of main module */ - *self_name_buf = '\0'; - GetModuleFileName (NULL, self_name_buf, sizeof (self_name_buf)); - filename = ext = self_name_buf; - } - else - { - ext = strrchr (filename, '.'); - } - - if (ext) - { - /* FILENAME already has an extension. */ - searchname = lt_estrdup (filename); - } - else - { - /* Append a `.' to stop Windows from adding an - implicit `.dll' extension. */ - searchname = LT_EMALLOC (char, 2+ LT_STRLEN (filename)); - if (searchname) - sprintf (searchname, "%s.", filename); - } - if (!searchname) - return 0; - -#if __CYGWIN__ - { - char wpath[MAX_PATH]; - cygwin_conv_to_full_win32_path(searchname, wpath); - module = LoadLibrary(wpath); - } -#else - module = LoadLibrary (searchname); -#endif - LT_DLFREE (searchname); - - /* libltdl expects this function to fail if it is unable - to physically load the library. Sadly, LoadLibrary - will search the loaded libraries for a match and return - one of them if the path search load fails. - - We check whether LoadLibrary is returning a handle to - an already loaded module, and simulate failure if we - find one. */ - LT_DLMUTEX_LOCK (); - cur = handles; - while (cur) - { - if (!cur->module) - { - cur = NULL; - break; - } - - if (cur->module == module) - { - break; - } - - cur = cur->next; - } - LT_DLMUTEX_UNLOCK (); - - if (cur || !module) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); - module = NULL; - } - - return module; -} - -static int -sys_wll_close (loader_data, module) - lt_user_data loader_data; - lt_module module; -{ - int errors = 0; - - if (FreeLibrary(module) == 0) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); - ++errors; - } - - return errors; -} - -static lt_ptr -sys_wll_sym (loader_data, module, symbol) - lt_user_data loader_data; - lt_module module; - const char *symbol; -{ - lt_ptr address = GetProcAddress (module, symbol); - - if (!address) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - } - - return address; -} - -static struct lt_user_dlloader sys_wll = { - 0, sys_wll_open, sys_wll_close, sys_wll_sym, 0, 0 -}; - -#endif /* __WINDOWS__ */ - - - - -/* --- LOAD_ADD_ON() INTERFACE LOADER --- */ - - -#ifdef __BEOS__ - -/* dynamic linking for BeOS */ - -#include <kernel/image.h> - -static lt_module -sys_bedl_open (loader_data, filename) - lt_user_data loader_data; - const char *filename; -{ - image_id image = 0; - - if (filename) - { - image = load_add_on (filename); - } - else - { - image_info info; - int32 cookie = 0; - if (get_next_image_info (0, &cookie, &info) == B_OK) - image = load_add_on (info.name); - } - - if (image <= 0) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); - image = 0; - } - - return (lt_module) image; -} - -static int -sys_bedl_close (loader_data, module) - lt_user_data loader_data; - lt_module module; -{ - int errors = 0; - - if (unload_add_on ((image_id) module) != B_OK) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); - ++errors; - } - - return errors; -} - -static lt_ptr -sys_bedl_sym (loader_data, module, symbol) - lt_user_data loader_data; - lt_module module; - const char *symbol; -{ - lt_ptr address = NULL; - image_id image = (image_id) module; - - if (get_image_symbol (image, symbol, B_SYMBOL_TYPE_ANY, address) != B_OK) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - address = NULL; - } - - return address; -} - -static struct lt_user_dlloader sys_bedl = { - 0, sys_bedl_open, sys_bedl_close, sys_bedl_sym, 0, 0 -}; - -#endif /* __BEOS__ */ - - - - -/* --- DLD_LINK() INTERFACE LOADER --- */ - - -#if HAVE_DLD - -/* dynamic linking with dld */ - -#if HAVE_DLD_H -#include <dld.h> -#endif - -static lt_module -sys_dld_open (loader_data, filename) - lt_user_data loader_data; - const char *filename; -{ - lt_module module = strdup (filename); - - if (dld_link (filename) != 0) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); - LT_DLFREE (module); - module = NULL; - } - - return module; -} - -static int -sys_dld_close (loader_data, module) - lt_user_data loader_data; - lt_module module; -{ - int errors = 0; - - if (dld_unlink_by_file ((char*)(module), 1) != 0) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); - ++errors; - } - else - { - LT_DLFREE (module); - } - - return errors; -} - -static lt_ptr -sys_dld_sym (loader_data, module, symbol) - lt_user_data loader_data; - lt_module module; - const char *symbol; -{ - lt_ptr address = dld_get_func (symbol); - - if (!address) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - } - - return address; -} - -static struct lt_user_dlloader sys_dld = { - 0, sys_dld_open, sys_dld_close, sys_dld_sym, 0, 0 -}; - -#endif /* HAVE_DLD */ - - - - -/* --- DLPREOPEN() INTERFACE LOADER --- */ - - -/* emulate dynamic linking using preloaded_symbols */ - -typedef struct lt_dlsymlists_t -{ - struct lt_dlsymlists_t *next; - const lt_dlsymlist *syms; -} lt_dlsymlists_t; - -static const lt_dlsymlist *default_preloaded_symbols = NULL; -static lt_dlsymlists_t *preloaded_symbols = NULL; - -static int -presym_init (loader_data) - lt_user_data loader_data; -{ - int errors = 0; - - LT_DLMUTEX_LOCK (); - - preloaded_symbols = NULL; - if (default_preloaded_symbols) - { - errors = lt_dlpreload (default_preloaded_symbols); - } - - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -static int -presym_free_symlists () -{ - lt_dlsymlists_t *lists; - - LT_DLMUTEX_LOCK (); - - lists = preloaded_symbols; - while (lists) - { - lt_dlsymlists_t *tmp = lists; - - lists = lists->next; - LT_DLFREE (tmp); - } - preloaded_symbols = NULL; - - LT_DLMUTEX_UNLOCK (); - - return 0; -} - -static int -presym_exit (loader_data) - lt_user_data loader_data; -{ - presym_free_symlists (); - return 0; -} - -static int -presym_add_symlist (preloaded) - const lt_dlsymlist *preloaded; -{ - lt_dlsymlists_t *tmp; - lt_dlsymlists_t *lists; - int errors = 0; - - LT_DLMUTEX_LOCK (); - - lists = preloaded_symbols; - while (lists) - { - if (lists->syms == preloaded) - { - goto done; - } - lists = lists->next; - } - - tmp = LT_EMALLOC (lt_dlsymlists_t, 1); - if (tmp) - { - memset (tmp, 0, sizeof(lt_dlsymlists_t)); - tmp->syms = preloaded; - tmp->next = preloaded_symbols; - preloaded_symbols = tmp; - } - else - { - ++errors; - } - - done: - LT_DLMUTEX_UNLOCK (); - return errors; -} - -static lt_module -presym_open (loader_data, filename) - lt_user_data loader_data; - const char *filename; -{ - lt_dlsymlists_t *lists; - lt_module module = (lt_module) 0; - - LT_DLMUTEX_LOCK (); - lists = preloaded_symbols; - - if (!lists) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_SYMBOLS)); - goto done; - } - - /* Can't use NULL as the reflective symbol header, as NULL is - used to mark the end of the entire symbol list. Self-dlpreopened - symbols follow this magic number, chosen to be an unlikely - clash with a real module name. */ - if (!filename) - { - filename = "@PROGRAM@"; - } - - while (lists) - { - const lt_dlsymlist *syms = lists->syms; - - while (syms->name) - { - if (!syms->address && strcmp(syms->name, filename) == 0) - { - module = (lt_module) syms; - goto done; - } - ++syms; - } - - lists = lists->next; - } - - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); - - done: - LT_DLMUTEX_UNLOCK (); - return module; -} - -static int -presym_close (loader_data, module) - lt_user_data loader_data; - lt_module module; -{ - /* Just to silence gcc -Wall */ - module = NULL; - return 0; -} - -static lt_ptr -presym_sym (loader_data, module, symbol) - lt_user_data loader_data; - lt_module module; - const char *symbol; -{ - lt_dlsymlist *syms = (lt_dlsymlist*) module; - - ++syms; - while (syms->address) - { - if (strcmp(syms->name, symbol) == 0) - { - return syms->address; - } - - ++syms; - } - - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - - return 0; -} - -static struct lt_user_dlloader presym = { - 0, presym_open, presym_close, presym_sym, presym_exit, 0 -}; - - - - - -/* --- DYNAMIC MODULE LOADING --- */ - - -/* The type of a function used at each iteration of foreach_dirinpath(). */ -typedef int foreach_callback_func LT_PARAMS((char *filename, lt_ptr data1, - lt_ptr data2)); - -static int foreach_dirinpath LT_PARAMS((const char *search_path, - const char *base_name, - foreach_callback_func *func, - lt_ptr data1, lt_ptr data2)); - -static int find_file_callback LT_PARAMS((char *filename, lt_ptr data, - lt_ptr ignored)); -static int find_handle_callback LT_PARAMS((char *filename, lt_ptr data, - lt_ptr ignored)); -static int foreachfile_callback LT_PARAMS((char *filename, lt_ptr data1, - lt_ptr data2)); - - -static int canonicalize_path LT_PARAMS((const char *path, - char **pcanonical)); -static int argzize_path LT_PARAMS((const char *path, - char **pargz, - size_t *pargz_len)); -static FILE *find_file LT_PARAMS((const char *search_path, - const char *base_name, - char **pdir)); -static lt_dlhandle *find_handle LT_PARAMS((const char *search_path, - const char *base_name, - lt_dlhandle *handle)); -static int find_module LT_PARAMS((lt_dlhandle *handle, - const char *dir, - const char *libdir, - const char *dlname, - const char *old_name, - int installed)); -static int free_vars LT_PARAMS((char *dlname, char *oldname, - char *libdir, char *deplibs)); -static int load_deplibs LT_PARAMS((lt_dlhandle handle, - char *deplibs)); -static int trim LT_PARAMS((char **dest, - const char *str)); -static int try_dlopen LT_PARAMS((lt_dlhandle *handle, - const char *filename)); -static int tryall_dlopen LT_PARAMS((lt_dlhandle *handle, - const char *filename)); -static int unload_deplibs LT_PARAMS((lt_dlhandle handle)); -static int lt_argz_insert LT_PARAMS((char **pargz, - size_t *pargz_len, - char *before, - const char *entry)); -static int lt_argz_insertinorder LT_PARAMS((char **pargz, - size_t *pargz_len, - const char *entry)); -static int lt_argz_insertdir LT_PARAMS((char **pargz, - size_t *pargz_len, - const char *dirnam, - struct dirent *dp)); -static int lt_dlpath_insertdir LT_PARAMS((char **ppath, - char *before, - const char *dir)); -static int list_files_by_dir LT_PARAMS((const char *dirnam, - char **pargz, - size_t *pargz_len)); -static int file_not_found LT_PARAMS((void)); - -static char *user_search_path= NULL; -static lt_dlloader *loaders = NULL; -static lt_dlhandle handles = NULL; -static int initialized = 0; - -/* Initialize libltdl. */ -int -lt_dlinit () -{ - int errors = 0; - - LT_DLMUTEX_LOCK (); - - /* Initialize only at first call. */ - if (++initialized == 1) - { - handles = NULL; - user_search_path = NULL; /* empty search path */ - -#if HAVE_LIBDL && !defined(__CYGWIN__) - errors += lt_dlloader_add (lt_dlloader_next (0), &sys_dl, "dlopen"); -#endif -#if HAVE_SHL_LOAD - errors += lt_dlloader_add (lt_dlloader_next (0), &sys_shl, "dlopen"); -#endif -#ifdef __WINDOWS__ - errors += lt_dlloader_add (lt_dlloader_next (0), &sys_wll, "dlopen"); -#endif -#ifdef __BEOS__ - errors += lt_dlloader_add (lt_dlloader_next (0), &sys_bedl, "dlopen"); -#endif -#if HAVE_DLD - errors += lt_dlloader_add (lt_dlloader_next (0), &sys_dld, "dld"); -#endif - errors += lt_dlloader_add (lt_dlloader_next (0), &presym, "dlpreload"); - - if (presym_init (presym.dlloader_data)) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INIT_LOADER)); - ++errors; - } - else if (errors != 0) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (DLOPEN_NOT_SUPPORTED)); - ++errors; - } - } - - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -int -lt_dlpreload (preloaded) - const lt_dlsymlist *preloaded; -{ - int errors = 0; - - if (preloaded) - { - errors = presym_add_symlist (preloaded); - } - else - { - presym_free_symlists(); - - LT_DLMUTEX_LOCK (); - if (default_preloaded_symbols) - { - errors = lt_dlpreload (default_preloaded_symbols); - } - LT_DLMUTEX_UNLOCK (); - } - - return errors; -} - -int -lt_dlpreload_default (preloaded) - const lt_dlsymlist *preloaded; -{ - LT_DLMUTEX_LOCK (); - default_preloaded_symbols = preloaded; - LT_DLMUTEX_UNLOCK (); - return 0; -} - -int -lt_dlexit () -{ - /* shut down libltdl */ - lt_dlloader *loader; - int errors = 0; - - LT_DLMUTEX_LOCK (); - loader = loaders; - - if (!initialized) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SHUTDOWN)); - ++errors; - goto done; - } - - /* shut down only at last call. */ - if (--initialized == 0) - { - int level; - - while (handles && LT_DLIS_RESIDENT (handles)) - { - handles = handles->next; - } - - /* close all modules */ - for (level = 1; handles; ++level) - { - lt_dlhandle cur = handles; - int saw_nonresident = 0; - - while (cur) - { - lt_dlhandle tmp = cur; - cur = cur->next; - if (!LT_DLIS_RESIDENT (tmp)) - saw_nonresident = 1; - if (!LT_DLIS_RESIDENT (tmp) && tmp->info.ref_count <= level) - { - if (lt_dlclose (tmp)) - { - ++errors; - } - } - } - /* done if only resident modules are left */ - if (!saw_nonresident) - break; - } - - /* close all loaders */ - while (loader) - { - lt_dlloader *next = loader->next; - lt_user_data data = loader->dlloader_data; - if (loader->dlloader_exit && loader->dlloader_exit (data)) - { - ++errors; - } - - LT_DLMEM_REASSIGN (loader, next); - } - loaders = NULL; - } - - done: - LT_DLMUTEX_UNLOCK (); - return errors; -} - -static int -tryall_dlopen (handle, filename) - lt_dlhandle *handle; - const char *filename; -{ - lt_dlhandle cur; - lt_dlloader *loader; - const char *saved_error; - int errors = 0; - - LT_DLMUTEX_GETERROR (saved_error); - LT_DLMUTEX_LOCK (); - - cur = handles; - loader = loaders; - - /* check whether the module was already opened */ - while (cur) - { - /* try to dlopen the program itself? */ - if (!cur->info.filename && !filename) - { - break; - } - - if (cur->info.filename && filename - && strcmp (cur->info.filename, filename) == 0) - { - break; - } - - cur = cur->next; - } - - if (cur) - { - ++cur->info.ref_count; - *handle = cur; - goto done; - } - - cur = *handle; - if (filename) - { - cur->info.filename = lt_estrdup (filename); - if (!cur->info.filename) - { - ++errors; - goto done; - } - } - else - { - cur->info.filename = NULL; - } - - while (loader) - { - lt_user_data data = loader->dlloader_data; - - cur->module = loader->module_open (data, filename); - - if (cur->module != NULL) - { - break; - } - loader = loader->next; - } - - if (!loader) - { - LT_DLFREE (cur->info.filename); - ++errors; - goto done; - } - - cur->loader = loader; - LT_DLMUTEX_SETERROR (saved_error); - - done: - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -static int -tryall_dlopen_module (handle, prefix, dirname, dlname) - lt_dlhandle *handle; - const char *prefix; - const char *dirname; - const char *dlname; -{ - int error = 0; - char *filename = NULL; - size_t filename_len = 0; - size_t dirname_len = LT_STRLEN (dirname); - - assert (handle); - assert (dirname); - assert (dlname); -#ifdef LT_DIRSEP_CHAR - /* Only canonicalized names (i.e. with DIRSEP chars already converted) - should make it into this function: */ - assert (strchr (dirname, LT_DIRSEP_CHAR) == NULL); -#endif - - if (dirname_len > 0) - if (dirname[dirname_len -1] == '/') - --dirname_len; - filename_len = dirname_len + 1 + LT_STRLEN (dlname); - - /* Allocate memory, and combine DIRNAME and MODULENAME into it. - The PREFIX (if any) is handled below. */ - filename = LT_EMALLOC (char, dirname_len + 1 + filename_len + 1); - if (!filename) - return 1; - - sprintf (filename, "%.*s/%s", (int) dirname_len, dirname, dlname); - - /* Now that we have combined DIRNAME and MODULENAME, if there is - also a PREFIX to contend with, simply recurse with the arguments - shuffled. Otherwise, attempt to open FILENAME as a module. */ - if (prefix) - { - error += tryall_dlopen_module (handle, - (const char *) 0, prefix, filename); - } - else if (tryall_dlopen (handle, filename) != 0) - { - ++error; - } - - LT_DLFREE (filename); - return error; -} - -static int -find_module (handle, dir, libdir, dlname, old_name, installed) - lt_dlhandle *handle; - const char *dir; - const char *libdir; - const char *dlname; - const char *old_name; - int installed; -{ - /* Try to open the old library first; if it was dlpreopened, - we want the preopened version of it, even if a dlopenable - module is available. */ - if (old_name && tryall_dlopen (handle, old_name) == 0) - { - return 0; - } - - /* Try to open the dynamic library. */ - if (dlname) - { - /* try to open the installed module */ - if (installed && libdir) - { - if (tryall_dlopen_module (handle, - (const char *) 0, libdir, dlname) == 0) - return 0; - } - - /* try to open the not-installed module */ - if (!installed) - { - if (tryall_dlopen_module (handle, dir, objdir, dlname) == 0) - return 0; - } - - /* maybe it was moved to another directory */ - { - if (tryall_dlopen_module (handle, - (const char *) 0, dir, dlname) == 0) - return 0; - } - } - - return 1; -} - - -static int -canonicalize_path (path, pcanonical) - const char *path; - char **pcanonical; -{ - char *canonical = NULL; - - assert (path && *path); - assert (pcanonical); - - canonical = LT_EMALLOC (char, 1+ LT_STRLEN (path)); - if (!canonical) - return 1; - - { - size_t dest = 0; - size_t src; - for (src = 0; path[src] != LT_EOS_CHAR; ++src) - { - /* Path separators are not copied to the beginning or end of - the destination, or if another separator would follow - immediately. */ - if (path[src] == LT_PATHSEP_CHAR) - { - if ((dest == 0) - || (path[1+ src] == LT_PATHSEP_CHAR) - || (path[1+ src] == LT_EOS_CHAR)) - continue; - } - - /* Anything other than a directory separator is copied verbatim. */ - if ((path[src] != '/') -#ifdef LT_DIRSEP_CHAR - && (path[src] != LT_DIRSEP_CHAR) -#endif - ) - { - canonical[dest++] = path[src]; - } - /* Directory separators are converted and copied only if they are - not at the end of a path -- i.e. before a path separator or - NULL terminator. */ - else if ((path[1+ src] != LT_PATHSEP_CHAR) - && (path[1+ src] != LT_EOS_CHAR) -#ifdef LT_DIRSEP_CHAR - && (path[1+ src] != LT_DIRSEP_CHAR) -#endif - && (path[1+ src] != '/')) - { - canonical[dest++] = '/'; - } - } - - /* Add an end-of-string marker at the end. */ - canonical[dest] = LT_EOS_CHAR; - } - - /* Assign new value. */ - *pcanonical = canonical; - - return 0; -} - -static int -argzize_path (path, pargz, pargz_len) - const char *path; - char **pargz; - size_t *pargz_len; -{ - error_t error; - - assert (path); - assert (pargz); - assert (pargz_len); - - if ((error = argz_create_sep (path, LT_PATHSEP_CHAR, pargz, pargz_len))) - { - switch (error) - { - case ENOMEM: - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); - break; - default: - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (UNKNOWN)); - break; - } - - return 1; - } - - return 0; -} - -/* Repeatedly call FUNC with each LT_PATHSEP_CHAR delimited element - of SEARCH_PATH and references to DATA1 and DATA2, until FUNC returns - non-zero or all elements are exhausted. If BASE_NAME is non-NULL, - it is appended to each SEARCH_PATH element before FUNC is called. */ -static int -foreach_dirinpath (search_path, base_name, func, data1, data2) - const char *search_path; - const char *base_name; - foreach_callback_func *func; - lt_ptr data1; - lt_ptr data2; -{ - int result = 0; - int filenamesize = 0; - size_t lenbase = LT_STRLEN (base_name); - size_t argz_len = 0; - char *argz = NULL; - char *filename = NULL; - char *canonical = NULL; - - LT_DLMUTEX_LOCK (); - - if (!search_path || !*search_path) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); - goto cleanup; - } - - if (canonicalize_path (search_path, &canonical) != 0) - goto cleanup; - - if (argzize_path (canonical, &argz, &argz_len) != 0) - goto cleanup; - - { - char *dir_name = NULL; - while ((dir_name = argz_next (argz, argz_len, dir_name))) - { - size_t lendir = LT_STRLEN (dir_name); - - if (lendir +1 +lenbase >= filenamesize) - { - LT_DLFREE (filename); - filenamesize = lendir +1 +lenbase +1; /* "/d" + '/' + "f" + '\0' */ - filename = LT_EMALLOC (char, filenamesize); - if (!filename) - goto cleanup; - } - - assert (filenamesize > lendir); - strcpy (filename, dir_name); - - if (base_name && *base_name) - { - if (filename[lendir -1] != '/') - filename[lendir++] = '/'; - strcpy (filename +lendir, base_name); - } - - if ((result = (*func) (filename, data1, data2))) - { - break; - } - } - } - - cleanup: - LT_DLFREE (argz); - LT_DLFREE (canonical); - LT_DLFREE (filename); - - LT_DLMUTEX_UNLOCK (); - - return result; -} - -/* If FILEPATH can be opened, store the name of the directory component - in DATA1, and the opened FILE* structure address in DATA2. Otherwise - DATA1 is unchanged, but DATA2 is set to a pointer to NULL. */ -static int -find_file_callback (filename, data1, data2) - char *filename; - lt_ptr data1; - lt_ptr data2; -{ - char **pdir = (char **) data1; - FILE **pfile = (FILE **) data2; - int is_done = 0; - - assert (filename && *filename); - assert (pdir); - assert (pfile); - - if ((*pfile = fopen (filename, LT_READTEXT_MODE))) - { - char *dirend = strrchr (filename, '/'); - - if (dirend > filename) - *dirend = LT_EOS_CHAR; - - LT_DLFREE (*pdir); - *pdir = lt_estrdup (filename); - is_done = (*pdir == NULL) ? -1 : 1; - } - - return is_done; -} - -static FILE * -find_file (search_path, base_name, pdir) - const char *search_path; - const char *base_name; - char **pdir; -{ - FILE *file = NULL; - - foreach_dirinpath (search_path, base_name, find_file_callback, pdir, &file); - - return file; -} - -static int -find_handle_callback (filename, data, ignored) - char *filename; - lt_ptr data; - lt_ptr ignored; -{ - lt_dlhandle *handle = (lt_dlhandle *) data; - int notfound = access (filename, R_OK); - - /* Bail out if file cannot be read... */ - if (notfound) - return 0; - - /* Try to dlopen the file, but do not continue searching in any - case. */ - if (tryall_dlopen (handle, filename) != 0) - *handle = NULL; - - return 1; -} - -/* If HANDLE was found return it, otherwise return 0. If HANDLE was - found but could not be opened, *HANDLE will be set to 0. */ -static lt_dlhandle * -find_handle (search_path, base_name, handle) - const char *search_path; - const char *base_name; - lt_dlhandle *handle; -{ - if (!search_path) - return 0; - - if (!foreach_dirinpath (search_path, base_name, find_handle_callback, - handle, 0)) - return 0; - - return handle; -} - -static int -load_deplibs (handle, deplibs) - lt_dlhandle handle; - char *deplibs; -{ -#if LTDL_DLOPEN_DEPLIBS - char *p, *save_search_path = NULL; - int depcount = 0; - int i; - char **names = NULL; -#endif - int errors = 0; - - handle->depcount = 0; - -#if LTDL_DLOPEN_DEPLIBS - if (!deplibs) - { - return errors; - } - ++errors; - - LT_DLMUTEX_LOCK (); - if (user_search_path) - { - save_search_path = lt_estrdup (user_search_path); - if (!save_search_path) - goto cleanup; - } - - /* extract search paths and count deplibs */ - p = deplibs; - while (*p) - { - if (!isspace ((int) *p)) - { - char *end = p+1; - while (*end && !isspace((int) *end)) - { - ++end; - } - - if (strncmp(p, "-L", 2) == 0 || strncmp(p, "-R", 2) == 0) - { - char save = *end; - *end = '\0'; /* set a temporary string terminator */ - if (lt_dladdsearchdir(p+2)) - { - goto cleanup; - } - *end = save; - } - else - { - ++depcount; - } - - p = end; - } - else - { - ++p; - } - } - - /* restore the old search path */ - LT_DLFREE (user_search_path); - user_search_path = save_search_path; - - LT_DLMUTEX_UNLOCK (); - - if (!depcount) - { - errors = 0; - goto cleanup; - } - - names = LT_EMALLOC (char *, depcount * sizeof (char*)); - if (!names) - goto cleanup; - - /* now only extract the actual deplibs */ - depcount = 0; - p = deplibs; - while (*p) - { - if (isspace ((int) *p)) - { - ++p; - } - else - { - char *end = p+1; - while (*end && !isspace ((int) *end)) - { - ++end; - } - - if (strncmp(p, "-L", 2) != 0 && strncmp(p, "-R", 2) != 0) - { - char *name; - char save = *end; - *end = '\0'; /* set a temporary string terminator */ - if (strncmp(p, "-l", 2) == 0) - { - size_t name_len = 3+ /* "lib" */ LT_STRLEN (p + 2); - name = LT_EMALLOC (char, 1+ name_len); - if (name) - sprintf (name, "lib%s", p+2); - } - else - name = lt_estrdup(p); - - if (!name) - goto cleanup_names; - - names[depcount++] = name; - *end = save; - } - p = end; - } - } - - /* load the deplibs (in reverse order) - At this stage, don't worry if the deplibs do not load correctly, - they may already be statically linked into the loading application - for instance. There will be a more enlightening error message - later on if the loaded module cannot resolve all of its symbols. */ - if (depcount) - { - int j = 0; - - handle->deplibs = (lt_dlhandle*) LT_EMALLOC (lt_dlhandle *, depcount); - if (!handle->deplibs) - goto cleanup; - - for (i = 0; i < depcount; ++i) - { - handle->deplibs[j] = lt_dlopenext(names[depcount-1-i]); - if (handle->deplibs[j]) - { - ++j; - } - } - - handle->depcount = j; /* Number of successfully loaded deplibs */ - errors = 0; - } - - cleanup_names: - for (i = 0; i < depcount; ++i) - { - LT_DLFREE (names[i]); - } - - cleanup: - LT_DLFREE (names); -#endif - - return errors; -} - -static int -unload_deplibs (handle) - lt_dlhandle handle; -{ - int i; - int errors = 0; - - if (handle->depcount) - { - for (i = 0; i < handle->depcount; ++i) - { - if (!LT_DLIS_RESIDENT (handle->deplibs[i])) - { - errors += lt_dlclose (handle->deplibs[i]); - } - } - } - - return errors; -} - -static int -trim (dest, str) - char **dest; - const char *str; -{ - /* remove the leading and trailing "'" from str - and store the result in dest */ - const char *end = strrchr (str, '\''); - size_t len = LT_STRLEN (str); - char *tmp; - - LT_DLFREE (*dest); - - if (len > 3 && str[0] == '\'') - { - tmp = LT_EMALLOC (char, end - str); - if (!tmp) - return 1; - - strncpy(tmp, &str[1], (end - str) - 1); - tmp[len-3] = LT_EOS_CHAR; - *dest = tmp; - } - else - { - *dest = NULL; - } - - return 0; -} - -static int -free_vars (dlname, oldname, libdir, deplibs) - char *dlname; - char *oldname; - char *libdir; - char *deplibs; -{ - LT_DLFREE (dlname); - LT_DLFREE (oldname); - LT_DLFREE (libdir); - LT_DLFREE (deplibs); - - return 0; -} - -static int -try_dlopen (phandle, filename) - lt_dlhandle *phandle; - const char *filename; -{ - const char * ext = NULL; - const char * saved_error = NULL; - char * canonical = NULL; - char * base_name = NULL; - char * dir = NULL; - char * name = NULL; - int errors = 0; - lt_dlhandle newhandle; - - assert (phandle); - assert (*phandle == NULL); - - LT_DLMUTEX_GETERROR (saved_error); - - /* dlopen self? */ - if (!filename) - { - *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); - if (*phandle == NULL) - return 1; - - memset (*phandle, 0, sizeof(struct lt_dlhandle_struct)); - newhandle = *phandle; - - /* lt_dlclose()ing yourself is very bad! Disallow it. */ - LT_DLSET_FLAG (*phandle, LT_DLRESIDENT_FLAG); - - if (tryall_dlopen (&newhandle, 0) != 0) - { - LT_DLFREE (*phandle); - return 1; - } - - goto register_handle; - } - - assert (filename && *filename); - - /* Doing this immediately allows internal functions to safely - assume only canonicalized paths are passed. */ - if (canonicalize_path (filename, &canonical) != 0) - { - ++errors; - goto cleanup; - } - - /* If the canonical module name is a path (relative or absolute) - then split it into a directory part and a name part. */ - base_name = strrchr (canonical, '/'); - if (base_name) - { - size_t dirlen = (1+ base_name) - canonical; - - dir = LT_EMALLOC (char, 1+ dirlen); - if (!dir) - { - ++errors; - goto cleanup; - } - - strncpy (dir, canonical, dirlen); - dir[dirlen] = LT_EOS_CHAR; - - ++base_name; - } - else - LT_DLMEM_REASSIGN (base_name, canonical); - - assert (base_name && *base_name); - - /* Check whether we are opening a libtool module (.la extension). */ - ext = strrchr (base_name, '.'); - if (ext && strcmp (ext, archive_ext) == 0) - { - /* this seems to be a libtool module */ - FILE * file = NULL; - char * dlname = NULL; - char * old_name = NULL; - char * libdir = NULL; - char * deplibs = NULL; - char * line = NULL; - size_t line_len; - - /* if we can't find the installed flag, it is probably an - installed libtool archive, produced with an old version - of libtool */ - int installed = 1; - - /* extract the module name from the file name */ - name = LT_EMALLOC (char, ext - base_name + 1); - if (!name) - { - ++errors; - goto cleanup; - } - - /* canonicalize the module name */ - { - size_t i; - for (i = 0; i < ext - base_name; ++i) - { - if (isalnum ((int)(base_name[i]))) - { - name[i] = base_name[i]; - } - else - { - name[i] = '_'; - } - } - name[ext - base_name] = LT_EOS_CHAR; - } - - /* Now try to open the .la file. If there is no directory name - component, try to find it first in user_search_path and then other - prescribed paths. Otherwise (or in any case if the module was not - yet found) try opening just the module name as passed. */ - if (!dir) - { - const char *search_path; - - LT_DLMUTEX_LOCK (); - search_path = user_search_path; - if (search_path) - file = find_file (user_search_path, base_name, &dir); - LT_DLMUTEX_UNLOCK (); - - if (!file) - { - search_path = getenv (LTDL_SEARCHPATH_VAR); - if (search_path) - file = find_file (search_path, base_name, &dir); - } - -#ifdef LTDL_SHLIBPATH_VAR - if (!file) - { - search_path = getenv (LTDL_SHLIBPATH_VAR); - if (search_path) - file = find_file (search_path, base_name, &dir); - } -#endif -#ifdef LTDL_SYSSEARCHPATH - if (!file && sys_search_path) - { - file = find_file (sys_search_path, base_name, &dir); - } -#endif - } - if (!file) - { - file = fopen (filename, LT_READTEXT_MODE); - } - - /* If we didn't find the file by now, it really isn't there. Set - the status flag, and bail out. */ - if (!file) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); - ++errors; - goto cleanup; - } - - line_len = LT_FILENAME_MAX; - line = LT_EMALLOC (char, line_len); - if (!line) - { - fclose (file); - ++errors; - goto cleanup; - } - - /* read the .la file */ - while (!feof (file)) - { - if (!fgets (line, (int) line_len, file)) - { - break; - } - - /* Handle the case where we occasionally need to read a line - that is longer than the initial buffer size. */ - while ((line[LT_STRLEN(line) -1] != '\n') && (!feof (file))) - { - line = LT_DLREALLOC (char, line, line_len *2); - if (!fgets (&line[line_len -1], (int) line_len +1, file)) - { - break; - } - line_len *= 2; - } - - if (line[0] == '\n' || line[0] == '#') - { - continue; - } - -#undef STR_DLNAME -#define STR_DLNAME "dlname=" - if (strncmp (line, STR_DLNAME, sizeof (STR_DLNAME) - 1) == 0) - { - errors += trim (&dlname, &line[sizeof (STR_DLNAME) - 1]); - } - -#undef STR_OLD_LIBRARY -#define STR_OLD_LIBRARY "old_library=" - else if (strncmp (line, STR_OLD_LIBRARY, - sizeof (STR_OLD_LIBRARY) - 1) == 0) - { - errors += trim (&old_name, &line[sizeof (STR_OLD_LIBRARY) - 1]); - } -#undef STR_LIBDIR -#define STR_LIBDIR "libdir=" - else if (strncmp (line, STR_LIBDIR, sizeof (STR_LIBDIR) - 1) == 0) - { - errors += trim (&libdir, &line[sizeof(STR_LIBDIR) - 1]); - } - -#undef STR_DL_DEPLIBS -#define STR_DL_DEPLIBS "dependency_libs=" - else if (strncmp (line, STR_DL_DEPLIBS, - sizeof (STR_DL_DEPLIBS) - 1) == 0) - { - errors += trim (&deplibs, &line[sizeof (STR_DL_DEPLIBS) - 1]); - } - else if (strcmp (line, "installed=yes\n") == 0) - { - installed = 1; - } - else if (strcmp (line, "installed=no\n") == 0) - { - installed = 0; - } - -#undef STR_LIBRARY_NAMES -#define STR_LIBRARY_NAMES "library_names=" - else if (! dlname && strncmp (line, STR_LIBRARY_NAMES, - sizeof (STR_LIBRARY_NAMES) - 1) == 0) - { - char *last_libname; - errors += trim (&dlname, &line[sizeof (STR_LIBRARY_NAMES) - 1]); - if (!errors - && dlname - && (last_libname = strrchr (dlname, ' ')) != NULL) - { - last_libname = lt_estrdup (last_libname + 1); - if (!last_libname) - { - ++errors; - goto cleanup; - } - LT_DLMEM_REASSIGN (dlname, last_libname); - } - } - - if (errors) - break; - } - - fclose (file); - LT_DLFREE (line); - - /* allocate the handle */ - *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); - if (*phandle == NULL) - ++errors; - - if (errors) - { - free_vars (dlname, old_name, libdir, deplibs); - LT_DLFREE (*phandle); - goto cleanup; - } - - assert (*phandle); - - memset (*phandle, 0, sizeof(struct lt_dlhandle_struct)); - if (load_deplibs (*phandle, deplibs) == 0) - { - newhandle = *phandle; - /* find_module may replace newhandle */ - if (find_module (&newhandle, dir, libdir, dlname, old_name, installed)) - { - unload_deplibs (*phandle); - ++errors; - } - } - else - { - ++errors; - } - - free_vars (dlname, old_name, libdir, deplibs); - if (errors) - { - LT_DLFREE (*phandle); - goto cleanup; - } - - if (*phandle != newhandle) - { - unload_deplibs (*phandle); - } - } - else - { - /* not a libtool module */ - *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); - if (*phandle == NULL) - { - ++errors; - goto cleanup; - } - - memset (*phandle, 0, sizeof (struct lt_dlhandle_struct)); - newhandle = *phandle; - - /* If the module has no directory name component, try to find it - first in user_search_path and then other prescribed paths. - Otherwise (or in any case if the module was not yet found) try - opening just the module name as passed. */ - if ((dir || (!find_handle (user_search_path, base_name, &newhandle) - && !find_handle (getenv (LTDL_SEARCHPATH_VAR), base_name, - &newhandle) -#ifdef LTDL_SHLIBPATH_VAR - && !find_handle (getenv (LTDL_SHLIBPATH_VAR), base_name, - &newhandle) -#endif -#ifdef LTDL_SYSSEARCHPATH - && !find_handle (sys_search_path, base_name, &newhandle) -#endif - ))) - { - if (tryall_dlopen (&newhandle, filename) != 0) - { - newhandle = NULL; - } - } - - if (!newhandle) - { - LT_DLFREE (*phandle); - ++errors; - goto cleanup; - } - } - - register_handle: - LT_DLMEM_REASSIGN (*phandle, newhandle); - - if ((*phandle)->info.ref_count == 0) - { - (*phandle)->info.ref_count = 1; - LT_DLMEM_REASSIGN ((*phandle)->info.name, name); - - LT_DLMUTEX_LOCK (); - (*phandle)->next = handles; - handles = *phandle; - LT_DLMUTEX_UNLOCK (); - } - - LT_DLMUTEX_SETERROR (saved_error); - - cleanup: - LT_DLFREE (dir); - LT_DLFREE (name); - LT_DLFREE (canonical); - - return errors; -} - -lt_dlhandle -lt_dlopen (filename) - const char *filename; -{ - lt_dlhandle handle = NULL; - - /* Just incase we missed a code path in try_dlopen() that reports - an error, but forgets to reset handle... */ - if (try_dlopen (&handle, filename) != 0) - return 0; - - return handle; -} - -/* If the last error messge store was `FILE_NOT_FOUND', then return - non-zero. */ -static int -file_not_found () -{ - const char *error = NULL; - - LT_DLMUTEX_GETERROR (error); - if (error == LT_DLSTRERROR (FILE_NOT_FOUND)) - return 1; - - return 0; -} - -/* If FILENAME has an ARCHIVE_EXT or SHLIB_EXT extension, try to - open the FILENAME as passed. Otherwise try appending ARCHIVE_EXT, - and if a file is still not found try again with SHLIB_EXT appended - instead. */ -lt_dlhandle -lt_dlopenext (filename) - const char *filename; -{ - lt_dlhandle handle = NULL; - char * tmp = NULL; - char * ext = NULL; - size_t len; - int errors = 0; - - if (!filename) - { - return lt_dlopen (filename); - } - - assert (filename); - - len = LT_STRLEN (filename); - ext = strrchr (filename, '.'); - - /* If FILENAME already bears a suitable extension, there is no need - to try appending additional extensions. */ - if (ext && ((strcmp (ext, archive_ext) == 0) -#ifdef LTDL_SHLIB_EXT - || (strcmp (ext, shlib_ext) == 0) -#endif - )) - { - return lt_dlopen (filename); - } - - /* First try appending ARCHIVE_EXT. */ - tmp = LT_EMALLOC (char, len + LT_STRLEN (archive_ext) + 1); - if (!tmp) - return 0; - - strcpy (tmp, filename); - strcat (tmp, archive_ext); - errors = try_dlopen (&handle, tmp); - - /* If we found FILENAME, stop searching -- whether we were able to - load the file as a module or not. If the file exists but loading - failed, it is better to return an error message here than to - report FILE_NOT_FOUND when the alternatives (foo.so etc) are not - in the module search path. */ - if (handle || ((errors > 0) && !file_not_found ())) - { - LT_DLFREE (tmp); - return handle; - } - -#ifdef LTDL_SHLIB_EXT - /* Try appending SHLIB_EXT. */ - if (LT_STRLEN (shlib_ext) > LT_STRLEN (archive_ext)) - { - LT_DLFREE (tmp); - tmp = LT_EMALLOC (char, len + LT_STRLEN (shlib_ext) + 1); - if (!tmp) - return 0; - - strcpy (tmp, filename); - } - else - { - tmp[len] = LT_EOS_CHAR; - } - - strcat(tmp, shlib_ext); - errors = try_dlopen (&handle, tmp); - - /* As before, if the file was found but loading failed, return now - with the current error message. */ - if (handle || ((errors > 0) && !file_not_found ())) - { - LT_DLFREE (tmp); - return handle; - } -#endif - - /* Still here? Then we really did fail to locate any of the file - names we tried. */ - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); - LT_DLFREE (tmp); - return 0; -} - - -static int -lt_argz_insert (pargz, pargz_len, before, entry) - char **pargz; - size_t *pargz_len; - char *before; - const char *entry; -{ - error_t error; - - if ((error = argz_insert (pargz, pargz_len, before, entry))) - { - switch (error) - { - case ENOMEM: - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); - break; - default: - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (UNKNOWN)); - break; - } - return 1; - } - - return 0; -} - -static int -lt_argz_insertinorder (pargz, pargz_len, entry) - char **pargz; - size_t *pargz_len; - const char *entry; -{ - char *before = NULL; - - assert (pargz); - assert (pargz_len); - assert (entry && *entry); - - if (*pargz) - while ((before = argz_next (*pargz, *pargz_len, before))) - { - int cmp = strcmp (entry, before); - - if (cmp < 0) break; - if (cmp == 0) return 0; /* No duplicates! */ - } - - return lt_argz_insert (pargz, pargz_len, before, entry); -} - -static int -lt_argz_insertdir (pargz, pargz_len, dirnam, dp) - char **pargz; - size_t *pargz_len; - const char *dirnam; - struct dirent *dp; -{ - char *buf = NULL; - size_t buf_len = 0; - char *end = NULL; - size_t end_offset = 0; - size_t dir_len = 0; - int errors = 0; - - assert (pargz); - assert (pargz_len); - assert (dp); - - dir_len = LT_STRLEN (dirnam); - end = dp->d_name + LT_D_NAMLEN(dp); - - /* Ignore version numbers. */ - { - char *p; - for (p = end; p -1 > dp->d_name; --p) - if (strchr (".0123456789", p[-1]) == 0) - break; - - if (*p == '.') - end = p; - } - - /* Ignore filename extension. */ - { - char *p; - for (p = end -1; p > dp->d_name; --p) - if (*p == '.') - { - end = p; - break; - } - } - - /* Prepend the directory name. */ - end_offset = end - dp->d_name; - buf_len = dir_len + 1+ end_offset; - buf = LT_EMALLOC (char, 1+ buf_len); - if (!buf) - return ++errors; - - assert (buf); - - strcpy (buf, dirnam); - strcat (buf, "/"); - strncat (buf, dp->d_name, end_offset); - buf[buf_len] = LT_EOS_CHAR; - - /* Try to insert (in order) into ARGZ/ARGZ_LEN. */ - if (lt_argz_insertinorder (pargz, pargz_len, buf) != 0) - ++errors; - - LT_DLFREE (buf); - - return errors; -} - -static int -list_files_by_dir (dirnam, pargz, pargz_len) - const char *dirnam; - char **pargz; - size_t *pargz_len; -{ - DIR *dirp = NULL; - int errors = 0; - - assert (dirnam && *dirnam); - assert (pargz); - assert (pargz_len); - assert (dirnam[LT_STRLEN(dirnam) -1] != '/'); - - dirp = opendir (dirnam); - if (dirp) - { - struct dirent *dp = NULL; - - while ((dp = readdir (dirp))) - if (dp->d_name[0] != '.') - if (lt_argz_insertdir (pargz, pargz_len, dirnam, dp)) - { - ++errors; - break; - } - - closedir (dirp); - } - else - ++errors; - - return errors; -} - - -/* If there are any files in DIRNAME, call the function passed in - DATA1 (with the name of each file and DATA2 as arguments). */ -static int -foreachfile_callback (dirname, data1, data2) - char *dirname; - lt_ptr data1; - lt_ptr data2; -{ - int (*func) LT_PARAMS((const char *filename, lt_ptr data)) - = (int (*) LT_PARAMS((const char *filename, lt_ptr data))) data1; - - int is_done = 0; - char *argz = NULL; - size_t argz_len = 0; - - if (list_files_by_dir (dirname, &argz, &argz_len) != 0) - goto cleanup; - if (!argz) - goto cleanup; - - { - char *filename = NULL; - while ((filename = argz_next (argz, argz_len, filename))) - if ((is_done = (*func) (filename, data2))) - break; - } - - cleanup: - LT_DLFREE (argz); - - return is_done; -} - - -/* Call FUNC for each unique extensionless file in SEARCH_PATH, along - with DATA. The filenames passed to FUNC would be suitable for - passing to lt_dlopenext. The extensions are stripped so that - individual modules do not generate several entries (e.g. libfoo.la, - libfoo.so, libfoo.so.1, libfoo.so.1.0.0). If SEARCH_PATH is NULL, - then the same directories that lt_dlopen would search are examined. */ -int -lt_dlforeachfile (search_path, func, data) - const char *search_path; - int (*func) LT_PARAMS ((const char *filename, lt_ptr data)); - lt_ptr data; -{ - int is_done = 0; - - if (search_path) - { - /* If a specific path was passed, search only the directories - listed in it. */ - is_done = foreach_dirinpath (search_path, 0, - foreachfile_callback, func, data); - } - else - { - /* Otherwise search the default paths. */ - is_done = foreach_dirinpath (user_search_path, 0, - foreachfile_callback, func, data); - if (!is_done) - { - is_done = foreach_dirinpath (getenv("LTDL_LIBRARY_PATH"), 0, - foreachfile_callback, func, data); - } - -#ifdef LTDL_SHLIBPATH_VAR - if (!is_done) - { - is_done = foreach_dirinpath (getenv(LTDL_SHLIBPATH_VAR), 0, - foreachfile_callback, func, data); - } -#endif -#ifdef LTDL_SYSSEARCHPATH - if (!is_done) - { - is_done = foreach_dirinpath (getenv(LTDL_SYSSEARCHPATH), 0, - foreachfile_callback, func, data); - } -#endif - } - - return is_done; -} - -int -lt_dlclose (handle) - lt_dlhandle handle; -{ - lt_dlhandle cur, last; - int errors = 0; - - LT_DLMUTEX_LOCK (); - - /* check whether the handle is valid */ - last = cur = handles; - while (cur && handle != cur) - { - last = cur; - cur = cur->next; - } - - if (!cur) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); - ++errors; - goto done; - } - - handle->info.ref_count--; - - /* Note that even with resident modules, we must track the ref_count - correctly incase the user decides to reset the residency flag - later (even though the API makes no provision for that at the - moment). */ - if (handle->info.ref_count <= 0 && !LT_DLIS_RESIDENT (handle)) - { - lt_user_data data = handle->loader->dlloader_data; - - if (handle != handles) - { - last->next = handle->next; - } - else - { - handles = handle->next; - } - - errors += handle->loader->module_close (data, handle->module); - errors += unload_deplibs(handle); - - /* It is up to the callers to free the data itself. */ - LT_DLFREE (handle->caller_data); - - LT_DLFREE (handle->info.filename); - LT_DLFREE (handle->info.name); - LT_DLFREE (handle); - - goto done; - } - - if (LT_DLIS_RESIDENT (handle)) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CLOSE_RESIDENT_MODULE)); - ++errors; - } - - done: - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -lt_ptr -lt_dlsym (handle, symbol) - lt_dlhandle handle; - const char *symbol; -{ - size_t lensym; - char lsym[LT_SYMBOL_LENGTH]; - char *sym; - lt_ptr address; - lt_user_data data; - - if (!handle) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); - return 0; - } - - if (!symbol) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - return 0; - } - - lensym = LT_STRLEN (symbol) + LT_STRLEN (handle->loader->sym_prefix) - + LT_STRLEN (handle->info.name); - - if (lensym + LT_SYMBOL_OVERHEAD < LT_SYMBOL_LENGTH) - { - sym = lsym; - } - else - { - sym = LT_EMALLOC (char, lensym + LT_SYMBOL_OVERHEAD + 1); - if (!sym) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (BUFFER_OVERFLOW)); - return 0; - } - } - - data = handle->loader->dlloader_data; - if (handle->info.name) - { - const char *saved_error; - - LT_DLMUTEX_GETERROR (saved_error); - - /* this is a libtool module */ - if (handle->loader->sym_prefix) - { - strcpy(sym, handle->loader->sym_prefix); - strcat(sym, handle->info.name); - } - else - { - strcpy(sym, handle->info.name); - } - - strcat(sym, "_LTX_"); - strcat(sym, symbol); - - /* try "modulename_LTX_symbol" */ - address = handle->loader->find_sym (data, handle->module, sym); - if (address) - { - if (sym != lsym) - { - LT_DLFREE (sym); - } - return address; - } - LT_DLMUTEX_SETERROR (saved_error); - } - - /* otherwise try "symbol" */ - if (handle->loader->sym_prefix) - { - strcpy(sym, handle->loader->sym_prefix); - strcat(sym, symbol); - } - else - { - strcpy(sym, symbol); - } - - address = handle->loader->find_sym (data, handle->module, sym); - if (sym != lsym) - { - LT_DLFREE (sym); - } - - return address; -} - -const char * -lt_dlerror () -{ - const char *error; - - LT_DLMUTEX_GETERROR (error); - LT_DLMUTEX_SETERROR (0); - - return error ? error : LT_DLSTRERROR (UNKNOWN); -} - -static int -lt_dlpath_insertdir (ppath, before, dir) - char **ppath; - char *before; - const char *dir; -{ - int errors = 0; - char *canonical = NULL; - char *argz = NULL; - size_t argz_len = 0; - - assert (ppath); - assert (dir && *dir); - - if (canonicalize_path (dir, &canonical) != 0) - { - ++errors; - goto cleanup; - } - - assert (canonical && *canonical); - - /* If *PPATH is empty, set it to DIR. */ - if (*ppath == NULL) - { - assert (!before); /* BEFORE cannot be set without PPATH. */ - assert (dir); /* Without DIR, don't call this function! */ - - *ppath = lt_estrdup (dir); - if (*ppath == NULL) - ++errors; - - return errors; - } - - assert (ppath && *ppath); - - if (argzize_path (*ppath, &argz, &argz_len) != 0) - { - ++errors; - goto cleanup; - } - - /* Convert BEFORE into an equivalent offset into ARGZ. This only works - if *PPATH is already canonicalized, and hence does not change length - with respect to ARGZ. We canonicalize each entry as it is added to - the search path, and don't call this function with (uncanonicalized) - user paths, so this is a fair assumption. */ - if (before) - { - assert (*ppath <= before); - assert (before - *ppath <= strlen (*ppath)); - - before = before - *ppath + argz; - } - - if (lt_argz_insert (&argz, &argz_len, before, dir) != 0) - { - ++errors; - goto cleanup; - } - - argz_stringify (argz, argz_len, LT_PATHSEP_CHAR); - LT_DLMEM_REASSIGN (*ppath, argz); - - cleanup: - LT_DLFREE (canonical); - LT_DLFREE (argz); - - return errors; -} - -int -lt_dladdsearchdir (search_dir) - const char *search_dir; -{ - int errors = 0; - - if (search_dir && *search_dir) - { - LT_DLMUTEX_LOCK (); - if (lt_dlpath_insertdir (&user_search_path, 0, search_dir) != 0) - ++errors; - LT_DLMUTEX_UNLOCK (); - } - - return errors; -} - -int -lt_dlinsertsearchdir (before, search_dir) - const char *before; - const char *search_dir; -{ - int errors = 0; - - if (before) - { - LT_DLMUTEX_LOCK (); - if ((before < user_search_path) - || (before >= user_search_path + LT_STRLEN (user_search_path))) - { - LT_DLMUTEX_UNLOCK (); - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_POSITION)); - return 1; - } - LT_DLMUTEX_UNLOCK (); - } - - if (search_dir && *search_dir) - { - LT_DLMUTEX_LOCK (); - if (lt_dlpath_insertdir (&user_search_path, - (char *) before, search_dir) != 0) - { - ++errors; - } - LT_DLMUTEX_UNLOCK (); - } - - return errors; -} - -int -lt_dlsetsearchpath (search_path) - const char *search_path; -{ - int errors = 0; - - LT_DLMUTEX_LOCK (); - LT_DLFREE (user_search_path); - LT_DLMUTEX_UNLOCK (); - - if (!search_path || !LT_STRLEN (search_path)) - { - return errors; - } - - LT_DLMUTEX_LOCK (); - if (canonicalize_path (search_path, &user_search_path) != 0) - ++errors; - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -const char * -lt_dlgetsearchpath () -{ - const char *saved_path; - - LT_DLMUTEX_LOCK (); - saved_path = user_search_path; - LT_DLMUTEX_UNLOCK (); - - return saved_path; -} - -int -lt_dlmakeresident (handle) - lt_dlhandle handle; -{ - int errors = 0; - - if (!handle) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); - ++errors; - } - else - { - LT_DLSET_FLAG (handle, LT_DLRESIDENT_FLAG); - } - - return errors; -} - -int -lt_dlisresident (handle) - lt_dlhandle handle; -{ - if (!handle) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); - return -1; - } - - return LT_DLIS_RESIDENT (handle); -} - - - - -/* --- MODULE INFORMATION --- */ - -const lt_dlinfo * -lt_dlgetinfo (handle) - lt_dlhandle handle; -{ - if (!handle) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); - return 0; - } - - return &(handle->info); -} - -lt_dlhandle -lt_dlhandle_next (place) - lt_dlhandle place; -{ - return place ? place->next : handles; -} - -int -lt_dlforeach (func, data) - int (*func) LT_PARAMS((lt_dlhandle handle, lt_ptr data)); - lt_ptr data; -{ - int errors = 0; - lt_dlhandle cur; - - LT_DLMUTEX_LOCK (); - - cur = handles; - while (cur) - { - lt_dlhandle tmp = cur; - - cur = cur->next; - if ((*func) (tmp, data)) - { - ++errors; - break; - } - } - - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -lt_dlcaller_id -lt_dlcaller_register () -{ - static lt_dlcaller_id last_caller_id = 0; - int result; - - LT_DLMUTEX_LOCK (); - result = ++last_caller_id; - LT_DLMUTEX_UNLOCK (); - - return result; -} - -lt_ptr -lt_dlcaller_set_data (key, handle, data) - lt_dlcaller_id key; - lt_dlhandle handle; - lt_ptr data; -{ - int n_elements = 0; - lt_ptr stale = NULL; - int i; - - /* This needs to be locked so that the caller data can be updated - simultaneously by different threads. */ - LT_DLMUTEX_LOCK (); - - if (handle->caller_data) - while (handle->caller_data[n_elements].key) - ++n_elements; - - for (i = 0; i < n_elements; ++i) - { - if (handle->caller_data[i].key == key) - { - stale = handle->caller_data[i].data; - break; - } - } - - /* Ensure that there is enough room in this handle's caller_data - array to accept a new element (and an empty end marker). */ - if (i == n_elements) - { - lt_caller_data *temp - = LT_DLREALLOC (lt_caller_data, handle->caller_data, 2+ n_elements); - - if (!temp) - { - stale = NULL; - goto done; - } - - handle->caller_data = temp; - - /* We only need this if we needed to allocate a new caller_data. */ - handle->caller_data[i].key = key; - handle->caller_data[1+ i].key = 0; - } - - handle->caller_data[i].data = data; - - done: - LT_DLMUTEX_UNLOCK (); - - return stale; -} - -lt_ptr -lt_dlcaller_get_data (key, handle) - lt_dlcaller_id key; - lt_dlhandle handle; -{ - lt_ptr result = (lt_ptr) 0; - - /* This needs to be locked so that the caller data isn't updated by - another thread part way through this function. */ - LT_DLMUTEX_LOCK (); - - /* Locate the index of the element with a matching KEY. */ - { - int i; - for (i = 0; handle->caller_data[i].key; ++i) - { - if (handle->caller_data[i].key == key) - { - result = handle->caller_data[i].data; - break; - } - } - } - - LT_DLMUTEX_UNLOCK (); - - return result; -} - - - -/* --- USER MODULE LOADER API --- */ - - -int -lt_dlloader_add (place, dlloader, loader_name) - lt_dlloader *place; - const struct lt_user_dlloader *dlloader; - const char *loader_name; -{ - int errors = 0; - lt_dlloader *node = NULL, *ptr = NULL; - - if ((dlloader == NULL) /* diagnose null parameters */ - || (dlloader->module_open == NULL) - || (dlloader->module_close == NULL) - || (dlloader->find_sym == NULL)) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); - return 1; - } - - /* Create a new dlloader node with copies of the user callbacks. */ - node = LT_EMALLOC (lt_dlloader, 1); - if (!node) - return 1; - - node->next = NULL; - node->loader_name = loader_name; - node->sym_prefix = dlloader->sym_prefix; - node->dlloader_exit = dlloader->dlloader_exit; - node->module_open = dlloader->module_open; - node->module_close = dlloader->module_close; - node->find_sym = dlloader->find_sym; - node->dlloader_data = dlloader->dlloader_data; - - LT_DLMUTEX_LOCK (); - if (!loaders) - { - /* If there are no loaders, NODE becomes the list! */ - loaders = node; - } - else if (!place) - { - /* If PLACE is not set, add NODE to the end of the - LOADERS list. */ - for (ptr = loaders; ptr->next; ptr = ptr->next) - { - /*NOWORK*/; - } - - ptr->next = node; - } - else if (loaders == place) - { - /* If PLACE is the first loader, NODE goes first. */ - node->next = place; - loaders = node; - } - else - { - /* Find the node immediately preceding PLACE. */ - for (ptr = loaders; ptr->next != place; ptr = ptr->next) - { - /*NOWORK*/; - } - - if (ptr->next != place) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); - ++errors; - } - else - { - /* Insert NODE between PTR and PLACE. */ - node->next = place; - ptr->next = node; - } - } - - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -int -lt_dlloader_remove (loader_name) - const char *loader_name; -{ - lt_dlloader *place = lt_dlloader_find (loader_name); - lt_dlhandle handle; - int errors = 0; - - if (!place) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); - return 1; - } - - LT_DLMUTEX_LOCK (); - - /* Fail if there are any open modules which use this loader. */ - for (handle = handles; handle; handle = handle->next) - { - if (handle->loader == place) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (REMOVE_LOADER)); - ++errors; - goto done; - } - } - - if (place == loaders) - { - /* PLACE is the first loader in the list. */ - loaders = loaders->next; - } - else - { - /* Find the loader before the one being removed. */ - lt_dlloader *prev; - for (prev = loaders; prev->next; prev = prev->next) - { - if (!strcmp (prev->next->loader_name, loader_name)) - { - break; - } - } - - place = prev->next; - prev->next = prev->next->next; - } - - if (place->dlloader_exit) - { - errors = place->dlloader_exit (place->dlloader_data); - } - - LT_DLFREE (place); - - done: - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -lt_dlloader * -lt_dlloader_next (place) - lt_dlloader *place; -{ - lt_dlloader *next; - - LT_DLMUTEX_LOCK (); - next = place ? place->next : loaders; - LT_DLMUTEX_UNLOCK (); - - return next; -} - -const char * -lt_dlloader_name (place) - lt_dlloader *place; -{ - const char *name = NULL; - - if (place) - { - LT_DLMUTEX_LOCK (); - name = place ? place->loader_name : 0; - LT_DLMUTEX_UNLOCK (); - } - else - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); - } - - return name; -} - -lt_user_data * -lt_dlloader_data (place) - lt_dlloader *place; -{ - lt_user_data *data = NULL; - - if (place) - { - LT_DLMUTEX_LOCK (); - data = place ? &(place->dlloader_data) : 0; - LT_DLMUTEX_UNLOCK (); - } - else - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); - } - - return data; -} - -lt_dlloader * -lt_dlloader_find (loader_name) - const char *loader_name; -{ - lt_dlloader *place = NULL; - - LT_DLMUTEX_LOCK (); - for (place = loaders; place; place = place->next) - { - if (strcmp (place->loader_name, loader_name) == 0) - { - break; - } - } - LT_DLMUTEX_UNLOCK (); - - return place; -} diff --git a/libguile-ltdl/raw-ltdl.h b/libguile-ltdl/raw-ltdl.h index 524ac8271..e69de29bb 100644 --- a/libguile-ltdl/raw-ltdl.h +++ b/libguile-ltdl/raw-ltdl.h @@ -1,344 +0,0 @@ -/* ltdl.h -- generic dlopen functions - Copyright (C) 1998-2000, 2002 Free Software Foundation, Inc. - Originally by Thomas Tanner <tanner@ffii.org> - This file is part of GNU Libtool. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Lesser General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -As a special exception to the GNU Lesser General Public License, -if you distribute this file as part of a program or library that -is built using GNU libtool, you may include it under the same -distribution terms that you use for the rest of that program. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with this library; if not, write to the Free -Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -02110-1301 USA -*/ - -/* Only include this header file once. */ -#ifndef LTDL_H -#define LTDL_H 1 - -#include "guile-ltdl.h" - -#include <sys/types.h> /* for size_t declaration */ - - -/* --- MACROS FOR PORTABILITY --- */ - -/* LTDL_BEGIN_C_DECLS should be used at the beginning of your declarations, - so that C++ compilers don't mangle their names. Use LTDL_END_C_DECLS at - the end of C declarations. */ -#ifdef __cplusplus -# define LT_BEGIN_C_DECLS extern "C" { -# define LT_END_C_DECLS } -#else -# define LT_BEGIN_C_DECLS /* empty */ -# define LT_END_C_DECLS /* empty */ -#endif - -LT_BEGIN_C_DECLS - - -/* LT_PARAMS is a macro used to wrap function prototypes, so that compilers - that don't understand ANSI C prototypes still work, and ANSI C - compilers can issue warnings about type mismatches. */ -#if defined (__STDC__) || defined (_AIX) || (defined (__mips) && defined (_SYSTYPE_SVR4)) || defined(WIN32) || defined(__cplusplus) -# define LT_PARAMS(protos) protos -# define lt_ptr void* -#else -# define LT_PARAMS(protos) () -# define lt_ptr char* -#endif - -/* LT_STMT_START/END are used to create macros which expand to a - a single compound statement in a portable way. */ -#if defined (__GNUC__) && !defined (__STRICT_ANSI__) && !defined (__cplusplus) -# define LT_STMT_START (void)( -# define LT_STMT_END ) -#else -# if (defined (sun) || defined (__sun__)) -# define LT_STMT_START if (1) -# define LT_STMT_END else (void)0 -# else -# define LT_STMT_START do -# define LT_STMT_END while (0) -# endif -#endif - -/* LT_CONC creates a new concatenated symbol for the compiler - in a portable way. */ -#if defined(__STDC__) || defined(__cplusplus) -# define LT_CONC(s,t) s##t -#else -# define LT_CONC(s,t) s/**/t -#endif - -/* LT_STRLEN can be used safely on NULL pointers. */ -#define LT_STRLEN(s) (((s) && (s)[0]) ? strlen (s) : 0) - - - -/* --- WINDOWS SUPPORT --- */ - - -/* Canonicalise Windows and Cygwin recognition macros. */ -#ifdef __CYGWIN32__ -# ifndef __CYGWIN__ -# define __CYGWIN__ __CYGWIN32__ -# endif -#endif -#if defined(_WIN32) || defined(WIN32) -# ifndef __WINDOWS__ -# ifdef _WIN32 -# define __WINDOWS__ _WIN32 -# else -# ifdef WIN32 -# define __WINDOWS__ WIN32 -# endif -# endif -# endif -#endif - -#ifdef __WINDOWS__ -# ifndef __CYGWIN__ -/* LT_DIRSEP_CHAR is accepted *in addition* to '/' as a directory - separator when it is set. */ -# define LT_DIRSEP_CHAR '\\' -# define LT_PATHSEP_CHAR ';' -# endif -#endif -#ifndef LT_PATHSEP_CHAR -# define LT_PATHSEP_CHAR ':' -#endif - -/* DLL building support on win32 hosts; mostly to workaround their - ridiculous implementation of data symbol exporting. */ -#ifndef LT_SCOPE -# ifdef __WINDOWS__ -# ifdef DLL_EXPORT /* defined by libtool (if required) */ -# define LT_SCOPE __declspec(dllexport) -# endif -# ifdef LIBLTDL_DLL_IMPORT /* define if linking with this dll */ -# define LT_SCOPE extern __declspec(dllimport) -# endif -# endif -# ifndef LT_SCOPE /* static linking or !__WINDOWS__ */ -# define LT_SCOPE extern -# endif -#endif - - - - -/* --- DYNAMIC MODULE LOADING API --- */ - - -typedef struct lt_dlhandle_struct *lt_dlhandle; /* A loaded module. */ - -/* Initialisation and finalisation functions for libltdl. */ -SCMLTXT int lt_dlinit LT_PARAMS((void)); -SCMLTXT int lt_dlexit LT_PARAMS((void)) SCM_UNUSED; - -/* Module search path manipulation. */ -SCMLTXT int lt_dladdsearchdir LT_PARAMS((const char *search_dir)) SCM_UNUSED; -SCMLTXT int lt_dlinsertsearchdir LT_PARAMS((const char *before, - const char *search_dir)) SCM_UNUSED; -SCMLTXT int lt_dlsetsearchpath LT_PARAMS((const char *search_path)) SCM_UNUSED; -SCMLTXT const char *lt_dlgetsearchpath LT_PARAMS((void)) SCM_UNUSED; -SCMLTXT int lt_dlforeachfile LT_PARAMS(( - const char *search_path, - int (*func) (const char *filename, lt_ptr data), - lt_ptr data)) SCM_UNUSED; - -/* Portable libltdl versions of the system dlopen() API. */ -SCMLTXT lt_dlhandle lt_dlopen LT_PARAMS((const char *filename)); -SCMLTXT lt_dlhandle lt_dlopenext LT_PARAMS((const char *filename)); -SCMLTXT lt_ptr lt_dlsym LT_PARAMS((lt_dlhandle handle, - const char *name)); -SCMLTXT const char *lt_dlerror LT_PARAMS((void)); -SCMLTXT int lt_dlclose LT_PARAMS((lt_dlhandle handle)); - -/* Module residency management. */ -SCMLTXT int lt_dlmakeresident LT_PARAMS((lt_dlhandle handle)) SCM_UNUSED; -SCMLTXT int lt_dlisresident LT_PARAMS((lt_dlhandle handle)) SCM_UNUSED; - - - - -/* --- MUTEX LOCKING --- */ - - -typedef void lt_dlmutex_lock LT_PARAMS((void)); -typedef void lt_dlmutex_unlock LT_PARAMS((void)); -typedef void lt_dlmutex_seterror LT_PARAMS((const char *errmsg)); -typedef const char *lt_dlmutex_geterror LT_PARAMS((void)); - -SCMLTXT int lt_dlmutex_register LT_PARAMS((lt_dlmutex_lock *lock, - lt_dlmutex_unlock *unlock, - lt_dlmutex_seterror *seterror, - lt_dlmutex_geterror *geterror)) SCM_UNUSED; - - - - -/* --- MEMORY HANDLING --- */ - - -/* By default, the realloc function pointer is set to our internal - realloc implementation which iself uses lt_dlmalloc and lt_dlfree. - libltdl relies on a featureful realloc, but if you are sure yours - has the right semantics then you can assign it directly. Generally, - it is safe to assign just a malloc() and a free() function. */ -LT_SCOPE lt_ptr (*lt_dlmalloc) LT_PARAMS((size_t size)); -LT_SCOPE lt_ptr (*lt_dlrealloc) LT_PARAMS((lt_ptr ptr, size_t size)) SCM_UNUSED; -LT_SCOPE void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)); - - - - -/* --- PRELOADED MODULE SUPPORT --- */ - - -/* A preopened symbol. Arrays of this type comprise the exported - symbols for a dlpreopened module. */ -typedef struct SCM_INSERTED_DLSYMLIST_STRUCT_DECL { - const char *name; - lt_ptr address; -} lt_dlsymlist; - -SCMLTXT int lt_dlpreload LT_PARAMS((const lt_dlsymlist *preloaded)); -SCMLTXT int lt_dlpreload_default - LT_PARAMS((const lt_dlsymlist *preloaded)); - -#define LTDL_SET_PRELOADED_SYMBOLS() LT_STMT_START{ \ - extern const lt_dlsymlist lt_preloaded_symbols[]; \ - lt_dlpreload_default(lt_preloaded_symbols); \ - }LT_STMT_END - - - - -/* --- MODULE INFORMATION --- */ - - -/* Read only information pertaining to a loaded module. */ -typedef struct { - char *filename; /* file name */ - char *name; /* module name */ - int ref_count; /* number of times lt_dlopened minus - number of times lt_dlclosed. */ -} lt_dlinfo; - -SCMLTXT const lt_dlinfo *lt_dlgetinfo LT_PARAMS((lt_dlhandle handle)) SCM_UNUSED; -SCMLTXT lt_dlhandle lt_dlhandle_next LT_PARAMS((lt_dlhandle place)) SCM_UNUSED; -SCMLTXT int lt_dlforeach LT_PARAMS(( - int (*func) (lt_dlhandle handle, lt_ptr data), - lt_ptr data)) SCM_UNUSED; - -/* Associating user data with loaded modules. */ -typedef unsigned lt_dlcaller_id; - -SCMLTXT lt_dlcaller_id lt_dlcaller_register LT_PARAMS((void)) SCM_UNUSED; -SCMLTXT lt_ptr lt_dlcaller_set_data LT_PARAMS((lt_dlcaller_id key, - lt_dlhandle handle, - lt_ptr data)) SCM_UNUSED; -SCMLTXT lt_ptr lt_dlcaller_get_data LT_PARAMS((lt_dlcaller_id key, - lt_dlhandle handle)) SCM_UNUSED; - - - -/* --- USER MODULE LOADER API --- */ - - -typedef struct lt_dlloader lt_dlloader; -typedef lt_ptr lt_user_data; -typedef lt_ptr lt_module; - -/* Function pointer types for creating user defined module loaders. */ -typedef lt_module lt_module_open LT_PARAMS((lt_user_data loader_data, - const char *filename)); -typedef int lt_module_close LT_PARAMS((lt_user_data loader_data, - lt_module handle)); -typedef lt_ptr lt_find_sym LT_PARAMS((lt_user_data loader_data, - lt_module handle, - const char *symbol)); -typedef int lt_dlloader_exit LT_PARAMS((lt_user_data loader_data)); - -struct lt_user_dlloader { - const char *sym_prefix; - lt_module_open *module_open; - lt_module_close *module_close; - lt_find_sym *find_sym; - lt_dlloader_exit *dlloader_exit; - lt_user_data dlloader_data; -}; - -SCMLTXT lt_dlloader *lt_dlloader_next LT_PARAMS((lt_dlloader *place)); -SCMLTXT lt_dlloader *lt_dlloader_find LT_PARAMS(( - const char *loader_name)); -SCMLTXT const char *lt_dlloader_name LT_PARAMS((lt_dlloader *place)) SCM_UNUSED; -SCMLTXT lt_user_data *lt_dlloader_data LT_PARAMS((lt_dlloader *place)) SCM_UNUSED; -SCMLTXT int lt_dlloader_add LT_PARAMS((lt_dlloader *place, - const struct lt_user_dlloader *dlloader, - const char *loader_name)); -SCMLTXT int lt_dlloader_remove LT_PARAMS(( - const char *loader_name)) SCM_UNUSED; - - - -/* --- ERROR MESSAGE HANDLING --- */ - - -/* Defining error strings alongside their symbolic names in a macro in - this way allows us to expand the macro in different contexts with - confidence that the enumeration of symbolic names will map correctly - onto the table of error strings. */ -#define lt_dlerror_table \ - LT_ERROR(UNKNOWN, "unknown error") \ - LT_ERROR(DLOPEN_NOT_SUPPORTED, "dlopen support not available") \ - LT_ERROR(INVALID_LOADER, "invalid loader") \ - LT_ERROR(INIT_LOADER, "loader initialization failed") \ - LT_ERROR(REMOVE_LOADER, "loader removal failed") \ - LT_ERROR(FILE_NOT_FOUND, "file not found") \ - LT_ERROR(DEPLIB_NOT_FOUND, "dependency library not found") \ - LT_ERROR(NO_SYMBOLS, "no symbols defined") \ - LT_ERROR(CANNOT_OPEN, "can't open the module") \ - LT_ERROR(CANNOT_CLOSE, "can't close the module") \ - LT_ERROR(SYMBOL_NOT_FOUND, "symbol not found") \ - LT_ERROR(NO_MEMORY, "not enough memory") \ - LT_ERROR(INVALID_HANDLE, "invalid module handle") \ - LT_ERROR(BUFFER_OVERFLOW, "internal buffer overflow") \ - LT_ERROR(INVALID_ERRORCODE, "invalid errorcode") \ - LT_ERROR(SHUTDOWN, "library already shutdown") \ - LT_ERROR(CLOSE_RESIDENT_MODULE, "can't close resident module") \ - LT_ERROR(INVALID_MUTEX_ARGS, "invalid mutex handler registration") \ - LT_ERROR(INVALID_POSITION, "invalid search path insert position") - -/* Enumerate the symbolic error names. */ -enum { -#define LT_ERROR(name, diagnostic) LT_CONC(LT_ERROR_, name), - lt_dlerror_table -#undef LT_ERROR - - LT_ERROR_MAX -}; - -/* These functions are only useful from inside custom module loaders. */ -SCMLTXT int lt_dladderror LT_PARAMS((const char *diagnostic)) SCM_UNUSED; -SCMLTXT int lt_dlseterror LT_PARAMS((int errorcode)) SCM_UNUSED; - - - -LT_END_C_DECLS - -#endif /* !LTDL_H */ diff --git a/libguile-ltdl/upstream/Makefile.am b/libguile-ltdl/upstream/Makefile.am index 147b4f769..e69de29bb 100644 --- a/libguile-ltdl/upstream/Makefile.am +++ b/libguile-ltdl/upstream/Makefile.am @@ -1,63 +0,0 @@ -## Process this file with Automake to create Makefile.in -## -## Copyright (C) 2002 Free Software Foundation, Inc. -## -## This file is part of GUILE. -## -## GUILE is free software; you can redistribute it and/or modify -## it under the terms of the GNU General Public License as -## published by the Free Software Foundation; either version 2, or -## (at your option) any later version. -## -## GUILE is distributed in the hope that it will be useful, but -## WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public -## License along with GUILE; see the file COPYING. If not, write -## to the Free Software Foundation, Inc., 51 Franklin Street, Fifth -## Floor, Boston, MA 02110-1301 USA - -AUTOMAKE_OPTIONS = gnu - -## Prevent automake from adding extra -I options -DEFS = @DEFS@ -## Check for headers in $(srcdir)/.., so that #include -## <libguile/MUMBLE.h> will find MUMBLE.h in this dir when we're -## building. -INCLUDES = -I.. -I$(srcdir)/.. - -ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_LONG\).*\"\([^\"]\)*\"/\3/' \ - --regex='/[ \t]*SCM_[G]?DEFINE1?[ \t]*(\([^,]*\),[^,]*/\1/' - -EXTRA_DIST := ltdl.h ltdl.c ltdl.h.diff ltdl.c.diff -BUILT_SOURCES := ltdl.h.diff ltdl.c.diff - -ltdl.h.diff: ltdl.h $(srcdir)/../raw-ltdl.h - cp $(srcdir)/../raw-ltdl.h raw-ltdl.guilemod.h.tmp - perl -pi \ - -e 's/SCMLTXT/extern/go;' \ - -e 's/SCMLTSTATIC //go;' \ - -e 's/ SCM_UNUSED//go;' \ - -e 's/SCM_INSERTED_DLSYMLIST_STRUCT_DECL //go;' \ - raw-ltdl.guilemod.h.tmp - mv raw-ltdl.guilemod.h.tmp raw-ltdl.guilemod.h - diff -ru $(srcdir)/ltdl.h raw-ltdl.guilemod.h > ltdl.h.diff; \ - test "$$?" -eq 1 - -ltdl.c.diff: ltdl.c $(srcdir)/../raw-ltdl.c - cp $(srcdir)/../raw-ltdl.c raw-ltdl.guilemod.c.tmp - perl -pi \ - -e 's/SCMLTXT/extern/go;' \ - -e 's/SCMLTSTATIC //go;' \ - -e 's/ SCM_UNUSED//go;' \ - -e 's/SCM_INSERTED_DLSYMLIST_STRUCT_DECL //go;' \ - raw-ltdl.guilemod.c.tmp - mv raw-ltdl.guilemod.c.tmp raw-ltdl.guilemod.c - diff -ru $(srcdir)/ltdl.c raw-ltdl.guilemod.c > ltdl.c.diff; \ - test "$$?" -eq 1 - -CLEANFILES := \ - raw-ltdl.guilemod.h raw-ltdl.guilemod.c \ - raw-ltdl.guilemod.h.tmp raw-ltdl.guilemod.c.tmp diff --git a/libguile-ltdl/upstream/ltdl.c b/libguile-ltdl/upstream/ltdl.c index 8bc6f2586..e69de29bb 100644 --- a/libguile-ltdl/upstream/ltdl.c +++ b/libguile-ltdl/upstream/ltdl.c @@ -1,3999 +0,0 @@ -/* ltdl.c -- system independent dlopen wrapper - Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. - Originally by Thomas Tanner <tanner@ffii.org> - This file is part of GNU Libtool. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Lesser General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -As a special exception to the GNU Lesser General Public License, -if you distribute this file as part of a program or library that -is built using GNU libtool, you may include it under the same -distribution terms that you use for the rest of that program. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with this library; if not, write to the Free Software -Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -02110-1301 USA - -*/ - -#if HAVE_CONFIG_H -# include <config.h> -#endif - -#if HAVE_UNISTD_H -# include <unistd.h> -#endif - -#if HAVE_STDIO_H -# include <stdio.h> -#endif - -#if HAVE_STDLIB_H -# include <stdlib.h> -#endif - -#if HAVE_STRING_H -# include <string.h> -#else -# if HAVE_STRINGS_H -# include <strings.h> -# endif -#endif - -#if HAVE_CTYPE_H -# include <ctype.h> -#endif - -#if HAVE_MALLOC_H -# include <malloc.h> -#endif - -#if HAVE_MEMORY_H -# include <memory.h> -#endif - -#if HAVE_ERRNO_H -# include <errno.h> -#endif - -#if HAVE_DIRENT_H -# include <dirent.h> -# define LT_D_NAMLEN(dirent) (strlen((dirent)->d_name)) -#else -# define dirent direct -# define LT_D_NAMLEN(dirent) ((dirent)->d_namlen) -# if HAVE_SYS_NDIR_H -# include <sys/ndir.h> -# endif -# if HAVE_SYS_DIR_H -# include <sys/dir.h> -# endif -# if HAVE_NDIR_H -# include <ndir.h> -# endif -#endif - -#if HAVE_ARGZ_H -# include <argz.h> -#endif - -#if HAVE_ASSERT_H -# include <assert.h> -#else -# define assert(arg) ((void) 0) -#endif - -#include "ltdl.h" - -#if WITH_DMALLOC -# include <dmalloc.h> -#endif - - - - -/* --- WINDOWS SUPPORT --- */ - - -#ifdef DLL_EXPORT -# define LT_GLOBAL_DATA __declspec(dllexport) -#else -# define LT_GLOBAL_DATA -#endif - -/* fopen() mode flags for reading a text file */ -#undef LT_READTEXT_MODE -#ifdef __WINDOWS__ -# define LT_READTEXT_MODE "rt" -#else -# define LT_READTEXT_MODE "r" -#endif - - - - -/* --- MANIFEST CONSTANTS --- */ - - -/* Standard libltdl search path environment variable name */ -#undef LTDL_SEARCHPATH_VAR -#define LTDL_SEARCHPATH_VAR "LTDL_LIBRARY_PATH" - -/* Standard libtool archive file extension. */ -#undef LTDL_ARCHIVE_EXT -#define LTDL_ARCHIVE_EXT ".la" - -/* max. filename length */ -#ifndef LT_FILENAME_MAX -# define LT_FILENAME_MAX 1024 -#endif - -/* This is the maximum symbol size that won't require malloc/free */ -#undef LT_SYMBOL_LENGTH -#define LT_SYMBOL_LENGTH 128 - -/* This accounts for the _LTX_ separator */ -#undef LT_SYMBOL_OVERHEAD -#define LT_SYMBOL_OVERHEAD 5 - - - - -/* --- MEMORY HANDLING --- */ - - -/* These are the functions used internally. In addition to making - use of the associated function pointers above, they also perform - error handling. */ -static char *lt_estrdup LT_PARAMS((const char *str)); -static lt_ptr lt_emalloc LT_PARAMS((size_t size)); -static lt_ptr lt_erealloc LT_PARAMS((lt_ptr addr, size_t size)); - -static lt_ptr rpl_realloc LT_PARAMS((lt_ptr ptr, size_t size)); - -/* These are the pointers that can be changed by the caller: */ -LT_GLOBAL_DATA lt_ptr (*lt_dlmalloc) LT_PARAMS((size_t size)) - = (lt_ptr (*) LT_PARAMS((size_t))) malloc; -LT_GLOBAL_DATA lt_ptr (*lt_dlrealloc) LT_PARAMS((lt_ptr ptr, size_t size)) - = (lt_ptr (*) LT_PARAMS((lt_ptr, size_t))) rpl_realloc; -LT_GLOBAL_DATA void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)) - = (void (*) LT_PARAMS((lt_ptr))) free; - -/* The following macros reduce the amount of typing needed to cast - assigned memory. */ -#if WITH_DMALLOC - -#define LT_DLMALLOC(tp, n) ((tp *) xmalloc ((n) * sizeof(tp))) -#define LT_DLREALLOC(tp, p, n) ((tp *) xrealloc ((p), (n) * sizeof(tp))) -#define LT_DLFREE(p) \ - LT_STMT_START { if (p) (p) = (xfree (p), (lt_ptr) 0); } LT_STMT_END - -#define LT_EMALLOC(tp, n) ((tp *) xmalloc ((n) * sizeof(tp))) -#define LT_EREALLOC(tp, p, n) ((tp *) xrealloc ((p), (n) * sizeof(tp))) - -#else - -#define LT_DLMALLOC(tp, n) ((tp *) lt_dlmalloc ((n) * sizeof(tp))) -#define LT_DLREALLOC(tp, p, n) ((tp *) rpl_realloc ((p), (n) * sizeof(tp))) -#define LT_DLFREE(p) \ - LT_STMT_START { if (p) (p) = (lt_dlfree (p), (lt_ptr) 0); } LT_STMT_END - -#define LT_EMALLOC(tp, n) ((tp *) lt_emalloc ((n) * sizeof(tp))) -#define LT_EREALLOC(tp, p, n) ((tp *) lt_erealloc ((p), (n) * sizeof(tp))) - -#endif - -#define LT_DLMEM_REASSIGN(p, q) LT_STMT_START { \ - if ((p) != (q)) { if (p) lt_dlfree (p); (p) = (q); (q) = 0; } \ - } LT_STMT_END - - -/* --- REPLACEMENT FUNCTIONS --- */ - - -#undef strdup -#define strdup rpl_strdup - -static char *strdup LT_PARAMS((const char *str)); - -static char * -strdup(str) - const char *str; -{ - char *tmp = NULL; - - if (str) - { - tmp = LT_DLMALLOC (char, 1+ strlen (str)); - if (tmp) - { - strcpy(tmp, str); - } - } - - return tmp; -} - - -#if ! HAVE_STRCMP - -#undef strcmp -#define strcmp rpl_strcmp - -static int strcmp LT_PARAMS((const char *str1, const char *str2)); - -static int -strcmp (str1, str2) - const char *str1; - const char *str2; -{ - if (str1 == str2) - return 0; - if (str1 == NULL) - return -1; - if (str2 == NULL) - return 1; - - for (;*str1 && *str2; ++str1, ++str2) - { - if (*str1 != *str2) - break; - } - - return (int)(*str1 - *str2); -} -#endif - - -#if ! HAVE_STRCHR - -# if HAVE_INDEX -# define strchr index -# else -# define strchr rpl_strchr - -static const char *strchr LT_PARAMS((const char *str, int ch)); - -static const char* -strchr(str, ch) - const char *str; - int ch; -{ - const char *p; - - for (p = str; *p != (char)ch && *p != LT_EOS_CHAR; ++p) - /*NOWORK*/; - - return (*p == (char)ch) ? p : 0; -} - -# endif -#endif /* !HAVE_STRCHR */ - - -#if ! HAVE_STRRCHR - -# if HAVE_RINDEX -# define strrchr rindex -# else -# define strrchr rpl_strrchr - -static const char *strrchr LT_PARAMS((const char *str, int ch)); - -static const char* -strrchr(str, ch) - const char *str; - int ch; -{ - const char *p, *q = NULL; - - for (p = str; *p != LT_EOS_CHAR; ++p) - { - if (*p == (char) ch) - { - q = p; - } - } - - return q; -} - -# endif -#endif - -/* NOTE: Neither bcopy nor the memcpy implementation below can - reliably handle copying in overlapping areas of memory. Use - memmove (for which there is a fallback implmentation below) - if you need that behaviour. */ -#if ! HAVE_MEMCPY - -# if HAVE_BCOPY -# define memcpy(dest, src, size) bcopy (src, dest, size) -# else -# define memcpy rpl_memcpy - -static lt_ptr memcpy LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size)); - -static lt_ptr -memcpy (dest, src, size) - lt_ptr dest; - const lt_ptr src; - size_t size; -{ - size_t i = 0; - - for (i = 0; i < size; ++i) - { - dest[i] = src[i]; - } - - return dest; -} - -# endif /* !HAVE_BCOPY */ -#endif /* !HAVE_MEMCPY */ - -#if ! HAVE_MEMMOVE -# define memmove rpl_memmove - -static lt_ptr memmove LT_PARAMS((lt_ptr dest, const lt_ptr src, size_t size)); - -static lt_ptr -memmove (dest, src, size) - lt_ptr dest; - const lt_ptr src; - size_t size; -{ - size_t i; - - if (dest < src) - for (i = 0; i < size; ++i) - { - dest[i] = src[i]; - } - else if (dest > src) - for (i = size -1; i >= 0; --i) - { - dest[i] = src[i]; - } - - return dest; -} - -#endif /* !HAVE_MEMMOVE */ - - -/* According to Alexandre Oliva <oliva@lsd.ic.unicamp.br>, - ``realloc is not entirely portable'' - In any case we want to use the allocator supplied by the user without - burdening them with an lt_dlrealloc function pointer to maintain. - Instead implement our own version (with known boundary conditions) - using lt_dlmalloc and lt_dlfree. */ - -#undef realloc -#define realloc rpl_realloc - -static lt_ptr -realloc (ptr, size) - lt_ptr ptr; - size_t size; -{ - if (size == 0) - { - /* For zero or less bytes, free the original memory */ - if (ptr != NULL) - { - lt_dlfree (ptr); - } - - return (lt_ptr) 0; - } - else if (ptr == NULL) - { - /* Allow reallocation of a NULL pointer. */ - return lt_dlmalloc (size); - } - else - { - /* Allocate a new block, copy and free the old block. */ - lt_ptr mem = lt_dlmalloc (size); - - if (mem) - { - memcpy (mem, ptr, size); - lt_dlfree (ptr); - } - - /* Note that the contents of PTR are not damaged if there is - insufficient memory to realloc. */ - return mem; - } -} - - -#if ! HAVE_ARGZ_APPEND -# define argz_append rpl_argz_append - -static error_t argz_append LT_PARAMS((char **pargz, size_t *pargz_len, - const char *buf, size_t buf_len)); - -static error_t -argz_append (pargz, pargz_len, buf, buf_len) - char **pargz; - size_t *pargz_len; - const char *buf; - size_t buf_len; -{ - size_t argz_len; - char *argz; - - assert (pargz); - assert (pargz_len); - assert ((*pargz && *pargz_len) || (!*pargz && !*pargz_len)); - - /* If nothing needs to be appended, no more work is required. */ - if (buf_len == 0) - return 0; - - /* Ensure there is enough room to append BUF_LEN. */ - argz_len = *pargz_len + buf_len; - argz = LT_DLREALLOC (char, *pargz, argz_len); - if (!argz) - return ENOMEM; - - /* Copy characters from BUF after terminating '\0' in ARGZ. */ - memcpy (argz + *pargz_len, buf, buf_len); - - /* Assign new values. */ - *pargz = argz; - *pargz_len = argz_len; - - return 0; -} -#endif /* !HAVE_ARGZ_APPEND */ - - -#if ! HAVE_ARGZ_CREATE_SEP -# define argz_create_sep rpl_argz_create_sep - -static error_t argz_create_sep LT_PARAMS((const char *str, int delim, - char **pargz, size_t *pargz_len)); - -static error_t -argz_create_sep (str, delim, pargz, pargz_len) - const char *str; - int delim; - char **pargz; - size_t *pargz_len; -{ - size_t argz_len; - char *argz = NULL; - - assert (str); - assert (pargz); - assert (pargz_len); - - /* Make a copy of STR, but replacing each occurence of - DELIM with '\0'. */ - argz_len = 1+ LT_STRLEN (str); - if (argz_len) - { - const char *p; - char *q; - - argz = LT_DLMALLOC (char, argz_len); - if (!argz) - return ENOMEM; - - for (p = str, q = argz; *p != LT_EOS_CHAR; ++p) - { - if (*p == delim) - { - /* Ignore leading delimiters, and fold consecutive - delimiters in STR into a single '\0' in ARGZ. */ - if ((q > argz) && (q[-1] != LT_EOS_CHAR)) - *q++ = LT_EOS_CHAR; - else - --argz_len; - } - else - *q++ = *p; - } - /* Copy terminating LT_EOS_CHAR. */ - *q = *p; - } - - /* If ARGZ_LEN has shrunk to nothing, release ARGZ's memory. */ - if (!argz_len) - LT_DLFREE (argz); - - /* Assign new values. */ - *pargz = argz; - *pargz_len = argz_len; - - return 0; -} -#endif /* !HAVE_ARGZ_CREATE_SEP */ - - -#if ! HAVE_ARGZ_INSERT -# define argz_insert rpl_argz_insert - -static error_t argz_insert LT_PARAMS((char **pargz, size_t *pargz_len, - char *before, const char *entry)); - -static error_t -argz_insert (pargz, pargz_len, before, entry) - char **pargz; - size_t *pargz_len; - char *before; - const char *entry; -{ - assert (pargz); - assert (pargz_len); - assert (entry && *entry); - - /* No BEFORE address indicates ENTRY should be inserted after the - current last element. */ - if (!before) - return argz_append (pargz, pargz_len, entry, 1+ LT_STRLEN (entry)); - - /* This probably indicates a programmer error, but to preserve - semantics, scan back to the start of an entry if BEFORE points - into the middle of it. */ - while ((before >= *pargz) && (before[-1] != LT_EOS_CHAR)) - --before; - - { - size_t entry_len = 1+ LT_STRLEN (entry); - size_t argz_len = *pargz_len + entry_len; - size_t offset = before - *pargz; - char *argz = LT_DLREALLOC (char, *pargz, argz_len); - - if (!argz) - return ENOMEM; - - /* Make BEFORE point to the equivalent offset in ARGZ that it - used to have in *PARGZ incase realloc() moved the block. */ - before = argz + offset; - - /* Move the ARGZ entries starting at BEFORE up into the new - space at the end -- making room to copy ENTRY into the - resulting gap. */ - memmove (before + entry_len, before, *pargz_len - offset); - memcpy (before, entry, entry_len); - - /* Assign new values. */ - *pargz = argz; - *pargz_len = argz_len; - } - - return 0; -} -#endif /* !HAVE_ARGZ_INSERT */ - - -#if ! HAVE_ARGZ_NEXT -# define argz_next rpl_argz_next - -static char *argz_next LT_PARAMS((char *argz, size_t argz_len, - const char *entry)); - -static char * -argz_next (argz, argz_len, entry) - char *argz; - size_t argz_len; - const char *entry; -{ - assert ((argz && argz_len) || (!argz && !argz_len)); - - if (entry) - { - /* Either ARGZ/ARGZ_LEN is empty, or ENTRY points into an address - within the ARGZ vector. */ - assert ((!argz && !argz_len) - || ((argz <= entry) && (entry < (argz + argz_len)))); - - /* Move to the char immediately after the terminating - '\0' of ENTRY. */ - entry = 1+ strchr (entry, LT_EOS_CHAR); - - /* Return either the new ENTRY, or else NULL if ARGZ is - exhausted. */ - return (entry >= argz + argz_len) ? 0 : (char *) entry; - } - else - { - /* This should probably be flagged as a programmer error, - since starting an argz_next loop with the iterator set - to ARGZ is safer. To preserve semantics, handle the NULL - case by returning the start of ARGZ (if any). */ - if (argz_len > 0) - return argz; - else - return 0; - } -} -#endif /* !HAVE_ARGZ_NEXT */ - - - -#if ! HAVE_ARGZ_STRINGIFY -# define argz_stringify rpl_argz_stringify - -static void argz_stringify LT_PARAMS((char *argz, size_t argz_len, - int sep)); - -static void -argz_stringify (argz, argz_len, sep) - char *argz; - size_t argz_len; - int sep; -{ - assert ((argz && argz_len) || (!argz && !argz_len)); - - if (sep) - { - --argz_len; /* don't stringify the terminating EOS */ - while (--argz_len > 0) - { - if (argz[argz_len] == LT_EOS_CHAR) - argz[argz_len] = sep; - } - } -} -#endif /* !HAVE_ARGZ_STRINGIFY */ - - - - -/* --- TYPE DEFINITIONS -- */ - - -/* This type is used for the array of caller data sets in each handler. */ -typedef struct { - lt_dlcaller_id key; - lt_ptr data; -} lt_caller_data; - - - - -/* --- OPAQUE STRUCTURES DECLARED IN LTDL.H --- */ - - -/* Extract the diagnostic strings from the error table macro in the same - order as the enumerated indices in ltdl.h. */ - -static const char *lt_dlerror_strings[] = - { -#define LT_ERROR(name, diagnostic) (diagnostic), - lt_dlerror_table -#undef LT_ERROR - - 0 - }; - -/* This structure is used for the list of registered loaders. */ -struct lt_dlloader { - struct lt_dlloader *next; - const char *loader_name; /* identifying name for each loader */ - const char *sym_prefix; /* prefix for symbols */ - lt_module_open *module_open; - lt_module_close *module_close; - lt_find_sym *find_sym; - lt_dlloader_exit *dlloader_exit; - lt_user_data dlloader_data; -}; - -struct lt_dlhandle_struct { - struct lt_dlhandle_struct *next; - lt_dlloader *loader; /* dlopening interface */ - lt_dlinfo info; - int depcount; /* number of dependencies */ - lt_dlhandle *deplibs; /* dependencies */ - lt_module module; /* system module handle */ - lt_ptr system; /* system specific data */ - lt_caller_data *caller_data; /* per caller associated data */ - int flags; /* various boolean stats */ -}; - -/* Various boolean flags can be stored in the flags field of an - lt_dlhandle_struct... */ -#define LT_DLGET_FLAG(handle, flag) (((handle)->flags & (flag)) == (flag)) -#define LT_DLSET_FLAG(handle, flag) ((handle)->flags |= (flag)) - -#define LT_DLRESIDENT_FLAG (0x01 << 0) -/* ...add more flags here... */ - -#define LT_DLIS_RESIDENT(handle) LT_DLGET_FLAG(handle, LT_DLRESIDENT_FLAG) - - -#define LT_DLSTRERROR(name) lt_dlerror_strings[LT_CONC(LT_ERROR_,name)] - -static const char objdir[] = LTDL_OBJDIR; -static const char archive_ext[] = LTDL_ARCHIVE_EXT; -#ifdef LTDL_SHLIB_EXT -static const char shlib_ext[] = LTDL_SHLIB_EXT; -#endif -#ifdef LTDL_SYSSEARCHPATH -static const char sys_search_path[] = LTDL_SYSSEARCHPATH; -#endif - - - - -/* --- MUTEX LOCKING --- */ - - -/* Macros to make it easier to run the lock functions only if they have - been registered. The reason for the complicated lock macro is to - ensure that the stored error message from the last error is not - accidentally erased if the current function doesn't generate an - error of its own. */ -#define LT_DLMUTEX_LOCK() LT_STMT_START { \ - if (lt_dlmutex_lock_func) (*lt_dlmutex_lock_func)(); \ - } LT_STMT_END -#define LT_DLMUTEX_UNLOCK() LT_STMT_START { \ - if (lt_dlmutex_unlock_func) (*lt_dlmutex_unlock_func)();\ - } LT_STMT_END -#define LT_DLMUTEX_SETERROR(errormsg) LT_STMT_START { \ - if (lt_dlmutex_seterror_func) \ - (*lt_dlmutex_seterror_func) (errormsg); \ - else lt_dllast_error = (errormsg); } LT_STMT_END -#define LT_DLMUTEX_GETERROR(errormsg) LT_STMT_START { \ - if (lt_dlmutex_seterror_func) \ - (errormsg) = (*lt_dlmutex_geterror_func) (); \ - else (errormsg) = lt_dllast_error; } LT_STMT_END - -/* The mutex functions stored here are global, and are necessarily the - same for all threads that wish to share access to libltdl. */ -static lt_dlmutex_lock *lt_dlmutex_lock_func = NULL; -static lt_dlmutex_unlock *lt_dlmutex_unlock_func = NULL; -static lt_dlmutex_seterror *lt_dlmutex_seterror_func = NULL; -static lt_dlmutex_geterror *lt_dlmutex_geterror_func = NULL; -static const char *lt_dllast_error = NULL; - - -/* Either set or reset the mutex functions. Either all the arguments must - be valid functions, or else all can be NULL to turn off locking entirely. - The registered functions should be manipulating a static global lock - from the lock() and unlock() callbacks, which needs to be reentrant. */ -int -lt_dlmutex_register (lock, unlock, seterror, geterror) - lt_dlmutex_lock *lock; - lt_dlmutex_unlock *unlock; - lt_dlmutex_seterror *seterror; - lt_dlmutex_geterror *geterror; -{ - lt_dlmutex_unlock *old_unlock = unlock; - int errors = 0; - - /* Lock using the old lock() callback, if any. */ - LT_DLMUTEX_LOCK (); - - if ((lock && unlock && seterror && geterror) - || !(lock || unlock || seterror || geterror)) - { - lt_dlmutex_lock_func = lock; - lt_dlmutex_unlock_func = unlock; - lt_dlmutex_geterror_func = geterror; - } - else - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_MUTEX_ARGS)); - ++errors; - } - - /* Use the old unlock() callback we saved earlier, if any. Otherwise - record any errors using internal storage. */ - if (old_unlock) - (*old_unlock) (); - - /* Return the number of errors encountered during the execution of - this function. */ - return errors; -} - - - - -/* --- ERROR HANDLING --- */ - - -static const char **user_error_strings = NULL; -static int errorcount = LT_ERROR_MAX; - -int -lt_dladderror (diagnostic) - const char *diagnostic; -{ - int errindex = 0; - int result = -1; - const char **temp = NULL; - - assert (diagnostic); - - LT_DLMUTEX_LOCK (); - - errindex = errorcount - LT_ERROR_MAX; - temp = LT_EREALLOC (const char *, user_error_strings, 1 + errindex); - if (temp) - { - user_error_strings = temp; - user_error_strings[errindex] = diagnostic; - result = errorcount++; - } - - LT_DLMUTEX_UNLOCK (); - - return result; -} - -int -lt_dlseterror (errindex) - int errindex; -{ - int errors = 0; - - LT_DLMUTEX_LOCK (); - - if (errindex >= errorcount || errindex < 0) - { - /* Ack! Error setting the error message! */ - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_ERRORCODE)); - ++errors; - } - else if (errindex < LT_ERROR_MAX) - { - /* No error setting the error message! */ - LT_DLMUTEX_SETERROR (lt_dlerror_strings[errindex]); - } - else - { - /* No error setting the error message! */ - LT_DLMUTEX_SETERROR (user_error_strings[errindex - LT_ERROR_MAX]); - } - - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -static lt_ptr -lt_emalloc (size) - size_t size; -{ - lt_ptr mem = lt_dlmalloc (size); - if (size && !mem) - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); - return mem; -} - -static lt_ptr -lt_erealloc (addr, size) - lt_ptr addr; - size_t size; -{ - lt_ptr mem = realloc (addr, size); - if (size && !mem) - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); - return mem; -} - -static char * -lt_estrdup (str) - const char *str; -{ - char *copy = strdup (str); - if (LT_STRLEN (str) && !copy) - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); - return copy; -} - - - - -/* --- DLOPEN() INTERFACE LOADER --- */ - - -/* The Cygwin dlopen implementation prints a spurious error message to - stderr if its call to LoadLibrary() fails for any reason. We can - mitigate this by not using the Cygwin implementation, and falling - back to our own LoadLibrary() wrapper. */ -#if HAVE_LIBDL && !defined(__CYGWIN__) - -/* dynamic linking with dlopen/dlsym */ - -#if HAVE_DLFCN_H -# include <dlfcn.h> -#endif - -#if HAVE_SYS_DL_H -# include <sys/dl.h> -#endif - -#ifdef RTLD_GLOBAL -# define LT_GLOBAL RTLD_GLOBAL -#else -# ifdef DL_GLOBAL -# define LT_GLOBAL DL_GLOBAL -# endif -#endif /* !RTLD_GLOBAL */ -#ifndef LT_GLOBAL -# define LT_GLOBAL 0 -#endif /* !LT_GLOBAL */ - -/* We may have to define LT_LAZY_OR_NOW in the command line if we - find out it does not work in some platform. */ -#ifndef LT_LAZY_OR_NOW -# ifdef RTLD_LAZY -# define LT_LAZY_OR_NOW RTLD_LAZY -# else -# ifdef DL_LAZY -# define LT_LAZY_OR_NOW DL_LAZY -# endif -# endif /* !RTLD_LAZY */ -#endif -#ifndef LT_LAZY_OR_NOW -# ifdef RTLD_NOW -# define LT_LAZY_OR_NOW RTLD_NOW -# else -# ifdef DL_NOW -# define LT_LAZY_OR_NOW DL_NOW -# endif -# endif /* !RTLD_NOW */ -#endif -#ifndef LT_LAZY_OR_NOW -# define LT_LAZY_OR_NOW 0 -#endif /* !LT_LAZY_OR_NOW */ - -#if HAVE_DLERROR -# define DLERROR(arg) dlerror () -#else -# define DLERROR(arg) LT_DLSTRERROR (arg) -#endif - -static lt_module -sys_dl_open (loader_data, filename) - lt_user_data loader_data; - const char *filename; -{ - lt_module module = dlopen (filename, LT_GLOBAL | LT_LAZY_OR_NOW); - - if (!module) - { - LT_DLMUTEX_SETERROR (DLERROR (CANNOT_OPEN)); - } - - return module; -} - -static int -sys_dl_close (loader_data, module) - lt_user_data loader_data; - lt_module module; -{ - int errors = 0; - - if (dlclose (module) != 0) - { - LT_DLMUTEX_SETERROR (DLERROR (CANNOT_CLOSE)); - ++errors; - } - - return errors; -} - -static lt_ptr -sys_dl_sym (loader_data, module, symbol) - lt_user_data loader_data; - lt_module module; - const char *symbol; -{ - lt_ptr address = dlsym (module, symbol); - - if (!address) - { - LT_DLMUTEX_SETERROR (DLERROR (SYMBOL_NOT_FOUND)); - } - - return address; -} - -static struct lt_user_dlloader sys_dl = - { -# ifdef NEED_USCORE - "_", -# else - 0, -# endif - sys_dl_open, sys_dl_close, sys_dl_sym, 0, 0 }; - - -#endif /* HAVE_LIBDL */ - - - -/* --- SHL_LOAD() INTERFACE LOADER --- */ - -#if HAVE_SHL_LOAD - -/* dynamic linking with shl_load (HP-UX) (comments from gmodule) */ - -#ifdef HAVE_DL_H -# include <dl.h> -#endif - -/* some flags are missing on some systems, so we provide - * harmless defaults. - * - * Mandatory: - * BIND_IMMEDIATE - Resolve symbol references when the library is loaded. - * BIND_DEFERRED - Delay code symbol resolution until actual reference. - * - * Optionally: - * BIND_FIRST - Place the library at the head of the symbol search - * order. - * BIND_NONFATAL - The default BIND_IMMEDIATE behavior is to treat all - * unsatisfied symbols as fatal. This flag allows - * binding of unsatisfied code symbols to be deferred - * until use. - * [Perl: For certain libraries, like DCE, deferred - * binding often causes run time problems. Adding - * BIND_NONFATAL to BIND_IMMEDIATE still allows - * unresolved references in situations like this.] - * BIND_NOSTART - Do not call the initializer for the shared library - * when the library is loaded, nor on a future call to - * shl_unload(). - * BIND_VERBOSE - Print verbose messages concerning possible - * unsatisfied symbols. - * - * hp9000s700/hp9000s800: - * BIND_RESTRICTED - Restrict symbols visible by the library to those - * present at library load time. - * DYNAMIC_PATH - Allow the loader to dynamically search for the - * library specified by the path argument. - */ - -#ifndef DYNAMIC_PATH -# define DYNAMIC_PATH 0 -#endif -#ifndef BIND_RESTRICTED -# define BIND_RESTRICTED 0 -#endif - -#define LT_BIND_FLAGS (BIND_IMMEDIATE | BIND_NONFATAL | DYNAMIC_PATH) - -static lt_module -sys_shl_open (loader_data, filename) - lt_user_data loader_data; - const char *filename; -{ - static shl_t self = (shl_t) 0; - lt_module module = shl_load (filename, LT_BIND_FLAGS, 0L); - - /* Since searching for a symbol against a NULL module handle will also - look in everything else that was already loaded and exported with - the -E compiler flag, we always cache a handle saved before any - modules are loaded. */ - if (!self) - { - lt_ptr address; - shl_findsym (&self, "main", TYPE_UNDEFINED, &address); - } - - if (!filename) - { - module = self; - } - else - { - module = shl_load (filename, LT_BIND_FLAGS, 0L); - - if (!module) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); - } - } - - return module; -} - -static int -sys_shl_close (loader_data, module) - lt_user_data loader_data; - lt_module module; -{ - int errors = 0; - - if (module && (shl_unload ((shl_t) (module)) != 0)) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); - ++errors; - } - - return errors; -} - -static lt_ptr -sys_shl_sym (loader_data, module, symbol) - lt_user_data loader_data; - lt_module module; - const char *symbol; -{ - lt_ptr address = NULL; - - /* sys_shl_open should never return a NULL module handle */ - if (module == (lt_module) 0) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); - } - else if (!shl_findsym((shl_t*) &module, symbol, TYPE_UNDEFINED, &address)) - { - if (!address) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - } - } - - return address; -} - -static struct lt_user_dlloader sys_shl = { - 0, sys_shl_open, sys_shl_close, sys_shl_sym, 0, 0 -}; - -#endif /* HAVE_SHL_LOAD */ - - - - -/* --- LOADLIBRARY() INTERFACE LOADER --- */ - -#ifdef __WINDOWS__ - -/* dynamic linking for Win32 */ - -#include <windows.h> - -/* Forward declaration; required to implement handle search below. */ -static lt_dlhandle handles; - -static lt_module -sys_wll_open (loader_data, filename) - lt_user_data loader_data; - const char *filename; -{ - lt_dlhandle cur; - lt_module module = NULL; - const char *errormsg = NULL; - char *searchname = NULL; - char *ext; - char self_name_buf[MAX_PATH]; - - if (!filename) - { - /* Get the name of main module */ - *self_name_buf = '\0'; - GetModuleFileName (NULL, self_name_buf, sizeof (self_name_buf)); - filename = ext = self_name_buf; - } - else - { - ext = strrchr (filename, '.'); - } - - if (ext) - { - /* FILENAME already has an extension. */ - searchname = lt_estrdup (filename); - } - else - { - /* Append a `.' to stop Windows from adding an - implicit `.dll' extension. */ - searchname = LT_EMALLOC (char, 2+ LT_STRLEN (filename)); - if (searchname) - sprintf (searchname, "%s.", filename); - } - if (!searchname) - return 0; - -#if __CYGWIN__ - { - char wpath[MAX_PATH]; - cygwin_conv_to_full_win32_path(searchname, wpath); - module = LoadLibrary(wpath); - } -#else - module = LoadLibrary (searchname); -#endif - LT_DLFREE (searchname); - - /* libltdl expects this function to fail if it is unable - to physically load the library. Sadly, LoadLibrary - will search the loaded libraries for a match and return - one of them if the path search load fails. - - We check whether LoadLibrary is returning a handle to - an already loaded module, and simulate failure if we - find one. */ - LT_DLMUTEX_LOCK (); - cur = handles; - while (cur) - { - if (!cur->module) - { - cur = NULL; - break; - } - - if (cur->module == module) - { - break; - } - - cur = cur->next; - } - LT_DLMUTEX_UNLOCK (); - - if (cur || !module) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); - module = NULL; - } - - return module; -} - -static int -sys_wll_close (loader_data, module) - lt_user_data loader_data; - lt_module module; -{ - int errors = 0; - - if (FreeLibrary(module) == 0) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); - ++errors; - } - - return errors; -} - -static lt_ptr -sys_wll_sym (loader_data, module, symbol) - lt_user_data loader_data; - lt_module module; - const char *symbol; -{ - lt_ptr address = GetProcAddress (module, symbol); - - if (!address) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - } - - return address; -} - -static struct lt_user_dlloader sys_wll = { - 0, sys_wll_open, sys_wll_close, sys_wll_sym, 0, 0 -}; - -#endif /* __WINDOWS__ */ - - - - -/* --- LOAD_ADD_ON() INTERFACE LOADER --- */ - - -#ifdef __BEOS__ - -/* dynamic linking for BeOS */ - -#include <kernel/image.h> - -static lt_module -sys_bedl_open (loader_data, filename) - lt_user_data loader_data; - const char *filename; -{ - image_id image = 0; - - if (filename) - { - image = load_add_on (filename); - } - else - { - image_info info; - int32 cookie = 0; - if (get_next_image_info (0, &cookie, &info) == B_OK) - image = load_add_on (info.name); - } - - if (image <= 0) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); - image = 0; - } - - return (lt_module) image; -} - -static int -sys_bedl_close (loader_data, module) - lt_user_data loader_data; - lt_module module; -{ - int errors = 0; - - if (unload_add_on ((image_id) module) != B_OK) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); - ++errors; - } - - return errors; -} - -static lt_ptr -sys_bedl_sym (loader_data, module, symbol) - lt_user_data loader_data; - lt_module module; - const char *symbol; -{ - lt_ptr address = NULL; - image_id image = (image_id) module; - - if (get_image_symbol (image, symbol, B_SYMBOL_TYPE_ANY, address) != B_OK) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - address = NULL; - } - - return address; -} - -static struct lt_user_dlloader sys_bedl = { - 0, sys_bedl_open, sys_bedl_close, sys_bedl_sym, 0, 0 -}; - -#endif /* __BEOS__ */ - - - - -/* --- DLD_LINK() INTERFACE LOADER --- */ - - -#if HAVE_DLD - -/* dynamic linking with dld */ - -#if HAVE_DLD_H -#include <dld.h> -#endif - -static lt_module -sys_dld_open (loader_data, filename) - lt_user_data loader_data; - const char *filename; -{ - lt_module module = strdup (filename); - - if (dld_link (filename) != 0) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_OPEN)); - LT_DLFREE (module); - module = NULL; - } - - return module; -} - -static int -sys_dld_close (loader_data, module) - lt_user_data loader_data; - lt_module module; -{ - int errors = 0; - - if (dld_unlink_by_file ((char*)(module), 1) != 0) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CANNOT_CLOSE)); - ++errors; - } - else - { - LT_DLFREE (module); - } - - return errors; -} - -static lt_ptr -sys_dld_sym (loader_data, module, symbol) - lt_user_data loader_data; - lt_module module; - const char *symbol; -{ - lt_ptr address = dld_get_func (symbol); - - if (!address) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - } - - return address; -} - -static struct lt_user_dlloader sys_dld = { - 0, sys_dld_open, sys_dld_close, sys_dld_sym, 0, 0 -}; - -#endif /* HAVE_DLD */ - - - - -/* --- DLPREOPEN() INTERFACE LOADER --- */ - - -/* emulate dynamic linking using preloaded_symbols */ - -typedef struct lt_dlsymlists_t -{ - struct lt_dlsymlists_t *next; - const lt_dlsymlist *syms; -} lt_dlsymlists_t; - -static const lt_dlsymlist *default_preloaded_symbols = NULL; -static lt_dlsymlists_t *preloaded_symbols = NULL; - -static int -presym_init (loader_data) - lt_user_data loader_data; -{ - int errors = 0; - - LT_DLMUTEX_LOCK (); - - preloaded_symbols = NULL; - if (default_preloaded_symbols) - { - errors = lt_dlpreload (default_preloaded_symbols); - } - - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -static int -presym_free_symlists () -{ - lt_dlsymlists_t *lists; - - LT_DLMUTEX_LOCK (); - - lists = preloaded_symbols; - while (lists) - { - lt_dlsymlists_t *tmp = lists; - - lists = lists->next; - LT_DLFREE (tmp); - } - preloaded_symbols = NULL; - - LT_DLMUTEX_UNLOCK (); - - return 0; -} - -static int -presym_exit (loader_data) - lt_user_data loader_data; -{ - presym_free_symlists (); - return 0; -} - -static int -presym_add_symlist (preloaded) - const lt_dlsymlist *preloaded; -{ - lt_dlsymlists_t *tmp; - lt_dlsymlists_t *lists; - int errors = 0; - - LT_DLMUTEX_LOCK (); - - lists = preloaded_symbols; - while (lists) - { - if (lists->syms == preloaded) - { - goto done; - } - lists = lists->next; - } - - tmp = LT_EMALLOC (lt_dlsymlists_t, 1); - if (tmp) - { - memset (tmp, 0, sizeof(lt_dlsymlists_t)); - tmp->syms = preloaded; - tmp->next = preloaded_symbols; - preloaded_symbols = tmp; - } - else - { - ++errors; - } - - done: - LT_DLMUTEX_UNLOCK (); - return errors; -} - -static lt_module -presym_open (loader_data, filename) - lt_user_data loader_data; - const char *filename; -{ - lt_dlsymlists_t *lists; - lt_module module = (lt_module) 0; - - LT_DLMUTEX_LOCK (); - lists = preloaded_symbols; - - if (!lists) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_SYMBOLS)); - goto done; - } - - /* Can't use NULL as the reflective symbol header, as NULL is - used to mark the end of the entire symbol list. Self-dlpreopened - symbols follow this magic number, chosen to be an unlikely - clash with a real module name. */ - if (!filename) - { - filename = "@PROGRAM@"; - } - - while (lists) - { - const lt_dlsymlist *syms = lists->syms; - - while (syms->name) - { - if (!syms->address && strcmp(syms->name, filename) == 0) - { - module = (lt_module) syms; - goto done; - } - ++syms; - } - - lists = lists->next; - } - - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); - - done: - LT_DLMUTEX_UNLOCK (); - return module; -} - -static int -presym_close (loader_data, module) - lt_user_data loader_data; - lt_module module; -{ - /* Just to silence gcc -Wall */ - module = NULL; - return 0; -} - -static lt_ptr -presym_sym (loader_data, module, symbol) - lt_user_data loader_data; - lt_module module; - const char *symbol; -{ - lt_dlsymlist *syms = (lt_dlsymlist*) module; - - ++syms; - while (syms->address) - { - if (strcmp(syms->name, symbol) == 0) - { - return syms->address; - } - - ++syms; - } - - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - - return 0; -} - -static struct lt_user_dlloader presym = { - 0, presym_open, presym_close, presym_sym, presym_exit, 0 -}; - - - - - -/* --- DYNAMIC MODULE LOADING --- */ - - -/* The type of a function used at each iteration of foreach_dirinpath(). */ -typedef int foreach_callback_func LT_PARAMS((char *filename, lt_ptr data1, - lt_ptr data2)); - -static int foreach_dirinpath LT_PARAMS((const char *search_path, - const char *base_name, - foreach_callback_func *func, - lt_ptr data1, lt_ptr data2)); - -static int find_file_callback LT_PARAMS((char *filename, lt_ptr data, - lt_ptr ignored)); -static int find_handle_callback LT_PARAMS((char *filename, lt_ptr data, - lt_ptr ignored)); -static int foreachfile_callback LT_PARAMS((char *filename, lt_ptr data1, - lt_ptr data2)); - - -static int canonicalize_path LT_PARAMS((const char *path, - char **pcanonical)); -static int argzize_path LT_PARAMS((const char *path, - char **pargz, - size_t *pargz_len)); -static FILE *find_file LT_PARAMS((const char *search_path, - const char *base_name, - char **pdir)); -static lt_dlhandle *find_handle LT_PARAMS((const char *search_path, - const char *base_name, - lt_dlhandle *handle)); -static int find_module LT_PARAMS((lt_dlhandle *handle, - const char *dir, - const char *libdir, - const char *dlname, - const char *old_name, - int installed)); -static int free_vars LT_PARAMS((char *dlname, char *oldname, - char *libdir, char *deplibs)); -static int load_deplibs LT_PARAMS((lt_dlhandle handle, - char *deplibs)); -static int trim LT_PARAMS((char **dest, - const char *str)); -static int try_dlopen LT_PARAMS((lt_dlhandle *handle, - const char *filename)); -static int tryall_dlopen LT_PARAMS((lt_dlhandle *handle, - const char *filename)); -static int unload_deplibs LT_PARAMS((lt_dlhandle handle)); -static int lt_argz_insert LT_PARAMS((char **pargz, - size_t *pargz_len, - char *before, - const char *entry)); -static int lt_argz_insertinorder LT_PARAMS((char **pargz, - size_t *pargz_len, - const char *entry)); -static int lt_argz_insertdir LT_PARAMS((char **pargz, - size_t *pargz_len, - const char *dirnam, - struct dirent *dp)); -static int lt_dlpath_insertdir LT_PARAMS((char **ppath, - char *before, - const char *dir)); -static int list_files_by_dir LT_PARAMS((const char *dirnam, - char **pargz, - size_t *pargz_len)); -static int file_not_found LT_PARAMS((void)); - -static char *user_search_path= NULL; -static lt_dlloader *loaders = NULL; -static lt_dlhandle handles = NULL; -static int initialized = 0; - -/* Initialize libltdl. */ -int -lt_dlinit () -{ - int errors = 0; - - LT_DLMUTEX_LOCK (); - - /* Initialize only at first call. */ - if (++initialized == 1) - { - handles = NULL; - user_search_path = NULL; /* empty search path */ - -#if HAVE_LIBDL && !defined(__CYGWIN__) - errors += lt_dlloader_add (lt_dlloader_next (0), &sys_dl, "dlopen"); -#endif -#if HAVE_SHL_LOAD - errors += lt_dlloader_add (lt_dlloader_next (0), &sys_shl, "dlopen"); -#endif -#ifdef __WINDOWS__ - errors += lt_dlloader_add (lt_dlloader_next (0), &sys_wll, "dlopen"); -#endif -#ifdef __BEOS__ - errors += lt_dlloader_add (lt_dlloader_next (0), &sys_bedl, "dlopen"); -#endif -#if HAVE_DLD - errors += lt_dlloader_add (lt_dlloader_next (0), &sys_dld, "dld"); -#endif - errors += lt_dlloader_add (lt_dlloader_next (0), &presym, "dlpreload"); - - if (presym_init (presym.dlloader_data)) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INIT_LOADER)); - ++errors; - } - else if (errors != 0) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (DLOPEN_NOT_SUPPORTED)); - ++errors; - } - } - - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -int -lt_dlpreload (preloaded) - const lt_dlsymlist *preloaded; -{ - int errors = 0; - - if (preloaded) - { - errors = presym_add_symlist (preloaded); - } - else - { - presym_free_symlists(); - - LT_DLMUTEX_LOCK (); - if (default_preloaded_symbols) - { - errors = lt_dlpreload (default_preloaded_symbols); - } - LT_DLMUTEX_UNLOCK (); - } - - return errors; -} - -int -lt_dlpreload_default (preloaded) - const lt_dlsymlist *preloaded; -{ - LT_DLMUTEX_LOCK (); - default_preloaded_symbols = preloaded; - LT_DLMUTEX_UNLOCK (); - return 0; -} - -int -lt_dlexit () -{ - /* shut down libltdl */ - lt_dlloader *loader; - int errors = 0; - - LT_DLMUTEX_LOCK (); - loader = loaders; - - if (!initialized) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SHUTDOWN)); - ++errors; - goto done; - } - - /* shut down only at last call. */ - if (--initialized == 0) - { - int level; - - while (handles && LT_DLIS_RESIDENT (handles)) - { - handles = handles->next; - } - - /* close all modules */ - for (level = 1; handles; ++level) - { - lt_dlhandle cur = handles; - int saw_nonresident = 0; - - while (cur) - { - lt_dlhandle tmp = cur; - cur = cur->next; - if (!LT_DLIS_RESIDENT (tmp)) - saw_nonresident = 1; - if (!LT_DLIS_RESIDENT (tmp) && tmp->info.ref_count <= level) - { - if (lt_dlclose (tmp)) - { - ++errors; - } - } - } - /* done if only resident modules are left */ - if (!saw_nonresident) - break; - } - - /* close all loaders */ - while (loader) - { - lt_dlloader *next = loader->next; - lt_user_data data = loader->dlloader_data; - if (loader->dlloader_exit && loader->dlloader_exit (data)) - { - ++errors; - } - - LT_DLMEM_REASSIGN (loader, next); - } - loaders = NULL; - } - - done: - LT_DLMUTEX_UNLOCK (); - return errors; -} - -static int -tryall_dlopen (handle, filename) - lt_dlhandle *handle; - const char *filename; -{ - lt_dlhandle cur; - lt_dlloader *loader; - const char *saved_error; - int errors = 0; - - LT_DLMUTEX_GETERROR (saved_error); - LT_DLMUTEX_LOCK (); - - cur = handles; - loader = loaders; - - /* check whether the module was already opened */ - while (cur) - { - /* try to dlopen the program itself? */ - if (!cur->info.filename && !filename) - { - break; - } - - if (cur->info.filename && filename - && strcmp (cur->info.filename, filename) == 0) - { - break; - } - - cur = cur->next; - } - - if (cur) - { - ++cur->info.ref_count; - *handle = cur; - goto done; - } - - cur = *handle; - if (filename) - { - cur->info.filename = lt_estrdup (filename); - if (!cur->info.filename) - { - ++errors; - goto done; - } - } - else - { - cur->info.filename = NULL; - } - - while (loader) - { - lt_user_data data = loader->dlloader_data; - - cur->module = loader->module_open (data, filename); - - if (cur->module != NULL) - { - break; - } - loader = loader->next; - } - - if (!loader) - { - LT_DLFREE (cur->info.filename); - ++errors; - goto done; - } - - cur->loader = loader; - LT_DLMUTEX_SETERROR (saved_error); - - done: - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -static int -tryall_dlopen_module (handle, prefix, dirname, dlname) - lt_dlhandle *handle; - const char *prefix; - const char *dirname; - const char *dlname; -{ - int error = 0; - char *filename = NULL; - size_t filename_len = 0; - size_t dirname_len = LT_STRLEN (dirname); - - assert (handle); - assert (dirname); - assert (dlname); -#ifdef LT_DIRSEP_CHAR - /* Only canonicalized names (i.e. with DIRSEP chars already converted) - should make it into this function: */ - assert (strchr (dirname, LT_DIRSEP_CHAR) == NULL); -#endif - - if (dirname[dirname_len -1] == '/') - --dirname_len; - filename_len = dirname_len + 1 + LT_STRLEN (dlname); - - /* Allocate memory, and combine DIRNAME and MODULENAME into it. - The PREFIX (if any) is handled below. */ - filename = LT_EMALLOC (char, dirname_len + 1 + filename_len + 1); - if (!filename) - return 1; - - sprintf (filename, "%.*s/%s", (int) dirname_len, dirname, dlname); - - /* Now that we have combined DIRNAME and MODULENAME, if there is - also a PREFIX to contend with, simply recurse with the arguments - shuffled. Otherwise, attempt to open FILENAME as a module. */ - if (prefix) - { - error += tryall_dlopen_module (handle, - (const char *) 0, prefix, filename); - } - else if (tryall_dlopen (handle, filename) != 0) - { - ++error; - } - - LT_DLFREE (filename); - return error; -} - -static int -find_module (handle, dir, libdir, dlname, old_name, installed) - lt_dlhandle *handle; - const char *dir; - const char *libdir; - const char *dlname; - const char *old_name; - int installed; -{ - /* Try to open the old library first; if it was dlpreopened, - we want the preopened version of it, even if a dlopenable - module is available. */ - if (old_name && tryall_dlopen (handle, old_name) == 0) - { - return 0; - } - - /* Try to open the dynamic library. */ - if (dlname) - { - /* try to open the installed module */ - if (installed && libdir) - { - if (tryall_dlopen_module (handle, - (const char *) 0, libdir, dlname) == 0) - return 0; - } - - /* try to open the not-installed module */ - if (!installed) - { - if (tryall_dlopen_module (handle, dir, objdir, dlname) == 0) - return 0; - } - - /* maybe it was moved to another directory */ - { - if (tryall_dlopen_module (handle, - (const char *) 0, dir, dlname) == 0) - return 0; - } - } - - return 1; -} - - -static int -canonicalize_path (path, pcanonical) - const char *path; - char **pcanonical; -{ - char *canonical = NULL; - - assert (path && *path); - assert (pcanonical); - - canonical = LT_EMALLOC (char, 1+ LT_STRLEN (path)); - if (!canonical) - return 1; - - { - size_t dest = 0; - size_t src; - for (src = 0; path[src] != LT_EOS_CHAR; ++src) - { - /* Path separators are not copied to the beginning or end of - the destination, or if another separator would follow - immediately. */ - if (path[src] == LT_PATHSEP_CHAR) - { - if ((dest == 0) - || (path[1+ src] == LT_PATHSEP_CHAR) - || (path[1+ src] == LT_EOS_CHAR)) - continue; - } - - /* Anything other than a directory separator is copied verbatim. */ - if ((path[src] != '/') -#ifdef LT_DIRSEP_CHAR - && (path[src] != LT_DIRSEP_CHAR) -#endif - ) - { - canonical[dest++] = path[src]; - } - /* Directory separators are converted and copied only if they are - not at the end of a path -- i.e. before a path separator or - NULL terminator. */ - else if ((path[1+ src] != LT_PATHSEP_CHAR) - && (path[1+ src] != LT_EOS_CHAR) -#ifdef LT_DIRSEP_CHAR - && (path[1+ src] != LT_DIRSEP_CHAR) -#endif - && (path[1+ src] != '/')) - { - canonical[dest++] = '/'; - } - } - - /* Add an end-of-string marker at the end. */ - canonical[dest] = LT_EOS_CHAR; - } - - /* Assign new value. */ - *pcanonical = canonical; - - return 0; -} - -static int -argzize_path (path, pargz, pargz_len) - const char *path; - char **pargz; - size_t *pargz_len; -{ - error_t error; - - assert (path); - assert (pargz); - assert (pargz_len); - - if ((error = argz_create_sep (path, LT_PATHSEP_CHAR, pargz, pargz_len))) - { - switch (error) - { - case ENOMEM: - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); - break; - default: - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (UNKNOWN)); - break; - } - - return 1; - } - - return 0; -} - -/* Repeatedly call FUNC with each LT_PATHSEP_CHAR delimited element - of SEARCH_PATH and references to DATA1 and DATA2, until FUNC returns - non-zero or all elements are exhausted. If BASE_NAME is non-NULL, - it is appended to each SEARCH_PATH element before FUNC is called. */ -static int -foreach_dirinpath (search_path, base_name, func, data1, data2) - const char *search_path; - const char *base_name; - foreach_callback_func *func; - lt_ptr data1; - lt_ptr data2; -{ - int result = 0; - int filenamesize = 0; - size_t lenbase = LT_STRLEN (base_name); - size_t argz_len = 0; - char *argz = NULL; - char *filename = NULL; - char *canonical = NULL; - - LT_DLMUTEX_LOCK (); - - if (!search_path || !*search_path) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); - goto cleanup; - } - - if (canonicalize_path (search_path, &canonical) != 0) - goto cleanup; - - if (argzize_path (canonical, &argz, &argz_len) != 0) - goto cleanup; - - { - char *dir_name = NULL; - while ((dir_name = argz_next (argz, argz_len, dir_name))) - { - size_t lendir = LT_STRLEN (dir_name); - - if (lendir +1 +lenbase >= filenamesize) - { - LT_DLFREE (filename); - filenamesize = lendir +1 +lenbase +1; /* "/d" + '/' + "f" + '\0' */ - filename = LT_EMALLOC (char, filenamesize); - if (!filename) - goto cleanup; - } - - assert (filenamesize > lendir); - strcpy (filename, dir_name); - - if (base_name && *base_name) - { - if (filename[lendir -1] != '/') - filename[lendir++] = '/'; - strcpy (filename +lendir, base_name); - } - - if ((result = (*func) (filename, data1, data2))) - { - break; - } - } - } - - cleanup: - LT_DLFREE (argz); - LT_DLFREE (canonical); - LT_DLFREE (filename); - - LT_DLMUTEX_UNLOCK (); - - return result; -} - -/* If FILEPATH can be opened, store the name of the directory component - in DATA1, and the opened FILE* structure address in DATA2. Otherwise - DATA1 is unchanged, but DATA2 is set to a pointer to NULL. */ -static int -find_file_callback (filename, data1, data2) - char *filename; - lt_ptr data1; - lt_ptr data2; -{ - char **pdir = (char **) data1; - FILE **pfile = (FILE **) data2; - int is_done = 0; - - assert (filename && *filename); - assert (pdir); - assert (pfile); - - if ((*pfile = fopen (filename, LT_READTEXT_MODE))) - { - char *dirend = strrchr (filename, '/'); - - if (dirend > filename) - *dirend = LT_EOS_CHAR; - - LT_DLFREE (*pdir); - *pdir = lt_estrdup (filename); - is_done = (*pdir == NULL) ? -1 : 1; - } - - return is_done; -} - -static FILE * -find_file (search_path, base_name, pdir) - const char *search_path; - const char *base_name; - char **pdir; -{ - FILE *file = NULL; - - foreach_dirinpath (search_path, base_name, find_file_callback, pdir, &file); - - return file; -} - -static int -find_handle_callback (filename, data, ignored) - char *filename; - lt_ptr data; - lt_ptr ignored; -{ - lt_dlhandle *handle = (lt_dlhandle *) data; - int notfound = access (filename, R_OK); - - /* Bail out if file cannot be read... */ - if (notfound) - return 0; - - /* Try to dlopen the file, but do not continue searching in any - case. */ - if (tryall_dlopen (handle, filename) != 0) - *handle = NULL; - - return 1; -} - -/* If HANDLE was found return it, otherwise return 0. If HANDLE was - found but could not be opened, *HANDLE will be set to 0. */ -static lt_dlhandle * -find_handle (search_path, base_name, handle) - const char *search_path; - const char *base_name; - lt_dlhandle *handle; -{ - if (!search_path) - return 0; - - if (!foreach_dirinpath (search_path, base_name, find_handle_callback, - handle, 0)) - return 0; - - return handle; -} - -static int -load_deplibs (handle, deplibs) - lt_dlhandle handle; - char *deplibs; -{ -#if LTDL_DLOPEN_DEPLIBS - char *p, *save_search_path = NULL; - int depcount = 0; - int i; - char **names = NULL; -#endif - int errors = 0; - - handle->depcount = 0; - -#if LTDL_DLOPEN_DEPLIBS - if (!deplibs) - { - return errors; - } - ++errors; - - LT_DLMUTEX_LOCK (); - if (user_search_path) - { - save_search_path = lt_estrdup (user_search_path); - if (!save_search_path) - goto cleanup; - } - - /* extract search paths and count deplibs */ - p = deplibs; - while (*p) - { - if (!isspace ((int) *p)) - { - char *end = p+1; - while (*end && !isspace((int) *end)) - { - ++end; - } - - if (strncmp(p, "-L", 2) == 0 || strncmp(p, "-R", 2) == 0) - { - char save = *end; - *end = '\0'; /* set a temporary string terminator */ - if (lt_dladdsearchdir(p+2)) - { - goto cleanup; - } - *end = save; - } - else - { - ++depcount; - } - - p = end; - } - else - { - ++p; - } - } - - /* restore the old search path */ - LT_DLFREE (user_search_path); - user_search_path = save_search_path; - - LT_DLMUTEX_UNLOCK (); - - if (!depcount) - { - errors = 0; - goto cleanup; - } - - names = LT_EMALLOC (char *, depcount * sizeof (char*)); - if (!names) - goto cleanup; - - /* now only extract the actual deplibs */ - depcount = 0; - p = deplibs; - while (*p) - { - if (isspace ((int) *p)) - { - ++p; - } - else - { - char *end = p+1; - while (*end && !isspace ((int) *end)) - { - ++end; - } - - if (strncmp(p, "-L", 2) != 0 && strncmp(p, "-R", 2) != 0) - { - char *name; - char save = *end; - *end = '\0'; /* set a temporary string terminator */ - if (strncmp(p, "-l", 2) == 0) - { - size_t name_len = 3+ /* "lib" */ LT_STRLEN (p + 2); - name = LT_EMALLOC (char, 1+ name_len); - if (name) - sprintf (name, "lib%s", p+2); - } - else - name = lt_estrdup(p); - - if (!name) - goto cleanup_names; - - names[depcount++] = name; - *end = save; - } - p = end; - } - } - - /* load the deplibs (in reverse order) - At this stage, don't worry if the deplibs do not load correctly, - they may already be statically linked into the loading application - for instance. There will be a more enlightening error message - later on if the loaded module cannot resolve all of its symbols. */ - if (depcount) - { - int j = 0; - - handle->deplibs = (lt_dlhandle*) LT_EMALLOC (lt_dlhandle *, depcount); - if (!handle->deplibs) - goto cleanup; - - for (i = 0; i < depcount; ++i) - { - handle->deplibs[j] = lt_dlopenext(names[depcount-1-i]); - if (handle->deplibs[j]) - { - ++j; - } - } - - handle->depcount = j; /* Number of successfully loaded deplibs */ - errors = 0; - } - - cleanup_names: - for (i = 0; i < depcount; ++i) - { - LT_DLFREE (names[i]); - } - - cleanup: - LT_DLFREE (names); -#endif - - return errors; -} - -static int -unload_deplibs (handle) - lt_dlhandle handle; -{ - int i; - int errors = 0; - - if (handle->depcount) - { - for (i = 0; i < handle->depcount; ++i) - { - if (!LT_DLIS_RESIDENT (handle->deplibs[i])) - { - errors += lt_dlclose (handle->deplibs[i]); - } - } - } - - return errors; -} - -static int -trim (dest, str) - char **dest; - const char *str; -{ - /* remove the leading and trailing "'" from str - and store the result in dest */ - const char *end = strrchr (str, '\''); - size_t len = LT_STRLEN (str); - char *tmp; - - LT_DLFREE (*dest); - - if (len > 3 && str[0] == '\'') - { - tmp = LT_EMALLOC (char, end - str); - if (!tmp) - return 1; - - strncpy(tmp, &str[1], (end - str) - 1); - tmp[len-3] = LT_EOS_CHAR; - *dest = tmp; - } - else - { - *dest = NULL; - } - - return 0; -} - -static int -free_vars (dlname, oldname, libdir, deplibs) - char *dlname; - char *oldname; - char *libdir; - char *deplibs; -{ - LT_DLFREE (dlname); - LT_DLFREE (oldname); - LT_DLFREE (libdir); - LT_DLFREE (deplibs); - - return 0; -} - -static int -try_dlopen (phandle, filename) - lt_dlhandle *phandle; - const char *filename; -{ - const char * ext = NULL; - const char * saved_error = NULL; - char * canonical = NULL; - char * base_name = NULL; - char * dir = NULL; - char * name = NULL; - int errors = 0; - lt_dlhandle newhandle; - - assert (phandle); - assert (*phandle == NULL); - - LT_DLMUTEX_GETERROR (saved_error); - - /* dlopen self? */ - if (!filename) - { - *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); - if (*phandle == NULL) - return 1; - - memset (*phandle, 0, sizeof(struct lt_dlhandle_struct)); - newhandle = *phandle; - - /* lt_dlclose()ing yourself is very bad! Disallow it. */ - LT_DLSET_FLAG (*phandle, LT_DLRESIDENT_FLAG); - - if (tryall_dlopen (&newhandle, 0) != 0) - { - LT_DLFREE (*phandle); - return 1; - } - - goto register_handle; - } - - assert (filename && *filename); - - /* Doing this immediately allows internal functions to safely - assume only canonicalized paths are passed. */ - if (canonicalize_path (filename, &canonical) != 0) - { - ++errors; - goto cleanup; - } - - /* If the canonical module name is a path (relative or absolute) - then split it into a directory part and a name part. */ - base_name = strrchr (canonical, '/'); - if (base_name) - { - size_t dirlen = (1+ base_name) - canonical; - - dir = LT_EMALLOC (char, 1+ dirlen); - if (!dir) - { - ++errors; - goto cleanup; - } - - strncpy (dir, canonical, dirlen); - dir[dirlen] = LT_EOS_CHAR; - - ++base_name; - } - else - LT_DLMEM_REASSIGN (base_name, canonical); - - assert (base_name && *base_name); - - /* Check whether we are opening a libtool module (.la extension). */ - ext = strrchr (base_name, '.'); - if (ext && strcmp (ext, archive_ext) == 0) - { - /* this seems to be a libtool module */ - FILE * file = NULL; - char * dlname = NULL; - char * old_name = NULL; - char * libdir = NULL; - char * deplibs = NULL; - char * line = NULL; - size_t line_len; - - /* if we can't find the installed flag, it is probably an - installed libtool archive, produced with an old version - of libtool */ - int installed = 1; - - /* extract the module name from the file name */ - name = LT_EMALLOC (char, ext - base_name + 1); - if (!name) - { - ++errors; - goto cleanup; - } - - /* canonicalize the module name */ - { - size_t i; - for (i = 0; i < ext - base_name; ++i) - { - if (isalnum ((int)(base_name[i]))) - { - name[i] = base_name[i]; - } - else - { - name[i] = '_'; - } - } - name[ext - base_name] = LT_EOS_CHAR; - } - - /* Now try to open the .la file. If there is no directory name - component, try to find it first in user_search_path and then other - prescribed paths. Otherwise (or in any case if the module was not - yet found) try opening just the module name as passed. */ - if (!dir) - { - const char *search_path; - - LT_DLMUTEX_LOCK (); - search_path = user_search_path; - if (search_path) - file = find_file (user_search_path, base_name, &dir); - LT_DLMUTEX_UNLOCK (); - - if (!file) - { - search_path = getenv (LTDL_SEARCHPATH_VAR); - if (search_path) - file = find_file (search_path, base_name, &dir); - } - -#ifdef LTDL_SHLIBPATH_VAR - if (!file) - { - search_path = getenv (LTDL_SHLIBPATH_VAR); - if (search_path) - file = find_file (search_path, base_name, &dir); - } -#endif -#ifdef LTDL_SYSSEARCHPATH - if (!file && sys_search_path) - { - file = find_file (sys_search_path, base_name, &dir); - } -#endif - } - if (!file) - { - file = fopen (filename, LT_READTEXT_MODE); - } - - /* If we didn't find the file by now, it really isn't there. Set - the status flag, and bail out. */ - if (!file) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); - ++errors; - goto cleanup; - } - - line_len = LT_FILENAME_MAX; - line = LT_EMALLOC (char, line_len); - if (!line) - { - fclose (file); - ++errors; - goto cleanup; - } - - /* read the .la file */ - while (!feof (file)) - { - if (!fgets (line, (int) line_len, file)) - { - break; - } - - /* Handle the case where we occasionally need to read a line - that is longer than the initial buffer size. */ - while (line[LT_STRLEN(line) -1] != '\n') - { - line = LT_DLREALLOC (char, line, line_len *2); - if (!fgets (&line[line_len -1], (int) line_len +1, file)) - { - break; - } - line_len *= 2; - } - - if (line[0] == '\n' || line[0] == '#') - { - continue; - } - -#undef STR_DLNAME -#define STR_DLNAME "dlname=" - if (strncmp (line, STR_DLNAME, sizeof (STR_DLNAME) - 1) == 0) - { - errors += trim (&dlname, &line[sizeof (STR_DLNAME) - 1]); - } - -#undef STR_OLD_LIBRARY -#define STR_OLD_LIBRARY "old_library=" - else if (strncmp (line, STR_OLD_LIBRARY, - sizeof (STR_OLD_LIBRARY) - 1) == 0) - { - errors += trim (&old_name, &line[sizeof (STR_OLD_LIBRARY) - 1]); - } -#undef STR_LIBDIR -#define STR_LIBDIR "libdir=" - else if (strncmp (line, STR_LIBDIR, sizeof (STR_LIBDIR) - 1) == 0) - { - errors += trim (&libdir, &line[sizeof(STR_LIBDIR) - 1]); - } - -#undef STR_DL_DEPLIBS -#define STR_DL_DEPLIBS "dependency_libs=" - else if (strncmp (line, STR_DL_DEPLIBS, - sizeof (STR_DL_DEPLIBS) - 1) == 0) - { - errors += trim (&deplibs, &line[sizeof (STR_DL_DEPLIBS) - 1]); - } - else if (strcmp (line, "installed=yes\n") == 0) - { - installed = 1; - } - else if (strcmp (line, "installed=no\n") == 0) - { - installed = 0; - } - -#undef STR_LIBRARY_NAMES -#define STR_LIBRARY_NAMES "library_names=" - else if (! dlname && strncmp (line, STR_LIBRARY_NAMES, - sizeof (STR_LIBRARY_NAMES) - 1) == 0) - { - char *last_libname; - errors += trim (&dlname, &line[sizeof (STR_LIBRARY_NAMES) - 1]); - if (!errors - && dlname - && (last_libname = strrchr (dlname, ' ')) != NULL) - { - last_libname = lt_estrdup (last_libname + 1); - if (!last_libname) - { - ++errors; - goto cleanup; - } - LT_DLMEM_REASSIGN (dlname, last_libname); - } - } - - if (errors) - break; - } - - fclose (file); - LT_DLFREE (line); - - /* allocate the handle */ - *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); - if (*phandle == NULL) - ++errors; - - if (errors) - { - free_vars (dlname, old_name, libdir, deplibs); - LT_DLFREE (*phandle); - goto cleanup; - } - - assert (*phandle); - - memset (*phandle, 0, sizeof(struct lt_dlhandle_struct)); - if (load_deplibs (*phandle, deplibs) == 0) - { - newhandle = *phandle; - /* find_module may replace newhandle */ - if (find_module (&newhandle, dir, libdir, dlname, old_name, installed)) - { - unload_deplibs (*phandle); - ++errors; - } - } - else - { - ++errors; - } - - free_vars (dlname, old_name, libdir, deplibs); - if (errors) - { - LT_DLFREE (*phandle); - goto cleanup; - } - - if (*phandle != newhandle) - { - unload_deplibs (*phandle); - } - } - else - { - /* not a libtool module */ - *phandle = (lt_dlhandle) LT_EMALLOC (struct lt_dlhandle_struct, 1); - if (*phandle == NULL) - { - ++errors; - goto cleanup; - } - - memset (*phandle, 0, sizeof (struct lt_dlhandle_struct)); - newhandle = *phandle; - - /* If the module has no directory name component, try to find it - first in user_search_path and then other prescribed paths. - Otherwise (or in any case if the module was not yet found) try - opening just the module name as passed. */ - if ((dir || (!find_handle (user_search_path, base_name, &newhandle) - && !find_handle (getenv (LTDL_SEARCHPATH_VAR), base_name, - &newhandle) -#ifdef LTDL_SHLIBPATH_VAR - && !find_handle (getenv (LTDL_SHLIBPATH_VAR), base_name, - &newhandle) -#endif -#ifdef LTDL_SYSSEARCHPATH - && !find_handle (sys_search_path, base_name, &newhandle) -#endif - ))) - { - if (tryall_dlopen (&newhandle, filename) != 0) - { - newhandle = NULL; - } - } - - if (!newhandle) - { - LT_DLFREE (*phandle); - ++errors; - goto cleanup; - } - } - - register_handle: - LT_DLMEM_REASSIGN (*phandle, newhandle); - - if ((*phandle)->info.ref_count == 0) - { - (*phandle)->info.ref_count = 1; - LT_DLMEM_REASSIGN ((*phandle)->info.name, name); - - LT_DLMUTEX_LOCK (); - (*phandle)->next = handles; - handles = *phandle; - LT_DLMUTEX_UNLOCK (); - } - - LT_DLMUTEX_SETERROR (saved_error); - - cleanup: - LT_DLFREE (dir); - LT_DLFREE (name); - LT_DLFREE (canonical); - - return errors; -} - -lt_dlhandle -lt_dlopen (filename) - const char *filename; -{ - lt_dlhandle handle = NULL; - - /* Just incase we missed a code path in try_dlopen() that reports - an error, but forgets to reset handle... */ - if (try_dlopen (&handle, filename) != 0) - return 0; - - return handle; -} - -/* If the last error messge store was `FILE_NOT_FOUND', then return - non-zero. */ -static int -file_not_found () -{ - const char *error = NULL; - - LT_DLMUTEX_GETERROR (error); - if (error == LT_DLSTRERROR (FILE_NOT_FOUND)) - return 1; - - return 0; -} - -/* If FILENAME has an ARCHIVE_EXT or SHLIB_EXT extension, try to - open the FILENAME as passed. Otherwise try appending ARCHIVE_EXT, - and if a file is still not found try again with SHLIB_EXT appended - instead. */ -lt_dlhandle -lt_dlopenext (filename) - const char *filename; -{ - lt_dlhandle handle = NULL; - char * tmp = NULL; - char * ext = NULL; - size_t len; - int errors = 0; - - if (!filename) - { - return lt_dlopen (filename); - } - - assert (filename); - - len = LT_STRLEN (filename); - ext = strrchr (filename, '.'); - - /* If FILENAME already bears a suitable extension, there is no need - to try appending additional extensions. */ - if (ext && ((strcmp (ext, archive_ext) == 0) -#ifdef LTDL_SHLIB_EXT - || (strcmp (ext, shlib_ext) == 0) -#endif - )) - { - return lt_dlopen (filename); - } - - /* First try appending ARCHIVE_EXT. */ - tmp = LT_EMALLOC (char, len + LT_STRLEN (archive_ext) + 1); - if (!tmp) - return 0; - - strcpy (tmp, filename); - strcat (tmp, archive_ext); - errors = try_dlopen (&handle, tmp); - - /* If we found FILENAME, stop searching -- whether we were able to - load the file as a module or not. If the file exists but loading - failed, it is better to return an error message here than to - report FILE_NOT_FOUND when the alternatives (foo.so etc) are not - in the module search path. */ - if (handle || ((errors > 0) && file_not_found ())) - { - LT_DLFREE (tmp); - return handle; - } - -#ifdef LTDL_SHLIB_EXT - /* Try appending SHLIB_EXT. */ - if (LT_STRLEN (shlib_ext) > LT_STRLEN (archive_ext)) - { - LT_DLFREE (tmp); - tmp = LT_EMALLOC (char, len + LT_STRLEN (shlib_ext) + 1); - if (!tmp) - return 0; - - strcpy (tmp, filename); - } - else - { - tmp[len] = LT_EOS_CHAR; - } - - strcat(tmp, shlib_ext); - errors = try_dlopen (&handle, tmp); - - /* As before, if the file was found but loading failed, return now - with the current error message. */ - if (handle || ((errors > 0) && file_not_found ())) - { - LT_DLFREE (tmp); - return handle; - } -#endif - - /* Still here? Then we really did fail to locate any of the file - names we tried. */ - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (FILE_NOT_FOUND)); - LT_DLFREE (tmp); - return 0; -} - - -static int -lt_argz_insert (pargz, pargz_len, before, entry) - char **pargz; - size_t *pargz_len; - char *before; - const char *entry; -{ - error_t error; - - if ((error = argz_insert (pargz, pargz_len, before, entry))) - { - switch (error) - { - case ENOMEM: - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (NO_MEMORY)); - break; - default: - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (UNKNOWN)); - break; - } - return 1; - } - - return 0; -} - -static int -lt_argz_insertinorder (pargz, pargz_len, entry) - char **pargz; - size_t *pargz_len; - const char *entry; -{ - char *before = NULL; - - assert (pargz); - assert (pargz_len); - assert (entry && *entry); - - if (*pargz) - while ((before = argz_next (*pargz, *pargz_len, before))) - { - int cmp = strcmp (entry, before); - - if (cmp < 0) break; - if (cmp == 0) return 0; /* No duplicates! */ - } - - return lt_argz_insert (pargz, pargz_len, before, entry); -} - -static int -lt_argz_insertdir (pargz, pargz_len, dirnam, dp) - char **pargz; - size_t *pargz_len; - const char *dirnam; - struct dirent *dp; -{ - char *buf = NULL; - size_t buf_len = 0; - char *end = NULL; - size_t end_offset = 0; - size_t dir_len = 0; - int errors = 0; - - assert (pargz); - assert (pargz_len); - assert (dp); - - dir_len = LT_STRLEN (dirnam); - end = dp->d_name + LT_D_NAMLEN(dp); - - /* Ignore version numbers. */ - { - char *p; - for (p = end; p -1 > dp->d_name; --p) - if (strchr (".0123456789", p[-1]) == 0) - break; - - if (*p == '.') - end = p; - } - - /* Ignore filename extension. */ - { - char *p; - for (p = end -1; p > dp->d_name; --p) - if (*p == '.') - { - end = p; - break; - } - } - - /* Prepend the directory name. */ - end_offset = end - dp->d_name; - buf_len = dir_len + 1+ end_offset; - buf = LT_EMALLOC (char, 1+ buf_len); - if (!buf) - return ++errors; - - assert (buf); - - strcpy (buf, dirnam); - strcat (buf, "/"); - strncat (buf, dp->d_name, end_offset); - buf[buf_len] = LT_EOS_CHAR; - - /* Try to insert (in order) into ARGZ/ARGZ_LEN. */ - if (lt_argz_insertinorder (pargz, pargz_len, buf) != 0) - ++errors; - - LT_DLFREE (buf); - - return errors; -} - -static int -list_files_by_dir (dirnam, pargz, pargz_len) - const char *dirnam; - char **pargz; - size_t *pargz_len; -{ - DIR *dirp = NULL; - int errors = 0; - - assert (dirnam && *dirnam); - assert (pargz); - assert (pargz_len); - assert (dirnam[LT_STRLEN(dirnam) -1] != '/'); - - dirp = opendir (dirnam); - if (dirp) - { - struct dirent *dp = NULL; - - while ((dp = readdir (dirp))) - if (dp->d_name[0] != '.') - if (lt_argz_insertdir (pargz, pargz_len, dirnam, dp)) - { - ++errors; - break; - } - - closedir (dirp); - } - else - ++errors; - - return errors; -} - - -/* If there are any files in DIRNAME, call the function passed in - DATA1 (with the name of each file and DATA2 as arguments). */ -static int -foreachfile_callback (dirname, data1, data2) - char *dirname; - lt_ptr data1; - lt_ptr data2; -{ - int (*func) LT_PARAMS((const char *filename, lt_ptr data)) - = (int (*) LT_PARAMS((const char *filename, lt_ptr data))) data1; - - int is_done = 0; - char *argz = NULL; - size_t argz_len = 0; - - if (list_files_by_dir (dirname, &argz, &argz_len) != 0) - goto cleanup; - if (!argz) - goto cleanup; - - { - char *filename = NULL; - while ((filename = argz_next (argz, argz_len, filename))) - if ((is_done = (*func) (filename, data2))) - break; - } - - cleanup: - LT_DLFREE (argz); - - return is_done; -} - - -/* Call FUNC for each unique extensionless file in SEARCH_PATH, along - with DATA. The filenames passed to FUNC would be suitable for - passing to lt_dlopenext. The extensions are stripped so that - individual modules do not generate several entries (e.g. libfoo.la, - libfoo.so, libfoo.so.1, libfoo.so.1.0.0). If SEARCH_PATH is NULL, - then the same directories that lt_dlopen would search are examined. */ -int -lt_dlforeachfile (search_path, func, data) - const char *search_path; - int (*func) LT_PARAMS ((const char *filename, lt_ptr data)); - lt_ptr data; -{ - int is_done = 0; - - if (search_path) - { - /* If a specific path was passed, search only the directories - listed in it. */ - is_done = foreach_dirinpath (search_path, 0, - foreachfile_callback, func, data); - } - else - { - /* Otherwise search the default paths. */ - is_done = foreach_dirinpath (user_search_path, 0, - foreachfile_callback, func, data); - if (!is_done) - { - is_done = foreach_dirinpath (getenv("LTDL_LIBRARY_PATH"), 0, - foreachfile_callback, func, data); - } - -#ifdef LTDL_SHLIBPATH_VAR - if (!is_done) - { - is_done = foreach_dirinpath (getenv(LTDL_SHLIBPATH_VAR), 0, - foreachfile_callback, func, data); - } -#endif -#ifdef LTDL_SYSSEARCHPATH - if (!is_done) - { - is_done = foreach_dirinpath (getenv(LTDL_SYSSEARCHPATH), 0, - foreachfile_callback, func, data); - } -#endif - } - - return is_done; -} - -int -lt_dlclose (handle) - lt_dlhandle handle; -{ - lt_dlhandle cur, last; - int errors = 0; - - LT_DLMUTEX_LOCK (); - - /* check whether the handle is valid */ - last = cur = handles; - while (cur && handle != cur) - { - last = cur; - cur = cur->next; - } - - if (!cur) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); - ++errors; - goto done; - } - - handle->info.ref_count--; - - /* Note that even with resident modules, we must track the ref_count - correctly incase the user decides to reset the residency flag - later (even though the API makes no provision for that at the - moment). */ - if (handle->info.ref_count <= 0 && !LT_DLIS_RESIDENT (handle)) - { - lt_user_data data = handle->loader->dlloader_data; - - if (handle != handles) - { - last->next = handle->next; - } - else - { - handles = handle->next; - } - - errors += handle->loader->module_close (data, handle->module); - errors += unload_deplibs(handle); - - /* It is up to the callers to free the data itself. */ - LT_DLFREE (handle->caller_data); - - LT_DLFREE (handle->info.filename); - LT_DLFREE (handle->info.name); - LT_DLFREE (handle); - - goto done; - } - - if (LT_DLIS_RESIDENT (handle)) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (CLOSE_RESIDENT_MODULE)); - ++errors; - } - - done: - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -lt_ptr -lt_dlsym (handle, symbol) - lt_dlhandle handle; - const char *symbol; -{ - size_t lensym; - char lsym[LT_SYMBOL_LENGTH]; - char *sym; - lt_ptr address; - lt_user_data data; - - if (!handle) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); - return 0; - } - - if (!symbol) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (SYMBOL_NOT_FOUND)); - return 0; - } - - lensym = LT_STRLEN (symbol) + LT_STRLEN (handle->loader->sym_prefix) - + LT_STRLEN (handle->info.name); - - if (lensym + LT_SYMBOL_OVERHEAD < LT_SYMBOL_LENGTH) - { - sym = lsym; - } - else - { - sym = LT_EMALLOC (char, lensym + LT_SYMBOL_OVERHEAD + 1); - if (!sym) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (BUFFER_OVERFLOW)); - return 0; - } - } - - data = handle->loader->dlloader_data; - if (handle->info.name) - { - const char *saved_error; - - LT_DLMUTEX_GETERROR (saved_error); - - /* this is a libtool module */ - if (handle->loader->sym_prefix) - { - strcpy(sym, handle->loader->sym_prefix); - strcat(sym, handle->info.name); - } - else - { - strcpy(sym, handle->info.name); - } - - strcat(sym, "_LTX_"); - strcat(sym, symbol); - - /* try "modulename_LTX_symbol" */ - address = handle->loader->find_sym (data, handle->module, sym); - if (address) - { - if (sym != lsym) - { - LT_DLFREE (sym); - } - return address; - } - LT_DLMUTEX_SETERROR (saved_error); - } - - /* otherwise try "symbol" */ - if (handle->loader->sym_prefix) - { - strcpy(sym, handle->loader->sym_prefix); - strcat(sym, symbol); - } - else - { - strcpy(sym, symbol); - } - - address = handle->loader->find_sym (data, handle->module, sym); - if (sym != lsym) - { - LT_DLFREE (sym); - } - - return address; -} - -const char * -lt_dlerror () -{ - const char *error; - - LT_DLMUTEX_GETERROR (error); - LT_DLMUTEX_SETERROR (0); - - return error ? error : LT_DLSTRERROR (UNKNOWN); -} - -static int -lt_dlpath_insertdir (ppath, before, dir) - char **ppath; - char *before; - const char *dir; -{ - int errors = 0; - char *canonical = NULL; - char *argz = NULL; - size_t argz_len = 0; - - assert (ppath); - assert (dir && *dir); - - if (canonicalize_path (dir, &canonical) != 0) - { - ++errors; - goto cleanup; - } - - assert (canonical && *canonical); - - /* If *PPATH is empty, set it to DIR. */ - if (*ppath == NULL) - { - assert (!before); /* BEFORE cannot be set without PPATH. */ - assert (dir); /* Without DIR, don't call this function! */ - - *ppath = lt_estrdup (dir); - if (*ppath == NULL) - ++errors; - - return errors; - } - - assert (ppath && *ppath); - - if (argzize_path (*ppath, &argz, &argz_len) != 0) - { - ++errors; - goto cleanup; - } - - /* Convert BEFORE into an equivalent offset into ARGZ. This only works - if *PPATH is already canonicalized, and hence does not change length - with respect to ARGZ. We canonicalize each entry as it is added to - the search path, and don't call this function with (uncanonicalized) - user paths, so this is a fair assumption. */ - if (before) - { - assert (*ppath <= before); - assert (before - *ppath <= strlen (*ppath)); - - before = before - *ppath + argz; - } - - if (lt_argz_insert (&argz, &argz_len, before, dir) != 0) - { - ++errors; - goto cleanup; - } - - argz_stringify (argz, argz_len, LT_PATHSEP_CHAR); - LT_DLMEM_REASSIGN (*ppath, argz); - - cleanup: - LT_DLFREE (canonical); - LT_DLFREE (argz); - - return errors; -} - -int -lt_dladdsearchdir (search_dir) - const char *search_dir; -{ - int errors = 0; - - if (search_dir && *search_dir) - { - LT_DLMUTEX_LOCK (); - if (lt_dlpath_insertdir (&user_search_path, 0, search_dir) != 0) - ++errors; - LT_DLMUTEX_UNLOCK (); - } - - return errors; -} - -int -lt_dlinsertsearchdir (before, search_dir) - const char *before; - const char *search_dir; -{ - int errors = 0; - - if (before) - { - LT_DLMUTEX_LOCK (); - if ((before < user_search_path) - || (before >= user_search_path + LT_STRLEN (user_search_path))) - { - LT_DLMUTEX_UNLOCK (); - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_POSITION)); - return 1; - } - LT_DLMUTEX_UNLOCK (); - } - - if (search_dir && *search_dir) - { - LT_DLMUTEX_LOCK (); - if (lt_dlpath_insertdir (&user_search_path, - (char *) before, search_dir) != 0) - { - ++errors; - } - LT_DLMUTEX_UNLOCK (); - } - - return errors; -} - -int -lt_dlsetsearchpath (search_path) - const char *search_path; -{ - int errors = 0; - - LT_DLMUTEX_LOCK (); - LT_DLFREE (user_search_path); - LT_DLMUTEX_UNLOCK (); - - if (!search_path || !LT_STRLEN (search_path)) - { - return errors; - } - - LT_DLMUTEX_LOCK (); - if (canonicalize_path (search_path, &user_search_path) != 0) - ++errors; - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -const char * -lt_dlgetsearchpath () -{ - const char *saved_path; - - LT_DLMUTEX_LOCK (); - saved_path = user_search_path; - LT_DLMUTEX_UNLOCK (); - - return saved_path; -} - -int -lt_dlmakeresident (handle) - lt_dlhandle handle; -{ - int errors = 0; - - if (!handle) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); - ++errors; - } - else - { - LT_DLSET_FLAG (handle, LT_DLRESIDENT_FLAG); - } - - return errors; -} - -int -lt_dlisresident (handle) - lt_dlhandle handle; -{ - if (!handle) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); - return -1; - } - - return LT_DLIS_RESIDENT (handle); -} - - - - -/* --- MODULE INFORMATION --- */ - -const lt_dlinfo * -lt_dlgetinfo (handle) - lt_dlhandle handle; -{ - if (!handle) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_HANDLE)); - return 0; - } - - return &(handle->info); -} - -lt_dlhandle -lt_dlhandle_next (place) - lt_dlhandle place; -{ - return place ? place->next : handles; -} - -int -lt_dlforeach (func, data) - int (*func) LT_PARAMS((lt_dlhandle handle, lt_ptr data)); - lt_ptr data; -{ - int errors = 0; - lt_dlhandle cur; - - LT_DLMUTEX_LOCK (); - - cur = handles; - while (cur) - { - lt_dlhandle tmp = cur; - - cur = cur->next; - if ((*func) (tmp, data)) - { - ++errors; - break; - } - } - - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -lt_dlcaller_id -lt_dlcaller_register () -{ - static lt_dlcaller_id last_caller_id = 0; - int result; - - LT_DLMUTEX_LOCK (); - result = ++last_caller_id; - LT_DLMUTEX_UNLOCK (); - - return result; -} - -lt_ptr -lt_dlcaller_set_data (key, handle, data) - lt_dlcaller_id key; - lt_dlhandle handle; - lt_ptr data; -{ - int n_elements = 0; - lt_ptr stale = NULL; - int i; - - /* This needs to be locked so that the caller data can be updated - simultaneously by different threads. */ - LT_DLMUTEX_LOCK (); - - if (handle->caller_data) - while (handle->caller_data[n_elements].key) - ++n_elements; - - for (i = 0; i < n_elements; ++i) - { - if (handle->caller_data[i].key == key) - { - stale = handle->caller_data[i].data; - break; - } - } - - /* Ensure that there is enough room in this handle's caller_data - array to accept a new element (and an empty end marker). */ - if (i == n_elements) - { - lt_caller_data *temp - = LT_DLREALLOC (lt_caller_data, handle->caller_data, 2+ n_elements); - - if (!temp) - { - stale = NULL; - goto done; - } - - handle->caller_data = temp; - - /* We only need this if we needed to allocate a new caller_data. */ - handle->caller_data[i].key = key; - handle->caller_data[1+ i].key = 0; - } - - handle->caller_data[i].data = data; - - done: - LT_DLMUTEX_UNLOCK (); - - return stale; -} - -lt_ptr -lt_dlcaller_get_data (key, handle) - lt_dlcaller_id key; - lt_dlhandle handle; -{ - lt_ptr result = (lt_ptr) 0; - - /* This needs to be locked so that the caller data isn't updated by - another thread part way through this function. */ - LT_DLMUTEX_LOCK (); - - /* Locate the index of the element with a matching KEY. */ - { - int i; - for (i = 0; handle->caller_data[i].key; ++i) - { - if (handle->caller_data[i].key == key) - { - result = handle->caller_data[i].data; - break; - } - } - } - - LT_DLMUTEX_UNLOCK (); - - return result; -} - - - -/* --- USER MODULE LOADER API --- */ - - -int -lt_dlloader_add (place, dlloader, loader_name) - lt_dlloader *place; - const struct lt_user_dlloader *dlloader; - const char *loader_name; -{ - int errors = 0; - lt_dlloader *node = NULL, *ptr = NULL; - - if ((dlloader == NULL) /* diagnose null parameters */ - || (dlloader->module_open == NULL) - || (dlloader->module_close == NULL) - || (dlloader->find_sym == NULL)) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); - return 1; - } - - /* Create a new dlloader node with copies of the user callbacks. */ - node = LT_EMALLOC (lt_dlloader, 1); - if (!node) - return 1; - - node->next = NULL; - node->loader_name = loader_name; - node->sym_prefix = dlloader->sym_prefix; - node->dlloader_exit = dlloader->dlloader_exit; - node->module_open = dlloader->module_open; - node->module_close = dlloader->module_close; - node->find_sym = dlloader->find_sym; - node->dlloader_data = dlloader->dlloader_data; - - LT_DLMUTEX_LOCK (); - if (!loaders) - { - /* If there are no loaders, NODE becomes the list! */ - loaders = node; - } - else if (!place) - { - /* If PLACE is not set, add NODE to the end of the - LOADERS list. */ - for (ptr = loaders; ptr->next; ptr = ptr->next) - { - /*NOWORK*/; - } - - ptr->next = node; - } - else if (loaders == place) - { - /* If PLACE is the first loader, NODE goes first. */ - node->next = place; - loaders = node; - } - else - { - /* Find the node immediately preceding PLACE. */ - for (ptr = loaders; ptr->next != place; ptr = ptr->next) - { - /*NOWORK*/; - } - - if (ptr->next != place) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); - ++errors; - } - else - { - /* Insert NODE between PTR and PLACE. */ - node->next = place; - ptr->next = node; - } - } - - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -int -lt_dlloader_remove (loader_name) - const char *loader_name; -{ - lt_dlloader *place = lt_dlloader_find (loader_name); - lt_dlhandle handle; - int errors = 0; - - if (!place) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); - return 1; - } - - LT_DLMUTEX_LOCK (); - - /* Fail if there are any open modules which use this loader. */ - for (handle = handles; handle; handle = handle->next) - { - if (handle->loader == place) - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (REMOVE_LOADER)); - ++errors; - goto done; - } - } - - if (place == loaders) - { - /* PLACE is the first loader in the list. */ - loaders = loaders->next; - } - else - { - /* Find the loader before the one being removed. */ - lt_dlloader *prev; - for (prev = loaders; prev->next; prev = prev->next) - { - if (!strcmp (prev->next->loader_name, loader_name)) - { - break; - } - } - - place = prev->next; - prev->next = prev->next->next; - } - - if (place->dlloader_exit) - { - errors = place->dlloader_exit (place->dlloader_data); - } - - LT_DLFREE (place); - - done: - LT_DLMUTEX_UNLOCK (); - - return errors; -} - -lt_dlloader * -lt_dlloader_next (place) - lt_dlloader *place; -{ - lt_dlloader *next; - - LT_DLMUTEX_LOCK (); - next = place ? place->next : loaders; - LT_DLMUTEX_UNLOCK (); - - return next; -} - -const char * -lt_dlloader_name (place) - lt_dlloader *place; -{ - const char *name = NULL; - - if (place) - { - LT_DLMUTEX_LOCK (); - name = place ? place->loader_name : 0; - LT_DLMUTEX_UNLOCK (); - } - else - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); - } - - return name; -} - -lt_user_data * -lt_dlloader_data (place) - lt_dlloader *place; -{ - lt_user_data *data = NULL; - - if (place) - { - LT_DLMUTEX_LOCK (); - data = place ? &(place->dlloader_data) : 0; - LT_DLMUTEX_UNLOCK (); - } - else - { - LT_DLMUTEX_SETERROR (LT_DLSTRERROR (INVALID_LOADER)); - } - - return data; -} - -lt_dlloader * -lt_dlloader_find (loader_name) - const char *loader_name; -{ - lt_dlloader *place = NULL; - - LT_DLMUTEX_LOCK (); - for (place = loaders; place; place = place->next) - { - if (strcmp (place->loader_name, loader_name) == 0) - { - break; - } - } - LT_DLMUTEX_UNLOCK (); - - return place; -} diff --git a/libguile-ltdl/upstream/ltdl.h b/libguile-ltdl/upstream/ltdl.h index 1842650b4..e69de29bb 100644 --- a/libguile-ltdl/upstream/ltdl.h +++ b/libguile-ltdl/upstream/ltdl.h @@ -1,361 +0,0 @@ -/* ltdl.h -- generic dlopen functions - Copyright (C) 1998-2000 Free Software Foundation, Inc. - Originally by Thomas Tanner <tanner@ffii.org> - This file is part of GNU Libtool. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Lesser General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -As a special exception to the GNU Lesser General Public License, -if you distribute this file as part of a program or library that -is built using GNU libtool, you may include it under the same -distribution terms that you use for the rest of that program. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with this library; if not, write to the Free -Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -02110-1301 USA -*/ - -/* Only include this header file once. */ -#ifndef LTDL_H -#define LTDL_H 1 - -#include <sys/types.h> /* for size_t declaration */ - - -/* --- MACROS FOR PORTABILITY --- */ - - -/* Saves on those hard to debug '\0' typos.... */ -#define LT_EOS_CHAR '\0' - -/* LTDL_BEGIN_C_DECLS should be used at the beginning of your declarations, - so that C++ compilers don't mangle their names. Use LTDL_END_C_DECLS at - the end of C declarations. */ -#ifdef __cplusplus -# define LT_BEGIN_C_DECLS extern "C" { -# define LT_END_C_DECLS } -#else -# define LT_BEGIN_C_DECLS /* empty */ -# define LT_END_C_DECLS /* empty */ -#endif - -LT_BEGIN_C_DECLS - - -/* LT_PARAMS is a macro used to wrap function prototypes, so that compilers - that don't understand ANSI C prototypes still work, and ANSI C - compilers can issue warnings about type mismatches. */ -#if defined (__STDC__) || defined (_AIX) || (defined (__mips) && defined (_SYSTYPE_SVR4)) || defined(WIN32) || defined(__cplusplus) -# define LT_PARAMS(protos) protos -# define lt_ptr void* -#else -# define LT_PARAMS(protos) () -# define lt_ptr char* -#endif - -/* LT_STMT_START/END are used to create macros which expand to a - a single compound statement in a portable way. */ -#if defined (__GNUC__) && !defined (__STRICT_ANSI__) && !defined (__cplusplus) -# define LT_STMT_START (void)( -# define LT_STMT_END ) -#else -# if (defined (sun) || defined (__sun__)) -# define LT_STMT_START if (1) -# define LT_STMT_END else (void)0 -# else -# define LT_STMT_START do -# define LT_STMT_END while (0) -# endif -#endif - -/* LT_CONC creates a new concatenated symbol for the compiler - in a portable way. */ -#if defined(__STDC__) || defined(__cplusplus) -# define LT_CONC(s,t) s##t -#else -# define LT_CONC(s,t) s/**/t -#endif - -/* LT_STRLEN can be used safely on NULL pointers. */ -#define LT_STRLEN(s) (((s) && (s)[0]) ? strlen (s) : 0) - - - -/* --- WINDOWS SUPPORT --- */ - - -/* Canonicalise Windows and Cygwin recognition macros. */ -#ifdef __CYGWIN32__ -# ifndef __CYGWIN__ -# define __CYGWIN__ __CYGWIN32__ -# endif -#endif -#if defined(_WIN32) || defined(WIN32) -# ifndef __WINDOWS__ -# ifdef _WIN32 -# define __WINDOWS__ _WIN32 -# else -# ifdef WIN32 -# define __WINDOWS__ WIN32 -# endif -# endif -# endif -#endif - -#ifdef __WINDOWS__ -# ifndef __CYGWIN__ -/* LT_DIRSEP_CHAR is accepted *in addition* to '/' as a directory - separator when it is set. */ -# define LT_DIRSEP_CHAR '\\' -# define LT_PATHSEP_CHAR ';' -# endif -#endif -#ifndef LT_PATHSEP_CHAR -# define LT_PATHSEP_CHAR ':' -#endif - -/* DLL building support on win32 hosts; mostly to workaround their - ridiculous implementation of data symbol exporting. */ -#ifndef LT_SCOPE -# ifdef __WINDOWS__ -# ifdef DLL_EXPORT /* defined by libtool (if required) */ -# define LT_SCOPE __declspec(dllexport) -# endif -# ifdef LIBLTDL_DLL_IMPORT /* define if linking with this dll */ -# define LT_SCOPE extern __declspec(dllimport) -# endif -# endif -# ifndef LT_SCOPE /* static linking or !__WINDOWS__ */ -# define LT_SCOPE extern -# endif -#endif - - - - -/* --- DYNAMIC MODULE LOADING API --- */ - - -typedef struct lt_dlhandle_struct *lt_dlhandle; /* A loaded module. */ - -/* Initialisation and finalisation functions for libltdl. */ -extern int lt_dlinit LT_PARAMS((void)); -extern int lt_dlexit LT_PARAMS((void)); - -/* Module search path manipulation. */ -extern int lt_dladdsearchdir LT_PARAMS((const char *search_dir)); -extern int lt_dlinsertsearchdir LT_PARAMS((const char *before, - const char *search_dir)); -extern int lt_dlsetsearchpath LT_PARAMS((const char *search_path)); -extern const char *lt_dlgetsearchpath LT_PARAMS((void)); -extern int lt_dlforeachfile LT_PARAMS(( - const char *search_path, - int (*func) (const char *filename, lt_ptr data), - lt_ptr data)); - -/* Portable libltdl versions of the system dlopen() API. */ -extern lt_dlhandle lt_dlopen LT_PARAMS((const char *filename)); -extern lt_dlhandle lt_dlopenext LT_PARAMS((const char *filename)); -extern lt_ptr lt_dlsym LT_PARAMS((lt_dlhandle handle, - const char *name)); -extern const char *lt_dlerror LT_PARAMS((void)); -extern int lt_dlclose LT_PARAMS((lt_dlhandle handle)); - -/* Module residency management. */ -extern int lt_dlmakeresident LT_PARAMS((lt_dlhandle handle)); -extern int lt_dlisresident LT_PARAMS((lt_dlhandle handle)); - - - - -/* --- MUTEX LOCKING --- */ - - -typedef void lt_dlmutex_lock LT_PARAMS((void)); -typedef void lt_dlmutex_unlock LT_PARAMS((void)); -typedef void lt_dlmutex_seterror LT_PARAMS((const char *errmsg)); -typedef const char *lt_dlmutex_geterror LT_PARAMS((void)); - -extern int lt_dlmutex_register LT_PARAMS((lt_dlmutex_lock *lock, - lt_dlmutex_unlock *unlock, - lt_dlmutex_seterror *seterror, - lt_dlmutex_geterror *geterror)); - - - - -/* --- MEMORY HANDLING --- */ - - -/* By default, the realloc function pointer is set to our internal - realloc implementation which iself uses lt_dlmalloc and lt_dlfree. - libltdl relies on a featureful realloc, but if you are sure yours - has the right semantics then you can assign it directly. Generally, - it is safe to assign just a malloc() and a free() function. */ -LT_SCOPE lt_ptr (*lt_dlmalloc) LT_PARAMS((size_t size)); -LT_SCOPE lt_ptr (*lt_dlrealloc) LT_PARAMS((lt_ptr ptr, size_t size)); -LT_SCOPE void (*lt_dlfree) LT_PARAMS((lt_ptr ptr)); - - - - -/* --- PRELOADED MODULE SUPPORT --- */ - - -/* A preopened symbol. Arrays of this type comprise the exported - symbols for a dlpreopened module. */ -typedef struct { - const char *name; - lt_ptr address; -} lt_dlsymlist; - -extern int lt_dlpreload LT_PARAMS((const lt_dlsymlist *preloaded)); -extern int lt_dlpreload_default - LT_PARAMS((const lt_dlsymlist *preloaded)); - -#define LTDL_SET_PRELOADED_SYMBOLS() LT_STMT_START{ \ - extern const lt_dlsymlist lt_preloaded_symbols[]; \ - lt_dlpreload_default(lt_preloaded_symbols); \ - }LT_STMT_END - - - - -/* --- MODULE INFORMATION --- */ - - -/* Read only information pertaining to a loaded module. */ -typedef struct { - char *filename; /* file name */ - char *name; /* module name */ - int ref_count; /* number of times lt_dlopened minus - number of times lt_dlclosed. */ -} lt_dlinfo; - -extern const lt_dlinfo *lt_dlgetinfo LT_PARAMS((lt_dlhandle handle)); -extern lt_dlhandle lt_dlhandle_next LT_PARAMS((lt_dlhandle place)); -extern int lt_dlforeach LT_PARAMS(( - int (*func) (lt_dlhandle handle, lt_ptr data), - lt_ptr data)); - -/* Associating user data with loaded modules. */ -typedef unsigned lt_dlcaller_id; - -extern lt_dlcaller_id lt_dlcaller_register LT_PARAMS((void)); -extern lt_ptr lt_dlcaller_set_data LT_PARAMS((lt_dlcaller_id key, - lt_dlhandle handle, - lt_ptr data)); -extern lt_ptr lt_dlcaller_get_data LT_PARAMS((lt_dlcaller_id key, - lt_dlhandle handle)); - - - -/* --- USER MODULE LOADER API --- */ - - -typedef struct lt_dlloader lt_dlloader; -typedef lt_ptr lt_user_data; -typedef lt_ptr lt_module; - -/* Function pointer types for creating user defined module loaders. */ -typedef lt_module lt_module_open LT_PARAMS((lt_user_data loader_data, - const char *filename)); -typedef int lt_module_close LT_PARAMS((lt_user_data loader_data, - lt_module handle)); -typedef lt_ptr lt_find_sym LT_PARAMS((lt_user_data loader_data, - lt_module handle, - const char *symbol)); -typedef int lt_dlloader_exit LT_PARAMS((lt_user_data loader_data)); - -struct lt_user_dlloader { - const char *sym_prefix; - lt_module_open *module_open; - lt_module_close *module_close; - lt_find_sym *find_sym; - lt_dlloader_exit *dlloader_exit; - lt_user_data dlloader_data; -}; - -extern lt_dlloader *lt_dlloader_next LT_PARAMS((lt_dlloader *place)); -extern lt_dlloader *lt_dlloader_find LT_PARAMS(( - const char *loader_name)); -extern const char *lt_dlloader_name LT_PARAMS((lt_dlloader *place)); -extern lt_user_data *lt_dlloader_data LT_PARAMS((lt_dlloader *place)); -extern int lt_dlloader_add LT_PARAMS((lt_dlloader *place, - const struct lt_user_dlloader *dlloader, - const char *loader_name)); -extern int lt_dlloader_remove LT_PARAMS(( - const char *loader_name)); - - - -/* --- ERROR MESSAGE HANDLING --- */ - - -/* Defining error strings alongside their symbolic names in a macro in - this way allows us to expand the macro in different contexts with - confidence that the enumeration of symbolic names will map correctly - onto the table of error strings. */ -#define lt_dlerror_table \ - LT_ERROR(UNKNOWN, "unknown error") \ - LT_ERROR(DLOPEN_NOT_SUPPORTED, "dlopen support not available") \ - LT_ERROR(INVALID_LOADER, "invalid loader") \ - LT_ERROR(INIT_LOADER, "loader initialization failed") \ - LT_ERROR(REMOVE_LOADER, "loader removal failed") \ - LT_ERROR(FILE_NOT_FOUND, "file not found") \ - LT_ERROR(DEPLIB_NOT_FOUND, "dependency library not found") \ - LT_ERROR(NO_SYMBOLS, "no symbols defined") \ - LT_ERROR(CANNOT_OPEN, "can't open the module") \ - LT_ERROR(CANNOT_CLOSE, "can't close the module") \ - LT_ERROR(SYMBOL_NOT_FOUND, "symbol not found") \ - LT_ERROR(NO_MEMORY, "not enough memory") \ - LT_ERROR(INVALID_HANDLE, "invalid module handle") \ - LT_ERROR(BUFFER_OVERFLOW, "internal buffer overflow") \ - LT_ERROR(INVALID_ERRORCODE, "invalid errorcode") \ - LT_ERROR(SHUTDOWN, "library already shutdown") \ - LT_ERROR(CLOSE_RESIDENT_MODULE, "can't close resident module") \ - LT_ERROR(INVALID_MUTEX_ARGS, "invalid mutex handler registration") \ - LT_ERROR(INVALID_POSITION, "invalid search path insert position") - -/* Enumerate the symbolic error names. */ -enum { -#define LT_ERROR(name, diagnostic) LT_CONC(LT_ERROR_, name), - lt_dlerror_table -#undef LT_ERROR - - LT_ERROR_MAX -}; - -/* These functions are only useful from inside custom module loaders. */ -extern int lt_dladderror LT_PARAMS((const char *diagnostic)); -extern int lt_dlseterror LT_PARAMS((int errorcode)); - - - - -/* --- SOURCE COMPATIBILITY WITH OLD LIBLTDL --- */ - - -#ifdef LT_NON_POSIX_NAMESPACE -# define lt_ptr_t lt_ptr -# define lt_module_t lt_module -# define lt_module_open_t lt_module_open -# define lt_module_close_t lt_module_close -# define lt_find_sym_t lt_find_sym -# define lt_dlloader_exit_t lt_dlloader_exit -# define lt_dlloader_t lt_dlloader -# define lt_dlloader_data_t lt_user_data -#endif - -LT_END_C_DECLS - -#endif /* !LTDL_H */ diff --git a/oop/Makefile.am b/oop/Makefile.am index 5545a4956..a48fcb080 100644 --- a/oop/Makefile.am +++ b/oop/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 2000, 2004 Free Software Foundation, Inc. +## Copyright (C) 2000, 2004, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/oop/goops.scm b/oop/goops.scm index ccbe02f21..c8f1f1837 100644 --- a/oop/goops.scm +++ b/oop/goops.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/oop/goops/Makefile.am b/oop/goops/Makefile.am index 61d2f7924..30b650d0a 100644 --- a/oop/goops/Makefile.am +++ b/oop/goops/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 2000, 2001, 2004, 2005 Free Software Foundation, Inc. +## Copyright (C) 2000, 2001, 2004, 2005, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/oop/goops/accessors.scm b/oop/goops/accessors.scm index cd629c459..1451f58ce 100644 --- a/oop/goops/accessors.scm +++ b/oop/goops/accessors.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999, 2000, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/oop/goops/active-slot.scm b/oop/goops/active-slot.scm index e6198d94a..e6b409ad0 100644 --- a/oop/goops/active-slot.scm +++ b/oop/goops/active-slot.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/oop/goops/compile.scm b/oop/goops/compile.scm index 5dfb5e762..c0175a72a 100644 --- a/oop/goops/compile.scm +++ b/oop/goops/compile.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/oop/goops/composite-slot.scm b/oop/goops/composite-slot.scm index a9f773afb..9bf5cf8f8 100644 --- a/oop/goops/composite-slot.scm +++ b/oop/goops/composite-slot.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/oop/goops/describe.scm b/oop/goops/describe.scm index 1cb7cd8f1..06acf30a0 100644 --- a/oop/goops/describe.scm +++ b/oop/goops/describe.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1998, 1999, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1998, 1999, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/oop/goops/dispatch.scm b/oop/goops/dispatch.scm index a1af69dd7..73f413234 100644 --- a/oop/goops/dispatch.scm +++ b/oop/goops/dispatch.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999, 2000, 2001, 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001, 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/oop/goops/internal.scm b/oop/goops/internal.scm index a8aed7e66..4288bd6f2 100644 --- a/oop/goops/internal.scm +++ b/oop/goops/internal.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/oop/goops/old-define-method.scm b/oop/goops/old-define-method.scm index b6c251341..3469dc9bb 100644 --- a/oop/goops/old-define-method.scm +++ b/oop/goops/old-define-method.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/oop/goops/save.scm b/oop/goops/save.scm index 88d31f7ee..e9c8e00eb 100644 --- a/oop/goops/save.scm +++ b/oop/goops/save.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 2000,2001,2002 Free Software Foundation, Inc. +;;;; Copyright (C) 2000,2001,2002, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/oop/goops/simple.scm b/oop/goops/simple.scm index 56fc945bb..48e76f312 100644 --- a/oop/goops/simple.scm +++ b/oop/goops/simple.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/oop/goops/stklos.scm b/oop/goops/stklos.scm index 49c62a53e..60ab293c3 100644 --- a/oop/goops/stklos.scm +++ b/oop/goops/stklos.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999,2002 Free Software Foundation, Inc. +;;;; Copyright (C) 1999,2002, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/oop/goops/util.scm b/oop/goops/util.scm index b4d85e022..33e871c54 100644 --- a/oop/goops/util.scm +++ b/oop/goops/util.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999, 2000, 2001, 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001, 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/qt/Makefile.am b/qt/Makefile.am index 7513f60cd..fc9951d30 100644 --- a/qt/Makefile.am +++ b/qt/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998, 2000 Free Software Foundation, Inc. +## Copyright (C) 1998, 2000, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/qt/md/Makefile.am b/qt/md/Makefile.am index b686468f5..7500dc66c 100644 --- a/qt/md/Makefile.am +++ b/qt/md/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998, 2002 Free Software Foundation, Inc. +## Copyright (C) 1998, 2002, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/qt/md/i386.asm b/qt/md/i386.asm index b79f165df..3638cc127 100644 --- a/qt/md/i386.asm +++ b/qt/md/i386.asm @@ -2,7 +2,7 @@ ;; ;; QuickThreads -- Threads-building toolkit. -;; Copyright (c) 2001 Free Software Foundation, Inc. +;; Copyright (c) 2001, 2006 Free Software Foundation, Inc. ;; ;; Permission to use, copy, modify and distribute this software and ;; its documentation for any purpose and without fee is hereby diff --git a/qt/time/Makefile.am b/qt/time/Makefile.am index 909cdf4e2..735620330 100644 --- a/qt/time/Makefile.am +++ b/qt/time/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998 Free Software Foundation, Inc. +## Copyright (C) 1998, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/scripts/Makefile.am b/scripts/Makefile.am index 048093d41..7b69312ce 100644 --- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 2002 Free Software Foundation, Inc. +## Copyright (C) 2002, 2006 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## diff --git a/scripts/PROGRAM b/scripts/PROGRAM index 476e0dfca..e83540851 100755 --- a/scripts/PROGRAM +++ b/scripts/PROGRAM @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; PROGRAM --- Does something -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/api-diff b/scripts/api-diff index 47188bd08..0b41eeaaf 100755 --- a/scripts/api-diff +++ b/scripts/api-diff @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; api-diff --- diff guile-api.alist files -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/autofrisk b/scripts/autofrisk index 5d44d6c72..154b635bb 100755 --- a/scripts/autofrisk +++ b/scripts/autofrisk @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; autofrisk --- Generate module checks for use with auto* tools -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/display-commentary b/scripts/display-commentary index 967882449..a12dae8c7 100755 --- a/scripts/display-commentary +++ b/scripts/display-commentary @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; display-commentary --- As advertized -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/doc-snarf b/scripts/doc-snarf index 11979e103..4bc09f57c 100755 --- a/scripts/doc-snarf +++ b/scripts/doc-snarf @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; doc-snarf --- Extract documentation from source files -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/frisk b/scripts/frisk index 25c4f526d..609a5e6a9 100755 --- a/scripts/frisk +++ b/scripts/frisk @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; frisk --- Grok the module interfaces of a body of files -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/generate-autoload b/scripts/generate-autoload index 8ce13f577..b08be8357 100755 --- a/scripts/generate-autoload +++ b/scripts/generate-autoload @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; generate-autoload --- Display define-module form with autoload info -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/lint b/scripts/lint index 6b62ed057..354420751 100755 --- a/scripts/lint +++ b/scripts/lint @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; lint --- Preemptive checks for coding errors in Guile Scheme code -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/punify b/scripts/punify index 00de3c66f..0f6a36114 100755 --- a/scripts/punify +++ b/scripts/punify @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; punify --- Display Scheme code w/o unnecessary comments / whitespace -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/read-rfc822 b/scripts/read-rfc822 index 12d84b3db..0904d61d1 100755 --- a/scripts/read-rfc822 +++ b/scripts/read-rfc822 @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; read-rfc822 --- Validate RFC822 file by displaying it to stdout -;; Copyright (C) 2002, 2004 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2004, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/read-scheme-source b/scripts/read-scheme-source index 023bd76f4..05bb1064c 100755 --- a/scripts/read-scheme-source +++ b/scripts/read-scheme-source @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; read-scheme-source --- Read a file, recognizing scheme forms and comments -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/read-text-outline b/scripts/read-text-outline index 7affb6348..c85026952 100755 --- a/scripts/read-text-outline +++ b/scripts/read-text-outline @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; read-text-outline --- Read a text outline and display it as a sexp -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/scan-api b/scripts/scan-api index 7fdc2e3b0..3ea10dbe6 100755 --- a/scripts/scan-api +++ b/scripts/scan-api @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; scan-api --- Scan and group interpreter and libguile interface elements -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/snarf-check-and-output-texi b/scripts/snarf-check-and-output-texi index 500a4097a..ea33e1797 100755 --- a/scripts/snarf-check-and-output-texi +++ b/scripts/snarf-check-and-output-texi @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; snarf-check-and-output-texi --- called by the doc snarfer. -;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/snarf-guile-m4-docs b/scripts/snarf-guile-m4-docs index 5ee52da16..b80f187fe 100755 --- a/scripts/snarf-guile-m4-docs +++ b/scripts/snarf-guile-m4-docs @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; snarf-guile-m4-docs --- Parse guile.m4 comments for texi documentation -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/summarize-guile-TODO b/scripts/summarize-guile-TODO index 9d6d3ac55..79543fe27 100755 --- a/scripts/summarize-guile-TODO +++ b/scripts/summarize-guile-TODO @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; summarize-guile-TODO --- Display Guile TODO list in various ways -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/scripts/use2dot b/scripts/use2dot index 5f1e5c73d..30b4690e0 100755 --- a/scripts/use2dot +++ b/scripts/use2dot @@ -5,7 +5,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; use2dot --- Display module dependencies as a DOT specification -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 29ab92c83..d7b7981af 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,45 @@ +2006-04-16 Kevin Ryde <user42@zip.com.au> + + * tests/filesys.test (lstat, stat): New tests. + * tests/ports.test (truncate-file): New tests. + +2006-03-28 Kevin Ryde <user42@zip.com.au> + + * Makefile.am (SCM_TESTS): Remove slib.test, it fails with current + slib and the ice-9 slib module is due for revision soon. + +2006-03-19 Kevin Ryde <user42@zip.com.au> + + * tests/unif.test (make-shared-array): Another test which failed in + 1.8.0 but is ok now. + +2006-03-05 Kevin Ryde <user42@zip.com.au> + + * tests/unif.test (make-shared-array): Add example usages from the + manual, two of which currently fail. + +2006-03-04 Ludovic Courtès <ludovic.courtes@laas.fr> + + * test-suite/tests/modules.test: New file. + * test-suite/Makefile.am (SCM_TESTS): Added it. + +2006-02-26 Kevin Ryde <user42@zip.com.au> + + * tests/filesys.test (opendir etc): Exercise a little. + + * tests/strings.test (string<?, string-ci<?, string<=?, string-ci<=?, + string>?, string-ci>?, string>=?, string-ci>=?): Check ordering is the + same as char<? etc. Use a define-module to keep private test bits + private. + * tests/srfi-13.test (string-compare, string-compare-ci): Ditto. + + * tests/unif.test (array-set!): Exercise bitvector case, which had + been seg faulting. + +2006-02-07 Kevin Ryde <user42@zip.com.au> + + * tests/poe.test (pure-funcq): New tests. + 2006-02-04 Neil Jerram <neil@ossau.uklinux.net> * tests/exceptions.test: 19 new test cases. diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 90bf60581..7f0e72bc5 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright 2001, 2002, 2003, 2004, 2005 Software Foundation, Inc. +## Copyright 2001, 2002, 2003, 2004, 2005, 2006 Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -46,6 +46,7 @@ SCM_TESTS = tests/alist.test \ tests/interp.test \ tests/list.test \ tests/load.test \ + tests/modules.test \ tests/multilingual.nottest \ tests/numbers.test \ tests/optargs.test \ @@ -61,7 +62,6 @@ SCM_TESTS = tests/alist.test \ tests/reader.test \ tests/receive.test \ tests/regexp.test \ - tests/slib.test \ tests/socket.test \ tests/srcprop.test \ tests/srfi-1.test \ diff --git a/test-suite/guile-test b/test-suite/guile-test index 9c8805497..1e1c70a77 100755 --- a/test-suite/guile-test +++ b/test-suite/guile-test @@ -5,7 +5,7 @@ ;;;; guile-test --- run the Guile test suite ;;;; Jim Blandy <jimb@red-bean.com> --- May 1999 ;;;; -;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/lib.scm b/test-suite/lib.scm index 520372762..f67018ee7 100644 --- a/test-suite/lib.scm +++ b/test-suite/lib.scm @@ -1,5 +1,5 @@ ;;;; test-suite/lib.scm --- generic support for testing -;;;; Copyright (C) 1999, 2000, 2001, 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/standalone/.cvsignore b/test-suite/standalone/.cvsignore index cf1f697db..49fe7fee0 100644 --- a/test-suite/standalone/.cvsignore +++ b/test-suite/standalone/.cvsignore @@ -10,3 +10,4 @@ test-gh test-num2integral test-round test-unwind +test-list diff --git a/test-suite/standalone/test-asmobs-lib.c b/test-suite/standalone/test-asmobs-lib.c index bbc277d92..f3d1634a2 100644 --- a/test-suite/standalone/test-asmobs-lib.c +++ b/test-suite/standalone/test-asmobs-lib.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1999,2000,2001,2003 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001,2003, 2006 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/standalone/test-conversion.c b/test-suite/standalone/test-conversion.c index d6902648f..9f1a7b60f 100644 --- a/test-suite/standalone/test-conversion.c +++ b/test-suite/standalone/test-conversion.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1999,2000,2001,2003,2004 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001,2003,2004, 2006 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/standalone/test-gh.c b/test-suite/standalone/test-gh.c index 170e210c0..7e030f4d3 100644 --- a/test-suite/standalone/test-gh.c +++ b/test-suite/standalone/test-gh.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1999,2000,2001,2003 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001,2003, 2006 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/standalone/test-num2integral.c b/test-suite/standalone/test-num2integral.c index af61ec13d..947890a48 100644 --- a/test-suite/standalone/test-num2integral.c +++ b/test-suite/standalone/test-num2integral.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1999,2000,2001,2003,2004 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001,2003,2004, 2006 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/standalone/test-round.c b/test-suite/standalone/test-round.c index 118961282..c594d5812 100644 --- a/test-suite/standalone/test-round.c +++ b/test-suite/standalone/test-round.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2004 Free Software Foundation, Inc. +/* Copyright (C) 2004, 2006 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/alist.test b/test-suite/tests/alist.test index e3722dc4d..a9e9b0d24 100644 --- a/test-suite/tests/alist.test +++ b/test-suite/tests/alist.test @@ -1,5 +1,5 @@ ;;;; alist.test --- tests guile's alists -*- scheme -*- -;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/and-let-star.test b/test-suite/tests/and-let-star.test index 099c3422d..0f74934f7 100644 --- a/test-suite/tests/and-let-star.test +++ b/test-suite/tests/and-let-star.test @@ -1,6 +1,6 @@ ;;;; and-let-star.test --- Tests for Guile and-let-star module. -*- scheme -*- ;;;; -;;;; Copyright (C) 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/arbiters.test b/test-suite/tests/arbiters.test index 3aedabd24..7591f02f0 100644 --- a/test-suite/tests/arbiters.test +++ b/test-suite/tests/arbiters.test @@ -1,6 +1,6 @@ ;;;; arbiters.test --- test arbiters functions -*- scheme -*- ;;;; -;;;; Copyright (C) 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/bit-operations.test b/test-suite/tests/bit-operations.test index f63f894ea..8e35257b3 100644 --- a/test-suite/tests/bit-operations.test +++ b/test-suite/tests/bit-operations.test @@ -1,5 +1,5 @@ ;;;; bit-operations.test --- bitwise operations on numbers -*- scheme -*- -;;;; Copyright (C) 2000, 2001, 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001, 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/c-api.test b/test-suite/tests/c-api.test index 6c24c0aac..4a165d4cb 100644 --- a/test-suite/tests/c-api.test +++ b/test-suite/tests/c-api.test @@ -1,7 +1,7 @@ ;;;; c-api.test --- complementary test suite for the c-api -*- scheme -*- ;;;; MDJ 990915 <djurfeldt@nada.kth.se> ;;;; -;;;; Copyright (C) 1999 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test index b7319466b..f14c832dd 100644 --- a/test-suite/tests/chars.test +++ b/test-suite/tests/chars.test @@ -1,7 +1,7 @@ ;;;; chars.test --- test suite for Guile's char functions -*- scheme -*- ;;;; Greg J. Badros <gjb@cs.washington.edu> ;;;; -;;;; Copyright (C) 2000 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/common-list.test b/test-suite/tests/common-list.test index 511da1f57..c6f659b1e 100644 --- a/test-suite/tests/common-list.test +++ b/test-suite/tests/common-list.test @@ -1,5 +1,5 @@ ;;;; common-list.test --- tests guile's common list functions -*- scheme -*- -;;;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001, 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/continuations.test b/test-suite/tests/continuations.test index 6d8a6a69a..c1b6803cb 100644 --- a/test-suite/tests/continuations.test +++ b/test-suite/tests/continuations.test @@ -1,7 +1,7 @@ ;;;; -*- scheme -*- ;;;; continuations.test --- test suite for continutations ;;;; -;;;; Copyright (C) 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/dynamic-scope.test b/test-suite/tests/dynamic-scope.test index 60f91f05e..d7a06a411 100644 --- a/test-suite/tests/dynamic-scope.test +++ b/test-suite/tests/dynamic-scope.test @@ -1,7 +1,7 @@ ;;;; -*- scheme -*- ;;;; dynamic-scop.test --- test suite for dynamic scoping constructs ;;;; -;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/elisp.test b/test-suite/tests/elisp.test index 964e8baeb..067f7b16f 100644 --- a/test-suite/tests/elisp.test +++ b/test-suite/tests/elisp.test @@ -1,5 +1,5 @@ ;;;; elisp.test --- tests guile's elisp support -*- scheme -*- -;;;; Copyright (C) 2002, 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 2002, 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/environments.test b/test-suite/tests/environments.test index d96295f22..19117e3b5 100644 --- a/test-suite/tests/environments.test +++ b/test-suite/tests/environments.test @@ -1,5 +1,5 @@ ;;;; environments.test -*- scheme -*- -;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test index 18541da94..6bca6235c 100644 --- a/test-suite/tests/eval.test +++ b/test-suite/tests/eval.test @@ -1,5 +1,5 @@ ;;;; eval.test --- tests guile's evaluator -*- scheme -*- -;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/exceptions.test b/test-suite/tests/exceptions.test index 565cc8fea..4a9c1cb55 100644 --- a/test-suite/tests/exceptions.test +++ b/test-suite/tests/exceptions.test @@ -1,5 +1,5 @@ ;;;; exceptions.test --- tests for Guile's exception handling -*- scheme -*- -;;;; Copyright (C) 2001, 2003, 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2003, 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test index 6ccb021ea..7ba4feb06 100644 --- a/test-suite/tests/filesys.test +++ b/test-suite/tests/filesys.test @@ -1,6 +1,6 @@ ;;;; filesys.test --- test file system functions -*- scheme -*- ;;;; -;;;; Copyright (C) 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -17,7 +17,14 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-suite test-filesys) - #:use-module (test-suite lib)) + #:use-module (test-suite lib) + #:use-module (test-suite guile-test)) + +(define (test-file) + (data-file-name "filesys-test.tmp")) +(define (test-symlink) + (data-file-name "filesys-test-link.tmp")) + ;;; ;;; copy-file @@ -37,3 +44,84 @@ (let ((old-next (next-fd))) (false-if-exception (copy-file "/dev/null" "no/such/dir/foo")) (= old-next (next-fd))))) + +;;; +;;; lstat +;;; + +(with-test-prefix "lstat" + + (pass-if "normal file" + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (eqv? 5 (stat:size (lstat (test-file))))) + + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (delete-file (test-symlink)) + (if (not (false-if-exception + (begin (symlink (test-file) (test-symlink)) #t))) + (display "cannot create symlink, lstat test skipped\n") + (pass-if "symlink" + ;; not much to test, except that it works + (->bool (lstat (test-symlink)))))) + +;;; +;;; opendir and friends +;;; + +(with-test-prefix "opendir" + + (with-test-prefix "root directory" + (let ((d (opendir "/"))) + (pass-if "not empty" + (string? (readdir d))) + (pass-if "all entries are strings" + (let more () + (let ((f (readdir d))) + (cond ((string? f) + (more)) + ((eof-object? f) + #t) + (else + #f))))) + (closedir d)))) + +;;; +;;; stat +;;; + +(with-test-prefix "stat" + + (with-test-prefix "filename" + + (pass-if "size" + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (eqv? 5 (stat:size (stat (test-file)))))) + + (with-test-prefix "file descriptor" + + (pass-if "size" + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (let* ((fd (open-fdes (test-file) O_RDONLY)) + (st (stat fd))) + (close-fdes fd) + (eqv? 5 (stat:size st))))) + + (with-test-prefix "port" + + (pass-if "size" + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (let* ((port (open-file (test-file) "r+")) + (st (stat port))) + (close-port port) + (eqv? 5 (stat:size st)))))) + diff --git a/test-suite/tests/format.test b/test-suite/tests/format.test index a99dfa737..3cdc8dc75 100644 --- a/test-suite/tests/format.test +++ b/test-suite/tests/format.test @@ -1,7 +1,7 @@ ;;;; format.test --- test suite for Guile's CL-ish format -*- scheme -*- ;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001 ;;;; -;;;; Copyright (C) 2001, 2003, 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2003, 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/fractions.test b/test-suite/tests/fractions.test index 9a95e126b..0e1a4d6c1 100644 --- a/test-suite/tests/fractions.test +++ b/test-suite/tests/fractions.test @@ -1,4 +1,4 @@ -;;;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License version 2 as diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test index c425e2daa..abd714b9a 100644 --- a/test-suite/tests/gc.test +++ b/test-suite/tests/gc.test @@ -1,5 +1,5 @@ ;;;; gc.test --- test guile's garbage collection -*- scheme -*- -;;;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001, 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/getopt-long.test b/test-suite/tests/getopt-long.test index b73eeb402..fe4a8872b 100644 --- a/test-suite/tests/getopt-long.test +++ b/test-suite/tests/getopt-long.test @@ -1,7 +1,7 @@ ;;;; getopt-long.test --- long options processing -*- scheme -*- ;;;; Thien-Thi Nguyen <ttn@gnu.org> --- August 2001 ;;;; -;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test index 7939ab296..dd61369c5 100644 --- a/test-suite/tests/goops.test +++ b/test-suite/tests/goops.test @@ -1,6 +1,6 @@ ;;;; goops.test --- test suite for GOOPS -*- scheme -*- ;;;; -;;;; Copyright (C) 2001,2003,2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2001,2003,2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/guardians.test b/test-suite/tests/guardians.test index f07e4a904..15f67e609 100644 --- a/test-suite/tests/guardians.test +++ b/test-suite/tests/guardians.test @@ -1,7 +1,7 @@ ;;;; guardians.test --- test suite for Guile Guardians -*- scheme -*- ;;;; Jim Blandy <jimb@red-bean.com> --- July 1999 ;;;; -;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test index 2c589a088..8215df118 100644 --- a/test-suite/tests/hash.test +++ b/test-suite/tests/hash.test @@ -1,6 +1,6 @@ ;;;; hash.test --- test guile hashing -*- scheme -*- ;;;; -;;;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/hooks.test b/test-suite/tests/hooks.test index cb43c019d..f8ed39919 100644 --- a/test-suite/tests/hooks.test +++ b/test-suite/tests/hooks.test @@ -1,5 +1,5 @@ ;;;; hooks.test --- tests guile's hooks implementation -*- scheme -*- -;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/import.test b/test-suite/tests/import.test index cdd75e5a2..4c4be02b2 100644 --- a/test-suite/tests/import.test +++ b/test-suite/tests/import.test @@ -1,5 +1,5 @@ ;;;; import.test --- test selective and renaming imports -*- scheme -*- -;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/interp.test b/test-suite/tests/interp.test index c84e6b397..a091515b9 100644 --- a/test-suite/tests/interp.test +++ b/test-suite/tests/interp.test @@ -1,6 +1,6 @@ ;;;; interp.test --- tests for bugs in the Guile interpreter -*- scheme -*- ;;;; -;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/list.test b/test-suite/tests/list.test index 98c14e9e6..7dc0ef0f8 100644 --- a/test-suite/tests/list.test +++ b/test-suite/tests/list.test @@ -1,5 +1,5 @@ ;;;; list.test --- tests guile's lists -*- scheme -*- -;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/load.test b/test-suite/tests/load.test index 6bcd01f2e..a71a34716 100644 --- a/test-suite/tests/load.test +++ b/test-suite/tests/load.test @@ -1,7 +1,7 @@ ;;;; load.test --- test LOAD and path searching functions -*- scheme -*- ;;;; Jim Blandy <jimb@red-bean.com> --- September 1999 ;;;; -;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test new file mode 100644 index 000000000..9541f0662 --- /dev/null +++ b/test-suite/tests/modules.test @@ -0,0 +1,50 @@ +;;;; modules.test --- exercise some of guile's module stuff -*- scheme -*- + +;;;; Copyright (C) 2006 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 2.1 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(use-modules (test-suite lib)) + +(with-test-prefix "autoload" + + (pass-if "autoloaded" + (catch #t + (lambda () + ;; Simple autoloading. + (eval '(begin + (define-module (test-autoload-one) + :autoload (ice-9 q) (make-q)) + (not (not make-q))) + (current-module))) + (lambda (key . args) + #f))) + + ;; In Guile 1.8.0 this failed because the binder in + ;; `make-autoload-interface' would try to remove the autoload interface + ;; from the module's "uses" without making sure it is still part of these + ;; "uses". + ;; + (pass-if "autoloaded+used" + (catch #t + (lambda () + (eval '(begin + (define-module (test-autoload-two) + :autoload (ice-9 q) (make-q) + :use-module (ice-9 q)) + (not (not make-q))) + (current-module))) + (lambda (key . args) + #f)))) diff --git a/test-suite/tests/multilingual.nottest b/test-suite/tests/multilingual.nottest index 18163d3a1..46a3ee2d3 100644 --- a/test-suite/tests/multilingual.nottest +++ b/test-suite/tests/multilingual.nottest @@ -2,7 +2,7 @@ ;;;; Jim Blandy <jimb@red-bean.com> --- September 1999 ;;;; This isn't a test yet, because we don't have multilingual support yet. ;;;; -;;;; Copyright (C) 1999 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index c19b065ca..54117b044 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -1,5 +1,5 @@ ;;;; numbers.test --- tests guile's numbers -*- scheme -*- -;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test index a45d3609b..040b68ba4 100644 --- a/test-suite/tests/optargs.test +++ b/test-suite/tests/optargs.test @@ -1,7 +1,7 @@ ;;;; optargs.test --- test suite for optional arg processing -*- scheme -*- ;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001 ;;;; -;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/options.test b/test-suite/tests/options.test index 168676b30..f2f87143b 100644 --- a/test-suite/tests/options.test +++ b/test-suite/tests/options.test @@ -1,6 +1,6 @@ ;;;; options.test --- test suite for options interface -*- scheme -*- ;;;; -;;;; Copyright (C) 2002 Free Software Foundation, Inc. +;;;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/pairs.test b/test-suite/tests/pairs.test index 97fd34f64..af2f3e275 100644 --- a/test-suite/tests/pairs.test +++ b/test-suite/tests/pairs.test @@ -1,6 +1,6 @@ ;;;; pairs.test --- test suite for Guile's pair functions -*- scheme -*- ;;;; -;;;; Copyright (C) 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/poe.test b/test-suite/tests/poe.test index 8d353de55..6c7625602 100644 --- a/test-suite/tests/poe.test +++ b/test-suite/tests/poe.test @@ -1,6 +1,6 @@ ;;;; poe.test --- exercise ice-9/poe.scm -*- scheme -*- ;;;; -;;;; Copyright 2003 Free Software Foundation, Inc. +;;;; Copyright 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -25,6 +25,64 @@ ;; pure-funcq ;; +(with-test-prefix "pure-funcq" + + (with-test-prefix "no args" + (define obj (vector 123)) ;; not gc'ed + (define called #f) + (define (foo) + (set! called #t) + obj) + + (let ((func (pure-funcq foo))) + + (pass-if "called first" + (set! called #f) + (and (eq? obj (func)) + called)) + + (pass-if "not called second" + (set! called #f) + (and (eq? obj (func)) + (not called))))) + + (with-test-prefix "1 arg" + (define obj1 (vector 123)) ;; not gc'ed + (define obj2 (vector 456)) ;; not gc'ed + (define called #f) + (define (foo sym) + (set! called #t) + (case sym + ((x) obj1) + ((y) obj2) + (else (error "oops")))) + + (let ((func (pure-funcq foo))) + + (pass-if "called first x" + (set! called #f) + (and (eq? obj1 (func 'x)) + called)) + + (pass-if "not called second x" + (set! called #f) + (and (eq? obj1 (func 'x)) + (not called))) + + (pass-if "called first y" + (set! called #f) + (and (eq? obj2 (func 'y)) + called)) + + (pass-if "not called second y" + (set! called #f) + (and (eq? obj2 (func 'y)) + (not called))) + + (pass-if "not called third x" + (set! called #f) + (and (eq? obj1 (func 'x)) + (not called)))))) ;; ;; perfect-funcq diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test index d83d91c4c..19d3edc49 100644 --- a/test-suite/tests/popen.test +++ b/test-suite/tests/popen.test @@ -1,6 +1,6 @@ ;;;; popen.test --- exercise ice-9/popen.scm -*- scheme -*- ;;;; -;;;; Copyright 2003 Free Software Foundation, Inc. +;;;; Copyright 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index aab58d071..15f888e00 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -1,7 +1,7 @@ ;;;; ports.test --- test suite for Guile I/O ports -*- scheme -*- ;;;; Jim Blandy <jimb@red-bean.com> --- May 1999 ;;;; -;;;; Copyright (C) 1999, 2001, 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -538,6 +538,42 @@ (while (not (eof-object? (read-char port)))) (= 8 (port-column port)))))) +;;; +;;; truncate-file +;;; + +(with-test-prefix "truncate-file" + + (with-test-prefix "filename" + + (pass-if "shorten" + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (truncate-file (test-file) 1) + (eqv? 1 (stat:size (stat (test-file)))))) + + (with-test-prefix "file descriptor" + + (pass-if "shorten" + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (let ((fd (open-fdes (test-file) O_RDWR))) + (truncate-file fd 1) + (close-fdes fd)) + (eqv? 1 (stat:size (stat (test-file)))))) + + (with-test-prefix "file port" + + (pass-if "shorten" + (call-with-output-file (test-file) + (lambda (port) + (display "hello" port))) + (let ((port (open-file (test-file) "r+"))) + (truncate-file port 1)) + (eqv? 1 (stat:size (stat (test-file))))))) + ;;;; testing read-delimited and friends diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test index 6e8d51af5..cd76a44ec 100644 --- a/test-suite/tests/posix.test +++ b/test-suite/tests/posix.test @@ -1,6 +1,6 @@ ;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*- ;;;; -;;;; Copyright 2003, 2004 Free Software Foundation, Inc. +;;;; Copyright 2003, 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/q.test b/test-suite/tests/q.test index d9238c3ee..5c24e5202 100644 --- a/test-suite/tests/q.test +++ b/test-suite/tests/q.test @@ -1,6 +1,6 @@ ;;;; q.test --- test (ice-9 q) module -*- scheme -*- ;;;; -;;;; Copyright 2004 Free Software Foundation, Inc. +;;;; Copyright 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/r4rs.test b/test-suite/tests/r4rs.test index 8abfabb3e..e47364c66 100644 --- a/test-suite/tests/r4rs.test +++ b/test-suite/tests/r4rs.test @@ -1,5 +1,5 @@ ;;;; r4rs.test --- tests for R4RS compliance -*- scheme -*- -;;;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1999, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1999, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/r5rs_pitfall.test b/test-suite/tests/r5rs_pitfall.test index 1c99b5fc9..8fa78e9c1 100644 --- a/test-suite/tests/r5rs_pitfall.test +++ b/test-suite/tests/r5rs_pitfall.test @@ -1,5 +1,5 @@ ;;;; r5rs_pitfall.test --- tests some pitfalls in R5RS -*- scheme -*- -;;;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test index 088a2d3e8..d923bc1f2 100644 --- a/test-suite/tests/ramap.test +++ b/test-suite/tests/ramap.test @@ -1,6 +1,6 @@ ;;;; ramap.test --- test array mapping functions -*- scheme -*- ;;;; -;;;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/receive.test b/test-suite/tests/receive.test index 2619a268a..4b55bdf9f 100644 --- a/test-suite/tests/receive.test +++ b/test-suite/tests/receive.test @@ -1,6 +1,6 @@ ;;;; receive.test --- Test suite for Guile receive module. -*- scheme -*- ;;;; -;;;; Copyright (C) 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/regexp.test b/test-suite/tests/regexp.test index 1e7cdd20d..7e7914534 100644 --- a/test-suite/tests/regexp.test +++ b/test-suite/tests/regexp.test @@ -1,7 +1,7 @@ ;;;; regexp.test --- test Guile's regular expression functions -*- scheme -*- ;;;; Jim Blandy <jimb@red-bean.com> --- September 1999 ;;;; -;;;; Copyright (C) 1999, 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/slib.test b/test-suite/tests/slib.test index fa9a601ce..e69de29bb 100644 --- a/test-suite/tests/slib.test +++ b/test-suite/tests/slib.test @@ -1,292 +0,0 @@ -;;;; slib.test --- Test suite for Guile's SLIB glue. -*- scheme -*- -;;;; -;;;; Copyright 2003, 2004 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;;;; Boston, MA 02110-1301 USA - -;; These tests are run only if slib is available. slib will need to be -;; installed (or linked) under the configured guile $prefix. -;; -(if (catch #t - (lambda () (resolve-module '(ice-9 slib))) - (lambda args #f)) - (begin - - (define-module (test-suite test-ice-9-slib) - #:use-module (test-suite lib) - #:use-module (ice-9 slib)) - - - (with-test-prefix "Configuration" - - ;; - ;; char-code-limit - ;; - - (with-test-prefix "char-code-limit" - (pass-if "integer" (integer? char-code-limit))) - - ;; - ;; most-positive-fixnum - ;; - - (with-test-prefix "most-positive-fixnum" - (pass-if "integer" (integer? most-positive-fixnum))) - - ;; - ;; slib:form-feed - ;; - - (with-test-prefix "slib:form-feed" - ;; in guile 1.6.4 this wasn't exported - (pass-if "char" (char? slib:form-feed))) - - ;; - ;; slib:report - ;; - - (with-test-prefix "slib:report" - (pass-if "exists" (procedure? slib:report))) - - ;; - ;; slib:report-version - ;; - - (with-test-prefix "slib:report-version" - (pass-if "exists" (procedure? slib:report-version))) - - ;; - ;; slib:tab - ;; - - (with-test-prefix "slib:tab" - ;; in guile 1.6.4 this wasn't exported - (pass-if "char" (char? slib:tab))) - - ;; - ;; software-type - ;; - - (with-test-prefix "software-type" - (pass-if "exists" (procedure? software-type)))) - - - (with-test-prefix "Input/Output" - - ;; - ;; call-with-open-ports - ;; - - (with-test-prefix "call-with-open-ports" - (pass-if "exists" (procedure? call-with-open-ports)) - - (pass-if "close on return" - (let ((port (open-input-file "/dev/null"))) - (call-with-open-ports port (lambda (port) #f)) - (port-closed? port)))) - - ;; - ;; delete-file - ;; - - ;; in guile 1.6.4 and earlier delete-file didn't match the slib spec - (with-test-prefix "delete-file" - (pass-if "non existant file" - (eq? #f (delete-file "nosuchfile"))) - (pass-if "existing file" - (call-with-output-file "slibtest.tmp" noop) - (eq? #t (delete-file "slibtest.tmp")))) - - ;; - ;; output-port-height - ;; - - (with-test-prefix "output-port-height" - ;; in guile 1.6.4 this wasn't exported - (pass-if "exists" (procedure? output-port-height))) - - ;; - ;; output-port-width - ;; - - (with-test-prefix "output-port-width" - ;; in guile 1.6.4 this wasn't exported - (pass-if "exists" (procedure? output-port-width))) - - ;; - ;; open-file - ;; - - ;; this style open-file is only a requirement in slib 3a1 and up, but - ;; we provide it always - (with-test-prefix "open-file" - (pass-if "r" (port? (open-file "/dev/null" 'r))) - (pass-if "rb" (port? (open-file "/dev/null" 'rb))) - (pass-if "w" (port? (open-file "/dev/null" 'w))) - (pass-if "wb" (port? (open-file "/dev/null" 'wb))))) - - - (with-test-prefix "System stuff" - - ;; - ;; browse-url - ;; - - (with-test-prefix "browse-url" - (pass-if "exists" (procedure? browse-url))) - - ;; - ;; slib:error - ;; - - (with-test-prefix "slib:error" - ;; in guile 1.6.4 this wasn't exported - (pass-if "exists" (procedure? slib:error))) - - ;; - ;; slib:eval - ;; - - (with-test-prefix "slib:eval" - ;; in guile 1.6.4 this wasn't exported - (pass-if "exists" (procedure? slib:eval))) - - ;; - ;; slib:eval-load - ;; - - (with-test-prefix "slib:eval-load" - ;; in guile 1.6.4 this wasn't exported - (pass-if "exists" (procedure? slib:eval-load))) - - ;; - ;; slib:exit - ;; - - (with-test-prefix "slib:exit" - ;; in guile 1.6.4 this wasn't exported - (pass-if "exists" (procedure? slib:exit))) - - ;; - ;; slib:load - ;; - - (with-test-prefix "slib:load" - (pass-if "exists" (procedure? slib:load))) - - ;; - ;; slib:load-source - ;; - - (with-test-prefix "slib:load-source" - ;; in guile 1.6.4 this wasn't exported - (pass-if "exists" (procedure? slib:load-source))) - - ;; - ;; slib:warn - ;; - - (with-test-prefix "slib:warn" - ;; in guile 1.6.4 this wasn't exported - (pass-if "exists" (procedure? slib:warn)))) - - - (with-test-prefix "Miscellany" - - ;; - ;; identity - ;; - - (with-test-prefix "identity" - (pass-if "exists" (procedure? identity))) - - (with-test-prefix "Legacy" - - ;; - ;; nil - ;; - - ;; in guile 1.6.4 and earlier this was missing - (with-test-prefix "nil" - (pass-if "value" (eq? #f nil))) - - ;; - ;; t - ;; - - ;; in guile 1.6.4 and earlier this was missing - (with-test-prefix "t" - (pass-if "value" (eq? #t t))))) - - - ;; - ;; rev2-procedures - ;; - - ;; in guile 1.6.4 the 'rev2-procedures feature we defined claimed - ;; these existed, but they didn't - (with-test-prefix "rev2-procedures" - (require 'rev2-procedures) - (pass-if "-1+" (procedure? -1+)) - (pass-if "<?" (procedure? <?)) - (pass-if "<=?" (procedure? <=?)) - (pass-if "=?" (procedure? =?)) - (pass-if ">?" (procedure? >?)) - (pass-if ">=?" (procedure? >=?))) - - - ;; - ;; system - ;; - - ;; in guile 1.6.4 and earlier system didn't match the slib spec - (with-test-prefix "system" - (pass-if "exit 0" (= 0 (system "exit 0"))) - (pass-if "exit 1" (= 1 (system "exit 1"))) - (pass-if "exit 99" (= 99 (system "exit 99")))) - - - (with-test-prefix "Time" - - ;; - ;; difftime - ;; - - (with-test-prefix "difftime" - ;; in guile 1.6.4 this wasn't exported - (pass-if "exists" (procedure? difftime))) - - ;; - ;; offset-time - ;; - - (with-test-prefix "offset-time" - ;; in guile 1.6.4 this wasn't exported - (pass-if "exists" (procedure? offset-time)))) - - - (require 'array) - (with-test-prefix "array" - - ;; - ;; create-array - ;; - - ;; create-array isn't in old slib, but when it exists it should work - (if (defined? 'create-array) - (with-test-prefix "create-array" - (pass-if "As32 create" - (array? (create-array (As32 0) '(0 1))))))))) diff --git a/test-suite/tests/socket.test b/test-suite/tests/socket.test index 79df42f0b..dd91f35b6 100644 --- a/test-suite/tests/socket.test +++ b/test-suite/tests/socket.test @@ -1,6 +1,6 @@ ;;;; socket.test --- test socket functions -*- scheme -*- ;;;; -;;;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/sort.test b/test-suite/tests/sort.test index 77c2da858..af4578ca0 100644 --- a/test-suite/tests/sort.test +++ b/test-suite/tests/sort.test @@ -1,5 +1,5 @@ ;;;; sort.test --- tests Guile's sort functions -*- scheme -*- -;;;; Copyright (C) 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/srcprop.test b/test-suite/tests/srcprop.test index 084a752be..5bfe68080 100644 --- a/test-suite/tests/srcprop.test +++ b/test-suite/tests/srcprop.test @@ -1,6 +1,6 @@ ;;;; srcprop.test --- test Guile source properties -*- scheme -*- ;;;; -;;;; Copyright (C) 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/srfi-10.test b/test-suite/tests/srfi-10.test index 96642e00a..248c04ff7 100644 --- a/test-suite/tests/srfi-10.test +++ b/test-suite/tests/srfi-10.test @@ -1,7 +1,7 @@ ;;;; srfi-10.test --- Test suite for Guile's SRFI-10 functions. -*- scheme -*- ;;;; Martin Grabmueller, 2001-05-10 ;;;; -;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/srfi-11.test b/test-suite/tests/srfi-11.test index 3c2ad2f37..ec2ed86c8 100644 --- a/test-suite/tests/srfi-11.test +++ b/test-suite/tests/srfi-11.test @@ -1,6 +1,6 @@ ;;;; srfi-11.test --- exercise SRFI-11 let-values ;;;; -;;;; Copyright 2004 Free Software Foundation, Inc. +;;;; Copyright 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/srfi-13.test b/test-suite/tests/srfi-13.test index b135434e5..89759d0d3 100644 --- a/test-suite/tests/srfi-13.test +++ b/test-suite/tests/srfi-13.test @@ -1,7 +1,7 @@ ;;;; srfi-13.test --- Test suite for Guile's SRFI-13 functions. -*- scheme -*- ;;;; Martin Grabmueller, 2001-05-07 ;;;; -;;;; Copyright (C) 2001, 2004, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2004, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -18,11 +18,20 @@ ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;;;; Boston, MA 02110-1301 USA -(use-modules (srfi srfi-13) (srfi srfi-14) (test-suite lib)) +(define-module (test-strings) + #:use-module (test-suite lib) + #:use-module (srfi srfi-13) + #:use-module (srfi srfi-14)) + (define exception:strict-infix-grammar (cons 'misc-error "^strict-infix")) +;; Create a string from integer char values, eg. (string-ints 65) => "A" +(define (string-ints . args) + (apply string (map integer->char args))) + + ;;; ;;; string-any ;;; @@ -185,6 +194,32 @@ (pass-if (equal? "abc" (string-concatenate '("a" "b" "c"))))) +;; +;; string-compare +;; + +(with-test-prefix "string-compare" + + (pass-if "same as char<?" + (eq? (char<? (integer->char 0) (integer->char 255)) + (string-compare (string-ints 0) (string-ints 255) + (lambda (pos) #t) ;; lt + (lambda (pos) #f) ;; eq + (lambda (pos) #f))))) ;; gt + +;; +;; string-compare-ci +;; + +(with-test-prefix "string-compare-ci" + + (pass-if "same as char-ci<?" + (eq? (char-ci<? (integer->char 0) (integer->char 255)) + (string-compare-ci (string-ints 0) (string-ints 255) + (lambda (pos) #t) ;; lt + (lambda (pos) #f) ;; eq + (lambda (pos) #f))))) ;; gt + ;;; ;;; string-concatenate/shared ;;; diff --git a/test-suite/tests/srfi-14.test b/test-suite/tests/srfi-14.test index ca4e961e6..fabb7842d 100644 --- a/test-suite/tests/srfi-14.test +++ b/test-suite/tests/srfi-14.test @@ -1,7 +1,7 @@ ;;;; srfi-14.test --- Test suite for Guile's SRFI-14 functions. -*- scheme -*- ;;;; Martin Grabmueller, 2001-07-16 ;;;; -;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/srfi-17.test b/test-suite/tests/srfi-17.test index 52a195576..806b420a6 100644 --- a/test-suite/tests/srfi-17.test +++ b/test-suite/tests/srfi-17.test @@ -1,6 +1,6 @@ ;;;; srfi-17.test --- test suite for Guile's SRFI-17 functions. -*- scheme -*- ;;;; -;;;; Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2003, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test index f694b8613..126198afa 100644 --- a/test-suite/tests/srfi-19.test +++ b/test-suite/tests/srfi-19.test @@ -1,7 +1,7 @@ ;;;; srfi-19.test --- test suite for SRFI-19 -*- scheme -*- ;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001 ;;;; -;;;; Copyright (C) 2001, 2003, 2004, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/srfi-31.test b/test-suite/tests/srfi-31.test index 5f00a73b5..bd6977333 100644 --- a/test-suite/tests/srfi-31.test +++ b/test-suite/tests/srfi-31.test @@ -1,6 +1,6 @@ ;;;; srfi-31.test --- Test suite for Guile's SRFI-31 functions. -*- scheme -*- ;;;; -;;;; Copyright (C) 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public diff --git a/test-suite/tests/srfi-34.test b/test-suite/tests/srfi-34.test index 1875f39da..2c7f4b202 100644 --- a/test-suite/tests/srfi-34.test +++ b/test-suite/tests/srfi-34.test @@ -1,6 +1,6 @@ ;;;; srfi-34.test --- test suite for SRFI-34 -*- scheme -*- ;;;; -;;;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/srfi-39.test b/test-suite/tests/srfi-39.test index 2c09d138d..1b7923a25 100644 --- a/test-suite/tests/srfi-39.test +++ b/test-suite/tests/srfi-39.test @@ -1,6 +1,6 @@ ;;;; srfi-39.test --- -*- scheme -*- ;;;; -;;;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test index b2e80f5e4..ee773a3f9 100644 --- a/test-suite/tests/srfi-4.test +++ b/test-suite/tests/srfi-4.test @@ -1,7 +1,7 @@ ;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*- ;;;; Martin Grabmueller, 2001-06-26 ;;;; -;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/srfi-6.test b/test-suite/tests/srfi-6.test index 1b485939b..217fc9f78 100644 --- a/test-suite/tests/srfi-6.test +++ b/test-suite/tests/srfi-6.test @@ -1,6 +1,6 @@ ;;;; srfi-6.test --- test suite for SRFI-6 -*- scheme -*- ;;;; -;;;; Copyright (C) 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/srfi-60.test b/test-suite/tests/srfi-60.test index a521529a8..5822cb1d0 100644 --- a/test-suite/tests/srfi-60.test +++ b/test-suite/tests/srfi-60.test @@ -1,6 +1,6 @@ ;;;; srfi-60.test --- Test suite for Guile's SRFI-60 functions. -*- scheme -*- ;;;; -;;;; Copyright 2005 Free Software Foundation, Inc. +;;;; Copyright 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/srfi-9.test b/test-suite/tests/srfi-9.test index 4781b80ad..9a6f8e31a 100644 --- a/test-suite/tests/srfi-9.test +++ b/test-suite/tests/srfi-9.test @@ -1,7 +1,7 @@ ;;;; srfi-9.test --- Test suite for Guile's SRFI-9 functions. -*- scheme -*- ;;;; Martin Grabmueller, 2001-05-10 ;;;; -;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/streams.test b/test-suite/tests/streams.test index 1d5fc8d95..92277c19c 100644 --- a/test-suite/tests/streams.test +++ b/test-suite/tests/streams.test @@ -1,6 +1,6 @@ ;;;; streams.test --- test Guile ice-9 streams module -*- scheme -*- ;;;; -;;;; Copyright (C) 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test index 7a2d40d40..aa9196e68 100644 --- a/test-suite/tests/strings.test +++ b/test-suite/tests/strings.test @@ -1,7 +1,7 @@ ;;;; strings.test --- test suite for Guile's string functions -*- scheme -*- ;;;; Jim Blandy <jimb@red-bean.com> --- August 1999 ;;;; -;;;; Copyright (C) 1999, 2001, 2004, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -18,11 +18,22 @@ ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;;;; Boston, MA 02110-1301 USA -(use-modules (test-suite lib)) +(define-module (test-strings) + #:use-module (test-suite lib)) + (define exception:read-only-string (cons 'misc-error "^string is read-only")) +;; Create a string from integer char values, eg. (string-ints 65) => "A" +(define (string-ints . args) + (apply string (map integer->char args))) + + +;; +;; string=? +;; + (with-test-prefix "string=?" (pass-if "respects 1st parameter's string length" @@ -41,6 +52,10 @@ exception:wrong-type-arg (string=? "a" 'b)))) +;; +;; string<? +;; + (with-test-prefix "string<?" (pass-if "respects string length" @@ -55,7 +70,15 @@ (pass-if-exception "2nd argument symbol" exception:wrong-type-arg - (string<? "a" 'b)))) + (string<? "a" 'b))) + + (pass-if "same as char<?" + (eq? (char<? (integer->char 0) (integer->char 255)) + (string<? (string-ints 0) (string-ints 255))))) + +;; +;; string-ci<? +;; (with-test-prefix "string-ci<?" @@ -71,7 +94,75 @@ (pass-if-exception "2nd argument symbol" exception:wrong-type-arg - (string-ci<? "a" 'b)))) + (string-ci<? "a" 'b))) + + (pass-if "same as char-ci<?" + (eq? (char-ci<? (integer->char 0) (integer->char 255)) + (string-ci<? (string-ints 0) (string-ints 255))))) + +;; +;; string<=? +;; + +(with-test-prefix "string<=?" + + (pass-if "same as char<=?" + (eq? (char<=? (integer->char 0) (integer->char 255)) + (string<=? (string-ints 0) (string-ints 255))))) + +;; +;; string-ci<=? +;; + +(with-test-prefix "string-ci<=?" + + (pass-if "same as char-ci<=?" + (eq? (char-ci<=? (integer->char 0) (integer->char 255)) + (string-ci<=? (string-ints 0) (string-ints 255))))) + +;; +;; string>? +;; + +(with-test-prefix "string>?" + + (pass-if "same as char>?" + (eq? (char>? (integer->char 0) (integer->char 255)) + (string>? (string-ints 0) (string-ints 255))))) + +;; +;; string-ci>? +;; + +(with-test-prefix "string-ci>?" + + (pass-if "same as char-ci>?" + (eq? (char-ci>? (integer->char 0) (integer->char 255)) + (string-ci>? (string-ints 0) (string-ints 255))))) + +;; +;; string>=? +;; + +(with-test-prefix "string>=?" + + (pass-if "same as char>=?" + (eq? (char>=? (integer->char 0) (integer->char 255)) + (string>=? (string-ints 0) (string-ints 255))))) + +;; +;; string-ci>=? +;; + +(with-test-prefix "string-ci>=?" + + (pass-if "same as char-ci>=?" + (eq? (char-ci>=? (integer->char 0) (integer->char 255)) + (string-ci>=? (string-ints 0) (string-ints 255))))) + +;; +;; string-set! +;; (with-test-prefix "string-set!" diff --git a/test-suite/tests/symbols.test b/test-suite/tests/symbols.test index 88632aa1e..b57667f7f 100644 --- a/test-suite/tests/symbols.test +++ b/test-suite/tests/symbols.test @@ -1,6 +1,6 @@ ;;;; symbols.test --- test suite for Guile's symbols -*- scheme -*- ;;;; -;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/syncase.test b/test-suite/tests/syncase.test index 4df9dfa2b..1184f7b54 100644 --- a/test-suite/tests/syncase.test +++ b/test-suite/tests/syncase.test @@ -1,6 +1,6 @@ ;;;; syncase.test --- test suite for (ice-9 syncase) -*- scheme -*- ;;;; -;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test index e944d30a4..37d608ce7 100644 --- a/test-suite/tests/syntax.test +++ b/test-suite/tests/syntax.test @@ -1,6 +1,6 @@ ;;;; syntax.test --- test suite for Guile's syntactic forms -*- scheme -*- ;;;; -;;;; Copyright (C) 2001,2003,2004, 2005 Free Software Foundation, Inc. +;;;; Copyright (C) 2001,2003,2004, 2005, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test index 88109655f..511927719 100644 --- a/test-suite/tests/threads.test +++ b/test-suite/tests/threads.test @@ -1,6 +1,6 @@ ;;;; threads.test --- Tests for Guile threading. -*- scheme -*- ;;;; -;;;; Copyright 2003 Free Software Foundation, Inc. +;;;; Copyright 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/time.test b/test-suite/tests/time.test index b872e1b99..3cbbb15f8 100644 --- a/test-suite/tests/time.test +++ b/test-suite/tests/time.test @@ -1,7 +1,7 @@ ;;;; time.test --- test suite for Guile's time functions -*- scheme -*- ;;;; Jim Blandy <jimb@red-bean.com> --- June 1999, 2004 ;;;; -;;;; Copyright (C) 1999, 2004 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/unif.test b/test-suite/tests/unif.test index 062a34e91..a5be1826f 100644 --- a/test-suite/tests/unif.test +++ b/test-suite/tests/unif.test @@ -1,6 +1,6 @@ ;;;; unif.test --- tests guile's uniform arrays -*- scheme -*- ;;;; -;;;; Copyright 2004 Free Software Foundation, Inc. +;;;; Copyright 2004, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -325,6 +325,20 @@ (with-test-prefix "array-set!" + (with-test-prefix "bitvector" + + ;; in Guile 1.8.0 a bug in bitvector_set() caused a segv in array-set! + ;; on a bitvector like the following + (let ((a (make-bitvector 1))) + (pass-if "one elem set #t" + (begin + (array-set! a #t 0) + (eq? #t (array-ref a 0)))) + (pass-if "one elem set #f" + (begin + (array-set! a #f 0) + (eq? #f (array-ref a 0)))))) + (with-test-prefix "byte" (let ((a (make-s8vector 1))) @@ -406,8 +420,69 @@ ;;; make-shared-array ;;; +(define exception:mapping-out-of-range + (cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array + (with-test-prefix "make-shared-array" + ;; this failed in guile 1.8.0 + (pass-if "vector unchanged" + (let* ((a (make-array #f '(0 7))) + (s (make-shared-array a list '(0 7)))) + (array-equal? a s))) + + (pass-if-exception "vector, high too big" exception:mapping-out-of-range + (let* ((a (make-array #f '(0 7)))) + (make-shared-array a list '(0 8)))) + + (pass-if-exception "vector, low too big" exception:out-of-range + (let* ((a (make-array #f '(0 7)))) + (make-shared-array a list '(-1 7)))) + + (pass-if "truncate columns" + (array-equal? (make-shared-array #2((a b c) (d e f) (g h i)) list 3 2) + #2((a b) (d e) (g h)))) + + (pass-if "pick one column" + (array-equal? (make-shared-array #2((a b c) (d e f) (g h i)) + (lambda (i) (list i 2)) + '(0 2)) + #(c f i))) + + (pass-if "diagonal" + (array-equal? (make-shared-array #2((a b c) (d e f) (g h i)) + (lambda (i) (list i i)) + '(0 2)) + #(a e i))) + + ;; this failed in guile 1.8.0 + (pass-if "2 dims from 1 dim" + (array-equal? (make-shared-array #1(a b c d e f g h i j k l) + (lambda (i j) (list (+ (* i 3) j))) + 4 3) + #2((a b c) (d e f) (g h i) (j k l)))) + + (pass-if "reverse columns" + (array-equal? (make-shared-array #2((a b c) (d e f) (g h i)) + (lambda (i j) (list i (- 2 j))) + 3 3) + #2((c b a) (f e d) (i h g)))) + + (pass-if "fixed offset, 0 based becomes 1 based" + (let* ((x #2((a b c) (d e f) (g h i))) + (y (make-shared-array x + (lambda (i j) (list (1- i) (1- j))) + '(1 3) '(1 3)))) + (and (eq? (array-ref x 0 0) 'a) + (eq? (array-ref y 1 1) 'a)))) + + ;; this failed in guile 1.8.0 + (pass-if "stride every third element" + (array-equal? (make-shared-array #1(a b c d e f g h i j k l) + (lambda (i) (list (* i 3))) + 4) + #1(a d g j))) + (pass-if "shared of shared" (let* ((a #2((1 2 3) (4 5 6) (7 8 9))) (s1 (make-shared-array a (lambda (i) (list i 1)) 3)) diff --git a/test-suite/tests/vectors.test b/test-suite/tests/vectors.test index c4907f872..1fb16bcb0 100644 --- a/test-suite/tests/vectors.test +++ b/test-suite/tests/vectors.test @@ -1,6 +1,6 @@ ;;;; vectors.test --- test suite for Guile's vector functions -*- scheme -*- ;;;; -;;;; Copyright (C) 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/version.test b/test-suite/tests/version.test index 0ef230629..b2a491950 100644 --- a/test-suite/tests/version.test +++ b/test-suite/tests/version.test @@ -1,7 +1,7 @@ ;;;; versions.test --- test suite for Guile's version functions -*- scheme -*- ;;;; Greg J. Badros <gjb@cs.washington.edu> ;;;; -;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by diff --git a/test-suite/tests/weaks.test b/test-suite/tests/weaks.test index 64edb735e..7bb77b07c 100644 --- a/test-suite/tests/weaks.test +++ b/test-suite/tests/weaks.test @@ -1,5 +1,5 @@ ;;;; weaks.test --- tests guile's weaks -*- scheme -*- -;;;; Copyright (C) 1999, 2001, 2003 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2003, 2006 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public |