diff options
37 files changed, 825 insertions, 260 deletions
@@ -341,7 +341,7 @@ Bug fixes: - PR#5973: Format module incorrectly parses format string (Pierre Weis, report by Frédéric Bour) - PR#5974: better documentation for Str.regexp - (Damien Doligez, report by user 'william') + (Damien Doligez, report by william) - PR#5976: crash after recovering from two stack overflows (ocamlopt on MacOS X) (Xavier Leroy, report by Pierre Boutillier) - PR#5977: Build failure on raspberry pi: "input_value: integer too large" @@ -406,6 +406,8 @@ Bug fixes: (Jacques Garrigue, report by Jeremy Yallop) - PR#6163: Assert_failure using polymorphic variants in GADTs (Jacques Garrigue, report by Leo P. White) +- PR#6164: segmentation fault on Num.power_num of 0/1 + (Fabrice Le Fessant, report by Johannes Kanig) Feature wishes: - PR#5181: Merge common floating point constants in ocamlopt @@ -745,11 +745,11 @@ otherlibrariesopt: partialclean:: for i in $(OTHERLIBRARIES); do \ - (cd otherlibs/$$i; $(MAKE) partialclean); \ + (cd otherlibs/$$i && $(MAKE) partialclean); \ done clean:: - for i in $(OTHERLIBRARIES); do (cd otherlibs/$$i; $(MAKE) clean); done + for i in $(OTHERLIBRARIES); do (cd otherlibs/$$i && $(MAKE) clean); done alldepend:: for i in $(OTHERLIBRARIES); do (cd otherlibs/$$i; $(MAKE) depend); done @@ -1,4 +1,4 @@ -4.02.0+dev1-2013-09-04 +4.02.0+dev2-2013-09-12 # The version string is the first line of this file. # It must be in the format described in stdlib/sys.mli @@ -17,6 +17,8 @@ true: -traverse # Traverse only these directories <{bytecomp,driver,stdlib,tools,asmcomp,camlp4,ocamlbuild,toplevel,ocamldoc,typing,otherlibs,utils,debugger,lex,parsing,byterun,asmrun}/**>: traverse +"ocamlbuild/test" or "ocamlbuild/testsuite": -traverse + "boot" or "byterun" or "asmrun" or "compilerlibs": not_hygienic # These should not be required but it fails on *BSD and Windows... @@ -86,6 +88,5 @@ true: use_stdlib <otherlibs/threads/**>: otherlibs_threads "otherlibs/threads/unix.cma": -otherlibs_threads <otherlibs/systhreads/**>: otherlibs_systhreads -<otherlibs/dbm/**>: otherlibs_dbm <otherlibs/graph/**>: otherlibs_graph <otherlibs/win32graph/**>: otherlibs_win32graph diff --git a/build/boot.sh b/build/boot.sh index 059df99c3..0f1b82e62 100755 --- a/build/boot.sh +++ b/build/boot.sh @@ -31,7 +31,7 @@ rm -f _build/myocamlbuild boot/ocamlrun boot/myocamlbuild.boot \ -just-plugin -install-lib-dir _build/ocamlbuild -byte-plugin \ - -no-ocamlfind + -no-ocamlfind || exit 1 cp _build/myocamlbuild boot/myocamlbuild diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml index 8dab7d8d6..a5f292fb5 100644 --- a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml +++ b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml @@ -694,10 +694,10 @@ value varify_constructors var_names = | ExAcc loc _ _ | <:expr@loc< $id:<:ident< $_$ . $_$ >>$ >> as e -> let (e, l) = match sep_expr_acc [] e with - [ [(loc, ml, <:expr@sloc< $uid:s$ >>) :: l] -> - (mkexp loc (Pexp_construct (mkli sloc (conv_con s) ml) None), l) - | [(loc, ml, <:expr@sloc< $lid:s$ >>) :: l] -> - (mkexp loc (Pexp_ident (mkli sloc s ml)), l) + [ [(loc, ml, <:expr< $uid:s$ >>) :: l] -> + (mkexp loc (Pexp_construct (mkli loc (conv_con s) ml) None), l) + | [(loc, ml, <:expr< $lid:s$ >>) :: l] -> + (mkexp loc (Pexp_ident (mkli loc s ml)), l) | [(_, [], e) :: l] -> (expr e, l) | _ -> error loc "bad ast in expression" ] in diff --git a/myocamlbuild.ml b/myocamlbuild.ml index bd6eb17d1..da5625c05 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -17,6 +17,7 @@ open Format module C = Myocamlbuild_config +let () = mark_tag_used "windows";; let windows = Sys.os_type = "Win32";; if windows then tag_any ["windows"];; let ccomptype = C.ccomptype @@ -399,6 +400,15 @@ rule "C files" mkobj (env ("%"-.-C.o)) (env "%.c") N end;; +let () = + (* define flags otherlibs_unix, otherlibs_bigarray... *) + let otherlibs = "otherlibs" in + let open Pathname in + Array.iter (fun file -> + if is_directory (concat "otherlibs" file) then + mark_tag_used ("otherlibs_" ^ file) + ) (readdir otherlibs);; + (* ../ is because .h files are not dependencies so they are not imported in build dir *) flag ["c"; "compile"; "otherlibs_bigarray"] (S[A"-I"; P"../otherlibs/bigarray"]);; flag [(* "ocaml" or "c"; *) "ocamlmklib"; "otherlibs_graph"] (S[Sh C.x11_link]);; diff --git a/ocamlbuild/configuration.ml b/ocamlbuild/configuration.ml index c77cca926..551acae6d 100644 --- a/ocamlbuild/configuration.ml +++ b/ocamlbuild/configuration.ml @@ -19,9 +19,8 @@ open Lexers type t = Lexers.conf let acknowledge_config config = - List.iter - (fun (_, config) -> List.iter Param_tags.acknowledge config.plus_tags) - config + let ack (tag, loc) = Param_tags.acknowledge (Some loc) tag in + List.iter (fun (_, config) -> List.iter ack config.plus_tags) config let cache = Hashtbl.create 107 let (configs, add_config) = @@ -33,23 +32,27 @@ let (configs, add_config) = Hashtbl.clear cache) let parse_lexbuf ?dir source lexbuf = - lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = source }; + lexbuf.Lexing.lex_curr_p <- + { lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = source }; let conf = Lexers.conf_lines dir lexbuf in add_config conf -let parse_string s = parse_lexbuf (Printf.sprintf "String %S" s) (Lexing.from_string s) +let parse_string s = + parse_lexbuf (Printf.sprintf "STRING(%s)" s) (Lexing.from_string s) let parse_file ?dir file = with_input_file file begin fun ic -> - parse_lexbuf ?dir (Printf.sprintf "File %S" file) (Lexing.from_channel ic) + parse_lexbuf ?dir file (Lexing.from_channel ic) end let key_match = Glob.eval let apply_config s (config : t) init = + let add (tag, _loc) = Tags.add tag in + let remove (tag, _loc) = Tags.remove tag in List.fold_left begin fun tags (key, v) -> if key_match key s then - List.fold_right Tags.add v.plus_tags (List.fold_right Tags.remove v.minus_tags tags) + List.fold_right add v.plus_tags (List.fold_right remove v.minus_tags tags) else tags end init config @@ -70,3 +73,18 @@ let tag_file file tags = let tag_any tags = if tags <> [] then parse_string (Printf.sprintf "true: %s" (String.concat ", " tags));; + +let check_tags_usage useful_tags = + let check_tag (tag, loc) = + if not (Tags.mem tag useful_tags) then + Log.eprintf "%aWarning: the tag %S is not used in any flag declaration, \ + so it will have no effect; it may be a typo. Otherwise use \ + `mark_tag_used` in your myocamlbuild.ml to disable \ + this warning." + Loc.print_loc loc tag + in + let check_conf (_, values) = + List.iter check_tag values.plus_tags; + List.iter check_tag values.minus_tags; + in + List.iter (List.iter check_conf) (configs ()) diff --git a/ocamlbuild/configuration.mli b/ocamlbuild/configuration.mli index 37ee64eb7..1f8856aac 100644 --- a/ocamlbuild/configuration.mli +++ b/ocamlbuild/configuration.mli @@ -37,3 +37,8 @@ val tag_any : Tags.elt list -> unit (** the tags that apply to any file *) val global_tags : unit -> Tags.t + +(** Given the list of all tags that are really used by an existing + flagset, traverse existing configuration files and warns on tags + that will never get used. *) +val check_tags_usage : Tags.t -> unit diff --git a/ocamlbuild/flags.ml b/ocamlbuild/flags.ml index 9999f835c..c776953ba 100644 --- a/ocamlbuild/flags.ml +++ b/ocamlbuild/flags.ml @@ -15,24 +15,35 @@ open Command open Bool (* FIXME remove me *) open Tags.Operators -let all_flags = ref [] -let of_tags tags = +type decl = { + tags: Tags.t; + flags: Command.spec; + deprecated: bool; +} +let flags_of_decl { flags; _ } = flags +let tags_of_decl { tags; _ } = tags + +let all_decls = ref [] + +let of_tags matched_tags = S begin - List.fold_left begin fun acc (xtags, xflags) -> - if Tags.does_match tags xtags then xflags :: acc + List.fold_left begin fun acc { tags; flags; _ } -> + if Tags.does_match matched_tags tags then flags :: acc else acc - end [] !all_flags + end [] !all_decls end let () = Command.tag_handler := of_tags let of_tag_list x = of_tags (Tags.of_list x) -let set_flags tags flags = - all_flags := (tags, flags) :: !all_flags +let add_decl decl = + all_decls := decl :: !all_decls -let flag tags flags = set_flags (Tags.of_list tags) flags +let flag ?(deprecated=false) tags flags = + let tags = Tags.of_list tags in + add_decl { tags; flags; deprecated } let pflag tags ptag flags = Param_tags.declare ptag @@ -41,4 +52,27 @@ let pflag tags ptag flags = let add x xs = x :: xs let remove me = List.filter (fun x -> me <> x) -let get_flags () = !all_flags +let pretty_print { tags; flags; deprecated } = + let sflag = Command.string_of_command_spec flags in + let header = if deprecated then "deprecated flag" else "flag" in + let pp fmt = Log.raw_dprintf (-1) fmt in + pp "@[<2>%s@ {. %a .}@ %S@]@\n@\n" header Tags.print tags sflag + +let show_documentation () = + List.iter + (fun decl -> if not decl.deprecated then pretty_print decl) + !all_decls; + List.iter + (fun decl -> if decl.deprecated then pretty_print decl) + !all_decls; + let pp fmt = Log.raw_dprintf (-1) fmt in + pp "@." + +let used_tags = ref Tags.empty + +let mark_tag_used tag = + used_tags := Tags.add tag !used_tags + +let get_used_tags () = + List.fold_left (fun acc decl -> Tags.union acc decl.tags) + !used_tags !all_decls diff --git a/ocamlbuild/flags.mli b/ocamlbuild/flags.mli index 13c5436a7..b32de2bc8 100644 --- a/ocamlbuild/flags.mli +++ b/ocamlbuild/flags.mli @@ -14,11 +14,27 @@ (* Original author: Nicolas Pouillard *) val of_tags : Tags.t -> Command.spec val of_tag_list : Tags.elt list -> Command.spec -val flag : Tags.elt list -> Command.spec -> unit + +(* The ?deprecated parameter marks the flag declaration as deprecated, + because it is superseded by a different, better way to express the + same thing (eg. a parametrized tag). So far, it is only used when + showing documentation. + + This flag is not exported in OCamlbuild_plugin interface for now. It + would make sense to let plugin authors deprecate their own flags, + but it has to be balanced again the simplicity of the plugin + interface exposed. If you're reading this as a plugin author that + has a real need for deprecation, drop us a note on the bugtracker. *) +val flag : ?deprecated:bool -> Tags.elt list -> Command.spec -> unit + val pflag : Tags.elt list -> string -> (string -> Command.spec) -> unit val add : 'a -> 'a list -> 'a list val remove : 'a -> 'a list -> 'a list -(** For system use only *) +val show_documentation : unit -> unit + +(** "useful" tags: they are used by a tag declaration, or have been + explicitly added with [mark_as_used] *) +val get_used_tags : unit -> Tags.t -val get_flags : unit -> (Tags.t * Command.spec) list +val mark_tag_used : Tags.elt -> unit diff --git a/ocamlbuild/lexers.mli b/ocamlbuild/lexers.mli index ae4939aa4..a59d7589b 100644 --- a/ocamlbuild/lexers.mli +++ b/ocamlbuild/lexers.mli @@ -12,11 +12,11 @@ (* Original author: Nicolas Pouillard *) -exception Error of (string * Lexing.position) +exception Error of (string * Loc.location) type conf_values = - { plus_tags : string list; - minus_tags : string list } + { plus_tags : (string * Loc.location) list; + minus_tags : (string * Loc.location) list } type conf = (Glob.globber * conf_values) list diff --git a/ocamlbuild/lexers.mll b/ocamlbuild/lexers.mll index 12099febd..797337d85 100644 --- a/ocamlbuild/lexers.mll +++ b/ocamlbuild/lexers.mll @@ -13,19 +13,23 @@ (* Original author: Nicolas Pouillard *) { -exception Error of (string * Lexing.position) +exception Error of (string * Loc.location) -let error lexbuf fmt = Printf.ksprintf (fun s -> raise (Error (s,Lexing.lexeme_start_p lexbuf))) fmt +let error lexbuf fmt = + Printf.ksprintf (fun s -> raise (Error (s, Loc.of_lexbuf lexbuf))) fmt open Glob_ast type conf_values = - { plus_tags : string list; - minus_tags : string list } + { plus_tags : (string * Loc.location) list; + minus_tags : (string * Loc.location) list } type conf = (Glob.globber * conf_values) list let empty = { plus_tags = []; minus_tags = [] } + +let locate lexbuf txt = + (txt, Loc.of_lexbuf lexbuf) } let newline = ('\n' | '\r' | "\r\n") @@ -122,8 +126,8 @@ and conf_lines dir = parse | _ { error lexbuf "Invalid line syntax" } and conf_value x = parse - | '-' (tag as tag) { { (x) with minus_tags = tag :: x.minus_tags } } - | '+'? (tag as tag) { { (x) with plus_tags = tag :: x.plus_tags } } + | '-' (tag as tag) { { (x) with minus_tags = locate lexbuf tag :: x.minus_tags } } + | '+'? (tag as tag) { { (x) with plus_tags = locate lexbuf tag :: x.plus_tags } } | (_ | eof) { error lexbuf "Invalid tag modifier only '+ or '-' are allowed as prefix for tag" } and conf_values x = parse diff --git a/ocamlbuild/loc.ml b/ocamlbuild/loc.ml new file mode 100644 index 000000000..2bf3900e8 --- /dev/null +++ b/ocamlbuild/loc.ml @@ -0,0 +1,30 @@ +(* it's not worth adding a dependency on parsing/location.ml(i) or + compilerlibs just to support location printing, so we re-implement + that here *) + +open Lexing + +type location = position * position + +let file loc = loc.pos_fname +let line loc = loc.pos_lnum +let char loc = loc.pos_cnum - loc.pos_bol + +let print_loc ppf (start, end_) = + let open Format in + let print one_or_two ppf (start_num, end_num) = + if one_or_two then fprintf ppf " %d" start_num + else fprintf ppf "s %d-%d" start_num end_num in + fprintf ppf "File %S, line%a, character%a:@." + (file start) + (print (line start = line end_)) + (line start, line end_) + (print (line start = line end_ && char start = char end_)) + (char start, char end_) + +let of_lexbuf lexbuf = + (lexbuf.lex_start_p, lexbuf.lex_curr_p) + +let print_loc_option ppf = function + | None -> () + | Some loc -> print_loc ppf loc diff --git a/ocamlbuild/loc.mli b/ocamlbuild/loc.mli new file mode 100644 index 000000000..9ed842ef2 --- /dev/null +++ b/ocamlbuild/loc.mli @@ -0,0 +1,6 @@ +type location = Lexing.position * Lexing.position + +val print_loc : Format.formatter -> location -> unit +val print_loc_option : Format.formatter -> location option -> unit + +val of_lexbuf : Lexing.lexbuf -> location diff --git a/ocamlbuild/main.ml b/ocamlbuild/main.ml index ecf4b5794..5f86f7932 100644 --- a/ocamlbuild/main.ml +++ b/ocamlbuild/main.ml @@ -48,17 +48,17 @@ let show_tags () = ;; let show_documentation () = - let rules = Rule.get_rules () in - let flags = Flags.get_flags () in - let pp fmt = Log.raw_dprintf (-1) fmt in - List.iter begin fun rule -> - pp "%a@\n@\n" (Rule.pretty_print Resource.print_pattern) rule - end rules; - List.iter begin fun (tags, flag) -> - let sflag = Command.string_of_command_spec flag in - pp "@[<2>flag@ {. %a .}@ %S@]@\n@\n" Tags.print tags sflag - end flags; - pp "@." + Rule.show_documentation (); + Flags.show_documentation (); +;; + +(* these tags are used in an ad-hoc way by the ocamlbuild implementation; + this means that even if they were not part of any flag declaration, + they should be marked as useful, to avoid the "unused tag" warning. *) +let builtin_useful_tags = + Tags.of_list + ["include"; "traverse"; "not_hygienic"; + "pack"; "ocamlmklib"; "native"; "thread"; "nopervasives"] ;; let proceed () = @@ -182,6 +182,10 @@ let proceed () = show_documentation (); raise Exit_silently end; + + let all_tags = Tags.union builtin_useful_tags (Flags.get_used_tags ()) in + Configuration.check_tags_usage all_tags; + Digest_cache.init (); Sys.catch_break true; @@ -297,9 +301,8 @@ let main () = | Ocaml_utils.Ocamldep_error msg -> Log.eprintf "Ocamldep error: %s" msg; exit rc_ocamldep_error - | Lexers.Error (msg,pos) -> - let module L = Lexing in - Log.eprintf "%s, line %d, column %d: Lexing error: %s." pos.L.pos_fname pos.L.pos_lnum (pos.L.pos_cnum - pos.L.pos_bol) msg; + | Lexers.Error (msg,loc) -> + Log.eprintf "%aLexing error: %s." Loc.print_loc loc msg; exit rc_lexing_error | Arg.Bad msg -> Log.eprintf "%s" msg; diff --git a/ocamlbuild/ocaml_specific.ml b/ocamlbuild/ocaml_specific.ml index bab898325..cd852f626 100644 --- a/ocamlbuild/ocaml_specific.ml +++ b/ocamlbuild/ocaml_specific.ml @@ -66,6 +66,9 @@ let x_native_o = "%.native"-.-ext_obj;; rule "target files" ~dep:"%.itarget" ~stamp:"%.otarget" + ~doc:"If foo.itarget contains a list of ocamlbuild targets, \ + asking ocamlbuild to produce foo.otarget will \ + build each of those targets in turn." begin fun env build -> let itarget = env "%.itarget" in let dir = Pathname.dirname itarget in @@ -92,6 +95,21 @@ rule "ocaml: mlpack & d.cmo* -> d.cmo & cmi" rule "ocaml: mlpack & cmo* & cmi -> cmo" ~prod:"%.cmo" ~deps:["%.mli"; "%.cmi"; "%.mlpack"] + ~doc:"If foo.mlpack contains a list of capitalized module names, \ + the target foo.cmo will produce a packed module containing \ + those modules as submodules. You can also have a foo.mli file \ + to restrict the interface of the resulting module. + +\ + Warning: to produce a native foo.cmx out of a foo.mlpack, you must \ + manually tag the included compilation units with for-pack(foo). \ + See the documentation of the corresponding rules for more details. + +\ + The modules named in the .mlpack \ + will be dynamic dependencies of the compilation action. \ + You cannot give the .mlpack the same name as one of the module \ + it contains, as this would create a circular dependency." (Ocaml_compiler.byte_pack_mlpack "%.mlpack" "%.cmo");; rule "ocaml: mlpack & cmo* -> cmo & cmi" @@ -103,6 +121,13 @@ rule "ocaml: ml & cmi -> d.cmo" ~prod:"%.d.cmo" ~deps:["%.mli"(* This one is inserted to force this rule to be skiped when a .ml is provided without a .mli *); "%.ml"; "%.ml.depends"; "%.cmi"] + ~doc:"The foo.d.cmo target compiles foo.ml with the 'debug' tag enabled (-g).\ + See also foo.d.byte. + +\ + For technical reason, .d.cmx and .d.native are not yet supported, \ + so you should explicitly add the 'debug' tag \ + to native targets (both compilation and linking)." (Ocaml_compiler.byte_compile_ocaml_implem ~tag:"debug" "%.ml" "%.d.cmo");; rule "ocaml: ml & cmi -> cmo" @@ -112,18 +137,39 @@ rule "ocaml: ml & cmi -> cmo" (Ocaml_compiler.byte_compile_ocaml_implem "%.ml" "%.cmo");; rule "ocaml: mlpack & cmi & p.cmx* & p.o* -> p.cmx & p.o" - ~prods:["%.p.cmx"; x_p_o(* no cmi here you must make the byte version to have it *)] + ~prods:["%.p.cmx"; x_p_o + (* no cmi here you must make the byte version to have it *)] ~deps:["%.mlpack"; "%.cmi"] (Ocaml_compiler.native_profile_pack_mlpack "%.mlpack" "%.p.cmx");; rule "ocaml: mlpack & cmi & cmx* & o* -> cmx & o" - ~prods:["%.cmx"; x_o(* no cmi here you must make the byte version to have it *)] + ~prods:["%.cmx"; x_o + (* no cmi here you must make the byte version to have it *)] ~deps:["%.mlpack"; "%.cmi"] + ~doc:"If foo.mlpack contains a list of capitalized module names, \ + the target foo.cmx will produce a packed module containing \ + those modules as submodules. + +\ + Warning: The .cmx files that will be included must be manually tagged \ + with the tag \"for-pack(foo)\". This means that you cannot include \ + the same bar.cmx in several .mlpack files, and that you should not \ + use an included .cmx as a separate module on its own. + +\ + This requirement comes from a technical limitation of \ + native module packing: ocamlopt needs the -for-pack argument to be passed \ + ahead of time, when compiling each included submodule, \ + because there is no reliable, portable way to rewrite \ + native object files afterwards." (Ocaml_compiler.native_pack_mlpack "%.mlpack" "%.cmx");; rule "ocaml: ml & cmi -> p.cmx & p.o" ~prods:["%.p.cmx"; x_p_o] ~deps:["%.ml"; "%.ml.depends"; "%.cmi"] + ~doc:"The foo.p.cmx target compiles foo.ml with the 'profile' \ + tag enabled (-p). Note that ocamlbuild provides no support \ + for the bytecode profiler, which works completely differently." (Ocaml_compiler.native_compile_ocaml_implem ~tag:"profile" ~cmx_ext:"p.cmx" "%.ml");; rule "ocaml: ml & cmi -> cmx & o" @@ -139,11 +185,22 @@ rule "ocaml: ml -> d.cmo & cmi" rule "ocaml: ml -> cmo & cmi" ~prods:["%.cmo"; "%.cmi"] ~deps:["%.ml"; "%.ml.depends"] + ~doc:"This rule allows to produce a .cmi from a .ml file \ + when the corresponding .mli is missing. + +\ + Note: you are strongly encourage to have a .mli file \ + for each of your .ml module, as it is a good development \ + practice which also simplifies the way build systems work, \ + as it avoids producing .cmi files as a silent side-effect of \ + another compilation action." (Ocaml_compiler.byte_compile_ocaml_implem "%.ml" "%.cmo");; rule "ocaml: d.cmo* -> d.byte" ~prod:"%.d.byte" ~dep:"%.d.cmo" + ~doc:"The target foo.d.byte will build a bytecode executable \ + with debug information enabled." (Ocaml_compiler.byte_debug_link "%.d.cmo" "%.d.byte");; rule "ocaml: cmo* -> byte" @@ -154,6 +211,9 @@ rule "ocaml: cmo* -> byte" rule "ocaml: cmo* -> byte.(o|obj)" ~prod:x_byte_o ~dep:"%.cmo" + ~doc:"The foo.byte.o target, or foo.byte.obj under Windows, \ + will produce an object file by passing the -output-obj option \ + to the OCaml compiler. See also foo.byte.c, and foo.native.{o,obj}." (Ocaml_compiler.byte_output_obj "%.cmo" x_byte_o);; rule "ocaml: cmo* -> byte.c" @@ -164,11 +224,14 @@ rule "ocaml: cmo* -> byte.c" rule "ocaml: p.cmx* & p.o* -> p.native" ~prod:"%.p.native" ~deps:["%.p.cmx"; x_p_o] + ~doc:"The foo.p.native target builds the native executable \ + with the 'profile' tag (-p) enabled throughout compilation and linking." (Ocaml_compiler.native_profile_link "%.p.cmx" "%.p.native");; rule "ocaml: cmx* & o* -> native" ~prod:"%.native" ~deps:["%.cmx"; x_o] + ~doc:"Builds a native executable" (Ocaml_compiler.native_link "%.cmx" "%.native");; rule "ocaml: cmx* & o* -> native.(o|obj)" @@ -184,6 +247,10 @@ rule "ocaml: mllib & d.cmo* -> d.cma" rule "ocaml: mllib & cmo* -> cma" ~prod:"%.cma" ~dep:"%.mllib" + ~doc:"Build a .cma archive file (bytecode library) containing \ + the list of modules given in the .mllib file of the same name. \ + Note that the .cma archive will contain exactly the modules listed, \ + so it may not be self-contained if some dependencies are missing." (Ocaml_compiler.byte_library_link_mllib "%.mllib" "%.cma");; rule "ocaml: d.cmo* -> d.cma" @@ -194,6 +261,10 @@ rule "ocaml: d.cmo* -> d.cma" rule "ocaml: cmo* -> cma" ~prod:"%.cma" ~dep:"%.cmo" + ~doc:"The preferred way to build a .cma archive is to create a .mllib file \ + with a list of modules to include. It is however possible to build one \ + from a .cmo of the same name; the archive will include this module and \ + the local modules it depends upon, transitively." (Ocaml_compiler.byte_library_link "%.cmo" "%.cma");; rule "ocaml C stubs: clib & (o|obj)* -> (a|lib) & (so|dll)" @@ -203,6 +274,7 @@ rule "ocaml C stubs: clib & (o|obj)* -> (a|lib) & (so|dll)" else []) ~dep:"%(path)lib%(libname).clib" + ?doc:None (* TODO document *) (C_tools.link_C_library "%(path)lib%(libname).clib" ("%(path)lib%(libname)"-.-ext_lib) "%(path)%(libname)");; rule "ocaml: mllib & p.cmx* & p.o* -> p.cmxa & p.a" @@ -213,6 +285,11 @@ rule "ocaml: mllib & p.cmx* & p.o* -> p.cmxa & p.a" rule "ocaml: mllib & cmx* & o* -> cmxa & a" ~prods:["%.cmxa"; x_a] ~dep:"%.mllib" + ~doc:"Creates a native archive file .cmxa, using the .mllib file \ + as the .cma rule above. Note that whereas bytecode .cma can \ + be used both for static and dynamic linking, .cmxa only support \ + static linking. For an archive usable with Dynlink, \ + see the rule producing a .cmxs from a .mldylib." (Ocaml_compiler.native_library_link_mllib "%.mllib" "%.cmxa");; rule "ocaml: p.cmx & p.o -> p.cmxa & p.a" @@ -223,6 +300,10 @@ rule "ocaml: p.cmx & p.o -> p.cmxa & p.a" rule "ocaml: cmx & o -> cmxa & a" ~prods:["%.cmxa"; x_a] ~deps:["%.cmx"; x_o] + ~doc:"Just as you can build a .cma from a .cmo in absence of .mllib file, \ + you can build a .cmxa (native archive file for static linking only) \ + from a .cmx, which will include the local modules it depends upon, \ + transitivitely." (Ocaml_compiler.native_library_link "%.cmx" "%.cmxa");; rule "ocaml: mldylib & p.cmx* & p.o* -> p.cmxs & p.so" @@ -233,6 +314,8 @@ rule "ocaml: mldylib & p.cmx* & p.o* -> p.cmxs & p.so" rule "ocaml: mldylib & cmx* & o* -> cmxs & so" ~prods:["%.cmxs"; x_dll] ~dep:"%.mldylib" + ~doc:"Builds a .cmxs (native archive for dynamic linking) containing exactly \ + the modules listed in the corresponding .mldylib file." (Ocaml_compiler.native_shared_library_link_mldylib "%.mldylib" "%.cmxs");; rule "ocaml: p.cmx & p.o -> p.cmxs & p.so" @@ -248,6 +331,16 @@ rule "ocaml: p.cmxa & p.a -> p.cmxs & p.so" rule "ocaml: cmx & o -> cmxs" ~prods:["%.cmxs"] ~deps:["%.cmx"; x_o] + ~doc:"If you have not created a foo.mldylib file for a compilation unit \ + foo.cmx, the target foo.cmxs will produce a .cmxs file containing \ + exactly the .cmx. + +\ + Note: this differs from the behavior of .cmxa targets \ + with no .mllib, as the dependencies of the modules will not be \ + included: generally, the modules compiled as dynamic plugins depend \ + on library modules that will be already linked in the executable, \ + and that the .cmxs should therefore not duplicate." (Ocaml_compiler.native_shared_library_link "%.cmx" "%.cmxs");; rule "ocaml: cmx & o -> cmxs & so" @@ -258,11 +351,24 @@ rule "ocaml: cmx & o -> cmxs & so" rule "ocaml: cmxa & a -> cmxs & so" ~prods:["%.cmxs"; x_dll] ~deps:["%.cmxa"; x_a] + ~doc:"This rule allows to build a .cmxs from a .cmxa, to avoid having \ + to duplicate a .mllib file into a .mldylib." (Ocaml_compiler.native_shared_library_link ~tags:["linkall"] "%.cmxa" "%.cmxs");; rule "ocaml dependencies ml" ~prod:"%.ml.depends" ~dep:"%.ml" + ~doc:"OCamlbuild will use ocamldep to approximate dependencies \ + of a source file. The ocamldep tool being purely syntactic, \ + it only computes an over-approximation of the dependencies. + +\ + If you manipulate a module Foo that is in fact a submodule Bar.Foo \ + (after 'open Bar'), ocamldep may believe that your module depends \ + on foo.ml -- when such a file also exists in your project. This can \ + lead to spurious circular dependencies. In that case, you can use \ + OCamlbuild_plugin.non_dependency in your myocamlbuild.ml \ + to manually remove the spurious dependency. See the plugins API." (Ocaml_tools.ocamldep_command "%.ml" "%.ml.depends");; rule "ocaml dependencies mli" @@ -278,6 +384,8 @@ rule "ocamllex" rule "ocaml: mli -> odoc" ~prod:"%.odoc" ~deps:["%.mli"; "%.mli.depends"] + ~doc:".odoc are intermediate files storing the result of ocamldoc processing \ + on a source file. See the various .docdir/... targets for ocamldoc." (Ocaml_tools.document_ocaml_interf "%.mli" "%.odoc");; rule "ocaml: ml -> odoc" @@ -287,21 +395,27 @@ rule "ocaml: ml -> odoc" rule "ocamldoc: document ocaml project odocl & *odoc -> docdir (html)" ~prod:"%.docdir/index.html" - ~stamp:"%.docdir/html.stamp" (* Depend on this file if you want to depends on all files of %.docdir *) + ~stamp:"%.docdir/html.stamp" ~dep:"%.odocl" + ~doc:"If you put a list of capitalized module names in a foo.odocl file, \ + the target foo.docdir/index.html will call ocamldoc to produce \ + the html documentation for these modules. \ + See also the max|latex|doc target below." (Ocaml_tools.document_ocaml_project ~ocamldoc:Ocaml_tools.ocamldoc_l_dir "%.odocl" "%.docdir/index.html" "%.docdir");; rule "ocamldoc: document ocaml project odocl & *odoc -> docdir (man)" ~prod:"%.docdir/man" - ~stamp:"%.docdir/man.stamp" (* Depend on this file if you want to depends on all files of %.docdir/man *) + ~stamp:"%.docdir/man.stamp" ~dep:"%.odocl" + ?doc:None (* TODO document *) (Ocaml_tools.document_ocaml_project ~ocamldoc:Ocaml_tools.ocamldoc_l_dir "%.odocl" "%.docdir/man" "%.docdir");; rule "ocamldoc: document ocaml project odocl & *odoc -> man|latex|dot..." ~prod:"%(dir).docdir/%(file)" ~dep:"%(dir).odocl" + ?doc:None (* TODO document *) (Ocaml_tools.document_ocaml_project ~ocamldoc:Ocaml_tools.ocamldoc_l_file "%(dir).odocl" "%(dir).docdir/%(file)" "%(dir).docdir");; @@ -313,6 +427,12 @@ if !Options.use_menhir || Configuration.has_tag "use_menhir" then begin rule "ocaml: modular menhir (mlypack)" ~prods:["%.mli" ; "%.ml"] ~deps:["%.mlypack"] + ~doc:"Menhir supports building a parser by composing several .mly files \ + together, containing different parts of the grammar description. \ + To use that feature with ocamlbuild, you should create a .mlypack \ + file with the same syntax as .mllib or .mlpack files: \ + a whitespace-separated list of the capitalized module names \ + of the .mly files you want to combine together." (Ocaml_tools.menhir_modular "%" "%.mlypack" "%.mlypack.depends"); rule "ocaml: menhir modular dependencies" @@ -323,6 +443,9 @@ if !Options.use_menhir || Configuration.has_tag "use_menhir" then begin rule "ocaml: menhir" ~prods:["%.ml"; "%.mli"] ~deps:["%.mly"; "%.mly.depends"] + ~doc:"Invokes menhir to build the .ml and .mli files derived from a .mly \ + grammar. If you want to use ocamlyacc instead, you must disable the \ + -use-menhir option that was passed to ocamlbuild." (Ocaml_tools.menhir "%.mly"); rule "ocaml: menhir dependencies" @@ -334,11 +457,17 @@ end else rule "ocamlyacc" ~prods:["%.ml"; "%.mli"] ~dep:"%.mly" + ~doc:"By default, ocamlbuild will use ocamlyacc to produce a .ml and .mly \ + from a .mly file of the same name. You can also enable the \ + -use-menhir option to use menhir instead. Menhir is a recommended \ + replacement for ocamlyacc, that supports more feature, lets you \ + write more readable grammars, and helps you understand conflicts." (Ocaml_tools.ocamlyacc "%.mly");; rule "ocaml C stubs: c -> o" ~prod:x_o ~dep:"%.c" + ?doc:None (* TODO document *) begin fun env _build -> let c = env "%.c" in let o = env x_o in @@ -351,16 +480,28 @@ rule "ocaml C stubs: c -> o" rule "ocaml: ml & ml.depends & *cmi -> .inferred.mli" ~prod:"%.inferred.mli" ~deps:["%.ml"; "%.ml.depends"] + ~doc:"The target foo.inferred.mli will produce a .mli that exposes all the \ + declarations in foo.ml, as obtained by direct invocation of `ocamlc -i`." (Ocaml_tools.infer_interface "%.ml" "%.inferred.mli");; rule "ocaml: mltop -> top" ~prod:"%.top" ~dep:"%.mltop" + ?doc:None (* TODO document *) (Ocaml_compiler.byte_toplevel_link_mltop "%.mltop" "%.top");; rule "preprocess: ml -> pp.ml" ~dep:"%.ml" ~prod:"%.pp.ml" + ~doc:"The target foo.pp.ml should generate a source file equivalent \ + to foo.ml after syntactic preprocessors (camlp4, etc.) have been \ + applied. + +\ + Warning: This option is currently known to malfunction \ + when used together with -use-ocamlfind (for syntax extensions \ + coming from ocamlfind packages). Direct compilation of the \ + corresponding file to produce a .cmx or .cmo will still work well." (Ocaml_tools.camlp4 "pp.ml" "%.ml" "%.pp.ml");; flag ["ocaml"; "pp"] begin @@ -464,7 +605,10 @@ let () = pflag ["ocaml"; "infer_interface"] "pp" (fun param -> S [A "-pp"; A param]); pflag ["ocaml";"compile";] "warn" - (fun param -> S [A "-w"; A param]) + (fun param -> S [A "-w"; A param]); + pflag ["ocaml";"compile";] "warn_error" + (fun param -> S [A "-warn-error"; A param]); + () let camlp4_flags camlp4s = List.iter begin fun camlp4 -> @@ -551,18 +695,23 @@ flag ["ocaml"; "compile"; "nolabels"] (A"-nolabels");; flag ["ocaml"; "ocamllex"; "quiet"] (A"-q");; let ocaml_warn_flag c = - flag ["ocaml"; "compile"; sprintf "warn_%c" (Char.uppercase c)] - (S[A"-w"; A (sprintf "%c" (Char.uppercase c))]); - flag ["ocaml"; "compile"; sprintf "warn_error_%c" (Char.uppercase c)] - (S[A"-warn-error"; A (sprintf "%c" (Char.uppercase c))]); - flag ["ocaml"; "compile"; sprintf "warn_%c" (Char.lowercase c)] - (S[A"-w"; A (sprintf "%c" (Char.lowercase c))]); - flag ["ocaml"; "compile"; sprintf "warn_error_%c" (Char.lowercase c)] - (S[A"-warn-error"; A (sprintf "%c" (Char.lowercase c))]);; + flag ~deprecated:true + ["ocaml"; "compile"; sprintf "warn_%c" (Char.uppercase c)] + (S[A"-w"; A (sprintf "%c" (Char.uppercase c))]); + flag ~deprecated:true + ["ocaml"; "compile"; sprintf "warn_error_%c" (Char.uppercase c)] + (S[A"-warn-error"; A (sprintf "%c" (Char.uppercase c))]); + flag ~deprecated:true + ["ocaml"; "compile"; sprintf "warn_%c" (Char.lowercase c)] + (S[A"-w"; A (sprintf "%c" (Char.lowercase c))]); + flag ~deprecated:true + ["ocaml"; "compile"; sprintf "warn_error_%c" (Char.lowercase c)] + (S[A"-warn-error"; A (sprintf "%c" (Char.lowercase c))]);; List.iter ocaml_warn_flag ['A'; 'C'; 'D'; 'E'; 'F'; 'K'; 'L'; 'M'; 'P'; 'R'; 'S'; 'U'; 'V'; 'X'; 'Y'; 'Z'];; -flag ["ocaml"; "compile"; "strict-sequence"] (A "-strict-sequence");; +flag ~deprecated:true + ["ocaml"; "compile"; "strict-sequence"] (A "-strict-sequence");; flag ["ocaml"; "compile"; "strict_sequence"] (A "-strict-sequence");; flag ["ocaml"; "doc"; "docdir"; "extension:html"] (A"-html");; diff --git a/ocamlbuild/ocaml_utils.ml b/ocamlbuild/ocaml_utils.ml index b35ad679e..592769637 100644 --- a/ocamlbuild/ocaml_utils.ml +++ b/ocamlbuild/ocaml_utils.ml @@ -118,6 +118,10 @@ let ocaml_lib ?(extern=false) ?(byte=true) ?(native=true) ?dir ?tag_name libpath if not extern then dep tags [lib] (* cannot happen? *) in Hashtbl.replace info_libraries tag_name (libpath, extern); + (* adding [tag_name] to [info_libraries] will make this tag + affect include-dir lookups, so it is used even if not + mentioned explicitly in any rule. *) + Flags.mark_tag_used tag_name; if extern then begin if byte then flag_and_dep ["ocaml"; tag_name; "link"; "byte"] (libpath^".cma"); diff --git a/ocamlbuild/ocamlbuild_pack.mlpack b/ocamlbuild/ocamlbuild_pack.mlpack index 09dc4e026..83f1065f4 100644 --- a/ocamlbuild/ocamlbuild_pack.mlpack +++ b/ocamlbuild/ocamlbuild_pack.mlpack @@ -1,3 +1,4 @@ +Loc Log My_unix My_std diff --git a/ocamlbuild/ocamlbuild_plugin.ml b/ocamlbuild/ocamlbuild_plugin.ml index 9f0de1be8..33c9c9df1 100644 --- a/ocamlbuild/ocamlbuild_plugin.ml +++ b/ocamlbuild/ocamlbuild_plugin.ml @@ -38,8 +38,9 @@ let dep = Command.dep let pdep = Command.pdep let copy_rule = Rule.copy_rule let ocaml_lib = Ocamlbuild_pack.Ocaml_utils.ocaml_lib -let flag = Ocamlbuild_pack.Flags.flag +let flag = Ocamlbuild_pack.Flags.flag ?deprecated:None let pflag = Ocamlbuild_pack.Flags.pflag +let mark_tag_used = Ocamlbuild_pack.Flags.mark_tag_used let flag_and_dep = Ocamlbuild_pack.Ocaml_utils.flag_and_dep let pflag_and_dep = Ocamlbuild_pack.Ocaml_utils.pflag_and_dep let non_dependency = Ocamlbuild_pack.Ocaml_utils.non_dependency diff --git a/ocamlbuild/param_tags.ml b/ocamlbuild/param_tags.ml index 2d4f4ae6c..1ccccc604 100644 --- a/ocamlbuild/param_tags.ml +++ b/ocamlbuild/param_tags.ml @@ -34,23 +34,25 @@ let declare name action = let parse tag = Lexers.tag_gen (Lexing.from_string tag) -let acknowledge tag = - acknowledged_tags := parse tag :: !acknowledged_tags +let acknowledge maybe_loc tag = + acknowledged_tags := (parse tag, maybe_loc) :: !acknowledged_tags -let really_acknowledge ?(quiet=false) (name, param) = +let really_acknowledge ?(quiet=false) ((name, param), maybe_loc) = match param with | None -> if Hashtbl.mem declared_tags name && not quiet then - Log.eprintf "Warning: tag %S expects a parameter" name + Log.eprintf "%aWarning: tag %S expects a parameter" + Loc.print_loc_option maybe_loc name | Some param -> let actions = List.rev (Hashtbl.find_all declared_tags name) in if actions = [] && not quiet then - Log.eprintf "Warning: tag %S does not expect a parameter, \ - but is used with parameter %S" name param; + Log.eprintf "%aWarning: tag %S does not expect a parameter, \ + but is used with parameter %S" + Loc.print_loc_option maybe_loc name param; List.iter (fun f -> f param) actions let partial_init ?quiet tags = - Tags.iter (fun tag -> really_acknowledge ?quiet (parse tag)) tags + Tags.iter (fun tag -> really_acknowledge ?quiet (parse tag, None)) tags let init () = List.iter really_acknowledge (My_std.List.ordered_unique !acknowledged_tags) diff --git a/ocamlbuild/param_tags.mli b/ocamlbuild/param_tags.mli index 3b978fa79..22c081256 100644 --- a/ocamlbuild/param_tags.mli +++ b/ocamlbuild/param_tags.mli @@ -22,7 +22,7 @@ if a tag of the form [name(param)] is [acknowledge]d. A given tag may be declared several times with different actions. All actions will be executed, in the order they were declared. *) -val acknowledge: string -> unit +val acknowledge: Loc.location option -> string -> unit (** Acknowledge a tag. If the tag is of the form [X(Y)], and have been declared using [declare], diff --git a/ocamlbuild/rule.ml b/ocamlbuild/rule.ml index a77015e91..d91360cc8 100644 --- a/ocamlbuild/rule.ml +++ b/ocamlbuild/rule.ml @@ -32,6 +32,7 @@ type 'a gen_rule = deps : Pathname.t list; (* These pathnames must be normalized *) prods : 'a list; (* Note that prods also contains stamp *) stamp : 'a option; + doc : string option; code : env -> builder -> digest_command } type rule = Pathname.t gen_rule @@ -41,6 +42,7 @@ let name_of_rule r = r.name let deps_of_rule r = r.deps let prods_of_rule r = r.prods let stamp_of_rule r = r.stamp +let doc_of_rule r = r.doc type 'a rule_printer = (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a gen_rule -> unit @@ -51,12 +53,21 @@ let print_rule_name f r = pp_print_string f r.name let print_resource_list = List.print Resource.print let print_rule_contents ppelt f r = - fprintf f "@[<v2>{@ @[<2>name =@ %S@];@ @[<2>deps =@ %a@];@ @[<2>prods = %a@];@ @[<2>code = <fun>@]@]@ }" - r.name print_resource_list r.deps (List.print ppelt) r.prods + fprintf f "@[<v2>{@ @[<2>name =@ %S@];@ @[<2>deps =@ %a@];@ @[<2>prods = %a@];@ @[<2>code = <fun>@];@ @[<hov 2> doc = %s@]@]@ }" + r.name print_resource_list r.deps (List.print ppelt) + r.prods + (match r.doc with + | None -> "None" + | Some doc -> sprintf "Some %S" doc) let pretty_print ppelt f r = - fprintf f "@[<hv2>rule@ %S@ ~deps:%a@ ~prods:%a@ <fun>@]" - r.name print_resource_list r.deps (List.print ppelt) r.prods + fprintf f "@[<hv2>rule %S@ ~deps:%a@ ~prods:%a@ " + r.name print_resource_list r.deps (List.print ppelt) r.prods; + begin match r.doc with + | None -> () + | Some doc -> fprintf f "~doc:\"@[<hov>%a@]\"@ " pp_print_text doc + end; + fprintf f "<fun>@]" let print = print_rule_name @@ -72,6 +83,7 @@ let subst env rule = (* The substition should preserve normalization of pathnames *) subst_resources rule.deps; stamp = stamp; + doc = rule.doc; code = (fun env -> rule.code (finder env)) } exception Can_produce of rule @@ -251,7 +263,7 @@ let (get_rules, add_rule, clear_rules) = end, (fun () -> rules := []) -let rule name ?tags ?(prods=[]) ?(deps=[]) ?prod ?dep ?stamp ?(insert = `bottom) code = +let rule name ?tags ?(prods=[]) ?(deps=[]) ?prod ?dep ?stamp ?(insert = `bottom) ?doc code = let () = match tags with | None -> () @@ -290,6 +302,7 @@ let rule name ?tags ?(prods=[]) ?(deps=[]) ?prod ?dep ?stamp ?(insert = `bottom) { name = name; deps = res_add Resource.import (* should normalize *) deps dep; stamp = stamp; + doc = doc; prods = prods; code = code } @@ -313,3 +326,13 @@ let copy_rule name ?insert src dest = Shell.mkdir_p (Pathname.dirname dest); cp_p src dest end + +let show_documentation () = + let pp fmt = Log.raw_dprintf (-1) fmt in + let rules = get_rules () in + List.iter + (fun rule -> pp "%a@\n@\n" (pretty_print Resource.print_pattern) rule) + rules; + pp "@." + + diff --git a/ocamlbuild/rule.mli b/ocamlbuild/rule.mli index 0acb125c9..70a735695 100644 --- a/ocamlbuild/rule.mli +++ b/ocamlbuild/rule.mli @@ -33,6 +33,7 @@ exception Failed val name_of_rule : 'a gen_rule -> string val deps_of_rule : 'a gen_rule -> Pathname.t list val prods_of_rule : 'a gen_rule -> 'a list +val doc_of_rule : 'a gen_rule -> string option val rule : string -> ?tags:string list -> @@ -42,6 +43,7 @@ val rule : string -> ?dep:string -> ?stamp:string -> ?insert:[`top | `before of string | `after of string | `bottom] -> + ?doc:string -> action -> unit (** [copy_rule name ?insert source destination] *) @@ -79,3 +81,5 @@ val clear_rules : unit -> unit val call : builder -> rule -> unit val build_deps_of_tags : builder -> Tags.t -> Pathname.t list + +val show_documentation : unit -> unit diff --git a/ocamlbuild/signatures.mli b/ocamlbuild/signatures.mli index bc2177891..0c323e202 100644 --- a/ocamlbuild/signatures.mli +++ b/ocamlbuild/signatures.mli @@ -594,14 +594,22 @@ module type PLUGIN = sig Use ~dep for one file, ~deps for list of files. - It finally takes the action to perform in order to produce the productions files using the dependencies (see [action]). - There is also two more options: + + There are some more optional parameters: - The ~insert argument allow to insert the rules precisely between other rules. - The ~stamp argument specify the name of a file that will be automatically produced by ocamlbuild. This file can serve as a virtual target (or phony target), since it will be filled up by a digest of it dependencies. - - The ~tags argument in deprecated, don't use it. *) + - The ~tags argument in deprecated, don't use it. + + Finally, the optional ~doc argument allows to give an informal + explanation of the rule purpose and behavior, that will be + displayed by [ocamlbuild -documentation]. For example, it is + a good place to specify the commands that will be called, any + new tags introduced by the rule, and dynamic dependencies. + *) val rule : string -> ?tags:string list -> ?prods:string list -> @@ -610,6 +618,7 @@ module type PLUGIN = sig ?dep:string -> ?stamp:string -> ?insert:[`top | `before of string | `after of string | `bottom] -> + ?doc:string -> action -> unit (** [copy_rule name ?insert source destination] *) @@ -641,13 +650,13 @@ module type PLUGIN = sig _build/_log after trying to compile your code. *) val flag : Tags.elt list -> Command.spec -> unit - (** Allows to use [flag] with a parameterized tag (as [pdep] for [dep]). + (** Allows to use [flag] with a parametrized tag (as [pdep] for [dep]). Example: [pflag ["ocaml"; "compile"] "inline" (fun count -> S [A "-inline"; A count])] says that command line option ["-inline 42"] should be added - when compiling files tagged with tag ["inline(42)"]. *) + when compiling OCaml modules tagged with ["inline(42)"]. *) val pflag : Tags.elt list -> Tags.elt -> (string -> Command.spec) -> unit (** [flag_and_dep tags command_spec] @@ -663,6 +672,19 @@ module type PLUGIN = sig val pflag_and_dep : Tags.elt list -> Tags.elt -> (string -> Command.spec) -> unit + (** manually mark the tag as "useful" to silence the warning about + tags that are not part of any flag declaration. + + This is useful, + for example, if the tag is used in a flag declaration that is + only perfored in a conditional branch: + [if we_are_on_Windows then flag ["libfoo"] (A "bar");] + + When [we_are_on_Windows] is not true, you could get a warning about + "libfoo" not used in any flag declaration. + *) + val mark_tag_used : Tags.elt -> unit + (** [non_dependency module_path module_name] Example: [non_dependency "foo/bar/baz" "Goo"] @@ -758,7 +780,7 @@ module type PLUGIN = sig val run_and_read : string -> string (** Here is the list of hooks that the dispatch function have to handle. - Generally one respond to one or two hooks (like After_rules) and do + Generally one responds to one or two hooks (like After_rules) and do nothing in the default case. *) type hook = | Before_hygiene diff --git a/ocamlbuild/testsuite/README b/ocamlbuild/testsuite/README new file mode 100644 index 000000000..08e68d908 --- /dev/null +++ b/ocamlbuild/testsuite/README @@ -0,0 +1,13 @@ +The organization of tests is the following: + +- internal.ml contains the tests that should be runnable from a bare + OCaml installation -- always passing the -no-ocamlfind option. + +- findlibonly.ml contains the tests that should be runnable from a bare + OCaml installation, with only ocamlfind/findlib on top. The only + ocamlfind packages it relies over are those of the OCaml + distribution. + +- external.ml contains the tests that rely on other findlib packages + or external tools to run. Each test will only run if the findlib + package it depends on is present.
\ No newline at end of file diff --git a/ocamlbuild/testsuite/external.ml b/ocamlbuild/testsuite/external.ml new file mode 100644 index 000000000..ce8dc9e7c --- /dev/null +++ b/ocamlbuild/testsuite/external.ml @@ -0,0 +1,22 @@ +#use "internal_test_header.ml";; +#use "findlibonly_test_header.ml";; +#use "external_test_header.ml";; + +let () = test "SubtoolOptions" + ~description:"Options that come from tags that needs to be spliced \ + to the subtool invocation (PR#5763)" + (* testing for the 'menhir' executable directly + is too hard to do in a portable way; test the ocamlfind package instead *) + ~requirements:(package_exists "menhirLib") + ~options:[`use_ocamlfind; `use_menhir; `tags["package\\(camlp4.fulllib\\)"]] + ~tree:[T.f "parser.mly" + ~content:"%{ %} + %token DUMMY + %start<Camlp4.PreCast.Syntax.Ast.expr option> test + %% + test: {None}"] + ~matching:[M.f "parser.native"; M.f "parser.byte"] + ~targets:("parser.native",["parser.byte"]) + ();; + +run ~root:"_test_external";; diff --git a/ocamlbuild/testsuite/external_test_header.ml b/ocamlbuild/testsuite/external_test_header.ml new file mode 100644 index 000000000..2b890e35e --- /dev/null +++ b/ocamlbuild/testsuite/external_test_header.ml @@ -0,0 +1,7 @@ +(* Fullfilled and Missing are defined in ocamlbuild_test.ml + Findlib was loaded in findlibonly_test_header.ml *) +let package_exists package = + let open Findlib in + try ignore (package_directory package); Fullfilled + with No_such_package _ -> + Missing (Printf.sprintf "the ocamlfind package %s" package) diff --git a/ocamlbuild/testsuite/findlibonly.ml b/ocamlbuild/testsuite/findlibonly.ml new file mode 100644 index 000000000..aea0168e3 --- /dev/null +++ b/ocamlbuild/testsuite/findlibonly.ml @@ -0,0 +1,28 @@ +#use "internal_test_header.ml";; +#use "findlibonly_test_header.ml";; + +let () = test "camlp4.opt" + ~description:"Fixes PR#5652" + ~options:[`package "camlp4.macro";`tags ["camlp4o.opt"; "syntax\\(camp4o\\)"]; + `ppflag "camlp4o.opt"; `ppflag "-parser"; `ppflag "macro"; + `ppflag "-DTEST"] + ~tree:[T.f "dummy.ml" + ~content:"IFDEF TEST THEN\nprint_endline \"Hello\";;\nENDIF;;"] + ~matching:[M.x "dummy.native" ~output:"Hello"] + ~targets:("dummy.native",[]) ();; + +let () = test "ThreadAndArchive" + ~description:"Fixes PR#6058" + ~options:[`use_ocamlfind; `package "threads"; `tag "thread"] + ~tree:[T.f "t.ml" ~content:""] + ~matching:[M.f "_build/t.cma"] + ~targets:("t.cma",[]) ();; + +let () = test "SyntaxFlag" + ~options:[`use_ocamlfind; `package "camlp4.macro"; `syntax "camlp4o"] + ~description:"-syntax for ocamlbuild" + ~tree:[T.f "dummy.ml" ~content:"IFDEF TEST THEN\nprint_endline \"Hello\";;\nENDIF;;"] + ~matching:[M.f "dummy.native"] + ~targets:("dummy.native",[]) ();; + +run ~root:"_test_findlibonly";; diff --git a/ocamlbuild/testsuite/findlibonly_test_header.ml b/ocamlbuild/testsuite/findlibonly_test_header.ml new file mode 100644 index 000000000..5b147820a --- /dev/null +++ b/ocamlbuild/testsuite/findlibonly_test_header.ml @@ -0,0 +1,9 @@ +match Sys.command "ocamlfind ocamlc" with + | 0 -> () + | _ -> + prerr_endline "Having ocamlfind installed is a prerequisite \ + for running these tests. Aborting."; + exit 1; +;; + +#use "topfind";; diff --git a/ocamlbuild/testsuite/level0.ml b/ocamlbuild/testsuite/internal.ml index 74f136153..b25594f88 100644 --- a/ocamlbuild/testsuite/level0.ml +++ b/ocamlbuild/testsuite/internal.ml @@ -1,21 +1,12 @@ -#load "unix.cma";; +#use "internal_test_header.ml";; -let ocamlbuild = try Sys.getenv "OCAMLBUILD" with Not_found -> "ocamlbuild";; - -#use "ocamlbuild_test.ml";; - -module M = Match;; -module T = Tree;; - -let _build = M.d "_build";; - -test "BasicNativeTree" +let () = test "BasicNativeTree" ~options:[`no_ocamlfind] ~description:"Output tree for native compilation" ~tree:[T.f "dummy.ml"] ~matching:[M.Exact - (_build - (M.lf + (_build + (M.lf ["_digests"; "dummy.cmi"; "dummy.cmo"; @@ -27,13 +18,13 @@ test "BasicNativeTree" "_log"]))] ~targets:("dummy.native",[]) ();; -test "BasicByteTree" +let () = test "BasicByteTree" ~options:[`no_ocamlfind] ~description:"Output tree for byte compilation" ~tree:[T.f "dummy.ml"] ~matching:[M.Exact - (_build - (M.lf + (_build + (M.lf ["_digests"; "dummy.cmi"; "dummy.cmo"; @@ -43,7 +34,7 @@ test "BasicByteTree" "_log"]))] ~targets:("dummy.byte",[]) ();; -test "SeveralTargets" +let () = test "SeveralTargets" ~options:[`no_ocamlfind] ~description:"Several targets" ~tree:[T.f "dummy.ml"] @@ -52,57 +43,40 @@ test "SeveralTargets" let alt_build_dir = "BuIlD2";; -test "BuildDir" +let () = test "BuildDir" ~options:[`no_ocamlfind; `build_dir alt_build_dir] ~description:"Different build directory" ~tree:[T.f "dummy.ml"] ~matching:[M.d alt_build_dir (M.lf ["dummy.byte"])] ~targets:("dummy.byte",[]) ();; -test "camlp4.opt" - ~description:"Fixes PR#5652" - ~options:[`package "camlp4.macro";`tags ["camlp4o.opt"; "syntax\\(camp4o\\)"]; - `ppflag "camlp4o.opt"; `ppflag "-parser"; `ppflag "macro"; `ppflag "-DTEST"] - ~tree:[T.f "dummy.ml" ~content:"IFDEF TEST THEN\nprint_endline \"Hello\";;\nENDIF;;"] - ~matching:[M.x "dummy.native" ~output:"Hello"] - ~targets:("dummy.native",[]) ();; +let tag_pat_msgs = + ["*:a", "File \"_tags\", line 1, characters 0-2:\n\ + Lexing error: Invalid globbing pattern \"*\"."; -test "ThreadAndArchive" - ~description:"Fixes PR#6058" - ~options:[`package "threads"; `tag "thread"] - ~tree:[T.f "t.ml" ~content:""] - ~matching:[M.f "_build/t.cma"] - ~targets:("t.cma",[]) ();; + "\n<*{>:a", "File \"_tags\", line 2, characters 0-5:\n\ + Lexing error: Invalid globbing pattern \"<*{>\"."; -let tag_pat_msgs = - ["*:a", "File \"_tags\", line 1, column 0: Lexing error: Invalid globbing pattern \"*\"."; - "\n<*{>:a", "File \"_tags\", line 2, column 0: Lexing error: Invalid globbing pattern \"<*{>\"."; - "<*>: ~@a,# ~a", "File \"_tags\", line 1, column 10: Lexing error: Only ',' separated tags are alllowed."];; + "<*>: ~@a,# ~a", "File \"_tags\", line 1, characters 10-11:\n\ + Lexing error: Only ',' separated tags are alllowed."];; List.iteri (fun i (content,failing_msg) -> - test (Printf.sprintf "TagsErrorMessage_%d" (i+1)) + let () = test (Printf.sprintf "TagsErrorMessage_%d" (i+1)) ~options:[`no_ocamlfind] ~description:"Confirm relevance of an error message due to erronous _tags" ~failing_msg ~tree:[T.f "_tags" ~content; T.f "dummy.ml"] - ~targets:("dummy.native",[]) ()) tag_pat_msgs;; - -test "SubtoolOptions" - ~description:"Options that come from tags that needs to be spliced to the subtool invocation (PR#5763)" - ~options:[`use_menhir; `tags["package\\(camlp4.fulllib\\)"]] - ~tree:[T.f "parser.mly" ~content:"%{\n%}\n%token DUMMY\n%start<Camlp4.PreCast.Syntax.Ast.expr option> test%%test: {None}\n\n"] - ~matching:[M.f "parser.native"; M.f "parser.byte"] - ~targets:("parser.native",["parser.byte"]) - ();; + ~targets:("dummy.native",[]) () + in ()) tag_pat_msgs;; -test "Itarget" +let () = test "Itarget" ~options:[`no_ocamlfind] ~description:".itarget building with dependencies between the modules (PR#5686)" ~tree:[T.f "foo.itarget" ~content:"a.cma\nb.byte\n"; T.f "a.ml"; T.f "b.ml" ~content:"open A\n"] ~matching:[M.f "a.cma"; M.f "b.byte"] ~targets:("foo.otarget",[]) ();; -test "PackAcross" +let () = test "PackAcross" ~options:[`no_ocamlfind] ~description:"Pack using a module from the other tree (PR#4592)" ~tree:[T.f "main.ml" ~content:"let _ = Pack.Packed.g ()\n"; @@ -115,7 +89,7 @@ test "PackAcross" ~targets:("main.byte", ["main.native"]) ();; -test "PackAcross2" +let () = test "PackAcross2" ~options:[`no_ocamlfind] ~description:"Pack using a module from the other tree (PR#4592)" ~tree:[T.f "a2.mli" ~content:"val f : unit -> unit"; @@ -127,7 +101,7 @@ test "PackAcross2" ~matching:[M.f "prog.byte"] ~targets:("prog.byte",[]) ();; -test "PackAcross3" +let () = test "PackAcross3" ~options:[`no_ocamlfind] ~description:"Pack using a module from the other tree (PR#4592)" ~tree:[T.d "foo" [ T.f "bar.ml" ~content:"let baz = Quux.xyzzy"]; @@ -139,22 +113,16 @@ test "PackAcross3" ~matching:[M.f "main.byte"] ~targets:("main.byte",[]) ();; -test "SyntaxFlag" - ~options:[`package "camlp4.macro"; `syntax "camlp4o"] - ~description:"-syntax for ocamlbuild" - ~tree:[T.f "dummy.ml" ~content:"IFDEF TEST THEN\nprint_endline \"Hello\";;\nENDIF;;"] - ~matching:[M.f "dummy.native"] - ~targets:("dummy.native",[]) ();; - -test "NativeMliCmi" - ~options:[`no_ocamlfind; `ocamlc "toto";(*using ocamlc would fail*) `tags["native"]] - ~description:"check that ocamlopt is used for .mli->.cmi when tag 'native' is set \ - (part of PR#4613)" +let () = test "NativeMliCmi" + ~options:[`no_ocamlfind; `ocamlc "toto" (*using ocamlc would fail*); + `tags["native"]] + ~description:"check that ocamlopt is used for .mli->.cmi \ + when tag 'native' is set (part of PR#4613)" ~tree:[T.f "foo.mli" ~content:"val bar : int"] ~matching:[_build [M.f "foo.cmi"]] ~targets:("foo.cmi",[]) ();; -test "NoIncludeNoHygiene1" +let () = test "NoIncludeNoHygiene1" ~options:[`no_ocamlfind] ~description:"check that hygiene checks are only done in traversed directories\ (PR#4502)" @@ -165,7 +133,7 @@ test "NoIncludeNoHygiene1" (* will make hygiene fail if must_ignore/ is checked *) ~targets:("hello.byte",[]) ();; -test "NoIncludeNoHygiene2" +let () = test "NoIncludeNoHygiene2" ~options:[`no_ocamlfind; `build_dir "must_ignore"] ~description:"check that hygiene checks are not done on the -build-dir \ (PR#4502)" @@ -176,7 +144,7 @@ test "NoIncludeNoHygiene2" (* will make hygiene fail if must_ignore/ is checked *) ~targets:("hello.byte",[]) ();; -test "NoIncludeNoHygiene3" +let () = test "NoIncludeNoHygiene3" ~options:[`no_ocamlfind; `X "must_ignore"] ~description:"check that hygiene checks are not done on excluded dirs (PR#4502)" ~tree:[T.d "must_ignore" [ T.f "dirty.mli" ~content:"val bug : int"]; @@ -186,13 +154,13 @@ test "NoIncludeNoHygiene3" (* will make hygiene fail if must_ignore/ is checked *) ~targets:("hello.byte",[]) ();; -test "OutputObj" +let () = test "OutputObj" ~options:[`no_ocamlfind] ~description:"output_obj targets for native and bytecode (PR #6049)" ~tree:[T.f "hello.ml" ~content:"print_endline \"Hello, World!\""] ~targets:("hello.byte.o",["hello.byte.c";"hello.native.o"]) ();; -test "StrictSequenceFlag" +let () = test "StrictSequenceFlag" ~options:[`no_ocamlfind; `quiet] ~description:"-strict_sequence tag" ~tree:[T.f "hello.ml" ~content:"let () = 1; ()"; @@ -202,25 +170,27 @@ Error: This expression has type int but an expression was expected of type unit\nCommand exited with code 2." ~targets:("hello.byte",[]) ();; -test "PrincipalFlag" +let () = test "PrincipalFlag" ~options:[`no_ocamlfind; `quiet] ~description:"-principal tag" - ~tree:[T.f "hello.ml" ~content:"type s={foo:int;bar:unit} type t={foo:int} let f x = x.bar;x.foo"; + ~tree:[T.f "hello.ml" + ~content:"type s={foo:int;bar:unit} type t={foo:int} + let f x = (x.bar; x.foo)"; T.f "_tags" ~content:"true: principal\n"] - ~failing_msg:"File \"hello.ml\", line 1, characters 61-64: + ~failing_msg:"File \"hello.ml\", line 2, characters 42-45: Warning 18: this type-based field disambiguation is not principal." ~targets:("hello.byte",[]) ();; -test "ModularPlugin1" - ~options:[`no_ocamlfind; `quiet; `plugin_tag "use_str"] +let () = test "ModularPlugin1" ~description:"test a plugin with dependency on external libraries" + ~options:[`no_ocamlfind; `quiet; `plugin_tag "use_str"] ~tree:[T.f "main.ml" ~content:"let x = 1"; T.f "myocamlbuild.ml" ~content:"ignore (Str.quote \"\");;"] ~matching:[M.f "main.byte"] ~targets:("main.byte",[]) ();; -test "ModularPlugin2" - ~description:"check that parametrized tags defined by the plugin +let () = test "ModularPlugin2" + ~description:"check that parametrized tags defined by the plugin \ do not warn at plugin-compilation time" ~options:[`no_ocamlfind; `quiet] ~tree:[T.f "main.ml" ~content:"let x = 1"; @@ -232,8 +202,8 @@ test "ModularPlugin2" ~matching:[M.f "main.byte"] ~targets:("main.byte",[]) ();; -test "ModularPlugin3" - ~description:"check that unknown parametrized tags encountered +let () = test "ModularPlugin3" + ~description:"check that unknown parametrized tags encountered \ during plugin compilation still warn" ~options:[`no_ocamlfind; `quiet; `plugin_tag "'toto(-g)'"] ~tree:[T.f "main.ml" ~content:"let x = 1"; @@ -245,4 +215,30 @@ test "ModularPlugin3" ~matching:[M.f "main.byte"] ~targets:("main.byte",[]) ();; -run ~root:"_test";; +let () = test "PluginCompilation1" + ~description:"check that the plugin is not compiled when -no-plugin is passed" + ~options:[`no_ocamlfind; `no_plugin] + ~tree:[T.f "main.ml" ~content:"let x = 1"; + T.f "myocamlbuild.ml" ~content:"prerr_endline \"foo\";;"] + ~matching:[_build [M.Not (M.f "myocamlbuild")]] + ~targets:("main.byte",[]) ();; + +let () = test "PluginCompilation2" + ~description:"check that the plugin is compiled when -just-plugin is passed" + ~options:[`no_ocamlfind; `just_plugin] + ~tree:[T.f "main.ml" ~content:"let x = 1"; + T.f "myocamlbuild.ml" ~content:"print_endline \"foo\";;"] + ~matching:[_build [M.f "myocamlbuild"]] + ~targets:("", []) ();; + +let () = test "PluginCompilation3" + ~description:"check that the plugin is not executed \ + when -just-plugin is passed" + ~options:[`no_ocamlfind; `quiet; `just_plugin] + ~tree:[T.f "main.ml" ~content:"let x = 1"; + T.f "myocamlbuild.ml" ~content:"print_endline \"foo\";;"] + (* if the plugin were executed we'd get "foo" in failing_msg *) + ~failing_msg:"" + ~targets:("main,byte", []) ();; + +run ~root:"_test_internal";; diff --git a/ocamlbuild/testsuite/internal_test_header.ml b/ocamlbuild/testsuite/internal_test_header.ml new file mode 100644 index 000000000..da78c7261 --- /dev/null +++ b/ocamlbuild/testsuite/internal_test_header.ml @@ -0,0 +1,10 @@ +#load "unix.cma";; + +let ocamlbuild = try Sys.getenv "OCAMLBUILD" with Not_found -> "ocamlbuild";; + +#use "ocamlbuild_test.ml";; + +module M = Match;; +module T = Tree;; + +let _build = M.d "_build";; diff --git a/ocamlbuild/testsuite/ocamlbuild_test.ml b/ocamlbuild/testsuite/ocamlbuild_test.ml index 4dc674565..e3f44c55c 100644 --- a/ocamlbuild/testsuite/ocamlbuild_test.ml +++ b/ocamlbuild/testsuite/ocamlbuild_test.ml @@ -19,8 +19,11 @@ let print_list ~sep f ppf = function | x :: [] -> f ppf x | x :: xs -> f ppf x; List.iter (fun x -> sep ppf (); f ppf x) xs -let print_list_com f = print_list ~sep:(fun ppf () -> pp_print_string ppf ",") f -let print_list_blank f = print_list ~sep:(fun ppf () -> pp_print_string ppf " ") f +let print_list_com f = + print_list ~sep:(fun ppf () -> pp_print_string ppf ",") f +let print_list_blank f = + print_list ~sep:(fun ppf () -> pp_print_string ppf " ") f + let print_string_list = print_list_com pp_print_string let print_string_list_com = print_list_com pp_print_string let print_string_list_blank = print_list_blank pp_print_string @@ -58,24 +61,25 @@ module Match = struct | D of file * t list (* Like file, but will be executed, and the result will compared *) | X of file * result - (* Symlink *) - | L of file * file + (* Symlink; currently not supported *) + (* | L of file * file *) (* We request that everything below should match exactly *) | Exact of t (* Here we want just the tree contained entities but we allow some other stuff to be there too *) | Contains of t - (* Any means that we match anything *) - | Any - (* Empty a tree leaf that don't match at all *) + (* matching on Empty always fail *) | Empty + (* matches the negation of its argument: fails when it succeeds + and vice versa; Any can be expressed as (Not Empty) *) + | Not of t (* Type of error, we either expect something or something is un-expected *) type error = Expected of string | Unexpected of string | Structure of string * string list - | Output of string * string + | Output of string * string * string (* This will print the tree *) let print ppf tree = @@ -83,13 +87,14 @@ module Match = struct List.iter (fun line -> pp_print_space ppf (); item ppf line) lst and item ppf = function | F (_, name) -> fprintf ppf "@[<h>%s@]" name - | D ((_, name), children) -> fprintf ppf "@[<v 1>@[<h>%s/@]%a@]" name lines children + | D ((_, name), children) -> + fprintf ppf "@[<v 1>@[<h>%s/@]%a@]" name lines children | X ((_,name), _) -> fprintf ppf "@[<h>%s@]" name - | L ((_,src), (_,dst)) -> fprintf ppf "@[<h>%s->%s@]@" src dst + (* | L ((_,src), (_,dst)) -> fprintf ppf "@[<h>%s->%s@]@" src dst *) | Exact content -> fprintf ppf "{%a}" item content | Contains content -> fprintf ppf "<%a>" item content - | Any -> pp_print_char ppf '*' | Empty -> pp_print_char ppf '#' + | Not t -> fprintf ppf "not(@[%a@])" item t in pp_open_vbox ppf 0; item ppf tree; @@ -101,57 +106,60 @@ module Match = struct let x ?(atts=()) name ~output = X ((atts,name), (0,output)) let match_with_fs ~root m = - - let errors = ref [] in - - let rec visit ~exact path m = - let file name = - "./" ^ (List.rev (name :: path) |> String.concat "/") - + let rec visit ~exact ~successes ~errors path m = + let string_of_path path = "./" ^ String.concat "/" (List.rev path) in + let file name = string_of_path (name :: path) in + let push li x = li := x :: !li in + let exists_assert filename = + push (if exists filename then successes else errors) (Expected filename) in - - let exists_assert filename = - if not (exists (file filename)) then - errors := Expected filename :: !errors; - in - - let take_name = function - | F (_, name) - | D ((_, name),_) -> [name] - | _ -> [] - in - - match m with - | F ((),name) -> - exists_assert name - | D (((),name), sub) -> - exists_assert name; - let lst = List.flatten (List.map take_name sub) in - let lst' = Sys.readdir name |> Array.to_list in - let lst' = List.filter (fun x -> not (List.mem x lst)) lst' in - (if exact && lst' <> [] then - errors := Structure ((file name), lst') :: !errors); - List.iter (visit ~exact (name :: path)) sub - | X (((), name), (retcode, output)) -> - let _,output' = execute (file name) in - let output' = String.concat "\n" output' in - if output <> output' then - errors := Output (output, output') :: !errors - | Exact sub -> visit ~exact:true path sub - | Contains sub -> visit ~exact:false path sub - | _ -> assert false + let rec take_name = function + | F (_, name) + | D ((_, name), _) + | X ((_, name), _) -> [name] + | Exact sub + | Contains sub + | Not sub -> take_name sub + | Empty -> [] + in + match m with + | F ((),name) -> + exists_assert (file name) + | D (((),name), sub) -> + exists_assert (file name); + let lst = List.flatten (List.map take_name sub) in + let lst' = Sys.readdir name |> Array.to_list in + let lst' = List.filter (fun x -> not (List.mem x lst)) lst' in + (if exact && lst' <> [] then + errors := Structure ((file name), lst') :: !errors); + List.iter (visit ~exact ~successes ~errors (name :: path)) sub + | X (((), name), (retcode, output)) -> + let _,output' = execute (file name) in + let output' = String.concat "\n" output' in + push (if output <> output' then errors else successes) + (Output (file name, output, output')); + | Exact sub -> visit ~exact:true ~successes ~errors path sub + | Contains sub -> visit ~exact:false ~successes ~errors path sub + | Empty -> push errors (Unexpected (string_of_path path)) + | Not sub -> visit ~exact ~errors:successes ~successes:errors path sub in let dir = Sys.getcwd () in Unix.chdir root; - visit ~exact:false [] m; + let successes = ref [] in + let errors = ref [] in + visit ~exact:false ~successes ~errors [] m; Unix.chdir dir; List.rev !errors let string_of_error = function | Expected s -> Printf.sprintf "expected '%s' on a file system" s | Unexpected s -> Printf.sprintf "un-expected '%s' on a file system" s - | Structure (s,l) -> Printf.sprintf "directory structure '%s' has un-expected files %s" s (String.concat ", " l) - | Output (e, p) -> Printf.sprintf "not matching output '%s' expected but got %s" e p + | Structure (s,l) -> + Printf.sprintf "directory structure '%s' has un-expected files %s" + s (String.concat ", " l) + | Output (s, e, p) -> + Printf.sprintf "executable %s expected output %S but got %S" + s e p end module Option = struct @@ -301,7 +309,7 @@ module Option = struct | `no_skip -> fprintf ppf "no-skip" | `no_hygiene -> fprintf ppf "no-hygiene" | `no_ocamlfind -> fprintf ppf "no-ocamlfind" - | `no_plugin -> fprintf ppf "no-pluging" + | `no_plugin -> fprintf ppf "no-plugin" | `no_stdlib -> fprintf ppf "no-stdlib" | `dont_catch_errors -> fprintf ppf "dont" | `just_plugin -> fprintf ppf "just-plugin" @@ -375,8 +383,11 @@ type content = string type filename = string type run = filename * content +type requirements = Fullfilled | Missing of string + type test = { name : string ; description : string + ; requirements : requirements option ; tree : Tree.t list ; matching : Match.t list ; options : Option.t list @@ -389,12 +400,38 @@ let tests = ref [] let test name ~description + ?requirements ?(options=[]) ?(run=[]) ?pre_cmd ?failing_msg ?(tree=[]) ?(matching=[]) ~targets () = - tests := !tests @ [{ name; description; tree; matching; options; targets; pre_cmd; failing_msg; run }] + tests := !tests @ [{ + name; + description; + requirements; + tree; + matching; + options; + targets; + pre_cmd; + failing_msg; + run; + }] + +let print_colored header_color header name body_color body = + let color_code = function + | `Red -> "31" + | `Green -> "32" + | `Yellow -> "33" + | `Blue -> "34" + | `Magenta -> "35" + | `Cyan -> "36" + in + Printf.printf "\x1b[0;%sm\x1b[1m[%s]\x1b[0m \ + \x1b[1m%-20s\x1b[0;%sm%s.\n\x1b[m%!" + (color_code header_color) header name + (color_code body_color) body let run ~root = let dir = Sys.getcwd () in @@ -413,6 +450,7 @@ let run ~root = let one_test { name ; description + ; requirements ; tree ; matching ; options @@ -427,47 +465,72 @@ let run ~root = List.iter (Tree.create_on_fs ~root:full_name) tree; Unix.chdir full_name; - (match pre_cmd with - | None -> () - | Some str -> ignore(Sys.command str)); - - let log_name = full_name ^ ".log" in - - let cmd = command options (fst targets :: snd targets) in - let allow_failure = failing_msg <> None in - - Unix.(match execute cmd with - | WEXITED n,lines - | WSIGNALED n,lines - | WSTOPPED n,lines when allow_failure || n <> 0 -> - begin match failing_msg with - | None -> - let ch = open_out log_name in - List.iter (fun l -> output_string ch l; output_string ch "\n") lines; - close_out ch; - Printf.printf "\x1b[0;31m\x1b[1m[FAILED]\x1b[0m \x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name - (Printf.sprintf "Command '%s' with error code %n output written to %s" cmd n log_name); - | Some failing_msg -> - let starts_with_plus s = String.length s > 0 && s.[0] = '+' in - let lines = List.filter (fun s -> not (starts_with_plus s)) lines in - let msg = String.concat "\n" lines in - if failing_msg = msg then - Printf.printf "\x1b[0;32m\x1b[1m[PASSED]\x1b[0m \x1b[1m%-20s\x1b[0;36m%s.\n\x1b[m%!" name description - else - Printf.printf "\x1b[0;31m\x1b[1m[FAILED]\x1b[0m \x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name ((Printf.sprintf "Failure with not matching message:\n%s\n!=\n%s\n") msg failing_msg) - end; - | _ -> - let errors = List.concat (List.map (Match.match_with_fs ~root:full_name) matching) in - begin if errors == [] then - Printf.printf "\x1b[0;32m\x1b[1m[PASSED]\x1b[0m \x1b[1m%-20s\x1b[0;36m%s.\n\x1b[m%!" name description - else begin - let ch = open_out log_name in - output_string ch ("Run '" ^ cmd ^ "'\n"); - List.iter (fun e -> output_string ch (Match.string_of_error e); output_string ch ".\n") errors; - close_out ch; - Printf.printf "\x1b[0;31m\x1b[1m[FAILED]\x1b[0m \x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name - (Printf.sprintf "Some system checks failed, output written to %s" log_name) - end - end) + match requirements with + | Some (Missing req) -> + print_colored `Yellow "SKIPPED" name `Yellow + (Printf.sprintf "%s is required and missing" req) + + | Some Fullfilled | None -> begin + + (match pre_cmd with + | None -> () + | Some str -> ignore(Sys.command str)); + + let log_name = full_name ^ ".log" in + + let cmd = command options (fst targets :: snd targets) in + let allow_failure = failing_msg <> None in + + let open Unix in + + match execute cmd with + | WEXITED n,lines + | WSIGNALED n,lines + | WSTOPPED n,lines when allow_failure || n <> 0 -> + begin match failing_msg with + | None -> + let ch = open_out log_name in + List.iter + (fun l -> output_string ch l; output_string ch "\n") + lines; + close_out ch; + print_colored `Red "FAILED" name `Yellow + (Printf.sprintf "Command '%s' with error code %n \ + output written to %s" cmd n log_name); + | Some failing_msg -> + let starts_with_plus s = String.length s > 0 && s.[0] = '+' in + let lines = + (* filter out -classic-display output *) + List.filter (fun s -> not (starts_with_plus s)) lines in + let msg = String.concat "\n" lines in + if failing_msg = msg then + print_colored `Green "PASSED" name `Cyan description + else + print_colored `Red "FAILED" name `Yellow + ((Printf.sprintf "Failure with not matching message:\n\ + %s\n!=\n%s\n") msg failing_msg) + end; + | _ -> + let errors = + List.concat + (List.map (Match.match_with_fs ~root:full_name) matching) in + begin if errors == [] then + print_colored `Green "PASSED" name `Cyan description + else begin + let ch = open_out log_name in + output_string ch ("Run '" ^ cmd ^ "'\n"); + List.iter + (fun e -> + output_string ch (Match.string_of_error e); + output_string ch ".\n") + errors; + close_out ch; + print_colored `Red "FAILED" name `Yellow + (Printf.sprintf "Some system checks failed, \ + output written to %s" + log_name) + end + end + end in List.iter one_test !tests diff --git a/stdlib/format.ml b/stdlib/format.ml index fc2df5128..02222932e 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -747,6 +747,41 @@ let pp_set_tab state () = enqueue_advance state elem ;; + +(* Convenience functions *) + +(* To format a list *) +let rec pp_print_list ?(pp_sep = pp_print_cut) pp_v ppf = function + | [] -> () + | [v] -> pp_v ppf v + | v :: vs -> + pp_v ppf v; + pp_sep ppf (); + pp_print_list ~pp_sep pp_v ppf vs + +(* To format free-flowing text *) +let pp_print_text ppf s = + let len = String.length s in + let left = ref 0 in + let right = ref 0 in + let flush () = + pp_print_string ppf (String.sub s !left (!right - !left)); + incr right; left := !right; + in + while (!right <> len) do + match s.[!right] with + | '\n' -> + flush (); + pp_force_newline ppf () + | ' ' -> + flush (); pp_print_space ppf () + (* there is no specific support for '\t' + as it is unclear what a right semantics would be *) + | _ -> incr right + done; + if !left <> len then flush () + + (************************************************************** Procedures to control the pretty-printers diff --git a/stdlib/format.mli b/stdlib/format.mli index 2df4779c2..1d8662bc6 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -564,6 +564,27 @@ val pp_get_formatter_out_functions : evaluation of these primitives. For instance, [print_string] is equal to [pp_print_string std_formatter]. *) +(** {6 Convenience formatting functions.} *) + +val pp_print_list: + ?pp_sep:(formatter -> unit -> unit) -> + (formatter -> 'a -> unit) -> (formatter -> 'a list -> unit) +(** [pp_print_list ?pp_sep pp_v ppf l] prints the list [l]. [pp_v] is + used on the elements of [l] and each element is separated by + a call to [pp_sep] (defaults to {!pp_print_cut}). Does nothing on + empty lists. + + @since 4.02 +*) + +val pp_print_text : formatter -> string -> unit +(** [pp_print_text ppf s] prints [s] with spaces and newlines + respectively printed with {!pp_print_space} and + {!pp_force_newline}. + + @since 4.02 +*) + (** {6 [printf] like functions for pretty-printing.} *) val fprintf : formatter -> ('a, formatter, unit) format -> 'a;; diff --git a/testsuite/external/.ignore b/testsuite/external/.ignore index 61f158306..a65ca6ca8 100644 --- a/testsuite/external/.ignore +++ b/testsuite/external/.ignore @@ -119,6 +119,8 @@ react react-0.9.3 res res-3.2.0 +rss +ocamlrss-2.2.2 sexplib sexplib-109.15.00 sks diff --git a/testsuite/external/Makefile b/testsuite/external/Makefile index d84e806fb..5fcd005ba 100644 --- a/testsuite/external/Makefile +++ b/testsuite/external/Makefile @@ -95,8 +95,9 @@ lablgtk: ${LABLGTK}.tar.gz findlib # TODO: add lablgl ${MAKE} world && \ ocamlfind remove lablgtk2 && \ ${MAKE} install && \ - ln -h -f -s ${PREFIX}/lib/ocaml/site-lib/lablgtk2 \ - ${PREFIX}/lib/ocaml/lablgtk2 ) + rm -f ${PREFIX}/lib/ocaml/lablgtk2 && \ + ln -f -s ${PREFIX}/lib/ocaml/site-lib/lablgtk2 \ + ${PREFIX}/lib/ocaml/lablgtk2 ) echo ${VERSION} >$@ clean:: rm -rf ${LABLGTK} lablgtk @@ -840,6 +841,7 @@ xmllight: ${XMLLIGHT}.zip ./Patcher.sh ${XMLLIGHT} ( cd ${XMLLIGHT} && \ export PATH=${PREFIX}/bin:$$PATH && \ + ${MAKE} xml_parser.ml && \ ${MAKE} all opt && \ ${MAKE} install ) echo ${VERSION} >$@ @@ -876,7 +878,7 @@ all: configfile XMLM=xmlm-1.1.0 ${XMLM}.tbz: ${WGET} http://erratique.ch/software/xmlm/releases/$@ -xmlm: ${XMLM}.tbz +xmlm: ${XMLM}.tbz findlib printf "%s " "$@" >/dev/tty test -d ${PREFIX} rm -rf ${XMLM} @@ -884,7 +886,7 @@ xmlm: ${XMLM}.tbz ./Patcher.sh ${XMLM} oasis-common.patch ( cd ${XMLM} && \ export PATH=${PREFIX}/bin:$$PATH && \ - ocaml setup.ml -configure && \ + ocaml setup.ml -configure --prefix ${PREFIX} && \ ocaml setup.ml -build && \ ocamlfind remove xmlm && \ ocaml setup.ml -install ) @@ -1110,6 +1112,28 @@ distclean:: rm -f ${OCAMLNET}.tar.gz all: ocamlnet +# http://zoggy.github.io/ocamlrss/ +RSS=ocamlrss-2.2.2 +${RSS}.tar.gz: + ${WGET} http://zoggy.github.io/ocamlrss/$@ +rss: ${RSS}.tar.gz xmlm ocamlnet + printf "%s " "$@" >/dev/tty + test -d ${PREFIX} + rm -rf ${RSS} + tar zxf ${RSS}.tar.gz + ./Patcher.sh ${RSS} + ( cd ${RSS} && \ + export PATH=${PREFIX}/bin:$$PATH && \ + ${MAKE} all && \ + ocamlfind remove ocaml-rss && \ + ${MAKE} install ) + echo ${VERSION} >$@ +clean:: + rm -rf ${RSS} rss +distclean:: + rm -f ${RSS}.tar.gz +all: rss + # http://code.google.com/p/ocaml-extlib/ EXTLIB=extlib-1.5.2 ${EXTLIB}.tar.gz: |