From 3e56c1df1caa6507804cb6caf31d7d401a117910 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Sun, 17 Dec 2017 16:13:36 +0000 Subject: [PATCH 1/2] Add an (inline ...) stanza --- CHANGES.md | 5 +- Makefile | 20 +----- bin/main.ml | 11 +++ doc/jbuild | 71 ++++++++++--------- doc/jbuild.rst | 20 ++++++ doc/update-jbuild.sh | 26 +++++++ src/action.ml | 65 ++++++++++++++++- src/action_intf.ml | 1 + src/clflags.ml | 1 + src/clflags.mli | 3 + src/diff.ml | 37 ++++++++++ src/diff.mli | 2 + src/gen_rules.ml | 49 ++++++++++++- src/jbuild.ml | 29 +++++++- src/jbuild.mli | 6 +- src/jbuild_load.ml | 4 +- test/blackbox-tests/jbuild | 7 ++ .../test-cases/inline/jbuild.in | 4 ++ test/blackbox-tests/test-cases/inline/run.t | 15 ++++ 19 files changed, 315 insertions(+), 61 deletions(-) create mode 100755 doc/update-jbuild.sh create mode 100644 src/diff.ml create mode 100644 src/diff.mli create mode 100644 test/blackbox-tests/test-cases/inline/jbuild.in create mode 100644 test/blackbox-tests/test-cases/inline/run.t diff --git a/CHANGES.md b/CHANGES.md index 5a693673825..4f8b364fa4b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -19,11 +19,14 @@ next absolute path but with the context's environment set appropriately. Lastly, `jbuilder exec` will change the root as to which paths are relative using the `-root` option. (#286) - + - Fix `jbuilder rules` printing rules when some binaries are missing (#292) - Build documentation for non public libraries (#306) +- Add an `(inline)` allowing one to auto-generate part of a jbuild + file and keep it up-to-date + 1.0+beta16 (05/11/2017) ----------------------- diff --git a/Makefile b/Makefile index 79a7073f1ae..765f84d740f 100644 --- a/Makefile +++ b/Makefile @@ -33,28 +33,12 @@ clean: doc: cd doc && sphinx-build . _build -CMDS = $(shell $(BIN) --help=plain | \ - sed -n '/COMMANDS/,/OPTIONS/p' | sed -En 's/^ ([a-z-]+)/\1/p') - update-jbuilds: $(BIN) - sed -n '1,/;;GENERATED/p' doc/jbuild > doc/jbuild.tmp - { for cmd in $(CMDS); do \ - echo -ne "\n"\ - "(rule\n"\ - " ((targets (jbuilder-$$cmd.1))\n"\ - " (action (with-stdout-to $$""{@}\n"\ - " (run $$""{bin:jbuilder} $$cmd --help=groff)))))\n"\ - "\n"\ - "(install\n"\ - " ((section man)\n"\ - " (files (jbuilder-$$cmd.1))))\n"; \ - done } >> doc/jbuild.tmp - rm -f doc/jbuild - mv doc/jbuild.tmp doc/jbuild + $(BIN) build --dev @jbuild accept-corrections: for i in `find . -name \*.corrected`; do \ - cp $$i $${i/.corrected}; \ + cp $$i $${i%.corrected}; \ done .DEFAULT_GOAL := default diff --git a/bin/main.ml b/bin/main.ml index 0caa03377a8..e68f13760fe 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -21,6 +21,7 @@ type common = ; target_prefix : string ; only_packages : String_set.t option ; capture_outputs : bool + ; diff_command : string option ; (* Original arguments for the external-lib-deps hint *) orig_args : string list } @@ -38,6 +39,7 @@ let set_common c ~targets = if c.root <> Filename.current_dir_name then Sys.chdir c.root; Clflags.workspace_root := Sys.getcwd (); + Clflags.diff_command := c.diff_command; Clflags.external_lib_deps_hint := List.concat [ ["jbuilder"; "external-lib-deps"; "--missing"] @@ -153,6 +155,7 @@ let common = verbose no_buffer workspace_file + diff_command (root, only_packages, orig) = let root, to_cwd = @@ -178,6 +181,7 @@ let common = ; root ; orig_args ; target_prefix = String.concat ~sep:"" (List.map to_cwd ~f:(sprintf "%s/")) + ; diff_command ; only_packages = Option.map only_packages ~f:(fun s -> String_set.of_list (String.split s ~on:',')) @@ -304,6 +308,12 @@ let common = $ only_packages $ frop)) in + let diff_command = + Arg.(value + & opt (some string) None + & info ["diff-command"] ~docs + ~doc:"Shell command to use to diff files") + in Term.(const make $ concurrency $ ddep_path @@ -313,6 +323,7 @@ let common = $ verbose $ no_buffer $ workspace_file + $ diff_command $ root_and_only_packages ) diff --git a/doc/jbuild b/doc/jbuild index e36aa02f9a5..2bb6c2cf55a 100644 --- a/doc/jbuild +++ b/doc/jbuild @@ -9,104 +9,105 @@ ((section man) (files (jbuilder.1)))) -;; Run "make update-jbuilds" to update the rest of this file -;;GENERATED +(inline (run bash ${path:update-jbuild.sh} ${bin:jbuilder})) (rule - ((targets (jbuilder-build.1)) - (action (with-stdout-to ${@} - (run ${bin:jbuilder} build --help=groff))))) + ((targets (jbuilder-build.1)) + (action (with-stdout-to ${@} + (run ${bin:jbuilder} build --help=groff))))) (install ((section man) (files (jbuilder-build.1)))) (rule - ((targets (jbuilder-clean.1)) - (action (with-stdout-to ${@} - (run ${bin:jbuilder} clean --help=groff))))) + ((targets (jbuilder-clean.1)) + (action (with-stdout-to ${@} + (run ${bin:jbuilder} clean --help=groff))))) (install ((section man) (files (jbuilder-clean.1)))) (rule - ((targets (jbuilder-exec.1)) - (action (with-stdout-to ${@} - (run ${bin:jbuilder} exec --help=groff))))) + ((targets (jbuilder-exec.1)) + (action (with-stdout-to ${@} + (run ${bin:jbuilder} exec --help=groff))))) (install ((section man) (files (jbuilder-exec.1)))) (rule - ((targets (jbuilder-external-lib-deps.1)) - (action (with-stdout-to ${@} - (run ${bin:jbuilder} external-lib-deps --help=groff))))) + ((targets (jbuilder-external-lib-deps.1)) + (action (with-stdout-to ${@} + (run ${bin:jbuilder} external-lib-deps --help=groff))))) (install ((section man) (files (jbuilder-external-lib-deps.1)))) (rule - ((targets (jbuilder-install.1)) - (action (with-stdout-to ${@} - (run ${bin:jbuilder} install --help=groff))))) + ((targets (jbuilder-install.1)) + (action (with-stdout-to ${@} + (run ${bin:jbuilder} install --help=groff))))) (install ((section man) (files (jbuilder-install.1)))) (rule - ((targets (jbuilder-installed-libraries.1)) - (action (with-stdout-to ${@} - (run ${bin:jbuilder} installed-libraries --help=groff))))) + ((targets (jbuilder-installed-libraries.1)) + (action (with-stdout-to ${@} + (run ${bin:jbuilder} installed-libraries --help=groff))))) (install ((section man) (files (jbuilder-installed-libraries.1)))) (rule - ((targets (jbuilder-rules.1)) - (action (with-stdout-to ${@} - (run ${bin:jbuilder} rules --help=groff))))) + ((targets (jbuilder-rules.1)) + (action (with-stdout-to ${@} + (run ${bin:jbuilder} rules --help=groff))))) (install ((section man) (files (jbuilder-rules.1)))) (rule - ((targets (jbuilder-runtest.1)) - (action (with-stdout-to ${@} - (run ${bin:jbuilder} runtest --help=groff))))) + ((targets (jbuilder-runtest.1)) + (action (with-stdout-to ${@} + (run ${bin:jbuilder} runtest --help=groff))))) (install ((section man) (files (jbuilder-runtest.1)))) (rule - ((targets (jbuilder-subst.1)) - (action (with-stdout-to ${@} - (run ${bin:jbuilder} subst --help=groff))))) + ((targets (jbuilder-subst.1)) + (action (with-stdout-to ${@} + (run ${bin:jbuilder} subst --help=groff))))) (install ((section man) (files (jbuilder-subst.1)))) (rule - ((targets (jbuilder-uninstall.1)) - (action (with-stdout-to ${@} - (run ${bin:jbuilder} uninstall --help=groff))))) + ((targets (jbuilder-uninstall.1)) + (action (with-stdout-to ${@} + (run ${bin:jbuilder} uninstall --help=groff))))) (install ((section man) (files (jbuilder-uninstall.1)))) (rule - ((targets (jbuilder-utop.1)) - (action (with-stdout-to ${@} - (run ${bin:jbuilder} utop --help=groff))))) + ((targets (jbuilder-utop.1)) + (action (with-stdout-to ${@} + (run ${bin:jbuilder} utop --help=groff))))) (install ((section man) (files (jbuilder-utop.1)))) + +(end) diff --git a/doc/jbuild.rst b/doc/jbuild.rst index 78e8bb635b2..7c1d3c5e7a4 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -537,6 +537,26 @@ The difference between ``copy_files`` and ``copy_files#`` is the same as the difference between the ``copy`` and ``copy#`` action. See the `User actions`_ section for more details. +inline +------ + +Inline blocks are written as follow: + +.. code:: scheme + + (inline ) + + (end) + +When reading jbuild files, ``inline`` and ``end`` stanzas are +ignored. However, when building the ``jbuild`` alias, jbuilder will +run ```` and make sure that the output of the action matches +````. If not, jbuilder will update the jbuild file in place +and print a diff. + +You can use this feature to auto-generate a part of a jbuild file and +keep it up to date. + Common items ============ diff --git a/doc/update-jbuild.sh b/doc/update-jbuild.sh new file mode 100755 index 00000000000..3ec82dae1df --- /dev/null +++ b/doc/update-jbuild.sh @@ -0,0 +1,26 @@ +#!/bin/bash + +# CR-someday jdimino: maybe it's possible to get cmdliner to print that directly + +set -e -o pipefail + +jbuilder=$1 + +CMDS=$($jbuilder --help=plain | \ + sed -n '/COMMANDS/,/OPTIONS/p' | sed -En 's/^ ([a-z-]+)/\1/p') + +for cmd in $CMDS; do + cat < List [Atom "remove-tree"; path x] | Mkdir x -> List [Atom "mkdir"; path x] | Digest_files paths -> List [Atom "digest-files"; List (List.map paths ~f:path)] + | Update_jbuild (p, paths) -> List [Atom "update-jbuild"; path p; List (List.map paths ~f:path)] end module Make_mapper @@ -126,6 +127,7 @@ module Make_mapper | Remove_tree x -> Remove_tree (f_path x) | Mkdir x -> Mkdir (f_path x) | Digest_files x -> Digest_files (List.map x ~f:f_path) + | Update_jbuild (x, y) -> Update_jbuild (f_path x, List.map y ~f:f_path) end module Prog = struct @@ -369,6 +371,8 @@ module Unexpanded = struct end | Digest_files x -> Digest_files (List.map x ~f:(E.path ~dir ~f)) + | Update_jbuild (x, y) -> + Update_jbuild (E.path ~dir ~f x, List.map y ~f:(E.path ~dir ~f)) end module E = struct @@ -465,6 +469,8 @@ module Unexpanded = struct Mkdir res | Digest_files x -> Digest_files (List.map x ~f:(E.path ~dir ~f)) + | Update_jbuild (x, y) -> + Update_jbuild (E.path ~dir ~f x, List.map y ~f:(E.path ~dir ~f)) end let fold_one_step t ~init:acc ~f = @@ -486,7 +492,8 @@ let fold_one_step t ~init:acc ~f = | Rename _ | Remove_tree _ | Mkdir _ - | Digest_files _ -> acc + | Digest_files _ + | Update_jbuild _ -> acc include Make_mapper(Ast)(Ast) @@ -637,6 +644,59 @@ let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to = (Marshal.to_string data []) in exec_echo stdout_to s + | Update_jbuild (jbuild, files) -> + let s = Io.read_file (Path.to_string jbuild) in + let repls = List.map files ~f:(fun p -> Io.read_file (Path.to_string p)) in + let sexps = + let lb = Lexing.from_string s in + lb.lex_curr_p <- + { pos_fname = Path.to_string jbuild + ; pos_lnum = 1 + ; pos_bol = 0 + ; pos_cnum = 0 + }; + Sexp_lexer.many lb + in + let fail loc = Loc.fail loc "jbuild file changed while jbuilder was running" in + let rec loop blocks inline_start = function + | [] -> + Option.iter inline_start ~f:fail; + List.rev blocks + | Sexp.Ast.List (loc, Atom (_, "inline") :: _) :: rest -> + if Option.is_some inline_start then fail loc; + loop blocks (Some loc) rest + | Sexp.Ast.List (loc2, Atom (_, "end") :: _) :: rest -> + (match inline_start with + | None -> fail loc2 + | Some loc1 -> loop ((loc1.stop.pos_cnum, loc2.start.pos_cnum) :: blocks) None rest) + | _ :: rest -> loop blocks inline_start rest + in + let blocks = loop [] None sexps in + if List.length repls <> List.length blocks then + fail (Loc.in_file (Path.to_string jbuild)); + let repl = + let buf = Buffer.create (String.length s) in + let ofs = + List.fold_left2 blocks repls ~init:0 ~f:(fun ofs (start, stop) repl -> + Buffer.add_substring buf s ofs (start - ofs); + Buffer.add_char buf '\n'; + Buffer.add_string buf repl; + stop) + in + let len = String.length s in + Buffer.add_substring buf s ofs (len - ofs); + Buffer.contents buf + in + if s = repl then + return () + else begin + let old = Path.extend_basename jbuild ~suffix:".old" in + Path.unlink_no_err old; + Unix.rename (Path.to_string jbuild) (Path.to_string old); + Io.write_file (Path.to_string jbuild) repl; + at_exit (fun () -> Path.unlink_no_err old); + Diff.print old jbuild + end and redirect outputs fn t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to = let fn = Path.to_string fn in @@ -720,6 +780,7 @@ module Infer = struct | Ignore (_, t) -> infer acc t | Progn l -> List.fold_left l ~init:acc ~f:infer | Digest_files l -> List.fold_left l ~init:acc ~f:(+<) + | Update_jbuild (x, l) -> List.fold_left l ~init:(acc +< x) ~f:(+<) | Echo _ | System _ | Bash _ @@ -761,6 +822,7 @@ module Infer = struct | Ignore (_, t) -> partial acc t | Progn l -> List.fold_left l ~init:acc ~f:partial | Digest_files l -> List.fold_left l ~init:acc ~f:(+ List.fold_left l ~init:(acc + partial_with_all_targets acc t | Progn l -> List.fold_left l ~init:acc ~f:partial_with_all_targets | Digest_files l -> List.fold_left l ~init:acc ~f:(+ List.fold_left l ~init:(acc +>= ) = Future.( >>= ) + +let print file1 file2 = + let loc = Loc.in_file (Path.to_string file1) in + let fallback () = + die "%aFiles \"%s\" and \"%s\" differ." Loc.print loc + (Path.to_string file1) (Path.to_string file2) + in + let normal_diff () = + match Bin.which "diff" with + | None -> fallback () + | Some prog -> + Format.eprintf "%a@?" Loc.print loc; + Future.run Strict (Path.to_string prog) ["-u"; Path.to_string file1; Path.to_string file2] + >>= fun () -> + die "diff reported no differences on \"%s\" and \"%s\"" + (Path.to_string file1) (Path.to_string file2) + in + match !Clflags.diff_command with + | Some cmd -> + let sh, arg = Utils.system_shell_exn ~needed_to:"print diffs" in + let q fn = Filename.quote (Path.to_string fn) in + let cmd = sprintf "%s %s %s" cmd (q file1) (q file2) in + Future.run Strict (Path.to_string sh) [arg; cmd] + >>= fun () -> + die "command reported no differences: %s" cmd + | None -> + match Bin.which "patdiff" with + | None -> normal_diff () + | Some prog -> + Future.run Strict (Path.to_string prog) + ["-keep-whitespace"; "-location-style"; "omake"; "-unrefined"; Path.to_string file1; Path.to_string file2] + >>= fun () -> + (* Use "diff" if "patdiff" reported no differences *) + normal_diff () diff --git a/src/diff.mli b/src/diff.mli new file mode 100644 index 00000000000..80d6ecc7848 --- /dev/null +++ b/src/diff.mli @@ -0,0 +1,2 @@ +(** Diff two files that are expected not to match. *) +val print : Path.t -> Path.t -> _ Future.t diff --git a/src/gen_rules.ml b/src/gen_rules.ml index a83e547e5ac..6c1f13d824a 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -750,6 +750,51 @@ Add it to your jbuild file to remove this warning. ; obj_name = "" } ) + (* +-----------------------------------------------------------------+ + | Inline | + +-----------------------------------------------------------------+ *) + + let process_inlines ~src_dir ~ctx_dir ~scope ~stanzas = + match + List.filter_map stanzas + ~f:(function + | Stanza.Inline (_, act) -> Some act + | _ -> None) + with + | [] -> () + | actions -> + let generated = + List.map actions ~f:(fun action -> + let digest = + Action.Unexpanded.sexp_of_t action + |> Sexp.to_string + |> Digest.string + in + let fn = Printf.sprintf ".jbuild.inline.%s" (Digest.to_hex digest) in + SC.add_rule sctx + (Build.return [] + >>> + SC.Action.run sctx + (Redirect (Stdout, String_with_vars.virt_text __POS__ fn, action)) + ~dir:ctx_dir + ~dep_kind:Required + ~targets:Infer + ~scope); + fn) + in + alias_rules ~dir:Path.root ~scope + { name = "jbuild" + ; deps = [] + ; action = + (let file dir fn = + String_with_vars.virt_text __POS__ (Path.relative dir fn |> Path.to_string) + in + Some (Update_jbuild (file src_dir "jbuild" , + List.map generated ~f:(file ctx_dir)))) + ; locks = [] + ; package = None + } + (* +-----------------------------------------------------------------+ | Stanza | +-----------------------------------------------------------------+ *) @@ -765,7 +810,8 @@ Add it to your jbuild file to remove this warning. | Alias alias -> alias_rules alias ~dir ~scope; None | Copy_files def -> Some (copy_files_rules def ~src_dir ~dir ~scope) - | Library _ | Executables _ | Provides _ | Install _ -> None) + | Library _ | Executables _ | Provides _ | Install _ + | Inline _ | End _ -> None) in let files = lazy ( let files = SC.sources_and_targets_known_so_far sctx ~src_path:src_dir in @@ -784,6 +830,7 @@ Add it to your jbuild file to remove this warning. guess_modules ~dir:src_dir ~files:(Lazy.force files)) in + process_inlines ~src_dir ~ctx_dir ~stanzas ~scope; List.fold_left stanzas ~init:merlins ~f:(fun merlins stanza -> let dir = ctx_dir in match (stanza : Stanza.t) with diff --git a/src/jbuild.ml b/src/jbuild.ml index 9c186cc2e18..ad9d5cac701 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -921,6 +921,8 @@ module Stanza = struct | Install of Install_conf.t | Alias of Alias_conf.t | Copy_files of Copy_files.t + | Inline of Loc.t * Action.Unexpanded.t + | End of Loc.t let rules l = List.map l ~f:(fun x -> Rule x) @@ -946,6 +948,8 @@ module Stanza = struct (fun glob -> [Copy_files {add_line_directive = true; glob}]) (* Just for validation and error messages *) ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> []) + ; cstr_loc "inline" (Action.Unexpanded.t @> nil) (fun loc act -> [Inline (loc, act)]) + ; cstr_loc "end" nil (fun loc -> [End loc]) ] let select : Jbuild_version.t -> Scope.t -> t list Sexp.Of_sexp.t = function @@ -955,7 +959,9 @@ end module Stanzas = struct type t = Stanza.t list - let parse pkgs sexps = + type syntax = OCaml | Plain + + let parse ~syntax pkgs sexps = let versions, sexps = List.partition_map sexps ~f:(function | List (loc, [Atom (_, "jbuild_version"); ver]) -> @@ -969,7 +975,26 @@ module Stanzas = struct | _ :: (_, loc) :: _ -> Loc.fail loc "jbuild_version specified too many times" in - List.concat_map sexps ~f:(Stanza.select version pkgs) + let stanzas = List.concat_map sexps ~f:(Stanza.select version pkgs) in + let rec check inline_start = function + | [] -> + Option.iter inline_start ~f:(fun loc -> + Loc.fail loc "this (inline) stanza doesn't have a matching (end) stanza") + | Stanza.Inline (loc, _) :: rest -> + (match syntax with + | OCaml -> Loc.fail loc "(inline) stanzas are not allowed in jbuild in OCaml syntax" + | Plain -> ()); + if Option.is_some inline_start then + Loc.fail loc "cannot have an inline block inside another one"; + check (Some loc) rest + | End loc :: rest -> + (match inline_start with + | None -> Loc.fail loc "this (end) stanza must come after an (inline) stanza" + | Some _ -> check None rest) + | _ :: rest -> check inline_start rest + in + check None stanzas; + stanzas let lib_names ts = List.fold_left ts ~init:String_set.empty ~f:(fun acc (_, _, stanzas) -> diff --git a/src/jbuild.mli b/src/jbuild.mli index 171a18500f8..9529c2e0ea5 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -246,11 +246,15 @@ module Stanza : sig | Install of Install_conf.t | Alias of Alias_conf.t | Copy_files of Copy_files.t + | Inline of Loc.t * Action.Unexpanded.t + | End of Loc.t end module Stanzas : sig type t = Stanza.t list - val parse : Scope.t -> Sexp.Ast.t list -> t + type syntax = OCaml | Plain + + val parse : syntax:syntax -> Scope.t -> Sexp.Ast.t list -> t val lib_names : (_ * _ * t) list -> String_set.t end diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index c0622e7a47f..9698eace875 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -145,7 +145,7 @@ end Did you forgot to call [Jbuild_plugin.V*.send]?" (Path.to_string file); let sexps = Sexp_lexer.Load.many (Path.to_string generated_jbuild) in - return (dir, scope, Stanzas.parse scope sexps)) + return (dir, scope, Stanzas.parse ~syntax:OCaml scope sexps)) |> Future.all end @@ -159,7 +159,7 @@ let load ~dir ~scope = let file = Path.relative dir "jbuild" in match Sexp_lexer.Load.many_or_ocaml_script (Path.to_string file) with | Sexps sexps -> - Jbuilds.Literal (dir, scope, Stanzas.parse scope sexps) + Jbuilds.Literal (dir, scope, Stanzas.parse scope ~syntax:Plain sexps) | Ocaml_script -> Script { dir; scope } diff --git a/test/blackbox-tests/jbuild b/test/blackbox-tests/jbuild index 032d877658b..d2bd4da9ff5 100644 --- a/test/blackbox-tests/jbuild +++ b/test/blackbox-tests/jbuild @@ -134,3 +134,10 @@ (action (chdir test-cases/select (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t)))))) + +(alias + ((name runtest) + (deps ((files_recursively_in test-cases/inline))) + (action + (chdir test-cases/inline + (setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t)))))) diff --git a/test/blackbox-tests/test-cases/inline/jbuild.in b/test/blackbox-tests/test-cases/inline/jbuild.in new file mode 100644 index 00000000000..271c981074c --- /dev/null +++ b/test/blackbox-tests/test-cases/inline/jbuild.in @@ -0,0 +1,4 @@ +(jbuild_version 1) + +(inline (echo "toto")) +(end) diff --git a/test/blackbox-tests/test-cases/inline/run.t b/test/blackbox-tests/test-cases/inline/run.t new file mode 100644 index 00000000000..926fa17c57a --- /dev/null +++ b/test/blackbox-tests/test-cases/inline/run.t @@ -0,0 +1,15 @@ + $ cat jbuild.in > jbuild + $ cat jbuild + (jbuild_version 1) + + (inline (echo "toto")) + (end) + $ $JBUILDER build --root . -j1 --diff-command false @jbuild + sh (internal) (exit 1) + /bin/sh -c 'false '\''jbuild.old'\'' '\''jbuild'\''' + [1] + $ cat jbuild + (jbuild_version 1) + + (inline (echo "toto")) + toto(end) From 48d7e69e9f69a57f2639abe245b1776a49e46353 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Mon, 18 Dec 2017 13:27:51 +0000 Subject: [PATCH 2/2] Update doc --- CHANGES.md | 2 +- doc/jbuild.rst | 14 +++++++++++--- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 4f8b364fa4b..eb839cb4736 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -25,7 +25,7 @@ next - Build documentation for non public libraries (#306) - Add an `(inline)` allowing one to auto-generate part of a jbuild - file and keep it up-to-date + file and keep it up-to-date (#371) 1.0+beta16 (05/11/2017) ----------------------- diff --git a/doc/jbuild.rst b/doc/jbuild.rst index 7c1d3c5e7a4..dfec7b18d3d 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -551,11 +551,19 @@ Inline blocks are written as follow: When reading jbuild files, ``inline`` and ``end`` stanzas are ignored. However, when building the ``jbuild`` alias, jbuilder will run ```` and make sure that the output of the action matches -````. If not, jbuilder will update the jbuild file in place -and print a diff. +````. If not, jbuilder will update the jbuild file in place, +print a diff and fail. You then have to restart the build to pick up +the changes. You can use this feature to auto-generate a part of a jbuild file and -keep it up to date. +keep it up to date. In order to make sure that the jbuild files are +up-to-date, simply build the ``jbuild`` alias. For instance you can +use this command line to build both the package and check the jbuild +files: + +..code:: bash + + $ jbuilder build @install @jbuild Common items ============