Merge commit '2208a4cbe6f3c15add9dae87d15aae461ea6c6cc' into parallel_minor_gc_4_11b

13 files changed, 179 insertions, 88 deletions

diff --git a/Changes b/Changes
index 50dec067c7..94a834b815 100644
--- a/Changes
+++ b/Changes
@@ -66,8 +66,12 @@ Working version
 - #9280: Micro-optimise allocations on amd64 to save a register.
   (Stephen Dolan, review by Xavier Leroy)
 
-- #9316: Use typing information from Clambda for mutable Cmm variables.
-  (Stephen Dolan, review by Vincent Laviron, Guillaume Bury and Xavier Leroy)
+- #9316, #9443: Use typing information from Clambda for mutable Cmm variables.
+  (Stephen Dolan, review by Vincent Laviron, Guillaume Bury, Xavier Leroy,
+  and Gabriel Scherer)
+
+- #9426: build the Mingw ports with higher levels of GCC optimization
+  (Xavier Leroy, review by Sébastien Hinderer)
 
 ### Code generation and optimizations:
 
@@ -253,6 +257,9 @@ Working version
   (Gabriel Scherer, Thomas Refis, Florian Angeletti and Jacques Garrigue,
    reviewing each other without self-loops)
 
+- #9321, #9322, #9359, #9361, #9417: refactor the pattern-matching compiler
+  (Thomas Refis and Gabriel Scherer, review by Florian Angeletti)
+
 - #9211, #9215, #9222: fix Makefile dependencies in
   compilerlibs, dynlink, ocamltest.
   (Gabriel Scherer, review by Vincent Laviron and David Allsopp)
@@ -278,9 +285,19 @@ Working version
   may not match the one in bytecode.
   (Nicolás Ojeda Bär, report by Pierre Chambart, review by Gabriel Scherer)
 
+- #7696, #6608: Record expression deleted when all fields specified
+  (Jacques Garrigue, report by Jeremy Yallop)
+
+- #7917, #9426: Use GCC option -fexcess-precision=standard when available,
+  avoiding a problem with x87 excess precision in Float.round.
+  (Xavier Leroy, review by Sébastien Hinderer)
+
 - #9064: Relax the level handling when unifying row fields
   (Leo White, review by Jacques Garrigue)
 
+- #9068, #9437: ocamlopt -output-complete-obj failure on FreeBSD 12
+  (Xavier Leroy, report by Hannes Mehnert, review by Sébastien Hinderer)
+
 - #9097: Do not emit references to dead labels introduced by #2321 (spacetime).
   (Greta Yorsh, review by Mark Shinwell)
 
@@ -310,6 +327,14 @@ Working version
 - #9367: Make bytecode and native-code backtraces agree.
   (Stephen Dolan, review by Gabriel Scherer)
 
+- #9420: Fix memory leak when `caml_output_value_to_block` raises an exception
+  (Xavier Leroy, review by Guillaume Munch-Maccagnoni)
+
+- #9428: Fix truncated exception backtrace for C->OCaml callbacks
+  on Power and Z System
+  (Xavier Leroy, review by Nicolás Ojeda Bär)
+
+
 OCaml 4.10 maintenance branch
 -----------------------------
 
@@ -1614,6 +1639,9 @@ OCaml 4.08.0 (13 June 2019)
 - #8508: refresh \moduleref macro
   (Florian Angeletti, review by Gabriel Scherer)
 
+- 9410: replaced fibonacci example with gcd of coreexamples manual
+  (Anukriti Kumar, review by San Vu Ngoc, Florian Angeletti, Léo Andrès)
+
 ### Code generation and optimizations:
 
 - #7725, #1754: improve AFL instrumentation for objects and lazy values.
diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
index 848d7036dd..8a8ef462b0 100644
--- a/asmcomp/selectgen.ml
+++ b/asmcomp/selectgen.ml
@@ -692,11 +692,7 @@ method emit_expr (env:environment) exp =
   | Clet_mut(v, k, e1, e2) ->
       begin match self#emit_expr env e1 with
         None -> None
-      | Some r1 ->
-        let rv = Reg.createv k in
-        name_regs v rv;
-        self#insert_moves env r1 rv;
-        self#emit_expr (env_add ~mut:Mutable v rv env) e2
+      | Some r1 -> self#emit_expr (self#bind_let_mut env v k r1) e2
       end
   | Cphantom_let (_var, _defining_expr, body) ->
       self#emit_expr env body
@@ -916,6 +912,12 @@ method private bind_let (env:environment) v r1 =
     env_add v rv env
   end
 
+method private bind_let_mut (env:environment) v k r1 =
+  let rv = Reg.createv k in
+  name_regs v rv;
+  self#insert_moves env r1 rv;
+  env_add ~mut:Mutable v rv env
+
 (* The following two functions, [emit_parts] and [emit_parts_list], force
    right-to-left evaluation order as required by the Flambda [Un_anf] pass
    (and to be consistent with the bytecode compiler). *)
@@ -1075,6 +1077,11 @@ method emit_tail (env:environment) exp =
         None -> ()
       | Some r1 -> self#emit_tail (self#bind_let env v r1) e2
       end
+  | Clet_mut (v, k, e1, e2) ->
+     begin match self#emit_expr env e1 with
+       None -> ()
+     | Some r1 -> self#emit_tail (self#bind_let_mut env v k r1) e2
+     end
   | Cphantom_let (_var, _defining_expr, body) ->
       self#emit_tail env body
   | Cop((Capply ty) as op, args, dbg) ->
@@ -1210,8 +1217,14 @@ method emit_tail (env:environment) exp =
           self#insert_moves env r1 loc;
           self#insert env Ireturn loc [||]
       end
-  | _ ->
-      self#emit_return env exp
+  | Cop _
+  | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _
+  | Cconst_pointer _ | Cconst_natpointer _ | Cblockheader _
+  | Cvar _
+  | Cassign _
+  | Ctuple _
+  | Cexit _ ->
+    self#emit_return env exp
 
 method private emit_tail_sequence env exp =
   let s = {< instr_seq = dummy_instr >} in
diff --git a/configure b/configure
index 4d6d66da89..91d4934e4d 100755
--- a/configure
+++ b/configure
@@ -12523,39 +12523,50 @@ esac
 # in the macro itself, too
 case $host in #(
   *-*-mingw32) :
+    case $ocaml_cv_cc_vendor in #(
+  gcc-[01234]-*) :
+    as_fn_error $? "This version of Mingw GCC is too old. Please use GCC version 5 or above." "$LINENO" 5 ;; #(
+  gcc-*) :
     internal_cflags="-Wno-unused $gcc_warnings"
-    # TODO: see whether the code can be fixed to avoid -Wno-unused
-    common_cflags="-O -mms-bitfields"
-    internal_cppflags='-DUNICODE -D_UNICODE'
-    internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
-    internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)" ;; #(
+        # TODO: see whether the code can be fixed to avoid -Wno-unused
+        common_cflags="-O2 -fno-strict-aliasing -fwrapv \
+-fexcess-precision=standard -mms-bitfields"
+        internal_cppflags='-DUNICODE -D_UNICODE'
+        internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
+        internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)" ;; #(
+  *) :
+    as_fn_error $? "Unsupported C compiler for a Mingw build" "$LINENO" 5 ;;
+esac ;; #(
   *) :
     case $ocaml_cv_cc_vendor in #(
   clang-*) :
     common_cflags="-O2 -fno-strict-aliasing -fwrapv";
       internal_cflags="$gcc_warnings -fno-common" ;; #(
-  gcc-012-*) :
+  gcc-[012]-*) :
     # Some versions known to miscompile OCaml, e,g, 2.7.2.1, some 2.96.
       # Plus: C99 support unknown.
-      as_fn_error $? "This version of GCC is too old.
-        Please use GCC version 4.2 or above." "$LINENO" 5 ;; #(
-  gcc-3-*|gcc-4-01) :
+      as_fn_error $? "This version of GCC is too old. Please use GCC version 4.2 or above." "$LINENO" 5 ;; #(
+  gcc-3-*|gcc-4-[01]) :
     # No -fwrapv option before GCC 3.4.
       # Known problems with -fwrapv fixed in 4.2 only.
-      { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: This version of GCC is rather old.
-        Reducing optimization level.\"" >&5
-$as_echo "$as_me: WARNING: This version of GCC is rather old.
-        Reducing optimization level.\"" >&2;};
+      { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: This version of GCC is rather old. Reducing optimization level.\"" >&5
+$as_echo "$as_me: WARNING: This version of GCC is rather old. Reducing optimization level.\"" >&2;};
       { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Consider using GCC version 4.2 or above." >&5
 $as_echo "$as_me: WARNING: Consider using GCC version 4.2 or above." >&2;};
       common_cflags="-std=gnu99 -O";
       internal_cflags="$gcc_warnings" ;; #(
+  gcc-4-[234]) :
+    # No -fexcess-precision option before GCC 4.5
+      common_cflags="-std=gnu99 -O2 -fno-strict-aliasing -fwrapv \
+-fno-builtin-memcmp";
+      internal_cflags="$gcc_warnings" ;; #(
   gcc-4-*) :
     common_cflags="-std=gnu99 -O2 -fno-strict-aliasing -fwrapv \
--fno-builtin-memcmp";
+-fno-builtin-memcmp -fexcess-precision=standard";
       internal_cflags="$gcc_warnings" ;; #(
   gcc-*) :
-    common_cflags="-O2 -fno-strict-aliasing -fwrapv";
+    common_cflags="-O2 -fno-strict-aliasing -fwrapv \
+-fexcess-precision=standard";
       internal_cflags="$gcc_warnings -fno-common" ;; #(
   msvc-*) :
     common_cflags="-nologo -O2 -Gy- -MD $gcc_warnings"
@@ -13937,22 +13948,20 @@ esac ;; #(
   s390x,elf) :
     default_as="${toolpref}as -m 64 -march=$model"
     default_aspp="${toolpref}gcc -c -Wa,-march=$model" ;; #(
-  arm,freebsd|arm64,freebsd) :
-    default_as="${toolpref}cc -c"
-    default_aspp="${toolpref}cc -c" ;; #(
-  *,dragonfly) :
-    default_as="${toolpref}as"
-    default_aspp="${toolpref}cc -c" ;; #(
   *,freebsd) :
+    default_as="${toolpref}cc -c -Wno-trigraphs"
+    default_aspp="${toolpref}cc -c -Wno-trigraphs" ;; #(
+  *,dragonfly) :
     default_as="${toolpref}as"
     default_aspp="${toolpref}cc -c" ;; #(
   amd64,*|arm,*|arm64,*|i386,*) :
-    default_as="${toolpref}as"
     case $ocaml_cv_cc_vendor in #(
   clang-*) :
-    default_aspp="${toolpref}clang -c -Wno-trigraphs" ;; #(
+    default_as="${toolpref}clang -c -Wno-trigraphs"
+                  default_aspp="${toolpref}clang -c -Wno-trigraphs" ;; #(
   *) :
-    default_aspp="${toolpref}gcc -c" ;;
+    default_as="${toolpref}as"
+      default_aspp="${toolpref}gcc -c" ;;
 esac ;; #(
   *) :
      ;;
diff --git a/configure.ac b/configure.ac
index fcf8cdd2ba..957dcd8635 100644
--- a/configure.ac
+++ b/configure.ac
@@ -569,35 +569,48 @@ AS_CASE([$enable_warn_error,AC_PACKAGE_VERSION],
 # in the macro itself, too
 AS_CASE([$host],
   [*-*-mingw32],
-    [internal_cflags="-Wno-unused $gcc_warnings"
-    # TODO: see whether the code can be fixed to avoid -Wno-unused
-    common_cflags="-O -mms-bitfields"
-    internal_cppflags='-DUNICODE -D_UNICODE'
-    internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
-    internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)"],
+    [AS_CASE([$ocaml_cv_cc_vendor],
+      [gcc-[[01234]]-*],
+        [AC_MSG_ERROR(m4_normalize([This version of Mingw GCC is too old.
+          Please use GCC version 5 or above.]))],
+      [gcc-*],
+        [internal_cflags="-Wno-unused $gcc_warnings"
+        # TODO: see whether the code can be fixed to avoid -Wno-unused
+        common_cflags="-O2 -fno-strict-aliasing -fwrapv \
+-fexcess-precision=standard -mms-bitfields"
+        internal_cppflags='-DUNICODE -D_UNICODE'
+        internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
+        internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)"],
+      [AC_MSG_ERROR([Unsupported C compiler for a Mingw build])])],
   [AS_CASE([$ocaml_cv_cc_vendor],
     [clang-*],
       [common_cflags="-O2 -fno-strict-aliasing -fwrapv";
       internal_cflags="$gcc_warnings -fno-common"],
-    [gcc-[012]-*],
+    [gcc-[[012]]-*],
       # Some versions known to miscompile OCaml, e,g, 2.7.2.1, some 2.96.
       # Plus: C99 support unknown.
-      [AC_MSG_ERROR([This version of GCC is too old.
-        Please use GCC version 4.2 or above.])],
-    [gcc-3-*|gcc-4-[01]],
+      [AC_MSG_ERROR(m4_normalize([This version of GCC is too old.
+        Please use GCC version 4.2 or above.]))],
+    [gcc-3-*|gcc-4-[[01]]],
       # No -fwrapv option before GCC 3.4.
       # Known problems with -fwrapv fixed in 4.2 only.
-      [AC_MSG_WARN([This version of GCC is rather old.
-        Reducing optimization level."]);
+      [AC_MSG_WARN(m4_normalize([This version of GCC is rather old.
+        Reducing optimization level."]));
       AC_MSG_WARN([Consider using GCC version 4.2 or above.]);
       common_cflags="-std=gnu99 -O";
       internal_cflags="$gcc_warnings"],
-    [gcc-4-*],
+    [gcc-4-[[234]]],
+      # No -fexcess-precision option before GCC 4.5
       [common_cflags="-std=gnu99 -O2 -fno-strict-aliasing -fwrapv \
 -fno-builtin-memcmp";
       internal_cflags="$gcc_warnings"],
+    [gcc-4-*],
+      [common_cflags="-std=gnu99 -O2 -fno-strict-aliasing -fwrapv \
+-fno-builtin-memcmp -fexcess-precision=standard";
+      internal_cflags="$gcc_warnings"],
     [gcc-*],
-      [common_cflags="-O2 -fno-strict-aliasing -fwrapv";
+      [common_cflags="-O2 -fno-strict-aliasing -fwrapv \
+-fexcess-precision=standard";
       internal_cflags="$gcc_warnings -fno-common"],
     [msvc-*],
       [common_cflags="-nologo -O2 -Gy- -MD $gcc_warnings"
@@ -1033,20 +1046,18 @@ AS_CASE(["$arch,$system"],
   [s390x,elf],
     [default_as="${toolpref}as -m 64 -march=$model"
     default_aspp="${toolpref}gcc -c -Wa,-march=$model"],
-  [arm,freebsd|arm64,freebsd],
-    [default_as="${toolpref}cc -c"
-    default_aspp="${toolpref}cc -c"],
-  [*,dragonfly],
-    [default_as="${toolpref}as"
-    default_aspp="${toolpref}cc -c"],
   [*,freebsd],
+    [default_as="${toolpref}cc -c -Wno-trigraphs"
+    default_aspp="${toolpref}cc -c -Wno-trigraphs"],
+  [*,dragonfly],
     [default_as="${toolpref}as"
     default_aspp="${toolpref}cc -c"],
   [amd64,*|arm,*|arm64,*|i386,*],
-    [default_as="${toolpref}as"
-    AS_CASE([$ocaml_cv_cc_vendor],
-      [clang-*], [default_aspp="${toolpref}clang -c -Wno-trigraphs"],
-      [default_aspp="${toolpref}gcc -c"])])
+    [AS_CASE([$ocaml_cv_cc_vendor],
+      [clang-*], [default_as="${toolpref}clang -c -Wno-trigraphs"
+                  default_aspp="${toolpref}clang -c -Wno-trigraphs"],
+      [default_as="${toolpref}as"
+      default_aspp="${toolpref}gcc -c"])])
 
 AS_IF([test "$with_pic"],
   [fpic=true
diff --git a/manual/manual/tutorials/coreexamples.etex b/manual/manual/tutorials/coreexamples.etex
index 8f8c8c7703..55726aba6c 100644
--- a/manual/manual/tutorials/coreexamples.etex
+++ b/manual/manual/tutorials/coreexamples.etex
@@ -941,15 +941,18 @@ source files created for use with OCaml compilers, but can be helpful
 to mark the end of a top-level expression unambiguously even when
 there are syntax errors.
 Here is a
-sample standalone program to print Fibonacci numbers:
+sample standalone program to print the greatest common divisor
+(gcd) of two numbers:
 \begin{verbatim}
-(* File fib.ml *)
-let rec fib n =
-  if n < 2 then 1 else fib (n-1) + fib (n-2);;
+(* File gcd.ml *)
+let rec gcd a b =
+  if b = 0 then a
+  else gcd b (a mod b);;
+
 let main () =
-  let arg = int_of_string Sys.argv.(1) in
-  print_int (fib arg);
-  print_newline ();
+  let a = int_of_string Sys.argv.(1) in
+  let b = int_of_string Sys.argv.(2) in
+  Printf.printf "%d\n" (gcd a b);
   exit 0;;
 main ();;
 \end{verbatim}
@@ -958,11 +961,11 @@ parameters. "Sys.argv.(1)" is thus the first command-line parameter.
 The program above is compiled and executed with the following shell
 commands:
 \begin{verbatim}
-$ ocamlc -o fib fib.ml
-$ ./fib 10
-89
-$ ./fib 20
-10946
+$ ocamlc -o gcd gcd.ml
+$ ./gcd 6 9
+3
+$ ./fib 7 11
+1
 \end{verbatim}
 
 More complex standalone OCaml programs are typically composed of
diff --git a/runtime/extern.c b/runtime/extern.c
index fe5aace607..ad3d552f54 100644
--- a/runtime/extern.c
+++ b/runtime/extern.c
@@ -158,12 +158,13 @@ static void free_extern_output(void)
 {
   struct output_block * blk, * nextblk;
 
-  if (extern_userprovided_output != NULL) return;
-  for (blk = extern_output_first; blk != NULL; blk = nextblk) {
-    nextblk = blk->next;
-    caml_stat_free(blk);
+  if (extern_userprovided_output == NULL) {
+    for (blk = extern_output_first; blk != NULL; blk = nextblk) {
+      nextblk = blk->next;
+      caml_stat_free(blk);
+    }
+    extern_output_first = NULL;
   }
-  extern_output_first = NULL;
   extern_free_stack();
 }
 
@@ -735,7 +736,7 @@ CAMLexport void caml_output_value_to_malloc(value v, value flags,
   int header_len;
   intnat data_len;
   char * res;
-  struct output_block * blk;
+  struct output_block * blk, * nextblk;
 
   init_extern_output();
   data_len = extern_value(v, flags, header, &header_len);
@@ -745,12 +746,13 @@ CAMLexport void caml_output_value_to_malloc(value v, value flags,
   *len = header_len + data_len;
   memcpy(res, header, header_len);
   res += header_len;
-  for (blk = extern_output_first; blk != NULL; blk = blk->next) {
+  for (blk = extern_output_first; blk != NULL; blk = nextblk) {
     intnat n = blk->end - blk->data;
     memcpy(res, blk->data, n);
     res += n;
+    nextblk = blk->next;
+    caml_stat_free(blk);
   }
-  free_extern_output();
 }
 
 /* Functions for writing user-defined marshallers */
diff --git a/runtime/power.S b/runtime/power.S
index 69e01fa7c9..1933a10ed9 100644
--- a/runtime/power.S
+++ b/runtime/power.S
@@ -410,8 +410,6 @@ FUNCTION(caml_raise_exception)
     /* Branch to handler */
         bctr
 .L121:
-        li      0, 0
-        stg     0, Caml_state(backtrace_pos)
         mr      27, 3           /* preserve exn bucket in callee-save reg */
                                 /* arg1: exception bucket, already in r3 */
         lg      4, Caml_state(last_return_address) /* arg2: PC of raise */
diff --git a/runtime/s390x.S b/runtime/s390x.S
index 0ae3f82ae1..aab63e9b24 100644
--- a/runtime/s390x.S
+++ b/runtime/s390x.S
@@ -183,8 +183,6 @@ caml_raise_exception:
     /* Branch to handler */
         br      %r1;
 .L112:
-        lgfi    %r0, 0
-        stg     %r0, Caml_state(backtrace_pos)
         ldgr    %f15,%r2        /* preserve exn bucket in callee-save reg */
                                 /* arg1: exception bucket, already in r2 */
         lg      %r3, Caml_state(last_return_address) /* arg2: PC of raise */
diff --git a/testsuite/Makefile b/testsuite/Makefile
index 5c1573332d..66f36c5294 100644
--- a/testsuite/Makefile
+++ b/testsuite/Makefile
@@ -62,12 +62,19 @@ else
                                $(ocamltest_program)
 endif
 
+# PROMOTE is only meant to be used internally in recursive calls;
+# users should call the 'promote' target explicitly.
+PROMOTE =
 ifeq "$(PROMOTE)" ""
   OCAMLTEST_PROMOTE_FLAG :=
 else
   OCAMLTEST_PROMOTE_FLAG := -promote
 endif
 
+# KEEP_TEST_DIR_ON_SUCCESS should be set by the user (to a non-empty value)
+# if they want to pass the -keep-test-dir-on-success option to ocamltest,
+# to preserve test data of succesful tests.
+KEEP_TEST_DIR_ON_SUCCESS ?=
 ifeq "$(KEEP_TEST_DIR_ON_SUCCESS)" ""
   OCAMLTEST_KEEP_TEST_DIR_ON_SUCCESS_FLAG :=
 else
diff --git a/testsuite/tests/letrec-check/basic.ml b/testsuite/tests/letrec-check/basic.ml
index ffdb56d177..595212802f 100644
--- a/testsuite/tests/letrec-check/basic.ml
+++ b/testsuite/tests/letrec-check/basic.ml
@@ -112,10 +112,13 @@ val x : 'a option -> unit = <fun>
 val y : 'a list -> unit = <fun>
 |}];;
 
-(* this is accepted as all fields are overridden *)
+(* used to be accepted, see PR#7696 *)
 let rec x = { x with contents = 3 }  [@ocaml.warning "-23"];;
 [%%expect{|
-val x : int ref = {contents = 3}
+Line 1, characters 12-35:
+1 | let rec x = { x with contents = 3 }  [@ocaml.warning "-23"];;
+                ^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
 |}];;
 
 (* this is rejected as `c` will be dereferenced during the copy,
diff --git a/testsuite/tests/regression/pr9443/pr9443.ml b/testsuite/tests/regression/pr9443/pr9443.ml
new file mode 100644
index 0000000000..8a72cd0839
--- /dev/null
+++ b/testsuite/tests/regression/pr9443/pr9443.ml
@@ -0,0 +1,11 @@
+(* TEST *)
+
+(* Test tail call optimisation with an elided mutable cell *)
+let rec loop n =
+  if n = 0 then () else begin
+    let last = ref 0 in
+    last := 0;
+    loop (n-1)
+  end
+
+let () = loop 1_000_000
diff --git a/testsuite/tests/typing-misc/records.ml b/testsuite/tests/typing-misc/records.ml
index a5a9f7b13e..d11f1b4e38 100644
--- a/testsuite/tests/typing-misc/records.ml
+++ b/testsuite/tests/typing-misc/records.ml
@@ -165,6 +165,17 @@ Error: This expression has type string t
        Type string is not compatible with type int
 |}]
 
+(* PR#7696 *)
+let r = { (assert false) with contents = 1 } ;;
+[%%expect{|
+Line 1, characters 8-44:
+1 | let r = { (assert false) with contents = 1 } ;;
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 23: all the fields are explicitly listed in this record:
+the 'with' clause is useless.
+Exception: Assert_failure ("", 1, 10).
+|}]
+
 (* reexport *)
 
 type ('a,'b) def = { x:int } constraint 'b = [> `A]
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 5052178511..3b8bea1931 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -2970,11 +2970,8 @@ and type_expect_
       let num_fields =
         match lbl_exp_list with [] -> assert false
         | (_, lbl,_)::_ -> Array.length lbl.lbl_all in
-      let opt_exp =
-        if opt_sexp <> None && List.length lid_sexp_list = num_fields then
-          (Location.prerr_warning loc Warnings.Useless_record_with; None)
-        else opt_exp
-      in
+      if opt_sexp <> None && List.length lid_sexp_list = num_fields then
+        Location.prerr_warning loc Warnings.Useless_record_with;
       let label_descriptions, representation =
         let (_, { lbl_all; lbl_repres }, _) = List.hd lbl_exp_list in
         lbl_all, lbl_repres