1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker and Richard O'Keefe 4 E-mail: J.Wielemaker@cs.vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2014-2022, VU University Amsterdam 7 CWI, Amsterdam 8 SWI-Prolog Solutions b.v. 9 All rights reserved. 10 11 Redistribution and use in source and binary forms, with or without 12 modification, are permitted provided that the following conditions 13 are met: 14 15 1. Redistributions of source code must retain the above copyright 16 notice, this list of conditions and the following disclaimer. 17 18 2. Redistributions in binary form must reproduce the above copyright 19 notice, this list of conditions and the following disclaimer in 20 the documentation and/or other materials provided with the 21 distribution. 22 23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 POSSIBILITY OF SUCH DAMAGE. 35*/ 36 37:- module(check_installation, 38 [ check_installation/0, 39 check_installation/1, % -Issues 40 check_config_files/0, 41 update_config_files/0, 42 test_installation/0, 43 test_installation/1 % +Options 44 ]). 45:- autoload(library(apply), [maplist/2, maplist/3]). 46:- autoload(library(archive), [archive_open/3, archive_close/1]). 47:- autoload(library(lists), [append/3, member/2]). 48:- autoload(library(option), [option/2, merge_options/3]). 49:- autoload(library(prolog_source), [path_segments_atom/2]). 50:- use_module(library(settings), [setting/2]). 51:- autoload(library(dcg/high_order), [sequence//2, sequence/4]). 52:- autoload(library(error), [must_be/2]).
http://www.swi-prolog.org/build/issues/
. If not provided,
the library file with extension .html
is used.windows
, unix
or linux
. If present, the component
is only checked for if we are running on a version of the
specified operating system.85% Feature tests 86component(tcmalloc, 87 _{ optional:true, 88 test:test_tcmalloc, 89 url:'tcmalloc.html' 90 }). 91component(gmp, 92 _{ test:current_prolog_flag(bounded, false), 93 url:'gmp.html' 94 }). 95% Packages that depend on foreign libraries 96component(library(archive), _{features:archive_features}). 97component(library(cgi), _{}). 98component(library(crypt), _{}). 99component(library(bdb), _{}). 100component(library(double_metaphone), _{}). 101component(library(filesex), _{}). 102component(library(http/http_stream), _{}). 103component(library(http/json), _{}). 104component(library(http/jquery), _{features:jquery_file}). 105component(library(isub), _{}). 106component(library(jpl), _{}). 107component(library(memfile), _{}). 108component(library(odbc), _{}). 109component(library(pce), 110 _{pre:use_foreign_library(pce_principal:foreign(pl2xpce)), 111 url:'xpce.html'}). 112component(library(pcre), _{features:pcre_features}). 113component(library(pdt_console), _{}). 114component(library(porter_stem), _{}). 115component(library(process), _{}). 116component(library(protobufs), _{}). 117component(library(editline), _{os:unix}). 118component(library(readline), _{os:unix}). 119component(library(readutil), _{}). 120component(library(rlimit), _{os:unix}). 121component(library(semweb/rdf_db), _{}). 122component(library(semweb/rdf_ntriples), _{}). 123component(library(semweb/turtle), _{}). 124component(library(sgml), _{}). 125component(library(sha), _{}). 126component(library(snowball), _{}). 127component(library(socket), _{}). 128component(library(ssl), _{}). 129component(library(sweep_link), _{features:sweep_emacs_module}). 130component(library(crypto), _{}). 131component(library(syslog), _{os:unix}). 132component(library(table), _{}). 133component(library(time), _{}). 134component(library(tipc/tipc), _{os:linux}). 135component(library(unicode), _{}). 136component(library(uri), _{}). 137component(library(uuid), _{}). 138component(library(zlib), _{}). 139component(library(yaml), _{}). 140 141issue_base('http://www.swi-prolog.org/build/issues/'). 142 143:- thread_local 144 issue/1. 145 146:- meta_predicate 147 run_silent( , ).
If issues are found it prints a diagnostic message with a link to a wiki page with additional information about the issue.
164check_installation :-
165 print_message(informational, installation(checking)),
166 check_installation_(InstallIssues),
167 check_on_path,
168 check_config_files(ConfigIssues),
169 maplist(print_message(warning), ConfigIssues),
170 append(InstallIssues, ConfigIssues, Issues),
171 ( Issues == []
172 -> print_message(informational, installation(perfect))
173 ; length(Issues, Count),
174 print_message(warning, installation(imperfect(Count)))
175 ).
optional_not_found
(optional component is not present), not_found
(component is
not present) or failed
(component is present but cannot be
loaded).185check_installation(Issues) :- 186 check_installation_(Issues0), 187 maplist(public_issue, Issues0, Issues). 188 189public_issue(installation(Term), Source-Issue) :- 190 functor(Term, Issue, _), 191 arg(1, Term, Properties), 192 Source = Properties.source. 193 194check_installation_(Issues) :- 195 retractall(issue(_)), 196 forall(component(Source, _Properties), 197 check_component(Source)), 198 findall(I, retract(issue(I)), Issues). 199 200check_component(Source) :- 201 component(Source, Properties), 202 !, 203 check_component(Source, Properties.put(source,Source)). 204 205check_component(Source, Properties) :- 206 compound(Source), 207 !, 208 check_source(Source, Properties). 209check_component(Feature, Properties) :- 210 print_message(informational, installation(checking(Feature))), 211 ( call(Properties.test) 212 -> print_message(informational, installation(ok)) 213 ; print_issue(installation(missing(Properties))) 214 ). 215 216check_source(_Source, Properties) :- 217 OS = Properties.get(os), 218 \+ current_os(OS), 219 !. 220check_source(Source, Properties) :- 221 exists_source(Source), 222 !, 223 print_message(informational, installation(loading(Source))), 224 ( run_silent(( ( Pre = Properties.get(pre) 225 -> call(Pre) 226 ; true 227 ), 228 load_files(Source, [silent(true), if(not_loaded)]) 229 ), 230 Properties.put(action, load)) 231 -> test_component(Properties), 232 print_message(informational, installation(ok)), 233 check_features(Properties) 234 ; true 235 ). 236check_source(_Source, Properties) :- 237 Properties.get(optional) == true, 238 !, 239 print_message(silent, 240 installation(optional_not_found(Properties))). 241check_source(_Source, Properties) :- 242 print_issue(installation(not_found(Properties))). 243 244current_os(unix) :- current_prolog_flag(unix, true). 245current_os(windows) :- current_prolog_flag(windows, true). 246current_os(linux) :- current_prolog_flag(arch, Arch), sub_atom(Arch, _, _, _, linux).
252test_component(Dict) :- 253 Test = Dict.get(test), 254 !, 255 call(Test). 256test_component(_).
265check_features(Dict) :- 266 Test = Dict.get(features), 267 !, 268 call(Test). 269check_features(_).
277run_silent(Goal, Properties) :-
278 run_collect_messages(Goal, Result, Messages),
279 ( Result == true,
280 Messages == []
281 -> true
282 ; print_issue(installation(failed(Properties, Result, Messages))),
283 fail
284 ).
true
, false
or exception(Error)
and messages with a list of generated error and warning
messages. Each message is a term:
message(Term,Kind,Lines)
296:- thread_local 297 got_message/1. 298 299run_collect_messages(Goal, Result, Messages) :- 300 setup_call_cleanup( 301 asserta((user:thread_message_hook(Term,Kind,Lines) :- 302 error_kind(Kind), 303 assertz(got_message(message(Term,Kind,Lines)))), Ref), 304 ( catch(Goal, E, true) 305 -> ( var(E) 306 -> Result0 = true 307 ; Result0 = exception(E) 308 ) 309 ; Result0 = false 310 ), 311 erase(Ref)), 312 findall(Msg, retract(got_message(Msg)), Messages), 313 Result = Result0. 314 315error_kind(warning). 316error_kind(error). 317 318 319 /******************************* 320 * SPECIAL TESTS * 321 *******************************/
325:- if(current_predicate(malloc_property/1)). 326test_tcmalloc :- 327 malloc_property('generic.current_allocated_bytes'(Bytes)), 328 Bytes > 1 000 000. 329:- else. 330test_tcmalloc :- 331 fail. 332:- endif.
338archive_features :- 339 tmp_file_stream(utf8, Name, Out), 340 close(Out), 341 findall(F, archive_filter(F, Name), Filters), 342 print_message(informational, installation(archive(filters, Filters))), 343 findall(F, archive_format(F, Name), Formats), 344 print_message(informational, installation(archive(formats, Formats))), 345 delete_file(Name). 346 347archive_filter(F, Name) :- 348 a_filter(F), 349 catch(archive_open(Name, A, [filter(F)]), E, true), 350 ( var(E) 351 -> archive_close(A) 352 ; true 353 ), 354 \+ subsumes_term(error(domain_error(filter, _),_), E). 355 356archive_format(F, Name) :- 357 a_format(F), 358 catch(archive_open(Name, A, [format(F)]), E, true), 359 ( var(E) 360 -> archive_close(A) 361 ; true 362 ), 363 \+ subsumes_term(error(domain_error(format, _),_), E). 364 365a_filter(bzip2). 366a_filter(compress). 367a_filter(gzip). 368a_filter(grzip). 369a_filter(lrzip). 370a_filter(lzip). 371a_filter(lzma). 372a_filter(lzop). 373a_filter(none). 374a_filter(rpm). 375a_filter(uu). 376a_filter(xz). 377 378a_format('7zip'). 379a_format(ar). 380a_format(cab). 381a_format(cpio). 382a_format(empty). 383a_format(gnutar). 384a_format(iso9660). 385a_format(lha). 386a_format(mtree). 387a_format(rar). 388a_format(raw). 389a_format(tar). 390a_format(xar). 391a_format(zip).
395pcre_features :- 396 findall(X, pcre_missing(X), Missing), 397 ( Missing == [] 398 -> true 399 ; print_message(warning, installation(pcre_missing(Missing))) 400 ), 401 ( re_config(compiled_widths(Widths)), 402 1 =:= Widths /\ 1 403 -> true 404 ; print_message(warning, installation(pcre_missing('8-bit support'))) 405 ). 406 407pcre_missing(X) :- 408 pcre_must_have(X), 409 Term =.. [X,true], 410 \+ catch(re_config(Term), _, fail). 411 412pcre_must_have(unicode).
418jquery_file :- 419 setting(jquery:version, File), 420 ( absolute_file_name(js(File), Path, [access(read), file_errors(fail)]) 421 -> print_message(informational, installation(jquery(found(Path)))) 422 ; print_message(warning, installation(jquery(not_found(File)))) 423 ). 424 425sweep_emacs_module :- 426 with_output_to(string(S), write_sweep_module_location), 427 split_string(S, "\n", "\n", [VersionInfo|Modules]), 428 must_be(oneof(["V 1"]), VersionInfo), 429 ( maplist(check_sweep_lib, Modules) 430 -> print_message(informational, installation(sweep(found(Modules)))) 431 ; print_message(warning, installation(sweep(not_found(Modules)))) 432 ). 433 434check_sweep_lib(Line) :- 435 sub_atom(Line, B, _, A, ' '), 436 sub_atom(Line, 0, B, _, Type), 437 must_be(oneof(['L', 'M']), Type), 438 sub_atom(Line, _, A, 0, Lib), 439 exists_file(Lib).
447check_on_path :- 448 current_prolog_flag(executable, EXEFlag), 449 prolog_to_os_filename(EXE, EXEFlag), 450 file_base_name(EXE, Prog), 451 absolute_file_name(EXE, AbsExe, 452 [ access(execute), 453 file_errors(fail) 454 ]), 455 !, 456 prolog_to_os_filename(AbsExe, OsExe), 457 ( absolute_file_name(path(Prog), OnPath, 458 [ access(execute), 459 file_errors(fail) 460 ]) 461 -> ( same_file(EXE, OnPath) 462 -> true 463 ; absolute_file_name(path(Prog), OnPathAny, 464 [ access(execute), 465 file_errors(fail), 466 solutions(all) 467 ]), 468 same_file(EXE, OnPathAny) 469 -> print_message(warning, installation(not_first_on_path(OsExe, OnPath))) 470 ; print_message(warning, installation(not_same_on_path(OsExe, OnPath))) 471 ) 472 ; print_message(warning, installation(not_on_path(OsExe, Prog))) 473 ). 474check_on_path. 475 476 477 /******************************* 478 * RUN TESTS * 479 *******************************/
cmake -DINSTALL_TESTS=ON
Options processed:
false
, do not test the packages496test_installation :- 497 test_installation([]). 498 499test_installation(Options) :- 500 absolute_file_name(swi(test/test), 501 TestFile, 502 [ access(read), 503 file_errors(fail), 504 file_type(prolog) 505 ]), 506 !, 507 test_installation_run(TestFile, Options). 508test_installation(_Options) :- 509 print_message(warning, installation(testing(no_installed_tests))). 510 511test_installation_run(TestFile, Options) :- 512 ( option(package(_), Options) 513 -> merge_options(Options, 514 [ core(false), 515 subdirs(false) 516 ], TestOptions) 517 ; merge_options(Options, 518 [ packages(true) 519 ], TestOptions) 520 ), 521 load_files(user:TestFile), 522 current_prolog_flag(verbose, Old), 523 setup_call_cleanup( 524 set_prolog_flag(verbose, silent), 525 user:test([], TestOptions), 526 set_prolog_flag(verbose, Old)). 527 528 529 /******************************* 530 * MESSAGES * 531 *******************************/ 532 533:- multifile 534 prolog:message//1. 535 536print_issue(Term) :- 537 assertz(issue(Term)), 538 print_message(warning, Term). 539 540issue_url(Properties, URL) :- 541 Local = Properties.get(url), 542 !, 543 issue_base(Base), 544 atom_concat(Base, Local, URL). 545issue_url(Properties, URL) :- 546 Properties.get(source) = library(Segments), 547 !, 548 path_segments_atom(Segments, Base), 549 file_name_extension(Base, html, URLFile), 550 issue_base(Issues), 551 atom_concat(Issues, URLFile, URL). 552 553prologmessage(installation(Message)) --> 554 message(Message). 555 556message(checking) --> 557 { current_prolog_flag(address_bits, Bits) }, 558 { current_prolog_flag(arch, Arch) }, 559 { current_prolog_flag(home, Home) }, 560 { current_prolog_flag(cpu_count, Cores) }, 561 [ 'Checking your SWI-Prolog kit for common issues ...'-[], nl, nl ], 562 [ 'Version: ~`.t~24| '-[] ], '$messages':prolog_message(version), [nl], 563 [ 'Address bits: ~`.t~24| ~d'-[Bits] ], [nl], 564 [ 'Architecture: ~`.t~24| ~w'-[Arch] ], [nl], 565 [ 'Installed at: ~`.t~24| ~w'-[Home] ], [nl], 566 [ 'Cores: ~`.t~24| ~w'-[Cores] ], [nl], 567 [ nl ]. 568message(perfect) --> 569 [ nl, 'Congratulations, your kit seems sound and complete!'-[] ]. 570message(imperfect(N)) --> 571 [ 'Found ~w issues.'-[N] ]. 572message(checking(Feature)) --> 573 [ 'Checking ~w ...'-[Feature], flush ]. 574message(missing(Properties)) --> 575 [ at_same_line, '~`.t~48| not present'-[] ], 576 details(Properties). 577message(loading(Source)) --> 578 [ 'Loading ~q ...'-[Source], flush ]. 579message(ok) --> 580 [ at_same_line, '~`.t~48| ok'-[] ]. 581message(optional_not_found(Properties)) --> 582 [ 'Optional ~q ~`.t~48| not present'-[Properties.source] ]. 583message(not_found(Properties)) --> 584 [ '~q ~`.t~48| NOT FOUND'-[Properties.source] ], 585 details(Properties). 586message(failed(Properties, false, [])) --> 587 !, 588 [ at_same_line, '~`.t~48| FAILED'-[] ], 589 details(Properties). 590message(failed(Properties, exception(Ex0), [])) --> 591 !, 592 { strip_stack(Ex0, Ex), 593 message_to_string(Ex, Msg) }, 594 [ '~w'-[Msg] ], 595 details(Properties). 596message(failed(Properties, true, Messages)) --> 597 [ at_same_line, '~`.t~48| FAILED'-[] ], 598 explain(Messages), 599 details(Properties). 600message(archive(What, Names)) --> 601 [ ' Supported ~w: '-[What] ], 602 list_names(Names). 603message(pcre_missing(Features)) --> 604 [ 'Missing libpcre features: '-[] ], 605 list_names(Features). 606message(not_first_on_path(EXE, OnPath)) --> 607 { public_executable(EXE, PublicEXE), 608 file_base_name(EXE, Prog) 609 }, 610 [ 'The first ~w on '-[Prog] ], 'PATH', [ ' is ~p, while '-[OnPath], nl ], 611 [ 'this version is ~p.'-[PublicEXE] ]. 612message(not_same_on_path(EXE, OnPath)) --> 613 { public_executable(EXE, PublicEXE), 614 file_base_name(EXE, Prog) 615 }, 616 [ 'The ~w on '-[Prog] ], 'PATH', [ ' is ~p, while '-[OnPath], nl ], 617 [ 'this version is ~p.'-[PublicEXE] ]. 618message(not_on_path(EXE, Prog)) --> 619 { public_bin_dir(EXE, Dir), 620 prolog_to_os_filename(Dir, OSDir) 621 }, 622 [ 'Could not find ~w on '-[Prog] ], 'PATH', [ '. '-[], nl ], 623 [ 'You may wish to add ~p to '-[OSDir] ], 'PATH', [ '. '-[], nl ]. 624message(jquery(found(Path))) --> 625 [ ' jQuery from ~w'-[Path] ]. 626message(jquery(not_found(File))) --> 627 [ ' Cannot find jQuery (~w)'-[File] ]. 628message(sweep(found(Paths))) --> 629 [ ' GNU-Emacs plugin loads'-[] ], 630 sequence(list_file, Paths). 631message(sweep(not_found(Paths))) --> 632 [ ' Could not find all GNU-Emacs libraries'-[] ], 633 sequence(list_file, Paths). 634message(testing(no_installed_tests)) --> 635 [ ' Runtime testing is not enabled.', nl], 636 [ ' Please recompile the system with INSTALL_TESTS enabled.' ]. 637 638 639public_executable(EXE, PublicProg) :- 640 file_base_name(EXE, Prog), 641 file_directory_name(EXE, ArchDir), 642 file_directory_name(ArchDir, BinDir), 643 file_directory_name(BinDir, Home), 644 file_directory_name(Home, Lib), 645 file_directory_name(Lib, Prefix), 646 atomic_list_concat([Prefix, bin, Prog], /, PublicProg), 647 exists_file(PublicProg), 648 same_file(EXE, PublicProg), 649 !. 650public_executable(EXE, EXE). 651 652public_bin_dir(EXE, Dir) :- 653 public_executable(EXE, PublicEXE), 654 file_directory_name(PublicEXE, Dir). 655 656 657 658'PATH' --> 659 { current_prolog_flag(windows, true) }, 660 !, 661 [ '%PATH%'-[] ]. 662'PATH' --> 663 [ '$PATH'-[] ]. 664 665strip_stack(error(Error, context(prolog_stack(S), Msg)), 666 error(Error, context(_, Msg))) :- 667 nonvar(S). 668strip_stack(Error, Error). 669 670details(Properties) --> 671 { issue_url(Properties, URL), ! 672 }, 673 [ nl, 'See ~w'-[URL] ]. 674details(_) --> []. 675 676explain(Messages) --> 677 { Messages = [message(error(shared_object(open, _Message), _), _, _)|_] 678 }, 679 !, 680 [nl], 681 ( { current_prolog_flag(windows, true) } 682 -> [ 'Cannot load required DLL'-[] ] 683 ; [ 'Cannot load required shared library'-[] ] 684 ). 685explain(Messages) --> 686 print_messages(Messages). 687 688print_messages([]) --> []. 689print_messages([message(_Term, _Kind, Lines)|T]) --> 690 , [nl], 691 print_messages(T). 692 693list_names([]) --> []. 694list_names([H|T]) --> 695 [ '~w'-[H] ], 696 ( {T==[]} 697 -> [] 698 ; [ ', '-[] ], 699 list_names(T) 700 ). 701 702list_file(File) --> 703 [ nl, ' '-[], url(File) ]. 704 705 706 /******************************* 707 * CONFIG FILES * 708 *******************************/
715check_config_files :- 716 check_config_files(Issues), 717 maplist(print_message(warning), Issues). 718 719check_config_files(Issues) :- 720 findall(Issue, check_config_file(Issue), Issues). 721 722check_config_file(config(Id, move(Type, OldFile, NewFile))) :- 723 old_config(Type, Id, OldFile), 724 access_file(OldFile, exist), 725 \+ ( new_config(Type, Id, NewFile), 726 access_file(NewFile, exist) 727 ), 728 once(new_config(Type, Id, NewFile)). 729check_config_file(config(Id, different(Type, OldFile, NewFile))) :- 730 old_config(Type, Id, OldFile), 731 access_file(OldFile, exist), 732 new_config(Type, Id, NewFile), 733 access_file(NewFile, exist), 734 \+ same_file(OldFile, NewFile).
741update_config_files :- 742 old_config(Type, Id, OldFile), 743 access_file(OldFile, exist), 744 \+ ( new_config(Type, Id, NewFile), 745 access_file(NewFile, exist) 746 ), 747 ( new_config(Type, Id, NewFile), 748 \+ same_file(OldFile, NewFile), 749 create_parent_dir(NewFile) 750 -> catch(rename_file(OldFile, NewFile), E, 751 print_message(warning, E)), 752 print_message(informational, config(Id, moved(Type, OldFile, NewFile))) 753 ), 754 fail. 755update_config_files. 756 757old_config(file, init, File) :- 758 current_prolog_flag(windows, true), 759 win_folder(appdata, Base), 760 atom_concat(Base, '/SWI-Prolog/swipl.ini', File). 761old_config(file, init, File) :- 762 expand_file_name('~/.swiplrc', [File]). 763old_config(directory, lib, Dir) :- 764 expand_file_name('~/lib/prolog', [Dir]). 765old_config(directory, xpce, Dir) :- 766 expand_file_name('~/.xpce', [Dir]). 767old_config(directory, history, Dir) :- 768 expand_file_name('~/.swipl-dir-history', [Dir]). 769old_config(directory, pack, Dir) :- 770 ( catch(expand_file_name('~/lib/swipl/pack', [Dir]), _, fail) 771 ; absolute_file_name(swi(pack), Dir, 772 [ file_type(directory), solutions(all) ]) 773 ). 774 775new_config(file, init, File) :- 776 absolute_file_name(user_app_config('init.pl'), File, 777 [ solutions(all) ]). 778new_config(directory, lib, Dir) :- 779 config_dir(user_app_config(lib), Dir). 780new_config(directory, xpce, Dir) :- 781 config_dir(user_app_config(xpce), Dir). 782new_config(directory, history, Dir) :- 783 config_dir(user_app_config('dir-history'), Dir). 784new_config(directory, pack, Dir) :- 785 config_dir([app_data(pack), swi(pack)], Dir). 786 787config_dir(Aliases, Dir) :- 788 is_list(Aliases), 789 !, 790 ( member(Alias, Aliases), 791 absolute_file_name(Alias, Dir, 792 [ file_type(directory), solutions(all) ]) 793 *-> true 794 ; member(Alias, Aliases), 795 absolute_file_name(Alias, Dir, 796 [ solutions(all) ]) 797 ). 798config_dir(Alias, Dir) :- 799 ( absolute_file_name(Alias, Dir, 800 [ file_type(directory), solutions(all) ]) 801 *-> true 802 ; absolute_file_name(Alias, Dir, 803 [ solutions(all) ]) 804 ). 805 806create_parent_dir(NewFile) :- 807 file_directory_name(NewFile, Dir), 808 create_parent_dir_(Dir). 809 810create_parent_dir_(Dir) :- 811 exists_directory(Dir), 812 '$my_file'(Dir), 813 !. 814create_parent_dir_(Dir) :- 815 file_directory_name(Dir, Parent), 816 Parent \== Dir, 817 create_parent_dir_(Parent), 818 make_directory(Dir). 819 820prologmessage(config(Id, Issue)) --> 821 [ 'Config: '-[] ], 822 config_description(Id), 823 config_issue(Issue). 824 825config_description(init) --> 826 [ '(user initialization file) '-[], nl ]. 827config_description(lib) --> 828 [ '(user library) '-[], nl ]. 829config_description(pack) --> 830 [ '(add-ons) '-[], nl ]. 831config_description(history) --> 832 [ '(command line history) '-[], nl ]. 833config_description(xpce) --> 834 [ '(gui) '-[], nl ]. 835 836config_issue(move(Type, Old, New)) --> 837 [ ' found ~w "~w"'-[Type, Old], nl ], 838 [ ' new location is "~w"'-[New] ]. 839config_issue(moved(Type, Old, New)) --> 840 [ ' found ~w "~w"'-[Type, Old], nl ], 841 [ ' moved to new location "~w"'-[New] ]. 842config_issue(different(Type, Old, New)) --> 843 [ ' found different ~w "~w"'-[Type, Old], nl ], 844 [ ' new location is "~w"'-[New] ]
Check installation issues and features
This library performs checks on the installed system to verify which optional components are available and whether all libraries that load shared objects/DLLs can be loaded. */