diff --git a/Logtalk/examples/testing/NOTES.txt b/Logtalk/examples/testing/NOTES.txt new file mode 100644 index 000000000..a18c2d371 --- /dev/null +++ b/Logtalk/examples/testing/NOTES.txt @@ -0,0 +1,14 @@ +================================================================ +Logtalk - Open source object-oriented logic programming language +Release 2.30.7 + +Copyright (c) 1998-2007 Paulo Moura. All Rights Reserved. +================================================================ + + +This folder contains a preliminary framework for defining and running +unit tests in Logtalk. + +The unit tests framework is inspired on the works of Joachim Schimpf +(ECLiPSe library "test_util") and Jan Wielemaker (SWI-Prolog "plunit" +package). diff --git a/Logtalk/examples/testing/SCRIPT.txt b/Logtalk/examples/testing/SCRIPT.txt new file mode 100644 index 000000000..393e09a8f --- /dev/null +++ b/Logtalk/examples/testing/SCRIPT.txt @@ -0,0 +1,15 @@ +================================================================ +Logtalk - Open source object-oriented logic programming language +Release 2.30.7 + +Copyright (c) 1998-2007 Paulo Moura. All Rights Reserved. +================================================================ + + +% start by loading the example: + +| ?- logtalk_load(testing(loader)). +... + + +% take a look at the "results.txt" file in the example directory \ No newline at end of file diff --git a/Logtalk/examples/testing/loader.lgt b/Logtalk/examples/testing/loader.lgt new file mode 100644 index 000000000..093b3d154 --- /dev/null +++ b/Logtalk/examples/testing/loader.lgt @@ -0,0 +1,4 @@ + +:- initialization(( + logtalk_load(library(lgtunit), [reload(skip)]), % allow for static binding + logtalk_load(testing))). diff --git a/Logtalk/examples/testing/testing.lgt b/Logtalk/examples/testing/testing.lgt new file mode 100644 index 000000000..261f5cdcf --- /dev/null +++ b/Logtalk/examples/testing/testing.lgt @@ -0,0 +1,134 @@ + +:- object(ctx_call_tests, + extends(lgtunit)). + + :- info([ + version is 1.0, + author is 'Paulo Moura', + date is 2007/04/17, + comment is 'Tests <2 built-in control construct.']). + +% :- initialization(::run). +% :- initialization(::run('bios_tests.txt', write)). + :- initialization(::run('results.txt', write)). + + throws(ctx1, _ << goal, error(instantiation_error, _, _)). + throws(ctx2, object << _, error(instantiation_error, _, _)). + throws(ctx3, 3 << goal, error(type_error(object_identifier, 3), _, _)). + throws(ctx4, object << 3, error(type_error(callable, 3), _, _)). + throws(ctx5, ctx_call_tests << goal, error(existence_error(procedure, goal/0), _)). + throws(ctx6, xpto << goal, error(existence_error(object, xpto), _, _)). + + succeeds(ctx7, user << true). + + fails(ctx8, user << fail). + +:- end_object. + + + +:- object(bios_tests, + extends(lgtunit)). + + :- info([ + version is 1.0, + author is 'Paulo Moura', + date is 2007/04/17, + comment is 'Tests built-in objects.']). + +% :- initialization(::run). +% :- initialization(::run('bios_tests.txt', write)). + :- initialization(::run('results.txt', append)). + + succeeds(all, (setof(Obj, (current_object(Obj), object_property(Obj, built_in)), Objs), Objs == [debugger,logtalk,user])). + + succeeds(user0, current_object(user)). + succeeds(user1, object_property(user, built_in)). + succeeds(user2, object_property(user, static)). + + succeeds(debugger0, current_object(debugger)). + succeeds(debugger1, object_property(debugger, built_in)). + succeeds(debugger2, object_property(debugger, static)). + + succeeds(logtalk0, current_object(logtalk)). + succeeds(logtalk1, object_property(logtalk, built_in)). + succeeds(logtalk2, object_property(logtalk, static)). + + throws(co0, current_object(1), error(type_error(object_identifier, 1), _)). + +:- end_object. + + + +:- object(list_tests, + extends(lgtunit)). + + :- info([ + version is 1.0, + author is 'Paulo Moura', + date is 2007/04/17, + comment is 'Tests for the library object "list".']). + +% :- initialization(::run). +% :- initialization(::run('list_tests.txt', write)). + :- initialization(::run('results.txt', append)). + + setup :- + current_logtalk_flag(report, Value), + set_logtalk_flag(report, off), + logtalk_load(library(types_loader), [reload(skip)]), + set_logtalk_flag(report, Value), + ^^setup. + + fails(member0, list << member(_, [])). + + succeeds(member1, list << member(1, [1,2,3])). + succeeds(member2, (findall(X, list << member(X, [1,2,3]), L), L == [1,2,3])). + + succeeds(length, (list << length([1,2,3], Length), Length =:= 3)). + +:- end_object. + + + +:- object(dyn_tests, + extends(lgtunit)). + + :- info([ + version is 1.1, + author is 'Paulo Moura', + date is 2007/09/15, + comment is 'Tests dynamic objects and dynamic predicates.']). + +% :- initialization(::run). +% :- initialization(::run('dyn_tests.txt', write)). + :- initialization(::run('results.txt', append)). + + setup :- + create_object(dyn_test, [], [], []). + + succeeds(dyn, This << goal) :- + this(This). + + goal :- + \+ dyn_test::current_predicate(_), + dyn_test::asserta(a(1)), + dyn_test::current_predicate(a/1), + dyn_test::predicate_property(a(_), public), + dyn_test::predicate_property(a(_), dynamic), + dyn_test::predicate_property(a(_), declared_in(dyn_test)), + dyn_test::predicate_property(a(_), defined_in(dyn_test)), + dyn_test::assertz(a(2)), + dyn_test::retractall(a(_)), + \+ dyn_test::a(_), + dyn_test::predicate_property(a(_), defined_in(dyn_test)), % closed-world assumption + dyn_test::current_predicate(a/1), + dyn_test::abolish(a/1), + \+ dyn_test::predicate_property(a(_), declared_in(dyn_test)), + \+ dyn_test::predicate_property(a(_), defined_in(dyn_test)), + \+ dyn_test::current_predicate(_). + + cleanup :- + abolish_object(dyn_test). + +:- end_object. diff --git a/Logtalk/examples/threads/barriers/NOTES.txt b/Logtalk/examples/threads/barriers/NOTES.txt new file mode 100644 index 000000000..23f545fcf --- /dev/null +++ b/Logtalk/examples/threads/barriers/NOTES.txt @@ -0,0 +1,11 @@ +================================================================ +Logtalk - Open source object-oriented logic programming language +Release 2.30.7 + +Copyright (c) 1998-2007 Paulo Moura. All Rights Reserved. +================================================================ + + +To load this example and for sample queries, please see the SCRIPT file. + +This folder contains examples of multi-threading barrier synchronization. \ No newline at end of file diff --git a/Logtalk/examples/threads/barriers/SCRIPT.txt b/Logtalk/examples/threads/barriers/SCRIPT.txt new file mode 100644 index 000000000..b53d02ec2 --- /dev/null +++ b/Logtalk/examples/threads/barriers/SCRIPT.txt @@ -0,0 +1,22 @@ +================================================================ +Logtalk - Open source object-oriented logic programming language +Release 2.30.7 + +Copyright (c) 1998-2007 Paulo Moura. All Rights Reserved. +================================================================ + + +% start by loading the loading the example: + +| ?- logtalk_load(barriers(loader)). +... + + +% run example: + +| ?- beatles::sing_along. + +hello(1)hello(4)hello(2)hello(3) +goodbye(2)goodbye(1)goodbye(3)goodbye(4) + +Yes diff --git a/Logtalk/examples/threads/barriers/beatles.lgt b/Logtalk/examples/threads/barriers/beatles.lgt new file mode 100644 index 000000000..a355fe541 --- /dev/null +++ b/Logtalk/examples/threads/barriers/beatles.lgt @@ -0,0 +1,36 @@ + +:- object(beatles). + + :- info([ + version is 1.0, + author is 'Paulo Moura', + date is 2007/10/23, + comment is 'Simple example of using a barrier to synchronize a set of threads.']). + + :- threaded. + + :- public(sing_along/0). + :- mode(sing_along, one). + :- info(sing_along/0, [ + comment is 'Wait for all threads to say "hello" and then proceed with the threads saying "goodbye".']). + + :- uses(random, [random/3]). + + sing(Thread) :- + random(1, 3, BusyHello), thread_sleep(BusyHello), % spend some time before saying hello + write(hello(Thread)), flush_output, + threaded_notify(ready(Thread)), % notify barrier that you have arrived + threaded_wait(go(Thread)), % wait for green light to cross the barrier + random(1, 3, BusyGoodbye), thread_sleep(BusyGoodbye), % spend some time before saying goodbye + write(goodbye(Thread)), flush_output. + + sing_along :- + threaded_ignore(sing(1)), % start the threads + threaded_ignore(sing(2)), + threaded_ignore(sing(3)), + threaded_ignore(sing(4)), + threaded_wait([ready(1), ready(2), ready(3), ready(4)]), % wait for all threads to reach the barrier + nl, write('Enough of hellos! Time for goodbyes!'), nl, + threaded_notify([go(1), go(2), go(3), go(4)]). % give green light to all threads to cross the barrier + +:- end_object. diff --git a/Logtalk/examples/threads/barriers/loader.lgt b/Logtalk/examples/threads/barriers/loader.lgt new file mode 100644 index 000000000..d44be3c1b --- /dev/null +++ b/Logtalk/examples/threads/barriers/loader.lgt @@ -0,0 +1,4 @@ + +:- initialization(( + logtalk_load(library(random_loader), [reload(skip)]), + logtalk_load(beatles))). diff --git a/Logtalk/examples/threads/tak/NOTES.txt b/Logtalk/examples/threads/tak/NOTES.txt new file mode 100644 index 000000000..3e5c0aaa5 --- /dev/null +++ b/Logtalk/examples/threads/tak/NOTES.txt @@ -0,0 +1,13 @@ +================================================================ +Logtalk - Open source object-oriented logic programming language +Release 2.30.7 + +Copyright (c) 1998-2007 Paulo Moura. All Rights Reserved. +================================================================ + + +To load this example and for sample queries, please see the SCRIPT file. + +This folder contains single-threaded and multi-threaded implementations +of the Takeuchi function (recursive arithmetic). The multi-threaded version +uses three threads per recursive call. diff --git a/Logtalk/examples/threads/tak/SCRIPT.txt b/Logtalk/examples/threads/tak/SCRIPT.txt new file mode 100644 index 000000000..26d38f9bc --- /dev/null +++ b/Logtalk/examples/threads/tak/SCRIPT.txt @@ -0,0 +1,54 @@ +================================================================ +Logtalk - Open source object-oriented logic programming language +Release 2.30.7 + +Copyright (c) 1998-2007 Paulo Moura. All Rights Reserved. +================================================================ + + +% load the example: + +| ?- logtalk_load(tak(loader)). +... + + +% single-threaded version: + +| ?- time(tak::tak_st(18, 12, 6, R)). + +% 254,474 inferences, 1.44 CPU in 1.47 seconds (98% CPU, 176718 Lips) + +R = 7 + +Yes + + +% multi-threaded version: + +| ?- time(tak::tak_mt(18, 12, 6, R)). + +% 202 inferences, 1.45 CPU in 0.77 seconds (188% CPU, 139 Lips) + +R = 7 + +Yes + + +% single-threaded version: + +| ?- time(tak::tak_st(21, 14, 7, R)). +% 1,583,066 inferences, 12.40 CPU in 12.53 seconds (99% CPU, 127667 Lips) + +R = 14 + +Yes + + +% multi-threaded version: + +| ?- time(tak::tak_mt(21, 14, 7, R)). +% 122 inferences, 11.98 CPU in 7.74 seconds (155% CPU, 10 Lips) + +R = 14 + +Yes diff --git a/Logtalk/examples/threads/tak/loader.lgt b/Logtalk/examples/threads/tak/loader.lgt new file mode 100644 index 000000000..f00fa445f --- /dev/null +++ b/Logtalk/examples/threads/tak/loader.lgt @@ -0,0 +1,3 @@ + +:- initialization( + logtalk_load(tak)). diff --git a/Logtalk/examples/threads/tak/tak.lgt b/Logtalk/examples/threads/tak/tak.lgt new file mode 100644 index 000000000..ea0b821e4 --- /dev/null +++ b/Logtalk/examples/threads/tak/tak.lgt @@ -0,0 +1,52 @@ + +:- object(tak). + + :- info([ + version is 1.0, + author is 'Paulo Moura', + date is 2007/07/15, + comment is 'Takeuchi function (recursive arithmetic).']). + + :- threaded. + + :- public(tak_st/4). + :- mode(tak_st(+integer, +integer, +integer, -integer), one). + :- info(tak_st/4, [ + comment is 'Single-threaded version of Takeuchi function.', + argnames is ['X', 'Y', 'Z', 'R']]). + + :- public(tak_mt/4). + :- mode(tak_mt(+integer, +integer, +integer, -integer), one). + :- info(tak_mt/4, [ + comment is 'Multi-threaded version of Takeuchi function.', + argnames is ['X', 'Y', 'Z', 'R']]). + + tak_st(X, Y, Z, A):- + X =< Y, + Z = A. + tak_st(X, Y, Z, A):- + X > Y, + X1 is X - 1, + tak_st(X1, Y, Z, A1), + Y1 is Y - 1, + tak_st(Y1, Z, X, A2), + Z1 is Z - 1, + tak_st(Z1, X, Y, A3), + tak_st(A1, A2, A3, A). + + tak_mt(X, Y, Z, A):- + X =< Y, + Z = A. + tak_mt(X, Y, Z, A):- + X > Y, + X1 is X - 1, + Y1 is Y - 1, + Z1 is Z - 1, + threaded(( + tak_st(X1, Y, Z, A1), + tak_st(Y1, Z, X, A2), + tak_st(Z1, X, Y, A3) + )), + tak_mt(A1, A2, A3, A). + +:- end_object. diff --git a/Logtalk/integration/logtalk_comp_xsbmt.pl b/Logtalk/integration/logtalk_comp_xsbmt.pl new file mode 100644 index 000000000..2fee6b917 --- /dev/null +++ b/Logtalk/integration/logtalk_comp_xsbmt.pl @@ -0,0 +1,71 @@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Logtalk - Open source object-oriented logic programming language +% Release 2.30.7 +% +% Copyright (c) 1998-2007 Paulo Moura. All Rights Reserved. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +:- import stat_set_flag/2 from machine. % workaround for compiling/loading source files +:- stat_set_flag(79, 1). % when more than one thread is active + +:- compiler_options([xpp_on]). + +#include ../compiler/logtalk.pl + +% tables of defined events and monitors +:- thread_shared('$lgt_before_'(_, _, _, _, _)). +:- thread_shared('$lgt_after_'(_, _, _, _, _)). + +% tables of loaded entities and respective relationships +:- thread_shared('$lgt_current_protocol_'(_, _, _)). +:- thread_shared('$lgt_current_category_'(_, _, _, _)). +:- thread_shared('$lgt_current_object_'(_, _, _, _, _, _, _, _)). + +:- thread_shared('$lgt_implements_protocol_'(_, _, _)). +:- thread_shared('$lgt_imports_category_'(_, _, _)). +:- thread_shared('$lgt_instantiates_class_'(_, _, _)). +:- thread_shared('$lgt_specializes_class_'(_, _, _)). +:- thread_shared('$lgt_extends_protocol_'(_, _, _)). +:- thread_shared('$lgt_extends_object_'(_, _, _)). + +% table of loaded files +:- thread_shared('$lgt_loaded_file_'(_, _)). + +% debugger status and tables +:- thread_shared('$lgt_debugging_'(_)). + +:- thread_shared('$lgt_dbg_debugging_'). +:- thread_shared('$lgt_dbg_tracing_'). +:- thread_shared('$lgt_dbg_skipping_'). +:- thread_shared('$lgt_dbg_spying_'(_, _)). +:- thread_shared('$lgt_dbg_spying_'(_, _, _, _)). +:- thread_shared('$lgt_dbg_leashing_'(_)). + +% runtime flags +:- thread_shared('$lgt_current_flag_'(_, _)). + +% static binding caches +:- thread_shared('$lgt_static_binding_entity_'(_)). +:- thread_shared('$lgt_obj_static_binding_cache_'(_, _, _, _)). +:- thread_shared('$lgt_ctg_static_binding_cache_'(_, _, _, _, _, _)). + +% lookup caches for messages to an object, messages to self, and super calls +:- thread_shared('$lgt_obj_lookup_cache_'(_, _, _, _)). +:- thread_shared('$lgt_self_lookup_cache_'(_, _, _, _)). +:- thread_shared('$lgt_super_lookup_cache_'(_, _, _, _, _)). + +% lookup cache for asserting and retracting dynamic facts +:- thread_shared('$lgt_db_lookup_cache_'(_, _, _, _, _)). + +% table of library paths +:- thread_shared(logtalk_library_path(_, _)). + +% compiler hook goal: +:- thread_shared('$lgt_hook_goal_'(_, _)). + +% multi-threading tags +:- thread_shared('$lgt_threaded_tag_counter'(_)). diff --git a/Logtalk/integration/logtalk_qp.pl b/Logtalk/integration/logtalk_qp.pl new file mode 100644 index 000000000..f89f388a0 --- /dev/null +++ b/Logtalk/integration/logtalk_qp.pl @@ -0,0 +1,19 @@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Logtalk - Open source object-oriented logic programming language +% Release 2.30.7 +% +% Copyright (c) 1998-2007 Paulo Moura. All Rights Reserved. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +:- os(system('ln -sf $LOGTALKUSER/configs/qu.config $LOGTALKUSER/configs/qu.pl')), + fcompile('$LOGTALKUSER/configs/qu.pl', [assemble_only(true)]), + load('$LOGTALKUSER/configs/qu.qo'), + os(system('ln -sf $LOGTALKHOME/compiler/logtalk.pl $LOGTALKUSER/.logtalk.pl')), + fcompile('$LOGTALKUSER/.logtalk.pl', [assemble_only(true), object_file('$LOGTALKUSER/.logtalk.qo'), string_table(256)]), + load('$LOGTALKUSER/.logtalk.qo'), + fcompile('$LOGTALKUSER/libpaths/libpaths.pl', [assemble_only(true)]), + load('$LOGTALKUSER/libpaths/libpaths.qo'). diff --git a/Logtalk/integration/logtalk_xsbmt.pl b/Logtalk/integration/logtalk_xsbmt.pl new file mode 100644 index 000000000..9a13359d7 --- /dev/null +++ b/Logtalk/integration/logtalk_xsbmt.pl @@ -0,0 +1,16 @@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% Logtalk - Open source object-oriented logic programming language +% Release 2.30.7 +% +% Copyright (c) 1998-2007 Paulo Moura. All Rights Reserved. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +:- import expand_atom/2 from standard. + +:- expand_atom('$LOGTALKUSER/configs/xsb.config', Config), reconsult(Config). +:- expand_atom('$LOGTALKHOME/integration/logtalk_comp_xsbmt.pl', Compiler), reconsult(Compiler). +:- expand_atom('$LOGTALKUSER/libpaths/libpaths.pl', Libpaths), reconsult(Libpaths). diff --git a/Logtalk/integration/qplgt.sh b/Logtalk/integration/qplgt.sh new file mode 100755 index 000000000..06054a84e --- /dev/null +++ b/Logtalk/integration/qplgt.sh @@ -0,0 +1,60 @@ +#/bin/sh + +## ================================================================ +## Logtalk - Open source object-oriented logic programming language +## Release 2.30.7 +## +## Copyright (c) 1998-2007 Paulo Moura. All Rights Reserved. +## ================================================================ + +if ! [ "$LOGTALKHOME" ]; then + echo "The environment variable LOGTALKHOME should be defined first, pointing" + echo "to your Logtalk installation directory!" + echo "Trying the default locations for the Logtalk installation..." + if [ -d "/usr/local/share/logtalk" ]; then + LOGTALKHOME=/usr/local/share/logtalk + echo "... using Logtalk installation found at /usr/local/share/logtalk" + elif [ -d "/usr/share/logtalk" ]; then + LOGTALKHOME=/usr/share/logtalk + echo "... using Logtalk installation found at /usr/share/logtalk" + elif [ -d "/opt/local/share/logtalk" ]; then + LOGTALKHOME=/opt/local/share/logtalk + echo "... using Logtalk installation found at /opt/local/share/logtalk" + elif [ -d "/opt/share/logtalk" ]; then + LOGTALKHOME=/opt/share/logtalk + echo "... using Logtalk installation found at /opt/share/logtalk" + else + echo "... unable to locate Logtalk installation directory!" + echo + exit 1 + fi + echo +elif ! [ -d "$LOGTALKHOME" ]; then + echo "The environment variable LOGTALKHOME points to a non-existing directory!" + echo "Its current value is: $LOGTALKHOME" + echo "The variable must be set to your Logtalk installation directory!" + echo + exit 1 +fi +export LOGTALKHOME + +if ! [ "$LOGTALKUSER" ]; then + echo "The environment variable LOGTALKUSER should be defined first, pointing" + echo "to your Logtalk user directory!" + echo "Trying the default location for the Logtalk user directory..." + export LOGTALKUSER=$HOME/logtalk + if [ -d "$LOGTALKUSER" ]; then + echo "... using Logtalk user directory found at $LOGTALKUSER" + else + echo "... Logtalk user directory not found at default location. Creating a" + echo "new Logtalk user directory by running the \"cplgtdirs\" shell script:" + cplgtdirs + fi +elif ! [ -d "$LOGTALKUSER" ]; then + echo "Cannot find \$LOGTALKUSER directory! Creating a new Logtalk user directory" + echo "by running the \"cplgtdirs\" shell script:" + cplgtdirs +fi +echo + +exec qp -s 3072 -d 1024 -h 2048 -g "['$LOGTALKHOME/integration/logtalk_qp.pl']." "$@" diff --git a/Logtalk/integration/xsbmtlgt.sh b/Logtalk/integration/xsbmtlgt.sh new file mode 100755 index 000000000..41cbefb02 --- /dev/null +++ b/Logtalk/integration/xsbmtlgt.sh @@ -0,0 +1,60 @@ +#/bin/sh + +## ================================================================ +## Logtalk - Open source object-oriented logic programming language +## Release 2.30.7 +## +## Copyright (c) 1998-2007 Paulo Moura. All Rights Reserved. +## ================================================================ + +if ! [ "$LOGTALKHOME" ]; then + echo "The environment variable LOGTALKHOME should be defined first, pointing" + echo "to your Logtalk installation directory!" + echo "Trying the default locations for the Logtalk installation..." + if [ -d "/usr/local/share/logtalk" ]; then + LOGTALKHOME=/usr/local/share/logtalk + echo "... using Logtalk installation found at /usr/local/share/logtalk" + elif [ -d "/usr/share/logtalk" ]; then + LOGTALKHOME=/usr/share/logtalk + echo "... using Logtalk installation found at /usr/share/logtalk" + elif [ -d "/opt/local/share/logtalk" ]; then + LOGTALKHOME=/opt/local/share/logtalk + echo "... using Logtalk installation found at /opt/local/share/logtalk" + elif [ -d "/opt/share/logtalk" ]; then + LOGTALKHOME=/opt/share/logtalk + echo "... using Logtalk installation found at /opt/share/logtalk" + else + echo "... unable to locate Logtalk installation directory!" + echo + exit 1 + fi + echo +elif ! [ -d "$LOGTALKHOME" ]; then + echo "The environment variable LOGTALKHOME points to a non-existing directory!" + echo "Its current value is: $LOGTALKHOME" + echo "The variable must be set to your Logtalk installation directory!" + echo + exit 1 +fi +export LOGTALKHOME + +if ! [ "$LOGTALKUSER" ]; then + echo "The environment variable LOGTALKUSER should be defined first, pointing" + echo "to your Logtalk user directory!" + echo "Trying the default location for the Logtalk user directory..." + export LOGTALKUSER=$HOME/logtalk + if [ -d "$LOGTALKUSER" ]; then + echo "... using Logtalk user directory found at $LOGTALKUSER" + else + echo "... Logtalk user directory not found at default location. Creating a" + echo "new Logtalk user directory by running the \"cplgtdirs\" shell script:" + cplgtdirs + fi +elif ! [ -d "$LOGTALKUSER" ]; then + echo "Cannot find \$LOGTALKUSER directory! Creating a new Logtalk user directory" + echo "by running the \"cplgtdirs\" shell script:" + cplgtdirs +fi +echo + +exec xsb-mt --shared_predicates -l -e "['$LOGTALKHOME/integration/logtalk_xsbmt.pl']." "$@" diff --git a/Logtalk/library/lgtunit.lgt b/Logtalk/library/lgtunit.lgt new file mode 100644 index 000000000..e0fbfebc7 --- /dev/null +++ b/Logtalk/library/lgtunit.lgt @@ -0,0 +1,140 @@ + +:- object(lgtunit). + + :- info([ + version is 0.2, + author is 'Paulo Moura', + date is 2007/08/27, + comment is 'Logtalk unit test framework.']). + + :- public(succeeds/2). + :- mode(succeeds(+atom, @callable), zero_or_more). + :- info(succeeds/2, [ + comment is 'Defines a test goal which is expected to succeed.', + argnames is ['Test', 'Goal']]). + + :- public(fails/2). + :- mode(fails(+atom, @callable), zero_or_more). + :- info(fails/2, [ + comment is 'Defines a test goal which is expected to fail.', + argnames is ['Test', 'Goal']]). + + :- public(throws/3). + :- mode(throws(+atom, @callable, @nonvar), zero_or_more). + :- info(throws/3, [ + comment is 'Defines a test goal which is expected to throw an error.', + argnames is ['Test', 'Goal', 'Error']]). + + :- public(run/2). + :- mode(run(+atom, +atom), zero_or_one). + :- info(run/2, [ + comment is 'Runs the unit tests, writing the results to the specified file. Mode can be either "write" (to create a new file) or "append" (to add results to an existing file).', + argnames is ['File', 'Mode']]). + + :- public(run/0). + :- mode(run, zero_or_one). + :- info(run/0, [ + comment is 'Runs the unit tests, writing the results to the current output stream.']). + + :- protected(setup/0). + :- mode(setup, zero_or_one). + :- info(setup/0, [ + comment is 'Setup environment before running the test. Defaults to the goal true.']). + + :- protected(test/0). + :- mode(test, zero_or_one). + :- info(test/0, [ + comment is 'Executes the tests. By default, starts with the "succeeds" tests, followed by the "fails" tests, and than the "throws" tests.']). + + :- protected(cleanup/0). + :- mode(cleanup, zero_or_one). + :- info(cleanup/0, [ + comment is 'Cleanup environment after running the test. Defaults to the goal true.']). + + % by default, no test setup is needed: + setup. + + % by default, run all "succeeds", "fails", and "throws" tests: + test :- + test_succeeds, + test_fails, + test_throws. + + test_succeeds :- + forall(::succeeds(Test, Goal), test_succeeds(Test, Goal)). + + test_succeeds(Test, Goal) :- + ( catch({Goal}, _, fail) -> + passed_test(Test, Goal) + ; failed_test(Test, Goal) + ). + + test_fails :- + forall(::fails(Test, Goal), test_fail(Test, Goal)). + + test_fail(Test, Goal) :- + ( catch(\+ {Goal}, _, fail) -> + passed_test(Test, Goal) + ; failed_test(Test, Goal) + ). + + test_throws :- + forall(::throws(Test, Goal, Error), test_throws(Test, Goal, Error)). + + test_throws(Test, Goal, Error) :- + ( catch({Goal}, Ball, ((Ball = Error -> passed_test(Test, Goal); failed_test(Test, Goal)), Flag = error)) -> + ( var(Flag) -> + failed_test(Test, Goal) + ; true + ) + ; failed_test(Test, Goal) + ). + + passed_test(Test, _Goal) :- + self(Self), + write('= passed test '), writeq(Test), write(' in object '), writeq(Self), nl. + + failed_test(Test, _Goal) :- + self(Self), + write('= failed test '), writeq(Test), write(' in object '), writeq(Self), nl. + + % by default, no test cleanup is needed: + cleanup. + + run(File, Mode) :- + open(File, Mode, Stream), + current_output(Output), + set_output(Stream), + ::run, + set_output(Output), + close(Stream). + + run :- + self(Self), + write('% running tests from object '), writeq(Self), nl, + ( catch(::setup, Error, (broken(setup, Error), fail)) -> + ( catch(::test, Error, (broken(test, Error), Flag = error)) -> + do_cleanup, + ( var(Flag) -> + write('% completed tests from object '), writeq(Self), nl + ; write('% test run failed'), nl + ) + ; do_cleanup, + write('! test run failed for object '), writeq(Self), nl, + write('% test run failed'), nl + ) + ; write('! test setup failed for object '), writeq(Self), nl + ). + + do_cleanup :- + self(Self), + ( catch(::cleanup, Error, (broken(cleanup, Error), fail)) -> + true + ; write('! test cleanup failed for object '), writeq(Self), nl + ). + + broken(Step, Error) :- + self(Self), + write('! broken '), write(Step), write(' for object '), writeq(Self), write(': '), write(Error), nl. + +:- end_object. diff --git a/Logtalk/library/lgtunit.notes b/Logtalk/library/lgtunit.notes new file mode 100644 index 000000000..d214528c3 --- /dev/null +++ b/Logtalk/library/lgtunit.notes @@ -0,0 +1,15 @@ + +================================================================ +Logtalk - Open source object-oriented logic programming language +Release 2.30.7 + +Copyright (c) 1998-2007 Paulo Moura. All Rights Reserved. +================================================================ + + +The "lgtunit.lgt" file contains a preliminary framework for defining +and running unit tests in Logtalk. + +The unit tests framework is inspired on the works of Joachim Schimpf +(ECLiPSe library "test_util") and Jan Wielemaker (SWI-Prolog "plunit" +package). diff --git a/Logtalk/manuals/refman/builtins/threaded_call1_2.html b/Logtalk/manuals/refman/builtins/threaded_call1_2.html new file mode 100644 index 000000000..a8cf11b28 --- /dev/null +++ b/Logtalk/manuals/refman/builtins/threaded_call1_2.html @@ -0,0 +1,75 @@ + + + + + +
+ +threaded_call(Goal) +threaded_call(Goal, Tag)+
+Proves Goal
asynchronously using a new thread. The argument can be a message sending goal. Calls to this predicate always succeeds and return immediately. The results (success, failure, or exception) are sent back to the message queue of the object containing the call (this); they can be retrieved by calling the threaded_exit/1
predicate.
+
+The variant threaded_call/2
returns a threaded call identifier tag that can be used with the threaded_exit/2
predicate. Tags shall be considered as an opaque term; users shall not rely on its type.
+
threaded_call(@callable) +threaded_call(@callable, -nonvar)+ +
instantiation_error
type_error(callable, Goal)
type_error(variable, Goal)
Goal
asynchronously in a new thread:threaded_call(Goal)
::Message
asynchronously in a new thread:threaded_call(::Message)
Object::Message
asynchronously in a new thread:threaded_call(Object::Message)
threaded_exit(Goal) +threaded_exit(Goal, Tag)+
+Retrieves the result of proving Goal
in a new thread. This predicate blocks execution until the reply is sent to the this message queue by the thread executing the goal. When there is no thread proving the goal, the predicate generates an exception. This predicate is non-deterministic, providing access to any alternative solutions of its argument.
+
+The argument of this predicate should be a variant of the argument of the corresponding threaded_call/1 call. When the predicate argument is subsumed by the threaded_call/1 call argument, the threaded_exit/1
call will succeed iff its argument is a solution of the (more general) goal.
+
+The variant threaded_exit/2
accepts a threaded call identifier tag generated by the calls to the threaded_call/2
and threaded_once/2
predicates. Tags shall be considered as an opaque term; users shall not rely on its type.
+
threaded_exit(+callable) +threaded_exit(+callable, +nonvar)+ +
instantiation_error
type_error(callable, Goal)
existence_error(goal_thread, Goal)
instantiation_error
threaded_exit(Goal)
threaded_exit(::Goal)
threaded_exit(Object::Goal)
threaded_once(Goal) +threaded_once(Goal, Tag)+
+Proves Goal
asynchronously using a new thread. Only the first goal solution is found. The argument can be a message sending goal. This call always succeeds. The result (success, failure, or exception) is sent back to the message queue of the object containing the call (this).
+
+The variant threaded_once/2
returns a threaded call identifier tag that can be used with the threaded_exit/2
predicate. Tags shall be considered as an opaque term; users shall not rely on its type.
+
threaded_once(@callable) +threaded_once(@callable, -nonvar)+ +
instantiation_error
type_error(callable, Goal)
type_error(variable, Goal)
Goal
asynchronously in a new thread:threaded_once(Goal)
::Message
asynchronously in a new thread:threaded_once(::Message)
Object::Message
asynchronously in a new thread:threaded_once(Object::Message)
threaded_peek(Goal) +threaded_peek(Goal, Tag)+
+Checks if the result of proving Goal
in a new thread is already available. This call succeeds or fails without blocking execution waiting for a reply to be available.
+
+The argument of this predicate should be a variant of the argument of the corresponding threaded_call/1 call. When the predicate argument is subsumed by the threaded_call/1 call argument, the threaded_peek/1
call will succeed iff its argument unifies with an already available solution of the (more general) goal.
+
+The variant threaded_peek/2
accepts a threaded call identifier tag generated by the calls to the threaded_call/2
and threaded_once/2
predicates. Tags shall be considered as an opaque term; users shall not rely on its type.
+
threaded_peek(+callable) +threaded_peek(+callable, +nonvar)+ +
instantiation_error
type_error(callable, Goal)
instantiation_error
threaded_peek(Goal)
threaded_peek(::Goal)
threaded_peek(Object::Goal)