let-rec check (tests): check that some ill-formed expressions are rejected.

7 files changed, 417 insertions, 7 deletions

diff --git a/testsuite/tests/letrec-disallowed/Makefile b/testsuite/tests/letrec-disallowed/Makefile
new file mode 100644
index 0000000000..7fc00661cb
--- /dev/null
+++ b/testsuite/tests/letrec-disallowed/Makefile
@@ -0,0 +1,18 @@
+#**************************************************************************
+#*                                                                        *
+#*                                OCaml                                   *
+#*                                                                        *
+#*                 Xavier Clerc, SED, INRIA Rocquencourt                  *
+#*                                                                        *
+#*   Copyright 2010 Institut National de Recherche en Informatique et     *
+#*     en Automatique.                                                    *
+#*                                                                        *
+#*   All rights reserved.  This file is distributed under the terms of    *
+#*   the GNU Lesser General Public License version 2.1, with the          *
+#*   special exception on linking described in the file LICENSE.          *
+#*                                                                        *
+#**************************************************************************
+
+BASEDIR=../..
+include $(BASEDIR)/makefiles/Makefile.toplevel
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/letrec-disallowed/disallowed.ml b/testsuite/tests/letrec-disallowed/disallowed.ml
new file mode 100644
index 0000000000..ded2be9615
--- /dev/null
+++ b/testsuite/tests/letrec-disallowed/disallowed.ml
@@ -0,0 +1,112 @@
+let rec x = let y = () in x;;
+
+let rec x = let module M = struct let f = x let g = x () end in fun () -> ();;
+
+let rec x = let module M = struct let f = x () let g = x end in fun () -> ();;
+
+let rec x = (let module M = struct let f = y 0 let g = () end in fun () -> ())
+    and y = succ;;
+
+let rec x = let module M = struct module N = struct let y = x end end in M.N.y;;
+
+let rec x = let module M = struct let f = x () and g = x end in fun () -> ();;
+
+class c _ = object end;;
+let rec x = new c x;;
+
+let rec x = ignore x;;
+
+let rec x = y 0 and y _ = ();;
+
+let rec c = { c with Complex.re = 1.0 };;
+
+let rec b = if b then true else false;;
+
+let r = ref ()
+let rec x = r := x;;
+
+let rec x =
+  for i = 0 to 1 do
+    let z = y in ignore z
+  done
+and y = x; ();;
+
+let rec x =
+  for i = 0 to y do
+    ()
+  done
+and y = 10;;
+
+let rec x =
+  for i = y to 10 do
+    ()
+  done
+and y = 0;;
+
+let rec x =
+  while false do
+    let y = x in ignore y
+  done
+and y = x; ();;
+
+let rec x =
+  while y do
+    ()
+  done
+and y = false;;
+
+let rec x =
+  while y do
+    let y = x in ignore y
+  done
+and y = false;;
+
+let rec x = y#m and y = object method m = () end;;
+
+let rec x = (object method m _ = () end)#m x;;
+
+let rec x = y.contents and y = { contents = 3 };;
+
+let rec x = object val mutable v = 0 method m = v <- y end and y = 1;;
+
+let rec x = assert y and y = true;;
+
+let rec x = object method m = x end;;
+
+let rec x = object method m = ignore x end;;
+
+(* The builtin Pervasives.ref is currently treated as a constructor.
+   Other functions of the same name should not be so treated. *)
+let _ =
+  let module Pervasives =
+  struct
+    let ref _ = assert false
+  end in
+  let rec x = Pervasives.ref y
+  and y = fun () -> ignore x
+  in (x, y)
+;;
+
+(* An example, from Leo White, of let rec bindings that allocate
+   values of unknown size *)
+let foo p x =
+  let rec f =
+    if p then (fun y -> x + g y) else (fun y -> g y)
+  and g =
+    if not p then (fun y -> x - f y) else (fun y -> f y)
+  in
+  (f, g)
+;;
+
+module type T = sig end
+let rec x = (module (val y : T) : T)
+and y = let module M = struct let x = x end in (module M : T)
+;;
+
+let rec x =
+  match let _ = y in raise Not_found with
+    _ -> "x"
+  | exception Not_found -> "z" 
+and y = match x with
+  z -> ("y", z);;
+
diff --git a/testsuite/tests/letrec-disallowed/disallowed.ml.reference b/testsuite/tests/letrec-disallowed/disallowed.ml.reference
new file mode 100644
index 0000000000..c053974b9d
--- /dev/null
+++ b/testsuite/tests/letrec-disallowed/disallowed.ml.reference
@@ -0,0 +1,126 @@
+
+# Characters 12-27:
+  let rec x = let y = () in x;;
+              ^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-77:
+  let rec x = let module M = struct let f = x let g = x () end in fun () -> ();;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-77:
+  let rec x = let module M = struct let f = x () let g = x end in fun () -> ();;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#     Characters 13-79:
+  let rec x = (let module M = struct let f = y 0 let g = () end in fun () -> ())
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-79:
+  let rec x = let module M = struct module N = struct let y = x end end in M.N.y;;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-77:
+  let rec x = let module M = struct let f = x () and g = x end in fun () -> ();;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   class c : 'a -> object  end
+# Characters 12-19:
+  let rec x = new c x;;
+              ^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-21:
+  let rec x = ignore x;;
+              ^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-16:
+  let rec x = y 0 and y _ = ();;
+              ^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-40:
+  let rec c = { c with Complex.re = 1.0 };;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-38:
+  let rec b = if b then true else false;;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#     Characters 28-34:
+  let rec x = r := x;;
+              ^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-65:
+  ..for i = 0 to 1 do
+      let z = y in ignore z
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-46:
+  ..for i = 0 to y do
+      ()
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-47:
+  ..for i = y to 10 do
+      ()
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-62:
+  ..while false do
+      let y = x in ignore y
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-39:
+  ..while y do
+      ()
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-58:
+  ..while y do
+      let y = x in ignore y
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-16:
+  let rec x = y#m and y = object method m = () end;;
+              ^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-45:
+  let rec x = (object method m _ = () end)#m x;;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-23:
+  let rec x = y.contents and y = { contents = 3 };;
+              ^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-59:
+  let rec x = object val mutable v = 0 method m = v <- y end and y = 1;;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-21:
+  let rec x = assert y and y = true;;
+              ^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-36:
+  let rec x = object method m = x end;;
+              ^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-43:
+  let rec x = object method m = ignore x end;;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   *                   Characters 230-246:
+    let rec x = Pervasives.ref y
+                ^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   *                 Characters 127-175:
+      if p then (fun y -> x + g y) else (fun y -> g y)
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#         Characters 37-61:
+  let rec x = (module (val y : T) : T)
+              ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#             Characters 15-98:
+  ..match let _ = y in raise Not_found with
+      _ -> "x"
+    | exception Not_found -> "z".
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   
diff --git a/testsuite/tests/letrec-disallowed/float_block.ml b/testsuite/tests/letrec-disallowed/float_block.ml
new file mode 100644
index 0000000000..4f8fc9d978
--- /dev/null
+++ b/testsuite/tests/letrec-disallowed/float_block.ml
@@ -0,0 +1,6 @@
+let test =
+  let rec x = [| y; y |] and y = 1. in
+  assert (x = [| 1.; 1. |]);
+  assert (y = 1.);
+  ()
+;;
diff --git a/testsuite/tests/letrec-disallowed/float_block.ml.reference b/testsuite/tests/letrec-disallowed/float_block.ml.reference
new file mode 100644
index 0000000000..58b1e32f55
--- /dev/null
+++ b/testsuite/tests/letrec-disallowed/float_block.ml.reference
@@ -0,0 +1,6 @@
+
+#           Characters 25-35:
+    let rec x = [| y; y |] and y = 1. in
+                ^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+# 
diff --git a/testsuite/tests/letrec/disallowed.reference b/testsuite/tests/letrec/disallowed.reference
new file mode 100644
index 0000000000..1c758979b7
--- /dev/null
+++ b/testsuite/tests/letrec/disallowed.reference
@@ -0,0 +1,149 @@
+
+# Characters 12-27:
+  let rec x = let y = () in x;;
+              ^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-77:
+  let rec x = let module M = struct let f = x let g = x () end in fun () -> ();;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-77:
+  let rec x = let module M = struct let f = x () let g = x end in fun () -> ();;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#     Characters 13-79:
+  let rec x = (let module M = struct let f = y 0 let g = () end in fun () -> ())
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-79:
+  let rec x = let module M = struct module N = struct let y = x end end in M.N.y;;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-77:
+  let rec x = let module M = struct let f = x () and g = x end in fun () -> ();;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   class c : 'a -> object  end
+# Characters 12-19:
+  let rec x = new c x;;
+              ^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-21:
+  let rec x = ignore x;;
+              ^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-16:
+  let rec x = y 0 and y _ = ();;
+              ^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#     Characters 13-18:
+  let rec x = [|y|]
+              ^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-40:
+  let rec c = { c with Complex.re = 1.0 };;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-36:
+  let rec x = { x with contents = 3 };;
+              ^^^^^^^^^^^^^^^^^^^^^^^
+Warning 23: all the fields are explicitly listed in this record:
+the 'with' clause is useless.
+Characters 13-36:
+  let rec x = { x with contents = 3 };;
+              ^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-38:
+  let rec b = if b then true else false;;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#     Characters 28-34:
+  let rec x = r := x;;
+              ^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-65:
+  ..for i = 0 to 1 do
+      let z = y in ignore z
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-46:
+  ..for i = 0 to y do
+      ()
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-47:
+  ..for i = y to 10 do
+      ()
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-62:
+  ..while false do
+      let y = x in ignore y
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-39:
+  ..while y do
+      ()
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#               Characters 15-58:
+  ..while y do
+      let y = x in ignore y
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-45:
+  let rec x = (object method m _ = () end)#m x;;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-23:
+  let rec x = y.contents and y = { contents = 3 };;
+              ^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-59:
+  let rec x = object val mutable v = 0 method m = v <- y end and y = 1;;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-21:
+  let rec x = assert y and y = true;;
+              ^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-36:
+  let rec x = object method m = x end;;
+              ^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-43:
+  let rec x = object method m = ignore x end;;
+              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   *                   Characters 230-246:
+    let rec x = Pervasives.ref y
+                ^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   *                 Characters 127-175:
+      if p then (fun y -> x + g y) else (fun y -> g y)
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   Characters 13-33:
+  let rec x = let y = (x; ()) in y;;
+              ^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-58:
+  ..for i = 0 to 1 do
+      let z = y in z
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#         Characters 37-61:
+  let rec x = (module (val y : T) : T)
+              ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#           Characters 15-55:
+  ..while false do
+      let y = x in y
+    done
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#             Characters 15-98:
+  ..match let _ = y in raise Not_found with
+      _ -> "x"
+    | exception Not_found -> "z".
+Error: This kind of expression is not allowed as right-hand side of `let rec'
+#   
diff --git a/testsuite/tests/letrec/float_block_2.ml b/testsuite/tests/letrec/float_block_2.ml
deleted file mode 100644
index 968cba4eb1..0000000000
--- a/testsuite/tests/letrec/float_block_2.ml
+++ /dev/null
@@ -1,7 +0,0 @@
-(* a bug in cmmgen.ml provokes a segfault in certain natively compiled
-   letrec-bindings involving float arrays *)
-let test =
-  let rec x = [| y; y |] and y = 1. in
-  assert (x = [| 1.; 1. |]);
-  assert (y = 1.);
-  ()