diff --git a/src/Tests/GC/test_agc_copyterm.pl b/src/Tests/GC/test_agc_copyterm.pl index 7defbba5f5..202d29eaf2 100644 --- a/src/Tests/GC/test_agc_copyterm.pl +++ b/src/Tests/GC/test_agc_copyterm.pl @@ -36,6 +36,7 @@ [ test_agc_copyterm/0 ]). :- use_module(library(plunit)). +:- use_module(library(debug)). test_agc_copyterm :- run_tests([ agc_copyterm diff --git a/src/Tests/core/test_code_type.pl b/src/Tests/core/test_code_type.pl index 023ce01e48..3109c73c94 100644 --- a/src/Tests/core/test_code_type.pl +++ b/src/Tests/core/test_code_type.pl @@ -36,6 +36,10 @@ :- module(test_code_type, [test_code_type/0]). :- use_module(library(plunit)). :- use_module(library(apply)). +:- use_module(library(aggregate)). +:- use_module(library(debug)). +:- use_module(library(ordsets)). +:- use_module(library(varnumbers)). /** Test Prolog text code_typeting primitives diff --git a/src/Tests/core/test_text.pl b/src/Tests/core/test_text.pl index 741ec7de34..21f0392ebf 100644 --- a/src/Tests/core/test_text.pl +++ b/src/Tests/core/test_text.pl @@ -35,6 +35,7 @@ :- module(test_text, [test_text/0]). :- use_module(library(plunit)). +:- use_module(library(debug)). /** Test Prolog core text processing primitives diff --git a/src/Tests/db/test_db.pl b/src/Tests/db/test_db.pl index 8b33858d55..583ed68a68 100644 --- a/src/Tests/db/test_db.pl +++ b/src/Tests/db/test_db.pl @@ -35,6 +35,9 @@ :- module(test_db, [test_db/0]). :- use_module(library(plunit)). +:- use_module(library(debug)). +:- use_module(library(gensym)). +:- use_module(library(lists)). /** Test Prolog core database functions diff --git a/src/Tests/library/test_aggregate.pl b/src/Tests/library/test_aggregate.pl index 212fcdf7c5..d13d7f9799 100644 --- a/src/Tests/library/test_aggregate.pl +++ b/src/Tests/library/test_aggregate.pl @@ -40,6 +40,7 @@ :- use_module(library(dif)). :- use_module(library(hashtable)). :- use_module(library(lists)). +:- use_module(library(debug)). test_aggregate :- run_tests([ foreach, diff --git a/src/Tests/library/test_apply.pl b/src/Tests/library/test_apply.pl index f72728cb79..1c34333280 100644 --- a/src/Tests/library/test_apply.pl +++ b/src/Tests/library/test_apply.pl @@ -37,6 +37,9 @@ [ test_apply/0 ]). :- use_module(library(apply)). +:- use_module(library(plunit)). +:- use_module(library(solution_sequences)). +:- use_module(library(yall)). % Test foldl of library(apply) % Author: David Tonhofer Dec 2020 diff --git a/src/Tests/library/test_date.pl b/src/Tests/library/test_date.pl index 0c9a91e56e..3036c27dd2 100644 --- a/src/Tests/library/test_date.pl +++ b/src/Tests/library/test_date.pl @@ -40,6 +40,7 @@ :- use_module(library(lists)). :- use_module(library(plunit)). :- use_module(library(date)). +:- use_module(library(debug)). :- dynamic error/1. diff --git a/src/Tests/library/test_evaluable_property.pl b/src/Tests/library/test_evaluable_property.pl index e143cf507b..d639ebc652 100644 --- a/src/Tests/library/test_evaluable_property.pl +++ b/src/Tests/library/test_evaluable_property.pl @@ -39,6 +39,7 @@ ]). :- use_module(library(plunit)). :- use_module(library(prolog_evaluable)). +:- use_module(library(debug)). test_evaluable_property :- run_tests(evaluable_property). diff --git a/src/Tests/library/test_intercept.pl b/src/Tests/library/test_intercept.pl index 44f385813b..d45f0ae0a4 100644 --- a/src/Tests/library/test_intercept.pl +++ b/src/Tests/library/test_intercept.pl @@ -37,7 +37,7 @@ ]). :- use_module(library(plunit)). :- use_module(library(intercept)). - +:- use_module(library(debug)). test_intercept :- run_tests([ intercept diff --git a/src/Tests/tabling/test_incr_answer_subsumption.pl b/src/Tests/tabling/test_incr_answer_subsumption.pl index e2eac0faea..0db2eac918 100644 --- a/src/Tests/tabling/test_incr_answer_subsumption.pl +++ b/src/Tests/tabling/test_incr_answer_subsumption.pl @@ -40,6 +40,9 @@ :- use_module(library(plunit)). :- use_module(library(increval)). :- use_module(library(tables)). +:- use_module(library(apply)). +:- use_module(library(debug)). +:- use_module(library(prolog_code)). %! test_incr_answer_subsumption % diff --git a/src/Tests/tabling/test_shared_units.pl b/src/Tests/tabling/test_shared_units.pl index 3ba1effb3d..06d017475a 100644 --- a/src/Tests/tabling/test_shared_units.pl +++ b/src/Tests/tabling/test_shared_units.pl @@ -38,6 +38,8 @@ [ test_shared_units/0 ]). :- use_module(library(plunit)). +:- use_module(library(debug)). +:- use_module(library(time)). test_shared_units :- run_tests([ shared_reeval diff --git a/src/Tests/thread/thr_local_1.pl b/src/Tests/thread/thr_local_1.pl index 6ecaedd4ad..d131be5e2b 100644 --- a/src/Tests/thread/thr_local_1.pl +++ b/src/Tests/thread/thr_local_1.pl @@ -36,6 +36,9 @@ [ thr_local_1/0 ]). :- use_module(library(apply)). +:- use_module(library(debug)). +:- use_module(library(lists)). +:- use_module(library(ordsets)). /** Test thread local predicates diff --git a/src/Tests/transaction/test_transactions.pl b/src/Tests/transaction/test_transactions.pl index 245d8c5ffc..8ecf9c211b 100644 --- a/src/Tests/transaction/test_transactions.pl +++ b/src/Tests/transaction/test_transactions.pl @@ -43,6 +43,7 @@ :- use_module(library(apply)). :- use_module(library(error)). :- use_module(library(debug)). +:- use_module(library(ordsets)). :- meta_predicate test_transaction(:). @@ -201,9 +202,10 @@ test_transaction(M:List) :- must_be(list, List), + anon_threads(Initial), test(List, 1, _{module:M}, State), cleanup(State), - assertion(no_more_threads). + assertion(no_more_threads(Initial)). test([], _, State, State). test([discard|More], _, State, _) :- @@ -378,12 +380,16 @@ thread_send_message(Thread, done), thread_join(Thread). -no_more_threads :- +anon_threads(Threads) :- current_prolog_flag(threads, true), !, - findall(T, anon_thread(T), Anon), - Anon == []. -no_more_threads. + findall(T, anon_thread(T), List), + sort(List, Threads). +anon_threads([]). + +no_more_threads(Initial) :- + anon_threads(Now), + ord_subtract(Now, Initial, []). anon_thread(T) :- thread_property(T, id(_)),