From 669f0da54662f015f3c5b8f7ebc36ef77e4c2774 Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Fri, 2 Feb 2024 13:10:07 +0000 Subject: [PATCH] Execute include blocks by default --- lib/block.ml | 58 +++++++++++-------- lib/block.mli | 5 +- lib/label.ml | 3 - lib/label.mli | 1 - lib/mli_parser.ml | 2 +- lib/test/mdx_test.ml | 2 +- .../expect/parts-begin-end/test-case.md | 2 +- .../parts-begin-end/test-case.md.expected | 26 ++++++++- .../expect/sync-to-md/test-case.md.expected | 22 +++++++ test/lib/test_block.ml | 7 ++- 10 files changed, 90 insertions(+), 38 deletions(-) diff --git a/lib/block.ml b/lib/block.ml index 12c78c7a2..460f12d18 100644 --- a/lib/block.ml +++ b/lib/block.ml @@ -30,26 +30,29 @@ let locate_errors ~loc r = (fun l -> List.map (fun (`Msg m) -> `Msg (locate_error_msg ~loc m)) l) r +type ocaml_kind = Impl | Intf + module Header = struct - type t = Shell of [ `Sh | `Bash ] | OCaml | Other of string + type t = Shell of [ `Sh | `Bash ] | OCaml of ocaml_kind | Other of string let pp ppf = function | Shell `Sh -> Fmt.string ppf "sh" | Shell `Bash -> Fmt.string ppf "bash" - | OCaml -> Fmt.string ppf "ocaml" + | OCaml _ -> Fmt.string ppf "ocaml" | Other s -> Fmt.string ppf s let of_string = function | "" -> None | "sh" -> Some (Shell `Sh) | "bash" -> Some (Shell `Bash) - | "ocaml" -> Some OCaml + | "ocaml" -> Some (OCaml Impl) | s -> Some (Other s) let infer_from_file file = match Filename.(remove_extension (basename file), extension file) with | ("dune" | "dune-project"), _ -> Some (Other "scheme") - | _, (".ml" | ".mli" | ".mlt" | ".eliom" | ".eliomi") -> Some OCaml + | _, (".ml" | ".mlt" | ".eliom") -> Some (OCaml Impl) + | _, (".mli" | ".eliomi") -> Some (OCaml Intf) | _, ".sh" -> Some (Shell `Sh) | _ -> None end @@ -82,6 +85,7 @@ type ocaml_value = { non_det : Label.non_det option; errors : Output.t list; header : Header.t option; + kind : ocaml_kind; } type toplevel_value = { env : Ocaml_env.t; non_det : Label.non_det option } @@ -136,8 +140,8 @@ let header t = | Raw { header; _ } -> header | OCaml { header; _ } -> header | Cram { language; _ } -> Some (Header.Shell language) - | Toplevel _ -> Some Header.OCaml - | Include { file_kind = Fk_ocaml _; _ } -> Some Header.OCaml + | Toplevel _ -> Some (Header.OCaml Impl) + | Include { file_kind = Fk_ocaml _; _ } -> Some (Header.OCaml Impl) | Include { file_kind = Fk_other b; _ } -> b.header let dump_value ppf = function @@ -359,7 +363,6 @@ type block_config = { env : string option; dir : string option; skip : bool; - exec : bool; version : (Label.Relation.t * Ocaml_version.t) option; os_type : (Label.Relation.t * string) option; set_variables : (string * string) list; @@ -380,7 +383,6 @@ let get_block_config l = env = get_label (function Env x -> Some x | _ -> None) l; dir = get_label (function Dir x -> Some x | _ -> None) l; skip = List.exists (function Label.Skip -> true | _ -> false) l; - exec = List.exists (function Label.Exec -> true | _ -> false) l; version = get_label (function Version (x, y) -> Some (x, y) | _ -> None) l; os_type = get_label (function Os_type (x, y) -> Some (x, y) | _ -> None) l; set_variables = @@ -390,20 +392,20 @@ let get_block_config l = file_inc = get_label (function File x -> Some x | _ -> None) l; } -let mk_ocaml_value env non_det errors header = - { env = Ocaml_env.mk env; non_det; errors; header } +let mk_ocaml_value env non_det errors header ~kind = + { env = Ocaml_env.mk env; non_det; errors; header; kind } -let mk_ocaml ~loc ~config ~header ~contents ~errors = - let kind = "OCaml" in +let mk_ocaml ~loc ~config ~header ~contents ~errors ~kind = match config with | { file_inc = None; part = None; env; non_det; _ } -> ( (* TODO: why does this call guess_ocaml_kind when infer_block already did? *) match guess_ocaml_kind contents with - | `Code -> Ok (OCaml (mk_ocaml_value env non_det errors header)) + | `Code -> Ok (OCaml (mk_ocaml_value env non_det errors header ~kind)) | `Toplevel -> loc_error ~loc "toplevel syntax is not allowed in OCaml blocks.") - | { file_inc = Some _; _ } -> label_not_allowed ~loc ~label:"file" ~kind - | { part = Some _; _ } -> label_not_allowed ~loc ~label:"part" ~kind + | { file_inc = Some _; _ } -> + label_not_allowed ~loc ~label:"file" ~kind:"OCaml" + | { part = Some _; _ } -> label_not_allowed ~loc ~label:"part" ~kind:"OCaml" let mk_cram ~loc ?language ~config ~header ~errors () = let kind = "shell" in @@ -435,15 +437,20 @@ let mk_toplevel ~loc ~config ~contents ~errors = | { part = Some _; _ } -> label_not_allowed ~loc ~label:"part" ~kind let mk_include ~loc ~config ~header ~errors = - let kind = "include" in match config with | { file_inc = Some file_included; part; non_det; env; _ } -> ( let* () = check_no_errors ~loc errors in match header with - | Some Header.OCaml -> + | Some (Header.OCaml k) -> + let kind = + match Header.infer_from_file file_included with + | Some (Header.OCaml k') -> k' + | _ -> k + in let ocaml_value = - if config.exec then Some (mk_ocaml_value env non_det errors header) - else None + match kind with + | Impl -> Some (mk_ocaml_value env non_det errors header ~kind) + | Intf -> None in let file_kind = Fk_ocaml { part_included = part; ocaml_value } in Ok (Include { file_included; file_kind }) @@ -454,7 +461,7 @@ let mk_include ~loc ~config ~header ~errors = Ok (Include { file_included; file_kind }) | Some _ -> label_not_allowed ~loc ~label:"part" ~kind:"non-OCaml include")) - | { file_inc = None; _ } -> label_required ~loc ~label:"file" ~kind + | { file_inc = None; _ } -> label_required ~loc ~label:"file" ~kind:"include" let infer_block ~loc ~config ~header ~contents ~errors = match config with @@ -463,9 +470,9 @@ let infer_block ~loc ~config ~header ~contents ~errors = match header with | Some (Header.Shell language) -> mk_cram ~loc ~language ~config ~header ~errors () - | Some Header.OCaml -> ( + | Some (Header.OCaml kind) -> ( match guess_ocaml_kind contents with - | `Code -> mk_ocaml ~loc ~config ~header ~contents ~errors + | `Code -> mk_ocaml ~loc ~config ~header ~contents ~errors ~kind | `Toplevel -> mk_toplevel ~loc ~config ~contents ~errors) | _ -> let* () = @@ -481,7 +488,7 @@ let mk ~loc ~section ~labels ~legacy_labels ~header ~delim ~contents ~errors = let config = get_block_config labels in let* value = match block_kind with - | Some OCaml -> mk_ocaml ~loc ~config ~header ~contents ~errors + | Some OCaml -> mk_ocaml ~loc ~config ~header ~contents ~errors ~kind:Impl | Some Cram -> mk_cram ~loc ~config ~header ~errors () | Some Toplevel -> mk_toplevel ~loc ~config ~contents ~errors | Some Include -> mk_include ~loc ~config ~header ~errors @@ -547,4 +554,7 @@ let is_active ?section:s t = | None -> Re.execp (Re.Perl.compile_pat p) "") | None -> true in - active && t.version_enabled && t.os_type_enabled && not t.skip + let executable = + match t.value with OCaml { kind = Intf; _ } -> false | _ -> true + in + active && t.version_enabled && t.os_type_enabled && (not t.skip) && executable diff --git a/lib/block.mli b/lib/block.mli index 030766623..f32261855 100644 --- a/lib/block.mli +++ b/lib/block.mli @@ -16,8 +16,10 @@ (** Code blocks headers. *) +type ocaml_kind = Impl | Intf + module Header : sig - type t = Shell of [ `Sh | `Bash ] | OCaml | Other of string + type t = Shell of [ `Sh | `Bash ] | OCaml of ocaml_kind | Other of string val pp : Format.formatter -> t -> unit val of_string : string -> t option @@ -35,6 +37,7 @@ type ocaml_value = { errors : Output.t list; (** [header] defines whether a header was specified for the block. *) header : Header.t option; + kind : ocaml_kind; } type toplevel_value = { diff --git a/lib/label.ml b/lib/label.ml index 2bfbd3852..b18fc6f02 100644 --- a/lib/label.ml +++ b/lib/label.ml @@ -87,7 +87,6 @@ type t = | Part of string | Env of string | Skip - | Exec | Non_det of non_det option | Version of Relation.t * Ocaml_version.t | Os_type of Relation.t * string @@ -112,7 +111,6 @@ let pp ppf = function | Part p -> Fmt.pf ppf "part=%s" p | Env e -> Fmt.pf ppf "env=%s" e | Skip -> Fmt.string ppf "skip" - | Exec -> Fmt.string ppf "exec" | Non_det None -> Fmt.string ppf "non-deterministic" | Non_det (Some Nd_output) -> Fmt.string ppf "non-deterministic=output" | Non_det (Some Nd_command) -> Fmt.string ppf "non-deterministic=command" @@ -161,7 +159,6 @@ let requires_eq_value ~label ~value f = let interpret label value = match label with | "skip" -> doesnt_accept_value ~label ~value Skip - | "exec" -> doesnt_accept_value ~label ~value Exec | "ocaml" -> doesnt_accept_value ~label ~value (Block_kind OCaml) | "cram" -> doesnt_accept_value ~label ~value (Block_kind Cram) | "toplevel" -> doesnt_accept_value ~label ~value (Block_kind Toplevel) diff --git a/lib/label.mli b/lib/label.mli index 3b41e8567..5abc4205d 100644 --- a/lib/label.mli +++ b/lib/label.mli @@ -40,7 +40,6 @@ type t = | Part of string | Env of string | Skip - | Exec | Non_det of non_det option | Version of Relation.t * Ocaml_version.t | Os_type of Relation.t * string diff --git a/lib/mli_parser.ml b/lib/mli_parser.ml index e8a977663..65fb2fc6e 100644 --- a/lib/mli_parser.ml +++ b/lib/mli_parser.ml @@ -138,7 +138,7 @@ let make_block code_block file_contents = Ok (header, language_label :: labels) | None -> (* If not specified, blocks are run as ocaml blocks *) - Ok (Some OCaml, []) + Ok (Some (OCaml Impl), []) in match handle_header code_block.Code_block.metadata with | Error _ as e -> e diff --git a/lib/test/mdx_test.ml b/lib/test/mdx_test.ml index 4896e58e5..c97961e22 100644 --- a/lib/test/mdx_test.ml +++ b/lib/test/mdx_test.ml @@ -341,7 +341,7 @@ let run_exn ~non_deterministic ~silent_eval ~record_backtrace ~syntax ~silent in let preludes = preludes ~prelude ~prelude_str in - let run_ocaml_value t Block.{ env; non_det; errors; header = _ } = + let run_ocaml_value t Block.{ env; non_det; errors; header = _; _ } = let det () = Mdx_top.in_env env (fun () -> eval_ocaml ~block:t ?root c errors) in diff --git a/test/bin/mdx-test/expect/parts-begin-end/test-case.md b/test/bin/mdx-test/expect/parts-begin-end/test-case.md index a31bdbc18..a958ac3a7 100644 --- a/test/bin/mdx-test/expect/parts-begin-end/test-case.md +++ b/test/bin/mdx-test/expect/parts-begin-end/test-case.md @@ -38,7 +38,7 @@ val x : int = 2 # s ;; ``` -```ocaml exec,file=parts-begin-end.ml,part=toto +```ocaml file=parts-begin-end.ml,part=toto ``` ```ocaml diff --git a/test/bin/mdx-test/expect/parts-begin-end/test-case.md.expected b/test/bin/mdx-test/expect/parts-begin-end/test-case.md.expected index 54d053892..92cb44269 100644 --- a/test/bin/mdx-test/expect/parts-begin-end/test-case.md.expected +++ b/test/bin/mdx-test/expect/parts-begin-end/test-case.md.expected @@ -23,6 +23,11 @@ let () = let () = f x print_int; ``` +```mdx-error +Line 2, characters 5-6: +Error: This expression has type float + This is not a function; it cannot be applied. +``` ```ocaml file=parts-begin-end.ml let () = @@ -54,6 +59,18 @@ let () = let () = fooooooooooooooooooooooooooooooooooooooooooo in if not fooooooooo then foooooooooooo ``` +```mdx-error +3442.3 +val x : int = 34 +val f : float = 42.3 +val s : string = "toto" +val fn : 'a -> ('a -> 'b) -> 'b = +Line 3, characters 3-6: +Error: Syntax error +Line 4, characters 5-6: +Error: This expression has type float + This is not a function; it cannot be applied. +``` ```ocaml # let x = 2;; @@ -67,14 +84,17 @@ val x : int = 2 let () = fooooooooooooooooooooooooooooooooooooooooooo in if not fooooooooo then foooooooooooo ``` +```mdx-error +Line 1, characters 12-56: +Error: Unbound value fooooooooooooooooooooooooooooooooooooooooooo +``` ```ocaml # s ;; -Line 1, characters 1-2: -Error: Unbound value s +- : string = "toto" ``` -```ocaml exec,file=parts-begin-end.ml,part=toto +```ocaml file=parts-begin-end.ml,part=toto let x = 34 let f = 42.3 let s = "toto" diff --git a/test/bin/mdx-test/expect/sync-to-md/test-case.md.expected b/test/bin/mdx-test/expect/sync-to-md/test-case.md.expected index c9fa847f4..5919cc86d 100644 --- a/test/bin/mdx-test/expect/sync-to-md/test-case.md.expected +++ b/test/bin/mdx-test/expect/sync-to-md/test-case.md.expected @@ -12,17 +12,30 @@ let () = print_float f ;; ``` +```mdx-error +Line 8, characters 17-18: +Error: This expression has type 'a -> ('a -> 'b) -> 'b + but an expression was expected of type float +``` ```ocaml file=sync_to_md.ml,part=zzz let () = print_string s ;; ``` +```mdx-error +Line 2, characters 18-19: +Error: Unbound value s +``` ```ocaml file=sync_to_md.ml,part=42 let () = f x print_int ``` +```mdx-error +Line 2, characters 5-6: +Error: Unbound value f +``` ```ocaml file=sync_to_md.ml,part= let () = @@ -54,6 +67,15 @@ let () = let () = f x print_int ``` +```mdx-error +Line 9, characters 17-18: +Error: This expression has type 'a -> ('a -> 'b) -> 'b + but an expression was expected of type float +Line 3, characters 18-19: +Error: Unbound value s +Line 3, characters 5-6: +Error: Unbound value f +``` ```ocaml # let x = 2;; diff --git a/test/lib/test_block.ml b/test/lib/test_block.ml index be45ed866..e2128cb51 100644 --- a/test/lib/test_block.ml +++ b/test/lib/test_block.ml @@ -14,7 +14,8 @@ let test_infer_from_file = make_test ~file:"dune" ~expected:(Some (Other "scheme")); make_test ~file:"dune-project" ~expected:(Some (Other "scheme")); make_test ~file:"foo.sh" ~expected:(Some (Shell `Sh)); - make_test ~file:"foo/foo/foo.ml" ~expected:(Some OCaml); + make_test ~file:"foo/foo/foo.ml" ~expected:(Some (OCaml Impl)); + make_test ~file:"foo/foo/foo.mli" ~expected:(Some (OCaml Intf)); ] let test_mk = @@ -39,10 +40,10 @@ let test_mk = in [ make_test ~name:"invalid ocaml" ~labels:[ Block_kind OCaml ] - ~header:(Some OCaml) ~contents:[ "# let x = 2;;" ] + ~header:(Some (OCaml Impl)) ~contents:[ "# let x = 2;;" ] ~expected:(Error (`Msg "toplevel syntax is not allowed in OCaml blocks.")); make_test ~name:"invalid toplevel" ~labels:[ Block_kind Toplevel ] - ~header:(Some OCaml) ~contents:[ "let x = 2;;" ] + ~header:(Some (OCaml Impl)) ~contents:[ "let x = 2;;" ] ~expected:(Error (`Msg "invalid toplevel syntax in toplevel blocks.")); ]