mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
337 lines
10 KiB
Mathematica
337 lines
10 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ts=4 sw=4 et ft=mercury
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Test case for io.write_binary/io.read_binary.
|
|
% (adapted from tests/hard_coded/write.m, which tests io.write).
|
|
|
|
% XXX currently we do not pass the test of "univ"!
|
|
|
|
:- module write_binary.
|
|
:- interface.
|
|
:- import_module io.
|
|
|
|
:- pred main(io::di, io::uo) is cc_multi.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module array.
|
|
:- import_module char.
|
|
:- import_module exception.
|
|
:- import_module int.
|
|
:- import_module io.file.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module require.
|
|
:- import_module std_util.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
:- import_module univ.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type enum
|
|
---> one
|
|
; two
|
|
; three.
|
|
|
|
:- type fruit
|
|
---> apple(list(int))
|
|
; banana(list(enum)).
|
|
|
|
:- type thingie
|
|
---> foo
|
|
; bar(int)
|
|
; bar(int, int)
|
|
; qux(int)
|
|
; quux(int)
|
|
; quuux(int, int)
|
|
; wombat
|
|
; zoom(int)
|
|
; zap(int, float)
|
|
; zip(int, int)
|
|
; zop(float, float).
|
|
|
|
:- type poly(A, B)
|
|
---> poly_one(A)
|
|
; poly_two(B)
|
|
; poly_three(B, A, poly(B, A)).
|
|
|
|
:- type no_tag
|
|
---> qwerty(int).
|
|
|
|
:- type expr
|
|
---> var(string)
|
|
; int(int)
|
|
; expr + expr
|
|
; expr - expr
|
|
; expr * expr
|
|
; (expr, expr)
|
|
; {expr; expr}
|
|
; {{expr}}
|
|
; (type)
|
|
; blah
|
|
; (?-).
|
|
|
|
main(!IO) :-
|
|
test_ops(!IO),
|
|
test_discriminated(!IO),
|
|
test_polymorphism(!IO),
|
|
test_builtins(!IO),
|
|
test_other(!IO).
|
|
|
|
:- pred test_ops(io::di, io::uo) is cc_multi.
|
|
|
|
test_ops(!IO) :-
|
|
io.write_string("TESTING TERMS WITH OPERATORS\n", !IO),
|
|
do_test(var("X") + int(3) * var("X^2") ; (type), !IO),
|
|
do_test(write_binary.{type}, !IO),
|
|
do_test(write_binary.{?-}, !IO),
|
|
do_test((?-), !IO),
|
|
do_test(write_binary.{blah}, !IO),
|
|
do_test((blah ; (type), (type) * blah ; (type)), !IO),
|
|
do_test(((blah ; blah), blah) * blah ; blah, !IO),
|
|
do_test((type) * blah ; (type), !IO).
|
|
|
|
:- pred test_discriminated(io::di, io::uo) is cc_multi.
|
|
|
|
test_discriminated(!IO) :-
|
|
io.write_string("\nTESTING DISCRIMINATED UNIONS\n", !IO),
|
|
|
|
% test enumerations
|
|
do_test(one, !IO),
|
|
do_test(two, !IO),
|
|
do_test(three, !IO),
|
|
|
|
% test simple tags
|
|
do_test(apple([9, 5, 1]), !IO),
|
|
do_test(banana([three, one, two]), !IO),
|
|
|
|
% test complicated tags
|
|
do_test(zop(3.3, 2.03), !IO),
|
|
do_test(zip(3, 2), !IO),
|
|
do_test(zap(3, -2.111), !IO),
|
|
|
|
% test complicated constant
|
|
do_test(wombat, !IO),
|
|
do_test(foo, !IO).
|
|
|
|
:- pred test_polymorphism(io::di, io::uo) is cc_multi.
|
|
|
|
test_polymorphism(!IO) :-
|
|
io.write_string("\nTESTING POLYMORPHISM\n", !IO),
|
|
do_test(poly_one([2399.3]) `with_type` poly(list(float), int), !IO),
|
|
do_test(poly_two(3) `with_type` poly(list(float), int), !IO),
|
|
do_test(poly_three(3.33, 4, poly_one(9.11)), !IO).
|
|
|
|
:- pred test_builtins(io::di, io::uo) is cc_multi.
|
|
|
|
test_builtins(!IO) :-
|
|
io.write_string("\nTESTING BUILTINS\n", !IO),
|
|
|
|
% test strings
|
|
do_test("", !IO),
|
|
do_test("Hello, world\n", !IO),
|
|
do_test("Foo%sFoo", !IO),
|
|
do_test("""", !IO),
|
|
|
|
% test characters
|
|
do_test('a' `with_type` char, !IO),
|
|
do_test('&' `with_type` char, !IO),
|
|
do_test('.' `with_type` char, !IO),
|
|
do_test('%' `with_type` char, !IO),
|
|
do_test(' ' `with_type` char, !IO),
|
|
do_test('\t' `with_type` char, !IO),
|
|
do_test('\n' `with_type` char, !IO),
|
|
do_test(('\\') `with_type` char, !IO),
|
|
do_test('*' `with_type` char, !IO),
|
|
do_test('/' `with_type` char, !IO),
|
|
|
|
% test floats
|
|
do_test(3.14159, !IO),
|
|
do_test(11.28324983E-22, !IO),
|
|
do_test(22.3954899E22, !IO),
|
|
|
|
% test ints
|
|
do_test(-65, !IO),
|
|
do_test(4, !IO),
|
|
|
|
% Test uints.
|
|
do_test(651u, !IO),
|
|
|
|
% Test fixed-size ints.
|
|
do_test(-128i8, !IO),
|
|
do_test(127i8, !IO),
|
|
do_test(255u8, !IO),
|
|
do_test(-32768i16, !IO),
|
|
do_test(32767i16, !IO),
|
|
do_test(65535u16, !IO),
|
|
do_test(-2147483648i32, !IO),
|
|
do_test(2147483647i32, !IO),
|
|
do_test(4294967295u32, !IO),
|
|
|
|
%%% XXX currently we do not pass this test!
|
|
%%% % test univ.
|
|
%%% type_to_univ(["hi! I'm a univ!"], Univ),
|
|
%%% do_test(Univ, !IO),
|
|
|
|
% test predicates
|
|
% io.read_binary doesn't work for higher-order terms,
|
|
% so this test is expected to fail.
|
|
io.write_string("\nthe next test is expected to fail:\n", !IO),
|
|
do_test(do_test `with_type` pred(int, io, io), !IO).
|
|
|
|
:- pred test_other(io::di, io::uo) is cc_multi.
|
|
|
|
test_other(!IO) :-
|
|
io.write_string("\nTESTING OTHER TYPES\n", !IO),
|
|
term.init_var_supply(VarSupply `with_type` var_supply(generic)),
|
|
term.create_var(Var, VarSupply, NewVarSupply),
|
|
do_test(Var, !IO),
|
|
do_test(VarSupply, !IO),
|
|
do_test(NewVarSupply, !IO),
|
|
|
|
% presently, at least, map is an equivalence and
|
|
% an abstract type.
|
|
map.init(Map `with_type` map(int, string)),
|
|
do_test(Map, !IO),
|
|
|
|
% a no tag type
|
|
do_test(qwerty(4), !IO),
|
|
|
|
array.from_list([1, 2, 3, 4], Array),
|
|
do_test(Array, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred do_test(T::in, io::di, io::uo) is cc_multi.
|
|
|
|
do_test(Term, !IO) :-
|
|
io.write_string("\ntest input <", !IO),
|
|
io.print(Term, !IO),
|
|
io.write_string(">\n", !IO),
|
|
io.file.make_temp_file(FileNameRes, !IO),
|
|
(
|
|
FileNameRes = ok(FileName),
|
|
% The code of do_test_2 itself does not throw any exceptions (anymore),
|
|
% but the implementations of io.write_binary and io.read_binary in the
|
|
% Mercury standard library *may* throw exceptions. We catch them here.
|
|
try_io(do_test_2(FileName, Term), TryResult, !IO),
|
|
(
|
|
TryResult = succeeded(MaybeTestErrorMsg),
|
|
(
|
|
MaybeTestErrorMsg = no,
|
|
io.print("test passed\n", !IO)
|
|
;
|
|
MaybeTestErrorMsg = yes(ErrorMsg),
|
|
io.format("test failed with this error:\n%s\n",
|
|
[s(ErrorMsg)], !IO)
|
|
)
|
|
;
|
|
TryResult = exception(Univ),
|
|
io.write_string("test threw this exception:\n", !IO),
|
|
io.print_line(Univ, !IO)
|
|
),
|
|
io.file.remove_file(FileName, _, !IO)
|
|
;
|
|
FileNameRes = error(_IOError),
|
|
ErrorMsg = "cannot create a temp file",
|
|
io.format("test failed with this error:\n%s\n", [s(ErrorMsg)], !IO)
|
|
).
|
|
|
|
:- pred do_test_2(string::in, T::in, maybe(string)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
do_test_2(FileName, Term, MaybeTestErrorMsg, !IO) :-
|
|
io.open_binary_output(FileName, OutputResult, !IO),
|
|
(
|
|
OutputResult = ok(OutputStream),
|
|
io.write_byte(OutputStream, 42, !IO),
|
|
io.write_binary(OutputStream, Term, !IO),
|
|
io.write_byte(OutputStream, 43, !IO),
|
|
io.close_binary_output(OutputStream, !IO),
|
|
io.open_binary_input(FileName, InputResult, !IO),
|
|
(
|
|
InputResult = ok(InputStream),
|
|
io.read_byte(InputStream, Result42, !IO),
|
|
io.read_binary(InputStream, ResultTerm, !IO),
|
|
io.read_byte(InputStream, Result43, !IO),
|
|
io.close_binary_input(InputStream, !IO),
|
|
( if
|
|
Result42 = ok(42),
|
|
ResultTerm = ok(Term),
|
|
Result43 = ok(43)
|
|
then
|
|
MaybeTestErrorMsg = no
|
|
else
|
|
( if
|
|
Result42 = ok(42),
|
|
ResultTerm = ok(Term)
|
|
then
|
|
(
|
|
Result43 = ok(ReadBack43),
|
|
BackStr = string.string(ReadBack43),
|
|
string.format("orig 43, readback <%s>",
|
|
[s(BackStr)], Msg)
|
|
;
|
|
Result43 = error(IOError),
|
|
io.error_message(IOError, IOErrorMsg),
|
|
string.format("orig 43, readback error\n<%s>",
|
|
[s(IOErrorMsg)], Msg)
|
|
;
|
|
Result43 = eof,
|
|
Msg = "orig 43, readback eof"
|
|
)
|
|
else if
|
|
Result42 = ok(42)
|
|
then
|
|
OrigStr = string.string(Term),
|
|
(
|
|
ResultTerm = ok(ReadBackTerm),
|
|
BackStr = string.string(ReadBackTerm),
|
|
string.format("orig %s, readback <%s>",
|
|
[s(OrigStr), s(BackStr)], Msg)
|
|
;
|
|
ResultTerm = error(IOError),
|
|
io.error_message(IOError, IOErrorMsg),
|
|
string.format("orig %s, readback error\n<%s>",
|
|
[s(OrigStr), s(IOErrorMsg)], Msg)
|
|
;
|
|
ResultTerm = eof,
|
|
string.format("orig %s, readback eof",
|
|
[s(OrigStr)], Msg)
|
|
)
|
|
else
|
|
(
|
|
Result42 = ok(ReadBack42),
|
|
BackStr = string.string(ReadBack42),
|
|
string.format("orig 42, readback <%s>",
|
|
[s(BackStr)], Msg)
|
|
;
|
|
Result42 = error(IOError),
|
|
io.error_message(IOError, IOErrorMsg),
|
|
string.format("orig 42, readback error\n<%s>",
|
|
[s(IOErrorMsg)], Msg)
|
|
;
|
|
Result42 = eof,
|
|
Msg = "orig 42, readback eof"
|
|
)
|
|
),
|
|
MaybeTestErrorMsg = yes(Msg)
|
|
)
|
|
;
|
|
InputResult = error(IOError),
|
|
io.error_message(IOError, IOErrorMsg),
|
|
MaybeTestErrorMsg = yes(IOErrorMsg)
|
|
)
|
|
;
|
|
OutputResult = error(IOError),
|
|
io.error_message(IOError, IOErrorMsg),
|
|
MaybeTestErrorMsg = yes(IOErrorMsg)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|