diff --git a/library/qsave.pl b/library/qsave.pl index d8e0308d41..328aa3171d 100644 --- a/library/qsave.pl +++ b/library/qsave.pl @@ -38,10 +38,16 @@ [ qsave_program/1, % +File qsave_program/2 % +File, +Options ]). +:- use_module(library(shlib)). :- use_module(library(lists)). :- use_module(library(option)). :- use_module(library(error)). :- use_module(library(apply)). +:- use_module(library(zip)). +:- use_module(library(prolog_autoload)). +:- use_module(library(dcg/high_order)). +:- use_module(library(dcg/basics)). + /** Save current program as a state or executable @@ -927,11 +933,16 @@ save_foreign_libraries1(Arch, RC, _Options) :- forall(current_foreign_library(FileSpec, _Predicates), - ( find_foreign_library(Arch, FileSpec, EntryName, File, Time), - term_to_atom(EntryName, Name), - zipper_append_file(RC, Name, File, [time(Time)]) + ( find_foreign_library(Arch, FileSpec, Entries), + add_shlibs_to_zip(RC, Entries) )). +add_shlibs_to_zip(RC, [_{entry: Entry, sofile: File, time: Time}|Entries]) :- + zipper_append_file(RC, Entry, File, [time(Time)]), + add_shlibs_to_zip(RC, Entries). +add_shlibs_to_zip(_, []). + + %! find_foreign_library(+Architecture, +FileSpec, -EntryName, -File, -Time) %! is det. % @@ -944,17 +955,42 @@ % % @bug Should perform OS search on failure -find_foreign_library(Arch, FileSpec, shlib(Arch,Name), SharedObject, Time) :- - FileSpec = foreign(Name), - ( catch(arch_find_shlib(Arch, FileSpec, File), +find_foreign_library(Arch, FileSpec, [MainEntry|Entries]) :- + ( catch(arch_find_shlib(Arch, FileSpec, File, DepFiles), E, print_message(error, E)), - exists_file(File) + exists_files([File|DepFiles]) -> true ; throw(error(existence_error(architecture_shlib(Arch), FileSpec),_)) ), + time_and_strip_entries(Arch, FileSpec, main, [File], [MainEntry]), + time_and_strip_entries(Arch, FileSpec, dep, DepFiles, Entries). + +time_and_strip_entries(Arch, FileSpec, Type, [File|Files], + [ _{ entry: Entry, + sofile: SharedObject, + time: Time} + |Entries]) :- + file_base_name(File, BaseName), + shlib_entry_info(Entry, + _{ arch: Arch, + spec: FileSpec, + basename: BaseName, + type: Type + }), time_file(File, Time), - strip_file(File, SharedObject). + strip_file(File, SharedObject), + time_and_strip_entries(Arch, FileSpec, Type, Files, Entries). +time_and_strip_entries(_, _, _, [], []). + +exists_files([File|Files]) :- + ( exists_file(File) + -> true + ; print_message(error, existence_error(file, File)), + fail + ), + exists_files(Files). +exists_files([]). %! strip_file(+File, -Stripped) is det. % @@ -982,24 +1018,29 @@ shell(Cmd), exists_file(Stripped). -%! qsave:arch_shlib(+Architecture, +FileSpec, -File) is det. +%! qsave:arch_shlib(+Architecture, +FileSpec, -File, -DepFiles) is det. % -% This is a user defined hook called by qsave_program/2. It is used to -% find a shared library for the specified Architecture, named by -% FileSpec. FileSpec is of the form foreign(Name), a specification -% usable by absolute_file_name/2. The predicate should unify File with -% the absolute path for the shared library that corresponds to the -% specified Architecture. +% This is a user defined hook called by qsave_program/2. It is +% used to find a shared library and its dependencies for the +% specified Architecture, named by FileSpec. FileSpec is of the +% form foreign(Name), a specification usable by absolute_file_name/2. +% The predicate should unify File with the absolute path for the +% shared library that corresponds to the specified Architecture, and +% DepFiles with a list of shared libraries that need to be loaded as +% dependencies. If there are no dependencies the DepFiles should be +% bound to []. % % If this predicate fails to find a file for the specified % architecture an `existence_error` is thrown. -:- multifile arch_shlib/3. +:- multifile arch_shlib/4. -arch_find_shlib(Arch, FileSpec, File) :- - arch_shlib(Arch, FileSpec, File), +arch_find_shlib(Arch, FileSpec, File, DepFiles) :- + arch_shlib(Arch, FileSpec, File, DepFiles), + must_be(list, DepFiles), + must_be(atom, File), !. -arch_find_shlib(Arch, FileSpec, File) :- +arch_find_shlib(Arch, FileSpec, File, []) :- current_prolog_flag(arch, Arch), absolute_file_name(FileSpec, [ file_type(executable), @@ -1007,6 +1048,71 @@ file_errors(fail) ], File). +%! shlib_entry_info(?Entry, ?Info). +% Two-way conversion between zip file $shlib entry name +% (an atom), and a dict with its information: +% +% Info = { arch: Arch, +% spec: Spec, +% basename: BaseName, +% type: Type +% } +shlib_entry_info(Entry, Info) :- + nonvar(Entry), + !, + Info = _{arch: Arch, spec: Spec, basename: BaseName, type: Type}, + atomic_list_concat(Entry0, '/', Entry), + phrase(shlib_entry_info(Arch,Spec,BaseName,Type),Entry0). +shlib_entry_info(Entry, Info) :- + var(Entry), + !, + Info = _{arch: Arch, spec: Spec, basename: BaseName, type: Type}, + phrase(shlib_entry_info(Arch,Spec,BaseName,Type),Entry0), + atomic_list_concat(Entry0, '/', Entry). + +shlib_entry_info(Arch, Spec, BaseName, Type) --> + { nonvar(Spec), + Spec =.. [Alias|[AliasArg]] + }, + ['$shlib'], [Arch], + ['alias'], [Alias], + path(AliasArg), + main_or_dep(BaseName,Type), + !. +shlib_entry_info(Arch, Spec, BaseName, Type) --> + { var(Spec) }, + ['$shlib'], [Arch], + ['alias'], [Alias], + path(AliasArg), + { Spec =.. [Alias|[AliasArg]] }, + main_or_dep(BaseName,Type), + !. +shlib_entry_info(Arch, Path, BaseName, Type) --> + ['$shlib'], [Arch], + path(Path), + main_or_dep(BaseName,Type), + !. + +main_or_dep(BaseName, Type) --> + [Type], + [BaseName]. + +segment(S) --> + [S]. + +path(P) --> + { nonvar(P), + atomic_list_concat(P0, '/', P) + }, + !, + sequence(segment, P0). + +path(P) --> + { var(P) }, + !, + sequence(segment, P0), + { atomic_list_concat(P0, '/', P) }. + /******************************* * UTIL * @@ -1282,3 +1388,5 @@ [Name, File] ]. prolog:message(qsave(nondet)) --> [ 'qsave_program/2 succeeded with a choice point'-[] ]. + +% vim: ft=prolog sw=4 : diff --git a/library/shlib.pl b/library/shlib.pl index 03075bf6be..2893f66b09 100644 --- a/library/shlib.pl +++ b/library/shlib.pl @@ -45,9 +45,16 @@ use_foreign_library/1, % :LibFile use_foreign_library/2, % :LibFile, +InstallFunc + qsave_foreign_libraries/4, % ?Arch, +Spec, -Resources, +Options + win_add_dll_directory/1 % +Dir ]). -:- use_module(library(lists), [reverse/2]). +:- use_module(library(lists), [member/2, reverse/2]). +:- use_module(library(error), [must_be/2]). +:- use_module(library(zip)). +:- use_module(library(apply)). +:- use_module(library(option)). +:- use_module(library(qsave)). :- set_prolog_flag(generate_debug_info, false). /** Utility library for loading foreign objects (DLLs, shared objects) @@ -148,11 +155,10 @@ find_library(Spec, TmpFile, true) :- '$rc_handle'(Zipper), - term_to_atom(Spec, Name), setup_call_cleanup( zip_lock(Zipper), setup_call_cleanup( - open_foreign_in_resources(Zipper, Name, In), + open_foreign_in_resources(Zipper, Spec, In), setup_call_cleanup( tmp_file_stream(binary, TmpFile, Out), copy_stream_data(In, Out), @@ -174,8 +180,31 @@ find_library(foreign(Spec), Spec, false) :- atom(Spec), !. % use machines finding schema -find_library(Spec, _, _) :- - throw(error(existence_error(source_sink, Spec), _)). +find_library(Spec, Path, Delete) :- + current_prolog_flag(arch, Arch), + try_user_exception(error(existence_error(source_sink, Spec), _), + find_library(Spec, Path, Delete), + _{arch: Arch, file: Spec}). + +:- dynamic '$user_exception_called'/2. +try_user_exception(Throw, _RetryGoal, Context) :- + '$user_exception_called'(missing_shared_object, Context), + retractall('$user_exception_called'(missing_shared_object, Context)), + throw(Throw), + !. % Allow only one retry + +try_user_exception(Throw, RetryGoal, _{arch: Arch, file: Spec}) :- + ( user:exception(missing_shared_object, + _{arch: Arch, file: Spec}, + Action) + -> ( Action == retry + -> asserta('$user_exception_called'(missing_shared_object, + _{arch: Arch, file: Spec})), + call(RetryGoal) + ; throw(Throw) + ) + ; throw(Throw) + ). %! lib_to_file(+Lib0, -Lib, -Copy) is det. % @@ -208,39 +237,112 @@ lib_to_file(Lib, Lib, false). -open_foreign_in_resources(Zipper, ForeignSpecAtom, Stream) :- - term_to_atom(foreign(Name), ForeignSpecAtom), - zipper_members(Zipper, Entries), - entries_for_name(Name, Entries, Entries1), - compatible_architecture_lib(Entries1, Name, CompatibleLib), - zipper_goto(Zipper, file(CompatibleLib)), +open_foreign_in_resources(Zipper, Spec, Stream) :- + current_prolog_flag(arch, Arch), + qsave_foreign_libraries(Arch, Spec, [CompatLib], + [main, plain]), + zipper_goto(Zipper, file(CompatLib.entry)), zipper_open_current(Zipper, Stream, [ type(binary), release(true) ]). -%! compatible_architecture_lib(+Entries, +Name, -CompatibleLib) is det. +%! qsave_foreign_libraries(+Arch, +FileSpec, -Entries, +Options). +% +% Get list of foreign libraries compatible with Arch in the current +% saved state. % -% Entries is a list of entries in the zip file, which are already -% filtered to match the shared library identified by `Name`. The -% filtering is done by entries_for_name/3. +% Multi-architecture foreign libraries can be stored in the saved +% state by qsave_program/2. See the `foreign` option. Entries is +% unified with a list of dicts of the form: `_{ entry: Resource, +% basename: Base, type: Type }`. Each dict contains a description of +% the entries in the saved state for FileSpec and compatible with +% Arch. Resource starts with `res://` so it can be used +% with most file predicates, including copy_file/2. `Base` is the +% original base name of the file, this is especially useful for +% dependencies which need to have the same name so that the linker +% finds them. Type is either `main` or `dep` indicating the main +% library or a dependency. % -% CompatibleLib is the name of the entry in the zip file which is -% compatible with the current architecture. The compatibility is -% determined according to the description in qsave_program/2 using the -% qsave:compat_arch/2 hook. +% The predicate can return only the main foreign library (which +% defines prolog predicates in a foreign language) and possibly its +% dependencies according to the options. % -% The entries are of the form 'shlib(Arch, Name)' - -compatible_architecture_lib([], _, _) :- !, fail. -compatible_architecture_lib(Entries, Name, CompatibleLib) :- - current_prolog_flag(arch, HostArch), - ( member(shlib(EntryArch, Name), Entries), - qsave_compat_arch1(HostArch, EntryArch) - -> term_to_atom(shlib(EntryArch, Name), CompatibleLib) - ; existence_error(arch_compatible_with(Name), HostArch) +% See qsave_program/2 to find out about how to store the +% dependencies of a shared object. +% +% This predicate also calls the qsave:compat_arch/2 hook to +% determine architecture compatibility, see qsave_program/2. +% +% The possible options are: +% * main +% Return only the main foreign library compatible with Arch. +% Resources is a list with one element. +% * main_and_deps +% Return the main foreign lirary and any dependencies that +% were stored in the saved state. Resources is a list in this +% case. This is the default option. +% * deps +% Return only the dependencies. +% * plain +% Do not return entries with the `res://` prefix, but +% just the plain entry name in the saved state. This can +% be used if you want to access the object directly using +% `library(zip)`, but this should be rare. +% +% @see qsave_program/2. +qsave_foreign_libraries(Arch, FileSpec, Resources, Options) :- + must_be(list(oneof([main,main_and_deps,deps,plain])), Options), + '$rc_handle'(Zipper), + zipper_members(Zipper, Entries), + entinfos_for_spec(FileSpec, Entries, EntInfos), + ( option(main, Options) + -> Type = main + ; option(main_and_deps, Options) + -> Type = _ + ; option(deps, Options) + -> Type = dep + ; Type = _ + ), + libs_for_compat_arch(FileSpec, EntInfos, Type, Arch, Es), + ( option(plain, Options) + -> Resources = Es + ; maplist(entry_resource, Es, Resources) ). +entry_resource(EntryDict, ResDict) :- + format(atom(Res), 'res://~w', [EntryDict.entry]), + ResDict = EntryDict.put(entry, Res). + + +%! lib_for_compat_arch(+Entries, +FileSpec, -CompatibleLib) is det. +% +% Entries is a list of entries in the zip file, which are already +% filtered to match the shared library identified by `FileSpec`. The +% filtering is done by entinfos_for_spec/3. +% +% CompatibleLib is the name of the entry in the zip file which is +% compatible with the current architecture. The compatibility is +% determined according to the description in qsave_program/2 using +% the qsave:compat_arch/2 hook. + +libs_for_compat_arch(FileSpec, Entries, Type, Arch, Libs) :- + findall(Lib, + lib_for_compat_arch(Arch, Type, Entries, FileSpec, Lib), + Libs). + +lib_for_compat_arch(Arch, Type, EntInfos, FileSpec, + _{entry: Entry, basename: BaseName, type: Type}) :- + EntInfo = _{ arch: EntryArch, + spec: FileSpec, + basename: BaseName, + type: Type + }, + member(EntInfo, EntInfos), + qsave_compat_arch1(Arch, EntryArch), + qsave:shlib_entry_info(Entry, EntInfo). + +:- multifile qsave:compat_arch/2. qsave_compat_arch1(Arch1, Arch2) :- qsave:compat_arch(Arch1, Arch2), !. qsave_compat_arch1(Arch1, Arch2) :- @@ -258,17 +360,12 @@ qsave:compat_arch(A,A). -shlib_atom_to_term(Atom, shlib(Arch, Name)) :- - sub_atom(Atom, 0, _, _, 'shlib('), - !, - term_to_atom(shlib(Arch,Name), Atom). -shlib_atom_to_term(Atom, Atom). +match_filespec(FileSpec, EntInfo) :- + FileSpec = EntInfo.spec. -match_filespec(Name, shlib(_,Name)). - -entries_for_name(Name, Entries, Filtered) :- - maplist(shlib_atom_to_term, Entries, Entries1), - include(match_filespec(Name), Entries1, Filtered). +entinfos_for_spec(FileSpec, Entries, Filtered) :- + convlist(qsave:shlib_entry_info, Entries, EntInfos), + include(match_filespec(FileSpec), EntInfos, Filtered). base(Path, Base) :- atomic(Path), @@ -355,12 +452,17 @@ install(Path, Entries)), _)) ). -load_foreign_library(LibFile, _, _) :- +load_foreign_library(LibFile, Module, Entry) :- + current_prolog_flag(arch, Arch), retractall(loading(LibFile)), ( error(_Path, E) -> retractall(error(_, _)), - throw(E) - ; throw(error(existence_error(foreign_library, LibFile), _)) + try_user_exception(E, + load_foreign_library(LibFile, Module, Entry), + _{arch: Arch, file: LibFile}) + ; try_user_exception(error(existence_error(foreign_library, LibFile), _), + load_foreign_library(LibFile, Module, Entry), + _{arch: Arch, file: LibFile}) ). delete_foreign_lib(true, Path) :- @@ -557,3 +659,5 @@ [ 'No install function in ~q'-[Lib], nl, '\tTried: ~q'-[List] ]. + +% vim: set sw=4 ft=prolog : diff --git a/man/hack.doc b/man/hack.doc index 54079e476f..6d88258f30 100644 --- a/man/hack.doc +++ b/man/hack.doc @@ -471,6 +471,38 @@ predicates. See also \prologflag{unknown} and \secref{autoload}. \arg{Context} is instantiated to the name of the missing global variable. The hook must call nb_setval/2 or b_setval/2 before returning with the action \const{retry}. + + \termitem{missing_shared_object}{} +\arg{Context} is instantiated to _{ arch: Arch, file: FileSpec }, +which points to the required architecture and `FileSpec` for the +missing shared library. \arg{Action} can be unified with error, to +throw an exception or with retry, in order to try to reload the +missing library Normally the hook will obtain the missing library +from the network, or a required dependency from the saved state (see +qsave_foreign_libraries/4), and put them in a directory where the +system dynamic linker can find it. The following example loads a +required depdency from the saved state: + +\begin{code} +:- use_foreign_library('input/shlib_with_dep.so'). + +:- assertz(( + user:exception(missing_shared_object, + _{ arch: _, file: Spec }, + retry) :- + handle_missing_shlib(Spec) + + )). + +handle_missing_shlib(Spec) :- + Spec = 'input/shlib_with_dep.so', + qsave_foreign_libraries(Arch, 'input/shlib_with_dep.so', [Dep], [deps]), + copy_file(Dep.entry,'libdep.so'). % linker finds it in current dir + +% here put some code that calls predicates in shlib_with_dep.so + +\end{code} + \end{description} \end{description} diff --git a/man/runtime.doc b/man/runtime.doc index c857aeffa5..1d89cd1cfe 100644 --- a/man/runtime.doc +++ b/man/runtime.doc @@ -163,16 +163,23 @@ to load a shared object from a zip file but requires write access to the file system. Future versions may provide shortcuts for specific platforms that bypass the file system.} -If \arg{Action} is of the form \term{arch}{ListOfArches} then the -shared objects for the specified architectures are stored in -the saved state. On the command line, the list of architectures -can be passed as \const{--foreign=}. In -order to obtain the shared object file for the specified -architectures, qsave_program/2 calls a user defined hook: -\term{qsave:arch_shlib}{+Arch, +FileSpec, -SoPath}. This hook -needs to unify \const{SoPath} with the absolute path to the -shared object for the specified architecture. \const{FileSpec} is -of the form \const{foreign(Name)}. +If \arg{Action} is of the form \term{arch}{ListOfArches} then the +shared objects for the specified architectures are stored in the saved +state. On the command line, the list of architectures can be passed as +\const{--foreign=}. In order to obtain the shared +object file for the specified architectures, qsave_program/2 calls a +user defined hook: \term{qsave:arch_shlib}{+Arch, +FileSpec, -SoPath, +-DepsPaths}. + +This hook needs to unify \const{SoPath} with the absolute path to the +main shared object for the specified architecture. Additional shared +libraries on which the main shared library depends may be specified as +a list of paths in \const{DepsPaths}, otherwise it should be bound to +[]. These dependencies are then stored in the resulting archive. In +order to make the dependencies accessible to `open_shared_object` they +need to be copied to an appropiate directory manually. Please note +that the dependencies are *not* loaded automatically from the saved +state, see user:exception/3 for a way to do this. At runtime, SWI-Prolog will try to load the shared library which is compatible with the current architecture, obtained by calling diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 847fa06c7c..e14ef22397 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -436,6 +436,11 @@ endif(0) add_custom_target(check COMMAND ${PROG_SWIPL} -q -g test -t halt ${CMAKE_CURRENT_SOURCE_DIR}/test.pl) +add_custom_target(test_save_shlibs + ALL + COMMAND cd ${CMAKE_CURRENT_SOURCE_DIR}/Tests/save && + ${PROG_SWIPL} -q -g build_test_shlibs -t halt ${CMAKE_CURRENT_SOURCE_DIR}/Tests/save/test_saved_states.pl) + set(SWIPL_TEST_DIRS unprotected core attvar library charset eclipse clp GC save) if(MULTI_THREADED) diff --git a/src/Tests/save/input/libdep.c b/src/Tests/save/input/libdep.c new file mode 100644 index 0000000000..63804fe06e --- /dev/null +++ b/src/Tests/save/input/libdep.c @@ -0,0 +1,4 @@ +const char* +shlib_fun_in_dep() +{ return "three_three_three"; +} diff --git a/src/Tests/save/input/missing_shlib.pl b/src/Tests/save/input/missing_shlib.pl new file mode 100644 index 0000000000..f617f03114 --- /dev/null +++ b/src/Tests/save/input/missing_shlib.pl @@ -0,0 +1,19 @@ +:- set_prolog_flag(autoload, false). +:- use_module(library(shlib)). +:- use_module(library(qsave)). +:- use_foreign_library('input/shlib_no_deps.so'). + +:- assertz(( + user:exception(missing_shared_object, + _{ arch: _, file: Spec }, + retry) :- + Spec = 'input/shlib_no_deps.so', + rename_file('input/shlib_no_deps.so.bak',Spec) + )). + +% Test loading md54pl.so through user:exception +shlib_test :- + shlib_fun(V), + format('~q.',[V]). + +% vim: sw=4 ft=prolog : diff --git a/src/Tests/save/input/multi_arch_compat.pl b/src/Tests/save/input/multi_arch_compat.pl new file mode 100644 index 0000000000..1ef7d14924 --- /dev/null +++ b/src/Tests/save/input/multi_arch_compat.pl @@ -0,0 +1,24 @@ +:- set_prolog_flag(autoload, false). +:- use_module(library(shlib)). +:- use_module(library(qsave)). +:- asserta( user:file_search_path(foreign, './input') ). +:- use_foreign_library(foreign(shlib_no_deps)). + +% Test loading shlib_no_deps.so ith another architecture +% which is compatible with the current one. +shlib_test :- + shlib_fun(V), + format('~q.',[V]). + + +:- multifile qsave:arch_shlib/3. +qsave:arch_shlib('x86_64-myarch', Spec, File, []) :- + Spec == foreign(shlib_no_deps), + absolute_file_name(Spec, File, + [ access(execute), + file_type(executable) + ]). + +qsave:compat_arch(_, 'x86_64-myarch'). + +% vim: sw=4 ft=prolog : diff --git a/src/Tests/save/input/multi_arch_simple.pl b/src/Tests/save/input/multi_arch_simple.pl new file mode 100644 index 0000000000..c1d96bf007 --- /dev/null +++ b/src/Tests/save/input/multi_arch_simple.pl @@ -0,0 +1,9 @@ +:- use_foreign_library('./input/shlib_no_deps'). + +% Test loading shlib_no_deps from the +% saved state +shlib_test :- + shlib_fun(V), % V == three_three_three + format('~q.',[V]). + +% vim: sw=4 ft=prolog : diff --git a/src/Tests/save/input/shlib_no_deps.c b/src/Tests/save/input/shlib_no_deps.c new file mode 100644 index 0000000000..aaf04f2389 --- /dev/null +++ b/src/Tests/save/input/shlib_no_deps.c @@ -0,0 +1,19 @@ +#include + +static atom_t ATOM_three_three_three; + + +static foreign_t +shlib_fun(term_t t) +{ return PL_unify_atom(t, ATOM_three_three_three); +} + + +#define MKATOM(n) ATOM_ ## n = PL_new_atom(#n); + +install_t +install(void) +{ MKATOM(three_three_three); + + PL_register_foreign("shlib_fun", 1, shlib_fun, 0); +} diff --git a/src/Tests/save/input/shlib_with_dep.c b/src/Tests/save/input/shlib_with_dep.c new file mode 100644 index 0000000000..b1360b327c --- /dev/null +++ b/src/Tests/save/input/shlib_with_dep.c @@ -0,0 +1,15 @@ +#include + +const char* shlib_fun_in_dep(); + +static foreign_t +shlib_fun(term_t t) +{ const char* str = shlib_fun_in_dep(); + return PL_unify_atom_chars(t, str); +} + + +install_t +install(void) +{ PL_register_foreign("shlib_fun", 1, shlib_fun, 0); +} diff --git a/src/Tests/save/input/shlib_with_dep.pl b/src/Tests/save/input/shlib_with_dep.pl new file mode 100644 index 0000000000..150f007bd5 --- /dev/null +++ b/src/Tests/save/input/shlib_with_dep.pl @@ -0,0 +1,42 @@ +:- set_prolog_flag(autoload, false). +:- use_module(library(shlib)). +:- use_module(library(qsave)). +:- use_foreign_library('input/shlib_with_dep.so'). + +:- assertz(( + user:exception(missing_shared_object, + _{ arch: _, file: Spec }, + retry) :- + handle_missing_shlib(Spec) + + )). + +handle_missing_shlib(Spec) :- + Spec = 'input/shlib_with_dep.so', + qsave_foreign_libraries(Arch, 'input/shlib_with_dep.so', [Dep], [deps]), + copy_file(Dep.entry,'libdep.so'). % linker finds it in current dir + +% Test loading md54pl.so through user:exception +shlib_test :- + shlib_fun(V), + format('~q.',[V]). + + +% Helpers +copy_file(From, To) :- + setup_call_cleanup( + open(From, read, In, [type(binary)]), + setup_call_cleanup( + open(To, write, Out, [type(binary)]), + copy_stream_data(In,Out), + close(Out) + ), + close(In)). + + +% qsave hook +qsave:arch_shlib(_, File, File, ['input/libdep.so']) :- + File == 'input/shlib_with_dep.so'. + + +% vim: sw=4 ft=prolog : diff --git a/src/Tests/save/test_saved_states.pl b/src/Tests/save/test_saved_states.pl index 4781b0aa29..3ca5e84174 100644 --- a/src/Tests/save/test_saved_states.pl +++ b/src/Tests/save/test_saved_states.pl @@ -33,7 +33,8 @@ */ :- module(test_saved_states, - [ test_saved_states/0 + [ test_saved_states/0, + build_test_shlibs/0 ]). :- prolog_load_context(directory, Here), @@ -77,7 +78,8 @@ 'Skipped saved state files because the system does\n\c not offer us enough open files~n', []). test_saved_states :- - run_tests([ saved_state + run_tests([ saved_state, + multi_arch ]). :- dynamic @@ -157,18 +159,23 @@ set_windows_path. create_state(File, Output, Args) :- + create_state(File, Output, Args, ErrOutput), + assertion(no_error(ErrOutput)). + +create_state(File, Output, Args, ErrOutput) :- me(Me), append(Args, ['-o', Output, '-c', File, '-f', none], AllArgs), test_dir(TestDir), debug(save, 'Creating state in ~q using ~q ~q', [TestDir, Me, AllArgs]), process_create(Me, AllArgs, [ cwd(TestDir), - stderr(pipe(Err)) + stderr(pipe(Err)), + process(Pid) ]), read_stream_to_codes(Err, ErrOutput), close(Err), - debug(save, 'Saved state', []), - assertion(no_error(ErrOutput)). + process_wait(Pid,_Status), % to allow error status + debug(save, 'Saved state', []). run_state(Exe, Args, Result) :- debug(save, 'Running state ~q ~q', [Exe, Args]), @@ -191,6 +198,31 @@ remove_state(State) :- catch(delete_file(State), _, true). +swipl_ld(SwiplLd) :- + current_prolog_flag(executable,SwiplExe), + file_directory_name(SwiplExe, Dir), + format(atom(SwiplLd0), "~w/swipl-ld",[Dir]), + prolog_to_os_filename(SwiplLd0,SwiplLd). + +build_shlib(Name) :- + swipl_ld(SwiplLd), + format(atom(Cmd), + "~w -shared -fPIC -o input/~w.so input/~w.c", + [SwiplLd,Name, Name]), + shell(Cmd). + +build_shlib(Name, Dep, DepDir) :- + swipl_ld(SwiplLd), + format(atom(Cmd), + "~w -shared -fPIC -L~w -l~w -o input/~w.so input/~w.c ", + [SwiplLd, DepDir, Dep, Name, Name]), + shell(Cmd). + +build_test_shlibs :- + build_shlib("shlib_no_deps"), + build_shlib("libdep"), + build_shlib("shlib_with_dep", "dep", "input"). + %% read_terms(+In:stream, -Data:list) % % True when Data are the Prolog terms on In. @@ -240,9 +272,70 @@ run_state(Exe, [], Result) ), remove_state(Exe)). - :- end_tests(saved_state). + +:- begin_tests(multi_arch). +test(load_shlib_no_deps, Result == [three_three_three]) :- + state_output(4, Exe), + call_cleanup( + ( create_state('input/multi_arch_simple.pl', Exe, ['-g', shlib_test]), + run_state(Exe, [], Result) + ), + remove_state(Exe)). +test(load_wrong_arch, ErrOut == "ERROR: architecture_shlib(x86_64-strange1) `'./input/shlib_no_deps'' does not exist\n") :- + state_output(5, Exe), + call_cleanup( + ( create_state('input/multi_arch_simple.pl', Exe, + ['--foreign=x86_64-strange1', '-g', shlib_test], + ErrOut0), + string_codes(ErrOut, ErrOut0) + ), + remove_state(Exe)). +test(compatible_arch, Result == [three_three_three]) :- + state_output(6, Exe), + call_cleanup( + ( create_state('input/multi_arch_compat.pl', Exe, + [ '--foreign=x86_64-myarch', + '--no-autoload', + '-g', shlib_test + ]), + run_state(Exe, [], Result) + ), + remove_state(Exe)). +test(retry_missing_shlib, Result == [three_three_three]) :- + state_output(7, Exe), + setup_call_cleanup( + rename_file('input/shlib_no_deps.so', + 'input/shlib_no_deps.so.bak'), + ( create_state('input/missing_shlib.pl', Exe, + [ '--no-autoload', + '-g', shlib_test + ]), + run_state(Exe, [], Result) + ), + ( catch(rename_file('input/shlib_no_deps.so.bak', + 'input/shlib_no_deps.so'), + _,true), + remove_state(Exe) + )). +test(shlib_with_dep, Result == [three_three_three]) :- + state_output(8, Exe), + setup_call_cleanup( + copy_file('input/libdep.so','libdep.so'), % for linker to find it + ( create_state('input/shlib_with_dep.pl', Exe, + [ '--no-autoload', + '--foreign=save', + '-g', shlib_test + ]), + delete_file('libdep.so'), % to load it from state + run_state(Exe, [], Result) + ), + ( catch(delete_file('libdep.so'), _, true), + remove_state(Exe) + )). +:- end_tests(multi_arch). + :- else. % No library(process) found test_saved_states :-