mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-20 20:03:44 +00:00
1f6d83692a
tests/hard_coded/*.m:
Update programming style, unless doing so would change
the meaning of the test, in particular:
- use '.' as a module qualifier in place of '__'
- use {write,print}_line where appropriate
- use if-then-else in place of C -> T ; E
- use state variables in place of DCGs
tests/hard_coded/dir_test.m:
Document what the expected outputs correspond to.
Use a uniform module qualifier in the output.
tests/hard_coded/dir_test.exp*:
Conform to the above change.
154 lines
4.6 KiB
Mathematica
154 lines
4.6 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ts=4 sw=4 et ft=mercury
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% This is a regression test (extracted from some code in std_util.m).
|
|
% The MLDS back-end in Mercury 0.10.1 generated incorrect code for this
|
|
% test case. In particular, when the float argument is passed to
|
|
% private_builtin.var(T::unused), it generated code which passed a pointer
|
|
% and then tried to unbox the float value returned, even though no value
|
|
% was actually returned, so it ended up dereferencing an uninitialized pointer.
|
|
|
|
:- module unused_float_box_test.
|
|
:- interface.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module univ.
|
|
|
|
:- pred main(io::di, io::uo) is det.
|
|
|
|
:- type my_functor_tag_info
|
|
---> my_functor_integer(int)
|
|
; my_functor_float(float)
|
|
; my_functor_string(string)
|
|
; my_functor_enum(int)
|
|
; my_functor_local(int, int)
|
|
; my_functor_remote(int, int, list(univ))
|
|
; my_functor_unshared(int, list(univ))
|
|
; my_functor_notag(univ)
|
|
; my_functor_equiv(univ).
|
|
|
|
:- type my_univ
|
|
---> some [T] my_univ_cons(T).
|
|
|
|
:- pred my_get_functor_info(my_univ::in, my_functor_tag_info::out) is semidet.
|
|
|
|
:- implementation.
|
|
:- import_module int.
|
|
|
|
main(!IO) :-
|
|
wipe_stack(200, !IO),
|
|
( if my_get_functor_info('new my_univ_cons'(42.0), R) then
|
|
io.print_line(R, !IO)
|
|
else
|
|
io.print_line("failed", !IO)
|
|
).
|
|
|
|
:- pred wipe_stack(int, io, io).
|
|
|
|
wipe_stack(N, !IO) :-
|
|
( if N =< 0 then
|
|
true
|
|
else
|
|
wipe_stack(N - 1, !IO),
|
|
wipe_stack(N // 10 - 1, !IO)
|
|
).
|
|
|
|
:- pragma no_inline(my_get_functor_info/2).
|
|
my_get_functor_info(Univ, FunctorInfo) :-
|
|
( if my_univ_to_type(Univ, Int) then
|
|
FunctorInfo = my_functor_integer(Int)
|
|
else if my_univ_to_type(Univ, Float) then
|
|
FunctorInfo = my_functor_float(Float)
|
|
else if my_univ_to_type(Univ, String) then
|
|
FunctorInfo = my_functor_string(String)
|
|
else if get_enum_functor_info(Univ, Enum) then
|
|
FunctorInfo = my_functor_enum(Enum)
|
|
else if get_du_functor_info(Univ, Where, Ptag, Sectag, Args) then
|
|
( if Where = 0 then
|
|
FunctorInfo = my_functor_unshared(Ptag, Args)
|
|
else if Where > 0 then
|
|
FunctorInfo = my_functor_remote(Ptag, Sectag, Args)
|
|
else
|
|
FunctorInfo = my_functor_local(Ptag, Sectag)
|
|
)
|
|
else if get_notag_functor_info(Univ, ExpUniv) then
|
|
FunctorInfo = my_functor_notag(ExpUniv)
|
|
else if get_equiv_functor_info(Univ, ExpUniv) then
|
|
FunctorInfo = my_functor_equiv(ExpUniv)
|
|
else
|
|
fail
|
|
).
|
|
|
|
:- pred get_notag_functor_info(Univ::in, ExpUniv::out) is semidet.
|
|
|
|
:- pragma foreign_proc("C",
|
|
get_notag_functor_info(_Univ::in, _ExpUniv::out),
|
|
[will_not_call_mercury, promise_pure], "
|
|
{
|
|
abort();
|
|
}").
|
|
get_notag_functor_info(_, _) :-
|
|
semidet_succeed,
|
|
private_builtin.sorry("local get_notag_functor_info").
|
|
|
|
% from the type stored in the univ.)
|
|
:- pred get_equiv_functor_info(Univ::in, ExpUniv::out) is semidet.
|
|
|
|
:- pragma foreign_proc("C",
|
|
get_equiv_functor_info(_Univ::in, _ExpUniv::out),
|
|
[will_not_call_mercury, promise_pure], "
|
|
{
|
|
abort();
|
|
}").
|
|
get_equiv_functor_info(_, _) :-
|
|
semidet_succeed,
|
|
private_builtin.sorry("local get_equiv_functor_info").
|
|
|
|
:- pred get_enum_functor_info(Univ::in, Int::out) is semidet.
|
|
|
|
:- pragma foreign_proc("C",
|
|
get_enum_functor_info(_Univ::in, _Enum::out),
|
|
[will_not_call_mercury, promise_pure], "
|
|
{
|
|
abort();
|
|
}").
|
|
get_enum_functor_info(_, _) :-
|
|
semidet_succeed,
|
|
private_builtin.sorry("local get_enum_functor_info").
|
|
|
|
:- pred get_du_functor_info(my_univ::in, int::out, int::out, int::out,
|
|
list(univ)::out) is semidet.
|
|
|
|
:- pragma foreign_proc("C", get_du_functor_info(_Univ::in, _Where::out,
|
|
_Ptag::out, _Sectag::out, _Args::out),
|
|
[will_not_call_mercury, promise_pure], "
|
|
{
|
|
abort();
|
|
}").
|
|
get_du_functor_info(_, _, _, _, _) :-
|
|
semidet_succeed,
|
|
private_builtin.sorry("local get_du_functor_info").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred my_type_to_univ(T, my_univ).
|
|
:- pragma promise_pure(my_type_to_univ/2).
|
|
|
|
my_univ_to_type(Univ, X) :-
|
|
my_type_to_univ(X, Univ).
|
|
|
|
my_type_to_univ(T, Univ) :-
|
|
(
|
|
impure private_builtin.var(T),
|
|
Univ = my_univ_cons(T0),
|
|
private_builtin.typed_unify(T0, T)
|
|
;
|
|
impure private_builtin.var(Univ),
|
|
Univ0 = 'new my_univ_cons'(T),
|
|
unsafe_promise_unique(Univ0, Univ)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|