Merge pull request #1173 from mshinwell/pr7533-4.05

Correctly perform side effects for "/" and "mod" (PR#7533)

Changes

@@ -246,6 +246,10 @@ Next major version (4.05.0):
   (Stephen Dolan, review by Gabriel Scherer, Pierre Chambart,
   Mark Shinwell, and bug report by Gabriel Scherer)
 
+- PR#7533, GPR#1173: Correctly perform side effects for certain
+  cases of "/" and "mod"
+  (Mark Shinwell, report by Mantis user jmi)
+
 ### Runtime system:
 
 - MPR#385, GPR#953: Add caml_startup_exn

asmcomp/cmmgen.ml

@@ -409,9 +409,10 @@ let rec div_int c1 c2 is_safe dbg =
       Cop(Cdivi, [c1; c2], dbg)
   | (c1, c2) ->
       bind "divisor" c2 (fun c2 ->
-        Cifthenelse(c2,
-                    Cop(Cdivi, [c1; c2], dbg),
-                    raise_symbol dbg "caml_exn_Division_by_zero"))
+        bind "dividend" c1 (fun c1 ->
+          Cifthenelse(c2,
+                      Cop(Cdivi, [c1; c2], dbg),
+                      raise_symbol dbg "caml_exn_Division_by_zero")))
 
 let mod_int c1 c2 is_safe dbg =
   match (c1, c2) with
@@ -445,9 +446,10 @@ let mod_int c1 c2 is_safe dbg =
       Cop(Cmodi, [c1; c2], dbg)
   | (c1, c2) ->
       bind "divisor" c2 (fun c2 ->
-        Cifthenelse(c2,
-                    Cop(Cmodi, [c1; c2], dbg),
-                    raise_symbol dbg "caml_exn_Division_by_zero"))
+        bind "dividend" c1 (fun c1 ->
+          Cifthenelse(c2,
+                      Cop(Cmodi, [c1; c2], dbg),
+                      raise_symbol dbg "caml_exn_Division_by_zero")))
 
 (* Division or modulo on boxed integers.  The overflow case min_int / -1
    can occur, in which case we force x / -1 = -x and x mod -1 = 0. (PR#5513). *)

testsuite/tests/basic/pr7533.ml

@@ -0,0 +1,19 @@
+(* PR#7533 *)
+
+exception Foo
+
+let f x =
+  if x > 42 then 1
+  else raise Foo
+
+let () =
+  let f = Sys.opaque_identity f in
+  match (f 0) / (List.hd (Sys.opaque_identity [0])) with
+  | exception Foo -> ()
+  | _ -> assert false
+
+let () =
+  let f = Sys.opaque_identity f in
+  match (f 0) mod (List.hd (Sys.opaque_identity [0])) with
+  | exception Foo -> ()
+  | _ -> assert false