test_cpp.pl

% -*- mode: Prolog; coding: utf-8 -*-

/*  Part of SWI-Prolog

    Author:        Jan Wielemaker and Peter Ludemann
    E-mail:        J.Wielemaker@vu.nl
    WWW:           http://www.swi-prolog.org
    Copyright (c)  2022-2024, SWI-Prolog Solutions b.v.
    All rights reserved.

    Redistribution and use in source and binary forms, with or without
    modification, are permitted provided that the following conditions
    are met:

    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.

    2. Redistributions in binary form must reproduce the above copyright
       notice, this list of conditions and the following disclaimer in
       the documentation and/or other materials provided with the
       distribution.

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
    POSSIBILITY OF SUCH DAMAGE.
*/

/* This tests the examples in the SWI-cpp2.h documentation. */

:- module(test_cpp,
	  [ test_cpp/0
	  ]).
:- use_module(library(debug)).
:- use_module(library(lists)).
:- use_module(library(apply)).
:- autoload(library(aggregate)).
:- use_module(library(plunit)).
:- use_module(library(dcg/basics)).
:- use_module(library(dcg/high_order)).

:- encoding(utf8).

:- use_foreign_library(foreign(test_cpp)).

:- dynamic user:file_search_path/2.
:- multifile user:file_search_path/2.

here.
user:file_search_path(cpp_test_home, Dir) :-
    source_file(here, File),
    file_directory_name(File, Dir).

:- multifile user:portray/1.

user:portray(MyBlob) :-
    blob(MyBlob, my_blob), !,
    portray_my_blob(current_output, MyBlob).

user:portray(MyFileBlob) :-
    blob(MyFileBlob, my_file_blob), !,
    my_file_blob_portray(current_output, MyFileBlob).

% test_cpp :-
%     run_tests([ cpp,
%                 cpp_atommap,
%                 cpp_map_str_str
%	      ]).

test_cpp :-
    run_tests.

% Some of the tests can result in crashes if there's a bug, so the
% `output(on_failure)` option results in nothing being written.
% If so, uncomment the following line
% :- set_test_options([output(always), format(log)]).

:- begin_tests(cpp).

test(unwrap) :-
    unwrap(foo(1)),
    unwrap(bar),
    unwrap("qqsv").

test(hello, Out == "hello hello hello") :-
    % hello :- write('hello hello hello')
    with_output_to(string(Out), hello).

test(helloex, error(unknown_error('an exception'))) :-
    helloex.
test(helloex, error(unknown_error(foo(bar)))) :-
    helloex(foo(bar)).

test(hello, Out == "Hello WORLD\nHello WORLD\nHello WORLD\nHello WORLD\nHello WORLD\n") :-
    hello("WORLD", Out).
test(hello, error(representation_error(encoding))) :-
    hello("世界", _Out).

% The following might give a different result, depending on locale:
test(hello2, Out == "Hello2 world2\nHello2 world2\nHello2 world2\nHello2 world2\nHello2 world2\n") :-
    hello2(world2, Out).

test(hello3, Out == "Hello3 世界弐\n") :-
    hello3(世界弐, Out).

test(hello4, Out == hello(world)) :-
    hello4(Out).

test(hello5, [Out1, Out2, Out3, Out4] == [abc, 世界, 世界, 世界]) :-
    hello5(Out1, Out2, Out3, Out4).

test(hello6, [Out1, Out2, Out3] == [abc, 世界, 世界]) :-
    hello6(Out1, Out2, Out3).

test(hello7, [Out1, Out2, Out3] == ["abc", "世界", "世界"]) :-
    hello7(Out1, Out2, Out3).

test(hello8, [Out1, Out2, Out3] == [abc(世界, 世界), 世界(世界, abc), 世界(abc, 世界)]) :-
    hello8(Out1, Out2, Out3).

test(call_cpp, Out == "hello(foo)\n") :-
    with_output_to(string(Out), call_cpp(writeln(hello(foo)))).
test(call_cpp, Out == "hello(世界四)\n") :-
    with_output_to(string(Out), call_cpp(writeln(hello(世界四)))).
test(call_cpp, error(existence_error(procedure,unknown_pred/1))) :-
    call_cpp(unknown_pred(hello(世界四))).
test(call_cpp, fail) :-
    call_cpp(atom(hello(foo))).

test(call_cpp, Ex == "no exception") :-
    call_cpp_ex(writeln(hello(世界四)), Ex).
test(call_cpp) :-
    call_cpp_ex(unknown_pred(hello(世界四)), Ex),
    assertion(subsumes_term(error(existence_error(procedure, unknown_pred/1), _), Ex)).

test(call_cpp, Out == "hello(世界四)\n") :-
    with_output_to(string(Out), call_cpp(writeln, hello(世界四))).
test(call_cpp, error(existence_error(procedure,unknown_pred/1))) :-
    call_cpp(unknown_pred, hello(世界四)).
test(call_cpp, fail) :-
    call_cpp(atom, hello(foo)).

test(as_string, S == "foo") :-
    atom_to_string(foo, S).
test(as_string, S == "foo(bar)") :-
    term_to_string(foo(bar), S).

% Note: atom_to_string/2 and term_to_string/2 translate the data
% to a UTF-8 string.  We currenly do not support encoding for
% PlTerm.unify_string(), so we get as result the byte encoding
% of the UTF8 data.
test(as_string, S == "ä¸\u0096ç\u0095\u008Cå\u009B\u009B") :-
    atom_to_string(世界四, S).
test(as_string, S == "hello(ä¸\u0096ç\u0095\u008Cå\u009B\u009B)") :-
    term_to_string(hello(世界四), S).

test(add_3, Result == 666) :-
    add(667, -1, Result).
test(add_3, Result == 123) :-
    add(100, 23, Result).
test(add_3_err, error(type_error(integer,0.1))) :-
    add(666, 0.1, _).

test(add_num_3, Result == 666) :-
    add_num(555, 111, Result).
test(add_num_3, Result == 666.6) :-
    add_num(555.2, 111.4, Result).
test(add_num_3, error(type_error(float,"abc"))) :-
    add_num(123, "abc", _Result).

testing:p(1).  % For average/3 test
testing:p(10).
testing:p(20).

test(average_3, Average =:= Expected) :-
    average(X, testing:p(X), Average),
    Expected is (1+10+20)/3 .
test(average_3, Average =:= Expected) :-
    average(X, between(1,6,X), Average),
    aggregate(sum(X)/count, between(1,6,X), A),
    Expected is A.

call_cut_test :-
    setup_call_cleanup(true,
		       between(1, 5, _X),
		       atom_codes(_,_)).

test(call_cut, error(existence_error(procedure,call_cut_test/0))) :-
    % This tests that an error in ~PlQuery() is handled properly
    % See discussion: https://github.com/SWI-Prolog/packages-cpp/pull/27
    call_cut("call_cut_test").

test(term_1a, Term == hello(world)) :-
    term1(Term).
test(term_1b, Term == 世界(world)) :-
    term2(Term).
test(term_1c, Term == hello(世界)) :-
    term3(Term).

test(term_2a, Result == 'hello world') :-
    term1(atom, Result).
test(term_2b, Result == "hello world") :-
    term1(string, Result).
test(term_2c, Result == [104,101,108,108,111,32,119,111,114,108,100]) :-
    term1(code_list, Result).
test(term_2d, Result == [h,e,l,l,o,' ',w,o,r,l,d]) :-
    term1(char_list, Result).
test(term_2e, Result == hello(world)) :-
    term1(term, Result).
test(term_2f, error(domain_error(type,foo))) :-
    term1(foo, _Result).

test(term_2h, Result == 世界) :-
    term2(atom, Result).
test(term_2h, Result == "世界") :-
    term2(string, Result).
test(term_2i, Result == hello(世界)) :-
    term2(term, Result).
test(term_2j, error(domain_error(type,foo))) :-
    term2(foo, _Result).

test(can_unify, [true(X\==Y)]) :-
    can_unify(f(X), f(Y)).
test(can_unify) :-
    can_unify(a(X), a(1)),
    assertion(var(X)).
test(can_unify, fail) :-
    can_unify(a(1), a(2)).

test(can_unify_ffi, [true(X\==Y)]) :-
    can_unify_ffi(f(X), f(Y)).
test(can_unify_ffi) :-
    can_unify_ffi(a(X), a(1)),
    assertion(var(X)).
test(can_unify_ffi, fail) :-
    can_unify_ffi(a(1), a(2)).

test(call_chars, Out=="1") :-
    with_output_to(string(Out), call_chars("X=1, write(X)")).
test(call_chars, Out=="1") :-
    with_output_to(string(Out), call_chars('X=1, write(X)')).
test(call_chars, fail) :-
    call_chars("1=2").
test(call_chars, error(syntax_error(operator_expected),string("1(2 . ",0))) :-
    call_chars("1(2").

% Note: unify_error has additional tests for eq1/2
test(eq1_2, X == a) :-
    eq1(foo(X), foo(a)).
test(eq1_2, fail) :-
    eq1(foo(_X), bar(a)).

test(make_integer_2, X == 123) :-
    make_uint64(123, X).
test(make_integer) :-
    X = 666,
    Y = 666,
    make_uint64(X, 666),
    make_uint64(666, 666),
    make_uint64(X, Y).
test(make_integer_2, fail) :-
    make_uint64(123, 124).

:- if(current_prolog_flag(bounded,false)).
test(make_uint64_2, error(representation_error(uint64_t))) :-
    Val is 0xffffffffffffffff + 999, % uses extended integers
    make_uint64(Val, _Y).
:- endif.

test(make_uint64_2, error(domain_error(not_less_than_zero,-1))) :-
    make_uint64(-1, _Y).

test(make_int64_2, X == 123) :-
    make_int64(123, X).
test(make_int64_2) :-
    X = 666,
    Y = 666,
    make_int64(X, 666),
    make_int64(666, 666),
    make_int64(X, Y).
test(make_int64_2, fail) :-
    make_int64(123, 124).
test(make_int64_2, error(type_error(integer,abc))) :-
    make_int64(abc, _Y).

:- if(current_prolog_flag(bounded,false)).
test(make_int64_2, error(representation_error(int64_t))) :-
    Val is 0xffffffffffffffff + 999, % uses extended integers
    make_int64(Val, _Y).
:- endif.

test(make_int64_2, Y == -1) :-
    make_int64(-1, Y).

test(hostname, [Host == Host2]) :-
    hostname(Host),
    hostname2(Host2).

test(cappend, Result == [a,b,c,d,e]) :-
    cappend([a,b,c], [d,e], Result).
test(cappend) :-
    cappend([a,b,c], [d,e], [a,b,c,d,e]).
test(cappend, fail) :-
    cappend([a,b,c], [d,e], [a,b,c,d]).
test(cappend, fail) :-
    cappend([a,b,c], [d,e], [a,b,c,d,e,f]).
test(cappend, fail) :-
    cappend([a,b,c], [d,e], [a,b,c,d,e|f]).

%% TODO: add more tests of cpp_call/2
test(cpp_call, Out == "abc\n") :-
    with_output_to(string(Out),
		   cpp_call(writeln(abc), [normal])).

cpp_call(Goal, Flags) :-
    query_flags(Flags, CombinedFlag),
    cpp_call_(Goal, CombinedFlag, false).

test(cpp_atom_codes, Out == [102,111,111]) :-
    cpp_atom_codes(foo, Out).
test(cpp_atom_codes, Out == [49,50,51]) :-
    cpp_atom_codes(123, Out).
test(cpp_atom_codes, error(type_error(atom,a(f)))) :-
    cpp_atom_codes(a(f), _Out).

test(square_roots_2, Result == [0.0, 1.0, 1.4142135623730951, 1.7320508075688772, 2.0]) :-
    square_roots(4, Result).

:- meta_predicate with_small_stacks(+, 0).
with_small_stacks(Free, Goal) :-
    force_gc,
    statistics(globalused, G),
    statistics(trailused, T),
    statistics(localused, L),
    NewLimit is G+L+T+Free,
    setup_call_cleanup(
	push_prolog_flag(stack_limit, NewLimit),
	Goal,
	pop_prolog_flag(stack_limit)).

test(square_roots_2, error(resource_error(stack))) :-
    with_small_stacks(5 000 000, % 400 000 seems to be about the smallest allowed value
		      square_roots(1000000000, _)).

test(malloc) :-
    malloc_new(1000, Result), % smoke test
    free_delete(Result).

test(malloc) :-
    malloc_malloc(1000, Result), % smoke test
    free_malloc(Result).

test(malloc) :-
    malloc_PL_malloc(1000, Result), % smoke test
    free_PL_malloc(Result).

:- if(\+ current_prolog_flag(asan, true)).
too_big_alloc_request(Request) :-
    current_prolog_flag(address_bits, Bits),
    (   Bits == 32
    ->  Request = 0xffffffff
    ;   Bits == 64
    ->  Request = 0xffffffffffffffff
	%         0x10000000000 is ASAN maximum on 64-bit machines
    ;   assertion(memberchk(Bits, [32,64]))
    ).

%!  cpp_memory_resource_error(+Error) is semidet.
%
%   True when Error is the formal term of a Prolog exception that
%   resulted from a failing memory allocation in C++ (e.g. an
%   over-sized `new`).  The expected error is resource_error(memory).
%
%   On macOS, a foreign extension built with GCC links libstdc++, yet
%   the process also loads the system libc++/libc++abi (dragged in by
%   the system frameworks).  As `operator new` is a coalesced weak
%   symbol it resolves to libc++, so `new` throws a libc++
%   std::bad_alloc whose type_info differs from the libstdc++ one named
%   in PREDICATE_CATCH's `catch(const std::bad_alloc&)`.  That handler
%   therefore misses and the exception is reported by the `catch(...)`
%   backstop as unknown_error(_) instead.  We accept either form.

cpp_memory_resource_error(resource_error(memory)).
cpp_memory_resource_error(unknown_error(_)).

:- if(current_prolog_flag(bounded,false)).

too_many_bits_alloc_request(Request) :-
    % This assumes size_t is no more than 64 bits:
    current_prolog_flag(address_bits, Bits),
    (   Bits == 32
    ->  Request is 0xffffffff + 1
    ;   Bits == 64
    ->  Request is 0xffffffffffffffff + 1
    ;   assertion(memberchk(Bits, [32,64]))
    ).

:- endif.

test(malloc) :-
    too_big_alloc_request(Request),
    catch(malloc_new(Request, _Result), error(E,_), true),
    assertion(cpp_memory_resource_error(E)).

:- if(current_prolog_flag(bounded,false)).

test(malloc) :-
    too_many_bits_alloc_request(Request),
    catch( ( malloc_new(Request, Result),
	     free_delete(Result)
	   ),
	   error(E,_), true),
    assertion(memberchk(E, [representation_error(_), % representation_error(uint64_t)
			    type_error(integer,_)])).


:- endif.

% ASAN has maximum 0x10000000000
%   see ASAN_OPTIONS=allocator_may_return_null=1:soft_rss_limit_mb=...:hard_rss_limit_mb=...
% https://github.com/google/sanitizers/issues/295
% https://github.com/google/sanitizers/issues/740

test(new_chars_2) :-
    too_big_alloc_request(Request),
    catch(( new_chars(Request, Result),
	    delete_chars(Result)
	  ), error(E,_), true),
    assertion(cpp_memory_resource_error(E)).

:- if(current_prolog_flag(bounded,false)).

test(new_chars_2) :-
    too_many_bits_alloc_request(Request),
    catch( ( new_chars(Request, Result),
	     delete_chars(Result)
	   ),
	   error(E,_), true),
    assertion(memberchk(E, [representation_error(_),
			    type_error(integer,_)])).

:- endif.
:- endif.

test(new_chars_2) :-
    new_chars(1000, Result), % smoke test
    delete_chars(Result).

test(name_arity, Out == "name = foo, arity = 2\n") :-
    with_output_to(string(Out),
                   name_arity(foo(bar,zot))).

test(name_arity, Out == "name = foo, arity = 2\n") :-
    name_arity(foo(bar,zot), Out).

test(name_arity) :-
    name_arity(foo(bar,zot), Name, Arity),
    assertion(Name == foo),
    assertion(Arity == 2).

test(name_arity) :-
    name_arity_bool(foo(bar,zot), Name, Arity),
    assertion(Name == foo),
    assertion(Arity == 2).
test(name_arity, error(type_error(compound,"foo"))) :-
    name_arity("foo", _, _).
test(name_arity, fail) :-
    name_arity_bool("bar", _, _).

test(list_modules_0) :-
    list_modules(Text),
    split_string(Text, "\n", "", Strings),
    forall(( member(S, Strings), S \== ""),
	   ( atom_string(M, S),
	     current_module(M))).

test(my_object, Contents == "foo-bar") :-
    make_my_object(MyObject),
    my_object_contents(MyObject, Contents),
    free_my_object(MyObject).

test(make_functor_3, F == foo(x)) :-
    make_functor(foo, x, F).
test(make_functor_3, error(type_error(atom,123))) :-
    make_functor(123, x, _).
test(make_functor_3) :-
    make_functor(bar, 123, bar(123)).
test(make_functor_3, fail) :-
    make_functor(bar, 123, bar(666)).
test(make_functor_3, fail) :-
    make_functor(bar, 123, qqsv(123)).
test(make_functor_3, Z==6.66) :-
    make_functor(bbb, Z, F),
    F = bbb(6.66).

test(cpp_arg, A == bar) :-
    cpp_arg(1, foo(bar,zot), A).
test(cpp_arg, A == zot) :-
    cpp_arg(2, foo(bar,zot), A).
test(cpp_arg, error(domain_error(arity,3))) :-
    cpp_arg(3, foo(bar,zot), _A).
test(cpp_arg, error(domain_error(not_less_than_zero,0))) :-
    cpp_arg(0, foo(bar,zot), _A).
test(cpp_arg, error(domain_error(not_less_than_zero,-2))) :-
    cpp_arg(-2, foo(bar,zot), _A).
test(cpp_arg, error(type_error(compound,foo))) :-
    cpp_arg(1, foo, _A).

% The following are for verifying some documentation details, and for
% ensuring that various mechanisms for reporting failure and
% exceptions behave as expected.

test(c_PL_unify_nil, X == []) :-
    c_PL_unify_nil(X).
test(c_PL_unify_nil) :-
    c_PL_unify_nil([]).
test(c_PL_unify_nil, fail) :-
    c_PL_unify_nil(abc).

test(c_PL_unify_nil_ex, X == []) :-
    c_PL_unify_nil_ex(X).
test(c_PL_unify_nil_ex) :-
    c_PL_unify_nil_ex([]).
test(c_PL_unify_nil_ex, error(type_error(list,abc))) :-
    c_PL_unify_nil_ex(abc).

test(check_c_PL_unify_nil, X == []) :-
    check_c_PL_unify_nil(X).
test(check_c_PL_unify_nil) :-
    check_c_PL_unify_nil([]).
% The following error is subject to change:
test(check_c_PL_unify_nil, error(unknown_error('False return code without exception'))) :-
    check_c_PL_unify_nil(abc).

test(check_c_PL_unify_nil_ex, X == []) :-
    check_c_PL_unify_nil_ex(X).
test(check_c_PL_unify_nil_ex) :-
    check_c_PL_unify_nil_ex([]).
test(check_c_PL_unify_nil_ex, error(type_error(list,abc))) :-
    check_c_PL_unify_nil_ex(abc).

test(cpp_unify_nil, X == []) :-
    cpp_unify_nil(X).
test(cpp_unify_nil) :-
    cpp_unify_nil([]).
test(cpp_unify_nil, fail) :-
    cpp_unify_nil(abc).

test(cpp_unify_nil_ex, X == []) :-
    cpp_unify_nil_ex(X).
test(cpp_unify_nil_ex) :-
    cpp_unify_nil_ex([]).
test(cpp_unify_nil_ex, error(type_error(list,abc))) :-
    cpp_unify_nil_ex(abc).

% The following are for verifying that an exception in
% PL_occurs_term() is handled properly - exceptions such as
% out-of-stack should behave the same way, if they don't result in a
% fatal error. The same set of tests are repeated for eq1/2, eq2/2,
% eq3/2.

test(unify_error, [ setup(( current_prolog_flag(occurs_check, OCF),
				set_prolog_flag(occurs_check, error) )),
		    cleanup(    set_prolog_flag(occurs_check, OCF) ),
		    error(occurs_check(B,f(B))) ]) :-
    eq1(X, f(X)).

test(unify_error, [ setup(( current_prolog_flag(occurs_check, OCF),
				set_prolog_flag(occurs_check, true) )),
		    cleanup(    set_prolog_flag(occurs_check, OCF) ),
		    fail]) :-
    eq1(X, f(X)).

test(unify_error, [ setup(( prolog_flag(occurs_check, OCF),
			       set_prolog_flag(occurs_check, false) )),
		    cleanup(   set_prolog_flag(occurs_check, OCF) ),
		    true]) :-
    eq1(X, f(X)).

% Repeat the unify_error test, using eq2/2:

test(unify_error, [ setup(( current_prolog_flag(occurs_check, OCF),
				set_prolog_flag(occurs_check, error) )),
		    cleanup(    set_prolog_flag(occurs_check, OCF) ),
		    error(occurs_check(B,f(B))) ]) :-
    eq2(X, f(X)).

test(unify_error, [ setup(( current_prolog_flag(occurs_check, OCF),
				set_prolog_flag(occurs_check, true) )),
		    cleanup(    set_prolog_flag(occurs_check, OCF) ),
		    fail]) :-
    eq2(X, f(X)).

test(unify_error, [ setup(( prolog_flag(occurs_check, OCF),
			       set_prolog_flag(occurs_check, false) )),
		    cleanup(   set_prolog_flag(occurs_check, OCF) ),
		    true]) :-
    eq2(X, f(X)).

% Repeat the unify_error test, using eq3/2:

test(unify_error, [ setup(( current_prolog_flag(occurs_check, OCF),
				set_prolog_flag(occurs_check, error) )),
		    cleanup(    set_prolog_flag(occurs_check, OCF) ),
		    error(occurs_check(B,f(B))) ]) :-
    eq3(X, f(X)).

test(unify_error, [ setup(( current_prolog_flag(occurs_check, OCF),
				set_prolog_flag(occurs_check, true) )),
		    cleanup(    set_prolog_flag(occurs_check, OCF) ),
		    fail]) :-
    eq3(X, f(X)).

test(unify_error, [ setup(( prolog_flag(occurs_check, OCF),
			       set_prolog_flag(occurs_check, false) )),
		    cleanup(   set_prolog_flag(occurs_check, OCF) ),
		    true]) :-
    eq3(X, f(X)).

% TODO: Add tests for as_string(enc), such as enc=EncLatin1 and atom is non-ascii
%       ... for PlTerm::as_string() where term isn't an atom


% Tests from test_ffi.pl, for functions translated from ffi4pl.c:

test(range_cpp, all(X == [1,2])) :-
    range_cpp(1, 3, X).
test(range_cpp, all(X == [-2,-1,0,1,2])) :-
    range_cpp(-2, 3, X).
test(range_cpp, all(X == [0])) :-
    range_cpp(0, 1, X).
test(range_cpp, all(X == [10])) :-
    range_cpp(10, 11, X).
test(range_cpp, all(X == [-2])) :-
    range_cpp(-2, -1, X).
test(range_cpp, fail) :-
    range_cpp(1, 1, _X).
test(range_cpp, fail) :-
    range_cpp(0, 0, _X).
test(range_cpp, fail) :-
    range_cpp(-1, -1, _X).
test(range_cpp, fail) :-
    range_cpp(1, 2, 2).
test(range_cpp, X == 1) :- % Will produce warning if non-deterministic
    range_cpp(1, 2, X).
test(range_cpp, error(type_error(integer,a))) :-
    range_cpp(a, 10, _).
test(range_cpp, error(type_error(integer,foo))) :-
    range_cpp(1, foo, _).

% TODO: not finished -- use nb_set and friends to preserve
%       first 2 results
range_2(From, To, Result) :-
    (   range_cpp(From, To, _),
        fail
    *-> true
    ;   range_cpp(From, To, Result)
    ).


% This is test wchar_1 in test_ffi.pl:
test(wchar_1, all(Result == ["//0", "/ /1",
			     "/abC/3",
			     "/Hello World!/12",
			     "/хелло/5",
			     "/хелло 世界/8",
			     "/網目錦へび [àmímé níshíkíhéꜜbì]/26"])) :-
    (   w_atom_cpp('',             Result)
    ;   w_atom_cpp(' ',            Result)
    ;   w_atom_cpp('abC',          Result)
    ;   w_atom_cpp('Hello World!', Result)
    ;   w_atom_cpp('хелло',        Result)
    ;   w_atom_cpp('хелло 世界',   Result)
    ;   w_atom_cpp('網目錦へび [àmímé níshíkíhéꜜbì]', Result)
    ).

% TODO: decouple this test from message hooks
%       ('$messages':message_to_string/2 or print_message/'$write_on_string'/2):
test(type_error_string) :-
    type_error_string('foo-bar', _S, T),
    assertion(unifiable(T, error(type_error(foofoo,'foo-bar'),A), [A=B])),
    % TODO: when PlException::string_term() is revived (using '$messages':message_to_string/2),
    %       add the following assertion:
    % assertion(S == "Type error: `foofoo' expected, found `'foo-bar'' (an atom)"])
    assertion(var(A)),
    assertion(var(B)),
    assertion(A\==B).

:- if(\+ current_prolog_flag(asan, true)).

% TODO: a better test that name_to_terms("two", X, "deux") cleans up `X`
test(name_to_terms, [T1,T2] = [1,"eins"]) :-
    name_to_terms("one", T1, T2).
test(name_to_terms, [T1,T2] = [2,"zwei"]) :-
    name_to_terms("two", T1, T2).
test(name_to_terms, fail) :-
    name_to_terms("foo", _, _).
test(name_to_terms, fail) :-
    name_to_terms("two", _, "deux").
test(name_to_terms, error(type_error('atom or string',A))) :-
     name_to_terms(A, 1, 2).

test(name_to_terms2, [T1,T2] = [1,"eins"]) :-
    name_to_terms2("one", T1, T2).
test(name_to_terms2, [T1,T2] = [2,"zwei"]) :-
    name_to_terms2("two", T1, T2).
test(name_to_terms2, fail) :-
    name_to_terms2("foo", _, _).
test(name_to_terms2, fail) :-
    name_to_terms2("two", _, "deux").

% test(int_info) causes a memory leak because the IntInfo map doesn't
% destruct the elements on cleanup. (At least, I think that's the
% cause of the memory leak.)

test(int_info) :-
    findall(Name:Info, int_info(Name, Info), Infos),
    assertion(memberchk(uint32_t:int_info(uint32_t,4,0,4294967295), Infos)).
test(int_info, [nondet, Name:Info == uint32_t:int_info(uint32_t,4,0,4294967295)]) :-
    Info = int_info(_,_,0,_),
    int_info(Name, Info),
    Info = int_info(uint32_t,_,_,_).
test(int_info) :-
    Info = int_info(_,_,0,_),
    findall(Name:Info, int_info(Name, Info), Infos),
    assertion(memberchk(uint16_t:int_info(uint16_t,2,0,65535), Infos)).
test(int_info) :-
    Info = int_info(_,_,-128,_), % skip over first result: int_info(bool,1,0,1)
    int_info(_Name, Info),
    !.
test(int_info) :-
    int_info(_Name, Info),
    Info = int_info(_,_,-128,_), % force backtracking
    !.

test(int_info2) :-
    findall(Name:Info, int_info2(Name, Info), Infos),
    assertion(memberchk(uint32_t:int_info(uint32_t,4,0,4294967295), Infos)).
test(int_info2, [nondet, Name:Info == uint32_t:int_info(uint32_t,4,0,4294967295)]) :-
    Info = int_info(_,_,0,_),
    int_info2(Name, Info),
    Info = int_info(uint32_t,_,_,_).
test(int_info2) :-
    Info = int_info(_,_,0,_),
    findall(Name:Info, int_info2(Name, Info), Infos),
    assertion(memberchk(uint16_t:int_info(uint16_t,2,0,65535), Infos)).
test(int_info2) :-
    Info = int_info(_,_,-128,_), % skip over first result: int_info(bool,1,0,1)
    int_info2(_Name, Info),
    !.
test(int_info2) :-
    int_info2(_Name, Info),
    Info = int_info(_,_,-128,_), % force backtracking
    !.

:- endif.

% int_info_cut test checks that PL_PRUNED works as expected:
test(int_info_cut, Name:Info == bool:int_info(bool, 1, 0, 1)) :-
    int_info(Name, Info), !.

test(cvt_i_bool, R == 1) :- cvt_i_bool(true, R).
test(cvt_i_bool, R == 1) :- cvt_i_bool(on, R).
test(cvt_i_bool, R == 1) :- cvt_i_bool(1, R).
test(cvt_i_bool, error(type_error(bool,666))) :- cvt_i_bool(666, _R).
test(cvt_i_bool, error(type_error(bool,-666))) :- cvt_i_bool(-666, _R).
:- if(current_prolog_flag(bounded,false)).
test(cvt_i_bool, error(type_error(bool,18446744073709552614))) :-
    Val is 0xffffffffffffffff + 999, % uses extended integers
    cvt_i_bool(Val, _R).
:- endif.
test(cvt_i_bool, R == 0) :- cvt_i_bool(false, R).
test(cvt_i_bool, R == 0) :- cvt_i_bool(off, R).
test(cvt_i_bool, R == 0) :- cvt_i_bool(0, R).
test(cvt_i_bool, error(type_error(bool,'FALSE')))  :- cvt_i_bool('FALSE', _R).
test(cvt_i_bool, error(type_error(bool,0.0)))      :- cvt_i_bool(0.0, _R).
test(cvt_i_bool, error(type_error(bool,"false")))  :- cvt_i_bool("false", _R).

test(scan_options, [R =@= options(1, 5, foo(bar), _, "")]) :- % Note use of (=@=)/2 because of uninstantiated variable
    cpp_options([quoted(true), length(5), callback(foo(bar))], false, R).
test(scan_options, [R == options(1, 5, foo(bar), qqsv, "DESCR")]) :-
    cpp_options([token(qqsv), descr("DESCR"), quoted(true), length(5), callback(foo(bar))], false, R).
test(scan_options, [R == options(1, 5, foo(bar), qqsv, "DESCR")]) :-
    cpp_options([token(qqsv), descr("DESCR"), quoted(true), length(5), callback(foo(bar)), unknown_option(blah)], false, R).
test(scan_options, [error(domain_error(cpp_options,unknown_option(blah)))]) :-
    cpp_options([token(qqsv), descr("DESCR"), quoted(true), length(5), callback(foo(bar)), unknown_option(blah)], true, _).
test(scan_options, [R == options(1, 5, foo(bar), qqsv, "DESCR")]) :-
    cpp_options(options{token:qqsv, descr:"DESCR", quoted:true, length:5, callback:foo(bar)}, false, R).
test(scan_options, [R == options(1, 5, foo(bar), qqsv, "DESCR")]) :-
    cpp_options([token(qqsv), descr("DESCR"), quoted, length(5), callback(foo(bar))], false, R).
test(scan_options, [R == options(0, 5, foo(bar), qqsv, "DESCR")]) :-
    cpp_options([token(qqsv), descr("DESCR"), length(5), callback(foo(bar))], false, R).
test(scan_options, [error(instantiation_error)]) :-
    cpp_options([token(qqsv), _, descr("DESCR"), length(5), callback(foo(bar))], false, _).
test(scan_options, [error(type_error(option,123))]) :- % TODO: is this intended behavior?
    cpp_options([token(qqsv), descr("DESCR"), 123, length(5), callback(foo(bar))], false, _R).
test(scan_options, [error(type_error(option,123))]) :- % TODO: is this intended behavior?
    cpp_options([token(qqsv), 123, descr("DESCR"), length(5), callback(foo(bar))], false, _R).
test(scan_options, [error(domain_error(cpp_options,unknown_option:blah))]) :-
    cpp_options(options{token:qqsv, descr:"DESCR", quoted:true, length:5, callback:foo(bar), unknown_option:blah}, true, _).

test(error_term, error(domain_error(footype,qqsv("ABC")),context(throw_domain_cpp0/1,_Msg))) :-
    throw_domain_cpp0(qqsv("ABC")).

test(error_term, [error(domain_error(footype,qqsv("ABC")),_)]) :-
    throw_domain_cpp1(qqsv("ABC")).

test(error_term, error(domain_error(footype,qqsv("ABC")),context(throw_domain_cpp2/1,_Msg))) :-
    throw_domain_cpp2(qqsv("ABC")).

test(error_term, error(domain_error(footype,qqsv("ABC")),context(throw_domain_cpp3/1,_Msg))) :-
    throw_domain_cpp3(qqsv("ABC")).

test(error_term, [error(domain_error(footype,qqsv("ABC")),_)]) :-
    throw_domain_cpp4(qqsv("ABC")).

test(throw, error(uninstantiation_error(abc),_)) :-
    throw_uninstantiation_error_cpp(abc).

test(throw, error(representation_error(some_resource))) :-
    throw_representation_error_cpp(some_resource).

test(throw, error(type_error(int, "abc"))) :-
    throw_type_error_cpp(int, "abc").

test(throw, error(type_error(float, abc))) :-
    throw_and_check_error_cpp(float, abc).

test(throw, error(domain_error(positive, -5))) :-
    throw_domain_error_cpp(positive, -5).

test(throw, error(existence_error(something_something, foo:bar/2))) :-
    throw_existence_error_cpp(something_something, foo:bar/2).

test(throw, error(permission_error(operation, type, the(culprit)))) :-
    throw_permission_error_cpp(operation, type, the(culprit)).

test(throw, error(resource_error('NO_RESOURCE'))) :-
    throw_resource_error_cpp('NO_RESOURCE').

test(compare) :-
    eq_int64(1, 1).
test(compare, fail) :-
    eq_int64(1, 2).
test(compare, error(type_error(integer,a))) :-
    eq_int64(1, a).
test(compare, error(type_error(integer,b))) :-
    eq_int64(b, 1).
test(compare) :-
    lt_int64(1, 2).
test(compare, fail) :-
    lt_int64(2, 1).
test(compare, error(type_error(integer,a))) :-
    lt_int64(1, a).
test(compare, error(type_error(integer,b))) :-
    lt_int64(b, 1).

test(get_atom, A == abc) :-
    get_atom_ex(abc, A).
test(get_atom) :-
    get_atom_ex(abc, abc).
test(get_atom, fail) :-
    get_atom_ex(abc, abcd).
test(get_atom, error(type_error(atom,"abc"))) :-
    get_atom_ex("abc", _A).
test(get_atom, error(type_error(atom,123))) :-
    get_atom_ex(123, _A).
test(get_atom, error(type_error(atom,foo(bar)))) :-
    get_atom_ex(foo(bar), _A).

test(ten,
     [[A1, A2, A3, A4, A5, A6, A7, A8, A9, A10] ==
      [one, two, three, 4, 5.0, "six", seven("SEVEN"), [], true, [hd]]]) :-
    ten(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10).

test(blob) :-
    create_my_blob(foo, Blob),
    assertion(blob(Blob, my_blob)),
    close_my_blob(Blob).
test(blob, error(my_blob_open_error(_),_)) :-
    create_my_blob('-FAIL_open-', _).
test(blob, error(my_blob_close_error(Blob))) :-
    create_my_blob('-FAIL_close-', Blob),
    assertion(blob(Blob, my_blob)),
    close_my_blob(Blob).
test(blob) :-
    create_my_blob('foo', A),
    with_output_to(string(Astr), write(current_output, A)),
    assertion(string_concat("<my_blob>(", _, Astr)), % The pointer part is implementation-defined
    assertion(\+ blob_released(A)),
    free_blob(A),
    assertion(blob_released(A)),
    % A released blob does not reach its own write(): that would
    % dereference the object that is gone.  It prints as
    % <Type>(freed), using the registered blob type name.
    with_output_to(string(Astr_freed), write(current_output, A)),
    assertion(Astr_freed == "<my_blob>(freed)"),
    assertion(blob(A, my_blob)).

% The following attempts to test the handling of close errors in the
% "release" callback, which calls ~MyBlob. It doesn't throw an error
% (because it can't) but does output an error message.
% You can run this test by hand:
%    ?- create_fail_close_blob.
%    ?- force_gc.
% and that should print:
%    Close MyBlob failed: FAIL_close
test(blob, [blocked(cant_throw_error),
            error(e),
            setup(force_gc(GC_thread)),
            cleanup(restore_gc(GC_thread))]) :-
    create_fail_close_blob,
    garbage_collect,
    garbage_collect_atoms.
test(blob, blocked('throws std::runtime_error')) :-
    create_my_blob('-FAIL_connection-', _Blob).
test(blob, error(my_blob_open_error(_))) :-
    create_my_blob('-FAIL_open-', _Blob).
test(blob, error(my_blob_fail_new(_))) :-
    create_my_blob('-FAIL_new-', _Blob).
test(blob, fail) :-
    create_my_blob('-FAIL_compare-1', Blob1),
    create_my_blob('-Fail_compare-2', Blob2),
    Blob1 = Blob2.
test(blob, error(my_blob_write_error(_))) :-
    create_my_blob('-FAIL_write-', Blob),
    with_output_to(string(_), write(current_output, Blob)).

create_fail_close_blob :-
    create_my_blob('-FAIL_close-', Blob),
    assertion(blob(Blob, my_blob)).

test(blob, cleanup(close_my_blob(A))) :-
    create_my_blob('foobar', A),
    with_output_to(string(Astr), write(current_output, A)),
    assertion(my_blob_string(Astr, _, _)).

test(blob_compare1, [cleanup((close_my_blob(A),
                             close_my_blob(B)))]) :-
    force_gc,
    create_my_blob('A', A),
    create_my_blob('B', B),
    sort([A,B], Sorted),
    predsort(compare_write_form, [A,B], Sorted2),
    assertion(Sorted == Sorted2).
test(blob_compare2, [cleanup((close_my_blob(A),
                              close_my_blob(B)))]) :-
    % Create in the opposite order from the previous test,
    % because the addresses ought to be in ascending order.
    force_gc,
    create_my_blob('B', B),
    create_my_blob('A', A),
    % The blobs are repeated here, to verify that the equality check
    % is done by Prolog and never gets to my_data::compare_fields(),
    % which has an assertion check.
    sort([B,A,B,A], Sorted),
    predsort(compare_write_form, [B,A,B,A], Sorted2),
    assertion(Sorted == Sorted2).
test(blob_compare3, [cleanup((close_my_blob(A1),
                              close_my_blob(A2),
                              close_my_blob(B)))]) :-
    force_gc,
    create_my_blob('A', A1),
    create_my_blob('A', A2),
    create_my_blob('B', B),
    sort([A2,A1,B], Sorted),
    predsort(compare_write_form, [A1,A2,B], Sorted2),
    assertion(Sorted == Sorted2).
test(blob_compare4, [cleanup((close_my_blob(A1),
                              close_my_blob(A2),
                              close_my_blob(B)))
                    ]) :-
    % Different ordering of creation, so that address order changes
    force_gc,
    create_my_blob('B', B),
    create_my_blob('A', A2),
    create_my_blob('A', A1),
    sort([A2,A1,B], Sorted),
    predsort(compare_write_form, [A2,A1,B], Sorted2),
    assertion(Sorted == Sorted2).

test(blob_portray, S == "MyBlob(Connection(name=foo))") :-
    create_my_blob(foo, B),
    with_output_to(string(S), print(B)),
    close_my_blob(B).
test(blob_portray, S == "MyBlob(closed)") :-
    create_my_blob(foo, B),
    close_my_blob(B),
    with_output_to(string(S), print(B)).

expected_file_name_cpp_test_home(ShortPath, AbsPathOS) :-
    absolute_file_name(cpp_test_home(ShortPath), AbsPath0),
    prolog_to_os_filename(AbsPath0, AbsPathOS).

expected_file_name_cpp_test_home_string(ShortPath, AbsPathOS) :-
    expected_file_name_cpp_test_home(ShortPath, AbsPathOS0),
    atom_string(AbsPathOS0, AbsPathOS).

test(file_blob, Read == "% -*- mode: Prolog; coding: utf-8 -*-\n\n") :-
    my_file_open(File, cpp_test_home('test_cpp.pl'), 'r', [search,absolute,ospath]),
    print(File), nl,
    absolute_file_name(cpp_test_home('test_cpp.pl'), Abs, [access(read)]),
    expected_file_name_cpp_test_home('test_cpp.pl', AbsPathOS_atom),
    assertion(prolog_to_os_filename(Abs, AbsPathOS_atom)),
    my_file_filename_atom(File, Filename),
    assertion(Filename == Abs),
    my_file_read(File, 39, Read),
    my_file_close(File).
% TODO: the following uses uninstantiated F, so explicit catch/3 is done
% test(file_blob, error(existence_error(my_file_blob_open,F))) :-
%     expected_file_name_cpp_test_home('non-existent-file', F0),
%     atom_string(F0, F),
%     my_file_open(_File, cpp_test_home('non-existent-file'), 'r', [search,absolute,ospath]).
test(file_blob, error((existence_error(my_file_blob_open,PlF)))) :-
    expected_file_name_cpp_test_home_string('non-existent-file', F),
    prolog_to_os_filename(PlF, F),
    my_file_open(_File, cpp_test_home('non-existent-file'), 'r', [search,absolute,ospath]).
test(file_blob, error(existence_error(source_sink,cpp_test_home('non-existent-file')))) :-
    my_file_open(_File, cpp_test_home('non-existent-file'), 'r', [search,absolute,ospath,read]).
test(file_blob, error(existence_error(source_sink,cpp_test_home('non-existent-file')))) :-
    absolute_file_name(cpp_test_home('non-existent-file'), _Abs, [access(read)]).

test(option_flags, error(domain_error('MyFileBlob-options',foo))) :-
    my_file_open(_File, cpp_test_home('test_cpp.pl'), 'r', [foo,search,absolute,ospath,read]).
test(option_flags, error(type_error('atom or string',access(read)))) :-
    my_file_open(_File, cpp_test_home('test_cpp.pl'), 'r', [search,absolute,ospath,access(read)]).

test(nchars_flags, F-S == 0x43f-"xinteger,all") :-
    nchars_flags([xinteger,all,atomic,number], F),
    nchars_flags_string(F, S).
test(nchars_flags, F-S == 0x37-"all") :-
    nchars_flags([all,atomic,number], F),
    nchars_flags_string(F, S).
test(nchars_flags, F-S == 0x7ff-"xinteger,all,variable,write,write_canonical,writeq") :-
    nchars_flags([atom,string,integer,list,rational,float,variable,number,atomic,write,write_canonical,writeq,all,xinteger], F),
    nchars_flags_string(F, S).
test(nchars_flags, F-S == 0x37-"all") :-
    nchars_flags([atomic,list], F),
    nchars_flags_string(F, S).
test(nchars_flags, F-S == 0x33-"atomic") :-
    nchars_flags([number,atom,string], F),
    nchars_flags_string(F, S).

test(nchars, S-FS-FS2 == "123"-"atomic"-"atomic") :-
    nchars_flags([atomic], F),
    nchars_flags_string(F, FS),
    get_nchars_string(123, F, S, FS2).
test(nchars, S-F == "123"-"atomic") :-
    get_nchars_string(123, [atomic], S, F).
test(nchars, error(type_error(string,f(a)))) :-
    get_nchars_string(f(a), [atomic], _, _).
test(nchars, S-F == "+(a,b)"-"all,write_canonical") :-
    get_nchars_string(a+b, [write_canonical,all], S, F).

% The flags to PlTerm::as_string are [all,writeq].
% TODO: try more flag combinations

test(nchars, [S-F == "a b"-"all,writeq"]) :-
    get_nchars_string('a b', [all,writeq], S, F).
test(nchars, [S-F == "a b"-"all,writeq"]) :-
    get_nchars_string("a b", [all,writeq], S, F).
test(nchars, [S-F == "'a b'"-"writeq"]) :-
    get_nchars_string('a b', [writeq], S, F).
test(nchars, [S-F == "\"a b\""-"writeq"]) :-
    get_nchars_string("a b", [writeq], S, F).
test(nchars, S-F == "f('a b')"-"all,writeq") :-
    get_nchars_string(f('a b'), [all,writeq], S, F).
test(nchars, S-F == "f(\"a b\")"-"all,writeq") :-
    get_nchars_string(f("a b"), [all,writeq], S, F).
test(nchars, S-F == "f(A,_,b,A)"-"writeq") :-
    get_nchars_string(f(X,_,b,X), [writeq], S, F).

test(nchars, S-F == "an atom"-"atom") :-
    get_nchars_string('an atom', [atom], S, F).
test(nchars, S-F == "a string"-"string") :-
    get_nchars_string("a string", [string], S, F).
test(nchars, S-F == "abc"-"list") :-
    get_nchars_string([a,b,c], [list], S, F).
test(nchars, S-F == "abcd"-"list") :-
    get_nchars_string([0'a,0'b,0'c,0'd], [list], S, F).
test(nchars, S-F == "10r3"-"rational") :-
    get_nchars_string(20r6, [rational], S, F).
test(nchars, S-F == "ar3"-"xinteger,rational") :-
    get_nchars_string(20r6, [xinteger,rational], S, F).
test(nchars, S-F == "14"-"xinteger,rational") :-
    get_nchars_string(20, [xinteger,rational], S, F).
test(nchars, S-F == "14"-"xinteger") :-
    get_nchars_string(20, [xinteger], S, F).
test(nchars, S-F == "0.25"-"xinteger,float") :-
    get_nchars_string(0.25, [xinteger,float], S, F).

% TODO: the type_error always shows atom - but making it more accurate
%       would be more work than it's worth.
test(nchars, error(type_error(atom,0.25))) :-
    get_nchars_string(0.25, [xinteger], _S, _F).

test(lookup_unify, N == 1) :-
    lookup_unify(item(one, N)).
test(lookup_unify, S == three) :-
    lookup_unify(item(S, 3)).
test(lookup_unify, fail) :-
    lookup_unify(xxx).

test(#, S == "abc") :-
    #(abc, S).
test(#, S == "foo(abc)") :-
    #(foo(abc), S).

compare_write_form(Compare, A, B) :-
    with_output_to(string(Astr), write(A)),
    with_output_to(string(Bstr), write(B)),
    my_blob_string(Astr, APtr, AName),
    my_blob_string(Bstr, BPtr, BName),
    compare(Compare, AName-APtr, BName-BPtr).

my_blob_string(String, Ptr, Name) :-
    atom_codes(String, Codes),
    phrase(my_blob(Ptr, Name), Codes).

my_blob(Ptr, Name) -->
    "<my_blob>(",
    optional("0x", []),
    xinteger(Ptr),
    ",Connection(name=",
    string(NameS),
    "))",
    !,
    { atom_codes(Name, NameS) }.

force_gc :-
    force_gc(GC_thread),
    restore_gc(GC_thread).

force_gc(GC_thread) :-
    current_prolog_flag(gc_thread, GC_thread),
    set_prolog_gc_thread(false),
    garbage_collect,
    garbage_collect_atoms.

restore_gc(GC_thread) :-
    set_prolog_gc_thread(GC_thread).


% TODO:
% test this (https://swi-prolog.discourse.group/t/cpp2-exceptions/6040/61):
%
% Now call this from C(++). The first PL_next_solution() says TRUE,
% but the cleanup is not executed. Now close the query. That runs the
% cleanup handler and should raise error. If the goal in the
% setup_call_cleanup/3 completed (fail, exception, deterministic
% true), the cleanup handler has done its work before control gets
% back to Prolog and thus PL_next_solution() already generates the
% exception.

test_setup_call_cleanup(X) :-
    setup_call_cleanup(
        true,
        between(1, 5, X),
        throw(error)).

% Experimental API tests
:- if((current_prolog_flag(version,V),V>=90308)).
% Scoped terms depend on a working PL_free_term_ref()
% implementation.  9.2.6 and up only provide a dummy.
test(plterm_scoped, R == []) :-
    unify_atom_list([], R).
test(plterm_scoped, R == [a, foo]) :-
    unify_atom_list(["a", foo], R).
test(plterm_scoped, error(type_error(list,foo))) :-
    unify_atom_list(foo, _).

test(plterm_scoped, R == []) :-
    unify_atom_list_c([], R).
test(plterm_scoped, R == [a, foo]) :-
    unify_atom_list_c(["a", foo], R).
test(plterm_scoped, error(type_error(list,foo))) :-
    unify_atom_list_c(foo, _).

test(plterm_scoped, [blocked('crashes in PL_free_term_ref')]) :-
    term_release.
:- endif.

test(record_ext, P == foo(bar,1,"a\0bc",'xy\0')) :-
    record_ext(foo(bar,1,"a\0bc", 'xy\0'), Str),
    record_ext(P, Str).
test(record_ext, P == foo(bar,1,"a\0bc世界",'\0xy\0')) :-
    record_ext2(foo(bar,1,"a\0bc世界", '\0xy\0'), Str),
    record_ext2(P, Str).

:- end_tests(cpp).

:- begin_tests(cpp_atommap).

test(atom_atom_map) :-
    atom_atom_add(foo, foo_value),
    atom_atom_add(bar, bar_value),
    atom_atom_add(bar, bar_value), % OK to add identical enntry
    catch(atom_atom_add(foo, foo_value2),
          error(permission_error(add,atom_atom,foo),_),
          Exc = true),
    assertion(Exc == true),
    atom_atom_find(foo, F),
    assertion(F == foo_value),
    assertion(\+ atom_atom_find(foox, _)),
    atom_atom_erase(foo),
    assertion(\+ atom_atom_find(foo, _)),
    atom_atom_erase(non_existent_key),
    atom_atom_erase(bar),
    atom_atom_size(Size),
    assertion(Size == 0).

test(atom_term_map) :-
    % This test uses different keys from the other atom_term_map test.
    % If it succeeds, it will have erased all the entries that were
    % inserted.
    atom_term_insert(foo, "foo_value"),
    atom_term_insert(bar, bar_value),
    atom_term_insert(bar, bar_value), % OK to add identical enntry
    catch(atom_term_insert(foo, foo_value2),
          error(permission_error(insert,atom_term,foo),_),
          Exc = true),
    assertion(Exc == true),
    atom_term_find(foo, F),
    assertion(F == "foo_value"),
    assertion(\+ atom_term_find(foox, _)),
    atom_term_erase(foo),
    assertion(\+ atom_term_find(foo, _)),
    atom_term_erase(non_existent_key),
    atom_term_erase(bar),
    atom_atom_size(Size),
    assertion(Size == 0).

test(atom_term_map) :-
    % This test uses different keys from the other atom_term_map test.
    % If it succeeds, it will have erased all the entries that were
    % inserted.
    atom_term_insert(foo2, foo2(value)),
    atom_term_insert(bar2, 123),
    atom_term_find(foo2, F),
    assertion(F == foo2(value)),
    atom_term_find(bar2, B),
    assertion(B == 123),
    assertion(\+ atom_term_find(foo2x, _)),
    atom_term_erase(foo2),
    assertion(\+ atom_term_find(foo2, _)),
    atom_term_erase(non_existent_key),
    atom_term_erase(bar2),
    atom_atom_size(Size),
    assertion(Size == 0).

:- end_tests(cpp_atommap).

:- begin_tests(cpp_map_str_str).

test(map, KVs == ["b"-"two","c"-"three"]) :-
    create_map_str_str(Map),
    insert_or_assign_map_str_str(Map, "a", "one"),
    insert_or_assign_map_str_str(Map, "c", "three"),
    insert_or_assign_map_str_str(Map, "b", "two"),
    find_map_str_str(Map, "a", One),
    assertion(One == "one"),
    assertion(find_map_str_str(Map, "a", "one")),
    erase_if_present_map_str_str(Map, "a"),
    erase_if_present_map_str_str(Map, "axx"),
    assertion(\+ find_map_str_str(Map, "a", _)),
    findall(K-V, enum_map_str_str(Map, "", K, V), KVs).

test(map, KVs = ["ab"-"two","ac"-"three"]) :-
    create_map_str_str(Map),
    maplist(insert_or_assign_map_str_str(Map), ["ab","ac","d"], ["two","three","four"]),
    findall(K-V, enum_map_str_str(Map, "a", K, V), KVs).

test(map) :-
    create_map_str_str(Map),
    maplist(insert_or_assign_map_str_str(Map), ["ab","ac","d"], ["two","three","four"]),
    enum_map_str_str(Map, "", K, V),
    !, % cut after PL_FIRST_CALL
    assertion(K == "ab"),
    assertion(V == "two"),
    enum_map_str_str(Map, "", K, V). % verify lookup with ground args, no choicepoint
test(map, [nondet, K-V == "ab"-"two"]) :-
    create_map_str_str(Map),
    maplist(insert_or_assign_map_str_str(Map), ["ab","ac","d"], ["two","three","four"]),
    enum_map_str_str(Map, "", K, V),
    enum_map_str_str(Map, "", K, V). % verify lookup with ground args, no choicepoint
test(map, K-V == "ac"-"three") :-
    create_map_str_str(Map),
    maplist(insert_or_assign_map_str_str(Map), ["ab","ac","d"], ["two","three","four"]),
    enum_map_str_str(Map, "", K, V),
    K \= "ab",
    !, % cut after PL_REDO
    assertion(K == "ac"),
    assertion(V == "three"),
    enum_map_str_str(Map, "", K, V). % verify lookup with ground args, no choicepoint
test(map) :-
    create_map_str_str(Map),
    maplist(insert_or_assign_map_str_str(Map), ["ab","ac","d"], ["two","three","four"]),
    enum_map_str_str(Map, "", K, V),
    K \= "ab",
    K \= "ac",
    !, % cut after deterministic return
    assertion(K == "d"),
    assertion(V == "four"),
    enum_map_str_str(Map, "", K, V). % verify lookup with ground args, no choicepoint
test(map, Ks == ["ab", "x"]) :-
    create_map_str_str(Map),
    maplist(insert_or_assign_map_str_str(Map), ["ab","ac","d","x"], ["two","three","four","two"]),
    findall(K, enum_map_str_str(Map, "", K, "two"), Ks).
test(map, Ks == ["ab"]) :-
    create_map_str_str(Map),
    maplist(insert_or_assign_map_str_str(Map), ["ab","ac","d","x"], ["two","three","four","two"]),
    findall(K, enum_map_str_str(Map, "a", K, "two"), Ks).

:- end_tests(cpp_map_str_str).

w_atom_cpp(Atom, String) :-
    with_output_to(string(String), w_atom_cpp_(current_output, Atom)).

%!  query_flag(?Name, ?Bit)
%
%   Flags for  PL_open_query().  Check  with SWI-Prolog.h.   Same code
%   appears   in  test_ffi.pl.    This  is   duplicated  to   simplify
%   installation of these tests in the binary version.
%
%   This code is mainly for debugging.

query_flag(debug,		I) => I =  0x0001.
query_flag(normal,		I) => I =  0x0002.
query_flag(nodebug,		I) => I =  0x0004.
query_flag(catch_exception,	I) => I =  0x0008.
query_flag(pass_exception,	I) => I =  0x0010.
query_flag(allow_yield,		I) => I =  0x0020.
query_flag(ext_status,		I) => I =  0x0040.
query_flag(deterministic,	I) => I =  0x0100.
% and pseudo-flags (see XX_Q_* flags in test_ffi.c):
query_flag(clear_return_true,   I) => I = 0x01000.
query_flag(close_query,         I) => I = 0x02000.
query_flag(exc_term,            I) => I = 0x04000.

% This should give the same result as PlQuery::verify()
check_query_flag(Flags) :-
    query_flag(normal, F1),
    query_flag(catch_exception, F2),
    query_flag(pass_exception, F3),
    Mask is F1 \/ F2 \/ F3,
    Bits is popcount(Flags /\ Mask),
    (   Bits =< 1
    ->  true
    ;   domain_error(query_flags, Flags)
    ).

query_flags(Flags, CombinedFlag) :-
    maplist(query_flag, Flags, Ints),
    aggregate_all(sum(I), member(I, Ints), CombinedFlag),
    check_query_flag(CombinedFlag).

end_of_file.