[m-rev.] diff: allow testing of java grade
Peter Wang
novalazy at gmail.com
Fri Aug 14 16:14:40 AEST 2009
On 2009-08-14, Peter Wang <novalazy at gmail.com> wrote:
> Branches: main
>
> Allow testing of java grade. Requires using `mmc --make' for now.
> This patch does not attempt to fix test failures.
Some of the simpler fixes.
Branches: main
Some changes to the Java implementation of the standard library.
library/array.m:
Use System.arraycopy and java.util.Arrays.fill and avoid using
reflection to work with arrays in some places.
library/dir.m:
Implement dir.current_directory.
library/rtti_implementation.m:
Fix typos where expanded type_infos were not being used.
library/string.m:
Make string.c_pointer_to_string handle null pointers.
tests/hard_coded/sub-modules/Mmakefile:
Enable testing of java grade in this directory.
tests/hard_coded/sub-modules/non_word_mutable.m:
tests/hard_coded/sub-modules/sm_exp_bug.m:
Add Java foreign code.
diff --git a/library/array.m b/library/array.m
index ff93f52..cd4be96 100644
--- a/library/array.m
+++ b/library/array.m
@@ -626,22 +626,55 @@ ML_init_array(MR_ArrayPtr array, MR_Integer size, MR_Word item)
").
:- pragma foreign_code("Java", "
-static Object
-ML_new_array(int Size, Object Item)
+public static Object
+ML_new_array(int Size, Object Item, boolean fill)
{
+ if (Size == 0) {
+ return null;
+ }
if (Item instanceof Integer) {
- return new int[Size];
+ int[] as = new int[Size];
+ if (fill) {
+ java.util.Arrays.fill(as, (Integer) Item);
+ }
+ return as;
}
if (Item instanceof Double) {
- return new double[Size];
+ double[] as = new double[Size];
+ if (fill) {
+ java.util.Arrays.fill(as, (Double) Item);
+ }
+ return as;
}
if (Item instanceof Character) {
- return new char[Size];
+ char[] as = new char[Size];
+ if (fill) {
+ java.util.Arrays.fill(as, (Character) Item);
+ }
+ return as;
}
if (Item instanceof Boolean) {
- return new boolean[Size];
+ boolean[] as = new boolean[Size];
+ if (fill) {
+ java.util.Arrays.fill(as, (Boolean) Item);
+ }
+ return as;
+ }
+ Object[] as = new Object[Size];
+ if (fill) {
+ java.util.Arrays.fill(as, Item);
+ }
+ return as;
+}
+
+public static int
+ML_array_size(Object Array)
+{
+ if (Array == null) {
+ return 0;
+ } else {
+ return java.lang.reflect.Array.getLength(Array);
}
- return new Object[Size];
}
").
@@ -716,10 +749,7 @@ array.init(Size, Item, Array) :-
array.init_2(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
- Array = ML_new_array(Size, Item);
- for (int i = 0; i < Size; i++) {
- java.lang.reflect.Array.set(Array, i, Item);
- }
+ Array = array.ML_new_array(Size, Item, true);
").
:- pragma foreign_proc("Java",
array.make_empty_array(Array::array_uo),
@@ -793,7 +823,7 @@ array.init(Size, Item, Array) :-
[will_not_call_mercury, promise_pure, thread_safe],
"
if (Array != null) {
- Max = java.lang.reflect.Array.getLength(Array) - 1;
+ Max = array.ML_array_size(Array) - 1;
} else {
Max = -1;
}
@@ -1078,22 +1108,16 @@ ML_resize_array(MR_ArrayPtr array, MR_ArrayPtr old_array,
if (Size == 0) {
Array = null;
} else if (Array0 == null) {
- Array = ML_new_array(Size, Item);
- for (int i = 0; i < Size; i++) {
- java.lang.reflect.Array.set(Array, i, Item);
- }
- } else if (java.lang.reflect.Array.getLength(Array0) == Size) {
+ Array = array.ML_new_array(Size, Item, true);
+ } else if (array.ML_array_size(Array0) == Size) {
Array = Array0;
} else {
- Array = ML_new_array(Size, Item);
+ Array = array.ML_new_array(Size, Item, false);
int i;
- for (i = 0; i < java.lang.reflect.Array.getLength(Array0) &&
- i < Size; i++)
- {
+ for (i = 0; i < array.ML_array_size(Array0) && i < Size; i++) {
java.lang.reflect.Array.set(Array, i,
- java.lang.reflect.Array.get(Array0, i)
- );
+ java.lang.reflect.Array.get(Array0, i));
}
for (/*i = Array0.length*/; i < Size; i++) {
java.lang.reflect.Array.set(Array, i, Item);
@@ -1183,14 +1207,20 @@ array.shrink(Array0, Size, Array) :-
"
if (Array0 == null) {
Array = null;
+ } else if (Array0 instanceof int[]) {
+ Array = new int[Size];
+ } else if (Array0 instanceof double[]) {
+ Array = new double[Size];
+ } else if (Array0 instanceof char[]) {
+ Array = new char[Size];
+ } else if (Array0 instanceof boolean[]) {
+ Array = new boolean[Size];
} else {
- java.lang.Class itemClass =
- java.lang.reflect.Array.get(Array0, 0).getClass();
- Array = java.lang.reflect.Array.newInstance(itemClass, Size);
- for (int i = 0; i < Size; i++) {
- java.lang.reflect.Array.set(Array, i,
- java.lang.reflect.Array.get(Array0, i));
+ Array = new Object[Size];
}
+
+ if (Array != null) {
+ System.arraycopy(Array0, 0, Array, 0, Size);
}
").
@@ -1259,17 +1289,30 @@ ML_copy_array(MR_ArrayPtr array, MR_ConstArrayPtr old_array)
array.copy(Array0::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
+ int Size;
+
if (Array0 == null) {
Array = null;
+ Size = 0;
+ } else if (Array0 instanceof int[]) {
+ Size = ((int[]) Array0).length;
+ Array = new int[Size];
+ } else if (Array0 instanceof double[]) {
+ Size = ((double[]) Array0).length;
+ Array = new double[Size];
+ } else if (Array0 instanceof char[]) {
+ Size = ((double[]) Array0).length;
+ Array = new char[Size];
+ } else if (Array0 instanceof boolean[]) {
+ Size = ((boolean[]) Array0).length;
+ Array = new boolean[Size];
} else {
- java.lang.Class itemClass =
- java.lang.reflect.Array.get(Array0, 0).getClass();
- int length = java.lang.reflect.Array.getLength(Array0);
- Array = java.lang.reflect.Array.newInstance(itemClass, length);
- for (int i = 0; i < length; i++) {
- java.lang.reflect.Array.set(Array, i,
- java.lang.reflect.Array.get(Array0, i));
+ Size = ((boolean[]) Array0).length;
+ Array = new Object[Size];
}
+
+ if (Array != null) {
+ System.arraycopy(Array0, 0, Array, 0, Size);
}
").
diff --git a/library/dir.m b/library/dir.m
index 15d7433..2c7d5a5 100644
--- a/library/dir.m
+++ b/library/dir.m
@@ -872,6 +872,20 @@ dir.relative_path_name_from_components(Components) = PathName :-
IO = IO0;
").
+:- pragma foreign_proc("Java",
+ dir.current_directory(Res::out, _IO0::di, _IO::uo),
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
+ may_not_duplicate],
+"
+ java.io.File dir = new java.io.File(""."");
+ try {
+ Res = io.ML_make_io_res_1_ok_string(dir.getCanonicalPath());
+ } catch (Exception e) {
+ Res = io.ML_make_io_res_1_error_string(e,
+ ""dir.current_directory failed: "");
+ }
+").
+
:- pragma foreign_proc("Erlang",
dir.current_directory(Res::out, _IO0::di, _IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
diff --git a/library/rtti_implementation.m b/library/rtti_implementation.m
index d5e85c1..96bd622 100644
--- a/library/rtti_implementation.m
+++ b/library/rtti_implementation.m
@@ -909,7 +909,7 @@ compare_type_infos(Res, TypeInfo1, TypeInfo2) :-
( same_pointer_value(NewTypeInfo1, NewTypeInfo2) ->
Res = (=)
;
- compare_collapsed_type_infos(Res, TypeInfo1, TypeInfo2)
+ compare_collapsed_type_infos(Res, NewTypeInfo1, NewTypeInfo2)
)
).
@@ -1605,7 +1605,7 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
NewTypeInfo = collapse_equivalences(TypeInfo),
NewTypeCtorInfo = get_type_ctor_info(NewTypeInfo),
NewTypeCtorRep = get_type_ctor_rep(NewTypeCtorInfo),
- deconstruct_2(Term, TypeInfo, NewTypeCtorInfo, NewTypeCtorRep,
+ deconstruct_2(Term, NewTypeInfo, NewTypeCtorInfo, NewTypeCtorRep,
NonCanon, Functor, Arity, Arguments)
;
% XXX noncanonical term
diff --git a/library/string.m b/library/string.m
index 6b3c11f..687565d 100644
--- a/library/string.m
+++ b/library/string.m
@@ -1236,7 +1236,11 @@ string.c_pointer_to_string(C_Pointer, Str) :-
[will_not_call_mercury, promise_pure, thread_safe],
"
/* Within the spirit of the function, at least. */
+ if (C_Pointer == null) {
+ Str = ""null"";
+ } else {
Str = C_Pointer.toString();
+ }
").
string.int_to_string_thousands(N) =
diff --git a/tests/hard_coded/sub-modules/Mmakefile b/tests/hard_coded/sub-modules/Mmakefile
index 7ef86d6..293b35d 100644
--- a/tests/hard_coded/sub-modules/Mmakefile
+++ b/tests/hard_coded/sub-modules/Mmakefile
@@ -40,12 +40,7 @@ else
SOLVER_PROGS =
endif
-# We currently don't do any testing in grade java on this directory.
-ifneq "$(findstring java,$(GRADE))" ""
- PROGS=
-else
- PROGS=$(SUB_MODULE_PROGS) $(SOLVER_PROGS)
-endif
+PROGS=$(SUB_MODULE_PROGS) $(SOLVER_PROGS)
TESTS = $(PROGS)
TESTS_DIR=../..
diff --git a/tests/hard_coded/sub-modules/non_word_mutable.m b/tests/hard_coded/sub-modules/non_word_mutable.m
index 4e77c5d..76322c9 100644
--- a/tests/hard_coded/sub-modules/non_word_mutable.m
+++ b/tests/hard_coded/sub-modules/non_word_mutable.m
@@ -22,6 +22,7 @@
:- type coord.
:- pragma foreign_type(c, coord, "coord *").
+:- pragma foreign_type("Java", coord, "coord").
:- pragma foreign_type("Erlang", coord, "").
:- pragma foreign_decl(c, "
@@ -30,7 +31,15 @@ typedef struct {
} coord;
").
+:- pragma foreign_decl("Java", "
+class coord {
+ public int x, y;
+}
+").
+
:- func new_coord(int, int) = coord.
+:- func x(coord) = int.
+:- func y(coord) = int.
:- pragma foreign_proc(c,
new_coord(X::in, Y::in) = (C::out),
@@ -41,9 +50,6 @@ typedef struct {
C->y = Y;
").
-:- func x(coord) = int.
-:- func y(coord) = int.
-
:- pragma foreign_proc(c,
x(C::in) = (X::out),
[will_not_call_mercury, promise_pure],
@@ -58,6 +64,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/sub-modules/sm_exp_bug.m b/tests/hard_coded/sub-modules/sm_exp_bug.m
index bc59fe7..a6f86bd 100644
--- a/tests/hard_coded/sub-modules/sm_exp_bug.m
+++ b/tests/hard_coded/sub-modules/sm_exp_bug.m
@@ -28,6 +28,14 @@ main(!IO) :-
IO = IO0;
").
+:- pragma foreign_proc("Java",
+ call_foreign(IO0::di, IO::uo),
+ [may_call_mercury, promise_pure],
+"
+ WRITE_HELLO();
+ IO = IO0;
+").
+
:- pragma foreign_proc("Erlang",
call_foreign(_IO0::di, _IO::uo),
[may_call_mercury, promise_pure],
@@ -36,6 +44,7 @@ main(!IO) :-
").
:- pragma foreign_export("C", write_hello(di, uo), "WRITE_HELLO").
+:- pragma foreign_export("Java", write_hello(di, uo), "WRITE_HELLO").
:- pragma foreign_export("Erlang", write_hello(di, uo), "WRITE_HELLO").
:- pred write_hello(io::di, io::uo) is det.
write_hello(!IO) :-
--------------------------------------------------------------------------
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