mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-16 18:03:36 +00:00
Code Issues Projects Releases Wiki Activity
Files
b357a3dadcdf29c8d8ca184d65f7634a1a94de36
mercury/tests/hard_coded/construct_test.m
Zoltan Somogyi c3cce83f0a Fix grammar in comment.
2019-08-20 18:48:46 +10:00

422 lines
14 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%---------------------------------------------------------------------------%
%
% Test case for construct, num_functors, type_of and get_functor.
%
% Original author: trd
%
:- module construct_test.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module list.
:- import_module int.
:- import_module univ.
:- import_module maybe.
:- import_module term.
:- import_module map.
:- import_module string.
:- import_module require.
:- import_module construct.
:- import_module type_desc.
:- type enum
---> one
; two
; three.
:- type fruit
---> apple(apple_list :: list(int))
; banana(banana_list :: 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, poly3_field2 :: A, poly(B, A))
; poly_four(A, B).
:- type no_tag
---> qwerty(qwerty_field :: int).
:- type dummy
---> dummy.
:- type unboxed_arg
---> no
; unboxed_arg(unboxed_struct).
:- type unboxed_struct
---> unboxed_struct(int, int).
:- type exist_type
---> some [T] xyzzy(f21name :: T).
% By using nine non-constant functors, we are forcing packed_8
% and packed_9 to share a primary tag even on 64 bit systems.
% packed_1 tests the secondary tag absent case in the construct predicate,
% while and packed_8 tests the secondary tag present case.
:- type packed(T)
---> packed_1(int8, uint8, dummy, dummy, int8, uint8, T)
; some [U] packed_2(dummy, U, int8, uint8, dummy, int8, uint8)
; packed_3(int)
; packed_4(int)
; packed_5(int)
; packed_6(int)
; packed_7(int)
; packed_8(T, dummy, int8, uint8, dummy, dummy, int8, uint8,
float, int)
; some [U] packed_9(T, dummy, U, int8, uint8, dummy, int8, uint8).
%---------------------------------------------------------------------------%
main(!IO) :-
io.write_string("------- TESTING TYPE DESCRIPTIONS -------\n", !IO),
describe_functors_in_du_types(!IO),
describe_functors_in_polymorphic_types(!IO),
describe_functors_in_builtin_types(!IO),
describe_functors_in_other_types(!IO),
io.write_string("\n------- TESTING CONSTRUCTION OF TERMS -------\n", !IO),
test_construction(!IO).
%---------------------------------------------------------------------------%
:- pred describe_functors_in_du_types(io::di, io::uo) is det.
describe_functors_in_du_types(!IO) :-
io.write_string("\nTESTING DISCRIMINATED UNIONS\n", !IO),
% Test enumerations.
describe_all_functors_of_type(two, !IO),
describe_all_functors_of_type(one, !IO),
describe_all_functors_of_type(three, !IO),
% Test simple tags.
describe_all_functors_of_type(apple([9, 5, 1]), !IO),
describe_all_functors_of_type(banana([three, one, two]), !IO),
% Test complicated tags.
describe_all_functors_of_type(zop(3.3, 2.03), !IO),
describe_all_functors_of_type(zip(3, 2), !IO),
describe_all_functors_of_type(zap(3, -2.111), !IO),
% Test complicated constants.
describe_all_functors_of_type(wombat, !IO),
describe_all_functors_of_type(foo, !IO).
:- pred describe_functors_in_polymorphic_types(io::di, io::uo) is det.
describe_functors_in_polymorphic_types(!IO) :-
io.write_string("\nTESTING POLYMORPHISM\n", !IO),
describe_all_functors_of_type(poly_three(3.33, 4, poly_one(9.11)), !IO),
describe_all_functors_of_type(poly_two(3) : poly(dummy, int), !IO),
describe_all_functors_of_type(poly_one([2399.3]) :
poly(list(float), dummy), !IO).
:- pred describe_functors_in_builtin_types(io::di, io::uo) is det.
describe_functors_in_builtin_types(!IO) :-
io.write_string("\nTESTING BUILTINS\n", !IO),
% Test strings.
describe_all_functors_of_type("", !IO),
describe_all_functors_of_type("Hello, world\n", !IO),
describe_all_functors_of_type("Foo%sFoo", !IO),
describe_all_functors_of_type("""", !IO),
% Test characters.
describe_all_functors_of_type('a', !IO),
describe_all_functors_of_type('&', !IO),
% Test floats.
describe_all_functors_of_type(3.14159, !IO),
describe_all_functors_of_type(11.28324983E-22, !IO),
describe_all_functors_of_type(22.3954899E22, !IO),
% Test integers.
describe_all_functors_of_type(-65, !IO),
describe_all_functors_of_type(4, !IO),
% Test unsigned integers.
describe_all_functors_of_type(42u, !IO),
% Test fixed size integers.
describe_all_functors_of_type(42i8, !IO),
describe_all_functors_of_type(42u8, !IO),
describe_all_functors_of_type(42i16, !IO),
describe_all_functors_of_type(42u16, !IO),
describe_all_functors_of_type(42i32, !IO),
describe_all_functors_of_type(42u32, !IO),
describe_all_functors_of_type(42i64, !IO),
describe_all_functors_of_type(42u64, !IO),
% Test univ.
% type_to_univ(["hi! I'm a univ!"], Univ),
% describe_all_functors_of_type(Univ, !IO),
% Test predicates.
describe_all_functors_of_type(newline, !IO),
% Test tuples.
describe_all_functors_of_type({1, "a", 'a', {4, 'd'}}, !IO),
% Test lists.
describe_all_functors_of_type([1, 2, 3, 4], !IO).
:- pred describe_functors_in_other_types(io::di, io::uo) is det.
describe_functors_in_other_types(!IO) :-
io.write_string("\nTESTING OTHER TYPES\n", !IO),
term.init_var_supply(VarSupply : var_supply(int)),
term.create_var(Var, VarSupply, NewVarSupply),
describe_all_functors_of_type(Var, !IO),
describe_all_functors_of_type(VarSupply, !IO),
describe_all_functors_of_type(NewVarSupply, !IO),
% Presently, at least, map is an equivalence and an abstract type.
% Note: testing abstract types is always going to have results
% that are dependent on the implementation. If someone changes
% the implementation, the results of this test can change.
map.init(Map : map(int, int)),
describe_all_functors_of_type(Map, !IO),
% A no tag type.
describe_all_functors_of_type(qwerty(4), !IO),
% A dummy type.
describe_all_functors_of_type(dummy, !IO),
% A functor with a single unboxed argument.
describe_all_functors_of_type(unboxed_arg(unboxed_struct(12, 34)), !IO),
% An existential type.
ExistVal = 'new xyzzy'(8),
describe_all_functors_of_type(ExistVal, !IO).
%---------------------------------------------------------------------------%
:- pred describe_all_functors_of_type(T::in, io::di, io::uo) is det.
describe_all_functors_of_type(T, !IO) :-
io.nl(!IO),
TypeInfo = type_desc.type_of(T),
( if NumFunctors = construct.num_functors(TypeInfo) then
io.format("#functors in this type = %d\n", [i(NumFunctors)], !IO),
describe_functors_of_type_loop(TypeInfo, 0, NumFunctors, !IO)
else
io.format("#functors in this type = %d\n", [i(0)], !IO)
).
:- pred describe_functors_of_type_loop(type_desc.type_desc::in,
int::in, int::in, io::di, io::uo) is det.
describe_functors_of_type_loop(TypeInfo, Cur, NumFunctors, !IO) :-
( if Cur >= NumFunctors then
true
else
describe_nth_functor_of_type(TypeInfo, Cur, !IO),
describe_functors_of_type_loop(TypeInfo, Cur + 1, NumFunctors, !IO)
).
:- pred describe_nth_functor_of_type(type_desc.type_desc::in, int::in,
io::di, io::uo) is det.
describe_nth_functor_of_type(TypeInfo, N, !IO) :-
( if
% Ordinal = construct.get_functor_ordinal(TypeInfo, N),
% Lex = construct.get_functor_lex(TypeInfo, Ordinal),
Lex = construct.get_functor_lex(TypeInfo, N),
Ordinal = construct.get_functor_ordinal(TypeInfo, Lex),
construct.get_functor_with_names(TypeInfo, Lex,
FunctorName, FunctorArity, _ArgTypesList, ArgMaybeNames)
then
( if N = Ordinal then
ArgNames = list.map(name_or_underscore, ArgMaybeNames),
ArgNamesDesc = join_list(", ", ArgNames),
FunctorNA = string.format("%s/%d",
[s(FunctorName), i(FunctorArity)]),
io.format("%2d - %-14s lex: %2d [%s]\n",
[i(N), s(FunctorNA), i(Lex), s(ArgNamesDesc)], !IO)
else
io.format("N (%d) != Ordinal (%d)\n", [i(N), i(Ordinal)], !IO)
)
else
io.format("%d failed\n", [i(N)], !IO)
).
:- func name_or_underscore(maybe(string)) = string.
name_or_underscore(MaybeName) = Str :-
(
MaybeName = yes(Name),
Str = Name
;
MaybeName = no,
Str = "_"
).
%---------------------------------------------------------------------------%
:- pred newline(io::di, io::uo) is det.
newline(!IO) :-
io.nl( !IO).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred test_construction(io::di, io::uo) is det.
test_construction(!IO) :-
% Valid tests.
% Enumerations:
test_construct(type_desc.type_of(one),
"three", [], !IO),
type_to_univ([1, 2, 3], NumList),
test_construct(type_desc.type_of(apple([])),
"apple", [NumList], !IO),
type_to_univ([one, two, three], EnumList),
test_construct(type_desc.type_of(apple([])),
"banana", [EnumList], !IO),
% Discriminated union:
% (Simple, complicated and complicated constant tags).
type_to_univ(1, One),
type_to_univ(2.1, TwoPointOne),
test_construct(type_desc.type_of(wombat),
"foo", [], !IO),
test_construct(type_desc.type_of(wombat),
"bar", [One], !IO),
test_construct(type_desc.type_of(wombat),
"bar", [One, One], !IO),
test_construct(type_desc.type_of(wombat),
"qux", [One], !IO),
test_construct(type_desc.type_of(wombat),
"quux", [One], !IO),
test_construct(type_desc.type_of(wombat),
"quuux", [One, One], !IO),
test_construct(type_desc.type_of(wombat),
"wombat", [], !IO),
test_construct(type_desc.type_of(wombat),
"zoom", [One], !IO),
test_construct(type_desc.type_of(wombat),
"zap", [One, TwoPointOne], !IO),
test_construct(type_desc.type_of(wombat),
"zip", [One, One], !IO),
test_construct(type_desc.type_of(wombat),
"zop", [TwoPointOne, TwoPointOne], !IO),
% No-tag type.
test_construct(type_desc.type_of(qwerty(7)),
"qwerty", [One], !IO),
% Functor with single unboxed argument.
type_to_univ(unboxed_struct(12, 34), UnboxedStruct),
test_construct(type_desc.type_of(_ : unboxed_arg),
"unboxed_arg", [UnboxedStruct], !IO),
type_to_univ("goodbye", Bye),
test_construct(type_desc.type_of(poly_four(3, "hello")),
"poly_one", [One], !IO),
test_construct(type_desc.type_of(poly_four(3, "hello")),
"poly_two", [Bye], !IO),
test_construct(type_desc.type_of(poly_four(3, "hello")),
"poly_four", [One, Bye], !IO),
test_construct(type_desc.type_of({1, "two", '3'}),
"{}", [univ(4), univ("five"), univ('6')], !IO),
io.nl(!IO),
io.write_string("About to construct a tuple\n", !IO),
Tuple = construct.construct_tuple([NumList, EnumList, One, TwoPointOne]),
io.write(Tuple, !IO),
io.nl(!IO),
Packed =
type_desc.type_of(packed_1(0i8, 0u8, dummy, dummy, 0i8, 0u8, "")),
test_construct(Packed, "packed_1",
[univ(-11i8), univ(11u8), univ(dummy), univ(dummy),
univ(-127i8), univ(255u8), univ("abc")], !IO),
% We cannot yet construct terms with existentially typed arguments.
% test_construct(Packed, "packed_2",
% [univ(dummy), univ(-11i8), univ(-11i8), univ(11u8), univ(dummy),
% univ(-127i8), univ(255u8)], !IO),
test_construct(Packed, "packed_8",
[univ("def"), univ(dummy), univ(-11i8), univ(11u8),
univ(dummy), univ(dummy), univ(-127i8), univ(255u8),
univ(1234.567), univ(42)], !IO).
% We cannot yet construct terms with existentially typed arguments.
% test_construct(Packed, "packed_9",
% [univ("def"), univ(dummy), univ(1234.56), univ(-25i8), univ(140u8),
% univ(dummy), univ(-127i8), univ(255u8)], !IO).
:- pred test_construct(type_desc.type_desc::in, string::in,
list(univ)::in, io::di, io::uo) is det.
test_construct(TypeInfo, FunctorName, Args, !IO) :-
io.nl(!IO),
list.length(Args, Arity),
find_functor(TypeInfo, FunctorName, Arity, FunctorNumber),
io.format("About to construct %s/%d\n", [s(FunctorName), i(Arity)], !IO),
( if Constructed = construct.construct(TypeInfo, FunctorNumber, Args) then
io.print(Constructed, !IO),
io.nl(!IO)
else
io.write_string("Construction failed.\n", !IO)
).
:- pred find_functor(type_desc.type_desc::in, string::in, int::in, int::out)
is det.
find_functor(TypeInfo, Functor, Arity, FunctorNumber) :-
( if N = construct.num_functors(TypeInfo) then
find_functor_loop(TypeInfo, Functor, Arity, N, FunctorNumber)
else
error("unable to find number of functors")
).
:- pred find_functor_loop(type_desc.type_desc::in, string::in, int::in,
int::in, int::out) is det.
find_functor_loop(TypeInfo, Functor, Arity, Num, FunctorNumber) :-
( if Num < 0 then
error("unable to find functor")
else
( if construct.get_functor(TypeInfo, Num, Functor, Arity, _) then
FunctorNumber = Num
else
find_functor_loop(TypeInfo, Functor, Arity, Num - 1,
FunctorNumber)
)
).
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink