diff --git a/bootstrap/lib/compiler/ebin/beam_doc.beam b/bootstrap/lib/compiler/ebin/beam_doc.beam index b979b16de770..26750e373fa9 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_doc.beam and b/bootstrap/lib/compiler/ebin/beam_doc.beam differ diff --git a/lib/common_test/proper_ext/ct_proper_ext.erl b/lib/common_test/proper_ext/ct_proper_ext.erl index 4c4b25da27cc..81472e319bba 100644 --- a/lib/common_test/proper_ext/ct_proper_ext.erl +++ b/lib/common_test/proper_ext/ct_proper_ext.erl @@ -31,6 +31,7 @@ %% do not shrink. -module(ct_proper_ext). +-moduledoc false. -export([existing_atom/0]). -export([safe_any/0]). diff --git a/lib/common_test/src/cte_track.erl b/lib/common_test/src/cte_track.erl index 2e64bc1ea4e3..b2e8b2523e29 100644 --- a/lib/common_test/src/cte_track.erl +++ b/lib/common_test/src/cte_track.erl @@ -19,6 +19,7 @@ %% -module(cte_track). +-moduledoc false. %% module for tracking CT execution progress %% test spec addition examples: %% {event_handler, {cte_track, []}}. diff --git a/lib/compiler/src/beam_doc.erl b/lib/compiler/src/beam_doc.erl index b91fac6a88a6..6eeb0088adef 100644 --- a/lib/compiler/src/beam_doc.erl +++ b/lib/compiler/src/beam_doc.erl @@ -219,7 +219,9 @@ }). -type internal_docs() :: #docs{}. --type opt() :: warn_missing_doc | nowarn_hidden_doc | {nowarn_hidden_doc, {atom(), arity()}}. +-type opt() :: warn_missing_doc | warn_missing_doc_functions | warn_missing_doc_callbacks | warn_missing_doc_types | + nowarn_missing_doc | nowarn_missing_doc_functions | nowarn_missing_doc_callbacks | nowarn_missing_doc_types | + nowarn_hidden_doc | {nowarn_hidden_doc, {atom(), arity()}}. -type kfa() :: {Kind :: function | type | callback, Name :: atom(), Arity :: arity()}. -type warnings() :: [{file:filename(), [{erl_anno:location(), beam_doc, warning()}]}]. @@ -248,7 +250,32 @@ main(Dirname, Filename, AST, CmdLineOpts) -> extract_opts(AST, CmdLineOpts) -> CompileOpts = lists:flatten([C || {attribute,_,compile,C} <- AST]), - CompileOpts ++ CmdLineOpts. + normalize_warn_missing_doc(CmdLineOpts ++ CompileOpts). + +normalize_warn_missing_doc(Opts) -> + normalize_warn_missing_doc(Opts, []). +normalize_warn_missing_doc([warn_missing_doc | Opts], _Warnings) -> + normalize_warn_missing_doc(Opts, [function,callback,type]); +normalize_warn_missing_doc([nowarn_missing_doc | Opts], _Warnings) -> + normalize_warn_missing_doc(Opts, []); +normalize_warn_missing_doc([warn_missing_doc_functions | Opts], Warnings) -> + normalize_warn_missing_doc(Opts, lists:uniq([function | Warnings])); +normalize_warn_missing_doc([nowarn_missing_doc_functions | Opts], Warnings) -> + normalize_warn_missing_doc(Opts, lists:uniq(Warnings -- [function])); +normalize_warn_missing_doc([warn_missing_doc_callbacks | Opts], Warnings) -> + normalize_warn_missing_doc(Opts, lists:uniq([callback | Warnings])); +normalize_warn_missing_doc([nowarn_missing_doc_callbacks | Opts], Warnings) -> + normalize_warn_missing_doc(Opts, lists:uniq(Warnings -- [callback])); +normalize_warn_missing_doc([warn_missing_doc_types | Opts], Warnings) -> + normalize_warn_missing_doc(Opts, lists:uniq([type | Warnings])); +normalize_warn_missing_doc([nowarn_missing_doc_types | Opts], Warnings) -> + normalize_warn_missing_doc(Opts, lists:uniq(Warnings -- [type])); +normalize_warn_missing_doc([Opt | Opts], Warnings) -> + [Opt | normalize_warn_missing_doc(Opts, Warnings)]; +normalize_warn_missing_doc([], []) -> + []; +normalize_warn_missing_doc([], Warnings) -> + [{warn_missing_doc,Warnings}]. -spec format_error(warning()) -> io_lib:chars(). format_error({hidden_type_used_in_exported_fun, {Type, Arity}}) -> @@ -688,6 +715,8 @@ warnings(_AST, State) -> ], foldl(fun (W, State0) -> W(State0) end, State, WarnFuns). +warn_missing_docs(State = #docs{ moduledoc = {_, hidden} }) -> + State; warn_missing_docs(State) -> DocNodes = process_docs(State), foldl(fun warn_missing_docs/2, State, DocNodes). @@ -747,19 +776,23 @@ create_warning(Anno, Warning, State) -> Location = erl_anno:location(Anno), {Filename, [{Location, ?MODULE, Warning}]}. -warn_missing_docs({KFA, Anno, _, Doc, _}, State) -> - case proplists:get_value(warn_missing_doc, State#docs.opts, false) of - true when Doc =:= none -> +warn_missing_docs({{Kind, _, _} = KFA, Anno, _, Doc, MD}, State) + when Doc =:= none, not is_map_key(equiv, MD) -> + case lists:member(Kind, proplists:get_value(warn_missing_doc, State#docs.opts, [])) of + true -> Warning = {missing_doc, KFA}, State#docs{ warnings = [create_warning(Anno, Warning, State) | State#docs.warnings] }; - _false -> + false -> State - end. + end; +warn_missing_docs(_, State) -> + State. warn_missing_moduledoc(State) -> {_, ModuleDoc} = State#docs.moduledoc, - case proplists:get_value(warn_missing_doc, State#docs.opts, false) of - true when ModuleDoc =:= none -> + case proplists:get_value(warn_missing_doc, State#docs.opts, []) of + %% If any warn_missing_doc flags is enabled, we also warn for missing moduledoc. + [_|_] when ModuleDoc =:= none -> Anno = erl_anno:new(?DEFAULT_MODULE_DOC_LOC), Warning = missing_moduledoc, State#docs{ warnings = [create_warning(Anno, Warning, State) | State#docs.warnings] }; diff --git a/lib/compiler/src/beam_ssa_ss.erl b/lib/compiler/src/beam_ssa_ss.erl index 01e6ee387ca1..0c2fb6928fe9 100644 --- a/lib/compiler/src/beam_ssa_ss.erl +++ b/lib/compiler/src/beam_ssa_ss.erl @@ -27,6 +27,7 @@ %% -module(beam_ssa_ss). +-moduledoc false. -compile({inline,[add_edge/4, add_vertex/3]}). diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 81304cfb741e..bc573a0cc7ac 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -2063,6 +2063,7 @@ is_c_map(#c_literal{val = V}) when is_map(V) -> is_c_map(_) -> false. +-doc "". -spec map_es(c_map() | c_literal()) -> [c_map_pair()]. map_es(#c_literal{anno=As,val=M}) when is_map(M) -> @@ -2073,6 +2074,7 @@ map_es(#c_literal{anno=As,val=M}) when is_map(M) -> map_es(#c_map{es = Es}) -> Es. +-doc "". -spec map_arg(c_map() | c_literal()) -> c_map() | c_literal(). map_arg(#c_literal{anno=As,val=M}) when is_map(M) -> @@ -2080,37 +2082,44 @@ map_arg(#c_literal{anno=As,val=M}) when is_map(M) -> map_arg(#c_map{arg=M}) -> M. +-doc "". -spec c_map([c_map_pair()]) -> c_map(). c_map(Pairs) -> ann_c_map([], Pairs). +-doc "". -spec c_map_pattern([c_map_pair()]) -> c_map(). c_map_pattern(Pairs) -> #c_map{es=Pairs, is_pat=true}. +-doc "". -spec ann_c_map_pattern([term()], [c_map_pair()]) -> c_map(). ann_c_map_pattern(As, Pairs) -> #c_map{anno=As, es=Pairs, is_pat=true}. +-doc "". -spec is_c_map_empty(c_map() | c_literal()) -> boolean(). is_c_map_empty(#c_map{ es=[] }) -> true; is_c_map_empty(#c_literal{val=M}) when is_map(M),map_size(M) =:= 0 -> true; is_c_map_empty(_) -> false. +-doc "". -spec is_c_map_pattern(c_map()) -> boolean(). is_c_map_pattern(#c_map{is_pat=IsPat}) -> IsPat. +-doc "". -spec ann_c_map([term()], [c_map_pair()]) -> c_map() | c_literal(). ann_c_map(As, Es) -> ann_c_map(As, #c_literal{val=#{}}, Es). +-doc "". -spec ann_c_map([term()], c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal(). ann_c_map(As, #c_literal{val=M0}=Lit, Es) when is_map(M0) -> @@ -2149,6 +2158,7 @@ update_map_literal([#c_map_pair{op=#c_literal{val=exact},key=Ck,val=Cv}|Es], M) update_map_literal([], M) -> M. +-doc "". -spec update_c_map(c_map(), cerl(), [cerl()]) -> c_map() | c_literal(). update_c_map(#c_map{is_pat=true}=Old, M, Es) -> @@ -2156,34 +2166,41 @@ update_c_map(#c_map{is_pat=true}=Old, M, Es) -> update_c_map(#c_map{is_pat=false}=Old, M, Es) -> ann_c_map(get_ann(Old), M, Es). +-doc "". -spec map_pair_key(c_map_pair()) -> cerl(). map_pair_key(#c_map_pair{key=K}) -> K. +-doc "". -spec map_pair_val(c_map_pair()) -> cerl(). map_pair_val(#c_map_pair{val=V}) -> V. +-doc "". -spec map_pair_op(c_map_pair()) -> map_op(). map_pair_op(#c_map_pair{op=Op}) -> Op. +-doc "". -spec c_map_pair(cerl(), cerl()) -> c_map_pair(). c_map_pair(Key,Val) -> #c_map_pair{op=#c_literal{val=assoc},key=Key,val=Val}. +-doc "". -spec c_map_pair_exact(cerl(), cerl()) -> c_map_pair(). c_map_pair_exact(Key,Val) -> #c_map_pair{op=#c_literal{val=exact},key=Key,val=Val}. +-doc "". -spec ann_c_map_pair([term()], cerl(), cerl(), cerl()) -> c_map_pair(). ann_c_map_pair(As,Op,K,V) -> #c_map_pair{op=Op, key = K, val=V, anno = As}. +-doc "". -spec update_c_map_pair(c_map_pair(), map_op(), cerl(), cerl()) -> c_map_pair(). update_c_map_pair(Old,Op,K,V) -> diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index 8a0d824114dd..8be9a1d81c89 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -1110,6 +1110,7 @@ filter_labels([A | As]) -> filter_labels([]) -> []. +-doc "". -spec get_label(cerl()) -> 'top' | integer(). get_label(T) -> diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 24d4604aebab..0534a6cce9ec 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -708,11 +708,19 @@ value are listed. enabled in a module that may load NIFs, as the compiler may inline NIF fallbacks by accident. Use this option to turn off this kind of warnings. -- **`warn_missing_doc`[](){: #warn_missing_doc } ** - By default, warnings are not emitted when `-doc` attribute for an exported function - is not given. Use this option to turn on this kind of warning. - -- **`nowarn_hidden_doc` | `{nowarn_hidden_doc,NAs}`[](){: #nowarn_hidden_doc } ** +- **`warn_missing_doc` | `warn_missing_doc_functions` | `warn_missing_doc_types` | `warn_missing_doc_callbacks` **{: #warn_missing_doc } + By default, warnings are not emitted when `-doc` attribute for an exported function, + callback or type is not given. Use these option to turn on this kind of warning. + `warn_missing_doc` is equivalent to setting all of `warn_missing_doc_functions`, + `warn_missing_doc_types` and `warn_missing_doc_callbacks`. + +- **`nowarn_missing_doc` | `nowarn_missing_doc_functions` | `nowarn_missing_doc_types` | `nowarn_missing_doc_callbacks` ** + If warnings are enabled by [`warn_missing_doc`](#warn_missing_doc), then you can use + these options turn those warnings off again. + `nowarn_missing_doc` is equivalent to setting all of `nowarn_missing_doc_functions`, + `nowarn_missing_doc_types` and `nowarn_missing_doc_callbacks`. + +- **`nowarn_hidden_doc` | `{nowarn_hidden_doc,NAs}`**{: #nowarn_hidden_doc } By default, warnings are emitted when `-doc false` attribute is set on a [callback or referenced type](`e:system:documentation.md#what-is-visible-versus-hidden`). You can set `nowarn_hidden_doc` to suppress all those warnings, or `{nowarn_hidden_doc, NAs}` diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl index bfb6914ae4f8..be2a087c3ba4 100644 --- a/lib/compiler/src/core_parse.yrl +++ b/lib/compiler/src/core_parse.yrl @@ -453,6 +453,7 @@ Header "". Erlang code. +-moduledoc false. -include("core_parse.hrl"). diff --git a/lib/compiler/test/beam_doc_SUITE.erl b/lib/compiler/test/beam_doc_SUITE.erl index 38e64162f1e9..0034b37e673e 100644 --- a/lib/compiler/test/beam_doc_SUITE.erl +++ b/lib/compiler/test/beam_doc_SUITE.erl @@ -418,9 +418,24 @@ deprecated(Conf) -> ok. warn_missing_doc(Conf) -> + + warn_missing_doc(Conf, [function, type, callback], [warn_missing_doc]), + warn_missing_doc(Conf, [function], [warn_missing_doc_functions]), + warn_missing_doc(Conf, [function, type], [warn_missing_doc_functions, warn_missing_doc_types]), + warn_missing_doc(Conf, [type, callback], [warn_missing_doc_types, warn_missing_doc_callbacks]), + warn_missing_doc(Conf, [callback], [warn_missing_doc_callbacks]), + + warn_missing_doc(Conf, [type, callback], [warn_missing_doc, nowarn_missing_doc_functions]), + warn_missing_doc(Conf, [function, callback], [warn_missing_doc, nowarn_missing_doc_types]), + warn_missing_doc(Conf, [type], [warn_missing_doc, nowarn_missing_doc_callbacks, nowarn_missing_doc_functions]), + warn_missing_doc(Conf, [], [warn_missing_doc_functions, nowarn_missing_doc]), + + ok. + +warn_missing_doc(Conf, ExpectedWarnings, Options) -> ModuleName = ?get_name(), - {ok, ModName, [{File,Warnings}, {HrlFile, HrlWarnings}]} = - default_compile_file(Conf, ModuleName, [return_warnings, warn_missing_doc, report]), + {ok, ModName, Ws} = + default_compile_file(Conf, ModuleName, [return_warnings, report | Options]), {ok, {docs_v1, _,_, _, none, _, [{{type,test,1},_,[<<"test(N)">>],none,_}, @@ -431,20 +446,51 @@ warn_missing_doc(Conf) -> {{function,test,2},_,[<<"test(N, M)">>],none,_}]} } = code:get_doc(ModName), - ?assertEqual("warn_missing_doc.erl", filename:basename(File)), - ?assertEqual(6, length(Warnings)), - ?assertMatch({1, beam_doc, missing_moduledoc}, lists:nth(1, Warnings)), - ?assertMatch({{6,2}, beam_doc, {missing_doc, {type,test,0}}}, lists:nth(2, Warnings)), - ?assertMatch({{7,2}, beam_doc, {missing_doc, {type,test,1}}}, lists:nth(3, Warnings)), - ?assertMatch({{9,2}, beam_doc, {missing_doc, {callback,test,0}}}, lists:nth(4, Warnings)), - ?assertMatch({{13,1}, beam_doc, {missing_doc, {function,test,0}}}, lists:nth(5, Warnings)), - ?assertMatch({{14,1}, beam_doc, {missing_doc, {function,test,1}}}, lists:nth(6, Warnings)), - - ?assertEqual("warn_missing_doc.hrl", filename:basename(HrlFile)), - ?assertEqual(1, length(HrlWarnings)), - ?assertMatch({{2,1}, beam_doc, {missing_doc, {function,test,2}}}, lists:nth(1, HrlWarnings)), - - ok. + case ExpectedWarnings of + [] -> + ?assertEqual([],Ws); + _ -> + [{File,Warnings} | Hrl] = Ws, + ExpectedWarningCount = 1 + lists:sum( + lists:flatten( + [[2 || lists:member(type, ExpectedWarnings)], + [1 || lists:member(callback, ExpectedWarnings)], + [2 || lists:member(function, ExpectedWarnings)]])), + + ?assertEqual("warn_missing_doc.erl", filename:basename(File)), + ?assertEqual(ExpectedWarningCount, length(Warnings)), + ?assertMatch({1, beam_doc, missing_moduledoc}, lists:nth(1, Warnings)), + TypePos = + case lists:member(type, ExpectedWarnings) of + true -> + ?assertMatch({{6,2}, beam_doc, {missing_doc, {type,test,0}}}, lists:nth(2, Warnings)), + ?assertMatch({{7,2}, beam_doc, {missing_doc, {type,test,1}}}, lists:nth(3, Warnings)), + 4; + false -> + 2 + end, + + CBPos = + case lists:member(callback, ExpectedWarnings) of + true -> + ?assertMatch({{9,2}, beam_doc, {missing_doc, {callback,test,0}}}, lists:nth(TypePos, Warnings)), + TypePos + 1; + false -> + TypePos + end, + + case lists:member(function, ExpectedWarnings) of + true -> + ?assertMatch({{13,1}, beam_doc, {missing_doc, {function,test,0}}}, lists:nth(CBPos, Warnings)), + ?assertMatch({{14,1}, beam_doc, {missing_doc, {function,test,1}}}, lists:nth(CBPos+1, Warnings)), + [{HrlFile, HrlWarnings}] = Hrl, + ?assertEqual("warn_missing_doc.hrl", filename:basename(HrlFile)), + ?assertEqual(1, length(HrlWarnings)), + ?assertMatch({{2,1}, beam_doc, {missing_doc, {function,test,2}}}, lists:nth(1, HrlWarnings)); + false -> + ok + end + end. doc_with_file(Conf) -> ModuleName = ?get_name(), diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index 23b6e9732db8..86299ebe7389 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -604,6 +604,7 @@ run_report_modules_analyzed(Opts) -> {Warnings, _ModulesChanged, ModulesAnalyzed} = run_report_modules_changed_and_analyzed(Opts), {Warnings, ModulesAnalyzed}. +-doc false. run_report_modules_changed_and_analyzed(Opts) -> try dialyzer_options:build([{report_mode, quiet}, {erlang_mode, true}|Opts]) of diff --git a/lib/diameter/src/compiler/diameter_dict_parser.yrl b/lib/diameter/src/compiler/diameter_dict_parser.yrl index 4d2eb098311b..d26dcff44d98 100644 --- a/lib/diameter/src/compiler/diameter_dict_parser.yrl +++ b/lib/diameter/src/compiler/diameter_dict_parser.yrl @@ -323,3 +323,6 @@ avp_code -> number : '$1'. avp_vendor -> '$empty' : false. avp_vendor -> number : '$1'. + +Erlang code. +-moduledoc false. diff --git a/lib/et/examples/Makefile b/lib/et/examples/Makefile index c572fb4ce65f..f482cdf5bf3c 100644 --- a/lib/et/examples/Makefile +++ b/lib/et/examples/Makefile @@ -55,7 +55,7 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += -pa ../../et/ebin +ERL_COMPILE_FLAGS += -pa ../../et/ebin +nowarn_missing_doc EBIN = . # ---------------------------------------------------- diff --git a/lib/eunit/src/eunit_autoexport.erl b/lib/eunit/src/eunit_autoexport.erl index de7022e63791..4ee0871ec1d2 100644 --- a/lib/eunit/src/eunit_autoexport.erl +++ b/lib/eunit/src/eunit_autoexport.erl @@ -90,7 +90,8 @@ rewrite([], As, Module, Test) -> [{function,L,test,0, [{clause,L,[],[], [{call,L,{remote,L,{atom,L,eunit},{atom,L,test}}, - [{atom,L,Module}]}]}]} + [{atom,L,Module}]}]}]}, + {attribute,L,doc,false} | As]; true -> As diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl index 9bb0811276ef..2861b6348a21 100644 --- a/lib/eunit/src/eunit_surefire.erl +++ b/lib/eunit/src/eunit_surefire.erl @@ -100,12 +100,15 @@ _See also: _`m:eunit`. testsuites = [] :: [#testsuite{}] }). +-doc false. start() -> start([]). +-doc false. start(Options) -> eunit_listener:start(?MODULE, Options). +-doc false. init(Options) -> XMLDir = proplists:get_value(dir, Options, ?XMLDIR), ensure_xmldir(XMLDir), @@ -117,6 +120,7 @@ init(Options) -> St end. +-doc false. terminate({ok, _Data}, St) -> TestSuites = St#state.testsuites, XmlDir = St#state.xmldir, @@ -127,6 +131,7 @@ terminate({error, _Reason}, _St) -> %% Just terminate. ok. +-doc false. handle_begin(Kind, Data, St) when Kind == group; Kind == test -> %% Run this code both for groups and tests; test is a bit %% surprising: This is a workaround for the fact that we don't get @@ -145,6 +150,8 @@ handle_begin(Kind, Data, St) when Kind == group; Kind == test -> _ -> St end. + +-doc false. handle_end(group, Data, St) -> %% Retrieve existing test suite: case proplists:get_value(id, Data) of @@ -180,6 +187,7 @@ handle_end(test, Data, St) -> %% Cancel group does not give information on the individual cancelled test case %% We ignore this event... +-doc false. handle_cancel(group, Data, St) -> %% ...except when it tells us that a fixture setup or cleanup failed. case proplists:get_value(reason, Data) of diff --git a/lib/inets/examples/httpd_load_test/Makefile b/lib/inets/examples/httpd_load_test/Makefile index 19edf10cb0aa..ad14418075de 100644 --- a/lib/inets/examples/httpd_load_test/Makefile +++ b/lib/inets/examples/httpd_load_test/Makefile @@ -55,6 +55,7 @@ TARGET_FILES = \ ifeq ($(TYPE),debug) ERL_COMPILE_FLAGS += -Ddebug -W endif +ERL_COMPILE_FLAGS += +nowarn_missing_doc # ---------------------------------------------------- diff --git a/lib/megaco/examples/simple/Makefile b/lib/megaco/examples/simple/Makefile index 8f1ca41433d0..405c665fa43e 100644 --- a/lib/megaco/examples/simple/Makefile +++ b/lib/megaco/examples/simple/Makefile @@ -60,12 +60,14 @@ MEGACO_ROOT_DIR = $(shell (cd .. ; dirname `pwd`)) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- + ifeq ($(WARN_UNUSED_WARS),true) ERL_COMPILE_FLAGS += +warn_unused_vars endif ERL_COMPILE_FLAGS += \ -pa $(ERL_TOP)/lib/megaco/ebin \ + +nowarn_missing_doc \ -I../../include ifneq ($(MGC_HOST),) diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index d8dbcf9ad8df..8e5ad3ad148e 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -168,6 +168,7 @@ For details about how to get started with the Crashdump Viewer, see the %% Functions = local | global | FunctionList %% FunctionList = [Function] %% Function = {FunctionName,Arity} | FunctionName +-doc false. debug(F) -> ttb:tracer(all,[{file,"cdv"}]), % tracing all nodes ttb:p(all,[call,timestamp]), @@ -175,6 +176,7 @@ debug(F) -> tp(F,MS), ttb:ctp(?MODULE,stop_debug), % don't want tracing of the stop_debug func ok. +-doc false. tp([{M,F,A}|T],MS) -> % mod:func/arity ttb:tpl(M,F,A,MS), tp(T,MS); @@ -186,6 +188,7 @@ tp([M|T],MS) -> % mod tp(T,MS); tp([],_MS) -> ok. +-doc false. stop_debug() -> ttb:stop([format]). @@ -219,9 +222,11 @@ stop() -> %%%----------------------------------------------------------------- %%% Start crashdump_viewer via the cdv script located in %%% $OBSERVER_PRIV_DIR/bin +-doc false. script_start() -> do_script_start(fun() -> start() end), erlang:halt(). +-doc false. script_start([FileAtom]) -> File = atom_to_list(FileAtom), case filelib:is_regular(File) of @@ -269,6 +274,7 @@ usage() -> %%==================================================================== %%%-------------------------------------------------------------------- %%% Start the server - called by cdv_wx +-doc false. start_link() -> case whereis(?SERVER) of undefined -> @@ -279,69 +285,93 @@ start_link() -> %%%----------------------------------------------------------------- %%% Called by cdv_wx +-doc false. read_file(File) -> cast({read_file,File}). %%%----------------------------------------------------------------- %%% The following functions are called when the different tabs are %%% created +-doc false. general_info() -> call(general_info). +-doc false. processes() -> call(procs_summary). +-doc false. ports() -> call(ports). +-doc false. ets_tables(Owner) -> call({ets_tables,Owner}). +-doc false. internal_ets_tables() -> call(internal_ets_tables). +-doc false. timers(Owner) -> call({timers,Owner}). +-doc false. funs() -> call(funs). +-doc false. atoms() -> call(atoms). +-doc false. dist_info() -> call(dist_info). +-doc false. node_info(Channel) -> call({node_info,Channel}). +-doc false. loaded_modules() -> call(loaded_mods). +-doc false. loaded_mod_details(Mod) -> call({loaded_mod_details,Mod}). +-doc false. memory() -> call(memory). +-doc false. persistent_terms() -> call(persistent_terms). +-doc false. allocated_areas() -> call(allocated_areas). +-doc false. allocator_info() -> call(allocator_info). +-doc false. hash_tables() -> call(hash_tables). +-doc false. index_tables() -> call(index_tables). +-doc false. schedulers() -> call(schedulers). %%%----------------------------------------------------------------- %%% Called when a link to a process (Pid) is clicked. +-doc false. proc_details(Pid) -> call({proc_details,Pid}). %%%----------------------------------------------------------------- %%% Called when a link to a port is clicked. +-doc false. port(Id) -> call({port,Id}). %%%----------------------------------------------------------------- %%% Called when "<< xxx bytes>>" link is clicket to open a new window %%% displaying the whole binary. +-doc false. expand_binary(Pos) -> call({expand_binary,Pos}). %%%----------------------------------------------------------------- %%% For testing only - called from crashdump_viewer_SUITE +-doc false. get_dump_versions() -> call(get_dump_versions). @@ -357,6 +387,7 @@ get_dump_versions() -> %% ignore | %% {stop, Reason} %%-------------------------------------------------------------------- +-doc false. init([]) -> ets:new(cdv_dump_index_table,[ordered_set,named_table,public]), ets:new(cdv_reg_proc_table,[ordered_set,named_table,public]), @@ -374,6 +405,7 @@ init([]) -> %% {stop, Reason, Reply, State} | (terminate/2 is called) %% {stop, Reason, State} (terminate/2 is called) %%-------------------------------------------------------------------- +-doc false. handle_call(general_info,_From,State=#state{file=File}) -> GenInfo = general_info(File), NumAtoms = GenInfo#general_info.num_atoms, @@ -527,6 +559,7 @@ handle_call(get_dump_versions,_From,State=#state{dump_vsn=DumpVsn}) -> %% {noreply, State, Timeout} | %% {stop, Reason, State} (terminate/2 is called) %%-------------------------------------------------------------------- +-doc false. handle_cast({read_file,File}, _State) -> case do_read_file(File) of {ok,DumpVsn} -> @@ -547,6 +580,7 @@ handle_cast(stop,State) -> %% {noreply, State, Timeout} | %% {stop, Reason, State} (terminate/2 is called) %%-------------------------------------------------------------------- +-doc false. handle_info(_Info, State) -> {noreply, State}. @@ -555,6 +589,7 @@ handle_info(_Info, State) -> %% Description: Shutdown the server %% Returns: any (ignored by gen_server) %%-------------------------------------------------------------------- +-doc false. terminate(_Reason, _State) -> ok. @@ -563,6 +598,7 @@ terminate(_Reason, _State) -> %% Purpose: Convert process state when code is changed %% Returns: {ok, NewState} %%-------------------------------------------------------------------- +-doc false. code_change(_OldVsn, State, _Extra) -> {ok, State}. @@ -3309,12 +3345,14 @@ lookup_and_parse_index(File,What,ParseFun,Str) when is_list(File) -> %%%----------------------------------------------------------------- %%% Convert a record to a proplist +-doc false. to_proplist(Fields,Record) -> Values = to_value_list(Record), lists:zip(Fields,Values). %%%----------------------------------------------------------------- %%% Convert a record to a simple list of field values +-doc false. to_value_list(Record) -> [_RecordName|Values] = tuple_to_list(Record), Values. diff --git a/lib/parsetools/include/yeccpre.hrl b/lib/parsetools/include/yeccpre.hrl index a572ec6bd4c7..64e7d88db8e3 100644 --- a/lib/parsetools/include/yeccpre.hrl +++ b/lib/parsetools/include/yeccpre.hrl @@ -23,10 +23,16 @@ -type yecc_ret() :: {'error', _} | {'ok', _}. +-ifdef (YECC_PARSE_DOC). +-doc ?YECC_PARSE_DOC. +-endif. -spec parse(Tokens :: list()) -> yecc_ret(). parse(Tokens) -> yeccpars0(Tokens, {no_func, no_location}, 0, [], []). +-ifdef (YECC_PARSE_AND_SCAN_DOC). +-doc ?YECC_PARSE_AND_SCAN_DOC. +-endif. -spec parse_and_scan({function() | {atom(), atom()}, [_]} | {atom(), atom(), [_]}) -> yecc_ret(). parse_and_scan({F, A}) -> @@ -35,6 +41,9 @@ parse_and_scan({M, F, A}) -> Arity = length(A), yeccpars0([], {{fun M:F/Arity, A}, no_location}, 0, [], []). +-ifdef (YECC_FORMAT_ERROR_DOC). +-doc ?YECC_FORMAT_ERROR_DOC. +-endif. -spec format_error(any()) -> [char() | list()]. format_error(Message) -> case io_lib:deep_char_list(Message) of diff --git a/lib/snmp/examples/ex1/Makefile b/lib/snmp/examples/ex1/Makefile index b4e7c7f2dd95..dfbd46046c3a 100644 --- a/lib/snmp/examples/ex1/Makefile +++ b/lib/snmp/examples/ex1/Makefile @@ -41,6 +41,7 @@ ERL_COMPILE_FLAGS += -I../include \ +'{parse_transform,sys_pre_attributes}' \ +'{attribute,insert,app_vsn,$(APP_VSN)}' \ -I$(ERL_TOP)/lib/stdlib \ + +nowarn_missing_doc \ $(SNMP_FLAGS) # ---------------------------------------------------- diff --git a/lib/snmp/examples/ex2/Makefile b/lib/snmp/examples/ex2/Makefile index f0f652af7416..b8408d8cecfe 100644 --- a/lib/snmp/examples/ex2/Makefile +++ b/lib/snmp/examples/ex2/Makefile @@ -42,6 +42,7 @@ ERL_COMPILE_FLAGS += -I../include \ +'{parse_transform,sys_pre_attributes}' \ +'{attribute,insert,app_vsn,$(APP_VSN)}' \ -I$(ERL_TOP)/lib/stdlib \ + +nowarn_missing_doc \ $(SNMP_FLAGS) # ---------------------------------------------------- diff --git a/lib/ssl/examples/src/Makefile b/lib/ssl/examples/src/Makefile index 8b0435bfc419..aca8affabeb8 100644 --- a/lib/ssl/examples/src/Makefile +++ b/lib/ssl/examples/src/Makefile @@ -37,7 +37,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/ssl-$(VSN) # ---------------------------------------------------- # Common Macros # ---------------------------------------------------- -EXTRA_ERLC_FLAGS = +warn_unused_vars +EXTRA_ERLC_FLAGS = +warn_unused_vars +nowarn_missing_doc ERL_COMPILE_FLAGS += $(EXTRA_ERLC_FLAGS) diff --git a/lib/ssl/src/dtls_client_connection.erl b/lib/ssl/src/dtls_client_connection.erl index 36b26adb44c8..edb77326d7b0 100644 --- a/lib/ssl/src/dtls_client_connection.erl +++ b/lib/ssl/src/dtls_client_connection.erl @@ -19,6 +19,7 @@ %% -module(dtls_client_connection). +-moduledoc false. %%---------------------------------------------------------------------- %% Purpose: DTLS-1-DTLS-1.2 FSM (* = optional) diff --git a/lib/ssl/src/dtls_server_connection.erl b/lib/ssl/src/dtls_server_connection.erl index cf9cdb440f27..f5b3aa7d0a90 100644 --- a/lib/ssl/src/dtls_server_connection.erl +++ b/lib/ssl/src/dtls_server_connection.erl @@ -19,6 +19,7 @@ %% -module(dtls_server_connection). +-moduledoc false. %%---------------------------------------------------------------------- %% Purpose: DTLS-1-DTLS-1.2 FSM (* = optional) diff --git a/lib/ssl/src/tls_client_connection.erl b/lib/ssl/src/tls_client_connection.erl index c773237df6f4..45172f153191 100644 --- a/lib/ssl/src/tls_client_connection.erl +++ b/lib/ssl/src/tls_client_connection.erl @@ -98,6 +98,7 @@ %%---------------------------------------------------------------------- -module(tls_client_connection). +-moduledoc false. -behaviour(gen_statem). diff --git a/lib/ssl/src/tls_dtls_client_connection.erl b/lib/ssl/src/tls_dtls_client_connection.erl index d022dc7117a7..21facb617bec 100644 --- a/lib/ssl/src/tls_dtls_client_connection.erl +++ b/lib/ssl/src/tls_dtls_client_connection.erl @@ -27,6 +27,7 @@ %%---------------------------------------------------------------------- -module(tls_dtls_client_connection). +-moduledoc false. -include_lib("public_key/include/public_key.hrl"). diff --git a/lib/ssl/src/tls_dtls_gen_connection.erl b/lib/ssl/src/tls_dtls_gen_connection.erl index e6a22c379a4e..ef89a3e62a97 100644 --- a/lib/ssl/src/tls_dtls_gen_connection.erl +++ b/lib/ssl/src/tls_dtls_gen_connection.erl @@ -27,6 +27,7 @@ %%---------------------------------------------------------------------- -module(tls_dtls_gen_connection). +-moduledoc false. -include_lib("public_key/include/public_key.hrl"). diff --git a/lib/ssl/src/tls_dtls_server_connection.erl b/lib/ssl/src/tls_dtls_server_connection.erl index d318f86fa497..db4131448d6e 100644 --- a/lib/ssl/src/tls_dtls_server_connection.erl +++ b/lib/ssl/src/tls_dtls_server_connection.erl @@ -27,6 +27,7 @@ %%---------------------------------------------------------------------- -module(tls_dtls_server_connection). +-moduledoc false. -include_lib("public_key/include/public_key.hrl"). diff --git a/lib/ssl/src/tls_server_connection.erl b/lib/ssl/src/tls_server_connection.erl index cfb9608aebc8..8ce874d87cf8 100644 --- a/lib/ssl/src/tls_server_connection.erl +++ b/lib/ssl/src/tls_server_connection.erl @@ -18,6 +18,10 @@ %% %CopyrightEnd% %% %% + +-module(tls_server_connection). +-moduledoc false. + %%---------------------------------------------------------------------- %% Purpose: TLS-1.0-TLS-1.2 FSM (* = optional) %% %%---------------------------------------------------------------------- @@ -96,8 +100,6 @@ %% GO BACK TO HELLO %%---------------------------------------------------------------------- --module(tls_server_connection). - -behaviour(gen_statem). -include("tls_connection.hrl"). diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 61b939577268..649d34b4aa30 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -731,6 +731,43 @@ Header "". Erlang code. +-moduledoc """ +This module is the basic Erlang parser that converts tokens into the abstract +form of either forms (that is, top-level constructs), expressions, or terms. + +The Abstract Format is described in the ERTS User's Guide. Notice that a token +list must end with the dot token to be acceptable to the parse functions +(see the `m:erl_scan`) module. + +## Error Information + +ErrorInfo is the standard ErrorInfo structure that is returned from all I/O modules. +The format is as follows: + +``` +{ErrorLine, Module, ErrorDescriptor} +``` + +A string describing the error is obtained with the following call: + +``` +Module:format_error(ErrorDescriptor) +``` + +## See Also + +`m:erl_anno`, `m:erl_scan`, `m:io`, section [The Abstract Format](`e:erts:absform`) +in the ERTS User's Guide. +""". + +-define(YECC_PARSE_DOC, false). +-define(YECC_PARSE_AND_SCAN_DOC, false). +-define(YECC_FORMAT_ERROR_DOC, """ +Uses an ErrorDescriptor and returns a string that describes the error. + +This function is usually called implicitly when an ErrorInfo structure is +processed (see section [Error Information](#module-error-information)). +"""). -export([parse_form/1,parse_exprs/1,parse_term/1]). -export([normalise/1,abstract/1,tokens/1,tokens/2]). diff --git a/lib/stdlib/uc_spec/gen_unicode_mod.escript b/lib/stdlib/uc_spec/gen_unicode_mod.escript index a6ac3b0e60ab..ec775634cb99 100644 --- a/lib/stdlib/uc_spec/gen_unicode_mod.escript +++ b/lib/stdlib/uc_spec/gen_unicode_mod.escript @@ -238,6 +238,7 @@ gen_header(Fd) -> io:put_chars(Fd, "%%\n%% this file is generated do not modify\n"), io:put_chars(Fd, "%% see ../uc_spec/gen_unicode_mod.escript\n\n"), io:put_chars(Fd, "-module(" ++ ?MOD ++").\n"), + io:put_chars(Fd, "-moduledoc false.\n"), io:put_chars(Fd, "-export([cp/1, gc/1]).\n"), io:put_chars(Fd, "-export([nfd/1, nfc/1, nfkd/1, nfkc/1]).\n"), io:put_chars(Fd, "-export([whitespace/0, is_whitespace/1]).\n"), diff --git a/lib/syntax_tools/src/merl_transform.erl b/lib/syntax_tools/src/merl_transform.erl index 6f7baa7f06cc..7a7c2421784f 100644 --- a/lib/syntax_tools/src/merl_transform.erl +++ b/lib/syntax_tools/src/merl_transform.erl @@ -50,6 +50,7 @@ unless the macro `MERL_NO_TRANSFORM` is defined first. %% TODO: unroll calls to switch? it will probably get messy %% TODO: use Igor to make resulting code independent of merl at runtime? +-doc "". -spec parse_transform(InForms, Options :: term()) -> OutForms when InForms :: [erl_parse:abstract_form() | erl_parse:form_info()], OutForms :: [erl_parse:abstract_form() | erl_parse:form_info()]. diff --git a/lib/tools/src/xref_parser.yrl b/lib/tools/src/xref_parser.yrl index 5ee6419ff5bd..e406554c964c 100644 --- a/lib/tools/src/xref_parser.yrl +++ b/lib/tools/src/xref_parser.yrl @@ -106,6 +106,7 @@ type -> decl : value_of('$1'). type -> '$empty' : unknown. Erlang code. +-moduledoc false. -export([t2s/1]). diff --git a/lib/wx/examples/demo/Makefile b/lib/wx/examples/demo/Makefile index 123c54580f26..e83c0673623f 100644 --- a/lib/wx/examples/demo/Makefile +++ b/lib/wx/examples/demo/Makefile @@ -61,6 +61,8 @@ TESTMODS = \ TESTTARGETS = $(TESTMODS:%=%.beam) TESTSRC = $(TESTMODS:%=%.erl) +ERL_COMPILE_FLAGS += +nowarn_missing_doc + # Targets $(TYPES): $(TESTTARGETS) clean: diff --git a/lib/wx/examples/simple/Makefile b/lib/wx/examples/simple/Makefile index 16ac01d40df5..682cd28f8217 100644 --- a/lib/wx/examples/simple/Makefile +++ b/lib/wx/examples/simple/Makefile @@ -30,6 +30,8 @@ TESTMODS = hello hello2 minimal menu TESTTARGETS = $(TESTMODS:%=%.beam) TESTSRC = $(TESTMODS:%=%.erl) +ERL_COMPILE_FLAGS += +nowarn_missing_doc + # Targets $(TYPES): $(TESTTARGETS) clean: diff --git a/lib/wx/examples/sudoku/Makefile b/lib/wx/examples/sudoku/Makefile index ccdcb7cd9f2c..d6f614e0f758 100644 --- a/lib/wx/examples/sudoku/Makefile +++ b/lib/wx/examples/sudoku/Makefile @@ -30,6 +30,8 @@ TESTMODS = sudoku sudoku_board sudoku_game sudoku_gui TESTTARGETS = $(TESTMODS:%=%.beam) TESTSRC = $(TESTMODS:%=%.erl) +ERL_COMPILE_FLAGS += +nowarn_missing_doc + # Targets $(TYPES): $(TESTTARGETS) clean: diff --git a/lib/wx/src/Makefile b/lib/wx/src/Makefile index b055dfed4a05..6a0fc332adc6 100644 --- a/lib/wx/src/Makefile +++ b/lib/wx/src/Makefile @@ -33,7 +33,7 @@ EGEN = gen EBIN = ../ebin ERLC = erlc ERLINC = ../include -ERL_COMPILE_FLAGS += -I$(ERLINC) +warn_unused_vars +ERL_COMPILE_FLAGS += -I$(ERLINC) +warn_unused_vars +nowarn_missing_doc ARCHIVE = wx-$(VSN).ez diff --git a/lib/xmerl/src/xmerl_b64Bin.yrl b/lib/xmerl/src/xmerl_b64Bin.yrl index 7028cc079c9c..1153809a2104 100644 --- a/lib/xmerl/src/xmerl_b64Bin.yrl +++ b/lib/xmerl/src/xmerl_b64Bin.yrl @@ -67,3 +67,6 @@ b64 -> b64x. b16 -> b04. b16 -> b16x. + +Erlang code. +-moduledoc false. diff --git a/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc b/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc index 6e59347fb878..9ce25031fc42 100644 --- a/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_latin1.erlsrc @@ -24,6 +24,7 @@ %% Created : 26 May 2008 %%---------------------------------------------------------------------- -module(xmerl_sax_parser_latin1). +-moduledoc false. %%---------------------------------------------------------------------- %% Macros diff --git a/lib/xmerl/src/xmerl_sax_parser_list.erlsrc b/lib/xmerl/src/xmerl_sax_parser_list.erlsrc index bb9213bff113..c287da95531f 100644 --- a/lib/xmerl/src/xmerl_sax_parser_list.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_list.erlsrc @@ -24,6 +24,7 @@ %% Created : 25 Apr 2008 %%---------------------------------------------------------------------- -module(xmerl_sax_parser_list). +-moduledoc false. %%---------------------------------------------------------------------- %% Macros diff --git a/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc index ec89024729f0..e7f64620a281 100644 --- a/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_utf16be.erlsrc @@ -24,6 +24,7 @@ %% Created : 26 May 2008 %%---------------------------------------------------------------------- -module(xmerl_sax_parser_utf16be). +-moduledoc false. %%---------------------------------------------------------------------- %% Macros diff --git a/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc index 566333a0451d..c745ec3aeb20 100644 --- a/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_utf16le.erlsrc @@ -24,6 +24,7 @@ %% Created : 26 May 2008 %%---------------------------------------------------------------------- -module(xmerl_sax_parser_utf16le). +-moduledoc false. %%---------------------------------------------------------------------- %% Macros diff --git a/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc b/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc index f41d06d01390..b8434b8e23e1 100644 --- a/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_utf8.erlsrc @@ -24,6 +24,7 @@ %% Created : 27 May 2008 %%---------------------------------------------------------------------- -module(xmerl_sax_parser_utf8). +-moduledoc false. %%---------------------------------------------------------------------- %% Macros diff --git a/lib/xmerl/src/xmerl_xpath_parse.yrl b/lib/xmerl/src/xmerl_xpath_parse.yrl index 1926e7ee84ef..98a5193e381d 100644 --- a/lib/xmerl/src/xmerl_xpath_parse.yrl +++ b/lib/xmerl/src/xmerl_xpath_parse.yrl @@ -301,6 +301,7 @@ Expect 2. Erlang code. +-moduledoc false. % token({Token, _Line}) -> % Token; diff --git a/make/otp.mk.in b/make/otp.mk.in index 589148c6126e..51a5aa0d79f1 100644 --- a/make/otp.mk.in +++ b/make/otp.mk.in @@ -103,7 +103,7 @@ endif ifdef PRIMARY_BOOTSTRAP ERL_COMPILE_FLAGS += +slim else - ERL_COMPILE_FLAGS += +debug_info + ERL_COMPILE_FLAGS += +debug_info +warn_missing_doc_function +warn_missing_doc_callback endif ifeq ($(ERL_DETERMINISTIC),yes) ERL_COMPILE_FLAGS += +deterministic