Add upstream tests

Tests from:
  - ocaml/ocaml#12236 (and the corresponding updates to outputs found in ocaml/ocaml#12386 and ocaml/ocaml#12391)
  - ocaml/ocaml#12496 (not merged)

ocaml/testsuite/tests/backtrace/names.ml

@@ -78,6 +78,13 @@ end
 
 let[@inline never] (+@+) n f = f 42 + 1
 
+(* [nested] shows up in the backtrace as [nested.(fun)] because
+   it creates an inner lambda. In contrast, [flat]'s arity is syntactically
+   2 and does not create an inner lambda.
+*)
+let[@inline never] flat = fun x f -> f x + 1
+let[@inline never] nested x = fun[@inline never] f -> f x + 1
+
 class klass = object (self)
   val other = new klass2 "asdf"
   method meth f : int =
@@ -122,6 +129,8 @@ let () =
     Inst.fn @@ fun _ ->
     Rec1.fn @@ fun _ ->
     42 +@+ fun _ ->
+    flat 7 @@ fun _ ->
+    nested 5 @@ fun _ ->
     (new klass)#meth @@ fun _ ->
     inline_object @@ fun _ ->
     lazy_ @@ fun _ ->

ocaml/testsuite/tests/backtrace/names.reference

@@ -1,13 +1,15 @@
 Raised at Names.bang in file "names.ml", line 9, characters 29-39
-Called from Names.nontailcall in file "names.ml", line 106, characters 2-6
-Called from Names.lazy_ in file "names.ml", line 101, characters 41-45
+Called from Names.nontailcall in file "names.ml", line 113, characters 2-6
+Called from Names.lazy_ in file "names.ml", line 108, characters 41-45
 Called from CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 37, characters 17-27
 Re-raised at CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 42, characters 4-11
-Called from Names.inline_object.object#othermeth in file "names.ml", line 96, characters 6-10
-Called from Names.inline_object.object#meth in file "names.ml", line 94, characters 6-26
-Called from Names.klass2#othermeth.(fun) in file "names.ml", line 88, characters 18-22
-Called from Names.klass2#othermeth in file "names.ml", line 88, characters 4-30
-Called from Names.klass#meth in file "names.ml", line 84, characters 4-27
+Called from Names.inline_object.object#othermeth in file "names.ml", line 103, characters 6-10
+Called from Names.inline_object.object#meth in file "names.ml", line 101, characters 6-26
+Called from Names.klass2#othermeth.(fun) in file "names.ml", line 95, characters 18-22
+Called from Names.klass2#othermeth in file "names.ml", line 95, characters 4-30
+Called from Names.klass#meth in file "names.ml", line 91, characters 4-27
+Called from Names.nested.(fun) in file "names.ml", line 86, characters 54-57
+Called from Names.flat in file "names.ml", line 85, characters 37-40
 Called from Names.(+@+) in file "names.ml", line 79, characters 31-35
 Called from Names.Rec2.fn in file "names.ml", line 76, characters 28-32
 Called from Names.Rec1.fn in file "names.ml", line 71, characters 28-34
@@ -27,4 +29,4 @@ Called from Names.Mod1.Nested.apply in file "names.ml", line 21, characters 33-3
 Called from Names.fn_poly in file "names.ml", line 17, characters 2-5
 Called from Names.fn_function in file "names.ml", line 14, characters 9-13
 Called from Names.fn_multi in file "names.ml", line 11, characters 36-40
-Called from Names in file "names.ml", line 111, characters 4-495
+Called from Names in file "names.ml", line 118, characters 4-543

ocaml/testsuite/tests/compiler-libs/test_untypeast.ml

@@ -6,13 +6,35 @@
    * expect
 *)
 
-let res =
-  let s = {| match None with Some (Some _) -> () | _ -> () |} in
+let run s =
   let pe = Parse.expression (Lexing.from_string s) in
   let te = Typecore.type_expression (Lazy.force Env.initial_safe_string) pe in
   let ute = Untypeast.untype_expression te in
   Format.asprintf "%a" Pprintast.expression ute
 
 [%%expect{|
-val res : string = "match None with | Some (Some _) -> () | _ -> ()"
-|}]
+val run : string -> string = <fun>
+|}];;
+
+run {| match None with Some (Some _) -> () | _ -> () |};;
+
+[%%expect{|
+- : string = "match None with | Some (Some _) -> () | _ -> ()"
+|}];;
+
+(***********************************)
+(* Untypeast/pprintast maintain the arity of a function. *)
+
+(* 4-ary function *)
+run {| fun x y z -> function w -> x y z w |};;
+
+[%%expect{|
+- : string = "fun x y z -> function | w -> x y z w"
+|}];;
+
+(* 3-ary function returning a 1-ary function *)
+run {| fun x y z -> (function w -> x y z w) |};;
+
+[%%expect{|
+- : string = "fun x y z -> (function | w -> x y z w)"
+|}];;

ocaml/testsuite/tests/ppx-attributes/warning.ml

@@ -31,6 +31,10 @@ module rec B : sig type t end = struct type t = T.deprecated end
 module type T = sig type t = T.deprecated end
 [@@ocaml.alert "-deprecated"]
 
+(* Warning 27 is unused function parameter. *)
+let f _ = function[@ocaml.warning "-27"]
+  | x -> ()
+
 (* Signature items *)
 
 module type S = sig

ocaml/testsuite/tests/syntactic-arity/alloc.compilers.reference

@@ -0,0 +1,6 @@
+File "alloc.ml", line 34, characters 33-37:
+34 | let dont_warn_with_partial_match None x = x
+                                      ^^^^
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some _

ocaml/testsuite/tests/syntactic-arity/alloc.ml

@@ -0,0 +1,29 @@
+(* TEST
+ * setup-ocamlopt.byte-build-env
+ ** ocamlopt.byte
+ *** run
+ **** check-program-output
+
+
+*)
+
+type a = { mutable a : int }
+
+let mutable_pat1 {a} b = a + b
+
+let mutable_pat2 b {a} = b + a
+
+let measure name f =
+  let a = {a = 1} in
+  let b = 2 in
+  let before = Gc.minor_words () in
+  let (_ : int) = f ~a ~b in
+  let after = Gc.minor_words () in
+  let alloc = int_of_float (after -. before) in
+  match alloc with
+  | 0 -> Printf.printf "%S doesn't allocate\n" name
+  | _ -> Printf.printf "%S allocates\n" name
+
+let () =
+  measure "mutable_pat1" (fun ~a ~b -> mutable_pat1 a b);
+  measure "mutable_pat2" (fun ~a ~b -> mutable_pat2 b a)

ocaml/testsuite/tests/syntactic-arity/alloc.reference

@@ -0,0 +1,2 @@
+"mutable_pat1" doesn't allocate
+"mutable_pat2" doesn't allocate

ocaml/testsuite/tests/syntactic-arity/comparative_alloc.ml

@@ -0,0 +1,56 @@
+(* TEST
+ * setup-ocamlopt.byte-build-env
+ ** ocamlopt.byte
+ *** run
+ **** check-program-output
+*)
+
+(* Check that the runtime arity of a function (i.e., its 'fast path' for
+   runtime application) matches its syntactic arity (i.e., the number
+   of arguments appearing directly following [fun]).
+*)
+
+let is_zero_alloc f =
+  let before = Gc.minor_words () in
+  f ();
+  let after = Gc.minor_words () in
+  int_of_float (after -. before) = 0
+
+let run ~name f =
+  let x, y, z = 1, 2, 3 in
+  let arity =
+    if is_zero_alloc (fun () ->
+      let f = Sys.opaque_identity (f x) in
+      let f = Sys.opaque_identity (f y) in
+      f z)
+    then "1-ary fun returning 1-ary fun returning 1-ary fun"
+    else if is_zero_alloc (fun () ->
+      let f = Sys.opaque_identity (f x y) in
+      f z)
+    then "2-ary fun returning 1-ary fun"
+    else if is_zero_alloc (fun () ->
+        let f = Sys.opaque_identity (f x) in
+        f y z)
+    then "1-ary fun returning 2-ary fun"
+    else if is_zero_alloc (fun () -> f x y z)
+    then "3-ary fun"
+    else "unknown arity"
+  in
+  Printf.printf "%s: %s\n" name arity
+
+let () =
+  print_endline "Key:";
+  print_endline "  <function description>: <function arity>";
+  print_newline ();
+  run (fun _ _ _ -> ()) ~name:"3 params";
+  run (fun _ _ -> fun _ -> ()) ~name:"2 params then 1 param";
+  run (fun _ -> fun _ _ -> ()) ~name:"1 param then 2 params";
+  run (fun _ -> fun _ -> fun _ -> ())
+    ~name:"1 param, then 1 param, then 1 param";
+  run (fun _ -> let g _ _ = () in g)
+    ~name:"1 param then let-bound 2 params";
+  run (fun _ _ -> let g _ = () in g)
+    ~name:"2 params then let-bound 1 param";
+  run (fun _ -> let g _ = let h _ = () in h in g)
+    ~name:"1 param, then let-bound 1 param, then let-bound 1 param";
+;;

ocaml/testsuite/tests/syntactic-arity/comparative_alloc.reference

@@ -0,0 +1,10 @@
+Key:
+  <function description>: <function arity>
+
+3 params: 3-ary fun
+2 params then 1 param: 2-ary fun returning 1-ary fun
+1 param then 2 params: 1-ary fun returning 2-ary fun
+1 param, then 1 param, then 1 param: 1-ary fun returning 1-ary fun returning 1-ary fun
+1 param then let-bound 2 params: 1-ary fun returning 2-ary fun
+2 params then let-bound 1 param: 2-ary fun returning 1-ary fun
+1 param, then let-bound 1 param, then let-bound 1 param: 1-ary fun returning 1-ary fun returning 1-ary fun

ocaml/testsuite/tests/syntactic-arity/max_arity.compilers.reference

@@ -0,0 +1,5 @@
+File "max_arity.ml", line 154, characters 8-12:
+154 | let _ = f ();;
+              ^^^^
+Warning 5 [ignored-partial-application]: this function application is partial,
+maybe some arguments are missing.

ocaml/testsuite/tests/syntactic-arity/max_arity.ml

@@ -0,0 +1,160 @@
+(* TEST
+
+ * setup-ocamlopt.byte-build-env
+ ** ocamlopt.byte
+ *** check-ocamlopt.byte-output
+ **** run
+ ***** check-program-output
+*)
+
+(* Observe a case where a function's arity is a different notion
+   than native code arity (i.e. the number of arguments required
+   to enter the "fast path" where arguments are passed in registers/in
+   the argument buffer).
+
+   The max native code arity is 128, but the side-effects here don't run
+   until after all 133 arguments are provided.
+ *)
+
+let f
+  ?x1:(_ = failwith "1")
+  ?x2:(_ = failwith "2")
+  ?x3:(_ = failwith "3")
+  ?x4:(_ = failwith "4")
+  ?x5:(_ = failwith "5")
+  ?x6:(_ = failwith "6")
+  ?x7:(_ = failwith "7")
+  ?x8:(_ = failwith "8")
+  ?x9:(_ = failwith "9")
+  ?x10:(_ = failwith "10")
+  ?x11:(_ = failwith "11")
+  ?x12:(_ = failwith "12")
+  ?x13:(_ = failwith "13")
+  ?x14:(_ = failwith "14")
+  ?x15:(_ = failwith "15")
+  ?x16:(_ = failwith "16")
+  ?x17:(_ = failwith "17")
+  ?x18:(_ = failwith "18")
+  ?x19:(_ = failwith "19")
+  ?x20:(_ = failwith "20")
+  ?x21:(_ = failwith "21")
+  ?x22:(_ = failwith "22")
+  ?x23:(_ = failwith "23")
+  ?x24:(_ = failwith "24")
+  ?x25:(_ = failwith "25")
+  ?x26:(_ = failwith "26")
+  ?x27:(_ = failwith "27")
+  ?x28:(_ = failwith "28")
+  ?x29:(_ = failwith "29")
+  ?x30:(_ = failwith "30")
+  ?x31:(_ = failwith "31")
+  ?x32:(_ = failwith "32")
+  ?x33:(_ = failwith "33")
+  ?x34:(_ = failwith "34")
+  ?x35:(_ = failwith "35")
+  ?x36:(_ = failwith "36")
+  ?x37:(_ = failwith "37")
+  ?x38:(_ = failwith "38")
+  ?x39:(_ = failwith "39")
+  ?x40:(_ = failwith "40")
+  ?x41:(_ = failwith "41")
+  ?x42:(_ = failwith "42")
+  ?x43:(_ = failwith "43")
+  ?x44:(_ = failwith "44")
+  ?x45:(_ = failwith "45")
+  ?x46:(_ = failwith "46")
+  ?x47:(_ = failwith "47")
+  ?x48:(_ = failwith "48")
+  ?x49:(_ = failwith "49")
+  ?x50:(_ = failwith "50")
+  ?x51:(_ = failwith "51")
+  ?x52:(_ = failwith "52")
+  ?x53:(_ = failwith "53")
+  ?x54:(_ = failwith "54")
+  ?x55:(_ = failwith "55")
+  ?x56:(_ = failwith "56")
+  ?x57:(_ = failwith "57")
+  ?x58:(_ = failwith "58")
+  ?x59:(_ = failwith "59")
+  ?x60:(_ = failwith "60")
+  ?x61:(_ = failwith "61")
+  ?x62:(_ = failwith "62")
+  ?x63:(_ = failwith "63")
+  ?x64:(_ = failwith "64")
+  ?x65:(_ = failwith "65")
+  ?x66:(_ = failwith "66")
+  ?x67:(_ = failwith "67")
+  ?x68:(_ = failwith "68")
+  ?x69:(_ = failwith "69")
+  ?x70:(_ = failwith "70")
+  ?x71:(_ = failwith "71")
+  ?x72:(_ = failwith "72")
+  ?x73:(_ = failwith "73")
+  ?x74:(_ = failwith "74")
+  ?x75:(_ = failwith "75")
+  ?x76:(_ = failwith "76")
+  ?x77:(_ = failwith "77")
+  ?x78:(_ = failwith "78")
+  ?x79:(_ = failwith "79")
+  ?x80:(_ = failwith "80")
+  ?x81:(_ = failwith "81")
+  ?x82:(_ = failwith "82")
+  ?x83:(_ = failwith "83")
+  ?x84:(_ = failwith "84")
+  ?x85:(_ = failwith "85")
+  ?x86:(_ = failwith "86")
+  ?x87:(_ = failwith "87")
+  ?x88:(_ = failwith "88")
+  ?x89:(_ = failwith "89")
+  ?x90:(_ = failwith "90")
+  ?x91:(_ = failwith "91")
+  ?x92:(_ = failwith "92")
+  ?x93:(_ = failwith "93")
+  ?x94:(_ = failwith "94")
+  ?x95:(_ = failwith "95")
+  ?x96:(_ = failwith "96")
+  ?x97:(_ = failwith "97")
+  ?x98:(_ = failwith "98")
+  ?x99:(_ = failwith "99")
+  ?x100:(_ = failwith "100")
+  ?x101:(_ = failwith "101")
+  ?x102:(_ = failwith "102")
+  ?x103:(_ = failwith "103")
+  ?x104:(_ = failwith "104")
+  ?x105:(_ = failwith "105")
+  ?x106:(_ = failwith "106")
+  ?x107:(_ = failwith "107")
+  ?x108:(_ = failwith "108")
+  ?x109:(_ = failwith "109")
+  ?x110:(_ = failwith "110")
+  ?x111:(_ = failwith "111")
+  ?x112:(_ = failwith "112")
+  ?x113:(_ = failwith "113")
+  ?x114:(_ = failwith "114")
+  ?x115:(_ = failwith "115")
+  ?x116:(_ = failwith "116")
+  ?x117:(_ = failwith "117")
+  ?x118:(_ = failwith "118")
+  ?x119:(_ = failwith "119")
+  ?x120:(_ = failwith "120")
+  ?x121:(_ = failwith "121")
+  ?x122:(_ = failwith "122")
+  ?x123:(_ = failwith "123")
+  ?x124:(_ = failwith "124")
+  ?x125:(_ = failwith "125")
+  ?x126:(_ = failwith "126")
+  ?x127:(_ = failwith "127")
+  ?x128:(_ = failwith "128")
+  ?x129:(_ = failwith "129")
+  ?x130:(_ = failwith "130")
+  ?x131:(_ = failwith "131")
+  ()
+  () = ();;
+
+let _ = f ();;
+
+print_endline "f (): No exception.";;
+
+try f () () with
+| _ -> print_endline "f () (): Exception."
+;;

ocaml/testsuite/tests/syntactic-arity/max_arity.reference

@@ -0,0 +1,2 @@
+f (): No exception.
+f () (): Exception.