Runtime: check upper bound during array creation

CHANGES.md

@@ -21,6 +21,7 @@
 * Runtime: no longer leak channels
 * Runtime: Fix Marshal.to_buffer (#1798)
 * Runtime: unmarshalling objects should refresh its id
+* Runtime: check size upper bound during array creation
 
 # 5.9.1 (02-12-2024) - Lille
 

compiler/tests-ocaml/lib-floatarray/floatarray.ml

@@ -107,9 +107,9 @@ module Test (A : S) : sig end = struct
   check_inval (fun i -> A.set a i 1.0) (-1);
   check_inval (fun i -> A.set a i 1.0) 1000;
   check_inval A.create (-1);
-  (* check_inval A.create (A.max_length + 1);*)
+  check_inval A.create (A.max_length + 1);
   check_inval (fun i -> A.make i 1.0) (-1);
-  (* check_inval (fun i -> A.make i 1.0) (A.max_length + 1); *)
+  check_inval (fun i -> A.make i 1.0) (A.max_length + 1);
 
   (* [length] *)
   let test_length l = assert (l = (A.length (A.create l))) in
@@ -125,8 +125,7 @@ module Test (A : S) : sig end = struct
   let a = A.init 1000 Float.of_int in
   check_i a;
   check_inval (fun i -> A.init i Float.of_int) (-1);
-  (* check_inval (fun i -> A.init i Float.of_int) (A.max_length + 1); *)
-
+  check_inval (fun i -> A.init i Float.of_int) (A.max_length + 1);
 
   (* [make_matrix] *)
   let check_make_matrix m n =
@@ -641,8 +640,7 @@ module Test (A : S) : sig end = struct
     assert (compare value value' = 0)
   in
   let l = [0.; 0.25; -4.; 3.14159265; nan; infinity; neg_infinity; neg_zero] in
-  (* js_of_ocaml doesn't marshal floats *)
-  if false then test_structured_io (A.of_list l);
+  test_structured_io (A.of_list l);
 
   (* map_inplace *)
   let a = A.init 4 (fun i -> Float.of_int (i + 1)) in

runtime/js/array.js

@@ -158,7 +158,7 @@ function caml_check_bound(array, index) {
 //Provides: caml_array_make const (const, mutable)
 //Requires: caml_array_bound_error
 function caml_array_make(len, init) {
-  if (len < 0) caml_array_bound_error();
+  if (len >>> 0 >= ((0x7fffffff / 4) | 0)) caml_array_bound_error();
   var len = (len + 1) | 0;
   var b = new Array(len);
   b[0] = 0;
@@ -175,7 +175,7 @@ function caml_make_vect(len, init) {
 //Provides: caml_make_float_vect const (const)
 //Requires: caml_array_bound_error
 function caml_make_float_vect(len) {
-  if (len < 0) caml_array_bound_error();
+  if (len >>> 0 >= ((0x7fffffff / 8) | 0)) caml_array_bound_error();
   var len = (len + 1) | 0;
   var b = new Array(len);
   b[0] = 254;
@@ -187,7 +187,7 @@ function caml_make_float_vect(len) {
 //Requires: caml_array_bound_error
 //Version: >= 5.3
 function caml_array_create_float(len) {
-  if (len < 0) caml_array_bound_error();
+  if (len >>> 0 >= ((0x7fffffff / 8) | 0)) caml_array_bound_error();
   var len = (len + 1) | 0;
   var b = new Array(len);
   b[0] = 254;
@@ -197,7 +197,7 @@ function caml_array_create_float(len) {
 //Provides: caml_floatarray_create const (const)
 //Requires: caml_array_bound_error
 function caml_floatarray_create(len) {
-  if (len < 0) caml_array_bound_error();
+  if (len >>> 0 >= ((0x7fffffff / 8) | 0)) caml_array_bound_error();
   var len = (len + 1) | 0;
   var b = new Array(len);
   b[0] = 254;
@@ -206,17 +206,22 @@ function caml_floatarray_create(len) {
 }
 
 //Provides: caml_floatarray_make const (const)
-//Requires: caml_array_make
+//Requires: caml_array_bound_error
 //Version: >= 5.3
 function caml_floatarray_make(len, init) {
-  return caml_array_make(len, init);
+  if (len >>> 0 >= ((0x7fffffff / 8) | 0)) caml_array_bound_error();
+  var len = (len + 1) | 0;
+  var b = new Array(len);
+  b[0] = 254;
+  for (var i = 1; i < len; i++) b[i] = init;
+  return b;
 }
 
 //Provides: caml_floatarray_make_unboxed const (const)
-//Requires: caml_array_make
+//Requires: caml_floatarray_make
 //Version: >= 5.3
 function caml_floatarray_make_unboxed(len, init) {
-  return caml_array_make(len, init);
+  return caml_floatarray_make(len, init);
 }
 
 //Provides: caml_uniform_array_make const (const)

runtime/wasm/array.wat

@@ -33,7 +33,7 @@
       (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
       (local $sz i32) (local $b (ref $block)) (local $f f64)
       (local.set $sz (i31.get_s (ref.cast (ref i31) (local.get $n))))
-      (if (i32.lt_s (local.get $sz) (i32.const 0))
+      (if (i32.ge_u (local.get $sz) (i32.const 0xfffffff))
          (then
             (call $caml_invalid_argument
                (array.new_data $string $Array_make
@@ -55,7 +55,7 @@
       (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
       (local $sz i32) (local $f f64)
       (local.set $sz (i31.get_s (ref.cast (ref i31) (local.get $n))))
-      (if (i32.lt_s (local.get $sz) (i32.const 0))
+      (if (i32.ge_u (local.get $sz) (i32.const 0x7ffffff))
          (then
             (call $caml_invalid_argument
                (array.new_data $string $Array_make
@@ -72,7 +72,7 @@
       (param $n (ref eq)) (result (ref eq))
       (local $sz i32)
       (local.set $sz (i31.get_s (ref.cast (ref i31) (local.get $n))))
-      (if (i32.lt_s (local.get $sz) (i32.const 0))
+      (if (i32.ge_u (local.get $sz) (i32.const 0x7ffffff))
          (then
             (call $caml_invalid_argument
                (array.new_data $string $Array_make