[m-rev.] diff: allow testing of java grade
Peter Wang
novalazy at gmail.com
Fri Aug 14 13:22:45 AEST 2009
Branches: main
Allow testing of java grade. Requires using `mmc --make' for now.
This patch does not attempt to fix test failures.
tests/Mmake.common:
Delete unneeded Java-specific rule, which was broken.
tests/benchmarks/Mmakefile:
tests/general/Mmakefile:
tests/general/string_format/Mmakefile:
tests/grade_subdirs/Mmakefile:
tests/hard_coded/Mmakefile:
tests/recompilation/Mmakefile:
tests/term/Mmakefile:
tests/valid/Mmakefile:
Don't deliberately disable tests in java grade.
tests/*.m:
Add Java foreign code.
Write dummy procedures instead of abusing `:- external'.
diff --git a/tests/Mmake.common b/tests/Mmake.common
index 84f9483..c688265 100644
--- a/tests/Mmake.common
+++ b/tests/Mmake.common
@@ -98,20 +98,10 @@ $(TESTS_DIR)/Mmake.params: ;
# to print out the contents, because that precedes each line of output with
# the filename, which is helpful when running a parallel make.
#
-ifneq "$(findstring java,$(GRADE))" ""
-
-%.out: %.class
- { [ -f $*.inp ] && cat $*.inp; } | $(JAVA) $* > $@ 2>&1 \
- || { grep . $@ /dev/null; exit 1; }
-
-else
-
%.out: %
{ [ -f $*.inp ] && cat $*.inp; } | ./$< > $@ 2>&1 || \
{ grep . $@ /dev/null; exit 1; }
-endif
-
#
# For some test cases, there is more than one valid output.
# We try matching the output with the `.exp' file, and if that
diff --git a/tests/benchmarks/Mmakefile b/tests/benchmarks/Mmakefile
index 7a0641c..dd1b5a8 100644
--- a/tests/benchmarks/Mmakefile
+++ b/tests/benchmarks/Mmakefile
@@ -11,28 +11,19 @@ THIS_DIR = benchmarks
#-----------------------------------------------------------------------------#
-JAVA_PROGS= \
+PROGS= \
cqueens \
crypt \
deriv \
deriv2 \
nrev \
+ poly \
primes \
qsort \
queens \
query \
tak
-# XXX These test cases don't work in Java yet
-NONJAVA_PROGS= \
- poly
-
-ifneq "$(findstring java,$(GRADE))" ""
- PROGS=$(JAVA_PROGS)
-else
- PROGS=$(JAVA_PROGS) $(NONJAVA_PROGS)
-endif
-
TESTS=$(PROGS)
TESTS = $(sort $(PROGS))
SUBDIRS =
diff --git a/tests/general/Mmakefile b/tests/general/Mmakefile
index e4c5e44..852fd59 100644
--- a/tests/general/Mmakefile
+++ b/tests/general/Mmakefile
@@ -81,14 +81,10 @@ EXCEPTION_PROGS = \
# currently fail. The reason for this is that they depend too
# heavily on the mercury library which cannot yet be compiled
# in grade java.
-ifneq "$(findstring java,$(GRADE))" ""
- PROGS0 =
+ifneq "$(findstring profdeep,$(GRADE))" ""
+ PROGS0 = $(ORDINARY_PROGS)
else
- ifneq "$(findstring profdeep,$(GRADE))" ""
- PROGS0 = $(ORDINARY_PROGS)
- else
- PROGS0 = $(ORDINARY_PROGS) $(EXCEPTION_PROGS)
- endif
+ PROGS0 = $(ORDINARY_PROGS) $(EXCEPTION_PROGS)
endif
# On Dec OSF 5.1 the floating point tests of
diff --git a/tests/general/mode_inf_bug.m b/tests/general/mode_inf_bug.m
index bf34a53..72bcff9 100644
--- a/tests/general/mode_inf_bug.m
+++ b/tests/general/mode_inf_bug.m
@@ -71,13 +71,15 @@ map_list_hook(hook_is_a,X) :- is_a(X).
%%% Generate a list of atoms -----------------------------------------
gen_a_list(N,L) :-
- ( N = 0 ->
- L = []
- ;
- L = [a|R],
- N1 = N - 1,
- gen_a_list(N1,R)
- ).
+ gen_a_list(N, [], L).
+
+gen_a_list(N, L0, L) :-
+ ( N = 0 ->
+ L = L0
+ ;
+ N1 = N - 1,
+ gen_a_list(N1, [a | L0], L)
+ ).
%%% Test suite -------------------------------------------------------
diff --git a/tests/general/string_format/Mmakefile b/tests/general/string_format/Mmakefile
index 9620db0..6775a8a 100644
--- a/tests/general/string_format/Mmakefile
+++ b/tests/general/string_format/Mmakefile
@@ -22,12 +22,7 @@ STRING_FORMAT_PROGS= \
ifneq "$(findstring .agc,$(GRADE))" ""
PROGS0=
else
- # We currently don't do any testing in grade java on this directory.
- ifneq "$(findstring java,$(GRADE))" ""
- PROGS0=
- else
- PROGS0=$(STRING_FORMAT_PROGS)
- endif
+ PROGS0=$(STRING_FORMAT_PROGS)
endif
# On solaris 5.{7,8} string_format_o fails because of a buggy
diff --git a/tests/grade_subdirs/Mmakefile b/tests/grade_subdirs/Mmakefile
index 5613a57..d1fea74 100644
--- a/tests/grade_subdirs/Mmakefile
+++ b/tests/grade_subdirs/Mmakefile
@@ -3,18 +3,13 @@
THIS_DIR = grade_subdirs
-# We currently don't do any testing in grade java on this directory.
-ifneq "$(findstring java,$(GRADE))" ""
- PROGS=
+ifndef WORKSPACE
+ PROGS=\
+ hello
else
- ifndef WORKSPACE
- PROGS=\
- hello
- else
- # We can only use a workspace if it was built with
- # `--use-grade-subdirs', which in general it won't be.
- PROGS=
- endif
+ # We can only use a workspace if it was built with
+ # `--use-grade-subdirs', which in general it won't be.
+ PROGS=
endif
# `--use-grade-subdirs' doesn't work with Mmake.
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 3c5270f..fab28dc 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -342,6 +342,7 @@ ifeq "$(filter il% java% erlang%,$(GRADE))" ""
any_free_unify \
solver_build_call \
solver_construction_init_test \
+ solver_default_eq_cmp \
solver_disj_inits \
solver_ite_inits
else
@@ -356,16 +357,16 @@ else
mutable_decl
endif
-# Mutables work properly only in C grades and Erlang grades.
-ifeq "$(filter il% java%,$(GRADE))" ""
+# Mutables don't work in IL grades.
+ifeq "$(filter il%,$(GRADE))" ""
MUTABLE_PROGS = \
float_gv
else
MUTABLE_PROGS =
endif
-# Trace goal with runtime conditions work properly only in C and Erlang grades.
-ifeq "$(filter il% java%,$(GRADE))" ""
+# Trace goal with runtime conditions don't work in IL grades.
+ifeq "$(filter il%,$(GRADE))" ""
TRACE_GOAL_ENV_PROGS = \
trace_goal_env_1 \
trace_goal_env_2 \
@@ -552,7 +553,6 @@ ifeq "$(findstring profdeep,$(GRADE))" ""
mutable_excp \
null_char \
io_globals_deadlock \
- solver_default_eq_cmp \
test_array2d \
test_injection \
tl_backjump_test \
@@ -660,18 +660,14 @@ ifneq "$(findstring apple-darwin,$(FULLARCH))" "apple-darwin"
endif
# We currently test only a limited selection in grade java on this directory.
-ifneq "$(findstring java,$(GRADE))" ""
- PROGS = $(JAVA_PROGS) $(JAVA_PASS_PROGS)
-else
- PROGS = $(ORDINARY_PROGS) $(PROF_PROGS) $(BROKEN_FOR_LCC_PROGS) \
- $(CLOSURE_LAYOUT_PROGS) $(NON_PROFDEEP_PROGS) \
- $(BACKEND_PROGS) $(NONDET_C_PROGS) \
- $(C_AND_GC_ONLY_PROGS) $(STATIC_LINK_PROGS) \
- $(CHAR_REP_PROGS) $(C_ONLY_PROGS) \
- $(DOTNET_PROGS) $(JAVA_PROGS) $(SOLVER_PROGS) \
- $(TRAILED_PROGS) $(MUTABLE_PROGS) $(TRACE_GOAL_ENV_PROGS) \
- $(CTGC_PROGS) $(BIG_DATA_PROGS)
-endif
+PROGS = $(ORDINARY_PROGS) $(PROF_PROGS) $(BROKEN_FOR_LCC_PROGS) \
+ $(CLOSURE_LAYOUT_PROGS) $(NON_PROFDEEP_PROGS) \
+ $(BACKEND_PROGS) $(NONDET_C_PROGS) \
+ $(C_AND_GC_ONLY_PROGS) $(STATIC_LINK_PROGS) \
+ $(CHAR_REP_PROGS) $(C_ONLY_PROGS) \
+ $(DOTNET_PROGS) $(JAVA_PROGS) $(SOLVER_PROGS) \
+ $(TRAILED_PROGS) $(MUTABLE_PROGS) $(TRACE_GOAL_ENV_PROGS) \
+ $(CTGC_PROGS) $(BIG_DATA_PROGS)
#-----------------------------------------------------------------------------#
diff --git a/tests/hard_coded/constraint_order.m b/tests/hard_coded/constraint_order.m
index 84dad9c..7b5a5a0 100644
--- a/tests/hard_coded/constraint_order.m
+++ b/tests/hard_coded/constraint_order.m
@@ -42,6 +42,10 @@ test(3) :- impure puts("call to test").
:- pragma c_code(puts(Str::in), "puts(Str);").
:- pragma foreign_proc("C#", puts(Str::in), [],
"System.Console.WriteLine(Str);").
+:- pragma foreign_proc("Java", puts(Str::in), [],
+"
+ System.out.println(Str);
+").
:- pragma foreign_proc("Erlang", puts(Str::in), [],
"
io:put_chars(Str),
diff --git a/tests/hard_coded/copy_pred_2.m b/tests/hard_coded/copy_pred_2.m
index cd150c6..4230447 100644
--- a/tests/hard_coded/copy_pred_2.m
+++ b/tests/hard_coded/copy_pred_2.m
@@ -34,6 +34,9 @@ make_closure(A, B, foo(A, B)).
:- pragma foreign_proc("C#",
inst_cast(X::in, Y::out(pred(in, out) is det)),
[will_not_call_mercury, thread_safe, promise_pure], "Y = X;").
+:- pragma foreign_proc("Java",
+ inst_cast(X::in, Y::out(pred(in, out) is det)),
+ [will_not_call_mercury, thread_safe, promise_pure], "Y = X;").
:- pragma foreign_proc("Erlang",
inst_cast(X::in, Y::out(pred(in, out) is det)),
[will_not_call_mercury, thread_safe, promise_pure], "Y = X").
diff --git a/tests/hard_coded/dupcall_impurity.m b/tests/hard_coded/dupcall_impurity.m
index ad125c4..be12dd3 100644
--- a/tests/hard_coded/dupcall_impurity.m
+++ b/tests/hard_coded/dupcall_impurity.m
@@ -65,6 +65,29 @@ test2 -->
:- pragma foreign_proc("C#", next_x(X::out), [], "X = my_global++;").
:- pragma foreign_proc("C#", incr_x, [], "my_global++;").
+:- pragma foreign_code("Java", "static int my_global;").
+
+:- pragma foreign_proc("Java",
+ get_x(X::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ X = my_global;
+").
+
+:- pragma foreign_proc("Java",
+ next_x(X::out),
+ [will_not_call_mercury],
+"
+ X = my_global++;
+").
+
+:- pragma foreign_proc("Java",
+ incr_x,
+ [will_not_call_mercury],
+"
+ my_global++;
+").
+
:- pragma foreign_proc("Erlang",
get_x(X::out),
[will_not_call_mercury, promise_semipure],
diff --git a/tests/hard_coded/ee_dummy.m b/tests/hard_coded/ee_dummy.m
index 02e0522..818f3b3 100644
--- a/tests/hard_coded/ee_dummy.m
+++ b/tests/hard_coded/ee_dummy.m
@@ -19,6 +19,9 @@
:- pragma foreign_export_enum("C", dummy_type/0, [prefix("FOO_")]).
:- pragma foreign_export_enum("C", poly_dummy_type/1, [prefix("BAR_")]).
+:- pragma foreign_export_enum("Java", dummy_type/0, [prefix("FOO_")]).
+:- pragma foreign_export_enum("Java", poly_dummy_type/1, [prefix("BAR_")]).
+
main(!IO) :-
check_dummy_type(dummy_type, DummyTypeSucceeded, !IO),
(
@@ -45,6 +48,13 @@ main(!IO) :-
Result = (X == FOO_dummy_type) ? MR_YES : MR_NO;
IO = IO0;
").
+:- pragma foreign_proc("Java",
+ check_dummy_type(X::in, Result::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Result = (X == FOO_dummy_type) ? bool.ML_YES : bool.ML_NO;
+ IO = IO0;
+").
:- pred check_poly_dummy_type(poly_dummy_type(dummy_type)::in, bool::out,
io::di, io::uo) is det.
@@ -55,3 +65,10 @@ main(!IO) :-
Result = (X == BAR_poly_dummy_type) ? MR_YES : MR_NO;
IO = IO0;
").
+:- pragma foreign_proc("Java",
+ check_poly_dummy_type(X::in, Result::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Result = (X == BAR_poly_dummy_type) ? bool.ML_YES : bool.ML_NO;
+ IO = IO0;
+").
diff --git a/tests/hard_coded/ee_valid_test.m b/tests/hard_coded/ee_valid_test.m
index c9bf2a2..5dcf4d6 100644
--- a/tests/hard_coded/ee_valid_test.m
+++ b/tests/hard_coded/ee_valid_test.m
@@ -38,10 +38,12 @@ main(!IO) :-
% Default mapping.
%
:- pragma foreign_export_enum("C", fruit/0).
+:- pragma foreign_export_enum("Java", fruit/0).
% Default mapping with prefix.
%
:- pragma foreign_export_enum("C", fruit/0, [prefix("PREFIX_")]).
+:- pragma foreign_export_enum("Java", fruit/0, [prefix("PREFIX_")]).
% User-specified mapping.
% Also checks that module qualifiers on constructor names are handled.
@@ -54,9 +56,18 @@ main(!IO) :-
ee_valid_test.lemon - "LEMON"
]).
+:- pragma foreign_export_enum("Java", fruit/0, [prefix("USER_")],
+ [
+ ee_valid_test.apple - "APPLE",
+ orange - "ORANGE",
+ ee_valid_test.pear - "PEAR",
+ ee_valid_test.lemon - "LEMON"
+ ]).
+
% Default mapping for quoted Mercury names.
%
:- pragma foreign_export_enum("C", foo/0).
+:- pragma foreign_export_enum("Java", foo/0).
:- func get_default_apple = fruit.
:- pragma foreign_proc("C",
@@ -65,6 +76,12 @@ main(!IO) :-
"
X = apple;
").
+:- pragma foreign_proc("Java",
+ get_default_apple = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = apple;
+").
:- func get_default_orange = fruit.
:- pragma foreign_proc("C",
@@ -73,6 +90,12 @@ main(!IO) :-
"
X = orange;
").
+:- pragma foreign_proc("Java",
+ get_default_orange = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = orange;
+").
:- func get_prefix_pear = fruit.
:- pragma foreign_proc("C",
@@ -81,6 +104,12 @@ main(!IO) :-
"
X = PREFIX_pear;
").
+:- pragma foreign_proc("Java",
+ get_prefix_pear = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = PREFIX_pear;
+").
:- func get_user_lemon = fruit.
:- pragma foreign_proc("C",
@@ -89,6 +118,12 @@ main(!IO) :-
"
X = USER_LEMON;
").
+:- pragma foreign_proc("Java",
+ get_user_lemon = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = USER_LEMON;
+").
:- func get_bar = foo.
:- pragma foreign_proc("C",
@@ -97,3 +132,9 @@ main(!IO) :-
"
X = BAR;
").
+:- pragma foreign_proc("Java",
+ get_bar = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = BAR;
+").
diff --git a/tests/hard_coded/equality_pred_which_requires_boxing.m b/tests/hard_coded/equality_pred_which_requires_boxing.m
index 86f2738..1a3c57e 100644
--- a/tests/hard_coded/equality_pred_which_requires_boxing.m
+++ b/tests/hard_coded/equality_pred_which_requires_boxing.m
@@ -18,6 +18,8 @@
where equality is unify_ft.
:- pragma foreign_type(il, type_which_needs_boxing,
"valuetype [mscorlib]System.Double") where equality is unify_ft.
+:- pragma foreign_type(java, type_which_needs_boxing,
+ "Double") where equality is unify_ft.
:- pragma foreign_type(erlang, type_which_needs_boxing,
"") where equality is unify_ft.
@@ -27,6 +29,8 @@
:- pragma foreign_type(il, type_which_needs_boxing(T),
"valuetype [mscorlib]System.Double")
where equality is unify_ft_T.
+:- pragma foreign_type(java, type_which_needs_boxing(T), "Double")
+ where equality is unify_ft_T.
:- pragma foreign_type(erlang, type_which_needs_boxing(T), "")
where equality is unify_ft_T.
@@ -80,6 +84,9 @@ unify(S, X, Y, !IO) :-
:- pragma foreign_proc("C#", create(X::in) = (Y::out), [promise_pure], "
Y = X;
").
+:- pragma foreign_proc("Java", create(X::in) = (Y::out), [promise_pure], "
+ Y = X;
+").
:- pragma foreign_proc("Erlang", create(X::in) = (Y::out), [promise_pure], "
Y = X
").
@@ -91,6 +98,9 @@ unify(S, X, Y, !IO) :-
:- pragma foreign_proc("C#", create_T(X::in) = (Y::out), [promise_pure], "
Y = X;
").
+:- pragma foreign_proc("Java", create_T(X::in) = (Y::out), [promise_pure], "
+ Y = X;
+").
:- pragma foreign_proc("Erlang", create_T(X::in) = (Y::out), [promise_pure], "
Y = X
").
@@ -103,6 +113,9 @@ unify(S, X, Y, !IO) :-
:- pragma foreign_proc("C#", unify_ft(X::in, Y::in), [promise_pure], "
SUCCESS_INDICATOR = (X == Y);
").
+:- pragma foreign_proc("Java", unify_ft(X::in, Y::in), [promise_pure], "
+ succeeded = X.equals(Y);
+").
:- pragma foreign_proc("Erlang", unify_ft(X::in, Y::in), [promise_pure], "
SUCCESS_INDICATOR = (X =:= Y)
").
@@ -115,6 +128,9 @@ unify(S, X, Y, !IO) :-
:- pragma foreign_proc("C#", unify_ft_T(X::in, Y::in), [promise_pure], "
SUCCESS_INDICATOR = (X == Y);
").
+:- pragma foreign_proc("Java", unify_ft_T(X::in, Y::in), [promise_pure], "
+ succeeded = X.equals(Y);
+").
:- pragma foreign_proc("Erlang", unify_ft_T(X::in, Y::in), [promise_pure], "
SUCCESS_INDICATOR = (X =:= Y)
").
diff --git a/tests/hard_coded/export_test.m b/tests/hard_coded/export_test.m
index 8ab12ad..8f36a6b 100644
--- a/tests/hard_coded/export_test.m
+++ b/tests/hard_coded/export_test.m
@@ -24,6 +24,7 @@ main -->
foo(X, X+1).
:- pragma export(foo(in, out), "foo").
+:- pragma foreign_export("Java", foo(in, out), "foo").
:- pragma c_code(bar(X::in, Y::out), may_call_mercury,
"
@@ -33,6 +34,10 @@ foo(X, X+1).
[may_call_mercury, promise_pure], "
export_test.mercury_code.foo(X, ref Y);
").
+:- pragma foreign_proc("Java", bar(X::in, Y::out),
+ [may_call_mercury, promise_pure], "
+ Y = export_test.foo(X);
+").
:- pragma foreign_proc("Erlang", bar(X::in, Y::out),
[may_call_mercury, promise_pure], "
Y = foo_2_p_0(X)
diff --git a/tests/hard_coded/external_unification_pred.m b/tests/hard_coded/external_unification_pred.m
index e04ced4..8816453 100644
--- a/tests/hard_coded/external_unification_pred.m
+++ b/tests/hard_coded/external_unification_pred.m
@@ -22,6 +22,7 @@
:- pragma foreign_type(c, ft, "int") where equality is unify_ft.
:- pragma foreign_type(il, ft, "valuetype [mscorlib]System.Int32")
where equality is unify_ft.
+ :- pragma foreign_type(java, ft, "Integer") where equality is unify_ft.
:- pragma foreign_type(erlang, ft, "") where equality is unify_ft.
:- pred unify_ft(ft::in, ft::in) is semidet.
@@ -34,6 +35,10 @@
"
SUCCESS_INDICATOR = (X == Y);
").
+ :- pragma foreign_proc("Java", unify_ft(X::in, Y::in), [promise_pure],
+ "
+ succeeded = (X == Y);
+ ").
:- pragma foreign_proc("Erlang", unify_ft(X::in, Y::in), [promise_pure],
"
SUCCESS_INDICATOR = (X =:= Y)
@@ -47,6 +52,10 @@
"
Y = X;
").
+ :- pragma foreign_proc("Java", create_ft(X::in) = (Y::out), [promise_pure],
+ "
+ Y = X;
+ ").
:- pragma foreign_proc("Erlang", create_ft(X::in) = (Y::out), [promise_pure],
"
Y = X
diff --git a/tests/hard_coded/float_gv.m b/tests/hard_coded/float_gv.m
index 37d3b74..42d72bb 100644
--- a/tests/hard_coded/float_gv.m
+++ b/tests/hard_coded/float_gv.m
@@ -19,6 +19,7 @@
:- type coord.
:- pragma foreign_type(c, coord, "coord *").
+:- pragma foreign_type("Java", coord, "Coord").
:- pragma foreign_type("Erlang", coord, "").
:- pragma foreign_decl(c, "
@@ -27,6 +28,12 @@ typedef struct {
} coord;
").
+:- pragma foreign_decl("Java", "
+class Coord {
+ public int x, y;
+}
+").
+
:- func new_coord(int, int) = coord.
:- func x(coord) = int.
@@ -55,6 +62,29 @@ typedef struct {
Y = C->y;
").
+:- pragma foreign_proc("Java",
+ new_coord(X::in, Y::in) = (C::out),
+ [will_not_call_mercury, promise_pure],
+"
+ C = new Coord();
+ C.x = X;
+ C.y = Y;
+").
+
+:- pragma foreign_proc("Java",
+ x(C::in) = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = C.x;
+").
+
+:- pragma foreign_proc("Java",
+ y(C::in) = (Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ Y = C.y;
+").
+
:- pragma foreign_proc("Erlang",
new_coord(X::in, Y::in) = (C::out),
[will_not_call_mercury, promise_pure],
diff --git a/tests/hard_coded/foreign_import_module.m b/tests/hard_coded/foreign_import_module.m
index 1a9c198..1a2b764 100644
--- a/tests/hard_coded/foreign_import_module.m
+++ b/tests/hard_coded/foreign_import_module.m
@@ -21,6 +21,7 @@ main -->
:- pragma foreign_import_module(c, foreign_import_module_2).
:- pragma foreign_import_module(il, foreign_import_module_2).
+:- pragma foreign_import_module(java, foreign_import_module_2).
% not actually necessary in Erlang
% :- pragma foreign_import_module(erlang, foreign_import_module_2).
@@ -45,6 +46,12 @@ main -->
throw new System.Exception(""Y1 != Y2"");
}
").
+:- pragma foreign_proc("Java",
+ bar(X::in, Y::out),
+ [may_call_mercury, promise_pure],
+"
+ Y = foreign_import_module_2.foo(X);
+").
:- pragma foreign_proc("Erlang",
bar(X::in, Y::out),
[may_call_mercury, promise_pure],
@@ -74,6 +81,12 @@ main -->
throw new System.Exception(""Y1 != Y2"");
}
").
+:- pragma foreign_proc("Java",
+ bar2(X::in, Y::out),
+ [may_call_mercury, promise_pure],
+"
+ Y = foreign_import_module_2.foo(X);
+").
:- pragma foreign_proc("Erlang",
bar2(X::in, Y::out),
[may_call_mercury, promise_pure],
diff --git a/tests/hard_coded/foreign_import_module_2.m b/tests/hard_coded/foreign_import_module_2.m
index ce5b5e1..5049ada 100644
--- a/tests/hard_coded/foreign_import_module_2.m
+++ b/tests/hard_coded/foreign_import_module_2.m
@@ -8,8 +8,9 @@
:- import_module int.
-:- pragma foreign_export("IL", foo(in, out), "foo").
:- pragma foreign_export("C", foo(in, out), "foo").
+:- pragma foreign_export("IL", foo(in, out), "foo").
+:- pragma foreign_export("Java", foo(in, out), "foo").
:- pragma foreign_export("Erlang", foo(in, out), "foo").
foo(X, X+1).
diff --git a/tests/hard_coded/foreign_name_mutable.m b/tests/hard_coded/foreign_name_mutable.m
index c99ddb3..fa5c879 100644
--- a/tests/hard_coded/foreign_name_mutable.m
+++ b/tests/hard_coded/foreign_name_mutable.m
@@ -8,7 +8,11 @@
:- implementation.
-:- mutable(foo, int, 42, ground, [untrailed, foreign_name("C", "FOO")]).
+:- mutable(foo, int, 42, ground, [
+ untrailed,
+ foreign_name("C", "FOO"),
+ foreign_name("Java", "FOO")
+]).
main(!IO) :-
increment_global(!IO),
@@ -28,3 +32,11 @@ main(!IO) :-
FOO++;
IO = IO0;
").
+
+:- pragma foreign_proc("Java",
+ increment_global(IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ FOO++;
+ IO = IO0;
+").
diff --git a/tests/hard_coded/foreign_type3.m b/tests/hard_coded/foreign_type3.m
index 8d31294..bf05311 100644
--- a/tests/hard_coded/foreign_type3.m
+++ b/tests/hard_coded/foreign_type3.m
@@ -43,21 +43,39 @@ public struct coord {
}
").
+:- pragma foreign_decl("Java", "
+enum dirs {
+ north,
+ east,
+ west,
+ south
+}
+
+class coord {
+ public int x;
+ public int y;
+}
+").
+
+
:- type dir.
:- pragma foreign_type(c, dir, "dirs").
:- pragma foreign_type(il, dir,
"valuetype [foreign_type3__csharp_code]dirs").
+:- pragma foreign_type(java, dir, "dirs").
:- pragma foreign_type(erlang, dir, "").
:- type coord.
:- pragma foreign_type(c, coord, "coord").
:- pragma foreign_type(il, coord,
"valuetype [foreign_type3__csharp_code]coord").
+:- pragma foreign_type(java, coord, "coord").
:- pragma foreign_type(erlang, coord, "").
:- type double.
:- pragma foreign_type(c, double, "double").
:- pragma foreign_type(il, double, "valuetype [mscorlib]System.Double").
+:- pragma foreign_type(java, double, "Double").
:- pragma foreign_type(erlang, double, "").
:- func north = dir.
@@ -69,6 +87,10 @@ public struct coord {
[will_not_call_mercury, promise_pure], "
E = dirs.north;
").
+:- pragma foreign_proc("Java", north = (E::out),
+ [will_not_call_mercury, promise_pure], "
+ E = dirs.north;
+").
:- pragma foreign_proc("Erlang", north = (E::out),
[will_not_call_mercury, promise_pure], "
E = north
@@ -85,6 +107,12 @@ public struct coord {
C.x = X;
C.y = Y;
").
+:- pragma foreign_proc("Java", new(X::in, Y::in) = (C::out),
+ [will_not_call_mercury, promise_pure], "
+ C = new coord();
+ C.x = X;
+ C.y = Y;
+").
:- pragma foreign_proc("Erlang", new(X::in, Y::in) = (C::out),
[will_not_call_mercury, promise_pure], "
C = {X, Y}
@@ -99,6 +127,10 @@ public struct coord {
[will_not_call_mercury, promise_pure], "
Pi = 3.14;
").
+:- pragma foreign_proc("Java", pi = (Pi::out),
+ [will_not_call_mercury, promise_pure], "
+ Pi = 3.14;
+").
:- pragma foreign_proc("Erlang", pi = (Pi::out),
[will_not_call_mercury, promise_pure], "
Pi = 3.14
diff --git a/tests/hard_coded/hash_table_test.m b/tests/hard_coded/hash_table_test.m
index f9b6f09..eac963c 100644
--- a/tests/hard_coded/hash_table_test.m
+++ b/tests/hard_coded/hash_table_test.m
@@ -147,5 +147,12 @@ do_replace_neg(I, !HT) :-
HT = HT0;
").
+:- pragma foreign_proc("Java",
+ unsafe_hash_table_cast(HT0::in, HT::out(hash_table)),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ HT = HT0;
+").
+
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=8 sts=4 sw=4 et
diff --git a/tests/hard_coded/ho_solns.m b/tests/hard_coded/ho_solns.m
index b5165b1..ef95f65 100644
--- a/tests/hard_coded/ho_solns.m
+++ b/tests/hard_coded/ho_solns.m
@@ -48,6 +48,13 @@ main -->
L = L0;
}
").
+:- pragma foreign_proc("Java",
+ convert_list(L0 :: in, L :: out(list_skel(mypred))),
+ [promise_pure], "
+{
+ L = L0;
+}
+").
:- pragma foreign_proc("Erlang",
convert_list(L0 :: in, L :: out(list_skel(mypred))),
[promise_pure], "
diff --git a/tests/hard_coded/ho_univ_to_type.m b/tests/hard_coded/ho_univ_to_type.m
index 33a01a5..8690423 100644
--- a/tests/hard_coded/ho_univ_to_type.m
+++ b/tests/hard_coded/ho_univ_to_type.m
@@ -66,6 +66,14 @@ foo(X) :- X = (pred(A::in, B::in, C::out) is det :- C = A + B).
Pred2 = Pred1;
}
").
+:- pragma foreign_proc("Java",
+ convert_inst(Pred1::in, Pred2::out(mypred)),
+ [will_not_call_mercury, promise_pure],
+"
+{
+ Pred2 = Pred1;
+}
+").
:- pragma foreign_proc("Erlang",
convert_inst(Pred1::in, Pred2::out(mypred)),
[will_not_call_mercury, promise_pure], "
diff --git a/tests/hard_coded/impure_foreign.m b/tests/hard_coded/impure_foreign.m
index 476d154..f260552 100644
--- a/tests/hard_coded/impure_foreign.m
+++ b/tests/hard_coded/impure_foreign.m
@@ -43,6 +43,8 @@ main -->
:- pragma foreign_code("C#", "static int counter = 1;").
+:- pragma foreign_code("Java", "static int counter = 1;").
+
:- impure pred incr(int::out) is det.
incr(_::out) :- error("incr/1 called for language other than C").
@@ -51,6 +53,8 @@ incr(_::out) :- error("incr/1 called for language other than C").
"counter++; Val = counter;").
:- pragma foreign_proc("C#", incr(Val::out), [will_not_call_mercury],
"counter++; Val = counter;").
+:- pragma foreign_proc("Java", incr(Val::out), [will_not_call_mercury],
+ "counter++; Val = counter;").
:- pragma foreign_proc("Erlang", incr(Val::out), [will_not_call_mercury],
"case get(counter) of
undefined -> Val = 2;
@@ -68,6 +72,9 @@ get(_::out) :- error("get/1 called for language other than C").
:- pragma foreign_proc("C#", get(Val::out),
[will_not_call_mercury, promise_semipure],
"Val = counter;").
+:- pragma foreign_proc("Java", get(Val::out),
+ [will_not_call_mercury, promise_semipure],
+ "Val = counter;").
:- pragma foreign_proc("Erlang", get(Val::out),
[will_not_call_mercury, promise_semipure],
"Val = case get(counter) of
diff --git a/tests/hard_coded/impure_init_and_final.m b/tests/hard_coded/impure_init_and_final.m
index 22feff3..b059184 100644
--- a/tests/hard_coded/impure_init_and_final.m
+++ b/tests/hard_coded/impure_init_and_final.m
@@ -22,6 +22,12 @@ main(!IO) :- io.write_string("This is main...\n", !IO).
"
puts(S);
").
+:- pragma foreign_proc("Java",
+ puts(S::in),
+ [will_not_call_mercury],
+"
+ System.out.println(S);
+").
:- pragma foreign_proc("Erlang",
puts(S::in),
[will_not_call_mercury],
diff --git a/tests/hard_coded/impure_prune.m b/tests/hard_coded/impure_prune.m
index 8599645..58ebfde 100644
--- a/tests/hard_coded/impure_prune.m
+++ b/tests/hard_coded/impure_prune.m
@@ -57,6 +57,15 @@ bump_counter :-
").
:- pragma foreign_proc("C#", set_counter(X::in), [], "counter = X;").
+:- pragma foreign_code("Java", "static int counter = 0;").
+:- pragma foreign_proc("Java",
+ get_counter(X::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ X = counter;
+").
+:- pragma foreign_proc("Java", set_counter(X::in), [], "counter = X;").
+
:- pragma foreign_proc("Erlang",
get_counter(X::out),
[will_not_call_mercury, promise_semipure],
diff --git a/tests/hard_coded/intermod_c_code2.m b/tests/hard_coded/intermod_c_code2.m
index 3b2610f..d413356 100644
--- a/tests/hard_coded/intermod_c_code2.m
+++ b/tests/hard_coded/intermod_c_code2.m
@@ -22,6 +22,11 @@ c_code(T, U) :- c_code_2(T, U).
U = T;
TypeInfo_for_U = TypeInfo_for_T;
}").
+:- pragma foreign_proc("Java", c_code_2(T::in, U::out), [promise_pure],
+"{
+ U = T;
+ TypeInfo_for_U = TypeInfo_for_T;
+}").
:- pragma foreign_proc("Erlang", c_code_2(T::in, U::out), [promise_pure],
"
U = T,
diff --git a/tests/hard_coded/intermod_multimode.m b/tests/hard_coded/intermod_multimode.m
index 1c922bb..e521b59 100644
--- a/tests/hard_coded/intermod_multimode.m
+++ b/tests/hard_coded/intermod_multimode.m
@@ -91,10 +91,16 @@ test2(0::out, 0::out) :-
puts(S)
").
:- pragma foreign_proc("C#", puts(S::in), [], "System.Console.WriteLine(S);").
+:- pragma foreign_proc("Java",
+ puts(S::in),
+ [will_not_call_mercury],
+"
+ System.out.println(S);
+").
:- pragma foreign_proc("Erlang", puts(S::in), [],
"
- io:put_chars(S),
- io:nl()
+ io:put_chars(S),
+ io:nl()
").
:- pragma promise_pure(get_determinism/2).
diff --git a/tests/hard_coded/intermod_poly_mode_2.m b/tests/hard_coded/intermod_poly_mode_2.m
index bc0bb4d..675da49 100644
--- a/tests/hard_coded/intermod_poly_mode_2.m
+++ b/tests/hard_coded/intermod_poly_mode_2.m
@@ -12,6 +12,12 @@
"
R = X;
").
+:- pragma foreign_proc("Java",
+ new(X::in(I)) = (R::out(I)),
+ [promise_pure, will_not_call_mercury],
+"
+ R = X;
+").
:- pragma foreign_proc("Erlang",
new(X::in(I)) = (R::out(I)),
[promise_pure, will_not_call_mercury],
diff --git a/tests/hard_coded/loop_inv_test.m b/tests/hard_coded/loop_inv_test.m
index bcf5b1c..865a9b0 100644
--- a/tests/hard_coded/loop_inv_test.m
+++ b/tests/hard_coded/loop_inv_test.m
@@ -88,6 +88,17 @@ loop2(N, Inv, Acc0, Acc) :-
X = Inv + 42;
").
+:- pragma foreign_code("Java", "static int p_num_calls = 0;").
+:- pragma foreign_proc("Java", p(Inv::in, X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ /* Test that p/1 only gets called once. */
+ if (p_num_calls++ > 0) {
+ throw new Error(""p/1 called more than once"");
+ }
+
+ X = Inv + 42;
+").
:- pragma foreign_proc("Erlang", p(Inv::in, X::out),
[will_not_call_mercury, promise_pure],
"
@@ -125,6 +136,17 @@ loop2(N, Inv, Acc0, Acc) :-
X = Inv + 53;
").
+:- pragma foreign_code("Java", "static int q_num_calls = 0;").
+:- pragma foreign_proc("Java", q(Inv::in, X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ /* Test that q/1 only gets called once. */
+ if (q_num_calls++ > 0) {
+ throw new Error(""q/1 called more than once"");
+ }
+
+ X = Inv + 53;
+").
:- pragma foreign_proc("Erlang", q(Inv::in, X::out),
[will_not_call_mercury, promise_pure],
"
diff --git a/tests/hard_coded/loop_inv_test1.m b/tests/hard_coded/loop_inv_test1.m
index 02358d2..a9fe844 100644
--- a/tests/hard_coded/loop_inv_test1.m
+++ b/tests/hard_coded/loop_inv_test1.m
@@ -87,6 +87,17 @@ loop2(N, Acc0, Acc) :-
X = 42;
").
+:- pragma foreign_code("Java", "static int p_num_calls = 0;").
+:- pragma foreign_proc("Java", p(X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ /* Test that p/1 only gets called once. */
+ if (p_num_calls++ > 0) {
+ throw new Error(""p/1 called more than once"");
+ }
+
+ X = 42;
+").
:- pragma foreign_proc("Erlang", p(X::out),
[will_not_call_mercury, promise_pure],
"
@@ -124,6 +135,17 @@ loop2(N, Acc0, Acc) :-
X = 53;
").
+:- pragma foreign_code("Java", "static int q_num_calls = 0;").
+:- pragma foreign_proc("Java", q(X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ /* Test that q/1 only gets called once. */
+ if (q_num_calls++ > 0) {
+ throw new Error(""q/1 called more than once"");
+ }
+
+ X = 53;
+").
:- pragma foreign_proc("Erlang", q(X::out),
[will_not_call_mercury, promise_pure],
"
diff --git a/tests/hard_coded/lp.m b/tests/hard_coded/lp.m
index 7b4b100..db9883f 100644
--- a/tests/hard_coded/lp.m
+++ b/tests/hard_coded/lp.m
@@ -380,6 +380,12 @@ set_index(Tableau0, Rows0, Cols0, J, K, R, Tableau) :-
ldloc 'A'
stloc 'B'
").
+:- pragma foreign_proc("Java",
+ mkuniq(A::in, B::array_uo),
+ [will_not_call_mercury, promise_pure],
+"
+ B = A;
+").
:- pragma foreign_proc("Erlang",
mkuniq(A::in, B::array_uo),
[will_not_call_mercury, promise_pure],
diff --git a/tests/hard_coded/mode_choice.m b/tests/hard_coded/mode_choice.m
index 328c2ea..ed0bb37 100644
--- a/tests/hard_coded/mode_choice.m
+++ b/tests/hard_coded/mode_choice.m
@@ -119,6 +119,9 @@ test2(_A::di, B::uo) :-
:- pragma foreign_proc("C#", mkany(S::out(any)), [promise_pure], "
S = null;
").
+:- pragma foreign_proc("Java", mkany(S::out(any)), [promise_pure], "
+ S = null;
+").
:- pragma foreign_proc("Erlang", mkany(S::out(any)), [promise_pure], "
S = null
").
diff --git a/tests/hard_coded/multimode.m b/tests/hard_coded/multimode.m
index 7e19e36..176d2b6 100644
--- a/tests/hard_coded/multimode.m
+++ b/tests/hard_coded/multimode.m
@@ -94,6 +94,12 @@ test2(0::out, 0::out) :-
").
:- pragma foreign_proc("C#", puts(S::in),
[promise_pure], "System.Console.WriteLine(S);").
+:- pragma foreign_proc("Java",
+ puts(S::in),
+ [will_not_call_mercury],
+"
+ System.out.println(S);
+").
:- pragma foreign_proc("Erlang",
puts(S::in),
[will_not_call_mercury],
diff --git a/tests/hard_coded/no_inline.m b/tests/hard_coded/no_inline.m
index bccda57..a914ed9 100644
--- a/tests/hard_coded/no_inline.m
+++ b/tests/hard_coded/no_inline.m
@@ -32,8 +32,13 @@ main -->
Value = counter++;
}
").
+
:- pragma foreign_code("C#", "static int counter = 0;").
:- pragma foreign_proc("C#", bar(Value::out), [], "Value = counter++;").
+
+:- pragma foreign_code("Java", "static int counter = 0;").
+:- pragma foreign_proc("Java", bar(Value::out), [], "Value = counter++;").
+
:- pragma foreign_proc("Erlang", bar(Value::out), [], "
case get(counter) of
undefined ->
diff --git a/tests/hard_coded/pragma_foreign_export.m b/tests/hard_coded/pragma_foreign_export.m
index 93e32be..5377625 100644
--- a/tests/hard_coded/pragma_foreign_export.m
+++ b/tests/hard_coded/pragma_foreign_export.m
@@ -16,6 +16,8 @@ main(!IO) :-
:- pred hello_world(io::di, io::uo) is det.
:- pragma foreign_export("C", hello_world(di, uo),
"exported_hello_world").
+:- pragma foreign_export("Java", hello_world(di, uo),
+ "exported_hello_world").
:- pragma foreign_export("Erlang", hello_world(di, uo),
"exported_hello_world").
@@ -30,6 +32,13 @@ hello_world(!IO) :-
IO = IO0;
").
+:- pragma foreign_proc("Java",
+ call_foreign(_IO0::di, _IO::uo),
+ [promise_pure, may_call_mercury],
+"
+ exported_hello_world();
+").
+
:- pragma foreign_proc("Erlang",
call_foreign(_IO0::di, _IO::uo),
[promise_pure, may_call_mercury],
diff --git a/tests/hard_coded/redoip_clobber.m b/tests/hard_coded/redoip_clobber.m
index ed9919b..31dc7b7 100644
--- a/tests/hard_coded/redoip_clobber.m
+++ b/tests/hard_coded/redoip_clobber.m
@@ -64,6 +64,11 @@ bar(X) :- X = 1.
"
SUCCESS_INDICATOR = false
").
+:- pragma foreign_proc("Java", use(_X::in),
+ [will_not_call_mercury, promise_pure],
+"
+ succeeded = false;
+").
:- pragma foreign_proc("Erlang", use(_X::in),
[will_not_call_mercury, promise_pure],
"
diff --git a/tests/hard_coded/rnd.m b/tests/hard_coded/rnd.m
index d71adb9..4cea107 100644
--- a/tests/hard_coded/rnd.m
+++ b/tests/hard_coded/rnd.m
@@ -249,6 +249,8 @@ set(Vec0, Ind, V, Vec) :-
").
:- pragma foreign_proc("C#", rfloat(I::in) = (F::out),
[promise_pure], "F = I;").
+:- pragma foreign_proc("Java", rfloat(I::in) = (F::out),
+ [promise_pure], "F = I;").
:- pragma foreign_proc("Erlang", rfloat(I::in) = (F::out),
[promise_pure], "F = float(I)").
@@ -261,6 +263,8 @@ set(Vec0, Ind, V, Vec) :-
").
:- pragma foreign_proc("C#", rint(F::in) = (I::out),
[promise_pure], "I = (int) F;").
+:- pragma foreign_proc("Java", rint(F::in) = (I::out),
+ [promise_pure], "I = (int) F;").
:- pragma foreign_proc("Erlang", rint(F::in) = (I::out),
[promise_pure], "I = trunc(F)").
diff --git a/tests/hard_coded/uc_export_enum.m b/tests/hard_coded/uc_export_enum.m
index 24e6d11..b2391a7 100644
--- a/tests/hard_coded/uc_export_enum.m
+++ b/tests/hard_coded/uc_export_enum.m
@@ -39,6 +39,12 @@ main(!IO) :-
"
X = UC_foo_FOO;
").
+:- pragma foreign_proc("Java",
+ test_uc(X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = UC_foo_FOO;
+").
:- pred test_lc(foo::out) is det.
:- pragma foreign_proc("C",
@@ -47,6 +53,12 @@ main(!IO) :-
"
X = LC_foo_foo;
").
+:- pragma foreign_proc("Java",
+ test_lc(X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = LC_foo_foo;
+").
:- pred test_or(foo::out, foo::out, foo::out) is det.
:- pragma foreign_proc("C",
@@ -57,6 +69,14 @@ main(!IO) :-
Y = OR_foo_mixed1234_bAr;
Z = OR_foo_BAZ;
").
+:- pragma foreign_proc("Java",
+ test_or(X::out, Y::out, Z::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = OR_foo_lowercase_foo;
+ Y = OR_foo_mixed1234_bAr;
+ Z = OR_foo_BAZ;
+").
%----------------------------------------------------------------------------%
@@ -68,10 +88,12 @@ main(!IO) :-
% Check that uppercase applies only the constructors and not to the prefix.
%
:- pragma foreign_export_enum("C", foo/0, [prefix("UC_foo_"), uppercase]).
+:- pragma foreign_export_enum("Java", foo/0, [prefix("UC_foo_"), uppercase]).
% Check that uppercase applies only when the uppercase attribute is specified.
%
:- pragma foreign_export_enum("C", foo/0, [prefix("LC_foo_")]).
+:- pragma foreign_export_enum("Java", foo/0, [prefix("LC_foo_")]).
% Check that the uppercase attribute does not apply to user supplied foreign
% names.
@@ -80,6 +102,10 @@ main(!IO) :-
foo - "lowercase_foo",
bar - "mixed1234_bAr"
]).
+:- pragma foreign_export_enum("Java", foo/0, [prefix("OR_foo_"), uppercase], [
+ foo - "lowercase_foo",
+ bar - "mixed1234_bAr"
+]).
%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
diff --git a/tests/hard_coded/user_compare.m b/tests/hard_coded/user_compare.m
index bcd2c9c..dd3b4da 100644
--- a/tests/hard_coded/user_compare.m
+++ b/tests/hard_coded/user_compare.m
@@ -55,6 +55,8 @@ compare_foo(Res, Foo1, Foo2) :-
equality is foreign_equals, comparison is foreign_compare.
:- pragma foreign_type(il, foreign, "int32") where
equality is foreign_equals, comparison is foreign_compare.
+:- pragma foreign_type("Java", foreign, "Integer") where
+ equality is foreign_equals, comparison is foreign_compare.
:- pragma foreign_type(erlang, foreign, "") where
equality is foreign_equals, comparison is foreign_compare.
@@ -63,10 +65,14 @@ compare_foo(Res, Foo1, Foo2) :-
[will_not_call_mercury, promise_pure],
"SUCCESS_INDICATOR = (Foreign1 == Foreign2);"
).
-:- pragma foreign_proc("c#", foreign_equals(Foreign1::in, Foreign2::in),
+:- pragma foreign_proc("C#", foreign_equals(Foreign1::in, Foreign2::in),
[will_not_call_mercury, promise_pure],
"SUCCESS_INDICATOR = (Foreign1 == Foreign2);"
).
+:- pragma foreign_proc("Java", foreign_equals(Foreign1::in, Foreign2::in),
+ [will_not_call_mercury, promise_pure],
+"succeeded = (Foreign1 == Foreign2);"
+).
:- pragma foreign_proc("Erlang", foreign_equals(Foreign1::in, Foreign2::in),
[will_not_call_mercury, promise_pure],
"SUCCESS_INDICATOR = (Foreign1 =:= Foreign2)"
@@ -90,6 +96,11 @@ foreign_compare(Result, Foreign1, Foreign2) :-
[will_not_call_mercury, promise_pure],
"Result = (Foreign1 < Foreign2 ? 1 : (Foreign1 == Foreign2 ? 0 : -1));"
).
+:- pragma foreign_proc("Java", foreign_compare_2(Result::out, Foreign1::in,
+ Foreign2::in),
+ [will_not_call_mercury, promise_pure],
+"Result = (Foreign1 < Foreign2 ? 1 : (Foreign1 == Foreign2 ? 0 : -1));"
+).
:- pragma foreign_proc("Erlang", foreign_compare_2(Result::out, Foreign1::in,
Foreign2::in),
[will_not_call_mercury, promise_pure],
@@ -109,6 +120,10 @@ end"
[will_not_call_mercury, promise_pure],
"Foreign = Int;"
).
+:- pragma foreign_proc("Java", foreign(Int::in) = (Foreign::out),
+ [will_not_call_mercury, promise_pure],
+"Foreign = Int;"
+).
:- pragma foreign_proc("Erlang", foreign(Int::in) = (Foreign::out),
[will_not_call_mercury, promise_pure],
"Foreign = Int"
diff --git a/tests/hard_coded/write_xml.m b/tests/hard_coded/write_xml.m
index 682b85e..b2e5cba 100644
--- a/tests/hard_coded/write_xml.m
+++ b/tests/hard_coded/write_xml.m
@@ -44,6 +44,7 @@
:- pred make_ftype(ftype::out) is det.
:- pragma foreign_type("C", ftype, "int").
+:- pragma foreign_type("Java", ftype, "Integer").
:- pragma foreign_type("Erlang", ftype, "").
:- pragma foreign_proc("C", make_ftype(F::out),
@@ -52,6 +53,12 @@
F = 1;
").
+:- pragma foreign_proc("Java", make_ftype(F::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ F = 1;
+").
+
:- pragma foreign_proc("Erlang", make_ftype(F::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
@@ -66,6 +73,12 @@
P = (MR_Word) NULL;
").
+:- pragma foreign_proc("Java", make_pointer(P::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ P = null;
+").
+
:- pragma foreign_proc("Erlang", make_pointer(P::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
diff --git a/tests/invalid/erroneous_throw_promise.m b/tests/invalid/erroneous_throw_promise.m
index 7663c49..e7d22e6 100644
--- a/tests/invalid/erroneous_throw_promise.m
+++ b/tests/invalid/erroneous_throw_promise.m
@@ -21,3 +21,17 @@
"
/* Do something with X */
").
+
+:- pragma foreign_proc("Java",
+ foo(X::in),
+ [will_not_call_mercury, promise_pure, will_not_throw_exception],
+"
+ /* Do something with X */
+").
+
+:- pragma foreign_proc("Java",
+ bar(X::in),
+ [may_call_mercury, promise_pure, will_not_throw_exception],
+"
+ /* Do something with X */
+").
diff --git a/tests/recompilation/Mmakefile b/tests/recompilation/Mmakefile
index 6790346..962920d 100644
--- a/tests/recompilation/Mmakefile
+++ b/tests/recompilation/Mmakefile
@@ -42,15 +42,8 @@ TESTS_SHOULD_FAIL = \
type_qual_re \
with_type_re
-# We currently don't do any testing in java, il or erlang grades in this
-# directory because smart compilation doesn't support intermodule-optimization
-# yet
-ifneq "$(filter java% il% erlang%,$(GRADE))" ""
- PROGS=
-else
- PROGS= $(TESTS_SHOULD_SUCCEED) $(NO_PARALLEL_MAKE_TESTS) \
- $(TESTS_SHOULD_FAIL)
-endif
+PROGS= $(TESTS_SHOULD_SUCCEED) $(NO_PARALLEL_MAKE_TESTS) \
+ $(TESTS_SHOULD_FAIL)
TESTS= $(sort $(PROGS:%=%-nodepend))
SUBDIRS =
diff --git a/tests/term/Mmakefile b/tests/term/Mmakefile
index de75ae0..dfcaaba 100644
--- a/tests/term/Mmakefile
+++ b/tests/term/Mmakefile
@@ -80,12 +80,7 @@ endif # $(MMAKE_USE_MMC_MAKE) == no
# can be found by `mmc --make'.
include Mercury.options
-# We currently don't do any testing in grade java on this directory.
-ifneq "$(findstring java,$(GRADE))" ""
- PROGS=
-else
- PROGS=$(TERM_PROGS)
-endif
+PROGS=$(TERM_PROGS)
#-----------------------------------------------------------------------------#
diff --git a/tests/valid/Mmakefile b/tests/valid/Mmakefile
index 50408bf..4b6e478 100644
--- a/tests/valid/Mmakefile
+++ b/tests/valid/Mmakefile
@@ -333,11 +333,10 @@ CONSTRAINT_TYPECHECK_PROGS = \
ifeq "$(findstring hl,$(GRADE))$(findstring .agc,$(GRADE))" "hl"
PROGS0 = $(TYPECLASS_PROGS) $(OTHER_PROGS)
else
- # The agc.* tests don't work in the il grades, as the CLR has
- # its own builtin GC.
+ # The agc.* tests don't work in the il, java or erlang grades.
# The agc.* tests also don't work in minimal model grades,
# because the collector doesn't scan the copied areas of the stacks.
- ifneq "$(findstring il,$(GRADE))$(findstring mm,$(GRADE))" ""
+ ifneq "$(filter java% il% erlang%,$(GRADE))$(findstring mm,$(GRADE))" ""
PROGS0 = $(TYPECLASS_PROGS) $(OTHER_PROGS)
else
PROGS0 = $(AGC_PROGS) $(TYPECLASS_PROGS) $(OTHER_PROGS)
@@ -368,12 +367,7 @@ else
endif
ifneq "$(filter java% il% erlang%,$(GRADE))$(findstring profdeep,$(GRADE))" ""
- # We currently don't do any testing in grade java on this directory.
- ifneq "$(findstring java,$(GRADE))" ""
- PROGS3 =
- else
- PROGS3 = $(PROGS2)
- endif
+ PROGS3 = $(PROGS2)
else
PROGS3 = $(PROGS2) $(TABLE_PROGS)
endif
@@ -414,10 +408,12 @@ ifeq ($(MMAKE_USE_MMC_MAKE),yes)
OS_SUBDIR=
ILS_SUBDIR=
DLLS_SUBDIR=
+CLASSES_SUBDIR=
else
OS_SUBDIR=$(os_subdir)
ILS_SUBDIR=$(ils_subdir)
DLLS_SUBDIR=$(dlls_subdir)
+CLASSES_SUBDIR=$(classes_subdir)
endif
@@ -430,10 +426,15 @@ ifeq ($(findstring erlang,$(GRADE)),erlang)
# Erlang backend currently requires `mmc --make'.
TARGET_OBJ_SUBDIR=
else
+ifeq ($(findstring java,$(GRADE)),java)
+ TARGET_OBJ_EXT=class
+ TARGET_OBJ_SUBDIR=$(CLASSES_SUBDIR)
+else
TARGET_OBJ_EXT=$(O)
TARGET_OBJ_SUBDIR=$(OS_SUBDIR)
endif
endif
+endif
OBJS = $(OBJ_PROGS:%=$(TARGET_OBJ_SUBDIR)%.$(TARGET_OBJ_EXT)) \
$(IL_PROGS:%=$(ILS_SUBDIR)%.il)
diff --git a/tests/valid/big_foreign_type.m b/tests/valid/big_foreign_type.m
index 0323004..e53b0b1 100644
--- a/tests/valid/big_foreign_type.m
+++ b/tests/valid/big_foreign_type.m
@@ -7,18 +7,25 @@
:- type foo.
:- pragma foreign_type(c, foo, "struct Foo").
:- pragma foreign_type(il, foo, "class [big_foreign_type__csharp_code]Foo").
+:- pragma foreign_type(java, foo, "Foo").
:- pragma foreign_type(erlang, foo, "").
+
:- type foo2.
:- pragma foreign_type(c, foo2, "char").
:- pragma foreign_type(il, foo2, "valuetype [mscorlib]System.Char").
+:- pragma foreign_type(java, foo2, "Character").
:- pragma foreign_type(erlang, foo2, "").
+
:- type foo3.
:- pragma foreign_type(c, foo3, "double").
:- pragma foreign_type(il, foo3, "valuetype [mscorlib]System.Double").
+:- pragma foreign_type(java, foo3, "Double").
:- pragma foreign_type(erlang, foo3, "").
+
:- type foo4.
:- pragma foreign_type(c, foo4, "enum e").
:- pragma foreign_type(il, foo4, "valuetype [big_foreign_type__csharp_code]e").
+:- pragma foreign_type(java, foo4, "e").
:- pragma foreign_type(erlang, foo4, "").
:- func bar(foo) = foo.
@@ -49,6 +56,14 @@ public class Foo {
public enum e { e0, e1, e2, e42=42 };
").
+:- pragma foreign_decl("Java", "
+class Foo {
+ int x, y, z;
+}
+
+enum e { e0, e1, e2 };
+").
+
:- pragma foreign_proc(c, bar(X::in) = (Y::out),
[will_not_call_mercury, promise_pure], "Y = X;").
:- pragma foreign_proc(c, bar2(X::in) = (Y::out),
@@ -67,6 +82,15 @@ public enum e { e0, e1, e2, e42=42 };
:- pragma foreign_proc("C#", bar4(X::in) = (Y::out),
[will_not_call_mercury, promise_pure], "Y = X;").
+:- pragma foreign_proc("Java", bar(X::in) = (Y::out),
+ [will_not_call_mercury, promise_pure], "Y = X;").
+:- pragma foreign_proc("Java", bar2(X::in) = (Y::out),
+ [will_not_call_mercury, promise_pure], "Y = X;").
+:- pragma foreign_proc("Java", bar3(X::in) = (Y::out),
+ [will_not_call_mercury, promise_pure], "Y = 2.0 * X;").
+:- pragma foreign_proc("Java", bar4(X::in) = (Y::out),
+ [will_not_call_mercury, promise_pure], "Y = X;").
+
:- pragma foreign_proc("Erlang", bar(X::in) = (Y::out),
[will_not_call_mercury, promise_pure], "Y = X").
:- pragma foreign_proc("Erlang", bar2(X::in) = (Y::out),
diff --git a/tests/valid/deforest_loop.m b/tests/valid/deforest_loop.m
index f530aa5..59372be 100644
--- a/tests/valid/deforest_loop.m
+++ b/tests/valid/deforest_loop.m
@@ -61,24 +61,27 @@ shade(Scene, Ray, Intersection, Attributes, Colour) :-
:- pred shade_from_light(scene, ray, ray, colour, light, colour).
:- mode shade_from_light(in(scene), in, in, in, in, out) is det.
-:- external(shade_from_light/6).
-:- pragma foreign_code("Erlang",
- "shade_from_light_6_p_0(_, _, _, _, _) -> void.").
+:- pragma no_inline(shade_from_light/6).
+
+shade_from_light(_, _, _, _, _, rgb(0.0, 0.0, 0.0)).
:- func colour(attributes) = colour.
-:- external(colour/1).
-:- pragma foreign_code("Erlang", "colour_1_f_0(_) -> void.").
+:- pragma no_inline(colour/1).
+
+colour(_) = rgb(0.0, 0.0, 0.0).
:- func scale(float, colour) = colour.
scale(F, rgb(R, G, B)) = rgb(range(F * R), range(F * G), range(F * B)).
:- func ambient(scene::in(scene)) = (float::out) is det.
-:- external(ambient/1).
-:- pragma foreign_code("Erlang", "ambient_1_f_0(_) -> void.").
+:- pragma no_inline(ambient/1).
+
+ambient(_) = 0.0.
:- func lights(scene::in(scene)) = (list(light)::out) is det.
-:- external(lights/1).
-:- pragma foreign_code("Erlang", "lights_1_f_0(_) -> void.").
+:- pragma no_inline(lights/1).
+
+lights(_) = [].
:- pred add_colours(colour::in, colour::in, colour::out) is det.
add_colours(C0, C1, C0 + C1).
@@ -88,6 +91,7 @@ rgb(Ra, Ga, Ba) + rgb(Rb, Gb, Bb) =
rgb(range(Ra + Rb), range(Ga + Gb), range(Ba + Bb)).
:- func range(float) = float.
-:- external(range/1).
-:- pragma foreign_code("Erlang", "range_1_f_0(_) -> void.").
+:- pragma no_inline(range/1).
+
+range(X) = X.
diff --git a/tests/valid/exported_foreign_type2.m b/tests/valid/exported_foreign_type2.m
index d425ba9..be49ca5 100644
--- a/tests/valid/exported_foreign_type2.m
+++ b/tests/valid/exported_foreign_type2.m
@@ -3,6 +3,7 @@
:- type t ---> t(int).
:- pragma foreign_type("C", t, "int") where equality is int_equals, comparison is int_compare.
+:- pragma foreign_type("Java", t, "Integer") where equality is int_equals, comparison is int_compare.
:- pragma foreign_type("Erlang", t, "int") where equality is int_equals, comparison is int_compare.
:- pred int_equals(t::in, t::in) is semidet.
@@ -14,6 +15,9 @@
:- pragma foreign_proc("C", int_equals(T1::in, T2::in), [promise_pure],
"SUCCESS_INDICATOR = (T1 == T2);").
+:- pragma foreign_proc("Java", int_equals(T1::in, T2::in), [promise_pure],
+"succeeded = (T1 == T2);").
+
:- pragma foreign_proc("Erlang", int_equals(T1::in, T2::in), [promise_pure],
"SUCCESS_INDICATOR = (T1 =:= T2)").
@@ -26,6 +30,10 @@ int_compare((Res < 0 -> (<) ; Res = 0 -> (=) ; (>)), T1, T2) :-
int_compare_2(Result::out, T1::in, T2::in), [promise_pure],
"Result = (T1 < T2) ? -1 : ((T1 == T2) ? 0 : 1);").
+:- pragma foreign_proc("Java",
+ int_compare_2(Result::out, T1::in, T2::in), [promise_pure],
+"Result = (T1 < T2) ? -1 : ((T1 == T2) ? 0 : 1);").
+
:- pragma foreign_proc("Erlang",
int_compare_2(Result::out, T1::in, T2::in), [promise_pure],
"Result = if T1 < T2 -> -1; T1 =:= T2 -> 0 ; true -> 1 end").
diff --git a/tests/valid/flatten_conj_bug.m b/tests/valid/flatten_conj_bug.m
index fbdef09..d0167f2 100644
--- a/tests/valid/flatten_conj_bug.m
+++ b/tests/valid/flatten_conj_bug.m
@@ -29,6 +29,8 @@ unwrap_cvar(cvar_wrapper(V)) = unsafe_any_to_cvar(V).
:- pragma foreign_proc("C", unsafe_any_to_cvar(X::in) = (Y::out(cvar)),
[will_not_call_mercury, promise_pure], "Y = X;").
+:- pragma foreign_proc("Java", unsafe_any_to_cvar(X::in) = (Y::out(cvar)),
+ [will_not_call_mercury, promise_pure], "Y = X;").
:- pragma foreign_proc("Erlang", unsafe_any_to_cvar(X::in) = (Y::out(cvar)),
[will_not_call_mercury, promise_pure], "Y = X").
diff --git a/tests/valid/headvar_not_found.m b/tests/valid/headvar_not_found.m
index 5c842c4..9c95e85 100644
--- a/tests/valid/headvar_not_found.m
+++ b/tests/valid/headvar_not_found.m
@@ -16,8 +16,9 @@
:- type module_info ---> module_info(int, int).
:- pred mode_is_input(module_info::in, (mode)::in) is semidet.
-:- external(mode_is_input/2).
-:- pragma foreign_code("Erlang", "mode_is_input_2_p_0(_, _) -> void.").
+
+mode_is_input(_, _) :-
+ semidet_true.
% succeed iff all the inputs in the list of modes precede the outputs
diff --git a/tests/valid/ho_and_type_spec_bug.m b/tests/valid/ho_and_type_spec_bug.m
index 008c264..5497bf0 100644
--- a/tests/valid/ho_and_type_spec_bug.m
+++ b/tests/valid/ho_and_type_spec_bug.m
@@ -47,6 +47,13 @@ beta(_E, V, _R0, R) :- R = gamma(V).
"
/* V F */
").
+:- pragma foreign_proc("Java",
+ gamma(V::in) = (F::out),
+ [will_not_call_mercury, promise_pure],
+"
+ /* V */
+ F = null;
+").
:- pragma foreign_proc("Erlang",
gamma(V::in) = (F::out),
[will_not_call_mercury, promise_pure],
diff --git a/tests/valid/intermod_impure2.m b/tests/valid/intermod_impure2.m
index abdc3c6..4173907 100644
--- a/tests/valid/intermod_impure2.m
+++ b/tests/valid/intermod_impure2.m
@@ -29,6 +29,13 @@ intermod_impure(Int) :-
ldc.i4 2
stloc Int
").
+:- pragma foreign_proc("Java",
+ intermod_impure_2(Int::out),
+ [will_not_call_mercury],
+"
+ System.out.println(""Output from impure predicate\\n"");
+ Int = 2;
+").
:- pragma foreign_proc("Erlang",
intermod_impure_2(Int::out),
[will_not_call_mercury],
diff --git a/tests/valid/lambda_recompute.m b/tests/valid/lambda_recompute.m
index 9b6d7e1..4701cc5 100644
--- a/tests/valid/lambda_recompute.m
+++ b/tests/valid/lambda_recompute.m
@@ -62,8 +62,9 @@ element(E, DL, [E|DL]).
:- func pos(int, int) = pos.
-:- external(pos/2).
-:- pragma foreign_code("Erlang", "pos_2_f_0(_, _) -> void.").
+:- pragma no_inline(pos/2).
+
+pos(X, Y) = pos(X, Y).
:- type map_i_know
diff --git a/tests/valid/livevals_seq.m b/tests/valid/livevals_seq.m
index 87dce43..f019373 100644
--- a/tests/valid/livevals_seq.m
+++ b/tests/valid/livevals_seq.m
@@ -38,6 +38,6 @@ det_insert_fcl(Map0, Ks, Vs, Map) :-
:- pred det_insert(map(K,V), K, V, map(K,V)).
:- mode det_insert(in, in, in, out) is det.
+:- pragma no_inline(det_insert/4).
-:- external(det_insert/4).
-:- pragma foreign_code("Erlang", "det_insert_4_p_0(_, _, _, _, _) -> void.").
+det_insert(M, _, _, M).
diff --git a/tests/valid/mert.m b/tests/valid/mert.m
index 155dea7..d8e1ed3 100644
--- a/tests/valid/mert.m
+++ b/tests/valid/mert.m
@@ -41,11 +41,13 @@
:- type c_candidate. % C-implemented, represents one sentence
:- pragma foreign_type("C", c_candidate, "void *",
[stable, can_pass_as_mercury_type]).
+:- pragma foreign_type("Java", c_candidate, "Object").
:- pragma foreign_type("Erlang", c_candidate, "").
:- type data. % C-implemented, represents the whole nbestlist
:- pragma foreign_type("C", data, "void *",
[stable, can_pass_as_mercury_type]).
+:- pragma foreign_type("Java", data, "Object").
:- pragma foreign_type("Erlang", data, "").
:- type feats == list(float). % score breakdown
@@ -63,6 +65,13 @@ new_c_candidate(NFeats::in, Feats::in, NComps::in, Comps::in) = (C::uo),
/* NFeats, Feats, NComps, Comps, C */
").
+:- pragma foreign_proc("Java",
+new_c_candidate(NFeats::in, Feats::in, NComps::in, Comps::in) = (C::uo),
+ [promise_pure, will_not_call_mercury, thread_safe], "
+ /* NFeats, Feats, NComps, Comps, C */
+ C = null;
+").
+
:- pragma foreign_proc("Erlang",
new_c_candidate(NFeats::in, Feats::in, NComps::in, Comps::in) = (C::uo),
[promise_pure, will_not_call_mercury, thread_safe], "
@@ -90,6 +99,12 @@ new_c_data(NSents::in, CandsPerSent::in, TotNCands::in, AllCands::in) = (D::uo),
[promise_pure, will_not_call_mercury, thread_safe], "
/* NSents, CandsPerSent, TotNCands, AllCands */
").
+:- pragma foreign_proc("Java",
+new_c_data(NSents::in, CandsPerSent::in, TotNCands::in, AllCands::in) = (D::uo),
+ [promise_pure, will_not_call_mercury, thread_safe], "
+ /* NSents, CandsPerSent, TotNCands, AllCands */
+ D = null;
+").
:- pragma foreign_proc("Erlang",
new_c_data(NSents::in, CandsPerSent::in, TotNCands::in, AllCands::in) = (D::uo),
[promise_pure, will_not_call_mercury, thread_safe], "
@@ -100,6 +115,7 @@ new_c_data(NSents::in, CandsPerSent::in, TotNCands::in, AllCands::in) = (D::uo),
:- type point. % C-implemented, represents the whole nbestlist
:- pragma foreign_type("C", point, "void *",
[stable, can_pass_as_mercury_type]).
+:- pragma foreign_type("Java", point, "Object").
:- pragma foreign_type("Erlang", point, "").
optimize(NBL, Rand, InW) = OutW :-
@@ -128,6 +144,12 @@ optimize_random(Data::in, BestSoFar::in, Min::in, Max::in, Iter::in) = (Out::out
[promise_pure, will_not_call_mercury, thread_safe], "
/* Data, BestSoFar, Min, Max, Iter */
").
+:- pragma foreign_proc("Java",
+optimize_random(Data::in, BestSoFar::in, Min::in, Max::in, Iter::in) = (Out::out),
+ [promise_pure, will_not_call_mercury, thread_safe], "
+ /* Data, BestSoFar, Min, Max, Iter */
+ Out = null;
+").
:- pragma foreign_proc("Erlang",
optimize_random(Data::in, BestSoFar::in, Min::in, Max::in, Iter::in) = (Out::out),
[promise_pure, will_not_call_mercury, thread_safe], "
@@ -143,6 +165,12 @@ optimize_koehn(Data::in, In::in) = (Out::out),
[promise_pure, will_not_call_mercury, thread_safe], "
/* Data, In, Out */
").
+:- pragma foreign_proc("Java",
+optimize_koehn(Data::in, In::in) = (Out::out),
+ [promise_pure, will_not_call_mercury, thread_safe], "
+ /* Data, In, Out */
+ Out = null;
+").
:- pragma foreign_proc("Erlang",
optimize_koehn(Data::in, In::in) = (Out::out),
[promise_pure, will_not_call_mercury, thread_safe], "
@@ -161,6 +189,12 @@ construct_point(List::in) = (Point::out),
[promise_pure, will_not_call_mercury, thread_safe], "
/* List, Point */
").
+:- pragma foreign_proc("Java",
+construct_point(List::in) = (Point::out),
+ [promise_pure, will_not_call_mercury, thread_safe], "
+ /* List, Point */
+ Point = null;
+").
:- pragma foreign_proc("Erlang",
construct_point(List::in) = (Point::out),
[promise_pure, will_not_call_mercury, thread_safe], "
@@ -173,6 +207,13 @@ deconstruct_point(Point::in) = (List::out),
/* Point, List */
").
+:- pragma foreign_proc("Java",
+deconstruct_point(Point::in) = (List::out),
+ [promise_pure, will_not_call_mercury, thread_safe], "
+ /* Point, List */
+ List = null;
+").
+
:- pragma foreign_proc("Erlang",
deconstruct_point(Point::in) = (List::out),
[promise_pure, will_not_call_mercury, thread_safe], "
diff --git a/tests/valid/mostly_uniq_neg.m b/tests/valid/mostly_uniq_neg.m
index d54b995..6513c7d 100644
--- a/tests/valid/mostly_uniq_neg.m
+++ b/tests/valid/mostly_uniq_neg.m
@@ -18,16 +18,16 @@
:- pred occurs(var(S), list(term(S)), store(S), store(S)).
:- mode occurs(in, in, mdi, muo) is semidet.
+:- pragma no_inline(occurs/4).
-:- external(occurs/4).
-:- pragma foreign_code("Erlang", "occurs_4_p_0(_, _, _) -> void.").
+occurs(_, _, !S) :-
+ semidet_true.
:- pred tr_store_set_mutvar(store_mutvar(T, S), T, store(S), store(S)).
:- mode tr_store_set_mutvar(in, in, mdi, muo) is det.
+:- pragma no_inline(tr_store_set_mutvar/4).
-:- external(tr_store_set_mutvar/4).
-:- pragma foreign_code("Erlang",
- "tr_store_set_mutvar_4_p_0(_, _, _, _) -> void.").
+tr_store_set_mutvar(_, _, S, S).
unify(T1, free, _T2, functor(Name2, Arity2, Args2)) -->
\+ occurs(T1, Args2),
diff --git a/tests/valid/multidet_prune1.m b/tests/valid/multidet_prune1.m
index ea51ac5..9a19104 100644
--- a/tests/valid/multidet_prune1.m
+++ b/tests/valid/multidet_prune1.m
@@ -8,8 +8,9 @@
:- import_module require.
:- pred q(int::in) is det.
-:- external(q/1).
-:- pragma foreign_code("Erlang", "q_1_p_0(_) -> void.").
+:- pragma no_inline(q/1).
+
+q(_).
main -->
( { X = 1 ; X = 2 ; fail }, { q(X) } ->
diff --git a/tests/valid/nondet_live.m b/tests/valid/nondet_live.m
index e43f1fb..84a25bd 100644
--- a/tests/valid/nondet_live.m
+++ b/tests/valid/nondet_live.m
@@ -59,12 +59,15 @@ a3(X, _, Y) :-
:- pred c(int::in, int::out) is nondet.
:- pred d(int::in, int::out) is nondet.
-:- external(b/2).
-:- external(c/2).
-:- external(d/2).
+:- pragma no_inline(b/2).
+:- pragma no_inline(c/2).
+:- pragma no_inline(d/2).
-:- pragma foreign_code("Erlang", "
-b_2_p_0(_, _) -> void.
-c_2_p_0(_, _) -> void.
-d_2_p_0(_, _) -> void.
-").
+b(X, X) :- semidet_true.
+b(X, X) :- semidet_true.
+
+c(X, X) :- semidet_true.
+c(X, X) :- semidet_true.
+
+d(X, X) :- semidet_true.
+d(X, X) :- semidet_true.
diff --git a/tests/valid/param_mode_bug.m b/tests/valid/param_mode_bug.m
index 68e56a3..a68ecc5 100644
--- a/tests/valid/param_mode_bug.m
+++ b/tests/valid/param_mode_bug.m
@@ -33,6 +33,12 @@ foo(Y::out(I), X::in(I)) :-
"
Y = X;
").
+:- pragma foreign_proc("Java",
+ foo_2(Y::out(I), X::in(I)),
+ [promise_pure, thread_safe, will_not_call_mercury],
+"
+ Y = X;
+").
:- pragma foreign_proc("Erlang",
foo_2(Y::out(I), X::in(I)),
[promise_pure, thread_safe, will_not_call_mercury],
diff --git a/tests/valid/simplify_bug.m b/tests/valid/simplify_bug.m
index 4337d25..ce74f68 100644
--- a/tests/valid/simplify_bug.m
+++ b/tests/valid/simplify_bug.m
@@ -30,5 +30,7 @@ nasty(_) :-
).
:- pred e(list(T)::in) is erroneous.
-:- external(e/1).
-:- pragma foreign_code("Erlang", "e_1_p_0(_, _) -> void.").
+:- pragma no_inline(e/1).
+
+e(_) :-
+ error("e/1").
diff --git a/tests/valid/soln_context.m b/tests/valid/soln_context.m
index da20345..6f95c2c 100644
--- a/tests/valid/soln_context.m
+++ b/tests/valid/soln_context.m
@@ -14,14 +14,13 @@ q :- p1(X, Y), p2(X, Y).
:- pred p1(int, int).
:- mode p1(free >> free, out) is nondet.
+:- pragma no_inline(p1/2).
+
+p1(_, 42) :- semidet_fail.
:- pred p2(int, int).
:- mode p2(out, in) is nondet.
+:- pragma no_inline(p2/2).
-:- external(p1/2).
-:- external(p2/2).
-
-:- pragma foreign_code("Erlang", "
-p1_2_p_0(_) -> void.
-p2_2_p_0(_, _) -> void.
-").
+p2(X, X) :- semidet_true.
+p2(X, X) :- semidet_true.
diff --git a/tests/valid/switch_detection_bug2.m b/tests/valid/switch_detection_bug2.m
index e4c98af..cfed843 100644
--- a/tests/valid/switch_detection_bug2.m
+++ b/tests/valid/switch_detection_bug2.m
@@ -62,10 +62,9 @@ display_diff_side_by_side_2(Prev, SBS, [Edit | Diff]) -->
display_diff_side_by_side_2(Prev, SBS, Diff).
:- pred first_mentioned_positions(edit :: in, pos :: out, pos :: out) is det.
-:- external(first_mentioned_positions/3).
-:- pragma foreign_code("Erlang", "
-first_mentioned_positions_3_p_0(_) -> void.
-").
+:- pragma no_inline(first_mentioned_positions/3).
+
+first_mentioned_positions(_, 42, 42).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
diff --git a/tests/valid/uniq_unify.m b/tests/valid/uniq_unify.m
index d861492..d586da4 100644
--- a/tests/valid/uniq_unify.m
+++ b/tests/valid/uniq_unify.m
@@ -12,21 +12,24 @@
:- implementation.
:- pred q(f::di, f::uo) is det.
-:- external(q/2).
+:- pragma no_inline(q/2).
+
+q(!F).
+
:- pred q2(fg::di, fg::uo) is det.
-:- external(q2/2).
+:- pragma no_inline(q2/2).
+
+q2(!FG).
:- pred r(f::di, f::uo) is det.
-:- external(r/2).
+:- pragma no_inline(r/2).
+
+r(!F).
+
:- pred r2(fg::di, fg::uo) is det.
-:- external(r2/2).
-
-:- pragma foreign_code("Erlang", "
-q_2_p_0(_) -> void.
-q2_2_p_0(_) -> void.
-r_2_p_0(_) -> void.
-r2_2_p_0(_) -> void.
-").
+:- pragma no_inline(r2/2).
+
+r2(!FG).
% This is a regression test: a previous version of the compiler
% reported a spurious mode error because after `F0 = f(_)' it
diff --git a/tests/valid/vn_float.m b/tests/valid/vn_float.m
index e74a873..06ddc83 100644
--- a/tests/valid/vn_float.m
+++ b/tests/valid/vn_float.m
@@ -104,42 +104,41 @@ get_angles_from_z_axis(Vec, Theta, Phi) :-
:- pred move_vertices_to_plane(list(int), array(vec3), vec3, mat3, list(vec3)).
:- mode move_vertices_to_plane(in, in, in, in, out) is det.
-:- external(move_vertices_to_plane/5).
+:- pragma no_inline(move_vertices_to_plane/5).
+
+move_vertices_to_plane(_, _, _, _, []).
:- func unit(vec3) = vec3.
+:- pragma no_inline(unit/1).
-:- external(unit/1).
+unit(V) = V.
:- func cross(vec3, vec3) = vec3.
+:- pragma no_inline(cross/2).
-:- external(cross/2).
+cross(V, _) = V.
:- func '-'(vec3, vec3) = vec3.
+:- pragma no_inline(('-')/2).
-:- external(('-')/2).
+V - _ = V.
:- func '-'(vec3) = vec3.
+:- pragma no_inline(('-')/1).
-:- external(('-')/1).
+-V = V.
:- func mag(vec3) = float.
+:- pragma no_inline(mag/1).
-:- external(mag/1).
+mag(_) = 42.0.
:- func '*'(vec3, mat3) = vec3.
+:- pragma no_inline('*'/2).
-:- external('*'/2).
+V * _ = V.
:- func matmult(mat3, mat3) = mat3.
+:- pragma no_inline(matmult/2).
-:- external(matmult/2).
-
-:- pragma foreign_code("Erlang", "
- move_vertices_to_plane_5_p_0(_, _, _, _) -> void.
- unit_1_f_0(_) -> void.
- cross_2_f_0(_, _) -> void.
- '-_2_f_0'(_, _) -> void.
- '-_1_f_0'(_) -> void.
- mag_1_f_0(_) -> void.
- matmult_2_f_0(_, _) -> void.
-").
+matmult(M, _) = M.
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list