Fix: static eval of String.get (#770)

Author: hhugo

compiler/lib/eval.ml

@@ -131,8 +131,9 @@ let eval_prim x =
       | "caml_tan_float", _ -> float_unop l tan
       | ("caml_string_get" | "caml_string_unsafe_get"), [(String s | IString s); Int pos]
         ->
-          if Config.Flag.safe_string () && String.length s > Int.to_int pos
-          then Some (Int (Int.of_int (Char.code s.[Int.to_int pos])))
+          let pos = Int.to_int pos in
+          if Config.Flag.safe_string () && pos >= 0 && pos < String.length s
+          then Some (Int (Int.of_int (Char.code s.[pos])))
           else None
       | "caml_string_equal", [String s1; String s2] -> bool (s1 = s2)
       | "caml_string_notequal", [String s1; String s2] -> bool (s1 <> s2)

compiler/tests/expect_tests/static_eval.ml

@@ -0,0 +1,49 @@
+(* Js_of_ocaml tests
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2019 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+*)
+
+open Util
+
+let%expect_test "static eval of string get" =
+  let cmo =
+    compile_ocaml_to_bytecode
+      {|
+    let lr = ref []
+    let black_box v = lr := (Obj.repr v) :: !lr
+
+    let constant = "abcdefghijklmnopqrstuvwxyz"
+
+    let call_with_char c = black_box c
+
+    let ex = call_with_char constant.[-10] ;;
+    black_box ex
+    let ax = call_with_char constant.[6]  ;;
+    black_box ax
+    let bx = call_with_char constant.[30] ;;
+    black_box bx ;;
+  |}
+  in
+  let program = parse_js (print_compiled_js ~pretty:true cmo) in
+  print_var_decl program "ex";
+  print_var_decl program "ax";
+  print_var_decl program "bx";
+  [%expect
+    {|
+    var ex = call_with_char(caml_string_get(constant,- 10));
+    var ax = call_with_char(103);
+    var bx = call_with_char(caml_string_get(constant,30)); |}]

compiler/tests/expect_tests/util.ml

@@ -124,3 +124,16 @@ let expression_to_string ?(compact = false) e =
   Pretty_print.set_compact pp compact;
   Js_output.program pp e;
   Buffer.contents buffer
+
+let print_var_decl program n =
+  let {var_decls; _} =
+    find_javascript
+      ~var_decl:(function
+        | Javascript.S {name; _}, _ when name = n -> true
+        | _ -> false)
+      program
+  in
+  print_string (Format.sprintf "var %s = " n);
+  match var_decls with
+  | [(_, Some (expression, _))] -> print_string (expression_to_string expression)
+  | _ -> print_endline "not found"

compiler/tests/expect_tests/util.mli

@@ -38,3 +38,5 @@ val find_javascript :
   -> find_result
 
 val expression_to_string : ?compact:bool -> Javascript.expression -> string
+
+val print_var_decl : Javascript.program -> string -> unit

compiler/tests/expect_tests/variable_declaration_output.ml

@@ -18,20 +18,6 @@
 *)
 
 open Util
-module J = Js_of_ocaml_compiler.Javascript
-
-let print_var_decl program n =
-  let {var_decls; _} =
-    find_javascript
-      ~var_decl:(function
-        | J.S {name; _}, _ when name = n -> true
-        | _ -> false)
-      program
-  in
-  print_string (Format.sprintf "var %s = " n);
-  match var_decls with
-  | [(_, Some (expression, _))] -> print_string (expression_to_string expression)
-  | _ -> print_endline "not found"
 
 let%expect_test _ =
   let cmo =