[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