diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml index 42c2dd05cd..8cb2de2a4a 100644 --- a/compiler/lib/stdlib.ml +++ b/compiler/lib/stdlib.ml @@ -307,23 +307,25 @@ module Int32 = struct external equal : int32 -> int32 -> bool = "%equal" - let warn_overflow ~to_dec ~to_hex i i32 = + let warn_overflow name ~to_dec ~to_hex i i32 = warn - "Warning: integer overflow: integer 0x%s (%s) truncated to 0x%lx (%ld); the \ - generated code might be incorrect.@." + "Warning: integer overflow: %s 0x%s (%s) truncated to 0x%lx (%ld); the generated \ + code might be incorrect.@." + name (to_hex i) (to_dec i) i32 i32 - let convert_warning_on_overflow ~to_int32 ~of_int32 ~equal ~to_dec ~to_hex x = + let convert_warning_on_overflow name ~to_int32 ~of_int32 ~equal ~to_dec ~to_hex x = let i32 = to_int32 x in let x' = of_int32 i32 in - if not (equal x' x) then warn_overflow ~to_dec ~to_hex x i32; + if not (equal x' x) then warn_overflow name ~to_dec ~to_hex x i32; i32 let of_nativeint_warning_on_overflow n = convert_warning_on_overflow + "native integer" ~to_int32:Nativeint.to_int32 ~of_int32:Nativeint.of_int32 ~equal:Nativeint.equal diff --git a/compiler/lib/targetint.ml b/compiler/lib/targetint.ml index 1d906e5ffe..5a79678e9e 100644 --- a/compiler/lib/targetint.ml +++ b/compiler/lib/targetint.ml @@ -122,6 +122,7 @@ let of_float_opt x = let of_int_warning_on_overflow i = Stdlib.Int32.convert_warning_on_overflow + "integer" ~to_int32:(fun i -> wrap_modulo (Int32.of_int i)) ~of_int32:Int32.to_int ~equal:Int.equal @@ -131,6 +132,7 @@ let of_int_warning_on_overflow i = let of_int32_warning_on_overflow n = Stdlib.Int32.convert_warning_on_overflow + "int32" ~to_int32:(fun i -> wrap_modulo i) ~of_int32:Fun.id ~equal:Int32.equal @@ -140,6 +142,7 @@ let of_int32_warning_on_overflow n = let of_nativeint_warning_on_overflow n = Stdlib.Int32.convert_warning_on_overflow + "native integer" ~to_int32:(fun i -> wrap_modulo (Nativeint.to_int32 i)) ~of_int32:Nativeint.of_int32 ~equal:Nativeint.equal diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc index 2e5db3e098..b1a61b3664 100644 --- a/compiler/tests-compiler/dune.inc +++ b/compiler/tests-compiler/dune.inc @@ -287,11 +287,11 @@ (library ;; compiler/tests-compiler/gh1051.ml (name gh1051_15) - (enabled_if true) + (enabled_if %{arch_sixtyfour}) (modules gh1051) (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper) (inline_tests - (enabled_if true) + (enabled_if %{arch_sixtyfour}) (deps (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe) (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe))) diff --git a/compiler/tests-compiler/gen-rules/gen.ml b/compiler/tests-compiler/gen-rules/gen.ml index a74855765d..7a216c040a 100644 --- a/compiler/tests-compiler/gen-rules/gen.ml +++ b/compiler/tests-compiler/gen-rules/gen.ml @@ -47,14 +47,17 @@ let prefix : string = type enabled_if = | GE5 + | B64 | Any let lib_enabled_if = function | "obj" | "effects" -> GE5 + | "gh1051" -> B64 | _ -> Any let test_enabled_if = function | "obj" | "lazy" -> GE5 + | "gh1051" -> B64 | _ -> Any let () = @@ -86,8 +89,10 @@ let () = (Hashtbl.hash prefix mod 100) (match lib_enabled_if basename with | Any -> "true" - | GE5 -> "(>= %{ocaml_version} 5)") + | GE5 -> "(>= %{ocaml_version} 5)" + | B64 -> "%{arch_sixtyfour}") basename (match test_enabled_if basename with | Any -> "true" - | GE5 -> "(>= %{ocaml_version} 5)")) + | GE5 -> "(>= %{ocaml_version} 5)" + | B64 -> "%{arch_sixtyfour}")) diff --git a/compiler/tests-compiler/gh1051.ml b/compiler/tests-compiler/gh1051.ml index 02045f8072..31030ffece 100644 --- a/compiler/tests-compiler/gh1051.ml +++ b/compiler/tests-compiler/gh1051.ml @@ -25,19 +25,21 @@ let%expect_test _ = Util.compile_and_run ~skip_modern:true prog; [%expect {| -Warning: integer overflow: integer 0xffffffff (4294967295) truncated to 0xffffffff (-1); the generated code might be incorrect. -ffffffff |}]; + Warning: integer overflow: native integer 0xffffffff (4294967295) truncated to 0xffffffff (-1); the generated code might be incorrect. + ffffffff + |}]; () let%expect_test _ = Util.print_fun_decl (Util.compile_and_parse prog) None; [%expect {| - Warning: integer overflow: integer 0xffffffff (4294967295) truncated to 0xffffffff (-1); the generated code might be incorrect. + Warning: integer overflow: native integer 0xffffffff (4294967295) truncated to 0xffffffff (-1); the generated code might be incorrect. function caml_call2(f, a0, a1){ return (f.l >= 0 ? f.l : f.l = f.length) == 2 ? f(a0, a1) : runtime.caml_call_gen(f, [a0, a1]); } - //end |}]; + //end + |}]; () diff --git a/compiler/tests-compiler/pbt/test_int31.ml b/compiler/tests-compiler/pbt/test_int31.ml index 26211f4cd4..37f72d354c 100644 --- a/compiler/tests-compiler/pbt/test_int31.ml +++ b/compiler/tests-compiler/pbt/test_int31.ml @@ -59,6 +59,8 @@ let%expect_test _ = i); [%expect ""] +let sixty_four = Sys.int_size > 32 + let%expect_test _ = let i = Gen.(generate1 (no_shrink out_of_range_i32)) in let i_trunc = Int32.(shift_right (shift_left i 1) 1) in @@ -66,14 +68,14 @@ let%expect_test _ = let output = [%expect.output] in let expected = Format.sprintf - "Warning: integer overflow: integer 0x%lx (%ld) truncated to 0x%lx (%ld); the \ + "Warning: integer overflow: int32 0x%lx (%ld) truncated to 0x%lx (%ld); the \ generated code might be incorrect.@." i i i_trunc i_trunc in - if not (String.equal output expected) + if sixty_four && not (String.equal output expected) then Format.printf "Unexpected output string@.%s@.Expected:@.%s@." output expected; [%expect ""] @@ -91,7 +93,7 @@ let%expect_test _ = i_trunc i_trunc in - if not (String.equal output expected) + if sixty_four && not (String.equal output expected) then Format.printf "Unexpected output string@.%s@.Expected:@.%s@." output expected; [%expect ""] @@ -102,14 +104,14 @@ let%expect_test _ = let output = [%expect.output] in let expected = Format.sprintf - "Warning: integer overflow: integer 0x%nx (%nd) truncated to 0x%lx (%ld); the \ - generated code might be incorrect.@." + "Warning: integer overflow: native integer 0x%nx (%nd) truncated to 0x%lx (%ld); \ + the generated code might be incorrect.@." i i i_trunc i_trunc in - if not (String.equal output expected) + if sixty_four && not (String.equal output expected) then Format.printf "Unexpected output string@.%s@.Expected:@.%s@." output expected; [%expect ""]