Update ppx dependencies, so we can rebase test cases and add more.

This reverts commit f89b589.

ppx/ppx_deriving_json/lib/.ocamlformat-ignore

@@ -0,0 +1 @@
+ppx_deriving_json.cppo.ml

ppx/ppx_deriving_json/lib/ppx_deriving_json.cppo.ml

@@ -16,6 +16,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)
+[@@@ocaml.alert "-deprecated"]
 
 open StdLabels
 
@@ -121,11 +122,16 @@ and write_body_of_tuple_type l ~arg ~poly ~tag =
   [%expr let [%p p] = [%e arg] in [%e e]]
 
 and write_poly_case r ~arg ~poly =
+#if OCAML_VERSION >= (4, 08, 0)
+  let { Parsetree.prf_desc = r; _ } = r in
+#endif
   match r with
 #if OCAML_VERSION < (4, 06, 0)
   | Parsetree.Rtag (label, _, _, l) ->
-#else
+#elif OCAML_VERSION < (4, 08, 0)
   | Parsetree.Rtag ({txt=label;_}, _, _, l) ->
+#else
+  | Parsetree.Rtag ({txt=label;_}, _, l) ->
 #endif
     let i = Ppx_deriving.hash_variant label
     and n = List.length l in
@@ -234,11 +240,17 @@ let recognize_case_of_constructor i l =
 
 let recognize_body_of_poly_variant l ~loc =
   let l =
-    let f = function
+    let f x =
+#if OCAML_VERSION >= (4, 08, 0)
+      let { Parsetree.prf_desc = x; _ } = x in
+#endif
+      match x with
 #if OCAML_VERSION < (4, 06, 0)
       | Parsetree.Rtag (label, _, _, l) ->
-#else
+#elif OCAML_VERSION < (4, 08, 0)
       | Parsetree.Rtag ({txt=label;_}, _, _, l) ->
+#else
+      | Parsetree.Rtag ({txt=label;_}, _, l) ->
 #endif
         let i = Ppx_deriving.hash_variant label in
         recognize_case_of_constructor i l
@@ -263,11 +275,17 @@ let maybe_tuple_type = function
   | [y] -> y
   | l -> Ast_helper.Typ.tuple l
 
-let rec read_poly_case ?decl y = function
+let rec read_poly_case ?decl y x =
+#if OCAML_VERSION >= (4, 08, 0)
+  let { Parsetree.prf_desc = x; _ } = x in
+#endif
+  match x with
 #if OCAML_VERSION < (4, 06, 0)
   | Parsetree.Rtag (label, _, _, l) ->
-#else
+#elif OCAML_VERSION < (4, 08, 0)
   | Parsetree.Rtag ({txt=label;_}, _, _, l) ->
+#else
+  | Parsetree.Rtag ({txt=label;_}, _, l) ->
 #endif
     let i = Ppx_deriving.hash_variant label |> Ast_convenience.pint in
     (match l with

ppx/ppx_deriving_json/tests/dune

@@ -11,8 +11,8 @@
 
 (rule
   (targets ppx.mlt.corrected)
-  (deps    ../../../lib/deriving_json/.js_of_ocaml_deriving.objs/deriving_Json.cmi
-           ../../../lib/deriving_json/.js_of_ocaml_deriving.objs/deriving_Json_lexer.cmi)
+  (deps    ../../../lib/deriving_json/.js_of_ocaml_deriving.objs/byte/deriving_Json.cmi
+           ../../../lib/deriving_json/.js_of_ocaml_deriving.objs/byte/deriving_Json_lexer.cmi)
   (action  (run %{exe:main.bc} %{dep:ppx.mlt})))
 
 (alias

ppx/ppx_deriving_json/tests/ppx.mlt

@@ -1,5 +1,7 @@
 #directory "../../../lib/deriving_json/"
 #directory "../../../lib/deriving_json/.js_of_ocaml_deriving.objs"
+#directory "../../../lib/deriving_json/.js_of_ocaml_deriving.objs/byte/"
+#directory "+/../../lib/ppx_deriving/runtime/"
 #directory "+/../../lib/ppx_deriving/"
 [@@@warning "-39"]
 

ppx/ppx_js/lib/dune

@@ -7,7 +7,7 @@
              ppx_tools_versioned)
   (ppx_runtime_libraries js_of_ocaml)
   (kind ppx_rewriter)
-  (preprocess (pps ppx_tools_versioned.metaquot_406)))
+  (preprocess (pps ppx_tools_versioned.metaquot_407)))
 
 
 (rule

ppx/ppx_js/lib/ppx_js.mli

@@ -18,4 +18,4 @@
 
 (**/**)
 
-val mapper : Migrate_parsetree.OCaml_406.Ast.Ast_mapper.mapper
+val mapper : Migrate_parsetree.OCaml_407.Ast.Ast_mapper.mapper

ppx/ppx_js/lib_internal/dune

@@ -4,4 +4,4 @@
              ocaml-migrate-parsetree
              ppx_tools_versioned)
   (kind ppx_rewriter)
-  (preprocess (pps ppx_tools_versioned.metaquot_406)))
+  (preprocess (pps ppx_tools_versioned.metaquot_407)))

ppx/ppx_js/lib_internal/ppx_js_internal.ml

@@ -18,16 +18,19 @@
 
 open StdLabels
 open Migrate_parsetree
-open OCaml_406.Ast
+open OCaml_407.Ast
 
 (* For implicit optional argument elimination. Annoying with Ast_helper. *)
 [@@@ocaml.warning "-48"]
 
+(* Pervasives is deprecated but metaquot refers to it. *)
+[@@@ocaml.warning "-3"]
+
 open Ast_mapper
 open Ast_helper
 open Asttypes
 open Parsetree
-open Ast_convenience_406
+open Ast_convenience_407
 
 (** Check if an expression is an identifier and returns it.
     Raise a Location.error if it's not.
@@ -53,12 +56,14 @@ let arrows args ret =
 let wrapper = ref None
 
 let make_str ?loc s =
-  match loc with None -> Location.mknoloc s | Some loc -> Location.mkloc s loc
+  match loc with
+  | None -> Location.mknoloc s
+  | Some loc -> Location.mkloc s loc
 
 let inside_Js =
   lazy
-    ( try Filename.basename (Filename.chop_extension !Location.input_name) = "js"
-      with Invalid_argument _ -> false )
+    (try Filename.basename (Filename.chop_extension !Location.input_name) = "js"
+     with Invalid_argument _ -> false)
 
 (* -- FIXME --
    [merlin_noloc] is an attempt to hide some ast node from merlin
@@ -81,7 +86,10 @@ end = struct
   let js_dot name =
     if Lazy.force inside_Js
     then name
-    else match !wrapper with None -> "Js." ^ name | Some m -> m ^ ".Js." ^ name
+    else
+      match !wrapper with
+      | None -> "Js." ^ name
+      | Some m -> m ^ ".Js." ^ name
 
   let js_unsafe_dot name = js_dot ("Unsafe." ^ name)
 
@@ -181,7 +189,7 @@ let invoker ?(extra_types = []) uplift downlift body arguments =
     List.map arguments ~f:(fun d ->
         let label = Arg.label d in
         let patt = Pat.var (Location.mknoloc (Arg.name d)) in
-        label, patt )
+        label, patt)
   in
   let make_fun (label, pat) (label', typ) expr =
     assert (label' = label);
@@ -236,12 +244,12 @@ let method_call ~loc obj meth args =
         | [] -> assert false
         | eobj :: eargs ->
             let eargs = inject_args eargs in
-            Js.unsafe "meth_call" [eobj; str (unescape meth); eargs] )
+            Js.unsafe "meth_call" [eobj; str (unescape meth); eargs])
       (Arg.make () :: List.map args ~f:(fun (label, _) -> Arg.make ~label ()))
   in
   Exp.apply
     invoker
-    ( (app_arg obj :: args)
+    ((app_arg obj :: args)
     @ [ app_arg
           (Exp.fun_
              ~loc
@@ -253,7 +261,7 @@ let method_call ~loc obj meth args =
                 ~loc
                 ~attrs:[merlin_noloc]
                 (Exp.ident ~loc:gloc (lid ~loc:gloc "x"))
-                (make_str ~loc meth))) ] )
+                (make_str ~loc meth))) ])
 
 (* {[ obj##.prop ]} generates
    {[
@@ -278,7 +286,7 @@ let prop_get ~loc:_ ~prop_loc obj prop =
       (fun eargs ->
         match eargs with
         | [] | _ :: _ :: _ -> assert false
-        | [only_arg] -> Js.unsafe "get" [only_arg; str (unescape prop)] )
+        | [only_arg] -> Js.unsafe "get" [only_arg; str (unescape prop)])
       [Arg.make ()]
   in
   Exp.apply
@@ -322,7 +330,7 @@ let prop_set ~loc ~prop_loc obj prop value =
             arrows
               [Label.nolabel, Arg.typ obj]
               (Js.type_ "gen_prop" [[%type: < set : [%t Arg.typ arg] -> unit ; .. > ]])
-        | _ -> assert false )
+        | _ -> assert false)
       (fun args _tres -> js_dot_t_the_first_arg args, [%type: unit])
       (function
         | [obj; arg] -> Js.unsafe "set" [obj; str (unescape prop); inject_arg arg]
@@ -374,22 +382,25 @@ let new_object constr args =
         | unit :: args ->
             assert (Arg.label unit = Label.nolabel);
             let args = Arg.args args in
-            (Label.nolabel, Js.type_ "constr" [arrows args tres]) :: args, tres )
+            (Label.nolabel, Js.type_ "constr" [arrows args tres]) :: args, tres)
       (function
         | constr :: args -> Js.unsafe "new_obj" [constr; inject_args args]
         | _ -> assert false)
       (Arg.make () :: List.map args ~f:(fun (label, _) -> Arg.make ~label ()))
   in
   Exp.apply
     invoker
-    ( (app_arg (Exp.ident ~loc:constr.loc constr) :: args)
-    @ [app_arg (Exp.construct ~loc:constr.loc (lid ~loc:constr.loc "()") None)] )
+    ((app_arg (Exp.ident ~loc:constr.loc constr) :: args)
+    @ [app_arg (Exp.construct ~loc:constr.loc (lid ~loc:constr.loc "()") None)])
 
 module S = Map.Make (String)
 
 (** We remove Pexp_poly as it should never be in the parsetree except after a method call.
 *)
-let format_meth body = match body.pexp_desc with Pexp_poly (e, _) -> e | _ -> body
+let format_meth body =
+  match body.pexp_desc with
+  | Pexp_poly (e, _) -> e
+  | _ -> body
 
 (** Ensure basic sanity rules about fields of a literal object:
     - No duplicated declaration
@@ -432,7 +443,9 @@ type field_desc =
 let filter_map f l =
   let l =
     List.fold_left l ~init:[] ~f:(fun acc x ->
-        match f x with Some x -> x :: acc | None -> acc )
+        match f x with
+        | Some x -> x :: acc
+        | None -> acc)
   in
   List.rev l
 
@@ -448,18 +461,13 @@ let preprocess_literal_object mappper fields : [`Fields of field_desc list | `Er
         if id.txt <> txt then Printf.sprintf " (normalized to %S)" txt else ""
       in
       let sub =
-        [ Location.errorf
-            ~loc:id'.loc
-            "Duplicated val or method %S%s."
-            id'.txt
-            (details id') ]
+        [id'.loc, Printf.sprintf "Duplicated val or method %S%s." id'.txt (details id')]
       in
-      Location.raise_errorf
+      Ast_mapper.make_error_of_message
         ~loc:id.loc
         ~sub
-        "Duplicated val or method %S%s."
-        id.txt
-        (details id)
+        (Printf.sprintf "Duplicated val or method %S%s." id.txt (details id))
+      |> Ast_mapper.raise_error
     else S.add txt id names
   in
   let drop_prefix ~prefix s =
@@ -520,7 +528,7 @@ let preprocess_literal_object mappper fields : [`Fields of field_desc list | `Er
           "This field is not valid inside a js literal object."
   in
   try `Fields (List.rev (snd (List.fold_left fields ~init:(S.empty, []) ~f)))
-  with Location.Error error -> `Error (extension_of_error error)
+  with Location.Error error -> `Error (Ast_mapper.extension_of_error error)
 
 (* {[ object%js (self)
      val readonlyprop = e1
@@ -558,13 +566,19 @@ let preprocess_literal_object mappper fields : [`Fields of field_desc list | `Er
           end)
    ]} *)
 let literal_object self_id (fields : field_desc list) =
-  let name = function Val (id, _, _, _) -> id | Meth (id, _, _, _, _) -> id in
+  let name = function
+    | Val (id, _, _, _) -> id
+    | Meth (id, _, _, _, _) -> id
+  in
   let body = function
     | Val (_, _, _, body) -> body
     | Meth (_, _, _, body, _) -> [%expr fun [%p self_id] -> [%e body]]
   in
   let extra_types =
-    List.concat (List.map fields ~f:(function Val _ -> [] | Meth (_, _, _, _, l) -> l))
+    List.concat
+      (List.map fields ~f:(function
+          | Val _ -> []
+          | Meth (_, _, _, _, l) -> l))
   in
   let invoker =
     invoker
@@ -580,9 +594,9 @@ let literal_object self_id (fields : field_desc list) =
                   ( label
                   , arrows
                       ((Label.nolabel, Js.type_ "t" [tres]) :: Arg.args args)
-                      (Js.type_ "meth" [ret_ty]) ) )
+                      (Js.type_ "meth" [ret_ty]) ))
         in
-        arrows ((Label.nolabel, Js.type_ "t" [tres]) :: args) tres )
+        arrows ((Label.nolabel, Js.type_ "t" [tres]) :: args) tres)
       (fun args tres ->
         let args =
           List.map2 fields args ~f:(fun f desc ->
@@ -593,9 +607,9 @@ let literal_object self_id (fields : field_desc list) =
               | Meth (_, _, _, _, args) ->
                   ( label
                   , arrows ((Label.nolabel, Js.type_ "t" [tres]) :: Arg.args args) ret_ty
-                  ) )
+                  ))
         in
-        args, Js.type_ "t" [tres] )
+        args, Js.type_ "t" [tres])
       (fun args ->
         Js.unsafe
           "obj"
@@ -604,12 +618,12 @@ let literal_object self_id (fields : field_desc list) =
                    tuple
                      [ str (unescape (name f).txt)
                      ; inject_arg
-                         ( match f with
+                         (match f with
                          | Val _ -> arg
-                         | Meth _ -> Js.fun_ "wrap_meth_callback" [arg] ) ] )) ] )
+                         | Meth _ -> Js.fun_ "wrap_meth_callback" [arg]) ])) ])
       (List.map fields ~f:(function
           | Val _ -> Arg.make ()
-          | Meth (_, _, _, _, _fun_ty) -> Arg.make () ))
+          | Meth (_, _, _, _, _fun_ty) -> Arg.make ()))
   in
   let self = "self" in
   let gloc = {!default_loc with Location.loc_ghost = true} in
@@ -634,11 +648,11 @@ let literal_object self_id (fields : field_desc list) =
                     , Cfk_concrete
                         ( Fresh
                         , apply (Exp.ident ~loc (lid ~loc:Location.none (name f).txt)) )
-                    ) } ) }
+                    ) }) }
   in
   Exp.apply
     invoker
-    ( List.map fields ~f:(fun f -> app_arg (body f))
+    (List.map fields ~f:(fun f -> app_arg (body f))
     @ [ app_arg
           (List.fold_right
              (self :: List.map fields ~f:(fun f -> (name f).txt))
@@ -649,7 +663,7 @@ let literal_object self_id (fields : field_desc list) =
                  Label.nolabel
                  None
                  (Pat.var ~loc:gloc (Location.mknoloc name))
-                 fun_ )) ] )
+                 fun_)) ])
 
 let mapper =
   { default_mapper with
@@ -703,8 +717,8 @@ let mapper =
               mapper.expr mapper {new_expr with pexp_attributes}
           (* new%js constr arg1 arg2 ..)] *)
           | { pexp_desc =
-                Pexp_apply ([%expr [%js [%e? {pexp_desc = Pexp_new constr; _}]]], args); _
-            } ->
+                Pexp_apply ([%expr [%js [%e? {pexp_desc = Pexp_new constr; _}]]], args)
+            ; _ } ->
               let args = List.map args ~f:(fun (s, e) -> s, mapper.expr mapper e) in
               let new_expr = new_object constr args in
               mapper.expr mapper {new_expr with pexp_attributes}
@@ -722,10 +736,10 @@ let mapper =
           | _ -> default_mapper.expr mapper expr
         in
         default_loc := prev_default_loc;
-        new_expr ) }
+        new_expr) }
 
 let () =
   Driver.register
     ~name:"ppx_js"
-    Migrate_parsetree.Versions.ocaml_406
-    (fun _config _cookies -> mapper )
+    Migrate_parsetree.Versions.ocaml_407
+    (fun _config _cookies -> mapper)