Merge pull request #905 from rgrinberg/template-sexp-take2
Template Parsing in Dune files via the Lexer
This commit is contained in:
commit
26e94463d4
|
@ -1383,7 +1383,8 @@ let printenv =
|
|||
in
|
||||
Build_system.do_build setup.build_system ~request
|
||||
>>| fun l ->
|
||||
let pp ppf = Format.fprintf ppf "@[<v1>(@,@[<v>%a@]@]@,)" (Format.pp_print_list Sexp.pp) in
|
||||
let pp ppf = Format.fprintf ppf "@[<v1>(@,@[<v>%a@]@]@,)"
|
||||
(Format.pp_print_list (Sexp.pp Dune)) in
|
||||
match l with
|
||||
| [(_, env)] ->
|
||||
Format.printf "%a@." pp env
|
||||
|
|
8
doc/dune
8
doc/dune
|
@ -1,5 +1,5 @@
|
|||
(rule
|
||||
(with-stdout-to dune.1 (run ${bin:dune} --help=groff)))
|
||||
(with-stdout-to dune.1 (run %{bin:dune} --help=groff)))
|
||||
|
||||
(install
|
||||
(section man)
|
||||
|
@ -8,7 +8,7 @@
|
|||
|
||||
(rule
|
||||
(with-stdout-to dune-config.5
|
||||
(run ${bin:jbuilder} help config --man-format=groff)))
|
||||
(run %{bin:jbuilder} help config --man-format=groff)))
|
||||
|
||||
(install
|
||||
(section man)
|
||||
|
@ -21,8 +21,8 @@
|
|||
(targets dune.inc.gen)
|
||||
(deps (package dune))
|
||||
(action
|
||||
(with-stdout-to ${@}
|
||||
(run bash ${path:update-jbuild.sh}))))
|
||||
(with-stdout-to %{@}
|
||||
(run bash %{path:update-jbuild.sh}))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
|
|
|
@ -62,6 +62,9 @@ special characters. Special characters are:
|
|||
|
||||
For instance ``hello`` or ``+`` are valid atoms.
|
||||
|
||||
Note that backslashes inside atoms have no special meaning are always
|
||||
interpreted as plain backslashes characters.
|
||||
|
||||
Strings
|
||||
-------
|
||||
|
||||
|
@ -80,6 +83,7 @@ sequences:
|
|||
- ``\xHH``, a backslach followed by two hexidecimal characters to
|
||||
represent the character with ASCII code ``HH`` in hexadecimal
|
||||
- ``\\``, a double backslash to represent a single backslash
|
||||
- ``\%{`` to represent ``%{`` (see :ref:`variables`)
|
||||
|
||||
Additionally, a backslash that comes just before the end of the line
|
||||
is used to skip the newline up to the next non-space character. For
|
||||
|
@ -137,6 +141,29 @@ descriptions. For instance:
|
|||
(body
|
||||
This is a simple example of using S-expressions))
|
||||
|
||||
.. _variables:
|
||||
|
||||
Variables
|
||||
---------
|
||||
|
||||
Dune allows variables in a few places. Their interpretation often
|
||||
depend on the context in which they appear.
|
||||
|
||||
The syntax of variables is as follow:
|
||||
|
||||
.. code::
|
||||
|
||||
%{var}
|
||||
|
||||
or, for more complex forms that take an argument:
|
||||
|
||||
.. code::
|
||||
|
||||
%{fun:arg}
|
||||
|
||||
In order to write a plain ``%{``, you need to write ``\%{`` in a
|
||||
string.
|
||||
|
||||
.. _opam-files:
|
||||
|
||||
dune-project files
|
||||
|
|
|
@ -5,11 +5,11 @@
|
|||
(deps (package dune) (source_tree sample-projects/hello_world))
|
||||
(action
|
||||
(chdir sample-projects/hello_world
|
||||
(run ${exe:../test/blackbox-tests/cram.exe} -test run.t))))
|
||||
(run %{exe:../test/blackbox-tests/cram.exe} -test run.t))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
(deps (package dune) (source_tree sample-projects/with-configure-step))
|
||||
(action
|
||||
(chdir sample-projects/with-configure-step
|
||||
(run ${exe:../test/blackbox-tests/cram.exe} -test run.t))))
|
||||
(run %{exe:../test/blackbox-tests/cram.exe} -test run.t))))
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
(rule
|
||||
((targets (hello_world.output))
|
||||
(action (with-stdout-to ${@} (run ${bin:hello_world})))))
|
||||
(action (with-stdout-to %{@} (run %{bin:hello_world})))))
|
||||
|
||||
(alias
|
||||
((name runtest)
|
||||
(action (run diff -uw ${path:hello_world.expected} ${path:hello_world.output}))))
|
||||
(action (run diff -uw %{path:hello_world.expected} %{path:hello_world.output}))))
|
||||
|
|
|
@ -2,9 +2,9 @@
|
|||
((fallback)
|
||||
(targets (config))
|
||||
(deps (config.defaults))
|
||||
(action (copy ${<} ${@}))))
|
||||
(action (copy %{<} %{@}))))
|
||||
|
||||
(rule
|
||||
((targets (config.full))
|
||||
(deps (config_common.ml config))
|
||||
(action (run ${OCAML} ${path:real_configure.ml}))))
|
||||
(action (run %{OCAML} %{path:real_configure.ml}))))
|
||||
|
|
|
@ -8,5 +8,5 @@
|
|||
(rule
|
||||
((targets (config.ml))
|
||||
(deps (../config.full))
|
||||
(action (copy ${<} ${@}))))
|
||||
(action (copy %{<} %{@}))))
|
||||
|
||||
|
|
|
@ -341,8 +341,6 @@ let prog_and_args_of_values p ~dir =
|
|||
| String s :: xs ->
|
||||
(Unresolved.Program.of_string ~dir s, Value.L.to_strings ~dir xs)
|
||||
|
||||
module SW = String_with_vars
|
||||
|
||||
module Unexpanded = struct
|
||||
module type Uast = Action_intf.Ast
|
||||
with type program = String_with_vars.t
|
||||
|
@ -355,7 +353,7 @@ module Unexpanded = struct
|
|||
let t =
|
||||
let open Sexp.Of_sexp in
|
||||
peek raw >>= function
|
||||
| Atom _ | Quoted_string _ as sexp ->
|
||||
| Template _ | Atom _ | Quoted_string _ as sexp ->
|
||||
of_sexp_errorf (Sexp.Ast.loc sexp)
|
||||
"if you meant for this to be executed with bash, write (bash \"...\") instead"
|
||||
| List _ -> t
|
||||
|
@ -365,7 +363,8 @@ module Unexpanded = struct
|
|||
Loc.fail loc
|
||||
"(mkdir ...) is not supported for paths outside of the workspace:\n\
|
||||
\ %a\n"
|
||||
Sexp.pp (List [Sexp.unsafe_atom_of_string "mkdir"; Path.sexp_of_t path])
|
||||
(Sexp.pp Dune)
|
||||
(List [Sexp.unsafe_atom_of_string "mkdir"; Path.sexp_of_t path])
|
||||
|
||||
module Partial = struct
|
||||
module Program = Unresolved.Program
|
||||
|
@ -450,7 +449,7 @@ module Unexpanded = struct
|
|||
| Left path -> Mkdir path
|
||||
| Right tmpl ->
|
||||
let path = E.path ~dir ~f x in
|
||||
check_mkdir (SW.loc tmpl) path;
|
||||
check_mkdir (String_with_vars.loc tmpl) path;
|
||||
Mkdir path
|
||||
end
|
||||
| Digest_files x ->
|
||||
|
@ -511,7 +510,7 @@ module Unexpanded = struct
|
|||
| Left dir ->
|
||||
Chdir (res, partial_expand t ~dir ~map_exe ~f)
|
||||
| Right fn ->
|
||||
let loc = SW.loc fn in
|
||||
let loc = String_with_vars.loc fn in
|
||||
Loc.fail loc
|
||||
"This directory cannot be evaluated statically.\n\
|
||||
This is not allowed by jbuilder"
|
||||
|
@ -542,7 +541,7 @@ module Unexpanded = struct
|
|||
| Mkdir x ->
|
||||
let res = E.path ~dir ~f x in
|
||||
(match res with
|
||||
| Left path -> check_mkdir (SW.loc x) path
|
||||
| Left path -> check_mkdir (String_with_vars.loc x) path
|
||||
| Right _ -> ());
|
||||
Mkdir res
|
||||
| Digest_files x ->
|
||||
|
@ -649,7 +648,8 @@ module Promotion = struct
|
|||
| l ->
|
||||
Io.write_file db_file
|
||||
(String.concat ~sep:""
|
||||
(List.map l ~f:(fun x -> Sexp.to_string (File.sexp_of_t x) ^ "\n")))
|
||||
(List.map l ~f:(fun x ->
|
||||
Sexp.to_string ~syntax:Dune (File.sexp_of_t x) ^ "\n")))
|
||||
end
|
||||
|
||||
let load_db () =
|
||||
|
@ -1062,7 +1062,8 @@ module Infer = struct
|
|||
match fn with
|
||||
| Left fn -> { acc with targets = Path.Set.add acc.targets fn }
|
||||
| Right sw ->
|
||||
Loc.fail (SW.loc sw) "Cannot determine this target statically."
|
||||
Loc.fail (String_with_vars.loc sw)
|
||||
"Cannot determine this target statically."
|
||||
let ( +< ) acc fn =
|
||||
match fn with
|
||||
| Left fn -> { acc with deps = Path.Set.add acc.deps fn }
|
||||
|
@ -1095,7 +1096,7 @@ module Infer = struct
|
|||
module Unexp = Make(Unexpanded.Uast)(S_unexp)(Outcome_unexp)(struct
|
||||
open Outcome_unexp
|
||||
let ( +@ ) acc fn =
|
||||
if SW.is_var fn ~name:"null" then
|
||||
if String_with_vars.is_var fn ~name:"null" then
|
||||
acc
|
||||
else
|
||||
{ acc with targets = fn :: acc.targets }
|
||||
|
|
|
@ -83,7 +83,7 @@ module Unexpanded : sig
|
|||
: t
|
||||
-> dir:Path.t
|
||||
-> map_exe:(Path.t -> Path.t)
|
||||
-> f:(Loc.t -> String.t -> Value.t list option)
|
||||
-> f:(String_with_vars.Var.t -> Value.t list option)
|
||||
-> Unresolved.t
|
||||
end
|
||||
|
||||
|
@ -91,7 +91,7 @@ module Unexpanded : sig
|
|||
: t
|
||||
-> dir:Path.t
|
||||
-> map_exe:(Path.t -> Path.t)
|
||||
-> f:(Loc.t -> string -> Value.t list option)
|
||||
-> f:(String_with_vars.Var.t -> Value.t list option)
|
||||
-> Partial.t
|
||||
end
|
||||
|
||||
|
|
|
@ -151,10 +151,12 @@ let strings p =
|
|||
>>^ fun l ->
|
||||
List.map l ~f:Scanf.unescaped
|
||||
|
||||
let read_sexp p =
|
||||
let read_sexp p syntax =
|
||||
contents p
|
||||
>>^ fun s ->
|
||||
Usexp.parse_string s ~fname:(Path.to_string p) ~mode:Single
|
||||
Usexp.parse_string s
|
||||
~lexer:(File_tree.Dune_file.Kind.lexer syntax)
|
||||
~fname:(Path.to_string p) ~mode:Single
|
||||
|
||||
let if_file_exists p ~then_ ~else_ =
|
||||
If_file_exists (p, ref (Undecided (then_, else_)))
|
||||
|
|
|
@ -91,7 +91,7 @@ val lines_of : Path.t -> ('a, string list) t
|
|||
val strings : Path.t -> ('a, string list) t
|
||||
|
||||
(** Load an S-expression from a file *)
|
||||
val read_sexp : Path.t -> (unit, Sexp.Ast.t) t
|
||||
val read_sexp : Path.t -> Usexp.syntax -> (unit, Sexp.Ast.t) t
|
||||
|
||||
(** Evaluates to [true] if the file is present on the file system or is the target of a
|
||||
rule. *)
|
||||
|
|
|
@ -29,7 +29,7 @@ module Promoted_to_delete = struct
|
|||
Io.write_file fn
|
||||
(String.concat ~sep:""
|
||||
(List.map (Path.Set.to_list db) ~f:(fun p ->
|
||||
Sexp.to_string (Path.sexp_of_t p) ^ "\n")))
|
||||
Sexp.to_string ~syntax:Dune (Path.sexp_of_t p) ^ "\n")))
|
||||
end
|
||||
|
||||
let files_in_source_tree_to_delete () =
|
||||
|
@ -1226,7 +1226,7 @@ let update_universe t =
|
|||
0
|
||||
in
|
||||
make_local_dirs t (Path.Set.singleton Path.build_dir);
|
||||
Io.write_file universe_file (Sexp.to_string (Sexp.To_sexp.int n))
|
||||
Io.write_file universe_file (Sexp.to_string ~syntax:Dune (Sexp.To_sexp.int n))
|
||||
|
||||
let do_build t ~request =
|
||||
entry_point t ~f:(fun () ->
|
||||
|
@ -1561,7 +1561,7 @@ module Alias = struct
|
|||
|
||||
let add_action build_system t ~context ?(locks=[]) ~stamp action =
|
||||
let def = get_alias_def build_system t in
|
||||
def.actions <- { stamp = Digest.string (Sexp.to_string stamp)
|
||||
def.actions <- { stamp = Digest.string (Sexp.to_string ~syntax:Dune stamp)
|
||||
; action
|
||||
; locks
|
||||
; context
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
(executable
|
||||
(name mk))
|
||||
|
||||
(rule (with-stdout-to flags.sexp (run ./mk.exe -ocamlv ${ocaml_version})))
|
||||
(rule (with-stdout-to flags.sexp (run ./mk.exe -ocamlv %{ocaml_version})))
|
||||
|
|
|
@ -488,7 +488,7 @@ end
|
|||
let write_flags fname s =
|
||||
let path = Path.in_source fname in
|
||||
let sexp = Usexp.List(List.map ~f:Usexp.atom_or_quoted_string s) in
|
||||
Io.write_file path (Usexp.to_string sexp)
|
||||
Io.write_file path (Usexp.to_string sexp ~syntax:Dune)
|
||||
|
||||
let main ?(args=[]) ~name f =
|
||||
let ocamlc = ref (
|
||||
|
|
|
@ -14,8 +14,9 @@ module Entry = struct
|
|||
| Library (path, lib_name) ->
|
||||
sprintf "library %S in %s" lib_name (Path.to_string_maybe_quoted path)
|
||||
| Preprocess l ->
|
||||
Sexp.to_string (List [Sexp.unsafe_atom_of_string "pps";
|
||||
Sexp.To_sexp.(list string) l])
|
||||
Sexp.to_string ~syntax:Dune
|
||||
(List [ Sexp.unsafe_atom_of_string "pps"
|
||||
; Sexp.To_sexp.(list string) l])
|
||||
| Loc loc ->
|
||||
Loc.to_file_colon_line loc
|
||||
|
||||
|
|
|
@ -279,7 +279,7 @@ module Extension = struct
|
|||
if not !dune_project_edited then begin
|
||||
dune_project_edited := true;
|
||||
Project_file_edit.append project_file
|
||||
(Sexp.to_string
|
||||
(Sexp.to_string ~syntax:Dune
|
||||
(List [ Sexp.atom "using"
|
||||
; Sexp.atom name
|
||||
; Sexp.atom (Syntax.Version.to_string version)
|
||||
|
|
|
@ -2,7 +2,7 @@ open! Import
|
|||
|
||||
module Dune_file = struct
|
||||
module Kind = struct
|
||||
type t = Dune | Jbuild
|
||||
type t = Usexp.syntax = Jbuild | Dune
|
||||
|
||||
let of_basename = function
|
||||
| "dune" -> Dune
|
||||
|
|
|
@ -4,7 +4,7 @@ open! Import
|
|||
|
||||
module Dune_file : sig
|
||||
module Kind : sig
|
||||
type t = Dune | Jbuild
|
||||
type t = Usexp.syntax = Jbuild | Dune
|
||||
|
||||
val lexer : t -> Sexp.Lexer.t
|
||||
end
|
||||
|
|
|
@ -107,9 +107,10 @@ module Gen(P : Install_rules.Params) = struct
|
|||
\nThis will become an error in the future."
|
||||
(let tag = Sexp.unsafe_atom_of_string
|
||||
"modules_without_implementation" in
|
||||
Sexp.to_string (List [ tag
|
||||
; Sexp.To_sexp.(list string) should_be_listed
|
||||
]))
|
||||
Sexp.to_string ~syntax:Dune
|
||||
(List [ tag
|
||||
; Sexp.To_sexp.(list string) should_be_listed
|
||||
]))
|
||||
| Some loc ->
|
||||
Loc.warn loc
|
||||
"The following modules must be listed here as they don't \
|
||||
|
|
|
@ -39,7 +39,7 @@ module Gen(P : Install_params) = struct
|
|||
let gen_lib_dune_file lib =
|
||||
SC.add_rule sctx
|
||||
(Build.arr (fun () ->
|
||||
Format.asprintf "%a@." Sexp.pp
|
||||
Format.asprintf "%a@." (Sexp.pp Dune)
|
||||
(Lib.Sub_system.dump_config lib |> Installed_dune_file.gen))
|
||||
>>> Build.write_file_dyn
|
||||
(lib_dune_file ~dir:(Lib.src_dir lib) ~name:(Lib.name lib)))
|
||||
|
|
|
@ -191,6 +191,8 @@ module Pps_and_flags = struct
|
|||
|
||||
let item =
|
||||
peek raw >>= function
|
||||
| Template { loc; _ } ->
|
||||
no_templates loc "in the preprocessors field"
|
||||
| Atom _ | Quoted_string _ -> plain_string of_string
|
||||
| List _ -> list string >>| fun l -> Right l
|
||||
|
||||
|
@ -260,7 +262,7 @@ module Dep_conf = struct
|
|||
]
|
||||
in
|
||||
peek raw >>= function
|
||||
| Atom _ | Quoted_string _ ->
|
||||
| Template _ | Atom _ | Quoted_string _ ->
|
||||
String_with_vars.t >>| fun x -> File x
|
||||
| List _ -> t
|
||||
|
||||
|
@ -363,9 +365,7 @@ module Lint = struct
|
|||
let no_lint = default
|
||||
end
|
||||
|
||||
let field_oslu name =
|
||||
field name Ordered_set_lang.Unexpanded.t
|
||||
~default:Ordered_set_lang.Unexpanded.standard
|
||||
let field_oslu name = Ordered_set_lang.Unexpanded.field name
|
||||
|
||||
module Js_of_ocaml = struct
|
||||
|
||||
|
@ -419,6 +419,7 @@ module Lib_dep = struct
|
|||
; forbidden
|
||||
; file
|
||||
}
|
||||
| Template _ -> no_templates loc "in the select form"
|
||||
| List _ ->
|
||||
of_sexp_errorf loc "(<[!]libraries>... -> <file>) expected"
|
||||
| (Atom (_, A s) | Quoted_string (_, s)) ->
|
||||
|
@ -529,8 +530,7 @@ module Buildable = struct
|
|||
; allow_overlapping_dependencies : bool
|
||||
}
|
||||
|
||||
let modules_field name =
|
||||
field name Ordered_set_lang.t ~default:Ordered_set_lang.standard
|
||||
let modules_field name = Ordered_set_lang.field name
|
||||
|
||||
let t =
|
||||
loc >>= fun loc ->
|
||||
|
@ -972,7 +972,8 @@ module Executables = struct
|
|||
let to_install =
|
||||
match Link_mode.Set.best_install_mode t.modes with
|
||||
| None when has_public_name ->
|
||||
let mode_to_string mode = " - " ^ Sexp.to_string (Link_mode.sexp_of_t mode) in
|
||||
let mode_to_string mode =
|
||||
" - " ^ Sexp.to_string ~syntax:Dune (Link_mode.sexp_of_t mode) in
|
||||
let mode_strings = List.map ~f:mode_to_string Link_mode.installable_modes in
|
||||
Loc.fail
|
||||
buildable.loc
|
||||
|
@ -1362,7 +1363,7 @@ module Documentation = struct
|
|||
let t =
|
||||
record
|
||||
(Pkg.field >>= fun package ->
|
||||
field "mld_files" Ordered_set_lang.t ~default:Ordered_set_lang.standard
|
||||
Ordered_set_lang.field "mld_files"
|
||||
>>= fun mld_files ->
|
||||
return
|
||||
{ package
|
||||
|
|
|
@ -1,9 +1,6 @@
|
|||
open Import
|
||||
|
||||
type t = Usexp.Loc.t =
|
||||
{ start : Lexing.position
|
||||
; stop : Lexing.position
|
||||
}
|
||||
include Usexp.Loc
|
||||
|
||||
(* TODO get rid of all this stuff once this parsing code moves to Usexp and
|
||||
there will be no circular dependency *)
|
||||
|
@ -64,8 +61,6 @@ let of_pos (fname, lnum, cnum, enum) =
|
|||
; stop = { pos with pos_cnum = enum }
|
||||
}
|
||||
|
||||
let none = in_file "<none>"
|
||||
|
||||
let print ppf { start; stop } =
|
||||
let start_c = start.pos_cnum - start.pos_bol in
|
||||
let stop_c = stop.pos_cnum - start.pos_bol in
|
||||
|
|
|
@ -88,7 +88,7 @@ let setup ?(log=Log.no_log)
|
|||
>>= fun contexts ->
|
||||
let contexts = List.concat contexts in
|
||||
List.iter contexts ~f:(fun (ctx : Context.t) ->
|
||||
Log.infof log "@[<1>Jbuilder context:@,%a@]@." Sexp.pp
|
||||
Log.infof log "@[<1>Jbuilder context:@,%a@]@." (Sexp.pp Dune)
|
||||
(Context.sexp_of_t ctx));
|
||||
let rule_done = ref 0 in
|
||||
let rule_total = ref 0 in
|
||||
|
|
|
@ -15,6 +15,7 @@ end
|
|||
type 'ast generic =
|
||||
{ ast : 'ast
|
||||
; loc : Loc.t option
|
||||
; context: Univ_map.t
|
||||
}
|
||||
|
||||
type ast_expanded = (Loc.t * string, Ast.expanded) Ast.t
|
||||
|
@ -24,7 +25,8 @@ let loc t = t.loc
|
|||
let parse_general sexp ~f =
|
||||
let rec of_sexp : Sexp.Ast.t -> _ = function
|
||||
| Atom (loc, A "\\") -> Loc.fail loc "unexpected \\"
|
||||
| (Atom (_, A "") | Quoted_string (_, _)) as t -> Ast.Element (f t)
|
||||
| (Atom (_, A "") | Quoted_string (_, _) | Template _ ) as t ->
|
||||
Ast.Element (f t)
|
||||
| Atom (loc, A s) as t ->
|
||||
if s.[0] = ':' then
|
||||
Special (loc, String.sub s ~pos:1 ~len:(String.length s - 1))
|
||||
|
@ -42,14 +44,17 @@ let parse_general sexp ~f =
|
|||
|
||||
let t =
|
||||
let open Sexp.Of_sexp in
|
||||
context >>= fun context ->
|
||||
raw >>| fun sexp ->
|
||||
let ast =
|
||||
parse_general sexp ~f:(function
|
||||
| Template t -> no_templates t.loc "here"
|
||||
| Atom (loc, A s) | Quoted_string (loc, s) -> (loc, s)
|
||||
| List _ -> assert false)
|
||||
in
|
||||
{ ast
|
||||
; loc = Some (Sexp.Ast.loc sexp)
|
||||
; context
|
||||
}
|
||||
|
||||
let is_standard t =
|
||||
|
@ -168,20 +173,24 @@ end
|
|||
let standard =
|
||||
{ ast = Ast.Special (Loc.none, "standard")
|
||||
; loc = None
|
||||
; context = Univ_map.empty
|
||||
}
|
||||
|
||||
let field ?(default=standard) name = Sexp.Of_sexp.field name t ~default
|
||||
|
||||
module Unexpanded = struct
|
||||
type ast = (Sexp.Ast.t, Ast.unexpanded) Ast.t
|
||||
type t = ast generic
|
||||
let t =
|
||||
let open Sexp.Of_sexp in
|
||||
context >>= fun context ->
|
||||
raw >>| fun sexp ->
|
||||
let rec map (t : (Sexp.Ast.t, Ast.expanded) Ast.t) =
|
||||
let open Ast in
|
||||
match t with
|
||||
| Element x -> Element x
|
||||
| Union [Special (_, "include"); Element fn] ->
|
||||
Include (Sexp.Of_sexp.parse String_with_vars.t Univ_map.empty fn)
|
||||
Include (Sexp.Of_sexp.parse String_with_vars.t context fn)
|
||||
| Union [Special (loc, "include"); _]
|
||||
| Special (loc, "include") ->
|
||||
Loc.fail loc "(:include expects a single element (do you need to quote the filename?)"
|
||||
|
@ -193,6 +202,7 @@ module Unexpanded = struct
|
|||
in
|
||||
{ ast = map (parse_general sexp ~f:(fun x -> x))
|
||||
; loc = Some (Sexp.Ast.loc sexp)
|
||||
; context
|
||||
}
|
||||
|
||||
let sexp_of_t t =
|
||||
|
@ -225,7 +235,12 @@ module Unexpanded = struct
|
|||
| Diff (l, r) ->
|
||||
loop (loop acc l) r
|
||||
in
|
||||
loop String.Set.empty t.ast
|
||||
let syntax =
|
||||
match Univ_map.find t.context (Syntax.key Stanza.syntax) with
|
||||
| Some (0, _)-> File_tree.Dune_file.Kind.Jbuild
|
||||
| None | Some (_, _) -> Dune
|
||||
in
|
||||
(syntax, loop String.Set.empty t.ast)
|
||||
|
||||
let has_special_forms t =
|
||||
let rec loop (t : ast) =
|
||||
|
@ -242,12 +257,14 @@ module Unexpanded = struct
|
|||
loop t.ast
|
||||
|
||||
let expand t ~files_contents ~f =
|
||||
let context = t.context in
|
||||
let rec expand (t : ast) : ast_expanded =
|
||||
let open Ast in
|
||||
match t with
|
||||
| Element s ->
|
||||
Element (Sexp.Ast.loc s,
|
||||
f (Sexp.Of_sexp.parse String_with_vars.t Univ_map.empty s))
|
||||
Element ( Sexp.Ast.loc s
|
||||
, f (Sexp.Of_sexp.parse String_with_vars.t context s)
|
||||
)
|
||||
| Special (l, s) -> Special (l, s)
|
||||
| Include fn ->
|
||||
let sexp =
|
||||
|
@ -264,7 +281,7 @@ module Unexpanded = struct
|
|||
in
|
||||
parse_general sexp ~f:(fun sexp ->
|
||||
(Sexp.Ast.loc sexp,
|
||||
f (Sexp.Of_sexp.parse String_with_vars.t Univ_map.empty sexp)))
|
||||
f (Sexp.Of_sexp.parse String_with_vars.t context sexp)))
|
||||
| Union l -> Union (List.map l ~f:expand)
|
||||
| Diff (l, r) ->
|
||||
Diff (expand l, expand r)
|
||||
|
|
|
@ -49,6 +49,8 @@ module Make(Key : Key)(Value : Value with type key = Key.t)
|
|||
val standard : t
|
||||
val is_standard : t -> bool
|
||||
|
||||
val field : ?default:t -> string -> t Sexp.Of_sexp.fields_parser
|
||||
|
||||
module Unexpanded : sig
|
||||
type expanded = t
|
||||
type t
|
||||
|
@ -61,7 +63,10 @@ module Unexpanded : sig
|
|||
val has_special_forms : t -> bool
|
||||
|
||||
(** List of files needed to expand this set *)
|
||||
val files : t -> f:(String_with_vars.t -> string) -> String.Set.t
|
||||
val files
|
||||
: t
|
||||
-> f:(String_with_vars.t -> string)
|
||||
-> Sexp.syntax * String.Set.t
|
||||
|
||||
(** Expand [t] using with the given file contents. [file_contents] is a map from
|
||||
filenames to their parsed contents. Every [(:include fn)] in [t] is replaced by
|
||||
|
|
|
@ -74,8 +74,8 @@ let report_with_backtrace exn =
|
|||
; pp = fun ppf ->
|
||||
Format.fprintf ppf "@{<error>Internal error, please report upstream \
|
||||
including the contents of _build/log.@}\n\
|
||||
Description: %a\n"
|
||||
Usexp.pp sexp
|
||||
Description:%a\n"
|
||||
(Usexp.pp Dune) sexp
|
||||
}
|
||||
| Unix.Unix_error (err, func, fname) ->
|
||||
{ p with pp = fun ppf ->
|
||||
|
|
|
@ -590,6 +590,7 @@ let of_string ?error_loc s =
|
|||
let t =
|
||||
Sexp.Of_sexp.(
|
||||
peek raw >>= function
|
||||
| Template _
|
||||
| Atom _ | Quoted_string _ ->
|
||||
(* necessary for old build dirs *)
|
||||
plain_string (fun ~loc:_ s -> of_string s)
|
||||
|
|
|
@ -63,6 +63,7 @@ module Of_sexp = struct
|
|||
type ast = Ast.t =
|
||||
| Atom of Loc.t * Atom.t
|
||||
| Quoted_string of Loc.t * string
|
||||
| Template of Template.t
|
||||
| List of Loc.t * ast list
|
||||
|
||||
type hint =
|
||||
|
@ -76,6 +77,9 @@ module Of_sexp = struct
|
|||
raise (Of_sexp (loc, msg, hint))
|
||||
let of_sexp_errorf ?hint loc fmt =
|
||||
Printf.ksprintf (fun msg -> of_sexp_error loc ?hint msg) fmt
|
||||
let no_templates ?hint loc fmt =
|
||||
Printf.ksprintf (fun msg ->
|
||||
of_sexp_error loc ?hint ("No variables allowed " ^ msg)) fmt
|
||||
|
||||
type unparsed_field =
|
||||
{ values : Ast.t list
|
||||
|
@ -133,6 +137,8 @@ module Of_sexp = struct
|
|||
|
||||
let get key ctx state = (Univ_map.find (get_user_context ctx) key, state)
|
||||
|
||||
let context ctx state = (get_user_context ctx, state)
|
||||
|
||||
let set : type a b k. a Univ_map.Key.t -> a -> (b, k) parser -> (b, k) parser
|
||||
= fun key v t ctx state ->
|
||||
match ctx with
|
||||
|
@ -236,7 +242,8 @@ module Of_sexp = struct
|
|||
let plain_string f =
|
||||
next (function
|
||||
| Atom (loc, A s) | Quoted_string (loc, s) -> f ~loc s
|
||||
| List (loc, _) -> of_sexp_error loc "Atom or quoted string expected")
|
||||
| Template { loc ; _ } | List (loc, _) ->
|
||||
of_sexp_error loc "Atom or quoted string expected")
|
||||
|
||||
let enter t =
|
||||
next_with_user_context (fun uc sexp ->
|
||||
|
@ -285,7 +292,7 @@ module Of_sexp = struct
|
|||
|
||||
let basic desc f =
|
||||
next (function
|
||||
| List (loc, _) | Quoted_string (loc, _) ->
|
||||
| Template { loc; _ } | List (loc, _) | Quoted_string (loc, _) ->
|
||||
of_sexp_errorf loc "%s expected" desc
|
||||
| Atom (loc, s) ->
|
||||
match f (Atom.to_string s) with
|
||||
|
@ -361,13 +368,14 @@ module Of_sexp = struct
|
|||
match sexp with
|
||||
| Atom (loc, A s) ->
|
||||
find_cstr cstrs loc s (Values (loc, Some s, uc)) []
|
||||
| Template { loc; _ }
|
||||
| Quoted_string (loc, _) ->
|
||||
of_sexp_error loc "Atom expected"
|
||||
| List (loc, []) ->
|
||||
of_sexp_error loc "Non-empty list expected"
|
||||
| List (loc, name :: args) ->
|
||||
match name with
|
||||
| Quoted_string (loc, _) | List (loc, _) ->
|
||||
| Quoted_string (loc, _) | List (loc, _) | Template { loc; _ } ->
|
||||
of_sexp_error loc "Atom expected"
|
||||
| Atom (s_loc, A s) ->
|
||||
find_cstr cstrs s_loc s (Values (loc, Some s, uc)) args)
|
||||
|
@ -375,6 +383,7 @@ module Of_sexp = struct
|
|||
let enum cstrs =
|
||||
next (function
|
||||
| Quoted_string (loc, _)
|
||||
| Template { loc; _ }
|
||||
| List (loc, _) -> of_sexp_error loc "Atom expected"
|
||||
| Atom (loc, A s) ->
|
||||
match List.assoc cstrs s with
|
||||
|
@ -496,7 +505,7 @@ module Of_sexp = struct
|
|||
; entry = sexp
|
||||
; prev = Name_map.find acc name
|
||||
}
|
||||
| List (loc, _) | Quoted_string (loc, _) ->
|
||||
| List (loc, _) | Quoted_string (loc, _) | Template { loc; _ } ->
|
||||
of_sexp_error loc "Atom expected"
|
||||
end
|
||||
| _ ->
|
||||
|
|
|
@ -56,6 +56,7 @@ module Of_sexp : sig
|
|||
type ast = Ast.t =
|
||||
| Atom of Loc.t * Atom.t
|
||||
| Quoted_string of Loc.t * string
|
||||
| Template of Template.t
|
||||
| List of Loc.t * ast list
|
||||
|
||||
type hint =
|
||||
|
@ -111,6 +112,8 @@ module Of_sexp : sig
|
|||
val set : 'a Univ_map.Key.t -> 'a -> ('b, 'k) parser -> ('b, 'k) parser
|
||||
val set_many : Univ_map.t -> ('a, 'k) parser -> ('a, 'k) parser
|
||||
|
||||
val context : (Univ_map.t, _) parser
|
||||
|
||||
(** Return the location of the list currently being parsed. *)
|
||||
val loc : (Loc.t, _) parser
|
||||
|
||||
|
@ -176,6 +179,12 @@ module Of_sexp : sig
|
|||
-> ('a, unit, string, 'b) format4
|
||||
-> 'a
|
||||
|
||||
val no_templates
|
||||
: ?hint:hint
|
||||
-> Loc.t
|
||||
-> ('a, unit, string, 'b) format4
|
||||
-> 'a
|
||||
|
||||
val located : 'a t -> (Loc.t * 'a) t
|
||||
|
||||
val enum : (string * 'a) list -> 'a t
|
||||
|
|
|
@ -1,111 +1,130 @@
|
|||
open! Import
|
||||
|
||||
type var_syntax = Parens | Braces
|
||||
open Usexp.Template
|
||||
|
||||
type item =
|
||||
| Text of string
|
||||
| Var of var_syntax * string
|
||||
type t = Usexp.Template.t
|
||||
|
||||
type t =
|
||||
{ items : item list
|
||||
; loc : Loc.t
|
||||
; quoted : bool }
|
||||
let literal ~quoted ~loc s =
|
||||
{ parts = [Text s]
|
||||
; quoted
|
||||
; loc
|
||||
}
|
||||
|
||||
module Token = struct
|
||||
type t =
|
||||
| String of string
|
||||
| Open of var_syntax
|
||||
| Close of var_syntax
|
||||
(* This module implements the "old" template parsing that is only used in jbuild
|
||||
files *)
|
||||
module Jbuild : sig
|
||||
val parse : string -> loc:Loc.t -> quoted:bool -> t
|
||||
end = struct
|
||||
type var_syntax = Parens | Braces
|
||||
module Token = struct
|
||||
type t =
|
||||
| String of string
|
||||
| Open of var_syntax
|
||||
| Close of var_syntax
|
||||
|
||||
let tokenise s =
|
||||
let len = String.length s in
|
||||
let sub i j = String.sub s ~pos:i ~len:(j - i) in
|
||||
let cons_str i j acc = if i = j then acc else String (sub i j) :: acc in
|
||||
let rec loop i j =
|
||||
if j = len
|
||||
then cons_str i j []
|
||||
else
|
||||
match s.[j] with
|
||||
| '}' -> cons_str i j (Close Braces :: loop (j + 1) (j + 1))
|
||||
| ')' -> cons_str i j (Close Parens :: loop (j + 1) (j + 1))
|
||||
| '$' when j + 1 < len -> begin
|
||||
match s.[j + 1] with
|
||||
| '{' -> cons_str i j (Open Braces :: loop (j + 2) (j + 2))
|
||||
| '(' -> cons_str i j (Open Parens :: loop (j + 2) (j + 2))
|
||||
| _ -> loop i (j + 1)
|
||||
end
|
||||
| _ -> loop i (j + 1)
|
||||
in
|
||||
loop 0 0
|
||||
let tokenise s =
|
||||
let len = String.length s in
|
||||
let sub i j = String.sub s ~pos:i ~len:(j - i) in
|
||||
let cons_str i j acc = if i = j then acc else String (sub i j) :: acc in
|
||||
let rec loop i j =
|
||||
if j = len
|
||||
then cons_str i j []
|
||||
else
|
||||
match s.[j] with
|
||||
| '}' -> cons_str i j (Close Braces :: loop (j + 1) (j + 1))
|
||||
| ')' -> cons_str i j (Close Parens :: loop (j + 1) (j + 1))
|
||||
| '$' when j + 1 < len -> begin
|
||||
match s.[j + 1] with
|
||||
| '{' -> cons_str i j (Open Braces :: loop (j + 2) (j + 2))
|
||||
| '(' -> cons_str i j (Open Parens :: loop (j + 2) (j + 2))
|
||||
| _ -> loop i (j + 1)
|
||||
end
|
||||
| _ -> loop i (j + 1)
|
||||
in
|
||||
loop 0 0
|
||||
|
||||
let to_string = function
|
||||
| String s -> s
|
||||
| Open Braces -> "${"
|
||||
| Open Parens -> "$("
|
||||
| Close Braces -> "}"
|
||||
| Close Parens -> ")"
|
||||
let to_string = function
|
||||
| String s -> s
|
||||
| Open Braces -> "${"
|
||||
| Open Parens -> "$("
|
||||
| Close Braces -> "}"
|
||||
| Close Parens -> ")"
|
||||
end
|
||||
(* Remark: Consecutive [Text] items are concatenated. *)
|
||||
let rec of_tokens
|
||||
: Loc.t -> Token.t list -> part list = fun loc -> function
|
||||
| [] -> []
|
||||
| Open a :: String s :: Close b :: rest when a = b ->
|
||||
let (name, payload) =
|
||||
match String.lsplit2 s ~on:':' with
|
||||
| None -> (s, None)
|
||||
| Some (n, p) -> (n, Some p)
|
||||
in
|
||||
Var { loc
|
||||
; name
|
||||
; payload
|
||||
; syntax =
|
||||
begin match a with
|
||||
| Parens -> Dollar_paren
|
||||
| Braces -> Dollar_brace
|
||||
end
|
||||
} :: of_tokens loc rest
|
||||
| token :: rest ->
|
||||
let s = Token.to_string token in
|
||||
match of_tokens loc rest with
|
||||
| Text s' :: l -> Text (s ^ s') :: l
|
||||
| l -> Text s :: l
|
||||
|
||||
let parse s ~loc ~quoted =
|
||||
{ parts = of_tokens loc (Token.tokenise s)
|
||||
; loc
|
||||
; quoted
|
||||
}
|
||||
end
|
||||
|
||||
(* Remark: Consecutive [Text] items are concatenated. *)
|
||||
let rec of_tokens : Token.t list -> item list = function
|
||||
| [] -> []
|
||||
| Open a :: String s :: Close b :: rest when a = b ->
|
||||
Var (a, s) :: of_tokens rest
|
||||
| token :: rest ->
|
||||
let s = Token.to_string token in
|
||||
match of_tokens rest with
|
||||
| Text s' :: l -> Text (s ^ s') :: l
|
||||
| l -> Text s :: l
|
||||
|
||||
let items_of_string s = of_tokens (Token.tokenise s)
|
||||
|
||||
let t =
|
||||
let open Sexp.Of_sexp in
|
||||
raw >>| fun sexp ->
|
||||
match sexp with
|
||||
| Atom(loc, A s) -> { items = items_of_string s; loc; quoted = false }
|
||||
| Quoted_string (loc, s) ->
|
||||
{ items = items_of_string s; loc; quoted = true }
|
||||
| List (loc, _) -> of_sexp_error loc "Atom or quoted string expected"
|
||||
let jbuild =
|
||||
raw >>| function
|
||||
| Template _ as t ->
|
||||
Exn.code_error "Unexpected dune template from a jbuild file"
|
||||
[ "t", Usexp.Ast.remove_locs t
|
||||
]
|
||||
| Atom(loc, A s) -> Jbuild.parse s ~loc ~quoted:false
|
||||
| Quoted_string (loc, s) -> Jbuild.parse s ~loc ~quoted:true
|
||||
| List (loc, _) -> Sexp.Of_sexp.of_sexp_error loc "Atom expected"
|
||||
in
|
||||
let dune =
|
||||
raw >>| function
|
||||
| Template t -> t
|
||||
| Atom(loc, A s) -> literal ~quoted:false ~loc s
|
||||
| Quoted_string (loc, s) -> literal ~quoted:true ~loc s
|
||||
| List (loc, _) -> Sexp.Of_sexp.of_sexp_error loc "Unexpected list"
|
||||
in
|
||||
Syntax.get_exn Stanza.syntax >>= function
|
||||
| (0, _) -> jbuild
|
||||
| (_, _) -> dune
|
||||
|
||||
let loc t = t.loc
|
||||
|
||||
let virt ?(quoted=false) pos s =
|
||||
{ items = items_of_string s; loc = Loc.of_pos pos; quoted }
|
||||
Jbuild.parse ~quoted ~loc:(Loc.of_pos pos) s
|
||||
|
||||
let virt_var ?(quoted=false) pos s =
|
||||
{ items = [Var (Braces, s)]; loc = Loc.of_pos pos; quoted }
|
||||
assert (String.for_all s ~f:(function ':' -> false | _ -> true));
|
||||
let loc = Loc.of_pos pos in
|
||||
{ parts =
|
||||
[Var { payload = None
|
||||
; name = s
|
||||
; syntax = Percent
|
||||
; loc
|
||||
}]
|
||||
; loc
|
||||
; quoted
|
||||
}
|
||||
|
||||
let virt_text pos s =
|
||||
{ items = [Text s]; loc = Loc.of_pos pos; quoted = true }
|
||||
|
||||
let sexp_of_var_syntax = function
|
||||
| Parens -> Sexp.unsafe_atom_of_string "parens"
|
||||
| Braces -> Sexp.unsafe_atom_of_string "braces"
|
||||
|
||||
let sexp_of_item =
|
||||
let open Sexp in function
|
||||
| Text s -> List [Sexp.unsafe_atom_of_string "text" ;
|
||||
Sexp.atom_or_quoted_string s]
|
||||
| Var (vs, s) -> List [sexp_of_var_syntax vs ;
|
||||
Sexp.atom_or_quoted_string s]
|
||||
|
||||
let sexp_of_ast t = Sexp.To_sexp.list sexp_of_item t.items
|
||||
|
||||
let fold t ~init ~f =
|
||||
List.fold_left t.items ~init ~f:(fun acc item ->
|
||||
match item with
|
||||
| Text _ -> acc
|
||||
| Var (_, v) -> f acc t.loc v)
|
||||
|
||||
let iter t ~f = List.iter t.items ~f:(function
|
||||
| Text _ -> ()
|
||||
| Var (_, v) -> f t.loc v)
|
||||
|
||||
let vars t = fold t ~init:String.Set.empty ~f:(fun acc _ x -> String.Set.add acc x)
|
||||
|
||||
let string_of_var syntax v =
|
||||
match syntax with
|
||||
| Parens -> sprintf "$(%s)" v
|
||||
| Braces -> sprintf "${%s}" v
|
||||
{ parts = [Text s]; loc = Loc.of_pos pos; quoted = true }
|
||||
|
||||
let concat_rev = function
|
||||
| [] -> ""
|
||||
|
@ -139,74 +158,99 @@ module Partial = struct
|
|||
| Unexpanded of t
|
||||
end
|
||||
|
||||
let invalid_multivalue syntax ~var t x =
|
||||
Loc.fail t.loc "Variable %s expands to %d values, \
|
||||
let invalid_multivalue (v : var) x =
|
||||
Loc.fail v.loc "Variable %s expands to %d values, \
|
||||
however a single value is expected here. \
|
||||
Please quote this atom."
|
||||
(string_of_var syntax var) (List.length x)
|
||||
(string_of_var v) (List.length x)
|
||||
|
||||
let partial_expand t ~mode ~dir ~f =
|
||||
let commit_text acc_text acc =
|
||||
let s = concat_rev acc_text in
|
||||
if s = "" then acc else Text s :: acc
|
||||
in
|
||||
let rec loop acc_text acc items =
|
||||
match items with
|
||||
| [] ->
|
||||
begin match acc with
|
||||
| [] -> Partial.Expanded (Mode.string mode (concat_rev acc_text))
|
||||
| _ -> Unexpanded { t with items = List.rev (commit_text acc_text acc) }
|
||||
module Var = struct
|
||||
type t = var
|
||||
|
||||
let loc (t : t) = t.loc
|
||||
|
||||
type kind =
|
||||
| Single of string
|
||||
| Pair of string * string
|
||||
|
||||
let destruct { loc = _ ; name; payload; syntax = _ } =
|
||||
match payload with
|
||||
| None -> Single name
|
||||
| Some p -> Pair (name, p)
|
||||
|
||||
let full_name t =
|
||||
match destruct t with
|
||||
| Single s -> s
|
||||
| Pair (k, v) -> k ^ ":" ^ v
|
||||
end
|
||||
|
||||
let partial_expand
|
||||
: 'a.t
|
||||
-> mode:'a Mode.t
|
||||
-> dir:Path.t
|
||||
-> f:(Var.t -> Value.t list option)
|
||||
-> 'a Partial.t
|
||||
= fun t ~mode ~dir ~f ->
|
||||
let commit_text acc_text acc =
|
||||
let s = concat_rev acc_text in
|
||||
if s = "" then acc else Text s :: acc
|
||||
in
|
||||
let rec loop acc_text acc items =
|
||||
match items with
|
||||
| [] ->
|
||||
begin match acc with
|
||||
| [] ->
|
||||
Partial.Expanded (Mode.string mode (concat_rev acc_text))
|
||||
| _ ->
|
||||
Unexpanded { t with parts = List.rev (commit_text acc_text acc) }
|
||||
end
|
||||
| Text s :: items -> loop (s :: acc_text) acc items
|
||||
| Var var as it :: items ->
|
||||
begin match f var with
|
||||
| Some ([] | _::_::_ as e) when not t.quoted ->
|
||||
invalid_multivalue var e
|
||||
| Some t ->
|
||||
loop (Value.L.concat ~dir t :: acc_text) acc items
|
||||
| None -> loop [] (it :: commit_text acc_text acc) items
|
||||
end
|
||||
in
|
||||
match t.parts with
|
||||
| [] -> Partial.Expanded (Mode.string mode "")
|
||||
| [Text s] -> Expanded (Mode.string mode s)
|
||||
| [Var var] when not t.quoted ->
|
||||
begin match f var with
|
||||
| None -> Partial.Unexpanded t
|
||||
| Some e -> Expanded (
|
||||
match Mode.value mode e with
|
||||
| None -> invalid_multivalue var e
|
||||
| Some s -> s)
|
||||
end
|
||||
| Text s :: items -> loop (s :: acc_text) acc items
|
||||
| Var (syntax, var) as it :: items ->
|
||||
begin match f syntax t.loc var with
|
||||
| Some ([] | _::_::_ as e) when not t.quoted ->
|
||||
invalid_multivalue syntax ~var t e
|
||||
| Some t ->
|
||||
loop (Value.L.concat ~dir t :: acc_text) acc items
|
||||
| None -> loop [] (it :: commit_text acc_text acc) items
|
||||
end
|
||||
in
|
||||
match t.items with
|
||||
| [] -> Partial.Expanded (Mode.string mode "")
|
||||
| [Text s] -> Expanded (Mode.string mode s)
|
||||
| [Var (syntax, v)] when not t.quoted ->
|
||||
(* Unquoted single var *)
|
||||
begin match f syntax t.loc v with
|
||||
| Some e -> Partial.Expanded (
|
||||
match Mode.value mode e with
|
||||
| None -> invalid_multivalue syntax ~var:v t e
|
||||
| Some s -> s)
|
||||
| None -> Unexpanded t
|
||||
end
|
||||
| _ -> loop [] [] t.items
|
||||
| _ -> loop [] [] t.parts
|
||||
|
||||
let expand t ~mode ~dir ~f =
|
||||
match
|
||||
partial_expand t ~mode ~dir ~f:(fun syntax loc var ->
|
||||
match f loc var with
|
||||
| None -> Some [Value.String (string_of_var syntax var)]
|
||||
partial_expand t ~mode ~dir ~f:(fun var ->
|
||||
match f var with
|
||||
| None ->
|
||||
begin match var.syntax with
|
||||
| Percent ->
|
||||
begin match Var.destruct var with
|
||||
| Single v -> Loc.fail var.loc "unknown variable %S" v
|
||||
| Pair _ -> Loc.fail var.loc "unknown form %s" (string_of_var var)
|
||||
end
|
||||
| Dollar_brace
|
||||
| Dollar_paren -> Some [Value.String (string_of_var var)]
|
||||
end
|
||||
| s -> s)
|
||||
with
|
||||
| Partial.Expanded s -> s
|
||||
| Unexpanded _ -> assert false (* we are expanding every variable *)
|
||||
|
||||
let partial_expand t ~mode ~dir ~f =
|
||||
partial_expand t ~mode ~dir ~f:(fun _ loc v -> f loc v)
|
||||
let partial_expand t ~mode ~dir ~f = partial_expand t ~mode ~dir ~f
|
||||
|
||||
let to_string t =
|
||||
match t.items with
|
||||
(* [to_string is only called from action.ml, always on [t]s of this form *)
|
||||
| [Var (syntax, v)] -> string_of_var syntax v
|
||||
| items ->
|
||||
List.map items ~f:(function
|
||||
| Text s -> s
|
||||
| Var (syntax, v) -> string_of_var syntax v)
|
||||
|> String.concat ~sep:""
|
||||
let sexp_of_t t = Usexp.Template t
|
||||
|
||||
let sexp_of_t t = Sexp.To_sexp.string (to_string t)
|
||||
|
||||
let is_var t ~name =
|
||||
match t.items with
|
||||
| [Var (_, v)] -> v = name
|
||||
let is_var { parts ; quoted = _; loc = _ } ~name =
|
||||
match parts with
|
||||
| [Var n] -> name = Var.full_name n
|
||||
| _ -> false
|
||||
|
|
|
@ -18,12 +18,6 @@ val loc : t -> Loc.t
|
|||
|
||||
val sexp_of_t : t -> Sexp.t
|
||||
|
||||
(** Same as [sexp_of_t] but the S-expression encodes the internal
|
||||
structure of [t]. *)
|
||||
val sexp_of_ast : t -> Sexp.t
|
||||
|
||||
val to_string : t -> string
|
||||
|
||||
(** [t] generated by the OCaml code. The first argument should be
|
||||
[__POS__]. The second is either a string to parse, a variable name
|
||||
or plain text. [quoted] says whether the string is quoted ([false]
|
||||
|
@ -32,17 +26,6 @@ val virt : ?quoted: bool -> (string * int * int * int) -> string -> t
|
|||
val virt_var : ?quoted: bool -> (string * int * int * int) -> string -> t
|
||||
val virt_text : (string * int * int * int) -> string -> t
|
||||
|
||||
val vars : t -> String.Set.t
|
||||
(** [vars t] returns the set of all variables in [t]. *)
|
||||
|
||||
val fold : t -> init:'a -> f:('a -> Loc.t -> string -> 'a) -> 'a
|
||||
(** [fold t ~init ~f] fold [f] on all variables of [t], the text
|
||||
portions being ignored. *)
|
||||
|
||||
val iter : t -> f:(Loc.t -> string -> unit) -> unit
|
||||
(** [iter t ~f] iterates [f] over all variables of [t], the text
|
||||
portions being ignored. *)
|
||||
|
||||
val is_var : t -> name:string -> bool
|
||||
|
||||
module Mode : sig
|
||||
|
@ -57,16 +40,29 @@ module Partial : sig
|
|||
| Unexpanded of t
|
||||
end
|
||||
|
||||
module Var : sig
|
||||
type t
|
||||
|
||||
val loc : t -> Loc.t
|
||||
val full_name : t -> string
|
||||
|
||||
type kind =
|
||||
| Single of string
|
||||
| Pair of string * string
|
||||
|
||||
val destruct : t -> kind
|
||||
end
|
||||
|
||||
val expand
|
||||
: t
|
||||
-> mode:'a Mode.t
|
||||
-> dir:Path.t
|
||||
-> f:(Loc.t -> string -> Value.t list option)
|
||||
-> f:(Var.t -> Value.t list option)
|
||||
-> 'a
|
||||
|
||||
val partial_expand
|
||||
: t
|
||||
-> mode:'a Mode.t
|
||||
-> dir:Path.t
|
||||
-> f:(Loc.t -> string -> Value.t list option)
|
||||
-> f:(Var.t -> Value.t list option)
|
||||
-> 'a Partial.t
|
||||
|
|
|
@ -88,7 +88,8 @@ let expand_var_no_root t var = String.Map.find t.vars var
|
|||
|
||||
let (expand_vars, expand_vars_path) =
|
||||
let expand t ~scope ~dir ?(extra_vars=String.Map.empty) s =
|
||||
String_with_vars.expand ~mode:Single ~dir s ~f:(fun _loc -> function
|
||||
String_with_vars.expand ~mode:Single ~dir s ~f:(fun v ->
|
||||
match String_with_vars.Var.full_name v with
|
||||
| "ROOT" -> Some [Value.Path t.context.build_dir]
|
||||
| "SCOPE_ROOT" -> Some [Value.Path (Scope.root scope)]
|
||||
| var ->
|
||||
|
@ -110,7 +111,8 @@ let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard =
|
|||
let open Build.O in
|
||||
let f = expand_vars t ~scope ~dir ?extra_vars in
|
||||
let parse ~loc:_ s = s in
|
||||
match Ordered_set_lang.Unexpanded.files set ~f |> String.Set.to_list with
|
||||
let (syntax, files) = Ordered_set_lang.Unexpanded.files set ~f in
|
||||
match String.Set.to_list files with
|
||||
| [] ->
|
||||
let set =
|
||||
Ordered_set_lang.Unexpanded.expand set ~files_contents:String.Map.empty ~f
|
||||
|
@ -119,7 +121,8 @@ let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard =
|
|||
Ordered_set_lang.String.eval set ~standard ~parse
|
||||
| files ->
|
||||
let paths = List.map files ~f:(Path.relative dir) in
|
||||
Build.fanout standard (Build.all (List.map paths ~f:Build.read_sexp))
|
||||
Build.fanout standard (Build.all (List.map paths ~f:(fun f ->
|
||||
Build.read_sexp f syntax)))
|
||||
>>^ fun (standard, sexps) ->
|
||||
let files_contents = List.combine files sexps |> String.Map.of_list_exn in
|
||||
let set = Ordered_set_lang.Unexpanded.expand set ~files_contents ~f in
|
||||
|
@ -564,13 +567,6 @@ module Scope_key = struct
|
|||
sprintf "%s@%s" key (Dune_project.Name.encode scope)
|
||||
end
|
||||
|
||||
let parse_bang var : bool * string =
|
||||
let len = String.length var in
|
||||
if len > 0 && var.[0] = '!' then
|
||||
(true, String.sub var ~pos:1 ~len:(len - 1))
|
||||
else
|
||||
(false, var)
|
||||
|
||||
module Action = struct
|
||||
open Build.O
|
||||
module U = Action.Unexpanded
|
||||
|
@ -630,10 +626,13 @@ module Action = struct
|
|||
; ddeps = String.Map.empty
|
||||
}
|
||||
in
|
||||
let expand loc key var = function
|
||||
| Some ("exe" , s) -> Some (path_exp (map_exe (Path.relative dir s)))
|
||||
| Some ("path" , s) -> Some (path_exp (Path.relative dir s) )
|
||||
| Some ("bin" , s) -> begin
|
||||
let expand var =
|
||||
let loc = String_with_vars.Var.loc var in
|
||||
let key = String_with_vars.Var.full_name var in
|
||||
match String_with_vars.Var.destruct var with
|
||||
| Pair ("exe" , s) -> Some (path_exp (map_exe (Path.relative dir s)))
|
||||
| Pair ("path" , s) -> Some (path_exp (Path.relative dir s) )
|
||||
| Pair ("bin" , s) -> begin
|
||||
let sctx = host sctx in
|
||||
match Artifacts.binary (artifacts sctx) s with
|
||||
| Ok path -> Some (path_exp path)
|
||||
|
@ -642,7 +641,7 @@ module Action = struct
|
|||
end
|
||||
(* "findlib" for compatibility with Jane Street packages which are not yet updated
|
||||
to convert "findlib" to "lib" *)
|
||||
| Some (("lib"|"findlib"), s) -> begin
|
||||
| Pair (("lib"|"findlib"), s) -> begin
|
||||
let lib_dep, file = parse_lib_file ~loc s in
|
||||
add_lib_dep acc lib_dep dep_kind;
|
||||
match
|
||||
|
@ -651,7 +650,7 @@ module Action = struct
|
|||
| Ok path -> Some (path_exp path)
|
||||
| Error fail -> add_fail acc fail
|
||||
end
|
||||
| Some ("libexec" , s) -> begin
|
||||
| Pair ("libexec" , s) -> begin
|
||||
let sctx = host sctx in
|
||||
let lib_dep, file = parse_lib_file ~loc s in
|
||||
add_lib_dep acc lib_dep dep_kind;
|
||||
|
@ -672,11 +671,11 @@ module Action = struct
|
|||
add_ddep acc ~key dep
|
||||
end
|
||||
end
|
||||
| Some ("lib-available", lib) ->
|
||||
| Pair ("lib-available", lib) ->
|
||||
add_lib_dep acc lib Optional;
|
||||
Some (str_exp (string_of_bool (
|
||||
Lib.DB.available (Scope.libs scope) lib)))
|
||||
| Some ("version", s) -> begin
|
||||
| Pair ("version", s) -> begin
|
||||
match Package.Name.Map.find (Scope.project scope).packages
|
||||
(Package.Name.of_string s) with
|
||||
| Some p ->
|
||||
|
@ -691,7 +690,7 @@ module Action = struct
|
|||
Loc.fail loc "Package %S doesn't exist in the current project." s
|
||||
}
|
||||
end
|
||||
| Some ("read", s) -> begin
|
||||
| Pair ("read", s) -> begin
|
||||
let path = Path.relative dir s in
|
||||
let data =
|
||||
Build.contents path
|
||||
|
@ -699,7 +698,7 @@ module Action = struct
|
|||
in
|
||||
add_ddep acc ~key data
|
||||
end
|
||||
| Some ("read-lines", s) -> begin
|
||||
| Pair ("read-lines", s) -> begin
|
||||
let path = Path.relative dir s in
|
||||
let data =
|
||||
Build.lines_of path
|
||||
|
@ -707,7 +706,7 @@ module Action = struct
|
|||
in
|
||||
add_ddep acc ~key data
|
||||
end
|
||||
| Some ("read-strings", s) -> begin
|
||||
| Pair ("read-strings", s) -> begin
|
||||
let path = Path.relative dir s in
|
||||
let data =
|
||||
Build.strings path
|
||||
|
@ -716,17 +715,15 @@ module Action = struct
|
|||
add_ddep acc ~key data
|
||||
end
|
||||
| _ ->
|
||||
match expand_var_no_root sctx var with
|
||||
match expand_var_no_root sctx key with
|
||||
| Some _ as x -> x
|
||||
| None -> String.Map.find extra_vars var
|
||||
| None -> String.Map.find extra_vars key
|
||||
in
|
||||
let t =
|
||||
U.partial_expand t ~dir ~map_exe ~f:(fun loc key ->
|
||||
let has_bang, var = parse_bang key in
|
||||
if has_bang then
|
||||
Loc.warn loc "The use of the variable prefix '!' is deprecated, \
|
||||
simply use '${%s}'@." var;
|
||||
match var with
|
||||
U.partial_expand t ~dir ~map_exe ~f:(fun var ->
|
||||
let var_name = String_with_vars.Var.full_name var in
|
||||
let loc = String_with_vars.Var.loc var in
|
||||
match var_name with
|
||||
| "ROOT" -> Some (path_exp sctx.context.build_dir)
|
||||
| "SCOPE_ROOT" -> Some (path_exp (Scope.root scope))
|
||||
| "@" -> begin
|
||||
|
@ -736,11 +733,11 @@ module Action = struct
|
|||
| Static l -> Some (Value.L.paths l)
|
||||
end
|
||||
| _ ->
|
||||
match String.lsplit2 var ~on:':' with
|
||||
| Some ("path-no-dep", s) ->
|
||||
match String_with_vars.Var.destruct var with
|
||||
| Pair ("path-no-dep", s) ->
|
||||
Some (path_exp (Path.relative dir s))
|
||||
| x ->
|
||||
let exp = expand loc key var x in
|
||||
| _ ->
|
||||
let exp = expand var in
|
||||
Option.iter exp ~f:(fun vs ->
|
||||
acc.sdeps <- Path.Set.union (Path.Set.of_list
|
||||
(Value.L.paths_only vs)) acc.sdeps;
|
||||
|
@ -750,12 +747,13 @@ module Action = struct
|
|||
(t, acc)
|
||||
|
||||
let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t =
|
||||
U.Partial.expand t ~dir ~map_exe ~f:(fun loc key ->
|
||||
U.Partial.expand t ~dir ~map_exe ~f:(fun var ->
|
||||
let key = String_with_vars.Var.full_name var in
|
||||
let loc = String_with_vars.Var.loc var in
|
||||
match String.Map.find dynamic_expansions key with
|
||||
| Some _ as opt -> opt
|
||||
| None ->
|
||||
let _, var = parse_bang key in
|
||||
match var with
|
||||
match key with
|
||||
| "<" ->
|
||||
Some
|
||||
(match deps_written_by_user with
|
||||
|
|
|
@ -8,7 +8,14 @@ let is_valid_dune =
|
|||
let rec loop s i len =
|
||||
i = len ||
|
||||
match String.unsafe_get s i with
|
||||
| '%' | '"' | '(' | ')' | ';' | '\000'..'\032' | '\127'..'\255' -> false
|
||||
| '%' -> after_percent s (i + 1) len
|
||||
| '"' | '(' | ')' | ';' | '\000'..'\032' | '\127'..'\255' -> false
|
||||
| _ -> loop s (i + 1) len
|
||||
and after_percent s i len =
|
||||
i = len ||
|
||||
match String.unsafe_get s i with
|
||||
| '%' -> after_percent s (i + 1) len
|
||||
| '"' | '(' | ')' | ';' | '\000'..'\032' | '\127'..'\255' | '{' -> false
|
||||
| _ -> loop s (i + 1) len
|
||||
in
|
||||
fun s ->
|
||||
|
|
|
@ -4,6 +4,91 @@ open Lexer_shared
|
|||
type block_string_line_kind =
|
||||
| With_escape_sequences
|
||||
| Raw
|
||||
|
||||
module Template = struct
|
||||
include Template
|
||||
|
||||
let dummy_loc =
|
||||
{ Loc.
|
||||
start = Lexing.dummy_pos
|
||||
; stop = Lexing.dummy_pos
|
||||
}
|
||||
|
||||
let add_text parts s =
|
||||
match parts with
|
||||
| Template.Text s' :: parts -> Template.Text (s' ^ s) :: parts
|
||||
| _ -> Template.Text s :: parts
|
||||
|
||||
let token parts ~quoted ~start (lexbuf : Lexing.lexbuf) =
|
||||
lexbuf.lex_start_p <- start;
|
||||
match parts with
|
||||
| [] | [Text ""] ->
|
||||
error lexbuf "Internal error in the S-expression parser, \
|
||||
please report upstream."
|
||||
| [Text s] ->
|
||||
Token.Atom (Atom.of_string s)
|
||||
| _ ->
|
||||
Token.Template
|
||||
{ quoted
|
||||
; loc = dummy_loc
|
||||
; parts = List.rev parts
|
||||
}
|
||||
|
||||
module Buffer : sig
|
||||
val new_token : unit -> unit
|
||||
val get : unit -> Token.t
|
||||
val add_var : part -> unit
|
||||
val add_text : string -> unit
|
||||
val add_text_c : char -> unit
|
||||
end = struct
|
||||
type state =
|
||||
| String
|
||||
| Template of Template.part list
|
||||
|
||||
let text_buf = Buffer.create 256
|
||||
|
||||
let new_token () = Buffer.clear text_buf
|
||||
|
||||
let take_buf () =
|
||||
let contents = Buffer.contents text_buf in
|
||||
Buffer.clear text_buf;
|
||||
contents
|
||||
|
||||
let state = ref String
|
||||
|
||||
let add_buf_to_parts parts =
|
||||
match take_buf () with
|
||||
| "" -> parts
|
||||
| t -> add_text parts t
|
||||
|
||||
let get () =
|
||||
match !state with
|
||||
| String -> Token.Quoted_string (take_buf ())
|
||||
| Template parts ->
|
||||
state := String;
|
||||
begin match add_buf_to_parts parts with
|
||||
| [] -> assert false
|
||||
| [Text s] -> Quoted_string s
|
||||
| parts ->
|
||||
Token.Template
|
||||
{ quoted = true
|
||||
; loc = dummy_loc
|
||||
; parts = List.rev parts
|
||||
}
|
||||
end
|
||||
|
||||
let add_var v =
|
||||
match !state with
|
||||
| String ->
|
||||
state := Template (v :: add_buf_to_parts []);
|
||||
| Template parts ->
|
||||
let parts = add_buf_to_parts parts in
|
||||
state := Template (v::parts)
|
||||
|
||||
let add_text = Buffer.add_string text_buf
|
||||
let add_text_c = Buffer.add_char text_buf
|
||||
end
|
||||
end
|
||||
}
|
||||
|
||||
let comment = ';' [^ '\n' '\r']*
|
||||
|
@ -12,7 +97,8 @@ let blank = [' ' '\t' '\012']
|
|||
let digit = ['0'-'9']
|
||||
let hexdigit = ['0'-'9' 'a'-'f' 'A'-'F']
|
||||
|
||||
let atom_char = [^ '%' ';' '(' ')' '"' '\000'-'\032' '\127'-'\255']
|
||||
let atom_char = [^ ';' '(' ')' '"' '\000'-'\032' '\127'-'\255']
|
||||
let varname_char = atom_char # [ ':' '%' '{' '}' ]
|
||||
|
||||
rule token = parse
|
||||
| newline
|
||||
|
@ -24,17 +110,26 @@ rule token = parse
|
|||
| ')'
|
||||
{ Rparen }
|
||||
| '"'
|
||||
{ Buffer.clear escaped_buf;
|
||||
let start = Lexing.lexeme_start_p lexbuf in
|
||||
let s = start_quoted_string lexbuf in
|
||||
{ let start = Lexing.lexeme_start_p lexbuf in
|
||||
Template.Buffer.new_token ();
|
||||
let token = start_quoted_string lexbuf in
|
||||
lexbuf.lex_start_p <- start;
|
||||
Quoted_string s
|
||||
token
|
||||
}
|
||||
| atom_char+ as s
|
||||
{ Token.Atom (Atom.of_string s) }
|
||||
| _ as c { error lexbuf (Printf.sprintf "Invalid atom character '%c'" c) }
|
||||
| eof
|
||||
{ Eof }
|
||||
| ""
|
||||
{ atom [] (Lexing.lexeme_start_p lexbuf) lexbuf }
|
||||
|
||||
and atom acc start = parse
|
||||
| (atom_char # '%')+ as s
|
||||
{ atom (Template.add_text acc s) start lexbuf }
|
||||
| "%{"
|
||||
{ atom ((template_variable lexbuf) :: acc) start lexbuf }
|
||||
| "%"
|
||||
{ atom (Template.add_text acc "%") start lexbuf }
|
||||
| ""
|
||||
{ Template.token acc ~quoted:false ~start lexbuf }
|
||||
|
||||
and start_quoted_string = parse
|
||||
| "\\|"
|
||||
|
@ -47,7 +142,7 @@ and start_quoted_string = parse
|
|||
and block_string_start kind = parse
|
||||
| newline as s
|
||||
{ Lexing.new_line lexbuf;
|
||||
Buffer.add_string escaped_buf s;
|
||||
Template.Buffer.add_text s;
|
||||
block_string_after_newline lexbuf
|
||||
}
|
||||
| ' '
|
||||
|
@ -56,8 +151,7 @@ and block_string_start kind = parse
|
|||
| Raw -> raw_block_string lexbuf
|
||||
}
|
||||
| eof
|
||||
{ Buffer.contents escaped_buf
|
||||
}
|
||||
{ Template.Buffer.get () }
|
||||
| _
|
||||
{ error lexbuf "There must be at least one space after \"\\|"
|
||||
}
|
||||
|
@ -65,7 +159,7 @@ and block_string_start kind = parse
|
|||
and block_string = parse
|
||||
| newline as s
|
||||
{ Lexing.new_line lexbuf;
|
||||
Buffer.add_string escaped_buf s;
|
||||
Template.Buffer.add_text s;
|
||||
block_string_after_newline lexbuf
|
||||
}
|
||||
| '\\'
|
||||
|
@ -73,12 +167,17 @@ and block_string = parse
|
|||
| Newline -> block_string_after_newline lexbuf
|
||||
| Other -> block_string lexbuf
|
||||
}
|
||||
| "%{" {
|
||||
let var = template_variable lexbuf in
|
||||
Template.Buffer.add_var var;
|
||||
block_string lexbuf
|
||||
}
|
||||
| _ as c
|
||||
{ Buffer.add_char escaped_buf c;
|
||||
{ Template.Buffer.add_text_c c;
|
||||
block_string lexbuf
|
||||
}
|
||||
| eof
|
||||
{ Buffer.contents escaped_buf
|
||||
{ Template.Buffer.get ()
|
||||
}
|
||||
|
||||
and block_string_after_newline = parse
|
||||
|
@ -87,38 +186,42 @@ and block_string_after_newline = parse
|
|||
| blank* "\"\\>"
|
||||
{ block_string_start Raw lexbuf }
|
||||
| ""
|
||||
{ Buffer.contents escaped_buf
|
||||
{ Template.Buffer.get ()
|
||||
}
|
||||
|
||||
and raw_block_string = parse
|
||||
| newline as s
|
||||
{ Lexing.new_line lexbuf;
|
||||
Buffer.add_string escaped_buf s;
|
||||
Template.Buffer.add_text s;
|
||||
block_string_after_newline lexbuf
|
||||
}
|
||||
| _ as c
|
||||
{ Buffer.add_char escaped_buf c;
|
||||
{ Template.Buffer.add_text_c c;
|
||||
raw_block_string lexbuf
|
||||
}
|
||||
| eof
|
||||
{ Buffer.contents escaped_buf
|
||||
{ Template.Buffer.get ()
|
||||
}
|
||||
|
||||
and quoted_string = parse
|
||||
| '"'
|
||||
{ Buffer.contents escaped_buf }
|
||||
{ Template.Buffer.get () }
|
||||
| '\\'
|
||||
{ match escape_sequence lexbuf with
|
||||
| Newline -> quoted_string_after_escaped_newline lexbuf
|
||||
| Other -> quoted_string lexbuf
|
||||
}
|
||||
| "%{"
|
||||
{ Template.Buffer.add_var (template_variable lexbuf);
|
||||
quoted_string lexbuf
|
||||
}
|
||||
| newline as s
|
||||
{ Lexing.new_line lexbuf;
|
||||
Buffer.add_string escaped_buf s;
|
||||
Template.Buffer.add_text s;
|
||||
quoted_string lexbuf
|
||||
}
|
||||
| _ as c
|
||||
{ Buffer.add_char escaped_buf c;
|
||||
{ Template.Buffer.add_text_c c;
|
||||
quoted_string lexbuf
|
||||
}
|
||||
| eof
|
||||
|
@ -129,6 +232,10 @@ and escape_sequence = parse
|
|||
| newline
|
||||
{ Lexing.new_line lexbuf;
|
||||
Newline }
|
||||
| "%{" as s
|
||||
{ Template.Buffer.add_text s;
|
||||
Other
|
||||
}
|
||||
| ['\\' '\'' '"' 'n' 't' 'b' 'r'] as c
|
||||
{ let c =
|
||||
match c with
|
||||
|
@ -138,7 +245,7 @@ and escape_sequence = parse
|
|||
| 't' -> '\t'
|
||||
| _ -> c
|
||||
in
|
||||
Buffer.add_char escaped_buf c;
|
||||
Template.Buffer.add_text_c c;
|
||||
Other
|
||||
}
|
||||
| (digit as c1) (digit as c2) (digit as c3)
|
||||
|
@ -146,7 +253,7 @@ and escape_sequence = parse
|
|||
if v > 255 then
|
||||
error lexbuf "escape sequence in quoted string out of range"
|
||||
~delta:(-1);
|
||||
Buffer.add_char escaped_buf (Char.chr v);
|
||||
Template.Buffer.add_text_c (Char.chr v);
|
||||
Other
|
||||
}
|
||||
| digit digit digit
|
||||
|
@ -157,7 +264,7 @@ and escape_sequence = parse
|
|||
}
|
||||
| 'x' (hexdigit as c1) (hexdigit as c2)
|
||||
{ let v = eval_hex_escape c1 c2 in
|
||||
Buffer.add_char escaped_buf (Char.chr v);
|
||||
Template.Buffer.add_text_c (Char.chr v);
|
||||
Other
|
||||
}
|
||||
| 'x' hexdigit*
|
||||
|
@ -173,3 +280,24 @@ and escape_sequence = parse
|
|||
and quoted_string_after_escaped_newline = parse
|
||||
| [' ' '\t']*
|
||||
{ quoted_string lexbuf }
|
||||
|
||||
and template_variable = parse
|
||||
| (varname_char+ as name) (':' (varname_char* as payload))? '}'
|
||||
{ let payload =
|
||||
match payload with
|
||||
| Some "" -> error lexbuf "payload after : in variable cannot be empty"
|
||||
| p -> p
|
||||
in
|
||||
Template.Var
|
||||
{ loc =
|
||||
{ start = Lexing.lexeme_start_p lexbuf
|
||||
; stop = Lexing.lexeme_end_p lexbuf
|
||||
}
|
||||
; name
|
||||
; payload
|
||||
; syntax = Percent
|
||||
}
|
||||
}
|
||||
| '}' | eof
|
||||
{ error lexbuf "%{...} forms cannot be empty" }
|
||||
| _ { error lexbuf "This character not allowed inside %{...} forms" }
|
||||
|
|
|
@ -0,0 +1,67 @@
|
|||
open Import
|
||||
|
||||
let quote_length s ~syntax =
|
||||
let n = ref 0 in
|
||||
let len = String.length s in
|
||||
for i = 0 to len - 1 do
|
||||
n := !n + (match String.unsafe_get s i with
|
||||
| '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
|
||||
| '%' ->
|
||||
if syntax = Atom.Dune && i + 1 < len && s.[i+1] = '{' then 2 else 1
|
||||
| ' ' .. '~' -> 1
|
||||
| _ -> 4)
|
||||
done;
|
||||
!n
|
||||
|
||||
let escape_to s ~dst:s' ~ofs ~syntax =
|
||||
let n = ref ofs in
|
||||
let len = String.length s in
|
||||
for i = 0 to len - 1 do
|
||||
begin match String.unsafe_get s i with
|
||||
| ('\"' | '\\') as c ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c
|
||||
| '\n' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n'
|
||||
| '\t' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't'
|
||||
| '\r' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r'
|
||||
| '\b' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b'
|
||||
| '%' when syntax = Atom.Dune && i + 1 < len && s.[i + 1] = '{' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n '%'
|
||||
| (' ' .. '~') as c -> Bytes.unsafe_set s' !n c
|
||||
| c ->
|
||||
let a = Char.code c in
|
||||
Bytes.unsafe_set s' !n '\\';
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a / 100));
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + (a / 10) mod 10));
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a mod 10));
|
||||
end;
|
||||
incr n
|
||||
done
|
||||
|
||||
(* Escape [s] if needed. *)
|
||||
let escaped s ~syntax =
|
||||
let n = quote_length s ~syntax in
|
||||
if n = 0 || n > String.length s then
|
||||
let s' = Bytes.create n in
|
||||
escape_to s ~dst:s' ~ofs:0 ~syntax;
|
||||
Bytes.unsafe_to_string s'
|
||||
else s
|
||||
|
||||
(* Surround [s] with quotes, escaping it if necessary. *)
|
||||
let quoted s ~syntax =
|
||||
let len = String.length s in
|
||||
let n = quote_length s ~syntax in
|
||||
let s' = Bytes.create (n + 2) in
|
||||
Bytes.unsafe_set s' 0 '"';
|
||||
if len = 0 || n > len then
|
||||
escape_to s ~dst:s' ~ofs:1 ~syntax
|
||||
else
|
||||
Bytes.blit_string ~src:s ~src_pos:0 ~dst:s' ~dst_pos:1 ~len;
|
||||
Bytes.unsafe_set s' (n + 1) '"';
|
||||
Bytes.unsafe_to_string s'
|
|
@ -0,0 +1,4 @@
|
|||
|
||||
val escaped : string -> syntax:Atom.syntax -> string
|
||||
|
||||
val quoted : string -> syntax:Atom.syntax -> string
|
|
@ -0,0 +1,26 @@
|
|||
(* TODO get rid of this when inverting the deps between stdune and usexp *)
|
||||
|
||||
module List = ListLabels
|
||||
module String = struct
|
||||
include StdLabels.String
|
||||
|
||||
let split_on_char s ~on =
|
||||
let rec loop i j =
|
||||
if j = length s then
|
||||
[sub s ~pos:i ~len:(j - i)]
|
||||
else if s.[j] = on then
|
||||
sub s ~pos:i ~len:(j - i) :: loop (j + 1) (j + 1)
|
||||
else
|
||||
loop i (j + 1)
|
||||
in
|
||||
loop 0 0
|
||||
end
|
||||
|
||||
module Bytes = struct
|
||||
include StdLabels.Bytes
|
||||
|
||||
(* [blit_string] was forgotten from the labeled version in OCaml
|
||||
4.02—4.04. *)
|
||||
let blit_string ~src ~src_pos ~dst ~dst_pos ~len =
|
||||
Bytes.blit_string src src_pos dst dst_pos len
|
||||
end
|
|
@ -6,6 +6,7 @@ module Token : sig
|
|||
| Rparen
|
||||
| Sexp_comment
|
||||
| Eof
|
||||
| Template of Template.t
|
||||
end
|
||||
|
||||
type t = Lexing.lexbuf -> Token.t
|
||||
|
|
|
@ -6,6 +6,7 @@ module Token = struct
|
|||
| Rparen
|
||||
| Sexp_comment
|
||||
| Eof
|
||||
| Template of Template.t
|
||||
end
|
||||
|
||||
type t = Lexing.lexbuf -> Token.t
|
||||
|
|
|
@ -6,6 +6,7 @@ module Token : sig
|
|||
| Rparen
|
||||
| Sexp_comment
|
||||
| Eof
|
||||
| Template of Template.t
|
||||
end
|
||||
|
||||
type t = Lexing.lexbuf -> Token.t
|
||||
|
|
|
@ -0,0 +1,18 @@
|
|||
type t =
|
||||
{ start : Lexing.position
|
||||
; stop : Lexing.position
|
||||
}
|
||||
|
||||
let in_file fn =
|
||||
let pos : Lexing.position =
|
||||
{ pos_fname = fn
|
||||
; pos_lnum = 1
|
||||
; pos_cnum = 0
|
||||
; pos_bol = 0
|
||||
}
|
||||
in
|
||||
{ start = pos
|
||||
; stop = pos
|
||||
}
|
||||
|
||||
let none = in_file "<none>"
|
|
@ -0,0 +1,8 @@
|
|||
type t =
|
||||
{ start : Lexing.position
|
||||
; stop : Lexing.position
|
||||
}
|
||||
|
||||
val in_file : string -> t
|
||||
|
||||
val none : t
|
|
@ -0,0 +1,7 @@
|
|||
include Types.Sexp
|
||||
|
||||
let atom_or_quoted_string s =
|
||||
if Atom.is_valid_dune s then
|
||||
Atom (Atom.of_string s)
|
||||
else
|
||||
Quoted_string s
|
|
@ -0,0 +1,7 @@
|
|||
type t = Types.Sexp.t =
|
||||
| Atom of Atom.t
|
||||
| Quoted_string of string
|
||||
| List of t list
|
||||
| Template of Types.Template.t
|
||||
|
||||
val atom_or_quoted_string : string -> t
|
|
@ -0,0 +1,101 @@
|
|||
open Import
|
||||
|
||||
include Types.Template
|
||||
|
||||
let var_enclosers = function
|
||||
| Percent -> "%{", "}"
|
||||
| Dollar_brace -> "${", "}"
|
||||
| Dollar_paren -> "$(", ")"
|
||||
|
||||
module Pp : sig
|
||||
val to_string : t -> syntax:Atom.syntax -> string
|
||||
end = struct
|
||||
let buf = Buffer.create 16
|
||||
|
||||
let add_var { loc = _; syntax; name; payload } =
|
||||
let before, after = var_enclosers syntax in
|
||||
Buffer.add_string buf before;
|
||||
Buffer.add_string buf name;
|
||||
begin match payload with
|
||||
| None -> ()
|
||||
| Some payload ->
|
||||
Buffer.add_char buf ':';
|
||||
Buffer.add_string buf payload
|
||||
end;
|
||||
Buffer.add_string buf after
|
||||
|
||||
(* TODO use the loc for the error *)
|
||||
let check_valid_unquoted s ~syntax ~loc:_ =
|
||||
if not (Atom.is_valid (Atom.of_string s) syntax) then
|
||||
Printf.ksprintf invalid_arg "Invalid text %S in unquoted template" s
|
||||
|
||||
let to_string { parts; quoted; loc } ~syntax =
|
||||
Buffer.clear buf;
|
||||
if quoted then Buffer.add_char buf '"';
|
||||
let commit_text s =
|
||||
if s = "" then
|
||||
()
|
||||
else if not quoted then begin
|
||||
check_valid_unquoted ~loc ~syntax s;
|
||||
Buffer.add_string buf s
|
||||
end else
|
||||
Buffer.add_string buf (Escape.escaped ~syntax s)
|
||||
in
|
||||
let rec add_parts acc_text = function
|
||||
| [] ->
|
||||
commit_text acc_text
|
||||
| Text s :: rest ->
|
||||
add_parts (if acc_text = "" then s else acc_text ^ s) rest
|
||||
| Var v :: rest ->
|
||||
commit_text acc_text;
|
||||
add_var v;
|
||||
add_parts "" rest
|
||||
in
|
||||
add_parts "" parts;
|
||||
if quoted then Buffer.add_char buf '"';
|
||||
Buffer.contents buf
|
||||
end
|
||||
|
||||
let to_string = Pp.to_string
|
||||
|
||||
let string_of_var { loc = _; syntax; name; payload } =
|
||||
let before, after = var_enclosers syntax in
|
||||
match payload with
|
||||
| None -> before ^ name ^ after
|
||||
| Some p -> before ^ name ^ ":" ^ p ^ after
|
||||
|
||||
let pp syntax ppf t =
|
||||
Format.pp_print_string ppf (Pp.to_string ~syntax t)
|
||||
|
||||
let pp_split_strings ppf (t : t) =
|
||||
let syntax = Atom.Dune in
|
||||
if t.quoted || List.exists t.parts ~f:(function
|
||||
| Text s -> String.contains s '\n'
|
||||
| Var _ -> false) then begin
|
||||
List.iter t.parts ~f:(function
|
||||
| Var s ->
|
||||
Format.pp_print_string ppf (string_of_var s)
|
||||
| Text s ->
|
||||
begin match String.split_on_char s ~on:'\n' with
|
||||
| [] -> assert false
|
||||
| [s] -> Format.pp_print_string ppf (Escape.escaped ~syntax s)
|
||||
| split ->
|
||||
Format.pp_print_list
|
||||
~pp_sep:(fun ppf () -> Format.fprintf ppf "@,\\n")
|
||||
Format.pp_print_string ppf
|
||||
split
|
||||
end
|
||||
);
|
||||
Format.fprintf ppf "@}\"@]"
|
||||
end
|
||||
else
|
||||
pp syntax ppf t
|
||||
|
||||
let remove_locs t =
|
||||
{ t with
|
||||
loc = Loc.none
|
||||
; parts =
|
||||
List.map t.parts ~f:(function
|
||||
| Var v -> Var { v with loc = Loc.none }
|
||||
| Text _ as s -> s)
|
||||
}
|
|
@ -0,0 +1,30 @@
|
|||
type var_syntax = Types.Template.var_syntax =
|
||||
| Dollar_brace
|
||||
| Dollar_paren
|
||||
| Percent
|
||||
|
||||
type var = Types.Template.var =
|
||||
{ loc: Loc.t
|
||||
; name: string
|
||||
; payload: string option
|
||||
; syntax: var_syntax
|
||||
}
|
||||
|
||||
type part = Types.Template.part =
|
||||
| Text of string
|
||||
| Var of var
|
||||
|
||||
type t = Types.Template.t =
|
||||
{ quoted: bool
|
||||
; parts: part list
|
||||
; loc: Loc.t
|
||||
}
|
||||
|
||||
val to_string : t -> syntax:Atom.syntax -> string
|
||||
val string_of_var : var -> string
|
||||
|
||||
val pp : Atom.syntax -> Format.formatter -> t -> unit
|
||||
|
||||
val pp_split_strings : Format.formatter -> t -> unit
|
||||
|
||||
val remove_locs : t -> t
|
|
@ -0,0 +1,28 @@
|
|||
module Template = struct
|
||||
type var_syntax = Dollar_brace | Dollar_paren | Percent
|
||||
|
||||
type var =
|
||||
{ loc: Loc.t
|
||||
; name: string
|
||||
; payload: string option
|
||||
; syntax: var_syntax
|
||||
}
|
||||
|
||||
type part =
|
||||
| Text of string
|
||||
| Var of var
|
||||
|
||||
type t =
|
||||
{ quoted: bool
|
||||
; parts: part list
|
||||
; loc: Loc.t
|
||||
}
|
||||
end
|
||||
|
||||
module Sexp = struct
|
||||
type t =
|
||||
| Atom of Atom.t
|
||||
| Quoted_string of string
|
||||
| List of t list
|
||||
| Template of Template.t
|
||||
end
|
|
@ -1,140 +1,59 @@
|
|||
module UnlabeledBytes = Bytes
|
||||
open StdLabels
|
||||
|
||||
module Bytes = struct
|
||||
include StdLabels.Bytes
|
||||
|
||||
(* [blit_string] was forgotten from the labeled version in OCaml
|
||||
4.02—4.04. *)
|
||||
let blit_string ~src ~src_pos ~dst ~dst_pos ~len =
|
||||
UnlabeledBytes.blit_string src src_pos dst dst_pos len
|
||||
end
|
||||
open Import
|
||||
|
||||
module Loc = Loc
|
||||
module Atom = Atom
|
||||
module Template = Template
|
||||
|
||||
type t =
|
||||
| Atom of Atom.t
|
||||
| Quoted_string of string
|
||||
| List of t list
|
||||
type syntax = Atom.syntax = Jbuild | Dune
|
||||
|
||||
type sexp = t
|
||||
include Sexp
|
||||
|
||||
let atom s = Atom (Atom.of_string s)
|
||||
|
||||
let unsafe_atom_of_string s = atom s
|
||||
|
||||
let atom_or_quoted_string s =
|
||||
if Atom.is_valid_dune s then
|
||||
Atom (Atom.of_string s)
|
||||
else
|
||||
Quoted_string s
|
||||
let rec to_string t ~syntax =
|
||||
match t with
|
||||
| Atom a -> Atom.print a syntax
|
||||
| Quoted_string s -> Escape.quoted s ~syntax
|
||||
| List l ->
|
||||
Printf.sprintf "(%s)" (List.map l ~f:(to_string ~syntax)
|
||||
|> String.concat ~sep:" ")
|
||||
| Template t -> Template.to_string t ~syntax
|
||||
|
||||
let quote_length s =
|
||||
let n = ref 0 in
|
||||
for i = 0 to String.length s - 1 do
|
||||
n := !n + (match String.unsafe_get s i with
|
||||
| '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
|
||||
| ' ' .. '~' -> 1
|
||||
| _ -> 4)
|
||||
done;
|
||||
!n
|
||||
|
||||
let escape_to s ~dst:s' ~ofs =
|
||||
let n = ref ofs in
|
||||
for i = 0 to String.length s - 1 do
|
||||
begin match String.unsafe_get s i with
|
||||
| ('\"' | '\\') as c ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c
|
||||
| '\n' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n'
|
||||
| '\t' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't'
|
||||
| '\r' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r'
|
||||
| '\b' ->
|
||||
Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b'
|
||||
| (' ' .. '~') as c -> Bytes.unsafe_set s' !n c
|
||||
| c ->
|
||||
let a = Char.code c in
|
||||
Bytes.unsafe_set s' !n '\\';
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a / 100));
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + (a / 10) mod 10));
|
||||
incr n;
|
||||
Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a mod 10));
|
||||
end;
|
||||
incr n
|
||||
done
|
||||
|
||||
(* Escape [s] if needed. *)
|
||||
let escaped s =
|
||||
let n = quote_length s in
|
||||
if n = 0 || n > String.length s then
|
||||
let s' = Bytes.create n in
|
||||
escape_to s ~dst:s' ~ofs:0;
|
||||
Bytes.unsafe_to_string s'
|
||||
else s
|
||||
|
||||
(* Surround [s] with quotes, escaping it if necessary. *)
|
||||
let quoted s =
|
||||
let len = String.length s in
|
||||
let n = quote_length s in
|
||||
let s' = Bytes.create (n + 2) in
|
||||
Bytes.unsafe_set s' 0 '"';
|
||||
if len = 0 || n > len then
|
||||
escape_to s ~dst:s' ~ofs:1
|
||||
else
|
||||
Bytes.blit_string ~src:s ~src_pos:0 ~dst:s' ~dst_pos:1 ~len;
|
||||
Bytes.unsafe_set s' (n + 1) '"';
|
||||
Bytes.unsafe_to_string s'
|
||||
|
||||
let rec to_string = function
|
||||
| Atom a -> Atom.print a Atom.Dune
|
||||
| Quoted_string s -> quoted s
|
||||
| List l -> Printf.sprintf "(%s)" (List.map l ~f:to_string |> String.concat ~sep:" ")
|
||||
|
||||
let rec pp ppf = function
|
||||
let rec pp syntax ppf = function
|
||||
| Atom s ->
|
||||
Format.pp_print_string ppf (Atom.print s Atom.Dune)
|
||||
Format.pp_print_string ppf (Atom.print s syntax)
|
||||
| Quoted_string s ->
|
||||
Format.pp_print_string ppf (quoted s)
|
||||
Format.pp_print_string ppf (Escape.quoted ~syntax s)
|
||||
| List [] ->
|
||||
Format.pp_print_string ppf "()"
|
||||
| List (first :: rest) ->
|
||||
Format.pp_open_box ppf 1;
|
||||
Format.pp_print_string ppf "(";
|
||||
Format.pp_open_hvbox ppf 0;
|
||||
pp ppf first;
|
||||
pp syntax ppf first;
|
||||
List.iter rest ~f:(fun sexp ->
|
||||
Format.pp_print_space ppf ();
|
||||
pp ppf sexp);
|
||||
pp syntax ppf sexp);
|
||||
Format.pp_close_box ppf ();
|
||||
Format.pp_print_string ppf ")";
|
||||
Format.pp_close_box ppf ()
|
||||
|
||||
let split_string s ~on =
|
||||
let rec loop i j =
|
||||
if j = String.length s then
|
||||
[String.sub s ~pos:i ~len:(j - i)]
|
||||
else if s.[j] = on then
|
||||
String.sub s ~pos:i ~len:(j - i) :: loop (j + 1) (j + 1)
|
||||
else
|
||||
loop i (j + 1)
|
||||
in
|
||||
loop 0 0
|
||||
| Template t -> Template.pp syntax ppf t
|
||||
|
||||
let pp_print_quoted_string ppf s =
|
||||
let syntax = Dune in
|
||||
if String.contains s '\n' then begin
|
||||
match split_string s ~on:'\n' with
|
||||
| [] -> Format.pp_print_string ppf (quoted s)
|
||||
match String.split_on_char s ~on:'\n' with
|
||||
| [] -> Format.pp_print_string ppf (Escape.quoted ~syntax s)
|
||||
| first :: rest ->
|
||||
Format.fprintf ppf "@[<hv 1>\"@{<atom>%s" (escaped first);
|
||||
Format.fprintf ppf "@[<hv 1>\"@{<atom>%s"
|
||||
(Escape.escaped ~syntax first);
|
||||
List.iter rest ~f:(fun s ->
|
||||
Format.fprintf ppf "@,\\n%s" (escaped s));
|
||||
Format.fprintf ppf "@,\\n%s" (Escape.escaped ~syntax s));
|
||||
Format.fprintf ppf "@}\"@]"
|
||||
end else
|
||||
Format.pp_print_string ppf (quoted s)
|
||||
Format.pp_print_string ppf (Escape.quoted ~syntax s)
|
||||
|
||||
let rec pp_split_strings ppf = function
|
||||
| Atom s -> Format.pp_print_string ppf (Atom.print s Atom.Dune)
|
||||
|
@ -152,6 +71,7 @@ let rec pp_split_strings ppf = function
|
|||
Format.pp_close_box ppf ();
|
||||
Format.pp_print_string ppf ")";
|
||||
Format.pp_close_box ppf ()
|
||||
| Template t -> Template.pp_split_strings ppf t
|
||||
|
||||
type formatter_state =
|
||||
| In_atom
|
||||
|
@ -196,40 +116,26 @@ let prepare_formatter ppf =
|
|||
| _ -> n))
|
||||
}
|
||||
|
||||
module Loc = struct
|
||||
type t =
|
||||
{ start : Lexing.position
|
||||
; stop : Lexing.position
|
||||
}
|
||||
|
||||
let in_file fn =
|
||||
let pos : Lexing.position =
|
||||
{ pos_fname = fn
|
||||
; pos_lnum = 1
|
||||
; pos_cnum = 0
|
||||
; pos_bol = 0
|
||||
}
|
||||
in
|
||||
{ start = pos
|
||||
; stop = pos
|
||||
}
|
||||
end
|
||||
|
||||
module Ast = struct
|
||||
type t =
|
||||
| Atom of Loc.t * Atom.t
|
||||
| Quoted_string of Loc.t * string
|
||||
| Template of Template.t
|
||||
| List of Loc.t * t list
|
||||
|
||||
let atom_or_quoted_string loc s =
|
||||
match atom_or_quoted_string s with
|
||||
match Sexp.atom_or_quoted_string s with
|
||||
| Atom a -> Atom (loc, a)
|
||||
| Quoted_string s -> Quoted_string (loc, s)
|
||||
| Template _
|
||||
| List _ -> assert false
|
||||
|
||||
let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)) = loc
|
||||
let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)
|
||||
| Template { loc ; _ }) = loc
|
||||
|
||||
let rec remove_locs : t -> sexp = function
|
||||
let rec remove_locs t : Sexp.t =
|
||||
match t with
|
||||
| Template t -> Template (Template.remove_locs t)
|
||||
| Atom (_, s) -> Atom s
|
||||
| Quoted_string (_, s) -> Quoted_string s
|
||||
| List (_, l) -> List (List.map l ~f:remove_locs)
|
||||
|
@ -240,6 +146,7 @@ let rec add_loc t ~loc : Ast.t =
|
|||
| Atom s -> Atom (loc, s)
|
||||
| Quoted_string s -> Quoted_string (loc, s)
|
||||
| List l -> List (loc, List.map l ~f:(add_loc ~loc))
|
||||
| Template t -> Template { t with loc }
|
||||
|
||||
module Parse_error = struct
|
||||
include Lexer.Error
|
||||
|
@ -298,6 +205,9 @@ module Parser = struct
|
|||
| Quoted_string s ->
|
||||
let loc = make_loc lexbuf in
|
||||
loop depth lexer lexbuf (Quoted_string (loc, s) :: acc)
|
||||
| Template t ->
|
||||
let loc = make_loc lexbuf in
|
||||
loop depth lexer lexbuf (Template { t with loc } :: acc)
|
||||
| Lparen ->
|
||||
let start = Lexing.lexeme_start_p lexbuf in
|
||||
let sexps = loop (depth + 1) lexer lexbuf [] in
|
||||
|
|
|
@ -2,11 +2,11 @@
|
|||
|
||||
This library is internal to jbuilder and guarantees no API stability.*)
|
||||
|
||||
type syntax = Jbuild | Dune
|
||||
|
||||
module Atom : sig
|
||||
type t = private A of string [@@unboxed]
|
||||
|
||||
type syntax = Jbuild | Dune
|
||||
|
||||
val is_valid : t -> syntax -> bool
|
||||
|
||||
val of_string : string -> t
|
||||
|
@ -26,6 +26,31 @@ module Loc : sig
|
|||
}
|
||||
|
||||
val in_file : string -> t
|
||||
|
||||
val none : t
|
||||
end
|
||||
|
||||
module Template : sig
|
||||
type var_syntax = Dollar_brace | Dollar_paren | Percent
|
||||
|
||||
type var =
|
||||
{ loc: Loc.t
|
||||
; name: string
|
||||
; payload: string option
|
||||
; syntax: var_syntax
|
||||
}
|
||||
|
||||
type part =
|
||||
| Text of string
|
||||
| Var of var
|
||||
|
||||
type t =
|
||||
{ quoted: bool
|
||||
; parts: part list
|
||||
; loc: Loc.t
|
||||
}
|
||||
|
||||
val string_of_var : var -> string
|
||||
end
|
||||
|
||||
(** The S-expression type *)
|
||||
|
@ -33,6 +58,7 @@ type t =
|
|||
| Atom of Atom.t
|
||||
| Quoted_string of string
|
||||
| List of t list
|
||||
| Template of Template.t
|
||||
|
||||
val atom : string -> t
|
||||
(** [atom s] convert the string [s] to an Atom.
|
||||
|
@ -43,13 +69,13 @@ val atom_or_quoted_string : string -> t
|
|||
val unsafe_atom_of_string : string -> t
|
||||
|
||||
(** Serialize a S-expression *)
|
||||
val to_string : t -> string
|
||||
val to_string : t -> syntax:syntax -> string
|
||||
|
||||
(** Serialize a S-expression using indentation to improve readability *)
|
||||
val pp : Format.formatter -> t -> unit
|
||||
val pp : syntax -> Format.formatter -> t -> unit
|
||||
|
||||
(** Same as [pp], but split long strings. The formatter must have been
|
||||
prepared with [prepare_formatter]. *)
|
||||
(** Same as [pp ~syntax:Dune], but split long strings. The formatter
|
||||
must have been prepared with [prepare_formatter]. *)
|
||||
val pp_split_strings : Format.formatter -> t -> unit
|
||||
|
||||
(** Prepare a formatter for [pp_split_strings]. Additionaly the
|
||||
|
@ -63,6 +89,7 @@ module Ast : sig
|
|||
type t =
|
||||
| Atom of Loc.t * Atom.t
|
||||
| Quoted_string of Loc.t * string
|
||||
| Template of Template.t
|
||||
| List of Loc.t * t list
|
||||
|
||||
val atom_or_quoted_string : Loc.t -> string -> t
|
||||
|
@ -85,17 +112,7 @@ end
|
|||
exception Parse_error of Parse_error.t
|
||||
|
||||
module Lexer : sig
|
||||
module Token : sig
|
||||
type t =
|
||||
| Atom of Atom.t
|
||||
| Quoted_string of string
|
||||
| Lparen
|
||||
| Rparen
|
||||
| Sexp_comment (** "#;", only used in the jbuild syntax *)
|
||||
| Eof
|
||||
end
|
||||
|
||||
type t = Lexing.lexbuf -> Token.t
|
||||
type t
|
||||
|
||||
val token : t
|
||||
val jbuild_token : t
|
||||
|
|
|
@ -52,7 +52,7 @@ struct
|
|||
|
||||
let id = Id.create ()
|
||||
|
||||
let to_string path x = To_sexp.t path x |> Sexp.to_string
|
||||
let to_string path x = To_sexp.t path x |> Sexp.to_string ~syntax:Dune
|
||||
|
||||
let load path =
|
||||
Of_sexp.t path (Io.Sexp.load path ~mode:Single)
|
||||
|
|
|
@ -22,7 +22,7 @@
|
|||
(rule
|
||||
(targets dune.inc.gen)
|
||||
(deps (source_tree test-cases))
|
||||
(action (with-stdout-to ${@} (run ./gen_tests.exe))))
|
||||
(action (with-stdout-to %{@} (run ./gen_tests.exe))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/aliases
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name bad-alias-error)
|
||||
|
@ -12,7 +12,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/bad-alias-error
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name block-strings)
|
||||
|
@ -20,7 +20,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/block-strings
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name byte-code-only)
|
||||
|
@ -28,7 +28,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/byte-code-only
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name c-stubs)
|
||||
|
@ -36,7 +36,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/c-stubs
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name configurator)
|
||||
|
@ -45,7 +45,7 @@
|
|||
(chdir
|
||||
test-cases/configurator
|
||||
(progn
|
||||
(run ${exe:cram.exe} -skip-platforms win -test run.t)
|
||||
(run %{exe:cram.exe} -skip-platforms win -test run.t)
|
||||
(diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
|
@ -54,7 +54,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/copy_files
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name cross-compilation)
|
||||
|
@ -62,7 +62,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/cross-compilation
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name custom-build-dir)
|
||||
|
@ -70,7 +70,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/custom-build-dir
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name depend-on-the-universe)
|
||||
|
@ -78,7 +78,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/depend-on-the-universe
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name dune-ppx-driver-system)
|
||||
|
@ -86,7 +86,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/dune-ppx-driver-system
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name dune-project-edition)
|
||||
|
@ -94,7 +94,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/dune-project-edition
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name env)
|
||||
|
@ -102,7 +102,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/env
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name exclude-missing-module)
|
||||
|
@ -110,7 +110,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/exclude-missing-module
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name exec-cmd)
|
||||
|
@ -118,7 +118,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/exec-cmd
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name findlib)
|
||||
|
@ -126,7 +126,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/findlib
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name force-test)
|
||||
|
@ -134,7 +134,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/force-test
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name gen-opam-install-file)
|
||||
|
@ -142,7 +142,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/gen-opam-install-file
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name github20)
|
||||
|
@ -150,7 +150,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/github20
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name github24)
|
||||
|
@ -158,7 +158,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/github24
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name github25)
|
||||
|
@ -169,7 +169,7 @@
|
|||
./findlib-packages
|
||||
(chdir
|
||||
test-cases/github25
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
|
||||
|
||||
(alias
|
||||
(name github534)
|
||||
|
@ -177,7 +177,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/github534
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name github568)
|
||||
|
@ -185,7 +185,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/github568
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name github597)
|
||||
|
@ -193,7 +193,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/github597
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name github644)
|
||||
|
@ -201,7 +201,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/github644
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name github660)
|
||||
|
@ -209,7 +209,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/github660
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name github717-odoc-index)
|
||||
|
@ -218,7 +218,7 @@
|
|||
(chdir
|
||||
test-cases/github717-odoc-index
|
||||
(progn
|
||||
(run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t)
|
||||
(run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t)
|
||||
(diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
|
@ -227,7 +227,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/github734
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name github759)
|
||||
|
@ -235,7 +235,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/github759
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name github761)
|
||||
|
@ -243,7 +243,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/github761
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name github764)
|
||||
|
@ -252,7 +252,7 @@
|
|||
(chdir
|
||||
test-cases/github764
|
||||
(progn
|
||||
(run ${exe:cram.exe} -skip-platforms win -test run.t)
|
||||
(run %{exe:cram.exe} -skip-platforms win -test run.t)
|
||||
(diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
|
@ -261,7 +261,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/github784
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name ignored_subdirs)
|
||||
|
@ -269,7 +269,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/ignored_subdirs
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name include-loop)
|
||||
|
@ -277,7 +277,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/include-loop
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name inline_tests)
|
||||
|
@ -285,7 +285,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/inline_tests
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name installable-dup-private-libs)
|
||||
|
@ -293,7 +293,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/installable-dup-private-libs
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name intf-only)
|
||||
|
@ -301,7 +301,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/intf-only
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name js_of_ocaml)
|
||||
|
@ -309,10 +309,10 @@
|
|||
(action
|
||||
(setenv
|
||||
NODE
|
||||
${bin:node}
|
||||
%{bin:node}
|
||||
(chdir
|
||||
test-cases/js_of_ocaml
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
|
||||
|
||||
(alias
|
||||
(name lib-available)
|
||||
|
@ -320,7 +320,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/lib-available
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name link-deps)
|
||||
|
@ -328,7 +328,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/link-deps
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name loop)
|
||||
|
@ -336,7 +336,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/loop
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name menhir)
|
||||
|
@ -344,7 +344,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/menhir
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name merlin-tests)
|
||||
|
@ -352,7 +352,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/merlin-tests
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name meta-gen)
|
||||
|
@ -360,7 +360,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/meta-gen
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name misc)
|
||||
|
@ -368,7 +368,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/misc
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name multiple-private-libs)
|
||||
|
@ -377,7 +377,7 @@
|
|||
(chdir
|
||||
test-cases/multiple-private-libs
|
||||
(progn
|
||||
(run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t)
|
||||
(run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t)
|
||||
(diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
|
@ -386,7 +386,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/no-installable-mode
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name null-dep)
|
||||
|
@ -394,7 +394,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/null-dep
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name ocaml-syntax)
|
||||
|
@ -402,7 +402,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/ocaml-syntax
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name ocamldep-multi-stanzas)
|
||||
|
@ -410,7 +410,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/ocamldep-multi-stanzas
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name odoc)
|
||||
|
@ -419,7 +419,7 @@
|
|||
(chdir
|
||||
test-cases/odoc
|
||||
(progn
|
||||
(run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t)
|
||||
(run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t)
|
||||
(diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
|
@ -429,7 +429,7 @@
|
|||
(chdir
|
||||
test-cases/odoc-unique-mlds
|
||||
(progn
|
||||
(run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t)
|
||||
(run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t)
|
||||
(diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
|
@ -440,7 +440,7 @@
|
|||
test-cases/output-obj
|
||||
(progn
|
||||
(run
|
||||
${exe:cram.exe}
|
||||
%{exe:cram.exe}
|
||||
-skip-versions
|
||||
<4.06.0
|
||||
-skip-platforms
|
||||
|
@ -455,7 +455,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/package-dep
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name ppx-rewriter)
|
||||
|
@ -464,7 +464,7 @@
|
|||
(chdir
|
||||
test-cases/ppx-rewriter
|
||||
(progn
|
||||
(run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t)
|
||||
(run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t)
|
||||
(diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
|
@ -473,7 +473,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/private-public-overlap
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name promote)
|
||||
|
@ -481,7 +481,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/promote
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name quoting)
|
||||
|
@ -489,7 +489,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/quoting
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name reason)
|
||||
|
@ -497,7 +497,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/reason
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name redirections)
|
||||
|
@ -505,7 +505,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/redirections
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name scope-bug)
|
||||
|
@ -513,7 +513,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/scope-bug
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name scope-ppx-bug)
|
||||
|
@ -521,7 +521,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/scope-ppx-bug
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name select)
|
||||
|
@ -529,7 +529,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/select
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name syntax-versioning)
|
||||
|
@ -537,7 +537,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/syntax-versioning
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name use-meta)
|
||||
|
@ -545,7 +545,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/use-meta
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name utop)
|
||||
|
@ -553,7 +553,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/utop
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name windows-diff)
|
||||
|
@ -561,7 +561,7 @@
|
|||
(action
|
||||
(chdir
|
||||
test-cases/windows-diff
|
||||
(progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
(progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
|
|
|
@ -12,6 +12,10 @@ module Sexp = struct
|
|||
|
||||
let constr name args =
|
||||
Usexp.List (Usexp.atom name :: args)
|
||||
|
||||
let parse s =
|
||||
Usexp.parse_string ~fname:"gen_tests.ml" ~mode:Single s
|
||||
|> Usexp.Ast.remove_locs
|
||||
end
|
||||
|
||||
let alias ?action name ~deps =
|
||||
|
@ -26,7 +30,7 @@ let alias ?action name ~deps =
|
|||
module Test = struct
|
||||
type t =
|
||||
{ name : string
|
||||
; env : (string * string) option
|
||||
; env : (string * Usexp.t) option
|
||||
; skip_ocaml : string option
|
||||
; skip_platforms : Platform.t list
|
||||
; enabled : bool
|
||||
|
@ -59,10 +63,13 @@ module Test = struct
|
|||
; atom (sprintf "test-cases/%s" t.name)
|
||||
; List
|
||||
[ atom "progn"
|
||||
; Sexp.strings (["run"; "${exe:cram.exe}"]
|
||||
@ skip_version
|
||||
@ skip_platforms
|
||||
@ ["-test"; "run.t"])
|
||||
; Usexp.List
|
||||
([ atom "run"
|
||||
; Sexp.parse "%{exe:cram.exe}" ]
|
||||
@ (List.map ~f:Usexp.atom_or_quoted_string
|
||||
(skip_version
|
||||
@ skip_platforms
|
||||
@ ["-test"; "run.t"])))
|
||||
; Sexp.strings ["diff?"; "run.t"; "run.t.corrected"]
|
||||
]
|
||||
|
||||
|
@ -74,7 +81,7 @@ module Test = struct
|
|||
| Some (k, v) ->
|
||||
List [ atom "setenv"
|
||||
; atom_or_quoted_string k
|
||||
; atom_or_quoted_string v
|
||||
; v
|
||||
; action ] in
|
||||
alias t.name
|
||||
~deps:(
|
||||
|
@ -83,14 +90,15 @@ module Test = struct
|
|||
; sprintf "test-cases/%s" t.name]
|
||||
]
|
||||
) ~action
|
||||
|> Usexp.pp fmt
|
||||
|> Usexp.pp Dune fmt
|
||||
end
|
||||
|
||||
let exclusions =
|
||||
let open Test in
|
||||
let odoc = make ~external_deps:true ~skip_ocaml:"4.02.3" in
|
||||
[ make "js_of_ocaml" ~external_deps:true ~js:true ~env:("NODE", "${bin:node}")
|
||||
; make "github25" ~env:("OCAMLPATH", "./findlib-packages")
|
||||
[ make "js_of_ocaml" ~external_deps:true ~js:true
|
||||
~env:("NODE", Sexp.parse "%{bin:node}")
|
||||
; make "github25" ~env:("OCAMLPATH", Usexp.atom "./findlib-packages")
|
||||
; odoc "odoc"
|
||||
; odoc "odoc-unique-mlds"
|
||||
; odoc "github717-odoc-index"
|
||||
|
@ -122,7 +130,7 @@ let pp_group fmt (name, tests) =
|
|||
alias name ~deps:(
|
||||
(List.map tests ~f:(fun (t : Test.t) ->
|
||||
Sexp.strings ["alias"; t.name])))
|
||||
|> Usexp.pp fmt
|
||||
|> Usexp.pp Dune fmt
|
||||
|
||||
let () =
|
||||
let tests = Lazy.force all_tests in
|
||||
|
|
|
@ -1,3 +1,3 @@
|
|||
(alias
|
||||
(name x)
|
||||
(action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n"))))
|
||||
(action (chdir %{ROOT} (echo "running in %{path-no-dep:.}\n"))))
|
||||
|
|
|
@ -1,3 +1,3 @@
|
|||
(alias
|
||||
(name x)
|
||||
(action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n"))))
|
||||
(action (chdir %{ROOT} (echo "running in %{path-no-dep:.}\n"))))
|
||||
|
|
|
@ -1,3 +1,3 @@
|
|||
(alias
|
||||
(name x)
|
||||
(action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n"))))
|
||||
(action (chdir %{ROOT} (echo "running in %{path-no-dep:.}\n"))))
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
|
||||
(rule
|
||||
(targets dummy.ml)
|
||||
(action (with-stdout-to ${@} (echo ""))))
|
||||
(action (with-stdout-to %{@} (echo ""))))
|
||||
|
||||
(library
|
||||
(name foo)
|
||||
|
@ -19,4 +19,4 @@
|
|||
(alias
|
||||
(name bar-source)
|
||||
(deps bar.h)
|
||||
(action (echo "${read:bar.h}")))
|
||||
(action (echo "%{read:bar.h}")))
|
||||
|
|
|
@ -4,4 +4,4 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps f.exe)
|
||||
(action (run ${<})))
|
||||
(action (run %{<})))
|
||||
|
|
|
@ -25,7 +25,7 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps foo.install)
|
||||
(action (echo "${read:foo.install}")))
|
||||
(action (echo "%{read:foo.install}")))
|
||||
|
||||
(documentation
|
||||
(mld_files (doc)))
|
||||
|
|
|
@ -6,5 +6,5 @@
|
|||
(deps (glob_files optional.ml)
|
||||
(glob_files *optional.ml))
|
||||
(action
|
||||
(with-stdout-to ${@}
|
||||
(with-stdout-to %{@}
|
||||
(run echo "let () = print_endline \"Hello World\""))))
|
||||
|
|
|
@ -8,7 +8,7 @@
|
|||
(name runtest)
|
||||
(package lib1)
|
||||
(deps test1.exe)
|
||||
(action (run ${<})))
|
||||
(action (run %{<})))
|
||||
|
||||
(executable
|
||||
(name test1)
|
||||
|
@ -25,7 +25,7 @@
|
|||
(name runtest)
|
||||
(package lib2)
|
||||
(deps test2.exe)
|
||||
(action (run ${<})))
|
||||
(action (run %{<})))
|
||||
|
||||
(executable
|
||||
(name test2)
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps main.exe)
|
||||
(action (run ${<})))
|
||||
(action (run %{<})))
|
||||
|
||||
(executable (name main))
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps main.exe)
|
||||
(action (run ${<})))
|
||||
(action (run %{<})))
|
||||
|
||||
(executable (name main))
|
||||
|
|
|
@ -1 +1 @@
|
|||
(rule (run ${bin:echo} foo))
|
||||
(rule (run %{bin:echo} foo))
|
|
@ -11,8 +11,8 @@
|
|||
(echo "let () = print_int 42")
|
||||
(echo "\n")
|
||||
(echo "let () = print_int 43;;")))
|
||||
(flags (inline-test-runner ${library-name}
|
||||
-source-tree-root ${ROOT} -diff-cmd -))))
|
||||
(flags (inline-test-runner %{library-name}
|
||||
-source-tree-root %{ROOT} -diff-cmd -))))
|
||||
|
||||
(library
|
||||
(name foo_tests)
|
||||
|
@ -21,4 +21,4 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps foo.dune)
|
||||
(action (echo "${read:foo.dune}")))
|
||||
(action (echo "%{read:foo.dune}")))
|
||||
|
|
|
@ -28,9 +28,9 @@
|
|||
((runner_libraries (str))
|
||||
(flags
|
||||
(inline-test-runner
|
||||
${library-name}
|
||||
%{library-name}
|
||||
-source-tree-root
|
||||
${ROOT}
|
||||
%{ROOT}
|
||||
-diff-cmd
|
||||
-))
|
||||
(generate_runner
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
(name backend_simple)
|
||||
(modules ())
|
||||
(inline_tests.backend
|
||||
(generate_runner (run sed "s/(\\*TEST:\\(.*\\)\\*)/let () = \\1;;/" ${impl-files})
|
||||
(generate_runner (run sed "s/(\\*TEST:\\(.*\\)\\*)/let () = \\1;;/" %{impl-files})
|
||||
)))
|
||||
|
||||
(library
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(action (system "${lib-available:unix}")))
|
||||
(action (system "%{lib-available:unix}")))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
(action (system "${lib-available:library-that-surely-doesnt-exist} && exit 1 || exit 0")))
|
||||
(action (system "%{lib-available:library-that-surely-doesnt-exist} && exit 1 || exit 0")))
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
(rule (copy ${read:x} a))
|
||||
(rule (copy ${read:y} b))
|
||||
(rule (copy %{read:x} a))
|
||||
(rule (copy %{read:y} b))
|
||||
|
||||
(rule (progn (run true) (with-stdout-to x (echo b))))
|
||||
(rule (progn (run true) (with-stdout-to y (echo a))))
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
(alias
|
||||
(name print-merlins)
|
||||
(deps lib/.merlin exe/.merlin)
|
||||
(action (run ./sanitize-dot-merlin/sanitize_dot_merlin.exe ${^})))
|
||||
(action (run ./sanitize-dot-merlin/sanitize_dot_merlin.exe %{^})))
|
||||
|
|
|
@ -43,4 +43,4 @@
|
|||
|
||||
(alias
|
||||
(name runtest)
|
||||
(action (echo "${read:META.foobar}")))
|
||||
(action (echo "%{read:META.foobar}")))
|
||||
|
|
|
@ -1,3 +1,3 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps ${SCOPE_ROOT}/023e1a58-4d08-11e7-a041-aa000008c8a6))
|
||||
(deps %{SCOPE_ROOT}/023e1a58-4d08-11e7-a041-aa000008c8a6))
|
||||
|
|
|
@ -1,17 +1,17 @@
|
|||
;; Test for ${^} with globs in rules
|
||||
;; Test for %{^} with globs in rules
|
||||
|
||||
(rule
|
||||
(targets result expected)
|
||||
(deps dune (glob_files *.txt))
|
||||
(action (progn
|
||||
(with-stdout-to result (echo ${^}))
|
||||
(with-stdout-to result (echo %{^}))
|
||||
(with-stdout-to expected (echo "dune a.txt b.txt c.txt")))))
|
||||
|
||||
(rule
|
||||
(targets result2 expected2)
|
||||
(deps (source_tree sub-tree))
|
||||
(action (progn
|
||||
(with-stdout-to result2 (echo ${^}))
|
||||
(with-stdout-to result2 (echo %{^}))
|
||||
(with-stdout-to expected2 (echo "sub-tree/a sub-tree/dir/b")))))
|
||||
|
||||
(alias
|
||||
|
@ -31,21 +31,21 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps dune dune-plop)
|
||||
(action (run diff -u ${^})))
|
||||
(action (run diff -u %{^})))
|
||||
|
||||
;; For some tests in subdirs
|
||||
|
||||
(rule (with-stdout-to 023e1a58-4d08-11e7-a041-aa000008c8a6 (echo "plop")))
|
||||
|
||||
;; Test for ${path-no-dep}
|
||||
;; Test for %{path-no-dep}
|
||||
|
||||
(rule
|
||||
(progn
|
||||
(with-stdout-to pnd-result
|
||||
(chdir sub-tree/dir
|
||||
(progn
|
||||
(echo "${path-no-dep:file-that-doesn't-exist}\n")
|
||||
(echo "${path-no-dep:.}\n"))))
|
||||
(echo "%{path-no-dep:file-that-doesn't-exist}\n")
|
||||
(echo "%{path-no-dep:.}\n"))))
|
||||
(with-stdout-to pnd-expected
|
||||
(progn
|
||||
(echo "../../file-that-doesn't-exist\n")
|
||||
|
@ -54,7 +54,7 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps pnd-result pnd-expected)
|
||||
(action (run diff -u ${^})))
|
||||
(action (run diff -u %{^})))
|
||||
|
||||
;; Test for globs
|
||||
|
||||
|
|
|
@ -1,3 +1,3 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(action (with-stdout-to ${null} (echo "hello world"))))
|
||||
(action (with-stdout-to %{null} (echo "hello world"))))
|
||||
|
|
|
@ -18,14 +18,14 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps _doc/_html/index.html)
|
||||
(action (echo "${read:_doc/_html/index.html}")))
|
||||
(action (echo "%{read:_doc/_html/index.html}")))
|
||||
|
||||
(alias
|
||||
(name foo-mld)
|
||||
(deps _doc/_mlds/foo/index.mld)
|
||||
(action (echo "${read:_doc/_mlds/foo/index.mld}")))
|
||||
(action (echo "%{read:_doc/_mlds/foo/index.mld}")))
|
||||
|
||||
(alias
|
||||
(name bar-mld)
|
||||
(deps _doc/_mlds/bar/index.mld)
|
||||
(action (echo "${read:_doc/_mlds/bar/index.mld}")))
|
||||
(action (echo "%{read:_doc/_mlds/bar/index.mld}")))
|
||||
|
|
|
@ -2,10 +2,10 @@
|
|||
(name all)
|
||||
(deps test.bc
|
||||
test.exe
|
||||
test.bc${ext_obj}
|
||||
test.exe${ext_obj}
|
||||
test.bc${ext_dll}
|
||||
test${ext_dll}
|
||||
test.bc%{ext_obj}
|
||||
test.exe%{ext_obj}
|
||||
test.bc%{ext_dll}
|
||||
test%{ext_dll}
|
||||
static.bc
|
||||
static.exe))
|
||||
|
||||
|
@ -20,20 +20,20 @@
|
|||
|
||||
(rule
|
||||
(targets static.exe)
|
||||
(deps test.exe${ext_obj} static.c)
|
||||
(action (run ${CC} -o ${@} -I ${ocaml_where} -I . ${^}
|
||||
${ocaml-config:native_c_libraries})))
|
||||
(deps test.exe%{ext_obj} static.c)
|
||||
(action (run %{CC} -o %{@} -I %{ocaml_where} -I . %{^}
|
||||
%{ocaml-config:native_c_libraries})))
|
||||
|
||||
(rule
|
||||
(targets static.bc)
|
||||
(deps test.bc${ext_obj} static.c)
|
||||
(action (run ${CC} -o ${@} -I ${ocaml_where} -I . ${^}
|
||||
${ocaml-config:bytecomp_c_libraries})))
|
||||
(deps test.bc%{ext_obj} static.c)
|
||||
(action (run %{CC} -o %{@} -I %{ocaml_where} -I . %{^}
|
||||
%{ocaml-config:bytecomp_c_libraries})))
|
||||
|
||||
(rule
|
||||
(targets dynamic.exe)
|
||||
(deps dynamic.c)
|
||||
(action (run ${CC} -o ${@} ${<} ${ocaml-config:native_c_libraries})))
|
||||
(action (run %{CC} -o %{@} %{<} %{ocaml-config:native_c_libraries})))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
|
@ -47,10 +47,10 @@
|
|||
|
||||
(alias
|
||||
(name runtest)
|
||||
(deps test.bc${ext_dll})
|
||||
(action (run ./dynamic.exe ./${<})))
|
||||
(deps test.bc%{ext_dll})
|
||||
(action (run ./dynamic.exe ./%{<})))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
(deps test${ext_dll})
|
||||
(action (run ./dynamic.exe ./${<})))
|
||||
(deps test%{ext_dll})
|
||||
(action (run ./dynamic.exe ./%{<})))
|
||||
|
|
|
@ -1,3 +1,3 @@
|
|||
(rule
|
||||
(targets x y)
|
||||
(action (with-stdout-to ${@} (echo foo))))
|
||||
(action (with-stdout-to %{@} (echo foo))))
|
|
@ -1,8 +1,8 @@
|
|||
|
||||
(alias
|
||||
(name unquoted)
|
||||
(action (echo ${read:foo bar.txt})))
|
||||
(action (echo %{read:foo bar.txt})))
|
||||
|
||||
(alias
|
||||
(name quoted)
|
||||
(action (echo "${read:foo bar.txt}")))
|
||||
(action (echo "%{read:foo bar.txt}")))
|
|
@ -1,3 +1,3 @@
|
|||
(rule
|
||||
(targets s t)
|
||||
(action (with-stdout-to "${@}" (echo foo))))
|
||||
(action (with-stdout-to "%{@}" (echo foo))))
|
|
@ -3,4 +3,4 @@
|
|||
|
||||
(alias
|
||||
(name runtest)
|
||||
(action (run ./count_args.exe ${read-lines:args})))
|
||||
(action (run ./count_args.exe %{read-lines:args})))
|
|
@ -1,4 +1,4 @@
|
|||
|
||||
(alias
|
||||
(name runtest)
|
||||
(action (echo "lines: ${read-lines:foo}")))
|
||||
(action (echo "lines: %{read-lines:foo}")))
|
|
@ -3,8 +3,8 @@ that ${@} is not quoted and doesn't contain exactly 1 element
|
|||
|
||||
$ dune build --root bad x
|
||||
Entering directory 'bad'
|
||||
File "dune", line 3, characters 25-29:
|
||||
Error: Variable ${@} expands to 2 values, however a single value is expected here. Please quote this atom.
|
||||
File "dune", line 3, characters 27-29:
|
||||
Error: Variable %{@} expands to 2 values, however a single value is expected here. Please quote this atom.
|
||||
[1]
|
||||
|
||||
The targets should only be interpreted as a single path when quoted
|
||||
|
@ -26,9 +26,11 @@ The targets should only be interpreted as a single path when quoted
|
|||
lines: foo bar baz
|
||||
|
||||
$ dune build @quoted --root filename-space
|
||||
Entering directory 'filename-space'
|
||||
filename contains spaces
|
||||
File "dune", line 4, characters 17-18:
|
||||
Error: This character not allowed inside %{...} forms
|
||||
[1]
|
||||
|
||||
$ dune build @unquoted --root filename-space
|
||||
Entering directory 'filename-space'
|
||||
${read:foo bar.txt}
|
||||
File "dune", line 4, characters 17-18:
|
||||
Error: This character not allowed inside %{...} forms
|
||||
[1]
|
||||
|
|
|
@ -8,27 +8,27 @@
|
|||
(lint
|
||||
(per_module
|
||||
((pps (reasonppx (-lint true))) (hello cppome))
|
||||
((action (run ./pp/reasononlypp.exe -lint ${<})) (foo bar pped))))
|
||||
((action (run ./pp/reasononlypp.exe -lint %{<})) (foo bar pped))))
|
||||
(preprocess
|
||||
(per_module
|
||||
((pps (reasonppx)) (foo))
|
||||
((pps (reasonppx (-lint false))) (hello))
|
||||
((action (run ./pp/reasononlypp.exe ${<})) (cppome))))))
|
||||
((action (run ./pp/reasononlypp.exe %{<})) (cppome))))))
|
||||
|
||||
(executable
|
||||
((name rbin)
|
||||
(modules (rbin))
|
||||
(lint (action (run ./pp/reasononlypp.exe -lint ${<})))
|
||||
(preprocess (action (run ./pp/reasononlypp.exe ${<})))
|
||||
(lint (action (run ./pp/reasononlypp.exe -lint %{<})))
|
||||
(preprocess (action (run ./pp/reasononlypp.exe %{<})))
|
||||
(libraries (rlib))))
|
||||
|
||||
;; we want to make sure that .rei files are present
|
||||
(alias
|
||||
((name install-file)
|
||||
(deps (rlib.install))
|
||||
(action (echo "${read:rlib.install}"))))
|
||||
(action (echo "%{read:rlib.install}"))))
|
||||
|
||||
(alias
|
||||
((name runtest)
|
||||
(deps (rbin.exe))
|
||||
(action (run ${<}))))
|
||||
(action (run %{<}))))
|
||||
|
|
|
@ -15,15 +15,15 @@
|
|||
|
||||
(rule
|
||||
(targets stdout.expected)
|
||||
(action (with-stdout-to ${@} (echo "toto\n"))))
|
||||
(action (with-stdout-to %{@} (echo "toto\n"))))
|
||||
|
||||
(rule
|
||||
(targets stderr.expected)
|
||||
(action (with-stdout-to ${@} (echo "titi\n"))))
|
||||
(action (with-stdout-to %{@} (echo "titi\n"))))
|
||||
|
||||
(rule
|
||||
(targets both.expected)
|
||||
(action (with-stdout-to ${@} (echo "toto\ntiti\n"))))
|
||||
(action (with-stdout-to %{@} (echo "toto\ntiti\n"))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
|
|
|
@ -11,4 +11,4 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps main.exe)
|
||||
(action (run ${<})))
|
||||
(action (run %{<})))
|
||||
|
|
40
test/dune
40
test/dune
|
@ -51,27 +51,27 @@ Printf.fprintf (open_out Sys.argv.(2)) \"%g\n%!\" (Sys.time ())
|
|||
|
||||
(executable (name incr) (libraries unix))
|
||||
|
||||
(rule (targets 01.foo) (action (run ./incr.exe x ${@})))
|
||||
(rule (targets 02.foo) (action (run ./incr.exe x ${@})))
|
||||
(rule (targets 03.foo) (action (run ./incr.exe x ${@})))
|
||||
(rule (targets 04.foo) (action (run ./incr.exe x ${@})))
|
||||
(rule (targets 05.foo) (action (run ./incr.exe x ${@})))
|
||||
(rule (targets 06.foo) (action (run ./incr.exe x ${@})))
|
||||
(rule (targets 07.foo) (action (run ./incr.exe x ${@})))
|
||||
(rule (targets 08.foo) (action (run ./incr.exe x ${@})))
|
||||
(rule (targets 09.foo) (action (run ./incr.exe x ${@})))
|
||||
(rule (targets 10.foo) (action (run ./incr.exe x ${@})))
|
||||
(rule (targets 01.foo) (action (run ./incr.exe x %{@})))
|
||||
(rule (targets 02.foo) (action (run ./incr.exe x %{@})))
|
||||
(rule (targets 03.foo) (action (run ./incr.exe x %{@})))
|
||||
(rule (targets 04.foo) (action (run ./incr.exe x %{@})))
|
||||
(rule (targets 05.foo) (action (run ./incr.exe x %{@})))
|
||||
(rule (targets 06.foo) (action (run ./incr.exe x %{@})))
|
||||
(rule (targets 07.foo) (action (run ./incr.exe x %{@})))
|
||||
(rule (targets 08.foo) (action (run ./incr.exe x %{@})))
|
||||
(rule (targets 09.foo) (action (run ./incr.exe x %{@})))
|
||||
(rule (targets 10.foo) (action (run ./incr.exe x %{@})))
|
||||
|
||||
(rule (targets 01.bar) (action (run ./incr.exe y ${@})) (locks m))
|
||||
(rule (targets 02.bar) (action (run ./incr.exe y ${@})) (locks m))
|
||||
(rule (targets 03.bar) (action (run ./incr.exe y ${@})) (locks m))
|
||||
(rule (targets 04.bar) (action (run ./incr.exe y ${@})) (locks m))
|
||||
(rule (targets 05.bar) (action (run ./incr.exe y ${@})) (locks m))
|
||||
(rule (targets 06.bar) (action (run ./incr.exe y ${@})) (locks m))
|
||||
(rule (targets 07.bar) (action (run ./incr.exe y ${@})) (locks m))
|
||||
(rule (targets 08.bar) (action (run ./incr.exe y ${@})) (locks m))
|
||||
(rule (targets 09.bar) (action (run ./incr.exe y ${@})) (locks m))
|
||||
(rule (targets 10.bar) (action (run ./incr.exe y ${@})) (locks m))
|
||||
(rule (targets 01.bar) (action (run ./incr.exe y %{@})) (locks m))
|
||||
(rule (targets 02.bar) (action (run ./incr.exe y %{@})) (locks m))
|
||||
(rule (targets 03.bar) (action (run ./incr.exe y %{@})) (locks m))
|
||||
(rule (targets 04.bar) (action (run ./incr.exe y %{@})) (locks m))
|
||||
(rule (targets 05.bar) (action (run ./incr.exe y %{@})) (locks m))
|
||||
(rule (targets 06.bar) (action (run ./incr.exe y %{@})) (locks m))
|
||||
(rule (targets 07.bar) (action (run ./incr.exe y %{@})) (locks m))
|
||||
(rule (targets 08.bar) (action (run ./incr.exe y %{@})) (locks m))
|
||||
(rule (targets 09.bar) (action (run ./incr.exe y %{@})) (locks m))
|
||||
(rule (targets 10.bar) (action (run ./incr.exe y %{@})) (locks m))
|
||||
|
||||
(alias
|
||||
(name runtest-no-deps)
|
||||
|
|
|
@ -14,8 +14,8 @@ let infer (a : Action.t) =
|
|||
List.map (Path.Set.to_list x.targets) ~f:Path.to_string)
|
||||
[%%expect{|
|
||||
- : unit = ()
|
||||
val p : ?error_loc:Usexp.Loc.t -> string -> Dune.Import.Path.t = <fun>
|
||||
val infer : Dune.Action.t -> string list * string list = <fun>
|
||||
val p : ?error_loc:Usexp.Loc.t -> string -> Path.t = <fun>
|
||||
val infer : Action.t -> string list * string list = <fun>
|
||||
|}]
|
||||
|
||||
infer (Copy (p "a", p "b"));;
|
||||
|
|
|
@ -5,4 +5,4 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps ./test_configurator.exe)
|
||||
(action (run ${<})))
|
||||
(action (run %{<})))
|
||||
|
|
|
@ -19,71 +19,71 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps tests.mlt
|
||||
(glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)
|
||||
(source_tree toolchain.d)
|
||||
(source_tree findlib-db))
|
||||
(action (chdir ${SCOPE_ROOT}
|
||||
(glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)
|
||||
(source_tree toolchain.d)
|
||||
(source_tree findlib-db))
|
||||
(action (chdir %{SCOPE_ROOT}
|
||||
(progn
|
||||
(run ${exe:expect_test.exe} ${<})
|
||||
(diff? ${<} ${<}.corrected)))))
|
||||
(run %{exe:expect_test.exe} %{<})
|
||||
(diff? %{<} %{<}.corrected)))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
(deps filename.mlt
|
||||
(glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
|
||||
(action (chdir ${SCOPE_ROOT}
|
||||
(glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
|
||||
(action (chdir %{SCOPE_ROOT}
|
||||
(progn
|
||||
(run ${exe:expect_test.exe} ${<})
|
||||
(diff? ${<} ${<}.corrected)))))
|
||||
(run %{exe:expect_test.exe} %{<})
|
||||
(diff? %{<} %{<}.corrected)))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
(deps import_dot_map.mlt
|
||||
(glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
|
||||
(action (chdir ${SCOPE_ROOT}
|
||||
(glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
|
||||
(action (chdir %{SCOPE_ROOT}
|
||||
(progn
|
||||
(run ${exe:expect_test.exe} ${<})
|
||||
(diff? ${<} ${<}.corrected)))))
|
||||
(run %{exe:expect_test.exe} %{<})
|
||||
(diff? %{<} %{<}.corrected)))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
(deps action.mlt
|
||||
(glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
|
||||
(action (chdir ${SCOPE_ROOT}
|
||||
(glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
|
||||
(action (chdir %{SCOPE_ROOT}
|
||||
(progn
|
||||
(run ${exe:expect_test.exe} ${<})
|
||||
(diff? ${<} ${<}.corrected)))))
|
||||
(run %{exe:expect_test.exe} %{<})
|
||||
(diff? %{<} %{<}.corrected)))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
(deps path.mlt
|
||||
(glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
|
||||
(action (chdir ${SCOPE_ROOT}
|
||||
(glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
|
||||
(action (chdir %{SCOPE_ROOT}
|
||||
(progn
|
||||
(run ${exe:expect_test.exe} ${<})
|
||||
(diff? ${<} ${<}.corrected)))))
|
||||
(run %{exe:expect_test.exe} %{<})
|
||||
(diff? %{<} %{<}.corrected)))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
(deps sexp.mlt
|
||||
(glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
|
||||
(action (chdir ${SCOPE_ROOT}
|
||||
(glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
|
||||
(action (chdir %{SCOPE_ROOT}
|
||||
(progn
|
||||
(run ${exe:expect_test.exe} ${<})
|
||||
(diff? ${<} ${<}.corrected)))))
|
||||
(run %{exe:expect_test.exe} %{<})
|
||||
(diff? %{<} %{<}.corrected)))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
(deps jbuild.mlt
|
||||
(glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
|
||||
(action (chdir ${SCOPE_ROOT}
|
||||
(glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
|
||||
(glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
|
||||
(action (chdir %{SCOPE_ROOT}
|
||||
(progn
|
||||
(run ${exe:expect_test.exe} ${<})
|
||||
(diff? ${<} ${<}.corrected)))))
|
||||
(run %{exe:expect_test.exe} %{<})
|
||||
(diff? %{<} %{<}.corrected)))))
|
||||
|
|
|
@ -38,13 +38,48 @@ and expectation txt = parse
|
|||
}
|
||||
|
||||
{
|
||||
module Outcometree_cleaner = struct
|
||||
open Outcometree
|
||||
|
||||
let lid s =
|
||||
match String.rindex s '.' with
|
||||
| exception Not_found -> s
|
||||
| i ->
|
||||
let pos = i + 1 in
|
||||
let len = String.length s in
|
||||
String.sub s ~pos ~len:(len - pos)
|
||||
|
||||
let ident = function
|
||||
| Oide_dot (_, s) -> Oide_ident (lid s)
|
||||
| Oide_ident s -> Oide_ident (lid s)
|
||||
| id -> id
|
||||
|
||||
let rec value = function
|
||||
| Oval_array l -> Oval_array (values l)
|
||||
| Oval_constr (id, l) -> Oval_constr (ident id, values l)
|
||||
| Oval_list l -> Oval_list (values l)
|
||||
| Oval_record l ->
|
||||
Oval_record (List.map l ~f:(fun (id, v) -> ident id, value v))
|
||||
| Oval_tuple l -> Oval_tuple (values l)
|
||||
| Oval_variant (s, Some v) -> Oval_variant (s, Some (value v))
|
||||
| v -> v
|
||||
|
||||
and values l = List.map l ~f:value
|
||||
|
||||
let () =
|
||||
let print_out_value = !Toploop.print_out_value in
|
||||
Toploop.print_out_value := (fun ppf v -> print_out_value ppf (value v))
|
||||
end
|
||||
|
||||
let main () =
|
||||
Clflags.real_paths := false;
|
||||
Test_common.run_expect_test Sys.argv.(1) ~f:(fun file_contents lexbuf ->
|
||||
let chunks = code file_contents lexbuf.lex_curr_p lexbuf in
|
||||
|
||||
Toploop.initialize_toplevel_env ();
|
||||
List.iter
|
||||
[ "src/stdune/.stdune.objs"
|
||||
[ "src/usexp/.usexp.objs"
|
||||
; "src/stdune/.stdune.objs"
|
||||
; "src/.dune.objs"
|
||||
]
|
||||
~f:Topdirs.dir_directory;
|
||||
|
|
|
@ -15,6 +15,5 @@ String.Map.of_list_multi
|
|||
]
|
||||
|> String.Map.to_list;;
|
||||
[%%expect{|
|
||||
- : (Dune.Import.String.Map.key * int list) list =
|
||||
[("a", [1; 2; 3]); ("b", [1; 2])]
|
||||
- : (string * int list) list = [("a", [1; 2; 3]); ("b", [1; 2])]
|
||||
|}]
|
||||
|
|
|
@ -2,67 +2,63 @@
|
|||
open Dune;;
|
||||
open Stdune;;
|
||||
|
||||
let sexp_pp = Sexp.pp Dune;;
|
||||
#install_printer Jbuild.Mode_conf.pp;;
|
||||
#install_printer Binary_kind.pp;;
|
||||
#install_printer Sexp.pp;;
|
||||
#install_printer sexp_pp;;
|
||||
|
||||
(* Jbuild.Executables.Link_mode.t *)
|
||||
let test s =
|
||||
Sexp.Of_sexp.parse Jbuild.Executables.Link_mode.t Univ_map.empty
|
||||
(Sexp.parse_string ~fname:"" ~mode:Sexp.Parser.Mode.Single s)
|
||||
[%%expect{|
|
||||
val test : string -> Dune.Jbuild.Executables.Link_mode.t = <fun>
|
||||
val sexp_pp : Format.formatter -> Usexp.t -> unit = <fun>
|
||||
val test : string -> Jbuild.Executables.Link_mode.t = <fun>
|
||||
|}]
|
||||
|
||||
(* Link modes can be read as a (<mode> <kind>) list *)
|
||||
test "(best exe)"
|
||||
[%%expect{|
|
||||
- : Dune.Jbuild.Executables.Link_mode.t =
|
||||
{Dune.Jbuild.Executables.Link_mode.mode = best; kind = exe}
|
||||
- : Jbuild.Executables.Link_mode.t = {mode = best; kind = exe}
|
||||
|}]
|
||||
|
||||
(* Some shortcuts also exist *)
|
||||
test "exe"
|
||||
[%%expect{|
|
||||
- : Dune.Jbuild.Executables.Link_mode.t =
|
||||
{Dune.Jbuild.Executables.Link_mode.mode = best; kind = exe}
|
||||
- : Jbuild.Executables.Link_mode.t = {mode = best; kind = exe}
|
||||
|}]
|
||||
test "object"
|
||||
[%%expect{|
|
||||
- : Dune.Jbuild.Executables.Link_mode.t =
|
||||
{Dune.Jbuild.Executables.Link_mode.mode = best; kind = object}
|
||||
- : Jbuild.Executables.Link_mode.t = {mode = best; kind = object}
|
||||
|}]
|
||||
test "shared_object"
|
||||
[%%expect{|
|
||||
- : Dune.Jbuild.Executables.Link_mode.t =
|
||||
{Dune.Jbuild.Executables.Link_mode.mode = best; kind = shared_object}
|
||||
- : Jbuild.Executables.Link_mode.t = {mode = best; kind = shared_object}
|
||||
|}]
|
||||
test "byte"
|
||||
[%%expect{|
|
||||
- : Dune.Jbuild.Executables.Link_mode.t =
|
||||
{Dune.Jbuild.Executables.Link_mode.mode = byte; kind = exe}
|
||||
- : Jbuild.Executables.Link_mode.t = {mode = byte; kind = exe}
|
||||
|}]
|
||||
test "native"
|
||||
[%%expect{|
|
||||
- : Dune.Jbuild.Executables.Link_mode.t =
|
||||
{Dune.Jbuild.Executables.Link_mode.mode = native; kind = exe}
|
||||
- : Jbuild.Executables.Link_mode.t = {mode = native; kind = exe}
|
||||
|}]
|
||||
|
||||
(* Jbuild.Executables.Link_mode.sexp_of_t *)
|
||||
let test l =
|
||||
Jbuild.Executables.Link_mode.sexp_of_t l
|
||||
[%%expect{|
|
||||
val test : Dune.Jbuild.Executables.Link_mode.t -> Stdune__Sexp.t = <fun>
|
||||
val test : Jbuild.Executables.Link_mode.t -> Usexp.t = <fun>
|
||||
|}]
|
||||
|
||||
(* In the general case, modes are serialized as a list *)
|
||||
test {Jbuild.Executables.Link_mode.kind = Shared_object; mode = Byte }
|
||||
[%%expect{|
|
||||
- : Stdune__Sexp.t = (byte shared_object)
|
||||
- : Usexp.t = (byte shared_object)
|
||||
|}]
|
||||
|
||||
(* But the specialized ones are serialized in the minimal version *)
|
||||
test Jbuild.Executables.Link_mode.exe
|
||||
[%%expect{|
|
||||
- : Stdune__Sexp.t = exe
|
||||
- : Usexp.t = exe
|
||||
|}]
|
||||
|
|
|
@ -5,4 +5,4 @@
|
|||
(alias
|
||||
(name runtest)
|
||||
(deps ./gh637.exe)
|
||||
(action (run ${<})))
|
||||
(action (run %{<})))
|
||||
|
|
|
@ -13,15 +13,15 @@ let e = Path.of_filename_relative_to_initial_cwd;;
|
|||
Path.(let p = relative root "foo" in descendant p ~of_:p)
|
||||
[%%expect{|
|
||||
- : unit = ()
|
||||
val r : string -> Stdune.Path.t = <fun>
|
||||
val e : string -> Stdune.Path.t = <fun>
|
||||
- : Stdune.Path.t option = Some (In_source_tree ".")
|
||||
val r : string -> Path.t = <fun>
|
||||
val e : string -> Path.t = <fun>
|
||||
- : Path.t option = Some (In_source_tree ".")
|
||||
|}]
|
||||
|
||||
(* different strings but same length *)
|
||||
Path.(descendant (relative root "foo") ~of_:(relative root "bar"))
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = None
|
||||
- : Path.t option = None
|
||||
|}]
|
||||
|
||||
Path.(is_descendant (r "foo") ~of_:(r "foo"))
|
||||
|
@ -91,37 +91,37 @@ Path.(is_descendant (e "/foo/bar") ~of_:(e "/"))
|
|||
|
||||
Path.(descendant (r "foo") ~of_:(r "foo/"))
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = Some (In_source_tree ".")
|
||||
- : Path.t option = Some (In_source_tree ".")
|
||||
|}]
|
||||
|
||||
Path.(descendant (r "foo/") ~of_:(r "foo"))
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = Some (In_source_tree ".")
|
||||
- : Path.t option = Some (In_source_tree ".")
|
||||
|}]
|
||||
|
||||
Path.(descendant (r "foo/bar") ~of_:(r "foo"))
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = Some (In_source_tree "bar")
|
||||
- : Path.t option = Some (In_source_tree "bar")
|
||||
|}]
|
||||
|
||||
Path.(descendant Path.root ~of_:(r "foo"))
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = None
|
||||
- : Path.t option = None
|
||||
|}]
|
||||
|
||||
Path.(descendant Path.root ~of_:Path.root)
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = Some (In_source_tree ".")
|
||||
- : Path.t option = Some (In_source_tree ".")
|
||||
|}]
|
||||
|
||||
Path.(descendant (r "foo") ~of_:Path.root)
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = Some (In_source_tree "foo")
|
||||
- : Path.t option = Some (In_source_tree "foo")
|
||||
|}]
|
||||
|
||||
Path.(descendant (relative build_dir "foo") ~of_:root)
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = Some (In_source_tree "_build/foo")
|
||||
- : Path.t option = Some (In_source_tree "_build/foo")
|
||||
|}]
|
||||
|
||||
Path.(descendant (relative build_dir "foo") ~of_:(absolute "/foo/bar"))
|
||||
|
@ -132,17 +132,17 @@ Error: Unbound value absolute
|
|||
|
||||
Path.(descendant (relative build_dir "foo/bar") ~of_:build_dir)
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = Some (In_source_tree "foo/bar")
|
||||
- : Path.t option = Some (In_source_tree "foo/bar")
|
||||
|}]
|
||||
|
||||
Path.(descendant (relative build_dir "foo/bar") ~of_:(relative build_dir "foo"))
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = Some (In_source_tree "bar")
|
||||
- : Path.t option = Some (In_source_tree "bar")
|
||||
|}]
|
||||
|
||||
Path.(descendant (relative build_dir "foo/bar") ~of_:(relative build_dir "foo"))
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = Some (In_source_tree "bar")
|
||||
- : Path.t option = Some (In_source_tree "bar")
|
||||
|}]
|
||||
|
||||
Path.(descendant (absolute "/foo/bar") ~of_:(absolute "/foo"))
|
||||
|
@ -188,27 +188,27 @@ Path.reach (Path.of_string "bar/foo") ~from:(Path.of_string "bar/baz/y")
|
|||
|
||||
Path.relative (Path.of_string "relative") "/absolute/path"
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (External "/absolute/path")
|
||||
- : Path.t = (External "/absolute/path")
|
||||
|}]
|
||||
|
||||
Path.relative (Path.of_string "/abs1") "/abs2"
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (External "/abs2")
|
||||
- : Path.t = (External "/abs2")
|
||||
|}]
|
||||
|
||||
Path.relative (Path.of_string "/abs1") ""
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (External "/abs1")
|
||||
- : Path.t = (External "/abs1")
|
||||
|}]
|
||||
|
||||
Path.relative Path.root "/absolute/path"
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (External "/absolute/path")
|
||||
- : Path.t = (External "/absolute/path")
|
||||
|}]
|
||||
|
||||
e "/absolute/path"
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (External "/absolute/path")
|
||||
- : Path.t = (External "/absolute/path")
|
||||
|}]
|
||||
|
||||
Path.is_managed (e "relative/path")
|
||||
|
@ -218,72 +218,83 @@ Path.is_managed (e "relative/path")
|
|||
|
||||
Path.insert_after_build_dir_exn Path.root "foobar"
|
||||
[%%expect{|
|
||||
Exception: Stdune__Exn.Code_error <abstr>.
|
||||
Exception:
|
||||
Code_error
|
||||
(List
|
||||
[Atom (A "Path.insert_after_build_dir_exn");
|
||||
List [Atom (A "path"); List [Atom (A "In_source_tree"); Atom (A ".")]];
|
||||
List [Atom (A "insert"); Atom (A "foobar")]]).
|
||||
|}]
|
||||
|
||||
Path.insert_after_build_dir_exn Path.build_dir "foobar"
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (In_build_dir "foobar")
|
||||
- : Path.t = (In_build_dir "foobar")
|
||||
|}]
|
||||
|
||||
Path.insert_after_build_dir_exn (Path.relative Path.build_dir "qux") "foobar"
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (In_build_dir "foobar/qux")
|
||||
- : Path.t = (In_build_dir "foobar/qux")
|
||||
|}]
|
||||
|
||||
Path.append Path.build_dir (Path.relative Path.root "foo")
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (In_build_dir "foo")
|
||||
- : Path.t = (In_build_dir "foo")
|
||||
|}]
|
||||
|
||||
Path.append Path.build_dir (Path.relative Path.build_dir "foo")
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (In_build_dir "_build/foo")
|
||||
- : Path.t = (In_build_dir "_build/foo")
|
||||
|}]
|
||||
|
||||
Path.append Path.root (Path.relative Path.build_dir "foo")
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (In_source_tree "_build/foo")
|
||||
- : Path.t = (In_source_tree "_build/foo")
|
||||
|}]
|
||||
|
||||
Path.append Path.root (Path.relative Path.root "foo")
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (In_source_tree "foo")
|
||||
- : Path.t = (In_source_tree "foo")
|
||||
|}]
|
||||
|
||||
Path.append (Path.of_string "/root") (Path.relative Path.root "foo")
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (External "/root/foo")
|
||||
- : Path.t = (External "/root/foo")
|
||||
|}]
|
||||
|
||||
Path.append (Path.of_string "/root") (Path.relative Path.build_dir "foo")
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (External "/root/_build/foo")
|
||||
- : Path.t = (External "/root/_build/foo")
|
||||
|}]
|
||||
|
||||
Path.rm_rf (Path.of_string "/does/not/exist/foo/bar/baz")
|
||||
[%%expect{|
|
||||
Exception: Stdune__Exn.Code_error <abstr>.
|
||||
Exception:
|
||||
Code_error
|
||||
(List
|
||||
[Quoted_string "Path.rm_rf called on external dir";
|
||||
List
|
||||
[Atom (A "t");
|
||||
List [Atom (A "External"); Atom (A "/does/not/exist/foo/bar/baz")]]]).
|
||||
|}]
|
||||
|
||||
Path.drop_build_context (Path.relative Path.build_dir "foo/bar")
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = Some (In_source_tree "bar")
|
||||
- : Path.t option = Some (In_source_tree "bar")
|
||||
|}]
|
||||
|
||||
Path.drop_build_context (Path.of_string "foo/bar")
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = None
|
||||
- : Path.t option = None
|
||||
|}]
|
||||
|
||||
Path.drop_build_context (e "/foo/bar")
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = None
|
||||
- : Path.t option = None
|
||||
|}]
|
||||
|
||||
Path.drop_build_context Path.build_dir
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t option = None
|
||||
- : Path.t option = None
|
||||
|}]
|
||||
|
||||
Path.is_in_build_dir Path.build_dir
|
||||
|
@ -320,11 +331,11 @@ Path.(reach_for_running (relative root "foo") ~from:(Path.relative root "foo"))
|
|||
|
||||
Path.relative Path.root "_build"
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (In_build_dir ".")
|
||||
- : Path.t = (In_build_dir ".")
|
||||
|}]
|
||||
|
||||
(* This is not right, but kind of annoying to fix :/ *)
|
||||
Path.relative (r "foo") "../_build"
|
||||
[%%expect{|
|
||||
- : Stdune.Path.t = (In_build_dir ".")
|
||||
- : Path.t = (In_build_dir ".")
|
||||
|}]
|
||||
|
|
|
@ -2,24 +2,10 @@
|
|||
open Stdune;;
|
||||
open Sexp.Of_sexp;;
|
||||
|
||||
let pp_sexp_ast =
|
||||
let rec subst_atoms ~f (s : Sexp.t) =
|
||||
match s with
|
||||
| Atom a -> f a
|
||||
| Quoted_string _ -> s
|
||||
| List xs -> List (List.map ~f:(subst_atoms ~f) xs)
|
||||
in
|
||||
fun ppf sexp ->
|
||||
sexp
|
||||
|> Sexp.Ast.remove_locs
|
||||
|> subst_atoms ~f:(fun (A s) ->
|
||||
List [(Sexp.atom "atom"); Sexp.atom_or_quoted_string s])
|
||||
|> Sexp.pp ppf
|
||||
;;
|
||||
|
||||
#install_printer pp_sexp_ast;;
|
||||
let print_loc ppf (_ : Sexp.Loc.t) = Format.pp_print_string ppf "<loc>";;
|
||||
#install_printer print_loc;;
|
||||
[%%expect{|
|
||||
val pp_sexp_ast : Format.formatter -> Stdune.Sexp.Ast.t -> unit = <fun>
|
||||
val print_loc : Format.formatter -> Usexp.Loc.t -> unit = <fun>
|
||||
|}]
|
||||
|
||||
Printexc.record_backtrace false;;
|
||||
|
@ -27,43 +13,46 @@ Printexc.record_backtrace false;;
|
|||
- : unit = ()
|
||||
|}]
|
||||
|
||||
let sexp = Sexp.parse_string ~fname:"" ~mode:Single {|
|
||||
let sexp = lazy (Sexp.parse_string ~fname:"" ~mode:Single {|
|
||||
((foo 1)
|
||||
(foo 2))
|
||||
|}
|
||||
|});;
|
||||
Sexp.Ast.remove_locs (Lazy.force sexp)
|
||||
[%%expect{|
|
||||
val sexp : Usexp.Ast.t = (((atom foo) (atom 1)) ((atom foo) (atom 2)))
|
||||
val sexp : ast lazy_t = <lazy>
|
||||
- : Usexp.t =
|
||||
List
|
||||
[List [Atom (A "foo"); Atom (A "1")]; List [Atom (A "foo"); Atom (A "2")]]
|
||||
|}]
|
||||
|
||||
let of_sexp = record (field "foo" int)
|
||||
let x = parse of_sexp Univ_map.empty sexp
|
||||
let x = parse of_sexp Univ_map.empty (Lazy.force sexp)
|
||||
[%%expect{|
|
||||
val of_sexp : int Stdune.Sexp.Of_sexp.t = <abstr>
|
||||
Exception:
|
||||
Stdune__Sexp.Of_sexp.Of_sexp (<abstr>,
|
||||
"Field \"foo\" is present too many times", None).
|
||||
val of_sexp : int t = <abstr>
|
||||
Exception: Of_sexp (<loc>, "Field \"foo\" is present too many times", None).
|
||||
|}]
|
||||
|
||||
let of_sexp = record (multi_field "foo" int)
|
||||
let x = parse of_sexp Univ_map.empty sexp
|
||||
let x = parse of_sexp Univ_map.empty (Lazy.force sexp)
|
||||
[%%expect{|
|
||||
val of_sexp : int list Stdune.Sexp.Of_sexp.t = <abstr>
|
||||
val of_sexp : int list t = <abstr>
|
||||
val x : int list = [1; 2]
|
||||
|}]
|
||||
|
||||
type parse_result_diff =
|
||||
{ jbuild : (Sexp.Ast.t list, string) result
|
||||
; dune : (Sexp.Ast.t list, string) result
|
||||
type 'res parse_result_diff =
|
||||
{ jbuild : ('res, string) result
|
||||
; dune : ('res, string) result
|
||||
}
|
||||
|
||||
type parse_result =
|
||||
| Same of (Sexp.Ast.t list, string) result
|
||||
| Different of parse_result_diff
|
||||
type 'res parse_result =
|
||||
| Same of ('res, string) result
|
||||
| Different of 'res parse_result_diff
|
||||
|
||||
let parse s =
|
||||
let f ~lexer =
|
||||
try
|
||||
Ok (Sexp.parse_string ~fname:"" ~mode:Many ~lexer s)
|
||||
Ok (Sexp.parse_string ~fname:"" ~mode:Many ~lexer s
|
||||
|> List.map ~f:Sexp.Ast.remove_locs)
|
||||
with
|
||||
| Sexp.Parse_error e -> Error (Sexp.Parse_error.message e)
|
||||
| Invalid_argument e -> Error e
|
||||
|
@ -75,122 +64,294 @@ let parse s =
|
|||
else
|
||||
Same jbuild
|
||||
[%%expect{|
|
||||
type parse_result_diff = {
|
||||
jbuild : (Stdune.Sexp.Ast.t list, string) Stdune.result;
|
||||
dune : (Stdune.Sexp.Ast.t list, string) Stdune.result;
|
||||
type 'res parse_result_diff = {
|
||||
jbuild : ('res, string) Stdune.result;
|
||||
dune : ('res, string) Stdune.result;
|
||||
}
|
||||
type parse_result =
|
||||
Same of (Stdune.Sexp.Ast.t list, string) Stdune.result
|
||||
| Different of parse_result_diff
|
||||
val parse : string -> parse_result = <fun>
|
||||
type 'res parse_result =
|
||||
Same of ('res, string) Stdune.result
|
||||
| Different of 'res parse_result_diff
|
||||
val parse : string -> Usexp.t list parse_result = <fun>
|
||||
|}]
|
||||
|
||||
parse {| # ## x##y x||y a#b|c#d copy# |}
|
||||
[%%expect{|
|
||||
- : parse_result =
|
||||
- : Usexp.t list parse_result =
|
||||
Same
|
||||
(Ok
|
||||
[(atom #); (atom ##); (atom x##y); (atom x||y); (atom a#b|c#d);
|
||||
(atom copy#)])
|
||||
[Atom (A "#"); Atom (A "##"); Atom (A "x##y"); Atom (A "x||y");
|
||||
Atom (A "a#b|c#d"); Atom (A "copy#")])
|
||||
|}]
|
||||
|
||||
|
||||
parse {|x #| comment |# y|}
|
||||
[%%expect{|
|
||||
- : parse_result =
|
||||
- : Usexp.t list parse_result =
|
||||
Different
|
||||
{jbuild = Ok [(atom x); (atom y)];
|
||||
dune = Ok [(atom x); (atom #|); (atom comment); (atom |#); (atom y)]}
|
||||
{jbuild = Ok [Atom (A "x"); Atom (A "y")];
|
||||
dune =
|
||||
Ok
|
||||
[Atom (A "x"); Atom (A "#|"); Atom (A "comment"); Atom (A "|#");
|
||||
Atom (A "y")]}
|
||||
|}]
|
||||
|
||||
parse {|x#|y|}
|
||||
[%%expect{|
|
||||
- : parse_result =
|
||||
- : Usexp.t list parse_result =
|
||||
Different
|
||||
{jbuild = Error "jbuild atoms cannot contain #|"; dune = Ok [(atom x#|y)]}
|
||||
{jbuild = Error "jbuild atoms cannot contain #|";
|
||||
dune = Ok [Atom (A "x#|y")]}
|
||||
|}]
|
||||
|
||||
parse {|x|#y|}
|
||||
[%%expect{|
|
||||
- : parse_result =
|
||||
- : Usexp.t list parse_result =
|
||||
Different
|
||||
{jbuild = Error "jbuild atoms cannot contain |#"; dune = Ok [(atom x|#y)]}
|
||||
{jbuild = Error "jbuild atoms cannot contain |#";
|
||||
dune = Ok [Atom (A "x|#y")]}
|
||||
|}]
|
||||
|
||||
parse {|"\a"|}
|
||||
[%%expect{|
|
||||
- : parse_result =
|
||||
Different {jbuild = Ok ["\\a"]; dune = Error "unknown escape sequence"}
|
||||
- : Usexp.t list parse_result =
|
||||
Different
|
||||
{jbuild = Ok [Quoted_string "\\a"]; dune = Error "unknown escape sequence"}
|
||||
|}]
|
||||
|
||||
parse {|"\%{x}"|}
|
||||
[%%expect{|
|
||||
- : parse_result =
|
||||
Different {jbuild = Ok ["\\%{x}"]; dune = Error "unknown escape sequence"}
|
||||
- : Usexp.t list parse_result =
|
||||
Different
|
||||
{jbuild = Ok [Quoted_string "\\%{x}"]; dune = Ok [Quoted_string "%{x}"]}
|
||||
|}]
|
||||
|
||||
parse {|"$foo"|}
|
||||
[%%expect{|
|
||||
- : parse_result = Same (Ok ["$foo"])
|
||||
- : Usexp.t list parse_result = Same (Ok [Quoted_string "$foo"])
|
||||
|}]
|
||||
|
||||
parse {|"%foo"|}
|
||||
[%%expect{|
|
||||
- : parse_result = Same (Ok ["%foo"])
|
||||
- : Usexp.t list parse_result = Same (Ok [Quoted_string "%foo"])
|
||||
|}]
|
||||
|
||||
parse {|"bar%foo"|}
|
||||
[%%expect{|
|
||||
- : parse_result = Same (Ok ["bar%foo"])
|
||||
- : Usexp.t list parse_result = Same (Ok [Quoted_string "bar%foo"])
|
||||
|}]
|
||||
|
||||
parse {|"bar$foo"|}
|
||||
[%%expect{|
|
||||
- : parse_result = Same (Ok ["bar$foo"])
|
||||
- : Usexp.t list parse_result = Same (Ok [Quoted_string "bar$foo"])
|
||||
|}]
|
||||
|
||||
parse {|"%bar$foo%"|}
|
||||
[%%expect{|
|
||||
- : parse_result = Same (Ok ["%bar$foo%"])
|
||||
- : Usexp.t list parse_result = Same (Ok [Quoted_string "%bar$foo%"])
|
||||
|}]
|
||||
|
||||
parse {|"$bar%foo%"|}
|
||||
[%%expect{|
|
||||
- : parse_result = Same (Ok ["$bar%foo%"])
|
||||
- : Usexp.t list parse_result = Same (Ok [Quoted_string "$bar%foo%"])
|
||||
|}]
|
||||
|
||||
parse {|\${foo}|}
|
||||
[%%expect{|
|
||||
- : parse_result = Same (Ok [(atom \${foo})])
|
||||
- : Usexp.t list parse_result = Same (Ok [Atom (A "\\${foo}")])
|
||||
|}]
|
||||
|
||||
parse {|\%{foo}|}
|
||||
[%%expect{|
|
||||
- : parse_result =
|
||||
- : Usexp.t list parse_result =
|
||||
Different
|
||||
{jbuild = Ok [(atom "\\%{foo}")]; dune = Error "Invalid atom character '%'"}
|
||||
{jbuild = Ok [Atom (A "\\%{foo}")];
|
||||
dune =
|
||||
Ok
|
||||
[Template
|
||||
{quoted = false;
|
||||
parts =
|
||||
[Text "\\";
|
||||
Var {loc = <loc>; name = "foo"; payload = None; syntax = Percent}];
|
||||
loc = <loc>}]}
|
||||
|}]
|
||||
|
||||
parse {|\$bar%foo%|}
|
||||
[%%expect{|
|
||||
- : parse_result =
|
||||
Different
|
||||
{jbuild = Ok [(atom "\\$bar%foo%")];
|
||||
dune = Error "Invalid atom character '%'"}
|
||||
- : Usexp.t list parse_result = Same (Ok [Atom (A "\\$bar%foo%")])
|
||||
|}]
|
||||
|
||||
parse {|\$bar\%foo%|}
|
||||
[%%expect{|
|
||||
- : parse_result =
|
||||
Different
|
||||
{jbuild = Ok [(atom "\\$bar\\%foo%")];
|
||||
dune = Error "Invalid atom character '%'"}
|
||||
- : Usexp.t list parse_result = Same (Ok [Atom (A "\\$bar\\%foo%")])
|
||||
|}]
|
||||
|
||||
parse {|\$bar\%foo%{bar}|}
|
||||
[%%expect{|
|
||||
- : parse_result =
|
||||
- : Usexp.t list parse_result =
|
||||
Different
|
||||
{jbuild = Ok [(atom "\\$bar\\%foo%{bar}")];
|
||||
dune = Error "Invalid atom character '%'"}
|
||||
{jbuild = Ok [Atom (A "\\$bar\\%foo%{bar}")];
|
||||
dune =
|
||||
Ok
|
||||
[Template
|
||||
{quoted = false;
|
||||
parts =
|
||||
[Text "\\$bar\\%foo";
|
||||
Var {loc = <loc>; name = "bar"; payload = None; syntax = Percent}];
|
||||
loc = <loc>}]}
|
||||
|}]
|
||||
|
||||
parse {|"bar%{foo}"|}
|
||||
[%%expect{|
|
||||
- : Usexp.t list parse_result =
|
||||
Different
|
||||
{jbuild = Ok [Quoted_string "bar%{foo}"];
|
||||
dune =
|
||||
Ok
|
||||
[Template
|
||||
{quoted = true;
|
||||
parts =
|
||||
[Text "bar";
|
||||
Var {loc = <loc>; name = "foo"; payload = None; syntax = Percent}];
|
||||
loc = <loc>}]}
|
||||
|}]
|
||||
|
||||
parse {|"bar\%{foo}"|}
|
||||
[%%expect{|
|
||||
- : Usexp.t list parse_result =
|
||||
Different
|
||||
{jbuild = Ok [Quoted_string "bar\\%{foo}"];
|
||||
dune = Ok [Quoted_string "bar%{foo}"]}
|
||||
|}]
|
||||
|
||||
parse {|bar%%{foo}|}
|
||||
[%%expect{|
|
||||
- : Usexp.t list parse_result =
|
||||
Different
|
||||
{jbuild = Ok [Atom (A "bar%%{foo}")];
|
||||
dune =
|
||||
Ok
|
||||
[Template
|
||||
{quoted = false;
|
||||
parts =
|
||||
[Text "bar%";
|
||||
Var {loc = <loc>; name = "foo"; payload = None; syntax = Percent}];
|
||||
loc = <loc>}]}
|
||||
|}]
|
||||
|
||||
parse {|"bar%%{foo}"|}
|
||||
[%%expect{|
|
||||
- : Usexp.t list parse_result =
|
||||
Different
|
||||
{jbuild = Ok [Quoted_string "bar%%{foo}"];
|
||||
dune =
|
||||
Ok
|
||||
[Template
|
||||
{quoted = true;
|
||||
parts =
|
||||
[Text "bar%";
|
||||
Var {loc = <loc>; name = "foo"; payload = None; syntax = Percent}];
|
||||
loc = <loc>}]}
|
||||
|}]
|
||||
|
||||
parse {|"bar\%foo"|}
|
||||
[%%expect{|
|
||||
- : Usexp.t list parse_result =
|
||||
Different
|
||||
{jbuild = Ok [Quoted_string "bar\\%foo"];
|
||||
dune = Error "unknown escape sequence"}
|
||||
|}]
|
||||
|
||||
(* +-----------------------------------------------------------------+
|
||||
| Printing tests |
|
||||
+-----------------------------------------------------------------+ *)
|
||||
|
||||
let loc = Sexp.Loc.in_file "<none>"
|
||||
let a = Sexp.atom
|
||||
let s x = Sexp.Quoted_string x
|
||||
let t x = Sexp.Template { quoted = false; parts = x; loc }
|
||||
let tq x = Sexp.Template { quoted = true ; parts = x; loc }
|
||||
let l x = Sexp.List x
|
||||
let var ?(syntax=Sexp.Template.Percent) ?payload name =
|
||||
{ Sexp.Template.
|
||||
loc
|
||||
; name
|
||||
; payload
|
||||
; syntax
|
||||
}
|
||||
|
||||
type sexp = S of Sexp.syntax * Sexp.t
|
||||
|
||||
let print_sexp ppf (S (syntax, sexp)) = Sexp.pp syntax ppf sexp;;
|
||||
#install_printer print_sexp
|
||||
|
||||
type round_trip_result =
|
||||
| Round_trip_success
|
||||
| Did_not_round_trip of Sexp.t
|
||||
| Did_not_parse_back of string
|
||||
|
||||
let test syntax sexp =
|
||||
(S (syntax, sexp),
|
||||
let s = Format.asprintf "%a" (Sexp.pp syntax) sexp in
|
||||
match
|
||||
Sexp.parse_string s ~mode:Single ~fname:""
|
||||
~lexer:(match syntax with
|
||||
| Jbuild -> Sexp.Lexer.jbuild_token
|
||||
| Dune -> Sexp.Lexer.token)
|
||||
with
|
||||
| sexp' ->
|
||||
let sexp' = Sexp.Ast.remove_locs sexp' in
|
||||
if sexp = sexp' then
|
||||
Round_trip_success
|
||||
else
|
||||
Did_not_round_trip sexp'
|
||||
| exception (Sexp.Parse_error e) ->
|
||||
Did_not_parse_back (Sexp.Parse_error.message e))
|
||||
;;
|
||||
#install_printer print_sexp
|
||||
|
||||
[%%expect{|
|
||||
val loc : Usexp.Loc.t = <loc>
|
||||
val a : string -> Usexp.t = <fun>
|
||||
val s : string -> Usexp.t = <fun>
|
||||
val t : Usexp.Template.part list -> Usexp.t = <fun>
|
||||
val tq : Usexp.Template.part list -> Usexp.t = <fun>
|
||||
val l : Usexp.t list -> Usexp.t = <fun>
|
||||
val var :
|
||||
?syntax:Usexp.Template.var_syntax ->
|
||||
?payload:string -> string -> Usexp.Template.var = <fun>
|
||||
type sexp = S of Usexp.syntax * Usexp.t
|
||||
val print_sexp : Format.formatter -> sexp -> unit = <fun>
|
||||
type round_trip_result =
|
||||
Round_trip_success
|
||||
| Did_not_round_trip of Usexp.t
|
||||
| Did_not_parse_back of string
|
||||
val test : Usexp.syntax -> Usexp.t -> sexp * round_trip_result = <fun>
|
||||
|}]
|
||||
|
||||
test Dune (a "toto")
|
||||
[%%expect{|
|
||||
- : sexp * round_trip_result = (toto, Round_trip_success)
|
||||
|}]
|
||||
|
||||
test Dune (t [Text "x%{"])
|
||||
[%%expect{|
|
||||
Exception: Invalid_argument "Invalid text \"x%{\" in unquoted template".
|
||||
|}]
|
||||
|
||||
test Dune (t [Text "x%"; Text "{"])
|
||||
[%%expect{|
|
||||
Exception: Invalid_argument "Invalid text \"x%{\" in unquoted template".
|
||||
|}]
|
||||
|
||||
(* This round trip failure is expected *)
|
||||
test Dune (tq [Text "x%{"])
|
||||
[%%expect{|
|
||||
- : sexp * round_trip_result =
|
||||
("x\%{", Did_not_round_trip (Quoted_string "x%{"))
|
||||
|}]
|
||||
|
||||
test Dune (tq [Text "x%"; Text "{"])
|
||||
[%%expect{|
|
||||
- : sexp * round_trip_result =
|
||||
("x\%{", Did_not_round_trip (Quoted_string "x%{"))
|
||||
|}]
|
||||
|
|
|
@ -5,13 +5,13 @@ let () = Printexc.record_backtrace true
|
|||
(* Test that all strings of length <= 3 such that [Usexp.Atom.is_valid
|
||||
s] are recignized as atoms by the parser *)
|
||||
|
||||
let string_of_syntax (x : Usexp.Atom.syntax) =
|
||||
let string_of_syntax (x : Usexp.syntax) =
|
||||
match x with
|
||||
| Dune -> "dune"
|
||||
| Jbuild -> "jbuild"
|
||||
|
||||
let () =
|
||||
[ Usexp.Atom.Dune, Usexp.Lexer.token, (fun s -> Usexp.Atom.is_valid s Dune)
|
||||
[ Usexp.Dune, Usexp.Lexer.token, (fun s -> Usexp.Atom.is_valid s Dune)
|
||||
; Jbuild, Usexp.Lexer.jbuild_token, (fun s -> Usexp.Atom.is_valid s Jbuild)
|
||||
]
|
||||
|> List.iter ~f:(fun (syntax, lexer, validator) ->
|
||||
|
|
|
@ -18,7 +18,7 @@ let print_pkg ppf pkg =
|
|||
#install_printer String_map.pp;;
|
||||
|
||||
[%%expect{|
|
||||
val print_pkg : Format.formatter -> Dune.Findlib.Package.t -> unit = <fun>
|
||||
val print_pkg : Format.formatter -> Findlib.Package.t -> unit = <fun>
|
||||
|}]
|
||||
|
||||
let findlib =
|
||||
|
@ -29,7 +29,7 @@ let findlib =
|
|||
;;
|
||||
|
||||
[%%expect{|
|
||||
val findlib : Dune.Findlib.t = <abstr>
|
||||
val findlib : Findlib.t = <abstr>
|
||||
|}]
|
||||
|
||||
let pkg =
|
||||
|
@ -38,7 +38,7 @@ let pkg =
|
|||
| Error _ -> assert false;;
|
||||
|
||||
[%%expect{|
|
||||
val pkg : Dune.Findlib.Package.t = <package:foo>
|
||||
val pkg : Findlib.Package.t = <package:foo>
|
||||
|}]
|
||||
|
||||
(* "foo" should depend on "baz" *)
|
||||
|
@ -60,7 +60,7 @@ let meta =
|
|||
|> Meta.load ~name:"foo"
|
||||
|
||||
[%%expect{|
|
||||
val meta : Dune.Meta.Simplified.t =
|
||||
val meta : Simplified.t =
|
||||
{ name = "foo"
|
||||
; vars =
|
||||
(requires =
|
||||
|
@ -89,7 +89,7 @@ let conf =
|
|||
~toolchain:"tlc" ~context:"<context>"
|
||||
|
||||
[%%expect{|
|
||||
val conf : Dune.Findlib.Config.t =
|
||||
val conf : Findlib.Config.t =
|
||||
{ vars =
|
||||
[ (FOO_BAR, { set_rules =
|
||||
[ { preds_required = [ "tlc"; "env" ]
|
||||
|
@ -104,15 +104,15 @@ val conf : Dune.Findlib.Config.t =
|
|||
}
|
||||
|}]
|
||||
|
||||
let env_pp fmt env = Sexp.pp fmt (Env.sexp_of_t env);;
|
||||
let env_pp fmt env = Sexp.pp Dune fmt (Env.sexp_of_t env);;
|
||||
#install_printer env_pp;;
|
||||
|
||||
[%%expect{|
|
||||
val env_pp : Format.formatter -> Dune.Env.t -> unit = <fun>
|
||||
val env_pp : Format.formatter -> Env.t -> unit = <fun>
|
||||
|}]
|
||||
|
||||
let env = Findlib.Config.env conf
|
||||
|
||||
[%%expect{|
|
||||
val env : Dune.Env.t = ((FOO_BAR "my variable"))
|
||||
val env : Env.t = ((FOO_BAR "my variable"))
|
||||
|}]
|
||||
|
|
Loading…
Reference in New Issue