[m-rev.] for review: fix problems with array.shrink/3

[Julien Fischer]

For review by anyone.

This fixes the issue marked JJJ in my previous commit.

--------------------------

Fix problems with array.shrink/3.

The behaviour of array.shrink/3 was not defined if its first argument was
negative.  If this occurred, the C backends would return an empty array, while
the non-C backends would abort.  This diff changes the behaviour of shrink/3 so
that it throws an exception if its first argument is negative.

The implementation of shrink/3 for the Java backend did not handle the case
where the array's element type was represented by the one the following Java
primitive types: byte, short, long and float.  Handle those cases.

library/array.m:
    Make the above fixes.

    Fix a typo in my previous commit.

NEWS:
    Note the change in behaviour if the first argument of shrink/3 is
    negative.

tests/hard_coded/Mmakefile:
tests/hard_coded/array_shrink.{m,exp}:
    Add a test case.

Julien.

diff --git a/NEWS b/NEWS
index 30a2292..fd13775 100644
--- a/NEWS
+++ b/NEWS
@@ -120,6 +120,9 @@ Changes that may break compatibility:
  * We have changed the semantics of array.map_corresponding_foldl/6 so that it
    throws an exception if the input arrays differ in size.

+* We have changed the semantics of array.shrink/3 so that it throws an
+  exception if its first argument is negative.
+
  Changes to the Mercury language:

  * We have added a new primitive type, uint, which is an unsigned integer type
diff --git a/library/array.m b/library/array.m
index a4dea56..b492df0 100644
--- a/library/array.m
+++ b/library/array.m
@@ -365,14 +365,16 @@

      % shrink(Size, Array0, Array):
      % The array is shrunk to make it fit the new size `Size'.
-    % Throws an exception if `Size' is larger than the size of `Array0'.
+    % Throws an exception if `Size' is larger than the size of `Array0' or
+    % if `Size' < 0.
      %
  :- pred shrink(int, array(T), array(T)).
  :- mode shrink(in, array_di, array_uo) is det.

      % shrink(Array0, Size) = Array:
      % The array is shrunk to make it fit the new size `Size'.
-    % Throws an exception if `Size' is larger than the size of `Array0'.
+    % Throws an exception if `Size' is larger than the size of `Array0' or
+    % if `Size' < 0.
      %
  :- func shrink(array(T), int) = array(T).
  :- mode shrink(array_di, in) = array_uo is det.
@@ -384,7 +386,7 @@

      % fill_range(Item, Lo, Hi, !Array):
      % Sets every element of the array with index in the range Lo..Hi
-    % (inclusive) to Item. Throws a software_error1/ exception if Lo > Hi.
+    % (inclusive) to Item. Throws a software_error/1 exception if Lo > Hi.
      % Throws an index_out_of_bound/0 exception if Lo or Hi is out of bounds.
      %
  :- pred fill_range(T::in, int::in, int::in,
@@ -2046,7 +2048,9 @@ shrink(!.Array, N) = !:Array :-

  shrink(Size, !Array) :-
      OldSize = array.size(!.Array),
-    ( if Size > OldSize then
+    ( if Size < 0 then
+        unexpected($pred, "cannot shrink to a negative size")
+    else if Size > OldSize then
          unexpected($pred, "cannot shrink to a larger size")
      else if Size = OldSize then
          true
@@ -2083,7 +2087,6 @@ shrink(Size, !Array) :-
      Array = list_to_tuple(lists:sublist(tuple_to_list(Array0), Size))
  ").

-% JJJ FIXME: why don't we handle the other primitive types below.
  :- pragma foreign_proc("Java",
      shrink_2(Size::in, Array0::array_di, Array::array_uo),
      [will_not_call_mercury, promise_pure, thread_safe],
@@ -2094,8 +2097,16 @@ shrink(Size, !Array) :-
          Array = new int[Size];
      } else if (Array0 instanceof double[]) {
          Array = new double[Size];
+    } else if (Array0 instanceof byte[]) {
+        Array = new byte[Size];
+    } else if (Array0 instanceof short[]) {
+        Array = new short[Size];
+    } else if (Array0 instanceof long[]) {
+        Array = new long[Size];
      } else if (Array0 instanceof char[]) {
          Array = new char[Size];
+    } else if (Array0 instanceof float[]) {
+        Array = new float[Size];
      } else if (Array0 instanceof boolean[]) {
          Array = new boolean[Size];
      } else {
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 3df1bcb..50b9a01 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -672,6 +672,7 @@ ifeq "$(findstring profdeep,$(GRADE))" ""
  	NON_PROFDEEP_PROGS = \
  		$(NON_PROFDEEP_PROGS_2) \
  		array_fill \
+		array_shrink \
  		allow_stubs \
  		arith_int16 \
  		arith_int32 \
diff --git a/tests/hard_coded/array_shrink.exp b/tests/hard_coded/array_shrink.exp
index e69de29..f51004b 100644
--- a/tests/hard_coded/array_shrink.exp
+++ b/tests/hard_coded/array_shrink.exp
@@ -0,0 +1,76 @@
+================
+Array0 = array([1, 2, 3, 4])
+Size = -1
+EXCEPTION: "predicate `array.shrink\'/3: Unexpected: cannot shrink to a negative size"
+================
+Array0 = array([1, 2, 3, 4])
+Size = 0
+Array = array([])
+================
+Array0 = array([1, 2, 3, 4])
+Size = 3
+Array = array([1, 2, 3])
+================
+Array0 = array([1, 2, 3, 4])
+Size = 4
+Array = array([1, 2, 3, 4])
+================
+Array0 = array([1, 2, 3, 4])
+Size = 5
+EXCEPTION: "predicate `array.shrink\'/3: Unexpected: cannot shrink to a larger size"
+================
+Array0 = array([1i8, 2i8, 3i8, 4i8])
+Size = 3
+Array = array([1i8, 2i8, 3i8])
+================
+Array0 = array([1u8, 2u8, 3u8, 4u8])
+Size = 3
+Array = array([1u8, 2u8, 3u8])
+================
+Array0 = array([1i16, 2i16, 3i16, 4i16])
+Size = 3
+Array = array([1i16, 2i16, 3i16])
+================
+Array0 = array([1u16, 2u16, 3u16, 4u16])
+Size = 3
+Array = array([1u16, 2u16, 3u16])
+================
+Array0 = array([1i32, 2i32, 3i32, 4i32])
+Size = 3
+Array = array([1i32, 2i32, 3i32])
+================
+Array0 = array([1u32, 2u32, 3u32, 4u32])
+Size = 3
+Array = array([1u32, 2u32, 3u32])
+================
+Array0 = array([1i64, 2i64, 3i64, 4i64])
+Size = 3
+Array = array([1i64, 2i64, 3i64])
+================
+Array0 = array([1u64, 2u64, 3u64, 4u64])
+Size = 3
+Array = array([1u64, 2u64, 3u64])
+================
+Array0 = array([1.0, 2.0, 3.0, 4.0])
+Size = 3
+Array = array([1.0, 2.0, 3.0])
+================
+Array0 = array(["one", "two", "three", "four"])
+Size = 3
+Array = array(["one", "two", "three"])
+================
+Array0 = array(['a', 'b', 'c', 'd'])
+Size = 3
+Array = array(['a', 'b', 'c'])
+================
+Array0 = array([orange, lemon, apple, pear])
+Size = 3
+Array = array([orange, lemon, apple])
+================
+Array0 = array([color(1u8, 1u8, 1u8), color(2u8, 2u8, 2u8), color(3u8, 3u8, 3u8), color(4u8, 4u8, 4u8)])
+Size = 3
+Array = array([color(1u8, 1u8, 1u8), color(2u8, 2u8, 2u8), color(3u8, 3u8, 3u8)])
+================
+Array0 = array([[1], [2, 2], [3, 3, 3], [4, 4, 4, 4]])
+Size = 3
+Array = array([[1], [2, 2], [3, 3, 3]])
diff --git a/tests/hard_coded/array_shrink.m b/tests/hard_coded/array_shrink.m
index e69de29..11a5956 100644
--- a/tests/hard_coded/array_shrink.m
+++ b/tests/hard_coded/array_shrink.m
@@ -0,0 +1,73 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+%
+% Test array.shrink/3.
+%
+%---------------------------------------------------------------------------%
+
+:- module array_shrink.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module array.
+:- import_module exception.
+:- import_module list.
+
+:- type fruit
+    --->    orange
+    ;       lemon
+    ;       apple
+    ;       pear.
+
+:- type color
+    --->    color(uint8, uint8, uint8).
+
+main(!IO) :-
+    test_shrink([1, 2, 3, 4], -1, !IO), % Should raise exception.
+    test_shrink([1, 2, 3, 4], 0, !IO),
+    test_shrink([1, 2, 3, 4], 3, !IO),
+    test_shrink([1, 2, 3, 4], 4, !IO),
+    test_shrink([1, 2, 3, 4], 5, !IO),  % Should raise exception.
+    test_shrink([1i8, 2i8, 3i8, 4i8], 3, !IO),
+    test_shrink([1u8, 2u8, 3u8, 4u8], 3, !IO),
+    test_shrink([1i16, 2i16, 3i16, 4i16], 3, !IO),
+    test_shrink([1u16, 2u16, 3u16, 4u16], 3, !IO),
+    test_shrink([1i32, 2i32, 3i32, 4i32], 3, !IO),
+    test_shrink([1u32, 2u32, 3u32, 4u32], 3, !IO),
+    test_shrink([1i64, 2i64, 3i64, 4i64], 3, !IO),
+    test_shrink([1u64, 2u64, 3u64, 4u64], 3, !IO),
+    test_shrink([1.0, 2.0, 3.0, 4.0], 3, !IO),
+    test_shrink(["one", "two", "three", "four"], 3, !IO),
+    test_shrink(['a', 'b', 'c', 'd'], 3, !IO),
+    test_shrink([orange, lemon, apple, pear], 3, !IO),
+    test_shrink([color(1u8, 1u8, 1u8), color(2u8, 2u8, 2u8),
+        color(3u8, 3u8, 3u8), color(4u8, 4u8, 4u8)], 3, !IO),
+    test_shrink([[1], [2, 2], [3, 3, 3], [4, 4, 4, 4]], 3, !IO).
+
+:- pred test_shrink(list(T)::in, int::in, io::di, io::uo) is cc_multi.
+
+test_shrink(Elems, Size, !IO) :-
+    io.write_string("================\n", !IO),
+    array.from_list(Elems, Array0),
+    io.write_string("Array0 = ", !IO),
+    io.write_line(Array0, !IO),
+    io.write_string("Size = ", !IO),
+    io.write_line(Size, !IO),
+    ( try [] (
+        array.shrink(Size, Array0, Array)
+    ) then
+        io.write_string("Array = ", !IO),
+        io.write_line(Array, !IO)
+    catch software_error(S) ->
+        io.write_string("EXCEPTION: ", !IO),
+        io.write_line(S, !IO)
+    ).