From 4a2963693031be73fc138f8e6c8dd8cc805d5d95 Mon Sep 17 00:00:00 2001 From: Nathan Rebours Date: Mon, 8 Jun 2020 16:30:28 +0200 Subject: [PATCH 1/4] Workaround for tests under 4.10 Signed-off-by: Nathan Rebours --- test/base/dune | 2 +- test/code_path/dune | 2 +- test/deriving/dune | 2 +- test/driver/attributes/dune | 2 +- test/driver/non-compressible-suffix/dune | 2 +- test/driver/transformations/dune | 2 +- test/quoter/dune | 2 +- test/traverse/dune | 2 +- 8 files changed, 8 insertions(+), 8 deletions(-) diff --git a/test/base/dune b/test/base/dune index 6278e9f1..bde88de5 100644 --- a/test/base/dune +++ b/test/base/dune @@ -7,5 +7,5 @@ (chdir %{project_root} (progn (ignore-outputs - (run %{project_root}/test/expect/expect_test.exe %{test})) + (run %{project_root}/test/expect/expect_test.bc %{test})) (diff? %{test} %{test}.corrected))))) diff --git a/test/code_path/dune b/test/code_path/dune index e84bb7fe..4f8c9da8 100644 --- a/test/code_path/dune +++ b/test/code_path/dune @@ -6,5 +6,5 @@ (action (chdir %{project_root} (progn (ignore-outputs - (run %{project_root}/test/expect/expect_test.exe %{test})) + (run %{project_root}/test/expect/expect_test.bc %{test})) (diff? %{test} %{test}.corrected))))) diff --git a/test/deriving/dune b/test/deriving/dune index e84bb7fe..4f8c9da8 100644 --- a/test/deriving/dune +++ b/test/deriving/dune @@ -6,5 +6,5 @@ (action (chdir %{project_root} (progn (ignore-outputs - (run %{project_root}/test/expect/expect_test.exe %{test})) + (run %{project_root}/test/expect/expect_test.bc %{test})) (diff? %{test} %{test}.corrected))))) diff --git a/test/driver/attributes/dune b/test/driver/attributes/dune index e84bb7fe..4f8c9da8 100644 --- a/test/driver/attributes/dune +++ b/test/driver/attributes/dune @@ -6,5 +6,5 @@ (action (chdir %{project_root} (progn (ignore-outputs - (run %{project_root}/test/expect/expect_test.exe %{test})) + (run %{project_root}/test/expect/expect_test.bc %{test})) (diff? %{test} %{test}.corrected))))) diff --git a/test/driver/non-compressible-suffix/dune b/test/driver/non-compressible-suffix/dune index e84bb7fe..4f8c9da8 100644 --- a/test/driver/non-compressible-suffix/dune +++ b/test/driver/non-compressible-suffix/dune @@ -6,5 +6,5 @@ (action (chdir %{project_root} (progn (ignore-outputs - (run %{project_root}/test/expect/expect_test.exe %{test})) + (run %{project_root}/test/expect/expect_test.bc %{test})) (diff? %{test} %{test}.corrected))))) diff --git a/test/driver/transformations/dune b/test/driver/transformations/dune index e84bb7fe..4f8c9da8 100644 --- a/test/driver/transformations/dune +++ b/test/driver/transformations/dune @@ -6,5 +6,5 @@ (action (chdir %{project_root} (progn (ignore-outputs - (run %{project_root}/test/expect/expect_test.exe %{test})) + (run %{project_root}/test/expect/expect_test.bc %{test})) (diff? %{test} %{test}.corrected))))) diff --git a/test/quoter/dune b/test/quoter/dune index e84bb7fe..4f8c9da8 100644 --- a/test/quoter/dune +++ b/test/quoter/dune @@ -6,5 +6,5 @@ (action (chdir %{project_root} (progn (ignore-outputs - (run %{project_root}/test/expect/expect_test.exe %{test})) + (run %{project_root}/test/expect/expect_test.bc %{test})) (diff? %{test} %{test}.corrected))))) diff --git a/test/traverse/dune b/test/traverse/dune index e84bb7fe..4f8c9da8 100644 --- a/test/traverse/dune +++ b/test/traverse/dune @@ -6,5 +6,5 @@ (action (chdir %{project_root} (progn (ignore-outputs - (run %{project_root}/test/expect/expect_test.exe %{test})) + (run %{project_root}/test/expect/expect_test.bc %{test})) (diff? %{test} %{test}.corrected))))) From f655de4e273c5447b918ed8d1bc749d638aa20f6 Mon Sep 17 00:00:00 2001 From: Nathan Rebours Date: Tue, 9 Jun 2020 12:09:22 +0200 Subject: [PATCH 2/4] Bump internal AST to 4.10 Signed-off-by: Nathan Rebours --- .travis.yml | 1 + ast/ast.ml | 208 ++++++++++++++++++++++--------------- ast/import.ml | 2 +- ast/pprintast.ml | 75 ++++++++----- ppxlib.opam | 2 +- src/ast_traverse.ml | 16 ++- src/gen/gen_ast_builder.ml | 20 ++-- src/location_check.ml | 40 +++---- 8 files changed, 225 insertions(+), 139 deletions(-) diff --git a/.travis.yml b/.travis.yml index fcab2a7d..fd68342b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -17,3 +17,4 @@ env: - OCAML_VERSION="4.07" - OCAML_VERSION="4.08" - OCAML_VERSION="4.09" + - OCAML_VERSION="4.10" diff --git a/ast/ast.ml b/ast/ast.ml index 65075283..53ce4f70 100644 --- a/ast/ast.ml +++ b/ast/ast.ml @@ -321,7 +321,7 @@ and pattern_desc = Parsetree.pattern_desc = (* #tconst *) | Ppat_lazy of pattern (* lazy P *) - | Ppat_unpack of string loc + | Ppat_unpack of string option loc (* (module P) Note: (module P : S) is represented as Ppat_constraint(Ppat_unpack, Ptyp_package) @@ -429,7 +429,7 @@ and expression_desc = Parsetree.expression_desc = (* x <- 2 *) | Pexp_override of (label loc * expression) list (* {< x1 = E1; ...; Xn = En >} *) - | Pexp_letmodule of string loc * module_expr * expression + | Pexp_letmodule of string option loc * module_expr * expression (* let module M = ME in E *) | Pexp_letexception of extension_constructor * expression (* let exception C in E *) @@ -792,7 +792,7 @@ and module_type_desc = Parsetree.module_type_desc = (* S *) | Pmty_signature of signature (* sig ... end *) - | Pmty_functor of string loc * module_type option * module_type + | Pmty_functor of functor_parameter * module_type (* functor(X : MT1) -> MT2 *) | Pmty_with of module_type * with_constraint list (* MT with ... *) @@ -803,6 +803,13 @@ and module_type_desc = Parsetree.module_type_desc = | Pmty_alias of longident_loc (* (module M) *) +and functor_parameter = Parsetree.functor_parameter = + | Unit + (* () *) + | Named of string option loc * module_type + (* (X : MT) Some X, MT + (_ : MT) None, MT *) + and signature = signature_item list and signature_item = Parsetree.signature_item = @@ -849,7 +856,7 @@ and signature_item_desc = Parsetree.signature_item_desc = and module_declaration = Parsetree.module_declaration = { - pmd_name: string loc; + pmd_name: string option loc; pmd_type: module_type; pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmd_loc: location; @@ -929,7 +936,7 @@ and module_expr_desc = Parsetree.module_expr_desc = (* X *) | Pmod_structure of structure (* struct ... end *) - | Pmod_functor of string loc * module_type option * module_expr + | Pmod_functor of functor_parameter * module_expr (* functor(X : MT1) -> ME *) | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) @@ -994,7 +1001,7 @@ and value_binding = Parsetree.value_binding = and module_binding = Parsetree.module_binding = { - pmb_name: string loc; + pmb_name: string option loc; pmb_expr: module_expr; pmb_attributes: attributes; pmb_loc: location; @@ -1229,7 +1236,8 @@ class virtual map = let b = self#core_type b in Ppat_constraint (a, b) | Ppat_type a -> let a = self#longident_loc a in Ppat_type a | Ppat_lazy a -> let a = self#pattern a in Ppat_lazy a - | Ppat_unpack a -> let a = self#loc self#string a in Ppat_unpack a + | Ppat_unpack a -> + let a = self#loc (self#option self#string) a in Ppat_unpack a | Ppat_exception a -> let a = self#pattern a in Ppat_exception a | Ppat_extension a -> let a = self#extension a in Ppat_extension a | Ppat_open (a, b) -> @@ -1332,7 +1340,7 @@ class virtual map = let b = self#expression b in (a, b)) a in Pexp_override a | Pexp_letmodule (a, b, c) -> - let a = self#loc self#string a in + let a = self#loc (self#option self#string) a in let b = self#module_expr b in let c = self#expression c in Pexp_letmodule (a, b, c) | Pexp_letexception (a, b) -> @@ -1678,16 +1686,22 @@ class virtual map = match x with | Pmty_ident a -> let a = self#longident_loc a in Pmty_ident a | Pmty_signature a -> let a = self#signature a in Pmty_signature a - | Pmty_functor (a, b, c) -> - let a = self#loc self#string a in - let b = self#option self#module_type b in - let c = self#module_type c in Pmty_functor (a, b, c) + | Pmty_functor (a, b) -> + let a = self#functor_parameter a in + let b = self#module_type b in Pmty_functor (a, b) | Pmty_with (a, b) -> let a = self#module_type a in let b = self#list self#with_constraint b in Pmty_with (a, b) | Pmty_typeof a -> let a = self#module_expr a in Pmty_typeof a | Pmty_extension a -> let a = self#extension a in Pmty_extension a | Pmty_alias a -> let a = self#longident_loc a in Pmty_alias a + method functor_parameter : functor_parameter -> functor_parameter= + fun x -> + match x with + | Unit -> Unit + | Named (a, b) -> + let a = self#loc (self#option self#string) a in + let b = self#module_type b in Named (a, b) method signature : signature -> signature= self#list self#signature_item method signature_item : signature_item -> signature_item= fun { psig_desc; psig_loc } -> @@ -1726,7 +1740,7 @@ class virtual map = let b = self#attributes b in Psig_extension (a, b) method module_declaration : module_declaration -> module_declaration= fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> - let pmd_name = self#loc self#string pmd_name in + let pmd_name = self#loc (self#option self#string) pmd_name in let pmd_type = self#module_type pmd_type in let pmd_attributes = self#attributes pmd_attributes in let pmd_loc = self#location pmd_loc in @@ -1796,10 +1810,9 @@ class virtual map = match x with | Pmod_ident a -> let a = self#longident_loc a in Pmod_ident a | Pmod_structure a -> let a = self#structure a in Pmod_structure a - | Pmod_functor (a, b, c) -> - let a = self#loc self#string a in - let b = self#option self#module_type b in - let c = self#module_expr c in Pmod_functor (a, b, c) + | Pmod_functor (a, b) -> + let a = self#functor_parameter a in + let b = self#module_expr b in Pmod_functor (a, b) | Pmod_apply (a, b) -> let a = self#module_expr a in let b = self#module_expr b in Pmod_apply (a, b) @@ -1856,7 +1869,7 @@ class virtual map = { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } method module_binding : module_binding -> module_binding= fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> - let pmb_name = self#loc self#string pmb_name in + let pmb_name = self#loc (self#option self#string) pmb_name in let pmb_expr = self#module_expr pmb_expr in let pmb_attributes = self#attributes pmb_attributes in let pmb_loc = self#location pmb_loc in @@ -2031,7 +2044,7 @@ class virtual iter = | Ppat_constraint (a, b) -> (self#pattern a; self#core_type b) | Ppat_type a -> self#longident_loc a | Ppat_lazy a -> self#pattern a - | Ppat_unpack a -> self#loc self#string a + | Ppat_unpack a -> self#loc (self#option self#string) a | Ppat_exception a -> self#pattern a | Ppat_extension a -> self#extension a | Ppat_open (a, b) -> (self#longident_loc a; self#pattern b) @@ -2099,7 +2112,9 @@ class virtual iter = self#list (fun (a, b) -> self#loc self#label a; self#expression b) a | Pexp_letmodule (a, b, c) -> - (self#loc self#string a; self#module_expr b; self#expression c) + (self#loc (self#option self#string) a; + self#module_expr b; + self#expression c) | Pexp_letexception (a, b) -> (self#extension_constructor a; self#expression b) | Pexp_assert a -> self#expression a @@ -2341,15 +2356,19 @@ class virtual iter = match x with | Pmty_ident a -> self#longident_loc a | Pmty_signature a -> self#signature a - | Pmty_functor (a, b, c) -> - (self#loc self#string a; - self#option self#module_type b; - self#module_type c) + | Pmty_functor (a, b) -> + (self#functor_parameter a; self#module_type b) | Pmty_with (a, b) -> (self#module_type a; self#list self#with_constraint b) | Pmty_typeof a -> self#module_expr a | Pmty_extension a -> self#extension a | Pmty_alias a -> self#longident_loc a + method functor_parameter : functor_parameter -> unit= + fun x -> + match x with + | Unit -> () + | Named (a, b) -> + (self#loc (self#option self#string) a; self#module_type b) method signature : signature -> unit= self#list self#signature_item method signature_item : signature_item -> unit= fun { psig_desc; psig_loc } -> @@ -2375,7 +2394,7 @@ class virtual iter = | Psig_extension (a, b) -> (self#extension a; self#attributes b) method module_declaration : module_declaration -> unit= fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> - self#loc self#string pmd_name; + self#loc (self#option self#string) pmd_name; self#module_type pmd_type; self#attributes pmd_attributes; self#location pmd_loc @@ -2432,10 +2451,8 @@ class virtual iter = match x with | Pmod_ident a -> self#longident_loc a | Pmod_structure a -> self#structure a - | Pmod_functor (a, b, c) -> - (self#loc self#string a; - self#option self#module_type b; - self#module_expr c) + | Pmod_functor (a, b) -> + (self#functor_parameter a; self#module_expr b) | Pmod_apply (a, b) -> (self#module_expr a; self#module_expr b) | Pmod_constraint (a, b) -> (self#module_expr a; self#module_type b) | Pmod_unpack a -> self#expression a @@ -2472,7 +2489,7 @@ class virtual iter = self#location pvb_loc method module_binding : module_binding -> unit= fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> - self#loc self#string pmb_name; + self#loc (self#option self#string) pmb_name; self#module_expr pmb_expr; self#attributes pmb_attributes; self#location pmb_loc @@ -2720,7 +2737,7 @@ class virtual ['acc] fold = let acc = self#core_type b acc in acc | Ppat_type a -> self#longident_loc a acc | Ppat_lazy a -> self#pattern a acc - | Ppat_unpack a -> self#loc self#string a acc + | Ppat_unpack a -> self#loc (self#option self#string) a acc | Ppat_exception a -> self#pattern a acc | Ppat_extension a -> self#extension a acc | Ppat_open (a, b) -> @@ -2824,7 +2841,7 @@ class virtual ['acc] fold = let acc = self#loc self#label a acc in let acc = self#expression b acc in acc) a acc | Pexp_letmodule (a, b, c) -> - let acc = self#loc self#string a acc in + let acc = self#loc (self#option self#string) a acc in let acc = self#module_expr b acc in let acc = self#expression c acc in acc | Pexp_letexception (a, b) -> @@ -3150,16 +3167,23 @@ class virtual ['acc] fold = match x with | Pmty_ident a -> self#longident_loc a acc | Pmty_signature a -> self#signature a acc - | Pmty_functor (a, b, c) -> - let acc = self#loc self#string a acc in - let acc = self#option self#module_type b acc in - let acc = self#module_type c acc in acc + | Pmty_functor (a, b) -> + let acc = self#functor_parameter a acc in + let acc = self#module_type b acc in acc | Pmty_with (a, b) -> let acc = self#module_type a acc in let acc = self#list self#with_constraint b acc in acc | Pmty_typeof a -> self#module_expr a acc | Pmty_extension a -> self#extension a acc | Pmty_alias a -> self#longident_loc a acc + method functor_parameter : functor_parameter -> 'acc -> 'acc= + fun x -> + fun acc -> + match x with + | Unit -> acc + | Named (a, b) -> + let acc = self#loc (self#option self#string) a acc in + let acc = self#module_type b acc in acc method signature : signature -> 'acc -> 'acc= self#list self#signature_item method signature_item : signature_item -> 'acc -> 'acc= @@ -3193,7 +3217,7 @@ class virtual ['acc] fold = method module_declaration : module_declaration -> 'acc -> 'acc= fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> fun acc -> - let acc = self#loc self#string pmd_name acc in + let acc = self#loc (self#option self#string) pmd_name acc in let acc = self#module_type pmd_type acc in let acc = self#attributes pmd_attributes acc in let acc = self#location pmd_loc acc in acc @@ -3264,10 +3288,9 @@ class virtual ['acc] fold = match x with | Pmod_ident a -> self#longident_loc a acc | Pmod_structure a -> self#structure a acc - | Pmod_functor (a, b, c) -> - let acc = self#loc self#string a acc in - let acc = self#option self#module_type b acc in - let acc = self#module_expr c acc in acc + | Pmod_functor (a, b) -> + let acc = self#functor_parameter a acc in + let acc = self#module_expr b acc in acc | Pmod_apply (a, b) -> let acc = self#module_expr a acc in let acc = self#module_expr b acc in acc @@ -3320,7 +3343,7 @@ class virtual ['acc] fold = method module_binding : module_binding -> 'acc -> 'acc= fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> fun acc -> - let acc = self#loc self#string pmb_name acc in + let acc = self#loc (self#option self#string) pmb_name acc in let acc = self#module_expr pmb_expr acc in let acc = self#attributes pmb_attributes acc in let acc = self#location pmb_loc acc in acc @@ -3636,7 +3659,7 @@ class virtual ['acc] fold_map = | Ppat_lazy a -> let (a, acc) = self#pattern a acc in ((Ppat_lazy a), acc) | Ppat_unpack a -> - let (a, acc) = self#loc self#string a acc in + let (a, acc) = self#loc (self#option self#string) a acc in ((Ppat_unpack a), acc) | Ppat_exception a -> let (a, acc) = self#pattern a acc in ((Ppat_exception a), acc) @@ -3778,7 +3801,7 @@ class virtual ['acc] fold_map = a acc in ((Pexp_override a), acc) | Pexp_letmodule (a, b, c) -> - let (a, acc) = self#loc self#string a acc in + let (a, acc) = self#loc (self#option self#string) a acc in let (b, acc) = self#module_expr b acc in let (c, acc) = self#expression c acc in ((Pexp_letmodule (a, b, c)), acc) @@ -4254,11 +4277,10 @@ class virtual ['acc] fold_map = | Pmty_signature a -> let (a, acc) = self#signature a acc in ((Pmty_signature a), acc) - | Pmty_functor (a, b, c) -> - let (a, acc) = self#loc self#string a acc in - let (b, acc) = self#option self#module_type b acc in - let (c, acc) = self#module_type c acc in - ((Pmty_functor (a, b, c)), acc) + | Pmty_functor (a, b) -> + let (a, acc) = self#functor_parameter a acc in + let (b, acc) = self#module_type b acc in + ((Pmty_functor (a, b)), acc) | Pmty_with (a, b) -> let (a, acc) = self#module_type a acc in let (b, acc) = self#list self#with_constraint b acc in @@ -4271,6 +4293,15 @@ class virtual ['acc] fold_map = | Pmty_alias a -> let (a, acc) = self#longident_loc a acc in ((Pmty_alias a), acc) + method functor_parameter : + functor_parameter -> 'acc -> (functor_parameter * 'acc)= + fun x -> + fun acc -> + match x with + | Unit -> (Unit, acc) + | Named (a, b) -> + let (a, acc) = self#loc (self#option self#string) a acc in + let (b, acc) = self#module_type b acc in ((Named (a, b)), acc) method signature : signature -> 'acc -> (signature * 'acc)= self#list self#signature_item method signature_item : @@ -4336,7 +4367,8 @@ class virtual ['acc] fold_map = module_declaration -> 'acc -> (module_declaration * 'acc)= fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> fun acc -> - let (pmd_name, acc) = self#loc self#string pmd_name acc in + let (pmd_name, acc) = + self#loc (self#option self#string) pmd_name acc in let (pmd_type, acc) = self#module_type pmd_type acc in let (pmd_attributes, acc) = self#attributes pmd_attributes acc in let (pmd_loc, acc) = self#location pmd_loc acc in @@ -4436,11 +4468,10 @@ class virtual ['acc] fold_map = | Pmod_structure a -> let (a, acc) = self#structure a acc in ((Pmod_structure a), acc) - | Pmod_functor (a, b, c) -> - let (a, acc) = self#loc self#string a acc in - let (b, acc) = self#option self#module_type b acc in - let (c, acc) = self#module_expr c acc in - ((Pmod_functor (a, b, c)), acc) + | Pmod_functor (a, b) -> + let (a, acc) = self#functor_parameter a acc in + let (b, acc) = self#module_expr b acc in + ((Pmod_functor (a, b)), acc) | Pmod_apply (a, b) -> let (a, acc) = self#module_expr a acc in let (b, acc) = self#module_expr b acc in @@ -4529,7 +4560,8 @@ class virtual ['acc] fold_map = module_binding -> 'acc -> (module_binding * 'acc)= fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> fun acc -> - let (pmb_name, acc) = self#loc self#string pmb_name acc in + let (pmb_name, acc) = + self#loc (self#option self#string) pmb_name acc in let (pmb_expr, acc) = self#module_expr pmb_expr acc in let (pmb_attributes, acc) = self#attributes pmb_attributes acc in let (pmb_loc, acc) = self#location pmb_loc acc in @@ -4817,7 +4849,8 @@ class virtual ['ctx] map_with_context = | Ppat_type a -> let a = self#longident_loc ctx a in Ppat_type a | Ppat_lazy a -> let a = self#pattern ctx a in Ppat_lazy a | Ppat_unpack a -> - let a = self#loc self#string ctx a in Ppat_unpack a + let a = self#loc (self#option self#string) ctx a in + Ppat_unpack a | Ppat_exception a -> let a = self#pattern ctx a in Ppat_exception a | Ppat_extension a -> @@ -4932,7 +4965,7 @@ class virtual ['ctx] map_with_context = let b = self#expression ctx b in (a, b)) ctx a in Pexp_override a | Pexp_letmodule (a, b, c) -> - let a = self#loc self#string ctx a in + let a = self#loc (self#option self#string) ctx a in let b = self#module_expr ctx b in let c = self#expression ctx c in Pexp_letmodule (a, b, c) | Pexp_letexception (a, b) -> @@ -5341,10 +5374,9 @@ class virtual ['ctx] map_with_context = | Pmty_ident a -> let a = self#longident_loc ctx a in Pmty_ident a | Pmty_signature a -> let a = self#signature ctx a in Pmty_signature a - | Pmty_functor (a, b, c) -> - let a = self#loc self#string ctx a in - let b = self#option self#module_type ctx b in - let c = self#module_type ctx c in Pmty_functor (a, b, c) + | Pmty_functor (a, b) -> + let a = self#functor_parameter ctx a in + let b = self#module_type ctx b in Pmty_functor (a, b) | Pmty_with (a, b) -> let a = self#module_type ctx a in let b = self#list self#with_constraint ctx b in @@ -5353,6 +5385,15 @@ class virtual ['ctx] map_with_context = | Pmty_extension a -> let a = self#extension ctx a in Pmty_extension a | Pmty_alias a -> let a = self#longident_loc ctx a in Pmty_alias a + method functor_parameter : + 'ctx -> functor_parameter -> functor_parameter= + fun ctx -> + fun x -> + match x with + | Unit -> Unit + | Named (a, b) -> + let a = self#loc (self#option self#string) ctx a in + let b = self#module_type ctx b in Named (a, b) method signature : 'ctx -> signature -> signature= self#list self#signature_item method signature_item : 'ctx -> signature_item -> signature_item= @@ -5405,7 +5446,7 @@ class virtual ['ctx] map_with_context = 'ctx -> module_declaration -> module_declaration= fun ctx -> fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> - let pmd_name = self#loc self#string ctx pmd_name in + let pmd_name = self#loc (self#option self#string) ctx pmd_name in let pmd_type = self#module_type ctx pmd_type in let pmd_attributes = self#attributes ctx pmd_attributes in let pmd_loc = self#location ctx pmd_loc in @@ -5487,10 +5528,9 @@ class virtual ['ctx] map_with_context = | Pmod_ident a -> let a = self#longident_loc ctx a in Pmod_ident a | Pmod_structure a -> let a = self#structure ctx a in Pmod_structure a - | Pmod_functor (a, b, c) -> - let a = self#loc self#string ctx a in - let b = self#option self#module_type ctx b in - let c = self#module_expr ctx c in Pmod_functor (a, b, c) + | Pmod_functor (a, b) -> + let a = self#functor_parameter ctx a in + let b = self#module_expr ctx b in Pmod_functor (a, b) | Pmod_apply (a, b) -> let a = self#module_expr ctx a in let b = self#module_expr ctx b in Pmod_apply (a, b) @@ -5559,7 +5599,7 @@ class virtual ['ctx] map_with_context = method module_binding : 'ctx -> module_binding -> module_binding= fun ctx -> fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> - let pmb_name = self#loc self#string ctx pmb_name in + let pmb_name = self#loc (self#option self#string) ctx pmb_name in let pmb_expr = self#module_expr ctx pmb_expr in let pmb_attributes = self#attributes ctx pmb_attributes in let pmb_loc = self#location ctx pmb_loc in @@ -5884,7 +5924,8 @@ class virtual ['res] lift = | Ppat_lazy a -> let a = self#pattern a in self#constr "Ppat_lazy" [a] | Ppat_unpack a -> - let a = self#loc self#string a in self#constr "Ppat_unpack" [a] + let a = self#loc (self#option self#string) a in + self#constr "Ppat_unpack" [a] | Ppat_exception a -> let a = self#pattern a in self#constr "Ppat_exception" [a] | Ppat_extension a -> @@ -6006,7 +6047,7 @@ class virtual ['res] lift = let b = self#expression b in self#tuple [a; b]) a in self#constr "Pexp_override" [a] | Pexp_letmodule (a, b, c) -> - let a = self#loc self#string a in + let a = self#loc (self#option self#string) a in let b = self#module_expr b in let c = self#expression c in self#constr "Pexp_letmodule" [a; b; c] @@ -6423,11 +6464,9 @@ class virtual ['res] lift = let a = self#longident_loc a in self#constr "Pmty_ident" [a] | Pmty_signature a -> let a = self#signature a in self#constr "Pmty_signature" [a] - | Pmty_functor (a, b, c) -> - let a = self#loc self#string a in - let b = self#option self#module_type b in - let c = self#module_type c in - self#constr "Pmty_functor" [a; b; c] + | Pmty_functor (a, b) -> + let a = self#functor_parameter a in + let b = self#module_type b in self#constr "Pmty_functor" [a; b] | Pmty_with (a, b) -> let a = self#module_type a in let b = self#list self#with_constraint b in @@ -6438,6 +6477,13 @@ class virtual ['res] lift = let a = self#extension a in self#constr "Pmty_extension" [a] | Pmty_alias a -> let a = self#longident_loc a in self#constr "Pmty_alias" [a] + method functor_parameter : functor_parameter -> 'res= + fun x -> + match x with + | Unit -> self#constr "Unit" [] + | Named (a, b) -> + let a = self#loc (self#option self#string) a in + let b = self#module_type b in self#constr "Named" [a; b] method signature : signature -> 'res= self#list self#signature_item method signature_item : signature_item -> 'res= fun { psig_desc; psig_loc } -> @@ -6490,7 +6536,7 @@ class virtual ['res] lift = let b = self#attributes b in self#constr "Psig_extension" [a; b] method module_declaration : module_declaration -> 'res= fun { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> - let pmd_name = self#loc self#string pmd_name in + let pmd_name = self#loc (self#option self#string) pmd_name in let pmd_type = self#module_type pmd_type in let pmd_attributes = self#attributes pmd_attributes in let pmd_loc = self#location pmd_loc in @@ -6585,11 +6631,9 @@ class virtual ['res] lift = let a = self#longident_loc a in self#constr "Pmod_ident" [a] | Pmod_structure a -> let a = self#structure a in self#constr "Pmod_structure" [a] - | Pmod_functor (a, b, c) -> - let a = self#loc self#string a in - let b = self#option self#module_type b in - let c = self#module_expr c in - self#constr "Pmod_functor" [a; b; c] + | Pmod_functor (a, b) -> + let a = self#functor_parameter a in + let b = self#module_expr b in self#constr "Pmod_functor" [a; b] | Pmod_apply (a, b) -> let a = self#module_expr a in let b = self#module_expr b in self#constr "Pmod_apply" [a; b] @@ -6665,7 +6709,7 @@ class virtual ['res] lift = ("pvb_loc", pvb_loc)] method module_binding : module_binding -> 'res= fun { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> - let pmb_name = self#loc self#string pmb_name in + let pmb_name = self#loc (self#option self#string) pmb_name in let pmb_expr = self#module_expr pmb_expr in let pmb_attributes = self#attributes pmb_attributes in let pmb_loc = self#location pmb_loc in diff --git a/ast/import.ml b/ast/import.ml index b1c767c5..26a5dbef 100644 --- a/ast/import.ml +++ b/ast/import.ml @@ -4,7 +4,7 @@ It must be opened in all modules, especially the ones coming from the compiler. *) -module Js = Migrate_parsetree.OCaml_408 +module Js = Migrate_parsetree.OCaml_410 module Ocaml = Migrate_parsetree.Versions.OCaml_current module Select_ast(Ocaml : Migrate_parsetree.Versions.OCaml_version) = struct diff --git a/ast/pprintast.ml b/ast/pprintast.ml index af373da0..95d80f2d 100644 --- a/ast/pprintast.ml +++ b/ast/pprintast.ml @@ -443,8 +443,10 @@ and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit = | Ppat_var ({txt = txt;_}) -> protect_ident f txt | Ppat_array l -> pp f "@[<2>[|%a|]@]" (list (pattern1 ctxt) ~sep:";") l - | Ppat_unpack (s) -> - pp f "(module@ %s)@ " s.txt + | Ppat_unpack { txt = None } -> + pp f "(module@ _)@ " + | Ppat_unpack { txt= Some s } -> + pp f "(module@ %s)@ " s | Ppat_type li -> pp f "#%a" longident_loc li | Ppat_record (l, closed) -> @@ -695,7 +697,8 @@ and expression ctxt f x = pp f "@[{<%a>}@]" (list string_x_expression ~sep:";" ) l; | Pexp_letmodule (s, me, e) -> - pp f "@[let@ module@ %s@ =@ %a@ in@ %a@]" s.txt + pp f "@[let@ module@ %s@ =@ %a@ in@ %a@]" + (match s.txt with None -> "_" | Some s -> s) (module_expr reset_ctxt) me (expression ctxt) e | Pexp_letexception (cd, e) -> pp f "@[let@ exception@ %a@ in@ %a@]" @@ -1018,15 +1021,17 @@ and module_type ctxt f x = (attributes ctxt) x.pmty_attributes end else match x.pmty_desc with - | Pmty_functor (_, None, mt2) -> + | Pmty_functor (Unit, mt2) -> pp f "@[functor () ->@ %a@]" (module_type ctxt) mt2 - | Pmty_functor (s, Some mt1, mt2) -> - if s.txt = "_" then - pp f "@[%a@ ->@ %a@]" - (module_type1 ctxt) mt1 (module_type ctxt) mt2 - else - pp f "@[functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt - (module_type ctxt) mt1 (module_type ctxt) mt2 + | Pmty_functor (Named (s, mt1), mt2) -> + begin match s.txt with + | None -> + pp f "@[%a@ ->@ %a@]" + (module_type1 ctxt) mt1 (module_type ctxt) mt2 + | Some name -> + pp f "@[functor@ (%s@ :@ %a)@ ->@ %a@]" name + (module_type ctxt) mt1 (module_type ctxt) mt2 + end | Pmty_with (mt, []) -> module_type ctxt f mt | Pmty_with (mt, l) -> let with_constraint f = function @@ -1100,12 +1105,13 @@ and signature_item ctxt f x : unit = end | Psig_module ({pmd_type={pmty_desc=Pmty_alias alias; pmty_attributes=[]; _};_} as pmd) -> - pp f "@[module@ %s@ =@ %a@]%a" pmd.pmd_name.txt + pp f "@[module@ %s@ =@ %a@]%a" + (match pmd.pmd_name.txt with None -> "_" | Some s -> s) longident_loc alias (item_attributes ctxt) pmd.pmd_attributes | Psig_module pmd -> pp f "@[module@ %s@ :@ %a@]%a" - pmd.pmd_name.txt + (match pmd.pmd_name.txt with None -> "_" | Some s -> s) (module_type ctxt) pmd.pmd_type (item_attributes ctxt) pmd.pmd_attributes | Psig_modsubst pms -> @@ -1138,11 +1144,13 @@ and signature_item ctxt f x : unit = | [] -> () ; | pmd :: tl -> if not first then - pp f "@ @[and@ %s:@ %a@]%a" pmd.pmd_name.txt + pp f "@ @[and@ %s:@ %a@]%a" + (match pmd.pmd_name.txt with None -> "_" | Some s -> s) (module_type1 ctxt) pmd.pmd_type (item_attributes ctxt) pmd.pmd_attributes else - pp f "@[module@ rec@ %s:@ %a@]%a" pmd.pmd_name.txt + pp f "@[module@ rec@ %s:@ %a@]%a" + (match pmd.pmd_name.txt with None -> "_" | Some s -> s) (module_type1 ctxt) pmd.pmd_type (item_attributes ctxt) pmd.pmd_attributes; string_x_module_type_list f ~first:false tl @@ -1167,11 +1175,12 @@ and module_expr ctxt f x = (module_type ctxt) mt | Pmod_ident (li) -> pp f "%a" longident_loc li; - | Pmod_functor (_, None, me) -> + | Pmod_functor (Unit, me) -> pp f "functor ()@;->@;%a" (module_expr ctxt) me - | Pmod_functor (s, Some mt, me) -> + | Pmod_functor (Named (s, mt), me) -> pp f "functor@ (%s@ :@ %a)@;->@;%a" - s.txt (module_type ctxt) mt (module_expr ctxt) me + (match s.txt with None -> "_" | Some s -> s) + (module_type ctxt) mt (module_expr ctxt) me | Pmod_apply (me1, me2) -> pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2 (* Cf: #7200 *) @@ -1296,14 +1305,19 @@ and structure_item ctxt f x = | Pstr_exception ed -> exception_declaration ctxt f ed | Pstr_module x -> let rec module_helper = function - | {pmod_desc=Pmod_functor(s,mt,me'); pmod_attributes = []} -> - if mt = None then pp f "()" - else Misc_helper.may (pp f "(%s:%a)" s.txt (module_type ctxt)) mt; + | {pmod_desc=Pmod_functor(arg_opt,me'); pmod_attributes = []} -> + begin match arg_opt with + | Unit -> pp f "()" + | Named (s, mt) -> + pp f "(%s:%a)" + (match s.txt with None -> "_" | Some s -> s) + (module_type ctxt) mt + end; module_helper me' | me -> me in pp f "@[module %s%a@]%a" - x.pmb_name.txt + (match x.pmb_name.txt with None -> "_" | Some s -> s) (fun f me -> let me = module_helper me in match me with @@ -1382,20 +1396,31 @@ and structure_item ctxt f x = | Pstr_recmodule decls -> (* 3.07 *) let aux f = function | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) -> - pp f "@[@ and@ %s:%a@ =@ %a@]%a" pmb.pmb_name.txt + pp f "@[@ and@ %s:%a@ =@ %a@]%a" + (match pmb.pmb_name.txt with None -> "_" | Some s -> s) (module_type ctxt) typ (module_expr ctxt) expr (item_attributes ctxt) pmb.pmb_attributes - | _ -> assert false + | pmb -> + pp f "@[@ and@ %s@ =@ %a@]%a" + (match pmb.pmb_name.txt with None -> "_" | Some s -> s) + (module_expr ctxt) pmb.pmb_expr + (item_attributes ctxt) pmb.pmb_attributes in begin match decls with | ({pmb_expr={pmod_desc=Pmod_constraint (expr, typ)}} as pmb) :: l2 -> pp f "@[@[module@ rec@ %s:%a@ =@ %a@]%a@ %a@]" - pmb.pmb_name.txt + (match pmb.pmb_name.txt with None -> "_" | Some s -> s) (module_type ctxt) typ (module_expr ctxt) expr (item_attributes ctxt) pmb.pmb_attributes (fun f l2 -> List.iter (aux f) l2) l2 + | pmb :: l2 -> + pp f "@[@[module@ rec@ %s@ =@ %a@]%a@ %a@]" + (match pmb.pmb_name.txt with None -> "_" | Some s -> s) + (module_expr ctxt) pmb.pmb_expr + (item_attributes ctxt) pmb.pmb_attributes + (fun f l2 -> List.iter (aux f) l2) l2 | _ -> assert false end | Pstr_attribute a -> floating_attribute ctxt f a diff --git a/ppxlib.opam b/ppxlib.opam index 94a7193f..c6cdf752 100644 --- a/ppxlib.opam +++ b/ppxlib.opam @@ -18,7 +18,7 @@ depends: [ "base" {>= "v0.11.0"} "dune" "ocaml-compiler-libs" {>= "v0.11.0"} - "ocaml-migrate-parsetree" {>= "1.3.1"} + "ocaml-migrate-parsetree" {>= "1.5.0"} "ppx_derivers" {>= "1.0"} "stdio" {>= "v0.11.0"} "ocamlfind" {with-test} diff --git a/src/ast_traverse.ml b/src/ast_traverse.ml index bfbbe15e..6e0a6531 100644 --- a/src/ast_traverse.ml +++ b/src/ast_traverse.ml @@ -30,7 +30,12 @@ class virtual ['res] lift = object inherit ['res] Ast.lift end +let module_name = function + | None -> "_" + | Some name -> name + let enter name path = if String.is_empty path then name else path ^ "." ^ name +let enter_opt name_opt path = enter (module_name name_opt) path class map_with_path = object inherit [string] map_with_context as super @@ -60,10 +65,10 @@ class map_with_path = object isn't, and the "path" constructed here would be able to differentiate between them. *) method! module_binding path mb = - super#module_binding (enter mb.pmb_name.txt path) mb + super#module_binding (enter_opt mb.pmb_name.txt path) mb method! module_declaration path md = - super#module_declaration (enter md.pmd_name.txt path) md + super#module_declaration (enter_opt md.pmd_name.txt path) md method! module_type_declaration path mtd = super#module_type_declaration (enter mtd.pmtd_name.txt path) mtd @@ -79,6 +84,9 @@ let var_names_of = object | _ -> acc end +let ec_enter_module_opt ~loc name_opt ctxt = + Expansion_context.Base.enter_module ~loc (module_name name_opt) ctxt + class map_with_expansion_context = object (self) inherit [Expansion_context.Base.t] map_with_context as super @@ -87,12 +95,12 @@ class map_with_expansion_context = object (self) method! module_binding ctxt mb = super#module_binding - (Expansion_context.Base.enter_module ~loc:mb.pmb_loc mb.pmb_name.txt ctxt) + (ec_enter_module_opt ~loc:mb.pmb_loc mb.pmb_name.txt ctxt) mb method! module_declaration ctxt md = super#module_declaration - (Expansion_context.Base.enter_module ~loc:md.pmd_loc md.pmd_name.txt ctxt) + (ec_enter_module_opt ~loc:md.pmd_loc md.pmd_name.txt ctxt) md method! module_type_declaration ctxt mtd = diff --git a/src/gen/gen_ast_builder.ml b/src/gen/gen_ast_builder.ml index 667b76ee..16d66418 100644 --- a/src/gen/gen_ast_builder.ml +++ b/src/gen/gen_ast_builder.ml @@ -213,14 +213,18 @@ let generate filename = in let st = [ Str.open_ (Opn.mk (Mod.ident (Loc.lident "Import"))) - ; Str.module_ (Mb.mk (Loc.mk "M") (Mod.structure (items false))) - ; Str.module_ (Mb.mk (Loc.mk "Make") - (Mod.functor_ (Loc.mk "Loc") (Some (Mty.signature [ - Sig.value (Val.mk (Loc.mk "loc") (M.ctyp "Location.t")) - ])) - (Mod.structure - (M.stri "let loc = Loc.loc" - :: items true)))) + ; Str.module_ (Mb.mk (Loc.mk (Some "M")) (Mod.structure (items false))) + ; Str.module_ (Mb.mk (Loc.mk (Some "Make")) + (Mod.functor_ + (Named + ( (Loc.mk (Some "Loc")) + , (Mty.signature [ + Sig.value + (Val.mk (Loc.mk "loc") (M.ctyp "Location.t")) + ]) )) + (Mod.structure + (M.stri "let loc = Loc.loc" + :: items true)))) ] in dump "ast_builder_generated" Pprintast.structure st ~ext:".ml" diff --git a/src/location_check.ml b/src/location_check.ml index cb08679f..05ac89da 100644 --- a/src/location_check.ml +++ b/src/location_check.ml @@ -1,4 +1,4 @@ -open! Import +open Import module Non_intersecting_ranges : sig type t @@ -93,20 +93,22 @@ let reloc_pmty_functors x = let outmost_loc = x.pmty_loc in let rec aux x = match x.pmty_desc with - | Pmty_functor (id, mty_opt, initial_res) -> + | Pmty_functor (Unit, initial_res) -> + let res = aux initial_res in + if phys_equal res initial_res then + x + else + { x with pmty_desc = Pmty_functor (Unit, res) } + | Pmty_functor (Named (id, mty), initial_res) -> let res = aux initial_res in if Location.compare outmost_loc res.pmty_loc = 0 then - let loc_start = - (match mty_opt with - | None -> id.loc - | Some mty -> mty.pmty_loc).loc_end - in + let loc_start = mty.pmty_loc.loc_end in let res = { res with pmty_loc = { res.pmty_loc with loc_start } } in - { x with pmty_desc = Pmty_functor (id, mty_opt, res) } + { x with pmty_desc = Pmty_functor (Named (id, mty), res) } else if phys_equal res initial_res then x else - { x with pmty_desc = Pmty_functor (id, mty_opt, res) } + { x with pmty_desc = Pmty_functor (Named (id, mty), res) } | _ -> x in aux x @@ -115,20 +117,22 @@ let reloc_pmod_functors x = let outmost_loc = x.pmod_loc in let rec aux x = match x.pmod_desc with - | Pmod_functor (id, mty_opt, initial_res) -> + | Pmod_functor (Unit, initial_res) -> + let res = aux initial_res in + if phys_equal res initial_res then + x + else + { x with pmod_desc = Pmod_functor (Unit, res) } + | Pmod_functor (Named (id, mty), initial_res) -> let res = aux initial_res in if Location.compare outmost_loc res.pmod_loc = 0 then - let loc_start = - (match mty_opt with - | None -> id.loc - | Some mty -> mty.pmty_loc).loc_end - in + let loc_start = mty.pmty_loc.loc_end in let res = { res with pmod_loc = { res.pmod_loc with loc_start } } in - { x with pmod_desc = Pmod_functor (id, mty_opt, res) } + { x with pmod_desc = Pmod_functor (Named (id, mty), res) } else if phys_equal res initial_res then x else - { x with pmod_desc = Pmod_functor (id, mty_opt, res) } + { x with pmod_desc = Pmod_functor (Named (id, mty), res) } | _ -> x in aux x @@ -632,7 +636,7 @@ let enforce_invariants fname = let acc = self#longident_loc lid acc in let acc = self#pattern pat acc in acc) labels acc | Ppat_constraint ({ ppat_desc = Ppat_unpack a; _ }, b) -> - let acc = self#loc self#string a acc in + let acc = self#loc (self#option self#string) a acc in self#core_type b acc | _ -> super#pattern_desc x acc From 46619a27b91de083d0d86b37ceef71fcc226873c Mon Sep 17 00:00:00 2001 From: Nathan Rebours Date: Tue, 16 Jun 2020 12:33:16 +0200 Subject: [PATCH 3/4] Run tests for latest support OCaml version Unfortunately, due to differences in how ASTs are printed between 4.09 and 4.10 we can only test 4.10. We could eventually try to make the tests compatible between those versions, I'm wondering how often this is susceptible to break. Signed-off-by: Nathan Rebours --- .travis.yml | 3 +++ appveyor.yml | 20 ++++++++++++++++++++ ppxlib.opam | 2 +- test/base/test.ml | 6 +++--- test/deriving/test.ml | 4 ++-- 5 files changed, 29 insertions(+), 6 deletions(-) diff --git a/.travis.yml b/.travis.yml index fd68342b..aae642af 100644 --- a/.travis.yml +++ b/.travis.yml @@ -15,6 +15,9 @@ env: - OCAML_VERSION="4.06" TESTS=false - OCAML_VERSION="4.07" + TEST=false - OCAML_VERSION="4.08" + TEST=false - OCAML_VERSION="4.09" + TEST=false - OCAML_VERSION="4.10" diff --git a/appveyor.yml b/appveyor.yml index 3bc371b3..57760dd8 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -9,24 +9,44 @@ environment: matrix: - OPAM_SWITCH: 4.04.2+mingw64c PACKAGE: ppxlib + TESTS: false - OPAM_SWITCH: 4.04.2+mingw32c PACKAGE: ppxlib + TESTS: false - OPAM_SWITCH: 4.05.0+mingw64c PACKAGE: ppxlib + TESTS: false - OPAM_SWITCH: 4.05.0+mingw32c PACKAGE: ppxlib + TESTS: false - OPAM_SWITCH: 4.06.0+mingw64c PACKAGE: ppxlib + TESTS: false - OPAM_SWITCH: 4.06.0+mingw32c PACKAGE: ppxlib + TESTS: false - OPAM_SWITCH: 4.07.1+mingw64c PACKAGE: ppxlib + TESTS: false - OPAM_SWITCH: 4.07.1+mingw32c PACKAGE: ppxlib + TESTS: false - OPAM_SWITCH: 4.08.0+mingw64c PACKAGE: ppxlib + TESTS: false - OPAM_SWITCH: 4.08.0+mingw32c PACKAGE: ppxlib + TESTS: false + - OPAM_SWITCH: 4.09.0+mingw64c + PACKAGE: ppxlib + TESTS: false + - OPAM_SWITCH: 4.09.0+mingw32c + PACKAGE: ppxlib + TESTS: false + - OPAM_SWITCH: 4.10.0+mingw64c + PACKAGE: ppxlib + - OPAM_SWITCH: 4.10.0+mingw32c + PACKAGE: ppxlib install: - ps: iex ((new-object net.webclient).DownloadString("https://raw.githubusercontent.com/$env:FORK_USER/ocaml-ci-scripts/$env:FORK_BRANCH/appveyor-install.ps1")) build_script: diff --git a/ppxlib.opam b/ppxlib.opam index c6cdf752..9bb10f05 100644 --- a/ppxlib.opam +++ b/ppxlib.opam @@ -11,7 +11,7 @@ build: [ ["dune" "build" "-p" name "-j" jobs] ] run-test: [ - ["dune" "runtest" "-p" name "-j" jobs] { ocaml:version >= "4.06" & ocaml:version < "4.08" } + ["dune" "runtest" "-p" name "-j" jobs] { ocaml:version >= "4.10" } ] depends: [ "ocaml" {>= "4.04.1"} diff --git a/test/base/test.ml b/test/base/test.ml index 42cbb0b2..b96f8952 100644 --- a/test/base/test.ml +++ b/test/base/test.ml @@ -107,17 +107,17 @@ let _ = convert_longident "Base.( land )" let _ = convert_longident "A(B)" [%%expect{| -Exception: Invalid_argument "Ppxlib.Longident.parse: \"A(B)\"". +Exception: (Invalid_argument "Ppxlib.Longident.parse: \"A(B)\"") |}] let _ = convert_longident "A.B(C)" [%%expect{| -Exception: Invalid_argument "Ppxlib.Longident.parse: \"A.B(C)\"". +Exception: (Invalid_argument "Ppxlib.Longident.parse: \"A.B(C)\"") |}] let _ = convert_longident ")" [%%expect{| -Exception: Invalid_argument "Ppxlib.Longident.parse: \")\"". +Exception: (Invalid_argument "Ppxlib.Longident.parse: \")\"") |}] let _ = Ppxlib.Code_path.(file_path @@ top_level ~file_path:"dir/main.ml") diff --git a/test/deriving/test.ml b/test/deriving/test.ml index 7b144038..79374597 100644 --- a/test/deriving/test.ml +++ b/test/deriving/test.ml @@ -74,7 +74,7 @@ Error: Signature mismatch: module type X = sig end [@@deriving mtd] [%%expect{| -module type X = sig end +module type X = sig end val y : int = 42 |}] @@ -85,5 +85,5 @@ end = struct let y = 42 end [%%expect{| -module Y : sig module type X = sig end val y : int end +module Y : sig module type X = sig end val y : int end |}] From 77ab0f65898a787cb92d34595d050c70c8146c81 Mon Sep 17 00:00:00 2001 From: Nathan Rebours Date: Tue, 23 Jun 2020 10:31:47 +0200 Subject: [PATCH 4/4] Disable tests on windows until we fix cinaps Signed-off-by: Nathan Rebours --- appveyor.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/appveyor.yml b/appveyor.yml index 57760dd8..2f4b36c1 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -45,8 +45,10 @@ environment: TESTS: false - OPAM_SWITCH: 4.10.0+mingw64c PACKAGE: ppxlib + TESTS: false - OPAM_SWITCH: 4.10.0+mingw32c PACKAGE: ppxlib + TESTS: false install: - ps: iex ((new-object net.webclient).DownloadString("https://raw.githubusercontent.com/$env:FORK_USER/ocaml-ci-scripts/$env:FORK_BRANCH/appveyor-install.ps1")) build_script: