diff options
Diffstat (limited to 'lib')
865 files changed, 42974 insertions, 39264 deletions
diff --git a/lib/asn1/Makefile b/lib/asn1/Makefile index 26e7e37924..10a8795703 100644 --- a/lib/asn1/Makefile +++ b/lib/asn1/Makefile @@ -54,12 +54,7 @@ SPECIAL_TARGETS = include $(ERL_TOP)/make/otp_subdir.mk -.PHONY: info version - -info: - @echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)" - @echo "APP_DIR: $(APP_DIR)" - @echo "APP_TAR_FILE: $(APP_TAR_FILE)" +.PHONY: version version: @echo "$(VSN)" @@ -100,3 +95,5 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/asn1/doc/src/Makefile b/lib/asn1/doc/src/Makefile index 9c0d865884..c18f567240 100644 --- a/lib/asn1/doc/src/Makefile +++ b/lib/asn1/doc/src/Makefile @@ -21,6 +21,7 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk + # ---------------------------------------------------- # Application version # ---------------------------------------------------- @@ -29,11 +30,6 @@ VSN=$(ASN1_VSN) APPLICATION=asn1 # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -47,6 +43,7 @@ XML_PART_FILES = part.xml XML_HTML_FILE = \ notes_history.xml + XML_CHAPTER_FILES = \ asn1_introduction.xml \ asn1_getting_started.xml \ @@ -60,77 +57,11 @@ XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ XML_GEN_FILES = $(GEN_XML:%=$(XMLDIR)/%) -GIF_FILES = \ +IMAGE_FILES = \ exclusive_Win_But.gif \ selective_Window2.gif \ selective_TypeList.gif -# ---------------------------------------------------- - -ASN1_FILES = \ - Seq.asn \ - Seq.asn1config - -INFO_FILE = ../../info -EXTRA_FILES = \ - $(DEFAULT_HTML_FILES) \ - $(ASN1_FILES) \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(GEN_XML:%.xml=$(HTMLDIR)/%.html) \ - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f $(GEN_XML) errs core *~ - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" +include $(ERL_TOP)/make/doc.mk -release_spec: +.SECONDARY: $(XML_GEN_FILES) diff --git a/lib/asn1/doc/users_guide/Makefile b/lib/asn1/doc/users_guide/Makefile index 38196f5e1c..079af7ac1f 100644 --- a/lib/asn1/doc/users_guide/Makefile +++ b/lib/asn1/doc/users_guide/Makefile @@ -40,8 +40,7 @@ PSFIG_FILES= USERS_GUIDE = users_guide.sgml EXTRA_GEN_FILES= $(SGML_FILES:.sgml=.html) \ - users_guide_frame.html users_guide_first.html \ - min_head.gif + users_guide_frame.html users_guide_first.html HTML_FILES= $(USERS_GUIDE:.sgml=.html) diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index cd50d30aa8..5708d5cb7e 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -76,6 +76,11 @@ -define(ALTERNATIVE_UNDECODED,alt_undec). -define(ALTERNATIVE_PARTS,alt_parts). +%% Removed functions + +-removed({decode,'_',"use Mod:decode/2 instead"}). +-removed({encode,'_',"use Mod:encode/2 instead"}). + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% This is the interface to the compiler diff --git a/lib/asn1/src/asn1ct_tok.erl b/lib/asn1/src/asn1ct_tok.erl index 8235b689f8..76ff60f9cf 100644 --- a/lib/asn1/src/asn1ct_tok.erl +++ b/lib/asn1/src/asn1ct_tok.erl @@ -239,16 +239,16 @@ skip_multiline_comment(Stream, [_|T], Lno, Level) -> skip_multiline_comment(Stream, T, Lno, Level). collect_quoted("'B"++T, Lno, L) -> - case check_bin(L) of - true -> - {{bstring,Lno,lists:reverse(L)}, T}; + case validate_bin(L) of + {ok, Bin} -> + {{bstring,Lno,Bin}, T}; false -> throw({error,{invalid_binary_number,lists:reverse(L)}}) end; collect_quoted("'H"++T, Lno, L) -> - case check_hex(L) of - true -> - {{hstring,Lno,lists:reverse(L)}, T}; + case validate_hex(L) of + {ok, Hex} -> + {{hstring,Lno,Hex}, T}; false -> throw({error,{invalid_hex_number,lists:reverse(L)}}) end; @@ -257,24 +257,31 @@ collect_quoted([H|T], Lno, L) -> collect_quoted([], _, _) -> % This should be allowed FIX later throw({error,eol_in_token}). -check_bin([$0|T]) -> - check_bin(T); -check_bin([$1|T]) -> - check_bin(T); -check_bin([]) -> - true; -check_bin(_) -> - false. - -check_hex([H|T]) when $0 =< H , H =< $9 -> - check_hex(T); -check_hex([H|T]) when $A =< H , H =< $F -> - check_hex(T); -check_hex([]) -> - true; -check_hex(_) -> - false. - +validate_bin(L) -> + validate_bin(L,[]). + +validate_bin([H|T], A) when H =:= $0; H =:= $1 -> + validate_bin(T, [H|A]); +validate_bin([$\s|T], A) -> + validate_bin(T, A); +validate_bin([_|_], _) -> + false; +validate_bin([], A) -> + {ok, A}. + +validate_hex(L) -> + validate_hex(L,[]). + +validate_hex([H|T], A) when $0 =< H , H =< $9 -> + validate_hex(T, [H|A]); +validate_hex([H|T], A) when $A =< H , H =< $F -> + validate_hex(T, [H|A]); +validate_hex([$\s|T], A) -> + validate_hex(T, A); +validate_hex([_|_], _) -> + false; +validate_hex([], A) -> + {ok, A}. %% reserved_word(A) -> true|false|rstrtype %% A = atom() diff --git a/lib/asn1/src/asn1rt.erl b/lib/asn1/src/asn1rt.erl new file mode 100644 index 0000000000..fc2e2c2d2a --- /dev/null +++ b/lib/asn1/src/asn1rt.erl @@ -0,0 +1,34 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2020. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% This module was removed entirely in OTP 20.0, it's only retained for its +%% removal warning attribute. +%% + +-module(asn1rt). + +-removed({decode,'_',"use Mod:decode/2 instead"}). +-removed({encode,'_',"use Mod:encode/2 instead"}). + +-removed({utf8_binary_to_list,'_', + "use unicode:characters_to_list/1 instead"}). +-removed({utf8_list_to_binary,'_', + "use unicode:characters_to_binary/1 instead"}). diff --git a/lib/asn1/test/asn1_SUITE_data/ValueTest.asn b/lib/asn1/test/asn1_SUITE_data/ValueTest.asn index b2c59d686a..0474386061 100644 --- a/lib/asn1/test/asn1_SUITE_data/ValueTest.asn +++ b/lib/asn1/test/asn1_SUITE_data/ValueTest.asn @@ -100,6 +100,7 @@ os-holder-1 OS-HOLDER ::= { ID 1 OS '4041FF'H } OctetStringSeq ::= ParamSeq{OCTET STRING} someOctetString OCTET STRING ::= '404142'H +someOctetStringWhiteSpace OCTET STRING ::= '40 41 42'H octetStringSeq1 OctetStringSeq ::= { a someOctetString } octetStringSeq2 OctetStringSeq ::= { a otherOctetString } @@ -128,6 +129,7 @@ BsSeq ::= SEQUENCE { } someBitString BIT STRING ::= '101101'B +someBitStringWhiteSpace BIT STRING ::= '101 101'B bsSeq1 BsSeq ::= { a someBitString, b someNamedBs } bsSeq2 BsSeq ::= { a otherBitString, b someOtherNamedBs } diff --git a/lib/asn1/test/testValueTest.erl b/lib/asn1/test/testValueTest.erl index 6699c0094a..f09a9ee307 100644 --- a/lib/asn1/test/testValueTest.erl +++ b/lib/asn1/test/testValueTest.erl @@ -84,6 +84,7 @@ main() -> {'OctetStringSeq',<<16#40,16#41,16#42>>} = M:octetStringSeq1(), <<16#40,16#41,16#42>> = M:otherOctetString(), <<16#40,16#41,16#42>> = M:someOctetString(), + <<16#40,16#41,16#42>> = M:someOctetStringWhiteSpace(), {'OctetStringSeq',<<16#40,16#41,16#42>>} = M:octetStringSeq2(), {'OctetStringSeq',<<16#40,16#41,16#FF>>} = M:octetStringSeq3(), <<16#40,16#41,16#FF>> = M:'os-1'(), @@ -94,6 +95,7 @@ main() -> {'BsSeq',<<2#101101:6>>,[c]} = M:bsSeq2(), {'BsSeq',<<2#101:3>>,[a,c]} = M:bsSeq3(), <<2#101101:6>> = M:someBitString(), + <<2#101101:6>> = M:someBitStringWhiteSpace(), <<2#101101:6>> = M:otherBitString(), <<2#101:3>> = M:bsFromObject(), <<2#101:3>> = M:bsFromObjectInd(), diff --git a/lib/common_test/Makefile b/lib/common_test/Makefile index f2065b8a0d..5ac76f0044 100644 --- a/lib/common_test/Makefile +++ b/lib/common_test/Makefile @@ -45,3 +45,7 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=compiler tools crypto runtime_tools syntax_tools ftp inets \ + debugger sasl snmp ssh reltool observer xmerl + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile index ae06572752..3a37cac09c 100644 --- a/lib/common_test/doc/src/Makefile +++ b/lib/common_test/doc/src/Makefile @@ -27,10 +27,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk include ../../vsn.mk VSN=$(COMMON_TEST_VSN) APPLICATION=common_test -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # ---------------------------------------------------- # Target Specs @@ -39,7 +35,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) CT_XML_FILES = $(CT_MODULES:=.xml) XML_APPLICATION_FILES = ref_man.xml -XML_REF1_FILES = ct_run.xml +XML_REF1_FILES = ct_run_cmd.xml # REMEMBER: links to HTML files for these modules in ref_man.xml XML_REF3_FILES = ct.xml \ ct_master.xml \ @@ -80,95 +76,18 @@ XML_CHAPTER_FILES = \ BOOK_FILES = book.xml -GIF_FILES = \ +IMAGE_FILES = \ tc_execution.gif \ config.gif \ html_logs.gif -INSTALL_NOTES = ../../notes.html - XML_FILES=$(XML_APPLICATION_FILES) $(XML_REF1_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES) \ $(XML_PART_FILES) $(XML_CHAPTER_FILES) $(BOOK_FILES) -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN1_FILES = $(XML_REF1_FILES:%.xml=$(MAN1DIR)/%.1) -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) - TOP_SPECS_FILE = specs.xml -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += -SPECS_FLAGS = -I../../include -I../../../snmp/include \ - -I../../../kernel/include - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: man pdf html - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -man: $(MAN6_FILES) $(MAN3_FILES) $(MAN1_FILES) +NO_CHUNKS = ct_hooks.xml - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN1DIR)/* - rm -f $(MAN3DIR)/* - rm -f $(MAN6DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f $(SPECDIR)/* - rm -f errs core *~ - -# ---------------------------------------------------- -# Release Target # ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man1" - $(INSTALL_DATA) $(MAN1DIR)/* "$(RELEASE_PATH)/man/man1" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6DIR)/* "$(RELEASE_PATH)/man/man6" - -release_spec: -release_tests_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/common_test/doc/src/ct_hooks_chapter.xml b/lib/common_test/doc/src/ct_hooks_chapter.xml index ea4b67be08..8d1c546fb1 100644 --- a/lib/common_test/doc/src/ct_hooks_chapter.xml +++ b/lib/common_test/doc/src/ct_hooks_chapter.xml @@ -506,9 +506,13 @@ If an event cannot be associated with a test case, it is printed in the <c>Common Test</c> framework log. This happens for test cases running in parallel and events occuring - in-between test cases. You can configure the level of - <seealso marker="sasl:sasl_app">SASL</seealso> reports - using the normal SASL mechanisms.</p> + in-between test cases.</p> + <p>The log events are handled using a <seealso marker="kernel:logger">Logger</seealso> + handler called cth_log_redirect. The formatting and level is copied from + the current <c>default</c> handler when the cth is started. If you want to + use another level either change the <c>default</c> handler level before + starting common_test, or use the <seealso marker="kernel:logger#set_handler_config-3"> + <c>logger:set_handler_config/3</c></seealso> API.</p> </item> <tag><c>cth_surefire</c></tag> <item> @@ -541,7 +545,3 @@ x86_64-unknown-linux-gnu.my_test.logs/run.2012-12-12_11.19.39/suite.log.html"</c </section> </chapter> - - - - diff --git a/lib/common_test/doc/src/ct_run.xml b/lib/common_test/doc/src/ct_run_cmd.xml index 5b962ed5c7..3a9b8bbc03 100644 --- a/lib/common_test/doc/src/ct_run.xml +++ b/lib/common_test/doc/src/ct_run_cmd.xml @@ -11,7 +11,7 @@ Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at - + http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software @@ -226,4 +226,3 @@ </section> </comref> - diff --git a/lib/common_test/doc/src/ref_man.xml b/lib/common_test/doc/src/ref_man.xml index 1ac20db5c2..e916fc7cec 100644 --- a/lib/common_test/doc/src/ref_man.xml +++ b/lib/common_test/doc/src/ref_man.xml @@ -33,7 +33,7 @@ </description> <xi:include href="common_test_app.xml"/> - <xi:include href="ct_run.xml"/> + <xi:include href="ct_run_cmd.xml"/> <xi:include href="ct.xml"/> <xi:include href="ct_master.xml"/> <xi:include href="ct_cover.xml"/> diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl index a07e61199b..adb90c0869 100644 --- a/lib/common_test/src/ct_config.erl +++ b/lib/common_test/src/ct_config.erl @@ -24,6 +24,8 @@ %% Created : 15 February 2010 %%---------------------------------------------------------------------- -module(ct_config). +-compile([{nowarn_deprecated_function,{crypto,block_decrypt,4}}, + {nowarn_deprecated_function,{crypto,block_encrypt,4}}]). -export([start/1, stop/0]). @@ -600,7 +602,7 @@ encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) -> 0 -> Bin1; N -> list_to_binary([Bin1,random_bytes(8-N)]) end, - EncBin = crypto:block_encrypt(des3_cbc, CryptoKey, IVec, Bin2), + EncBin = crypto:crypto_one_time(des_ede3_cbc, CryptoKey, IVec, Bin2, true), case file:write_file(EncryptFileName, EncBin) of ok -> io:format("~ts --(encrypt)--> ~ts~n", @@ -634,7 +636,7 @@ decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) -> {CryptoKey,IVec} = make_crypto_key(Key), case file:read_file(EncryptFileName) of {ok,Bin} -> - DecBin = crypto:block_decrypt(des3_cbc, CryptoKey, IVec, Bin), + DecBin = crypto:crypto_one_time(des_ede3_cbc, CryptoKey, IVec, Bin, false), case catch binary_to_term(DecBin) of {'EXIT',_} -> {error,bad_file}; @@ -706,7 +708,8 @@ get_crypt_key_from_file() -> make_crypto_key(String) -> <<K1:8/binary,K2:8/binary>> = First = erlang:md5(String), <<K3:8/binary,IVec:8/binary>> = erlang:md5([First|lists:reverse(String)]), - {[K1,K2,K3],IVec}. + Key = <<K1/binary,K2/binary,K3/binary>>, + {Key,IVec}. random_bytes(N) -> random_bytes_1(N, []). diff --git a/lib/common_test/src/ct_property_test.erl b/lib/common_test/src/ct_property_test.erl index 251a0a4896..b8bb890add 100644 --- a/lib/common_test/src/ct_property_test.erl +++ b/lib/common_test/src/ct_property_test.erl @@ -23,8 +23,8 @@ %%% API %% Main functions -export([init_per_suite/1, - quickcheck/2 - ]). + init_tool/1, + quickcheck/2]). %% Result presentation -export([present_result/4, present_result/5, @@ -50,34 +50,40 @@ %%% the property tests %%% init_per_suite(Config) -> + case init_tool(Config) of + {skip, _}=Skip -> + Skip; + Config1 -> + Path = property_tests_path("property_test", Config1), + case compile_tests(Path, Config1) of + error -> + {fail, "Property test compilation failed in "++Path}; + {skip,Reason} -> + {skip,Reason}; + up_to_date -> + add_code_pathz(Path), + [{property_dir, Path} | Config1] + end + end. + +init_tool(Config) -> ToolsToCheck = proplists:get_value(prop_tools, Config, [eqc,proper,triq]), case which_module_exists(ToolsToCheck) of {ok,ToolModule} -> case code:where_is_file(lists:concat([ToolModule,".beam"])) of non_existing -> - ct:log("Found ~p, but ~tp is not found", + ct:log("Found ~p, but ~tp~n is not found", [ToolModule, lists:concat([ToolModule,".beam"])]), {skip, "Strange Property testing tool installation"}; ToolPath -> ct:pal("Found property tester ~p~n" "at ~tp", [ToolModule, ToolPath]), - Path = property_tests_path("property_test", Config), - case compile_tests(Path,ToolModule) of - error -> - {fail, "Property test compilation failed in "++Path}; - {skip,Reason} -> - {skip,Reason}; - up_to_date -> - add_code_pathz(Path), - [{property_dir,Path}, - {property_test_tool,ToolModule} | Config] - end + [{property_test_tool, ToolModule} | Config] end; - - not_found -> - ct:pal("No property tester found",[]), - {skip, "No property testing tool found"} + not_found -> + ct:pal("No property tester found",[]), + {skip, "No property testing tool found"} end. %%%---------------------------------------------------------------- @@ -189,7 +195,8 @@ add_code_pathz(Dir) -> ok end. -compile_tests(Path, ToolModule) -> +compile_tests(Path, Config) -> + ToolModule = proplists:get_value(property_test_tool, Config), MacroDefs = macro_def(ToolModule), {ok,Cwd} = file:get_cwd(), case file:set_cwd(Path) of diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index fe869a4373..9743611425 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -129,10 +129,16 @@ start_log_handler() -> _Pid -> ok end, + {DefaultFormatter, DefaultLevel} = + case logger:get_handler_config(default) of + {ok, Default} -> + {maps:get(formatter, Default), maps:get(level, Default)}; + _Else -> + {{?DEFAULT_FORMATTER,?DEFAULT_FORMAT_CONFIG},info} + end, ok = logger:add_handler(?MODULE,?MODULE, - #{level=>info, - formatter=>{?DEFAULT_FORMATTER, - ?DEFAULT_FORMAT_CONFIG}}). + #{level=>DefaultLevel, + formatter=>DefaultFormatter}). init([]) -> {ok, #eh_state{log_func = tc_log_async}}. diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index b87464f5e4..4c95fcbde3 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -32,6 +32,7 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("common_test/include/ct_event.hrl"). +-include_lib("kernel/src/logger_internal.hrl"). -define(eh, ct_test_support_eh). @@ -60,6 +61,13 @@ end_per_suite(Config) -> init_per_testcase(TestCase, Config) -> ct_test_support:init_per_testcase(TestCase, Config). + +end_per_testcase(cth_log_formatter = TestCase, Config) -> + ct_test_support:ct_rpc( + {logger,set_handler_config, + [default, formatter, + {?DEFAULT_FORMATTER,?DEFAULT_FORMAT_CONFIG}]}, Config), + ct_test_support:end_per_testcase(TestCase, Config); end_per_testcase(TestCase, Config) -> ct_test_support:end_per_testcase(TestCase, Config). @@ -92,7 +100,8 @@ all(suite) -> fail_n_skip_with_minimal_cth, prio_cth, no_config, no_init_suite_config, no_init_config, no_end_config, failed_sequence, repeat_force_stop, config_clash, - callbacks_on_skip, fallback, data_dir, cth_log + callbacks_on_skip, fallback, data_dir, + cth_log, cth_log_formatter, cth_log_unexpect ] ). @@ -263,10 +272,79 @@ data_dir(Config) when is_list(Config) -> cth_log(Config) when is_list(Config) -> %% test that cth_log_redirect writes properly to - %% unexpected I/O log + %% html I/O log ct:timetrap({minutes,10}), StartOpts = do_test(cth_log, "cth_log_SUITE.erl", [], Config), Logdir = proplists:get_value(logdir, StartOpts), + TCLogs = + filelib:wildcard( + filename:join(Logdir, + "ct_run*/cth.tests*/run*/cth_log_suite.tc*.html")), + lists:foreach( + fun(TCLog) -> + {ok,Bin} = file:read_file(TCLog), + Ts = string:lexemes(binary_to_list(Bin),[$\n]), + Matches = lists:foldl(fun("=ERROR"++_, {E,I,N,L}) -> + {E+1,I,N,L}; + ("=INFO"++_, {E,I,N,L}) -> + {E,I+1,N,L}; + ("=NOTICE"++_, {E,I,N,L}) -> + {E,I,N+1,L}; + ("Logger"++_, {E,I,N,L}) -> + {E,I,N,L+1}; + (_, N) -> N + end, {0,0,0,0}, Ts), + ct:pal("~p ({Error,Info,Notice,Log}) matches in ~tp", + [Matches,TCLog]), + MatchList = tuple_to_list(Matches), + case [N || N <- MatchList, N<1] of + [] -> ok; + _ -> exit({missing_io,TCLog}) + end + end, TCLogs), + ok. + +cth_log_formatter(Config) when is_list(Config) -> + %% test that cth_log_redirect writes properly to + %% html I/O log using the formatter + ct:timetrap({minutes,10}), + ct_test_support:ct_rpc({logger,set_handler_config,[default, formatter, + {logger_formatter,#{ template => [level,":",msg,"\n"] }}]}, + Config), + StartOpts = do_test(cth_log_formatter, "cth_log_formatter_SUITE.erl", [], Config), + Logdir = proplists:get_value(logdir, StartOpts), + TCLogs = + filelib:wildcard( + filename:join(Logdir, + "ct_run*/cth.tests*/run*/cth_log_formatter_suite.tc*.html")), + lists:foreach( + fun(TCLog) -> + {ok,Bin} = file:read_file(TCLog), + Ts = string:lexemes(binary_to_list(Bin),[$\n]), + Matches = lists:foldl(fun("error:"++_, {E,N,L}) -> + {E+1,N,L}; + ("notice:"++_, {E,N,L}) -> + {E,N+1,L}; + ("Logger"++_, {E,N,L}) -> + {E,N,L+1}; + (_, N) -> N + end, {0,0,0}, Ts), + ct:pal("~p ({Error,Notice,Log}) matches in ~tp", + [Matches,TCLog]), + MatchList = tuple_to_list(Matches), + case [N || N <- MatchList, N<1] of + [] -> ok; + _ -> exit({missing_io,TCLog}) + end + end, TCLogs), + ok. + +cth_log_unexpect(Config) when is_list(Config) -> + %% test that cth_log_redirect writes properly to + %% unexpected I/O log + ct:timetrap({minutes,10}), + StartOpts = do_test(cth_log_unexpect, "cth_log_unexpect_SUITE.erl", [], Config), + Logdir = proplists:get_value(logdir, StartOpts), UnexpIoLogs = filelib:wildcard( filename:join(Logdir, @@ -275,11 +353,11 @@ cth_log(Config) when is_list(Config) -> fun(UnexpIoLog) -> {ok,Bin} = file:read_file(UnexpIoLog), Ts = string:lexemes(binary_to_list(Bin),[$\n]), - Matches = lists:foldl(fun([$=,$E,$R,$R,$O,$R|_], {E,I,L}) -> + Matches = lists:foldl(fun("=ERROR"++_, {E,I,L}) -> {E+1,I,L}; - ([$=,$I,$N,$F,$O|_], {E,I,L}) -> + ("=INFO"++_, {E,I,L}) -> {E,I+1,L}; - ([$L,$o,$g,$g,$e,$r|_], {E,I,L}) -> + ("Logger"++_, {E,I,L}) -> {E,I,L+1}; (_, N) -> N end, {0,0,0}, Ts), @@ -1824,18 +1902,58 @@ test_events(cth_log) -> {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{cth_log_SUITE,init_per_suite}}, + {?eh,tc_start,{ct_framework,{init_per_group,g1, + [{suite,cth_log_SUITE}]}}}, + {?eh,tc_done,{ct_framework,{init_per_group,g1, + [{suite,cth_log_SUITE}]},ok}}, + {?eh,test_stats,{30,0,{0,0}}}, + {?eh,tc_start,{ct_framework,{end_per_group,g1, + [{suite,cth_log_SUITE}]}}}, + {?eh,tc_done,{ct_framework,{end_per_group,g1, + [{suite,cth_log_SUITE}]},ok}}, + + {?eh,tc_done,{cth_log_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(cth_log_formatter) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{cth_log_formatter_SUITE,init_per_suite}}, + + {?eh,tc_start,{ct_framework,{init_per_group,g1, + [{suite,cth_log_formatter_SUITE}]}}}, + {?eh,tc_done,{ct_framework,{init_per_group,g1, + [{suite,cth_log_formatter_SUITE}]},ok}}, + {?eh,test_stats,{30,0,{0,0}}}, + {?eh,tc_start,{ct_framework,{end_per_group,g1, + [{suite,cth_log_formatter_SUITE}]}}}, + {?eh,tc_done,{ct_framework,{end_per_group,g1, + [{suite,cth_log_formatter_SUITE}]},ok}}, + + {?eh,tc_done,{cth_log_formatter_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(cth_log_unexpect) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{cth_log_unexpect_SUITE,init_per_suite}}, + {parallel, [{?eh,tc_start,{ct_framework,{init_per_group,g1, - [{suite,cth_log_SUITE},parallel]}}}, + [{suite,cth_log_unexpect_SUITE},parallel]}}}, {?eh,tc_done,{ct_framework,{init_per_group,g1, - [{suite,cth_log_SUITE},parallel]},ok}}, + [{suite,cth_log_unexpect_SUITE},parallel]},ok}}, {?eh,test_stats,{30,0,{0,0}}}, {?eh,tc_start,{ct_framework,{end_per_group,g1, - [{suite,cth_log_SUITE},parallel]}}}, + [{suite,cth_log_unexpect_SUITE},parallel]}}}, {?eh,tc_done,{ct_framework,{end_per_group,g1, - [{suite,cth_log_SUITE},parallel]},ok}}]}, + [{suite,cth_log_unexpect_SUITE},parallel]},ok}}]}, - {?eh,tc_done,{cth_log_SUITE,end_per_suite,ok}}, + {?eh,tc_done,{cth_log_unexpect_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl index eda190b682..0de234f77e 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl @@ -41,8 +41,8 @@ suite() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> application:start(sasl), - Gen = spawn(fun() -> gen() end), - [{gen,Gen}|Config]. + do_log(?FUNCTION_NAME), + Config. %%-------------------------------------------------------------------- %% @spec end_per_suite(Config0) -> void() | {save_config,Config1} @@ -50,9 +50,7 @@ init_per_suite(Config) -> %% @end %%-------------------------------------------------------------------- end_per_suite(Config) -> - Gen = proplists:get_value(gen, Config), - exit(Gen, kill), - ct:sleep(100), + do_log(?FUNCTION_NAME), application:stop(sasl), ok. @@ -92,8 +90,7 @@ end_per_testcase(_TestCase, _Config) -> %% @end %%-------------------------------------------------------------------- groups() -> - [{g1,[parallel,{repeat,10}],[tc1,tc2,tc3]}, - {g2,[{repeat,10}],[tc1,tc2,tc3]}]. + [{g1,[{repeat,10}],[tc1,tc2,tc3]}]. %%-------------------------------------------------------------------- %% @spec all() -> GroupsAndTestCases | {skip,Reason} @@ -104,26 +101,24 @@ groups() -> %% @end %%-------------------------------------------------------------------- all() -> - [{group,g1},{group,g2}]. + [{group,g1}]. tc1(_) -> - ct:sleep(100), + do_log(?FUNCTION_NAME), ok. tc2(_) -> - ct:sleep(100), + do_log(?FUNCTION_NAME), ok. tc3(_) -> - ct:sleep(100), + do_log(?FUNCTION_NAME), ok. %%%----------------------------------------------------------------- -gen() -> - gen_loop(1). -gen_loop(N) -> - ct:log("Logger iteration: ~p", [N]), - error_logger:error_report(N), - error_logger:info_report(N), - ct:sleep(150), - gen_loop(N+1). +do_log(What) -> + ct:log("Logger ~p", [What]), + error_logger:error_report(What), + error_logger:info_report(What), + logger:notice("~p",[What]), + timer:sleep(100). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_formatter_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_formatter_SUITE.erl new file mode 100644 index 0000000000..26097f5eae --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_formatter_SUITE.erl @@ -0,0 +1,124 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(cth_log_formatter_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +%%-------------------------------------------------------------------- +%% @spec suite() -> Info +%% Info = [tuple()] +%% @end +%%-------------------------------------------------------------------- +suite() -> + [{timetrap,{seconds,30}}]. + +%%-------------------------------------------------------------------- +%% @spec init_per_suite(Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + application:start(sasl), + do_log(?FUNCTION_NAME), + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_suite(Config0) -> void() | {save_config,Config1} +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_suite(Config) -> + do_log(?FUNCTION_NAME), + application:stop(sasl), + ok. + +%%-------------------------------------------------------------------- +%% @spec init_per_testcase(TestCase, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_testcase(TestCase, Config0) -> +%% void() | {save_config,Config1} | {fail,Reason} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +end_per_testcase(_TestCase, _Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec groups() -> [Group] +%% Group = {GroupName,Properties,GroupsAndTestCases} +%% GroupName = atom() +%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}] +%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase] +%% TestCase = atom() +%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}} +%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | +%% repeat_until_any_ok | repeat_until_any_fail +%% N = integer() | forever +%% @end +%%-------------------------------------------------------------------- +groups() -> + [{g1,[{repeat,10}],[tc1,tc2,tc3]}]. + +%%-------------------------------------------------------------------- +%% @spec all() -> GroupsAndTestCases | {skip,Reason} +%% GroupsAndTestCases = [{group,GroupName} | TestCase] +%% GroupName = atom() +%% TestCase = atom() +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +all() -> + [{group,g1}]. + +tc1(_) -> + do_log(?FUNCTION_NAME), + ok. +tc2(_) -> + do_log(?FUNCTION_NAME), + ok. +tc3(_) -> + do_log(?FUNCTION_NAME), + ok. + +%%%----------------------------------------------------------------- + + +do_log(What) -> + ct:log("Logger ~p", [What]), + error_logger:error_report(What), + error_logger:info_report(What), + logger:notice("~p",[What]), + timer:sleep(100). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_unexpect_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_unexpect_SUITE.erl new file mode 100644 index 0000000000..af482b8f27 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_unexpect_SUITE.erl @@ -0,0 +1,129 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(cth_log_unexpect_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +%%-------------------------------------------------------------------- +%% @spec suite() -> Info +%% Info = [tuple()] +%% @end +%%-------------------------------------------------------------------- +suite() -> + [{timetrap,{seconds,30}}]. + +%%-------------------------------------------------------------------- +%% @spec init_per_suite(Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + application:start(sasl), + Gen = spawn(fun() -> gen() end), + [{gen,Gen}|Config]. + +%%-------------------------------------------------------------------- +%% @spec end_per_suite(Config0) -> void() | {save_config,Config1} +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_suite(Config) -> + Gen = proplists:get_value(gen, Config), + exit(Gen, kill), + ct:sleep(100), + application:stop(sasl), + ok. + +%%-------------------------------------------------------------------- +%% @spec init_per_testcase(TestCase, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_testcase(TestCase, Config0) -> +%% void() | {save_config,Config1} | {fail,Reason} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +end_per_testcase(_TestCase, _Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec groups() -> [Group] +%% Group = {GroupName,Properties,GroupsAndTestCases} +%% GroupName = atom() +%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}] +%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase] +%% TestCase = atom() +%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}} +%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | +%% repeat_until_any_ok | repeat_until_any_fail +%% N = integer() | forever +%% @end +%%-------------------------------------------------------------------- +groups() -> + [{g1,[parallel,{repeat,10}],[tc1,tc2,tc3]}, + {g2,[{repeat,10}],[tc1,tc2,tc3]}]. + +%%-------------------------------------------------------------------- +%% @spec all() -> GroupsAndTestCases | {skip,Reason} +%% GroupsAndTestCases = [{group,GroupName} | TestCase] +%% GroupName = atom() +%% TestCase = atom() +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +all() -> + [{group,g1},{group,g2}]. + +tc1(_) -> + ct:sleep(100), + ok. +tc2(_) -> + ct:sleep(100), + ok. +tc3(_) -> + ct:sleep(100), + ok. + +%%%----------------------------------------------------------------- + +gen() -> + gen_loop(1). + +gen_loop(N) -> + ct:log("Logger iteration: ~p", [N]), + error_logger:error_report(N), + error_logger:info_report(N), + ct:sleep(150), + gen_loop(N+1). diff --git a/lib/common_test/test_server/conf_vars.in b/lib/common_test/test_server/conf_vars.in index 7c55d7b9ed..2d1e78fc69 100644 --- a/lib/common_test/test_server/conf_vars.in +++ b/lib/common_test/test_server/conf_vars.in @@ -23,3 +23,4 @@ SSLEAY_ROOT:@SSLEAY_ROOT@ JAVAC:@JAVAC@ make_command:@make_command@ test_c_compiler:@test_c_compiler@ +WSL:@wsl@ diff --git a/lib/common_test/test_server/configure.in b/lib/common_test/test_server/configure.in index a32d050081..cb9df0e717 100644 --- a/lib/common_test/test_server/configure.in +++ b/lib/common_test/test_server/configure.in @@ -371,7 +371,7 @@ HCC='$(CC)' AC_SUBST(HCC) #-------------------------------------------------------------------- -# ld is used for linking on vxworks +# ld #-------------------------------------------------------------------- LD='$(CC) $(CFLAGS)' AC_SUBST(LD) @@ -389,6 +389,12 @@ exe='' AC_SUBST(exe) #-------------------------------------------------------------------- +# wsl command (if on windows using wsl) +#-------------------------------------------------------------------- +wsl='' +AC_SUBST(wsl) + +#-------------------------------------------------------------------- # flags when linking for cross platform targets (yet 'tis useful with # native builds) #-------------------------------------------------------------------- diff --git a/lib/common_test/test_server/ts_autoconf_win32.erl b/lib/common_test/test_server/ts_autoconf_win32.erl index 1179dfe0e5..33492a18fd 100644 --- a/lib/common_test/test_server/ts_autoconf_win32.erl +++ b/lib/common_test/test_server/ts_autoconf_win32.erl @@ -57,7 +57,9 @@ tests() -> {"for C compiler", fun c_compiler/1}, {"for make program", fun make/1}, {"for location of SSL libraries", fun ssl/1}, - {"for location of Java compiler", fun javac/1}]. + {"for location of Java compiler", fun javac/1}, + {"if wsl is to used as shell", fun wsl/1} + ]. system_type(Vars) -> Os = case os:type() of @@ -168,7 +170,7 @@ visual_cxx(Vars) -> {'DEFS', common_c_defs()}, {'SHLIB_SUFFIX', ".dll"}, {'ERTS_LIBS', ERTS_THR_LIB ++ LIBS}, - {'LIBS', DEFAULT_THR_LIB ++ DBG_LINK ++ LIBS}, + {'LIBS', DBG_LINK ++ LIBS}, {obj,".obj"}, {exe, ".exe"}, {test_c_compiler, "{msc, undefined}"} @@ -247,6 +249,14 @@ javac(Vars) -> {Path, [{'JAVAC', "javac"} | Vars]} end. +wsl(Vars) -> + case os:getenv("WSLENV") of + false -> + {no, [{'wsl', ""} | Vars]}; + _ -> + {"wsl.exe", [{'wsl', "wsl.exe"} | Vars]} + end. + is_debug_build() -> case catch string:find(erlang:system_info(system_version), "debug") of nomatch -> diff --git a/lib/compiler/Makefile b/lib/compiler/Makefile index b8b2f562a2..f18df11e9f 100644 --- a/lib/compiler/Makefile +++ b/lib/compiler/Makefile @@ -36,3 +36,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=crypto hipe + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/compiler/doc/src/Makefile b/lib/compiler/doc/src/Makefile index 2fb163b9e7..e1c445662c 100644 --- a/lib/compiler/doc/src/Makefile +++ b/lib/compiler/doc/src/Makefile @@ -28,94 +28,19 @@ VSN=$(COMPILER_VSN) APPLICATION=compiler # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) -COMPILER_DIR = $(ERL_TOP)/lib/compiler/src - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = compile.xml +EDOC_REF3_FILES = cerl.xml cerl_trees.xml cerl_clauses.xml XML_PART_FILES = internal.xml -XML_CHAPTER_FILES = notes.xml +XML_NOTES_FILES = notes.xml BOOK_FILES = book.xml -GIF_FILES = - XML_FILES = \ - $(BOOK_FILES) $(XML_CHAPTER_FILES) \ + $(BOOK_FILES) $(XML_NOTES_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) -XML_INTERNAL_FILES = \ - cerl.xml cerl_trees.xml cerl_clauses.xml - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -XML_GEN_FILES = $(XML_INTERNAL_FILES:%=$(XMLDIR)/%) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -$(XML_INTERNAL_FILES:%=$(XMLDIR)/%): $(COMPILER_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) - $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(COMPILER_VSN) -dir $(XMLDIR) $(COMPILER_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/compiler/scripts/.gitignore b/lib/compiler/scripts/.gitignore index 4e4eba766d..444b0cea1e 100644 --- a/lib/compiler/scripts/.gitignore +++ b/lib/compiler/scripts/.gitignore @@ -1 +1,5 @@ -/smoke-build +/smoke-build/* + +# The dependency lock file must be kept to ensure that the smoke +# test won't be broken as time passes. +!/smoke-build/mix.lock diff --git a/lib/compiler/scripts/smoke-build/mix.lock b/lib/compiler/scripts/smoke-build/mix.lock new file mode 100644 index 0000000000..9fb83798c4 --- /dev/null +++ b/lib/compiler/scripts/smoke-build/mix.lock @@ -0,0 +1,9 @@ +%{ + "credentials_obfuscation": {:hex, :credentials_obfuscation, "1.1.0", "513793cc20c18afc9e03e584b436192a751a8344890e03a8741c65c8d6866fab", [:rebar3], [], "hexpm"}, + "goldrush": {:hex, :goldrush, "0.1.9", "f06e5d5f1277da5c413e84d5a2924174182fb108dabb39d5ec548b27424cd106", [:rebar3], [], "hexpm"}, + "jsx": {:hex, :jsx, "2.9.0", "d2f6e5f069c00266cad52fb15d87c428579ea4d7d73a33669e12679e203329dd", [:mix, :rebar3], [], "hexpm"}, + "lager": {:hex, :lager, "3.8.0", "3402b9a7e473680ca179fc2f1d827cab88dd37dd1e6113090c6f45ef05228a1c", [:rebar3], [{:goldrush, "0.1.9", [hex: :goldrush, repo: "hexpm", optional: false]}], "hexpm"}, + "rabbit_common": {:hex, :rabbit_common, "3.7.18", "4249efdf1fd96a81739ffad675582f980cc55aa0a02217e4907b4cd719c44822", [:make, :rebar3], [{:credentials_obfuscation, "1.1.0", [hex: :credentials_obfuscation, repo: "hexpm", optional: false]}, {:jsx, "2.9.0", [hex: :jsx, repo: "hexpm", optional: false]}, {:lager, "3.8.0", [hex: :lager, repo: "hexpm", optional: false]}, {:ranch, "1.7.1", [hex: :ranch, repo: "hexpm", optional: false]}, {:recon, "2.5.0", [hex: :recon, repo: "hexpm", optional: false]}], "hexpm"}, + "ranch": {:hex, :ranch, "1.7.1", "6b1fab51b49196860b733a49c07604465a47bdb78aa10c1c16a3d199f7f8c881", [:rebar3], [], "hexpm"}, + "recon": {:hex, :recon, "2.5.0", "2f7fcbec2c35034bade2f9717f77059dc54eb4e929a3049ca7ba6775c0bd66cd", [:mix, :rebar3], [], "hexpm"}, +} diff --git a/lib/compiler/scripts/smoke-mix.exs b/lib/compiler/scripts/smoke-mix.exs index ba0815e465..0bfb80b53c 100644 --- a/lib/compiler/scripts/smoke-mix.exs +++ b/lib/compiler/scripts/smoke-mix.exs @@ -45,6 +45,7 @@ defmodule Smoke.MixProject do {:gpb, "~> 4.6"}, {:gproc, "~> 0.8.0"}, {:graphql, "~> 0.15.0", hex: :graphql_erl}, + {:hut, "~> 1.3"}, {:hackney, "~> 1.15.0"}, {:ibrowse, "~> 4.4.1"}, {:jose, "~> 1.9.0"}, @@ -89,12 +90,13 @@ defmodule Smoke.MixProject do defp build_wings do # If the Erlang system is not installed, the build will - # crash in plugins_src/accel when attempting to build - # the accel driver. Since there is very little Erlang code in - # the directory, skip the entire directory. + # crash in c_src or plugins_src/accel when attempting to + # build native code. Since there is very little Erlang + # code in these directories, skip them both. """ echo "all:\n\t" >plugins_src/accel/Makefile + echo "all:\n\t" >c_src/Makefile git commit -a -m'Disable for smoke testing' git tag -a -m'Smoke test' vsmoke_test make diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 87b0d345f2..6ce354359c 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -49,16 +49,18 @@ MODULES = \ beam_a \ beam_asm \ beam_block \ + beam_call_types \ beam_clean \ beam_dict \ + beam_digraph \ beam_disasm \ - beam_except \ beam_flatten \ beam_jump \ beam_listing \ beam_opcodes \ beam_peep \ beam_ssa \ + beam_ssa_bool \ beam_ssa_bsm \ beam_ssa_codegen \ beam_ssa_dead \ @@ -72,6 +74,7 @@ MODULES = \ beam_ssa_type \ beam_kernel_to_ssa \ beam_trim \ + beam_types \ beam_utils \ beam_validator \ beam_z \ @@ -93,6 +96,7 @@ MODULES = \ sys_core_fold \ sys_core_fold_lists \ sys_core_inline \ + sys_core_prepare \ sys_pre_attributes \ v3_core \ v3_kernel \ @@ -104,6 +108,7 @@ HRL_FILES= \ beam_disasm.hrl \ beam_ssa_opt.hrl \ beam_ssa.hrl \ + beam_types.hrl \ core_parse.hrl \ v3_kernel.hrl @@ -190,6 +195,7 @@ release_docs_spec: # Dependencies -- alphabetically, please # ---------------------------------------------------- +$(EBIN)/beam_call_types.beam: beam_types.hrl $(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl $(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl beam_ssa.hrl $(EBIN)/beam_kernel_to_ssa.beam: v3_kernel.hrl beam_ssa.hrl @@ -204,7 +210,9 @@ $(EBIN)/beam_ssa_pp.beam: beam_ssa.hrl $(EBIN)/beam_ssa_pre_codegen.beam: beam_ssa.hrl $(EBIN)/beam_ssa_recv.beam: beam_ssa.hrl $(EBIN)/beam_ssa_share.beam: beam_ssa.hrl -$(EBIN)/beam_ssa_type.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_type.beam: beam_ssa.hrl beam_types.hrl +$(EBIN)/beam_types.beam: beam_types.hrl +$(EBIN)/beam_validator.beam: beam_types.hrl $(EBIN)/cerl.beam: core_parse.hrl $(EBIN)/compile.beam: core_parse.hrl ../../stdlib/include/erl_compile.hrl $(EBIN)/core_lib.beam: core_parse.hrl diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index eadd858885..bd4be485bb 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -59,16 +59,6 @@ rename_instrs([{test,is_eq_exact,_,[Dst,Src]}=Test, rename_instrs([{test,is_eq_exact,_,[Same,Same]}|Is]) -> %% Same literal or same register. Will always succeed. rename_instrs(Is); -rename_instrs([{recv_set,_}, - {label,Lbl}, - {loop_rec,{f,Fail},{x,0}}, - {loop_rec_end,_},{label,Fail}|Is]) -> - %% This instruction sequence does nothing. All we need to - %% keep is the first label. - [{label,Lbl}|rename_instrs(Is)]; -rename_instrs([{loop_rec,{f,Fail},{x,0}},{loop_rec_end,_},{label,Fail}|Is]) -> - %% This instruction sequence does nothing. - rename_instrs(Is); rename_instrs([{apply_last,A,N}|Is]) -> [{apply,A},{deallocate,N},return|rename_instrs(Is)]; rename_instrs([{call_last,A,F,N}|Is]) -> diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index df09dcb06c..60e19ec596 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -64,11 +64,30 @@ module(Code, ExtraChunks, CompileInfo, CompilerOpts) -> assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, CompileInfo, CompilerOpts) -> {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()), {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0), + Dict2 = shared_fun_wrappers(CompilerOpts, Dict1), NumFuncs = length(Asm0), {Asm,Attr} = on_load(Asm0, Attr0), Exp = cerl_sets:from_list(Exp0), - {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []), - build_file(Code, Attr, Dict2, NumLabels, NumFuncs, ExtraChunks, CompileInfo, CompilerOpts). + {Code,Dict} = assemble_1(Asm, Exp, Dict2, []), + build_file(Code, Attr, Dict, NumLabels, NumFuncs, + ExtraChunks, CompileInfo, CompilerOpts). + +shared_fun_wrappers(Opts, Dict) -> + case proplists:get_bool(no_shared_fun_wrappers, Opts) of + false -> + %% The compiler in OTP 23 depends on the on the loader + %% using the new indices in funs and being able to have + %% multiple make_fun2 instructions referring to the same + %% fun entry. Artificially set the highest opcode for the + %% module to ensure that it cannot be loaded in OTP 22 + %% and earlier. + Swap = beam_opcodes:opcode(swap, 2), + beam_dict:opcode(Swap, Dict); + true -> + %% Fun wrappers are not shared for compatibility with a + %% previous OTP release. + Dict + end. on_load(Fs0, Attr0) -> case proplists:get_value(on_load, Attr0) of diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 707974b2c1..a734ca3a10 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -33,8 +33,9 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> function({function,Name,Arity,CLabel,Is0}) -> try - Is1 = blockify(Is0), - Is = embed_lines(Is1), + Is1 = swap_opt(Is0), + Is2 = blockify(Is1), + Is = embed_lines(Is2), {function,Name,Arity,CLabel,Is} catch Class:Error:Stack -> @@ -42,6 +43,40 @@ function({function,Name,Arity,CLabel,Is0}) -> erlang:raise(Class, Error, Stack) end. +%%% +%%% Try to use a `swap` instruction instead of a sequence of moves. +%%% +%%% Note that beam_ssa_codegen generates `swap` instructions only for +%%% the moves within a single SSA instruction (such as `call`), not +%%% for the moves generated by a sequence of SSA instructions. +%%% Therefore, this optimization is needed. +%%% + +swap_opt([{move,Reg1,{x,X}=Temp}=Move1, + {move,Reg2,Reg1}=Move2, + {move,Temp,Reg2}=Move3|Is]) when Reg1 =/= Temp -> + case is_unused(X, Is) of + true -> + [{swap,Reg1,Reg2}|swap_opt(Is)]; + false -> + [Move1|swap_opt([Move2,Move3|Is])] + end; +swap_opt([I|Is]) -> + [I|swap_opt(Is)]; +swap_opt([]) -> []. + +is_unused(X, [{call,A,_}|_]) when A =< X -> true; +is_unused(X, [{call_ext,A,_}|_]) when A =< X -> true; +is_unused(X, [{make_fun2,_,_,_,A}|_]) when A =< X -> true; +is_unused(X, [{move,Src,Dst}|Is]) -> + case {Src,Dst} of + {{x,X},_} -> false; + {_,{x,X}} -> true; + {_,_} -> is_unused(X, Is) + end; +is_unused(X, [{line,_}|Is]) -> is_unused(X, Is); +is_unused(_, _) -> false. + %% blockify(Instructions0) -> Instructions %% Collect sequences of instructions to basic blocks. %% Also do some simple optimations on instructions outside the blocks. diff --git a/lib/compiler/src/beam_call_types.erl b/lib/compiler/src/beam_call_types.erl new file mode 100644 index 0000000000..290a31b8ba --- /dev/null +++ b/lib/compiler/src/beam_call_types.erl @@ -0,0 +1,983 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_call_types). + +-include("beam_types.hrl"). + +-import(lists, [duplicate/2,foldl/3]). + +-export([will_succeed/3, types/3]). + +%% +%% Returns whether a call will succeed or not. +%% +%% Note that it only answers 'yes' for functions in the 'erlang' module as +%% calls to other modules may fail due to not being loaded, even if we consider +%% the module to be known. +%% + +-spec will_succeed(Mod, Func, ArgTypes) -> Result when + Mod :: atom(), + Func :: atom(), + ArgTypes :: [normal_type()], + Result :: yes | no | maybe. + +will_succeed(erlang, '++', [LHS, _RHS]) -> + succeeds_if_type(LHS, proper_list()); +will_succeed(erlang, '--', [LHS, RHS]) -> + case {succeeds_if_type(LHS, proper_list()), + succeeds_if_type(RHS, proper_list())} of + {yes, yes} -> yes; + {no, _} -> no; + {_, no} -> no; + {_, _} -> maybe + end; +will_succeed(erlang, BoolOp, [LHS, RHS]) when BoolOp =:= 'and'; + BoolOp =:= 'or' -> + case {succeeds_if_type(LHS, beam_types:make_boolean()), + succeeds_if_type(RHS, beam_types:make_boolean())} of + {yes, yes} -> yes; + {no, _} -> no; + {_, no} -> no; + {_, _} -> maybe + end; +will_succeed(erlang, bit_size, [Arg]) -> + succeeds_if_type(Arg, #t_bitstring{}); +will_succeed(erlang, byte_size, [Arg]) -> + succeeds_if_type(Arg, #t_bitstring{}); +will_succeed(erlang, hd, [Arg]) -> + succeeds_if_type(Arg, #t_cons{}); +will_succeed(erlang, is_map_key, [_Key, Map]) -> + succeeds_if_type(Map, #t_map{}); +will_succeed(erlang, length, [Arg]) -> + succeeds_if_type(Arg, proper_list()); +will_succeed(erlang, map_size, [Arg]) -> + succeeds_if_type(Arg, #t_map{}); +will_succeed(erlang, 'not', [Arg]) -> + succeeds_if_type(Arg, beam_types:make_boolean()); +will_succeed(erlang, setelement, [#t_integer{elements={Min,Max}}, + #t_tuple{exact=Exact,size=Size}, _]) -> + case Min >= 1 andalso Max =< Size of + true -> yes; + false when Exact -> no; + false -> maybe + end; +will_succeed(erlang, size, [Arg]) -> + ArgType = beam_types:join(#t_tuple{}, #t_bitstring{}), + succeeds_if_type(Arg, ArgType); +will_succeed(erlang, tuple_size, [Arg]) -> + succeeds_if_type(Arg, #t_tuple{}); +will_succeed(erlang, tl, [Arg]) -> + succeeds_if_type(Arg, #t_cons{}); +will_succeed(Mod, Func, Args) -> + Arity = length(Args), + case erl_bifs:is_safe(Mod, Func, Arity) of + true -> + yes; + false -> + case erl_bifs:is_exit_bif(Mod, Func, Arity) of + true -> + no; + false -> + %% While we can't infer success for functions outside the + %% 'erlang' module (see above comment), it's safe to infer + %% failure when we know the arguments must have certain + %% types. + {_, ArgTypes, _} = types(Mod, Func, Args), + fails_on_conflict(Args, ArgTypes) + end + end. + +fails_on_conflict([ArgType | Args], [Required | Types]) -> + case beam_types:meet(ArgType, Required) of + none -> no; + _ -> fails_on_conflict(Args, Types) + end; +fails_on_conflict([], []) -> + maybe. + +succeeds_if_type(ArgType, Required) -> + case beam_types:meet(ArgType, Required) of + ArgType -> yes; + none -> no; + _ -> maybe + end. + +%% +%% Returns the inferred return and argument types for known functions, and +%% whether it's safe to subtract argument types on failure. +%% +%% Note that the return type will be 'none' if we can statically determine that +%% the function will fail at runtime. +%% + +-spec types(Mod, Func, ArgTypes) -> {RetType, ArgTypes, CanSubtract} when + Mod :: atom(), + Func :: atom(), + ArgTypes :: [normal_type()], + RetType :: type(), + CanSubtract :: boolean(). + +%% Functions that only fail due to bad argument *types*, meaning it's safe to +%% subtract argument types on failure. +%% +%% Note that these are all from the erlang module; suitable functions in other +%% modules could fail due to the module not being loaded. +types(erlang, 'map_size', [_]) -> + sub_safe(#t_integer{}, [#t_map{}]); +types(erlang, 'tuple_size', [_]) -> + sub_safe(#t_integer{}, [#t_tuple{}]); +types(erlang, 'bit_size', [_]) -> + sub_safe(#t_integer{}, [#t_bitstring{}]); +types(erlang, 'byte_size', [_]) -> + sub_safe(#t_integer{}, [#t_bitstring{}]); +types(erlang, hd, [Src]) -> + RetType = erlang_hd_type(Src), + sub_safe(RetType, [#t_cons{}]); +types(erlang, tl, [Src]) -> + RetType = erlang_tl_type(Src), + sub_safe(RetType, [#t_cons{}]); +types(erlang, 'not', [_]) -> + Bool = beam_types:make_boolean(), + sub_safe(Bool, [Bool]); +types(erlang, 'length', [_]) -> + sub_safe(#t_integer{}, [proper_list()]); + +%% Boolean ops +types(erlang, 'and', [_,_]) -> + Bool = beam_types:make_boolean(), + sub_unsafe(Bool, [Bool, Bool]); +types(erlang, 'or', [_,_]) -> + Bool = beam_types:make_boolean(), + sub_unsafe(Bool, [Bool, Bool]); +types(erlang, 'xor', [_,_]) -> + Bool = beam_types:make_boolean(), + sub_unsafe(Bool, [Bool, Bool]); + +%% Bitwise ops +types(erlang, 'band', [_,_]=Args) -> + sub_unsafe(erlang_band_type(Args), [#t_integer{}, #t_integer{}]); +types(erlang, 'bor', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'bxor', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'bsl', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'bsr', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'bnot', [_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}]); + +%% Fixed-type arithmetic +types(erlang, 'float', [_]) -> + sub_unsafe(#t_float{}, [number]); +types(erlang, 'round', [_]) -> + sub_unsafe(#t_integer{}, [number]); +types(erlang, 'floor', [_]) -> + sub_unsafe(#t_integer{}, [number]); +types(erlang, 'ceil', [_]) -> + sub_unsafe(#t_integer{}, [number]); +types(erlang, 'trunc', [_]) -> + sub_unsafe(#t_integer{}, [number]); +types(erlang, '/', [_,_]) -> + sub_unsafe(#t_float{}, [number, number]); +types(erlang, 'div', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'rem', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); + +%% Mixed-type arithmetic; '+'/2 and friends are handled in the catch-all +%% clause for the 'erlang' module. +types(erlang, 'abs', [_]=Args) -> + mixed_arith_types(Args); + +%% List operations +types(erlang, '++', [LHS, RHS]) -> + %% `[] ++ RHS` yields RHS, even if RHS is not a list. + ListType = copy_list(LHS, same_length, proper), + RetType = beam_types:join(ListType, RHS), + sub_unsafe(RetType, [proper_list(), any]); +types(erlang, '--', [LHS, _]) -> + RetType = copy_list(LHS, new_length, proper), + sub_unsafe(RetType, [proper_list(), proper_list()]); + +types(erlang, 'iolist_to_binary', [_]) -> + %% Arg is an iodata(), despite its name. + ArgType = beam_types:join(#t_list{}, #t_bitstring{size_unit=8}), + sub_unsafe(#t_bitstring{size_unit=8}, [ArgType]); +types(erlang, 'list_to_binary', [_]) -> + %% Arg is an iolist(), despite its name. + sub_unsafe(#t_bitstring{size_unit=8}, [#t_list{}]); +types(erlang, 'list_to_bitstring', [_]) -> + %% As list_to_binary but with bitstrings rather than binaries. + sub_unsafe(#t_bitstring{}, [proper_list()]); + +%% Misc ops. +types(erlang, 'binary_part', [_, _]) -> + PosLen = make_two_tuple(#t_integer{}, #t_integer{}), + Binary = #t_bitstring{size_unit=8}, + sub_unsafe(Binary, [Binary, PosLen]); +types(erlang, 'binary_part', [_, _, _]) -> + Binary = #t_bitstring{size_unit=8}, + sub_unsafe(Binary, [Binary, #t_integer{}, #t_integer{}]); +types(erlang, 'is_map_key', [Key, Map]) -> + RetType = case erlang_map_get_type(Key, Map) of + none -> beam_types:make_atom(false); + _ -> beam_types:make_boolean() + end, + sub_unsafe(RetType, [any, #t_map{}]); +types(erlang, 'map_get', [Key, Map]) -> + RetType = erlang_map_get_type(Key, Map), + sub_unsafe(RetType, [any, #t_map{}]); +types(erlang, 'node', [_]) -> + sub_unsafe(#t_atom{}, [any]); +types(erlang, 'node', []) -> + sub_unsafe(#t_atom{}, []); +types(erlang, 'size', [_]) -> + ArgType = beam_types:join(#t_tuple{}, #t_bitstring{}), + sub_unsafe(#t_integer{}, [ArgType]); + +%% Tuple element ops +types(erlang, element, [PosType, TupleType]) -> + Index = case PosType of + #t_integer{elements={Same,Same}} when is_integer(Same) -> + Same; + _ -> + 0 + end, + + RetType = case TupleType of + #t_tuple{size=Sz,elements=Es} when Index =< Sz, + Index >= 1 -> + beam_types:get_tuple_element(Index, Es); + _ -> + any + end, + + sub_unsafe(RetType, [#t_integer{}, #t_tuple{size=Index}]); +types(erlang, setelement, [PosType, TupleType, ArgType]) -> + RetType = case {PosType,TupleType} of + {#t_integer{elements={Index,Index}}, + #t_tuple{elements=Es0,size=Size}=T} when Index >= 1 -> + %% This is an exact index, update the type of said + %% element or return 'none' if it's known to be out of + %% bounds. + Es = beam_types:set_tuple_element(Index, ArgType, Es0), + case T#t_tuple.exact of + false -> + T#t_tuple{size=max(Index, Size),elements=Es}; + true when Index =< Size -> + T#t_tuple{elements=Es}; + true -> + none + end; + {#t_integer{elements={Min,Max}}, + #t_tuple{elements=Es0,size=Size}=T} when Min >= 1 -> + %% We know this will land between Min and Max, so kill + %% the types for those indexes. + Es = discard_tuple_element_info(Min, Max, Es0), + case T#t_tuple.exact of + false -> + T#t_tuple{elements=Es,size=max(Min, Size)}; + true when Min =< Size -> + T#t_tuple{elements=Es,size=Size}; + true -> + none + end; + {_,#t_tuple{}=T} -> + %% Position unknown, so we have to discard all element + %% information. + T#t_tuple{elements=#{}}; + {#t_integer{elements={Min,_Max}},_} -> + #t_tuple{size=Min}; + {_,_} -> + #t_tuple{} + end, + sub_unsafe(RetType, [#t_integer{}, #t_tuple{}, any]); + +types(erlang, make_fun, [_,_,Arity0]) -> + Type = case Arity0 of + #t_integer{elements={Arity,Arity}} when Arity >= 0 -> + #t_fun{arity=Arity}; + _ -> + #t_fun{} + end, + sub_unsafe(Type, [#t_atom{}, #t_atom{}, #t_integer{}]); + +types(erlang, Name, Args) -> + Arity = length(Args), + + case erl_bifs:is_exit_bif(erlang, Name, Arity) of + true -> + {none, Args, false}; + false -> + case erl_internal:arith_op(Name, Arity) of + true -> + mixed_arith_types(Args); + false -> + IsTest = + erl_internal:new_type_test(Name, Arity) orelse + erl_internal:comp_op(Name, Arity), + + RetType = case IsTest of + true -> beam_types:make_boolean(); + false -> any + end, + + sub_unsafe(RetType, duplicate(Arity, any)) + end + end; + +%% +%% Math BIFs +%% + +types(math, cos, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, cosh, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, sin, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, sinh, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, tan, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, tanh, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, acos, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, acosh, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, asin, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, asinh, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, atan, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, atanh, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, erf, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, erfc, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, exp, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, log, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, log2, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, log10, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, sqrt, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, atan2, [_,_]) -> + sub_unsafe(#t_float{}, [number, number]); +types(math, pow, [_,_]) -> + sub_unsafe(#t_float{}, [number, number]); +types(math, ceil, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, floor, [_]) -> + sub_unsafe(#t_float{}, [number]); +types(math, fmod, [_,_]) -> + sub_unsafe(#t_float{}, [number, number]); +types(math, pi, []) -> + sub_unsafe(#t_float{}, []); + +%% +%% List functions +%% +%% These tend to have tricky edge cases around nil and proper lists, be very +%% careful and try not to narrow the types needlessly. Keep in mind that they +%% need to be safe regardless of how the function is implemented, so it's best +%% not to say that a list is proper unless every element must be visited to +%% succeed. +%% + +%% Operator aliases. +types(lists, append, [_,_]=Args) -> + types(erlang, '++', Args); +types(lists, append, [_]) -> + %% This is implemented through folding the list over erlang:'++'/2, so it + %% can hypothetically return anything, but we can infer that its argument + %% is a proper list on success. + sub_unsafe(any, [proper_list()]); +types(lists, subtract, [_,_]=Args) -> + types(erlang, '--', Args); + +%% Functions returning booleans. +types(lists, all, [_,_]) -> + %% This can succeed on improper lists if the fun returns 'false' for an + %% element before reaching the end. + sub_unsafe(beam_types:make_boolean(), [#t_fun{arity=1}, #t_list{}]); +types(lists, any, [_,_]) -> + %% Doesn't imply that the argument is a proper list; see lists:all/2 + sub_unsafe(beam_types:make_boolean(), [#t_fun{arity=1}, #t_list{}]); +types(lists, keymember, [_,_,_]) -> + %% Doesn't imply that the argument is a proper list; see lists:all/2 + sub_unsafe(beam_types:make_boolean(), [any, #t_integer{}, #t_list{}]); +types(lists, member, [_,_]) -> + %% Doesn't imply that the argument is a proper list; see lists:all/2 + sub_unsafe(beam_types:make_boolean(), [any, #t_list{}]); +types(lists, prefix, [_,_]) -> + %% This function doesn't need to reach the end of either list to return + %% false, so we can succeed even when both are improper lists. + sub_unsafe(beam_types:make_boolean(), [#t_list{}, #t_list{}]); +types(lists, suffix, [_,_]) -> + %% A different implementation could return true when the first list is nil, + %% so we can't tell if either is proper. + sub_unsafe(beam_types:make_boolean(), [#t_list{}, #t_list{}]); + +%% Simple folds +types(lists, foldl, [Fun, Init, List]) -> + RetType = lists_fold_type(Fun, Init, List), + sub_unsafe(RetType, [#t_fun{arity=2}, any, proper_list()]); +types(lists, foldr, [Fun, Init, List]) -> + RetType = lists_fold_type(Fun, Init, List), + sub_unsafe(RetType, [#t_fun{arity=2}, any, proper_list()]); + +%% Functions returning plain lists. +types(lists, droplast, [List]) -> + RetType = copy_list(List, new_length, proper), + sub_unsafe(RetType, [proper_list()]); +types(lists, dropwhile, [_Fun, List]) -> + %% If the element is found before the end of the list, we could return an + %% improper list. + RetType = copy_list(List, new_length, maybe_improper), + sub_unsafe(RetType, [#t_fun{arity=1}, #t_list{}]); +types(lists, duplicate, [_Count, Element]) -> + sub_unsafe(proper_list(Element), [#t_integer{}, any]); +types(lists, filter, [_Fun, List]) -> + RetType = copy_list(List, new_length, proper), + sub_unsafe(RetType, [#t_fun{arity=1}, proper_list()]); +types(lists, flatten, [_]) -> + sub_unsafe(proper_list(), [proper_list()]); +types(lists, map, [Fun, List]) -> + RetType = lists_map_type(Fun, List), + sub_unsafe(RetType, [#t_fun{arity=1}, proper_list()]); +types(lists, reverse, [List]) -> + RetType = copy_list(List, same_length, proper), + sub_unsafe(RetType, [proper_list()]); +types(lists, sort, [List]) -> + RetType = copy_list(List, same_length, proper), + sub_unsafe(RetType, [proper_list()]); +types(lists, takewhile, [_Fun, List]) -> + %% Doesn't imply that the argument is a proper list; see lists:all/2 + RetType = copy_list(List, new_length, proper), + sub_unsafe(RetType, [#t_fun{arity=1}, #t_list{}]); +types(lists, usort, [List]) -> + %% The result is not quite the same length, but a non-empty list will stay + %% non-empty. + RetType = copy_list(List, same_length, proper), + sub_unsafe(RetType, [proper_list()]); +types(lists, zip, [_,_]=Lists) -> + {RetType, ArgType} = lists_zip_types(Lists), + sub_unsafe(RetType, [ArgType, ArgType]); +types(lists, zipwith, [Fun | [_,_]=Lists]) -> + {RetType, ArgType} = lists_zipwith_types(Fun, Lists), + sub_unsafe(RetType, [#t_fun{arity=2}, ArgType, ArgType]); + +%% Functions with complex return values. +types(lists, keyfind, [KeyType,PosType,_]) -> + %% Doesn't imply that the argument is a proper list; see lists:all/2 + TupleType = case PosType of + #t_integer{elements={Index,Index}} when is_integer(Index), + Index >= 1 -> + Es = beam_types:set_tuple_element(Index, KeyType, #{}), + #t_tuple{size=Index,elements=Es}; + _ -> + #t_tuple{} + end, + RetType = beam_types:join(TupleType, beam_types:make_atom(false)), + sub_unsafe(RetType, [any, #t_integer{}, #t_list{}]); +types(lists, MapFold, [Fun, Init, List]) + when MapFold =:= mapfoldl; MapFold =:= mapfoldr -> + RetType = lists_mapfold_type(Fun, Init, List), + sub_unsafe(RetType, [#t_fun{arity=2}, any, proper_list()]); +types(lists, partition, [_Fun, List]) -> + ListType = copy_list(List, new_length, proper), + RetType = make_two_tuple(ListType, ListType), + sub_unsafe(RetType, [#t_fun{arity=1}, proper_list()]); +types(lists, search, [_,_]) -> + %% Doesn't imply that the argument is a proper list; see lists:all/2 + TupleType = make_two_tuple(beam_types:make_atom(value), any), + RetType = beam_types:join(TupleType, beam_types:make_atom(false)), + sub_unsafe(RetType, [#t_fun{arity=1}, #t_list{}]); +types(lists, splitwith, [_Fun, List]) -> + %% Only the elements in the left list are guaranteed to be visited, so both + %% the argument and the right list may be improper. + Left = copy_list(List, new_length, proper), + Right = copy_list(List, new_length, maybe_improper), + sub_unsafe(make_two_tuple(Left, Right), [#t_fun{arity=1}, #t_list{}]); +types(lists, unzip, [List]) -> + RetType = lists_unzip_type(2, List), + sub_unsafe(RetType, [proper_list()]); + +%% +%% Map functions +%% + +types(maps, filter, [_Fun, Map]) -> + %% Conservatively assume that key/value types are unchanged. + RetType = case Map of + #t_map{}=T -> T; + _ -> #t_map{} + end, + sub_unsafe(RetType, [#t_fun{arity=2}, #t_map{}]); +types(maps, find, [Key, Map]) -> + TupleType = case erlang_map_get_type(Key, Map) of + none -> + none; + ValueType -> + make_two_tuple(beam_types:make_atom(ok), ValueType) + end, + %% error | {ok, Value} + RetType = beam_types:join(beam_types:make_atom(error), TupleType), + sub_unsafe(RetType, [any, #t_map{}]); +types(maps, fold, [Fun, Init, _Map]) -> + RetType = case Fun of + #t_fun{type=Type} -> + %% The map is potentially empty, so we have to assume it + %% can return the initial value. + beam_types:join(Type, Init); + _ -> + any + end, + sub_unsafe(RetType, [#t_fun{arity=3}, any, #t_map{}]); +types(maps, from_list, [Pairs]) -> + PairType = erlang_hd_type(Pairs), + RetType = case beam_types:normalize(PairType) of + #t_tuple{elements=Es} -> + SKey = beam_types:get_tuple_element(1, Es), + SValue = beam_types:get_tuple_element(2, Es), + #t_map{super_key=SKey,super_value=SValue}; + _ -> + #t_map{} + end, + sub_unsafe(RetType, [proper_list()]); +types(maps, get, [_Key, _Map]=Args) -> + types(erlang, map_get, Args); +types(maps, get, [Key, Map, Default]) -> + RetType = case erlang_map_get_type(Key, Map) of + none -> Default; + ValueType -> beam_types:join(ValueType, Default) + end, + sub_unsafe(RetType, [any, #t_map{}, any]); +types(maps, is_key, [_Key, _Map]=Args) -> + types(erlang, is_map_key, Args); +types(maps, keys, [Map]) -> + RetType = case Map of + #t_map{super_key=none} -> nil; + #t_map{super_key=SKey} -> proper_list(SKey); + _ -> proper_list() + end, + sub_unsafe(RetType, [#t_map{}]); +types(maps, map, [Fun, Map]) -> + RetType = case {Fun, Map} of + {#t_fun{type=FunRet}, #t_map{super_value=SValue0}} -> + SValue = beam_types:join(FunRet, SValue0), + Map#t_map{super_value=SValue}; + _ -> + #t_map{} + end, + sub_unsafe(RetType, [#t_fun{arity=2}, #t_map{}]); +types(maps, merge, [A, B]) -> + RetType = case {A, B} of + {#t_map{super_key=SKeyA,super_value=SValueA}, + #t_map{super_key=SKeyB,super_value=SValueB}} -> + SKey = beam_types:join(SKeyA, SKeyB), + SValue = beam_types:join(SValueA, SValueB), + #t_map{super_key=SKey,super_value=SValue}; + _ -> + #t_map{} + end, + sub_unsafe(RetType, [#t_map{}, #t_map{}]); +types(maps, new, []) -> + RetType = #t_map{super_key=none,super_value=none}, + sub_unsafe(RetType, []); +types(maps, put, [Key, Value, Map]) -> + RetType = case Map of + #t_map{super_key=SKey0,super_value=SValue0} -> + SKey = beam_types:join(Key, SKey0), + SValue = beam_types:join(Value, SValue0), + #t_map{super_key=SKey,super_value=SValue}; + _ -> + #t_map{} + end, + sub_unsafe(RetType, [any, any, #t_map{}]); +types(maps, remove, [Key, Map]) -> + RetType = maps_remove_type(Key, Map), + sub_unsafe(RetType, [any, #t_map{}]); +types(maps, take, [Key, Map]) -> + TupleType = case erlang_map_get_type(Key, Map) of + none -> + none; + ValueType -> + MapType = beam_types:meet(Map, #t_map{}), + make_two_tuple(ValueType, MapType) + end, + %% error | {Value, Map} + RetType = beam_types:join(beam_types:make_atom(error), TupleType), + sub_unsafe(RetType, [any, #t_map{}]); +types(maps, to_list, [Map]) -> + RetType = case Map of + #t_map{super_key=SKey,super_value=SValue} -> + proper_list(make_two_tuple(SKey, SValue)); + _ -> + proper_list() + end, + sub_unsafe(RetType, [#t_map{}]); +types(maps, update_with, [_Key, Fun, Map]) -> + RetType = case {Fun, Map} of + {#t_fun{type=FunRet}, #t_map{super_value=SValue0}} -> + SValue = beam_types:join(FunRet, SValue0), + Map#t_map{super_value=SValue}; + _ -> + #t_map{} + end, + sub_unsafe(RetType, [any, #t_fun{arity=1}, #t_map{}]); +types(maps, values, [Map]) -> + RetType = case Map of + #t_map{super_value=none} -> nil; + #t_map{super_value=SValue} -> proper_list(SValue); + _ -> proper_list() + end, + sub_unsafe(RetType, [#t_map{}]); +types(maps, with, [Keys, Map]) -> + RetType = case Map of + #t_map{super_key=SKey0} -> + %% Since we know that the Map will only contain the pairs + %% pointed out by Keys, we can restrict the types to + %% those in the list. + SKey = beam_types:meet(erlang_hd_type(Keys), SKey0), + Map#t_map{super_key=SKey}; + _ -> + #t_map{} + end, + sub_unsafe(RetType, [proper_list(), #t_map{}]); +types(maps, without, [Keys, Map]) -> + RetType = maps_remove_type(erlang_hd_type(Keys), Map), + sub_unsafe(RetType, [proper_list(), #t_map{}]); + +%% Catch-all clause for unknown functions. + +types(_, _, Args) -> + sub_unsafe(any, [any || _ <- Args]). + +%% +%% Function-specific helpers. +%% + +mixed_arith_types([FirstType | _]=Args0) -> + RetType = foldl(fun(#t_integer{}, #t_integer{}) -> #t_integer{}; + (#t_integer{}, number) -> number; + (#t_integer{}, #t_float{}) -> #t_float{}; + (#t_float{}, #t_integer{}) -> #t_float{}; + (#t_float{}, number) -> #t_float{}; + (#t_float{}, #t_float{}) -> #t_float{}; + (number, #t_integer{}) -> number; + (number, #t_float{}) -> #t_float{}; + (number, number) -> number; + (any, _) -> number; + (_, _) -> none + end, FirstType, Args0), + sub_unsafe(RetType, [number || _ <- Args0]). + +erlang_hd_type(Src) -> + case beam_types:meet(Src, #t_cons{}) of + #t_cons{type=Type} -> Type; + _ -> any + end. + +erlang_tl_type(Src) -> + case beam_types:meet(Src, #t_cons{}) of + #t_cons{terminator=Term}=Cons -> beam_types:join(Cons, Term); + _ -> any + end. + +erlang_band_type([#t_integer{elements={Int,Int}}, RHS]) when is_integer(Int) -> + erlang_band_type_1(RHS, Int); +erlang_band_type([LHS, #t_integer{elements={Int,Int}}]) when is_integer(Int) -> + erlang_band_type_1(LHS, Int); +erlang_band_type(_) -> + #t_integer{}. + +erlang_band_type_1(LHS, Int) -> + case LHS of + #t_integer{elements={Min0,Max0}} when Max0 - Min0 < 1 bsl 256 -> + {Intersection, Union} = range_masks(Min0, Max0), + + Min = Intersection band Int, + Max = min(Max0, Union band Int), + + #t_integer{elements={Min,Max}}; + _ when Int >= 0 -> + %% The range is either unknown or too wide, conservatively assume + %% that the new range is 0 .. Int. + beam_types:meet(LHS, #t_integer{elements={0,Int}}); + _ -> + %% We can't infer boundaries when LHS is not an integer or + %% the range is unknown and the other operand is a + %% negative number, as the latter sign-extends to infinity + %% and we can't express an inverted range at the moment + %% (cf. X band -8; either less than -7 or greater than 7). + beam_types:meet(LHS, #t_integer{}) + end. + +erlang_map_get_type(Key, Map) -> + case Map of + #t_map{super_key=SKey,super_value=SValue} -> + case beam_types:meet(SKey, Key) of + none -> none; + _ -> SValue + end; + _ -> + any + end. + +lists_fold_type(_Fun, Init, nil) -> + Init; +lists_fold_type(#t_fun{type=Type}, _Init, #t_cons{}) -> + %% The list is non-empty so it's safe to ignore Init. + Type; +lists_fold_type(#t_fun{type=Type}, Init, #t_list{}) -> + %% The list is possibly empty so we have to assume it can return the + %% initial value, whose type can differ significantly from the fun's + %% return value. + beam_types:join(Type, Init); +lists_fold_type(_Fun, _Init, _List) -> + any. + +lists_map_type(#t_fun{type=Type}, Types) -> + lists_map_type_1(Types, Type); +lists_map_type(_Fun, Types) -> + lists_map_type_1(Types, any). + +lists_map_type_1(nil, _ElementType) -> + nil; +lists_map_type_1(#t_cons{}, none) -> + %% The list is non-empty and the fun never returns. + none; +lists_map_type_1(#t_cons{}, ElementType) -> + proper_cons(ElementType); +lists_map_type_1(_, none) -> + %% The fun never returns, so the only way we could return normally is + %% if the list is empty. + nil; +lists_map_type_1(_, ElementType) -> + proper_list(ElementType). + +lists_mapfold_type(#t_fun{type=#t_tuple{size=2,elements=Es}}, Init, List) -> + ElementType = beam_types:get_tuple_element(1, Es), + AccType = beam_types:get_tuple_element(2, Es), + lists_mapfold_type_1(List, ElementType, Init, AccType); +lists_mapfold_type(#t_fun{type=none}, _Init, #t_cons{}) -> + %% The list is non-empty and the fun never returns. + none; +lists_mapfold_type(#t_fun{type=none}, Init, _List) -> + %% The fun never returns, so the only way we could return normally is + %% if the list is empty, in which case we'll return [] and the initial + %% value. + make_two_tuple(nil, Init); +lists_mapfold_type(_Fun, Init, List) -> + lists_mapfold_type_1(List, any, Init, any). + +lists_mapfold_type_1(nil, _ElementType, Init, _AccType) -> + make_two_tuple(nil, Init); +lists_mapfold_type_1(#t_cons{}, ElementType, _Init, AccType) -> + %% The list has at least one element, so it's safe to ignore Init. + make_two_tuple(proper_cons(ElementType), AccType); +lists_mapfold_type_1(_, ElementType, Init, AccType0) -> + %% We can only rely on AccType when we know the list is non-empty, so we + %% have to join it with the initial value in case the list is empty. + AccType = beam_types:join(AccType0, Init), + make_two_tuple(proper_list(ElementType), AccType). + +lists_unzip_type(Size, List) -> + Es = lut_make_elements(lut_list_types(Size, List), 1, #{}), + #t_tuple{size=Size,exact=true,elements=Es}. + +lut_make_elements([Type | Types], Index, Es0) -> + Es = beam_types:set_tuple_element(Index, Type, Es0), + lut_make_elements(Types, Index + 1, Es); +lut_make_elements([], _Index, Es) -> + Es. + +lut_list_types(Size, #t_cons{type=#t_tuple{size=Size,elements=Es}}) -> + Types = lut_element_types(1, Size, Es), + [proper_cons(T) || T <- Types]; +lut_list_types(Size, #t_list{type=#t_tuple{size=Size,elements=Es}}) -> + Types = lut_element_types(1, Size, Es), + [proper_list(T) || T <- Types]; +lut_list_types(Size, nil) -> + lists:duplicate(Size, nil); +lut_list_types(Size, _) -> + lists:duplicate(Size, proper_list()). + +lut_element_types(Index, Max, #{}) when Index > Max -> + []; +lut_element_types(Index, Max, Es) -> + ElementType = beam_types:get_tuple_element(Index, Es), + [ElementType | lut_element_types(Index + 1, Max, Es)]. + +%% lists:zip/2 and friends only succeed when all arguments have the same +%% length, so if one of them is #t_cons{}, we can infer that all of them are +%% #t_cons{} on success. + +lists_zip_types(Types) -> + lists_zip_types_1(Types, false, #{}, 1). + +lists_zip_types_1([nil | _], _AnyCons, _Es, _N) -> + %% Early exit; we know the result is [] on success. + {nil, nil}; +lists_zip_types_1([#t_cons{type=Type,terminator=nil} | Lists], + _AnyCons, Es0, N) -> + Es = beam_types:set_tuple_element(N, Type, Es0), + lists_zip_types_1(Lists, true, Es, N + 1); +lists_zip_types_1([#t_list{type=Type,terminator=nil} | Lists], + AnyCons, Es0, N) -> + Es = beam_types:set_tuple_element(N, Type, Es0), + lists_zip_types_1(Lists, AnyCons, Es, N + 1); +lists_zip_types_1([_ | Lists], AnyCons, Es, N) -> + lists_zip_types_1(Lists, AnyCons, Es, N + 1); +lists_zip_types_1([], true, Es, N) -> + %% At least one element was cons, so we know it's non-empty on success. + ElementType = #t_tuple{exact=true,size=(N - 1),elements=Es}, + RetType = proper_cons(ElementType), + ArgType = proper_cons(), + {RetType, ArgType}; +lists_zip_types_1([], false, Es, N) -> + ElementType = #t_tuple{exact=true,size=(N - 1),elements=Es}, + RetType = proper_list(ElementType), + ArgType = proper_list(), + {RetType, ArgType}. + +lists_zipwith_types(#t_fun{type=Type}, Types) -> + lists_zipwith_type_1(Types, Type); +lists_zipwith_types(_Fun, Types) -> + lists_zipwith_type_1(Types, any). + +lists_zipwith_type_1([nil | _], _ElementType) -> + %% Early exit; we know the result is [] on success. + {nil, nil}; +lists_zipwith_type_1([#t_cons{} | _Lists], none) -> + %% Early exit; the list is non-empty and we know the fun never + %% returns. + {none, any}; +lists_zipwith_type_1([#t_cons{} | _Lists], ElementType) -> + %% Early exit; we know the result is cons on success. + RetType = proper_cons(ElementType), + ArgType = proper_cons(), + {RetType, ArgType}; +lists_zipwith_type_1([_ | Lists], ElementType) -> + lists_zipwith_type_1(Lists, ElementType); +lists_zipwith_type_1([], none) -> + %% Since we know the fun won't return, the only way we could return + %% normally is if all lists are empty. + {nil, nil}; +lists_zipwith_type_1([], ElementType) -> + RetType = proper_list(ElementType), + ArgType = proper_list(), + {RetType, ArgType}. + +maps_remove_type(Key, #t_map{super_key=SKey0}=Map) -> + case beam_types:is_singleton_type(Key) of + true -> + SKey = beam_types:subtract(SKey0, Key), + Map#t_map{super_key=SKey}; + false -> + Map + end; +maps_remove_type(_Key, _Map) -> + #t_map{}. + +%%% +%%% Generic helpers +%%% + +sub_unsafe(RetType, ArgTypes) -> + {RetType, ArgTypes, false}. + +sub_safe(RetType, ArgTypes) -> + {RetType, ArgTypes, true}. + +discard_tuple_element_info(Min, Max, Es) -> + foldl(fun(El, Acc) when Min =< El, El =< Max -> + maps:remove(El, Acc); + (_El, Acc) -> Acc + end, Es, maps:keys(Es)). + +%% Returns two bitmasks describing all possible values between From and To. +%% +%% The first contains the bits that are common to all values, and the second +%% contains the bits that are set by any value in the range. +range_masks(From, To) when From =< To -> + range_masks_1(From, To, 0, -1, 0). + +range_masks_1(From, To, BitPos, Intersection, Union) when From < To -> + range_masks_1(From + (1 bsl BitPos), To, BitPos + 1, + Intersection band From, Union bor From); +range_masks_1(_From, To, _BitPos, Intersection0, Union0) -> + Intersection = To band Intersection0, + Union = To bor Union0, + {Intersection, Union}. + +proper_cons() -> + #t_cons{terminator=nil}. + +proper_cons(ElementType) -> + #t_cons{type=ElementType,terminator=nil}. + +proper_list() -> + #t_list{terminator=nil}. + +proper_list(ElementType) -> + #t_list{type=ElementType,terminator=nil}. + +%% Constructs a new list type based on another, optionally keeping the same +%% length and/or making it proper. +-spec copy_list(List, Length, Proper) -> type() when + List :: type(), + Length :: same_length | new_length, + Proper :: proper | maybe_improper. +copy_list(#t_cons{terminator=Term}=T, Length, maybe_improper) -> + copy_list_1(T, Length, Term); +copy_list(#t_list{terminator=Term}=T, Length, maybe_improper) -> + copy_list_1(T, Length, Term); +copy_list(T, Length, proper) -> + copy_list_1(T, Length, nil); +copy_list(T, Length, _Proper) -> + copy_list_1(T, Length, any). + +copy_list_1(#t_cons{}=T, same_length, Terminator) -> + T#t_cons{terminator=Terminator}; +copy_list_1(#t_cons{type=Type}, new_length, Terminator) -> + #t_list{type=Type,terminator=Terminator}; +copy_list_1(#t_list{}=T, _Length, Terminator) -> + T#t_list{terminator=Terminator}; +copy_list_1(nil, _Length, _Terminator) -> + nil; +copy_list_1(_, _Length, Terminator) -> + #t_list{terminator=Terminator}. + +make_two_tuple(Type1, Type2) -> + Es0 = beam_types:set_tuple_element(1, Type1, #{}), + Es = beam_types:set_tuple_element(2, Type2, Es0), + #t_tuple{size=2,exact=true,elements=Es}. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 7299654476..6b2b2ce085 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -34,7 +34,8 @@ module({Mod,Exp,Attr,Fs0,_}, Opts) -> Used = find_all_used(WorkList, All, cerl_sets:from_list(WorkList)), Fs1 = remove_unused(Order, Used, All), {Fs2,Lc} = clean_labels(Fs1), - Fs = maybe_remove_lines(Fs2, Opts), + Fs3 = fix_swap(Fs2, Opts), + Fs = maybe_remove_lines(Fs3, Opts), {ok,{Mod,Exp,Attr,Fs,Lc}}. %% Determine the rootset, i.e. exported functions and @@ -137,31 +138,54 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> function_replace([], _, Acc) -> Acc. %%% +%%% If compatibility with a previous release (OTP 22 or earlier) has +%%% been requested, replace swap instructions with a sequence of moves. +%%% + +fix_swap(Fs, Opts) -> + case proplists:get_bool(no_swap, Opts) of + false -> Fs; + true -> fold_functions(fun swap_moves/1, Fs) + end. + +swap_moves([{swap,Reg1,Reg2}|Is]) -> + Temp = {x,1022}, + [{move,Reg1,Temp},{move,Reg2,Reg1},{move,Temp,Reg2}|swap_moves(Is)]; +swap_moves([I|Is]) -> + [I|swap_moves(Is)]; +swap_moves([]) -> []. + +%%% %%% Remove line instructions if requested. %%% maybe_remove_lines(Fs, Opts) -> case proplists:get_bool(no_line_info, Opts) of false -> Fs; - true -> remove_lines(Fs) + true -> fold_functions(fun remove_lines/1, Fs) end. -remove_lines([{function,N,A,Lbl,Is0}|T]) -> - Is = remove_lines_fun(Is0), - [{function,N,A,Lbl,Is}|remove_lines(T)]; -remove_lines([]) -> []. - -remove_lines_fun([{line,_}|Is]) -> - remove_lines_fun(Is); -remove_lines_fun([{block,Bl0}|Is]) -> +remove_lines([{line,_}|Is]) -> + remove_lines(Is); +remove_lines([{block,Bl0}|Is]) -> Bl = remove_lines_block(Bl0), - [{block,Bl}|remove_lines_fun(Is)]; -remove_lines_fun([I|Is]) -> - [I|remove_lines_fun(Is)]; -remove_lines_fun([]) -> []. + [{block,Bl}|remove_lines(Is)]; +remove_lines([I|Is]) -> + [I|remove_lines(Is)]; +remove_lines([]) -> []. remove_lines_block([{set,_,_,{line,_}}|Is]) -> remove_lines_block(Is); remove_lines_block([I|Is]) -> [I|remove_lines_block(Is)]; remove_lines_block([]) -> []. + + +%%% +%%% Helpers. +%%% + +fold_functions(F, [{function,N,A,Lbl,Is0}|T]) -> + Is = F(Is0), + [{function,N,A,Lbl,Is}|fold_functions(F, T)]; +fold_functions(_F, []) -> []. diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index b2056332e6..b6f8c5a6e7 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -36,10 +36,11 @@ -type import_tab() :: gb_trees:tree(mfa(), index()). -type fname_tab() :: #{Name :: term() => index()}. -type line_tab() :: #{{Fname :: index(), Line :: term()} => index()}. --type literal_tab() :: dict:dict(Literal :: term(), index()). +-type literal_tab() :: #{Literal :: term() => index()}. -type lambda_info() :: {label(),{index(),label(),non_neg_integer()}}. -type lambda_tab() :: {non_neg_integer(),[lambda_info()]}. +-type wrapper() :: #{label() => index()}. -record(asm, {atoms = #{} :: atom_tab(), @@ -48,7 +49,8 @@ imports = gb_trees:empty() :: import_tab(), strings = <<>> :: binary(), %String pool lambdas = {0,[]} :: lambda_tab(), - literals = dict:new() :: literal_tab(), + wrappers = #{} :: wrapper(), + literals = #{} :: literal_tab(), fnames = #{} :: fname_tab(), lines = #{} :: line_tab(), num_lines = 0 :: non_neg_integer(), %Number of line instructions @@ -147,22 +149,32 @@ string(BinString, Dict) when is_binary(BinString) -> -spec lambda(label(), non_neg_integer(), bdict()) -> {non_neg_integer(), bdict()}. -lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) -> - %% Set Index the same as OldIndex. - Index = OldIndex, - Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0], - {OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}. +lambda(Lbl, NumFree, #asm{wrappers=Wrappers0, + lambdas={OldIndex,Lambdas0}}=Dict) -> + case Wrappers0 of + #{Lbl:=Index} -> + %% OTP 23: There old is a fun entry for this wrapper function. + %% Share the fun entry. + {Index,Dict}; + #{} -> + %% Set Index the same as OldIndex. + Index = OldIndex, + Wrappers = Wrappers0#{Lbl=>Index}, + Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0], + {OldIndex,Dict#asm{wrappers=Wrappers, + lambdas={OldIndex+1,Lambdas}}} + end. %% Returns the index for a literal (adding it to the literal table if necessary). %% literal(Literal, Dict) -> {Index,Dict'} -spec literal(term(), bdict()) -> {non_neg_integer(), bdict()}. literal(Lit, #asm{literals=Tab0,next_literal=NextIndex}=Dict) -> - case dict:find(Lit, Tab0) of - {ok,Index} -> + case Tab0 of + #{Lit:=Index} -> {Index,Dict}; - error -> - Tab = dict:store(Lit, NextIndex, Tab0), + #{} -> + Tab = Tab0#{Lit=>NextIndex}, {NextIndex,Dict#asm{literals=Tab,next_literal=NextIndex+1}} end. @@ -253,7 +265,7 @@ lambda_table(#asm{locals=Loc0,lambdas={NumLambdas,Lambdas0}}) -> -spec literal_table(bdict()) -> {non_neg_integer(), [[binary(),...]]}. literal_table(#asm{literals=Tab,next_literal=NumLiterals}) -> - L0 = dict:fold(fun(Lit, Num, Acc) -> + L0 = maps:fold(fun(Lit, Num, Acc) -> [{Num,my_term_to_binary(Lit)}|Acc] end, [], Tab), L1 = lists:sort(L0), @@ -261,7 +273,12 @@ literal_table(#asm{literals=Tab,next_literal=NumLiterals}) -> {NumLiterals,L}. my_term_to_binary(Term) -> - term_to_binary(Term, [{minor_version,1}]). + %% Use the latest possible minor version. Minor version 2 can be + %% be decoded by OTP 16, which is as far back as we have compatibility + %% options for the compiler. (When this comment was written, some time + %% after the release of OTP 22, the default minor version was 1.) + + term_to_binary(Term, [{minor_version,2}]). %% Return the line table. -spec line_table(bdict()) -> diff --git a/lib/compiler/src/beam_digraph.erl b/lib/compiler/src/beam_digraph.erl new file mode 100644 index 0000000000..800fcf4c22 --- /dev/null +++ b/lib/compiler/src/beam_digraph.erl @@ -0,0 +1,308 @@ + +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% Digraph data type. Similar to the digraph module, but provides a +%% functional API. The functional API allows us to revert to a +%% previous version of the digraph when an optimization that may have +%% damaged the digraph has failed. +%% + +-module(beam_digraph). + +-export([new/0, + add_vertex/2, add_vertex/3, add_edge/3, add_edge/4, + del_edge/2, del_edges/2, + has_vertex/2, + is_path/3, + in_degree/2, in_edges/2, in_neighbours/2, + out_degree/2, out_edges/2, out_neighbours/2, + vertex/2, vertices/1, + reverse_postorder/2, + roots/1, + topsort/1, + strong_components/2]). + +%% Debugging. +-define(DEBUG, false). +-if(?DEBUG). +-export([dump/1,dump/2,dump/3]). +-endif. + +-import(lists, [foldl/3, reverse/1]). + +-type edge_map() :: #{ vertex() => ordsets:ordset(vertex()) }. +-type vertice_map() :: #{ vertex() => label() }. + +-record(dg, {vs = #{} :: vertice_map(), + in_es = #{} :: edge_map(), + out_es = #{} :: edge_map()}). + +-type graph() :: #dg{}. + +-type vertex() :: term(). +-type label() :: term(). +-type edge() :: {vertex(), vertex(), label()}. + +-spec new() -> graph(). +new() -> #dg{}. + +-spec add_vertex(graph(), vertex()) -> graph(). +add_vertex(Dg, V) -> + add_vertex(Dg, V, vertex). + +-spec add_vertex(graph(), vertex(), label()) -> graph(). +add_vertex(Dg, V, Label) -> + #dg{in_es=InEsMap0,out_es=OutEsMap0,vs=Vs0} = Dg, + InEsMap = init_edge_map(V, InEsMap0), + OutEsMap = init_edge_map(V, OutEsMap0), + Vs = Vs0#{V=>Label}, + Dg#dg{vs=Vs,in_es=InEsMap,out_es=OutEsMap}. + +init_edge_map(V, EsMap) -> + case is_map_key(V, EsMap) of + true -> + EsMap; + false -> + EsMap#{V=>ordsets:new()} + end. + +-spec add_edge(graph(), vertex(), vertex()) -> graph(). +add_edge(Dg, From, To) -> + add_edge(Dg, From, To, edge). + +-spec add_edge(graph(), vertex(), vertex(), label()) -> graph(). +add_edge(Dg, From, To, Label) -> + #dg{in_es=InEsMap0,out_es=OutEsMap0} = Dg, + Name = {From,To,Label}, + InEsMap = edge_map_add(To, Name, InEsMap0), + OutEsMap = edge_map_add(From, Name, OutEsMap0), + Dg#dg{in_es=InEsMap,out_es=OutEsMap}. + +edge_map_add(V, E, EsMap) -> + Es0 = map_get(V, EsMap), + Es = ordsets:add_element(E, Es0), + EsMap#{V:=Es}. + +-spec del_edge(graph(), edge()) -> graph(). +del_edge(Dg, {From,To,_}=E) -> + #dg{in_es=InEsMap0,out_es=OutEsMap0} = Dg, + InEsMap = edge_map_del(To, E, InEsMap0), + OutEsMap = edge_map_del(From, E, OutEsMap0), + Dg#dg{in_es=InEsMap,out_es=OutEsMap}. + +edge_map_del(V, E, EsMap) -> + Es0 = map_get(V, EsMap), + Es = Es0 -- [E], + EsMap#{V:=Es}. + +-spec del_edges(graph(), [edge()]) -> graph(). +del_edges(G, Es) when is_list(Es) -> + foldl(fun(E, A) -> del_edge(A, E) end, G, Es). + +-spec has_vertex(graph(), vertex()) -> boolean(). +has_vertex(#dg{vs=Vs}, V) -> + is_map_key(V, Vs). + +-spec in_degree(graph(), vertex()) -> non_neg_integer(). +in_degree(#dg{in_es=InEsMap}, V) -> + length(map_get(V, InEsMap)). + +-spec in_edges(graph(), vertex()) -> [edge()]. +in_edges(#dg{in_es=InEsMap}, V) -> + map_get(V, InEsMap). + +-spec in_neighbours(graph(), vertex()) -> [vertex()]. +in_neighbours(#dg{in_es=InEsMap}, V) -> + [From || {From,_,_} <- map_get(V, InEsMap)]. + +-spec is_path(graph(), vertex(), vertex()) -> boolean(). +is_path(G, From, To) -> + Seen = cerl_sets:new(), + try + _ = is_path_1([From], To, G, Seen), + false + catch + throw:true -> + true + end. + +is_path_1([To|_], To, _G, _Seen) -> + throw(true); +is_path_1([V|Vs], To, G, Seen0) -> + case cerl_sets:is_element(V, Seen0) of + true -> + is_path_1(Vs, To, G, Seen0); + false -> + Seen1 = cerl_sets:add_element(V, Seen0), + Successors = out_neighbours(G, V), + Seen = is_path_1(Successors, To, G, Seen1), + is_path_1(Vs, To, G, Seen) + end; +is_path_1([], _To, _G, Seen) -> + Seen. + +-spec out_degree(graph(), vertex()) -> non_neg_integer(). +out_degree(#dg{out_es=OutEsMap}, V) -> + length(map_get(V, OutEsMap)). + +-spec out_edges(graph(), vertex()) -> [edge()]. +out_edges(#dg{out_es=OutEsMap}, V) -> + map_get(V, OutEsMap). + +-spec out_neighbours(graph(), vertex()) -> [vertex()]. +out_neighbours(#dg{out_es=OutEsMap}, V) -> + [To || {_,To,_} <- map_get(V, OutEsMap)]. + +-spec vertex(graph(), vertex()) -> label(). +vertex(#dg{vs=Vs}, V) -> + map_get(V, Vs). + +-spec vertices(graph()) -> [{vertex(), label()}]. +vertices(#dg{vs=Vs}) -> + maps:to_list(Vs). + +-spec reverse_postorder(graph(), [vertex()]) -> [vertex()]. +reverse_postorder(G, Vs) -> + Seen = cerl_sets:new(), + {RPO, _} = reverse_postorder_1(Vs, G, Seen, []), + RPO. + +reverse_postorder_1([V|Vs], G, Seen0, Acc0) -> + case cerl_sets:is_element(V, Seen0) of + true -> + reverse_postorder_1(Vs, G, Seen0, Acc0); + false -> + Seen1 = cerl_sets:add_element(V, Seen0), + Successors = out_neighbours(G, V), + {Acc,Seen} = reverse_postorder_1(Successors, G, Seen1, Acc0), + reverse_postorder_1(Vs, G, Seen, [V|Acc]) + end; +reverse_postorder_1([], _, Seen, Acc) -> + {Acc, Seen}. + +-spec roots(graph()) -> [vertex()]. +roots(G) -> + roots_1(vertices(G), G). + +roots_1([{V,_}|Vs], G) -> + case in_degree(G, V) of + 0 -> + [V|roots_1(Vs, G)]; + _ -> + roots_1(Vs, G) + end; +roots_1([], _G) -> []. + +-spec topsort(graph()) -> [vertex()]. +topsort(G) -> + Seen = roots(G), + reverse_postorder(G, Seen). + +%% +%% Kosaraju's algorithm +%% +%% Visit each node in reverse post order. If the node has not been assigned to +%% a component yet, start a new component and add all of its in-neighbors to it +%% if they don't yet belong to one. Keep going until all nodes have been +%% visited. +%% +%% https://en.wikipedia.org/wiki/Kosaraju%27s_algorithm +%% + +-spec strong_components(graph(), [vertex()]) -> ComponentMap when + %% Vertices together with their components. + ComponentMap :: #{ vertex() => [vertex()] }. +strong_components(G, Vs) -> + sc_1(Vs, G, #{}, #{}). + +sc_1([V | Vs], G, Roots0, Components) when not is_map_key(V, Roots0) -> + %% V has not been assigned to a component, start a new one with this one as + %% the root. + {Roots, Component} = sc_2([V], G, V, Roots0, []), + sc_1(Vs, G, Roots, Components#{ V => Component }); +sc_1([V | Vs], G, Roots, Components0) -> + %% V is already part of a component, copy it over. + Root = map_get(V, Roots), + Components = Components0#{ V => map_get(Root, Components0) }, + + sc_1(Vs, G, Roots, Components); +sc_1([], _G, _Roots, Components) -> + Components. + +sc_2([V | Vs], G, Root, Roots, Acc) when not is_map_key(V, Roots) -> + %% V has not been assigned to a component, so assign it to the current one. + sc_2(in_neighbours(G, V) ++ Vs, G, Root, Roots#{ V => Root }, [V | Acc]); +sc_2([_V | Vs], G, Root, Roots, Acc) -> + %% V is already part of a component, skip it. + sc_2(Vs, G, Root, Roots, Acc); +sc_2([], _G, _Root, Roots, Acc) -> + {Roots, reverse(Acc)}. + +-if(?DEBUG). + +%% +%% Dumps the graph as a string in dot (graphviz) format. +%% +%% Use dot(1) to convert to an image: +%% +%% dot [input] -T[format] +%% dot graph_file -Tsvg > graph.svg + +-spec dump(any()) -> any(). +dump(G) -> + Formatter = fun(Node) -> io_lib:format("~p", [Node]) end, + io:format("~s", [dump_1(G, Formatter)]). + +-spec dump(any(), any()) -> any(). +dump(G, FileName) -> + Formatter = fun(Node) -> io_lib:format("~p", [Node]) end, + dump(G, FileName, Formatter). + +-spec dump(any(), any(), any()) -> any(). +dump(G, FileName, Formatter) -> + {ok, Fd} = file:open(FileName, [write]), + io:fwrite(Fd, "~s", [dump_1(G, Formatter)]), + file:close(Fd). + +dump_1(G, Formatter) -> + Vs = maps:keys(G#dg.vs), + + {Map, Vertices} = dump_vertices(Vs, 0, Formatter,#{}, []), + Edges = dump_edges(Vs, G, Map, []), + + io_lib:format("digraph g {~n~s~n~s~n}~n", [Vertices, Edges]). + +dump_vertices([V | Vs], Counter, Formatter, Map, Acc) -> + VerticeSlug = io_lib:format(" ~p [label=\"~s\"]~n", + [Counter, Formatter(V)]), + dump_vertices(Vs, Counter + 1, Formatter, + Map#{ V => Counter }, [VerticeSlug | Acc]); +dump_vertices([], _Counter, _Formatter, Map, Acc) -> + {Map, Acc}. + +dump_edges([V | Vs], G, Map, Acc) -> + SelfId = map_get(V, Map), + EdgeSlug = [io_lib:format(" ~p -> ~p~n", [SelfId, map_get(To, Map)]) || + {_, To, _} <- out_edges(G, V)], + dump_edges(Vs, G, Map, [EdgeSlug | Acc]); +dump_edges([], _G, _Map, Acc) -> + Acc. + +-endif. diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 7d048716e4..c52edd6635 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1123,6 +1123,15 @@ resolve_inst({put_tuple2,[Dst,{{z,1},{u,_},List0}]},_,_,_) -> {put_tuple2,Dst,{list,List}}; %% +%% OTP 23. +%% +resolve_inst({bs_start_match4,[Fail,Live,Src,Dst]},_,_,_) -> + {bs_start_match4,Fail,Live,Src,Dst}; +resolve_inst({swap,[_,_]=List},_,_,_) -> + [R1,R2] = resolve_args(List), + {swap,R1,R2}; + +%% %% Catches instructions that are not yet handled. %% resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}). diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl deleted file mode 100644 index 04a5e3430a..0000000000 --- a/lib/compiler/src/beam_except.erl +++ /dev/null @@ -1,256 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2011-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --module(beam_except). --export([module/2]). - -%%% Rewrite certain calls to erlang:error/{1,2} to specialized -%%% instructions: -%%% -%%% erlang:error({badmatch,Value}) => badmatch Value -%%% erlang:error({case_clause,Value}) => case_end Value -%%% erlang:error({try_clause,Value}) => try_case_end Value -%%% erlang:error(if_clause) => if_end -%%% erlang:error(function_clause, Args) => jump FuncInfoLabel -%%% - --import(lists, [reverse/1,reverse/2,seq/2,splitwith/2]). - --spec module(beam_utils:module_code(), [compile:option()]) -> - {'ok',beam_utils:module_code()}. - -module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> - Fs = [function(F) || F <- Fs0], - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Is0}) -> - try - Is = function_1(Is0), - {function,Name,Arity,CLabel,Is} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - --record(st, - {lbl :: beam_asm:label(), %func_info label - loc :: [_], %location for func_info - arity :: arity() %arity for function - }). - -function_1(Is0) -> - case Is0 of - [{label,Lbl},{line,Loc},{func_info,_,_,Arity}|_] -> - St = #st{lbl=Lbl,loc=Loc,arity=Arity}, - translate(Is0, St, []); - [{label,_}|_] -> - %% No line numbers. The source must be a .S file. - %% There is no need to do anything. - Is0 - end. - -translate([{call_ext,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) -> - translate_1(Ar, I, Is, St, Acc); -translate([I|Is], St, Acc) -> - translate(Is, St, [I|Acc]); -translate([], _, Acc) -> - reverse(Acc). - -translate_1(Ar, I, Is, #st{arity=Arity}=St, [{line,_}=Line|Acc1]=Acc0) -> - case dig_out(Ar, Arity, Acc1) of - no -> - translate(Is, St, [I|Acc0]); - {yes,function_clause,Acc2} -> - case {Is,Line,St} of - {[return|_],{line,Loc},#st{lbl=Fi,loc=Loc}} -> - Instr = {jump,{f,Fi}}, - translate(Is, St, [Instr|Acc2]); - {_,_,_} -> - %% Not a call_only instruction, or not the same - %% location information as in in the line instruction - %% before the func_info instruction. Not safe - %% to translate to a jump. - translate(Is, St, [I|Acc0]) - end; - {yes,Instr,Acc2} -> - translate(Is, St, [Instr,Line|Acc2]) - end. - -dig_out(1, _Arity, Is) -> - dig_out(Is); -dig_out(2, Arity, Is) -> - dig_out_fc(Arity, Is); -dig_out(_, _, _) -> no. - -dig_out([{block,Bl0}|Is]) -> - case dig_out_block(reverse(Bl0)) of - no -> no; - {yes,What,[]} -> - {yes,What,Is}; - {yes,What,Bl} -> - {yes,What,[{block,Bl}|Is]} - end; -dig_out(_) -> no. - -dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) -> - {yes,if_end,[]}; -dig_out_block([{set,[{x,0}],[{literal,{Exc,Value}}],move}|Is]) -> - translate_exception(Exc, {literal,Value}, Is, 0); -dig_out_block([{set,[{x,0}],[{atom,Exc},Value],put_tuple2}|Is]) -> - translate_exception(Exc, Value, Is, 3); -dig_out_block(_) -> no. - -translate_exception(badmatch, Val, Is, Words) -> - {yes,{badmatch,Val},fix_block(Is, Words)}; -translate_exception(case_clause, Val, Is, Words) -> - {yes,{case_end,Val},fix_block(Is, Words)}; -translate_exception(try_clause, Val, Is, Words) -> - {yes,{try_case_end,Val},fix_block(Is, Words)}; -translate_exception(_, _, _, _) -> no. - -fix_block(Is, 0) -> - reverse(Is); -fix_block(Is, Words) -> - reverse(fix_block_1(Is, Words)). - -fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) - when is_integer(Needed0) -> - case Needed0 - Words of - 0 -> - Is; - Needed -> - true = Needed >= 0, %Assertion. - [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] - end; -fix_block_1([I|Is], Words) -> - [I|fix_block_1(Is, Words)]; -fix_block_1([], _Words) -> - %% Rare. The heap allocation was probably done by a binary - %% construction instruction. - []. - -dig_out_fc(Arity, Is0) -> - Regs0 = maps:from_list([{{x,X},{arg,X}} || X <- seq(0, Arity-1)]), - {Is,Acc0} = splitwith(fun({label,_}) -> false; - ({test,_,_,_}) -> false; - (_) -> true - end, Is0), - {Regs,Acc} = dig_out_fc_1(reverse(Is), Arity, Regs0, Acc0), - case Regs of - #{{x,0}:={atom,function_clause},{x,1}:=Args} -> - case moves_from_stack(Args, 0, []) of - {Moves,Arity} -> - {yes,function_clause,reverse(Moves, Acc)}; - {_,_} -> - no - end; - #{} -> - no - end. - -dig_out_fc_1([{block,Bl}|Is], Arity, Regs0, Acc) -> - Regs = dig_out_fc_block(Bl, Regs0), - dig_out_fc_1(Is, Arity, Regs, Acc); -dig_out_fc_1([{bs_set_position,_,_}=I|Is], Arity, Regs, Acc) -> - dig_out_fc_1(Is, Arity, Regs, [I|Acc]); -dig_out_fc_1([{bs_get_tail,Src,Dst,Live0}|Is], Arity, Regs0, Acc) -> - case Src of - {x,X} when X < Arity -> - %% The heuristic for determining the number of live - %% registers is likely to give an incorrect result. - %% Give up. - {#{},[]}; - _ -> - Regs = prune_xregs(Live0, Regs0), - Live = dig_out_stack_live(Regs, Live0), - I = {bs_get_tail,Src,Dst,Live}, - dig_out_fc_1(Is, Arity, Regs, [I|Acc]) - end; -dig_out_fc_1([_|_], _Arity, _Regs, _Acc) -> - {#{},[]}; -dig_out_fc_1([], _Arity, Regs, Acc) -> - {Regs,Acc}. - -dig_out_fc_block([{set,[],[],{alloc,Live,_}}|Is], Regs0) -> - Regs = prune_xregs(Live, Regs0), - dig_out_fc_block(Is, Regs); -dig_out_fc_block([{set,[Dst],[Hd,Tl],put_list}|Is], Regs0) -> - Regs = Regs0#{Dst=>{cons,get_reg(Hd, Regs0),get_reg(Tl, Regs0)}}, - dig_out_fc_block(Is, Regs); -dig_out_fc_block([{set,[Dst],[Src],move}|Is], Regs0) -> - Regs = Regs0#{Dst=>get_reg(Src, Regs0)}, - dig_out_fc_block(Is, Regs); -dig_out_fc_block([{set,_,_,_}|_], _Regs) -> - %% Unknown instruction. Fail. - #{}; -dig_out_fc_block([], Regs) -> Regs. - -dig_out_stack_live(Regs, Default) -> - Reg = {x,2}, - case Regs of - #{Reg:=List} -> - dig_out_stack_live_1(List, Default); - #{} -> - Default - end. - -dig_out_stack_live_1({cons,{arg,N},T}, Live) -> - dig_out_stack_live_1(T, max(N + 1, Live)); -dig_out_stack_live_1({cons,_,T}, Live) -> - dig_out_stack_live_1(T, Live); -dig_out_stack_live_1(nil, Live) -> - Live; -dig_out_stack_live_1(_, Live) -> Live. - -prune_xregs(Live, Regs) -> - maps:filter(fun({x,X}, _) -> X < Live end, Regs). - -moves_from_stack({cons,{arg,N},_}, I, _Acc) when N =/= I -> - %% Wrong argument. Give up. - {[],-1}; -moves_from_stack({cons,H,T}, I, Acc) -> - case H of - {arg,I} -> - moves_from_stack(T, I+1, Acc); - _ -> - moves_from_stack(T, I+1, [{move,H,{x,I}}|Acc]) - end; -moves_from_stack(nil, I, Acc) -> - {reverse(Acc),I}; -moves_from_stack({literal,[H|T]}, I, Acc) -> - Cons = {cons,tag_literal(H),tag_literal(T)}, - moves_from_stack(Cons, I, Acc); -moves_from_stack(_, _, _) -> - %% Not understood. Give up. - {[],-1}. - - -get_reg(R, Regs) -> - case Regs of - #{R:=Val} -> Val; - #{} -> R - end. - -tag_literal([]) -> nil; -tag_literal(T) when is_atom(T) -> {atom,T}; -tag_literal(T) when is_float(T) -> {float,T}; -tag_literal(T) when is_integer(T) -> {integer,T}; -tag_literal(T) -> {literal,T}. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 2d5d3dc457..61738e4435 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -136,6 +136,8 @@ -type instruction() :: beam_utils:instruction(). +-include("beam_types.hrl"). + -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -189,6 +191,15 @@ eliminate_moves([{test,is_eq_exact,_,[Reg,Val]}=I, RegVal = {Reg,Val}, BlkIs = eliminate_moves_blk(BlkIs0, RegVal), eliminate_moves([{block,BlkIs}|Is], D, [I|Acc]); +eliminate_moves([{test,is_nonempty_list,Fail,[Reg]}=I|Is], D0, Acc) -> + case is_proper_list(Reg, Acc) of + true -> + D = update_value_dict([nil,Fail], Reg, D0), + eliminate_moves(Is, D, [I|Acc]); + false -> + D = update_unsafe_labels(I, D0), + eliminate_moves(Is, D, [I|Acc]) + end; eliminate_moves([{label,Lbl},{block,BlkIs0}=Blk|Is], D, Acc0) -> Acc = [{label,Lbl}|Acc0], case {no_fallthrough(Acc0),D} of @@ -198,6 +209,10 @@ eliminate_moves([{label,Lbl},{block,BlkIs0}=Blk|Is], D, Acc0) -> {_,_} -> eliminate_moves([Blk|Is], D, Acc) end; +eliminate_moves([{call,_,_}=I|Is], D, Acc) -> + eliminate_moves_call(Is, D, [I | Acc]); +eliminate_moves([{call_ext,_,_}=I|Is], D, Acc) -> + eliminate_moves_call(Is, D, [I | Acc]); eliminate_moves([{block,[]}|Is], D, Acc) -> %% Empty blocks can prevent further jump optimizations. eliminate_moves(Is, D, Acc); @@ -206,6 +221,21 @@ eliminate_moves([I|Is], D0, Acc) -> eliminate_moves(Is, D, [I|Acc]); eliminate_moves([], _, Acc) -> reverse(Acc). +eliminate_moves_call([{'%',{var_info,{x,0},Info}}=Anno, + {block,BlkIs0}=Blk | Is], D, Acc0) -> + Acc = [Anno | Acc0], + RetType = proplists:get_value(type, Info, none), + case beam_types:get_singleton_value(RetType) of + {ok, Value} -> + RegVal = {{x,0}, value_to_literal(Value)}, + BlkIs = eliminate_moves_blk(BlkIs0, RegVal), + eliminate_moves([{block,BlkIs}|Is], D, Acc); + error -> + eliminate_moves(Is, D, [Blk | Acc]) + end; +eliminate_moves_call(Is, D, Acc) -> + eliminate_moves(Is, D, Acc). + eliminate_moves_blk([{set,[Dst],[_],move}|_]=Is, {_,Dst}) -> Is; eliminate_moves_blk([{set,[Dst],[Lit],move}|Is], {Dst,Lit}) -> @@ -217,9 +247,29 @@ eliminate_moves_blk([{set,[_],[_],move}=I|Is], {_,_}=RegVal) -> [I|eliminate_moves_blk(Is, RegVal)]; eliminate_moves_blk(Is, _) -> Is. +no_fallthrough([{'%',_} | Is]) -> + no_fallthrough(Is); no_fallthrough([I|_]) -> is_unreachable_after(I). +is_proper_list(Reg, [{'%',{var_info,Reg,Info}}|_]) -> + case proplists:get_value(type, Info) of + #t_list{terminator=nil} -> + true; + _ -> + %% Unknown type or not a proper list. + false + end; +is_proper_list(Reg, [{'%',{var_info,_,_}}|Is]) -> + is_proper_list(Reg, Is); +is_proper_list(_, _) -> false. + +value_to_literal([]) -> nil; +value_to_literal(A) when is_atom(A) -> {atom,A}; +value_to_literal(F) when is_float(F) -> {float,F}; +value_to_literal(I) when is_integer(I) -> {integer,I}; +value_to_literal(Other) -> {literal,Other}. + update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> D = case D0 of #{Lbl:=unsafe} -> D0; @@ -267,55 +317,84 @@ insert_labels([], Lc, Acc) -> %%% (1) We try to share the code for identical code segments by replacing all %%% occurrences except the last with jumps to the last occurrence. %%% +%%% We must not share code that raises an exception from outside a +%%% try/catch block with code inside a try/catch block and vice versa, +%%% because beam_validator will probably flag it as unsafe +%%% (ambiguous_catch_try_state). The same goes for a plain catch. +%%% share(Is0) -> Is1 = eliminate_fallthroughs(Is0, []), Is2 = find_fixpoint(fun(Is) -> - share_1(Is, #{}, #{}, [], []) + share_1(Is) end, Is1), reverse(Is2). -share_1([{label,L}=Lbl|Is], Dict0, Lbls0, [_|_]=Seq, Acc) -> - case maps:find(Seq, Dict0) of - error -> - Dict = case is_shareable(Seq) of - true -> - maps:put(Seq, L, Dict0); - false -> - Dict0 - end, - share_1(Is, Dict, Lbls0, [], [[Lbl|Seq]|Acc]); - {ok,Label} -> - Lbls = maps:put(L, Label, Lbls0), - share_1(Is, Dict0, Lbls, [], [[Lbl,{jump,{f,Label}}]|Acc]) +share_1(Is) -> + Safe = classify_labels(Is), + share_1(Is, Safe, #{}, #{}, [], []). + +%% Note that we examine the instructions in reverse execution order. +share_1([{label,L}=Lbl|Is], Safe, Dict0, Lbls0, [_|_]=Seq, Acc) -> + case Dict0 of + #{Seq := Label} -> + %% This sequence of instructions has been seen previously. Find out + %% whether it would be safe to jump the label for previous occurrence. + case is_safely_shareable(L, Label, Seq, Safe) of + true -> + %% Safe, because either the sequence never raises an exception + %% or the jump to the label will not pass a try/catch or catch + %% boundary. + Lbls = Lbls0#{L => Label}, + share_1(Is, Safe, Dict0, Lbls, [], + [[Lbl,{jump,{f,Label}}]|Acc]); + false -> + %% Not safe, because the sequence can raise an exception + %% and the jump would pass the boundary going in + %% or out of a try/catch or catch block. + share_1(Is, Safe, Dict0, Lbls0, [], [[Lbl|Seq]|Acc]) + end; + #{} -> + %% This is first time we have seen this sequence of instructions. + case is_shareable(Seq) of + true -> + Dict = Dict0#{Seq => L}, + share_1(Is, Safe, Dict, Lbls0, [], [[Lbl|Seq]|Acc]); + false -> + %% The sequence begins with an inappropriate instruction. + share_1(Is, Safe, Dict0, Lbls0, [], [[Lbl|Seq]|Acc]) + end end; -share_1([{func_info,_,_,_}|_]=Is0, _, Lbls, [], Acc0) when Lbls =/= #{} -> - lists:foldl(fun(Is, Acc) -> - beam_utils:replace_labels(Is, Acc, Lbls, fun(Old) -> Old end) - end, Is0, Acc0); -share_1([{func_info,_,_,_}|_]=Is, _, Lbls, [], Acc) when Lbls =:= #{} -> - lists:foldl(fun lists:reverse/2, Is, Acc); -share_1([{'catch',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> - {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), - share_1(Is, Dict, Lbls, [I|Seq], Acc); -share_1([{'try',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> - {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), - share_1(Is, Dict, Lbls, [I|Seq], Acc); -share_1([{try_case,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> - {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), - share_1(Is, Dict, Lbls, [I|Seq], Acc); -share_1([{catch_end,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> - {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), - share_1(Is, Dict, Lbls, [I|Seq], Acc); -share_1([{jump,{f,To}}=I,{label,L}=Lbl|Is], Dict0, Lbls0, _Seq, Acc) -> - Lbls = maps:put(L, To, Lbls0), - share_1(Is, Dict0, Lbls, [], [[Lbl,I]|Acc]); -share_1([I|Is], Dict, Lbls, Seq, Acc) -> +share_1([{func_info,_,_,_}|_]=Is0, _Safe, _, Lbls, [], Acc0) -> + %% Replace jumps to jumps with a jump to the final destination + %% (jump threading). This optimization is done in the main + %% optimization pass of this module, but we do it here too because + %% it can give more opportunities for sharing code. + F = case Lbls =:= #{} of + true -> + fun lists:reverse/2; + false -> + fun(Is, Acc) -> + beam_utils:replace_labels(Is, Acc, Lbls, + fun(Old) -> Old end) + end + end, + foldl(F, Is0, Acc0); +share_1([{'catch',_,_}=I|Is], Safe, Dict, _Lbls0, Seq, Acc) -> + %% Disable the jump threading optimization because it may be unsafe. + share_1(Is, Safe, Dict, #{}, [I|Seq], Acc); +share_1([{'try',_,_}=I|Is], Safe, Dict, _Lbls, Seq, Acc) -> + %% Disable the jump threading optimization because it may be unsafe. + share_1(Is, Safe, Dict, #{}, [I|Seq], Acc); +share_1([{jump,{f,To}}=I,{label,From}=Lbl|Is], Safe, Dict0, Lbls0, _Seq, Acc) -> + Lbls = Lbls0#{From => To}, + share_1(Is, Safe, Dict0, Lbls, [], [[Lbl,I]|Acc]); +share_1([I|Is], Safe, Dict, Lbls, Seq, Acc) -> case is_unreachable_after(I) of false -> - share_1(Is, Dict, Lbls, [I|Seq], Acc); + share_1(Is, Safe, Dict, Lbls, [I|Seq], Acc); true -> - share_1(Is, Dict, Lbls, [I], Acc) + share_1(Is, Safe, Dict, Lbls, [I], Acc) end. is_shareable([{'catch',_,_}|_]) -> false; @@ -325,34 +404,73 @@ is_shareable([{try_case,_}|_]) -> false; is_shareable([{try_end,_}|_]) -> false; is_shareable(_) -> true. -clean_non_sharable(Dict0, Lbls0) -> - %% We are passing in or out of a 'catch' or 'try' block. Remove - %% sequences that should not be shared over the boundaries of the - %% block. Since the end of the sequence must match, the only - %% possible match between a sequence outside and a sequence inside - %% the 'catch'/'try' block is a sequence that ends with an - %% instruction that causes an exception. Any sequence that causes - %% an exception must contain a line/1 instruction. - Dict1 = maps:to_list(Dict0), - Lbls1 = maps:to_list(Lbls0), - {Dict2,Lbls2} = foldl(fun({K, V}, {Dict,Lbls}) -> - case sharable_with_try(K) of - true -> - {[{K,V}|Dict],lists:keydelete(V, 2, Lbls)}; - false -> - {Dict,Lbls} - end - end, {[],Lbls1}, Dict1), - {maps:from_list(Dict2),maps:from_list(Lbls2)}. - -sharable_with_try([{line,_}|_]) -> - %% This sequence may cause an exception and may potentially +%% There are identical code sequences Seq at labels Lbl1 and Lbl2. Is it +%% safe to replace the sequence at label Lbl1 with a jump to Lbl2? + +is_safely_shareable(Lbl1, Lbl2, Seq, Safe) -> + case no_exception(Seq) of + true -> + %% Safe, because the sequence Seq can't raise an exception. + true; + false -> + %% Safe if both labels are either ouside try/catch or inside + %% the same part of the same try/catch or catch block. + case Safe of + #{Lbl1 := Scope, Lbl2 := Scope} -> true; + #{} -> false + end + end. + +no_exception([{line,_}|_]) -> + %% This sequence may raise an exception and may potentially %% match a sequence on the other side of the 'catch'/'try' block %% boundary. false; -sharable_with_try([_|Is]) -> - sharable_with_try(Is); -sharable_with_try([]) -> true. +no_exception([_|Is]) -> + no_exception(Is); +no_exception([]) -> true. + +%% +%% Classify labels according to where the instructions that branch to +%% the labels are located. Each label is assigned a scope identifer. +%% If two labels have different scope identfiers, sharing a sequence +%% that raises an exception between the labels may not be safe, because +%% one label is inside a try/catch, and the other label is outside. +%% +%% Note that we don't care where the labels themselves are located, +%% only from where the branches to them are located. This is essential +%% to ensure that beam_jump is idempotent, ensuring that beam_jump +%% will not do any unsafe optimizations when when compiling from a .S +%% file. The move/1 optimization pass below (2) will move instruction +%% sequences that end in an exception raising instruction to the end +%% of the function. Thus instruction sequences initially being in +%% different scopes could be placed next to each other. +%% + +classify_labels(Is) -> + classify_labels(Is, 0, #{}). + +classify_labels([{'catch',_,_}|Is], Scope, Safe) -> + classify_labels(Is, Scope+1, Safe); +classify_labels([{catch_end,_}|Is], Scope, Safe) -> + classify_labels(Is, Scope+1, Safe); +classify_labels([{'try',_,_}|Is], Scope, Safe) -> + classify_labels(Is, Scope+1, Safe); +classify_labels([{'try_end',_}|Is], Scope, Safe) -> + classify_labels(Is, Scope+1, Safe); +classify_labels([{'try_case',_}|Is], Scope, Safe) -> + classify_labels(Is, Scope+1, Safe); +classify_labels([I|Is], Scope, Safe0) -> + Labels = instr_labels(I), + Safe = foldl(fun(L, A) -> + case A of + #{L := Scope} -> A; + #{L := _} -> maps:remove(L, A); + #{} -> A#{L => Scope} + end + end, Safe0, Labels), + classify_labels(Is, Scope, Safe); +classify_labels([], _Scope, Safe) -> Safe. %% Eliminate all fallthroughs. Return the result reversed. @@ -592,8 +710,6 @@ is_unreachable_after(I) -> is_exit_instruction(I). -spec is_exit_instruction(instruction()) -> boolean(). -is_exit_instruction({call_ext,_,{extfunc,M,F,A}}) -> - erl_bifs:is_exit_bif(M, F, A); is_exit_instruction(if_end) -> true; is_exit_instruction({case_end,_}) -> true; is_exit_instruction({try_case_end,_}) -> true; @@ -736,7 +852,13 @@ instr_labels({recv_set,Lbl}) -> do_instr_labels(Lbl); instr_labels({fcheckerror,Lbl}) -> do_instr_labels(Lbl); -instr_labels(_) -> []. +instr_labels({bs_start_match4,Fail,_,_,_}) -> + case Fail of + {f,L} -> [L]; + {atom,_} -> [] + end; +instr_labels(_) -> + []. do_instr_labels({f,0}) -> []; do_instr_labels({f,F}) -> [F]. diff --git a/lib/compiler/src/beam_kernel_to_ssa.erl b/lib/compiler/src/beam_kernel_to_ssa.erl index aa04a75804..6b552ae38c 100644 --- a/lib/compiler/src/beam_kernel_to_ssa.erl +++ b/lib/compiler/src/beam_kernel_to_ssa.erl @@ -24,7 +24,7 @@ %% The main interface. -export([module/2]). --import(lists, [append/1,duplicate/2,flatmap/2,foldl/3, +-import(lists, [all/2,append/1,flatmap/2,foldl/3, keysort/2,mapfoldl/3,map/2,member/2, reverse/1,reverse/2,sort/1]). @@ -34,13 +34,14 @@ -type label() :: beam_ssa:label(). %% Main codegen structure. --record(cg, {lcount=1 :: label(), %Label counter +-record(cg, {lcount=1 :: label(), %Label counter bfail=1 :: label(), catch_label=none :: 'none' | label(), vars=#{} :: map(), %Defined variables. break=0 :: label(), %Break label recv=0 :: label(), %Receive label - ultimate_failure=0 :: label() %Label for ultimate match failure. + ultimate_failure=0 :: label(), %Label for ultimate match failure. + labels=#{} :: #{atom() => label()} }). %% Internal records. @@ -83,6 +84,7 @@ function(#k_fdef{anno=Anno0,func=Name,arity=Arity, cg_fun(Ke, St0) -> {UltimateFail,FailIs,St1} = make_failure(badarg, St0), + ?EXCEPTION_BLOCK = UltimateFail, %Assertion. St2 = St1#cg{bfail=UltimateFail,ultimate_failure=UltimateFail}, {B,St} = cg(Ke, St2), Asm = [{label,0}|B++FailIs], @@ -105,8 +107,6 @@ make_failure(Reason, St0) -> cg(#k_match{body=M,ret=Rs}, St) -> do_match_cg(M, Rs, St); -cg(#k_guard_match{body=M,ret=Rs}, St) -> - do_match_cg(M, Rs, St); cg(#k_seq{arg=Arg,body=Body}, St0) -> {ArgIs,St1} = cg(Arg, St0), {BodyIs,St} = cg(Body, St1), @@ -123,14 +123,6 @@ cg(#k_try_enter{arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th}, St) -> try_enter_cg(Ta, Vs, Tb, Evs, Th, St); cg(#k_catch{body=Cb,ret=[R]}, St) -> do_catch_cg(Cb, R, St); -cg(#k_receive{anno=Le,timeout=Te,var=Rvar,body=Rm,action=Tes,ret=Rs}, St) -> - recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, St); -cg(#k_receive_next{}, #cg{recv=Recv}=St) -> - Is = [#b_set{op=recv_next},make_uncond_branch(Recv)], - {Is,St}; -cg(#k_receive_accept{}, St) -> - Remove = #b_set{op=remove_message}, - {[Remove],St}; cg(#k_put{anno=Le,arg=Con,ret=Var}, St) -> put_cg(Var, Con, Le, St); cg(#k_return{args=[Ret0]}, St) -> @@ -139,18 +131,30 @@ cg(#k_return{args=[Ret0]}, St) -> cg(#k_break{args=Bs}, #cg{break=Br}=St) -> Args = ssa_args(Bs, St), {[#cg_break{args=Args,phi=Br}],St}; -cg(#k_guard_break{args=Bs}, St) -> - cg(#k_break{args=Bs}, St). +cg(#k_letrec_goto{label=Label,first=First,then=Then,ret=Rs}, + #cg{break=OldBreak,labels=Labels0}=St0) -> + {Tf,St1} = new_label(St0), + {B,St2} = new_label(St1), + Labels = Labels0#{Label=>Tf}, + {Fis,St3} = cg(First, St2#cg{labels=Labels,break=B}), + {Sis,St4} = cg(Then, St3), + St5 = St4#cg{labels=Labels0}, + {BreakVars,St} = new_ssa_vars(Rs, St5), + Phi = #cg_phi{vars=BreakVars}, + {Fis ++ [{label,Tf}] ++ Sis ++ [{label,B},Phi],St#cg{break=OldBreak}}; +cg(#k_goto{label=Label}, #cg{labels=Labels}=St) -> + Branch = map_get(Label, Labels), + {[make_uncond_branch(Branch)],St}. %% match_cg(Matc, [Ret], State) -> {[Ainstr],State}. %% Generate code for a match. -do_match_cg(M, Rs, St0) -> +do_match_cg(M, Rs, #cg{bfail=Bfail,break=OldBreak}=St0) -> {B,St1} = new_label(St0), - {Mis,St2} = match_cg(M, St1#cg.bfail, St1#cg{break=B}), - {BreakVars,St} = new_ssa_vars(Rs, St2), - {Mis ++ [{label,B},#cg_phi{vars=BreakVars}], - St#cg{bfail=St0#cg.bfail,break=St1#cg.break}}. + {Mis,St2} = match_cg(M, Bfail, St1#cg{break=B}), + St3 = St2#cg{break=OldBreak}, + {BreakVars,St} = new_ssa_vars(Rs, St3), + {Mis ++ [{label,B},#cg_phi{vars=BreakVars}],St}. %% match_cg(Match, Fail, State) -> {[Ainstr],State}. %% Generate code for a match tree. @@ -206,6 +210,22 @@ select_cg(#k_type_clause{type=Type,values=Scs}, Var, Tf, Vf, St0) -> {Is,St} = select_val_cg(Type, Arg, Vls, Tf, Vf, Sis, St2), {Is,St}. +select_val_cg(k_atom, {succeeded,Dst}, Vls, _Tf, _Vf, Sis, St0) -> + [{#b_literal{val=false},Fail},{#b_literal{val=true},Succ}] = sort(Vls), + case Dst of + #b_var{} -> + %% Generate a `succeeded` instruction and two-way branch + %% following the `peek_message` and `wait_timeout` + %% instructions. + {Bool,St} = new_ssa_var('@ssa_bool', St0), + Succeeded = #b_set{op=succeeded,dst=Bool,args=[Dst]}, + Br = #b_br{bool=Bool,succ=Succ,fail=Fail}, + {[Succeeded,Br|Sis],St}; + #b_literal{val=true}=Bool -> + %% A 'wait_timeout 0' instruction was optimized away. + Br = #b_br{bool=Bool,succ=Succ,fail=Succ}, + {[Br|Sis],St0} + end; select_val_cg(k_tuple, Tuple, Vls, Tf, Vf, Sis, St0) -> {Is0,St1} = make_cond_branch({bif,is_tuple}, [Tuple], Tf, St0), {Arity,St2} = new_ssa_var('@ssa_arity', St1), @@ -269,7 +289,7 @@ select_cons(#k_val_clause{val=#k_cons{hd=Hd,tl=Tl},body=B}, {Is,St} = make_cond_branch(is_nonempty_list, [Src], Tf, St2), {Is ++ Eis ++ Bis,St}. -select_nil(#k_val_clause{val=#k_nil{},body=B}, V, Tf, Vf, St0) -> +select_nil(#k_val_clause{val=#k_literal{val=[]},body=B}, V, Tf, Vf, St0) -> {Bis,St1} = match_cg(B, Vf, St0), Src = ssa_arg(V, St1), {Is,St} = make_cond_branch({bif,'=:='}, [Src,#b_literal{val=[]}], Tf, St1), @@ -279,9 +299,10 @@ select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=Ctx0}},body=B}, #k_var{}=Src, Tf, Vf, St0) -> {Ctx,St1} = new_ssa_var(Ctx0, St0), {Bis0,St2} = match_cg(B, Vf, St1), - {TestIs,St} = make_cond_branch(succeeded, [Ctx], Tf, St2), + {TestIs,St} = make_succeeded(Ctx, {guard, Tf}, St2), Bis1 = [#b_set{op=bs_start_match,dst=Ctx, - args=[ssa_arg(Src, St)]}] ++ TestIs ++ Bis0, + args=[#b_literal{val=new}, + ssa_arg(Src, St)]}] ++ TestIs ++ Bis0, Bis = finish_bs_matching(Bis1), {Bis,St}. @@ -311,6 +332,35 @@ make_cond_branch(Cond, Args, Fail, St0) -> make_uncond_branch(Fail) -> #b_br{bool=#b_literal{val=true},succ=Fail,fail=Fail}. +%% +%% The 'succeeded' instruction needs special treatment in catch blocks to +%% prevent the checked operation from being optimized away if a later pass +%% determines that it always fails. +%% + +make_succeeded(Var, {in_catch, CatchLbl}, St0) -> + {Bool, St1} = new_ssa_var('@ssa_bool', St0), + {Succ, St2} = new_label(St1), + {Fail, St} = new_label(St2), + + Check = [#b_set{op=succeeded,dst=Bool,args=[Var]}, + #b_br{bool=Bool,succ=Succ,fail=Fail}], + + %% Add a dummy block that references the checked variable, ensuring it + %% stays alive and that it won't be merged with the landing pad. + Trampoline = [{label,Fail}, + #b_set{op=exception_trampoline,args=[Var]}, + make_uncond_branch(CatchLbl)], + + {Check ++ Trampoline ++ [{label,Succ}], St}; +make_succeeded(Var, {no_catch, Fail}, St) -> + %% Ultimate failure raises an exception, so we must treat it as if it were + %% in a catch to keep it from being optimized out. + #cg{ultimate_failure=Fail} = St, %Assertion + make_succeeded(Var, {in_catch, Fail}, St); +make_succeeded(Var, {guard, Fail}, St) -> + make_cond_branch(succeeded, [Var], Fail, St). + %% Instructions for selection of binary segments. select_bin_segs(Scs, Ivar, Tf, St) -> @@ -375,15 +425,23 @@ select_bin_end(#k_val_clause{val=#k_bin_end{},body=B}, Src, Tf, St0) -> select_extract_bin(#k_var{name=Hd}, Size0, Unit, Type, Flags, Vf, Ctx, Anno, St0) -> {Dst,St1} = new_ssa_var(Hd, St0), - Size = ssa_arg(Size0, St0), + Size = case {Size0,ssa_arg(Size0, St0)} of + {#k_var{},#b_literal{val=all}} -> + %% The size `all` is used for the size of the final binary + %% segment in a pattern. Using `all` explicitly is not allowed, + %% so we convert it to an obvious invalid size. + #b_literal{val=bad_size}; + {_,Size1} -> + Size1 + end, build_bs_instr(Anno, Type, Vf, Ctx, Size, Unit, Flags, Dst, St1). -select_extract_int(#k_var{name=Tl}, 0, #k_int{val=0}, _U, _Fs, _Vf, +select_extract_int(#k_var{name=Tl}, 0, #k_literal{val=0}, _U, _Fs, _Vf, Ctx, St0) -> St = set_ssa_var(Tl, Ctx, St0), {[],St}; -select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf, - Ctx, St0) -> +select_extract_int(#k_var{name=Tl}, Val, #k_literal{val=Sz}, U, Fs, Vf, + Ctx, St0) when is_integer(Sz) -> {Dst,St1} = new_ssa_var(Tl, St0), Bits = U*Sz, Bin = case member(big, Fs) of @@ -394,7 +452,7 @@ select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf, <<Val:Bits/little>> end, Bits = bit_size(Bin), %Assertion. - {TestIs,St} = make_cond_branch(succeeded, [Dst], Vf, St1), + {TestIs,St} = make_succeeded(Dst, {guard, Vf}, St1), Set = #b_set{op=bs_match,dst=Dst, args=[#b_literal{val=string},Ctx,#b_literal{val=Bin}]}, {[Set|TestIs],St}. @@ -412,21 +470,14 @@ build_bs_instr(Anno, Type, Fail, Ctx, Size, Unit0, Flags0, Dst, St0) -> #b_set{anno=Anno,op=bs_match,dst=Dst, args=[TypeArg,Ctx,Flags]} end, - {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St0), + {Is,St} = make_succeeded(Dst, {guard, Fail}, St0), {[Get|Is],St}. select_val(#k_val_clause{val=#k_tuple{es=Es},body=B}, V, Vf, St0) -> - #k{us=Used} = k_get_anno(B), - {Eis,St1} = select_extract_tuple(V, Es, Used, St0), + {Eis,St1} = select_extract_tuple(V, Es, St0), {Bis,St2} = match_cg(B, Vf, St1), {length(Es),Eis ++ Bis,St2}; -select_val(#k_val_clause{val=Val0,body=B}, _V, Vf, St0) -> - Val = case Val0 of - #k_atom{val=Lit} -> Lit; - #k_float{val=Lit} -> Lit; - #k_int{val=Lit} -> Lit; - #k_literal{val=Lit} -> Lit - end, +select_val(#k_val_clause{val=#k_literal{val=Val},body=B}, _V, Vf, St0) -> {Bis,St1} = match_cg(B, Vf, St0), {Val,Bis,St1}. @@ -438,17 +489,18 @@ select_val(#k_val_clause{val=Val0,body=B}, _V, Vf, St0) -> %% It is probably worthwhile because it is common to extract only a %% few elements from a huge record. -select_extract_tuple(Src, Vs, Used, St0) -> +select_extract_tuple(Src, Vs, St0) -> Tuple = ssa_arg(Src, St0), - F = fun (#k_var{name=V}, {Elem,S0}) -> - case member(V, Used) of + F = fun (#k_var{anno=Anno,name=V}, {Elem,S0}) -> + case member(unused, Anno) of true -> + {[],{Elem+1,S0}}; + false -> Args = [Tuple,#b_literal{val=Elem}], {Dst,S} = new_ssa_var(V, S0), - Get = #b_set{op=get_tuple_element,dst=Dst,args=Args}, - {[Get],{Elem+1,S}}; - false -> - {[],{Elem+1,S0}} + Get = #b_set{op=get_tuple_element, + dst=Dst,args=Args}, + {[Get],{Elem+1,S}} end end, {Es,{_,St}} = flatmapfoldl(F, {0,St0}, Vs), @@ -475,7 +527,7 @@ select_extract_map([P|Ps], Src, Fail, St0) -> Key = ssa_arg(Key0, St0), {Dst,St1} = new_ssa_var(Dst0, St0), Set = #b_set{op=get_map_element,dst=Dst,args=[MapSrc,Key]}, - {TestIs,St2} = make_cond_branch(succeeded, [Dst], Fail, St1), + {TestIs,St2} = make_succeeded(Dst, {guard, Fail}, St1), {Is,St} = select_extract_map(Ps, Src, Fail, St2), {[Set|TestIs]++Is,St}; select_extract_map([], _, _, St) -> @@ -501,11 +553,20 @@ guard_clause_cg(#k_guard_clause{guard=G,body=B}, Fail, St0) -> %% the correct exit point. Primops and tests all go to the next %% instruction on success or jump to a failure label. -guard_cg(#k_protected{arg=Ts,ret=Rs,inner=Inner}, Fail, St) -> - protected_cg(Ts, Rs, Inner, Fail, St); -guard_cg(#k_test{op=Test0,args=As,inverted=Inverted}, Fail, St0) -> - #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Test}} = Test0, - test_cg(Test, Inverted, As, Fail, St0); +guard_cg(#k_try{arg=Ts,vars=[],body=#k_break{args=[]}, + evars=[],handler=#k_break{args=[]}}, + Fail, + #cg{bfail=OldBfail,break=OldBreak}=St0) -> + %% Do a try/catch without return value for effect. The return + %% value is not checked; success passes on to the next instruction + %% and failure jumps to Fail. + {Next,St1} = new_label(St0), + {Tis,St2} = guard_cg(Ts, Fail, St1#cg{bfail=Fail,break=Next}), + Is = Tis ++ [{label,Next},#cg_phi{vars=[]}], + {Is,St2#cg{bfail=OldBfail,break=OldBreak}}; +guard_cg(#k_test{op=Test0,args=As}, Fail, St0) -> + #k_remote{mod=#k_literal{val=erlang},name=#k_literal{val=Test}} = Test0, + test_cg(Test, false, As, Fail, St0); guard_cg(#k_seq{arg=Arg,body=Body}, Fail, St0) -> {ArgIs,St1} = guard_cg(Arg, Fail, St0), {BodyIs,St} = guard_cg(Body, Fail, St1), @@ -522,7 +583,8 @@ test_cg(Test, Inverted, As0, Fail, St0) -> case {Test,ssa_args(As0, St0)} of {is_record,[Tuple,#b_literal{val=Atom}=Tag,#b_literal{val=Int}=Arity]} when is_atom(Atom), is_integer(Int) -> - test_is_record_cg(Inverted, Fail, Tuple, Tag, Arity, St0); + false = Inverted, %Assertion. + test_is_record_cg(Fail, Tuple, Tag, Arity, St0); {_,As} -> {Bool,St1} = new_ssa_var('@ssa_bool', St0), {Succ,St} = new_label(St1), @@ -534,7 +596,7 @@ test_cg(Test, Inverted, As0, Fail, St0) -> {[Bif,Br,{label,Succ}],St} end. -test_is_record_cg(false, Fail, Tuple, TagVal, ArityVal, St0) -> +test_is_record_cg(Fail, Tuple, TagVal, ArityVal, St0) -> {Arity,St1} = new_ssa_var('@ssa_arity', St0), {Tag,St2} = new_ssa_var('@ssa_tag', St1), {Is0,St3} = make_cond_branch({bif,is_tuple}, [Tuple], Fail, St2), @@ -544,44 +606,8 @@ test_is_record_cg(false, Fail, Tuple, TagVal, ArityVal, St0) -> args=[Tuple,#b_literal{val=0}]}, {Is2,St} = make_cond_branch({bif,'=:='}, [Tag,TagVal], Fail, St4), Is = Is0 ++ [GetArity] ++ Is1 ++ [GetTag] ++ Is2, - {Is,St}; -test_is_record_cg(true, Fail, Tuple, TagVal, ArityVal, St0) -> - {Succ,St1} = new_label(St0), - {Arity,St2} = new_ssa_var('@ssa_arity', St1), - {Tag,St3} = new_ssa_var('@ssa_tag', St2), - {Is0,St4} = make_cond_branch({bif,is_tuple}, [Tuple], Succ, St3), - GetArity = #b_set{op={bif,tuple_size},dst=Arity,args=[Tuple]}, - {Is1,St5} = make_cond_branch({bif,'=:='}, [Arity,ArityVal], Succ, St4), - GetTag = #b_set{op=get_tuple_element,dst=Tag, - args=[Tuple,#b_literal{val=0}]}, - {Is2,St} = make_cond_branch({bif,'=:='}, [Tag,TagVal], Succ, St5), - Is3 = [make_uncond_branch(Fail),{label,Succ}], - Is = Is0 ++ [GetArity] ++ Is1 ++ [GetTag] ++ Is2 ++ Is3, {Is,St}. -%% protected_cg([Kexpr], [Ret], Fail, St) -> {[Ainstr],St}. -%% Do a protected. Protecteds without return values are just done -%% for effect, the return value is not checked, success passes on to -%% the next instruction and failure jumps to Fail. If there are -%% return values then these must be set to 'false' on failure, -%% control always passes to the next instruction. - -protected_cg(Ts, [], _, Fail, St0) -> - %% Protect these calls, revert when done. - {Tis,St1} = guard_cg(Ts, Fail, St0#cg{bfail=Fail}), - {Tis,St1#cg{bfail=St0#cg.bfail}}; -protected_cg(Ts, Rs, Inner0, _Fail, St0) -> - {Pfail,St1} = new_label(St0), - {Br,St2} = new_label(St1), - Prot = duplicate(length(Rs), #b_literal{val=false}), - {Tis,St3} = guard_cg(Ts, Pfail, St2#cg{break=Pfail,bfail=Pfail}), - Inner = ssa_args(Inner0, St3), - {BreakVars,St} = new_ssa_vars(Rs, St3), - Is = Tis ++ [#cg_break{args=Inner,phi=Br}, - {label,Pfail},#cg_break{args=Prot,phi=Br}, - {label,Br},#cg_phi{vars=BreakVars}], - {Is,St#cg{break=St0#cg.break,bfail=St0#cg.bfail}}. - %% match_fmf(Fun, LastFail, State, [Clause]) -> {Is,State}. %% This is a special flatmapfoldl for match code gen where we %% generate a "failure" label for each clause. The last clause uses @@ -596,7 +622,7 @@ match_fmf(F, LastFail, St0, [H|T]) -> {Rs,St3} = match_fmf(F, LastFail, St2, T), {R ++ [{label,Fail}] ++ Rs,St3}. -%% fail_label(State) -> {Where,FailureLabel}. +%% fail_context(State) -> {Where,FailureLabel}. %% Where = guard | no_catch | in_catch %% Return an indication of which part of a function code is %% being generated for and the appropriate failure label to @@ -609,7 +635,7 @@ match_fmf(F, LastFail, St0, [H|T]) -> %% a try/catch or catch. %% in_catch - In the scope of a try/catch or catch. -fail_label(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) -> +fail_context(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) -> if Fail =/= Ult -> {guard,Fail}; @@ -619,14 +645,6 @@ fail_label(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) -> {in_catch,Catch} end. -%% bif_fail_label(State) -> FailureLabel. -%% Return the appropriate failure label for a guard BIF call or -%% primop that fails. - -bif_fail_label(St) -> - {_,Fail} = fail_label(St), - Fail. - %% call_cg(Func, [Arg], [Ret], Le, State) -> %% {[Ainstr],State}. %% enter_cg(Func, [Arg], Le, St) -> {[Ainstr],St}. @@ -634,96 +652,58 @@ bif_fail_label(St) -> call_cg(Func, As, [], Le, St) -> call_cg(Func, As, [#k_var{name='@ssa_ignored'}], Le, St); -call_cg(Func0, As, [#k_var{name=R}|MoreRs]=Rs, Le, St0) -> - case fail_label(St0) of +call_cg(Func, As, [#k_var{name=R}|MoreRs]=Rs, Le, St0) -> + case fail_context(St0) of {guard,Fail} -> %% Inside a guard. The only allowed function call is to %% erlang:error/1,2. We will generate a branch to the %% failure branch. - #k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=error}} = Func0, %Assertion. + #k_remote{mod=#k_literal{val=erlang}, + name=#k_literal{val=error}} = Func, %Assertion. [#k_var{name=DestVar}] = Rs, St = set_ssa_var(DestVar, #b_literal{val=unused}, St0), {[make_uncond_branch(Fail),#cg_unreachable{}],St}; - {Catch,Fail} -> + FailCtx -> %% Ordinary function call in a function body. - Args = ssa_args(As, St0), + Args = ssa_args([Func|As], St0), {Ret,St1} = new_ssa_var(R, St0), - Func = call_target(Func0, Args, St0), - Call = #b_set{anno=line_anno(Le),op=call,dst=Ret,args=[Func|Args]}, + Call = #b_set{anno=line_anno(Le),op=call,dst=Ret,args=Args}, %% If this is a call to erlang:error(), MoreRs could be a %% nonempty list of variables that each need a value. St2 = foldl(fun(#k_var{name=Dummy}, S) -> set_ssa_var(Dummy, #b_literal{val=unused}, S) end, St1, MoreRs), - case Catch of - no_catch -> - {[Call],St2}; - in_catch -> - {TestIs,St} = make_cond_branch(succeeded, [Ret], Fail, St2), - {[Call|TestIs],St} - end + + {TestIs,St} = make_succeeded(Ret, FailCtx, St2), + {[Call|TestIs],St} end. -enter_cg(Func0, As0, Le, St0) -> - Anno = line_anno(Le), - Func = call_target(Func0, As0, St0), - As = ssa_args(As0, St0), +enter_cg(Func, As0, Le, St0) -> + %% Adding a trampoline here would give us greater freedom in rewriting + %% calls, but doing so makes it difficult to tell tail calls apart from + %% body calls during code generation. + %% + %% We therefore skip the trampoline, reasoning that we've already left the + %% current function by the time an exception is thrown. + As = ssa_args([Func|As0], St0), {Ret,St} = new_ssa_var('@ssa_ret', St0), - Call = #b_set{anno=Anno,op=call,dst=Ret,args=[Func|As]}, + Call = #b_set{anno=line_anno(Le),op=call,dst=Ret,args=As}, {[Call,#b_ret{arg=Ret}],St}. -call_target(Func, As, St) -> - Arity = length(As), - case Func of - #k_remote{mod=Mod0,name=Name0} -> - Mod = ssa_arg(Mod0, St), - Name = ssa_arg(Name0, St), - #b_remote{mod=Mod,name=Name,arity=Arity}; - #k_local{name=Name} when is_atom(Name) -> - #b_local{name=#b_literal{val=Name},arity=Arity}; - #k_var{}=Var -> - ssa_arg(Var, St) - end. - %% bif_cg(#k_bif{}, Le,State) -> {[Ainstr],State}. %% Generate code for a guard BIF or primop. -bif_cg(#k_bif{op=#k_internal{name=Name},args=As,ret=Rs}, Le, St) -> - internal_cg(Name, As, Rs, Le, St); -bif_cg(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, +bif_cg(#k_bif{op=#k_internal{name=Name},args=As,ret=Rs}, _Le, St) -> + internal_cg(Name, As, Rs, St); +bif_cg(#k_bif{op=#k_remote{mod=#k_literal{val=erlang},name=#k_literal{val=Name}}, args=As,ret=Rs}, Le, St) -> bif_cg(Name, As, Rs, Le, St). %% internal_cg(Bif, [Arg], [Ret], Le, State) -> %% {[Ainstr],State}. -internal_cg(make_fun, [Name0,Arity0|As], Rs, _Le, St0) -> - #k_atom{val=Name} = Name0, - #k_int{val=Arity} = Arity0, - case Rs of - [#k_var{name=Dst0}] -> - {Dst,St} = new_ssa_var(Dst0, St0), - Args = ssa_args(As, St), - Local = #b_local{name=#b_literal{val=Name},arity=Arity}, - MakeFun = #b_set{op=make_fun,dst=Dst,args=[Local|Args]}, - {[MakeFun],St}; - [] -> - {[],St0} - end; -internal_cg(bs_init_writable=I, As, [#k_var{name=Dst0}], _Le, St0) -> - %% This behaves like a function call. - {Dst,St} = new_ssa_var(Dst0, St0), - Args = ssa_args(As, St), - Set = #b_set{op=I,dst=Dst,args=Args}, - {[Set],St}; -internal_cg(build_stacktrace=I, As, [#k_var{name=Dst0}], _Le, St0) -> - {Dst,St} = new_ssa_var(Dst0, St0), - Args = ssa_args(As, St), - Set = #b_set{op=I,dst=Dst,args=Args}, - {[Set],St}; -internal_cg(raise, As, [#k_var{name=Dst0}], _Le, St0) -> +internal_cg(raise, As, [#k_var{name=Dst0}], St0) -> Args = ssa_args(As, St0), {Dst,St} = new_ssa_var(Dst0, St0), Resume = #b_set{op=resume,dst=Dst,args=Args}, @@ -734,11 +714,41 @@ internal_cg(raise, As, [#k_var{name=Dst0}], _Le, St0) -> Is = [Resume,make_uncond_branch(Catch),#cg_unreachable{}], {Is,St} end; -internal_cg(raw_raise=I, As, [#k_var{name=Dst0}], _Le, St0) -> +internal_cg(recv_peek_message, [], [#k_var{name=Succeeded0}, + #k_var{name=Dst0}], St0) -> + {Dst,St1} = new_ssa_var(Dst0, St0), + St = new_succeeded_value(Succeeded0, Dst, St1), + Set = #b_set{op=peek_message,dst=Dst,args=[]}, + {[Set],St}; +internal_cg(recv_wait_timeout, As, [#k_var{name=Succeeded0}], St0) -> + case ssa_args(As, St0) of + [#b_literal{val=0}] -> + %% If beam_ssa_opt is run (which is default), the + %% `wait_timeout` instruction will be removed if the + %% operand is a literal 0. However, if optimizations have + %% been turned off, we must not not generate a + %% `wait_timeout` instruction with a literal 0 timeout, + %% because the BEAM instruction will not handle it + %% correctly. + St = new_succeeded_value(Succeeded0, #b_literal{val=true}, St0), + {[],St}; + Args -> + {Wait,St1} = new_ssa_var('@ssa_wait', St0), + St = new_succeeded_value(Succeeded0, Wait, St1), + Set = #b_set{op=wait_timeout,dst=Wait,args=Args}, + {[Set],St} + end; +internal_cg(Op, As, [#k_var{name=Dst0}], St0) when is_atom(Op) -> %% This behaves like a function call. {Dst,St} = new_ssa_var(Dst0, St0), Args = ssa_args(As, St), - Set = #b_set{op=I,dst=Dst,args=Args}, + Set = #b_set{op=Op,dst=Dst,args=Args}, + {[Set],St}; +internal_cg(Op, As, [], St0) when is_atom(Op) -> + %% This behaves like a function call. + {Dst,St} = new_ssa_var('@ssa_ignored', St0), + Args = ssa_args(As, St), + Set = #b_set{op=Op,dst=Dst,args=Args}, {[Set],St}. bif_cg(Bif, As0, [#k_var{name=Dst0}], Le, St0) -> @@ -752,8 +762,8 @@ bif_cg(Bif, As0, [#k_var{name=Dst0}], Le, St0) -> I = #b_set{anno=line_anno(Le),op={bif,Bif},dst=Dst,args=As}, case erl_bifs:is_safe(erlang, Bif, length(As)) of false -> - Fail = bif_fail_label(St1), - {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + FailCtx = fail_context(St1), + {Is,St} = make_succeeded(Dst, FailCtx, St1), {[I|Is],St}; true-> {[I],St1} @@ -779,50 +789,6 @@ bif_is_record_cg(Dst, Tuple, TagVal, ArityVal, St0) -> Is = Is0 ++ [GetArity] ++ Is1 ++ [GetTag] ++ Is2 ++ Is3, {Is,St}. -%% recv_loop_cg(TimeOut, ReceiveVar, ReceiveMatch, TimeOutExprs, -%% [Ret], Le, St) -> {[Ainstr],St}. - -recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, St0) -> - %% Get labels. - {Rl,St1} = new_label(St0), - {Tl,St2} = new_label(St1), - {Bl,St3} = new_label(St2), - St4 = St3#cg{break=Bl,recv=Rl}, - {Ris,St5} = cg_recv_mesg(Rvar, Rm, Tl, Le, St4), - {Wis,St6} = cg_recv_wait(Te, Tes, St5), - {BreakVars,St} = new_ssa_vars(Rs, St6), - {Ris ++ [{label,Tl}] ++ Wis ++ - [{label,Bl},#cg_phi{vars=BreakVars}], - St#cg{break=St0#cg.break,recv=St0#cg.recv}}. - -%% cg_recv_mesg( ) -> {[Ainstr],St}. - -cg_recv_mesg(#k_var{name=R}, Rm, Tl, Le, St0) -> - {Dst,St1} = new_ssa_var(R, St0), - {Mis,St2} = match_cg(Rm, none, St1), - RecvLbl = St1#cg.recv, - {TestIs,St} = make_cond_branch(succeeded, [Dst], Tl, St2), - Is = [#b_br{anno=line_anno(Le),bool=#b_literal{val=true}, - succ=RecvLbl,fail=RecvLbl}, - {label,RecvLbl}, - #b_set{op=peek_message,dst=Dst}|TestIs], - {Is++Mis,St}. - -%% cg_recv_wait(Te, Tes, St) -> {[Ainstr],St}. - -cg_recv_wait(#k_int{val=0}, Es, St0) -> - {Tis,St} = cg(Es, St0), - {[#b_set{op=timeout}|Tis],St}; -cg_recv_wait(Te, Es, St0) -> - {Tis,St1} = cg(Es, St0), - Args = [ssa_arg(Te, St1)], - {WaitDst,St2} = new_ssa_var('@ssa_wait', St1), - {WaitIs,St} = make_cond_branch(succeeded, [WaitDst], St1#cg.recv, St2), - %% Infinite timeout will be optimized later. - Is = [#b_set{op=wait_timeout,dst=WaitDst,args=Args}] ++ WaitIs ++ - [#b_set{op=timeout}] ++ Tis, - {Is,St}. - %% try_cg(TryBlock, [BodyVar], TryBody, [ExcpVar], TryHandler, [Ret], St) -> %% {[Ainstr],St}. @@ -835,24 +801,106 @@ try_cg(Ta, Vs, Tb, Evs, Th, Rs, St0) -> {SsaVs,St6} = new_ssa_vars(Vs, St5), {SsaEvs,St7} = new_ssa_vars(Evs, St6), {Ais,St8} = cg(Ta, St7#cg{break=B,catch_label=H}), - St9 = St8#cg{break=E,catch_label=St7#cg.catch_label}, - {Bis,St10} = cg(Tb, St9), - {His,St11} = cg(Th, St10), - {BreakVars,St12} = new_ssa_vars(Rs, St11), - {CatchedAgg,St} = new_ssa_var('@ssa_agg', St12), - ExtractVs = extract_vars(SsaEvs, CatchedAgg, 0), - KillTryTag = #b_set{op=kill_try_tag,args=[TryTag]}, - Args = [#b_literal{val='try'},TryTag], - Handler = [{label,H}, - #b_set{op=landingpad,dst=CatchedAgg,args=Args}] ++ - ExtractVs ++ [KillTryTag], - {[#b_set{op=new_try_tag,dst=TryTag,args=[#b_literal{val='try'}]}, - #b_br{bool=TryTag,succ=Next,fail=H}, - {label,Next}] ++ Ais ++ - [{label,B},#cg_phi{vars=SsaVs},KillTryTag] ++ Bis ++ - Handler ++ His ++ - [{label,E},#cg_phi{vars=BreakVars}], - St#cg{break=St0#cg.break}}. + + %% We try to avoid constructing a try/catch if the expression to + %% be evaluated don't have any side effects and if the error + %% reason is not explicitly matched. + %% + %% Starting in OTP 23, segment sizes in binary matching and keys + %% in map matching are allowed to be arbitrary guard + %% expressions. Those expressions are evaluated in a try/catch + %% so that matching can continue with the next clause if the evaluation + %% of such expression fails. + %% + %% It is not allowed to use try/catch during matching in a receive + %% (the try/catch would force the saving of fragile message references + %% to the stack frame). Therefore, avoiding creating try/catch is + %% not merely an optimization but necessary for correctness. + + case {Vs,Tb,Th,is_guard_cg_safe_list(Ais)} of + {[#k_var{name=X}],#k_break{args=[#k_var{name=X}]}, + #k_break{args=[#k_literal{}]},true} -> + %% There are no instructions that will clobber X registers + %% and the exception is not matched. Therefore, a + %% try/catch is not needed. This code is probably located + %% in a guard. + {ProtIs,St9} = guard_cg(Ta, H, St7#cg{break=B,bfail=H}), + {His,St10} = cg(Th, St9), + {RetVars,St} = new_ssa_vars(Rs, St10), + Is = ProtIs ++ [{label,H}] ++ His ++ + [{label,B},#cg_phi{vars=RetVars}], + {Is,St#cg{break=St0#cg.break,bfail=St7#cg.bfail}}; + {[#k_var{name=X}],#k_break{args=[#k_literal{}=SuccLit0,#k_var{name=X}]}, + #k_break{args=[#k_literal{val=false},#k_literal{}]},true} -> + %% There are no instructions that will clobber X registers + %% and the exception is not matched. Therefore, a + %% try/catch is not needed. This code probably evaluates + %% a key expression in map matching. + {FinalLabel,St9} = new_label(St7), + {ProtIs,St10} = guard_cg(Ta, H, St9#cg{break=B,bfail=H}), + {His,St11} = cg(Th, St10#cg{break=FinalLabel}), + {RetVars,St12} = new_ssa_vars(Rs, St11), + {Result,St} = new_ssa_var('@ssa_result', St12), + SuccLit = ssa_arg(SuccLit0, St), + Is = ProtIs ++ [{label,H}] ++ His ++ + [{label,B}, + #cg_phi{vars=[Result]}, + #cg_break{args=[SuccLit,Result],phi=FinalLabel}, + {label,FinalLabel}, + #cg_phi{vars=RetVars}], + {Is,St#cg{break=St0#cg.break,bfail=St7#cg.bfail}}; + {_,#k_break{args=[]},#k_break{args=[]},true} -> + %% There are no instructions that will clobber X registers + %% and the exception is not matched. Therefore, a + %% try/catch is not needed. This code probably does the + %% size calculation for a segment in binary matching. + {ProtIs,St9} = guard_cg(Ta, H, St7#cg{break=B,bfail=H}), + {His,St10} = cg(Th, St9), + {RetVars,St} = new_ssa_vars(Rs, St10), + Is = ProtIs ++ [{label,H}] ++ His ++ + [{label,B},#cg_phi{vars=RetVars}], + {Is,St#cg{break=St0#cg.break,bfail=St7#cg.bfail}}; + {_,_,_,_} -> + %% The general try/catch (not in a guard). + St9 = St8#cg{break=E,catch_label=St7#cg.catch_label}, + {Bis,St10} = cg(Tb, St9), + {His,St11} = cg(Th, St10), + {BreakVars,St12} = new_ssa_vars(Rs, St11), + {CatchedAgg,St13} = new_ssa_var('@ssa_agg', St12), + ExtractVs = extract_vars(SsaEvs, CatchedAgg, 0), + KillTryTag = #b_set{op=kill_try_tag,args=[TryTag]}, + Args = [#b_literal{val='try'},TryTag], + Handler = [{label,H}, + #b_set{op=landingpad,dst=CatchedAgg,args=Args}] ++ + ExtractVs ++ [KillTryTag], + {[#b_set{op=new_try_tag,dst=TryTag,args=[#b_literal{val='try'}]}, + #b_br{bool=TryTag,succ=Next,fail=H}, + {label,Next}] ++ Ais ++ + [{label,B},#cg_phi{vars=SsaVs},KillTryTag] ++ Bis ++ + Handler ++ His ++ + [{label,E},#cg_phi{vars=BreakVars}], + St13#cg{break=St0#cg.break}} + end. + +is_guard_cg_safe_list(Is) -> + all(fun is_guard_cg_safe/1, Is). + +is_guard_cg_safe(#b_set{op=call,args=Args}) -> + case Args of + [#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}, + arity=1}|_] -> + true; + _ -> + false + end; +is_guard_cg_safe(#b_set{}=I) -> not beam_ssa:clobbers_xregs(I); +is_guard_cg_safe(#b_br{}) -> true; +is_guard_cg_safe(#b_switch{}) -> true; +is_guard_cg_safe(#cg_break{}) -> true; +is_guard_cg_safe(#cg_phi{}) -> true; +is_guard_cg_safe({label,_}) -> true; +is_guard_cg_safe(#cg_unreachable{}) -> false. try_enter_cg(Ta, Vs, Tb, Evs, Th, St0) -> {B,St1} = new_label(St0), %Body label @@ -928,9 +976,9 @@ put_cg([#k_var{name=R}], #k_tuple{es=Es}, _Le, St0) -> PutTuple = #b_set{op=put_tuple,dst=Ret,args=Args}, {[PutTuple],St}; put_cg([#k_var{name=R}], #k_binary{segs=Segs}, Le, St0) -> - Fail = bif_fail_label(St0), + FailCtx = fail_context(St0), {Dst,St1} = new_ssa_var(R, St0), - cg_binary(Dst, Segs, Fail, Le, St1); + cg_binary(Dst, Segs, FailCtx, Le, St1); put_cg([#k_var{name=R}], #k_map{op=Op,var=Map, es=[#k_map_pair{key=#k_var{}=K,val=V}]}, Le, St0) -> @@ -959,14 +1007,14 @@ put_cg([#k_var{name=R}], Con0, _Le, St0) -> {[],St}. put_cg_map(LineAnno, Op, SrcMap, Dst, List, St0) -> - Fail = bif_fail_label(St0), Args = [#b_literal{val=Op},SrcMap|List], PutMap = #b_set{anno=LineAnno,op=put_map,dst=Dst,args=Args}, if Op =:= assoc -> {[PutMap],St0}; true -> - {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St0), + FailCtx = fail_context(St0), + {Is,St} = make_succeeded(Dst, FailCtx, St0), {[PutMap|Is],St} end. @@ -974,18 +1022,18 @@ put_cg_map(LineAnno, Op, SrcMap, Dst, List, St0) -> %%% Code generation for constructing binaries. %%% -cg_binary(Dst, Segs0, Fail, Le, St0) -> - {PutCode0,SzCalc0,St1} = cg_bin_put(Segs0, Fail, St0), +cg_binary(Dst, Segs0, FailCtx, Le, St0) -> + {PutCode0,SzCalc0,St1} = cg_bin_put(Segs0, FailCtx, St0), LineAnno = line_anno(Le), - Anno = Le#k.a, + Anno = Le, case PutCode0 of [#b_set{op=bs_put,dst=Bool,args=[_,_,Src,#b_literal{val=all}|_]}, #b_br{bool=Bool}, {label,_}|_] -> #k_bin_seg{unit=Unit0,next=Segs} = Segs0, Unit = #b_literal{val=Unit0}, - {PutCode,SzCalc1,St2} = cg_bin_put(Segs, Fail, St1), - {_,SzVar,SzCode0,St3} = cg_size_calc(1, SzCalc1, Fail, St2), + {PutCode,SzCalc1,St2} = cg_bin_put(Segs, FailCtx, St1), + {_,SzVar,SzCode0,St3} = cg_size_calc(1, SzCalc1, FailCtx, St2), SzCode = cg_bin_anno(SzCode0, LineAnno), Args = case member(single_use, Anno) of true -> @@ -994,14 +1042,14 @@ cg_binary(Dst, Segs0, Fail, Le, St0) -> [#b_literal{val=append},Src,SzVar,Unit] end, BsInit = #b_set{anno=LineAnno,op=bs_init,dst=Dst,args=Args}, - {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St3), + {TestIs,St} = make_succeeded(Dst, FailCtx, St3), {SzCode ++ [BsInit] ++ TestIs ++ PutCode,St}; [#b_set{op=bs_put}|_] -> - {Unit,SzVar,SzCode0,St2} = cg_size_calc(8, SzCalc0, Fail, St1), + {Unit,SzVar,SzCode0,St2} = cg_size_calc(8, SzCalc0, FailCtx, St1), SzCode = cg_bin_anno(SzCode0, LineAnno), Args = [#b_literal{val=new},SzVar,Unit], BsInit = #b_set{anno=LineAnno,op=bs_init,dst=Dst,args=Args}, - {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St2), + {TestIs,St} = make_succeeded(Dst, FailCtx, St2), {SzCode ++ [BsInit] ++ TestIs ++ PutCode0,St} end. @@ -1009,18 +1057,18 @@ cg_bin_anno([Set|Sets], Anno) -> [Set#b_set{anno=Anno}|Sets]; cg_bin_anno([], _) -> []. -%% cg_size_calc(PreferredUnit, SzCalc, Fail, St0) -> +%% cg_size_calc(PreferredUnit, SzCalc, FailCtx, St0) -> %% {ActualUnit,SizeVariable,SizeCode,St}. %% Generate size calculation code. -cg_size_calc(Unit, error, _Fail, St) -> +cg_size_calc(Unit, error, _FailCtx, St) -> {#b_literal{val=Unit},#b_literal{val=badarg},[],St}; -cg_size_calc(8, [{1,_}|_]=SzCalc, Fail, St) -> - cg_size_calc(1, SzCalc, Fail, St); -cg_size_calc(8, SzCalc, Fail, St0) -> - {Var,Pre,St} = cg_size_calc_1(SzCalc, Fail, St0), +cg_size_calc(8, [{1,_}|_]=SzCalc, FailCtx, St) -> + cg_size_calc(1, SzCalc, FailCtx, St); +cg_size_calc(8, SzCalc, FailCtx, St0) -> + {Var,Pre,St} = cg_size_calc_1(SzCalc, FailCtx, St0), {#b_literal{val=8},Var,Pre,St}; -cg_size_calc(1, SzCalc0, Fail, St0) -> +cg_size_calc(1, SzCalc0, FailCtx, St0) -> SzCalc = map(fun({8,#b_literal{val=Size}}) -> {1,#b_literal{val=8*Size}}; ({8,{{bif,byte_size},Src}}) -> @@ -1030,54 +1078,54 @@ cg_size_calc(1, SzCalc0, Fail, St0) -> ({_,_}=Pair) -> Pair end, SzCalc0), - {Var,Pre,St} = cg_size_calc_1(SzCalc, Fail, St0), + {Var,Pre,St} = cg_size_calc_1(SzCalc, FailCtx, St0), {#b_literal{val=1},Var,Pre,St}. -cg_size_calc_1(SzCalc, Fail, St0) -> - cg_size_calc_2(SzCalc, #b_literal{val=0}, Fail, St0). +cg_size_calc_1(SzCalc, FailCtx, St0) -> + cg_size_calc_2(SzCalc, #b_literal{val=0}, FailCtx, St0). -cg_size_calc_2([{_,{'*',Unit,{_,_}=Bif}}|T], Sum0, Fail, St0) -> - {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), - {BifDst,Pre1,St2} = cg_size_bif(Bif, Fail, St1), - {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, Unit, Fail, St2), +cg_size_calc_2([{_,{'*',Unit,{_,_}=Bif}}|T], Sum0, FailCtx, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0), + {BifDst,Pre1,St2} = cg_size_bif(Bif, FailCtx, St1), + {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, Unit, FailCtx, St2), {Sum,Pre0++Pre1++Pre2,St}; -cg_size_calc_2([{_,#b_literal{}=Sz}|T], Sum0, Fail, St0) -> - {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), - {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, Fail, St1), +cg_size_calc_2([{_,#b_literal{}=Sz}|T], Sum0, FailCtx, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0), + {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, FailCtx, St1), {Sum,Pre0++Pre,St}; -cg_size_calc_2([{_,#b_var{}=Sz}|T], Sum0, Fail, St0) -> - {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), - {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, Fail, St1), +cg_size_calc_2([{_,#b_var{}=Sz}|T], Sum0, FailCtx, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0), + {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, FailCtx, St1), {Sum,Pre0++Pre,St}; -cg_size_calc_2([{_,{_,_}=Bif}|T], Sum0, Fail, St0) -> - {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), - {BifDst,Pre1,St2} = cg_size_bif(Bif, Fail, St1), - {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, #b_literal{val=1}, Fail, St2), +cg_size_calc_2([{_,{_,_}=Bif}|T], Sum0, FailCtx, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0), + {BifDst,Pre1,St2} = cg_size_bif(Bif, FailCtx, St1), + {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, #b_literal{val=1}, FailCtx, St2), {Sum,Pre0++Pre1++Pre2,St}; -cg_size_calc_2([], Sum, _Fail, St) -> +cg_size_calc_2([], Sum, _FailCtx, St) -> {Sum,[],St}. -cg_size_bif(#b_var{}=Var, _Fail, St) -> +cg_size_bif(#b_var{}=Var, _FailCtx, St) -> {Var,[],St}; -cg_size_bif({Name,Src}, Fail, St0) -> +cg_size_bif({Name,Src}, FailCtx, St0) -> {Dst,St1} = new_ssa_var('@ssa_bif', St0), Bif = #b_set{op=Name,dst=Dst,args=[Src]}, - {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + {TestIs,St} = make_succeeded(Dst, FailCtx, St1), {Dst,[Bif|TestIs],St}. -cg_size_add(#b_literal{val=0}, Val, #b_literal{val=1}, _Fail, St) -> +cg_size_add(#b_literal{val=0}, Val, #b_literal{val=1}, _FailCtx, St) -> {Val,[],St}; -cg_size_add(A, B, Unit, Fail, St0) -> +cg_size_add(A, B, Unit, FailCtx, St0) -> {Dst,St1} = new_ssa_var('@ssa_sum', St0), - {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + {TestIs,St} = make_succeeded(Dst, FailCtx, St1), BsAdd = #b_set{op=bs_add,dst=Dst,args=[A,B,Unit]}, {Dst,[BsAdd|TestIs],St}. -cg_bin_put(Seg, Fail, St) -> - cg_bin_put_1(Seg, Fail, [], [], St). +cg_bin_put(Seg, FailCtx, St) -> + cg_bin_put_1(Seg, FailCtx, [], [], St). cg_bin_put_1(#k_bin_seg{size=Size0,unit=U,type=T,flags=Fs,seg=Src0,next=Next}, - Fail, Acc, SzCalcAcc, St0) -> + FailCtx, Acc, SzCalcAcc, St0) -> [Src,Size] = ssa_args([Src0,Size0], St0), NeedSize = bs_need_size(T), TypeArg = #b_literal{val=T}, @@ -1087,9 +1135,12 @@ cg_bin_put_1(#k_bin_seg{size=Size0,unit=U,type=T,flags=Fs,seg=Src0,next=Next}, true -> [TypeArg,Flags,Src,Size,Unit]; false -> [TypeArg,Flags,Src] end, - {Is,St} = make_cond_branch(bs_put, Args, Fail, St0), + %% bs_put has its own 'succeeded' logic, and should always jump directly to + %% the fail label regardless of whether it's in a catch or not. + {_, FailLbl} = FailCtx, + {Is,St} = make_cond_branch(bs_put, Args, FailLbl, St0), SzCalc = bin_size_calc(T, Src, Size, U), - cg_bin_put_1(Next, Fail, reverse(Is, Acc), [SzCalc|SzCalcAcc], St); + cg_bin_put_1(Next, FailCtx, reverse(Is, Acc), [SzCalc|SzCalcAcc], St); cg_bin_put_1(#k_bin_end{}, _, Acc, SzCalcAcc, St) -> SzCalc = fold_size_calc(SzCalcAcc, 0, []), {reverse(Acc),SzCalc,St}. @@ -1139,12 +1190,18 @@ fold_size_calc([], Bits, Acc) -> ssa_args(As, St) -> [ssa_arg(A, St) || A <- As]. -ssa_arg(#k_var{name=V}, #cg{vars=Vars}) -> maps:get(V, Vars); +ssa_arg(#k_var{name=V}, #cg{vars=Vars}) -> map_get(V, Vars); ssa_arg(#k_literal{val=V}, _) -> #b_literal{val=V}; -ssa_arg(#k_atom{val=V}, _) -> #b_literal{val=V}; -ssa_arg(#k_float{val=V}, _) -> #b_literal{val=V}; -ssa_arg(#k_int{val=V}, _) -> #b_literal{val=V}; -ssa_arg(#k_nil{}, _) -> #b_literal{val=[]}. +ssa_arg(#k_remote{mod=Mod0,name=Name0,arity=Arity}, St) -> + Mod = ssa_arg(Mod0, St), + Name = ssa_arg(Name0, St), + #b_remote{mod=Mod,name=Name,arity=Arity}; +ssa_arg(#k_local{name=Name,arity=Arity}, _) when is_atom(Name) -> + #b_local{name=#b_literal{val=Name},arity=Arity}. + +new_succeeded_value(VarBase, Var, #cg{vars=Vars0}=St) -> + Vars = Vars0#{VarBase=>{succeeded,Var}}, + St#cg{vars=Vars}. new_ssa_vars(Vs, St) -> mapfoldl(fun(#k_var{name=V}, S) -> @@ -1178,23 +1235,20 @@ new_label(#cg{lcount=Next}=St) -> %% current filename and line number. The annotation should be %% included in any operation that could cause an exception. -line_anno(#k{a=Anno}) -> - line_anno_1(Anno). - -line_anno_1([Line,{file,Name}]) when is_integer(Line) -> - line_anno_2(Name, Line); -line_anno_1([_|_]=A) -> +line_anno([Line,{file,Name}]) when is_integer(Line) -> + line_anno_1(Name, Line); +line_anno([_|_]=A) -> {Name,Line} = find_loc(A, no_file, 0), - line_anno_2(Name, Line); -line_anno_1([]) -> + line_anno_1(Name, Line); +line_anno([]) -> #{}. -line_anno_2(no_file, _) -> +line_anno_1(no_file, _) -> #{}; -line_anno_2(_, 0) -> +line_anno_1(_, 0) -> %% Missing line number or line number 0. #{}; -line_anno_2(Name, Line) -> +line_anno_1(Name, Line) -> #{location=>{Name,Line}}. find_loc([Line|T], File, _) when is_integer(Line) -> @@ -1220,27 +1274,37 @@ finalize(Asm0, St0) -> {Asm,St} = fix_sets(Asm1, [], St0), {build_map(Asm),St}. +%% fix_phis(Is0) -> Is. +%% Rewrite #cg_break{} and #cg_phi{} records to #b_set{} records. +%% A #cg_break{} is rewritten to an unconditional branch, and +%% and a #cg_phi{} is rewritten to one or more phi nodes. + fix_phis(Is) -> fix_phis_1(Is, none, #{}). -fix_phis_1([{label,L},#cg_phi{vars=[]}=Phi|Is0], _Lbl, Map0) -> - case maps:is_key(L, Map0) of - false -> - %% No #cg_break{} references this label. Nothing else can - %% reference it, so it can be safely be removed. - {Is,Map} = drop_upto_label(Is0, Map0), - fix_phis_1(Is, none, Map); - true -> - %% There is a break referencing this label; probably caused - %% by a try/catch whose return value is ignored. - [{label,L}|fix_phis_1([Phi|Is0], L, Map0)] +fix_phis_1([{label,Lbl},#cg_phi{vars=Vars}|Is0], _Lbl, Map0) -> + case Map0 of + #{Lbl:=Pairs} -> + %% This phi node was referenced by at least one #cg_break{}. + %% Create the phi nodes. + Phis = gen_phis(Vars, Pairs), + Map = maps:remove(Lbl, Map0), + [{label,Lbl}] ++ Phis ++ fix_phis_1(Is0, Lbl, Map); + #{} -> + %% No #cg_break{} instructions reference this label. + %% #cg_break{} instructions must reference the labels for + %% #cg_phi{} instructions; therefore this label is + %% unreachable and can be dropped. + Is = drop_upto_label(Is0), + fix_phis_1(Is, none, Map0) end; fix_phis_1([{label,L}=I|Is], _Lbl, Map) -> [I|fix_phis_1(Is, L, Map)]; -fix_phis_1([#cg_unreachable{}|Is0], _Lbl, Map0) -> - {Is,Map} = drop_upto_label(Is0, Map0), +fix_phis_1([#cg_unreachable{}|Is0], _Lbl, Map) -> + Is = drop_upto_label(Is0), fix_phis_1(Is, none, Map); fix_phis_1([#cg_break{args=Args,phi=Target}|Is], Lbl, Map) when is_integer(Lbl) -> + %% Pair each argument with the label for this block and save in the map. Pairs1 = case Map of #{Target:=Pairs0} -> Pairs0; #{} -> [] @@ -1248,17 +1312,6 @@ fix_phis_1([#cg_break{args=Args,phi=Target}|Is], Lbl, Map) when is_integer(Lbl) Pairs = [[{Arg,Lbl} || Arg <- Args]|Pairs1], I = make_uncond_branch(Target), [I|fix_phis_1(Is, none, Map#{Target=>Pairs})]; -fix_phis_1([#cg_phi{vars=Vars}|Is0], Lbl, Map0) -> - Pairs = maps:get(Lbl, Map0), - Map1 = maps:remove(Lbl, Map0), - case gen_phis(Vars, Pairs) of - [#b_set{op=phi,args=[]}] -> - {Is,Map} = drop_upto_label(Is0, Map1), - Ret = #b_ret{arg=#b_literal{val=unreachable}}, - [Ret|fix_phis_1(Is, none, Map)]; - Phis -> - Phis ++ fix_phis_1(Is0, Lbl, Map1) - end; fix_phis_1([I|Is], Lbl, Map) -> [I|fix_phis_1(Is, Lbl, Map)]; fix_phis_1([], _, Map) -> @@ -1267,6 +1320,7 @@ fix_phis_1([], _, Map) -> gen_phis([V|Vs], Preds0) -> {Pairs,Preds} = collect_preds(Preds0, [], []), + [_|_] = Pairs, %Assertion. [#b_set{op=phi,dst=V,args=Pairs}|gen_phis(Vs, Preds)]; gen_phis([], _) -> []. @@ -1275,6 +1329,36 @@ collect_preds([[First|Rest]|T], ColAcc, RestAcc) -> collect_preds([], ColAcc, RestAcc) -> {keysort(2, ColAcc),RestAcc}. +drop_upto_label([{label,_}|_]=Is) -> Is; +drop_upto_label([_|Is]) -> drop_upto_label(Is). + +%% fix_sets(Is0, Acc, St0) -> {Is,St}. +%% Ensure that #b_set.dst is filled in with a proper variable. +%% (For convenience, for instructions that don't have a useful return value, +%% the code generator would set #b_set.dst to `none`.) + +fix_sets([#b_set{op=Op,dst=Dst}=Set,#b_ret{arg=Dst}=Ret|Is], Acc, St) -> + NoValue = case Op of + remove_message -> true; + timeout -> true; + _ -> false + end, + case NoValue of + true -> + %% An instruction without value was used in effect + %% context in `after` block. Example: + %% + %% try + %% ... + %% after + %% receive _ -> ignored end + %% end, + %% ok. + %% + fix_sets(Is, [Ret#b_ret{arg=#b_literal{val=ok}},Set|Acc], St); + false -> + fix_sets(Is, [Ret,Set|Acc], St) + end; fix_sets([#b_set{dst=none}=Set|Is], Acc, St0) -> {Dst,St} = new_ssa_var('@ssa_ignored', St0), I = Set#b_set{dst=Dst}, @@ -1284,6 +1368,10 @@ fix_sets([I|Is], Acc, St) -> fix_sets([], Acc, St) -> {reverse(Acc),St}. +%% build_map(Is) -> #{}. +%% Split up the sequential instruction stream into blocks and +%% store them in a map. + build_map(Is) -> Blocks = build_graph_1(Is, [], []), maps:from_list(Blocks). @@ -1301,16 +1389,3 @@ make_blocks(Lbls, [Last|Is0]) -> Is = reverse(Is0), Block = #b_blk{is=Is,last=Last}, [{L,Block} || L <- Lbls]. - -drop_upto_label([{label,_}|_]=Is, Map) -> - {Is,Map}; -drop_upto_label([#cg_break{phi=Target}|Is], Map) -> - Pairs = case Map of - #{Target:=Pairs0} -> Pairs0; - #{} -> [] - end, - drop_upto_label(Is, Map#{Target=>Pairs}); -drop_upto_label([_|Is], Map) -> - drop_upto_label(Is, Map). - -k_get_anno(Thing) -> element(2, Thing). diff --git a/lib/compiler/src/beam_ssa.erl b/lib/compiler/src/beam_ssa.erl index 6492d1e1bf..9a8ae9b407 100644 --- a/lib/compiler/src/beam_ssa.erl +++ b/lib/compiler/src/beam_ssa.erl @@ -21,12 +21,13 @@ -module(beam_ssa). -export([add_anno/3,get_anno/2,get_anno/3, - clobbers_xregs/1,def/2,def_used/2, + clobbers_xregs/1,def/2,def_unused/3, definitions/1, dominators/1,common_dominators/3, flatmapfold_instrs_rpo/4, fold_po/3,fold_po/4,fold_rpo/3,fold_rpo/4, fold_instrs_rpo/4, + is_loop_header/1, linearize/1, mapfold_blocks_rpo/4, mapfold_instrs_rpo/4, @@ -79,7 +80,7 @@ -type var_base() :: atom() | non_neg_integer(). -type literal_value() :: atom() | integer() | float() | list() | - nil() | tuple() | map() | binary(). + nil() | tuple() | map() | binary() | fun(). -type op() :: {'bif',atom()} | {'float',float_op()} | prim_op() | cg_prim_op(). -type anno() :: #{atom() := any()}. @@ -101,7 +102,7 @@ 'bs_match' | 'bs_put' | 'bs_start_match' | 'bs_test_tail' | 'bs_utf16_size' | 'bs_utf8_size' | 'build_stacktrace' | 'call' | 'catch_end' | - 'extract' | + 'extract' | 'exception_trampoline' | 'get_hd' | 'get_map_element' | 'get_tl' | 'get_tuple_element' | 'has_map_field' | 'is_nonempty_list' | 'is_tagged_tuple' | @@ -120,10 +121,11 @@ %% Primops only used internally during code generation. -type cg_prim_op() :: 'bs_get' | 'bs_get_position' | 'bs_match_string' | 'bs_restore' | 'bs_save' | 'bs_set_position' | 'bs_skip' | - 'copy' | 'put_tuple_arity' | 'put_tuple_element' | - 'put_tuple_elements' | 'set_tuple_element'. + 'copy' | 'match_fail' | 'put_tuple_arity' | + 'put_tuple_element' | 'put_tuple_elements' | + 'set_tuple_element'. --import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1,umerge/1]). +-import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1,sort/1]). -spec add_anno(Key, Value, Construct) -> Construct when Key :: atom(), @@ -174,6 +176,8 @@ clobbers_xregs(#b_set{op=Op}) -> make_fun -> true; peek_message -> true; raw_raise -> true; + timeout -> true; + wait_timeout -> true; _ -> false end. @@ -188,13 +192,17 @@ no_side_effect(#b_set{op=Op}) -> case Op of {bif,_} -> true; {float,get} -> true; + bs_add -> true; bs_init -> true; + bs_init_writable -> true; bs_extract -> true; bs_match -> true; bs_start_match -> true; bs_test_tail -> true; bs_get_tail -> true; bs_put -> true; + bs_utf16_size -> true; + bs_utf8_size -> true; extract -> true; get_hd -> true; get_tl -> true; @@ -211,6 +219,18 @@ no_side_effect(#b_set{op=Op}) -> _ -> false end. +%% is_loop_header(#b_set{}) -> true|false. +%% Test whether this instruction is a loop header. + +-spec is_loop_header(b_set()) -> boolean(). + +is_loop_header(#b_set{op=Op}) -> + case Op of + peek_message -> true; + wait_timeout -> true; + _ -> false + end. + -spec predecessors(Blocks) -> #{BlockNumber:=[Predecessor]} when Blocks :: block_map(), BlockNumber :: label(), @@ -299,7 +319,7 @@ normalize(#b_switch{arg=Arg,fail=Fail,list=List}=Sw) -> #b_var{} when List =:= [] -> #b_br{bool=#b_literal{val=true},succ=Fail,fail=Fail}; #b_var{} -> - Sw + Sw#b_switch{list=sort(List)} end; normalize(#b_ret{}=Ret) -> Ret. @@ -319,17 +339,18 @@ def(Ls, Blocks) -> Blks = [map_get(L, Blocks) || L <- Top], def_1(Blks, []). --spec def_used(Ls, Blocks) -> {Def,Used} when +-spec def_unused(Ls, Used, Blocks) -> {Def,Unused} when Ls :: [label()], + Used :: ordsets:ordset(var_name()), Blocks :: block_map(), Def :: ordsets:ordset(var_name()), - Used :: ordsets:ordset(var_name()). + Unused :: ordsets:ordset(var_name()). -def_used(Ls, Blocks) -> +def_unused(Ls, Unused, Blocks) -> Top = rpo(Ls, Blocks), Blks = [map_get(L, Blocks) || L <- Top], Preds = cerl_sets:from_list(Top), - def_used_1(Blks, Preds, [], []). + def_unused_1(Blks, Preds, [], Unused). %% dominators(BlockMap) -> {Dominators,Numbering}. %% Calculate the dominator tree, returning a map where each entry @@ -651,34 +672,28 @@ is_commutative('=/=') -> true; is_commutative('/=') -> true; is_commutative(_) -> false. -def_used_1([#b_blk{is=Is,last=Last}|Bs], Preds, Def0, UsedAcc) -> - {Def,Used} = def_used_is(Is, Preds, Def0, used(Last)), - case Used of - [] -> - def_used_1(Bs, Preds, Def, UsedAcc); - [_|_] -> - def_used_1(Bs, Preds, Def, [Used|UsedAcc]) - end; -def_used_1([], _Preds, Def0, UsedAcc) -> - Def = ordsets:from_list(Def0), - Used = umerge(UsedAcc), - {Def,Used}. +def_unused_1([#b_blk{is=Is,last=Last}|Bs], Preds, Def0, Unused0) -> + Unused1 = ordsets:subtract(Unused0, used(Last)), + {Def,Unused} = def_unused_is(Is, Preds, Def0, Unused1), + def_unused_1(Bs, Preds, Def, Unused); +def_unused_1([], _Preds, Def, Unused) -> + {ordsets:from_list(Def), Unused}. -def_used_is([#b_set{op=phi,dst=Dst,args=Args}|Is], - Preds, Def0, Used0) -> +def_unused_is([#b_set{op=phi,dst=Dst,args=Args}|Is], + Preds, Def0, Unused0) -> Def = [Dst|Def0], %% We must be careful to only include variables that will %% be used when arriving from one of the predecessor blocks %% in Preds. - Used1 = [V || {#b_var{}=V,L} <- Args, cerl_sets:is_element(L, Preds)], - Used = ordsets:union(ordsets:from_list(Used1), Used0), - def_used_is(Is, Preds, Def, Used); -def_used_is([#b_set{dst=Dst}=I|Is], Preds, Def0, Used0) -> + Unused1 = [V || {#b_var{}=V,L} <- Args, cerl_sets:is_element(L, Preds)], + Unused = ordsets:subtract(Unused0, ordsets:from_list(Unused1)), + def_unused_is(Is, Preds, Def, Unused); +def_unused_is([#b_set{dst=Dst}=I|Is], Preds, Def0, Unused0) -> Def = [Dst|Def0], - Used = ordsets:union(used(I), Used0), - def_used_is(Is, Preds, Def, Used); -def_used_is([], _Preds, Def, Used) -> - {Def,Used}. + Unused = ordsets:subtract(Unused0, used(I)), + def_unused_is(Is, Preds, Def, Unused); +def_unused_is([], _Preds, Def, Unused) -> + {Def,Unused}. def_1([#b_blk{is=Is}|Bs], Def0) -> Def = def_is(Is, Def0), diff --git a/lib/compiler/src/beam_ssa.hrl b/lib/compiler/src/beam_ssa.hrl index fa76b08453..509a94135e 100644 --- a/lib/compiler/src/beam_ssa.hrl +++ b/lib/compiler/src/beam_ssa.hrl @@ -62,5 +62,13 @@ -record(b_local, {name :: beam_ssa:b_literal(), arity :: non_neg_integer()}). -%% If this block exists, it calls erlang:error(badarg). --define(BADARG_BLOCK, 1). +%% This is a psuedo-block used to express that certain instructions and BIFs +%% throw exceptions on failure. The code generator rewrites all branches to +%% this block to {f,0} which causes the instruction to throw an exception +%% instead of branching. +%% +%% Since this is not an ordinary block, it's illegal to merge it with other +%% blocks, and jumps are only valid when we know that an exception will be +%% thrown by the operation that branches here; the *block itself* does not +%% throw an exception. +-define(EXCEPTION_BLOCK, 1). diff --git a/lib/compiler/src/beam_ssa_bool.erl b/lib/compiler/src/beam_ssa_bool.erl new file mode 100644 index 0000000000..0860029c59 --- /dev/null +++ b/lib/compiler/src/beam_ssa_bool.erl @@ -0,0 +1,1625 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% The purpose of this pass is to optimize boolean expressions in +%% guards. Instead of evaluating a boolean expression and finally +%% comparing it to 'true', evaluate the expression using control flow. +%% +%% This pass is run directly after conversion to SSA code because some +%% optimizations in beam_ssa_opt (especially sinking of +%% get_tuple_element instructions) would prevent these optimizations +%% or at least make them much more difficult to perform. +%% +%% As an example, take the guard: +%% +%% when is_integer(V0), is_atom(V1) -> +%% +%% The unoptimized SSA code translated to pseudo BEAM code would look +%% like: +%% +%% bif is_integer V0 => Bool0 +%% bif is_atom V1 => Bool1 +%% bif and Bool0 Bool1 => Bool +%% test Bool =:= true else goto Fail +%% ... +%% Fail: +%% ... +%% +%% The optimized code would look like: +%% +%% test is_integer V0 else goto Fail +%% test is_atom V1 else goto Fail +%% ... +%% Fail: +%% ... +%% +%% An 'or' operation is only slightly more complicated: +%% +%% test is_integer V0 else goto NotFailedYet +%% goto Success +%% +%% NotFailedYet: +%% test is_atom V1 else goto Fail +%% +%% Success: +%% ... +%% Fail: +%% ... +%% +%% The unoptimized SSA code for the first example looks like: +%% +%% 0: +%% _2 = bif:is_integer _0 +%% _3 = bif:is_atom _1 +%% _7 = bif:'and' _2, _3 +%% @ssa_bool = succeeded _7 +%% br @ssa_bool, label 4, label 3 +%% +%% 4: +%% @ssa_bool:5 = bif:'=:=' _7, literal true +%% br @ssa_bool:5, label 6, label 3 +%% +%% 6: +%% ret literal ok +%% +%% 3: Error. +%% ... +%% +%% The optimized SSA code looks like: +%% +%% 0: +%% _2 = bif:is_integer _0 +%% br _2, label 11, label 3 +%% +%% 11: +%% _3 = bif:is_atom _1 +%% br _3, label 6, label 3 +%% +%% 6: +%% ret literal ok +%% +%% 3: Error. +%% ... + +-module(beam_ssa_bool). +-export([module/2]). + +-import(lists, [all/2,foldl/3,keyfind/3,last/1,partition/2, + reverse/1,reverse/2,sort/1]). + +-include("beam_ssa.hrl"). + +-record(st, {defs=#{}, + ldefs=#{}, + count :: beam_ssa:label(), + dom, + uses}). + +-spec module(beam_ssa:b_module(), [compile:option()]) -> + {'ok',beam_ssa:b_module()}. + +module(#b_module{body=Fs0}=Module, _Opts) -> + Fs = [function(F) || F <- Fs0], + {ok,Module#b_module{body=Fs}}. + +function(#b_function{anno=Anno}=F) -> + try + opt_function(F) + catch + Class:Error:Stack -> + #{func_info:={_,Name,Arity}} = Anno, + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +opt_function(#b_function{bs=Blocks0,cnt=Count0}=F) -> + {Blocks1,Count1} = pre_opt(Blocks0, Count0), + DefVars = interesting_defs(Blocks1), + if + map_size(DefVars) > 1 -> + Dom = beam_ssa:dominators(Blocks1), + Uses = beam_ssa:uses(Blocks1), + St0 = #st{defs=DefVars,count=Count1,dom=Dom,uses=Uses}, + {Blocks,St} = bool_opt(Blocks1, St0), + Count = St#st.count, + F#b_function{bs=Blocks,cnt=Count}; + true -> + %% There are no boolean operators that can be optimized in + %% this function. + F#b_function{bs=Blocks1,cnt=Count1} + end. + +%%% +%%% Do some optimizations to help the main boolean optimization pass: +%%% +%%% * Remove `succeeded` instructions that can't fail after `and`, +%%% `or`, and `not`. The main optimization pass can only optimize +%%% boolean operators that are known not to fail. +%%% +%%% * Rewrite a boolean #b_switch{} to a #b_br{} if the fail label +%%% can't be reached or is not important. (The main optimization +%%% can't handle #b_switch{}.) +%%% +%%% * Simplify phi nodes, eliminating them if they only have one +%%% value. Also annotate phi nodes that are known to evaluate +%%% to a boolean. +%%% + +-type var() :: beam_ssa:b_var(). + +%% Note: We use the substitution map for both substitutions and type +%% information. If the associated value for a variable is a #b_set{}, +%% it means that the value is a boolean. +-type pre_sub_val() :: + beam_ssa:value() | %Value to be substituted. + beam_ssa:b_set() | %This variable is a boolean. + {'true_or_any',beam_ssa:label()} | + '=:='. + +-type pre_sub_map() :: #{'uses' => {'uses',beam_ssa:block_map() | list()}, + var() => pre_sub_val()}. + +pre_opt(Blocks, Count) -> + Top = beam_ssa:rpo(Blocks), + + %% Collect information to help the pre_opt pass to optimize + %% `switch` instructions. + Sub0 = #{uses => {uses,Blocks}}, + Sub1 = get_phi_info(Top, Blocks, Sub0), + Sub = maps:remove(uses, Sub1), + + %% Now do the actual optimizations. + Reached = gb_sets:singleton(hd(Top)), + pre_opt(Top, Sub, Reached, Count, Blocks). + +-spec get_phi_info(Ls, Blocks, Sub0) -> Sub when + Ls :: [beam_ssa:label()], + Blocks :: beam_ssa:block_map(), + Sub0 :: pre_sub_map(), + Sub :: pre_sub_map(). + +%% get_phi_info([Label], Blocks, Sub0) -> Sub. +%% Collect information to help us optimize `switch` instructions +%% such as: +%% +%% switch SomeVar, label _, [ {literal false, _ }, {literal true, _ } ] +%% . +%% . +%% . +%% PhiVar = phi { SomeVar, _ }, { literal fail, _ }, { literal false, _} +%% EqBool = bif:'=:=' PhiVar, literal true +%% +%% Here it can be seen that `SomeVar` is compared to `true`. If +%% `SomeVar` is not `true`, it does not matter whether its value is +%% `false` or some other value. That means that the `switch` can be +%% replaced with a two-way `br`: +%% +%% NewBoolVar = bif:'=:=' SomeVar, literal true +%% br NewBoolVar, label _, label _ +%% +%% For this example, the value {true_or_any,LabelOfPhiBlock} will be +%% added for the key `SomeVar` in the substitution map. + +get_phi_info([L|Ls], Blocks, Sub0) -> + Sub = get_phi_info(Ls, Blocks, Sub0), + #b_blk{is=Is} = map_get(L, Blocks), + get_phi_info_is(Is, L, Sub); +get_phi_info([], _, Sub) -> Sub. + +get_phi_info_is([I|Is], From, Sub0) -> + Sub = get_phi_info_is(Is, From, Sub0), + get_phi_info_instr(I, From, Sub); +get_phi_info_is([], _, Sub) -> Sub. + +get_phi_info_instr(#b_set{op={bif,'=:='}, + args=[#b_var{}=Bool,#b_literal{val=true}]}, + _From, Sub) -> + Sub#{Bool=>'=:='}; +get_phi_info_instr(#b_set{op=phi,dst=Dst,args=Args}, From, Sub0) -> + {Safe,Sub} = + case Sub0 of + #{Dst:='=:='} -> + get_phi_info_single_use(Dst, Sub0); + #{Dst:={true_or_any,_}} -> + get_phi_info_single_use(Dst, Sub0); + #{} -> + {false,Sub0} + end, + case Safe of + true -> + foldl(fun({#b_var{}=V,_}, A) -> + A#{V => {true_or_any,From}}; + (_, A) -> A + end, Sub, Args); + false -> Sub + end; +get_phi_info_instr(_, _, Sub) -> Sub. + +get_phi_info_single_use(Var, Sub) -> + case map_get(uses, Sub) of + Uses when is_map(Uses) -> + {case Uses of + #{Var:=[_]} -> true; + #{Var:=[_|_]} -> false + end,Sub}; + {uses,Blocks} -> + Uses = beam_ssa:uses(Blocks), + get_phi_info_single_use(Var, Sub#{uses => Uses}) + end. + +-spec pre_opt(Ls, Sub, Reached, Count0, Blocks0) -> {Blocks,Count} when + Ls :: [beam_ssa:label()], + Reached :: gb_sets:set(beam_ssa:label()), + Count0 :: beam_ssa:label(), + Blocks0 :: beam_ssa:block_map(), + Sub :: pre_sub_map(), + Count :: beam_ssa:label(), + Blocks :: beam_ssa:block_map(). + +pre_opt([L|Ls], Sub0, Reached0, Count0, Blocks) -> + case gb_sets:is_member(L, Reached0) of + false -> + %% This block will never be reached. + pre_opt(Ls, Sub0, Reached0, Count0, maps:remove(L, Blocks)); + true -> + #b_blk{is=Is0,last=Last0} = Blk0 = map_get(L, Blocks), + {Is,Sub} = pre_opt_is(Is0, Reached0, Sub0, []), + case pre_opt_terminator(Last0, Sub, Blocks) of + {#b_set{}=Test0,#b_br{}=Br0} -> + %% Here is a #b_switch{} that has been reduced to + %% a '=:=' followed by a two-way `br`. + Bool = #b_var{name={'@ssa_bool',Count0}}, + Count = Count0 + 1, + Test = Test0#b_set{dst=Bool}, + Br = Br0#b_br{bool=Bool}, + Blk = Blk0#b_blk{is=Is++[Test],last=Br}, + Successors = beam_ssa:successors(Blk), + Reached = gb_sets:union(Reached0, + gb_sets:from_list(Successors)), + pre_opt(Ls, Sub, Reached, Count, Blocks#{L:=Blk}); + Last -> + Blk = Blk0#b_blk{is=Is,last=Last}, + Successors = beam_ssa:successors(Blk), + Reached = gb_sets:union(Reached0, + gb_sets:from_list(Successors)), + pre_opt(Ls, Sub, Reached, Count0, Blocks#{L:=Blk}) + end + end; +pre_opt([], _, _, Count, Blocks) -> + {Blocks,Count}. + +pre_opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is], Reached, Sub0, Acc) -> + Args1 = [{Val,From} || {Val,From} <- Args0, + gb_sets:is_member(From, Reached)], + Args = sub_args(Args1, Sub0), + case all_same(Args) of + true -> + %% Single value or all values are the same. We can remove + %% the phi node. + {Arg,_} = hd(Args), + Sub = Sub0#{Dst=>Arg}, + pre_opt_is(Is, Reached, Sub, Acc); + false -> + case pre_is_phi_bool(Args, Sub0) of + true -> + %% The value of the phi node is always a + %% boolean. Update type information in the sub map + %% and add an annotation. + Anno = I0#b_set.anno, + I = I0#b_set{args=Args,anno=Anno#{boolean_phi=>true}}, + Sub = Sub0#{Dst=>I}, + pre_opt_is(Is, Reached, Sub, [I|Acc]); + false -> + I = I0#b_set{args=Args}, + pre_opt_is(Is, Reached, Sub0, [I|Acc]) + end + end; +pre_opt_is([#b_set{op=succeeded,dst=Dst,args=Args0}=I0|Is], Reached, Sub0, Acc) -> + [Arg] = Args = sub_args(Args0, Sub0), + I = I0#b_set{args=Args}, + case pre_is_safe_bool(Arg, Sub0) of + true -> + %% The preceding boolean operation can't fail. Get rid + %% of this `succeeded` instruction. + Sub = Sub0#{Dst=>#b_literal{val=true}}, + pre_opt_is(Is, Reached, Sub, Acc); + false -> + pre_opt_is(Is, Reached, Sub0, [I|Acc]) + end; +pre_opt_is([#b_set{dst=Dst,args=Args0}=I0|Is], Reached, Sub0, Acc) -> + Args = sub_args(Args0, Sub0), + I = I0#b_set{args=Args}, + case is_bool_expr(I) of + true -> + case pre_eval_op(I, Sub0) of + none -> + Sub = Sub0#{Dst=>I}, + pre_opt_is(Is, Reached, Sub, [I|Acc]); + #b_var{}=Var -> + %% We must remove the 'succeeded' instruction that + %% follows since the variable it checks is gone. + [#b_set{op=succeeded,dst=SuccDst,args=[Dst]}] = Is, + Sub = Sub0#{Dst=>Var,SuccDst=>#b_literal{val=true}}, + pre_opt_is([], Reached, Sub, Acc); + #b_literal{}=Lit -> + Sub = Sub0#{Dst=>Lit}, + pre_opt_is(Is, Reached, Sub, Acc) + end; + false -> + pre_opt_is(Is, Reached, Sub0, [I|Acc]) + end; +pre_opt_is([], _Reached, Sub, Acc) -> + {reverse(Acc),Sub}. + +pre_opt_terminator(#b_br{bool=#b_literal{}}=Br, _Sub, _Blocks) -> + Br; +pre_opt_terminator(#b_br{bool=Bool}=Br0, Sub, Blocks) -> + case beam_ssa:normalize(Br0#b_br{bool=sub_arg(Bool, Sub)}) of + Br0 -> + Br0; + #b_br{bool=#b_literal{val=true},succ=Next}=Br -> + %% See if the terminator from the successor block + %% can be incorporated into this block to give + %% more opportunities for optimization. + #b_blk{is=Is,last=Last} = map_get(Next, Blocks), + case {Is,Last} of + {[],#b_switch{}} -> + pre_opt_terminator(Last, Sub, Blocks); + {_,_} -> + Br + end + end; +pre_opt_terminator(#b_ret{arg=Arg}=Ret, Sub, _Blocks) -> + Ret#b_ret{arg=sub_arg(Arg, Sub)}; +pre_opt_terminator(#b_switch{arg=Arg0,list=List}=Sw0, Sub, Blocks) -> + Arg = sub_arg(Arg0, Sub), + Sw = Sw0#b_switch{arg=Arg}, + case sort(List) of + [{#b_literal{val=false},Fail}, + {#b_literal{val=true},Succ}] -> + case pre_is_arg_bool(Arg, Sub) of + false -> + pre_opt_sw(Sw, Fail, Succ, Sub, Blocks); + true -> + beam_ssa:normalize(#b_br{bool=Arg,succ=Succ,fail=Fail}) + end; + _ -> + Sw + end. + +pre_opt_sw(#b_switch{arg=Arg,fail=Fail}=Sw, False, True, Sub, Blocks) -> + case Sub of + #{Arg:={true_or_any,PhiL}} -> + #{Fail:=FailBlk,False:=FalseBlk,PhiL:=PhiBlk} = Blocks, + case {FailBlk,FalseBlk,PhiBlk} of + {#b_blk{is=[],last=#b_br{succ=PhiL,fail=PhiL}}, + #b_blk{is=[],last=#b_br{succ=PhiL,fail=PhiL}}, + #b_blk{is=[#b_set{op=phi,args=PhiArgs}|_]}} -> + case keyfind(False, 2, PhiArgs) of + {#b_literal{val=Bool},False} when Bool =/= true -> + %% This is an `andalso` in a guard. The code + %% can be simplified to a two-way `br` because + %% the actual value of the variable does not + %% matter if it is not equal to `true`. + DummyDst = #b_var{name=0}, + {#b_set{op={bif,'=:='},dst=DummyDst, + args=[Arg,#b_literal{val=true}]}, + #b_br{bool=DummyDst,succ=True,fail=False}}; + {_,_} -> + Sw + end; + {_,_,_} -> + Sw + end; + #{} -> + Sw + end. + +pre_eval_op(#b_set{op={bif,Op},args=Args}, Sub) -> + case pre_are_args_bool(Args, Sub) of + true -> + case {Op,Args} of + {'and',[#b_literal{val=true},#b_var{}=Res]} -> Res; + {'and',[#b_literal{val=false}=Res,#b_var{}]} -> Res; + {'and',[#b_var{}=Res,#b_literal{val=true}]} -> Res; + {'and',[#b_var{},#b_literal{val=false}=Res]} -> Res; + {'or',[#b_literal{val=true}=Res,#b_var{}]} -> Res; + {'or',[#b_literal{val=false},#b_var{}=Res]} -> Res; + {'or',[#b_var{},#b_literal{val=true}=Res]} -> Res; + {'or',[#b_var{}=Res,#b_literal{val=false}]} -> Res; + _ -> none + end; + false -> + none + end. + +all_same([{H,_}|T]) -> + all(fun({E,_}) -> E =:= H end, T). + +pre_is_phi_bool([{#b_literal{val=Lit},_}|As], Sub) -> + is_boolean(Lit) andalso pre_is_phi_bool(As, Sub); +pre_is_phi_bool([{#b_var{}=A,_}|As], Sub) -> + case Sub of + #{A:=#b_set{}} -> + pre_is_phi_bool(As, Sub); + #{} -> + false + end; +pre_is_phi_bool([], _Sub) -> true. + +pre_is_safe_bool(#b_literal{}, _Sub) -> + true; +pre_is_safe_bool(Var, Sub) -> + case Sub of + #{Var:=#b_set{op={bif,is_function}, + args=[_,Arity]}} -> + case Arity of + #b_literal{val=Lit} -> + is_integer(Lit) andalso Lit >= 0; + #b_var{} -> + false + end; + #{Var:=#b_set{op={bif,Op},args=Args}} -> + Arity = length(Args), + erl_internal:bool_op(Op, Arity) andalso + pre_are_args_bool(Args, Sub); + #{} -> + false + end. + +pre_are_args_bool([A|As], Sub) -> + pre_is_arg_bool(A, Sub) andalso pre_are_args_bool(As, Sub); +pre_are_args_bool([], _Sub) -> true. + +pre_is_arg_bool(#b_literal{val=Lit}, _Sub) -> + is_boolean(Lit); +pre_is_arg_bool(#b_var{}=A, Sub) -> + case Sub of + #{A:=#b_set{}} -> + true; + #{} -> + false + end. + +%%% +%%% Build a map from variable to definitions for boolean expressions +%%% phi nodes. This map will be used by collect_bool_vars() and by +%%% shortcut_branches(). +%%% + +interesting_defs(Blocks) -> + interesting_defs(maps:to_list(Blocks), []). + +interesting_defs([{L,#b_blk{is=Is}}|Bs], Acc) -> + interesting_defs(Bs, interesting_defs_is(Is, L, Acc)); +interesting_defs([], Acc) -> + maps:from_list(Acc). + +interesting_defs_is([#b_set{op={bif,_},dst=V}=I|Is], L, Acc) -> + case is_bool_expr(I) of + true -> + interesting_defs_is(Is, L, [{V,{L,I}}|Acc]); + false -> + interesting_defs_is(Is, L, Acc) + end; +interesting_defs_is([#b_set{op=phi,dst=V}=Set|Is], L, Acc) -> + interesting_defs_is(Is, L, [{V,{L,Set}}|Acc]); +interesting_defs_is([#b_set{}|Is], L, Acc) -> + interesting_defs_is(Is, L, Acc); +interesting_defs_is([], _L, Acc) -> Acc. + +%%% +%%% Search for boolean expressions to optimize. +%%% +%%% The main purpose of this module is to optimize guards. A guard ends in the +%%% following instructions: +%%% +%%% Bool = bif:'=:=' Var, literal true +%%% br BoolVar, label Success, label Failure +%%% +%%% To make sure that we'll find the end of the guard instead of some +%%% interior '=:=' instruction we will visit the blocks in postorder. +%%% + +bool_opt(Blocks, St) -> + bool_opt(beam_ssa:rpo(Blocks), Blocks, St). + +bool_opt([L|Ls], Blocks0, St0) -> + {Blocks,St1} = bool_opt(Ls, Blocks0, St0), + case Blocks of + #{L:=#b_blk{is=[_|_]=Is,last=#b_br{bool=#b_var{}=Bool}=Br}} -> + case last(Is) of + #b_set{op={bif,'=:='},dst=Bool, + args=[#b_var{},#b_literal{val=true}]} -> + try + bool_opt_rewrite(Bool, L, Br, Blocks, St1) + catch + throw:not_possible -> + {Blocks,St1} + end; + #b_set{} -> + {Blocks,St1} + end; + #{} -> + %% Either this block was removed by a previous successful + %% optimization, it is empty, or its terminator is not a + %% two-way `br` instruction. + {Blocks,St1} + end; +bool_opt([], Blocks, St) -> + {Blocks,St}. + +bool_opt_rewrite(Bool, From, Br, Blocks0, St0) -> + TreeVars = collect_bool_vars(Bool, St0), + case TreeVars of + [Bool] -> + %% Only one variable means that there is nothing to + %% optimize. (The variable is either a function argument, + %% or has been defined by an instruction such as `call` or + %% `get_tuple_element`.) + not_possible(); + [_|_] -> + ok + end, + + %% Find the common dominator block for all the blocks with boolean + %% variables. + Dom = bool_opt_dom(TreeVars, St0), + + %% Split out non-boolean instruction from the block that dominates + %% all the boolean operators. Splitting will save some work, and + %% it could also make more optimizations possible since phi nodes + %% could be difficult to handle later when they have been included + %% in the graph. + {DomPreIs,Blocks1} = split_dom_block(Dom, Blocks0), + + %% Collect all blocks from the Dom block up to and including + %% the From block. + Bs = collect_digraph_blocks(Dom, From, Br, Blocks1), + + %% Build a digraph from the collected blocks. + {Root,G0,St1} = build_digraph(Bs, Br, St0), + + %% Optimize the digraph. + LDefs = digraph_bool_def(G0), + St = St1#st{ldefs=LDefs}, + G1 = opt_digraph_top(Bool, G0, St), + G = shortcut_branches(Root, G1, St), + + %% Make sure that every variable that is used will be defined + %% on every path to its use. + ensure_init(Root, G, G0), + + %% Delete the original blocks. This is important so that we will not + %% try optimize the already optimized code. That would not work + %% because the map of definitions in St#st.defs would not be updated + %% to include the newly optimized blocks. + DomBlk0 = map_get(Dom, Blocks1), + Blocks2 = maps:without([L || {L,#b_blk{}} <- Bs], Blocks1), + + %% Convert the optimized digraph back to SSA code. + Blocks3 = digraph_to_ssa([Root], G, Blocks2), + + %% Add a branch from the pre-sequence in the dominating block to + %% the first block of the optimized code. + DomBlk = DomBlk0#b_blk{is=DomPreIs,last=oneway_br(Root)}, + Blocks = Blocks3#{Dom => DomBlk}, + {Blocks,St#st{ldefs=#{}}}. + +%%% +%%% Collect boolean variables recursively reachable from the root +%%% boolean variable. +%%% + +collect_bool_vars(RootBool, St) -> + #b_set{args=[#b_var{}=Var,#b_literal{}]} = get_def(RootBool, St), + collect_bool_vars([Var], St, [RootBool]). + +collect_bool_vars([V|Vs], St, Acc) -> + case get_def(V, St) of + #b_set{op=phi,anno=Anno,args=Args} -> + {Vars,Ls} = collect_phi_args(Args, Anno), + collect_bool_vars(Vars ++ Vs, St, Ls ++ Vars ++ Acc); + #b_set{args=Args}=I -> + %% This is a boolean expression. + Vars = [Arg || #b_var{}=Arg <- Args], + case is_rewritable_bool_op(I) of + true -> + %% This is a bool op ('and', 'or', or + %% 'not'). Recursively collect more boolean + %% variables from its arguments. + collect_bool_vars(Vars ++ Vs, St, [V|Acc]); + false -> + %% This is a comparison operator (such as `<`) or + %% type test. Don't visit its arguments + %% recursively. + collect_bool_vars(Vs, St, [V|Acc]) + end; + none -> + collect_bool_vars(Vs, St, Acc) + end; +collect_bool_vars([], _St, Acc) -> + ordsets:from_list(Acc). + +is_rewritable_bool_op(#b_set{op={bif,Bif}}) -> + %% `xor` is a bool op, but it is not practical to rewrite it. + case Bif of + 'and' -> true; + 'or' -> true; + 'not' -> true; + _ -> false + end. + +collect_phi_args(Args, Anno) -> + case is_map_key(boolean_phi, Anno) of + true -> + Vars = [V || {#b_var{}=V,_} <- Args], + case Vars of + [_|_] -> + {Vars,[]}; + [] -> + %% This phi node only contains literal values. + %% Force the inclusion of referenced blocks. + Ls = [{block,L} || {_,L} <- Args], + {[],Ls} + end; + false -> + %% We can't rewrite phi nodes that don't return + %% a boolean value. + {[],[]} + end. + +%%% +%%% Dominator utility functions. +%%% + +bool_opt_dom(TreeVars, #st{defs=Defs,dom={DomBy,Num}}) -> + Ls0 = foldl(fun({block,L}, A) -> + [L|A]; + (V, A) -> + {L,_} = map_get(V, Defs), + [L|A] + end, [], TreeVars), + Ls = ordsets:from_list(Ls0), + [Common|_] = beam_ssa:common_dominators(Ls, DomBy, Num), + Common. + +split_dom_block(L, Blocks0) -> + #b_blk{is=Is} = Blk0 = map_get(L, Blocks0), + {PreIs,TailIs} = split_dom_block_is(Is, []), + Blk = Blk0#b_blk{is=TailIs}, + Blocks = Blocks0#{L:=Blk}, + {PreIs,Blocks}. + +split_dom_block_is([#b_set{},#b_set{op=succeeded}]=Is, PreAcc) -> + {reverse(PreAcc),Is}; +split_dom_block_is([#b_set{}=I|Is]=Is0, PreAcc) -> + case is_bool_expr(I) of + true -> + {reverse(PreAcc),Is0}; + false -> + split_dom_block_is(Is, [I|PreAcc]) + end; +split_dom_block_is([], PreAcc) -> + {reverse(PreAcc),[]}. + +%%% +%%% Find and collect the blocks that should be converted to a digraph. +%%% + +collect_digraph_blocks(FirstL, LastL, #b_br{succ=Succ,fail=Fail}, Blocks) -> + Ws = gb_sets:singleton(FirstL), + Seen = cerl_sets:from_list([Succ,Fail]), + collect_digraph_blocks(Ws, LastL, Blocks, Seen, []). + +collect_digraph_blocks(Ws0, LastL, Blocks, Seen0, Acc0) -> + case gb_sets:is_empty(Ws0) of + true -> + Acc0; + false -> + {L,Ws1} = gb_sets:take_smallest(Ws0), + Seen = cerl_sets:add_element(L, Seen0), + Blk = map_get(L, Blocks), + Acc = [{L,Blk}|Acc0], + Ws = cdb_update_workset(L, Blk, LastL, Seen, Ws1), + collect_digraph_blocks(Ws, LastL, Blocks, Seen, Acc) + end. + +cdb_update_workset(LastL, _Blk, LastL, _Seen, Ws) -> + Ws; +cdb_update_workset(_L, Blk, _LastL, Seen, Ws) -> + Successors = beam_ssa:successors(Blk), + cdb_update_workset(Successors, Seen, Ws). + +cdb_update_workset([L|Ls], Seen, Ws) -> + case cerl_sets:is_element(L, Seen) of + true -> + cdb_update_workset(Ls, Seen, Ws); + false -> + cdb_update_workset(Ls, Seen, gb_sets:add_element(L, Ws)) + end; +cdb_update_workset([], _Seen, Ws) -> Ws. + +%%% +%%% For the blocks from the dominating block up to the last block, +%%% build a digraph where each vertex is an instruction. This is just +%%% a more convenient way to represent the code, more suitable for +%%% the optimizations we are about to do. +%%% + +build_digraph(Bs, #b_br{succ=Succ,fail=Fail}, St0) -> + Ignore = ordsets:from_list([Succ,Fail]), + G0 = beam_digraph:new(), + {Map0,G1,St1} = build_mapping(Bs, #{}, G0, St0), + {Map,G2} = add_external_vertices(Ignore, Map0, G1), + {G,St} = build_digraph_1(Bs, G2, Map, St1), + + %% Find the root node now. After we have done optimizations, + %% there may be more than one root node (that is, nodes without + %% any incident vertices). + [Root] = digraph_roots(G), + {Root,G,St}. + +build_mapping([{L,Blk}|Bs], Map0, G0, St0) -> + {Vtx,St} = new_label(St0), + Map = Map0#{L=>Vtx}, + Label = case Blk of + #b_blk{is=[]} -> br; + #b_blk{} -> initial + end, + G = beam_digraph:add_vertex(G0, Vtx, Label), + build_mapping(Bs, Map, G, St); +build_mapping([], Map, G, St) -> + {Map,G,St}. + +add_external_vertices([V|Vs], Map0, G0) -> + G = beam_digraph:add_vertex(G0, V, {external,#{}}), + Map = Map0#{V=>V}, + add_external_vertices(Vs, Map, G); +add_external_vertices([], Map, G) -> + {Map,G}. + +build_digraph_1([{L,Blk}|Bs], G0, Map, St0) -> + #b_blk{is=Is,last=Last} = Blk, + Vtx = map_get(L, Map), + {G,St} = build_digraph_is(Is, Last, Vtx, Map, G0, St0), + build_digraph_1(Bs, G, Map, St); +build_digraph_1([], G, _Map, St) -> + {G,St}. + +build_digraph_is([#b_set{op=phi,args=Args0}=I0|Is], Last, Vtx, Map, G, St) -> + case Is of + [#b_set{op=phi}|_] -> not_possible(); + _ -> ok + end, + Args = [{V,map_get(L, Map)} || {V,L} <- Args0], + I = I0#b_set{args=Args}, + build_digraph_is_1(I, Is, Last, Vtx, Map, G, St); +build_digraph_is([#b_set{}=I|Is], Last, Vtx, Map, G, St) -> + case beam_ssa:no_side_effect(I) of + true -> + build_digraph_is_1(I, Is, Last, Vtx, Map, G, St); + false -> + not_possible() + end; +build_digraph_is([], Last, From, Map, G0, St) -> + case Last of + #b_br{bool=#b_literal{val=true},succ=To0,fail=To0} -> + To = map_get(To0, Map), + G = beam_digraph:add_edge(G0, From, To, next), + {G,St}; + #b_br{bool=#b_var{}=Bool,succ=Succ0,fail=Fail0} -> + #{Succ0:=Succ,Fail0:=Fail} = Map, + case beam_digraph:vertex(G0, From) of + #b_set{dst=Bool} -> + G = add_succ_fail_edges(From, Succ, Fail, G0), + {G,St}; + #b_set{} -> + %% Wrong variable being tested. This is rare. + not_possible(); + br -> + G1 = add_succ_fail_edges(From, Succ, Fail, G0), + G = beam_digraph:add_vertex(G1, From, {br,Bool}), + {G,St} + end; + _ -> + not_possible() + end. + +build_digraph_is_1(I, Is, Last, Vtx, Map, G0, St0) -> + G1 = beam_digraph:add_vertex(G0, Vtx, I), + case Is of + [] -> + build_digraph_is(Is, Last, Vtx, Map, G1, St0); + [_|_] -> + {NextVtx,St} = new_label(St0), + G2 = beam_digraph:add_vertex(G1, NextVtx, initial), + G = beam_digraph:add_edge(G2, Vtx, NextVtx, next), + build_digraph_is(Is, Last, NextVtx, Map, G, St) + end. + +%%% +%%% Optimize the graph, attempting to eliminating 'and', 'or', and 'not' +%%% instructions. +%%% + +opt_digraph_top(Arg, G0, St) -> + I = get_def(Arg, G0, St), + #b_set{op={bif,'=:='},dst=Dst, + args=[#b_var{}=Bool,#b_literal{val=true}]} = I, + {br,Succ,Fail} = get_targets(Dst, G0, St), + G1 = ensure_single_use(Dst, G0, St), + G = convert_to_br_node(I, Succ, G1, St), + redirect_test(Bool, {fail,Fail}, G, St). + +do_opt_digraph([A|As], G0, St) -> + I = get_def(A, G0, St), + try opt_digraph_instr(I, G0, St) of + G -> + do_opt_digraph(As, G, St) + catch + throw:not_possible -> + do_opt_digraph(As, G0, St) + end; +do_opt_digraph([], G, _St) -> G. + +opt_digraph_instr(#b_set{dst=Dst}=I, G0, St) -> + %% We KNOW that this node has two outgoing edges (one labeled + %% `succ` and one `fail`). + {br,Succ,Fail} = get_targets(Dst, G0, St), + G1 = ensure_single_use(Dst, G0, St), + case I of + #b_set{op={bif,'and'},args=Args} -> + G2 = convert_to_br_node(I, Succ, G1, St), + {First,Second} = order_args(Args, G2, St), + G = redirect_test(First, {fail,Fail}, G2, St), + redirect_test(Second, {fail,Fail}, G, St); + #b_set{op={bif,'or'},args=Args} -> + {First,Second} = order_args(Args, G1, St), + + %% Here we give up the optimization if the optimization + %% would skip instructions that may fail. A possible + %% future improvement would be to hoist the failing + %% instructions so that they would always be executed. + ensure_no_failing_instructions(First, Second, G1, St), + + G2 = convert_to_br_node(I, Succ, G1, St), + G = redirect_test(First, {succ,Succ}, G2, St), + redirect_test(Second, {fail,Fail}, G, St); + #b_set{op={bif,'xor'}} -> + %% Rewriting 'xor' is not practical. Fortunately, + %% 'xor' is almost never used in practice. + not_possible(); + #b_set{op={bif,'not'},args=[#b_var{}=Bool]} -> + G = convert_to_br_node(I, Fail, G1, St), + redirect_test(Bool, {fail,Succ}, G, St); + #b_set{op=phi,dst=Bool} -> + Vtx = get_vertex(Bool, St), + G2 = del_out_edges(Vtx, G1), + G = beam_digraph:add_edge(G2, Vtx, Succ, next), + redirect_test(Bool, {fail,Fail}, G, St); + #b_set{} -> + G1 + end. + +ensure_single_use(Bool, G, #st{uses=U}=St) -> + case map_get(Bool, U) of + [_] -> + G; + Uses -> + Vtx = get_vertex(Bool, St), + ensure_single_use_1(Bool, Vtx, Uses, G) + end. + +ensure_single_use_1(Bool, Vtx, Uses, G) -> + Fail = case get_targets(Vtx, G) of + {br,_,Fail0} -> Fail0; + _ -> not_possible() + end, + case partition(fun({L,#b_set{}}) when L =:= Fail -> true; + (_) -> false + end, Uses) of + {[_],[_]} -> + case beam_digraph:vertex(G, Fail) of + {external,Bs0} -> + %% The only other use of the variable Bool + %% is in the failure block. It can be + %% replaced with the literal `false` + %% in that block. + Bs = Bs0#{Bool => #b_literal{val=false}}, + beam_digraph:add_vertex(G, Fail, {external,Bs}); + _ -> + not_possible() + end; + {_,_} -> + not_possible() + end. + +convert_to_br_node(I, Target, G0, St) -> + Vtx = get_vertex(I, St), + G1 = del_out_edges(Vtx, G0), + G = beam_digraph:add_vertex(G1, Vtx, br), + beam_digraph:add_edge(G, Vtx, Target, next). + + +%% ensure_no_failing_instructions(First, Second, G, St) -> ok. +%% Ensure that there are no instructions that can fail that would not +%% be executed if right-hand side of the `or` would be skipped. That +%% means that the `or` could succeed when it was supposed to +%% fail. Example: +%% +%% (element(1, T) =:= tag) or +%% (element(10, T) =:= y) + +ensure_no_failing_instructions(First, Second, G, St) -> + Vs0 = covered(get_vertex(First, St), get_vertex(Second, St), G), + Vs = [{V,beam_digraph:vertex(G, V)} || V <- Vs0], + Failing = [P || {V,#b_set{op=succeeded}}=P <- Vs, + not eaten_by_phi(V, G)], + case Failing of + [] -> ok; + [_|_] -> not_possible() + end. + +eaten_by_phi(V, G) -> + {br,_,Fail} = get_targets(V, G), + case beam_digraph:vertex(G, Fail) of + br -> + [To] = beam_digraph:out_neighbours(G, Fail), + case beam_digraph:vertex(G, To) of + #b_set{op=phi} -> + true; + _ -> + false + end; + _ -> + false + end. + +%% order_args([Arg1,Arg2], G, St) -> {First,Second}. +%% Order arguments for a boolean operator so that there is path in the +%% digraph from the instruction referered to by the first operand to +%% the instruction refered to by the second operand. + +order_args([#b_var{}=VarA,#b_var{}=VarB], G, St) -> + {VA,VB} = {get_vertex(VarA, St),get_vertex(VarB, St)}, + case beam_digraph:is_path(G, VA, VB) of + true -> + %% Core Erlang code generated by v3_core always + %% has operands already in correct order. + {VarA,VarB}; + false -> + %% Core Erlang code generated by other frontends + %% such as LFE may have the operands swapped. + true = beam_digraph:is_path(G, VB, VA), %Assertion. + {VarB,VarB} + end; +order_args(_Args, _G, _St) -> + %% Literal operands. Can only happen if the Core Erlang optimization + %% passes have been turned off. + not_possible(). + +redirect_test(Bool, SuccFail, G0, St) -> + V = get_vertex(Bool, St), + I = get_def(Bool, G0, St), + case I of + #b_set{op=phi,args=Args} -> + G = ensure_single_use(Bool, G0, St), + redirect_phi(Bool, Args, SuccFail, G, St); + #b_set{} -> + G1 = redirect_test_1(V, SuccFail, G0), + G = ensure_single_use(Bool, G1, St), + do_opt_digraph([Bool], G, St) + end. + +redirect_test_1(V, SuccFail, G) -> + case get_targets(V, G) of + {br,_Succ,Fail} -> + %% I have only seen this happen in code generated by LFE + %% (in lfe_andor_SUITE.core and lfe_guard_SUITE.core) + case SuccFail of + {fail,Fail} -> G; + {succ,_} -> not_possible() + end; + {br,Next} -> + case SuccFail of + {succ,Succ} -> + add_succ_fail_edges(V, Succ, Next, G); + {fail,Fail} -> + add_succ_fail_edges(V, Next, Fail, G) + end + end. + +redirect_phi(Phi, Args, SuccFail, G0, St) -> + PhiVtx = get_vertex(Phi, St), + G = beam_digraph:add_vertex(G0, PhiVtx, br), + redirect_phi_1(PhiVtx, sort(Args), SuccFail, G, St). + +redirect_phi_1(PhiVtx, [{#b_literal{val=false},FalseExit}, + {#b_var{}=SuccBool,_BoolExit}], + SuccFail, G0, St) -> + BoolVtx = get_vertex(SuccBool, St), + [FalseOut] = beam_digraph:out_edges(G0, FalseExit), + G1 = beam_digraph:del_edge(G0, FalseOut), + case SuccFail of + {fail,Fail} -> + G2 = beam_digraph:add_edge(G1, FalseExit, Fail, next), + G = add_succ_fail_edges(BoolVtx, PhiVtx, FalseExit, G2), + do_opt_digraph([SuccBool], G, St); + {succ,Succ} -> + G2 = beam_digraph:add_edge(G1, FalseExit, PhiVtx, next), + G = add_succ_fail_edges(BoolVtx, Succ, PhiVtx, G2), + do_opt_digraph([SuccBool], G, St) + end; +redirect_phi_1(PhiVtx, [{#b_literal{val=true},TrueExit}, + {#b_var{}=SuccBool,_BoolExit}], + {fail,Fail}, G0, St) -> + %% This was probably an `orelse` in the source code. + BoolVtx = get_vertex(SuccBool, St), + [TrueOut] = beam_digraph:out_edges(G0, TrueExit), + G1 = beam_digraph:del_edge(G0, TrueOut), + G2 = beam_digraph:add_edge(G1, TrueExit, PhiVtx, next), + G = add_succ_fail_edges(BoolVtx, PhiVtx, Fail, G2), + %% As as future improvement, we could follow TrueExit + %% back to its originating boolean expression and + %% optimize that too. + do_opt_digraph([SuccBool], G, St); +redirect_phi_1(_PhiVtx, [{#b_literal{val=false},FalseExit}, + {#b_literal{val=true},TrueExit}], + SuccFail, G0, _St) -> + case SuccFail of + {fail,Fail} -> + [FalseOut] = beam_digraph:out_edges(G0, FalseExit), + G = beam_digraph:del_edge(G0, FalseOut), + beam_digraph:add_edge(G, FalseExit, Fail, next); + {succ,Succ} -> + [TrueOut] = beam_digraph:out_edges(G0, TrueExit), + G = beam_digraph:del_edge(G0, TrueOut), + beam_digraph:add_edge(G, TrueExit, Succ, next) + end; +redirect_phi_1(_PhiVtx, _Args, _SuccFail, _G, _St) -> + not_possible(). + +digraph_bool_def(G) -> + Vs = beam_digraph:vertices(G), + Ds = [{Dst,Vtx} || {Vtx,#b_set{dst=Dst}} <- Vs], + maps:from_list(Ds). + +%%% +%%% Shortcut branches that branch to other branches. +%%% +%%% Shortcutting may eliminate problems with variables that +%%% are not defined on all paths to their use. For example, +%%% code such as the following can be made safe again: +%%% +%%% ensure_written(Head, false) when not Head#head.ram_file -> ... +%%% +%%% Shortcutting also simplifies the conversion from the digraph +%%% back to the standard SSA format. +%%% + +shortcut_branches(Vtx, G, St) -> + Vs = reverse(beam_digraph:reverse_postorder(G, [Vtx])), + do_shortcut_branches(Vs, G, St). + +do_shortcut_branches([V|Vs], G0, St) -> + case get_targets(V, G0) of + {br,Succ0,Fail0} -> + {SuccBs,FailBs} = eval_bs(V, G0, St), + Succ = eval_instr(Succ0, G0, SuccBs), + G1 = redirect_edge(V, Succ0, {succ,Succ}, G0), + Fail = eval_instr(Fail0, G1, FailBs), + G = redirect_edge(V, Fail0, {fail,Fail}, G1), + do_shortcut_branches(Vs, G, St); + {br,Next0} -> + Next = eval_instr(Next0, G0, #{}), + G = redirect_edge(V, Next0, {next,Next}, G0), + do_shortcut_branches(Vs, G, St); + none -> + %% This is an external vertex. + do_shortcut_branches(Vs, G0, St) + end; +do_shortcut_branches([], G, _St) -> G. + +redirect_edge(_From, To, {_Label,To}, G) -> + G; +redirect_edge(From, To0, {Label,To}, G0) -> + G = beam_digraph:del_edge(G0, {From,To0,Label}), + beam_digraph:add_edge(G, From, To, Label). + +eval_bs(Vtx, G, St) -> + case beam_digraph:vertex(G, Vtx) of + #b_set{op={bif,'=:='},args=[#b_var{}=Bool,#b_literal{val=true}]} -> + case get_def(Bool, G, St) of + #b_set{op=phi}=Phi -> + phi_bs(Phi); + _ -> + {#{},#{}} + end; + _ -> + {#{},#{}} + end. + +phi_bs(#b_set{op=phi,dst=PhiDst,args=PhiArgs}) -> + Literals0 = [Lit || {#b_literal{}=Lit,_} <- PhiArgs], + case length(Literals0) =:= length(PhiArgs) of + true -> + %% The values in the phi node are all literals. + Literals = ordsets:from_list(Literals0), + case partition(fun(#b_literal{val=Val}) -> + Val =:= true + end, Literals) of + {[True],[FailVal]} -> + %% As there is only two possible values, we can + %% predict the value of the phi node on both + %% branches. + SuccBs = #{PhiDst => True}, + FailBs = #{PhiDst => FailVal}, + {SuccBs,FailBs}; + {_,_} -> + {#{},#{}} + end; + false -> + {#{},#{}} + end. + +eval_instr(Vtx, G, Bs) -> + case beam_digraph:vertex(G, Vtx) of + #b_set{} when map_size(Bs) =:= 0 -> + %% With no bindings, eval_safe_bool_expr() is + %% unlikely to do anything useful. If we would + %% call it anyway, the time complexity would be + %% quadratic, which would be slow for large + %% graphs. + Vtx; + #b_set{}=I -> + case is_safe_bool_expr(I) of + true -> eval_safe_bool_expr(I, Vtx, G, Bs); + false -> Vtx + end; + br -> + %% We can shortcut this branch unless its + %% target is a phi node. + [Next] = beam_digraph:out_neighbours(G, Vtx), + case beam_digraph:vertex(G, Next) of + #b_set{op=phi} -> Vtx; + _ -> eval_instr(Next, G, Bs) + end; + {br,#b_var{}} -> + Vtx; + {external,_} -> + Vtx + end. + +eval_safe_bool_expr(#b_set{op={bif,Bif},dst=Dst,args=Args0}, Vtx, G, Bs) -> + case get_targets(Vtx, G) of + {br,Succ,Fail} -> + True = #b_literal{val=true}, + False = #b_literal{val=false}, + Args = sub_args(Args0, Bs), + case eval_bif(Bif, Args) of + none -> + case {eval_instr(Succ, G, Bs#{Dst=>True}), + eval_instr(Fail, G, Bs#{Dst=>False})} of + {Same,Same} -> Same; + {_,_} -> Vtx + end; + true -> + eval_instr(Succ, G, Bs#{Dst=>True}); + false -> + eval_instr(Fail, G, Bs#{Dst=>False}) + end; + {br,_} -> + Vtx + end. + +eval_bif(Bif, Args0) -> + case eval_literal_args(Args0, []) of + none -> + none; + Args -> + %% We have already made sure that this expression can't + %% fail; thus there is no need for a `try`. + apply(erlang, Bif, Args) + end. + +eval_literal_args([#b_literal{val=Val}|As], Acc) -> + eval_literal_args(As, [Val|Acc]); +eval_literal_args([_|_], _) -> + none; +eval_literal_args([], Acc) -> + reverse(Acc). + +%%% +%%% Check that variables are initialized on all paths and abort +%%% the optimization if not. +%%% +%%% Expressions that use `or` and `not` may have added +%%% `bif:is_boolean` instructions at the end of the boolean +%%% expression. It can happen that the variables tested by +%%% `bif:is_boolean` are not initialized on all paths. +%%% + +ensure_init(Root, G, G0) -> + Vs = beam_digraph:vertices(G), + + %% Build an ordset of a all variables used by the code + %% before the optimization. + Used = ensure_init_used(G0), + + %% Build a map of all variables that are set by instructions in + %% the digraph. Variables not included in this map have been + %% defined by code before the code in the digraph. + Vars = maps:from_list([{Dst,unset} || + {_,#b_set{dst=Dst}} <- Vs]), + RPO = beam_digraph:reverse_postorder(G, [Root]), + ensure_init_1(RPO, Used, G, #{Root=>Vars}). + +ensure_init_1([V|Vs], Used, G, InitMaps0) -> + InitMaps = ensure_init_instr(V, Used, G, InitMaps0), + ensure_init_1(Vs, Used, G, InitMaps); +ensure_init_1([], _, _, _) -> ok. + +ensure_init_instr(Vtx, Used, G, InitMaps0) -> + VarMap0 = map_get(Vtx, InitMaps0), + case beam_digraph:vertex(G, Vtx) of + #b_set{dst=Dst}=I -> + do_ensure_init_instr(I, VarMap0, InitMaps0), + OutVs = beam_digraph:out_neighbours(G, Vtx), + VarMap = VarMap0#{Dst=>set}, + InitMaps = InitMaps0#{Vtx:=VarMap}, + ensure_init_successors(OutVs, G, VarMap, InitMaps); + {external,_} -> + %% We have reached the success or failure node. + %% If the code we have been optimizing does not + %% originate from a guard, it is possible that a + %% variable set in the optimized code will be used + %% here. + case [V || {V,unset} <- maps:to_list(VarMap0)] of + [] -> + InitMaps0; + [_|_]=Unset0 -> + %% There are some variables that are not always + %% set when this node is reached. We must make + %% sure that they are not used at this node or + %% one of its successors. + Unset = ordsets:from_list(Unset0), + case ordsets:is_subset(Unset, Used) of + true -> + %% Note that all of the potentially unset + %% variables are only used once (otherwise + %% the optimization would have been + %% aborted earlier). Therefore, since all + %% variables are used in the optimized code, + %% they cannot be used in this node or in one + %% of its successors. + InitMaps0; + false -> + %% The original code probably did not + %% originate from a guard. One of the + %% potentially unset variables are not + %% used in the optimized code. That means + %% that it must be used at this node or in + %% one of its successors. (Or that it was + %% not used at all in the original code, + %% but that basically only happens in test + %% cases.) + not_possible() + end + end; + _ -> + OutVs = beam_digraph:out_neighbours(G, Vtx), + ensure_init_successors(OutVs, G, VarMap0, InitMaps0) + end. + +ensure_init_used(G) -> + Vs = beam_digraph:vertices(G), + ensure_init_used_1(Vs, G, []). + +ensure_init_used_1([{Vtx,#b_set{dst=Dst}=I}|Vs], G, Acc0) -> + Acc1 = [beam_ssa:used(I)|Acc0], + case beam_digraph:out_degree(G, Vtx) of + 2 -> + Acc = [[Dst]|Acc1], + ensure_init_used_1(Vs, G, Acc); + _ -> + ensure_init_used_1(Vs, G, Acc1) + end; +ensure_init_used_1([{_Vtx,{br,Bool}}|Vs], G, Acc) -> + ensure_init_used_1(Vs, G, [[Bool]|Acc]); +ensure_init_used_1([_|Vs], G, Acc) -> + ensure_init_used_1(Vs, G, Acc); +ensure_init_used_1([], _G, Acc) -> + ordsets:union(Acc). + +do_ensure_init_instr(#b_set{op=phi,args=Args}, + _VarMap, InitMaps) -> + _ = [ensure_init_used(Var, map_get(From, InitMaps)) || + {#b_var{}=Var,From} <- Args], + ok; +do_ensure_init_instr(#b_set{}=I, VarMap, _InitMaps) -> + Used = beam_ssa:used(I), + _ = [ensure_init_used(Var, VarMap) || Var <- Used], + ok. + +ensure_init_used(Var, VarMap) -> + case VarMap of + #{Var:=unset} -> not_possible(); + #{Var:=set} -> ok; + #{} -> ok + end. + +ensure_init_successors([To|Vs], G, Vars0, InitMaps0) -> + case InitMaps0 of + #{To:=Vars1} -> + Vars = join_inits(Vars0, Vars1), + InitMaps = InitMaps0#{To:=Vars}, + ensure_init_successors(Vs, G, Vars0, InitMaps); + #{} -> + InitMaps = InitMaps0#{To=>Vars0}, + ensure_init_successors(Vs, G, Vars0, InitMaps) + end; +ensure_init_successors([], _, _, InitMaps) -> + InitMaps. + +join_inits(VarMap0, VarMap1) -> + join_inits_1(maps:to_list(VarMap0), VarMap1). + +join_inits_1([{V,State0}|Vs], VarMap) -> + State1 = map_get(V, VarMap), + State = case {State0,State1} of + {set,set} -> set; + {_,_} -> unset + end, + case State =:= State1 of + true -> + join_inits_1(Vs, VarMap); + false -> + join_inits_1(Vs, VarMap#{V:=State}) + end; +join_inits_1([], VarMap) -> + VarMap. + +%%% +%%% Transform the digraph back to standard SSA code. +%%% + +digraph_to_ssa(Ls, G, Blocks0) -> + Seen = cerl_sets:new(), + {Blocks,_} = digraph_to_ssa(Ls, G, Blocks0, Seen), + Blocks. + +digraph_to_ssa([L|Ls], G, Blocks0, Seen0) -> + Seen1 = cerl_sets:add_element(L, Seen0), + {Blk,Successors0} = digraph_to_ssa_blk(L, G, Blocks0, []), + Blocks1 = Blocks0#{L=>Blk}, + Successors = [S || S <- Successors0, + not cerl_sets:is_element(S, Seen1)], + {Blocks,Seen} = digraph_to_ssa(Successors, G, Blocks1, Seen1), + digraph_to_ssa(Ls, G, Blocks, Seen); +digraph_to_ssa([], _G, Blocks, Seen) -> + {Blocks,Seen}. + +digraph_to_ssa_blk(From, G, Blocks, Acc) -> + case beam_digraph:vertex(G, From) of + #b_set{dst=Dst}=I -> + case get_targets(From, G) of + {br,Succ,Fail} -> + %% This is a two-way branch that ends the current block. + Br = #b_br{bool=Dst,succ=Succ,fail=Fail}, + Is = reverse(Acc, [I]), + Blk = #b_blk{is=Is,last=Br}, + {Blk,beam_ssa:successors(Blk)}; + {br,Next} -> + case beam_digraph:in_degree(G, Next) of + 1 -> + digraph_to_ssa_blk(Next, G, Blocks, [I|Acc]); + _ -> + %% The Next node has multiple incident edge. That + %% means that it can't be part of the current block, + %% but must start a new block. + Br = oneway_br(Next), + Is = reverse(Acc, [I]), + Blk = #b_blk{is=Is,last=Br}, + {Blk,beam_ssa:successors(Blk)} + end + end; + br -> + case Acc of + [] -> + %% Create an empty block. + {br,Next} = get_targets(From, G), + Blk = #b_blk{is=[],last=oneway_br(Next)}, + {Blk,beam_ssa:successors(Blk)}; + [_|_] -> + %% Finish up the block, and let the block + %% transfer control to the `br` node at From. + Br = oneway_br(From), + Is = reverse(Acc), + Blk = #b_blk{is=Is,last=Br}, + {Blk,beam_ssa:successors(Blk)} + end; + {br,Bool} -> + %% This is a two-way `br` instruction. The most common + %% reason for its existence in the graph is that the root + %% node only contained a phi instruction (which was taken + %% out of the block before building the graph). + [] = Acc, %Assertion. + {br,Succ,Fail} = get_targets(From, G), + Br = #b_br{bool=Bool,succ=Succ,fail=Fail}, + Blk = #b_blk{is=[],last=Br}, + {Blk,beam_ssa:successors(Blk)}; + {external,Sub} -> + #b_blk{is=Is0} = Blk = map_get(From, Blocks), + Is = [I#b_set{args=sub_args(Args0, Sub)} || + #b_set{args=Args0}=I <- Is0], + {Blk#b_blk{is=Is},[]} + end. + +%%% +%%% Helper functions follow. +%%% + +%% get_def(Var, #st{}) -> #b_set{} | none. +%% Find the definition for a variable. Only boolean +%% expressions and phi nodes can be found. + +get_def(#b_var{}=Bool, #st{defs=Defs}) -> + case Defs of + #{Bool:={_,Def}} -> + Def; + #{} -> + none + end. + +%% get_def(Var, Graph, #st{}) -> #b_set{} | none. +%% Find the definition for a variable, looking first in the digraph +%% Graph. If it is not found there, look in the global map of +%% interesting definitions from the entire functions. + +get_def(Var, G, #st{ldefs=LDefs,defs=Defs}) -> + case LDefs of + #{Var:=Vtx} -> + beam_digraph:vertex(G, Vtx); + #{} -> + %% Not in the graph. Returning definitions for phi nodes + %% outside the graph is useful for shortcut_branches(). + case Defs of + #{Var:={_,Def}} -> Def; + #{} -> none + end + end. + +add_succ_fail_edges(From, Succ, Fail, G0) -> + G1 = beam_digraph:add_edge(G0, From, Succ, succ), + G = beam_digraph:add_edge(G1, From, Fail, fail), + case beam_digraph:out_edges(G0, From) of + [{From,_,next}=E] -> beam_digraph:del_edge(G, E); + [] -> G + end. + +get_vertex(#b_set{dst=Dst}, St) -> + get_vertex(Dst, St); +get_vertex(#b_var{}=Var, #st{ldefs=LDefs}) -> + map_get(Var, LDefs). + +get_targets(Vtx, G) when is_integer(Vtx) -> + case beam_digraph:out_edges(G, Vtx) of + [{_,To,next}] -> + {br,To}; + [{_,Succ,succ},{_,Fail,fail}] -> + {br,Succ,Fail}; + [{_,Fail,fail},{_,Succ,succ}] -> + {br,Succ,Fail}; + [] -> + none + end. + +get_targets(#b_var{}=Var, G, #st{ldefs=LDefs}) -> + get_targets(map_get(Var, LDefs), G). + +del_out_edges(V, G) -> + beam_digraph:del_edges(G, beam_digraph:out_edges(G, V)). + +covered(From, To, G) -> + Seen0 = gb_sets:empty(), + {yes,Seen} = covered_1(From, To, G, Seen0), + gb_sets:to_list(Seen). + +covered_1(To, To, _G, Seen) -> + {yes,Seen}; +covered_1(From, To, G, Seen0) -> + Vs0 = beam_digraph:out_neighbours(G, From), + Vs = [V || V <- Vs0, not gb_sets:is_member(V, Seen0)], + Seen = gb_sets:union(gb_sets:from_list(Vs), Seen0), + case Vs of + [] -> + no; + [_|_] -> + covered_list(Vs, To, G, Seen, false) + end. + +covered_list([V|Vs], To, G, Seen0, AnyFound) -> + case covered_1(V, To, G, Seen0) of + {yes,Seen} -> + covered_list(Vs, To, G, Seen, true); + no -> + covered_list(Vs, To, G, Seen0, AnyFound) + end; +covered_list([], _, _, Seen, AnyFound) -> + case AnyFound of + true -> {yes,Seen}; + false -> no + end. + +digraph_roots(G) -> + digraph_roots_1(beam_digraph:vertices(G), G). + +digraph_roots_1([{V,_}|Vs], G) -> + case beam_digraph:in_degree(G, V) of + 0 -> + [V|digraph_roots_1(Vs, G)]; + _ -> + digraph_roots_1(Vs, G) + end; +digraph_roots_1([], _G) -> []. + +not_possible() -> + throw(not_possible). + +new_label(#st{count=Count}=St) -> + {Count,St#st{count=Count+1}}. + +sub_args(Args, Sub) -> + [sub_arg(Arg, Sub) || Arg <- Args]. + +sub_arg({#b_var{}=Arg,From}, Sub) when is_integer(From) -> + {do_sub_arg(Arg, Sub),From}; +sub_arg(#b_var{}=Arg, Sub) -> + do_sub_arg(Arg, Sub); +sub_arg(#b_remote{mod=Mod,name=Name}=Rem, Sub) -> + Rem#b_remote{mod=do_sub_arg(Mod, Sub), + name=do_sub_arg(Name, Sub)}; +sub_arg(Arg, _Sub) -> Arg. + +do_sub_arg(#b_var{}=Old, Sub) -> + case Sub of + #{Old:=#b_literal{}=New} -> New; + #{Old:=#b_var{}=New} -> New; + #{} -> Old + end; +do_sub_arg(#b_literal{}=Old, _Sub) -> Old. + +is_bool_expr(#b_set{op={bif,Op},args=Args}) -> + Arity = length(Args), + erl_internal:comp_op(Op, Arity) orelse + erl_internal:new_type_test(Op, Arity) orelse + erl_internal:bool_op(Op, Arity); +is_bool_expr(_) -> false. + +%% Test whether the expression always succeeds and +%% always returns a boolean. +is_safe_bool_expr(#b_set{op={bif,Op},args=Args}) -> + Arity = length(Args), + erl_internal:comp_op(Op, Arity) orelse + erl_internal:new_type_test(Op, Arity); +is_safe_bool_expr(#b_set{}) -> false. + +oneway_br(To) -> + #b_br{bool=#b_literal{val=true},succ=To,fail=To}. diff --git a/lib/compiler/src/beam_ssa_bsm.erl b/lib/compiler/src/beam_ssa_bsm.erl index cb36f1c242..1d5a99a7a1 100644 --- a/lib/compiler/src/beam_ssa_bsm.erl +++ b/lib/compiler/src/beam_ssa_bsm.erl @@ -57,6 +57,7 @@ -export([module/2, format_error/1]). -include("beam_ssa.hrl"). +-include("beam_types.hrl"). -import(lists, [member/2, reverse/1, reverse/2, splitwith/2, map/2, foldl/3, mapfoldl/3, nth/2, max/1, unzip/1]). @@ -469,7 +470,7 @@ combine_matches(#b_function{bs=Blocks0,cnt=Counter0}=F, ModInfo) -> cm_1([#b_set{ op=bs_start_match, dst=Ctx, - args=[Src] }, + args=[_,Src] }, #b_set{ op=succeeded, dst=Bool, args=[Ctx] }]=MatchSeq, Acc0, Lbl, State0) -> @@ -574,7 +575,7 @@ aca_1(Blocks, State) -> EntryBlock = maps:get(0, Blocks), aca_enable_reuse(EntryBlock#b_blk.is, EntryBlock, Blocks, [], State). -aca_enable_reuse([#b_set{op=bs_start_match,args=[Src]}=I0 | Rest], +aca_enable_reuse([#b_set{op=bs_start_match,args=[_,Src]}=I0 | Rest], EntryBlock, Blocks0, Acc, State0) -> case aca_is_reuse_safe(Src, State0) of true -> @@ -618,7 +619,8 @@ aca_is_reuse_safe(Src, State) -> %% they're unused so far. ordsets:is_element(Src, State#aca.unused_parameters). -aca_reuse_context(#b_set{dst=Dst, args=[Src]}=I0, Block, Blocks0, State0) -> +aca_reuse_context(#b_set{op=bs_start_match,dst=Dst,args=[_,Src]}=I0, + Block, Blocks0, State0) -> %% When matching fails on a reused context it needs to be converted back %% to a binary. We only need to do this on the success path since it can't %% be a context on the type failure path, but it's very common for these @@ -687,9 +689,9 @@ aca_copy_successors(Lbl0, Blocks0, Counter0) -> Lbl = maps:get(Lbl0, BRs), {Lbl, Blocks, Counter}. -aca_cs_build_brs([?BADARG_BLOCK=Lbl | Path], Counter, Acc) -> - %% ?BADARG_BLOCK is a marker and not an actual block, so renaming it will - %% break exception handling. +aca_cs_build_brs([?EXCEPTION_BLOCK=Lbl | Path], Counter, Acc) -> + %% ?EXCEPTION_BLOCK is a marker and not an actual block, so renaming it + %% will break exception handling. aca_cs_build_brs(Path, Counter, Acc#{ Lbl => Lbl }); aca_cs_build_brs([Lbl | Path], Counter0, Acc) -> aca_cs_build_brs(Path, Counter0 + 1, Acc#{ Lbl => Counter0 }); @@ -874,25 +876,25 @@ sote_rewrite_call(Call0, [Arg | ArgsIn], ArgsOut, State0) -> sote_rewrite_call(Call0, ArgsIn, [Arg | ArgsOut], State0) end. -%% Adds parameter_type_info annotations to help the validator determine whether -%% our optimizations were safe. +%% Adds parameter annotations to help the validator determine whether our +%% optimizations were safe. annotate_context_parameters({Fs, ModInfo}) -> mapfoldl(fun annotate_context_parameters/2, ModInfo, Fs). annotate_context_parameters(F, ModInfo) -> ParamInfo = funcinfo_get(F, parameter_info, ModInfo), - TypeAnno0 = beam_ssa:get_anno(parameter_type_info, F, #{}), - TypeAnno = maps:fold(fun(K, _V, Acc) when is_map_key(K, Acc) -> - %% Assertion. - error(conflicting_parameter_types); - (K, suitable_for_reuse, Acc) -> - T = beam_validator:type_anno(match_context), - Acc#{ K => T }; - (_K, _V, Acc) -> - Acc - end, TypeAnno0, ParamInfo), - {beam_ssa:add_anno(parameter_type_info, TypeAnno, F), ModInfo}. + ParamAnno0 = beam_ssa:get_anno(parameter_info, F, #{}), + ParamAnno = maps:fold(fun(K, _V, Acc) when is_map_key(K, Acc) -> + %% Assertion. + error(conflicting_parameter_types); + (K, suitable_for_reuse, Acc) -> + Info = maps:get(K, Acc, []), + Acc#{ K => [accepts_match_context | Info] }; + (_K, _V, Acc) -> + Acc + end, ParamAnno0, ParamInfo), + {beam_ssa:add_anno(parameter_info, ParamAnno, F), ModInfo}. %%% %%% +bin_opt_info diff --git a/lib/compiler/src/beam_ssa_codegen.erl b/lib/compiler/src/beam_ssa_codegen.erl index 08641e2abc..5799f0e00f 100644 --- a/lib/compiler/src/beam_ssa_codegen.erl +++ b/lib/compiler/src/beam_ssa_codegen.erl @@ -28,7 +28,7 @@ -include("beam_ssa.hrl"). --import(lists, [foldl/3,keymember/3,keysort/2,last/1,map/2,mapfoldl/3, +-import(lists, [foldl/3,keymember/3,keysort/2,map/2,mapfoldl/3, reverse/1,reverse/2,sort/1,splitwith/2,takewhile/2]). -record(cg, {lcount=1 :: beam_label(), %Label counter @@ -37,7 +37,8 @@ used_labels=gb_sets:empty() :: gb_sets:set(ssa_label()), regs=#{} :: #{beam_ssa:var_name()=>ssa_register()}, ultimate_fail=1 :: beam_label(), - catches=gb_sets:empty() :: gb_sets:set(ssa_label()) + catches=gb_sets:empty() :: gb_sets:set(ssa_label()), + fc_label=1 :: beam_label() }). -spec module(beam_ssa:b_module(), [compile:option()]) -> @@ -114,17 +115,17 @@ functions(Forms, AtomMod) -> function(#b_function{anno=Anno,bs=Blocks}, AtomMod, St0) -> #{func_info:={_,Name,Arity}} = Anno, try - assert_badarg_block(Blocks), %Assertion. + assert_exception_block(Blocks), %Assertion. Regs = maps:get(registers, Anno), St1 = St0#cg{labels=#{},used_labels=gb_sets:empty(), regs=Regs}, {Fi,St2} = new_label(St1), %FuncInfo label {Entry,St3} = local_func_label(Name, Arity, St2), {Ult,St4} = new_label(St3), %Ultimate failure - Labels = (St4#cg.labels)#{0=>Entry,?BADARG_BLOCK=>0}, + Labels = (St4#cg.labels)#{0=>Entry,?EXCEPTION_BLOCK=>0}, St5 = St4#cg{labels=Labels,used_labels=gb_sets:singleton(Entry), ultimate_fail=Ult}, - {Body,St} = cg_fun(Blocks, St5), + {Body,St} = cg_fun(Blocks, St5#cg{fc_label=Fi}), Asm = [{label,Fi},line(Anno), {func_info,AtomMod,{atom,Name},Arity}] ++ add_parameter_annos(Body, Anno) ++ @@ -137,10 +138,10 @@ function(#b_function{anno=Anno,bs=Blocks}, AtomMod, St0) -> erlang:raise(Class, Error, Stack) end. -assert_badarg_block(Blocks) -> - %% Assertion: ?BADARG_BLOCK must be the call erlang:error(badarg). +assert_exception_block(Blocks) -> + %% Assertion: ?EXCEPTION_BLOCK must be a call erlang:error(badarg). case Blocks of - #{?BADARG_BLOCK:=Blk} -> + #{?EXCEPTION_BLOCK:=Blk} -> #b_blk{is=[#b_set{op=call,dst=Ret, args=[#b_remote{mod=#b_literal{val=erlang}, name=#b_literal{val=error}}, @@ -148,19 +149,21 @@ assert_badarg_block(Blocks) -> last=#b_ret{arg=Ret}} = Blk, ok; #{} -> - %% ?BADARG_BLOCK has been removed because it was never used. + %% ?EXCEPTION_BLOCK has been removed because it was never used. ok end. add_parameter_annos([{label, _}=Entry | Body], Anno) -> - ParamInfo = maps:get(parameter_type_info, Anno, #{}), + ParamTypes = maps:get(parameter_info, Anno, #{}), + Annos = maps:fold( - fun(K, V, Acc) when is_map_key(K, ParamInfo) -> - TypeInfo = maps:get(K, ParamInfo), - [{'%', {type_info, V, TypeInfo}} | Acc]; + fun(K, V, Acc) when is_map_key(K, ParamTypes) -> + Info = map_get(K, ParamTypes), + [{'%', {var_info, V, Info}} | Acc]; (_K, _V, Acc) -> Acc end, [], maps:get(registers, Anno)), + [Entry | sort(Annos)] ++ Body. cg_fun(Blocks, St0) -> @@ -365,7 +368,7 @@ classify_heap_need(bs_save) -> neutral; classify_heap_need(bs_get_position) -> gc; classify_heap_need(bs_set_position) -> neutral; classify_heap_need(bs_skip) -> gc; -classify_heap_need(bs_start_match) -> neutral; +classify_heap_need(bs_start_match) -> gc; classify_heap_need(bs_test_tail) -> neutral; classify_heap_need(bs_utf16_size) -> neutral; classify_heap_need(bs_utf8_size) -> neutral; @@ -384,6 +387,7 @@ classify_heap_need(is_tagged_tuple) -> neutral; classify_heap_need(kill_try_tag) -> gc; classify_heap_need(landingpad) -> gc; classify_heap_need(make_fun) -> gc; +classify_heap_need(match_fail) -> gc; classify_heap_need(new_try_tag) -> gc; classify_heap_need(peek_message) -> gc; classify_heap_need(put_map) -> gc; @@ -629,7 +633,7 @@ liveness_get(S, LiveMap) -> end. liveness_successors(Terminator) -> - successors(Terminator) -- [?BADARG_BLOCK]. + successors(Terminator) -- [?EXCEPTION_BLOCK]. liveness_is([#cg_alloc{}=I0|Is], Regs, Live, Acc) -> I = I0#cg_alloc{live=num_live(Live, Regs)}, @@ -973,6 +977,12 @@ cg_block(Is0, Last, Next, St0) -> case Last of #cg_br{succ=Next,fail=Next} -> cg_block(Is0, none, St0); + #cg_br{succ=Same,fail=Same} when Same =:= ?EXCEPTION_BLOCK -> + %% An expression in this block *always* throws an exception, so we + %% terminate it with an 'if_end' to make sure the validator knows + %% that the following instructions won't actually be reached. + {Is,St} = cg_block(Is0, none, St0), + {Is++[if_end],St}; #cg_br{succ=Same,fail=Same} -> {Fail,St1} = use_block_label(Same, St0), {Is,St} = cg_block(Is0, none, St1), @@ -1136,7 +1146,10 @@ cg_block([#cg_set{op=bs_init,dst=Dst0,args=Args0,anno=Anno}=I, Is = [Line,{bs_append,Fail,Bits,Alloc,Live,Unit,Src,Flags,Dst}], {Is,St} end; -cg_block([#cg_set{anno=Anno,op=bs_start_match,dst=Ctx0,args=[Bin0]}=I, +cg_block([#cg_set{anno=Anno, + op=bs_start_match, + dst=Ctx0, + args=[#b_literal{val=new},Bin0]}=I, #cg_set{op=succeeded,dst=Bool}], {Bool,Fail}, St) -> [Dst,Bin1] = beam_args([Ctx0,Bin0], St), {Bin,Pre} = force_reg(Bin1, Dst), @@ -1178,6 +1191,10 @@ cg_block([#cg_set{op=call}=I, #cg_set{op=succeeded,dst=Bool}], {Bool,_Fail}, St) -> %% A call in try/catch block. cg_block([I], none, St); +cg_block([#cg_set{op=match_fail}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,_Fail}, St) -> + %% A match_fail instruction in a try/catch block. + cg_block([I], none, St); cg_block([#cg_set{op=get_map_element,dst=Dst0,args=Args0}, #cg_set{op=succeeded,dst=Bool}], {Bool,Fail0}, St) -> [Dst,Map,Key] = beam_args([Dst0|Args0], St), @@ -1201,8 +1218,9 @@ cg_block([#cg_set{op=is_tagged_tuple,dst=Bool,args=Args0}], {Bool,Fail}, St) -> cg_block([#cg_set{op=is_nonempty_list,dst=Bool,args=Args0}], {Bool,Fail}, St) -> Args = beam_args(Args0, St), {[{test,is_nonempty_list,ensure_label(Fail, St),Args}],St}; -cg_block([#cg_set{op=has_map_field,dst=Bool,args=Args0}], {Bool,Fail}, St) -> +cg_block([#cg_set{op=has_map_field,dst=Bool,args=Args0}], {Bool,Fail0}, St) -> [Src,Key] = beam_args(Args0, St), + Fail = ensure_label(Fail0, St), {[{test,has_map_fields,Fail,Src,{list,[Key]}}],St}; cg_block([#cg_set{op=call}=Call], {_Bool,_Fail}=Context, St0) -> {Is0,St1} = cg_call(Call, body, none, St0), @@ -1220,15 +1238,24 @@ cg_block([#cg_set{op=call}=Call|T], Context, St0) -> {Is0,St1} = cg_call(Call, body, none, St0), {Is1,St} = cg_block(T, Context, St1), {Is0++Is1,St}; -cg_block([#cg_set{op=make_fun,dst=Dst0,args=[Local|Args0]}|T], +cg_block([#cg_set{anno=Anno,op=make_fun,dst=Dst0,args=[Local|Args0]}|T], Context, St0) -> #b_local{name=#b_literal{val=Func},arity=Arity} = Local, [Dst|Args] = beam_args([Dst0|Args0], St0), {FuncLbl,St1} = local_func_label(Func, Arity, St0), Is0 = setup_args(Args) ++ [{make_fun2,{f,FuncLbl},0,0,length(Args)}|copy({x,0}, Dst)], - {Is1,St} = cg_block(T, Context, St1), - {Is0++Is1,St}; + + Is1 = case Anno of + #{ result_type := Type } -> + Info = {var_info, Dst, [{fun_type, Type}]}, + Is0 ++ [{'%', Info}]; + #{} -> + Is0 + end, + + {Is2,St} = cg_block(T, Context, St1), + {Is1++Is2,St}; cg_block([#cg_set{op=copy}|_]=T0, Context, St0) -> {Is0,T} = cg_copy(T0, St0), {Is1,St} = cg_block(T, Context, St0), @@ -1239,6 +1266,28 @@ cg_block([#cg_set{op=copy}|_]=T0, Context, St0) -> no -> {Is,St} end; +cg_block([#cg_set{op=match_fail,args=Args0,anno=Anno}], none, St) -> + Args = beam_args(Args0, St), + Is = cg_match_fail(Args, line(Anno), none), + {Is,St}; +cg_block([#cg_set{op=match_fail,args=Args0,anno=Anno}|T], Context, St0) -> + FcLabel = case Context of + {return,_,none} -> + %% There is no stack frame. If this is a function_clause + %% exception, it is safe to jump to the label of the + %% func_info instruction. + St0#cg.fc_label; + _ -> + %% This is most probably not a function_clause. + %% If this is a function_clause exception + %% (rare), it is not safe to jump to the + %% func_info label. + none + end, + Args = beam_args(Args0, St0), + Is0 = cg_match_fail(Args, line(Anno), FcLabel), + {Is1,St} = cg_block(T, Context, St0), + {Is0++Is1,St}; cg_block([#cg_set{op=Op,dst=Dst0,args=Args0}=Set], none, St) -> [Dst|Args] = beam_args([Dst0|Args0], St), Is = cg_instr(Op, Args, Dst, Set), @@ -1270,8 +1319,7 @@ cg_copy(T0, St) -> end, T0), Moves0 = cg_copy_1(Copies, St), Moves1 = [Move || {move,Src,Dst}=Move <- Moves0, Src =/= Dst], - Scratch = {x,1022}, - Moves = order_moves(Moves1, Scratch), + Moves = order_moves(Moves1), {Moves,T}. cg_copy_1([#cg_set{dst=Dst0,args=Args}|T], St) -> @@ -1473,8 +1521,9 @@ cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=[#b_local{}=Func0|Args0]}, Call = build_call(call, Arity, {f,FuncLbl}, Context, Dst), Is = setup_args(Args, Anno, Context, St) ++ Line ++ Call, case Anno of - #{ result_type := Info } -> - {Is ++ [{'%', {type_info, Dst, Info}}], St}; + #{ result_type := Type } -> + Info = {var_info, Dst, [{type,Type}]}, + {Is ++ [{'%', Info}], St}; #{} -> {Is, St} end; @@ -1510,7 +1559,49 @@ cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=Args0}, Arity = length(Args), Call = build_call(call_fun, Arity, Func, Context, Dst), Is = setup_args(Args++[Func], Anno, Context, St) ++ Line ++ Call, - {Is,St}. + case Anno of + #{ result_type := Type } -> + Info = {var_info, Dst, [{type,Type}]}, + {Is ++ [{'%', Info}], St}; + #{} -> + {Is, St} + end. + +cg_match_fail([{atom,function_clause}|Args], Line, Fc) -> + case Fc of + none -> + %% There is a stack frame (probably because of inlining). + %% Jumping to the func_info label is not allowed by + %% beam_validator. Rewrite the instruction as a call to + %% erlang:error/2. + make_fc(Args, Line); + _ -> + setup_args(Args) ++ [{jump,{f,Fc}}] + end; +cg_match_fail([{atom,Op}], Line, _Fc) -> + [Line,Op]; +cg_match_fail([{atom,Op},Val], Line, _Fc) -> + [Line,{Op,Val}]. + +make_fc(Args, Line) -> + %% Recreate the original call to erlang:error/2. + Live = foldl(fun({x,X}, A) -> max(X+1, A); + (_, A) -> A + end, 0, Args), + TmpReg = {x,Live}, + StkMoves = build_stk(reverse(Args), TmpReg, nil), + [{test_heap,2*length(Args),Live}|StkMoves] ++ + [{move,{atom,function_clause},{x,0}}, + Line, + {call_ext,2,{extfunc,erlang,error,2}}]. + +build_stk([V], _TmpReg, Tail) -> + [{put_list,V,Tail,{x,1}}]; +build_stk([V|Vs], TmpReg, Tail) -> + I = {put_list,V,Tail,TmpReg}, + [I|build_stk(Vs, TmpReg, TmpReg)]; +build_stk([], _TmpReg, nil) -> + [{move,nil,{x,1}}]. build_call(call_fun, Arity, _Func, none, Dst) -> [{call_fun,Arity}|copy({x,0}, Dst)]; @@ -1550,15 +1641,22 @@ build_apply(Arity, {return,Val,N}, _Dst) when is_integer(N) -> build_apply(Arity, none, Dst) -> [{apply,Arity}|copy({x,0}, Dst)]. -cg_instr(put_map, [{atom,assoc},SrcMap|Ss], Dst, Set) -> +cg_instr(bs_start_match, [{atom,resume}, Src], Dst, Set) -> Live = get_live(Set), - [{put_map_assoc,{f,0},SrcMap,Dst,Live,{list,Ss}}]; + [{bs_start_match4,{atom,resume},Live,Src,Dst}]; +cg_instr(bs_start_match, [{atom,new}, Src0], Dst, Set) -> + {Src, Pre} = force_reg(Src0, Dst), + Live = get_live(Set), + Pre ++ [{bs_start_match4,{atom,no_fail},Live,Src,Dst}]; cg_instr(bs_get_tail, [Src], Dst, Set) -> Live = get_live(Set), [{bs_get_tail,Src,Dst,Live}]; cg_instr(bs_get_position, [Ctx], Dst, Set) -> Live = get_live(Set), [{bs_get_position,Ctx,Dst,Live}]; +cg_instr(put_map, [{atom,assoc},SrcMap|Ss], Dst, Set) -> + Live = get_live(Set), + [{put_map_assoc,{f,0},SrcMap,Dst,Live,{list,Ss}}]; cg_instr(Op, Args, Dst, _Set) -> cg_instr(Op, Args, Dst). @@ -1592,6 +1690,8 @@ cg_instr(get_tl=Op, [Src], Dst) -> [{Op,Src,Dst}]; cg_instr(get_tuple_element=Op, [Src,{integer,N}], Dst) -> [{Op,Src,N,Dst}]; +cg_instr(has_map_field, [Map,Key], Dst) -> + [{bif,is_map_key,{f,0},[Key,Map],Dst}]; cg_instr(put_list=Op, [Hd,Tl], Dst) -> [{Op,Hd,Tl,Dst}]; cg_instr(put_tuple, Elements, Dst) -> @@ -1728,7 +1828,7 @@ cg_catch(Agg, T0, Context, St0) -> cg_try(Agg, Tag, T0, Context, St0) -> {Moves0,T1} = cg_extract(T0, Agg, St0), - Moves = order_moves(Moves0, {x,3}), + Moves = order_moves(Moves0), [#cg_set{op=kill_try_tag}|T2] = T1, {T,St} = cg_block(T2, Context, St0), {[{try_case,Tag}|Moves++T],St}. @@ -1780,7 +1880,7 @@ linearize(Blocks) -> Linear = beam_ssa:linearize(Blocks), linearize_1(Linear, Blocks). -linearize_1([{?BADARG_BLOCK,_}|Ls], Blocks) -> +linearize_1([{?EXCEPTION_BLOCK,_}|Ls], Blocks) -> linearize_1(Ls, Blocks); linearize_1([{L,Block0}|Ls], Blocks) -> Block = translate_block(L, Block0, Blocks), @@ -1884,8 +1984,7 @@ setup_args([]) -> []; setup_args([_|_]=Args) -> Moves = gen_moves(Args, 0, []), - Scratch = {x,1+last(sort([length(Args)-1|[X || {x,X} <- Args]]))}, - order_moves(Moves, Scratch). + order_moves(Moves). %% kill_yregs(Anno, #cg{}) -> [{kill,{y,Y}}]. %% Kill Y registers that will not be used again. @@ -1905,47 +2004,48 @@ gen_moves([A|As], I, Acc) -> gen_moves([], _, Acc) -> keysort(3, Acc). -%% order_moves([Move], ScratchReg) -> [Move] +%% order_moves([Move]) -> [Move] %% Orders move instruction so that source registers are not %% destroyed before they are used. If there are cycles %% (such as {move,{x,0},{x,1}}, {move,{x,1},{x,1}}), -%% the scratch register is used to break up the cycle. -%% If possible, the first move of the input list is placed +%% swap instructions will be used to break up the cycle. +%% +%% If possible, the first move of the input list is placed %% last in the result list (to make the move to {x,0} occur %% just before the call to allow the Beam loader to coalesce %% the instructions). -order_moves(Ms, Scr) -> order_moves(Ms, Scr, []). +order_moves(Ms) -> order_moves(Ms, []). -order_moves([{move,_,_}=M|Ms0], ScrReg, Acc0) -> - {Chain,Ms} = collect_chain(Ms0, [M], ScrReg), +order_moves([{move,_,_}=M|Ms0], Acc0) -> + {Chain,Ms} = collect_chain(Ms0, [M]), Acc = reverse(Chain, Acc0), - order_moves(Ms, ScrReg, Acc); -order_moves([], _, Acc) -> Acc. + order_moves(Ms, Acc); +order_moves([], Acc) -> Acc. -collect_chain(Ms, Path, ScrReg) -> - collect_chain(Ms, Path, [], ScrReg). +collect_chain(Ms, Path) -> + collect_chain(Ms, Path, []). -collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others, ScrReg) -> +collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others) -> case keymember(Src, 3, Path) of false -> - collect_chain(reverse(Others, Ms0), [M|Path], [], ScrReg); + collect_chain(reverse(Others, Ms0), [M|Path], []); true -> - %% There is a cycle, which we must break up. - {break_up_cycle(M, Path, ScrReg),reverse(Others, Ms0)} + %% There is a cycle. + {break_up_cycle(M, Path),reverse(Others, Ms0)} end; -collect_chain([M|Ms], Path, Others, ScrReg) -> - collect_chain(Ms, Path, [M|Others], ScrReg); -collect_chain([], Path, Others, _) -> +collect_chain([M|Ms], Path, Others) -> + collect_chain(Ms, Path, [M|Others]); +collect_chain([], Path, Others) -> {Path,Others}. -break_up_cycle({move,Src,_}=M, Path, ScrReg) -> - [{move,ScrReg,Src},M|break_up_cycle1(Src, Path, ScrReg)]. +break_up_cycle({move,Src,_Dst}=M, Path) -> + break_up_cycle_1(Src, [M|Path], []). -break_up_cycle1(Dst, [{move,Src,Dst}|Path], ScrReg) -> - [{move,Src,ScrReg}|Path]; -break_up_cycle1(Dst, [M|Path], LastMove) -> - [M|break_up_cycle1(Dst, Path, LastMove)]. +break_up_cycle_1(Dst, [{move,_Src,Dst}|Path], Acc) -> + reverse(Acc, Path); +break_up_cycle_1(Dst, [{move,S,D}|Path], Acc) -> + break_up_cycle_1(Dst, Path, [{swap,S,D}|Acc]). %%% %%% General utility functions. diff --git a/lib/compiler/src/beam_ssa_dead.erl b/lib/compiler/src/beam_ssa_dead.erl index e78e4647a8..021b773419 100644 --- a/lib/compiler/src/beam_ssa_dead.erl +++ b/lib/compiler/src/beam_ssa_dead.erl @@ -28,7 +28,7 @@ -include("beam_ssa.hrl"). -import(lists, [append/1,keymember/3,last/1,member/2, - takewhile/2,reverse/1]). + reverse/1,sort/1,takewhile/2]). -type used_vars() :: #{beam_ssa:label():=cerl_sets:set(beam_ssa:var_name())}. @@ -97,38 +97,38 @@ shortcut_opt(#st{bs=Blocks}=St) -> %% in the first clause of shortcut_2/5). Ls = beam_ssa:rpo(Blocks), - shortcut_opt(Ls, #{}, St). + shortcut_opt(Ls, St). -shortcut_opt([L|Ls], Bs, #st{bs=Blocks0}=St) -> +shortcut_opt([L|Ls], #st{bs=Blocks0}=St) -> #b_blk{is=Is,last=Last0} = Blk0 = get_block(L, St), - case shortcut_terminator(Last0, Is, L, Bs, St) of + case shortcut_terminator(Last0, Is, L, St) of Last0 -> %% No change. No need to update the block. - shortcut_opt(Ls, Bs, St); + shortcut_opt(Ls, St); Last -> %% The terminator was simplified in some way. %% Update the block. Blk = Blk0#b_blk{last=Last}, Blocks = Blocks0#{L=>Blk}, - shortcut_opt(Ls, Bs, St#st{bs=Blocks}) + shortcut_opt(Ls, St#st{bs=Blocks}) end; -shortcut_opt([], _, St) -> St. +shortcut_opt([], St) -> St. shortcut_terminator(#b_br{bool=#b_literal{val=true},succ=Succ0}, - _Is, From, Bs, St0) -> + _Is, From, St0) -> St = St0#st{rel_op=none}, - shortcut(Succ0, From, Bs, St); + shortcut(Succ0, From, #{}, St); shortcut_terminator(#b_br{bool=#b_var{}=Bool,succ=Succ0,fail=Fail0}=Br, - Is, From, Bs, St0) -> + Is, From, St0) -> St = St0#st{target=one_way}, RelOp = get_rel_op(Bool, Is), %% The boolean in a `br` is seldom used by the successors. By %% not binding its value unless it is actually used we might be able %% to skip some work in shortcut/4 and sub/2. - SuccBs = bind_var_if_used(Succ0, Bool, #b_literal{val=true}, Bs, St), + SuccBs = bind_var_if_used(Succ0, Bool, #b_literal{val=true}, St), BrSucc = shortcut(Succ0, From, SuccBs, St#st{rel_op=RelOp}), - FailBs = bind_var_if_used(Fail0, Bool, #b_literal{val=false}, Bs, St), + FailBs = bind_var_if_used(Fail0, Bool, #b_literal{val=false}, St), BrFail = shortcut(Fail0, From, FailBs, St#st{rel_op=invert_op(RelOp)}), case {BrSucc,BrFail} of @@ -141,19 +141,34 @@ shortcut_terminator(#b_br{bool=#b_var{}=Bool,succ=Succ0,fail=Fail0}=Br, %% No change. Br end; -shortcut_terminator(#b_switch{arg=Bool,list=List0}=Sw, _Is, From, Bs, St) -> - List = shortcut_switch(List0, Bool, From, Bs, St), - beam_ssa:normalize(Sw#b_switch{list=List}); -shortcut_terminator(Last, _Is, _Bs, _From, _St) -> +shortcut_terminator(#b_switch{arg=Bool,fail=Fail0,list=List0}=Sw, + _Is, From, St) -> + Fail = shortcut_sw_fail(Fail0, List0, Bool, From, St), + List = shortcut_sw_list(List0, Bool, From, St), + beam_ssa:normalize(Sw#b_switch{fail=Fail,list=List}); +shortcut_terminator(Last, _Is, _From, _St) -> Last. -shortcut_switch([{Lit,L0}|T], Bool, From, Bs, St0) -> +shortcut_sw_fail(Fail0, List, Bool, From, St0) -> + case sort(List) of + [{#b_literal{val=false},_}, + {#b_literal{val=true},_}] -> + RelOp = {{'not',is_boolean},Bool}, + St = St0#st{rel_op=RelOp,target=one_way}, + #b_br{bool=#b_literal{val=true},succ=Fail} = + shortcut(Fail0, From, #{}, St), + Fail; + _ -> + Fail0 + end. + +shortcut_sw_list([{Lit,L0}|T], Bool, From, St0) -> RelOp = {'=:=',Bool,Lit}, St = St0#st{rel_op=RelOp}, #b_br{bool=#b_literal{val=true},succ=L} = - shortcut(L0, From, bind_var(Bool, Lit, Bs), St#st{target=one_way}), - [{Lit,L}|shortcut_switch(T, Bool, From, Bs, St0)]; -shortcut_switch([], _, _, _, _) -> []. + shortcut(L0, From, bind_var(Bool, Lit, #{}), St#st{target=one_way}), + [{Lit,L}|shortcut_sw_list(T, Bool, From, St0)]; +shortcut_sw_list([], _, _, _) -> []. shortcut(L, _From, Bs, #st{rel_op=none,target=one_way}) when map_size(Bs) =:= 0 -> %% There is no way that we can find a suitable branch, because there is no @@ -409,8 +424,10 @@ is_br_safe(UnsetVars, Br, #st{us=Us}=St) -> is_forbidden(L, St) -> case get_block(L, St) of - #b_blk{is=[#b_set{op=phi}|_]} -> true; - #b_blk{is=[#b_set{op=peek_message}|_]} -> true; + #b_blk{is=[#b_set{op=phi}|_]} -> + true; + #b_blk{is=[#b_set{}=I|_]} -> + beam_ssa:is_loop_header(I); #b_blk{} -> false end. @@ -423,11 +440,22 @@ eval_is([#b_set{op=phi,dst=Dst,args=Args}|Is], From, Bs0, St) -> Val = get_phi_arg(Args, From), Bs = bind_var(Dst, Val, Bs0), eval_is(Is, From, Bs, St); +eval_is([#b_set{op=succeeded,dst=Dst,args=[Var]}], _From, Bs, _St) -> + case Bs of + #{Var:=failed} -> + bind_var(Dst, #b_literal{val=false}, Bs); + #{Var:=#b_literal{}} -> + bind_var(Dst, #b_literal{val=true}, Bs); + #{} -> + Bs + end; eval_is([#b_set{op={bif,_},dst=Dst}=I0|Is], From, Bs, St) -> I = sub(I0, Bs), case eval_bif(I, St) of #b_literal{}=Val -> eval_is(Is, From, bind_var(Dst, Val, Bs), St); + failed -> + eval_is(Is, From, bind_var(Dst, failed, Bs), St); none -> eval_is(Is, From, Bs, St) end; @@ -521,15 +549,14 @@ eval_switch_1([], _Arg, _PrevOp, Fail) -> %% Fail is now either the failure label or 'none'. Fail. -bind_var_if_used(L, Var, Val0, Bs, #st{us=Us}) -> +bind_var_if_used(L, Var, Val, #st{us=Us}) -> case cerl_sets:is_element(Var, map_get(L, Us)) of - true -> - Val = get_value(Val0, Bs), - Bs#{Var=>Val}; - false -> - Bs + true -> #{Var=>Val}; + false -> #{} end. +bind_var(Var, failed, Bs) -> + Bs#{Var=>failed}; bind_var(Var, Val0, Bs) -> Val = get_value(Val0, Bs), Bs#{Var=>Val}. @@ -675,7 +702,7 @@ eval_rel_op(_Bif, _Args, #st{rel_op=none}) -> eval_rel_op(Bif, Args, #st{rel_op=Prev}) -> case normalize_op(Bif, Args) of none -> - none; + eval_boolean(Prev, Bif, Args); RelOp -> case will_succeed(Prev, RelOp) of yes -> #b_literal{val=true}; @@ -684,11 +711,22 @@ eval_rel_op(Bif, Args, #st{rel_op=Prev}) -> end end. +eval_boolean({{'not',is_boolean},Var}, {bif,'not'}, [Var]) -> + failed; +eval_boolean({{'not',is_boolean},Var}, {bif,Op}, Args) + when Op =:= 'and'; Op =:= 'or' -> + case member(Var, Args) of + true -> failed; + false -> none + end; +eval_boolean(_, _, _) -> + none. + %% will_succeed(PrevCondition, Condition) -> yes | no | maybe %% PrevCondition is a condition known to be true. This function %% will tell whether Condition will succeed. -will_succeed({_Op,_Var,_Value}=Same, {_Op,_Var,_Value}=Same) -> +will_succeed({_,_,_}=Same, {_,_,_}=Same) -> %% Repeated test. yes; will_succeed({Op1,Var,#b_literal{val=A}}, {Op2,Var,#b_literal{val=B}}) -> @@ -702,6 +740,9 @@ will_succeed({_,_}=Same, {_,_}=Same) -> yes; will_succeed({Test1,Var}, {Test2,Var}) -> will_succeed_test(Test1, Test2); +will_succeed({{'not',is_boolean},Var}, {'=:=',Var,#b_literal{val=Lit}}) + when is_boolean(Lit) -> + no; will_succeed({_,_}, {_,_}) -> maybe; will_succeed({_,_}, {_,_,_}) -> @@ -760,8 +801,8 @@ will_succeed_1('=/=', A, '=:=', B) when A =:= B -> no; will_succeed_1('<', A, '=:=', B) when B >= A -> no; will_succeed_1('<', A, '=/=', B) when B >= A -> yes; will_succeed_1('<', A, '<', B) when B >= A -> yes; -will_succeed_1('<', A, '=<', B) when B > A -> yes; -will_succeed_1('<', A, '>=', B) when B > A -> no; +will_succeed_1('<', A, '=<', B) when B >= A -> yes; +will_succeed_1('<', A, '>=', B) when B >= A -> no; will_succeed_1('<', A, '>', B) when B >= A -> no; will_succeed_1('=<', A, '=:=', B) when B > A -> no; @@ -781,9 +822,9 @@ will_succeed_1('>=', A, '>', B) when B < A -> yes; will_succeed_1('>', A, '=:=', B) when B =< A -> no; will_succeed_1('>', A, '=/=', B) when B =< A -> yes; will_succeed_1('>', A, '<', B) when B =< A -> no; -will_succeed_1('>', A, '=<', B) when B < A -> no; +will_succeed_1('>', A, '=<', B) when B =< A -> no; will_succeed_1('>', A, '>=', B) when B =< A -> yes; -will_succeed_1('>', A, '>', B) when B < A -> yes; +will_succeed_1('>', A, '>', B) when B =< A -> yes; will_succeed_1('==', A, '==', B) -> if @@ -920,17 +961,14 @@ combine_eqs_1([L|Ls], #st{bs=Blocks0}=St0) -> end; combine_eqs_1([], St) -> St. -comb_get_sw(L, Blocks) -> - comb_get_sw(L, true, Blocks). - -comb_get_sw(L, Safe0, #st{bs=Blocks,skippable=Skippable}) -> +comb_get_sw(L, #st{bs=Blocks,skippable=Skippable}) -> #b_blk{is=Is,last=Last} = map_get(L, Blocks), - Safe1 = Safe0 andalso is_map_key(L, Skippable), + Safe0 = is_map_key(L, Skippable), case Last of #b_ret{} -> none; #b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail} -> - case comb_is(Is, Bool, Safe1) of + case comb_is(Is, Bool, Safe0) of {none,_} -> none; {#b_set{op={bif,'=:='},args=[#b_var{}=Arg,#b_literal{}=Lit]},Safe} -> @@ -941,7 +979,7 @@ comb_get_sw(L, Safe0, #st{bs=Blocks,skippable=Skippable}) -> #b_br{} -> none; #b_switch{arg=#b_var{}=Arg,fail=Fail,list=List} -> - {none,Safe} = comb_is(Is, none, Safe1), + {none,Safe} = comb_is(Is, none, Safe0), {Safe,Arg,L,Fail,List} end. diff --git a/lib/compiler/src/beam_ssa_lint.erl b/lib/compiler/src/beam_ssa_lint.erl index a003607dab..224095d4c4 100644 --- a/lib/compiler/src/beam_ssa_lint.erl +++ b/lib/compiler/src/beam_ssa_lint.erl @@ -65,13 +65,19 @@ format_error({{_M,F,A},{phi_inside_block, Name, Id}}) -> [F, A, format_var(Name), Id]); format_error({{_M,F,A},{undefined_label_in_phi, Label, I}}) -> io_lib:format("~p/~p: Unknown block label ~p in phi node ~ts", - [F, A, Label, format_instr(I)]). + [F, A, Label, format_instr(I)]); +format_error({{_M,F,A},{succeeded_not_preceded, I}}) -> + io_lib:format("~p/~p: ~ts does not reference the preceding instruction", + [F, A, format_instr(I)]); +format_error({{_M,F,A},{succeeded_not_last, I}}) -> + io_lib:format("~p/~p: ~ts is not the last instruction in its block", + [F, A, format_instr(I)]). format_instr(I) -> [$',beam_ssa_pp:format_instr(I),$']. format_var(V) -> - beam_ssa_pp:format_var(#b_var{name=V}). + beam_ssa_pp:format_var(V). validate_function(F) -> try @@ -86,34 +92,36 @@ validate_function(F) -> erlang:raise(Class, Error, Stack) end. --type defined_vars() :: gb_sets:set(beam_ssa:var_name()). +-type defined_vars() :: gb_sets:set(beam_ssa:argument()). -record(vvars, {blocks :: #{ beam_ssa:label() => beam_ssa:b_blk() }, branch_def_vars :: #{ - %% Describes the variable state at the time of this exact branch (phi - %% node validation). - {From :: beam_ssa:label(), To :: beam_ssa:label()} => defined_vars(), - %% Describes the variable state common to all branches leading to this - %% label (un/redefined variable validation). - beam_ssa:label() => defined_vars() }, + %% Describes the variable state at the time of + %% this exact branch (phi node validation). + {From :: beam_ssa:label(), + To :: beam_ssa:label()} => defined_vars(), + %% Describes the variable state common to all + %% branches leading to this label (un/redefined + %% variable validation). + beam_ssa:label() => defined_vars() }, defined_vars :: defined_vars()}). -spec validate_variables(beam_ssa:b_function()) -> ok. validate_variables(#b_function{ args = Args, bs = Blocks }) -> %% Prefill the mapping with function arguments. - ArgNames = vvars_get_varnames(Args), - DefVars = gb_sets:from_list(ArgNames), + Args = vvars_get_variables(Args), + DefVars = gb_sets:from_list(Args), Entry = 0, State = #vvars{blocks = Blocks, branch_def_vars = #{ Entry => DefVars }, defined_vars = DefVars}, - ok = vvars_assert_unique(Blocks, ArgNames), + ok = vvars_assert_unique(Blocks, Args), vvars_phi_nodes(vvars_block(Entry, State)). %% Checks the uniqueness of all variables across all blocks. --spec vvars_assert_unique(Blocks, [beam_ssa:var_name()]) -> ok when +-spec vvars_assert_unique(Blocks, [beam_ssa:b_var()]) -> ok when Blocks :: #{ beam_ssa:label() => beam_ssa:b_blk() }. vvars_assert_unique(Blocks, Args) -> BlockIs = [Is || #b_blk{is=Is} <- maps:values(Blocks)], @@ -124,12 +132,12 @@ vvars_assert_unique(Blocks, Args) -> ok. -spec vvars_assert_unique_1(Is, Defined) -> ok when - Is :: list(beam_ssa:b_set()), - Defined :: #{ beam_ssa:var_name() => beam_ssa:b_set() }. -vvars_assert_unique_1([#b_set{dst=#b_var{name=DstName}}=I|Is], Defined) -> + Is :: list(beam_ssa:b_set()), + Defined :: #{ beam_ssa:b_var() => beam_ssa:b_set() }. +vvars_assert_unique_1([#b_set{dst=Dst}=I|Is], Defined) -> case Defined of - #{DstName:=Old} -> throw({redefined_variable, DstName, Old, I}); - _ -> vvars_assert_unique_1(Is, Defined#{DstName=>I}) + #{Dst:=Old} -> throw({redefined_variable, Dst, Old, I}); + _ -> vvars_assert_unique_1(Is, Defined#{Dst=>I}) end; vvars_assert_unique_1([], Defined) -> Defined. @@ -141,17 +149,17 @@ vvars_phi_nodes(#vvars{ blocks = Blocks }=State) -> ok. -spec vvars_phi_nodes_1(Is, Id, State) -> ok when - Is :: list(beam_ssa:b_set()), - Id :: beam_ssa:label(), - State :: #vvars{}. + Is :: list(beam_ssa:b_set()), + Id :: beam_ssa:label(), + State :: #vvars{}. vvars_phi_nodes_1([#b_set{ op = phi, args = Phis }=I | Is], Id, State) -> ok = vvars_assert_phi_paths(Phis, I, Id, State), ok = vvars_assert_phi_vars(Phis, I, Id, State), vvars_phi_nodes_1(Is, Id, State); vvars_phi_nodes_1([_ | Is], Id, _State) -> - case [Dst || #b_set{op=phi,dst=#b_var{name=Dst}} <- Is] of - [Name|_] -> - throw({phi_inside_block, Name, Id}); + case [Dst || #b_set{op=phi,dst=Dst} <- Is] of + [Var|_] -> + throw({phi_inside_block, Var, Id}); [] -> ok end; @@ -161,10 +169,10 @@ vvars_phi_nodes_1([], _Id, _State) -> %% Checks whether all paths leading to this phi node are represented, and that %% it doesn't reference any non-existent paths. -spec vvars_assert_phi_paths(Phis, I, Id, State) -> ok when - Phis :: list({beam_ssa:argument(), beam_ssa:label()}), - Id :: beam_ssa:label(), - I :: beam_ssa:b_set(), - State :: #vvars{}. + Phis :: list({beam_ssa:argument(), beam_ssa:label()}), + Id :: beam_ssa:label(), + I :: beam_ssa:b_set(), + State :: #vvars{}. vvars_assert_phi_paths(Phis, I, Id, State) -> BranchKeys = maps:keys(State#vvars.branch_def_vars), RequiredPaths = ordsets:from_list([From || {From, To} <- BranchKeys, To =:= Id]), @@ -173,34 +181,34 @@ vvars_assert_phi_paths(Phis, I, Id, State) -> [_|_]=MissingPaths -> throw({missing_phi_paths, MissingPaths, I}); [] -> ok end. - %% %% The following test is sometimes useful to find missing optimizations. - %% %% It is commented out, though, because it can be triggered by - %% %% by weird but legal code. - %% case ordsets:subtract(ProvidedPaths, RequiredPaths) of - %% [_|_]=GarbagePaths -> throw({garbage_phi_paths, GarbagePaths, I}); - %% [] -> ok - %% end. +%% %% The following test is sometimes useful to find missing optimizations. +%% %% It is commented out, though, because it can be triggered by +%% %% by weird but legal code. +%% case ordsets:subtract(ProvidedPaths, RequiredPaths) of +%% [_|_]=GarbagePaths -> throw({garbage_phi_paths, GarbagePaths, I}); +%% [] -> ok +%% end. %% Checks whether all variables used in this phi node are defined in the branch %% they arrived on. -spec vvars_assert_phi_vars(Phis, I, Id, State) -> ok when - Phis :: list({beam_ssa:argument(), beam_ssa:label()}), - Id :: beam_ssa:label(), - I :: beam_ssa:b_set(), - State :: #vvars{}. + Phis :: list({beam_ssa:argument(), beam_ssa:label()}), + Id :: beam_ssa:label(), + I :: beam_ssa:b_set(), + State :: #vvars{}. vvars_assert_phi_vars(Phis, I, Id, #vvars{blocks=Blocks, branch_def_vars=BranchDefVars}) -> Vars = [{Var, From} || {#b_var{}=Var, From} <- Phis], - foreach(fun({#b_var{name=VarName}, From}) -> + foreach(fun({Var, From}) -> BranchKey = {From, Id}, case BranchDefVars of #{BranchKey:=DefVars} -> - case gb_sets:is_member(VarName, DefVars) of + case gb_sets:is_member(Var, DefVars) of true -> ok; - false -> throw({unknown_variable, VarName, I}) + false -> throw({unknown_variable, Var, I}) end; #{} -> - throw({unknown_phi_variable, VarName, BranchKey, I}) + throw({unknown_phi_variable, Var, BranchKey, I}) end end, Vars), Labels = [From || {#b_literal{},From} <- Phis], @@ -214,32 +222,44 @@ vvars_assert_phi_vars(Phis, I, Id, #vvars{blocks=Blocks, end, Labels). -spec vvars_block(Id, State) -> #vvars{} when - Id :: beam_ssa:label(), - State :: #vvars{}. + Id :: beam_ssa:label(), + State :: #vvars{}. vvars_block(Id, State0) -> #{ Id := #b_blk{ is = Is, last = Terminator} } = State0#vvars.blocks, #{ Id := DefVars } = State0#vvars.branch_def_vars, State = State0#vvars{ defined_vars = DefVars }, vvars_terminator(Terminator, Id, vvars_block_1(Is, State)). --spec vvars_block_1(Blocks, State) -> #vvars{} when - Blocks :: list(beam_ssa:b_blk()), - State :: #vvars{}. +-spec vvars_block_1(Is, State) -> #vvars{} when + Is :: list(#b_set{}), + State :: #vvars{}. vvars_block_1([], State) -> State; -vvars_block_1([#b_set{ dst = #b_var{ name = DstName }, op = phi } | Is], State0) -> +vvars_block_1([#b_set{dst=OpVar,args=OpArgs}=I, + #b_set{op=succeeded,args=[OpVar],dst=SuccVar}], State) -> + ok = vvars_assert_args(OpArgs, I, State), + vvars_save_var(SuccVar, vvars_save_var(OpVar, State)); +vvars_block_1([#b_set{op=succeeded,args=Args}=I | [_|_]], State) -> + ok = vvars_assert_args(Args, I, State), + %% 'succeeded' must be the last instruction in its block. + throw({succeeded_not_last, I}); +vvars_block_1([#b_set{op=succeeded,args=Args}=I], State)-> + ok = vvars_assert_args(Args, I, State), + %% 'succeeded' must be be directly preceded by the operation it checks. + throw({succeeded_not_preceded, I}); +vvars_block_1([#b_set{ dst = Dst, op = phi } | Is], State) -> %% We don't check phi node arguments at this point since we may not have %% visited their definition yet. They'll be handled later on in %% vvars_phi_nodes/1 after all blocks are processed. - vvars_block_1(Is, vvars_save_var(DstName, State0)); -vvars_block_1([#b_set{ dst = #b_var{ name = DstName }, args = Args }=I | Is], State0) -> - ok = vvars_assert_args(Args, I, State0), - vvars_block_1(Is, vvars_save_var(DstName, State0)). + vvars_block_1(Is, vvars_save_var(Dst, State)); +vvars_block_1([#b_set{ dst = Dst, args = Args }=I | Is], State) -> + ok = vvars_assert_args(Args, I, State), + vvars_block_1(Is, vvars_save_var(Dst, State)). -spec vvars_terminator(Terminator, From, State) -> #vvars{} when - Terminator :: beam_ssa:terminator(), - From :: beam_ssa:label(), - State :: #vvars{}. + Terminator :: beam_ssa:terminator(), + From :: beam_ssa:label(), + State :: #vvars{}. vvars_terminator(#b_ret{ arg = Arg }=I, _From, State) -> ok = vvars_assert_args([Arg], I, State), State; @@ -264,62 +284,62 @@ vvars_terminator(#b_br{ bool = Arg, succ = Succ, fail = Fail }=I, From, State) - vvars_terminator_1(Labels, From, State). -spec vvars_terminator_1(Labels, From, State) -> #vvars{} when - Labels :: list(beam_ssa:label()), - From :: beam_ssa:label(), - State :: #vvars{}. + Labels :: list(beam_ssa:label()), + From :: beam_ssa:label(), + State :: #vvars{}. vvars_terminator_1(Labels0, From, State0) -> %% Filter out all branches that have already been taken. This should result %% in either all of Labels0 or an empty list. Labels = [To || To <- Labels0, - not maps:is_key({From, To}, State0#vvars.branch_def_vars)], + not maps:is_key({From, To}, State0#vvars.branch_def_vars)], true = Labels =:= Labels0 orelse Labels =:= [], %Assertion State1 = foldl(fun(To, State) -> - vvars_save_branch(From, To, State) + vvars_save_branch(From, To, State) end, State0, Labels), foldl(fun(To, State) -> - vvars_block(To, State) + vvars_block(To, State) end, State1, Labels). %% Gets all variable names in args, ignoring literals etc --spec vvars_get_varnames(Args) -> list(beam_ssa:var_name()) when - Args :: list(beam_ssa:argument()). -vvars_get_varnames(Args) -> - [Name || #b_var{ name = Name } <- Args]. +-spec vvars_get_variables(Args) -> list(beam_ssa:b_var()) when + Args :: list(beam_ssa:argument()). +vvars_get_variables(Args) -> + [Var || #b_var{}=Var <- Args]. %% Checks that all variables in Args are defined in all paths leading to the %% current State. -spec vvars_assert_args(Args, I, State) -> ok when - Args :: list(beam_ssa:argument()), - I :: beam_ssa:terminator() | beam_ssa:b_set(), - State :: #vvars{}. + Args :: list(beam_ssa:argument()), + I :: beam_ssa:terminator() | beam_ssa:b_set(), + State :: #vvars{}. vvars_assert_args(Args, I, #vvars{defined_vars=DefVars}=State) -> foreach(fun(#b_remote{mod=Mod,name=Name}) -> vvars_assert_args([Mod,Name], I, State); - (#b_var{name=Name}) -> - case gb_sets:is_member(Name, DefVars) of + (#b_var{}=Var) -> + case gb_sets:is_member(Var, DefVars) of true -> ok; - false -> throw({unknown_variable,Name,I}) + false -> throw({unknown_variable,Var,I}) end; (_) -> ok end, Args). %% Checks that all given labels are defined in State. -spec vvars_assert_labels(Labels, I, State) -> ok when - Labels :: list(beam_ssa:label()), - I :: beam_ssa:terminator(), - State :: #vvars{}. + Labels :: list(beam_ssa:label()), + I :: beam_ssa:terminator(), + State :: #vvars{}. vvars_assert_labels(Labels, I, #vvars{blocks=Blocks}) -> foreach(fun(Label) -> - case maps:is_key(Label, Blocks) of - false -> throw({unknown_block, Label, I}); - true -> ok - end + case maps:is_key(Label, Blocks) of + false -> throw({unknown_block, Label, I}); + true -> ok + end end, Labels). -spec vvars_save_branch(From, To, State) -> #vvars{} when - From :: beam_ssa:label(), - To :: beam_ssa:label(), - State :: #vvars{}. + From :: beam_ssa:label(), + To :: beam_ssa:label(), + State :: #vvars{}. vvars_save_branch(From, To, State) -> DefVars = State#vvars.defined_vars, Branches0 = State#vvars.branch_def_vars, @@ -335,15 +355,15 @@ vvars_save_branch(From, To, State) -> end. -spec vvars_merge_branches(New, Existing) -> defined_vars() when - New :: defined_vars(), - Existing :: defined_vars(). + New :: defined_vars(), + Existing :: defined_vars(). vvars_merge_branches(New, Existing) -> gb_sets:intersection(New, Existing). --spec vvars_save_var(VarName, State) -> #vvars{} when - VarName :: beam_ssa:var_name(), - State :: #vvars{}. -vvars_save_var(VarName, State0) -> +-spec vvars_save_var(Var, State) -> #vvars{} when + Var :: #b_var{}, + State :: #vvars{}. +vvars_save_var(Var, State0) -> %% vvars_assert_unique guarantees that variables are never set twice. - DefVars = gb_sets:insert(VarName, State0#vvars.defined_vars), + DefVars = gb_sets:insert(Var, State0#vvars.defined_vars), State0#vvars{ defined_vars = DefVars }. diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index d87c66c272..00d57ca7a9 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -28,9 +28,9 @@ %%% in one phase and then apply it in the next without having to risk working %%% with incomplete information. %%% -%%% Each sub-pass operates on a #st{} record and a func_info_db(), where the -%%% former is just a #b_function{} whose blocks can be represented either in -%%% linear or map form, and the latter is a map with information about all +%%% Each sub-pass operates on a #opt_st{} record and a func_info_db(), where +%%% the former is just a #b_function{} whose blocks can be represented either +%%% in linear or map form, and the latter is a map with information about all %%% functions in the module (see beam_ssa_opt.hrl for more details). %%% @@ -39,45 +39,76 @@ -include("beam_ssa_opt.hrl"). --import(lists, [all/2,append/1,duplicate/2,foldl/3,keyfind/3,member/2, - reverse/1,reverse/2, - splitwith/2,sort/1,takewhile/2,unzip/1]). +-import(lists, [all/2,append/1,duplicate/2,flatten/1,foldl/3,keyfind/3, + member/2,reverse/1,reverse/2,splitwith/2,sort/1, + takewhile/2,unzip/1]). --define(DEFAULT_REPETITIONS, 2). +-define(MAX_REPETITIONS, 16). -spec module(beam_ssa:b_module(), [compile:option()]) -> {'ok',beam_ssa:b_module()}. --record(st, {ssa :: [{beam_ssa:label(),beam_ssa:b_blk()}] | - beam_ssa:block_map(), - args :: [beam_ssa:b_var()], - cnt :: beam_ssa:label(), - anno :: beam_ssa:anno()}). --type st_map() :: #{ func_id() => #st{} }. - module(Module, Opts) -> - FuncDb0 = case proplists:get_value(no_module_opt, Opts, false) of - false -> build_func_db(Module); - true -> #{} - end, + FuncDb = case proplists:get_value(no_module_opt, Opts, false) of + false -> build_func_db(Module); + true -> #{} + end, %% Passes that perform module-level optimizations are often aided by %% optimizing callers before callees and vice versa, so we optimize all - %% functions in call order, flipping it as required. + %% functions in call order, alternating the order every time. StMap0 = build_st_map(Module), - Order = get_call_order_po(StMap0, FuncDb0), - - Phases = - [{Order, prologue_passes(Opts)}] ++ - repeat(Opts, repeated_passes(Opts), Order) ++ - [{Order, epilogue_passes(Opts)}], + Order = get_call_order_po(StMap0, FuncDb), - {StMap, _FuncDb} = foldl(fun({FuncIds, Ps}, {StMap, FuncDb}) -> - phase(FuncIds, Ps, StMap, FuncDb) - end, {StMap0, FuncDb0}, Phases), + Phases = [{once, Order, prologue_passes(Opts)}, + {module, module_passes(Opts)}, + {fixpoint, Order, repeated_passes(Opts)}, + {once, Order, epilogue_passes(Opts)}], + StMap = run_phases(Phases, StMap0, FuncDb), {ok, finish(Module, StMap)}. +run_phases([{module, Passes} | Phases], StMap0, FuncDb0) -> + {StMap, FuncDb} = compile:run_sub_passes(Passes, {StMap0, FuncDb0}), + run_phases(Phases, StMap, FuncDb); +run_phases([{once, FuncIds0, Passes} | Phases], StMap0, FuncDb0) -> + FuncIds = skip_removed(FuncIds0, StMap0), + {StMap, FuncDb} = phase(FuncIds, Passes, StMap0, FuncDb0), + run_phases(Phases, StMap, FuncDb); +run_phases([{fixpoint, FuncIds0, Passes} | Phases], StMap0, FuncDb0) -> + FuncIds = skip_removed(FuncIds0, StMap0), + RevFuncIds = reverse(FuncIds), + Order = {FuncIds, RevFuncIds}, + {StMap, FuncDb} = fixpoint(RevFuncIds, Order, Passes, + StMap0, FuncDb0, ?MAX_REPETITIONS), + run_phases(Phases, StMap, FuncDb); +run_phases([], StMap, _FuncDb) -> + StMap. + +skip_removed(FuncIds, StMap) -> + [F || F <- FuncIds, is_map_key(F, StMap)]. + +%% Run the given passes until a fixpoint is reached. +fixpoint(_FuncIds, _Order, _Passes, StMap, FuncDb, 0) -> + %% Too many repetitions. Give up and return what we have. + {StMap, FuncDb}; +fixpoint(FuncIds0, Order0, Passes, StMap0, FuncDb0, N) -> + {StMap, FuncDb} = phase(FuncIds0, Passes, StMap0, FuncDb0), + Repeat = changed(FuncIds0, FuncDb0, FuncDb, StMap0, StMap), + case cerl_sets:size(Repeat) of + 0 -> + %% No change. Fixpoint reached. + {StMap, FuncDb}; + _ -> + %% Repeat the optimizations for functions whose code has + %% changed or for which there is potentially updated type + %% information. + {OrderA, OrderB} = Order0, + Order = {OrderB, OrderA}, + FuncIds = [Id || Id <- OrderA, cerl_sets:is_element(Id, Repeat)], + fixpoint(FuncIds, Order, Passes, StMap, FuncDb, N - 1) + end. + phase([FuncId | Ids], Ps, StMap, FuncDb0) -> try compile:run_sub_passes(Ps, {map_get(FuncId, StMap), FuncDb0}) of {St, FuncDb} -> @@ -91,19 +122,94 @@ phase([FuncId | Ids], Ps, StMap, FuncDb0) -> phase([], _Ps, StMap, FuncDb) -> {StMap, FuncDb}. -%% Repeats the given passes, alternating the order between runs to make the -%% type pass more efficient. -repeat(Opts, Ps, OrderA) -> - Repeat = proplists:get_value(ssa_opt_repeat, Opts, ?DEFAULT_REPETITIONS), - OrderB = reverse(OrderA), - repeat_1(Repeat, Ps, OrderA, OrderB). - -repeat_1(0, _Opts, _OrderA, _OrderB) -> - []; -repeat_1(N, Ps, OrderA, OrderB) when N > 0, N rem 2 =:= 0 -> - [{OrderA, Ps} | repeat_1(N - 1, Ps, OrderA, OrderB)]; -repeat_1(N, Ps, OrderA, OrderB) when N > 0, N rem 2 =:= 1 -> - [{OrderB, Ps} | repeat_1(N - 1, Ps, OrderA, OrderB)]. +changed(PrevIds, FuncDb0, FuncDb, StMap0, StMap) -> + %% Find all functions in FuncDb that can be reached by changes + %% of argument and/or return types. Those are the functions that + %% may gain from running the optimization passes again. + %% + %% Note that we examine all functions in FuncDb, not only functions + %% optimized in the previous run, because the argument types can + %% have been updated for functions not included in the previous run. + + F = fun(Id, A) -> + case cerl_sets:is_element(Id, A) of + true -> + A; + false -> + {#func_info{arg_types=ATs0,succ_types=ST0}, + #func_info{arg_types=ATs1,succ_types=ST1}} = + {map_get(Id, FuncDb0),map_get(Id, FuncDb)}, + + %% If the argument types have changed for this + %% function, re-optimize this function and all + %% functions it calls directly or indirectly. + %% + %% If the return type has changed, re-optimize + %% this function and all functions that call + %% this function directly or indirectly. + Opts = case ATs0 =:= ATs1 of + true -> []; + false -> [called] + end ++ + case ST0 =:= ST1 of + true -> []; + false -> [callers] + end, + case Opts of + [] -> A; + [_|_] -> add_changed([Id], Opts, FuncDb, A) + end + end + end, + Ids = foldl(F, cerl_sets:new(), maps:keys(FuncDb)), + + %% From all functions that were optimized in the previous run, + %% find the functions that had any change in the SSA code. Those + %% functions might gain from being optimized again. (For example, + %% when beam_ssa_dead has shortcut branches, the types for some + %% variables could become narrower, giving beam_ssa_type new + %% opportunities for optimization.) + %% + %% Note that the functions examined could be functions with module-level + %% optimization turned off (and thus not included in FuncDb). + + foldl(fun(Id, A) -> + case cerl_sets:is_element(Id, A) of + true -> + %% Already scheduled for another optimization. + %% No need to compare the SSA code. + A; + false -> + %% Compare the SSA code before and after optimization. + case {map_get(Id, StMap0),map_get(Id, StMap)} of + {Same,Same} -> A; + {_,_} -> cerl_sets:add_element(Id, A) + end + end + end, Ids, PrevIds). + +add_changed([Id|Ids], Opts, FuncDb, S0) when is_map_key(Id, FuncDb) -> + case cerl_sets:is_element(Id, S0) of + true -> + add_changed(Ids, Opts, FuncDb, S0); + false -> + S1 = cerl_sets:add_element(Id, S0), + #func_info{in=In,out=Out} = map_get(Id, FuncDb), + S2 = case member(callers, Opts) of + true -> add_changed(In, Opts, FuncDb, S1); + false -> S1 + end, + S = case member(called, Opts) of + true -> add_changed(Out, Opts, FuncDb, S2); + false -> S2 + end, + add_changed(Ids, Opts, FuncDb, S) + end; +add_changed([_|Ids], Opts, FuncDb, S) -> + %% This function is exempt from module-level optimization and will not + %% provide any more information. + add_changed(Ids, Opts, FuncDb, S); +add_changed([], _, _, S) -> S. %% @@ -117,7 +223,7 @@ build_st_map(#b_module{body=Fs}) -> build_st_map_1([F | Fs], Map) -> #b_function{anno=Anno,args=Args,cnt=Counter,bs=Bs} = F, - St = #st{anno=Anno,args=Args,cnt=Counter,ssa=Bs}, + St = #opt_st{anno=Anno,args=Args,cnt=Counter,ssa=Bs}, build_st_map_1(Fs, Map#{ get_func_id(F) => St }); build_st_map_1([], Map) -> Map. @@ -127,9 +233,14 @@ finish(#b_module{body=Fs0}=Module, StMap) -> Module#b_module{body=finish_1(Fs0, StMap)}. finish_1([F0 | Fs], StMap) -> - #st{anno=Anno,cnt=Counter,ssa=Blocks} = map_get(get_func_id(F0), StMap), - F = F0#b_function{anno=Anno,bs=Blocks,cnt=Counter}, - [F | finish_1(Fs, StMap)]; + FuncId = get_func_id(F0), + case StMap of + #{ FuncId := #opt_st{anno=Anno,cnt=Counter,ssa=Blocks} } -> + F = F0#b_function{anno=Anno,bs=Blocks,cnt=Counter}, + [F | finish_1(Fs, StMap)]; + #{} -> + finish_1(Fs, StMap) + end; finish_1([], _StMap) -> []. @@ -145,10 +256,17 @@ prologue_passes(Opts) -> ?PASS(ssa_opt_linearize), ?PASS(ssa_opt_tuple_size), ?PASS(ssa_opt_record), - ?PASS(ssa_opt_cse), %Helps the first type pass. - ?PASS(ssa_opt_type_start)], + ?PASS(ssa_opt_cse), % Helps the first type pass. + ?PASS(ssa_opt_live)], % ... passes_1(Ps, Opts). +module_passes(Opts) -> + Ps0 = [{ssa_opt_type_start, + fun({StMap, FuncDb}) -> + beam_ssa_type:opt_start(StMap, FuncDb) + end}], + passes_1(Ps0, Opts). + %% These passes all benefit from each other (in roughly this order), so they %% are repeated as required. repeated_passes(Opts) -> @@ -157,6 +275,9 @@ repeated_passes(Opts) -> ?PASS(ssa_opt_dead), ?PASS(ssa_opt_cse), ?PASS(ssa_opt_tail_phis), + ?PASS(ssa_opt_sink), + ?PASS(ssa_opt_tuple_size), + ?PASS(ssa_opt_record), ?PASS(ssa_opt_type_continue)], %Must run after ssa_opt_dead to %clean up phi nodes. passes_1(Ps, Opts). @@ -169,14 +290,15 @@ epilogue_passes(Opts) -> %% Run live one more time to clean up after the float and sw %% passes. ?PASS(ssa_opt_live), + ?PASS(ssa_opt_try), ?PASS(ssa_opt_bsm), - ?PASS(ssa_opt_bsm_units), ?PASS(ssa_opt_bsm_shortcut), - ?PASS(ssa_opt_blockify), ?PASS(ssa_opt_sink), + ?PASS(ssa_opt_blockify), ?PASS(ssa_opt_merge_blocks), ?PASS(ssa_opt_get_tuple_element), - ?PASS(ssa_opt_trim_unreachable)], + ?PASS(ssa_opt_trim_unreachable), + ?PASS(ssa_opt_unfold_literals)], passes_1(Ps, Opts). passes_1(Ps, Opts0) -> @@ -194,16 +316,26 @@ passes_1(Ps, Opts0) -> %% Builds a function information map with basic information about incoming and %% outgoing local calls, as well as whether the function is exported. -spec build_func_db(#b_module{}) -> func_info_db(). -build_func_db(#b_module{body=Fs,exports=Exports}) -> +build_func_db(#b_module{body=Fs,attributes=Attr,exports=Exports0}) -> + Exports = fdb_exports(Attr, Exports0), try - fdb_1(Fs, gb_sets:from_list(Exports), #{}) + fdb_fs(Fs, Exports, #{}) catch %% All module-level optimizations are invalid when a NIF can override a %% function, so we have to bail out. throw:load_nif -> #{} end. -fdb_1([#b_function{ args=Args,bs=Bs }=F | Fs], Exports, FuncDb0) -> +fdb_exports([{on_load, L} | Attrs], Exports) -> + %% Functions marked with on_load must be treated as exported to prevent + %% them from being optimized away when unused. + fdb_exports(Attrs, flatten(L) ++ Exports); +fdb_exports([_Attr | Attrs], Exports) -> + fdb_exports(Attrs, Exports); +fdb_exports([], Exports) -> + gb_sets:from_list(Exports). + +fdb_fs([#b_function{ args=Args,bs=Bs }=F | Fs], Exports, FuncDb0) -> Id = get_func_id(F), #b_local{name=#b_literal{val=Name}, arity=Arity} = Id, @@ -224,8 +356,8 @@ fdb_1([#b_function{ args=Args,bs=Bs }=F | Fs], Exports, FuncDb0) -> fdb_is(Is, Id, FuncDb) end, FuncDb1, Bs), - fdb_1(Fs, Exports, FuncDb); -fdb_1([], _Exports, FuncDb) -> + fdb_fs(Fs, Exports, FuncDb); +fdb_fs([], _Exports, FuncDb) -> FuncDb. fdb_is([#b_set{op=call, @@ -237,6 +369,12 @@ fdb_is([#b_set{op=call, name=#b_literal{val=load_nif}}, _Path, _LoadInfo]} | _Is], _Caller, _FuncDb) -> throw(load_nif); +fdb_is([#b_set{op=make_fun, + args=[#b_local{}=Callee | _]} | Is], + Caller, FuncDb) -> + %% The make_fun instruction's type depends on the return type of the + %% function in question, so we treat this as a function call. + fdb_is(Is, Caller, fdb_update(Caller, Callee, FuncDb)); fdb_is([_ | Is], Caller, FuncDb) -> fdb_is(Is, Caller, FuncDb); fdb_is([], _Caller, FuncDb) -> @@ -289,29 +427,25 @@ gco_rpo([], _, Seen, Acc) -> %%% Trivial sub passes. %%% -ssa_opt_dead({#st{ssa=Linear}=St, FuncDb}) -> - {St#st{ssa=beam_ssa_dead:opt(Linear)}, FuncDb}. - -ssa_opt_linearize({#st{ssa=Blocks}=St, FuncDb}) -> - {St#st{ssa=beam_ssa:linearize(Blocks)}, FuncDb}. +ssa_opt_dead({#opt_st{ssa=Linear}=St, FuncDb}) -> + {St#opt_st{ssa=beam_ssa_dead:opt(Linear)}, FuncDb}. -ssa_opt_type_start({#st{ssa=Linear0,args=Args,anno=Anno}=St0, FuncDb0}) -> - {Linear, FuncDb} = beam_ssa_type:opt_start(Linear0, Args, Anno, FuncDb0), - {St0#st{ssa=Linear}, FuncDb}. +ssa_opt_linearize({#opt_st{ssa=Blocks}=St, FuncDb}) -> + {St#opt_st{ssa=beam_ssa:linearize(Blocks)}, FuncDb}. -ssa_opt_type_continue({#st{ssa=Linear0,args=Args,anno=Anno}=St0, FuncDb0}) -> +ssa_opt_type_continue({#opt_st{ssa=Linear0,args=Args,anno=Anno}=St0, FuncDb0}) -> {Linear, FuncDb} = beam_ssa_type:opt_continue(Linear0, Args, Anno, FuncDb0), - {St0#st{ssa=Linear}, FuncDb}. + {St0#opt_st{ssa=Linear}, FuncDb}. -ssa_opt_type_finish({#st{args=Args,anno=Anno0}=St0, FuncDb0}) -> +ssa_opt_type_finish({#opt_st{args=Args,anno=Anno0}=St0, FuncDb0}) -> {Anno, FuncDb} = beam_ssa_type:opt_finish(Args, Anno0, FuncDb0), - {St0#st{anno=Anno}, FuncDb}. + {St0#opt_st{anno=Anno}, FuncDb}. -ssa_opt_blockify({#st{ssa=Linear}=St, FuncDb}) -> - {St#st{ssa=maps:from_list(Linear)}, FuncDb}. +ssa_opt_blockify({#opt_st{ssa=Linear}=St, FuncDb}) -> + {St#opt_st{ssa=maps:from_list(Linear)}, FuncDb}. -ssa_opt_trim_unreachable({#st{ssa=Blocks}=St, FuncDb}) -> - {St#st{ssa=beam_ssa:trim_unreachable(Blocks)}, FuncDb}. +ssa_opt_trim_unreachable({#opt_st{ssa=Blocks}=St, FuncDb}) -> + {St#opt_st{ssa=beam_ssa:trim_unreachable(Blocks)}, FuncDb}. %%% %%% Split blocks before certain instructions to enable more optimizations. @@ -323,14 +457,14 @@ ssa_opt_trim_unreachable({#st{ssa=Blocks}=St, FuncDb}) -> %%% for sinking get_tuple_element instructions. %%% -ssa_opt_split_blocks({#st{ssa=Blocks0,cnt=Count0}=St, FuncDb}) -> +ssa_opt_split_blocks({#opt_st{ssa=Blocks0,cnt=Count0}=St, FuncDb}) -> P = fun(#b_set{op={bif,element}}) -> true; (#b_set{op=call}) -> true; (#b_set{op=make_fun}) -> true; (_) -> false end, {Blocks,Count} = beam_ssa:split_blocks(P, Blocks0, Count0), - {St#st{ssa=Blocks,cnt=Count}, FuncDb}. + {St#opt_st{ssa=Blocks,cnt=Count}, FuncDb}. %%% %%% Coalesce phi nodes. @@ -354,10 +488,10 @@ ssa_opt_split_blocks({#st{ssa=Blocks0,cnt=Count0}=St, FuncDb}) -> %%% different registers). %%% -ssa_opt_coalesce_phis({#st{ssa=Blocks0}=St, FuncDb}) -> +ssa_opt_coalesce_phis({#opt_st{ssa=Blocks0}=St, FuncDb}) -> Ls = beam_ssa:rpo(Blocks0), Blocks = c_phis_1(Ls, Blocks0), - {St#st{ssa=Blocks}, FuncDb}. + {St#opt_st{ssa=Blocks}, FuncDb}. c_phis_1([L|Ls], Blocks0) -> case map_get(L, Blocks0) of @@ -460,9 +594,9 @@ c_fix_branches([], _, Blocks) -> Blocks. %%% - Smaller stack frames %%% -ssa_opt_tail_phis({#st{ssa=SSA0,cnt=Count0}=St, FuncDb}) -> +ssa_opt_tail_phis({#opt_st{ssa=SSA0,cnt=Count0}=St, FuncDb}) -> {SSA,Count} = opt_tail_phis(SSA0, Count0), - {St#st{ssa=SSA,cnt=Count}, FuncDb}. + {St#opt_st{ssa=SSA,cnt=Count}, FuncDb}. opt_tail_phis(Blocks, Count) when is_map(Blocks) -> opt_tail_phis(maps:values(Blocks), Blocks, Count); @@ -591,7 +725,7 @@ are_all_literals(Args) -> %%% be replaced with get_tuple_element/3 instructions. %%% -ssa_opt_element({#st{ssa=Blocks}=St, FuncDb}) -> +ssa_opt_element({#opt_st{ssa=Blocks}=St, FuncDb}) -> %% Collect the information about element instructions in this %% function. GetEls = collect_element_calls(beam_ssa:linearize(Blocks)), @@ -603,7 +737,7 @@ ssa_opt_element({#st{ssa=Blocks}=St, FuncDb}) -> %% For each chain, swap the first element call with the %% element call with the highest index. - {St#st{ssa=swap_element_calls(Chains, Blocks)}, FuncDb}. + {St#opt_st{ssa=swap_element_calls(Chains, Blocks)}, FuncDb}. collect_element_calls([{L,#b_blk{is=Is0,last=Last}}|Bs]) -> case {Is0,Last} of @@ -664,9 +798,9 @@ swap_element_calls_1([], _, Blocks) -> %%% when applicable. %%% -ssa_opt_record({#st{ssa=Linear}=St, FuncDb}) -> +ssa_opt_record({#opt_st{ssa=Linear}=St, FuncDb}) -> Blocks = maps:from_list(Linear), - {St#st{ssa=record_opt(Linear, Blocks)}, FuncDb}. + {St#opt_st{ssa=record_opt(Linear, Blocks)}, FuncDb}. record_opt([{L,#b_blk{is=Is0,last=Last}=Blk0}|Bs], Blocks) -> Is = record_opt_is(Is0, Last, Blocks), @@ -759,9 +893,9 @@ is_tagged_tuple_4([], _, _) -> no. %%% subexpressions across instructions that clobber the X registers. %%% -ssa_opt_cse({#st{ssa=Linear}=St, FuncDb}) -> +ssa_opt_cse({#opt_st{ssa=Linear}=St, FuncDb}) -> M = #{0=>#{}}, - {St#st{ssa=cse(Linear, #{}, M)}, FuncDb}. + {St#opt_st{ssa=cse(Linear, #{}, M)}, FuncDb}. cse([{L,#b_blk{is=Is0,last=Last0}=Blk}|Bs], Sub0, M0) -> Es0 = map_get(L, M0), @@ -898,34 +1032,52 @@ cse_suitable(#b_set{}) -> false. -record(fs, {s=undefined :: 'undefined' | 'cleared', regs=#{} :: #{beam_ssa:b_var():=beam_ssa:b_var()}, + vars=cerl_sets:new() :: cerl_sets:set(), fail=none :: 'none' | beam_ssa:label(), non_guards :: gb_sets:set(beam_ssa:label()), bs :: beam_ssa:block_map() }). -ssa_opt_float({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> +ssa_opt_float({#opt_st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> NonGuards = non_guards(Linear0), Blocks = maps:from_list(Linear0), Fs = #fs{non_guards=NonGuards,bs=Blocks}, {Linear,Count} = float_opt(Linear0, Count0, Fs), - {St#st{ssa=Linear,cnt=Count}, FuncDb}. + {St#opt_st{ssa=Linear,cnt=Count}, FuncDb}. -float_blk_is_in_guard(#b_blk{last=#b_br{fail=F}}, #fs{non_guards=NonGuards}) -> - not gb_sets:is_member(F, NonGuards); -float_blk_is_in_guard(#b_blk{}, #fs{}) -> +%% The fconv instruction doesn't support jumping to a fail label, so we have to +%% skip this optimization if the fail block is a guard. +%% +%% We also skip the optimization in blocks that always fail, as it's both +%% difficult and pointless to rewrite them to use float ops. +float_can_optimize_blk(#b_blk{last=#b_br{bool=#b_var{},fail=F}}, + #fs{non_guards=NonGuards}) -> + gb_sets:is_member(F, NonGuards); +float_can_optimize_blk(#b_blk{}, #fs{}) -> false. +float_opt([{L,#b_blk{is=[#b_set{op=exception_trampoline,args=[Var]}]}=Blk0} | + Bs0], Count0, Fs) -> + %% If we've replaced a BIF with float operations, we'll have a lot of extra + %% blocks that jump to the same failure block, which may have a trampoline + %% that refers to the original operation. + %% + %% Since the point of the trampoline is to keep the BIF from being removed + %% by liveness optimization, we can discard it as the liveness pass leaves + %% floats alone. + Blk = case cerl_sets:is_element(Var, Fs#fs.vars) of + true -> Blk0#b_blk{is=[]}; + false -> Blk0 + end, + {Bs, Count} = float_opt(Bs0, Count0, Fs), + {[{L,Blk}|Bs],Count}; float_opt([{L,Blk}|Bs0], Count0, Fs) -> - case float_blk_is_in_guard(Blk, Fs) of + case float_can_optimize_blk(Blk, Fs) of true -> - %% This block is inside a guard. Don't do - %% any floating point optimizations. - {Bs,Count} = float_opt(Bs0, Count0, Fs), - {[{L,Blk}|Bs],Count}; + float_opt_1(L, Blk, Bs0, Count0, Fs); false -> - %% This block is not inside a guard. - %% We can do the optimization. - float_opt_1(L, Blk, Bs0, Count0, Fs) + {Bs,Count} = float_opt(Bs0, Count0, Fs), + {[{L,Blk}|Bs],Count} end; float_opt([], Count, _Fs) -> {[],Count}. @@ -1004,12 +1156,12 @@ float_maybe_flush(Blk0, #fs{s=cleared,fail=Fail,bs=Blocks}=Fs0, Count0) -> #b_blk{last=#b_br{bool=#b_var{},succ=Succ}=Br} = Blk0, %% If the success block starts with a floating point operation, we can - %% defer flushing to that block as long as it isn't a guard. + %% defer flushing to that block as long as it's suitable for optimization. #b_blk{is=Is} = SuccBlk = map_get(Succ, Blocks), - SuccIsGuard = float_blk_is_in_guard(SuccBlk, Fs0), + CanOptimizeSucc = float_can_optimize_blk(SuccBlk, Fs0), case Is of - [#b_set{anno=#{float_op:=_}}|_] when not SuccIsGuard -> + [#b_set{anno=#{float_op:=_}}|_] when CanOptimizeSucc -> %% No flush needed. {[],Blk0,Fs0,Count0}; _ -> @@ -1065,21 +1217,22 @@ float_opt_is([], Fs, _Count, _Acc) -> none. float_make_op(#b_set{op={bif,Op},dst=Dst,args=As0}=I0, - Ts, #fs{s=S,regs=Rs0}=Fs, Count0) -> + Ts, #fs{s=S,regs=Rs0,vars=Vs0}=Fs, Count0) -> {As1,Rs1,Count1} = float_load(As0, Ts, Rs0, Count0, []), {As,Is0} = unzip(As1), {Fr,Count2} = new_reg('@fr', Count1), FrDst = #b_var{name=Fr}, I = I0#b_set{op={float,Op},dst=FrDst,args=As}, + Vs = cerl_sets:add_element(Dst, Vs0), Rs = Rs1#{Dst=>FrDst}, Is = append(Is0) ++ [I], case S of undefined -> {Ignore,Count} = new_reg('@ssa_ignore', Count2), C = #b_set{op={float,clearerror},dst=#b_var{name=Ignore}}, - {[C|Is],Fs#fs{s=cleared,regs=Rs},Count}; + {[C|Is],Fs#fs{s=cleared,regs=Rs,vars=Vs},Count}; cleared -> - {Is,Fs#fs{regs=Rs},Count2} + {Is,Fs#fs{regs=Rs,vars=Vs},Count2} end. float_load([A|As], [T|Ts], Rs0, Count0, Acc) -> @@ -1143,12 +1296,12 @@ float_flush_regs(#fs{regs=Rs}) -> %%% with a cheaper instructions %%% -ssa_opt_live({#st{ssa=Linear0}=St, FuncDb}) -> +ssa_opt_live({#opt_st{ssa=Linear0}=St, FuncDb}) -> RevLinear = reverse(Linear0), Blocks0 = maps:from_list(RevLinear), Blocks = live_opt(RevLinear, #{}, Blocks0), Linear = beam_ssa:linearize(Blocks), - {St#st{ssa=Linear}, FuncDb}. + {St#opt_st{ssa=Linear}, FuncDb}. live_opt([{L,Blk0}|Bs], LiveMap0, Blocks) -> Blk1 = beam_ssa_share:block(Blk0, Blocks), @@ -1208,34 +1361,31 @@ live_opt_is([#b_set{op=phi,dst=Dst}=I|Is], Live, Acc) -> false -> live_opt_is(Is, Live, Acc) end; -live_opt_is([#b_set{op=succeeded,dst=SuccDst=SuccDstVar, - args=[Dst]}=SuccI, - #b_set{dst=Dst}=I|Is], Live0, Acc) -> - case gb_sets:is_member(Dst, Live0) of - true -> - Live1 = gb_sets:add(Dst, Live0), - Live = gb_sets:delete_any(SuccDst, Live1), - live_opt_is([I|Is], Live, [SuccI|Acc]); - false -> - case live_opt_unused(I) of - {replace,NewI0} -> - NewI = NewI0#b_set{dst=SuccDstVar}, - live_opt_is([NewI|Is], Live0, Acc); - keep -> - case gb_sets:is_member(SuccDst, Live0) of - true -> - Live1 = gb_sets:add(Dst, Live0), - Live = gb_sets:delete(SuccDst, Live1), - live_opt_is([I|Is], Live, [SuccI|Acc]); - false -> - live_opt_is([I|Is], Live0, Acc) - end - end +live_opt_is([#b_set{op=succeeded,dst=SuccDst,args=[MapDst]}=SuccI, + #b_set{op=get_map_element,dst=MapDst}=MapI | Is], + Live0, Acc) -> + case {gb_sets:is_member(SuccDst, Live0), + gb_sets:is_member(MapDst, Live0)} of + {true, true} -> + Live = gb_sets:delete(SuccDst, Live0), + live_opt_is([MapI | Is], Live, [SuccI | Acc]); + {true, false} -> + %% 'get_map_element' is unused; replace 'succeeded' with + %% 'has_map_field' + NewI = MapI#b_set{op=has_map_field,dst=SuccDst}, + live_opt_is([NewI | Is], Live0, Acc); + {false, true} -> + %% 'succeeded' is unused (we know it will succeed); discard it and + %% keep 'get_map_element' + live_opt_is([MapI | Is], Live0, Acc); + {false, false} -> + live_opt_is(Is, Live0, Acc) end; live_opt_is([#b_set{dst=Dst}=I|Is], Live0, Acc) -> case gb_sets:is_member(Dst, Live0) of true -> - Live1 = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))), + LiveUsed = gb_sets:from_ordset(beam_ssa:used(I)), + Live1 = gb_sets:union(Live0, LiveUsed), Live = gb_sets:delete(Dst, Live1), live_opt_is(Is, Live, [I|Acc]); false -> @@ -1243,16 +1393,112 @@ live_opt_is([#b_set{dst=Dst}=I|Is], Live0, Acc) -> true -> live_opt_is(Is, Live0, Acc); false -> - Live = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))), + LiveUsed = gb_sets:from_ordset(beam_ssa:used(I)), + Live = gb_sets:union(Live0, LiveUsed), live_opt_is(Is, Live, [I|Acc]) end end; live_opt_is([], Live, Acc) -> {Acc,Live}. -live_opt_unused(#b_set{op=get_map_element}=Set) -> - {replace,Set#b_set{op=has_map_field}}; -live_opt_unused(_) -> keep. +%%% +%%% Do a strength reduction of try/catch and catch. +%%% +%%% In try/catch constructs where the expression is restricted +%%% (essentially a guard expression) and the error reason is ignored +%%% in the catch part, such as: +%%% +%%% try +%%% <RestrictedExpression> +%%% catch +%%% _:_ -> +%%% ... +%%% end +%%% +%%% the try/catch can be eliminated by simply removing the `new_try_tag`, +%%% `landingpad`, and `kill_try_tag` instructions. + +ssa_opt_try({#opt_st{ssa=Linear0}=St, FuncDb}) -> + Linear = opt_try(Linear0), + {St#opt_st{ssa=Linear}, FuncDb}. + +opt_try([{L,#b_blk{is=[#b_set{op=new_try_tag}], + last=Last}=Blk0}|Bs0]) -> + #b_br{succ=Succ,fail=Fail} = Last, + Ws = cerl_sets:from_list([Succ,Fail]), + try do_opt_try(Bs0, Ws) of + Bs -> + Blk = Blk0#b_blk{is=[], + last=#b_br{bool=#b_literal{val=true}, + succ=Succ,fail=Succ}}, + [{L,Blk}|opt_try(Bs)] + catch + throw:not_possible -> + [{L,Blk0}|opt_try(Bs0)] + end; +opt_try([{L,Blk}|Bs]) -> + [{L,Blk}|opt_try(Bs)]; +opt_try([]) -> []. + +do_opt_try([{L,Blk}|Bs]=Bs0, Ws0) -> + case cerl_sets:is_element(L, Ws0) of + false -> + %% This block is not reachable from the block with the + %% `new_try_tag` instruction. Retain it. There is no + %% need to check it for safety. + case cerl_sets:size(Ws0) of + 0 -> Bs0; + _ -> [{L,Blk}|do_opt_try(Bs, Ws0)] + end; + true -> + Ws1 = cerl_sets:del_element(L, Ws0), + #b_blk{is=Is0} = Blk, + case is_safe_without_try(Is0, []) of + safe -> + %% This block does not execute any instructions + %% that would require a try. Analyze successors. + Successors = beam_ssa:successors(Blk), + Ws = cerl_sets:union(cerl_sets:from_list(Successors), + Ws1), + [{L,Blk}|do_opt_try(Bs, Ws)]; + unsafe -> + %% There is something unsafe in the block, for + %% example a `call` instruction or an `extract` + %% instruction. + throw(not_possible); + {done,Is} -> + %% This block kills the try tag (either after successful + %% execution or at the landing pad). Don't analyze + %% successors. + [{L,Blk#b_blk{is=Is}}|do_opt_try(Bs, Ws1)] + end + end; +do_opt_try([], Ws) -> + 0 = cerl_sets:size(Ws), %Assertion. + []. + +is_safe_without_try([#b_set{op=kill_try_tag}|Is], Acc) -> + %% Remove this kill_try_tag instruction. If there was a landingpad + %% instruction in this block, it has already been removed. Preserve + %% all other instructions in the block. + {done,reverse(Is, Acc)}; +is_safe_without_try([#b_set{op=extract}|_], _Acc) -> + %% The error reason is accessed. + unsafe; +is_safe_without_try([#b_set{op=exception_trampoline}|Is], Acc) -> + is_safe_without_try(Is, Acc); +is_safe_without_try([#b_set{op=landingpad}|Is], Acc) -> + is_safe_without_try(Is, Acc); +is_safe_without_try([#b_set{op=Op}=I|Is], Acc) -> + IsSafe = case Op of + phi -> true; + _ -> beam_ssa:no_side_effect(I) + end, + case IsSafe of + true -> is_safe_without_try(Is, [I|Acc]); + false -> unsafe + end; +is_safe_without_try([], _Acc) -> safe. %%% %%% Optimize binary matching. @@ -1264,10 +1510,10 @@ live_opt_unused(_) -> keep. %%% with bs_test_tail. %%% -ssa_opt_bsm({#st{ssa=Linear}=St, FuncDb}) -> +ssa_opt_bsm({#opt_st{ssa=Linear}=St, FuncDb}) -> Extracted0 = bsm_extracted(Linear), Extracted = cerl_sets:from_list(Extracted0), - {St#st{ssa=bsm_skip(Linear, Extracted)}, FuncDb}. + {St#opt_st{ssa=bsm_skip(Linear, Extracted)}, FuncDb}. bsm_skip([{L,#b_blk{is=Is0}=Blk}|Bs0], Extracted) -> Bs = bsm_skip(Bs0, Extracted), @@ -1365,14 +1611,14 @@ coalesce_skips_is(_, _, _) -> %%% Short-cutting binary matching instructions. %%% -ssa_opt_bsm_shortcut({#st{ssa=Linear}=St, FuncDb}) -> +ssa_opt_bsm_shortcut({#opt_st{ssa=Linear}=St, FuncDb}) -> Positions = bsm_positions(Linear, #{}), case map_size(Positions) of 0 -> %% No binary matching instructions. {St, FuncDb}; _ -> - {St#st{ssa=bsm_shortcut(Linear, Positions)}, FuncDb} + {St#opt_st{ssa=bsm_shortcut(Linear, Positions)}, FuncDb} end. bsm_positions([{L,#b_blk{is=Is,last=Last}}|Bs], PosMap0) -> @@ -1431,110 +1677,6 @@ bsm_shortcut([{L,#b_blk{is=Is,last=Last0}=Blk}|Bs], PosMap) -> bsm_shortcut([], _PosMap) -> []. %%% -%%% Eliminate redundant bs_test_unit2 instructions. -%%% - -ssa_opt_bsm_units({#st{ssa=Linear}=St, FuncDb}) -> - {St#st{ssa=bsm_units(Linear, #{})}, FuncDb}. - -bsm_units([{L,#b_blk{last=#b_br{succ=Succ,fail=Fail}}=Block0} | Bs], UnitMaps0) -> - UnitsIn = maps:get(L, UnitMaps0, #{}), - {Block, UnitsOut} = bsm_units_skip(Block0, UnitsIn), - UnitMaps1 = bsm_units_join(Succ, UnitsOut, UnitMaps0), - UnitMaps = bsm_units_join(Fail, UnitsIn, UnitMaps1), - [{L, Block} | bsm_units(Bs, UnitMaps)]; -bsm_units([{L,#b_blk{last=#b_switch{fail=Fail,list=Switch}}=Block} | Bs], UnitMaps0) -> - UnitsIn = maps:get(L, UnitMaps0, #{}), - Labels = [Fail | [Lbl || {_Arg, Lbl} <- Switch]], - UnitMaps = foldl(fun(Lbl, UnitMaps) -> - bsm_units_join(Lbl, UnitsIn, UnitMaps) - end, UnitMaps0, Labels), - [{L, Block} | bsm_units(Bs, UnitMaps)]; -bsm_units([{L, Block} | Bs], UnitMaps) -> - [{L, Block} | bsm_units(Bs, UnitMaps)]; -bsm_units([], _UnitMaps) -> - []. - -bsm_units_skip(Block, Units) -> - bsm_units_skip_1(Block#b_blk.is, Block, Units). - -bsm_units_skip_1([#b_set{op=bs_start_match,dst=New}|_], Block, Units) -> - %% We bail early since there can't be more than one match per block. - {Block, Units#{ New => 1 }}; -bsm_units_skip_1([#b_set{op=bs_match, - dst=New, - args=[#b_literal{val=skip}, - Ctx, - #b_literal{val=binary}, - _Flags, - #b_literal{val=all}, - #b_literal{val=OpUnit}]}=Skip | Test], - Block0, Units) -> - [#b_set{op=succeeded,dst=Bool,args=[New]}] = Test, %Assertion. - #b_br{bool=Bool} = Last0 = Block0#b_blk.last, %Assertion. - CtxUnit = map_get(Ctx, Units), - if - CtxUnit rem OpUnit =:= 0 -> - Is = takewhile(fun(I) -> I =/= Skip end, Block0#b_blk.is), - Last = Last0#b_br{bool=#b_literal{val=true}}, - Block = Block0#b_blk{is=Is,last=Last}, - {Block, Units#{ New => CtxUnit }}; - CtxUnit rem OpUnit =/= 0 -> - {Block0, Units#{ New => OpUnit, Ctx => OpUnit }} - end; -bsm_units_skip_1([#b_set{op=bs_match,dst=New,args=Args}|_], Block, Units) -> - [_,Ctx|_] = Args, - CtxUnit = map_get(Ctx, Units), - OpUnit = bsm_op_unit(Args), - {Block, Units#{ New => gcd(OpUnit, CtxUnit) }}; -bsm_units_skip_1([_I | Is], Block, Units) -> - bsm_units_skip_1(Is, Block, Units); -bsm_units_skip_1([], Block, Units) -> - {Block, Units}. - -bsm_op_unit([_,_,_,Size,#b_literal{val=U}]) -> - case Size of - #b_literal{val=Sz} when is_integer(Sz) -> Sz*U; - _ -> U - end; -bsm_op_unit([#b_literal{val=string},_,#b_literal{val=String}]) -> - bit_size(String); -bsm_op_unit([#b_literal{val=utf8}|_]) -> - 8; -bsm_op_unit([#b_literal{val=utf16}|_]) -> - 16; -bsm_op_unit([#b_literal{val=utf32}|_]) -> - 32; -bsm_op_unit(_) -> - 1. - -%% Several paths can lead to the same match instruction and the inferred units -%% may differ between them, so we can only keep the information that is common -%% to all paths. -bsm_units_join(Lbl, MapA, UnitMaps0) when is_map_key(Lbl, UnitMaps0) -> - MapB = map_get(Lbl, UnitMaps0), - Merged = if - map_size(MapB) =< map_size(MapA) -> - bsm_units_join_1(maps:keys(MapB), MapA, MapB); - map_size(MapB) > map_size(MapA) -> - bsm_units_join_1(maps:keys(MapA), MapB, MapA) - end, - UnitMaps0#{Lbl := Merged}; -bsm_units_join(Lbl, MapA, UnitMaps0) when MapA =/= #{} -> - UnitMaps0#{Lbl => MapA}; -bsm_units_join(_Lbl, _MapA, UnitMaps0) -> - UnitMaps0. - -bsm_units_join_1([Key | Keys], Left, Right) when is_map_key(Key, Left) -> - UnitA = map_get(Key, Left), - UnitB = map_get(Key, Right), - bsm_units_join_1(Keys, Left, Right#{Key := gcd(UnitA, UnitB)}); -bsm_units_join_1([Key | Keys], Left, Right) -> - bsm_units_join_1(Keys, Left, maps:remove(Key, Right)); -bsm_units_join_1([], _MapA, Right) -> - Right. - -%%% %%% Optimize binary construction. %%% %%% If an integer segment or a float segment has a literal size and @@ -1543,9 +1685,9 @@ bsm_units_join_1([], _MapA, Right) -> %%% to bs_put_string instructions in later pass. %%% -ssa_opt_bs_puts({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> +ssa_opt_bs_puts({#opt_st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> {Linear,Count} = opt_bs_puts(Linear0, Count0, []), - {St#st{ssa=Linear,cnt=Count}, FuncDb}. + {St#opt_st{ssa=Linear,cnt=Count}, FuncDb}. opt_bs_puts([{L,#b_blk{is=Is}=Blk0}|Bs], Count0, Acc0) -> case Is of @@ -1641,8 +1783,13 @@ opt_bs_put(#b_set{args=[#b_literal{val=Type},#b_literal{val=Flags}, I = I0#b_set{args=Args}, opt_bs_put(I); {binary,_} when is_bitstring(Val) -> - <<Bitstring:EffectiveSize/bits,_/bits>> = Val, - [Bitstring]; + case Val of + <<Bitstring:EffectiveSize/bits,_/bits>> -> + [Bitstring]; + _ -> + %% Specified size exceeds size of bitstring. + not_possible + end; {float,Endian} -> try [opt_bs_put_float(Val, EffectiveSize, Endian)] @@ -1763,12 +1910,12 @@ opt_bs_put_split_int_1(Int, L, R) -> %%% is_tuple_of_arity instruction by the loader. %%% -ssa_opt_tuple_size({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> +ssa_opt_tuple_size({#opt_st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> %% This optimization is only safe in guards, as prefixing tuple_size with %% an is_tuple check prevents it from throwing an exception. NonGuards = non_guards(Linear0), {Linear,Count} = opt_tup_size(Linear0, NonGuards, Count0, []), - {St#st{ssa=Linear,cnt=Count}, FuncDb}. + {St#opt_st{ssa=Linear,cnt=Count}, FuncDb}. opt_tup_size([{L,#b_blk{is=Is,last=Last}=Blk}|Bs], NonGuards, Count0, Acc0) -> case {Is,Last} of @@ -1835,33 +1982,20 @@ opt_tup_size_is([], _, _, _Acc) -> none. %%% %%% Optimize #b_switch{} instructions. %%% -%%% If the argument for a #b_switch{} comes from a phi node with all -%%% literals, any values in the switch list which are not in the phi -%%% node can be removed. -%%% -%%% If the values in the phi node and switch list are the same, -%%% the failure label can't be reached and be eliminated. -%%% %%% A #b_switch{} with only one value can be rewritten to %%% a #b_br{}. A switch that only verifies that the argument -%%% is 'true' or 'false' can be rewritten to a is_boolean test. -%%% +%%% is 'true' or 'false' can be rewritten to an is_boolean test. +%%%b -ssa_opt_sw({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> +ssa_opt_sw({#opt_st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> {Linear,Count} = opt_sw(Linear0, Count0, []), - {St#st{ssa=Linear,cnt=Count}, FuncDb}. + {St#opt_st{ssa=Linear,cnt=Count}, FuncDb}. opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Sw0}=Blk0}|Bs], Count0, Acc) -> - %% Ensure that no label in the switch list is the same - %% as the failure label. - #b_switch{fail=Fail,list=List0} = Sw0, - List = [{Val,Lbl} || {Val,Lbl} <- List0, Lbl =/= Fail], - Sw1 = beam_ssa:normalize(Sw0#b_switch{list=List}), - case Sw1 of + case Sw0 of #b_switch{arg=Arg,fail=Fail,list=[{Lit,Lbl}]} -> %% Rewrite a single value switch to a br. - Bool = #b_var{name={'@ssa_bool',Count0}}, - Count = Count0 + 1, + {Bool,Count} = new_var('@ssa_bool', Count0), IsEq = #b_set{op={bif,'=:='},dst=Bool,args=[Arg,Lit]}, Br = #b_br{bool=Bool,succ=Lbl,fail=Fail}, Blk = Blk0#b_blk{is=Is++[IsEq],last=Br}, @@ -1870,17 +2004,13 @@ opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Sw0}=Blk0}|Bs], Count0, Acc) -> list=[{#b_literal{val=B1},Lbl},{#b_literal{val=B2},Lbl}]} when B1 =:= not B2 -> %% Replace with is_boolean test. - Bool = #b_var{name={'@ssa_bool',Count0}}, - Count = Count0 + 1, + {Bool,Count} = new_var('@ssa_bool', Count0), IsBool = #b_set{op={bif,is_boolean},dst=Bool,args=[Arg]}, Br = #b_br{bool=Bool,succ=Lbl,fail=Fail}, Blk = Blk0#b_blk{is=Is++[IsBool],last=Br}, opt_sw(Bs, Count, [{L,Blk}|Acc]); - Sw0 -> - opt_sw(Bs, Count0, [{L,Blk0}|Acc]); - Sw -> - Blk = Blk0#b_blk{last=Sw}, - opt_sw(Bs, Count0, [{L,Blk}|Acc]) + _ -> + opt_sw(Bs, Count0, [{L,Blk0}|Acc]) end; opt_sw([{L,#b_blk{}=Blk}|Bs], Count, Acc) -> opt_sw(Bs, Count, [{L,Blk}|Acc]); @@ -1891,10 +2021,10 @@ opt_sw([], Count, Acc) -> %%% Merge blocks. %%% -ssa_opt_merge_blocks({#st{ssa=Blocks}=St, FuncDb}) -> +ssa_opt_merge_blocks({#opt_st{ssa=Blocks}=St, FuncDb}) -> Preds = beam_ssa:predecessors(Blocks), Merged = merge_blocks_1(beam_ssa:rpo(Blocks), Preds, Blocks), - {St#st{ssa=Merged}, FuncDb}. + {St#opt_st{ssa=Merged}, FuncDb}. merge_blocks_1([L|Ls], Preds0, Blocks0) -> case Preds0 of @@ -1937,9 +2067,17 @@ verify_merge_is([#b_set{op=Op}|_]) -> verify_merge_is(_) -> ok. -is_merge_allowed(_, #b_blk{}, #b_blk{is=[#b_set{op=peek_message}|_]}) -> +is_merge_allowed(_, #b_blk{}, #b_blk{is=[#b_set{op=exception_trampoline}|_]}) -> false; -is_merge_allowed(L, #b_blk{last=#b_br{}}=Blk, #b_blk{is=Is}) -> +is_merge_allowed(_, #b_blk{is=[#b_set{op=exception_trampoline}|_]}, #b_blk{}) -> + false; +is_merge_allowed(L, #b_blk{}=Blk1, #b_blk{is=[#b_set{}=I|_]}=Blk2) -> + not beam_ssa:is_loop_header(I) andalso + is_merge_allowed_1(L, Blk1, Blk2); +is_merge_allowed(L, Blk1, Blk2) -> + is_merge_allowed_1(L, Blk1, Blk2). + +is_merge_allowed_1(L, #b_blk{last=#b_br{}}=Blk, #b_blk{is=Is}) -> %% The predecessor block must have exactly one successor (L) for %% the merge to be safe. case beam_ssa:successors(Blk) of @@ -1958,7 +2096,7 @@ is_merge_allowed(L, #b_blk{last=#b_br{}}=Blk, #b_blk{is=Is}) -> [_|_] -> false end; -is_merge_allowed(_, #b_blk{last=#b_switch{}}, #b_blk{}) -> +is_merge_allowed_1(_, #b_blk{last=#b_switch{}}, #b_blk{}) -> false. %%% @@ -1977,9 +2115,7 @@ is_merge_allowed(_, #b_blk{last=#b_switch{}}, #b_blk{}) -> %%% extracted values. %%% -ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) -> - Linear = beam_ssa:linearize(Blocks0), - +ssa_opt_sink({#opt_st{ssa=Linear}=St, FuncDb}) -> %% Create a map with all variables that define get_tuple_element %% instructions. The variable name map to the block it is defined in. case def_blocks(Linear) of @@ -1988,10 +2124,12 @@ ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) -> {St, FuncDb}; [_|_]=Defs0 -> Defs = maps:from_list(Defs0), - {do_ssa_opt_sink(Linear, Defs, St), FuncDb} + {do_ssa_opt_sink(Defs, St), FuncDb} end. -do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) -> +do_ssa_opt_sink(Defs, #opt_st{ssa=Linear}=St) -> + Blocks0 = maps:from_list(Linear), + %% Now find all the blocks that use variables defined by get_tuple_element %% instructions. Used = used_blocks(Linear, Defs, []), @@ -2016,7 +2154,8 @@ do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) -> From = map_get(V, Defs), move_defs(V, From, To, A) end, Blocks0, DefLoc), - St#st{ssa=Blocks}. + + St#opt_st{ssa=beam_ssa:linearize(Blocks)}. def_blocks([{L,#b_blk{is=Is}}|Bs]) -> def_blocks_is(Is, L, def_blocks(Bs)); @@ -2045,15 +2184,14 @@ unsuitable(Linear, Blocks) -> Unsuitable1 = unsuitable_recv(Linear, Blocks, Predecessors), gb_sets:from_list(Unsuitable0 ++ Unsuitable1). -unsuitable_1([{L,#b_blk{is=[#b_set{op=Op}|_]}}|Bs]) -> +unsuitable_1([{L,#b_blk{is=[#b_set{op=Op}=I|_]}}|Bs]) -> Unsuitable = case Op of bs_extract -> true; bs_put -> true; + exception_trampoline -> true; {float,_} -> true; landingpad -> true; - peek_message -> true; - wait_timeout -> true; - _ -> false + _ -> beam_ssa:is_loop_header(I) end, case Unsuitable of true -> @@ -2087,10 +2225,10 @@ unsuitable_loop(L, Blocks, Predecessors, Acc) -> unsuitable_loop_1(Ps, Blocks, Predecessors, Acc). unsuitable_loop_1([P|Ps], Blocks, Predecessors, Acc0) -> - case map_get(P, Blocks) of - #b_blk{is=[#b_set{op=peek_message}|_]} -> + case is_loop_header(P, Blocks) of + true -> unsuitable_loop_1(Ps, Blocks, Predecessors, Acc0); - #b_blk{} -> + false -> case ordsets:is_element(P, Acc0) of false -> Acc1 = ordsets:add_element(P, Acc0), @@ -2102,6 +2240,14 @@ unsuitable_loop_1([P|Ps], Blocks, Predecessors, Acc0) -> end; unsuitable_loop_1([], _, _, Acc) -> Acc. +is_loop_header(L, Blocks) -> + case map_get(L, Blocks) of + #b_blk{is=[I|_]} -> + beam_ssa:is_loop_header(I); + #b_blk{} -> + false + end. + %% new_def_locations([{Variable,[UsedInBlock]}|Vs], Defs, %% Dominators, Numbering, Unsuitable) -> %% [{Variable,NewDefinitionBlock}] @@ -2207,9 +2353,9 @@ insert_def_is([], _V, Def) -> %%% for combining get_tuple_element instructions. %%% -ssa_opt_get_tuple_element({#st{ssa=Blocks0}=St, FuncDb}) -> +ssa_opt_get_tuple_element({#opt_st{ssa=Blocks0}=St, FuncDb}) -> Blocks = opt_get_tuple_element(maps:to_list(Blocks0), Blocks0), - {St#st{ssa=Blocks}, FuncDb}. + {St#opt_st{ssa=Blocks}, FuncDb}. opt_get_tuple_element([{L,#b_blk{is=Is0}=Blk0}|Bs], Blocks) -> case opt_get_tuple_element_is(Is0, false, []) of @@ -2243,27 +2389,247 @@ collect_get_tuple_element(Is, _Src, Acc) -> {Acc,Is}. %%% -%%% Common utilities. +%%% Unfold literals to avoid unnecessary move instructions in call +%%% instructions. +%%% +%%% Consider the following example: +%%% +%%% -module(whatever). +%%% -export([foo/0]). +%%% foo() -> +%%% foobar(1, 2, 3). +%%% foobar(A, B, C) -> +%%% foobar(A, B, C, []). +%%% foobar(A, B, C, D) -> ... +%%% +%%% The type optimization pass will find out that A, B, and C have constant +%%% values and do constant folding, rewriting foobar/3 to: +%%% +%%% foobar(A, B, C) -> +%%% foobar(1, 2, 3, []). +%%% +%%% That will result in three extra `move` instructions. +%%% +%%% This optimization sub pass will undo the constant folding +%%% optimization, rewriting code to use the original variable instead +%%% of the constant if the original variable is known to be in an x +%%% register. +%%% +%%% This optimization sub pass will also undo constant folding of the +%%% list of arguments in the call to error/2 in the last clause of a +%%% function. For example: +%%% +%%% bar(X, Y) -> +%%% error(function_clause, [X,42]). +%%% +%%% will be rewritten to: +%%% +%%% bar(X, Y) -> +%%% error(function_clause, [X,Y]). %%% -gcd(A, B) -> - case A rem B of - 0 -> B; - X -> gcd(B, X) +ssa_opt_unfold_literals({St,FuncDb}) -> + #opt_st{ssa=Blocks0,args=Args,anno=Anno,cnt=Count0} = St, + ParamInfo = maps:get(parameter_info, Anno, #{}), + LitMap = collect_arg_literals(Args, ParamInfo, 0, #{}), + case map_size(LitMap) of + 0 -> + %% None of the arguments for this function are known + %% literals. Nothing to do. + {St,FuncDb}; + _ -> + SafeMap = #{0 => true}, + {Blocks,Count} = unfold_literals(beam_ssa:rpo(Blocks0), + LitMap, SafeMap, Count0, Blocks0), + {St#opt_st{ssa=Blocks,cnt=Count},FuncDb} end. +collect_arg_literals([V|Vs], Info, X, Acc0) -> + case Info of + #{V:=VarInfo} -> + Type = proplists:get_value(type, VarInfo, any), + case beam_types:get_singleton_value(Type) of + {ok,Val} -> + F = fun(Vars) -> [{X,V}|Vars] end, + Acc = maps:update_with(Val, F, [{X,V}], Acc0), + collect_arg_literals(Vs, Info, X + 1, Acc); + error -> + collect_arg_literals(Vs, Info, X + 1, Acc0) + end; + #{} -> + collect_arg_literals(Vs, Info, X + 1, Acc0) + end; +collect_arg_literals([], _Info, _X, Acc) -> Acc. + +unfold_literals([L|Ls], LitMap, SafeMap0, Count0, Blocks0) -> + {Blocks,Safe,Count} = + case map_get(L, SafeMap0) of + false -> + %% Before reaching this block, an instruction that + %% clobbers x registers has been executed. *If* we + %% would use an argument variable instead of literal, + %% it would force the value to be saved to a y + %% register. This is not what we want. + {Blocks0,false,Count0}; + true -> + %% All x registers live when entering the function + %% are still live. Using the variable instead of + %% the substituted value will eliminate a `move` + %% instruction. + #b_blk{is=Is0} = Blk = map_get(L, Blocks0), + {Is,Safe0,Count1} = unfold_lit_is(Is0, LitMap, Count0, []), + {Blocks0#{L:=Blk#b_blk{is=Is}},Safe0,Count1} + end, + %% Propagate safeness to successors. + Successors = beam_ssa:successors(L, Blocks), + SafeMap = unfold_update_succ(Successors, Safe, SafeMap0), + unfold_literals(Ls, LitMap, SafeMap, Count,Blocks); +unfold_literals([], _, _, Count, Blocks) -> + {Blocks,Count}. + +unfold_update_succ([S|Ss], Safe, SafeMap0) -> + F = fun(Prev) -> Prev and Safe end, + SafeMap = maps:update_with(S, F, Safe, SafeMap0), + unfold_update_succ(Ss, Safe, SafeMap); +unfold_update_succ([], _, SafeMap) -> SafeMap. + +unfold_lit_is([#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}, + arity=2}, + #b_literal{val=function_clause}, + ArgumentList]}=I0|Is], LitMap, Count0, Acc0) -> + %% This is a call to error/2 that raises a function_clause + %% exception in the final clause of a function. Try to undo + %% constant folding in the list of arguments (the second argument + %% for error/2). + case unfold_arg_list(Acc0, ArgumentList, LitMap, Count0, 0, []) of + {[FinalPutList|_]=Acc,Count} -> + %% Acc now contains the possibly rewritten code that + %% creates the argument list. All that remains is to + %% rewrite the call to error/2 itself so that is will + %% refer to rewritten argument list. This is essential + %% when all arguments have known literal values as in this + %% example: + %% + %% foo(X, Y) -> error(function_clause, [0,1]). + %% + #b_set{op=put_list,dst=ListVar} = FinalPutList, + #b_set{args=[ErlangError,Fc,_]} = I0, + I = I0#b_set{args=[ErlangError,Fc,ListVar]}, + {reverse(Acc, [I|Is]),false,Count}; + {[],_} -> + %% Handle code such as: + %% + %% bar(KnownValue, Stk) -> error(function_clause, Stk). + {reverse(Acc0, [I0|Is]),false,Count0} + end; +unfold_lit_is([#b_set{op=Op,args=Args0}=I0|Is], LitMap, Count, Acc) -> + %% Using a register instead of a literal is a clear win only for + %% `call` and `make_fun` instructions. Substituting into other + %% instructions is unlikely to be an improvement. + Unfold = case Op of + call -> true; + make_fun -> true; + _ -> false + end, + I = case Unfold of + true -> + Args = unfold_call_args(Args0, LitMap, -1), + I0#b_set{args=Args}; + false -> + I0 + end, + case beam_ssa:clobbers_xregs(I) of + true -> + %% This instruction clobbers x register. Don't do + %% any substitutions in rest of this block or in any + %% of its successors. + {reverse(Acc, [I|Is]),false,Count}; + false -> + unfold_lit_is(Is, LitMap, Count, [I|Acc]) + end; +unfold_lit_is([], _LitMap, Count, Acc) -> + {reverse(Acc),true,Count}. + +%% unfold_arg_list(Is, ArgumentList, LitMap, Count0, X, Acc) -> +%% {UpdatedAcc, Count}. +%% +%% Unfold the arguments in the argument list (second argument for error/2). +%% +%% Note that Is is the reversed list of instructions before the +%% call to error/2. Because of the way the list is built in reverse, +%% it means that the first put_list instruction found will add the first +%% argument (x0) to the list, the second the second argument (x1), and +%% so on. + +unfold_arg_list(Is, #b_literal{val=[Hd|Tl]}, LitMap, Count0, X, Acc) -> + %% Handle the case that the entire argument list (the second argument + %% for error/2) is a literal. + {PutListDst,Count} = new_var('@put_list', Count0), + PutList = #b_set{op=put_list,dst=PutListDst, + args=[#b_literal{val=Hd},#b_literal{val=Tl}]}, + unfold_arg_list([PutList|Is], PutListDst, LitMap, Count, X, Acc); +unfold_arg_list([#b_set{op=put_list,dst=List, + args=[Hd0,#b_literal{val=[Hd|Tl]}]}=I0|Is0], + List, LitMap, Count0, X, Acc) -> + %% The rest of the argument list is a literal list. + {PutListDst,Count} = new_var('@put_list', Count0), + PutList = #b_set{op=put_list,dst=PutListDst, + args=[#b_literal{val=Hd},#b_literal{val=Tl}]}, + I = I0#b_set{args=[Hd0,PutListDst]}, + unfold_arg_list([I,PutList|Is0], List, LitMap, Count, X, Acc); +unfold_arg_list([#b_set{op=put_list,dst=List,args=[Hd0,Tl]}=I0|Is], + List, LitMap, Count, X, Acc) -> + %% Unfold the head of the list. + Hd = unfold_arg(Hd0, LitMap, X), + I = I0#b_set{args=[Hd,Tl]}, + unfold_arg_list(Is, Tl, LitMap, Count, X + 1, [I|Acc]); +unfold_arg_list([I|Is], List, LitMap, Count, X, Acc) -> + %% Some other instruction, such as bs_get_tail. + unfold_arg_list(Is, List, LitMap, Count, X, [I|Acc]); +unfold_arg_list([], _, _, Count, _, Acc) -> + {reverse(Acc),Count}. + +unfold_call_args([A0|As], LitMap, X) -> + A = unfold_arg(A0, LitMap, X), + [A|unfold_call_args(As, LitMap, X + 1)]; +unfold_call_args([], _, _) -> []. + +unfold_arg(#b_literal{val=Val}=Lit, LitMap, X) -> + case LitMap of + #{Val:=Vars} -> + %% This literal is available in an x register. + %% If it is in the correct x register, use + %% the register. Don't bother if it is in the + %% wrong register, because that would still result + %% in a `move` instruction. + case keyfind(X, 1, Vars) of + false -> Lit; + {X,Var} -> Var + end; + #{} -> Lit + end; +unfold_arg(Expr, _LitMap, _X) -> Expr. + +%%% +%%% Common utilities. +%%% + non_guards(Linear) -> gb_sets:from_list(non_guards_1(Linear)). non_guards_1([{L,#b_blk{is=Is}}|Bs]) -> case Is of + [#b_set{op=exception_trampoline}|_] -> + [L | non_guards_1(Bs)]; [#b_set{op=landingpad}|_] -> [L | non_guards_1(Bs)]; _ -> non_guards_1(Bs) end; non_guards_1([]) -> - [?BADARG_BLOCK]. + [?EXCEPTION_BLOCK]. rel2fam(S0) -> S1 = sofs:relation(S0), @@ -2300,4 +2666,6 @@ new_var(#b_var{name={Base,N}}, Count) -> true = is_integer(N), %Assertion. {#b_var{name={Base,Count}},Count+1}; new_var(#b_var{name=Base}, Count) -> + {#b_var{name={Base,Count}},Count+1}; +new_var(Base, Count) when is_atom(Base) -> {#b_var{name={Base,Count}},Count+1}. diff --git a/lib/compiler/src/beam_ssa_opt.hrl b/lib/compiler/src/beam_ssa_opt.hrl index 37711a6f48..800096dce2 100644 --- a/lib/compiler/src/beam_ssa_opt.hrl +++ b/lib/compiler/src/beam_ssa_opt.hrl @@ -38,16 +38,34 @@ %% when dealing with co-recursive functions. arg_types = [] :: list(arg_type_map()), - %% The inferred return type of this function, this is either [type()] - %% or [] to note absence. - ret_type = [] :: list()}). + %% The success types of this function, grouping return values by their + %% argument types at the time of return. + %% + %% This gives us more precise types than a naive join of all returned + %% values, as we can rule out the cases where the arguments are + %% incompatible with the ones we're passing. + %% + %% Note that the argument types are those seen on successful return, + %% they do not cover all types that are provided to the function. + succ_types = [] :: success_type_set()}). -type arg_key() :: {CallerId :: func_id(), CallDst :: beam_ssa:b_var()}. -type arg_type_map() :: #{ arg_key() => term() }. +-type call_self() :: {call_self, ArgTypes :: [term()]}. +-type success_type_set() :: [{ArgTypes :: [term()], + RetType :: call_self() | term()}]. + %% Per-function metadata used by various optimization passes to perform %% module-level optimization. If a function is absent it means that %% module-level optimization has been turned off for said function. -type func_id() :: beam_ssa:b_local(). -type func_info_db() :: #{ func_id() => #func_info{} }. + +-record(opt_st, {ssa :: [{beam_ssa:label(),beam_ssa:b_blk()}] | + beam_ssa:block_map(), + args :: [beam_ssa:b_var()], + cnt :: beam_ssa:label(), + anno :: beam_ssa:anno()}). +-type st_map() :: #{ func_id() => #opt_st{} }. diff --git a/lib/compiler/src/beam_ssa_pp.erl b/lib/compiler/src/beam_ssa_pp.erl index 34ac08b32e..fdfc91b425 100644 --- a/lib/compiler/src/beam_ssa_pp.erl +++ b/lib/compiler/src/beam_ssa_pp.erl @@ -35,10 +35,10 @@ format_function(#b_function{anno=Anno0,args=Args, #{} -> Anno0 end, - ReachableBlocks = beam_ssa:rpo(Blocks), - All = maps:keys(Blocks), - Unreachable = ordsets:subtract(ordsets:from_list(All), - ordsets:from_list(ReachableBlocks)), + ReachableBlocks = beam_ssa:rpo(Blocks), + All = maps:keys(Blocks), + Unreachable = ordsets:subtract(ordsets:from_list(All), + ordsets:from_list(ReachableBlocks)), [case Anno0 of #{location:={Filename,Line}} -> io_lib:format("%% ~ts:~p\n", [Filename,Line]); @@ -48,7 +48,8 @@ format_function(#b_function{anno=Anno0,args=Args, io_lib:format("%% Counter = ~p\n", [Counter]), [format_anno(Key, Value) || {Key,Value} <- lists:sort(maps:to_list(Anno))], - io_lib:format("function ~p:~p(~ts) {\n", [M,F,format_args(Args, FuncAnno)]), + io_lib:format("function `~p`:`~p`(~ts) {\n", + [M, F, format_args(Args, FuncAnno)]), [format_live_interval(Var, FuncAnno) || Var <- Args], format_blocks(ReachableBlocks, Blocks, FuncAnno), case Unreachable of @@ -82,6 +83,20 @@ format_var(V) -> %%% Local functions. %%% +format_anno(parameter_info, Map) when is_map(Map) -> + case map_size(Map) of + 0 -> + []; + _ -> + Params = lists:sort(maps:to_list(Map)), + Break = "\n%% ", + [io_lib:format("%% Parameters\n", []), + [io_lib:format("%% ~s =>~s~s\n", + [format_var(V), + Break, + format_param_info(I, Break)]) || + {V,I} <- Params]] + end; format_anno(Key, Map) when is_map(Map) -> Sorted = lists:sort(maps:to_list(Map)), [io_lib:format("%% ~s:\n", [Key]), @@ -89,6 +104,20 @@ format_anno(Key, Map) when is_map(Map) -> format_anno(Key, Value) -> io_lib:format("%% ~s: ~p\n", [Key,Value]). +format_param_info([{type, T} | Infos], Break) -> + [format_type(T, Break) | + format_param_info(Infos, Break)]; +format_param_info([Info | Infos], Break) -> + [io_lib:format("~s~p", [Break, Info]) | + format_param_info(Infos, Break)]; +format_param_info([], _Break) -> + []. + +format_type(T, Break) -> + %% Gross hack, but it's short and simple. + Indented = lists:flatten(io_lib:format("~p", [T])), + string:replace(Indented, [$\n], Break, all). + format_blocks(Ls, Blocks, Anno) -> PP = [format_block(L, Blocks, Anno) || L <- Ls], lists:join($\n, PP). @@ -140,16 +169,20 @@ format_i_number(#{n:=N}) -> format_i_number(#{}) -> []. format_terminator(#b_br{anno=A,bool=#b_literal{val=true},succ=Lbl}, _) -> - io_lib:format(" ~sbr label ~p\n", [format_i_number(A),Lbl]); + io_lib:format(" ~sbr ~ts\n", [format_i_number(A),format_label(Lbl)]); format_terminator(#b_br{anno=A,bool=#b_literal{val=false},fail=Lbl}, _) -> - io_lib:format(" ~sbr label ~p\n", [format_i_number(A),Lbl]); + io_lib:format(" ~sbr ~ts\n", [format_i_number(A),format_label(Lbl)]); format_terminator(#b_br{anno=A,bool=Bool,succ=Succ,fail=Fail}, FuncAnno) -> - io_lib:format(" ~sbr ~ts, label ~p, label ~p\n", - [format_i_number(A),format_arg(Bool, FuncAnno),Succ,Fail]); + io_lib:format(" ~sbr ~ts, ~ts, ~ts\n", + [format_i_number(A), + format_arg(Bool, FuncAnno), + format_label(Succ), + format_label(Fail)]); format_terminator(#b_switch{anno=A,arg=Arg,fail=Fail,list=List}, FuncAnno) -> - io_lib:format(" ~sswitch ~ts, label ~p, ~ts\n", - [format_i_number(A),format_arg(Arg, FuncAnno),Fail, - format_list(List,FuncAnno)]); + io_lib:format(" ~sswitch ~ts, ~ts, ~ts\n", + [format_i_number(A),format_arg(Arg, FuncAnno), + format_label(Fail), + format_switch_list(List, FuncAnno)]); format_terminator(#b_ret{anno=A,arg=Arg}, FuncAnno) -> io_lib:format(" ~sret ~ts\n", [format_i_number(A),format_arg(Arg, FuncAnno)]). @@ -189,30 +222,36 @@ format_args(Args, FuncAnno) -> format_arg(#b_var{}=Arg, FuncAnno) -> format_var(Arg, FuncAnno); format_arg(#b_literal{val=Val}, _FuncAnno) -> - io_lib:format("literal ~p", [Val]); + io_lib:format("`~p`", [Val]); format_arg(#b_remote{mod=Mod,name=Name,arity=Arity}, FuncAnno) -> - io_lib:format("remote (~ts):(~ts)/~p", + io_lib:format("(~ts:~ts/~p)", [format_arg(Mod, FuncAnno),format_arg(Name, FuncAnno),Arity]); format_arg(#b_local{name=Name,arity=Arity}, FuncAnno) -> - io_lib:format("local ~ts/~p", [format_arg(Name, FuncAnno),Arity]); + io_lib:format("(~ts/~p)", [format_arg(Name, FuncAnno),Arity]); format_arg({Value,Label}, FuncAnno) when is_integer(Label) -> - io_lib:format("{ ~ts, ~p }", [format_arg(Value, FuncAnno),Label]); + io_lib:format("{ ~ts, ~ts }", [format_arg(Value, FuncAnno), + format_label(Label)]); format_arg(Other, _) -> io_lib:format("*** ~p ***", [Other]). -format_list(List, FuncAnno) -> - Ss = [io_lib:format("{ ~ts, ~ts }", [format_arg(Val, FuncAnno),format_label(L)]) || - {Val,L} <- List], - io_lib:format("[ ~ts ]", [lists:join(", ", Ss)]). +format_switch_list(List, FuncAnno) -> + Ss = [io_lib:format("{ ~ts, ~ts }", [format_arg(Val, FuncAnno), + format_label(L)]) || {Val,L} <- List], + io_lib:format("[\n ~ts\n ]", [lists:join(",\n ", Ss)]). format_label(L) -> - ["label ",integer_to_list(L)]. + io_lib:format("^~w", [L]). format_anno(#{n:=_}=Anno) -> format_anno(maps:remove(n, Anno)); format_anno(#{location:={File,Line}}=Anno0) -> Anno = maps:remove(location, Anno0), - [io_lib:format(" %% ~ts:~p\n", [File,Line])|format_anno_1(Anno)]; + [io_lib:format(" %% ~ts:~p\n", [File,Line])|format_anno(Anno)]; +format_anno(#{result_type:=T}=Anno0) -> + Anno = maps:remove(result_type, Anno0), + Break = "\n %% ", + [io_lib:format(" %% Result type:~s~s\n", + [Break, format_type(T, Break)]) | format_anno(Anno)]; format_anno(Anno) -> format_anno_1(Anno). diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl index 6b4b4890a1..b94223c3cf 100644 --- a/lib/compiler/src/beam_ssa_pre_codegen.erl +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -108,7 +108,8 @@ functions([], _Ps, _UseBSM3) -> []. intervals=[] :: [{b_var(),[range()]}], res=[] :: [{b_var(),reservation()}] | #{b_var():=reservation()}, regs=#{} :: #{b_var():=ssa_register()}, - extra_annos=[] :: [{atom(),term()}] + extra_annos=[] :: [{atom(),term()}], + location :: term() }). -define(PASS(N), {N,fun N/1}). @@ -118,8 +119,10 @@ passes(Opts) -> Ps = [?PASS(assert_no_critical_edges), %% Preliminaries. + ?PASS(exception_trampolines), ?PASS(fix_bs), ?PASS(sanitize), + ?PASS(match_fail_instructions), case FixTuples of false -> ignore; true -> ?PASS(fix_tuples) @@ -164,7 +167,9 @@ passes(Opts) -> function(#b_function{anno=Anno,args=Args,bs=Blocks0,cnt=Count0}=F0, Ps, UseBSM3) -> try - St0 = #st{ssa=Blocks0,args=Args,use_bsm3=UseBSM3,cnt=Count0}, + Location = maps:get(location, Anno, none), + St0 = #st{ssa=Blocks0,args=Args,use_bsm3=UseBSM3, + cnt=Count0,location=Location}, St = compile:run_sub_passes(Ps, St0), #st{ssa=Blocks,cnt=Count,regs=Regs,extra_annos=ExtraAnnos} = St, F1 = add_extra_annos(F0, ExtraAnnos), @@ -253,25 +258,26 @@ bs_pos_bsm3(Linear0, CtxChain, Count0) -> S = sofs:to_external(S1), {SavePoints,Count1} = make_bs_pos_dict(S, Count0, []), - {Gets,Count2} = make_bs_setpos_map(Rs, SavePoints, Count1, []), - {Sets,Count} = make_bs_getpos_map(maps:to_list(Rs0), SavePoints, Count2, []), + + {Gets,Count2} = make_bs_getpos_map(Rs, SavePoints, Count1, []), + {Sets,Count} = make_bs_setpos_map(maps:to_list(Rs0), SavePoints, Count2, []), %% Now insert all saves and restores. - {bs_insert_bsm3(Linear0, Gets, Sets, SavePoints),Count}. + {bs_insert_bsm3(Linear0, Gets, Sets), Count}. -make_bs_setpos_map([{Ctx,Save}=Ps|T], SavePoints, Count, Acc) -> +make_bs_getpos_map([{Ctx,Save}=Ps|T], SavePoints, Count, Acc) -> SavePoint = get_savepoint(Ps, SavePoints), I = #b_set{op=bs_get_position,dst=SavePoint,args=[Ctx]}, - make_bs_setpos_map(T, SavePoints, Count+1, [{Save,I}|Acc]); -make_bs_setpos_map([], _, Count, Acc) -> + make_bs_getpos_map(T, SavePoints, Count+1, [{Save,I}|Acc]); +make_bs_getpos_map([], _, Count, Acc) -> {maps:from_list(Acc),Count}. -make_bs_getpos_map([{Bef,{Ctx,_}=Ps}|T], SavePoints, Count, Acc) -> +make_bs_setpos_map([{Bef,{Ctx,_}=Ps}|T], SavePoints, Count, Acc) -> Ignored = #b_var{name={'@ssa_ignored',Count}}, Args = [Ctx, get_savepoint(Ps, SavePoints)], I = #b_set{op=bs_set_position,dst=Ignored,args=Args}, - make_bs_getpos_map(T, SavePoints, Count+1, [{Bef,I}|Acc]); -make_bs_getpos_map([], _, Count, Acc) -> + make_bs_setpos_map(T, SavePoints, Count+1, [{Bef,I}|Acc]); +make_bs_setpos_map([], _, Count, Acc) -> {maps:from_list(Acc),Count}. get_savepoint({_,_}=Ps, SavePoints) -> @@ -394,30 +400,37 @@ join_positions_1(MapPos0, MapPos1) -> %% bs_restores_is([#b_set{op=bs_start_match,dst=Start}|Is], - CtxChain, SPos0, FPos, Rs) -> - %% We only allow one match per block. - SPos0 = FPos, %Assertion. + CtxChain, SPos0, _FPos, Rs) -> + %% Match instructions leave the position unchanged on failure, so + %% FPos must be the SPos we entered the *instruction* with, and not the + %% *block*. + %% + %% This is important when we have multiple matches in a single block where + %% all but the last are guaranteed to succeed; the upcoming fail block must + %% restore to the position of the next-to-last match, not the position we + %% entered the current block with. + FPos = SPos0, SPos = SPos0#{Start=>Start}, bs_restores_is(Is, CtxChain, SPos, FPos, Rs); bs_restores_is([#b_set{op=bs_match,dst=NewPos,args=Args}=I|Is], - CtxChain, SPos0, FPos0, Rs0) -> - SPos0 = FPos0, %Assertion. + CtxChain, SPos0, _FPos, Rs0) -> Start = bs_subst_ctx(NewPos, CtxChain), [_,FromPos|_] = Args, case SPos0 of #{Start:=FromPos} -> %% Same position, no restore needed. SPos = case bs_match_type(I) of - plain -> - %% Update position to new position. - SPos0#{Start:=NewPos}; - _ -> - %% Position will not change (test_unit - %% instruction or no instruction at - %% all). - SPos0#{Start:=FromPos} - end, - bs_restores_is(Is, CtxChain, SPos, FPos0, Rs0); + plain -> + %% Update position to new position. + SPos0#{Start:=NewPos}; + _ -> + %% Position will not change (test_unit + %% instruction or no instruction at + %% all). + SPos0 + end, + FPos = SPos0, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs0); #{Start:=_} -> %% Different positions, might need a restore instruction. case bs_match_type(I) of @@ -425,50 +438,71 @@ bs_restores_is([#b_set{op=bs_match,dst=NewPos,args=Args}=I|Is], %% This is a tail test that will be optimized away. %% There's no need to do a restore, and all %% positions are unchanged. - bs_restores_is(Is, CtxChain, SPos0, FPos0, Rs0); + FPos = SPos0, + bs_restores_is(Is, CtxChain, SPos0, FPos, Rs0); test_unit -> %% This match instruction will be replaced by %% a test_unit instruction. We will need a %% restore. The new position will be the position %% restored to (NOT NewPos). SPos = SPos0#{Start:=FromPos}, - FPos = FPos0#{Start:=FromPos}, + FPos = SPos, Rs = Rs0#{NewPos=>{Start,FromPos}}, bs_restores_is(Is, CtxChain, SPos, FPos, Rs); plain -> %% Match or skip. Position will be changed. SPos = SPos0#{Start:=NewPos}, - FPos = FPos0#{Start:=FromPos}, + FPos = SPos0#{Start:=FromPos}, Rs = Rs0#{NewPos=>{Start,FromPos}}, bs_restores_is(Is, CtxChain, SPos, FPos, Rs) end end; bs_restores_is([#b_set{op=bs_extract,args=[FromPos|_]}|Is], - CtxChain, SPos, FPos, Rs) -> + CtxChain, SPos, _FPos, Rs) -> Start = bs_subst_ctx(FromPos, CtxChain), + #{Start:=FromPos} = SPos, %Assertion. - #{Start:=FromPos} = FPos, %Assertion. + FPos = SPos, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); bs_restores_is([#b_set{op=call,dst=Dst,args=Args}|Is], - CtxChain, SPos0, FPos0, Rs0) -> - {Rs, SPos1, FPos1} = bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0), - {SPos, FPos} = bs_invalidate_pos(Args, SPos1, FPos1, CtxChain), + CtxChain, SPos0, _FPos, Rs0) -> + {SPos1, Rs} = bs_restore_args(Args, SPos0, CtxChain, Dst, Rs0), + + SPos = bs_invalidate_pos(Args, SPos1, CtxChain), + FPos = SPos, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); -bs_restores_is([#b_set{op=landingpad}|Is], CtxChain, SPos0, FPos0, Rs) -> +bs_restores_is([#b_set{op=landingpad}|Is], CtxChain, SPos0, _FPos, Rs) -> %% We can land here from any point, so all positions are invalid. Invalidate = fun(_Start,_Pos) -> unknown end, + SPos = maps:map(Invalidate, SPos0), - FPos = maps:map(Invalidate, FPos0), + FPos = SPos, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); bs_restores_is([#b_set{op=Op,dst=Dst,args=Args}|Is], - CtxChain, SPos0, FPos0, Rs0) + CtxChain, SPos0, _FPos, Rs0) when Op =:= bs_test_tail; Op =:= bs_get_tail -> - {Rs, SPos, FPos} = bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0), + {SPos, Rs} = bs_restore_args(Args, SPos0, CtxChain, Dst, Rs0), + FPos = SPos, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); -bs_restores_is([_|Is], CtxChain, SPos, FPos, Rs) -> +bs_restores_is([#b_set{op=succeeded,args=[Arg]}], CtxChain, SPos, FPos0, Rs) -> + %% If we're branching on a match operation, the positions will be different + %% depending on whether it succeeds. + Ctx = bs_subst_ctx(Arg, CtxChain), + FPos = case SPos of + #{ Ctx := _ } -> FPos0; + #{} -> SPos + end, + {SPos, FPos, Rs}; +bs_restores_is([_ | Is], CtxChain, SPos, _FPos, Rs) -> + FPos = SPos, bs_restores_is(Is, CtxChain, SPos, FPos, Rs); -bs_restores_is([], _CtxChain, SPos, FPos, Rs) -> +bs_restores_is([], _CtxChain, SPos, _FPos, Rs) -> + FPos = SPos, {SPos, FPos, Rs}. bs_match_type(#b_set{args=[#b_literal{val=skip},_Ctx, @@ -483,54 +517,52 @@ bs_match_type(_) -> %% Call instructions leave the match position in an undefined state, %% requiring us to invalidate each affected argument. -bs_invalidate_pos([#b_var{}=Arg|Args], SPos0, FPos0, CtxChain) -> +bs_invalidate_pos([#b_var{}=Arg|Args], Pos0, CtxChain) -> Start = bs_subst_ctx(Arg, CtxChain), - case SPos0 of + case Pos0 of #{Start:=_} -> - SPos = SPos0#{Start:=unknown}, - FPos = FPos0#{Start:=unknown}, - bs_invalidate_pos(Args, SPos, FPos, CtxChain); + Pos = Pos0#{Start:=unknown}, + bs_invalidate_pos(Args, Pos, CtxChain); #{} -> %% Not a match context. - bs_invalidate_pos(Args, SPos0, FPos0, CtxChain) + bs_invalidate_pos(Args, Pos0, CtxChain) end; -bs_invalidate_pos([_|Args], SPos, FPos, CtxChain) -> - bs_invalidate_pos(Args, SPos, FPos, CtxChain); -bs_invalidate_pos([], SPos, FPos, _CtxChain) -> - {SPos, FPos}. +bs_invalidate_pos([_|Args], Pos, CtxChain) -> + bs_invalidate_pos(Args, Pos, CtxChain); +bs_invalidate_pos([], Pos, _CtxChain) -> + Pos. -bs_restore_args([#b_var{}=Arg|Args], SPos0, FPos0, CtxChain, Dst, Rs0) -> +bs_restore_args([#b_var{}=Arg|Args], Pos0, CtxChain, Dst, Rs0) -> Start = bs_subst_ctx(Arg, CtxChain), - case SPos0 of + case Pos0 of #{Start:=Arg} -> %% Same position, no restore needed. - bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0); + bs_restore_args(Args, Pos0, CtxChain, Dst, Rs0); #{Start:=_} -> %% Different positions, need a restore instruction. - SPos = SPos0#{Start:=Arg}, - FPos = FPos0#{Start:=Arg}, + Pos = Pos0#{Start:=Arg}, Rs = Rs0#{Dst=>{Start,Arg}}, - bs_restore_args(Args, SPos, FPos, CtxChain, Dst, Rs); + bs_restore_args(Args, Pos, CtxChain, Dst, Rs); #{} -> %% Not a match context. - bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0) + bs_restore_args(Args, Pos0, CtxChain, Dst, Rs0) end; -bs_restore_args([_|Args], SPos, FPos, CtxChain, Dst, Rs) -> - bs_restore_args(Args, SPos, FPos, CtxChain, Dst, Rs); -bs_restore_args([], SPos, FPos, _CtxChain, _Dst, Rs) -> - {Rs,SPos,FPos}. +bs_restore_args([_|Args], Pos, CtxChain, Dst, Rs) -> + bs_restore_args(Args, Pos, CtxChain, Dst, Rs); +bs_restore_args([], Pos, _CtxChain, _Dst, Rs) -> + {Pos, Rs}. %% Insert all bs_save and bs_restore instructions. -bs_insert_bsm3(Blocks, Saves, Restores, SavePoints) -> - bs_insert_1(Blocks, Saves, Restores, SavePoints, fun(I) -> I end). +bs_insert_bsm3(Blocks, Saves, Restores) -> + bs_insert_1(Blocks, [], Saves, Restores, fun(I) -> I end). -bs_insert_bsm2(Blocks, Saves, Restores, SavePoints) -> +bs_insert_bsm2(Blocks, Saves, Restores, Slots) -> %% The old instructions require bs_start_match to be annotated with the %% number of position slots it needs. - bs_insert_1(Blocks, Saves, Restores, SavePoints, + bs_insert_1(Blocks, [], Saves, Restores, fun(#b_set{op=bs_start_match,dst=Dst}=I0) -> - NumSlots = case SavePoints of + NumSlots = case Slots of #{Dst:=NumSlots0} -> NumSlots0; #{} -> 0 end, @@ -539,46 +571,38 @@ bs_insert_bsm2(Blocks, Saves, Restores, SavePoints) -> I end). -bs_insert_1([{L,#b_blk{is=Is0}=Blk}|Bs0], Saves, Restores, Slots, XFrm) -> - Is = bs_insert_is_1(Is0, Restores, Slots, XFrm), - Bs = bs_insert_saves(Is, Bs0, Saves), - [{L,Blk#b_blk{is=Is}}|bs_insert_1(Bs, Saves, Restores, Slots, XFrm)]; -bs_insert_1([], _, _, _, _) -> []. +bs_insert_1([{L,#b_blk{is=Is0}=Blk} | Bs], Deferred0, Saves, Restores, XFrm) -> + Is1 = bs_insert_deferred(Is0, Deferred0), + {Is, Deferred} = bs_insert_is(Is1, Saves, Restores, XFrm, []), + [{L,Blk#b_blk{is=Is}} | bs_insert_1(Bs, Deferred, Saves, Restores, XFrm)]; +bs_insert_1([], [], _, _, _) -> + []. -bs_insert_is_1([#b_set{op=Op,dst=Dst}=I0|Is], Restores, SavePoints, XFrm) -> - I = XFrm(I0), - if - Op =:= bs_test_tail; - Op =:= bs_get_tail; - Op =:= bs_match; - Op =:= call -> - Rs = case Restores of - #{Dst:=R} -> [R]; - #{} -> [] - end, - Rs ++ [I|bs_insert_is_1(Is, Restores, SavePoints, XFrm)]; - true -> - [I|bs_insert_is_1(Is, Restores, SavePoints, XFrm)] - end; -bs_insert_is_1([], _, _, _) -> []. +bs_insert_deferred([#b_set{op=bs_extract}=I | Is], Deferred) -> + [I | bs_insert_deferred(Is, Deferred)]; +bs_insert_deferred(Is, Deferred) -> + Deferred ++ Is. -bs_insert_saves([#b_set{dst=Dst}|Is], Bs, Saves) -> - case Saves of - #{Dst:=S} -> - bs_insert_save(S, Bs); - #{} -> - bs_insert_saves(Is, Bs, Saves) +bs_insert_is([#b_set{dst=Dst}=I0|Is], Saves, Restores, XFrm, Acc0) -> + I = XFrm(I0), + Pre = case Restores of + #{Dst:=R} -> [R]; + #{} -> [] + end, + Post = case Saves of + #{Dst:=S} -> [S]; + #{} -> [] + end, + Acc = [I | Pre] ++ Acc0, + case Is of + [#b_set{op=succeeded,args=[Dst]}] -> + %% Defer the save sequence to the success block. + {reverse(Acc, Is), Post}; + _ -> + bs_insert_is(Is, Saves, Restores, XFrm, Post ++ Acc) end; -bs_insert_saves([], Bs, _) -> Bs. - -bs_insert_save(Save, [{L,#b_blk{is=Is0}=Blk}|Bs]) -> - Is = case Is0 of - [#b_set{op=bs_extract}=Ex|Is1] -> - [Ex,Save|Is1]; - _ -> - [Save|Is0] - end, - [{L,Blk#b_blk{is=Is}}|Bs]. +bs_insert_is([], _, _, _, Acc) -> + {reverse(Acc), []}. %% Translate bs_match instructions to bs_get, bs_match_string, %% or bs_skip. Also rename match context variables to use the @@ -598,6 +622,10 @@ bs_instrs([{L,#b_blk{is=Is0}=Blk}|Bs], CtxChain, Acc0) -> bs_instrs([], _, Acc) -> reverse(Acc). +bs_instrs_is([#b_set{op=succeeded}=I|Is], CtxChain, Acc) -> + %% This instruction refers to a specific operation, so we must not + %% substitute the context argument. + bs_instrs_is(Is, CtxChain, [I | Acc]); bs_instrs_is([#b_set{op=Op,args=Args0}=I0|Is], CtxChain, Acc) -> Args = [bs_subst_ctx(A, CtxChain) || A <- Args0], I1 = I0#b_set{args=Args}, @@ -606,8 +634,6 @@ bs_instrs_is([#b_set{op=Op,args=Args0}=I0|Is], CtxChain, Acc) -> I1#b_set{op=bs_skip,args=[Type,Ctx|As]}; {bs_match,[#b_literal{val=string},Ctx|As]} -> I1#b_set{op=bs_match_string,args=[Ctx|As]}; - {bs_get_tail,[Ctx|As]} -> - I1#b_set{op=bs_get_tail,args=[Ctx|As]}; {_,_} -> I1 end, @@ -691,6 +717,54 @@ legacy_bs_is([I|Is], Last, IsYreg, Count, Copies, Acc) -> legacy_bs_is([], _Last, _IsYreg, Count, Copies, Acc) -> {reverse(Acc),Count,Copies}. +%% exception_trampolines(St0) -> St. +%% +%% Removes the "exception trampolines" that were added to prevent exceptions +%% from being optimized away. + +exception_trampolines(#st{ssa=Blocks0}=St) -> + RPO = reverse(beam_ssa:rpo(Blocks0)), + Blocks = et_1(RPO, #{}, #{}, Blocks0), + St#st{ssa=Blocks}. + +et_1([L | Ls], Trampolines, Exceptions, Blocks) -> + #{ L := #b_blk{is=Is,last=Last0}=Block0 } = Blocks, + case {Is, Last0} of + {[#b_set{op=exception_trampoline,args=[Arg]}], #b_br{succ=Succ}} -> + et_1(Ls, + Trampolines#{ L => Succ }, + Exceptions#{ L => Arg }, + maps:remove(L, Blocks)); + {_, #b_br{succ=Same,fail=Same}} when Same =:= ?EXCEPTION_BLOCK -> + %% The exception block is just a marker saying that we should raise + %% an exception (= {f,0}) instead of jumping to a particular fail + %% block. Since it's not a reachable block we can't allow + %% unconditional jumps to it except through a trampoline. + error({illegal_jump_to_exception_block, L}); + {_, #b_br{succ=Same,fail=Same}} + when map_get(Same, Trampolines) =:= ?EXCEPTION_BLOCK -> + %% This block always fails at runtime (and we are not in a + %% try/catch); rewrite the terminator to a return. + Last = #b_ret{arg=map_get(Same, Exceptions)}, + Block = Block0#b_blk{last=Last}, + et_1(Ls, Trampolines, Exceptions, Blocks#{ L := Block }); + {_, #b_br{succ=Succ0,fail=Fail0}} -> + Succ = maps:get(Succ0, Trampolines, Succ0), + Fail = maps:get(Fail0, Trampolines, Fail0), + if + Succ =/= Succ0; Fail =/= Fail0 -> + Last = Last0#b_br{succ=Succ,fail=Fail}, + Block = Block0#b_blk{last=Last}, + et_1(Ls, Trampolines, Exceptions, Blocks#{ L := Block }); + Succ =:= Succ0, Fail =:= Fail0 -> + et_1(Ls, Trampolines, Exceptions, Blocks) + end; + {_, _} -> + et_1(Ls, Trampolines, Exceptions, Blocks) + end; +et_1([], _Trampolines, _Exceptions, Blocks) -> + Blocks. + %% sanitize(St0) -> St. %% Remove constructs that can cause problems later: %% @@ -819,12 +893,17 @@ sanitize_instr(is_tagged_tuple, [#b_literal{val=Tuple}, true -> {value,false} end; +sanitize_instr(bs_add, [_,#b_literal{val=Sz},_|_], I0) -> + if + is_integer(Sz), Sz >= 0 -> ok; + true -> {ok,sanitize_badarg(I0)} + end; sanitize_instr(bs_init, [#b_literal{val=new},#b_literal{val=Sz}|_], I0) -> if is_integer(Sz), Sz >= 0 -> ok; true -> {ok,sanitize_badarg(I0)} end; -sanitize_instr(bs_init, [#b_literal{val=append},_,#b_literal{val=Sz}|_], I0) -> +sanitize_instr(bs_init, [#b_literal{},_,#b_literal{val=Sz}|_], I0) -> if is_integer(Sz), Sz >= 0 -> ok; true -> {ok,sanitize_badarg(I0)} @@ -856,6 +935,114 @@ prune_phi(#b_set{args=Args0}=Phi, Reachable) -> gb_sets:is_element(Pred, Reachable)], Phi#b_set{args=Args}. +%%% Rewrite certain calls to erlang:error/{1,2} to specialized +%%% instructions: +%%% +%%% erlang:error({badmatch,Value}) => badmatch Value +%%% erlang:error({case_clause,Value}) => case_end Value +%%% erlang:error({try_clause,Value}) => try_case_end Value +%%% erlang:error(if_clause) => if_end +%%% erlang:error(function_clause, Args) => jump FuncInfoLabel +%%% +%%% In SSA code, we represent those instructions as a 'match_fail' +%%% instruction with the name of the BEAM instruction as the first +%%% argument. + +match_fail_instructions(#st{ssa=Blocks0,args=Args,location=Location}=St) -> + Ls = maps:to_list(Blocks0), + Info = {length(Args),Location}, + Blocks = match_fail_instrs_1(Ls, Info, Blocks0), + St#st{ssa=Blocks}. + +match_fail_instrs_1([{L,#b_blk{is=Is0}=Blk}|Bs], Arity, Blocks0) -> + case match_fail_instrs_blk(Is0, Arity, []) of + none -> + match_fail_instrs_1(Bs, Arity, Blocks0); + Is -> + Blocks = Blocks0#{L:=Blk#b_blk{is=Is}}, + match_fail_instrs_1(Bs, Arity, Blocks) + end; +match_fail_instrs_1([], _Arity, Blocks) -> Blocks. + +match_fail_instrs_blk([#b_set{op=put_tuple,dst=Dst, + args=[#b_literal{val=Tag},Val]}, + #b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + Dst]}=Call|Is], + _Arity, Acc) -> + match_fail_instr(Call, Tag, Val, Is, Acc); +match_fail_instrs_blk([#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + #b_literal{val={Tag,Val}}]}=Call|Is], + _Arity, Acc) -> + match_fail_instr(Call, Tag, #b_literal{val=Val}, Is, Acc); +match_fail_instrs_blk([#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + #b_literal{val=if_clause}]}=Call|Is], + _Arity, Acc) -> + I = Call#b_set{op=match_fail,args=[#b_literal{val=if_end}]}, + reverse(Acc, [I|Is]); +match_fail_instrs_blk([#b_set{op=call,anno=Anno, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + #b_literal{val=function_clause}, + Stk]}=Call], + {Arity,Location}, Acc) -> + case match_fail_stk(Stk, Acc, [], []) of + {[_|_]=Vars,Is} when length(Vars) =:= Arity -> + case maps:get(location, Anno, none) of + Location -> + I = Call#b_set{op=match_fail, + args=[#b_literal{val=function_clause}|Vars]}, + Is ++ [I]; + _ -> + %% erlang:error/2 has a different location than the + %% func_info instruction at the beginning of the function + %% (probably because of inlining). Keep the original call. + reverse(Acc, [Call]) + end; + _ -> + %% Either the stacktrace could not be picked apart (for example, + %% if the call to erlang:error/2 was handwritten) or the number + %% of arguments in the stacktrace was different from the arity + %% of the host function (because it is the implementation of a + %% fun). Keep the original call. + reverse(Acc, [Call]) + end; +match_fail_instrs_blk([I|Is], Arity, Acc) -> + match_fail_instrs_blk(Is, Arity, [I|Acc]); +match_fail_instrs_blk(_, _, _) -> + none. + +match_fail_instr(Call, Tag, Val, Is, Acc) -> + Op = case Tag of + badmatch -> Tag; + case_clause -> case_end; + try_clause -> try_case_end; + _ -> none + end, + case Op of + none -> + none; + _ -> + I = Call#b_set{op=match_fail,args=[#b_literal{val=Op},Val]}, + reverse(Acc, [I|Is]) + end. + +match_fail_stk(#b_var{}=V, [#b_set{op=put_list,dst=V,args=[H,T]}|Is], IAcc, VAcc) -> + match_fail_stk(T, Is, IAcc, [H|VAcc]); +match_fail_stk(#b_literal{val=[H|T]}, Is, IAcc, VAcc) -> + match_fail_stk(#b_literal{val=T}, Is, IAcc, [#b_literal{val=H}|VAcc]); +match_fail_stk(#b_literal{val=[]}, [], IAcc, VAcc) -> + {reverse(VAcc),IAcc}; +match_fail_stk(T, [#b_set{op=Op}=I|Is], IAcc, VAcc) + when Op =:= bs_get_tail; Op =:= bs_set_position -> + match_fail_stk(T, Is, [I|IAcc], VAcc); +match_fail_stk(_, _, _, _) -> none. + %%% %%% Fix tuples. %%% @@ -911,9 +1098,8 @@ use_set_tuple_element(#st{ssa=Blocks0}=St) -> Blocks = use_ste_1(RPO, Uses, Blocks0), St#st{ssa=Blocks}. -use_ste_1([L|Ls], Uses, Blocks0) -> - {Blk0,Blocks} = use_ste_across(L, Uses, Blocks0), - #b_blk{is=Is0} = Blk0, +use_ste_1([L|Ls], Uses, Blocks) -> + #b_blk{is=Is0} = Blk0 = map_get(L, Blocks), case use_ste_is(Is0, Uses) of Is0 -> use_ste_1(Ls, Uses, Blocks); @@ -976,69 +1162,6 @@ extract_ste(#b_set{op=call,dst=Dst, end; extract_ste(#b_set{}) -> none. -%%% Optimize accross blocks within a try/catch block. - -use_ste_across(L, Uses, Blocks) -> - case map_get(L, Blocks) of - #b_blk{last=#b_br{bool=#b_var{}}}=Blk -> - try - use_ste_across_1(L, Blk, Uses, Blocks) - catch - throw:not_possible -> - {Blk,Blocks} - end; - #b_blk{}=Blk -> - {Blk,Blocks} - end. - -use_ste_across_1(L, Blk0, Uses, Blocks0) -> - #b_blk{is=IsThis,last=#b_br{bool=Bool,succ=Next}} = Blk0, - case reverse(IsThis) of - [#b_set{op=succeeded,dst=Bool,args=[Result]}=Succ0, - #b_set{op=call,args=[#b_remote{}|_],dst=Result}=Call1|Prefix] -> - case is_single_use(Bool, Uses) andalso - is_n_uses(2, Result, Uses) of - true -> ok; - false -> throw(not_possible) - end, - Call2 = use_ste_across_next(Next, Uses, Blocks0), - Is = [Call1,Call2], - case use_ste_is(Is, decrement_uses(Result, Uses)) of - [#b_set{}=Call,#b_set{op=set_tuple_element}=Ste] -> - Blocks1 = use_ste_fix_next(Ste, Next, Blocks0), - Succ = Succ0#b_set{args=[Call#b_set.dst]}, - Blk = Blk0#b_blk{is=reverse(Prefix, [Call,Succ])}, - Blocks = Blocks1#{L:=Blk}, - {Blk,Blocks}; - _ -> - throw(not_possible) - end; - _ -> - throw(not_possible) - end. - -use_ste_across_next(Next, Uses, Blocks) -> - case map_get(Next, Blocks) of - #b_blk{is=[#b_set{op=call,dst=Result,args=[#b_remote{}|_]}=Call, - #b_set{op=succeeded,dst=Bool,args=[Result]}], - last=#b_br{bool=Bool}} -> - case is_single_use(Bool, Uses) andalso - is_n_uses(2, Result, Uses) of - true -> ok; - false -> throw(not_possible) - end, - Call; - #b_blk{} -> - throw(not_possible) - end. - -use_ste_fix_next(Ste, Next, Blocks) -> - Blk0 = map_get(Next, Blocks), - #b_blk{is=[#b_set{op=call},#b_set{op=succeeded}],last=Br0} = Blk0, - Br = beam_ssa:normalize(Br0#b_br{bool=#b_literal{val=true}}), - Blk = Blk0#b_blk{is=[Ste],last=Br}, - Blocks#{Next:=Blk}. - %% Count how many times each variable is used. count_uses(Blocks) -> @@ -1048,7 +1171,7 @@ count_uses_blk([#b_blk{is=Is,last=Last}|Bs], CountMap0) -> F = fun(I, CountMap) -> foldl(fun(Var, Acc) -> case Acc of - #{Var:=3} -> Acc; + #{Var:=2} -> Acc; #{Var:=C} -> Acc#{Var:=C+1}; #{} -> Acc#{Var=>1} end @@ -1058,16 +1181,6 @@ count_uses_blk([#b_blk{is=Is,last=Last}|Bs], CountMap0) -> count_uses_blk(Bs, CountMap); count_uses_blk([], CountMap) -> CountMap. -decrement_uses(V, Uses) -> - #{V:=C} = Uses, - Uses#{V:=C-1}. - -is_n_uses(N, V, Uses) -> - case Uses of - #{V:=N} -> true; - #{} -> false - end. - is_single_use(V, Uses) -> case Uses of #{V:=1} -> true; @@ -1189,10 +1302,10 @@ place_frame_here(L, Blocks, Doms, Frames) -> Descendants = beam_ssa:rpo([L], Blocks), PhiPredecessors = phi_predecessors(L, Blocks), MustDominate = ordsets:from_list(PhiPredecessors ++ Descendants), - Dominates = all(fun(?BADARG_BLOCK) -> + Dominates = all(fun(?EXCEPTION_BLOCK) -> %% This block defines no variables and calls %% erlang:error(badarg). It does not matter - %% whether L dominates ?BADARG_BLOCK or not; + %% whether L dominates ?EXCEPTION_BLOCK or not; %% it is still safe to put the frame in L. true; (Bl) -> @@ -1250,14 +1363,9 @@ need_frame_1([#b_set{op=call,args=[Func|_]}|Is], Context) -> #b_remote{mod=#b_literal{val=Mod}, name=#b_literal{val=Name}, arity=Arity} when is_atom(Mod), is_atom(Name) -> - case erl_bifs:is_exit_bif(Mod, Name, Arity) of - true -> - false; - false -> - Context =:= body orelse - Is =/= [] orelse - is_trap_bif(Mod, Name, Arity) - end; + Context =:= body orelse + Is =/= [] orelse + is_trap_bif(Mod, Name, Arity); #b_remote{} -> %% This is an apply(), which always needs a frame. true; @@ -1340,9 +1448,9 @@ recv_common(_Defs, none, _Blocks) -> %% in the tail position of a function. []; recv_common(Defs, Exit, Blocks) -> - {ExitDefs,ExitUsed} = beam_ssa:def_used([Exit], Blocks), + {ExitDefs,ExitUnused} = beam_ssa:def_unused([Exit], Defs, Blocks), Def = ordsets:subtract(Defs, ExitDefs), - ordsets:intersection(Def, ExitUsed). + ordsets:subtract(Def, ExitUnused). %% recv_crit_edges([RemoveMessageLabel], LoopExit, %% Blocks0, Count0) -> {Blocks,Count}. @@ -1447,9 +1555,9 @@ exit_predecessors([], _Exit, _Blocks) -> []. %% later used within a clause of the receive. fix_receive([L|Ls], Defs, Blocks0, Count0) -> - {RmDefs,Used0} = beam_ssa:def_used([L], Blocks0), + {RmDefs,Unused} = beam_ssa:def_unused([L], Defs, Blocks0), Def = ordsets:subtract(Defs, RmDefs), - Used = ordsets:intersection(Def, Used0), + Used = ordsets:subtract(Def, Unused), {NewVars,Count} = new_vars([Base || #b_var{name=Base} <- Used], Count0), Ren = zip(Used, NewVars), Blocks1 = beam_ssa:rename_vars(Ren, [L], Blocks0), @@ -1483,8 +1591,8 @@ find_loop_exit(_, _) -> %% loop exit block. none. -find_loop_exit_1([?BADARG_BLOCK|Ls], RmSet, Dominators, Blocks) -> - %% ?BADARG_BLOCK is a marker and not an actual block, so it is not +find_loop_exit_1([?EXCEPTION_BLOCK|Ls], RmSet, Dominators, Blocks) -> + %% ?EXCEPTION_BLOCK is a marker and not an actual block, so it is not %% the block we are looking for. find_loop_exit_1(Ls, RmSet, Dominators, Blocks); find_loop_exit_1([L|Ls0], RmSet, Dominators, Blocks) -> @@ -1767,7 +1875,7 @@ collect_yregs([], Yregs) -> Yregs. copy_retval_2([L|Ls], Yregs, Copy0, Blocks0, Count0) -> #b_blk{is=Is0,last=Last} = Blk = map_get(L, Blocks0), RC = case {Last,Ls} of - {#b_br{succ=Succ,fail=?BADARG_BLOCK},[Succ|_]} -> + {#b_br{succ=Succ,fail=?EXCEPTION_BLOCK},[Succ|_]} -> true; {_,_} -> false @@ -1984,11 +2092,9 @@ number_is_2([], N, Acc) -> live_intervals(#st{args=Args,ssa=Blocks}=St) -> Vars0 = [{V,{0,1}} || #b_var{}=V <- Args], - F = fun(L, _, A) -> live_interval_blk(L, Blocks, A) end, - LiveMap0 = #{}, - Acc0 = {[],LiveMap0}, - {Vars,_} = beam_ssa:fold_po(F, Acc0, Blocks), - Intervals = merge_ranges(rel2fam(Vars0++Vars)), + PO = reverse(beam_ssa:rpo(Blocks)), + Vars = live_interval_blk(PO, Blocks, Vars0, #{}), + Intervals = merge_ranges(rel2fam(Vars)), St#st{intervals=Intervals}. merge_ranges([{V,Rs}|T]) -> @@ -2001,32 +2107,51 @@ merge_ranges_1([R|Rs]) -> [R|merge_ranges_1(Rs)]; merge_ranges_1([]) -> []. -live_interval_blk(L, Blocks, {Vars0,LiveMap0}) -> +live_interval_blk([L|Ls], Blocks, Vars0, LiveMap0) -> Live0 = [], - Successors = beam_ssa:successors(L, Blocks), + Blk = map_get(L, Blocks), + Successors = beam_ssa:successors(Blk), Live1 = update_successors(Successors, L, Blocks, LiveMap0, Live0), %% Add ranges for all variables that are live in the successors. - #b_blk{is=Is,last=Last} = map_get(L, Blocks), + #b_blk{is=Is,last=Last} = Blk, End = beam_ssa:get_anno(n, Last), - Use = [{V,{use,End+1}} || V <- Live1], + EndUse = {use,End+1}, + Use = [{V,EndUse} || V <- Live1], %% Determine used and defined variables in this block. FirstNumber = first_number(Is, Last), - UseDef0 = live_interval_blk_1([Last|reverse(Is)], FirstNumber, Use), - UseDef = rel2fam(UseDef0), + UseDef0 = live_interval_last(Last, Use), + UseDef1 = live_interval_blk_is(Is, FirstNumber, UseDef0), + UseDef = rel2fam(UseDef1), %% Update what is live at the beginning of this block and %% store it. - Used = [V || {V,[{use,_}|_]} <- UseDef], - Live2 = ordsets:union(Live1, Used), - Killed = [V || {V,[{def,_}|_]} <- UseDef], - Live = ordsets:subtract(Live2, Killed), + Live = [V || {V,[{use,_}|_]} <- UseDef], LiveMap = LiveMap0#{L=>Live}, %% Construct the ranges for this block. Vars = make_block_ranges(UseDef, FirstNumber, Vars0), - {Vars,LiveMap}. + live_interval_blk(Ls, Blocks, Vars, LiveMap); +live_interval_blk([], _Blocks, Vars, _LiveMap) -> + Vars. + +live_interval_last(I, Acc) -> + N = beam_ssa:get_anno(n, I), + Used = beam_ssa:used(I), + [{V,{use,N}} || V <- Used] ++ Acc. + +live_interval_blk_is([#b_set{op=phi,dst=Dst}|Is], FirstNumber, Acc0) -> + Acc = [{Dst,{def,FirstNumber}}|Acc0], + live_interval_blk_is(Is, FirstNumber, Acc); +live_interval_blk_is([#b_set{dst=Dst}=I|Is], FirstNumber, Acc0) -> + N = beam_ssa:get_anno(n, I), + Acc1 = [{Dst,{def,N}}|Acc0], + Used = beam_ssa:used(I), + Acc = [{V,{use,N}} || V <- Used] ++ Acc1, + live_interval_blk_is(Is, FirstNumber, Acc); +live_interval_blk_is([], _FirstNumber, Acc) -> + Acc. make_block_ranges([{V,[{def,Def}]}|Vs], First, Acc) -> make_block_ranges(Vs, First, [{V,{Def,Def}}|Acc]); @@ -2038,30 +2163,6 @@ make_block_ranges([{V,[{use,_}|_]=Uses}|Vs], First, Acc) -> make_block_ranges(Vs, First, [{V,{First,Last}}|Acc]); make_block_ranges([], _, Acc) -> Acc. -live_interval_blk_1([#b_set{op=phi,dst=Dst}|Is], FirstNumber, Acc0) -> - Acc = [{Dst,{def,FirstNumber}}|Acc0], - live_interval_blk_1(Is, FirstNumber, Acc); -live_interval_blk_1([#b_set{op=bs_start_match}=I|Is], - FirstNumber, Acc0) -> - N = beam_ssa:get_anno(n, I), - #b_set{dst=Dst} = I, - Acc1 = [{Dst,{def,N}}|Acc0], - Acc = [{V,{use,N}} || V <- beam_ssa:used(I)] ++ Acc1, - live_interval_blk_1(Is, FirstNumber, Acc); -live_interval_blk_1([I|Is], FirstNumber, Acc0) -> - N = beam_ssa:get_anno(n, I), - Acc1 = case I of - #b_set{dst=Dst} -> - [{Dst,{def,N}}|Acc0]; - _ -> - Acc0 - end, - Used = beam_ssa:used(I), - Acc = [{V,{use,N}} || V <- Used] ++ Acc1, - live_interval_blk_1(Is, FirstNumber, Acc); -live_interval_blk_1([], _FirstNumber, Acc) -> - Acc. - %% first_number([#b_set{}]) -> InstructionNumber. %% Return the number for the first instruction for the block. %% Note that this number is one less than the first @@ -2116,8 +2217,8 @@ reserve_yregs(#st{frames=Frames}=St0) -> reserve_yregs_1(L, #st{ssa=Blocks0,cnt=Count0,res=Res0}=St) -> Blk = map_get(L, Blocks0), Yregs = beam_ssa:get_anno(yregs, Blk), - {Def,Used} = beam_ssa:def_used([L], Blocks0), - UsedYregs = ordsets:intersection(Yregs, Used), + {Def,Unused} = beam_ssa:def_unused([L], Yregs, Blocks0), + UsedYregs = ordsets:subtract(Yregs, Unused), DefBefore = ordsets:subtract(UsedYregs, Def), {BeforeVars,Blocks,Count} = rename_vars(DefBefore, L, Blocks0, Count0), InsideVars = ordsets:subtract(UsedYregs, DefBefore), @@ -2307,68 +2408,69 @@ reserve_zregs(Blocks, Intervals, Res) -> end, beam_ssa:fold_rpo(F, [0], Res, Blocks). -reserve_zreg([#b_set{op=Op,dst=Dst}], - #b_br{bool=Dst}, _ShortLived, A) when Op =:= call; - Op =:= get_tuple_element -> - %% If type optimization has determined that the result of these - %% instructions can be used directly in a branch, we must avoid reserving a - %% z register or code generation will fail. - A; reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}, - #b_set{op={bif,'=:='},args=[Dst,Val]}], Last, ShortLived, A0) -> + #b_set{op={bif,'=:='},args=[Dst,Val],dst=Bool}], + Last, ShortLived, A) -> case {Val,Last} of - {#b_literal{val=Arity},#b_br{bool=#b_var{}}} when Arity bsr 32 =:= 0 -> + {#b_literal{val=Arity},#b_br{bool=Bool}} when Arity bsr 32 =:= 0 -> %% These two instructions can be combined to a test_arity %% instruction provided that the arity variable is short-lived. - reserve_zreg_1(Dst, ShortLived, A0); + reserve_test_zreg(Dst, ShortLived, A); {_,_} -> %% Either the arity is too big, or the boolean value is not %% used in a conditional branch. - A0 + A end; reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}], - #b_switch{}, ShortLived, A) -> - reserve_zreg_1(Dst, ShortLived, A); -reserve_zreg([#b_set{op={bif,'xor'}}], _Last, _ShortLived, A) -> - %% There is no short, easy way to rewrite 'xor' to a series of - %% test instructions. - A; -reserve_zreg([#b_set{op={bif,is_record}}], _Last, _ShortLived, A) -> - %% There is no short, easy way to rewrite is_record/2 to a series of - %% test instructions. - A; -reserve_zreg([#b_set{op=Op,dst=Dst}|Is], Last, ShortLived, A0) -> - IsZReg = case Op of - bs_match_string -> true; - bs_save -> true; - bs_restore -> true; - bs_set_position -> true; - {float,clearerror} -> true; - kill_try_tag -> true; - landingpad -> true; - put_tuple_elements -> true; - remove_message -> true; - set_tuple_element -> true; - succeeded -> true; - timeout -> true; - wait_timeout -> true; - _ -> false - end, - A = case IsZReg of - true -> [{Dst,z}|A0]; - false -> A0 - end, - reserve_zreg(Is, Last, ShortLived, A); -reserve_zreg([], #b_br{bool=Bool}, ShortLived, A) -> - reserve_zreg_1(Bool, ShortLived, A); + #b_switch{arg=Dst}, ShortLived, A) -> + reserve_test_zreg(Dst, ShortLived, A); +reserve_zreg([#b_set{op=Op,dst=Dst}], #b_br{bool=Dst}, ShortLived, A) -> + case use_zreg(Op) of + yes -> [{Dst,z} | A]; + no -> A; + maybe -> reserve_test_zreg(Dst, ShortLived, A) + end; +reserve_zreg([#b_set{op=Op,dst=Dst} | Is], Last, ShortLived, A) -> + case use_zreg(Op) of + yes -> reserve_zreg(Is, Last, ShortLived, [{Dst,z} | A]); + _Other -> reserve_zreg(Is, Last, ShortLived, A) + end; reserve_zreg([], _, _, A) -> A. -reserve_zreg_1(#b_var{}=V, ShortLived, A) -> +use_zreg(bs_match_string) -> yes; +use_zreg(bs_save) -> yes; +use_zreg(bs_restore) -> yes; +use_zreg(bs_set_position) -> yes; +use_zreg({float,clearerror}) -> yes; +use_zreg(kill_try_tag) -> yes; +use_zreg(landingpad) -> yes; +use_zreg(put_tuple_elements) -> yes; +use_zreg(remove_message) -> yes; +use_zreg(set_tuple_element) -> yes; +use_zreg(succeeded) -> yes; +use_zreg(timeout) -> yes; +use_zreg(wait_timeout) -> yes; +%% There's no way we can combine these into a test instruction, so we must +%% avoid using a z register if their result is used directly in a branch. +use_zreg(call) -> no; +use_zreg({bif,is_map_key}) -> no; +use_zreg({bif,is_record}) -> no; +use_zreg({bif,map_get}) -> no; +use_zreg({bif,'xor'}) -> no; +use_zreg(get_hd) -> no; +use_zreg(get_tl) -> no; +use_zreg(get_tuple_element) -> no; +%% Assume the instruction can use a z register, provided it's the last in its +%% block and that the result is only used in the terminator. +use_zreg(_) -> maybe. + +%% If V is defined just before a branch, we may be able to combine it into a +%% test instruction. +reserve_test_zreg(#b_var{}=V, ShortLived, A) -> case cerl_sets:is_element(V, ShortLived) of true -> [{V,z}|A]; false -> A - end; -reserve_zreg_1(#b_literal{}, _, A) -> A. + end. reserve_fregs(Blocks, Res) -> F = fun(_, #b_blk{is=Is}, A) -> @@ -2506,9 +2608,9 @@ reserve_xregs_is([], Res, Xs, _Used) -> {Res,Xs}. %% Pick up register hints from the successors of this blocks. -reserve_terminator(_L, _Is, #b_br{bool=#b_var{},succ=Succ,fail=?BADARG_BLOCK}, +reserve_terminator(_L, _Is, #b_br{bool=#b_var{},succ=Succ,fail=?EXCEPTION_BLOCK}, _Blocks, XsMap, _Res) -> - %% We know that no variables are used at ?BADARG_BLOCK, so + %% We know that no variables are used at ?EXCEPTION_BLOCK, so %% any register hints from the success blocks are safe to use. map_get(Succ, XsMap); reserve_terminator(L, Is, #b_br{bool=#b_var{},succ=Succ,fail=Fail}, @@ -2915,11 +3017,9 @@ are_overlapping_1({_,_}, []) -> false. %% Check whether the block is a loop header. is_loop_header(L, Blocks) -> - %% We KNOW that a loop header must start with a peek_message - %% instruction. case map_get(L, Blocks) of - #b_blk{is=[#b_set{op=peek_message}|_]} -> true; - _ -> false + #b_blk{is=[I|_]} -> beam_ssa:is_loop_header(I); + #b_blk{} -> false end. rel2fam(S0) -> diff --git a/lib/compiler/src/beam_ssa_recv.erl b/lib/compiler/src/beam_ssa_recv.erl index 767242d1e5..20fcd3e9a6 100644 --- a/lib/compiler/src/beam_ssa_recv.erl +++ b/lib/compiler/src/beam_ssa_recv.erl @@ -165,19 +165,21 @@ recv_opt_makes_ref([I|Is], RecvLbl, Blocks, Acc) -> recv_opt_makes_ref([], _, _, _) -> no. makes_ref(#b_set{dst=Dst,args=[Func0|_]}, Blocks) -> - Func = case Func0 of - #b_remote{mod=#b_literal{val=erlang}, - name=#b_literal{val=Name},arity=A0} -> - {Name,A0}; + MFA = case Func0 of + #b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Func},arity=A0} -> + {Mod,Func,A0}; _ -> none end, - case Func of - {make_ref,0} -> + case MFA of + {erlang,make_ref,0} -> {yes,Dst}; - {monitor,2} -> + {erlang,monitor,2} -> {yes,Dst}; - {spawn_monitor,A} when A =:= 1; A =:= 3 -> + {erlang,spawn_request,A} when 1 =< A, A =< 5 -> + {yes,Dst}; + {erlang,spawn_monitor,A} when 1 =< A, A =< 4 -> ref_in_tuple(Dst, Blocks); _ -> no diff --git a/lib/compiler/src/beam_ssa_share.erl b/lib/compiler/src/beam_ssa_share.erl index 73983bd34a..98cf0d9247 100644 --- a/lib/compiler/src/beam_ssa_share.erl +++ b/lib/compiler/src/beam_ssa_share.erl @@ -117,8 +117,8 @@ share_terminator(_Last, _Blocks) -> none. %% possible if the blocks are not equivalent, as that is the common %% case. -are_equivalent(_Succ, _, ?BADARG_BLOCK, _, _Blocks) -> - %% ?BADARG_BLOCK is special. Sharing could be incorrect. +are_equivalent(_Succ, _, ?EXCEPTION_BLOCK, _, _Blocks) -> + %% ?EXCEPTION_BLOCK is special. Sharing could be incorrect. false; are_equivalent(_Succ, #b_blk{is=Is1,last=#b_ret{arg=RetVal1}=Ret1}, _Fail, #b_blk{is=Is2,last=#b_ret{arg=RetVal2}=Ret2}, _Blocks) -> @@ -331,11 +331,16 @@ canonical_terminator(_, _, _) -> none. canonical_terminator_phis([#b_set{op=phi,args=PhiArgs}=Phi|Is], L) -> {Value,L} = keyfind(L, 2, PhiArgs), [Phi#b_set{op=copy,args=[Value]}|canonical_terminator_phis(Is, L)]; -canonical_terminator_phis([#b_set{op=peek_message}=I|_], L) -> - %% We could get stuck into an infinite loop if we allowed the - %% comparisons to continue into this block. Force an unequal - %% compare with all other predecessors of this block. - [I#b_set{op=copy,args=[#b_literal{val=L}]}]; +canonical_terminator_phis([#b_set{}=I|_], L) -> + case beam_ssa:is_loop_header(I) of + true -> + %% We could get stuck into an infinite loop if we allowed the + %% comparisons to continue into this loop. Force an unequal + %% compare with all other predecessors of this block. + [I#b_set{op=copy,args=[#b_literal{val=L}]}]; + false -> + [] + end; canonical_terminator_phis(_, _) -> []. canonical_arg(#b_var{}=Var, VarMap) -> @@ -368,7 +373,9 @@ shortcut_nonempty_block(L, Blocks) -> is_forbidden(L, Blocks) -> case map_get(L, Blocks) of - #b_blk{is=[#b_set{op=phi}|_]} -> true; - #b_blk{is=[#b_set{op=peek_message}|_]} -> true; + #b_blk{is=[#b_set{op=phi}|_]} -> + true; + #b_blk{is=[#b_set{}=I|_]} -> + beam_ssa:is_loop_header(I); #b_blk{} -> false end. diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index 3c06c83e2e..e0baadccb2 100644 --- a/lib/compiler/src/beam_ssa_type.erl +++ b/lib/compiler/src/beam_ssa_type.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018. All Rights Reserved. +%% Copyright Ericsson AB 2018-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -17,126 +17,553 @@ %% %% %CopyrightEnd% %% +%% This pass infers types from expressions and attempts to simplify or remove +%% subsequent instructions based on that information. +%% +%% This is divided into two subpasses; the first figures out function type +%% signatures for the whole module without optimizing anything, and the second +%% optimizes based on that information, further refining the type signatures as +%% it goes. +%% -module(beam_ssa_type). --export([opt_start/4, opt_continue/4, opt_finish/3]). +-export([opt_start/2, opt_continue/4, opt_finish/3]). -include("beam_ssa_opt.hrl"). --import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2, - keyfind/3,reverse/1,reverse/2, - sort/1,split/2]). - --define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). - --record(d, - {ds :: #{beam_ssa:b_var():=beam_ssa:b_set()}, - ls :: #{beam_ssa:label():=type_db()}, - once :: cerl_sets:set(beam_ssa:b_var()), - func_id :: func_id(), - func_db :: func_info_db(), - sub = #{} :: #{beam_ssa:b_var():=beam_ssa:value()}, - ret_type = [] :: [type()]}). - --define(ATOM_SET_SIZE, 5). - -%% Records that represent type information. --record(t_atom, {elements=any :: 'any' | [atom()]}). --record(t_integer, {elements=any :: 'any' | {integer(),integer()}}). --record(t_bs_match, {type :: type()}). --record(t_tuple, {size=0 :: integer(), - exact=false :: boolean(), - %% Known element types (1-based index), unknown elements are - %% are assumed to be 'any'. - elements=#{} :: #{ non_neg_integer() => type() }}). - --type type() :: 'any' | 'none' | - #t_atom{} | #t_integer{} | #t_bs_match{} | #t_tuple{} | - {'binary',pos_integer()} | 'cons' | 'float' | 'list' | 'map' | 'nil' | 'number'. --type type_db() :: #{beam_ssa:var_name():=type()}. - --spec opt_start(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when - Linear :: [{non_neg_integer(), beam_ssa:b_blk()}], - Args :: [beam_ssa:b_var()], - Anno :: beam_ssa:anno(), - FuncDb :: func_info_db(). -opt_start(Linear, Args, Anno, FuncDb) -> - %% This is the first run through the module, so our arg_types can be - %% incomplete as we may not have visited all call sites at least once. - Ts = maps:from_list([{V,any} || #b_var{}=V <- Args]), - opt_continue_1(Linear, Args, get_func_id(Anno), Ts, FuncDb). +-include("beam_types.hrl"). + +-import(lists, [all/2,any/2,duplicate/2,foldl/3,member/2, + keyfind/3,reverse/1,split/2,zip/2]). + +%% The maximum number of #b_ret{} terminators a function can have before +%% collapsing success types into a single entry. Consider the following code: +%% +%% f(0) -> 1; +%% f(...) -> ...; +%% f(500000) -> 500000. +%% +%% Since success types are grouped by return type and each clause returns a +%% distinct type (singleton #t_integer{}s), we'll add 500000 entries which +%% makes progress glacial since every call needs to examine them all to +%% determine the return type. +%% +%% The entries are collapsed unconditionally if the number of returns in a +%% function exceeds this threshold. This is necessary because collapsing as we +%% go might widen a type; if we're at (?RETURN_LIMIT - 1) entries and suddenly +%% narrow a type down, it could push us over the edge and collapse all entries, +%% possibly widening the return type and breaking optimizations that were based +%% on the earlier (narrower) types. +-define(RETURN_LIMIT, 100). + +%% Constants common to all subpasses. +-record(metadata, + { func_id :: func_id(), + limit_return :: boolean(), + params :: [beam_ssa:b_var()], + used_once :: cerl_sets:set(beam_ssa:b_var()) }). + +-type type_db() :: #{ beam_ssa:var_name() := type() }. + +%% + +-spec opt_start(term(), term()) -> term(). +opt_start(StMap, FuncDb0) when FuncDb0 =/= #{} -> + {ArgDb, FuncDb} = signatures(StMap, FuncDb0), + + opt_start_1(maps:keys(StMap), ArgDb, StMap, FuncDb); +opt_start(StMap, FuncDb) -> + %% Module-level analysis is disabled, likely because of a call to + %% load_nif/2 or similar. opt_continue/4 will assume that all arguments and + %% return types are 'any'. + {StMap, FuncDb}. + +opt_start_1([Id | Ids], ArgDb, StMap0, FuncDb0) -> + case ArgDb of + #{ Id := ArgTypes } -> + #opt_st{ssa=Linear0,args=Args} = St0 = map_get(Id, StMap0), + + Ts = maps:from_list(zip(Args, ArgTypes)), + {Linear, FuncDb} = opt_function(Linear0, Args, Id, Ts, FuncDb0), + + St = St0#opt_st{ssa=Linear}, + StMap = StMap0#{ Id := St }, + + opt_start_1(Ids, ArgDb, StMap, FuncDb); + #{} -> + %% Unreachable functions must be removed so that opt_continue/4 + %% won't process them and potentially taint the argument types of + %% other functions. + StMap = maps:remove(Id, StMap0), + FuncDb = maps:remove(Id, FuncDb0), + + opt_start_1(Ids, ArgDb, StMap, FuncDb) + end; +opt_start_1([], _CommittedArgs, StMap, FuncDb) -> + {StMap, FuncDb}. + +%% +%% The initial signature analysis is based on the paper "Practical Type +%% Inference Based on Success Typings" [1] by `Tobias Lindahl` and +%% `Konstantinos Sagonas`, mainly section 6.1 and onwards. +%% +%% The general idea is to start out at the module's entry points and propagate +%% types to the functions we call. The argument types of all exported functions +%% start out a 'any', whereas local functions start at 'none'. Every time a +%% function call widens the argument types, we analyze the callee again and +%% propagate its return types to the callers, analyzing them again, and +%% continuing this process until all arguments and return types have been +%% widened as far as they can be. +%% +%% Note that we do not "jump-start the analysis" by first determining success +%% types as in the paper because we need to know all possible inputs including +%% those that will not return. +%% +%% [1] http://www.it.uu.se/research/group/hipe/papers/succ_types.pdf +%% + +-record(sig_st, + { wl = wl_new() :: worklist(), + committed = #{} :: #{ func_id() => [type()] }, + updates = #{} :: #{ func_id() => [type()] }}). + +signatures(StMap, FuncDb0) -> + State0 = init_sig_st(StMap, FuncDb0), + {State, FuncDb} = signatures_1(StMap, FuncDb0, State0), + {State#sig_st.committed, FuncDb}. + +signatures_1(StMap, FuncDb0, State0) -> + case wl_next(State0#sig_st.wl) of + {ok, FuncId} -> + {State, FuncDb} = sig_function(FuncId, StMap, State0, FuncDb0), + signatures_1(StMap, FuncDb, State); + empty -> + %% No more work to do, assert that we don't have any outstanding + %% updates. + #sig_st{updates=Same,committed=Same} = State0, %Assertion. + + {State0, FuncDb0} + end. + +sig_function(Id, StMap, State0, FuncDb0) -> + case sig_function_1(Id, StMap, State0, FuncDb0) of + {false, false, State, FuncDb} -> + %% No added work and the types are identical. Pop ourselves from + %% the work list and move on to the next function. + Wl = wl_pop(Id, State#sig_st.wl), + {State#sig_st{wl=Wl}, FuncDb}; + {false, true, State, FuncDb} -> + %% We've added some work and our return type is unchanged. Keep + %% following the work list without popping ourselves; we're very + %% likely to need to return here later and can avoid a lot of + %% redundant work by keeping our place in line. + {State, FuncDb}; + {true, WlChanged, State, FuncDb} -> + %% Our return type has changed so all of our (previously analyzed) + %% callers need to be analyzed again. + %% + %% If our worklist is unchanged we'll pop ourselves since our + %% callers will add us back if we need to analyzed again, and + %% it's wasteful to stay in the worklist when we don't. + Wl0 = case WlChanged of + true -> State#sig_st.wl; + false -> wl_pop(Id, State#sig_st.wl) + end, + + #func_info{in=Cs0} = map_get(Id, FuncDb0), + Callers = [C || C <- Cs0, is_map_key(C, State#sig_st.updates)], + Wl = wl_defer_list(Callers, Wl0), + + {State#sig_st{wl=Wl}, FuncDb} + end. + +sig_function_1(Id, StMap, State0, FuncDb) -> + #opt_st{ssa=Linear,args=Args} = map_get(Id, StMap), + + {ArgTypes, State1} = sig_commit_args(Id, State0), + Ts = maps:from_list(zip(Args, ArgTypes)), + + FakeCall = #b_set{op=call,args=[#b_remote{mod=#b_literal{val=unknown}, + name=#b_literal{val=unknown}, + arity=0}]}, + + Ds = maps:from_list([{Var, FakeCall#b_set{dst=Var}} || + #b_var{}=Var <- Args]), + + Ls = #{ ?EXCEPTION_BLOCK => Ts, + 0 => Ts }, + + Meta = init_metadata(Id, Linear, Args), + + Wl0 = State1#sig_st.wl, + + {State, SuccTypes} = sig_bs(Linear, Ds, Ls, FuncDb, #{}, [], Meta, State1), + + WlChanged = wl_changed(Wl0, State#sig_st.wl), + #{ Id := #func_info{succ_types=SuccTypes0}=Entry0 } = FuncDb, + + if + SuccTypes0 =:= SuccTypes -> + {false, WlChanged, State, FuncDb}; + SuccTypes0 =/= SuccTypes -> + Entry = Entry0#func_info{succ_types=SuccTypes}, + {true, WlChanged, State, FuncDb#{ Id := Entry }} + end. + +sig_bs([{L, #b_blk{is=Is,last=Last0}} | Bs], + Ds0, Ls0, Fdb, Sub0, SuccTypes0, Meta, State0) when is_map_key(L, Ls0) -> + + #{ L := Ts0 } = Ls0, + + {Ts, Ds, Sub, State} = sig_is(Is, Ts0, Ds0, Ls0, Fdb, Sub0, State0), + + Last = simplify_terminator(Last0, Ts, Ds, Sub), + SuccTypes = update_success_types(Last, Ts, Ds, Meta, SuccTypes0), + {_, Ls} = update_successors(Last, Ts, Ds, Ls0, Meta#metadata.used_once), + + sig_bs(Bs, Ds, Ls, Fdb, Sub, SuccTypes, Meta, State); +sig_bs([_Blk | Bs], Ds, Ls, Fdb, Sub, SuccTypes, Meta, State) -> + %% This block is never reached. Ignore it. + sig_bs(Bs, Ds, Ls, Fdb, Sub, SuccTypes, Meta, State); +sig_bs([], _Ds, _Ls, _Fdb, _Sub, SuccTypes, _Meta, State) -> + {State, SuccTypes}. + +sig_is([#b_set{op=call, + args=[#b_local{}=Callee | _]=Args0, + dst=Dst}=I0 | Is], + Ts0, Ds0, Ls, Fdb, Sub, State0) -> + Args = simplify_args(Args0, Ts0, Sub), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + [_ | CallArgs] = Args, + {I, State} = sig_local_call(I1, Callee, CallArgs, Ts0, Fdb, State0), + + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + sig_is(Is, Ts, Ds, Ls, Fdb, Sub, State); +sig_is([#b_set{op=call, + args=[#b_var{} | _]=Args0, + dst=Dst}=I0 | Is], + Ts0, Ds0, Ls, Fdb, Sub, State) -> + Args = simplify_args(Args0, Ts0, Sub), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + [Fun | _] = Args, + I = case normalized_type(Fun, Ts0) of + #t_fun{type=Type} -> beam_ssa:add_anno(result_type, Type, I1); + _ -> I1 + end, + + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + sig_is(Is, Ts, Ds, Ls, Fdb, Sub, State); +sig_is([#b_set{op=make_fun,args=Args0,dst=Dst}=I0|Is], + Ts0, Ds0, Ls, Fdb, Sub0, State0) -> + Args = simplify_args(Args0, Ts0, Sub0), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + {I, State} = sig_make_fun(I1, Ts0, Fdb, State0), + + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + sig_is(Is, Ts, Ds, Ls, Fdb, Sub0, State); +sig_is([I0 | Is], Ts0, Ds0, Ls, Fdb, Sub0, State) -> + case simplify(I0, Ts0, Ds0, Ls, Sub0) of + {#b_set{}, Ts, Ds} -> + sig_is(Is, Ts, Ds, Ls, Fdb, Sub0, State); + Sub when is_map(Sub) -> + sig_is(Is, Ts0, Ds0, Ls, Fdb, Sub, State) + end; +sig_is([], Ts, Ds, _Ls, _Fdb, Sub, State) -> + {Ts, Ds, Sub, State}. + +sig_local_call(I0, Callee, Args, Ts, Fdb, State) -> + ArgTypes = argument_types(Args, Ts), + I = sig_local_return(I0, Callee, ArgTypes, Fdb), + {I, sig_update_args(Callee, ArgTypes, State)}. + +%% While it's impossible to tell which arguments a fun will be called with +%% (someone could steal it through tracing and call it), we do know its free +%% variables and can update their types as if this were a local call. +sig_make_fun(#b_set{op=make_fun, + args=[#b_local{}=Callee | FreeVars]}=I0, + Ts, Fdb, State) -> + ArgCount = Callee#b_local.arity - length(FreeVars), + + FVTypes = [raw_type(FreeVar, Ts) || FreeVar <- FreeVars], + ArgTypes = duplicate(ArgCount, any) ++ FVTypes, + + I = sig_local_return(I0, Callee, ArgTypes, Fdb), + {I, sig_update_args(Callee, ArgTypes, State)}. + +sig_local_return(I, Callee, ArgTypes, Fdb) -> + #func_info{succ_types=SuccTypes} = map_get(Callee, Fdb), + case return_type(SuccTypes, ArgTypes) of + any -> I; + Type -> beam_ssa:add_anno(result_type, Type, I) + end. + +init_sig_st(StMap, FuncDb) -> + %% Start out as if all the roots have been called with 'any' for all + %% arguments. + Roots = init_sig_roots(FuncDb), + #sig_st{ committed=#{}, + updates=init_sig_args(Roots, StMap, #{}), + wl=wl_defer_list(Roots, wl_new()) }. + +init_sig_roots(FuncDb) -> + maps:fold(fun(Id, #func_info{exported=true}, Acc) -> + [Id | Acc]; + (_, _, Acc) -> + Acc + end, [], FuncDb). + +init_sig_args([Root | Roots], StMap, Acc) -> + #opt_st{args=Args0} = map_get(Root, StMap), + ArgTypes = lists:duplicate(length(Args0), any), + init_sig_args(Roots, StMap, Acc#{ Root => ArgTypes }); +init_sig_args([], _StMap, Acc) -> + Acc. + +sig_commit_args(Id, #sig_st{updates=Us,committed=Committed0}=State0) -> + Types = map_get(Id, Us), + Committed = Committed0#{ Id => Types }, + State = State0#sig_st{committed=Committed}, + {Types, State}. + +sig_update_args(Callee, Types, #sig_st{committed=Committed}=State) -> + case Committed of + #{ Callee := Current } -> + case parallel_join(Current, Types) of + Current -> + %% We've already processed this function with these + %% arguments, so there's no need to visit it again. + State; + Widened -> + sig_update_args_1(Callee, Widened, State) + end; + #{} -> + sig_update_args_1(Callee, Types, State) + end. + +sig_update_args_1(Callee, Types, #sig_st{updates=Us0,wl=Wl0}=State) -> + Us = case Us0 of + #{ Callee := Current } -> + Us0#{ Callee => parallel_join(Current, Types) }; + #{} -> + Us0#{ Callee => Types } + end, + State#sig_st{updates=Us,wl=wl_add(Callee, Wl0)}. -spec opt_continue(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when Linear :: [{non_neg_integer(), beam_ssa:b_blk()}], Args :: [beam_ssa:b_var()], Anno :: beam_ssa:anno(), FuncDb :: func_info_db(). -opt_continue(Linear, Args, Anno, FuncDb) -> +opt_continue(Linear0, Args, Anno, FuncDb) when FuncDb =/= #{} -> Id = get_func_id(Anno), case FuncDb of #{ Id := #func_info{exported=false,arg_types=ArgTypes} } -> %% This is a local function and we're guaranteed to have visited %% every call site at least once, so we know that the parameter %% types are at least as narrow as the join of all argument types. - Ts = join_arg_types(Args, ArgTypes, Anno), - opt_continue_1(Linear, Args, Id, Ts, FuncDb); - #{} -> - %% We can't infer the parameter types of exported functions, nor - %% the ones where module-level optimization is disabled, but + Ts = join_arg_types(Args, ArgTypes, #{}), + opt_function(Linear0, Args, Id, Ts, FuncDb); + #{ Id := #func_info{exported=true} } -> + %% We can't infer the parameter types of exported functions, but %% running the pass again could still help other functions. Ts = maps:from_list([{V,any} || #b_var{}=V <- Args]), - opt_continue_1(Linear, Args, Id, Ts, FuncDb) - end. + opt_function(Linear0, Args, Id, Ts, FuncDb) + end; +opt_continue(Linear0, Args, Anno, _FuncDb) -> + %% Module-level optimization is disabled, pass an empty function database + %% so we only perform local optimizations. + Id = get_func_id(Anno), + Ts = maps:from_list([{V,any} || #b_var{}=V <- Args]), + {Linear, _} = opt_function(Linear0, Args, Id, Ts, #{}), + {Linear, #{}}. -join_arg_types(Args, ArgTypes, Anno) -> - %% We suppress type optimization for parameters that have already been - %% optimized by another pass, as they may have done things we have no idea - %% how to interpret and running them over could generate incorrect code. - ParamTypes = maps:get(parameter_type_info, Anno, #{}), - Ts0 = join_arg_types_1(Args, ArgTypes, #{}), - maps:fold(fun(Arg, _V, Ts) -> - maps:put(Arg, any, Ts) - end, Ts0, ParamTypes). - -join_arg_types_1([Arg | Args], [TM | TMs], Ts) when map_size(TM) =/= 0 -> - join_arg_types_1(Args, TMs, Ts#{ Arg => join(maps:values(TM))}); -join_arg_types_1([Arg | Args], [_TM | TMs], Ts) -> - join_arg_types_1(Args, TMs, Ts#{ Arg => any }); -join_arg_types_1([], [], Ts) -> +join_arg_types([Arg | Args], [TypeMap | TMs], Ts) -> + Type = beam_types:join(maps:values(TypeMap)), + join_arg_types(Args, TMs, Ts#{ Arg => Type }); +join_arg_types([], [], Ts) -> Ts. --spec opt_continue_1(Linear, Args, Id, Ts, FuncDb) -> Result when +%% +%% Optimizes a function based on the type information inferred by signatures/2 +%% and earlier runs of opt_function/5. +%% +%% This is pretty straightforward as it only walks through each function once, +%% and because it only makes types narrower it's safe to optimize the functions +%% in any order or not at all. +%% + +-spec opt_function(Linear, Args, Id, Ts, FuncDb) -> Result when Linear :: [{non_neg_integer(), beam_ssa:b_blk()}], Args :: [beam_ssa:b_var()], Id :: func_id(), Ts :: type_db(), FuncDb :: func_info_db(), Result :: {Linear, FuncDb}. -opt_continue_1(Linear0, Args, Id, Ts, FuncDb0) -> - UsedOnce = used_once(Linear0, Args), +opt_function(Linear0, Args, Id, Ts, FuncDb0) -> FakeCall = #b_set{op=call,args=[#b_remote{mod=#b_literal{val=unknown}, name=#b_literal{val=unknown}, arity=0}]}, - Defs = maps:from_list([{Var,FakeCall#b_set{dst=Var}} || - #b_var{}=Var <- Args]), - D = #d{ func_db=FuncDb0, - func_id=Id, - ds=Defs, - ls=#{0=>Ts,?BADARG_BLOCK=>#{}}, - once=UsedOnce }, + Ds = maps:from_list([{Var, FakeCall#b_set{dst=Var}} || + #b_var{}=Var <- Args]), + + Ls = #{ ?EXCEPTION_BLOCK => Ts, + 0 => Ts }, + + Meta = init_metadata(Id, Linear0, Args), - {Linear, FuncDb, NewRet} = opt(Linear0, D, []), + {Linear, FuncDb, SuccTypes} = + opt_bs(Linear0, Ds, Ls, FuncDb0, #{}, [], Meta, []), case FuncDb of #{ Id := Entry0 } -> - Entry = Entry0#func_info{ret_type=NewRet}, + Entry = Entry0#func_info{succ_types=SuccTypes}, {Linear, FuncDb#{ Id := Entry }}; #{} -> - %% Module-level optimizations have been turned off for this - %% function. + %% Module-level optimizations have been turned off. {Linear, FuncDb} end. +get_func_id(Anno) -> + #{func_info:={_Mod, Name, Arity}} = Anno, + #b_local{name=#b_literal{val=Name}, arity=Arity}. + +opt_bs([{L, #b_blk{is=Is0,last=Last0}=Blk0} | Bs], + Ds0, Ls0, Fdb0, Sub0, SuccTypes0, Meta, Acc) when is_map_key(L, Ls0) -> + + #{ L := Ts0 } = Ls0, + {Is, Ts, Ds, Fdb, Sub} = opt_is(Is0, Ts0, Ds0, Ls0, Fdb0, Sub0, Meta, []), + + Last1 = simplify_terminator(Last0, Ts, Ds, Sub), + + SuccTypes = update_success_types(Last1, Ts, Ds, Meta, SuccTypes0), + {Last, Ls} = update_successors(Last1, Ts, Ds, Ls0, Meta#metadata.used_once), + + Blk = Blk0#b_blk{is=Is,last=Last}, + opt_bs(Bs, Ds, Ls, Fdb, Sub, SuccTypes, Meta, [{L,Blk} | Acc]); +opt_bs([_Blk | Bs], Ds, Ls, Fdb, Sub, SuccTypes, Meta, Acc) -> + %% This block is never reached. Discard it. + opt_bs(Bs, Ds, Ls, Fdb, Sub, SuccTypes, Meta, Acc); +opt_bs([], _Ds, _Ls, Fdb, _Sub, SuccTypes, _Meta, Acc) -> + {reverse(Acc), Fdb, SuccTypes}. + +opt_is([#b_set{op=call, + args=[#b_local{}=Callee | _]=Args0, + dst=Dst}=I0 | Is], + Ts0, Ds0, Ls, Fdb0, Sub, Meta, Acc) -> + Args = simplify_args(Args0, Ts0, Sub), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + [_ | CallArgs] = Args, + {I, Fdb} = opt_local_call(I1, Callee, CallArgs, Dst, Ts0, Fdb0, Meta), + + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + opt_is(Is, Ts, Ds, Ls, Fdb, Sub, Meta, [I | Acc]); +opt_is([#b_set{op=call, + args=[#b_var{} | _]=Args0, + dst=Dst}=I0 | Is], + Ts0, Ds0, Ls, Fdb, Sub, Meta, Acc) -> + Args = simplify_args(Args0, Ts0, Sub), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + [Fun | _] = Args, + I = case normalized_type(Fun, Ts0) of + #t_fun{type=Type} -> beam_ssa:add_anno(result_type, Type, I1); + _ -> I1 + end, + + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + opt_is(Is, Ts, Ds, Ls, Fdb, Sub, Meta, [I | Acc]); +opt_is([#b_set{op=make_fun,args=Args0,dst=Dst}=I0|Is], + Ts0, Ds0, Ls, Fdb0, Sub0, Meta, Acc) -> + Args = simplify_args(Args0, Ts0, Sub0), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + + {I, Fdb} = opt_make_fun(I1, Ts0, Fdb0, Meta), + + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + opt_is(Is, Ts, Ds, Ls, Fdb, Sub0, Meta, [I|Acc]); +opt_is([I0 | Is], Ts0, Ds0, Ls, Fdb, Sub0, Meta, Acc) -> + case simplify(I0, Ts0, Ds0, Ls, Sub0) of + {#b_set{}=I, Ts, Ds} -> + opt_is(Is, Ts, Ds, Ls, Fdb, Sub0, Meta, [I | Acc]); + Sub when is_map(Sub) -> + opt_is(Is, Ts0, Ds0, Ls, Fdb, Sub, Meta, Acc) + end; +opt_is([], Ts, Ds, _Ls, Fdb, Sub, _Meta, Acc) -> + {reverse(Acc), Ts, Ds, Fdb, Sub}. + +opt_local_call(I0, Callee, Args, Dst, Ts, Fdb, Meta) -> + ArgTypes = argument_types(Args, Ts), + I = opt_local_return(I0, Callee, ArgTypes, Fdb), + case Fdb of + #{ Callee := #func_info{exported=false,arg_types=AT0}=Info0 } -> + %% Update the argument types of *this exact call*, the types + %% will be joined later when the callee is optimized. + CallId = {Meta#metadata.func_id, Dst}, + + AT = update_arg_types(ArgTypes, AT0, CallId), + Info = Info0#func_info{arg_types=AT}, + + {I, Fdb#{ Callee := Info }}; + #{} -> + %% We can't narrow the argument types of exported functions as they + %% can receive anything as part of an external call. We can still + %% rely on their return types however. + {I, Fdb} + end. + +%% See sig_make_fun/4 +opt_make_fun(#b_set{op=make_fun, + dst=Dst, + args=[#b_local{}=Callee | FreeVars]}=I0, + Ts, Fdb, Meta) -> + ArgCount = Callee#b_local.arity - length(FreeVars), + FVTypes = [raw_type(FreeVar, Ts) || FreeVar <- FreeVars], + ArgTypes = duplicate(ArgCount, any) ++ FVTypes, + + I = opt_local_return(I0, Callee, ArgTypes, Fdb), + + case Fdb of + #{ Callee := #func_info{exported=false,arg_types=AT0}=Info0 } -> + CallId = {Meta#metadata.func_id, Dst}, + + AT = update_arg_types(ArgTypes, AT0, CallId), + Info = Info0#func_info{arg_types=AT}, + + {I, Fdb#{ Callee := Info }}; + #{} -> + %% We can't narrow the argument types of exported functions as they + %% can receive anything as part of an external call. + {I, Fdb} + end. + +opt_local_return(I, Callee, ArgTypes, Fdb) when Fdb =/= #{} -> + #func_info{succ_types=SuccTypes} = map_get(Callee, Fdb), + case return_type(SuccTypes, ArgTypes) of + any -> I; + Type -> beam_ssa:add_anno(result_type, Type, I) + end; +opt_local_return(I, _Callee, _ArgTyps, _Fdb) -> + %% Module-level optimization is disabled, assume it returns anything. + I. + +update_arg_types([ArgType | ArgTypes], [TypeMap0 | TypeMaps], CallId) -> + TypeMap = TypeMap0#{ CallId => ArgType }, + [TypeMap | update_arg_types(ArgTypes, TypeMaps, CallId)]; +update_arg_types([], [], _CallId) -> + []. + +%% + -spec opt_finish(Args, Anno, FuncDb) -> {Anno, FuncDb} when Args :: [beam_ssa:b_var()], Anno :: beam_ssa:anno(), @@ -145,325 +572,129 @@ opt_finish(Args, Anno, FuncDb) -> Id = get_func_id(Anno), case FuncDb of #{ Id := #func_info{exported=false,arg_types=ArgTypes} } -> - ParamInfo0 = maps:get(parameter_type_info, Anno, #{}), + ParamInfo0 = maps:get(parameter_info, Anno, #{}), ParamInfo = opt_finish_1(Args, ArgTypes, ParamInfo0), - {Anno#{ parameter_type_info => ParamInfo }, FuncDb}; + {Anno#{ parameter_info => ParamInfo }, FuncDb}; #{} -> {Anno, FuncDb} end. -opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo) - when is_map_key(Arg, ParamInfo); %% See join_arg_types/3 - map_size(TypeMap) =:= 0 -> - opt_finish_1(Args, TypeMaps, ParamInfo); -opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo0) -> - case join(maps:values(TypeMap)) of +opt_finish_1([Arg | Args], [TypeMap | TypeMaps], Acc0) -> + case beam_types:join(maps:values(TypeMap)) of any -> - opt_finish_1(Args, TypeMaps, ParamInfo0); - none -> - %% This function will never be called. Pretend that we don't - %% know the type for this argument. - opt_finish_1(Args, TypeMaps, ParamInfo0); + opt_finish_1(Args, TypeMaps, Acc0); JoinedType -> - JoinedType = verified_type(JoinedType), - ParamInfo = ParamInfo0#{ Arg => validator_anno(JoinedType) }, - opt_finish_1(Args, TypeMaps, ParamInfo) + Info = maps:get(Arg, Acc0, []), + Acc = Acc0#{ Arg => [{type, JoinedType} | Info] }, + opt_finish_1(Args, TypeMaps, Acc) end; -opt_finish_1([], [], ParamInfo) -> - ParamInfo. - -validator_anno(#t_tuple{size=Size,exact=Exact,elements=Elements0}) -> - Elements = maps:fold(fun(Index, Type, Acc) -> - Key = beam_validator:type_anno(integer, Index), - Acc#{ Key => validator_anno(Type) } - end, #{}, Elements0), - beam_validator:type_anno(tuple, Size, Exact, Elements); -validator_anno(#t_integer{elements={Same,Same}}) -> - beam_validator:type_anno(integer, Same); -validator_anno(#t_integer{}) -> - beam_validator:type_anno(integer); -validator_anno(float) -> - beam_validator:type_anno(float); -validator_anno(#t_atom{elements=[Val]}) -> - beam_validator:type_anno(atom, Val); -validator_anno(#t_atom{}=A) -> - case t_is_boolean(A) of - true -> beam_validator:type_anno(bool); - false -> beam_validator:type_anno(atom) - end; -validator_anno(T) -> - beam_validator:type_anno(T). +opt_finish_1([], [], Acc) -> + Acc. -get_func_id(Anno) -> - #{func_info:={_Mod, Name, Arity}} = Anno, - #b_local{name=#b_literal{val=Name}, arity=Arity}. +%%% +%%% Optimization helpers +%%% -opt([{L,Blk}|Bs], #d{ls=Ls}=D, Acc) -> - case Ls of - #{L:=Ts} -> - opt_1(L, Blk, Bs, Ts, D, Acc); - #{} -> - %% This block is never reached. Discard it. - opt(Bs, D, Acc) +simplify_terminator(#b_br{bool=Bool}=Br0, Ts, Ds, Sub) -> + Br = beam_ssa:normalize(Br0#b_br{bool=simplify_arg(Bool, Ts, Sub)}), + simplify_not(Br, Ts, Ds, Sub); +simplify_terminator(#b_switch{arg=Arg0,fail=Fail,list=List0}=Sw0, + Ts, Ds, Sub) -> + Arg = simplify_arg(Arg0, Ts, Sub), + %% Ensure that no label in the switch list is the same as the + %% failure label. + List = [{Val,Lbl} || {Val,Lbl} <- List0, Lbl =/= Fail], + case beam_ssa:normalize(Sw0#b_switch{arg=Arg,list=List}) of + #b_switch{}=Sw -> + case beam_types:is_boolean_type(raw_type(Arg, Ts)) of + true -> simplify_switch_bool(Sw, Ts, Ds, Sub); + false -> Sw + end; + #b_br{}=Br -> + simplify_terminator(Br, Ts, Ds, Sub) end; -opt([], D, Acc) -> - #d{func_db=FuncDb,ret_type=NewRet} = D, - {reverse(Acc), FuncDb, NewRet}. - -opt_1(L, #b_blk{is=Is0,last=Last0}=Blk0, Bs, Ts0, - #d{ds=Ds0,sub=Sub0,func_db=Fdb0}=D0, Acc) -> - case opt_is(Is0, Ts0, Ds0, Fdb0, D0, Sub0, []) of - {Is,Ts,Ds,Fdb,Sub} -> - D1 = D0#d{ds=Ds,sub=Sub,func_db=Fdb}, - Last1 = simplify_terminator(Last0, Sub, Ts, Ds), - Last = opt_terminator(Last1, Ts, Ds), - D = update_successors(Last, Ts, D1), - Blk = Blk0#b_blk{is=Is,last=Last}, - opt(Bs, D, [{L,Blk}|Acc]); - {no_return,Ret,Is,Ds,Fdb,Sub} -> - %% This call will never reach the successor block. - %% Rewrite the terminator to a 'ret', and remove - %% all type information for this label. That can - %% potentially narrow the type of the phi node - %% in the former successor. - Ls = maps:remove(L, D0#d.ls), - RetType = join([none|D0#d.ret_type]), - D = D0#d{ds=Ds,ls=Ls,sub=Sub, - func_db=Fdb,ret_type=[RetType]}, - Blk = Blk0#b_blk{is=Is,last=Ret}, - opt(Bs, D, [{L,Blk}|Acc]) - end. - -simplify_terminator(#b_br{bool=Bool}=Br, Sub, Ts, _Ds) -> - Br#b_br{bool=simplify_arg(Bool, Sub, Ts)}; -simplify_terminator(#b_switch{arg=Arg}=Sw, Sub, Ts, _Ds) -> - Sw#b_switch{arg=simplify_arg(Arg, Sub, Ts)}; -simplify_terminator(#b_ret{arg=Arg}=Ret, Sub, Ts, Ds) -> +simplify_terminator(#b_ret{arg=Arg}=Ret, Ts, Ds, Sub) -> %% Reducing the result of a call to a literal (fairly common for 'ok') %% breaks tail call optimization. case Ds of #{ Arg := #b_set{op=call}} -> Ret; - #{} -> Ret#b_ret{arg=simplify_arg(Arg, Sub, Ts)} + #{} -> Ret#b_ret{arg=simplify_arg(Arg, Ts, Sub)} end. -opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is], - Ts0, Ds0, Fdb, #d{ls=Ls}=D, Sub0, Acc) -> +%% +%% Simplifies an instruction, returning either a new instruction (with updated +%% type and definition maps), or an updated substitution map if the instruction +%% was redundant. +%% + +simplify(#b_set{op=phi,dst=Dst,args=Args0}=I0, Ts0, Ds0, Ls, Sub) -> %% Simplify the phi node by removing all predecessor blocks that no %% longer exists or no longer branches to this block. - Args = [{simplify_arg(Arg, Sub0, Ts0),From} || + Args = [{simplify_arg(Arg, Ts0, Sub), From} || {Arg,From} <- Args0, maps:is_key(From, Ls)], case all_same(Args) of true -> %% Eliminate the phi node if there is just one source %% value or if the values are identical. [{Val,_}|_] = Args, - Sub = Sub0#{Dst=>Val}, - opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc); + Sub#{ Dst => Val }; false -> I = I0#b_set{args=Args}, Ts = update_types(I, Ts0, Ds0), Ds = Ds0#{Dst=>I}, - opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]) + {I, Ts, Ds} end; -opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0|Is], - Ts0, Ds0, Fdb0, D, Sub0, Acc) -> - Args = simplify_args(Args0, Sub0, Ts0), - I1 = beam_ssa:normalize(I0#b_set{args=Args}), - {Ts1,Ds,Fdb,I2} = opt_call(I1, D, Ts0, Ds0, Fdb0), - case {map_get(Dst, Ts1),Is} of - {Type,[#b_set{op=succeeded}]} when Type =/= none -> - %% This call instruction is inside a try/catch - %% block. Don't attempt to simplify it. - opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I2|Acc]); - {none,[#b_set{op=succeeded}]} -> - %% This call instruction is inside a try/catch - %% block, but we know it will never return and - %% later optimizations may try to exploit that. - %% - %% For example, if we have an expression that - %% either returns this call or a tuple, we know - %% that the expression always returns a tuple - %% and can turn a later element/3 into - %% get_tuple_element. - %% - %% This is sound but difficult to validate in a - %% meaningful way as try/catch currently forces - %% us to maintain the illusion that the success - %% block is reachable even when its not, so we - %% disable the optimization to keep things - %% simple. - Ts = Ts1#{ Dst := any }, - opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I2|Acc]); - {none,_} -> - %% This call never returns. The rest of the - %% instructions will not be executed. - Ret = #b_ret{arg=Dst}, - {no_return,Ret,reverse(Acc, [I2]),Ds,Fdb,Sub0}; - {_,_} -> - case simplify_call(I2) of - #b_set{}=I -> - opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I|Acc]); - #b_literal{}=Lit -> - Sub = Sub0#{Dst=>Lit}, - Ts = maps:remove(Dst, Ts1), - opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc); - #b_var{}=Var -> - Ts = maps:remove(Dst, Ts1), - Sub = Sub0#{Dst=>Var}, - opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc) - end +simplify(#b_set{op=succeeded,dst=Dst}=I0, Ts0, Ds0, _Ls, Sub) -> + case will_succeed(I0, Ts0, Ds0, Sub) of + yes -> + Lit = #b_literal{val=true}, + Sub#{ Dst => Lit }; + no -> + Lit = #b_literal{val=false}, + Sub#{ Dst => Lit }; + maybe -> + %% Note that we never simplify args; this instruction is specific + %% to the operation being checked, and simplifying could break that + %% connection. + I = beam_ssa:normalize(I0), + Ts = Ts0#{ Dst => beam_types:make_boolean() }, + Ds = Ds0#{ Dst => I }, + {I, Ts, Ds} end; -opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I], - Ts0, Ds0, Fdb, D, Sub0, Acc) -> - case Ds0 of - #{ Arg := #b_set{op=call} } -> - %% The success check of a call is part of exception handling and - %% must not be optimized away. We still have to update its type - %% though. - Ts = update_types(I, Ts0, Ds0), - Ds = Ds0#{Dst=>I}, - - opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc]); - #{} -> - Args = simplify_args([Arg], Sub0, Ts0), - Type = type(succeeded, Args, Ts0, Ds0), - case get_literal_from_type(Type) of - #b_literal{}=Lit -> - Sub = Sub0#{Dst=>Lit}, - opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc); - none -> - Ts = Ts0#{Dst=>Type}, - Ds = Ds0#{Dst=>I}, - opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc]) - end - end; -opt_is([#b_set{args=Args0,dst=Dst}=I0|Is], - Ts0, Ds0, Fdb, D, Sub0, Acc) -> - Args = simplify_args(Args0, Sub0, Ts0), +simplify(#b_set{op=bs_match,dst=Dst,args=Args0}=I0, Ts0, Ds0, _Ls, Sub) -> + Args = simplify_args(Args0, Ts0, Sub), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + I2 = case {Args0,Args} of + {[_,_,_,#b_var{},_],[Type,Val,Flags,#b_literal{val=all},Unit]} -> + %% The size `all` is used for the size of the final binary + %% segment in a pattern. Using `all` explicitly is not allowed, + %% so we convert it to an obvious invalid size. + I1#b_set{args=[Type,Val,Flags,#b_literal{val=bad_size},Unit]}; + {_,_} -> + I1 + end, + %% We KNOW that simplify/2 will return a #b_set{} record when called with + %% a bs_match instruction. + #b_set{} = I3 = simplify(I2, Ts0), + I = beam_ssa:normalize(I3), + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + {I, Ts, Ds}; +simplify(#b_set{dst=Dst,args=Args0}=I0, Ts0, Ds0, _Ls, Sub) -> + Args = simplify_args(Args0, Ts0, Sub), I1 = beam_ssa:normalize(I0#b_set{args=Args}), case simplify(I1, Ts0) of #b_set{}=I2 -> I = beam_ssa:normalize(I2), Ts = update_types(I, Ts0, Ds0), - Ds = Ds0#{Dst=>I}, - opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]); + Ds = Ds0#{ Dst => I }, + {I, Ts, Ds}; #b_literal{}=Lit -> - Sub = Sub0#{Dst=>Lit}, - opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc); + Sub#{ Dst => Lit }; #b_var{}=Var -> - case Is of - [#b_set{op=succeeded,dst=SuccDst,args=[Dst]}] -> - %% We must remove this 'succeeded' instruction. - Sub = Sub0#{Dst=>Var,SuccDst=>#b_literal{val=true}}, - opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc); - _ -> - Sub = Sub0#{Dst=>Var}, - opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc) - end - end; -opt_is([], Ts, Ds, Fdb, _D, Sub, Acc) -> - {reverse(Acc), Ts, Ds, Fdb, Sub}. - -simplify_call(#b_set{op=call,args=[#b_remote{}=Rem|Args]}=I) -> - case Rem of - #b_remote{mod=#b_literal{val=Mod}, - name=#b_literal{val=Name}} -> - case erl_bifs:is_pure(Mod, Name, length(Args)) of - true -> - simplify_remote_call(Mod, Name, Args, I); - false -> - I - end; - #b_remote{} -> - I - end; -simplify_call(I) -> I. - -%% Simplify a remote call to a pure BIF. -simplify_remote_call(erlang, '++', [#b_literal{val=[]},Tl], _I) -> - Tl; -simplify_remote_call(erlang, setelement, - [#b_literal{val=Pos}, - #b_literal{val=Tuple}, - #b_var{}=Value], I) - when is_integer(Pos), 1 =< Pos, Pos =< tuple_size(Tuple) -> - %% Position is a literal integer and the shape of the - %% tuple is known. - Els0 = [#b_literal{val=El} || El <- tuple_to_list(Tuple)], - {Bef,[_|Aft]} = split(Pos - 1, Els0), - Els = Bef ++ [Value|Aft], - I#b_set{op=put_tuple,args=Els}; -simplify_remote_call(Mod, Name, Args0, I) -> - case make_literal_list(Args0) of - none -> - I; - Args -> - %% The arguments are literals. Try to evaluate the BIF. - try apply(Mod, Name, Args) of - Val -> - case cerl:is_literal_term(Val) of - true -> - #b_literal{val=Val}; - false -> - %% The value can't be expressed as a literal - %% (e.g. a pid). - I - end - catch - _:_ -> - %% Failed. Don't bother trying to optimize - %% the call. - I - end + Sub#{ Dst => Var } end. -opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) -> - {Ts, Ds, I} = opt_local_call(I0, Ts0, Ds0, Fdb0), - case Fdb0 of - #{ Callee := #func_info{exported=false,arg_types=ArgTypes0}=Info } -> - %% Update the argument types of *this exact call*, the types - %% will be joined later when the callee is optimized. - CallId = {D#d.func_id, Dst}, - ArgTypes = update_arg_types(Args, ArgTypes0, CallId, Ts0), - - Fdb = Fdb0#{ Callee => Info#func_info{arg_types=ArgTypes} }, - {Ts, Ds, Fdb, I}; - #{} -> - %% We can't narrow the argument types of exported functions as they - %% can receive anything as part of an external call. - {Ts, Ds, Fdb0, I} - end; -opt_call(#b_set{dst=Dst}=I, _D, Ts0, Ds0, Fdb) -> - Ts = update_types(I, Ts0, Ds0), - Ds = Ds0#{ Dst => I }, - {Ts, Ds, Fdb, I}. - -opt_local_call(#b_set{dst=Dst,args=[Id|_]}=I0, Ts0, Ds0, Fdb) -> - Type = case Fdb of - #{ Id := #func_info{ret_type=[T]} } -> T; - #{} -> any - end, - I = case Type of - any -> I0; - none -> I0; - _ -> beam_ssa:add_anno(result_type, validator_anno(Type), I0) - end, - Ts = Ts0#{ Dst => Type }, - Ds = Ds0#{ Dst => I }, - {Ts, Ds, I}. - -update_arg_types([Arg | Args], [TypeMap0 | TypeMaps], CallId, Ts) -> - %% Match contexts are treated as bitstrings when optimizing arguments, as - %% we don't yet support removing the "bs_start_match3" instruction. - NewType = case get_type(Arg, Ts) of - #t_bs_match{} -> {binary, 1}; - Type -> Type - end, - TypeMap = TypeMap0#{ CallId => NewType }, - [TypeMap | update_arg_types(Args, TypeMaps, CallId, Ts)]; -update_arg_types([], [], _CallId, _Ts) -> - []. - simplify(#b_set{op={bif,'and'},args=Args}=I, Ts) -> case is_safe_bool_op(Args, Ts) of true -> @@ -487,8 +718,10 @@ simplify(#b_set{op={bif,'or'},args=Args}=I, Ts) -> I end; simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I0, Ts) -> - case t_tuple_size(get_type(Tuple, Ts)) of - {_,Size} when is_integer(Index), 1 =< Index, Index =< Size -> + case normalized_type(Tuple, Ts) of + #t_tuple{size=Size} when is_integer(Index), + 1 =< Index, + Index =< Size -> I = I0#b_set{op=get_tuple_element, args=[Tuple,#b_literal{val=Index-1}]}, simplify(I, Ts); @@ -496,67 +729,110 @@ simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I0, Ts) -> eval_bif(I0, Ts) end; simplify(#b_set{op={bif,hd},args=[List]}=I, Ts) -> - case get_type(List, Ts) of - cons -> + case normalized_type(List, Ts) of + #t_cons{} -> I#b_set{op=get_hd}; _ -> eval_bif(I, Ts) end; simplify(#b_set{op={bif,tl},args=[List]}=I, Ts) -> - case get_type(List, Ts) of - cons -> + case normalized_type(List, Ts) of + #t_cons{} -> I#b_set{op=get_tl}; _ -> eval_bif(I, Ts) end; simplify(#b_set{op={bif,size},args=[Term]}=I, Ts) -> - case get_type(Term, Ts) of + case normalized_type(Term, Ts) of #t_tuple{} -> simplify(I#b_set{op={bif,tuple_size}}, Ts); + #t_bitstring{size_unit=U} when U rem 8 =:= 0 -> + %% If the bitstring is a binary (the size in bits is + %% evenly divisibly by 8), byte_size/1 gives + %% the same result as size/1. + simplify(I#b_set{op={bif,byte_size}}, Ts); _ -> eval_bif(I, Ts) end; simplify(#b_set{op={bif,tuple_size},args=[Term]}=I, Ts) -> - case get_type(Term, Ts) of + case normalized_type(Term, Ts) of #t_tuple{size=Size,exact=true} -> #b_literal{val=Size}; _ -> I end; -simplify(#b_set{op={bif,'=='},args=Args}=I, Ts) -> - Types = get_types(Args, Ts), - EqEq = case {meet(Types),join(Types)} of - {none,any} -> true; - {#t_integer{},#t_integer{}} -> true; - {float,float} -> true; - {{binary,_},_} -> true; - {#t_atom{},_} -> true; - {_,_} -> false - end, +simplify(#b_set{op={bif,is_function},args=[Fun,#b_literal{val=Arity}]}=I, Ts) + when is_integer(Arity), Arity >= 0 -> + case normalized_type(Fun, Ts) of + #t_fun{arity=any} -> + I; + #t_fun{arity=Arity} -> + #b_literal{val=true}; + any -> + I; + _ -> + #b_literal{val=false} + end; +simplify(#b_set{op={bif,is_map_key},args=[Key,Map]}=I, Ts) -> + case normalized_type(Map, Ts) of + #t_map{} -> + I#b_set{op=has_map_field,args=[Map,Key]}; + _ -> + I + end; +simplify(#b_set{op={bif,Op0},args=Args}=I, Ts) when Op0 =:= '=='; + Op0 =:= '/=' -> + Types = normalized_types(Args, Ts), + EqEq0 = case {beam_types:meet(Types),beam_types:join(Types)} of + {none,any} -> true; + {#t_integer{},#t_integer{}} -> true; + {#t_float{},#t_float{}} -> true; + {#t_bitstring{},_} -> true; + {#t_atom{},_} -> true; + {_,_} -> false + end, + EqEq = EqEq0 orelse any_non_numeric_argument(Args, Ts), case EqEq of true -> - simplify(I#b_set{op={bif,'=:='}}, Ts); + Op = case Op0 of + '==' -> '=:='; + '/=' -> '=/=' + end, + simplify(I#b_set{op={bif,Op}}, Ts); false -> eval_bif(I, Ts) end; simplify(#b_set{op={bif,'=:='},args=[Same,Same]}, _Ts) -> #b_literal{val=true}; -simplify(#b_set{op={bif,'=:='},args=[A1,_A2]=Args}=I, Ts) -> - [T1,T2] = get_types(Args, Ts), - case meet(T1, T2) of +simplify(#b_set{op={bif,'=:='},args=[LHS,RHS]}=I, Ts) -> + LType = raw_type(LHS, Ts), + RType = raw_type(RHS, Ts), + case beam_types:meet(LType, RType) of none -> #b_literal{val=false}; _ -> - case {t_is_boolean(T1),T2} of + case {beam_types:is_boolean_type(LType), + beam_types:normalize(RType)} of {true,#t_atom{elements=[true]}} -> %% Bool =:= true ==> Bool - A1; + LHS; + {true,#t_atom{elements=[false]}} -> + %% Bool =:= false ==> not Bool + %% + %% This will be further optimized to eliminate the + %% 'not', swapping the success and failure + %% branches in the br instruction. If LHS comes + %% from a type test (such as is_atom/1) or a + %% comparison operator (such as >=) that can be + %% translated to test instruction, this + %% optimization will eliminate one instruction. + simplify(I#b_set{op={bif,'not'},args=[LHS]}, Ts); {_,_} -> eval_bif(I, Ts) end end; simplify(#b_set{op={bif,Op},args=Args}=I, Ts) -> - Types = get_types(Args, Ts), + Types = normalized_types(Args, Ts), case is_float_op(Op, Types) of false -> eval_bif(I, Ts); @@ -564,29 +840,57 @@ simplify(#b_set{op={bif,Op},args=Args}=I, Ts) -> AnnoArgs = [anno_float_arg(A) || A <- Types], eval_bif(beam_ssa:add_anno(float_op, AnnoArgs, I), Ts) end; -simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=N}]}=I, Ts) -> - case get_type(Tuple, Ts) of - #t_tuple{size=Size,elements=Es} when Size > N -> - ElemType = get_element_type(N + 1, Es), - case get_literal_from_type(ElemType) of - #b_literal{}=Lit -> Lit; - none -> I - end; - none -> - %% Will never be executed because of type conflict. - %% #b_literal{val=ignored}; +simplify(#b_set{op=bs_extract,args=[Ctx]}=I, Ts) -> + case raw_type(Ctx, Ts) of + #t_bitstring{} -> + %% This is a bs_match that has been rewritten as a bs_get_tail; + %% just return the input as-is. + Ctx; + #t_bs_context{} -> I end; +simplify(#b_set{op=bs_match, + args=[#b_literal{val=binary}, Ctx, _Flags, + #b_literal{val=all}, + #b_literal{val=OpUnit}]}=I, Ts) -> + %% <<..., Foo/binary>> can be rewritten as <<..., Foo/bits>> if we know the + %% unit is correct. + #t_bs_context{tail_unit=CtxUnit} = raw_type(Ctx, Ts), + if + CtxUnit rem OpUnit =:= 0 -> + I#b_set{op=bs_get_tail,args=[Ctx]}; + CtxUnit rem OpUnit =/= 0 -> + I + end; +simplify(#b_set{op=bs_start_match,args=[#b_literal{val=new}, Src]}=I, Ts) -> + case raw_type(Src, Ts) of + #t_bs_context{} -> + I#b_set{op=bs_start_match,args=[#b_literal{val=resume}, Src]}; + _ -> + I + end; +simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=N}]}=I, Ts) -> + #t_tuple{size=Size,elements=Es} = normalized_type(Tuple, Ts), + true = Size > N, %Assertion. + ElemType = beam_types:get_tuple_element(N + 1, Es), + case beam_types:get_singleton_value(ElemType) of + {ok, Val} -> #b_literal{val=Val}; + error -> I + end; simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) -> - case get_type(Src, Ts) of - any -> I; - list -> I; - cons -> #b_literal{val=true}; - _ -> #b_literal{val=false} + case normalized_type(Src, Ts) of + any -> + I; + #t_list{} -> + I; + #t_cons{} -> + #b_literal{val=true}; + _ -> + #b_literal{val=false} end; simplify(#b_set{op=is_tagged_tuple, args=[Src,#b_literal{val=Size},#b_literal{}=Tag]}=I, Ts) -> - simplify_is_record(I, get_type(Src, Ts), Size, Tag, Ts); + simplify_is_record(I, normalized_type(Src, Ts), Size, Tag, Ts); simplify(#b_set{op=put_list,args=[#b_literal{val=H}, #b_literal{val=T}]}, _Ts) -> #b_literal{val=[H|T]}; @@ -599,8 +903,274 @@ simplify(#b_set{op=wait_timeout,args=[#b_literal{val=0}]}, _Ts) -> #b_literal{val=true}; simplify(#b_set{op=wait_timeout,args=[#b_literal{val=infinity}]}=I, _Ts) -> I#b_set{op=wait,args=[]}; +simplify(#b_set{op=call,args=[#b_remote{}=Rem|Args]}=I, _Ts) -> + case Rem of + #b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Name}} -> + case erl_bifs:is_pure(Mod, Name, length(Args)) of + true -> + simplify_remote_call(Mod, Name, Args, I); + false -> + I + end; + #b_remote{} -> + I + end; simplify(I, _Ts) -> I. +will_succeed(#b_set{args=[Src]}, Ts, Ds, Sub) -> + case {Ds, Ts} of + {#{}, #{ Src := none }} -> + %% Checked operation never returns. + no; + {#{ Src := I }, #{}} -> + will_succeed_1(I, Src, Ts, Sub); + {#{}, #{}} -> + %% The checked instruction has been removed and substituted, so we + %% can assume it always succeeds. + true = is_map_key(Src, Sub), %Assertion. + yes + end. + +will_succeed_1(#b_set{op=bs_get_tail}, _Src, _Ts, _Sub) -> + yes; +will_succeed_1(#b_set{op=bs_start_match,args=[_, Arg]}, _Src, Ts, _Sub) -> + ArgType = raw_type(Arg, Ts), + case beam_types:is_bs_matchable_type(ArgType) of + true -> + %% In the future we may be able to remove this instruction + %% altogether when we have a #t_bs_context{}, but for now we need + %% to keep it for compatibility with older releases of OTP. + yes; + false -> + %% Is it at all possible to match? + case beam_types:meet(ArgType, #t_bs_matchable{}) of + none -> no; + _ -> maybe + end + end; + +will_succeed_1(#b_set{op={bif,Bif},args=BifArgs}, _Src, Ts, _Sub) -> + ArgTypes = normalized_types(BifArgs, Ts), + beam_call_types:will_succeed(erlang, Bif, ArgTypes); +will_succeed_1(#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Func}} | + CallArgs]}, + _Src, Ts, _Sub) -> + ArgTypes = normalized_types(CallArgs, Ts), + beam_call_types:will_succeed(Mod, Func, ArgTypes); + +will_succeed_1(#b_set{op=get_hd}, _Src, _Ts, _Sub) -> + yes; +will_succeed_1(#b_set{op=get_tl}, _Src, _Ts, _Sub) -> + yes; +will_succeed_1(#b_set{op=has_map_field}, _Src, _Ts, _Sub) -> + yes; +will_succeed_1(#b_set{op=get_tuple_element}, _Src, _Ts, _Sub) -> + yes; +will_succeed_1(#b_set{op=put_tuple}, _Src, _Ts, _Sub) -> + yes; + +%% Remove the success branch from binary operations with invalid +%% sizes. That will remove subsequent bs_put and bs_match instructions, +%% which are probably not loadable. +will_succeed_1(#b_set{op=bs_add,args=[_,#b_literal{val=Size},_]}, + _Src, _Ts, _Sub) -> + if + is_integer(Size), Size >= 0 -> + maybe; + true -> + no + end; +will_succeed_1(#b_set{op=bs_init, + args=[#b_literal{val=new},#b_literal{val=Size},_Unit]}, + _Src, _Ts, _Sub) -> + if + is_integer(Size), Size >= 0 -> + maybe; + true -> + no + end; +will_succeed_1(#b_set{op=bs_init, + args=[#b_literal{},_,#b_literal{val=Size},_Unit]}, + _Src, _Ts, _Sub) -> + if + is_integer(Size), Size >= 0 -> + maybe; + true -> + no + end; +will_succeed_1(#b_set{op=bs_match, + args=[#b_literal{val=Type},_,_,#b_literal{val=Size},_]}, + _Src, _Ts, _Sub) -> + if + is_integer(Size), Size >= 0 -> + maybe; + Type =:= binary, Size =:= all -> + %% `all` is a legal size for binary segments at the end of + %% a binary pattern. + maybe; + true -> + %% Invalid size. Matching will fail. + no + end; + +%% These operations may fail even though we know their return value on success. +will_succeed_1(#b_set{op=call}, _Src, _Ts, _Sub) -> + maybe; +will_succeed_1(#b_set{op=get_map_element}, _Src, _Ts, _Sub) -> + maybe; + +will_succeed_1(#b_set{op=wait}, _Src, _Ts, _Sub) -> + no; + +will_succeed_1(#b_set{}, Src, Ts, Sub) -> + case simplify_arg(Src, Ts, Sub) of + #b_var{}=Src -> + %% No substitution; might fail at runtime. + maybe; + _ -> + %% Substituted with literal or other variable; always succeeds. + yes + end. + +simplify_is_record(I, #t_tuple{exact=Exact, + size=Size, + elements=Es}, + RecSize, #b_literal{val=TagVal}=RecTag, Ts) -> + TagType = maps:get(1, Es, any), + TagMatch = case beam_types:get_singleton_value(TagType) of + {ok, TagVal} -> yes; + {ok, _} -> no; + error -> + %% Is it at all possible for the tag to match? + case beam_types:meet(raw_type(RecTag, Ts), TagType) of + none -> no; + _ -> maybe + end + end, + if + Size =/= RecSize, Exact; Size > RecSize; TagMatch =:= no -> + #b_literal{val=false}; + Size =:= RecSize, Exact, TagMatch =:= yes -> + #b_literal{val=true}; + true -> + I + end; +simplify_is_record(I, any, _Size, _Tag, _Ts) -> + I; +simplify_is_record(_I, _Type, _Size, _Tag, _Ts) -> + #b_literal{val=false}. + +simplify_switch_bool(#b_switch{arg=B,fail=Fail,list=List0}, Ts, Ds, Sub) -> + FalseVal = #b_literal{val=false}, + TrueVal = #b_literal{val=true}, + List1 = List0 ++ [{FalseVal,Fail},{TrueVal,Fail}], + {_,FalseLbl} = keyfind(FalseVal, 1, List1), + {_,TrueLbl} = keyfind(TrueVal, 1, List1), + Br = #b_br{bool=B,succ=TrueLbl,fail=FalseLbl}, + simplify_terminator(Br, Ts, Ds, Sub). + +simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds, Sub) -> + case Ds of + #{V:=#b_set{op={bif,'not'},args=[Bool]}} -> + case beam_types:is_boolean_type(raw_type(Bool, Ts)) of + true -> + Br = Br0#b_br{bool=Bool,succ=Fail,fail=Succ}, + simplify_terminator(Br, Ts, Ds, Sub); + false -> + Br0 + end; + #{} -> + Br0 + end; +simplify_not(#b_br{bool=#b_literal{}}=Br, _Sub, _Ts, _Ds) -> + Br. + +%% Simplify a remote call to a pure BIF. +simplify_remote_call(erlang, '++', [#b_literal{val=[]},Tl], _I) -> + Tl; +simplify_remote_call(erlang, setelement, + [#b_literal{val=Pos}, + #b_literal{val=Tuple}, + #b_var{}=Value], I) + when is_integer(Pos), 1 =< Pos, Pos =< tuple_size(Tuple) -> + %% Position is a literal integer and the shape of the + %% tuple is known. + Els0 = [#b_literal{val=El} || El <- tuple_to_list(Tuple)], + {Bef,[_|Aft]} = split(Pos - 1, Els0), + Els = Bef ++ [Value|Aft], + I#b_set{op=put_tuple,args=Els}; +simplify_remote_call(Mod, Name, Args0, I) -> + case make_literal_list(Args0) of + none -> + I; + Args -> + %% The arguments are literals. Try to evaluate the BIF. + try apply(Mod, Name, Args) of + Val -> + case cerl:is_literal_term(Val) of + true -> + #b_literal{val=Val}; + false -> + %% The value can't be expressed as a literal + %% (e.g. a pid). + I + end + catch + _:_ -> + %% Failed. Don't bother trying to optimize + %% the call. + I + end + end. + +any_non_numeric_argument([#b_literal{val=Lit}|_], _Ts) -> + is_non_numeric(Lit); +any_non_numeric_argument([#b_var{}=V|T], Ts) -> + is_non_numeric_type(raw_type(V, Ts)) orelse any_non_numeric_argument(T, Ts); +any_non_numeric_argument([], _Ts) -> false. + +is_non_numeric([H|T]) -> + is_non_numeric(H) andalso is_non_numeric(T); +is_non_numeric(Tuple) when is_tuple(Tuple) -> + is_non_numeric_tuple(Tuple, tuple_size(Tuple)); +is_non_numeric(Map) when is_map(Map) -> + %% Starting from OTP 18, map keys are compared using `=:=`. + %% Therefore, we only need to check that the values in the map are + %% non-numeric. (Support for compiling BEAM files for OTP releases + %% older than OTP 18 has been dropped.) + is_non_numeric(maps:values(Map)); +is_non_numeric(Num) when is_number(Num) -> + false; +is_non_numeric(_) -> true. + +is_non_numeric_tuple(Tuple, El) when El >= 1 -> + is_non_numeric(element(El, Tuple)) andalso + is_non_numeric_tuple(Tuple, El-1); +is_non_numeric_tuple(_Tuple, 0) -> true. + +is_non_numeric_type(#t_atom{}) -> true; +is_non_numeric_type(#t_bitstring{}) -> true; +is_non_numeric_type(#t_cons{type=Type,terminator=Terminator}) -> + is_non_numeric_type(Type) andalso is_non_numeric_type(Terminator); +is_non_numeric_type(#t_list{type=Type,terminator=Terminator}) -> + is_non_numeric_type(Type) andalso is_non_numeric_type(Terminator); +is_non_numeric_type(#t_map{super_value=Value}) -> + is_non_numeric_type(Value); +is_non_numeric_type(nil) -> true; +is_non_numeric_type(#t_tuple{size=Size,exact=true,elements=Types}) + when map_size(Types) =:= Size -> + is_non_numeric_tuple_type(Size, Types); +is_non_numeric_type(_) -> false. + +is_non_numeric_tuple_type(0, _Types) -> + true; +is_non_numeric_tuple_type(Pos, Types) -> + is_non_numeric_type(map_get(Pos, Types)) andalso + is_non_numeric_tuple_type(Pos - 1, Types). + make_literal_list(Args) -> make_literal_list(Args, []). @@ -611,9 +1181,11 @@ make_literal_list([_|_], _) -> make_literal_list([], Acc) -> reverse(Acc). -is_safe_bool_op(Args, Ts) -> - [T1,T2] = get_types(Args, Ts), - t_is_boolean(T1) andalso t_is_boolean(T2). +is_safe_bool_op([LHS, RHS], Ts) -> + LType = raw_type(LHS, Ts), + RType = raw_type(RHS, Ts), + beam_types:is_boolean_type(LType) andalso + beam_types:is_boolean_type(RType). all_same([{H,_}|T]) -> all(fun({E,_}) -> E =:= H end, T). @@ -626,21 +1198,7 @@ eval_bif(#b_set{op={bif,Bif},args=Args}=I, Ts) -> true -> case make_literal_list(Args) of none -> - case get_types(Args, Ts) of - [any] -> - I; - [Type] -> - case will_succeed(Bif, Type) of - yes -> - #b_literal{val=true}; - no -> - #b_literal{val=false}; - maybe -> - I - end; - _ -> - I - end; + eval_type_test_bif(I, Bif, raw_types(Args, Ts)); LitArgs -> try apply(erlang, Bif, LitArgs) of Val -> #b_literal{val=Val} @@ -651,24 +1209,101 @@ eval_bif(#b_set{op={bif,Bif},args=Args}=I, Ts) -> end end. -simplify_args(Args, Sub, Ts) -> - [simplify_arg(Arg, Sub, Ts) || Arg <- Args]. +eval_type_test_bif(I, is_atom, [Type]) -> + eval_type_test_bif_1(I, Type, #t_atom{}); +eval_type_test_bif(I, is_binary, [Type]) -> + eval_type_test_bif_1(I, Type, #t_bs_matchable{tail_unit=8}); +eval_type_test_bif(I, is_bitstring, [Type]) -> + eval_type_test_bif_1(I, Type, #t_bs_matchable{}); +eval_type_test_bif(I, is_boolean, [Type]) -> + case beam_types:is_boolean_type(Type) of + true -> + #b_literal{val=true}; + false -> + case beam_types:meet(Type, #t_atom{}) of + #t_atom{elements=[_|_]=Es} -> + case any(fun is_boolean/1, Es) of + true -> I; + false -> #b_literal{val=false} + end; + #t_atom{} -> + I; + none -> + #b_literal{val=false} + end + end; +eval_type_test_bif(I, is_float, [Type]) -> + eval_type_test_bif_1(I, Type, #t_float{}); +eval_type_test_bif(I, is_function, [Type]) -> + eval_type_test_bif_1(I, Type, #t_fun{}); +eval_type_test_bif(I, is_integer, [Type]) -> + eval_type_test_bif_1(I, Type, #t_integer{}); +eval_type_test_bif(I, is_list, [Type]) -> + eval_type_test_bif_1(I, Type, #t_list{}); +eval_type_test_bif(I, is_map, [Type]) -> + eval_type_test_bif_1(I, Type, #t_map{}); +eval_type_test_bif(I, is_number, [Type]) -> + eval_type_test_bif_1(I, Type, number); +eval_type_test_bif(I, is_tuple, [Type]) -> + eval_type_test_bif_1(I, Type, #t_tuple{}); +eval_type_test_bif(I, Op, Types) -> + case Types of + [#t_integer{},#t_integer{elements={0,0}}] + when Op =:= '+'; Op =:= '-'; Op =:= 'bor'; Op =:= 'bxor' -> + #b_set{args=[Result,_]} = I, + Result; + [#t_integer{},#t_integer{elements={0,0}}] when Op =:= '*'; Op =:= 'band' -> + #b_literal{val=0}; + [#t_integer{},#t_integer{elements={1,1}}] when Op =:= '*'; Op =:= 'div' -> + #b_set{args=[Result,_]} = I, + Result; + [#t_integer{elements={LMin,LMax}},#t_integer{elements={RMin,RMax}}] -> + case is_inequality_op(Op) of + true -> + case {erlang:Op(LMin, RMin),erlang:Op(LMax, RMin), + erlang:Op(LMin, RMax),erlang:Op(LMax, RMax)} of + {Bool,Bool,Bool,Bool} -> + #b_literal{val=Bool}; + _ -> + I + end; + false -> + I + end; + _ -> + I + end. + +is_inequality_op('<') -> true; +is_inequality_op('=<') -> true; +is_inequality_op('>') -> true; +is_inequality_op('>=') -> true; +is_inequality_op(_) -> false. + +eval_type_test_bif_1(I, ArgType, Required) -> + case beam_types:meet(ArgType, Required) of + ArgType -> #b_literal{val=true}; + none -> #b_literal{val=false}; + _ -> I + end. + +simplify_args(Args, Ts, Sub) -> + [simplify_arg(Arg, Ts, Sub) || Arg <- Args]. -simplify_arg(#b_var{}=Arg0, Sub, Ts) -> +simplify_arg(#b_var{}=Arg0, Ts, Sub) -> case sub_arg(Arg0, Sub) of #b_literal{}=LitArg -> LitArg; #b_var{}=Arg -> - Type = get_type(Arg, Ts), - case get_literal_from_type(Type) of - none -> Arg; - #b_literal{}=Lit -> Lit + case beam_types:get_singleton_value(raw_type(Arg, Ts)) of + {ok, Val} -> #b_literal{val=Val}; + error -> Arg end end; -simplify_arg(#b_remote{mod=Mod,name=Name}=Rem, Sub, Ts) -> - Rem#b_remote{mod=simplify_arg(Mod, Sub, Ts), - name=simplify_arg(Name, Sub, Ts)}; -simplify_arg(Arg, _Sub, _Ts) -> Arg. +simplify_arg(#b_remote{mod=Mod,name=Name}=Rem, Ts, Sub) -> + Rem#b_remote{mod=simplify_arg(Mod, Ts, Sub), + name=simplify_arg(Name, Ts, Sub)}; +simplify_arg(Arg, _Ts, _Sub) -> Arg. sub_arg(#b_var{}=Old, Sub) -> case Sub of @@ -676,13 +1311,13 @@ sub_arg(#b_var{}=Old, Sub) -> #{} -> Old end. -is_float_op('-', [float]) -> +is_float_op('-', [#t_float{}]) -> true; is_float_op('/', [_,_]) -> true; -is_float_op(Op, [float,_Other]) -> +is_float_op(Op, [#t_float{},_Other]) -> is_float_op_1(Op); -is_float_op(Op, [_Other,float]) -> +is_float_op(Op, [_Other,#t_float{}]) -> is_float_op_1(Op); is_float_op(_, _) -> false. @@ -691,486 +1326,365 @@ is_float_op_1('-') -> true; is_float_op_1('*') -> true; is_float_op_1(_) -> false. -anno_float_arg(float) -> float; +anno_float_arg(#t_float{}) -> float; anno_float_arg(_) -> convert. -opt_terminator(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) -> - beam_ssa:normalize(Br); -opt_terminator(#b_br{bool=#b_var{}}=Br, Ts, Ds) -> - simplify_not(Br, Ts, Ds); -opt_terminator(#b_switch{arg=#b_literal{}}=Sw, _Ts, _Ds) -> - beam_ssa:normalize(Sw); -opt_terminator(#b_switch{arg=#b_var{}=V}=Sw, Ts, Ds) -> - case get_type(V, Ts) of - any -> - beam_ssa:normalize(Sw); - Type -> - beam_ssa:normalize(opt_switch(Sw, Type, Ts, Ds)) - end; -opt_terminator(#b_ret{}=Ret, _Ts, _Ds) -> Ret. - - -opt_switch(#b_switch{fail=Fail,list=List0}=Sw0, Type, Ts, Ds) -> - List = prune_switch_list(List0, Fail, Type, Ts), - Sw1 = Sw0#b_switch{list=List}, - case Type of - #t_integer{elements={_,_}=Range} -> - simplify_switch_int(Sw1, Range); - #t_atom{elements=[_|_]} -> - case t_is_boolean(Type) of - true -> - #b_br{} = Br = simplify_switch_bool(Sw1, Ts, Ds), - opt_terminator(Br, Ts, Ds); - false -> - simplify_switch_atom(Type, Sw1) - end; - _ -> - Sw1 - end. +%%% +%%% Type helpers +%%% -prune_switch_list([{_,Fail}|T], Fail, Type, Ts) -> - prune_switch_list(T, Fail, Type, Ts); -prune_switch_list([{Arg,_}=Pair|T], Fail, Type, Ts) -> - case meet(get_type(Arg, Ts), Type) of - none -> - %% Different types. This value can never match. - prune_switch_list(T, Fail, Type, Ts); - _ -> - [Pair|prune_switch_list(T, Fail, Type, Ts)] - end; -prune_switch_list([], _, _, _) -> []. +%% Returns the narrowest possible return type for the given success types and +%% arguments. +return_type(SuccTypes0, CallArgs0) -> + SuccTypes = st_filter_reachable(SuccTypes0, CallArgs0, [], []), + st_join_return_types(SuccTypes, none). -update_successors(#b_br{bool=#b_literal{val=true},succ=S}, Ts, D) -> - update_successor(S, Ts, D); -update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}, Ts0, D0) -> - case cerl_sets:is_element(Bool, D0#d.once) of +st_filter_reachable([{SuccArgs, {call_self, SelfArgs}}=SuccType | Rest], + CallArgs0, Deferred, Acc) -> + case st_is_reachable(SuccArgs, CallArgs0) of true -> - %% This variable is defined in this block and is only - %% referenced by this br terminator. Therefore, there is - %% no need to include it in the type database passed on to - %% the successors of this block. - Ts = maps:remove(Bool, Ts0), - {SuccTs,FailTs} = infer_types_br(Bool, Ts, D0), - D = update_successor(Fail, FailTs, D0), - update_successor(Succ, SuccTs, D); + %% If we return a call to ourselves, we need to join our current + %% argument types with that of the call to ensure all possible + %% return paths are covered. + CallArgs = parallel_join(SelfArgs, CallArgs0), + st_filter_reachable(Rest, CallArgs, Deferred, Acc); false -> - {SuccTs,FailTs} = infer_types_br(Bool, Ts0, D0), - D = update_successor_bool(Bool, false, Fail, FailTs, D0), - update_successor_bool(Bool, true, Succ, SuccTs, D) + %% This may be reachable after we've joined another self-call, so + %% we defer it until we've gone through all other self-calls. + st_filter_reachable(Rest, CallArgs0, [SuccType | Deferred], Acc) end; -update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts, D0) -> - case cerl_sets:is_element(V, D0#d.once) of +st_filter_reachable([SuccType | Rest], CallArgs, Deferred, Acc) -> + st_filter_reachable(Rest, CallArgs, Deferred, [SuccType | Acc]); +st_filter_reachable([], CallArgs, Deferred, Acc) -> + case st_any_reachable(Deferred, CallArgs) of true -> - %% This variable is defined in this block and is only - %% referenced by this switch terminator. Therefore, there is - %% no need to include it in the type database passed on to - %% the successors of this block. - D = update_successor(Fail, Ts, D0), - F = fun({Val,S}, A) -> - SuccTs0 = infer_types_switch(V, Val, Ts, D), - SuccTs = maps:remove(V, SuccTs0), - update_successor(S, SuccTs, A) - end, - foldl(F, D, List); + %% Handle all deferred self calls that may be reachable now that + %% we've expanded our argument types. + st_filter_reachable(Deferred, CallArgs, [], Acc); false -> - %% V can not be equal to any of the values in List at the fail - %% block. - FailTs = subtract_sw_list(V, List, Ts), - D = update_successor(Fail, FailTs, D0), - F = fun({Val,S}, A) -> - SuccTs = infer_types_switch(V, Val, Ts, D), - update_successor(S, SuccTs, A) - end, - foldl(F, D, List) - end; -update_successors(#b_ret{arg=Arg}, Ts, D) -> - FuncId = D#d.func_id, - case D#d.ds of - #{ Arg := #b_set{op=call,args=[FuncId | _]} } -> - %% Returning a call to ourselves doesn't affect our own return - %% type. - D; - #{} -> - RetType = join([get_type(Arg, Ts) | D#d.ret_type]), - D#d{ret_type=[RetType]} + %% We have no reachable self calls, so we know our argument types + %% can't expand any further. Filter out our reachable sites and + %% return. + [ST || {SuccArgs, _}=ST <- Acc, st_is_reachable(SuccArgs, CallArgs)] end. -subtract_sw_list(V, List, Ts) -> - Ts#{ V := sub_sw_list_1(get_type(V, Ts), List, Ts) }. +st_join_return_types([{_SuccArgs, SuccRet} | Rest], Acc0) -> + st_join_return_types(Rest, beam_types:join(SuccRet, Acc0)); +st_join_return_types([], Acc) -> + Acc. -sub_sw_list_1(Type, [{Val,_}|T], Ts) -> - ValType = get_type(Val, Ts), - sub_sw_list_1(subtract(Type, ValType), T, Ts); -sub_sw_list_1(Type, [], _Ts) -> - Type. +st_any_reachable([{SuccArgs, _} | SuccType], CallArgs) -> + case st_is_reachable(SuccArgs, CallArgs) of + true -> true; + false -> st_any_reachable(SuccType, CallArgs) + end; +st_any_reachable([], _CallArgs) -> + false. -update_successor_bool(#b_var{}=Var, BoolValue, S, Ts, D) -> - case t_is_boolean(get_type(Var, Ts)) of - true -> - update_successor(S, Ts#{Var:=t_atom(BoolValue)}, D); - false -> - %% The `br` terminator is preceeded by an instruction that - %% does not produce a boolean value, such a `new_try_tag`. - update_successor(S, Ts, D) - end. +st_is_reachable([A | SuccArgs], [B | CallArgs]) -> + case beam_types:meet(A, B) of + none -> false; + _Other -> st_is_reachable(SuccArgs, CallArgs) + end; +st_is_reachable([], []) -> + true. + +update_success_types(#b_ret{arg=Arg}, Ts, Ds, Meta, SuccTypes) -> + #metadata{ func_id=FuncId, + limit_return=Limited, + params=Params } = Meta, + + RetType = case Ds of + #{ Arg := #b_set{op=call,args=[FuncId | Args]} } -> + {call_self, argument_types(Args, Ts)}; + #{} -> + argument_type(Arg, Ts) + end, + ArgTypes = argument_types(Params, Ts), + + case Limited of + true -> ust_limited(SuccTypes, ArgTypes, RetType); + false -> ust_unlimited(SuccTypes, ArgTypes, RetType) + end; +update_success_types(_Last, _Ts, _Ds, _Meta, SuccTypes) -> + SuccTypes. + +%% See ?RETURN_LIMIT for details. +ust_limited(SuccTypes, CallArgs, {call_self, SelfArgs}) -> + NewArgs = parallel_join(CallArgs, SelfArgs), + ust_limited_1(SuccTypes, NewArgs, none); +ust_limited(SuccTypes, CallArgs, CallRet) -> + ust_limited_1(SuccTypes, CallArgs, CallRet). + +ust_limited_1([], ArgTypes, RetType) -> + [{ArgTypes, RetType}]; +ust_limited_1([{SuccArgs, SuccRet}], CallArgs, CallRet) -> + NewTypes = parallel_join(SuccArgs, CallArgs), + NewType = beam_types:join(SuccRet, CallRet), + [{NewTypes, NewType}]. + +%% Adds a new success type, collapsing it with entries that have the same +%% return type to keep the list short. +ust_unlimited(SuccTypes, _CallArgs, none) -> + %% 'none' is implied since functions can always fail. + SuccTypes; +ust_unlimited([{SuccArgs, Same} | SuccTypes], CallArgs, Same) -> + NewArgs = parallel_join(SuccArgs, CallArgs), + [{NewArgs, Same} | SuccTypes]; +ust_unlimited([SuccType | SuccTypes], CallArgs, CallRet) -> + [SuccType | ust_unlimited(SuccTypes, CallArgs, CallRet)]; +ust_unlimited([], CallArgs, CallRet) -> + [{CallArgs, CallRet}]. + +update_successors(#b_br{bool=#b_literal{val=true},succ=Succ}=Last, + Ts, _Ds, Ls, _UsedOnce) -> + {Last, update_successor(Succ, Ts, Ls)}; +update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}=Last0, + Ts, Ds, Ls0, UsedOnce) -> + IsTempVar = cerl_sets:is_element(Bool, UsedOnce), + case infer_types_br(Bool, Ts, IsTempVar, Ds) of + {#{}=SuccTs, #{}=FailTs} -> + Ls1 = update_successor(Succ, SuccTs, Ls0), + Ls = update_successor(Fail, FailTs, Ls1), + {Last0, Ls}; + {#{}=SuccTs, none} -> + Last = Last0#b_br{bool=#b_literal{val=true},fail=Succ}, + {Last, update_successor(Succ, SuccTs, Ls0)}; + {none, #{}=FailTs} -> + Last = Last0#b_br{bool=#b_literal{val=true},succ=Fail}, + {Last, update_successor(Fail, FailTs, Ls0)} + end; +update_successors(#b_switch{arg=#b_var{}=V,fail=Fail0,list=List0}=Last0, + Ts, Ds, Ls0, UsedOnce) -> + IsTempVar = cerl_sets:is_element(V, UsedOnce), + + {List1, FailTs, Ls1} = + update_switch(List0, V, raw_type(V, Ts), Ts, Ds, Ls0, IsTempVar, []), + + case FailTs of + none -> + %% The fail block is unreachable; swap it with one of the choices. + case List1 of + [{#b_literal{val=0},_}|_] -> + %% Swap with the last choice in order to keep the zero the + %% first choice. If the loader can substitute a jump table + %% instruction, then a shorter version of the jump table + %% instruction can be used if the first value is zero. + {List, [{_,Fail}]} = split(length(List1)-1, List1), + Last = Last0#b_switch{fail=Fail,list=List}, + {Last, Ls1}; + [{_,Fail}|List] -> + %% Swap with the first choice in the list. + Last = Last0#b_switch{fail=Fail,list=List}, + {Last, Ls1} + end; + #{} -> + Ls = update_successor(Fail0, FailTs, Ls1), + Last = Last0#b_switch{list=List1}, + {Last, Ls} + end; +update_successors(#b_ret{}=Last, _Ts, _Ds, Ls, _UsedOnce) -> + {Last, Ls}. -update_successor(?BADARG_BLOCK, _Ts, #d{}=D) -> - %% We KNOW that no variables are used in the ?BADARG_BLOCK, +update_switch([{Val, Lbl}=Sw | List], + V, FailType0, Ts, Ds, Ls0, IsTempVar, Acc) -> + FailType = beam_types:subtract(FailType0, raw_type(Val, Ts)), + case infer_types_switch(V, Val, Ts, IsTempVar, Ds) of + none -> + update_switch(List, V, FailType, Ts, Ds, Ls0, IsTempVar, Acc); + SwTs -> + Ls = update_successor(Lbl, SwTs, Ls0), + update_switch(List, V, FailType, Ts, Ds, Ls, IsTempVar, [Sw | Acc]) + end; +update_switch([], _V, none, _Ts, _Ds, Ls, _IsTempVar, Acc) -> + %% Fail label is unreachable. + {reverse(Acc), none, Ls}; +update_switch([], V, FailType, Ts, Ds, Ls, IsTempVar, Acc) -> + %% Fail label is reachable, see if we can narrow the type down further. + FailTs = case beam_types:get_singleton_value(FailType) of + {ok, Value} -> + %% This is the only possible value at the fail label, so + %% we can infer types as if we matched it directly. + Lit = #b_literal{val=Value}, + infer_types_switch(V, Lit, Ts, IsTempVar, Ds); + error when IsTempVar -> + ts_remove_var(V, Ts); + error -> + Ts#{ V := FailType } + end, + {reverse(Acc), FailTs, Ls}. + +update_successor(?EXCEPTION_BLOCK, _Ts, Ls) -> + %% We KNOW that no variables are used in the ?EXCEPTION_BLOCK, %% so there is no need to update the type information. That %% can be a huge timesaver for huge functions. - D; -update_successor(S, Ts0, #d{ls=Ls}=D) -> + Ls; +update_successor(S, Ts0, Ls) -> case Ls of - #{S:=Ts1} -> + #{ S := Ts1 } -> Ts = join_types(Ts0, Ts1), - D#d{ls=Ls#{S:=Ts}}; + Ls#{ S := Ts }; #{} -> - D#d{ls=Ls#{S=>Ts0}} + Ls#{ S => Ts0 } end. -update_types(#b_set{op=Op,dst=Dst,args=Args}, Ts, Ds) -> - T = type(Op, Args, Ts, Ds), +update_types(#b_set{op=Op,dst=Dst,anno=Anno,args=Args}, Ts, Ds) -> + T = type(Op, Args, Anno, Ts, Ds), Ts#{Dst=>T}. -type(phi, Args, Ts, _Ds) -> - Types = [get_type(A, Ts) || {A,_} <- Args], - join(Types); -type({bif,'band'}, Args, Ts, _Ds) -> - band_type(Args, Ts); -type({bif,Bif}, Args, Ts, _Ds) -> - case bif_type(Bif, Args) of - number -> - arith_op_type(Args, Ts); - Type -> - Type +type(phi, Args, _Anno, Ts, _Ds) -> + Types = [raw_type(A, Ts) || {A,_} <- Args], + beam_types:join(Types); +type({bif,Bif}, Args, _Anno, Ts, _Ds) -> + ArgTypes = normalized_types(Args, Ts), + {RetType, _, _} = beam_call_types:types(erlang, Bif, ArgTypes), + RetType; +type(bs_init, _Args, _Anno, _Ts, _Ds) -> + #t_bitstring{}; +type(bs_extract, [Ctx], _Anno, _Ts, Ds) -> + #b_set{op=bs_match,args=Args} = map_get(Ctx, Ds), + bs_match_type(Args); +type(bs_start_match, [_, Src], _Anno, Ts, _Ds) -> + case beam_types:meet(#t_bs_matchable{}, raw_type(Src, Ts)) of + none -> + none; + T -> + Unit = beam_types:get_bs_matchable_unit(T), + #t_bs_context{tail_unit=Unit} end; -type(bs_init, _Args, _Ts, _Ds) -> - {binary, 1}; -type(bs_extract, [Ctx], Ts, _Ds) -> - #t_bs_match{type=Type} = get_type(Ctx, Ts), - Type; -type(bs_match, Args, _Ts, _Ds) -> - #t_bs_match{type=bs_match_type(Args)}; -type(bs_get_tail, _Args, _Ts, _Ds) -> - {binary, 1}; +type(bs_match, [#b_literal{val=binary}, Ctx, _Flags, + #b_literal{val=all}, #b_literal{val=OpUnit}], + _Anno, Ts, _Ds) -> + + %% This is an explicit tail unit test which does not advance the match + %% position. + CtxType = raw_type(Ctx, Ts), + OpType = #t_bs_context{tail_unit=OpUnit}, + + beam_types:meet(CtxType, OpType); +type(bs_match, Args, _Anno, Ts, _Ds) -> + [_, Ctx | _] = Args, + + %% Matches advance the current position without testing the tail unit. We + %% try to retain unit information by taking the GCD of our current unit and + %% the increments we know the match will advance by. + #t_bs_context{tail_unit=CtxUnit} = raw_type(Ctx, Ts), + OpUnit = bs_match_stride(Args, Ts), + + #t_bs_context{tail_unit=gcd(OpUnit, CtxUnit)}; +type(bs_get_tail, [Ctx], _Anno, Ts, _Ds) -> + #t_bs_context{tail_unit=Unit} = raw_type(Ctx, Ts), + #t_bitstring{size_unit=Unit}; type(call, [#b_remote{mod=#b_literal{val=Mod}, - name=#b_literal{val=Name}}|Args], Ts, _Ds) -> - case {Mod,Name,Args} of - {erlang,setelement,[Pos,Tuple,Arg]} -> - case {get_type(Pos, Ts),get_type(Tuple, Ts)} of - {#t_integer{elements={Index,Index}}, - #t_tuple{elements=Es0,size=Size}=T} -> - %% This is an exact index, update the type of said element - %% or return 'none' if it's known to be out of bounds. - Es = set_element_type(Index, get_type(Arg, Ts), Es0), - case T#t_tuple.exact of - false -> - T#t_tuple{size=max(Index, Size),elements=Es}; - true when Index =< Size -> - T#t_tuple{elements=Es}; - true -> - none - end; - {#t_integer{elements={Min,_}}=IntType, - #t_tuple{elements=Es0,size=Size}=T} -> - %% Remove type information for all indices that - %% falls into the range of the integer. - Es = remove_element_info(IntType, Es0), - case T#t_tuple.exact of - false -> - T#t_tuple{elements=Es,size=max(Min, Size)}; - true when Min =< Size -> - T#t_tuple{elements=Es,size=Size}; - true -> - none - end; - {_,#t_tuple{}=T} -> - %% Position unknown, so we have to discard all element - %% information. - T#t_tuple{elements=#{}}; - {#t_integer{elements={Min,_Max}},_} -> - #t_tuple{size=Min}; - {_,_} -> - #t_tuple{} - end; - {erlang,'++',[LHS,RHS]} -> - LType = get_type(LHS, Ts), - RType = get_type(RHS, Ts), - case LType =:= cons orelse RType =:= cons of - true -> - cons; - false -> - %% `[] ++ RHS` yields RHS, even if RHS is not a list. - join(list, RType) - end; - {erlang,'--',[_,_]} -> - list; - {lists,F,Args} -> - Types = get_types(Args, Ts), - lists_function_type(F, Types); - {math,_,_} -> - case is_math_bif(Name, length(Args)) of - false -> any; - true -> float - end; - {_,_,_} -> - case erl_bifs:is_exit_bif(Mod, Name, length(Args)) of - true -> none; - false -> any - end + name=#b_literal{val=Name}}|Args], _Anno, Ts, _Ds) -> + ArgTypes = normalized_types(Args, Ts), + {RetType, _, _} = beam_call_types:types(Mod, Name, ArgTypes), + RetType; +type(call, [#b_remote{} | _Args], _Anno, _Ts, _Ds) -> + %% Remote call with variable Module and/or Function. + any; +type(call, [#b_local{} | _Args], Anno, _Ts, _Ds) -> + case Anno of + #{ result_type := Type } -> Type; + #{} -> any end; -type(get_tuple_element, [Tuple, Offset], Ts, _Ds) -> - #t_tuple{size=Size,elements=Es} = get_type(Tuple, Ts), +type(call, [#b_var{} | _Args], Anno, _Ts, _Ds) -> + case Anno of + #{ result_type := Type } -> Type; + #{} -> any + end; +type(call, [#b_literal{} | _Args], _Anno, _Ts, _Ds) -> + none; +type(get_hd, [Src], _Anno, Ts, _Ds) -> + SrcType = #t_cons{} = normalized_type(Src, Ts), %Assertion. + {RetType, _, _} = beam_call_types:types(erlang, hd, [SrcType]), + RetType; +type(get_tl, [Src], _Anno, Ts, _Ds) -> + SrcType = #t_cons{} = normalized_type(Src, Ts), %Assertion. + {RetType, _, _} = beam_call_types:types(erlang, tl, [SrcType]), + RetType; +type(get_map_element, [_, _]=Args0, _Anno, Ts, _Ds) -> + [#t_map{}=Map, Key] = normalized_types(Args0, Ts), %Assertion. + {RetType, _, _} = beam_call_types:types(erlang, map_get, [Key, Map]), + RetType; +type(get_tuple_element, [Tuple, Offset], _Anno, Ts, _Ds) -> + #t_tuple{size=Size,elements=Es} = normalized_type(Tuple, Ts), #b_literal{val=N} = Offset, true = Size > N, %Assertion. - get_element_type(N + 1, Es); -type(is_nonempty_list, [_], _Ts, _Ds) -> - t_boolean(); -type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Ts, _Ds) -> - t_boolean(); -type(put_map, _Args, _Ts, _Ds) -> - map; -type(put_list, _Args, _Ts, _Ds) -> - cons; -type(put_tuple, Args, Ts, _Ds) -> + beam_types:get_tuple_element(N + 1, Es); +type(has_map_field, [_, _]=Args0, _Anno, Ts, _Ds) -> + [#t_map{}=Map, Key] = normalized_types(Args0, Ts), %Assertion. + {RetType, _, _} = beam_call_types:types(erlang, is_map_key, [Key, Map]), + RetType; +type(is_nonempty_list, [_], _Anno, _Ts, _Ds) -> + beam_types:make_boolean(); +type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Anno, _Ts, _Ds) -> + beam_types:make_boolean(); +type(make_fun, [#b_local{arity=TotalArity} | Env], Anno, _Ts, _Ds) -> + RetType = case Anno of + #{ result_type := Type } -> Type; + #{} -> any + end, + #t_fun{arity=TotalArity - length(Env), type=RetType}; +type(put_map, [_Kind, Map | Ss], _Anno, Ts, _Ds) -> + put_map_type(Map, Ss, Ts); +type(put_list, [Head, Tail], _Anno, Ts, _Ds) -> + HeadType = raw_type(Head, Ts), + TailType = raw_type(Tail, Ts), + beam_types:make_cons(HeadType, TailType); +type(put_tuple, Args, _Anno, Ts, _Ds) -> {Es, _} = foldl(fun(Arg, {Es0, Index}) -> - Type = get_type(Arg, Ts), - Es = set_element_type(Index, Type, Es0), - {Es, Index + 1} + Type = raw_type(Arg, Ts), + Es = beam_types:set_tuple_element(Index, Type, Es0), + {Es, Index + 1} end, {#{}, 1}, Args), #t_tuple{exact=true,size=length(Args),elements=Es}; -type(succeeded, [#b_var{}=Src], Ts, Ds) -> - case maps:get(Src, Ds) of - #b_set{op={bif,Bif},args=BifArgs} -> - Types = get_types(BifArgs, Ts), - case {Bif,Types} of - {BoolOp,[T1,T2]} when BoolOp =:= 'and'; BoolOp =:= 'or' -> - case t_is_boolean(T1) andalso t_is_boolean(T2) of - true -> t_atom(true); - false -> t_boolean() - end; - {byte_size,[{binary,_}]} -> - t_atom(true); - {bit_size,[{binary,_}]} -> - t_atom(true); - {map_size,[map]} -> - t_atom(true); - {'not',[Type]} -> - case t_is_boolean(Type) of - true -> t_atom(true); - false -> t_boolean() - end; - {size,[{binary,_}]} -> - t_atom(true); - {tuple_size,[#t_tuple{}]} -> - t_atom(true); - {_,_} -> - t_boolean() - end; - #b_set{op=get_hd} -> - t_atom(true); - #b_set{op=get_tl} -> - t_atom(true); - #b_set{op=get_tuple_element} -> - t_atom(true); - #b_set{op=wait} -> - t_atom(false); - #b_set{} -> - t_boolean() - end; -type(succeeded, [#b_literal{}], _Ts, _Ds) -> - t_atom(true); -type(_, _, _, _) -> any. - -arith_op_type(Args, Ts) -> - Types = get_types(Args, Ts), - foldl(fun(#t_integer{}, unknown) -> t_integer(); - (#t_integer{}, number) -> number; - (#t_integer{}, float) -> float; - (#t_integer{}, #t_integer{}) -> t_integer(); - (float, unknown) -> float; - (float, #t_integer{}) -> float; - (float, number) -> float; - (number, unknown) -> number; - (number, #t_integer{}) -> number; - (number, float) -> float; - (any, _) -> number; - (Same, Same) -> Same; - (_, _) -> none - end, unknown, Types). - -lists_function_type(F, Types) -> - case {F,Types} of - %% Functions that return booleans. - {all,[_,_]} -> - t_boolean(); - {any,[_,_]} -> - t_boolean(); - {keymember,[_,_,_]} -> - t_boolean(); - {member,[_,_]} -> - t_boolean(); - {prefix,[_,_]} -> - t_boolean(); - {suffix,[_,_]} -> - t_boolean(); - - %% Functions that return lists. - {dropwhile,[_,_]} -> - list; - {duplicate,[_,_]} -> - list; - {filter,[_,_]} -> - list; - {flatten,[_]} -> - list; - {map,[_Fun,List]} -> - same_length_type(List); - {MapFold,[_Fun,_Acc,List]} when MapFold =:= mapfoldl; - MapFold =:= mapfoldr -> - #t_tuple{size=2,exact=true, - elements=#{1=>same_length_type(List)}}; - {partition,[_,_]} -> - t_two_tuple(list, list); - {reverse,[List]} -> - same_length_type(List); - {sort,[List]} -> - same_length_type(List); - {splitwith,[_,_]} -> - t_two_tuple(list, list); - {takewhile,[_,_]} -> - list; - {unzip,[List]} -> - ListType = same_length_type(List), - t_two_tuple(ListType, ListType); - {usort,[List]} -> - same_length_type(List); - {zip,[_,_]} -> - list; - {zipwith,[_,_,_]} -> - list; - {_,_} -> - any - end. +type(_, _, _, _, _) -> any. -%% For a lists function that return a list of the same -%% length as the input list, return the type of the list. -same_length_type(cons) -> cons; -same_length_type(nil) -> nil; -same_length_type(_) -> list. +put_map_type(Map, Ss, Ts) -> + pmt_1(Ss, Ts, normalized_type(Map, Ts)). -t_two_tuple(Type1, Type2) -> - #t_tuple{size=2,exact=true, - elements=#{1=>Type1,2=>Type2}}. - -%% will_succeed(TestOperation, Type) -> yes|no|maybe. -%% Test whether TestOperation applied to an argument of type Type -%% will succeed. Return yes, no, or maybe. -%% -%% Type is a type as described in the comment for verified_type/1 at -%% the very end of this file, but it will *never* be 'any'. - -will_succeed(is_atom, Type) -> - case Type of - #t_atom{} -> yes; - _ -> no - end; -will_succeed(is_binary, Type) -> - case Type of - {binary,U} when U rem 8 =:= 0 -> yes; - {binary,_} -> maybe; - _ -> no - end; -will_succeed(is_bitstring, Type) -> - case Type of - {binary,_} -> yes; - _ -> no - end; -will_succeed(is_boolean, Type) -> - case Type of - #t_atom{elements=any} -> - maybe; - #t_atom{elements=Es} -> - case t_is_boolean(Type) of - true -> - yes; - false -> - case any(fun is_boolean/1, Es) of - true -> maybe; - false -> no - end - end; - _ -> - no - end; -will_succeed(is_float, Type) -> - case Type of - float -> yes; - number -> maybe; - _ -> no - end; -will_succeed(is_integer, Type) -> - case Type of - #t_integer{} -> yes; - number -> maybe; - _ -> no - end; -will_succeed(is_list, Type) -> - case Type of - list -> yes; - cons -> yes; - _ -> no - end; -will_succeed(is_map, Type) -> - case Type of - map -> yes; - _ -> no - end; -will_succeed(is_number, Type) -> - case Type of - float -> yes; - #t_integer{} -> yes; - number -> yes; - _ -> no - end; -will_succeed(is_tuple, Type) -> - case Type of - #t_tuple{} -> yes; - _ -> no - end; -will_succeed(_, _) -> maybe. - - -band_type([Other,#b_literal{val=Int}], Ts) when is_integer(Int) -> - band_type_1(Int, Other, Ts); -band_type([_,_], _) -> t_integer(). +pmt_1([Key0, Value0 | Ss], Ts, Acc0) -> + Key = normalized_type(Key0, Ts), + Value = normalized_type(Value0, Ts), + {Acc, _, _} = beam_call_types:types(maps, put, [Key, Value, Acc0]), + pmt_1(Ss, Ts, Acc); +pmt_1([], _Ts, Acc) -> + Acc. -band_type_1(Int, OtherSrc, Ts) -> - Type = band_type_2(Int, 0), - OtherType = get_type(OtherSrc, Ts), - meet(Type, OtherType). +%% We seldom know how far a match operation may advance, but we can often tell +%% which increment it will advance by. +bs_match_stride([#b_literal{val=Type} | Args], Ts) -> + bs_match_stride(Type, Args, Ts). -band_type_2(N, Bits) when Bits < 64 -> - case 1 bsl Bits of - P when P =:= N + 1 -> - t_integer(0, N); - P when P > N + 1 -> - t_integer(); +bs_match_stride(_, [_,_,Size,#b_literal{val=Unit}], Ts) -> + case raw_type(Size, Ts) of + #t_integer{elements={Sz, Sz}} when is_integer(Sz) -> + Sz * Unit; _ -> - band_type_2(N, Bits+1) + Unit end; -band_type_2(_, _) -> - %% Negative or large positive number. Give up. - t_integer(). +bs_match_stride(string, [_,#b_literal{val=String}], _) -> + bit_size(String); +bs_match_stride(utf8, _, _) -> + 8; +bs_match_stride(utf16, _, _) -> + 16; +bs_match_stride(utf32, _, _) -> + 32; +bs_match_stride(_, _, _) -> + 1. + +-define(UNICODE_MAX, (16#10FFFF)). bs_match_type([#b_literal{val=Type}|Args]) -> bs_match_type(Type, Args). bs_match_type(binary, Args) -> [_,_,_,#b_literal{val=U}] = Args, - {binary,U}; + #t_bitstring{size_unit=U}; bs_match_type(float, _) -> - float; + #t_float{}; bs_match_type(integer, Args) -> case Args of [_, @@ -1180,194 +1694,48 @@ bs_match_type(integer, Args) -> NumBits = Size * Unit, case member(unsigned, Flags) of true -> - t_integer(0, (1 bsl NumBits)-1); + beam_types:make_integer(0, (1 bsl NumBits)-1); false -> %% Signed integer. Don't bother. - t_integer() + #t_integer{} end; [_|_] -> - t_integer() + #t_integer{} end; bs_match_type(skip, _) -> any; bs_match_type(string, _) -> any; bs_match_type(utf8, _) -> - ?UNICODE_INT; + beam_types:make_integer(0, ?UNICODE_MAX); bs_match_type(utf16, _) -> - ?UNICODE_INT; + beam_types:make_integer(0, ?UNICODE_MAX); bs_match_type(utf32, _) -> - ?UNICODE_INT. - -simplify_switch_atom(#t_atom{elements=Atoms}, #b_switch{list=List0}=Sw) -> - case sort([A || {#b_literal{val=A},_} <- List0]) of - Atoms -> - %% All possible atoms are included in the list. The - %% failure label will never be used. - [{_,Fail}|List] = List0, - Sw#b_switch{fail=Fail,list=List}; - _ -> - Sw - end. - -simplify_switch_int(#b_switch{list=List0}=Sw, {Min,Max}) -> - List1 = sort(List0), - Vs = [V || {#b_literal{val=V},_} <- List1], - case eq_ranges(Vs, Min, Max) of - true -> - {_,LastL} = last(List1), - List = droplast(List1), - Sw#b_switch{fail=LastL,list=List}; - false -> - Sw - end. - -eq_ranges([H], H, H) -> true; -eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max); -eq_ranges(_, _, _) -> false. - -simplify_is_record(I, #t_tuple{exact=Exact, - size=Size, - elements=Es}, - RecSize, RecTag, Ts) -> - TagType = maps:get(1, Es, any), - TagMatch = case get_literal_from_type(TagType) of - #b_literal{}=RecTag -> yes; - #b_literal{} -> no; - none -> - %% Is it at all possible for the tag to match? - case meet(get_type(RecTag, Ts), TagType) of - none -> no; - _ -> maybe - end - end, - if - Size =/= RecSize, Exact; Size > RecSize; TagMatch =:= no -> - #b_literal{val=false}; - Size =:= RecSize, Exact, TagMatch =:= yes -> - #b_literal{val=true}; - true -> - I - end; -simplify_is_record(I, any, _Size, _Tag, _Ts) -> - I; -simplify_is_record(_I, _Type, _Size, _Tag, _Ts) -> - #b_literal{val=false}. - -simplify_switch_bool(#b_switch{arg=B,fail=Fail,list=List0}, Ts, Ds) -> - FalseVal = #b_literal{val=false}, - TrueVal = #b_literal{val=true}, - List1 = List0 ++ [{FalseVal,Fail},{TrueVal,Fail}], - {_,FalseLbl} = keyfind(FalseVal, 1, List1), - {_,TrueLbl} = keyfind(TrueVal, 1, List1), - Br = beam_ssa:normalize(#b_br{bool=B,succ=TrueLbl,fail=FalseLbl}), - simplify_not(Br, Ts, Ds). - -simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) -> - case Ds of - #{V:=#b_set{op={bif,'not'},args=[Bool]}} -> - case t_is_boolean(get_type(Bool, Ts)) of - true -> - Br = Br0#b_br{bool=Bool,succ=Fail,fail=Succ}, - beam_ssa:normalize(Br); - false -> - Br0 - end; - #{} -> - Br0 - end; -simplify_not(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) -> Br. + beam_types:make_integer(0, ?UNICODE_MAX). -%%% -%%% Calculate the set of variables that are only used once in the -%%% terminator of the block that defines them. That will allow us to -%%% discard type information for variables that will never be -%%% referenced by the successor blocks, potentially improving -%%% compilation times. -%%% +normalized_types(Values, Ts) -> + [normalized_type(Val, Ts) || Val <- Values]. -used_once(Linear, Args) -> - Map0 = used_once_1(reverse(Linear), #{}), - Map = maps:without(Args, Map0), - cerl_sets:from_list(maps:keys(Map)). +normalized_type(V, Ts) -> + beam_types:normalize(raw_type(V, Ts)). -used_once_1([{L,#b_blk{is=Is,last=Last}}|Bs], Uses0) -> - Uses1 = used_once_last_uses(beam_ssa:used(Last), L, Uses0), - Uses = used_once_2(reverse(Is), L, Uses1), - used_once_1(Bs, Uses); -used_once_1([], Uses) -> Uses. +argument_types(Values, Ts) -> + [argument_type(Val, Ts) || Val <- Values]. -used_once_2([#b_set{dst=Dst}=I|Is], L, Uses0) -> - Uses = used_once_uses(beam_ssa:used(I), L, Uses0), - case Uses of - #{Dst:=[L]} -> - used_once_2(Is, L, Uses); - #{} -> - %% Used more than once or used once in - %% in another block. - used_once_2(Is, L, maps:remove(Dst, Uses)) - end; -used_once_2([], _, Uses) -> Uses. - -used_once_uses([V|Vs], L, Uses) -> - case Uses of - #{V:=more_than_once} -> - used_once_uses(Vs, L, Uses); - #{} -> - %% Already used or first use is not in - %% a terminator. - used_once_uses(Vs, L, Uses#{V=>more_than_once}) - end; -used_once_uses([], _, Uses) -> Uses. +-spec argument_type(beam_ssa:value(), type_db()) -> type(). -used_once_last_uses([V|Vs], L, Uses) -> - case Uses of - #{V:=[_]} -> - %% Second time this variable is used. - used_once_last_uses(Vs, L, Uses#{V:=more_than_once}); - #{V:=more_than_once} -> - %% Used at least twice before. - used_once_last_uses(Vs, L, Uses); - #{} -> - %% First time this variable is used. - used_once_last_uses(Vs, L, Uses#{V=>[L]}) - end; -used_once_last_uses([], _, Uses) -> Uses. +argument_type(V, Ts) -> + beam_types:limit_depth(raw_type(V, Ts)). +raw_types(Values, Ts) -> + [raw_type(Val, Ts) || Val <- Values]. -get_types(Values, Ts) -> - [get_type(Val, Ts) || Val <- Values]. --spec get_type(beam_ssa:value(), type_db()) -> type(). +-spec raw_type(beam_ssa:value(), type_db()) -> type(). -get_type(#b_var{}=V, Ts) -> - #{V:=T} = Ts, - T; -get_type(#b_literal{val=Val}, _Ts) -> - if - is_atom(Val) -> - t_atom(Val); - is_float(Val) -> - float; - is_integer(Val) -> - t_integer(Val); - is_list(Val), Val =/= [] -> - cons; - is_map(Val) -> - map; - Val =:= {} -> - #t_tuple{exact=true}; - is_tuple(Val) -> - {Es, _} = foldl(fun(E, {Es0, Index}) -> - Type = get_type(#b_literal{val=E}, #{}), - Es = set_element_type(Index, Type, Es0), - {Es, Index + 1} - end, {#{}, 1}, tuple_to_list(Val)), - #t_tuple{exact=true,size=tuple_size(Val),elements=Es}; - Val =:= [] -> - nil; - true -> - any - end. +raw_type(#b_literal{val=Value}, _Ts) -> + beam_types:make_type_from_value(Value); +raw_type(V, Ts) -> + map_get(V, Ts). %% infer_types(Var, Types, #d{}) -> {SuccTypes,FailTypes} %% Looking at the expression that defines the variable Var, infer @@ -1390,10 +1758,107 @@ get_type(#b_literal{val=Val}, _Ts) -> %% 'cons' would give 'nil' as the only possible type. The result of the %% subtraction for L will be added to FailTypes. -infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) -> +infer_types_br(#b_var{}=V, Ts, IsTempVar, Ds) -> #{V:=#b_set{op=Op,args=Args}} = Ds, - PosTypes0 = infer_type(Op, Args, Ds), - NegTypes0 = infer_type_negative(Op, Args, Ds), + + {PosTypes, NegTypes} = infer_type(Op, Args, Ts, Ds), + + SuccTs0 = meet_types(PosTypes, Ts), + FailTs0 = subtract_types(NegTypes, Ts), + + case IsTempVar of + true -> + %% The branch variable is defined in this block and is only + %% referenced by this terminator. Therefore, there is no need to + %% include it in the type database passed on to the successors of + %% of this block. + SuccTs = ts_remove_var(V, SuccTs0), + FailTs = ts_remove_var(V, FailTs0), + {SuccTs, FailTs}; + false -> + SuccTs = infer_br_value(V, true, SuccTs0), + FailTs = infer_br_value(V, false, FailTs0), + {SuccTs, FailTs} + end. + +infer_br_value(_V, _Bool, none) -> + none; +infer_br_value(V, Bool, NewTs) -> + #{ V := T } = NewTs, + case beam_types:is_boolean_type(T) of + true -> + NewTs#{ V := beam_types:make_atom(Bool) }; + false -> + %% V is a try/catch tag or similar, leave it alone. + NewTs + end. + +infer_types_switch(V, Lit, Ts0, IsTempVar, Ds) -> + {PosTypes, _} = infer_type({bif,'=:='}, [V, Lit], Ts0, Ds), + Ts = meet_types(PosTypes, Ts0), + case IsTempVar of + true -> ts_remove_var(V, Ts); + false -> Ts + end. + +ts_remove_var(_V, none) -> none; +ts_remove_var(V, Ts) -> maps:remove(V, Ts). + +infer_type(succeeded, [#b_var{}=Src], Ts, Ds) -> + #b_set{op=Op,args=Args} = maps:get(Src, Ds), + infer_success_type(Op, Args, Ts, Ds); + +%% Type tests are handled separately from other BIFs as we're inferring types +%% based on their result, so we know that subtraction is safe even if we're +%% not branching on 'succeeded'. +infer_type(is_tagged_tuple, [#b_var{}=Src,#b_literal{val=Size}, + #b_literal{}=Tag], _Ts, _Ds) -> + Es = beam_types:set_tuple_element(1, raw_type(Tag, #{}), #{}), + T = {Src,#t_tuple{exact=true,size=Size,elements=Es}}, + {[T], [T]}; +infer_type(is_nonempty_list, [#b_var{}=Src], _Ts, _Ds) -> + T = {Src,#t_cons{}}, + {[T], [T]}; +infer_type({bif,is_atom}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_atom{}}, + {[T], [T]}; +infer_type({bif,is_binary}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_bitstring{size_unit=8}}, + {[T], [T]}; +infer_type({bif,is_bitstring}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_bitstring{}}, + {[T], [T]}; +infer_type({bif,is_boolean}, [Arg], _Ts, _Ds) -> + T = {Arg, beam_types:make_boolean()}, + {[T], [T]}; +infer_type({bif,is_float}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_float{}}, + {[T], [T]}; +infer_type({bif,is_integer}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_integer{}}, + {[T], [T]}; +infer_type({bif,is_list}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_list{}}, + {[T], [T]}; +infer_type({bif,is_map}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_map{}}, + {[T], [T]}; +infer_type({bif,is_number}, [Arg], _Ts, _Ds) -> + T = {Arg, number}, + {[T], [T]}; +infer_type({bif,is_tuple}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_tuple{}}, + {[T], [T]}; +infer_type({bif,'=:='}, [#b_var{}=LHS,#b_var{}=RHS], Ts, _Ds) -> + %% As an example, assume that L1 is known to be 'list', and L2 is + %% known to be 'cons'. Then if 'L1 =:= L2' evaluates to 'true', it can + %% be inferred that L1 is 'cons' (the meet of 'cons' and 'list'). + LType = raw_type(LHS, Ts), + RType = raw_type(RHS, Ts), + Type = beam_types:meet(LType, RType), + + PosTypes = [{V,Type} || {V, OrigType} <- [{LHS, LType}, {RHS, RType}], + OrigType =/= Type], %% We must be careful with types inferred from '=:='. %% @@ -1404,219 +1869,72 @@ infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) -> %% %% However, it is safe to subtract a type inferred from '=:=' if %% it is single-valued, e.g. if it is [] or the atom 'true'. + NegTypes = case beam_types:is_singleton_type(Type) of + true -> PosTypes; + false -> [] + end, - EqTypes = infer_eq_type(Op, Args, Ts, Ds), - NegTypes1 = [P || {_,T}=P <- EqTypes, is_singleton_type(T)], + {PosTypes, NegTypes}; +infer_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) -> + Def = maps:get(Src, Ds), + LitType = raw_type(Lit, Ts), + PosTypes = [{Src, LitType} | infer_eq_lit(Def, LitType)], - PosTypes = EqTypes ++ PosTypes0, - SuccTs = meet_types(PosTypes, Ts), + %% Subtraction is only safe if LitType is single-valued. + NegTypes = case beam_types:is_singleton_type(LitType) of + true -> PosTypes; + false -> [] + end, - NegTypes = NegTypes0 ++ NegTypes1, - FailTs = subtract_types(NegTypes, Ts), + {PosTypes, NegTypes}; +infer_type(_Op, _Args, _Ts, _Ds) -> + {[], []}. - {SuccTs,FailTs}. +infer_success_type({bif,Op}, Args, Ts, _Ds) -> + ArgTypes = normalized_types(Args, Ts), -infer_types_switch(V, Lit, Ts, #d{ds=Ds}) -> - Types = infer_eq_type({bif,'=:='}, [V, Lit], Ts, Ds), - meet_types(Types, Ts). + {_, PosTypes0, CanSubtract} = beam_call_types:types(erlang, Op, ArgTypes), + PosTypes = [T || {#b_var{},_}=T <- zip(Args, PosTypes0)], -infer_eq_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) -> - Def = maps:get(Src, Ds), - Type = get_type(Lit, Ts), - [{Src,Type} | infer_eq_lit(Def, Lit)]; -infer_eq_type({bif,'=:='}, [#b_var{}=Arg0,#b_var{}=Arg1], Ts, _Ds) -> - %% As an example, assume that L1 is known to be 'list', and L2 is - %% known to be 'cons'. Then if 'L1 =:= L2' evaluates to 'true', it can - %% be inferred that L1 is 'cons' (the meet of 'cons' and 'list'). - Type0 = get_type(Arg0, Ts), - Type1 = get_type(Arg1, Ts), - Type = meet(Type0, Type1), - [{V,MeetType} || - {V,OrigType,MeetType} <- - [{Arg0,Type0,Type},{Arg1,Type1,Type}], - OrigType =/= MeetType]; -infer_eq_type(_Op, _Args, _Ts, _Ds) -> - []. + case CanSubtract of + true -> {PosTypes, PosTypes}; + false -> {PosTypes, []} + end; +infer_success_type(call, [#b_var{}=Fun|Args], _Ts, _Ds) -> + T = {Fun, #t_fun{arity=length(Args)}}, + {[T], []}; +infer_success_type(bs_start_match, [_, #b_var{}=Src], _Ts, _Ds) -> + T = {Src,#t_bs_matchable{}}, + {[T], [T]}; +infer_success_type(bs_match, [#b_literal{val=binary}, + Ctx, _Flags, + #b_literal{val=all}, + #b_literal{val=OpUnit}], + _Ts, _Ds) -> + %% This is an explicit tail unit test which does not advance the match + %% position, so we know that Ctx has the same unit. + T = {Ctx, #t_bs_context{tail_unit=OpUnit}}, + {[T], [T]}; +infer_success_type(_Op, _Args, _Ts, _Ds) -> + {[], []}. infer_eq_lit(#b_set{op={bif,tuple_size},args=[#b_var{}=Tuple]}, - #b_literal{val=Size}) when is_integer(Size) -> + #t_integer{elements={Size,Size}}) -> [{Tuple,#t_tuple{exact=true,size=Size}}]; infer_eq_lit(#b_set{op=get_tuple_element, args=[#b_var{}=Tuple,#b_literal{val=N}]}, - #b_literal{}=Lit) -> + LitType) -> Index = N + 1, - Es = set_element_type(Index, get_type(Lit, #{}), #{}), - [{Tuple,#t_tuple{size=Index,elements=Es}}]; -infer_eq_lit(_, _) -> []. - -infer_type_negative(Op, Args, Ds) -> - case is_negative_inference_safe(Op, Args) of - true -> - infer_type(Op, Args, Ds); - false -> - [] - end. - -%% Conservative list of instructions for which negative -%% inference is safe. -is_negative_inference_safe(is_nonempty_list, _Args) -> true; -is_negative_inference_safe(_, _) -> false. - -infer_type({bif,element}, [#b_literal{val=Pos},#b_var{}=Tuple], _Ds) -> - if - is_integer(Pos), 1 =< Pos -> - [{Tuple,#t_tuple{size=Pos}}]; - true -> + case beam_types:set_tuple_element(Index, LitType, #{}) of + #{ Index := _ }=Es -> + [{Tuple,#t_tuple{size=Index,elements=Es}}]; + #{} -> + %% Index was above the element limit; subtraction is not safe. [] end; -infer_type({bif,element}, [#b_var{}=Position,#b_var{}=Tuple], _Ds) -> - [{Position,t_integer()},{Tuple,#t_tuple{}}]; -infer_type({bif,Bif}, [#b_var{}=Src]=Args, _Ds) -> - case inferred_bif_type(Bif, Args) of - any -> []; - T -> [{Src,T}] - end; -infer_type({bif,binary_part}, [#b_var{}=Src,_], _Ds) -> - [{Src,{binary,8}}]; -infer_type({bif,is_map_key}, [_,#b_var{}=Src], _Ds) -> - [{Src,map}]; -infer_type({bif,map_get}, [_,#b_var{}=Src], _Ds) -> - [{Src,map}]; -infer_type({bif,Bif}, [_,_]=Args, _Ds) -> - case inferred_bif_type(Bif, Args) of - any -> []; - T -> [{A,T} || #b_var{}=A <- Args] - end; -infer_type({bif,binary_part}, [#b_var{}=Src,Pos,Len], _Ds) -> - [{Src,{binary,8}}| - [{V,t_integer()} || #b_var{}=V <- [Pos,Len]]]; -infer_type(bs_start_match, [#b_var{}=Bin], _Ds) -> - [{Bin,{binary,1}}]; -infer_type(is_nonempty_list, [#b_var{}=Src], _Ds) -> - [{Src,cons}]; -infer_type(is_tagged_tuple, [#b_var{}=Src,#b_literal{val=Size}, - #b_literal{}=Tag], _Ds) -> - Es = set_element_type(1, get_type(Tag, #{}), #{}), - [{Src,#t_tuple{exact=true,size=Size,elements=Es}}]; -infer_type(succeeded, [#b_var{}=Src], Ds) -> - #b_set{op=Op,args=Args} = maps:get(Src, Ds), - infer_type(Op, Args, Ds); -infer_type(_Op, _Args, _Ds) -> +infer_eq_lit(_, _) -> []. -%% bif_type(Name, Args) -> Type -%% Return the return type for the guard BIF or operator Name with -%% arguments Args. -%% -%% Note that that the following BIFs are handle elsewhere: -%% -%% band/2 - -bif_type(abs, [_]) -> number; -bif_type(bit_size, [_]) -> t_integer(); -bif_type(byte_size, [_]) -> t_integer(); -bif_type(ceil, [_]) -> t_integer(); -bif_type(float, [_]) -> float; -bif_type(floor, [_]) -> t_integer(); -bif_type(is_map_key, [_,_]) -> t_boolean(); -bif_type(length, [_]) -> t_integer(); -bif_type(map_size, [_]) -> t_integer(); -bif_type(node, []) -> #t_atom{}; -bif_type(node, [_]) -> #t_atom{}; -bif_type(round, [_]) -> t_integer(); -bif_type(size, [_]) -> t_integer(); -bif_type(trunc, [_]) -> t_integer(); -bif_type(tuple_size, [_]) -> t_integer(); -bif_type('bnot', [_]) -> t_integer(); -bif_type('bor', [_,_]) -> t_integer(); -bif_type('bsl', [_,_]) -> t_integer(); -bif_type('bsr', [_,_]) -> t_integer(); -bif_type('bxor', [_,_]) -> t_integer(); -bif_type('div', [_,_]) -> t_integer(); -bif_type('rem', [_,_]) -> t_integer(); -bif_type('/', [_,_]) -> float; -bif_type(Name, Args) -> - Arity = length(Args), - case erl_internal:new_type_test(Name, Arity) orelse - erl_internal:bool_op(Name, Arity) orelse - erl_internal:comp_op(Name, Arity) of - true -> - t_boolean(); - false -> - case erl_internal:arith_op(Name, Arity) of - true -> number; - false -> any - end - end. - -inferred_bif_type(is_atom, [_]) -> t_atom(); -inferred_bif_type(is_binary, [_]) -> {binary,8}; -inferred_bif_type(is_bitstring, [_]) -> {binary,1}; -inferred_bif_type(is_boolean, [_]) -> t_boolean(); -inferred_bif_type(is_float, [_]) -> float; -inferred_bif_type(is_integer, [_]) -> t_integer(); -inferred_bif_type(is_list, [_]) -> list; -inferred_bif_type(is_map, [_]) -> map; -inferred_bif_type(is_number, [_]) -> number; -inferred_bif_type(is_tuple, [_]) -> #t_tuple{}; -inferred_bif_type(abs, [_]) -> number; -inferred_bif_type(bit_size, [_]) -> {binary,1}; -inferred_bif_type('bnot', [_]) -> t_integer(); -inferred_bif_type(byte_size, [_]) -> {binary,1}; -inferred_bif_type(ceil, [_]) -> number; -inferred_bif_type(float, [_]) -> number; -inferred_bif_type(floor, [_]) -> number; -inferred_bif_type(hd, [_]) -> cons; -inferred_bif_type(length, [_]) -> list; -inferred_bif_type(map_size, [_]) -> map; -inferred_bif_type('not', [_]) -> t_boolean(); -inferred_bif_type(round, [_]) -> number; -inferred_bif_type(trunc, [_]) -> number; -inferred_bif_type(tl, [_]) -> cons; -inferred_bif_type(tuple_size, [_]) -> #t_tuple{}; -inferred_bif_type('and', [_,_]) -> t_boolean(); -inferred_bif_type('or', [_,_]) -> t_boolean(); -inferred_bif_type('xor', [_,_]) -> t_boolean(); -inferred_bif_type('band', [_,_]) -> t_integer(); -inferred_bif_type('bor', [_,_]) -> t_integer(); -inferred_bif_type('bsl', [_,_]) -> t_integer(); -inferred_bif_type('bsr', [_,_]) -> t_integer(); -inferred_bif_type('bxor', [_,_]) -> t_integer(); -inferred_bif_type('div', [_,_]) -> t_integer(); -inferred_bif_type('rem', [_,_]) -> t_integer(); -inferred_bif_type('+', [_,_]) -> number; -inferred_bif_type('-', [_,_]) -> number; -inferred_bif_type('*', [_,_]) -> number; -inferred_bif_type('/', [_,_]) -> number; -inferred_bif_type(_, _) -> any. - -is_math_bif(cos, 1) -> true; -is_math_bif(cosh, 1) -> true; -is_math_bif(sin, 1) -> true; -is_math_bif(sinh, 1) -> true; -is_math_bif(tan, 1) -> true; -is_math_bif(tanh, 1) -> true; -is_math_bif(acos, 1) -> true; -is_math_bif(acosh, 1) -> true; -is_math_bif(asin, 1) -> true; -is_math_bif(asinh, 1) -> true; -is_math_bif(atan, 1) -> true; -is_math_bif(atanh, 1) -> true; -is_math_bif(erf, 1) -> true; -is_math_bif(erfc, 1) -> true; -is_math_bif(exp, 1) -> true; -is_math_bif(log, 1) -> true; -is_math_bif(log2, 1) -> true; -is_math_bif(log10, 1) -> true; -is_math_bif(sqrt, 1) -> true; -is_math_bif(atan2, 2) -> true; -is_math_bif(pow, 2) -> true; -is_math_bif(ceil, 1) -> true; -is_math_bif(floor, 1) -> true; -is_math_bif(fmod, 2) -> true; -is_math_bif(pi, 0) -> true; -is_math_bif(_, _) -> false. - join_types(Ts0, Ts1) -> if map_size(Ts0) < map_size(Ts1) -> @@ -1630,7 +1948,7 @@ join_types_1([V|Vs], Ts0, Ts1) -> {#{V:=Same},#{V:=Same}} -> join_types_1(Vs, Ts0, Ts1); {#{V:=T0},#{V:=T1}} -> - case join(T0, T1) of + case beam_types:join(T0, T1) of T1 -> join_types_1(Vs, Ts0, Ts1); T -> @@ -1642,326 +1960,175 @@ join_types_1([V|Vs], Ts0, Ts1) -> join_types_1([], Ts0, Ts1) -> maps:merge(Ts0, Ts1). -join([T1,T2|Ts]) -> - join([join(T1, T2)|Ts]); -join([T]) -> T. - -get_literal_from_type(#t_atom{elements=[Atom]}) -> - #b_literal{val=Atom}; -get_literal_from_type(#t_integer{elements={Int,Int}}) -> - #b_literal{val=Int}; -get_literal_from_type(nil) -> - #b_literal{val=[]}; -get_literal_from_type(_) -> none. - -remove_element_info(#t_integer{elements={Min,Max}}, Es) -> - foldl(fun(El, Acc) when Min =< El, El =< Max -> - maps:remove(El, Acc); - (_El, Acc) -> Acc - end, Es, maps:keys(Es)). - -t_atom() -> - #t_atom{elements=any}. - -t_atom(Atom) when is_atom(Atom) -> - #t_atom{elements=[Atom]}. - -t_boolean() -> - #t_atom{elements=[false,true]}. - -t_integer() -> - #t_integer{elements=any}. - -t_integer(Int) when is_integer(Int) -> - #t_integer{elements={Int,Int}}. - -t_integer(Min, Max) when is_integer(Min), is_integer(Max) -> - #t_integer{elements={Min,Max}}. - -t_is_boolean(#t_atom{elements=[F,T]}) -> - F =:= false andalso T =:= true; -t_is_boolean(#t_atom{elements=[B]}) -> - is_boolean(B); -t_is_boolean(_) -> false. - -t_tuple_size(#t_tuple{size=Size,exact=false}) -> - {at_least,Size}; -t_tuple_size(#t_tuple{size=Size,exact=true}) -> - {exact,Size}; -t_tuple_size(_) -> - none. - -is_singleton_type(Type) -> - get_literal_from_type(Type) =/= none. - -get_element_type(Index, Es) -> - case Es of - #{ Index := T } -> T; - #{} -> any - end. - -set_element_type(_Key, none, Es) -> - Es; -set_element_type(Key, any, Es) -> - maps:remove(Key, Es); -set_element_type(Key, Type, Es) -> - Es#{ Key => Type }. - -%% join(Type1, Type2) -> Type -%% Return the "join" of Type1 and Type2. The join is a more general -%% type than Type1 and Type2. For example: -%% -%% join(#t_integer{elements=any}, #t_integer=elements={0,3}}) -> -%% #t_integer{} -%% -%% The join for two different types result in 'any', which is -%% the top element for our type lattice: -%% -%% join(#t_integer{}, map) -> any - --spec join(type(), type()) -> type(). - -join(T, T) -> - verified_type(T); -join(none, T) -> - verified_type(T); -join(T, none) -> - verified_type(T); -join(any, _) -> any; -join(_, any) -> any; -join(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> - Set = ordsets:union(Set1, Set2), - case ordsets:size(Set) of - Size when Size =< ?ATOM_SET_SIZE -> - #t_atom{elements=Set}; - _Size -> - #t_atom{elements=any} - end; -join(#t_atom{elements=any}=T, #t_atom{elements=[_|_]}) -> T; -join(#t_atom{elements=[_|_]}, #t_atom{elements=any}=T) -> T; -join({binary,U1}, {binary,U2}) -> - {binary,gcd(U1, U2)}; -join(#t_integer{}, #t_integer{}) -> t_integer(); -join(list, cons) -> list; -join(cons, list) -> list; -join(nil, cons) -> list; -join(cons, nil) -> list; -join(nil, list) -> list; -join(list, nil) -> list; -join(#t_integer{}, float) -> number; -join(float, #t_integer{}) -> number; -join(#t_integer{}, number) -> number; -join(number, #t_integer{}) -> number; -join(float, number) -> number; -join(number, float) -> number; -join(#t_tuple{size=Sz,exact=ExactA,elements=EsA}, - #t_tuple{size=Sz,exact=ExactB,elements=EsB}) -> - Exact = ExactA and ExactB, - Es = join_tuple_elements(Sz, EsA, EsB), - #t_tuple{size=Sz,exact=Exact,elements=Es}; -join(#t_tuple{size=SzA,elements=EsA}, #t_tuple{size=SzB,elements=EsB}) -> - Sz = min(SzA, SzB), - Es = join_tuple_elements(Sz, EsA, EsB), - #t_tuple{size=Sz,elements=Es}; -join(_T1, _T2) -> - %%io:format("~p ~p\n", [_T1,_T2]), - any. - -join_tuple_elements(MinSize, EsA, EsB) -> - Es0 = join_elements(EsA, EsB), - maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0). - -join_elements(Es1, Es2) -> - Keys = if - map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); - map_size(Es1) > map_size(Es2) -> maps:keys(Es2) - end, - join_elements_1(Keys, Es1, Es2, #{}). - -join_elements_1([Key | Keys], Es1, Es2, Acc0) -> - case {Es1, Es2} of - {#{ Key := Type1 }, #{ Key := Type2 }} -> - Acc = set_element_type(Key, join(Type1, Type2), Acc0), - join_elements_1(Keys, Es1, Es2, Acc); - {#{}, #{}} -> - join_elements_1(Keys, Es1, Es2, Acc0) - end; -join_elements_1([], _Es1, _Es2, Acc) -> - Acc. - -gcd(A, B) -> - case A rem B of - 0 -> B; - X -> gcd(B, X) - end. - meet_types([{V,T0}|Vs], Ts) -> #{V:=T1} = Ts, - case meet(T0, T1) of + case beam_types:meet(T0, T1) of + none -> none; T1 -> meet_types(Vs, Ts); T -> meet_types(Vs, Ts#{V:=T}) end; meet_types([], Ts) -> Ts. -meet([T1,T2|Ts]) -> - meet([meet(T1, T2)|Ts]); -meet([T]) -> T. - subtract_types([{V,T0}|Vs], Ts) -> #{V:=T1} = Ts, - case subtract(T1, T0) of + case beam_types:subtract(T1, T0) of + none -> none; T1 -> subtract_types(Vs, Ts); T -> subtract_types(Vs, Ts#{V:=T}) end; subtract_types([], Ts) -> Ts. -%% subtract(Type1, Type2) -> Type. -%% Subtract Type2 from Type1. Example: -%% -%% subtract(list, cons) -> nil +parallel_join([A | As], [B | Bs]) -> + [beam_types:join(A, B) | parallel_join(As, Bs)]; +parallel_join([], []) -> + []. -subtract(#t_atom{elements=[_|_]=Set0}, #t_atom{elements=[_|_]=Set1}) -> - case ordsets:subtract(Set0, Set1) of - [] -> none; - [_|_]=Set -> #t_atom{elements=Set} - end; -subtract(number, float) -> #t_integer{}; -subtract(number, #t_integer{elements=any}) -> float; -subtract(list, cons) -> nil; -subtract(list, nil) -> cons; -subtract(T, _) -> T. - -%% meet(Type1, Type2) -> Type -%% Return the "meet" of Type1 and Type2. The meet is a narrower -%% type than Type1 and Type2. For example: -%% -%% meet(#t_integer{elements=any}, #t_integer{elements={0,3}}) -> -%% #t_integer{elements={0,3}} -%% -%% The meet for two different types result in 'none', which is -%% the bottom element for our type lattice: -%% -%% meet(#t_integer{}, map) -> none +gcd(A, B) -> + case A rem B of + 0 -> B; + X -> gcd(B, X) + end. + +%%% +%%% Helpers +%%% --spec meet(type(), type()) -> type(). +init_metadata(FuncId, Linear, Params) -> + {RetCounter, Map0} = init_metadata_1(reverse(Linear), 0, #{}), + Map = maps:without(Params, Map0), + UsedOnce = cerl_sets:from_list(maps:keys(Map)), + + #metadata{ func_id = FuncId, + limit_return = (RetCounter >= ?RETURN_LIMIT), + params = Params, + used_once = UsedOnce }. + +init_metadata_1([{L,#b_blk{is=Is,last=Last}} | Bs], RetCounter0, Uses0) -> + %% Track the number of return terminators in use. See ?RETURN_LIMIT for + %% details. + RetCounter = case Last of + #b_ret{} -> RetCounter0 + 1; + _ -> RetCounter0 + end, + + %% Calculate the set of variables that are only used once in the terminator + %% of the block that defines them. That will allow us to discard type + %% information discard type information for variables that will never be + %% referenced by the successor blocks, potentially improving compilation + %% times. -meet(T, T) -> - verified_type(T); -meet(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> - case ordsets:intersection(Set1, Set2) of - [] -> - none; - [_|_]=Set -> - #t_atom{elements=Set} + Uses1 = used_once_last_uses(beam_ssa:used(Last), L, Uses0), + Uses = used_once_2(reverse(Is), L, Uses1), + init_metadata_1(Bs, RetCounter, Uses); +init_metadata_1([], RetCounter, Uses) -> + {RetCounter, Uses}. + +used_once_2([#b_set{dst=Dst}=I|Is], L, Uses0) -> + Uses = used_once_uses(beam_ssa:used(I), L, Uses0), + case Uses of + #{Dst:=[L]} -> + used_once_2(Is, L, Uses); + #{} -> + %% Used more than once or used once in + %% in another block. + used_once_2(Is, L, maps:remove(Dst, Uses)) end; -meet(#t_atom{elements=[_|_]}=T, #t_atom{elements=any}) -> - T; -meet(#t_atom{elements=any}, #t_atom{elements=[_|_]}=T) -> - T; -meet(#t_integer{elements={_,_}}=T, #t_integer{elements=any}) -> - T; -meet(#t_integer{elements=any}, #t_integer{elements={_,_}}=T) -> - T; -meet(#t_integer{elements={Min1,Max1}}, - #t_integer{elements={Min2,Max2}}) -> - #t_integer{elements={max(Min1, Min2),min(Max1, Max2)}}; -meet(#t_integer{}=T, number) -> T; -meet(float=T, number) -> T; -meet(number, #t_integer{}=T) -> T; -meet(number, float=T) -> T; -meet(list, cons) -> cons; -meet(list, nil) -> nil; -meet(cons, list) -> cons; -meet(nil, list) -> nil; -meet(#t_tuple{}=T1, #t_tuple{}=T2) -> - meet_tuples(T1, T2); -meet({binary,U1}, {binary,U2}) -> - {binary,max(U1, U2)}; -meet(any, T) -> - verified_type(T); -meet(T, any) -> - verified_type(T); -meet(_, _) -> - %% Inconsistent types. There will be an exception at runtime. - none. - -meet_tuples(#t_tuple{size=Sz1,exact=true}, - #t_tuple{size=Sz2,exact=true}) when Sz1 =/= Sz2 -> - none; -meet_tuples(#t_tuple{size=Sz1,exact=Ex1,elements=Es1}, - #t_tuple{size=Sz2,exact=Ex2,elements=Es2}) -> - Size = max(Sz1, Sz2), - Exact = Ex1 or Ex2, - case meet_elements(Es1, Es2) of - none -> - none; - Es -> - #t_tuple{size=Size,exact=Exact,elements=Es} - end. +used_once_2([], _, Uses) -> Uses. -meet_elements(Es1, Es2) -> - Keys = maps:keys(Es1) ++ maps:keys(Es2), - meet_elements_1(Keys, Es1, Es2, #{}). +used_once_uses([V|Vs], L, Uses) -> + case Uses of + #{V:=more_than_once} -> + used_once_uses(Vs, L, Uses); + #{} -> + %% Already used or first use is not in + %% a terminator. + used_once_uses(Vs, L, Uses#{V=>more_than_once}) + end; +used_once_uses([], _, Uses) -> Uses. -meet_elements_1([Key | Keys], Es1, Es2, Acc) -> - case {Es1, Es2} of - {#{ Key := Type1 }, #{ Key := Type2 }} -> - case meet(Type1, Type2) of - none -> none; - Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) - end; - {#{ Key := Type1 }, _} -> - meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); - {_, #{ Key := Type2 }} -> - meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) +used_once_last_uses([V|Vs], L, Uses) -> + case Uses of + #{V:=[_]} -> + %% Second time this variable is used. + used_once_last_uses(Vs, L, Uses#{V:=more_than_once}); + #{V:=more_than_once} -> + %% Used at least twice before. + used_once_last_uses(Vs, L, Uses); + #{} -> + %% First time this variable is used. + used_once_last_uses(Vs, L, Uses#{V=>[L]}) end; -meet_elements_1([], _Es1, _Es2, Acc) -> - Acc. +used_once_last_uses([], _, Uses) -> Uses. -%% verified_type(Type) -> Type -%% Returns the passed in type if it is one of the defined types. -%% Crashes if there is anything wrong with the type. %% -%% Here are all possible types: +%% Ordered worklist used in signatures/2. %% -%% any Any Erlang term (top element for the type lattice). +%% This is equivalent to consing (wl_add) and appending (wl_defer_list) +%% to a regular list, but avoids uneccessary work by reordering elements. %% -%% #t_atom{} Any atom or some specific atoms. -%% {binary,Unit} Binary/bitstring aligned to unit Unit. -%% float Floating point number. -%% #t_integer{} Integer -%% list Empty or nonempty list. -%% map Map. -%% nil Empty list. -%% cons Cons (nonempty list). -%% number A number (float or integer). -%% #t_tuple{} Tuple. +%% We can do this since a function only needs to be visited *once* for all +%% prior updates to take effect, so if an element is added to the front, then +%% all earlier instances of the same element are redundant. %% -%% none No type (bottom element for the type lattice). - --spec verified_type(T) -> T when - T :: type(). - -verified_type(any=T) -> T; -verified_type(none=T) -> T; -verified_type(#t_atom{elements=any}=T) -> T; -verified_type(#t_atom{elements=[_|_]}=T) -> T; -verified_type({binary,U}=T) when is_integer(U) -> T; -verified_type(#t_integer{elements=any}=T) -> T; -verified_type(#t_integer{elements={Min,Max}}=T) - when is_integer(Min), is_integer(Max) -> T; -verified_type(list=T) -> T; -verified_type(map=T) -> T; -verified_type(nil=T) -> T; -verified_type(cons=T) -> T; -verified_type(number=T) -> T; -verified_type(#t_tuple{size=Size,elements=Es}=T) -> - %% All known elements must have a valid index and type. 'any' is prohibited - %% since it's implicit and should never be present in the map. - maps:fold(fun(Index, Element, _) when is_integer(Index), - 1 =< Index, Index =< Size, - Element =/= any, Element =/= none -> - verified_type(Element) - end, [], Es), - T; -verified_type(float=T) -> T. + +-record(worklist, + { counter = 0 :: integer(), + elements = gb_trees:empty() :: gb_trees:tree(integer(), term()), + indexes = #{} :: #{ term() => integer() } }). + +-type worklist() :: #worklist{}. + +wl_new() -> #worklist{}. + +%% Adds an element to the worklist, or moves it to the front if it's already +%% present. +wl_add(Element, #worklist{counter=Counter,elements=Es,indexes=Is}) -> + case Is of + #{ Element := Index } -> + wl_add_1(Element, Counter, gb_trees:delete(Index, Es), Is); + #{} -> + wl_add_1(Element, Counter, Es, Is) + end. + +wl_add_1(Element, Counter0, Es0, Is0) -> + Counter = Counter0 + 1, + Es = gb_trees:insert(Counter, Element, Es0), + Is = Is0#{ Element => Counter }, + #worklist{counter=Counter,elements=Es,indexes=Is}. + +%% All mutations bump the counter, so we can check for changes without a deep +%% comparison. +wl_changed(#worklist{counter=Same}, #worklist{counter=Same}) -> false; +wl_changed(#worklist{}, #worklist{}) -> true. + +%% Adds the given elements to the back of the worklist, skipping the elements +%% that are already present. This lets us append elements arbitrarly after the +%% current front without changing the work order. +wl_defer_list(Elements, #worklist{counter=Counter,elements=Es,indexes=Is}) -> + wl_defer_list_1(Elements, Counter, Es, Is). + +wl_defer_list_1([Element | Elements], Counter0, Es0, Is0) -> + case Is0 of + #{ Element := _ } -> + wl_defer_list_1(Elements, Counter0, Es0, Is0); + #{} -> + Counter = Counter0 + 1, + Es = gb_trees:insert(-Counter, Element, Es0), + Is = Is0#{ Element => -Counter }, + wl_defer_list_1(Elements, Counter, Es, Is) + end; +wl_defer_list_1([], Counter, Es, Is) -> + #worklist{counter=Counter,elements=Es,indexes=Is}. + +wl_next(#worklist{indexes=Is}) when Is =:= #{} -> + empty; +wl_next(#worklist{elements=Es,indexes=Is}) when Is =/= #{} -> + {_Key, Element} = gb_trees:largest(Es), + {ok, Element}. + +%% Removes the front of the worklist. +wl_pop(Element, #worklist{counter=Counter0,elements=Es0,indexes=Is0}=Wl) -> + Counter = Counter0 + 1, + {_Key, Element, Es} = gb_trees:take_largest(Es0), %Assertion. + Is = maps:remove(Element, Is0), + Wl#worklist{counter=Counter,elements=Es,indexes=Is}. diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index acf3838da4..ddf8e6f89c 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -208,6 +208,9 @@ remap([{block,Bl0}|Is], Map, Acc) -> remap([{bs_get_tail,Src,Dst,Live}|Is], Map, Acc) -> I = {bs_get_tail,Map(Src),Map(Dst),Live}, remap(Is, Map, [I|Acc]); +remap([{bs_start_match4,Fail,Live,Src,Dst}|Is], Map, Acc) -> + I = {bs_start_match4,Fail,Live,Map(Src),Map(Dst)}, + remap(Is, Map, [I|Acc]); remap([{bs_set_position,Src1,Src2}|Is], Map, Acc) -> I = {bs_set_position,Map(Src1),Map(Src2)}, remap(Is, Map, [I|Acc]); @@ -244,6 +247,9 @@ remap([{make_fun2,_,_,_,_}=I|T], Map, Acc) -> remap([{deallocate,N}|Is], Map, Acc) -> I = {deallocate,Map({frame_size,N})}, remap(Is, Map, [I|Acc]); +remap([{swap,Reg1,Reg2}|Is], Map, Acc) -> + I = {swap,Map(Reg1),Map(Reg2)}, + remap(Is, Map, [I|Acc]); remap([{test,Name,Fail,Ss}|Is], Map, Acc) -> I = {test,Name,Fail,[Map(S) || S <- Ss]}, remap(Is, Map, [I|Acc]); @@ -378,10 +384,17 @@ frame_size([{deallocate,N}|_], _) -> N; frame_size([{line,_}|Is], Safe) -> frame_size(Is, Safe); +frame_size([{bs_start_match4,Fail,_,_,_}|Is], Safe) -> + case Fail of + {f,L} -> frame_size_branch(L, Is, Safe); + _ -> frame_size(Is, Safe) + end; frame_size([{bs_set_position,_,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{bs_get_tail,_,_,_}|Is], Safe) -> frame_size(Is, Safe); +frame_size([{swap,_,_}|Is], Safe) -> + frame_size(Is, Safe); frame_size(_, _) -> throw(not_possible). frame_size_branch(0, Is, Safe) -> @@ -417,6 +430,9 @@ is_not_used(Y, [{bs_init,_,_,_,Ss,Dst}|Is]) -> is_not_used_ss_dst(Y, Ss, Dst, Is); is_not_used(Y, [{bs_put,{f,_},_,Ss}|Is]) -> not member(Y, Ss) andalso is_not_used(Y, Is); +is_not_used(Y, [{bs_start_match4,_Fail,_Live,Src,Dst}|Is]) -> + Y =/= Src andalso Y =/= Dst andalso + is_not_used(Y, Is); is_not_used(Y, [{bs_set_position,Src1,Src2}|Is]) -> Y =/= Src1 andalso Y =/= Src2 andalso is_not_used(Y, Is); @@ -444,6 +460,8 @@ is_not_used(Y, [{line,_}|Is]) -> is_not_used(Y, Is); is_not_used(Y, [{make_fun2,_,_,_,_}|Is]) -> is_not_used(Y, Is); +is_not_used(Y, [{swap,Reg1,Reg2}|Is]) -> + Y =/= Reg1 andalso Y =/= Reg2 andalso is_not_used(Y, Is); is_not_used(Y, [{test,_,_,Ss}|Is]) -> not member(Y, Ss) andalso is_not_used(Y, Is); is_not_used(Y, [{test,_Op,{f,_},_Live,Ss,Dst}|Is]) -> diff --git a/lib/compiler/src/beam_types.erl b/lib/compiler/src/beam_types.erl new file mode 100644 index 0000000000..5577fe79d8 --- /dev/null +++ b/lib/compiler/src/beam_types.erl @@ -0,0 +1,1127 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_types). + +-define(BEAM_TYPES_INTERNAL, true). +-include("beam_types.hrl"). + +-import(lists, [foldl/3, reverse/1]). + +-export([meet/1, meet/2, join/1, join/2, subtract/2]). + +-export([is_boolean_type/1, + get_bs_matchable_unit/1, + is_bs_matchable_type/1, + get_singleton_value/1, + is_singleton_type/1, + normalize/1]). + +-export([get_tuple_element/2, set_tuple_element/3]). + +-export([make_type_from_value/1]). + +-export([make_atom/1, + make_boolean/0, + make_cons/2, + make_float/1, + make_float/2, + make_integer/1, + make_integer/2]). + +-export([limit_depth/1]). + +%% This is exported to help catch errors in property test generators and is not +%% meant to be used outside of test suites. +-export([verified_type/1]). + +-define(IS_LIST_TYPE(N), + is_record(N, t_list) orelse + is_record(N, t_cons) orelse + N =:= nil). + +-define(IS_NUMBER_TYPE(N), + N =:= number orelse + is_record(N, t_float) orelse + is_record(N, t_integer)). + +%% Folds meet/2 over a list. + +-spec meet([type()]) -> type(). + +meet([T1, T2 | Ts]) -> + meet([meet(T1, T2) | Ts]); +meet([T]) -> T. + +%% Return the "meet" of Type1 and Type2, which is more specific than Type1 and +%% Type2. This is identical to glb/2 but can operate on and produce unions. +%% +%% A = #t_union{list=nil, number=[number], other=[#t_map{}]} +%% B = #t_union{number=[#t_integer{}], other=[#t_map{}]} +%% +%% meet(A, B) -> +%% #t_union{number=[#t_integer{}], other=[#t_map{}]} +%% +%% The meet of two different types result in 'none', which is the bottom +%% element for our type lattice: +%% +%% meet(#t_integer{}, #t_map{}) -> none + +-spec meet(type(), type()) -> type(). + +meet(T, T) -> + verified_type(T); +meet(any, T) -> + verified_type(T); +meet(T, any) -> + verified_type(T); +meet(#t_union{}=A, B) -> + meet_unions(A, B); +meet(A, #t_union{}=B) -> + meet_unions(B, A); +meet(A, B) -> + glb(A, B). + +meet_unions(#t_union{atom=AtomA,list=ListA,number=NumberA, + tuple_set=TSetA,other=OtherA}, + #t_union{atom=AtomB,list=ListB,number=NumberB, + tuple_set=TSetB,other=OtherB}) -> + Union = #t_union{atom=glb(AtomA, AtomB), + list=glb(ListA, ListB), + number=glb(NumberA, NumberB), + tuple_set=meet_tuple_sets(TSetA, TSetB), + other=glb(OtherA, OtherB)}, + shrink_union(Union); +meet_unions(#t_union{atom=AtomA}, #t_atom{}=B) -> + case glb(AtomA, B) of + none -> none; + Atom -> Atom + end; +meet_unions(#t_union{number=NumberA}, B) when ?IS_NUMBER_TYPE(B) -> + case glb(NumberA, B) of + none -> none; + Number -> Number + end; +meet_unions(#t_union{list=ListA}, B) when ?IS_LIST_TYPE(B) -> + case glb(ListA, B) of + none -> none; + List -> List + end; +meet_unions(#t_union{tuple_set=Tuples}, #t_tuple{}=B) -> + Set = meet_tuple_sets(Tuples, new_tuple_set(B)), + shrink_union(#t_union{tuple_set=Set}); +meet_unions(#t_union{other=OtherA}, OtherB) -> + case glb(OtherA, OtherB) of + none -> none; + Other -> Other + end. + +meet_tuple_sets(none, _) -> + none; +meet_tuple_sets(_, none) -> + none; +meet_tuple_sets(#t_tuple{}=A, #t_tuple{}=B) -> + new_tuple_set(glb(A, B)); +meet_tuple_sets(#t_tuple{}=Tuple, Records) -> + mts_tuple(Records, Tuple, []); +meet_tuple_sets(Records, #t_tuple{}=Tuple) -> + meet_tuple_sets(Tuple, Records); +meet_tuple_sets(RecordsA, RecordsB) -> + mts_records(RecordsA, RecordsB). + +mts_tuple([{Key, Type} | Records], Tuple, Acc) -> + case glb(Type, Tuple) of + none -> mts_tuple(Records, Tuple, Acc); + T -> mts_tuple(Records, Tuple, [{Key, T} | Acc]) + end; +mts_tuple([], _Tuple, [_|_]=Acc) -> + reverse(Acc); +mts_tuple([], _Tuple, []) -> + none. + +mts_records(RecordsA, RecordsB) -> + mts_records(RecordsA, RecordsB, []). + +mts_records([{Key, A} | RsA], [{Key, B} | RsB], Acc) -> + case glb(A, B) of + none -> mts_records(RsA, RsB, Acc); + T -> mts_records(RsA, RsB, [{Key, T} | Acc]) + end; +mts_records([{KeyA, _} | _ ]=RsA, [{KeyB, _} | RsB], Acc) when KeyA > KeyB -> + mts_records(RsA, RsB, Acc); +mts_records([{KeyA, _} | RsA], [{KeyB, _} | _] = RsB, Acc) when KeyA < KeyB -> + mts_records(RsA, RsB, Acc); +mts_records(_RsA, [], [_|_]=Acc) -> + reverse(Acc); +mts_records([], _RsB, [_|_]=Acc) -> + reverse(Acc); +mts_records(_RsA, _RsB, []) -> + none. + +%% Folds join/2 over a list. + +-spec join([type()]) -> type(). + +join([T1, T2| Ts]) -> + join([join(T1, T2) | Ts]); +join([T]) -> T. + +%% Return the "join" of Type1 and Type2, which is more general than Type1 and +%% Type2. This is identical to lub/2 but can operate on and produce unions. +%% +%% join(#t_integer{}, #t_map{}) -> #t_union{number=[#t_integer{}], +%% other=[#t_map{}]} + +-spec join(type(), type()) -> type(). + +join(T, T) -> T; +join(_T, any) -> any; +join(any, _T) -> any; +join(T, none) -> T; +join(none, T) -> T; + +join(#t_union{}=A, B) -> + join_unions(A, B); +join(A, #t_union{}=B) -> + join_unions(B, A); + +%% Union creation... +join(#t_atom{}=A, #t_atom{}=B) -> + lub(A, B); +join(#t_atom{}=A, B) when ?IS_LIST_TYPE(B) -> + #t_union{atom=A,list=B}; +join(#t_atom{}=A, B) when ?IS_NUMBER_TYPE(B) -> + #t_union{atom=A,number=B}; +join(#t_atom{}=A, #t_tuple{}=B) -> + #t_union{atom=A,tuple_set=new_tuple_set(B)}; +join(#t_atom{}=A, B) -> + #t_union{atom=A,other=B}; +join(A, #t_atom{}=B) -> + join(B, A); + +join(A, B) when ?IS_LIST_TYPE(A), ?IS_LIST_TYPE(B) -> + lub(A, B); +join(A, B) when ?IS_LIST_TYPE(A), ?IS_NUMBER_TYPE(B) -> + #t_union{list=A,number=B}; +join(A, #t_tuple{}=B) when ?IS_LIST_TYPE(A) -> + #t_union{list=A,tuple_set=new_tuple_set(B)}; +join(A, B) when ?IS_LIST_TYPE(A) -> + #t_union{list=A,other=B}; +join(A, B) when ?IS_LIST_TYPE(B) -> + join(B, A); + +join(A, B) when ?IS_NUMBER_TYPE(A), ?IS_NUMBER_TYPE(B) -> + lub(A, B); +join(A, #t_tuple{}=B) when ?IS_NUMBER_TYPE(A) -> + #t_union{number=A,tuple_set=new_tuple_set(B)}; +join(A, B) when ?IS_NUMBER_TYPE(A) -> + #t_union{number=A,other=B}; +join(A, B) when ?IS_NUMBER_TYPE(B) -> + join(B, A); + +join(#t_tuple{}=A, #t_tuple{}=B) -> + case {record_key(A), record_key(B)} of + {Same, Same} -> + lub(A, B); + {none, _Key} -> + lub(A, B); + {_Key, none} -> + lub(A, B); + {KeyA, KeyB} when KeyA < KeyB -> + #t_union{tuple_set=[{KeyA, A}, {KeyB, B}]}; + {KeyA, KeyB} when KeyA > KeyB -> + #t_union{tuple_set=[{KeyB, B}, {KeyA, A}]} + end; +join(#t_tuple{}=A, B) -> + %% All other combinations have been tried already, so B must be 'other' + #t_union{tuple_set=new_tuple_set(A),other=B}; +join(A, #t_tuple{}=B) -> + join(B, A); + +join(A, B) -> + lub(A, B). + +join_unions(#t_union{atom=AtomA,list=ListA,number=NumberA, + tuple_set=TSetA,other=OtherA}, + #t_union{atom=AtomB,list=ListB,number=NumberB, + tuple_set=TSetB,other=OtherB}) -> + Union = #t_union{atom=lub(AtomA, AtomB), + list=lub(ListA, ListB), + number=lub(NumberA, NumberB), + tuple_set=join_tuple_sets(TSetA, TSetB), + other=lub(OtherA, OtherB)}, + shrink_union(Union); +join_unions(#t_union{atom=AtomA}=A, #t_atom{}=B) -> + A#t_union{atom=lub(AtomA, B)}; +join_unions(#t_union{list=ListA}=A, B) when ?IS_LIST_TYPE(B) -> + A#t_union{list=lub(ListA, B)}; +join_unions(#t_union{number=NumberA}=A, B) when ?IS_NUMBER_TYPE(B) -> + A#t_union{number=lub(NumberA, B)}; +join_unions(#t_union{tuple_set=TSetA}=A, #t_tuple{}=B) -> + Set = join_tuple_sets(TSetA, new_tuple_set(B)), + shrink_union(A#t_union{tuple_set=Set}); +join_unions(#t_union{other=OtherA}=A, B) -> + case lub(OtherA, B) of + any -> any; + T -> A#t_union{other=T} + end. + +join_tuple_sets(A, none) -> + A; +join_tuple_sets(none, B) -> + B; +join_tuple_sets(#t_tuple{}=A, #t_tuple{}=B) -> + lub(A, B); +join_tuple_sets(#t_tuple{}=Tuple, Records) -> + jts_tuple(Records, Tuple); +join_tuple_sets(Records, #t_tuple{}=Tuple) -> + join_tuple_sets(Tuple, Records); +join_tuple_sets(RecordsA, RecordsB) -> + jts_records(RecordsA, RecordsB). + +jts_tuple([{_Key, Tuple} | Records], Acc) -> + jts_tuple(Records, lub(Tuple, Acc)); +jts_tuple([], Acc) -> + Acc. + +jts_records(RsA, RsB) -> + jts_records(RsA, RsB, 0, []). + +jts_records([], [], _N, Acc) -> + reverse(Acc); +jts_records(RsA, RsB, N, Acc) when N > ?TUPLE_SET_LIMIT -> + A = normalize_tuple_set(RsA, none), + B = normalize_tuple_set(RsB, A), + #t_tuple{} = normalize_tuple_set(Acc, B); +jts_records([{Key, A} | RsA], [{Key, B} | RsB], N, Acc) -> + jts_records(RsA, RsB, N + 1, [{Key, lub(A, B)} | Acc]); +jts_records([{KeyA, _} | _]=RsA, [{KeyB, B} | RsB], N, Acc) when KeyA > KeyB -> + jts_records(RsA, RsB, N + 1, [{KeyB, B} | Acc]); +jts_records([{KeyA, A} | RsA], [{KeyB, _} | _] = RsB, N, Acc) when KeyA < KeyB -> + jts_records(RsA, RsB, N + 1, [{KeyA, A} | Acc]); +jts_records([{KeyA, A} | RsA], [], N, Acc) -> + jts_records(RsA, [], N + 1, [{KeyA, A} | Acc]); +jts_records([], [{KeyB, B} | RsB], N, Acc) -> + jts_records([], RsB, N + 1, [{KeyB, B} | Acc]). + +%% Subtract Type2 from Type1. Example: +%% subtract(list, cons) -> nil + +-spec subtract(type(), type()) -> type(). + +subtract(#t_atom{elements=[_|_]=Set0}, #t_atom{elements=[_|_]=Set1}) -> + case ordsets:subtract(Set0, Set1) of + [] -> none; + [_|_]=Set -> #t_atom{elements=Set} + end; +subtract(#t_bitstring{size_unit=UnitA}=T, #t_bs_matchable{tail_unit=UnitB}) -> + subtract_matchable(T, UnitA, UnitB); +subtract(#t_bitstring{size_unit=UnitA}=T, #t_bitstring{size_unit=UnitB}) -> + subtract_matchable(T, UnitA, UnitB); +subtract(#t_bs_context{tail_unit=UnitA}=T, #t_bs_matchable{tail_unit=UnitB}) -> + subtract_matchable(T, UnitA, UnitB); +subtract(#t_bs_context{tail_unit=UnitA}=T, #t_bs_context{tail_unit=UnitB}) -> + subtract_matchable(T, UnitA, UnitB); +subtract(#t_integer{elements={Min, Max}}, #t_integer{elements={N,N}}) -> + if + Min =:= N, Max =:= N -> + none; + Min =/= N, Max =/= N -> + #t_integer{elements={Min, Max}}; + Min =:= N -> + #t_integer{elements={Min + 1, Max}}; + Max =:= N -> + #t_integer{elements={Min, Max - 1}} + end; +subtract(number, #t_float{elements=any}) -> #t_integer{}; +subtract(number, #t_integer{elements=any}) -> #t_float{}; + +%% A list is essentially `#t_cons{} | nil`, so we're left with nil if we +%% subtract a cons cell that is more general than the one in the list. +subtract(#t_list{type=TypeA,terminator=TermA}=T, + #t_cons{type=TypeB,terminator=TermB}) -> + case {meet(TypeA, TypeB), meet(TermA, TermB)} of + {TypeA, TermA} -> nil; + _ -> T + end; +subtract(#t_list{type=Type,terminator=Term}, nil) -> + #t_cons{type=Type,terminator=Term}; + +subtract(#t_union{atom=Atom}=A, #t_atom{}=B)-> + shrink_union(A#t_union{atom=subtract(Atom, B)}); +subtract(#t_union{number=Number}=A, B) when ?IS_NUMBER_TYPE(B) -> + shrink_union(A#t_union{number=subtract(Number, B)}); +subtract(#t_union{list=List}=A, B) when ?IS_LIST_TYPE(B) -> + shrink_union(A#t_union{list=subtract(List, B)}); +subtract(#t_union{tuple_set=[_|_]=Records0}=A, #t_tuple{}=B) -> + %% Filter out all records that are more specific than B. + NewSet = case [{Key, T} || {Key, T} <- Records0, meet(T, B) =/= T] of + [_|_]=Records -> Records; + [] -> none + end, + shrink_union(A#t_union{tuple_set=NewSet}); +subtract(#t_union{tuple_set=#t_tuple{}=Tuple}=A, #t_tuple{}=B) -> + %% Exclude Tuple if it's more specific than B. + case meet(Tuple, B) of + Tuple -> shrink_union(A#t_union{tuple_set=none}); + _ -> A + end; +subtract(#t_union{other=Other}=A, B) -> + shrink_union(A#t_union{other=subtract(Other, B)}); + +subtract(A, B) -> + %% There's nothing left if A is more specific than B. + case meet(A, B) of + A -> none; + _Other -> A + end. + +subtract_matchable(T, UnitA, UnitB) -> + if + UnitA rem UnitB =:= 0 -> none; + UnitA rem UnitB =/= 0 -> T + end. + +%%% +%%% Type operators +%%% + +-spec get_bs_matchable_unit(type()) -> pos_integer() | error. +get_bs_matchable_unit(#t_bitstring{size_unit=Unit}) -> + Unit; +get_bs_matchable_unit(#t_bs_context{tail_unit=Unit}) -> + Unit; +get_bs_matchable_unit(#t_bs_matchable{tail_unit=Unit}) -> + Unit; +get_bs_matchable_unit(_) -> + error. + +-spec is_bs_matchable_type(type()) -> boolean(). +is_bs_matchable_type(Type) -> + get_bs_matchable_unit(Type) =/= error. + +-spec get_singleton_value(Type) -> Result when + Type :: type(), + Result :: {ok, term()} | error. +get_singleton_value(#t_atom{elements=[Atom]}) -> + {ok, Atom}; +get_singleton_value(#t_float{elements={Float,Float}}) -> + {ok, Float}; +get_singleton_value(#t_integer{elements={Int,Int}}) -> + {ok, Int}; +get_singleton_value(#t_map{super_key=none,super_value=none}) -> + {ok, #{}}; +get_singleton_value(#t_tuple{exact=true,size=Size,elements=Es}) -> + case gsv_elements(Size, Es, []) of + Values when is_list(Values) -> + {ok, list_to_tuple(Values)}; + error -> + error + end; +get_singleton_value(nil) -> + {ok, []}; +get_singleton_value(_) -> + error. + +gsv_elements(0, _Es, Acc) -> + %% The elements were added right-to-left, so it's already in order. + Acc; +gsv_elements(N, Es, Acc) -> + ElementType = get_tuple_element(N, Es), + case get_singleton_value(ElementType) of + {ok, Value} -> gsv_elements(N - 1, Es, [Value | Acc]); + error -> error + end. + +-spec is_singleton_type(type()) -> boolean(). +is_singleton_type(Type) -> + get_singleton_value(Type) =/= error. + +-spec is_boolean_type(type()) -> boolean(). +is_boolean_type(#t_atom{elements=[F,T]}) -> + F =:= false andalso T =:= true; +is_boolean_type(#t_atom{elements=[B]}) -> + is_boolean(B); +is_boolean_type(#t_union{}=T) -> + is_boolean_type(normalize(T)); +is_boolean_type(_) -> + false. + +-spec set_tuple_element(Index, Type, Elements) -> Elements when + Index :: pos_integer(), + Type :: type(), + Elements :: tuple_elements(). +set_tuple_element(Index, _Type, Es) when Index > ?TUPLE_ELEMENT_LIMIT -> + Es; +set_tuple_element(_Index, none, Es) -> + Es; +set_tuple_element(Index, any, Es) -> + maps:remove(Index, Es); +set_tuple_element(Index, Type, Es) -> + Es#{ Index => Type }. + +-spec get_tuple_element(Index, Elements) -> type() when + Index :: pos_integer(), + Elements :: tuple_elements(). +get_tuple_element(Index, Es) -> + case Es of + #{ Index := T } -> T; + #{} -> any + end. + +-spec normalize(type()) -> normal_type(). +normalize(#t_union{atom=Atom,list=List,number=Number, + tuple_set=Tuples,other=Other}) -> + A = lub(Atom, List), + B = lub(A, Number), + C = lub(B, Other), + normalize_tuple_set(Tuples, C); +normalize(T) -> + verified_normal_type(T). + +normalize_tuple_set([{_, A} | Records], B) -> + normalize_tuple_set(Records, lub(A, B)); +normalize_tuple_set([], B) -> + B; +normalize_tuple_set(A, B) -> + lub(A, B). + +%%% +%%% Type constructors +%%% + +-spec make_type_from_value(term()) -> type(). +make_type_from_value(Value) -> + mtfv_1(Value). + +mtfv_1(A) when is_atom(A) -> + #t_atom{elements=[A]}; +mtfv_1(B) when is_bitstring(B) -> + case bit_size(B) of + 0 -> + %% This is a bit of a hack, but saying that empty binaries have a + %% unit of 8 helps us get rid of is_binary/1 checks. + #t_bitstring{size_unit=8}; + Size -> + #t_bitstring{size_unit=Size} + end; +mtfv_1(F) when is_float(F) -> + make_float(F); +mtfv_1(F) when is_function(F) -> + {arity, Arity} = erlang:fun_info(F, arity), + #t_fun{arity=Arity}; +mtfv_1(I) when is_integer(I) -> + make_integer(I); +mtfv_1(L) when is_list(L) -> + case L of + [_|_] -> mtfv_cons(L, none); + [] -> nil + end; +mtfv_1(M) when is_map(M) -> + {SKey, SValue} = + maps:fold(fun(Key, Value, {SKey0, SValue0}) -> + SKey = join(mtfv_1(Key), SKey0), + SValue = join(mtfv_1(Value), SValue0), + {SKey, SValue} + end, {none, none}, M), + #t_map{super_key=SKey,super_value=SValue}; +mtfv_1(T) when is_tuple(T) -> + {Es,_} = foldl(fun(Val, {Es0, Index}) -> + Type = mtfv_1(Val), + Es = set_tuple_element(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, tuple_to_list(T)), + #t_tuple{exact=true,size=tuple_size(T),elements=Es}; +mtfv_1(_Term) -> + any. + +mtfv_cons([Head | Tail], Type) -> + mtfv_cons(Tail, join(mtfv_1(Head), Type)); +mtfv_cons(Terminator, Type) -> + #t_cons{type=Type,terminator=mtfv_1(Terminator)}. + +-spec make_atom(atom()) -> type(). +make_atom(Atom) when is_atom(Atom) -> + #t_atom{elements=[Atom]}. + +-spec make_boolean() -> type(). +make_boolean() -> + #t_atom{elements=[false,true]}. + +-spec make_cons(type(), type()) -> type(). +make_cons(Head0, Tail) -> + case meet(Tail, #t_cons{}) of + #t_cons{type=Type0,terminator=Term0} -> + %% Propagate element and terminator types. Note that if the tail is + %% the union of a list and something else, the new list could be + %% terminated by the other types in the union. + Type = join(Head0, Type0), + Term = join(subtract(Tail, #t_cons{}), Term0), + #t_cons{type=Type,terminator=Term}; + _ -> + %% Tail can't be a cons cell, so we know it terminates the list. + #t_cons{type=Head0,terminator=Tail} + end. + +-spec make_float(float()) -> type(). +make_float(Float) when is_float(Float) -> + make_float(Float, Float). + +-spec make_float(float(), float()) -> type(). +make_float(Min, Max) when is_float(Min), is_float(Max), Min =< Max -> + #t_float{elements={Min, Max}}. + +-spec make_integer(integer()) -> type(). +make_integer(Int) when is_integer(Int) -> + make_integer(Int, Int). + +-spec make_integer(Min, Max) -> type() when + Min :: integer(), + Max :: integer(). +make_integer(Min, Max) when is_integer(Min), is_integer(Max), Min =< Max -> + #t_integer{elements={Min,Max}}. + +-spec limit_depth(type()) -> type(). + +limit_depth(Type) -> + limit_depth(Type, ?MAX_TYPE_DEPTH). + +limit_depth(#t_cons{}=T, Depth) -> + limit_depth_list(T, Depth); +limit_depth(#t_list{}=T, Depth) -> + limit_depth_list(T, Depth); +limit_depth(#t_tuple{}=T, Depth) -> + limit_depth_tuple(T, Depth); +limit_depth(#t_fun{}=T, Depth) -> + limit_depth_fun(T, Depth); +limit_depth(#t_map{}=T, Depth) -> + limit_depth_map(T, Depth); +limit_depth(#t_union{list=List0,tuple_set=TupleSet0,other=Other0}=U, Depth) -> + TupleSet = limit_depth_tuple(TupleSet0, Depth), + List = limit_depth_list(List0, Depth), + Other = limit_depth(Other0, Depth), + shrink_union(U#t_union{list=List,tuple_set=TupleSet,other=Other}); +limit_depth(Type, _Depth) -> + Type. + +limit_depth_fun(#t_fun{type=Type0}=T, Depth) -> + Type = if + Depth > 0 -> limit_depth(Type0, Depth - 1); + Depth =< 0 -> any + end, + T#t_fun{type=Type}. + +limit_depth_list(#t_cons{type=Type0,terminator=Term0}=T, Depth) -> + {Type, Term} = limit_depth_list_1(Type0, Term0, Depth), + T#t_cons{type=Type,terminator=Term}; +limit_depth_list(#t_list{type=Type0,terminator=Term0}=T, Depth) -> + {Type, Term} = limit_depth_list_1(Type0, Term0, Depth), + T#t_list{type=Type,terminator=Term}; +limit_depth_list(nil, _Depth) -> + nil; +limit_depth_list(none, _Depth) -> + none. + +limit_depth_list_1(Type0, Terminator0, Depth) when Depth > 0 -> + Type = limit_depth(Type0, Depth - 1), + Terminator = limit_depth(Terminator0, Depth - 1), + {Type, Terminator}; +limit_depth_list_1(_Type, _Terminator, Depth) when Depth =< 0 -> + {any, any}. + +limit_depth_map(#t_map{ super_key=SKey0, + super_value=SValue0 }, Depth) when Depth > 0 -> + SKey = limit_depth(SKey0, Depth - 1), + SValue = limit_depth(SValue0, Depth - 1), + #t_map{super_key=SKey,super_value=SValue}; +limit_depth_map(#t_map{}, Depth) when Depth =< 0 -> + #t_map{}. + +limit_depth_tuple(#t_tuple{elements=Es0}=T, Depth) -> + if + Depth > 0 -> + Es = maps:map(fun(_, E) -> limit_depth(E, Depth - 1) end, Es0), + T#t_tuple{elements=Es}; + Depth =< 0 -> + #t_tuple{elements=#{}} + end; +limit_depth_tuple([{{MinSize,_},_}|_], Depth) when Depth =< 0 -> + %% Preserve the minimum size of the tuple set. + #t_tuple{exact=false,size=MinSize}; +limit_depth_tuple([{SzTag,Tuple}|Ts], Depth) -> + [{SzTag, limit_depth_tuple(Tuple, Depth)} | limit_depth_tuple(Ts, Depth)]; +limit_depth_tuple([], _Depth) -> + []; +limit_depth_tuple(none, _Depth) -> + none. + +%%% +%%% Helpers +%%% + +%% Return the greatest lower bound of the types Type1 and Type2. The GLB is a +%% more specific type than Type1 and Type2, and is always a normal type. +%% +%% glb(#t_integer{elements=any}, #t_integer{elements={0,3}}) -> +%% #t_integer{elements={0,3}} +%% +%% The GLB of two different types result in 'none', which is the bottom +%% element for our type lattice: +%% +%% glb(#t_integer{}, #t_map{}) -> none + +-spec glb(normal_type(), normal_type()) -> normal_type(). + +glb(T, T) -> + verified_normal_type(T); +glb(any, T) -> + verified_normal_type(T); +glb(T, any) -> + verified_normal_type(T); +glb(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> + case ordsets:intersection(Set1, Set2) of + [] -> + none; + [_|_]=Set -> + #t_atom{elements=Set} + end; +glb(#t_atom{elements=[_|_]}=T, #t_atom{elements=any}) -> + T; +glb(#t_atom{elements=any}, #t_atom{elements=[_|_]}=T) -> + T; +glb(#t_bitstring{size_unit=U1}, #t_bitstring{size_unit=U2}) -> + #t_bitstring{size_unit=U1 * U2 div gcd(U1, U2)}; +glb(#t_bitstring{size_unit=UnitA}=T, #t_bs_matchable{tail_unit=UnitB}) -> + Unit = UnitA * UnitB div gcd(UnitA, UnitB), + T#t_bitstring{size_unit=Unit}; +glb(#t_bs_context{tail_unit=UnitA,slots=SlotCountA,valid=ValidSlotsA}, + #t_bs_context{tail_unit=UnitB,slots=SlotCountB,valid=ValidSlotsB}) -> + CommonSlotMask = (1 bsl min(SlotCountA, SlotCountB)) - 1, + CommonSlotsA = ValidSlotsA band CommonSlotMask, + CommonSlotsB = ValidSlotsB band CommonSlotMask, + Unit = UnitA * UnitB div gcd(UnitA, UnitB), + if + CommonSlotsA =:= CommonSlotsB -> + #t_bs_context{tail_unit=Unit, + slots=max(SlotCountA, SlotCountB), + valid=ValidSlotsA bor ValidSlotsB}; + CommonSlotsA =/= CommonSlotsB -> + none + end; +glb(#t_bs_context{tail_unit=UnitA}=T, #t_bs_matchable{tail_unit=UnitB}) -> + Unit = UnitA * UnitB div gcd(UnitA, UnitB), + T#t_bs_context{tail_unit=Unit}; +glb(#t_bs_matchable{tail_unit=UnitA}, #t_bs_matchable{tail_unit=UnitB}) -> + Unit = UnitA * UnitB div gcd(UnitA, UnitB), + #t_bs_matchable{tail_unit=Unit}; +glb(#t_bs_matchable{tail_unit=UnitA}, #t_bitstring{size_unit=UnitB}=T) -> + Unit = UnitA * UnitB div gcd(UnitA, UnitB), + T#t_bitstring{size_unit=Unit}; +glb(#t_bs_matchable{tail_unit=UnitA}, #t_bs_context{tail_unit=UnitB}=T) -> + Unit = UnitA * UnitB div gcd(UnitA, UnitB), + T#t_bs_context{tail_unit=Unit}; +glb(#t_cons{type=TypeA,terminator=TermA}, + #t_cons{type=TypeB,terminator=TermB}) -> + %% Note the use of meet/2; elements don't need to be normal types. + case {meet(TypeA, TypeB), meet(TermA, TermB)} of + {none, _} -> none; + {_, none} -> none; + {Type, Term} -> #t_cons{type=Type,terminator=Term} + end; +glb(#t_cons{type=TypeA,terminator=TermA}, + #t_list{type=TypeB,terminator=TermB}) -> + case {meet(TypeA, TypeB), meet(TermA, TermB)} of + {none, _} -> none; + {_, none} -> none; + {Type, Term} -> #t_cons{type=Type,terminator=Term} + end; +glb(#t_float{}=T, #t_float{elements=any}) -> + T; +glb(#t_float{elements=any}, #t_float{}=T) -> + T; +glb(#t_float{elements={MinA,MaxA}}, #t_float{elements={MinB,MaxB}}) + when MinA >= MinB, MinA =< MaxB; + MinB >= MinA, MinB =< MaxA -> + true = MinA =< MaxA andalso MinB =< MaxB, %Assertion. + #t_float{elements={max(MinA, MinB),min(MaxA, MaxB)}}; +glb(#t_fun{arity=Same,type=TypeA}, #t_fun{arity=Same,type=TypeB}=T) -> + T#t_fun{type=meet(TypeA, TypeB)}; +glb(#t_fun{arity=any,type=TypeA}, #t_fun{type=TypeB}=T) -> + T#t_fun{type=meet(TypeA, TypeB)}; +glb(#t_fun{type=TypeA}=T, #t_fun{arity=any,type=TypeB}) -> + T#t_fun{type=meet(TypeA, TypeB)}; +glb(#t_integer{elements={_,_}}=T, #t_integer{elements=any}) -> + T; +glb(#t_integer{elements=any}, #t_integer{elements={_,_}}=T) -> + T; +glb(#t_integer{elements={MinA,MaxA}}, #t_integer{elements={MinB,MaxB}}) + when MinA >= MinB, MinA =< MaxB; + MinB >= MinA, MinB =< MaxA -> + true = MinA =< MaxA andalso MinB =< MaxB, %Assertion. + #t_integer{elements={max(MinA, MinB),min(MaxA, MaxB)}}; +glb(#t_integer{}=T, number) -> + T; +glb(#t_float{}=T, number) -> + T; +glb(#t_list{type=TypeA,terminator=TermA}, + #t_list{type=TypeB,terminator=TermB}) -> + %% A list is a union of `[type() | _]` and `[]`, so we're left with + %% nil when the element types are incompatible. + case {meet(TypeA, TypeB), meet(TermA, TermB)} of + {none, _} -> nil; + {_, none} -> nil; + {Type, Term} -> #t_list{type=Type,terminator=Term} + end; +glb(#t_list{}=A, #t_cons{}=B) -> + glb(B, A); +glb(#t_list{}, nil) -> + nil; +glb(nil, #t_list{}) -> + nil; +glb(number, #t_integer{}=T) -> + T; +glb(number, #t_float{}=T) -> + T; +glb(#t_map{super_key=SKeyA,super_value=SValueA}, + #t_map{super_key=SKeyB,super_value=SValueB}) -> + %% Note the use of meet/2; elements don't need to be normal types. + SKey = meet(SKeyA, SKeyB), + SValue = meet(SValueA, SValueB), + #t_map{super_key=SKey,super_value=SValue}; +glb(#t_tuple{}=T1, #t_tuple{}=T2) -> + glb_tuples(T1, T2); +glb(_, _) -> + %% Inconsistent types. There will be an exception at runtime. + none. + +glb_tuples(#t_tuple{size=Sz1,exact=Ex1}, #t_tuple{size=Sz2,exact=Ex2}) + when Ex1, Sz1 < Sz2; + Ex2, Sz2 < Sz1 -> + none; +glb_tuples(#t_tuple{size=Sz1,exact=Ex1,elements=Es1}, + #t_tuple{size=Sz2,exact=Ex2,elements=Es2}) -> + Size = max(Sz1, Sz2), + Exact = Ex1 or Ex2, + case glb_elements(Es1, Es2) of + none -> + none; + Es -> + #t_tuple{size=Size,exact=Exact,elements=Es} + end. + +glb_elements(Es1, Es2) -> + Keys = maps:keys(Es1) ++ maps:keys(Es2), + glb_elements_1(Keys, Es1, Es2, #{}). + +glb_elements_1([Key | Keys], Es1, Es2, Acc) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + %% Note the use of meet/2; elements don't need to be normal types. + case meet(Type1, Type2) of + none -> none; + Type -> glb_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) + end; + {#{ Key := Type1 }, _} -> + glb_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); + {_, #{ Key := Type2 }} -> + glb_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) + end; +glb_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% Return the least upper bound of the types Type1 and Type2. The LUB is a more +%% general type than Type1 and Type2, and is always a normal type. +%% +%% For example: +%% +%% lub(#t_integer{elements=any}, #t_integer=elements={0,3}}) -> +%% #t_integer{} +%% +%% The LUB for two different types result in 'any' (not a union type!), which +%% is the top element for our type lattice: +%% +%% lub(#t_integer{}, #t_map{}) -> any + +-spec lub(normal_type(), normal_type()) -> normal_type(). + +lub(T, T) -> + verified_normal_type(T); +lub(none, T) -> + verified_normal_type(T); +lub(T, none) -> + verified_normal_type(T); +lub(any, _) -> + any; +lub(_, any) -> + any; +lub(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> + Set = ordsets:union(Set1, Set2), + case ordsets:size(Set) of + Size when Size =< ?ATOM_SET_SIZE -> + #t_atom{elements=Set}; + _Size -> + #t_atom{elements=any} + end; +lub(#t_atom{elements=any}=T, #t_atom{elements=[_|_]}) -> T; +lub(#t_atom{elements=[_|_]}, #t_atom{elements=any}=T) -> T; +lub(#t_bitstring{size_unit=U1}, #t_bitstring{size_unit=U2}) -> + #t_bitstring{size_unit=gcd(U1, U2)}; +lub(#t_bitstring{size_unit=U1}, #t_bs_context{tail_unit=U2}) -> + #t_bs_matchable{tail_unit=gcd(U1, U2)}; +lub(#t_bitstring{size_unit=UnitA}, #t_bs_matchable{tail_unit=UnitB}) -> + lub_bs_matchable(UnitA, UnitB); +lub(#t_bs_context{tail_unit=UnitA,slots=SlotsA,valid=ValidA}, + #t_bs_context{tail_unit=UnitB,slots=SlotsB,valid=ValidB}) -> + #t_bs_context{tail_unit=gcd(UnitA, UnitB), + slots=min(SlotsA, SlotsB), + valid=ValidA band ValidB}; +lub(#t_bs_context{tail_unit=U1}, #t_bitstring{size_unit=U2}) -> + #t_bs_matchable{tail_unit=gcd(U1, U2)}; +lub(#t_bs_context{tail_unit=UnitA}, #t_bs_matchable{tail_unit=UnitB}) -> + lub_bs_matchable(UnitA, UnitB); +lub(#t_bs_matchable{tail_unit=UnitA}, #t_bs_matchable{tail_unit=UnitB}) -> + lub_bs_matchable(UnitA, UnitB); +lub(#t_bs_matchable{tail_unit=UnitA}, #t_bitstring{size_unit=UnitB}) -> + lub_bs_matchable(UnitA, UnitB); +lub(#t_bs_matchable{tail_unit=UnitA}, #t_bs_context{tail_unit=UnitB}) -> + lub_bs_matchable(UnitA, UnitB); +lub(#t_cons{type=TypeA,terminator=TermA}, + #t_cons{type=TypeB,terminator=TermB}) -> + %% Note the use of join/2; elements don't need to be normal types. + #t_cons{type=join(TypeA,TypeB),terminator=join(TermA, TermB)}; +lub(#t_cons{type=TypeA,terminator=TermA}, + #t_list{type=TypeB,terminator=TermB}) -> + #t_list{type=join(TypeA,TypeB),terminator=join(TermA, TermB)}; +lub(#t_cons{type=Type,terminator=Term}, nil) -> + #t_list{type=Type,terminator=Term}; +lub(#t_float{elements={MinA,MaxA}}, + #t_float{elements={MinB,MaxB}}) -> + #t_float{elements={min(MinA,MinB),max(MaxA,MaxB)}}; +lub(#t_float{}, #t_float{}) -> + #t_float{}; +lub(#t_float{}, #t_integer{}) -> + number; +lub(#t_float{}, number) -> + number; +lub(#t_fun{arity=Same,type=TypeA}, #t_fun{arity=Same,type=TypeB}) -> + #t_fun{arity=Same,type=join(TypeA, TypeB)}; +lub(#t_fun{type=TypeA}, #t_fun{type=TypeB}) -> + #t_fun{type=join(TypeA, TypeB)}; +lub(#t_integer{elements={MinA,MaxA}}, + #t_integer{elements={MinB,MaxB}}) -> + #t_integer{elements={min(MinA,MinB),max(MaxA,MaxB)}}; +lub(#t_integer{}, #t_integer{}) -> + #t_integer{}; +lub(#t_integer{}, #t_float{}) -> + number; +lub(#t_integer{}, number) -> + number; +lub(#t_list{type=TypeA,terminator=TermA}, + #t_list{type=TypeB,terminator=TermB}) -> + #t_list{type=join(TypeA, TypeB),terminator=join(TermA, TermB)}; +lub(#t_list{}=A, #t_cons{}=B) -> + lub(B, A); +lub(nil=A, #t_cons{}=B) -> + lub(B, A); +lub(nil, #t_list{}=T) -> + T; +lub(#t_list{}=T, nil) -> + T; +lub(number, #t_integer{}) -> + number; +lub(number, #t_float{}) -> + number; +lub(#t_map{super_key=SKeyA,super_value=SValueA}, + #t_map{super_key=SKeyB,super_value=SValueB}) -> + %% Note the use of join/2; elements don't need to be normal types. + SKey = join(SKeyA, SKeyB), + SValue = join(SValueA, SValueB), + #t_map{super_key=SKey,super_value=SValue}; +lub(#t_tuple{size=Sz,exact=ExactA,elements=EsA}, + #t_tuple{size=Sz,exact=ExactB,elements=EsB}) -> + Exact = ExactA and ExactB, + Es = lub_tuple_elements(Sz, EsA, EsB), + #t_tuple{size=Sz,exact=Exact,elements=Es}; +lub(#t_tuple{size=SzA,elements=EsA}, #t_tuple{size=SzB,elements=EsB}) -> + Sz = min(SzA, SzB), + Es = lub_tuple_elements(Sz, EsA, EsB), + #t_tuple{size=Sz,elements=Es}; +lub(_T1, _T2) -> + %%io:format("~p ~p\n", [_T1,_T2]), + any. + +lub_bs_matchable(UnitA, UnitB) -> + #t_bs_matchable{tail_unit=gcd(UnitA, UnitB)}. + +lub_tuple_elements(MinSize, EsA, EsB) -> + Es0 = lub_elements(EsA, EsB), + maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0). + +lub_elements(Es1, Es2) -> + Keys = if + map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); + map_size(Es1) > map_size(Es2) -> maps:keys(Es2) + end, + lub_elements_1(Keys, Es1, Es2, #{}). + +lub_elements_1([Key | Keys], Es1, Es2, Acc0) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + %% Note the use of join/2; elements don't need to be normal types. + Acc = set_tuple_element(Key, join(Type1, Type2), Acc0), + lub_elements_1(Keys, Es1, Es2, Acc); + {#{}, #{}} -> + lub_elements_1(Keys, Es1, Es2, Acc0) + end; +lub_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% + +gcd(A, B) -> + case A rem B of + 0 -> B; + X -> gcd(B, X) + end. + +%% + +record_key(#t_tuple{exact=true,size=Size,elements=#{ 1 := Tag }}) -> + case is_singleton_type(Tag) of + true -> {Size, Tag}; + false -> none + end; +record_key(_) -> + none. + +new_tuple_set(T) -> + case record_key(T) of + none -> T; + Key -> [{Key, T}] + end. + +%% + +shrink_union(#t_union{other=any}) -> + any; +shrink_union(#t_union{atom=Atom,list=none,number=none, + tuple_set=none,other=none}) -> + Atom; +shrink_union(#t_union{atom=none,list=List,number=none, + tuple_set=none,other=none}) -> + List; +shrink_union(#t_union{atom=none,list=none,number=Number, + tuple_set=none,other=none}) -> + Number; +shrink_union(#t_union{atom=none,list=none,number=none, + tuple_set=#t_tuple{}=Tuple,other=none}) -> + Tuple; +shrink_union(#t_union{atom=none,list=none,number=none, + tuple_set=[{_Key, Record}],other=none}) -> + #t_tuple{} = Record; %Assertion. +shrink_union(#t_union{atom=none,list=none,number=none, + tuple_set=none,other=Other}) -> + Other; +shrink_union(#t_union{}=T) -> + T. + +%% Verifies that the given type is well-formed. + +-spec verified_type(T) -> T when + T :: type(). + +verified_type(#t_union{atom=Atom, + list=List, + number=Number, + tuple_set=TSet, + other=Other}=T) -> + _ = verified_normal_type(Atom), + _ = verified_normal_type(List), + _ = verified_normal_type(Number), + _ = verify_tuple_set(TSet), + _ = verified_normal_type(Other), + T; +verified_type(T) -> + verified_normal_type(T). + +verify_tuple_set([_|_]=T) -> + _ = verify_tuple_set_1(T, 0), + T; +verify_tuple_set(#t_tuple{}=T) -> + none = record_key(T), %Assertion. + T; +verify_tuple_set(none=T) -> + T. + +verify_tuple_set_1([{_Tag, Record} | Records], Size) -> + true = Size =< ?TUPLE_SET_LIMIT, %Assertion. + _ = verified_normal_type(Record), + verify_tuple_set_1(Records, Size + 1); +verify_tuple_set_1([], _Size) -> + ok. + +-spec verified_normal_type(T) -> T when + T :: normal_type(). + +verified_normal_type(any=T) -> T; +verified_normal_type(none=T) -> T; +verified_normal_type(#t_atom{elements=any}=T) -> T; +verified_normal_type(#t_atom{elements=[_|_]}=T) -> T; +verified_normal_type(#t_bitstring{size_unit=U}=T) + when is_integer(U), U >= 1 -> + T; +verified_normal_type(#t_bs_context{tail_unit=U}=T) + when is_integer(U), U >= 1 -> + T; +verified_normal_type(#t_bs_matchable{tail_unit=U}=T) + when is_integer(U), U >= 1 -> + T; +verified_normal_type(#t_cons{type=Type,terminator=Term}=T) -> + _ = verified_type(Type), + _ = verified_type(Term), + T; +verified_normal_type(#t_fun{arity=Arity,type=ReturnType}=T) + when Arity =:= any; is_integer(Arity) -> + _ = verified_type(ReturnType), + T; +verified_normal_type(#t_float{}=T) -> T; +verified_normal_type(#t_integer{elements=any}=T) -> T; +verified_normal_type(#t_integer{elements={Min,Max}}=T) + when is_integer(Min), is_integer(Max), Min =< Max -> + T; +verified_normal_type(#t_list{type=Type,terminator=Term}=T) -> + _ = verified_type(Type), + _ = verified_type(Term), + T; +verified_normal_type(#t_map{}=T) -> T; +verified_normal_type(nil=T) -> T; +verified_normal_type(number=T) -> T; +verified_normal_type(#t_tuple{size=Size,elements=Es}=T) -> + %% All known elements must have a valid index and type (which may be a + %% union). 'any' is prohibited since it's implicit and should never be + %% present in the map, and a 'none' element ought to have reduced the + %% entire tuple to 'none'. + maps:fold(fun(Index, Element, _) when is_integer(Index), + 1 =< Index, Index =< Size, + Index =< ?TUPLE_ELEMENT_LIMIT, + Element =/= any, Element =/= none -> + verified_type(Element) + end, [], Es), + T. diff --git a/lib/compiler/src/beam_types.hrl b/lib/compiler/src/beam_types.hrl new file mode 100644 index 0000000000..c20e1ce7a0 --- /dev/null +++ b/lib/compiler/src/beam_types.hrl @@ -0,0 +1,154 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% Common term types for passes operating on beam SSA and assembly. Helper +%% functions for wrangling these can be found in beam_types.erl +%% +%% The type lattice is as follows: +%% +%% any Any Erlang term (top element). +%% +%% - #t_atom{} Atom, or a set thereof. +%% - #t_bs_matchable{} Binary-matchable types. +%% - #t_bitstring{} Bitstring. +%% - #t_bs_context{} Match context. +%% - #t_fun{} Fun. +%% - #t_map{} Map. +%% - number Any number. +%% -- #t_float{} Floating point number. +%% -- #t_integer{} Integer. +%% - #t_list{} Any list. +%% -- #t_cons{} Cons (nonempty list). +%% -- nil The empty list. +%% - #t_tuple{} Tuple. +%% +%% none No type (bottom element). +%% +%% We also use #t_union{} to represent conflicting types produced by certain +%% expressions, e.g. the "#t_atom{} or #t_tuple{}" of lists:keyfind/3, which is +%% very useful for preserving type information when we would otherwise have +%% reduced it to 'any'. Since few operations can make direct use of this extra +%% type information, types should generally be normalized to one of the above +%% before use. +%% +%% When adding a new type it's important that the lattice stays consistent [1]. +%% In brief, the following properties must hold: +%% +%% * All types must be unambiguous; any given value must narrow down to a +%% single type, and multiple supertypes are not allowed. +%% +%% * `meet` is used when we know more about a value (e.g. type tests), so it +%% must not return a more general type than either of its arguments. In other +%% words, we're only allowed to *add* knowledge in a `meet`. +%% +%% * `join` is used when we know less about a value (e.g. phi node), so it +%% must not return a more specific type than either of its arguments. In +%% other words we're only allowed to *remove* knowledge in a `join`. +%% +%% * Both `join` and `meet` must be commutative, associative, and idempotent. +%% +%% Maintaining the above may seem trivial but subtle errors can creep in when +%% adding fields or restrictions to a type. ?TUPLE_ELEMENT_LIMIT is a great +%% example of this. +%% +%% The property test suite ensures that the above holds, so don't forget to +%% add your new types there. You should also consider increasing ?REPETITIONS +%% during development to ensure it hits all nooks and crannies. +%% +%% [1] https://en.wikipedia.org/wiki/Lattice_(order)#General_lattice + +-define(ATOM_SET_SIZE, 5). + +-record(t_atom, {elements=any :: 'any' | ordsets:ordset(atom())}). +-record(t_bitstring, {size_unit=1 :: pos_integer()}). +-record(t_bs_context, {tail_unit=1 :: pos_integer(), + slots=0 :: non_neg_integer(), + valid=0 :: non_neg_integer()}). +-record(t_bs_matchable, {tail_unit=1}). +-record(t_float, {elements=any :: 'any' | {float(),float()}}). +-record(t_fun, {arity=any :: arity() | 'any', + type=any :: type() }). +-record(t_integer, {elements=any :: 'any' | {integer(),integer()}}). + +%% `super_key` and `super_value` are the join of all key and value types. +%% +%% Note that we don't track specific elements as we have no obvious way to +%% limit them. See ?TUPLE_ELEMENT_LIMIT for details. +-record(t_map, {super_key=any :: type(), + super_value=any :: type()}). + +%% `type` is the join of all list elements, and `terminator` is the tail of the +%% last cons cell ('nil' for proper lists). +%% +%% Note that `type` may not be updated unless the entire list is known, and +%% that the terminator being known is not a guarantee that the rest of the list +%% is. +-record(t_cons, {type=any :: type(), terminator=any :: type()}). +-record(t_list, {type=any :: type(), terminator=any :: type()}). + +-record(t_tuple, {size=0 :: integer(), + exact=false :: boolean(), + elements=#{} :: tuple_elements()}). + +%% Known element types, where the key is a 1-based integer index. Unknown +%% elements are assumed to be 'any', and indexes above ?TUPLE_ELEMENT_LIMIT are +%% ignored for performance reasons. +%% +%% Cutting off all indexes above a certain limit may seem strange, but is +%% required to ensure that a meet of two types always returns a type that's at +%% least as specific as either type. Consider the following types: +%% +%% A = #t_tuple{elements=#{ ... elements 1 .. 6 ... }} +%% B = #t_tuple{elements=#{ ... elements 7 .. 13 ... }} +%% +%% If we'd collapse types once a tuple has more than 12 elements, meet(A, B) +%% would suddenly be less specific than either A or B. Ignoring all elements +%% above a certain index avoids this problem, at the small price of losing type +%% information in huge tuples. + +-define(TUPLE_ELEMENT_LIMIT, 12). +-type tuple_elements() :: #{ Key :: pos_integer() => type() }. + +-type normal_type() :: any | none | + number | #t_float{} | #t_integer{} | + #t_atom{} | + #t_bitstring{} | #t_bs_context{} | #t_bs_matchable{} | + #t_fun{} | + #t_list{} | #t_cons{} | nil | + #t_map{} | + #t_tuple{}. + +-type record_key() :: {Arity :: integer(), Tag :: normal_type() }. +-type record_set() :: ordsets:ordset({record_key(), #t_tuple{}}). +-type tuple_set() :: #t_tuple{} | record_set(). + +-record(t_union, {atom=none :: none | #t_atom{}, + list=none :: none | #t_list{} | #t_cons{} | nil, + number=none :: none | number | #t_float{} | #t_integer{}, + tuple_set=none :: none | tuple_set(), + other=none :: normal_type()}). + +-type type() :: #t_union{} | normal_type(). + +-ifdef(BEAM_TYPES_INTERNAL). +%% Internal constants used by beam_types.erl and its whitebox tests +-define(TUPLE_SET_LIMIT, 12). +-define(MAX_TYPE_DEPTH, 4). +-endif. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 6e6574c0b3..9bf18911c5 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -88,11 +88,12 @@ split_even(Rs) -> split_even(Rs, [], []). %%% %%% Local functions. %%% - replace_labels_1([{test,Test,{f,Lbl},Ops}|Is], Acc, D, Fb) -> - replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Ops}|Acc], D, Fb); + I = {test,Test,{f,label(Lbl, D, Fb)},Ops}, + replace_labels_1(Is, [I | Acc], D, Fb); replace_labels_1([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D, Fb) -> - replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Live,Ops,Dst}|Acc], D, Fb); + I = {test,Test,{f,label(Lbl, D, Fb)},Live,Ops,Dst}, + replace_labels_1(Is, [I | Acc], D, Fb); replace_labels_1([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D, Fb) -> Vls = map(fun ({f,L}) -> {f,label(L, D, Fb)}; (Other) -> Other @@ -134,6 +135,9 @@ replace_labels_1([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D, Fb) replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Op,Src,Dst,Live,List}|Acc], D, Fb); replace_labels_1([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D, Fb) when Lbl =/= 0 -> replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Src,List}|Acc], D, Fb); +replace_labels_1([{bs_start_match4,{f,Lbl},Live,Src,Dst}|Is], Acc, D, Fb) -> + I = {bs_start_match4,{f,label(Lbl, D, Fb)},Live,Src,Dst}, + replace_labels_1(Is, [I | Acc], D, Fb); replace_labels_1([I|Is], Acc, D, Fb) -> replace_labels_1(Is, [I|Acc], D, Fb); replace_labels_1([], Acc, _, _) -> Acc. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 12aaa01b6b..8a71ac35e3 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -19,6 +19,10 @@ -module(beam_validator). +-include("beam_types.hrl"). + +-define(UNICODE_MAX, (16#10FFFF)). + -compile({no_auto_import,[min/2]}). %% Avoid warning for local function error/1 clashing with autoimported BIF. @@ -26,7 +30,6 @@ %% Interface for compiler. -export([module/2, format_error/1]). --export([type_anno/1, type_anno/2, type_anno/4]). -import(lists, [dropwhile/2,foldl/3,member/2,reverse/1,sort/1,zip/2]). @@ -45,34 +48,6 @@ module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) {error,[{atom_to_list(Mod),Es}]} end. -%% Provides a stable interface for type annotations, used by certain passes to -%% indicate that we can safely assume that a register has a given type. --spec type_anno(term()) -> term(). -type_anno(atom) -> {atom,[]}; -type_anno(bool) -> bool; -type_anno({binary,_}) -> binary; -type_anno(cons) -> cons; -type_anno(float) -> {float,[]}; -type_anno(integer) -> {integer,[]}; -type_anno(list) -> list; -type_anno(map) -> map; -type_anno(match_context) -> match_context; -type_anno(number) -> number; -type_anno(nil) -> nil. - --spec type_anno(term(), term()) -> term(). -type_anno(atom, Value) when is_atom(Value) -> {atom, Value}; -type_anno(float, Value) when is_float(Value) -> {float, Value}; -type_anno(integer, Value) when is_integer(Value) -> {integer, Value}. - --spec type_anno(term(), term(), term(), term()) -> term(). -type_anno(tuple, Size, Exact, Elements) when is_integer(Size), Size >= 0, - is_map(Elements) -> - case Exact of - true -> {tuple, Size, Elements}; - false -> {tuple, [Size], Elements} - end. - -spec format_error(term()) -> iolist(). format_error({{_M,F,A},{I,Off,limit}}) -> @@ -119,7 +94,7 @@ format_error(Error) -> %% format as used in the compiler and in .S files. validate(Module, Fs) -> - Ft = index_parameter_types(Fs, []), + Ft = build_function_table(Fs, []), validate_0(Module, Fs, Ft). validate_0(_Module, [], _) -> []; @@ -127,17 +102,24 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> try validate_1(Code, Name, Ar, Entry, Ft) of _ -> validate_0(Module, Fs, Ft) catch - throw:Error -> - %% Controlled error. - [Error|validate_0(Module, Fs, Ft)]; + throw:Error -> + %% Controlled error. + [Error|validate_0(Module, Fs, Ft)]; Class:Error:Stack -> %% Crash. io:fwrite("Function: ~w/~w\n", [Name,Ar]), erlang:raise(Class, Error, Stack) end. +-record(t_abstract, {kind}). + +%% The types are the same as in 'beam_types.hrl', with the addition of +%% #t_abstract{} that describes tuples under construction, match context +%% positions, and so on. +-type validator_type() :: #t_abstract{} | type(). + -record(value_ref, {id :: index()}). --record(value, {op :: term(), args :: [argument()], type :: type()}). +-record(value, {op :: term(), args :: [argument()], type :: validator_type()}). -type argument() :: #value_ref{} | literal(). @@ -149,34 +131,28 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> {literal, term()} | nil. --type tuple_sz() :: [non_neg_integer()] | %% Inexact - non_neg_integer(). %% Exact. - -%% Match context type. --record(ms, - {id=make_ref() :: reference(), %Unique ID. - valid=0 :: non_neg_integer(), %Valid slots - slots=0 :: non_neg_integer() %Number of slots - }). - --type type() :: binary | - cons | - list | - map | - nil | - #ms{} | - ms_position | - none | - number | - term | - tuple_in_progress | - {tuple, tuple_sz(), #{ literal() => type() }} | - literal(). - +%% Register tags describe the state of the register rather than the value they +%% contain (if any). +%% +%% initialized The register has been initialized with some valid term +%% so that it is safe to pass to the garbage collector. +%% NOT safe to use in any other way (will not crash the +%% emulator, but clearly points to a bug in the compiler). +%% +%% uninitialized The register contains any old garbage and can not be +%% passed to the garbage collector. +%% +%% {catchtag,[Lbl]} A special term used within a catch. Must only be used +%% by the catch instructions; NOT safe to use in other +%% instructions. +%% +%% {trytag,[Lbl]} A special term used within a try block. Must only be +%% used by the catch instructions; NOT safe to use in other +%% instructions. -type tag() :: initialized | uninitialized | - {catchtag, [label()]} | - {trytag, [label()]}. + {catchtag, ordsets:ordset(label())} | + {trytag, ordsets:ordset(label())}. -type x_regs() :: #{ {x, index()} => #value_ref{} }. -type y_regs() :: #{ {y, index()} => tag() | #value_ref{} }. @@ -200,11 +176,11 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> numy=none :: none | undecided | index(), %% Available heap size. h=0, - %Available heap size for floats. + %%Available heap size for floats. hf=0, %% Floating point state. fls=undefined, - %% List of hot catch/try labels + %% List of hot catch/try tags ct=[], %% Previous instruction was setelement/3. setelem=false, @@ -230,36 +206,34 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> branched=gb_trees:empty() :: branched_tab(), %% All defined labels labels=gb_sets:empty() :: label_set(), - %% Argument information of other functions in the module + %% Information of other functions in the module ft=gb_trees:empty() :: ft_tab(), %% Counter for #value_ref{} creation ref_ctr=0 :: index() }). -index_parameter_types([{function,_,_,Entry,Code0}|Fs], Acc0) -> +build_function_table([{function,_,Arity,Entry,Code0}|Fs], Acc0) -> Code = dropwhile(fun({label,L}) when L =:= Entry -> false; (_) -> true end, Code0), case Code of [{label,Entry}|Is] -> - Acc = index_parameter_types_1(Is, Entry, Acc0), - index_parameter_types(Fs, Acc); + Info = #{ arity => Arity, + parameter_info => find_parameter_info(Is, #{}) }, + build_function_table(Fs, [{Entry, Info} | Acc0]); _ -> - %% Something serious is wrong. Ignore it for now. + %% Something is seriously wrong. Ignore it for now. %% It will be detected and diagnosed later. - index_parameter_types(Fs, Acc0) + build_function_table(Fs, Acc0) end; -index_parameter_types([], Acc) -> +build_function_table([], Acc) -> gb_trees:from_orddict(sort(Acc)). -index_parameter_types_1([{'%', {type_info, Reg, Type0}} | Is], Entry, Acc) -> - Type = case Type0 of - match_context -> #ms{}; - _ -> Type0 - end, - Key = {Entry, Reg}, - index_parameter_types_1(Is, Entry, [{Key, Type} | Acc]); -index_parameter_types_1(_, _, Acc) -> +find_parameter_info([{'%', {var_info, Reg, Info}} | Is], Acc) -> + find_parameter_info(Is, Acc#{ Reg => Info }); +find_parameter_info([{'%', _} | Is], Acc) -> + find_parameter_info(Is, Acc); +find_parameter_info(_, Acc) -> Acc. validate_1(Is, Name, Arity, Entry, Ft) -> @@ -278,7 +252,7 @@ validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) -> EntryOK -> Vst0 = init_vst(Arity, Ls1, Ls2, Ft), MFA = {Mod,Name,Arity}, - Vst = valfun(Is, MFA, Offset, Vst0), + Vst = validate_instrs(Is, MFA, Offset, Vst0), validate_fun_info_branches(Ls1, MFA, Vst); true -> error({{Mod,Name,Arity},{first(Is),Offset,no_entry_label}}) @@ -331,12 +305,12 @@ init_vst(Arity, Ls1, Ls2, Ft) -> init_function_args(-1, Vst) -> Vst; init_function_args(X, Vst) -> - init_function_args(X - 1, create_term(term, argument, [], {x,X}, Vst)). + init_function_args(X - 1, create_term(any, argument, [], {x,X}, Vst)). kill_heap_allocation(St) -> St#st{h=0,hf=0}. -valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> +validate_instrs([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> Targets = gb_trees:keys(Targets0), Labels = gb_sets:to_list(Labels0), case Targets -- Labels of @@ -345,109 +319,134 @@ valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> Error = {undef_labels,Undef}, error({MFA,Error}) end; -valfun([I|Is], MFA, Offset, Vst0) -> - valfun(Is, MFA, Offset+1, +validate_instrs([I|Is], MFA, Offset, Vst0) -> + validate_instrs(Is, MFA, Offset+1, try - Vst = val_dsetel(I, Vst0), - valfun_1(I, Vst) + Vst = validate_mutation(I, Vst0), + vi_safe(I, Vst) catch Error -> error({MFA,{I,Offset,Error}}) end). -%% Instructions that are allowed in dead code or when failing, -%% that is while the state is undecided in some way. -valfun_1({label,Lbl}, #vst{current=St0, - ref_ctr=Counter0, - branched=B, - labels=Lbls}=Vst) -> +%%% +%%% vi_safe/2 handles instructions that will never throw an exception, and can +%%% thus be used when the state is undecided in some way. +%%% +vi_safe({label,Lbl}, #vst{current=St0, + ref_ctr=Counter0, + branched=B, + labels=Lbls}=Vst) -> {St, Counter} = merge_states(Lbl, St0, B, Counter0), Vst#vst{current=St, ref_ctr=Counter, branched=gb_trees:enter(Lbl, St, B), labels=gb_sets:add(Lbl, Lbls)}; -valfun_1(_I, #vst{current=none}=Vst) -> - %% Ignore instructions after erlang:error/1,2, which - %% the original R10B compiler thought would return. +vi_safe(_I, #vst{current=none}=Vst) -> + %% Ignore all unreachable code. Vst; -valfun_1({badmatch,Src}, Vst) -> - assert_durable_term(Src, Vst), - verify_y_init(Vst), - kill_state(Vst); -valfun_1({case_end,Src}, Vst) -> - assert_durable_term(Src, Vst), - verify_y_init(Vst), - kill_state(Vst); -valfun_1(if_end, Vst) -> - verify_y_init(Vst), - kill_state(Vst); -valfun_1({try_case_end,Src}, Vst) -> - verify_y_init(Vst), - assert_durable_term(Src, Vst), - kill_state(Vst); -%% Instructions that cannot cause exceptions -valfun_1({bs_get_tail,Ctx,Dst,Live}, Vst0) -> - bsm_validate_context(Ctx, Vst0), +vi_safe({bs_get_tail,Ctx,Dst,Live}, Vst0) -> + assert_type(#t_bs_context{}, Ctx, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), + + #t_bs_context{tail_unit=Unit} = get_raw_type(Ctx, Vst0), + Vst = prune_x_regs(Live, Vst0), - extract_term(binary, bs_get_tail, [Ctx], Dst, Vst, Vst0); -valfun_1(bs_init_writable=I, Vst) -> + extract_term(#t_bitstring{size_unit=Unit}, bs_get_tail, [Ctx], Dst, + Vst, Vst0); +vi_safe(bs_init_writable=I, Vst) -> call(I, 1, Vst); -valfun_1(build_stacktrace=I, Vst) -> +vi_safe(build_stacktrace=I, Vst) -> call(I, 1, Vst); -valfun_1({move,Src,Dst}, Vst) -> +vi_safe({move,Src,Dst}, Vst) -> assign(Src, Dst, Vst); -valfun_1({fmove,Src,{fr,_}=Dst}, Vst) -> - assert_type(float, Src, Vst), +vi_safe({swap,RegA,RegB}, Vst0) -> + assert_movable(RegA, Vst0), + assert_movable(RegB, Vst0), + + %% We don't expect fragile registers to be swapped. + %% Therefore, we can conservatively make both registers + %% fragile if one of the register is fragile instead of + %% swapping the fragility of the registers. + Sources = [RegA,RegB], + Vst1 = propagate_fragility(RegA, Sources, Vst0), + Vst2 = propagate_fragility(RegB, Sources, Vst1), + + %% Swap the value references. + VrefA = get_reg_vref(RegA, Vst2), + VrefB = get_reg_vref(RegB, Vst2), + Vst = set_reg_vref(VrefB, RegA, Vst2), + set_reg_vref(VrefA, RegB, Vst); +vi_safe({fmove,Src,{fr,_}=Dst}, Vst) -> + assert_type(#t_float{}, Src, Vst), set_freg(Dst, Vst); -valfun_1({fmove,{fr,_}=Src,Dst}, Vst0) -> +vi_safe({fmove,{fr,_}=Src,Dst}, Vst0) -> assert_freg_set(Src, Vst0), assert_fls(checked, Vst0), Vst = eat_heap_float(Vst0), - create_term({float,[]}, fmove, [], Dst, Vst); -valfun_1({kill,Reg}, Vst) -> + create_term(#t_float{}, fmove, [], Dst, Vst); +vi_safe({kill,Reg}, Vst) -> create_tag(initialized, kill, [], Reg, Vst); -valfun_1({init,Reg}, Vst) -> +vi_safe({init,Reg}, Vst) -> create_tag(initialized, init, [], Reg, Vst); -valfun_1({test_heap,Heap,Live}, Vst) -> +vi_safe({test_heap,Heap,Live}, Vst) -> test_heap(Heap, Live, Vst); -valfun_1({bif,Op,{f,_},Ss,Dst}=I, Vst) -> - case is_bif_safe(Op, length(Ss)) of - false -> - %% Since the BIF can fail, make sure that any catch state - %% is updated. - valfun_2(I, Vst); - true -> - %% It can't fail, so we finish handling it here (not updating - %% catch state). - validate_src(Ss, Vst), - Type = bif_return_type(Op, Ss, Vst), - extract_term(Type, {bif,Op}, Ss, Dst, Vst) +vi_safe({bif,Op,{f,0},Ss,Dst}=I, Vst0) -> + case will_bif_succeed(Op, Ss, Vst0) of + yes -> + %% This BIF cannot fail, handle it here without updating catch + %% state. + validate_bif(Op, cannot_fail, Ss, Dst, Vst0); + no -> + %% The stack will be scanned, so Y registers must be initialized. + Vst = branch_exception(Vst0), + verify_y_init(Vst), + kill_state(Vst); + maybe -> + %% The BIF can fail, make sure that any catch state is updated. + Vst = branch_exception(Vst0), + vi_float(I, Vst) + end; +vi_safe({gc_bif,Op,{f,0},Live,Ss,Dst}=I, Vst0) -> + case will_bif_succeed(Op, Ss, Vst0) of + yes -> + validate_gc_bif(Op, cannot_fail, Ss, Dst, Live, Vst0); + no -> + Vst = branch_exception(Vst0), + verify_y_init(Vst), + kill_state(Vst); + maybe -> + Vst = branch_exception(Vst0), + assert_float_checked(Vst), + vi_float(I, Vst) end; %% Put instructions. -valfun_1({put_list,A,B,Dst}, Vst0) -> - assert_term(A, Vst0), - assert_term(B, Vst0), +vi_safe({put_list,A,B,Dst}, Vst0) -> Vst = eat_heap(2, Vst0), - create_term(cons, put_list, [A, B], Dst, Vst); -valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> + + Head = get_term_type(A, Vst), + Tail = get_term_type(B, Vst), + + create_term(beam_types:make_cons(Head, Tail), put_list, [A, B], Dst, Vst); +vi_safe({put_tuple2,Dst,{list,Elements}}, Vst0) -> _ = [assert_term(El, Vst0) || El <- Elements], Size = length(Elements), Vst = eat_heap(Size+1, Vst0), {Es,_} = foldl(fun(Val, {Es0, Index}) -> Type = get_term_type(Val, Vst0), - Es = set_element_type({integer,Index}, Type, Es0), + Es = beam_types:set_tuple_element(Index, Type, Es0), {Es, Index + 1} end, {#{}, 1}, Elements), - Type = {tuple,Size,Es}, + Type = #t_tuple{exact=true,size=Size,elements=Es}, create_term(Type, put_tuple2, [], Dst, Vst); -valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> +vi_safe({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> Vst1 = eat_heap(1, Vst0), - Vst = create_term(tuple_in_progress, put_tuple, [], Dst, Vst1), + Vst = create_term(#t_abstract{kind=unfinished_tuple}, put_tuple, [], + Dst, Vst1), #vst{current=St0} = Vst, St = St0#st{puts_left={Sz,{Dst,Sz,#{}}}}, Vst#vst{current=St}; -valfun_1({put,Src}, Vst0) -> +vi_safe({put,Src}, Vst0) -> assert_term(Src, Vst0), Vst = eat_heap(1, Vst0), #vst{current=St0} = Vst, @@ -455,35 +454,46 @@ valfun_1({put,Src}, Vst0) -> #st{puts_left=none} -> error(not_building_a_tuple); #st{puts_left={1,{Dst,Sz,Es0}}} -> - Es = Es0#{ {integer,Sz} => get_term_type(Src, Vst0) }, + ElementType = get_term_type(Src, Vst0), + Es = beam_types:set_tuple_element(Sz, ElementType, Es0), St = St0#st{puts_left=none}, - create_term({tuple,Sz,Es}, put_tuple, [], Dst, Vst#vst{current=St}); + Type = #t_tuple{exact=true,size=Sz,elements=Es}, + create_term(Type, put_tuple, [], Dst, Vst#vst{current=St}); #st{puts_left={PutsLeft,{Dst,Sz,Es0}}} when is_integer(PutsLeft) -> Index = Sz - PutsLeft + 1, - Es = Es0#{ {integer,Index} => get_term_type(Src, Vst0) }, + ElementType = get_term_type(Src, Vst0), + Es = beam_types:set_tuple_element(Index, ElementType, Es0), St = St0#st{puts_left={PutsLeft-1,{Dst,Sz,Es}}}, Vst#vst{current=St} end; +%% This instruction never fails, though it may be invalid in some contexts; see +%% validate_mutation/2 +vi_safe({set_tuple_element,Src,Tuple,N}, Vst) -> + I = N + 1, + assert_term(Src, Vst), + assert_type(#t_tuple{size=I}, Tuple, Vst), + %% Manually update the tuple type; we can't rely on the ordinary update + %% helpers as we must support overwriting (rather than just widening or + %% narrowing) known elements, and we can't use extract_term either since + %% the source tuple may be aliased. + #t_tuple{elements=Es0}=Type = normalize(get_term_type(Tuple, Vst)), + Es = beam_types:set_tuple_element(I, get_term_type(Src, Vst), Es0), + override_type(Type#t_tuple{elements=Es}, Tuple, Vst); %% Instructions for optimization of selective receives. -valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) -> +vi_safe({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) -> set_receive_marker(initialized, Vst); -valfun_1({recv_set,{f,Fail}}, Vst) when is_integer(Fail) -> +vi_safe({recv_set,{f,Fail}}, Vst) when is_integer(Fail) -> set_receive_marker(committed, Vst); %% Misc. -valfun_1(remove_message, Vst0) -> +vi_safe(remove_message, Vst0) -> Vst = set_receive_marker(none, Vst0), %% The message term is no longer fragile. It can be used %% without restrictions. remove_fragility(Vst); -valfun_1({'%', {type_info, Reg, match_context}}, Vst) -> - update_type(fun meet/2, #ms{}, Reg, Vst); -valfun_1({'%', {type_info, Reg, Type}}, Vst) -> - %% Explicit type information inserted by optimization passes to indicate - %% that Reg has a certain type, so that we can accept cross-function type - %% optimizations. - update_type(fun meet/2, Type, Reg, Vst); -valfun_1({'%', {remove_fragility, Reg}}, Vst) -> +vi_safe({'%', {var_info, Reg, Info}}, Vst) -> + validate_var_info(Info, Reg, Vst); +vi_safe({'%', {remove_fragility, Reg}}, Vst) -> %% This is a hack to make prim_eval:'receive'/2 work. %% %% Normally it's illegal to pass fragile terms as a function argument as we @@ -491,40 +501,50 @@ valfun_1({'%', {remove_fragility, Reg}}, Vst) -> %% prim_eval:'receive'/2 won't leak the term, nor cause a GC since it's %% disabled while matching messages. remove_fragility(Reg, Vst); -valfun_1({'%',_}, Vst) -> +vi_safe({'%',_}, Vst) -> Vst; -valfun_1({line,_}, Vst) -> +vi_safe({line,_}, Vst) -> Vst; -%% Exception generating calls -valfun_1({call_ext,Live,Func}=I, Vst) -> - case call_return_type(Func, Vst) of - exception -> - verify_live(Live, Vst), - %% The stack will be scanned, so Y registers - %% must be initialized. - verify_y_init(Vst), - kill_state(Vst); - _ -> - valfun_2(I, Vst) - end; -valfun_1(_I, #vst{current=#st{ct=undecided}}) -> + +%% +%% Calls; these may be okay when the try/catch state or stack is undecided, +%% depending on whether they always succeed or always fail. +%% +vi_safe({apply,Live}, Vst) -> + validate_body_call(apply, Live+2, Vst); +vi_safe({apply_last,Live,N}, Vst) -> + validate_tail_call(N, apply, Live+2, Vst); +vi_safe({call,Live,Func}, Vst) -> + validate_body_call(Func, Live, Vst); +vi_safe({call_ext,Live,Func}, Vst) -> + validate_body_call(Func, Live, Vst); +vi_safe({call_only,Live,Func}, Vst) -> + validate_tail_call(none, Func, Live, Vst); +vi_safe({call_ext_only,Live,Func}, Vst) -> + validate_tail_call(none, Func, Live, Vst); +vi_safe({call_last,Live,Func,N}, Vst) -> + validate_tail_call(N, Func, Live, Vst); +vi_safe({call_ext_last,Live,Func,N}, Vst) -> + validate_tail_call(N, Func, Live, Vst); +vi_safe(_I, #vst{current=#st{ct=undecided}}) -> error(unknown_catch_try_state); %% %% Allocate and deallocate, et.al -valfun_1({allocate,Stk,Live}, Vst) -> +%% +vi_safe({allocate,Stk,Live}, Vst) -> allocate(uninitialized, Stk, 0, Live, Vst); -valfun_1({allocate_heap,Stk,Heap,Live}, Vst) -> +vi_safe({allocate_heap,Stk,Heap,Live}, Vst) -> allocate(uninitialized, Stk, Heap, Live, Vst); -valfun_1({allocate_zero,Stk,Live}, Vst) -> +vi_safe({allocate_zero,Stk,Live}, Vst) -> allocate(initialized, Stk, 0, Live, Vst); -valfun_1({allocate_heap_zero,Stk,Heap,Live}, Vst) -> +vi_safe({allocate_heap_zero,Stk,Heap,Live}, Vst) -> allocate(initialized, Stk, Heap, Live, Vst); -valfun_1({deallocate,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) -> +vi_safe({deallocate,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) -> verify_no_ct(Vst), deallocate(Vst); -valfun_1({deallocate,_}, #vst{current=#st{numy=NumY}}) -> +vi_safe({deallocate,_}, #vst{current=#st{numy=NumY}}) -> error({allocated,NumY}); -valfun_1({trim,N,Remaining}, #vst{current=St0}=Vst) -> +vi_safe({trim,N,Remaining}, #vst{current=St0}=Vst) -> #st{numy=NumY} = St0, if N =< NumY, N+Remaining =:= NumY -> @@ -533,13 +553,13 @@ valfun_1({trim,N,Remaining}, #vst{current=St0}=Vst) -> error({trim,N,Remaining,allocated,NumY}) end; %% Catch & try. -valfun_1({'catch',Dst,{f,Fail}}, Vst) when Fail =/= none -> +vi_safe({'catch',Dst,{f,Fail}}, Vst) when Fail =/= none -> init_try_catch_branch(catchtag, Dst, Fail, Vst); -valfun_1({'try',Dst,{f,Fail}}, Vst) when Fail =/= none -> +vi_safe({'try',Dst,{f,Fail}}, Vst) when Fail =/= none -> init_try_catch_branch(trytag, Dst, Fail, Vst); -valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> +vi_safe({catch_end,Reg}, #vst{current=#st{ct=[Tag|_]}}=Vst0) -> case get_tag_type(Reg, Vst0) of - {catchtag,Fail} -> + {catchtag,_Fail}=Tag -> %% Kill the catch tag and receive marker. %% %% The marker is only cleared when an exception is thrown, but it's @@ -548,164 +568,116 @@ valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> Vst = set_receive_marker(none, Vst1), %% {x,0} contains the caught term, if any. - create_term(term, catch_end, [], {x,0}, Vst); + create_term(any, catch_end, [], {x,0}, Vst); Type -> error({wrong_tag_type,Type}) end; -valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst) -> +vi_safe({try_end,Reg}, #vst{current=#st{ct=[Tag|_]}}=Vst) -> case get_tag_type(Reg, Vst) of - {trytag,Fail} -> + {trytag,_Fail}=Tag -> %% Kill the catch tag. Note that x registers and the receive marker %% are unaffected. kill_catch_tag(Reg, Vst); Type -> error({wrong_tag_type,Type}) end; -valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> +vi_safe({try_case,Reg}, #vst{current=#st{ct=[Tag|_]}}=Vst0) -> case get_tag_type(Reg, Vst0) of - {trytag,Fail} -> + {trytag,_Fail}=Tag -> %% Kill the catch tag, all x registers, and the receive marker. Vst1 = kill_catch_tag(Reg, Vst0), Vst2 = prune_x_regs(0, Vst1), Vst3 = set_receive_marker(none, Vst2), %% Class:Error:Stacktrace - Vst4 = create_term({atom,[]}, try_case, [], {x,0}, Vst3), - Vst = create_term(term, try_case, [], {x,1}, Vst4), - create_term(term, try_case, [], {x,2}, Vst); + Vst4 = create_term(#t_atom{}, try_case, [], {x,0}, Vst3), + Vst = create_term(any, try_case, [], {x,1}, Vst4), + create_term(any, try_case, [], {x,2}, Vst); Type -> error({wrong_tag_type,Type}) end; -valfun_1({get_list,Src,D1,D2}, Vst0) -> +%% Simple getters that can't fail. +vi_safe({get_list,Src,D1,D2}, Vst0) -> assert_not_literal(Src), - assert_type(cons, Src, Vst0), - Vst = extract_term(term, get_hd, [Src], D1, Vst0), - extract_term(term, get_tl, [Src], D2, Vst); -valfun_1({get_hd,Src,Dst}, Vst) -> + assert_type(#t_cons{}, Src, Vst0), + + SrcType = get_term_type(Src, Vst0), + {HeadType, _, _} = beam_call_types:types(erlang, hd, [SrcType]), + {TailType, _, _} = beam_call_types:types(erlang, tl, [SrcType]), + + Vst = extract_term(HeadType, get_hd, [Src], D1, Vst0), + extract_term(TailType, get_tl, [Src], D2, Vst, Vst0); +vi_safe({get_hd,Src,Dst}, Vst) -> assert_not_literal(Src), - assert_type(cons, Src, Vst), - extract_term(term, get_hd, [Src], Dst, Vst); -valfun_1({get_tl,Src,Dst}, Vst) -> + assert_type(#t_cons{}, Src, Vst), + + SrcType = get_term_type(Src, Vst), + {HeadType, _, _} = beam_call_types:types(erlang, hd, [SrcType]), + + extract_term(HeadType, get_hd, [Src], Dst, Vst); +vi_safe({get_tl,Src,Dst}, Vst) -> assert_not_literal(Src), - assert_type(cons, Src, Vst), - extract_term(term, get_tl, [Src], Dst, Vst); -valfun_1({get_tuple_element,Src,N,Dst}, Vst) -> + assert_type(#t_cons{}, Src, Vst), + + SrcType = get_term_type(Src, Vst), + {TailType, _, _} = beam_call_types:types(erlang, tl, [SrcType]), + + extract_term(TailType, get_tl, [Src], Dst, Vst); +vi_safe({get_tuple_element,Src,N,Dst}, Vst) -> + Index = N+1, assert_not_literal(Src), - assert_type({tuple_element,N+1}, Src, Vst), - Index = {integer,N+1}, - Type = get_element_type(Index, Src, Vst), - extract_term(Type, {bif,element}, [Index, Src], Dst, Vst); -valfun_1({jump,{f,Lbl}}, Vst) -> + assert_type(#t_tuple{size=Index}, Src, Vst), + #t_tuple{elements=Es} = normalize(get_term_type(Src, Vst)), + Type = beam_types:get_tuple_element(Index, Es), + extract_term(Type, {bif,element}, [{integer,Index}, Src], Dst, Vst); +vi_safe({jump,{f,Lbl}}, Vst) -> branch(Lbl, Vst, fun(SuccVst) -> %% The next instruction is never executed. kill_state(SuccVst) end); -valfun_1(return, Vst) -> +vi_safe(return, Vst) -> assert_durable_term({x,0}, Vst), - verify_return(Vst), - kill_state(Vst); + verify_return(Vst); -valfun_1({set_tuple_element,Src,Tuple,N}, Vst) -> - I = N + 1, - assert_term(Src, Vst), - assert_type({tuple_element,I}, Tuple, Vst), - %% Manually update the tuple type; we can't rely on the ordinary update - %% helpers as we must support overwriting (rather than just widening or - %% narrowing) known elements, and we can't use extract_term either since - %% the source tuple may be aliased. - {tuple, Sz, Es0} = get_term_type(Tuple, Vst), - Es = set_element_type({integer,I}, get_term_type(Src, Vst), Es0), - override_type({tuple, Sz, Es}, Tuple, Vst); +%% +%% Matching and test instructions. +%% -%% Match instructions. -valfun_1({select_val,Src,{f,Fail},{list,Choices}}, Vst) -> +vi_safe({select_val,Src,{f,Fail},{list,Choices}}, Vst) -> assert_term(Src, Vst), assert_choices(Choices), validate_select_val(Fail, Choices, Src, Vst); -valfun_1({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> - assert_type(tuple, Tuple, Vst), +vi_safe({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> + assert_type(#t_tuple{}, Tuple, Vst), assert_arities(Choices), validate_select_tuple_arity(Fail, Choices, Tuple, Vst); - -%% New bit syntax matching instructions. -valfun_1({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst) -> - validate_bs_start_match(Fail, Live, bsm_match_state(), Src, Dst, Vst); -valfun_1({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst) -> - validate_bs_start_match(Fail, Live, bsm_match_state(Slots), Src, Dst, Vst); -valfun_1({test,bs_match_string,{f,Fail},[Ctx,_,_]}, Vst) -> - bsm_validate_context(Ctx, Vst), - branch(Fail, Vst, fun(V) -> V end); -valfun_1({test,bs_skip_bits2,{f,Fail},[Ctx,Src,_,_]}, Vst) -> - bsm_validate_context(Ctx, Vst), - assert_term(Src, Vst), - branch(Fail, Vst, fun(V) -> V end); -valfun_1({test,bs_test_tail2,{f,Fail},[Ctx,_]}, Vst) -> - bsm_validate_context(Ctx, Vst), - branch(Fail, Vst, fun(V) -> V end); -valfun_1({test,bs_test_unit,{f,Fail},[Ctx,_]}, Vst) -> - bsm_validate_context(Ctx, Vst), - branch(Fail, Vst, fun(V) -> V end); -valfun_1({test,bs_skip_utf8,{f,Fail},[Ctx,Live,_]}, Vst) -> - validate_bs_skip_utf(Fail, Ctx, Live, Vst); -valfun_1({test,bs_skip_utf16,{f,Fail},[Ctx,Live,_]}, Vst) -> - validate_bs_skip_utf(Fail, Ctx, Live, Vst); -valfun_1({test,bs_skip_utf32,{f,Fail},[Ctx,Live,_]}, Vst) -> - validate_bs_skip_utf(Fail, Ctx, Live, Vst); -valfun_1({test,bs_get_integer2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_1({test,bs_get_float2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {float, []}, Dst, Vst); -valfun_1({test,bs_get_binary2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, binary, Dst, Vst); -valfun_1({test,bs_get_utf8=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_1({test,bs_get_utf16=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_1({test,bs_get_utf32=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_1({bs_save2,Ctx,SavePoint}, Vst) -> - bsm_save(Ctx, SavePoint, Vst); -valfun_1({bs_restore2,Ctx,SavePoint}, Vst) -> - bsm_restore(Ctx, SavePoint, Vst); -valfun_1({bs_get_position, Ctx, Dst, Live}, Vst0) -> - bsm_validate_context(Ctx, Vst0), - verify_live(Live, Vst0), - verify_y_init(Vst0), - Vst = prune_x_regs(Live, Vst0), - create_term(ms_position, bs_get_position, [Ctx], Dst, Vst, Vst0); -valfun_1({bs_set_position, Ctx, Pos}, Vst) -> - bsm_validate_context(Ctx, Vst), - assert_type(ms_position, Pos, Vst), - Vst; -valfun_1({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> - assert_type(map, Src, Vst), - assert_unique_map_keys(List), - branch(Lbl, Vst, fun(V) -> V end); -valfun_1({test,is_atom,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {atom,[]}, Src, Vst); -valfun_1({test,is_binary,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, binary, Src, Vst); -valfun_1({test,is_bitstr,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, binary, Src, Vst); -valfun_1({test,is_boolean,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, bool, Src, Vst); -valfun_1({test,is_float,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {float,[]}, Src, Vst); -valfun_1({test,is_tuple,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {tuple,[0],#{}}, Src, Vst); -valfun_1({test,is_integer,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {integer,[]}, Src, Vst); -valfun_1({test,is_nonempty_list,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, cons, Src, Vst); -valfun_1({test,is_number,{f,Lbl},[Src]}, Vst) -> +vi_safe({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> + verify_has_map_fields(Lbl, Src, List, Vst); +vi_safe({test,is_atom,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_atom{}, Src, Vst); +vi_safe({test,is_binary,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_bitstring{size_unit=8}, Src, Vst); +vi_safe({test,is_bitstr,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_bitstring{}, Src, Vst); +vi_safe({test,is_boolean,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, beam_types:make_boolean(), Src, Vst); +vi_safe({test,is_float,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_float{}, Src, Vst); +vi_safe({test,is_tuple,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_tuple{}, Src, Vst); +vi_safe({test,is_integer,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_integer{}, Src, Vst); +vi_safe({test,is_nonempty_list,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_cons{}, Src, Vst); +vi_safe({test,is_number,{f,Lbl},[Src]}, Vst) -> type_test(Lbl, number, Src, Vst); -valfun_1({test,is_list,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, list, Src, Vst); -valfun_1({test,is_map,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, map, Src, Vst); -valfun_1({test,is_nil,{f,Lbl},[Src]}, Vst) -> +vi_safe({test,is_list,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_list{}, Src, Vst); +vi_safe({test,is_map,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, #t_map{}, Src, Vst); +vi_safe({test,is_nil,{f,Lbl},[Src]}, Vst) -> %% is_nil is an exact check against the 'nil' value, and should not be %% treated as a simple type test. assert_term(Src, Vst), @@ -716,15 +688,16 @@ valfun_1({test,is_nil,{f,Lbl},[Src]}, Vst) -> fun(SuccVst) -> update_eq_types(Src, nil, SuccVst) end); -valfun_1({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> - assert_type(tuple, Tuple, Vst), - Type = {tuple, Sz, #{}}, +vi_safe({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> + assert_type(#t_tuple{}, Tuple, Vst), + Type = #t_tuple{exact=true,size=Sz}, type_test(Lbl, Type, Tuple, Vst); -valfun_1({test,is_tagged_tuple,{f,Lbl},[Src,Sz,Atom]}, Vst) -> +vi_safe({test,is_tagged_tuple,{f,Lbl},[Src,Sz,Atom]}, Vst) -> assert_term(Src, Vst), - Type = {tuple, Sz, #{ {integer,1} => Atom }}, + Es = #{ 1 => get_literal_type(Atom) }, + Type = #t_tuple{exact=true,size=Sz,elements=Es}, type_test(Lbl, Type, Src, Vst); -valfun_1({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> +vi_safe({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> validate_src(Ss, Vst), branch(Lbl, Vst, fun(FailVst) -> @@ -733,7 +706,7 @@ valfun_1({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> fun(SuccVst) -> update_eq_types(Src, Val, SuccVst) end); -valfun_1({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> +vi_safe({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> validate_src(Ss, Vst), branch(Lbl, Vst, fun(FailVst) -> @@ -742,63 +715,220 @@ valfun_1({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> fun(SuccVst) -> update_ne_types(Src, Val, SuccVst) end); -valfun_1({test,_Op,{f,Lbl},Src}, Vst) -> +%% +%% New bit syntax matching instructions. +%% +vi_safe({bs_start_match4,Fail,Live,Src,Dst}, Vst) -> + validate_bs_start_match(Fail, Live, 0, Src, Dst, Vst); +vi_safe({test,bs_start_match3,{f,_}=Fail,Live,[Src],Dst}, Vst) -> + validate_bs_start_match(Fail, Live, 0, Src, Dst, Vst); +vi_safe({test,bs_start_match2,{f,_}=Fail,Live,[Src,Slots],Dst}, Vst) -> + validate_bs_start_match(Fail, Live, Slots, Src, Dst, Vst); +%% +%% Bit syntax positioning +%% +vi_safe({bs_save2,Ctx,SavePoint}, Vst) -> + bsm_save(Ctx, SavePoint, Vst); +vi_safe({bs_restore2,Ctx,SavePoint}, Vst) -> + bsm_restore(Ctx, SavePoint, Vst); +vi_safe({bs_get_position, Ctx, Dst, Live}, Vst0) -> + assert_type(#t_bs_context{}, Ctx, Vst0), + verify_live(Live, Vst0), + verify_y_init(Vst0), + Vst = prune_x_regs(Live, Vst0), + create_term(#t_abstract{kind=ms_position}, bs_get_position, [Ctx], + Dst, Vst, Vst0); +vi_safe({bs_set_position, Ctx, Pos}, Vst) -> + assert_type(#t_bs_context{}, Ctx, Vst), + assert_type(#t_abstract{kind=ms_position}, Pos, Vst), + Vst; +%% +%% Bit syntax matching +%% +vi_safe({test,bs_match_string,{f,Fail},[Ctx,Rem,{string,String}]}, Vst) -> + true = is_bitstring(String), %Assertion. + Stride = bit_size(String) + Rem, + validate_bs_skip(Fail, Ctx, Stride, Vst); +vi_safe({test,bs_skip_bits2,{f,Fail},[Ctx,Size,Unit,_Flags]}, Vst) -> + assert_term(Size, Vst), + + Stride = case get_raw_type(Size, Vst) of + #t_integer{elements={Same,Same}} -> Same * Unit; + _ -> Unit + end, + + validate_bs_skip(Fail, Ctx, Stride, Vst); +vi_safe({test,bs_test_tail2,{f,Fail},[Ctx,_Size]}, Vst) -> + assert_type(#t_bs_context{}, Ctx, Vst), + branch(Fail, Vst, fun(V) -> V end); +vi_safe({test,bs_test_unit,{f,Fail},[Ctx,Unit]}, Vst) -> + assert_type(#t_bs_context{}, Ctx, Vst), + type_test(Fail, #t_bs_context{tail_unit=Unit}, Ctx, Vst); +vi_safe({test,bs_skip_utf8,{f,Fail},[Ctx,Live,_]}, Vst) -> + validate_bs_skip(Fail, Ctx, 8, Live, Vst); +vi_safe({test,bs_skip_utf16,{f,Fail},[Ctx,Live,_]}, Vst) -> + validate_bs_skip(Fail, Ctx, 16, Live, Vst); +vi_safe({test,bs_skip_utf32,{f,Fail},[Ctx,Live,_]}, Vst) -> + validate_bs_skip(Fail, Ctx, 32, Live, Vst); +vi_safe({test,bs_get_integer2=Op,{f,Fail},Live, + [Ctx,{integer,Size},Unit,{field_flags,Flags}],Dst},Vst) -> + NumBits = Size * Unit, + Type = case member(unsigned, Flags) of + true when NumBits =< 64 -> + beam_types:make_integer(0, (1 bsl NumBits)-1); + _ -> + %% Signed integer or way too large, don't bother. + #t_integer{} + end, + validate_bs_get(Op, Fail, Ctx, Live, NumBits, Type, Dst, Vst); +vi_safe({test,bs_get_integer2=Op,{f,Fail},Live, + [Ctx,_Size,Unit,_Flags],Dst},Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, Unit, #t_integer{}, Dst, Vst); +vi_safe({test,bs_get_float2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, 1, #t_float{}, Dst, Vst); +vi_safe({test,bs_get_binary2=Op,{f,Fail},Live,[Ctx,_,Unit,_],Dst}, Vst) -> + Type = #t_bitstring{size_unit=Unit}, + validate_bs_get(Op, Fail, Ctx, Live, Unit, Type, Dst, Vst); +vi_safe({test,bs_get_utf8=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + Type = beam_types:make_integer(0, ?UNICODE_MAX), + validate_bs_get(Op, Fail, Ctx, Live, 8, Type, Dst, Vst); +vi_safe({test,bs_get_utf16=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + Type = beam_types:make_integer(0, ?UNICODE_MAX), + validate_bs_get(Op, Fail, Ctx, Live, 16, Type, Dst, Vst); +vi_safe({test,bs_get_utf32=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + Type = beam_types:make_integer(0, ?UNICODE_MAX), + validate_bs_get(Op, Fail, Ctx, Live, 32, Type, Dst, Vst); + +vi_safe({test,_Op,{f,Lbl},Src}, Vst) -> %% is_pid, is_reference, et cetera. validate_src(Src, Vst), branch(Lbl, Vst, fun(V) -> V end); - -%% Map instructions. -valfun_1({put_map_assoc=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> +vi_safe({put_map_assoc=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); -valfun_1({get_map_elements,{f,Fail},Src,{list,List}}, Vst) -> +vi_safe({get_map_elements,{f,Fail},Src,{list,List}}, Vst) -> verify_get_map(Fail, Src, List, Vst); +vi_safe(I, Vst0) -> + Vst = branch_exception(Vst0), + vi_float(I, Vst). + +validate_var_info([{fun_type, Type} | Info], Reg, Vst0) -> + %% Explicit type information inserted after make_fun2 instructions to mark + %% the return type of the created fun. + Vst = update_type(fun meet/2, #t_fun{type=Type}, Reg, Vst0), + validate_var_info(Info, Reg, Vst); +validate_var_info([{type, none} | _Info], _Reg, Vst) -> + %% Unreachable code, typically after a call that never returns. + kill_state(Vst); +validate_var_info([{type, Type} | Info], Reg, Vst0) -> + %% Explicit type information inserted by optimization passes to indicate + %% that Reg has a certain type, so that we can accept cross-function type + %% optimizations. + Vst = update_type(fun meet/2, Type, Reg, Vst0), + validate_var_info(Info, Reg, Vst); +validate_var_info([_ | Info], Reg, Vst) -> + validate_var_info(Info, Reg, Vst); +validate_var_info([], _Reg, Vst) -> + Vst. + +validate_tail_call(Deallocate, Func, Live, #vst{current=#st{numy=NumY}}=Vst0) -> + assert_float_checked(Vst0), + case will_call_succeed(Func, Vst0) of + yes when Deallocate =:= NumY -> + %% This call cannot fail, handle it without updating catch state. + tail_call(Func, Live, Vst0); + maybe when Deallocate =:= NumY -> + %% The call can fail, make sure that any catch state is updated. + Vst = branch_exception(Vst0), + tail_call(Func, Live, Vst); + no -> + %% The stack will be scanned, so Y registers must be initialized. + %% + %% Note that the compiler is allowed to emit garbage values for + %% "Deallocate" as we know that it will not be used in this case. + Vst = branch_exception(Vst0), + verify_live(Live, Vst), + verify_y_init(Vst), + kill_state(Vst); + _ when Deallocate =/= NumY -> + error({allocated, NumY}) + end. + +validate_body_call(Func, Live, + #vst{current=#st{numy=NumY}}=Vst0) when is_integer(NumY)-> + assert_float_checked(Vst0), + case will_call_succeed(Func, Vst0) of + yes -> + call(Func, Live, Vst0); + maybe -> + Vst = branch_exception(Vst0), + call(Func, Live, Vst); + no -> + Vst = branch_exception(Vst0), + verify_live(Live, Vst), + verify_y_init(Vst), + kill_state(Vst) + end; +validate_body_call(_, _, #vst{current=#st{numy=NumY}}) -> + error({allocated, NumY}). -valfun_1(I, Vst) -> - valfun_2(I, Vst). +assert_float_checked(Vst) -> + case get_fls(Vst) of + undefined -> ok; + checked -> ok; + Fls -> error({unsafe_instruction,{float_error_state,Fls}}) + end. -init_try_catch_branch(Tag, Dst, Fail, Vst0) -> - Vst1 = create_tag({Tag,[Fail]}, 'try_catch', [], Dst, Vst0), - #vst{current=#st{ct=Fails}=St0} = Vst1, - St = St0#st{ct=[[Fail]|Fails]}, - Vst = Vst0#vst{current=St}, +init_try_catch_branch(Kind, Dst, Fail, Vst0) -> + Tag = {Kind, [Fail]}, + Vst = create_tag(Tag, 'try_catch', [], Dst, Vst0), branch(Fail, Vst, fun(CatchVst0) -> - #vst{current=#st{ys=Ys}} = CatchVst0, - CatchVst = maps:fold(fun init_catch_handler_1/3, - CatchVst0, Ys), - %% The receive marker is cleared on exceptions. - set_receive_marker(none, CatchVst) + %% We add the tag here because branch/4 rejects jumps to + %% labels referenced by try tags. + #vst{current=#st{ct=Tags,ys=Ys}=St0} = CatchVst0, + St = St0#st{ct=[Tag|Tags]}, + CatchVst1 = CatchVst0#vst{current=St}, + + %% The receive marker is cleared on exceptions. + CatchVst = set_receive_marker(none, CatchVst1), + + maps:fold(fun init_catch_handler_1/3, CatchVst, Ys) end, - fun(SuccVst) -> - %% All potentially-throwing instructions after this - %% one will implicitly branch to the fail label; - %% see valfun_2/2 - SuccVst + fun(SuccVst0) -> + #vst{current=#st{ct=Tags}=St0} = SuccVst0, + St = St0#st{ct=[Tag|Tags]}, + SuccVst = SuccVst0#vst{current=St}, + + %% All potentially-throwing instructions after this one will + %% implicitly branch to the current try/catch handler; see + %% the base case of vi_safe/2 + SuccVst end). %% Set the initial state at the try/catch label. Assume that Y registers %% contain terms or try/catch tags. init_catch_handler_1(Reg, initialized, Vst) -> - create_term(term, 'catch_handler', [], Reg, Vst); + create_term(any, 'catch_handler', [], Reg, Vst); init_catch_handler_1(Reg, uninitialized, Vst) -> - create_term(term, 'catch_handler', [], Reg, Vst); + create_term(any, 'catch_handler', [], Reg, Vst); init_catch_handler_1(_, _, Vst) -> Vst. -valfun_2(I, #vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) -> +branch_exception(#vst{current=#st{ct=[{_,[Fail]}|_]}}=Vst) + when is_integer(Fail) -> %% We have an active try/catch tag and we can jump there from this %% instruction, so we need to update the branched state of the try/catch %% handler. - valfun_3(I, branch_state(Fail, Vst)); -valfun_2(I, #vst{current=#st{ct=[]}}=Vst) -> - valfun_3(I, Vst); -valfun_2(_, _) -> + fork_state(Fail, Vst); +branch_exception(#vst{current=#st{ct=[]}}=Vst) -> + Vst; +branch_exception(_) -> error(ambiguous_catch_try_state). %% Handle the remaining floating point instructions here. %% Floating point. -valfun_3({fconv,Src,{fr,_}=Dst}, Vst) -> +vi_float({fconv,Src,{fr,_}=Dst}, Vst) -> assert_term(Src, Vst), %% An exception is raised on error, hence branching to 0. @@ -807,184 +937,127 @@ valfun_3({fconv,Src,{fr,_}=Dst}, Vst) -> SuccVst = update_type(fun meet/2, number, Src, SuccVst0), set_freg(Dst, SuccVst) end); -valfun_3({bif,fadd,_,[_,_]=Ss,Dst}, Vst) -> +vi_float({bif,fadd,_,[_,_]=Ss,Dst}, Vst) -> float_op(Ss, Dst, Vst); -valfun_3({bif,fdiv,_,[_,_]=Ss,Dst}, Vst) -> +vi_float({bif,fdiv,_,[_,_]=Ss,Dst}, Vst) -> float_op(Ss, Dst, Vst); -valfun_3({bif,fmul,_,[_,_]=Ss,Dst}, Vst) -> +vi_float({bif,fmul,_,[_,_]=Ss,Dst}, Vst) -> float_op(Ss, Dst, Vst); -valfun_3({bif,fnegate,_,[_]=Ss,Dst}, Vst) -> +vi_float({bif,fnegate,_,[_]=Ss,Dst}, Vst) -> float_op(Ss, Dst, Vst); -valfun_3({bif,fsub,_,[_,_]=Ss,Dst}, Vst) -> +vi_float({bif,fsub,_,[_,_]=Ss,Dst}, Vst) -> float_op(Ss, Dst, Vst); -valfun_3(fclearerror, Vst) -> +vi_float(fclearerror, Vst) -> case get_fls(Vst) of - undefined -> ok; - checked -> ok; - Fls -> error({bad_floating_point_state,Fls}) + undefined -> ok; + checked -> ok; + Fls -> error({bad_floating_point_state,Fls}) end, set_fls(cleared, Vst); -valfun_3({fcheckerror,_}, Vst) -> +vi_float({fcheckerror,_}, Vst) -> assert_fls(cleared, Vst), set_fls(checked, Vst); -valfun_3(I, Vst) -> - %% The instruction is not a float instruction. - case get_fls(Vst) of - undefined -> - valfun_4(I, Vst); - checked -> - valfun_4(I, Vst); - Fls -> - error({unsafe_instruction,{float_error_state,Fls}}) - end. - -%% Instructions that can cause exceptions. -valfun_4({put_map_exact=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> - verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); -valfun_4({apply,Live}, Vst) -> - call(apply, Live+2, Vst); -valfun_4({apply_last,Live,_}, Vst) -> - tail_call(apply, Live+2, Vst); -valfun_4({call_fun,Live}, Vst) -> - validate_src([{x,Live}], Vst), - call('fun', Live+1, Vst); -valfun_4({call,Live,Func}, Vst) -> - call(Func, Live, Vst); -valfun_4({call_ext,Live,Func}, Vst) -> - %% Exception BIFs has already been taken care of above. - call(Func, Live, Vst); -valfun_4({call_only,Live,Func}, Vst) -> - tail_call(Func, Live, Vst); -valfun_4({call_ext_only,Live,Func}, Vst) -> - tail_call(Func, Live, Vst); -valfun_4({call_last,Live,Func,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) -> - tail_call(Func, Live, Vst); -valfun_4({call_last,_,_,_}, #vst{current=#st{numy=NumY}}) -> - error({allocated,NumY}); -valfun_4({call_ext_last,Live,Func,StkSize}, - #vst{current=#st{numy=StkSize}}=Vst) -> - tail_call(Func, Live, Vst); -valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) -> - error({allocated,NumY}); -valfun_4({make_fun2,_,_,_,Live}, Vst) -> - call(make_fun, Live, Vst); -%% Other BIFs -valfun_4({bif,element,{f,Fail},[Pos,Src],Dst}, Vst) -> - branch(Fail, Vst, - fun(SuccVst0) -> - PosType = get_term_type(Pos, SuccVst0), - TupleType = {tuple,[get_tuple_size(PosType)],#{}}, +vi_float(I, Vst) -> + assert_float_checked(Vst), + vi_throwing(I, Vst). - SuccVst1 = update_type(fun meet/2, TupleType, - Src, SuccVst0), - SuccVst = update_type(fun meet/2, {integer,[]}, - Pos, SuccVst1), - - ElementType = get_element_type(PosType, Src, SuccVst), - extract_term(ElementType, {bif,element}, [Pos,Src], - Dst, SuccVst) - end); -valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> - validate_src(Src, Vst), +%%% +%%% vi_throwing/2 handles instructions that can cause exceptions. +%%% +vi_throwing({badmatch,Src}, Vst) -> + assert_durable_term(Src, Vst), + verify_y_init(Vst), kill_state(Vst); -valfun_4(raw_raise=I, Vst) -> - call(I, 3, Vst); -valfun_4({bif,Op,{f,Fail},[Src]=Ss,Dst}, Vst) when Op =:= hd; Op =:= tl -> - assert_term(Src, Vst), - branch(Fail, Vst, - fun(FailVst) -> - update_type(fun subtract/2, cons, Src, FailVst) - end, - fun(SuccVst0) -> - SuccVst = update_type(fun meet/2, cons, Src, SuccVst0), - extract_term(term, {bif,Op}, Ss, Dst, SuccVst) - end); -valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst) -> - validate_src(Ss, Vst), - branch(Fail, Vst, +vi_throwing({case_end,Src}, Vst) -> + assert_durable_term(Src, Vst), + verify_y_init(Vst), + kill_state(Vst); +vi_throwing(if_end, Vst) -> + verify_y_init(Vst), + kill_state(Vst); +vi_throwing({try_case_end,Src}, Vst) -> + verify_y_init(Vst), + assert_durable_term(Src, Vst), + kill_state(Vst); +vi_throwing({call_fun,Live}, Vst) -> + Fun = {x,Live}, + assert_term(Fun, Vst), + + %% An exception is raised on error, hence branching to 0. + branch(0, Vst, fun(SuccVst0) -> - %% Infer argument types. Note that we can't subtract - %% types as the BIF could fail for reasons other than - %% bad argument types. - ArgTypes = bif_arg_types(Op, Ss), - SuccVst = foldl(fun({Arg, T}, V) -> - update_type(fun meet/2, T, Arg, V) - end, SuccVst0, zip(Ss, ArgTypes)), - Type = bif_return_type(Op, Ss, SuccVst), - extract_term(Type, {bif,Op}, Ss, Dst, SuccVst) + SuccVst = update_type(fun meet/2, #t_fun{arity=Live}, + Fun, SuccVst0), + validate_body_call('fun', Live+1, SuccVst) end); -valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> - validate_src(Ss, Vst0), - verify_live(Live, Vst0), - verify_y_init(Vst0), +vi_throwing({make_fun2,{f,Lbl},_,_,NumFree}, #vst{ft=Ft}=Vst0) -> + #{ arity := Arity0 } = gb_trees:get(Lbl, Ft), + Arity = Arity0 - NumFree, - %% Heap allocations and X registers are killed regardless of whether we - %% fail or not, as we may fail after GC. - St = kill_heap_allocation(St0), - Vst = prune_x_regs(Live, Vst0#vst{current=St}), - - branch(Fail, Vst, - fun(SuccVst0) -> - ArgTypes = bif_arg_types(Op, Ss), - SuccVst = foldl(fun({Arg, T}, V) -> - update_type(fun meet/2, T, Arg, V) - end, SuccVst0, zip(Ss, ArgTypes)), + true = Arity >= 0, %Assertion. - Type = bif_return_type(Op, Ss, SuccVst), + Vst = prune_x_regs(NumFree, Vst0), + verify_call_args(make_fun, NumFree, Vst), + verify_y_init(Vst), - %% We're passing Vst0 as the original because the - %% registers were pruned before the branch. - extract_term(Type, {gc_bif,Op}, Ss, Dst, SuccVst, Vst0) - end); -valfun_4({loop_rec,{f,Fail},Dst}, Vst) -> + create_term(#t_fun{arity=Arity}, make_fun, [], {x,0}, Vst); +%% Other BIFs +vi_throwing({bif,raise,{f,0},Src,_Dst}, Vst) -> + validate_src(Src, Vst), + kill_state(Vst); +vi_throwing(raw_raise=I, Vst) -> + call(I, 3, Vst); +vi_throwing({bif,Op,{f,Fail},Ss,Dst}, Vst) -> + validate_bif(Op, Fail, Ss, Dst, Vst); +vi_throwing({gc_bif,Op,{f,Fail},Live,Ss,Dst}, Vst) -> + validate_gc_bif(Op, Fail, Ss, Dst, Live, Vst); +vi_throwing({loop_rec,{f,Fail},Dst}, Vst) -> %% This term may not be part of the root set until remove_message/0 is %% executed. If control transfers to the loop_rec_end/1 instruction, no %% part of this term must be stored in a Y register. branch(Fail, Vst, fun(SuccVst0) -> - {Ref, SuccVst} = new_value(term, loop_rec, [], SuccVst0), + {Ref, SuccVst} = new_value(any, loop_rec, [], SuccVst0), mark_fragile(Dst, set_reg_vref(Ref, Dst, SuccVst)) end); -valfun_4({wait,_}, Vst) -> +vi_throwing({wait,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); -valfun_4({wait_timeout,_,Src}, Vst) -> +vi_throwing({wait_timeout,_,Src}, Vst) -> %% Note that the receive marker is not cleared since we may re-enter the %% loop while waiting. If we time out we'll be transferred to a timeout %% instruction that clears the marker. assert_term(Src, Vst), verify_y_init(Vst), prune_x_regs(0, Vst); -valfun_4({loop_rec_end,_}, Vst) -> +vi_throwing({loop_rec_end,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); -valfun_4(timeout, Vst0) -> +vi_throwing(timeout, Vst0) -> Vst = set_receive_marker(none, Vst0), prune_x_regs(0, Vst); -valfun_4(send, Vst) -> +vi_throwing(send, Vst) -> call(send, 2, Vst); - -%% Other test instructions. -valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) -> +vi_throwing({bs_add,{f,Fail},[A,B,_],Dst}, Vst) -> assert_term(A, Vst), assert_term(B, Vst), branch(Fail, Vst, fun(SuccVst) -> - create_term({integer,[]}, bs_add, [A, B], Dst, SuccVst) + create_term(#t_integer{}, bs_add, [A, B], Dst, SuccVst) end); -valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> +vi_throwing({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), branch(Fail, Vst, fun(SuccVst) -> - create_term({integer,[]}, bs_utf8_size, [A], Dst, SuccVst) + create_term(#t_integer{}, bs_utf8_size, [A], Dst, SuccVst) end); -valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> +vi_throwing({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), branch(Fail, Vst, fun(SuccVst) -> - create_term({integer,[]}, bs_utf16_size, [A], Dst, SuccVst) + create_term(#t_integer{}, bs_utf16_size, [A], Dst, SuccVst) end); -valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> +vi_throwing({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), if @@ -997,9 +1070,10 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> branch(Fail, Vst, fun(SuccVst0) -> SuccVst = prune_x_regs(Live, SuccVst0), - create_term(binary, bs_init2, [], Dst, SuccVst, SuccVst0) + create_term(#t_bitstring{size_unit=8}, bs_init2, [], Dst, + SuccVst, SuccVst0) end); -valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> +vi_throwing({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), if @@ -1012,9 +1086,9 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> branch(Fail, Vst, fun(SuccVst0) -> SuccVst = prune_x_regs(Live, SuccVst0), - create_term(binary, bs_init_bits, [], Dst, SuccVst) + create_term(#t_bitstring{}, bs_init_bits, [], Dst, SuccVst) end); -valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> +vi_throwing({bs_append,{f,Fail},Bits,Heap,Live,Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), assert_term(Bits, Vst0), @@ -1023,62 +1097,81 @@ valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> branch(Fail, Vst, fun(SuccVst0) -> SuccVst = prune_x_regs(Live, SuccVst0), - create_term(binary, bs_append, [Bin], Dst, SuccVst, SuccVst0) + create_term(#t_bitstring{size_unit=Unit}, bs_append, + [Bin], Dst, SuccVst, SuccVst0) end); -valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst) -> +vi_throwing({bs_private_append,{f,Fail},Bits,Unit,Bin,_Flags,Dst}, Vst) -> assert_term(Bits, Vst), assert_term(Bin, Vst), branch(Fail, Vst, fun(SuccVst) -> - create_term(binary, bs_private_append, [Bin], Dst, SuccVst) + create_term(#t_bitstring{size_unit=Unit}, bs_private_append, + [Bin], Dst, SuccVst) end); -valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> +vi_throwing({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; -valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> +vi_throwing({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, binary, Src, SuccVst) + update_type(fun meet/2, #t_bitstring{}, Src, SuccVst) end); -valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> +vi_throwing({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {float,[]}, Src, SuccVst) + update_type(fun meet/2, #t_float{}, Src, SuccVst) end); -valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> +vi_throwing({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {integer,[]}, Src, SuccVst) + update_type(fun meet/2, #t_integer{}, Src, SuccVst) end); -valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) -> +vi_throwing({bs_put_utf8,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {integer,[]}, Src, SuccVst) + update_type(fun meet/2, #t_integer{}, Src, SuccVst) end); -valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) -> +vi_throwing({bs_put_utf16,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {integer,[]}, Src, SuccVst) + update_type(fun meet/2, #t_integer{}, Src, SuccVst) end); -valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> +vi_throwing({bs_put_utf32,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {integer,[]}, Src, SuccVst) + update_type(fun meet/2, #t_integer{}, Src, SuccVst) end); -valfun_4(_, _) -> +%% Map instructions. +vi_throwing({put_map_exact=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); +vi_throwing(_, _) -> error(unknown_instruction). +verify_has_map_fields(Lbl, Src, List, Vst) -> + assert_type(#t_map{}, Src, Vst), + assert_unique_map_keys(List), + verify_map_fields(List, Src, Lbl, Vst). + +verify_map_fields([Key | Keys], Map, Lbl, Vst) -> + assert_term(Key, Vst), + case bif_types(map_get, [Key, Map], Vst) of + {none, _, _} -> kill_state(Vst); + {_, _, _} -> verify_map_fields(Keys, Map, Lbl, Vst) + end; +verify_map_fields([], _Map, Lbl, Vst) -> + branch(Lbl, Vst, fun(V) -> V end). + verify_get_map(Fail, Src, List, Vst0) -> assert_not_literal(Src), %OTP 22. - assert_type(map, Src, Vst0), + assert_type(#t_map{}, Src, Vst0), branch(Fail, Vst0, fun(FailVst) -> @@ -1102,7 +1195,7 @@ verify_get_map(Fail, Src, List, Vst0) -> clobber_map_vals([Key,Dst|T], Map, Vst0) -> case is_reg_initialized(Dst, Vst0) of true -> - Vst = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vst0), + Vst = extract_term(any, {bif,map_get}, [Key, Map], Dst, Vst0), clobber_map_vals(T, Map, Vst); false -> clobber_map_vals(T, Map, Vst0) @@ -1125,15 +1218,20 @@ extract_map_keys([Key,_Val|T]) -> [Key|extract_map_keys(T)]; extract_map_keys([]) -> []. -extract_map_vals([Key,Dst|Vs], Map, Vst0, Vsti0) -> +extract_map_vals([Key, Dst | Vs], Map, Vst0, Vsti0) -> assert_term(Key, Vst0), - Vsti = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vsti0), - extract_map_vals(Vs, Map, Vst0, Vsti); + case bif_types(map_get, [Key, Map], Vst0) of + {none, _, _} -> + kill_state(Vsti0); + {DstType, _, _} -> + Vsti = extract_term(DstType, {bif,map_get}, [Key, Map], Dst, Vsti0), + extract_map_vals(Vs, Map, Vst0, Vsti) + end; extract_map_vals([], _Map, _Vst0, Vst) -> Vst. verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) -> - assert_type(map, Src, Vst0), + assert_type(#t_map{}, Src, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), _ = [assert_term(Term, Vst0) || Term <- List], @@ -1144,9 +1242,22 @@ verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) -> SuccVst = prune_x_regs(Live, SuccVst0), Keys = extract_map_keys(List), assert_unique_map_keys(Keys), - create_term(map, Op, [Src], Dst, SuccVst, SuccVst0) + + Type = put_map_type(Src, List, Vst), + create_term(Type, Op, [Src], Dst, SuccVst, SuccVst0) end). +put_map_type(Map0, List, Vst) -> + Map = normalize(get_term_type(Map0, Vst)), + pmt_1(List, Vst, Map). + +pmt_1([Key0, Value0 | List], Vst, Acc0) -> + Key = normalize(get_term_type(Key0, Vst)), + Value = normalize(get_term_type(Value0, Vst)), + {Acc, _, _} = beam_call_types:types(maps, put, [Key, Value, Acc0]), + pmt_1(List, Vst, Acc); +pmt_1([], _Vst, Acc) -> + Acc. %% %% Common code for validating returns, whether naked or as part of a tail call. @@ -1172,66 +1283,162 @@ verify_return(#vst{current=#st{recv_marker=Mark}}) when Mark =/= none -> error({return_with_receive_marker,Mark}); verify_return(Vst) -> verify_no_ct(Vst), - ok. + kill_state(Vst). + +%% +%% Common code for validating BIFs. +%% +%% OrigVst is the state we entered the instruction with, which is needed for +%% gc_bifs as X registers are pruned prior to calling this function, which may +%% have clobbered the sources. +%% + +validate_bif(Op, Fail, Ss, Dst, Vst) -> + validate_src(Ss, Vst), + validate_bif_1(bif, Op, Fail, Ss, Dst, Vst, Vst). + +validate_gc_bif(Op, Fail, Ss, Dst, Live, #vst{current=St0}=Vst0) -> + validate_src(Ss, Vst0), + verify_live(Live, Vst0), + verify_y_init(Vst0), + + %% Heap allocations and X registers are killed regardless of whether we + %% fail or not, as we may fail after GC. + St = kill_heap_allocation(St0), + Vst = prune_x_regs(Live, Vst0#vst{current=St}), + validate_src(Ss, Vst), + + validate_bif_1(gc_bif, Op, Fail, Ss, Dst, Vst, Vst). + +validate_bif_1(Kind, Op, cannot_fail, Ss, Dst, OrigVst, Vst0) -> + %% This BIF explicitly cannot fail; it will not jump to a guard nor throw + %% an exception. Validation will fail if it returns 'none' or has a type + %% conflict on one of its arguments. + + {Type, ArgTypes, _CanSubtract} = bif_types(Op, Ss, Vst0), + ZippedArgs = zip(Ss, ArgTypes), + + Vst = foldl(fun({A, T}, V) -> + update_type(fun meet/2, T, A, V) + end, Vst0, ZippedArgs), + + true = Type =/= none, %Assertion. + + extract_term(Type, {Kind, Op}, Ss, Dst, Vst, OrigVst); +validate_bif_1(Kind, Op, Fail, Ss, Dst, OrigVst, Vst) -> + {Type, ArgTypes, CanSubtract} = bif_types(Op, Ss, Vst), + ZippedArgs = zip(Ss, ArgTypes), + + FailFun = case CanSubtract of + true -> + fun(FailVst0) -> + foldl(fun({A, T}, V) -> + update_type(fun subtract/2, T, A, V) + end, FailVst0, ZippedArgs) + end; + false -> + fun(S) -> S end + end, + SuccFun = fun(SuccVst0) -> + SuccVst = foldl(fun({A, T}, V) -> + update_type(fun meet/2, T, A, V) + end, SuccVst0, ZippedArgs), + extract_term(Type, {Kind, Op}, Ss, Dst, SuccVst, OrigVst) + end, + + branch(Fail, Vst, FailFun, SuccFun). %% %% Common code for validating bs_start_match* instructions. %% -validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst) -> - verify_live(Live, Vst), - verify_y_init(Vst), +validate_bs_start_match({atom,resume}, Live, 0, Src, Dst, Vst0) -> + assert_type(#t_bs_context{}, Src, Vst0), + verify_live(Live, Vst0), + verify_y_init(Vst0), + + Vst = assign(Src, Dst, Vst0), + prune_x_regs(Live, Vst); +validate_bs_start_match({atom,no_fail}, Live, Slots, Src, Dst, Vst0) -> + verify_live(Live, Vst0), + verify_y_init(Vst0), + + Vst1 = update_type(fun meet/2, #t_bs_matchable{}, Src, Vst0), + + %% Retain the current unit, if known. + SrcType = get_movable_term_type(Src, Vst1), + TailUnit = beam_types:get_bs_matchable_unit(SrcType), - %% #ms{} can represent either a match context or a term, so we have to mark - %% the source as a term if it fails with a match context as an input. This - %% hack is only needed until we get proper union types. + CtxType = #t_bs_context{slots=Slots,tail_unit=TailUnit}, + + Vst = prune_x_regs(Live, Vst1), + extract_term(CtxType, bs_start_match, [Src], Dst, Vst, Vst0); +validate_bs_start_match({f,Fail}, Live, Slots, Src, Dst, Vst) -> branch(Fail, Vst, fun(FailVst) -> - case get_movable_term_type(Src, FailVst) of - #ms{} -> override_type(term, Src, FailVst); - _ -> FailVst - end + update_type(fun subtract/2, #t_bs_matchable{}, Src, FailVst) end, - fun(SuccVst0) -> - SuccVst1 = update_type(fun meet/2, binary, - Src, SuccVst0), - SuccVst = prune_x_regs(Live, SuccVst1), - extract_term(Type, bs_start_match, [Src], Dst, - SuccVst, SuccVst0) + fun(SuccVst) -> + validate_bs_start_match({atom,no_fail}, Live, Slots, + Src, Dst, SuccVst) end). %% %% Common code for validating bs_get* instructions. %% -validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst) -> - bsm_validate_context(Ctx, Vst), +validate_bs_get(Op, Fail, Ctx, Live, Stride, Type, Dst, Vst) -> + assert_type(#t_bs_context{}, Ctx, Vst), verify_live(Live, Vst), verify_y_init(Vst), + #t_bs_context{tail_unit=TailUnit} = get_raw_type(Ctx, Vst), + CtxType = #t_bs_context{tail_unit=gcd(Stride, TailUnit)}, + branch(Fail, Vst, fun(SuccVst0) -> - SuccVst = prune_x_regs(Live, SuccVst0), + SuccVst1 = update_type(fun meet/2, CtxType, Ctx, SuccVst0), + SuccVst = prune_x_regs(Live, SuccVst1), extract_term(Type, Op, [Ctx], Dst, SuccVst, SuccVst0) end). %% -%% Common code for validating bs_skip_utf* instructions. +%% Common code for validating bs_skip* instructions. %% -validate_bs_skip_utf(Fail, Ctx, Live, Vst) -> - bsm_validate_context(Ctx, Vst), +validate_bs_skip(Fail, Ctx, Stride, Vst) -> + validate_bs_skip(Fail, Ctx, Stride, no_live, Vst). + +validate_bs_skip(Fail, Ctx, Stride, Live, Vst) -> + assert_type(#t_bs_context{}, Ctx, Vst), + + #t_bs_context{tail_unit=TailUnit} = get_raw_type(Ctx, Vst), + CtxType = #t_bs_context{tail_unit=gcd(Stride, TailUnit)}, + + validate_bs_skip_1(Fail, Ctx, CtxType, Live, Vst). + +validate_bs_skip_1(Fail, Ctx, CtxType, no_live, Vst) -> + branch(Fail, Vst, + fun(SuccVst0) -> + update_type(fun meet/2, CtxType, Ctx, SuccVst0) + end); +validate_bs_skip_1(Fail, Ctx, CtxType, Live, Vst) -> verify_y_init(Vst), verify_live(Live, Vst), - branch(Fail, Vst, - fun(SuccVst) -> + fun(SuccVst0) -> + SuccVst = update_type(fun meet/2, CtxType, Ctx, SuccVst0), prune_x_regs(Live, SuccVst) end). - %% %% Common code for is_$type instructions. %% +type_test(Fail, #t_bs_context{}=Type, Reg, Vst) -> + assert_movable(Reg, Vst), + type_test_1(Fail, Type, Reg, Vst); type_test(Fail, Type, Reg, Vst) -> assert_term(Reg, Vst), + type_test_1(Fail, Type, Reg, Vst). + +type_test_1(Fail, Type, Reg, Vst) -> branch(Fail, Vst, fun(FailVst) -> update_type(fun subtract/2, Type, Reg, FailVst) @@ -1247,21 +1454,27 @@ type_test(Fail, Type, Reg, Vst) -> %% %% Note that #vst.current will be 'none' if the instruction is unreachable. %% -val_dsetel({move,_,_}, Vst) -> + +validate_mutation(I, Vst) -> + vm_1(I, Vst). + +vm_1({move,_,_}, Vst) -> Vst; -val_dsetel({call_ext,3,{extfunc,erlang,setelement,3}}, #vst{current=#st{}=St}=Vst) -> +vm_1({swap,_,_}, Vst) -> + Vst; +vm_1({call_ext,3,{extfunc,erlang,setelement,3}}, #vst{current=#st{}=St}=Vst) -> Vst#vst{current=St#st{setelem=true}}; -val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) -> +vm_1({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) -> error(illegal_context_for_set_tuple_element); -val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=true}}=Vst) -> +vm_1({set_tuple_element,_,_,_}, #vst{current=#st{setelem=true}}=Vst) -> Vst; -val_dsetel({get_tuple_element,_,_,_}, Vst) -> +vm_1({get_tuple_element,_,_,_}, Vst) -> Vst; -val_dsetel({line,_}, Vst) -> +vm_1({line,_}, Vst) -> Vst; -val_dsetel(_, #vst{current=#st{setelem=true}=St}=Vst) -> +vm_1(_, #vst{current=#st{setelem=true}=St}=Vst) -> Vst#vst{current=St#st{setelem=false}}; -val_dsetel(_, Vst) -> Vst. +vm_1(_, Vst) -> Vst. kill_state(Vst) -> Vst#vst{current=none}. @@ -1272,12 +1485,13 @@ kill_state(Vst) -> call(Name, Live, #vst{current=St0}=Vst0) -> verify_call_args(Name, Live, Vst0), verify_y_init(Vst0), - case call_return_type(Name, Vst0) of - Type when Type =/= exception -> - %% Type is never 'exception' because it has been handled earlier. + case call_types(Name, Live, Vst0) of + {none, _, _} -> + kill_state(Vst0); + {RetType, _, _} -> St = St0#st{f=init_fregs()}, Vst = prune_x_regs(0, Vst0#vst{current=St}), - create_term(Type, call, [], {x,0}, Vst) + create_term(RetType, call, [], {x,0}, Vst) end. %% Tail call. @@ -1287,16 +1501,19 @@ tail_call(Name, Live, Vst0) -> verify_y_init(Vst0), Vst = deallocate(Vst0), verify_call_args(Name, Live, Vst), - case call_return_type(Name, Vst0) of - exception -> verify_no_ct(Vst); - _ -> verify_return(Vst) - end, - kill_state(Vst). + verify_return(Vst). verify_call_args(_, 0, #vst{}) -> ok; -verify_call_args({f,Lbl}, Live, Vst) when is_integer(Live)-> - verify_local_args(Live - 1, Lbl, #{}, Vst); +verify_call_args({f,Lbl}, Live, #vst{ft=Ft}=Vst) when is_integer(Live) -> + case gb_trees:lookup(Lbl, Ft) of + {value, FuncInfo} -> + #{ arity := Live, + parameter_info := ParamInfo } = FuncInfo, + verify_local_args(Live - 1, ParamInfo, #{}, Vst); + none -> + error(local_call_to_unknown_function) + end; verify_call_args(_, Live, Vst) when is_integer(Live)-> verify_remote_args_1(Live - 1, Vst); verify_call_args(_, Live, _) -> @@ -1308,86 +1525,50 @@ verify_remote_args_1(X, Vst) -> assert_durable_term({x, X}, Vst), verify_remote_args_1(X - 1, Vst). -verify_local_args(-1, _Lbl, _CtxIds, _Vst) -> +verify_local_args(-1, _ParamInfo, _CtxIds, _Vst) -> ok; -verify_local_args(X, Lbl, CtxIds, Vst) -> +verify_local_args(X, ParamInfo, CtxRefs, Vst) -> Reg = {x, X}, assert_not_fragile(Reg, Vst), case get_movable_term_type(Reg, Vst) of - #ms{id=Id}=Type -> - case CtxIds of - #{ Id := Other } -> + #t_bs_context{}=Type -> + VRef = get_reg_vref(Reg, Vst), + case CtxRefs of + #{ VRef := Other } -> error({multiple_match_contexts, [Reg, Other]}); #{} -> - verify_arg_type(Lbl, Reg, Type, Vst), - verify_local_args(X - 1, Lbl, CtxIds#{ Id => Reg }, Vst) + verify_arg_type(Reg, Type, ParamInfo), + verify_local_args(X - 1, ParamInfo, + CtxRefs#{ VRef => Reg }, Vst) end; Type -> - verify_arg_type(Lbl, Reg, Type, Vst), - verify_local_args(X - 1, Lbl, CtxIds, Vst) + verify_arg_type(Reg, Type, ParamInfo), + verify_local_args(X - 1, ParamInfo, CtxRefs, Vst) end. -%% Verifies that the given argument narrows to what the function expects. -verify_arg_type(Lbl, Reg, #ms{}, #vst{ft=Ft}) -> - %% Match contexts require explicit support, and may not be passed to a - %% function that accepts arbitrary terms. - case gb_trees:lookup({Lbl, Reg}, Ft) of - {value, #ms{}} -> ok; - _ -> error(no_bs_start_match2) - end; -verify_arg_type(Lbl, Reg, GivenType, #vst{ft=Ft}) -> - case gb_trees:lookup({Lbl, Reg}, Ft) of - {value, #ms{}} -> - %% Functions that accept match contexts also accept all other - %% terms. This will change once we support union types. - ok; - {value, RequiredType} -> - case vat_1(GivenType, RequiredType) of - true -> ok; - false -> error({bad_arg_type, Reg, GivenType, RequiredType}) +verify_arg_type(Reg, GivenType, ParamTypes) -> + case {ParamTypes, GivenType} of + {#{ Reg := Info }, #t_bs_context{}} -> + %% Match contexts require explicit support, and may not be passed + %% to a function that accepts arbitrary terms. + case member(accepts_match_context, Info) of + true -> verify_arg_type_1(Reg, GivenType, Info); + false -> error(no_bs_start_match2) end; - none -> + {_, #t_bs_context{}} -> + error(no_bs_start_match2); + {#{ Reg := Info }, _} -> + verify_arg_type_1(Reg, GivenType, Info); + {#{}, _} -> ok end. -%% Checks whether the Given argument is compatible with the Required one. This -%% is essentially a relaxed version of 'meet(Given, Req) =:= Given', where we -%% accept that the Given value has the right type but not necessarily the exact -%% same value; if {atom,gurka} is required, we'll consider {atom,[]} valid. -%% -%% This will catch all problems that could crash the emulator, like passing a -%% 1-tuple when the callee expects a 3-tuple, but some value errors might slip -%% through. -vat_1(Same, Same) -> true; -vat_1({atom,A}, {atom,B}) -> A =:= B orelse is_list(A) orelse is_list(B); -vat_1({atom,A}, bool) -> is_boolean(A) orelse is_list(A); -vat_1(bool, {atom,B}) -> is_boolean(B) orelse is_list(B); -vat_1(cons, list) -> true; -vat_1({float,A}, {float,B}) -> A =:= B orelse is_list(A) orelse is_list(B); -vat_1({float,_}, number) -> true; -vat_1({integer,A}, {integer,B}) -> A =:= B orelse is_list(A) orelse is_list(B); -vat_1({integer,_}, number) -> true; -vat_1(_, {literal,_}) -> false; -vat_1({literal,_}=Lit, Required) -> vat_1(get_literal_type(Lit), Required); -vat_1(nil, list) -> true; -vat_1({tuple,SzA,EsA}, {tuple,SzB,EsB}) -> - if - is_list(SzB) -> - tuple_sz(SzA) >= tuple_sz(SzB) andalso vat_elements(EsA, EsB); - SzA =:= SzB -> - vat_elements(EsA, EsB); - SzA =/= SzB -> - false - end; -vat_1(_, _) -> false. - -vat_elements(EsA, EsB) -> - maps:fold(fun(Key, Req, Acc) -> - case EsA of - #{ Key := Given } -> Acc andalso vat_1(Given, Req); - #{} -> false - end - end, true, EsB). +verify_arg_type_1(Reg, GivenType, Info) -> + RequiredType = proplists:get_value(type, Info, any), + case meet(GivenType, RequiredType) of + GivenType -> ok; + _ -> error({bad_arg_type, Reg, GivenType, RequiredType}) + end. allocate(Tag, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) -> verify_live(Live, Vst0), @@ -1560,7 +1741,7 @@ assert_unique_map_keys([_,_|_]=Ls) -> assert_literal(L), L end || L <- Ls], - case length(Vs) =:= sets:size(sets:from_list(Vs)) of + case length(Vs) =:= cerl_sets:size(cerl_sets:from_list(Vs)) of true -> ok; false -> error(keys_not_unique) end. @@ -1569,49 +1750,35 @@ assert_unique_map_keys([_,_|_]=Ls) -> %%% New binary matching instructions. %%% -bsm_match_state() -> - #ms{}. -bsm_match_state(Slots) -> - #ms{slots=Slots}. - -bsm_validate_context(Reg, Vst) -> - _ = bsm_get_context(Reg, Vst), - ok. - -bsm_get_context({Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y-> - case get_movable_term_type(Reg, Vst) of - #ms{}=Ctx -> Ctx; - _ -> error({no_bsm_context,Reg}) - end; -bsm_get_context(Reg, _) -> - error({bad_source,Reg}). - bsm_save(Reg, {atom,start}, Vst) -> %% Save point refering to where the match started. %% It is always valid. But don't forget to validate the context register. - bsm_validate_context(Reg, Vst), + assert_type(#t_bs_context{}, Reg, Vst), Vst; bsm_save(Reg, SavePoint, Vst) -> - case bsm_get_context(Reg, Vst) of - #ms{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots -> - Ctx = Ctxt0#ms{valid=Bits bor (1 bsl SavePoint),slots=Slots}, - override_type(Ctx, Reg, Vst); - _ -> error({illegal_save,SavePoint}) + case get_movable_term_type(Reg, Vst) of + #t_bs_context{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots -> + Ctx = Ctxt0#t_bs_context{valid=Bits bor (1 bsl SavePoint), + slots=Slots}, + override_type(Ctx, Reg, Vst); + _ -> + error({illegal_save, SavePoint}) end. bsm_restore(Reg, {atom,start}, Vst) -> %% (Mostly) automatic save point refering to where the match started. %% It is always valid. But don't forget to validate the context register. - bsm_validate_context(Reg, Vst), + assert_type(#t_bs_context{}, Reg, Vst), Vst; bsm_restore(Reg, SavePoint, Vst) -> - case bsm_get_context(Reg, Vst) of - #ms{valid=Bits,slots=Slots} when SavePoint < Slots -> - case Bits band (1 bsl SavePoint) of - 0 -> error({illegal_restore,SavePoint,not_set}); - _ -> Vst - end; - _ -> error({illegal_restore,SavePoint,range}) + case get_movable_term_type(Reg, Vst) of + #t_bs_context{valid=Bits,slots=Slots} when SavePoint < Slots -> + case Bits band (1 bsl SavePoint) of + 0 -> error({illegal_restore, SavePoint, not_set}); + _ -> Vst + end; + _ -> + error({illegal_restore, SavePoint, range}) end. validate_select_val(_Fail, _Choices, _Src, #vst{current=none}=Vst) -> @@ -1627,7 +1794,7 @@ validate_select_val(Fail, [Val,{f,L}|T], Src, Vst0) -> update_ne_types(Src, Val, FailVst) end), validate_select_val(Fail, T, Src, Vst); -validate_select_val(Fail, [], _, Vst) -> +validate_select_val(Fail, [], _Src, Vst) -> branch(Fail, Vst, fun(SuccVst) -> %% The next instruction is never executed. @@ -1639,7 +1806,7 @@ validate_select_tuple_arity(_Fail, _Choices, _Src, #vst{current=none}=Vst) -> %% can't reach the fail label or any of the remaining choices. Vst; validate_select_tuple_arity(Fail, [Arity,{f,L}|T], Tuple, Vst0) -> - Type = {tuple, Arity, #{}}, + Type = #t_tuple{exact=true,size=Arity}, Vst = branch(L, Vst0, fun(BranchVst) -> update_type(fun meet/2, Type, Tuple, BranchVst) @@ -1655,63 +1822,103 @@ validate_select_tuple_arity(Fail, [], _, #vst{}=Vst) -> kill_state(SuccVst) end). -infer_types({Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y -> - infer_types(get_reg_vref(Reg, Vst), Vst); -infer_types(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> +%% +%% Infers types from comparisons, looking at the expressions that produced the +%% compared values and updates their types if we've learned something new from +%% the comparison. +%% + +infer_types(CompareOp, {Kind,_}=LHS, RHS, Vst) when Kind =:= x; Kind =:= y -> + infer_types(CompareOp, get_reg_vref(LHS, Vst), RHS, Vst); +infer_types(CompareOp, LHS, {Kind,_}=RHS, Vst) when Kind =:= x; Kind =:= y -> + infer_types(CompareOp, LHS, get_reg_vref(RHS, Vst), Vst); +infer_types(CompareOp, LHS, RHS, #vst{current=#st{vs=Vs}}=Vst0) -> case Vs of - #{ Ref := Entry } -> infer_types_1(Entry); - #{} -> fun(_, S) -> S end + #{ LHS := LEntry, RHS := REntry } -> + Vst = infer_types_1(LEntry, RHS, CompareOp, Vst0), + infer_types_1(REntry, LHS, CompareOp, Vst); + #{ LHS := LEntry } -> + infer_types_1(LEntry, RHS, CompareOp, Vst0); + #{ RHS := REntry } -> + infer_types_1(REntry, LHS, CompareOp, Vst0); + #{} -> + Vst0 + end. + +infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}, Val, Op, Vst) -> + case Val of + {atom, Bool} when Op =:= eq_exact, Bool; Op =:= ne_exact, not Bool -> + update_eq_types(LHS, RHS, Vst); + {atom, Bool} when Op =:= ne_exact, Bool; Op =:= eq_exact, not Bool -> + update_ne_types(LHS, RHS, Vst); + _ -> + Vst end; -infer_types(_, #vst{}) -> - fun(_, S) -> S end. - -infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}) -> - fun({atom,true}, S) -> - %% Either side might contain something worth inferring, so we need - %% to check them both. - Infer_L = infer_types(RHS, S), - Infer_R = infer_types(LHS, S), - Infer_R(RHS, Infer_L(LHS, S)); - (_, S) -> S +infer_types_1(#value{op={bif,'=/='},args=[LHS,RHS]}, Val, Op, Vst) -> + case Val of + {atom, Bool} when Op =:= ne_exact, Bool; Op =:= eq_exact, not Bool -> + update_ne_types(LHS, RHS, Vst); + {atom, Bool} when Op =:= eq_exact, Bool; Op =:= ne_exact, not Bool -> + update_eq_types(LHS, RHS, Vst); + _ -> + Vst end; -infer_types_1(#value{op={bif,element},args=[{integer,Index}=Key,Tuple]}) -> - fun(Val, S) -> - Type = {tuple,[Index], #{ Key => get_term_type(Val, S) }}, - update_type(fun meet/2, Type, Tuple, S) +infer_types_1(#value{op={bif,element},args=[{integer,Index},Tuple]}, + Val, Op, Vst) when Index >= 1 -> + ElementType = get_term_type(Val, Vst), + Es = beam_types:set_tuple_element(Index, ElementType, #{}), + TupleType = #t_tuple{size=Index,elements=Es}, + case Op of + eq_exact -> + update_type(fun meet/2, TupleType, Tuple, Vst); + ne_exact -> + %% Subtraction is only safe when ElementType is single-valued and + %% the index is below the tuple element limit. + case beam_types:is_singleton_type(ElementType) of + true when Es =/= #{} -> + update_type(fun subtract/2, TupleType, Tuple, Vst); + _ -> + Vst + end end; -infer_types_1(#value{op={bif,is_atom},args=[Src]}) -> - infer_type_test_bif({atom,[]}, Src); -infer_types_1(#value{op={bif,is_boolean},args=[Src]}) -> - infer_type_test_bif(bool, Src); -infer_types_1(#value{op={bif,is_binary},args=[Src]}) -> - infer_type_test_bif(binary, Src); -infer_types_1(#value{op={bif,is_bitstring},args=[Src]}) -> - infer_type_test_bif(binary, Src); -infer_types_1(#value{op={bif,is_float},args=[Src]}) -> - infer_type_test_bif(float, Src); -infer_types_1(#value{op={bif,is_integer},args=[Src]}) -> - infer_type_test_bif({integer,{}}, Src); -infer_types_1(#value{op={bif,is_list},args=[Src]}) -> - infer_type_test_bif(list, Src); -infer_types_1(#value{op={bif,is_map},args=[Src]}) -> - infer_type_test_bif(map, Src); -infer_types_1(#value{op={bif,is_number},args=[Src]}) -> - infer_type_test_bif(number, Src); -infer_types_1(#value{op={bif,is_tuple},args=[Src]}) -> - infer_type_test_bif({tuple,[0],#{}}, Src); -infer_types_1(#value{op={bif,tuple_size}, args=[Tuple]}) -> - fun({integer,Arity}, S) -> - update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); - (_, S) -> S +infer_types_1(#value{op={bif,is_atom},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_atom{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_boolean},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(beam_types:make_boolean(), Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_binary},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_bitstring{size_unit=8}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_bitstring},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_bitstring{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_float},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_float{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_integer},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_integer{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_list},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_list{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_map},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_map{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_number},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(number, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_tuple},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_tuple{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,tuple_size}, args=[Tuple]}, + {integer,Arity}, Op, Vst) -> + Type = #t_tuple{exact=true,size=Arity}, + case Op of + eq_exact -> update_type(fun meet/2, Type, Tuple, Vst); + ne_exact -> update_type(fun subtract/2, Type, Tuple, Vst) end; -infer_types_1(_) -> - fun(_, S) -> S end. - -infer_type_test_bif(Type, Src) -> - fun({atom,true}, S) -> - update_type(fun meet/2, Type, Src, S); - (_, S) -> - S +infer_types_1(_, _, _, Vst) -> + Vst. + +infer_type_test_bif(Type, Src, Val, Op, Vst) -> + case Val of + {atom, Bool} when Op =:= eq_exact, Bool; Op =:= ne_exact, not Bool -> + update_type(fun meet/2, Type, Src, Vst); + {atom, Bool} when Op =:= ne_exact, Bool; Op =:= eq_exact, not Bool -> + update_type(fun subtract/2, Type, Src, Vst); + _ -> + Vst end. %%% @@ -1822,43 +2029,58 @@ update_type(Merge, With, #value_ref{}=Ref, Vst) -> update_type(Merge, With, {Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y -> update_type(Merge, With, get_reg_vref(Reg, Vst), Vst); update_type(Merge, With, Literal, Vst) -> - assert_literal(Literal), %% Literals always retain their type, but we still need to bail on type %% conflicts. - case Merge(Literal, With) of - none -> throw({type_conflict, Literal, With}); + Type = get_literal_type(Literal), + case Merge(Type, With) of + none -> throw({type_conflict, Type, With}); _Type -> Vst end. -update_ne_types(LHS, RHS, Vst) -> +update_eq_types(LHS, RHS, Vst0) -> + LType = get_term_type(LHS, Vst0), + RType = get_term_type(RHS, Vst0), + + Vst1 = update_type(fun meet/2, RType, LHS, Vst0), + Vst = update_type(fun meet/2, LType, RHS, Vst1), + + infer_types(eq_exact, LHS, RHS, Vst). + +update_ne_types(LHS, RHS, Vst0) -> + Vst1 = update_ne_types_1(LHS, RHS, Vst0), + Vst = update_ne_types_1(RHS, LHS, Vst1), + + infer_types(ne_exact, LHS, RHS, Vst). + +update_ne_types_1(LHS, RHS, Vst0) -> %% While updating types on equality is fairly straightforward, inequality %% is a bit trickier since all we know is that the *value* of LHS differs %% from RHS, so we can't blindly subtract their types. %% - %% Consider `number =/= {integer,[]}`; all we know is that LHS isn't equal + %% Consider `number =/= #t_integer{}`; all we know is that LHS isn't equal %% to some *specific integer* of unknown value, and if we were to subtract - %% {integer,[]} we would erroneously infer that the new type is {float,[]}. + %% #t_integer{} we would erroneously infer that the new type is float. %% %% Therefore, we only subtract when we know that RHS has a specific value. - RType = get_term_type(RHS, Vst), - case is_literal(RType) of - true -> update_type(fun subtract/2, RType, LHS, Vst); - false -> Vst + RType = get_term_type(RHS, Vst0), + case beam_types:is_singleton_type(RType) of + true -> + Vst = update_type(fun subtract/2, RType, LHS, Vst0), + + %% If LHS has a specific value after subtraction we can infer types + %% as if we've made an exact match, which is much stronger than + %% ne_exact. + LType = get_term_type(LHS, Vst), + case beam_types:get_singleton_value(LType) of + {ok, Value} -> + infer_types(eq_exact, LHS, value_to_literal(Value), Vst); + error -> + Vst + end; + false -> + Vst0 end. -update_eq_types(LHS, RHS, Vst0) -> - %% Either side might contain something worth inferring, so we need - %% to check them both. - Infer_L = infer_types(RHS, Vst0), - Infer_R = infer_types(LHS, Vst0), - Vst1 = Infer_R(RHS, Infer_L(LHS, Vst0)), - - T1 = get_term_type(LHS, Vst1), - T2 = get_term_type(RHS, Vst1), - - Vst = update_type(fun meet/2, T2, LHS, Vst1), - update_type(fun meet/2, T1, RHS, Vst). - %% Helper functions for the above. assign_1(Src, Dst, Vst0) -> @@ -1909,16 +2131,9 @@ get_reg_vref({y,_}=Src, #vst{current=#st{ys=Ys}}) -> end. set_type(Type, #value_ref{}=Ref, #vst{current=#st{vs=Vs0}=St}=Vst) -> - case Vs0 of - #{ Ref := #value{}=Entry } -> - Vs = Vs0#{ Ref => Entry#value{type=Type} }, - Vst#vst{current=St#st{vs=Vs}}; - #{} -> - %% Dead references may happen during type inference and are not an - %% error in and of themselves. If a problem were to arise from this - %% it'll explode elsewhere. - Vst - end. + #{ Ref := #value{}=Entry } = Vs0, + Vs = Vs0#{ Ref => Entry#value{type=Type} }, + Vst#vst{current=St#st{vs=Vs}}. new_value(Type, Op, Ss, #vst{current=#st{vs=Vs0}=St,ref_ctr=Counter}=Vst) -> Ref = #value_ref{id=Counter}, @@ -1926,9 +2141,9 @@ new_value(Type, Op, Ss, #vst{current=#st{vs=Vs0}=St,ref_ctr=Counter}=Vst) -> {Ref, Vst#vst{current=St#st{vs=Vs},ref_ctr=Counter+1}}. -kill_catch_tag(Reg, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) -> - Vst = Vst0#vst{current=St#st{ct=Fails,fls=undefined}}, - {_, Fail} = get_tag_type(Reg, Vst), %Assertion. +kill_catch_tag(Reg, #vst{current=#st{ct=[Tag|Tags]}=St}=Vst0) -> + Vst = Vst0#vst{current=St#st{ct=Tags,fls=undefined}}, + Tag = get_tag_type(Reg, Vst), %Assertion. kill_tag(Reg, Vst). check_try_catch_tags(Type, {y,N}=Reg, Vst) -> @@ -1973,308 +2188,44 @@ is_literal({integer,I}) when is_integer(I) -> true; is_literal({literal,_L}) -> true; is_literal(_) -> false. -%% The possible types. -%% -%% First non-term types: -%% -%% initialized Only for Y registers. Means that the Y register -%% has been initialized with some valid term so that -%% it is safe to pass to the garbage collector. -%% NOT safe to use in any other way (will not crash the -%% emulator, but clearly points to a bug in the compiler). -%% -%% {catchtag,[Lbl]} A special term used within a catch. Must only be used -%% by the catch instructions; NOT safe to use in other -%% instructions. -%% -%% {trytag,[Lbl]} A special term used within a try block. Must only be -%% used by the catch instructions; NOT safe to use in other -%% instructions. -%% -%% exception Can only be used as a type returned by -%% call_return_type/2 (which gives the type of the value -%% returned by a call). Thus 'exception' is never stored -%% as type descriptor for a register. -%% -%% #ms{} A match context for bit syntax matching. We do allow -%% it to moved/to from stack, but otherwise it must only -%% be accessed by bit syntax matching instructions. -%% -%% -%% Normal terms: -%% -%% term Any valid Erlang (but not of the special types above). -%% -%% binary Binary or bitstring. -%% -%% bool The atom 'true' or the atom 'false'. -%% -%% cons Cons cell: [_|_] -%% -%% nil Empty list: [] -%% -%% list List: [] or [_|_] -%% -%% {tuple,[Sz],Es} Tuple. An element has been accessed using -%% element/2 or setelement/3 so that it is known that -%% the type is a tuple of size at least Sz. Es is a map -%% containing known types by tuple index. -%% -%% {tuple,Sz,Es} Tuple. A test_arity instruction has been seen -%% so that it is known that the size is exactly Sz. -%% -%% {atom,[]} Atom. -%% {atom,Atom} -%% -%% {integer,[]} Integer. -%% {integer,Integer} -%% -%% {float,[]} Float. -%% {float,Float} -%% -%% number Integer or Float of unknown value -%% -%% map Map. -%% -%% none A conflict in types. There will be an exception at runtime. -%% - -%% join(Type1, Type2) -> Type -%% Return the most specific type possible. -join(Same, Same) -> - Same; -join(none, Other) -> - Other; -join(Other, none) -> - Other; -join({literal,_}=T1, T2) -> - join_literal(T1, T2); -join(T1, {literal,_}=T2) -> - join_literal(T2, T1); -join({tuple,Size,EsA}, {tuple,Size,EsB}) -> - Es = join_tuple_elements(tuple_sz(Size), EsA, EsB), - {tuple, Size, Es}; -join({tuple,A,EsA}, {tuple,B,EsB}) -> - Size = min(tuple_sz(A), tuple_sz(B)), - Es = join_tuple_elements(Size, EsA, EsB), - {tuple, [Size], Es}; -join({Type,A}, {Type,B}) - when Type =:= atom; Type =:= integer; Type =:= float -> - if A =:= B -> {Type,A}; - true -> {Type,[]} - end; -join({Type,_}, number) - when Type =:= integer; Type =:= float -> - number; -join(number, {Type,_}) - when Type =:= integer; Type =:= float -> - number; -join({integer,_}, {float,_}) -> - number; -join({float,_}, {integer,_}) -> - number; -join(bool, {atom,A}) -> - join_bool(A); -join({atom,A}, bool) -> - join_bool(A); -join({atom,A}, {atom,B}) when is_boolean(A), is_boolean(B) -> - bool; -join({atom,_}, {atom,_}) -> - {atom,[]}; -join(#ms{id=Id1,valid=B1,slots=Slots1}, - #ms{id=Id2,valid=B2,slots=Slots2}) -> - Id = if - Id1 =:= Id2 -> Id1; - true -> make_ref() - end, - #ms{id=Id,valid=B1 band B2,slots=min(Slots1, Slots2)}; -join(T1, T2) when T1 =/= T2 -> - %% We've exhaused all other options, so the type must either be a list or - %% a 'term'. - join_list(T1, T2). +value_to_literal([]) -> nil; +value_to_literal(A) when is_atom(A) -> {atom,A}; +value_to_literal(F) when is_float(F) -> {float,F}; +value_to_literal(I) when is_integer(I) -> {integer,I}; +value_to_literal(Other) -> {literal,Other}. -join_tuple_elements(Limit, EsA, EsB) -> - Es0 = join_elements(EsA, EsB), - maps:filter(fun({integer,Index}, _Type) -> Index =< Limit end, Es0). - -join_elements(Es1, Es2) -> - Keys = if - map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); - map_size(Es1) > map_size(Es2) -> maps:keys(Es2) - end, - join_elements_1(Keys, Es1, Es2, #{}). - -join_elements_1([Key | Keys], Es1, Es2, Acc0) -> - Type = case {Es1, Es2} of - {#{ Key := Same }, #{ Key := Same }} -> Same; - {#{ Key := Type1 }, #{ Key := Type2 }} -> join(Type1, Type2); - {#{}, #{}} -> term - end, - Acc = set_element_type(Key, Type, Acc0), - join_elements_1(Keys, Es1, Es2, Acc); -join_elements_1([], _Es1, _Es2, Acc) -> - Acc. - -%% Joins types of literals; note that the left argument must either be a -%% literal or exactly equal to the second argument. -join_literal(Same, Same) -> - Same; -join_literal({literal,_}=Lit, T) -> - join_literal(T, get_literal_type(Lit)); -join_literal(T1, T2) -> - %% We're done extracting the types, try merging them again. - join(T1, T2). - -join_list(nil, cons) -> list; -join_list(nil, list) -> list; -join_list(cons, list) -> list; -join_list(T, nil) -> join_list(nil, T); -join_list(T, cons) -> join_list(cons, T); -join_list(_, _) -> - %% Not a list, so it must be a term. - term. - -join_bool([]) -> {atom,[]}; -join_bool(true) -> bool; -join_bool(false) -> bool; -join_bool(_) -> {atom,[]}. - -%% meet(Type1, Type2) -> Type -%% Return the meet of two types. The meet is a more specific type. -%% It will be 'none' if the types are in conflict. - -meet(Same, Same) -> - Same; -meet(term, Other) -> - Other; -meet(Other, term) -> - Other; -meet(#ms{}, binary) -> - #ms{}; -meet(binary, #ms{}) -> - #ms{}; -meet({literal,_}, {literal,_}) -> - none; -meet(T1, {literal,_}=T2) -> - meet(T2, T1); -meet({literal,_}=T1, T2) -> - case meet(get_literal_type(T1), T2) of - none -> none; - _ -> T1 - end; -meet(T1, T2) -> - case {erlang:min(T1, T2),erlang:max(T1, T2)} of - {{atom,_}=A,{atom,[]}} -> A; - {bool,{atom,B}=Atom} when is_boolean(B) -> Atom; - {bool,{atom,[]}} -> bool; - {cons,list} -> cons; - {{float,_}=T,{float,[]}} -> T; - {{integer,_}=T,{integer,[]}} -> T; - {list,nil} -> nil; - {number,{integer,_}=T} -> T; - {number,{float,_}=T} -> T; - {{tuple,Size1,Es1},{tuple,Size2,Es2}} -> - Es = meet_elements(Es1, Es2), - case {Size1,Size2,Es} of - {_, _, none} -> - none; - {[Sz1],[Sz2],_} -> - Sz = erlang:max(Sz1, Sz2), - assert_tuple_elements(Sz, Es), - {tuple,[Sz],Es}; - {Sz1,[Sz2],_} when Sz2 =< Sz1 -> - assert_tuple_elements(Sz1, Es), - {tuple,Sz1,Es}; - {Sz,Sz,_} -> - assert_tuple_elements(Sz, Es), - {tuple,Sz,Es}; - {_,_,_} -> - none - end; - {_,_} -> none +%% These are just wrappers around their equivalents in beam_types, which +%% handle the validator-specific #t_abstract{} type. +%% +%% The funny-looking abstract types produced here are intended to provoke +%% errors on actual use; they do no harm just lying around. + +normalize(#t_abstract{}=A) -> error({abstract_type, A}); +normalize(T) -> beam_types:normalize(T). + +join(Same, Same) -> Same; +join(#t_abstract{}=A, B) -> #t_abstract{kind={join, A, B}}; +join(A, #t_abstract{}=B) -> #t_abstract{kind={join, A, B}}; +join(A, B) -> beam_types:join(A, B). + +meet(Same, Same) -> Same; +meet(#t_abstract{}=A, B) -> #t_abstract{kind={meet, A, B}}; +meet(A, #t_abstract{}=B) -> #t_abstract{kind={meet, A, B}}; +meet(A, B) -> beam_types:meet(A, B). + +subtract(#t_abstract{}=A, B) -> #t_abstract{kind={subtract, A, B}}; +subtract(A, #t_abstract{}=B) -> #t_abstract{kind={subtract, A, B}}; +subtract(A, B) -> beam_types:subtract(A, B). + +assert_type(RequiredType, Term, Vst) -> + GivenType = get_movable_term_type(Term, Vst), + case meet(RequiredType, GivenType) of + GivenType -> + ok; + _RequiredType -> + error({bad_type,{needed,RequiredType},{actual,GivenType}}) end. -meet_elements(Es1, Es2) -> - Keys = maps:keys(Es1) ++ maps:keys(Es2), - meet_elements_1(Keys, Es1, Es2, #{}). - -meet_elements_1([Key | Keys], Es1, Es2, Acc) -> - case {Es1, Es2} of - {#{ Key := Type1 }, #{ Key := Type2 }} -> - case meet(Type1, Type2) of - none -> none; - Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) - end; - {#{ Key := Type1 }, _} -> - meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); - {_, #{ Key := Type2 }} -> - meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) - end; -meet_elements_1([], _Es1, _Es2, Acc) -> - Acc. - -%% No tuple elements may have an index above the known size. -assert_tuple_elements(Limit, Es) -> - true = maps:fold(fun({integer,Index}, _T, true) -> - Index =< Limit - end, true, Es). %Assertion. - -%% subtract(Type1, Type2) -> Type -%% Subtract Type2 from Type2. Example: -%% subtract(list, nil) -> cons - -subtract(Same, Same) -> none; -subtract(list, nil) -> cons; -subtract(list, cons) -> nil; -subtract(number, {integer,[]}) -> {float,[]}; -subtract(number, {float,[]}) -> {integer,[]}; -subtract(bool, {atom,false}) -> {atom, true}; -subtract(bool, {atom,true}) -> {atom, false}; -subtract(Type, _) -> Type. - -assert_type(WantedType, Term, Vst) -> - Type = get_term_type(Term, Vst), - assert_type(WantedType, Type). - -assert_type(Correct, Correct) -> ok; -assert_type(float, {float,_}) -> ok; -assert_type(tuple, {tuple,_,_}) -> ok; -assert_type(tuple, {literal,Tuple}) when is_tuple(Tuple) -> ok; -assert_type({tuple_element,I}, {tuple,[Sz],_}) - when 1 =< I, I =< Sz -> - ok; -assert_type({tuple_element,I}, {tuple,Sz,_}) - when is_integer(Sz), 1 =< I, I =< Sz -> - ok; -assert_type({tuple_element,I}, {literal,Lit}) when I =< tuple_size(Lit) -> - ok; -assert_type(cons, {literal,[_|_]}) -> - ok; -assert_type(Needed, Actual) -> - error({bad_type,{needed,Needed},{actual,Actual}}). - -get_element_type(Key, Src, Vst) -> - get_element_type_1(Key, get_term_type(Src, Vst)). - -get_element_type_1({integer,_}=Key, {tuple,_Sz,Es}) -> - case Es of - #{ Key := Type } -> Type; - #{} -> term - end; -get_element_type_1(_Index, _Type) -> - term. - -set_element_type(_Key, none, Es) -> - Es; -set_element_type(Key, term, Es) -> - maps:remove(Key, Es); -set_element_type(Key, Type, Es) -> - Es#{ Key => Type }. - -get_tuple_size({integer,[]}) -> 0; -get_tuple_size({integer,Sz}) -> Sz; -get_tuple_size(_) -> 0. - validate_src(Ss, Vst) when is_list(Ss) -> _ = [assert_term(S, Vst) || S <- Ss], ok. @@ -2285,7 +2236,8 @@ validate_src(Ss, Vst) when is_list(Ss) -> get_term_type(Src, Vst) -> case get_movable_term_type(Src, Vst) of - #ms{} -> error({match_context,Src}); + #t_bs_context{} -> error({match_context,Src}); + #t_abstract{} -> error({abstract_term,Src}); Type -> Type end. @@ -2295,12 +2247,11 @@ get_term_type(Src, Vst) -> get_movable_term_type(Src, Vst) -> case get_raw_type(Src, Vst) of + #t_abstract{kind=unfinished_tuple=Kind} -> error({Kind,Src}); initialized -> error({unassigned,Src}); uninitialized -> error({uninitialized_reg,Src}); {catchtag,_} -> error({catchtag,Src}); {trytag,_} -> error({trytag,Src}); - tuple_in_progress -> error({tuple_in_progress,Src}); - {literal,_}=Lit -> get_literal_type(Lit); Type -> Type end. @@ -2339,33 +2290,21 @@ get_raw_type(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> #{ Ref := #value{type=Type} } -> Type; #{} -> none end; -get_raw_type(Src, #vst{}) -> +get_raw_type(Src, #vst{current=#st{}}) -> get_literal_type(Src). -get_literal_type(nil=T) -> T; -get_literal_type({atom,A}=T) when is_atom(A) -> T; -get_literal_type({float,F}=T) when is_float(F) -> T; -get_literal_type({integer,I}=T) when is_integer(I) -> T; -get_literal_type({literal,[_|_]}) -> cons; -get_literal_type({literal,Bitstring}) when is_bitstring(Bitstring) -> binary; -get_literal_type({literal,Map}) when is_map(Map) -> map; -get_literal_type({literal,Tuple}) when is_tuple(Tuple) -> glt_1(Tuple); -get_literal_type({literal,_}) -> term; -get_literal_type(T) -> error({not_literal,T}). - -glt_1([]) -> nil; -glt_1(A) when is_atom(A) -> {atom, A}; -glt_1(F) when is_float(F) -> {float, F}; -glt_1(I) when is_integer(I) -> {integer, I}; -glt_1(T) when is_tuple(T) -> - {Es,_} = foldl(fun(Val, {Es0, Index}) -> - Type = glt_1(Val), - Es = set_element_type({integer,Index}, Type, Es0), - {Es, Index + 1} - end, {#{}, 1}, tuple_to_list(T)), - {tuple, tuple_size(T), Es}; -glt_1(L) -> - {literal, L}. +get_literal_type(nil) -> + beam_types:make_type_from_value([]); +get_literal_type({atom,A}) when is_atom(A) -> + beam_types:make_type_from_value(A); +get_literal_type({float,F}) when is_float(F) -> + beam_types:make_type_from_value(F); +get_literal_type({integer,I}) when is_integer(I) -> + beam_types:make_type_from_value(I); +get_literal_type({literal,L}) -> + beam_types:make_type_from_value(L); +get_literal_type(T) -> + error({not_literal,T}). %%% %%% Branch tracking @@ -2383,10 +2322,12 @@ glt_1(L) -> SuccFun :: BranchFun) -> #vst{} when BranchFun :: fun((#vst{}) -> #vst{}). branch(Lbl, Vst0, FailFun, SuccFun) -> + validate_branch(Lbl, Vst0), #vst{current=St0} = Vst0, + try FailFun(Vst0) of Vst1 -> - Vst2 = branch_state(Lbl, Vst1), + Vst2 = fork_state(Lbl, Vst1), Vst = Vst2#vst{current=St0}, try SuccFun(Vst) of V -> V @@ -2404,6 +2345,24 @@ branch(Lbl, Vst0, FailFun, SuccFun) -> SuccFun(Vst0) end. +validate_branch(Lbl, #vst{current=#st{ct=Tags}}) -> + validate_branch_1(Lbl, Tags). + +validate_branch_1(Lbl, [{trytag, FailLbls} | Tags]) -> + %% 'try_case' assumes that an exception has been thrown, so a direct branch + %% will crash the emulator. + %% + %% (Jumping to a 'catch_end' is fine however as it will simply nop in the + %% absence of an exception.) + case ordsets:is_element(Lbl, FailLbls) of + true -> error({illegal_branch, try_handler, Lbl}); + false -> validate_branch_1(Lbl, Tags) + end; +validate_branch_1(Lbl, [_ | Tags]) -> + validate_branch_1(Lbl, Tags); +validate_branch_1(_Lbl, []) -> + ok. + %% A shorthand version of branch/4 for when the state is only altered on %% success. branch(Fail, Vst, SuccFun) -> @@ -2411,12 +2370,12 @@ branch(Fail, Vst, SuccFun) -> %% Directly branches off the state. This is an "internal" operation that should %% be used sparingly. -branch_state(0, #vst{}=Vst) -> +fork_state(0, #vst{}=Vst) -> %% If the instruction fails, the stack may be scanned looking for a catch %% tag. Therefore the Y registers must be initialized at this point. verify_y_init(Vst), Vst; -branch_state(L, #vst{current=St,branched=B,ref_ctr=Counter0}=Vst) -> +fork_state(L, #vst{current=St,branched=B,ref_ctr=Counter0}=Vst) -> case gb_trees:is_defined(L, B) of true -> {MergedSt, Counter} = merge_states(L, St, B, Counter0), @@ -2432,14 +2391,14 @@ branch_state(L, #vst{current=St,branched=B,ref_ctr=Counter0}=Vst) -> merge_states(L, St, Branched, Counter) when L =/= 0 -> case gb_trees:lookup(L, Branched) of - none -> - {St, Counter}; - {value,OtherSt} when St =:= none -> - {OtherSt, Counter}; - {value,OtherSt} -> - merge_states_1(St, OtherSt, Counter) + {value, OtherSt} -> merge_states_1(St, OtherSt, Counter); + none -> {St, Counter} end. +merge_states_1(St, none, Counter) -> + {St, Counter}; +merge_states_1(none, St, Counter) -> + {St, Counter}; merge_states_1(StA, StB, Counter0) -> #st{xs=XsA,ys=YsA,vs=VsA,fragile=FragA,numy=NumYA, h=HA,ct=CtA,recv_marker=MarkerA} = StA, @@ -2501,10 +2460,10 @@ merge_tags(uninitialized, _) -> uninitialized; merge_tags(_, uninitialized) -> uninitialized; -merge_tags({catchtag,T0}, {catchtag,T1}) -> - {catchtag, ordsets:from_list(T0 ++ T1)}; -merge_tags({trytag,T0}, {trytag,T1}) -> - {trytag, ordsets:from_list(T0 ++ T1)}; +merge_tags({trytag, LblsA}, {trytag, LblsB}) -> + {trytag, ordsets:union(LblsA, LblsB)}; +merge_tags({catchtag, LblsA}, {catchtag, LblsB}) -> + {catchtag, ordsets:union(LblsA, LblsB)}; merge_tags(_A, _B) -> %% All other combinations leave the register initialized. Errors arising %% from this will be caught later on. @@ -2587,13 +2546,14 @@ merge_stk(_, _) -> undecided. merge_ct(S, S) -> S; merge_ct(Ct0, Ct1) -> merge_ct_1(Ct0, Ct1). -merge_ct_1([C0|Ct0], [C1|Ct1]) -> - [ordsets:from_list(C0++C1)|merge_ct_1(Ct0, Ct1)]; -merge_ct_1([], []) -> []; -merge_ct_1(_, _) -> undecided. - -tuple_sz([Sz]) -> Sz; -tuple_sz(Sz) -> Sz. +merge_ct_1([], []) -> + []; +merge_ct_1([{trytag, LblsA} | CtA], [{trytag, LblsB} | CtB]) -> + [{trytag, ordsets:union(LblsA, LblsB)} | merge_ct_1(CtA, CtB)]; +merge_ct_1([{catchtag, LblsA} | CtA], [{catchtag, LblsB} | CtB]) -> + [{catchtag, ordsets:union(LblsA, LblsB)} | merge_ct_1(CtA, CtB)]; +merge_ct_1(_, _) -> + undecided. verify_y_init(#vst{current=#st{numy=NumY,ys=Ys}}=Vst) when is_integer(NumY) -> HighestY = maps:fold(fun({y,Y}, _, Acc) -> max(Y, Acc) end, -1, Ys), @@ -2770,320 +2730,46 @@ assert_not_fragile(Lit, #vst{}) -> ok. %%% -%%% Return/argument types of BIFs -%%% - -bif_return_type('-', Src, Vst) -> - arith_return_type(Src, Vst); -bif_return_type('+', Src, Vst) -> - arith_return_type(Src, Vst); -bif_return_type('*', Src, Vst) -> - arith_return_type(Src, Vst); -bif_return_type(abs, [Num], Vst) -> - case get_term_type(Num, Vst) of - {float,_}=T -> T; - {integer,_}=T -> T; - _ -> number - end; -bif_return_type(float, _, _) -> {float,[]}; -bif_return_type('/', _, _) -> {float,[]}; -%% Binary operations -bif_return_type('binary_part', [_,_], _) -> binary; -bif_return_type('binary_part', [_,_,_], _) -> binary; -bif_return_type('bit_size', [_], _) -> {integer,[]}; -bif_return_type('byte_size', [_], _) -> {integer,[]}; -%% Integer operations. -bif_return_type(ceil, [_], _) -> {integer,[]}; -bif_return_type('div', [_,_], _) -> {integer,[]}; -bif_return_type(floor, [_], _) -> {integer,[]}; -bif_return_type('rem', [_,_], _) -> {integer,[]}; -bif_return_type(length, [_], _) -> {integer,[]}; -bif_return_type(size, [_], _) -> {integer,[]}; -bif_return_type(trunc, [_], _) -> {integer,[]}; -bif_return_type(round, [_], _) -> {integer,[]}; -bif_return_type('band', [_,_], _) -> {integer,[]}; -bif_return_type('bor', [_,_], _) -> {integer,[]}; -bif_return_type('bxor', [_,_], _) -> {integer,[]}; -bif_return_type('bnot', [_], _) -> {integer,[]}; -bif_return_type('bsl', [_,_], _) -> {integer,[]}; -bif_return_type('bsr', [_,_], _) -> {integer,[]}; -%% Booleans. -bif_return_type('==', [_,_], _) -> bool; -bif_return_type('/=', [_,_], _) -> bool; -bif_return_type('=<', [_,_], _) -> bool; -bif_return_type('<', [_,_], _) -> bool; -bif_return_type('>=', [_,_], _) -> bool; -bif_return_type('>', [_,_], _) -> bool; -bif_return_type('=:=', [_,_], _) -> bool; -bif_return_type('=/=', [_,_], _) -> bool; -bif_return_type('not', [_], _) -> bool; -bif_return_type('and', [_,_], _) -> bool; -bif_return_type('or', [_,_], _) -> bool; -bif_return_type('xor', [_,_], _) -> bool; -bif_return_type(is_atom, [_], _) -> bool; -bif_return_type(is_boolean, [_], _) -> bool; -bif_return_type(is_binary, [_], _) -> bool; -bif_return_type(is_float, [_], _) -> bool; -bif_return_type(is_function, [_], _) -> bool; -bif_return_type(is_function, [_,_], _) -> bool; -bif_return_type(is_integer, [_], _) -> bool; -bif_return_type(is_list, [_], _) -> bool; -bif_return_type(is_map, [_], _) -> bool; -bif_return_type(is_map_key, [_, _], _) -> bool; -bif_return_type(is_number, [_], _) -> bool; -bif_return_type(is_pid, [_], _) -> bool; -bif_return_type(is_port, [_], _) -> bool; -bif_return_type(is_reference, [_], _) -> bool; -bif_return_type(is_tuple, [_], _) -> bool; -%% Misc. -bif_return_type(tuple_size, [_], _) -> {integer,[]}; -bif_return_type(map_size, [_], _) -> {integer,[]}; -bif_return_type(node, [], _) -> {atom,[]}; -bif_return_type(node, [_], _) -> {atom,[]}; -bif_return_type(hd, [_], _) -> term; -bif_return_type(tl, [_], _) -> term; -bif_return_type(get, [_], _) -> term; -bif_return_type(Bif, _, _) when is_atom(Bif) -> term. - -%% Generic -bif_arg_types(tuple_size, [_]) -> [{tuple,[0],#{}}]; -bif_arg_types(map_size, [_]) -> [map]; -bif_arg_types(is_map_key, [_,_]) -> [term, map]; -bif_arg_types(map_get, [_,_]) -> [term, map]; -bif_arg_types(length, [_]) -> [list]; -bif_arg_types(hd, [_]) -> [cons]; -bif_arg_types(tl, [_]) -> [cons]; -%% Boolean -bif_arg_types('not', [_]) -> [bool]; -bif_arg_types('and', [_,_]) -> [bool, bool]; -bif_arg_types('or', [_,_]) -> [bool, bool]; -bif_arg_types('xor', [_,_]) -> [bool, bool]; -%% Binary -bif_arg_types('binary_part', [_,_]) -> - PosLen = {tuple, 2, #{ {integer,1} => {integer,[]}, - {integer,2} => {integer,[]} }}, - [binary, PosLen]; -bif_arg_types('binary_part', [_,_,_]) -> - [binary, {integer,[]}, {integer,[]}]; -bif_arg_types('bit_size', [_]) -> [binary]; -bif_arg_types('byte_size', [_]) -> [binary]; -%% Numerical -bif_arg_types('-', [_]) -> [number]; -bif_arg_types('-', [_,_]) -> [number,number]; -bif_arg_types('+', [_]) -> [number]; -bif_arg_types('+', [_,_]) -> [number,number]; -bif_arg_types('*', [_,_]) -> [number, number]; -bif_arg_types('/', [_,_]) -> [number, number]; -bif_arg_types(abs, [_]) -> [number]; -bif_arg_types(ceil, [_]) -> [number]; -bif_arg_types(float, [_]) -> [number]; -bif_arg_types(floor, [_]) -> [number]; -bif_arg_types(trunc, [_]) -> [number]; -bif_arg_types(round, [_]) -> [number]; -%% Integer-specific -bif_arg_types('div', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('rem', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('band', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('bor', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('bxor', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('bnot', [_]) -> [{integer,[]}]; -bif_arg_types('bsl', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('bsr', [_,_]) -> [{integer,[]}, {integer,[]}]; -%% Unsafe type tests that may fail if an argument doesn't have the right type. -bif_arg_types(is_function, [_,_]) -> [term, {integer,[]}]; -bif_arg_types(_, Args) -> [term || _Arg <- Args]. - -is_bif_safe('/=', 2) -> true; -is_bif_safe('<', 2) -> true; -is_bif_safe('=/=', 2) -> true; -is_bif_safe('=:=', 2) -> true; -is_bif_safe('=<', 2) -> true; -is_bif_safe('==', 2) -> true; -is_bif_safe('>', 2) -> true; -is_bif_safe('>=', 2) -> true; -is_bif_safe(is_atom, 1) -> true; -is_bif_safe(is_boolean, 1) -> true; -is_bif_safe(is_binary, 1) -> true; -is_bif_safe(is_bitstring, 1) -> true; -is_bif_safe(is_float, 1) -> true; -is_bif_safe(is_function, 1) -> true; -is_bif_safe(is_integer, 1) -> true; -is_bif_safe(is_list, 1) -> true; -is_bif_safe(is_map, 1) -> true; -is_bif_safe(is_number, 1) -> true; -is_bif_safe(is_pid, 1) -> true; -is_bif_safe(is_port, 1) -> true; -is_bif_safe(is_reference, 1) -> true; -is_bif_safe(is_tuple, 1) -> true; -is_bif_safe(get, 1) -> true; -is_bif_safe(self, 0) -> true; -is_bif_safe(node, 0) -> true; -is_bif_safe(_, _) -> false. - -arith_return_type([A], Vst) -> - %% Unary '+' or '-'. - case get_term_type(A, Vst) of - {integer,_} -> {integer,[]}; - {float,_} -> {float,[]}; - _ -> number - end; -arith_return_type([A,B], Vst) -> - TypeA = get_term_type(A, Vst), - TypeB = get_term_type(B, Vst), - case {TypeA, TypeB} of - {{integer,_},{integer,_}} -> {integer,[]}; - {{float,_},_} -> {float,[]}; - {_,{float,_}} -> {float,[]}; - {_,_} -> number - end; -arith_return_type(_, _) -> number. - -%%% -%%% Return/argument types of calls +%%% Return/argument types of calls and BIFs %%% -call_return_type({extfunc,M,F,A}, Vst) -> call_return_type_1(M, F, A, Vst); -call_return_type(_, _) -> term. - -call_return_type_1(erlang, setelement, 3, Vst) -> - IndexType = get_term_type({x,0}, Vst), - TupleType = - case get_term_type({x,1}, Vst) of - {literal,Tuple}=Lit when is_tuple(Tuple) -> get_literal_type(Lit); - {tuple,_,_}=TT -> TT; - _ -> {tuple,[0],#{}} - end, - case IndexType of - {integer,I} when is_integer(I) -> - case meet({tuple,[I],#{}}, TupleType) of - {tuple, Sz, Es0} -> - ValueType = get_term_type({x,2}, Vst), - Es = set_element_type({integer,I}, ValueType, Es0), - {tuple, Sz, Es}; - none -> - TupleType - end; - _ -> - %% The index could point anywhere, so we must discard all element - %% information. - setelement(3, TupleType, #{}) - end; -call_return_type_1(erlang, '++', 2, Vst) -> - LType = get_term_type({x,0}, Vst), - RType = get_term_type({x,1}, Vst), - case LType =:= cons orelse RType =:= cons of - true -> - cons; - false -> - %% `[] ++ RHS` yields RHS, even if RHS is not a list - join(list, RType) - end; -call_return_type_1(erlang, '--', 2, _Vst) -> - list; -call_return_type_1(erlang, F, A, _) -> - erlang_mod_return_type(F, A); -call_return_type_1(lists, F, A, Vst) -> - lists_mod_return_type(F, A, Vst); -call_return_type_1(math, F, A, _) -> - math_mod_return_type(F, A); -call_return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> - term. - -erlang_mod_return_type(exit, 1) -> exception; -erlang_mod_return_type(throw, 1) -> exception; -erlang_mod_return_type(error, 1) -> exception; -erlang_mod_return_type(error, 2) -> exception; -erlang_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. - -math_mod_return_type(cos, 1) -> {float,[]}; -math_mod_return_type(cosh, 1) -> {float,[]}; -math_mod_return_type(sin, 1) -> {float,[]}; -math_mod_return_type(sinh, 1) -> {float,[]}; -math_mod_return_type(tan, 1) -> {float,[]}; -math_mod_return_type(tanh, 1) -> {float,[]}; -math_mod_return_type(acos, 1) -> {float,[]}; -math_mod_return_type(acosh, 1) -> {float,[]}; -math_mod_return_type(asin, 1) -> {float,[]}; -math_mod_return_type(asinh, 1) -> {float,[]}; -math_mod_return_type(atan, 1) -> {float,[]}; -math_mod_return_type(atanh, 1) -> {float,[]}; -math_mod_return_type(erf, 1) -> {float,[]}; -math_mod_return_type(erfc, 1) -> {float,[]}; -math_mod_return_type(exp, 1) -> {float,[]}; -math_mod_return_type(log, 1) -> {float,[]}; -math_mod_return_type(log2, 1) -> {float,[]}; -math_mod_return_type(log10, 1) -> {float,[]}; -math_mod_return_type(sqrt, 1) -> {float,[]}; -math_mod_return_type(atan2, 2) -> {float,[]}; -math_mod_return_type(pow, 2) -> {float,[]}; -math_mod_return_type(ceil, 1) -> {float,[]}; -math_mod_return_type(floor, 1) -> {float,[]}; -math_mod_return_type(fmod, 2) -> {float,[]}; -math_mod_return_type(pi, 0) -> {float,[]}; -math_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. - -lists_mod_return_type(all, 2, _Vst) -> - bool; -lists_mod_return_type(any, 2, _Vst) -> - bool; -lists_mod_return_type(keymember, 3, _Vst) -> - bool; -lists_mod_return_type(member, 2, _Vst) -> - bool; -lists_mod_return_type(prefix, 2, _Vst) -> - bool; -lists_mod_return_type(suffix, 2, _Vst) -> - bool; -lists_mod_return_type(dropwhile, 2, _Vst) -> - list; -lists_mod_return_type(duplicate, 2, _Vst) -> - list; -lists_mod_return_type(filter, 2, _Vst) -> - list; -lists_mod_return_type(flatten, 1, _Vst) -> - list; -lists_mod_return_type(map, 2, Vst) -> - same_length_type({x,1}, Vst); -lists_mod_return_type(MF, 3, Vst) when MF =:= mapfoldl; MF =:= mapfoldr -> - ListType = same_length_type({x,2}, Vst), - {tuple,2,#{ {integer,1} => ListType} }; -lists_mod_return_type(partition, 2, _Vst) -> - two_tuple(list, list); -lists_mod_return_type(reverse, 1, Vst) -> - same_length_type({x,0}, Vst); -lists_mod_return_type(seq, 2, _Vst) -> - list; -lists_mod_return_type(sort, 1, Vst) -> - same_length_type({x,0}, Vst); -lists_mod_return_type(sort, 2, Vst) -> - same_length_type({x,1}, Vst); -lists_mod_return_type(splitwith, 2, _Vst) -> - two_tuple(list, list); -lists_mod_return_type(takewhile, 2, _Vst) -> - list; -lists_mod_return_type(unzip, 1, Vst) -> - ListType = same_length_type({x,0}, Vst), - two_tuple(ListType, ListType); -lists_mod_return_type(usort, 1, Vst) -> - same_length_type({x,0}, Vst); -lists_mod_return_type(zip, 2, _Vst) -> - list; -lists_mod_return_type(zipwith, 3, _Vst) -> - list; -lists_mod_return_type(_, _, _) -> - term. - -two_tuple(Type1, Type2) -> - {tuple,2,#{ {integer,1} => Type1, - {integer,2} => Type2 }}. - -same_length_type(Reg, Vst) -> - case get_term_type(Reg, Vst) of - {literal,[_|_]} -> cons; - cons -> cons; - nil -> nil; - _ -> list - end. +bif_types(Op, Ss, Vst) -> + Args = [normalize(get_term_type(Arg, Vst)) || Arg <- Ss], + beam_call_types:types(erlang, Op, Args). + +call_types({extfunc,M,F,A}, A, Vst) -> + Args = get_call_args(A, Vst), + beam_call_types:types(M, F, Args); +call_types(_, A, Vst) -> + {any, get_call_args(A, Vst), false}. + +will_bif_succeed(fadd, [_,_], _Vst) -> + maybe; +will_bif_succeed(fdiv, [_,_], _Vst) -> + maybe; +will_bif_succeed(fmul, [_,_], _Vst) -> + maybe; +will_bif_succeed(fnegate, [_], _Vst) -> + maybe; +will_bif_succeed(fsub, [_,_], _Vst) -> + maybe; +will_bif_succeed(Op, Ss, Vst) -> + Args = [normalize(get_term_type(Arg, Vst)) || Arg <- Ss], + beam_call_types:will_succeed(erlang, Op, Args). + +will_call_succeed({extfunc,M,F,A}, Vst) -> + beam_call_types:will_succeed(M, F, get_call_args(A, Vst)); +will_call_succeed(_Call, _Vst) -> + maybe. + +get_call_args(Arity, Vst) -> + get_call_args_1(0, Arity, Vst). + +get_call_args_1(Arity, Arity, _) -> + []; +get_call_args_1(N, Arity, Vst) when N < Arity -> + ArgType = normalize(get_movable_term_type({x,N}, Vst)), + [ArgType | get_call_args_1(N + 1, Arity, Vst)]. check_limit({x,X}=Src) when is_integer(X) -> if @@ -3108,6 +2794,12 @@ check_limit({fr,Fr}=Src) when is_integer(Fr) -> min(A, B) when is_integer(A), is_integer(B), A < B -> A; min(A, B) when is_integer(A), is_integer(B) -> B. +gcd(A, B) -> + case A rem B of + 0 -> B; + X -> gcd(B, X) + end. + gb_trees_from_list(L) -> gb_trees:from_orddict(sort(L)). error(Error) -> throw(Error). diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 415b579240..b5b2dde22c 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -47,16 +47,31 @@ function({function,Name,Arity,CLabel,Is0}, NoGetHdTl) -> undo_renames([{call_ext,2,send}|Is]) -> [send|undo_renames(Is)]; + undo_renames([{apply,A},{deallocate,N},return|Is]) -> [{apply_last,A,N}|undo_renames(Is)]; + +undo_renames([{call,A,F},{'%',{var_info,{x,0},_}},{deallocate,N},return|Is]) -> + %% We've removed a redundant move of a literal to {x,0}. + [{call_last,A,F,N} | undo_renames(Is)]; undo_renames([{call,A,F},{deallocate,N},return|Is]) -> - [{call_last,A,F,N}|undo_renames(Is)]; + [{call_last,A,F,N} | undo_renames(Is)]; + +undo_renames([{call_ext,A,F},{'%',{var_info,{x,0},_}},{deallocate,N},return|Is]) -> + [{call_ext_last,A,F,N} | undo_renames(Is)]; undo_renames([{call_ext,A,F},{deallocate,N},return|Is]) -> - [{call_ext_last,A,F,N}|undo_renames(Is)]; + [{call_ext_last,A,F,N} | undo_renames(Is)]; + +undo_renames([{call,A,F},{'%',{var_info,{x,0},_}},return|Is]) -> + [{call_only,A,F} | undo_renames(Is)]; undo_renames([{call,A,F},return|Is]) -> [{call_only,A,F}|undo_renames(Is)]; + +undo_renames([{call_ext,A,F},{'%',{var_info,{x,0},_}},return|Is]) -> + [{call_ext_only,A,F} | undo_renames(Is)]; undo_renames([{call_ext,A,F},return|Is]) -> [{call_ext_only,A,F}|undo_renames(Is)]; + undo_renames([{bif,raise,_,_,_}=I|Is0]) -> %% A minor optimization. Done here because: %% (1) beam_jump may move or share 'raise' instructions, and that diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index caff47dbcb..8a2ea77b99 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -65,7 +65,7 @@ map_pair_op/1, map_pair_key/1, map_pair_val/1 ]). --import(lists, [foldl/3, foldr/3, mapfoldl/3, reverse/1]). +-import(lists, [foldl/3, foldr/3, member/2, mapfoldl/3, reverse/1]). %% %% Constants @@ -142,7 +142,7 @@ weight(module) -> 1. % Like a letrec with a constant body %% environment, the state location, and the effort counter at the call %% site (cf. `visit'). --record(opnd, {expr, ren, env, loc, effort}). +-record(opnd, {expr, ren, env, loc, effort, no_inline}). %% Since expressions are only visited in `effect' context when they are %% not bound to a referenced variable, only expressions visited in @@ -903,10 +903,14 @@ i_fun(E, Ctxt, Ren, Env, S) -> %% side of each definition. i_letrec(E, Ctxt, Ren, Env, S) -> + %% We must turn off inlining if this `letrec' is specially + %% implemented. + NoInline = member(letrec_goto, get_ann(E)), + %% Note that we pass an empty list for the auto-referenced %% (exported) functions here. {Es, B, _, S1} = i_letrec(letrec_defs(E), letrec_body(E), [], Ctxt, - Ren, Env, S), + Ren, Env, NoInline, S), %% If no bindings remain, only the body is returned. case Es of @@ -920,12 +924,13 @@ i_letrec(E, Ctxt, Ren, Env, S) -> %% The major part of this is shared by letrec-expressions and module %% definitions alike. -i_letrec(Es, B, Xs, Ctxt, Ren, Env, S) -> +i_letrec(Es, B, Xs, Ctxt, Ren, Env, NoInline, S) -> %% First, we create operands with dummy renamings and environments, %% and with fresh store locations for cached expressions and operand %% info. {Opnds, S1} = mapfoldl(fun ({_, E}, S) -> - make_opnd(E, undefined, undefined, S) + make_opnd(E, undefined, undefined, + NoInline, S) end, S, Es), @@ -1277,7 +1282,7 @@ i_module(E, Ctxt, Ren, Env, S) -> %% "body" parameter. Exps = i_module_exports(E), {Es, _, Xs1, S1} = i_letrec(module_defs(E), void(), - Exps, Ctxt, Ren, Env, S), + Exps, Ctxt, Ren, Env, false, S), %% Sanity check: case Es of [] -> @@ -1500,23 +1505,15 @@ inline(E, #app{opnds = Opnds, ctxt = Ctxt, loc = L}, Ren, Env, S) -> %% respective operand structures from the app-structure. {Rs, Ren1, Env1, S1} = bind_locals(Vs, Opnds, Ren, Env, S), - %% function_clause exceptions that have been inlined - %% into another function (or even into the same function) - %% will not work properly. The v3_kernel pass will - %% take care of it, but we will need to help it by - %% removing any function_name annotations on match_fail - %% primops that we inline. - E1 = kill_function_name_anns(fun_body(E)), - %% Visit the body in the context saved in the structure. - {E2, S2} = i(E1, Ctxt, Ren1, Env1, S1), + {E1, S2} = i(fun_body(E), Ctxt, Ren1, Env1, S1), %% Create necessary bindings and/or set flags. - {E3, S3} = make_let_bindings(Rs, E2, S2), + {E2, S3} = make_let_bindings(Rs, E1, S2), %% Lastly, flag the application as inlined, since the inlining %% attempt was not aborted before we reached this point. - {E3, st__set_app_inlined(L, S3)} + {E2, st__set_app_inlined(L, S3)} end. %% For the (possibly renamed) argument variables to an inlined call, @@ -1674,6 +1671,8 @@ copy_var(R, Ctxt, Env, S) -> end end. +copy_1(R, #opnd{no_inline = true}, _E, _Ctxt, _Env, S) -> + residualize_var(R, S); copy_1(R, Opnd, E, Ctxt, Env, S) -> case type(E) of 'fun' -> @@ -2075,9 +2074,13 @@ ref_to_var(#ref{name = Name}) -> %% passive, the operands will also be processed with a passive counter. make_opnd(E, Ren, Env, S) -> + make_opnd(E, Ren, Env, false, S). + +make_opnd(E, Ren, Env, NoInline, S) -> {L, S1} = st__new_opnd_loc(S), C = st__get_effort(S1), - Opnd = #opnd{expr = E, ren = Ren, env = Env, loc = L, effort = C}, + Opnd = #opnd{expr = E, ren = Ren, env = Env, loc = L, + effort = C, no_inline = NoInline}, {Opnd, S1}. keep_referenced(Rs, S) -> @@ -2469,19 +2472,6 @@ kill_id_anns([A | As]) -> kill_id_anns([]) -> []. -kill_function_name_anns(Body) -> - F = fun(P) -> - case type(P) of - primop -> - Ann = get_ann(P), - Ann1 = lists:keydelete(function_name, 1, Ann), - set_ann(P, Ann1); - _ -> - P - end - end, - cerl_trees:map(F, Body). - %% ===================================================================== %% General utilities @@ -2526,21 +2516,19 @@ set_clause_bodies([], _) -> %% Abstract datatype: renaming() ren__identity() -> - dict:new(). + #{}. ren__add(X, Y, Ren) -> - dict:store(X, Y, Ren). + Ren#{X=>Y}. ren__map(X, Ren) -> - case dict:find(X, Ren) of - {ok, Y} -> - Y; - error -> - X + case Ren of + #{X:=Y} -> Y; + #{} -> X end. ren__add_identity(X, Ren) -> - dict:erase(X, Ren). + maps:remove(X, Ren). %% ===================================================================== @@ -2633,7 +2621,7 @@ st__new(Effort, Size, Unroll) -> size = counter__new_passive(Size), effort = counter__new_passive(Effort), unroll = Unroll, - cache = dict:new(), + cache = maps:new(), var_flags = ets:new(var, EtsOpts), opnd_flags = ets:new(opnd, EtsOpts), app_flags = ets:new(app, EtsOpts)}. @@ -2664,12 +2652,12 @@ st__get_var_referenced(L, S) -> ets:lookup_element(S#state.var_flags, L, #var_flags.referenced). st__lookup_opnd_cache(L, S) -> - dict:find(L, S#state.cache). + maps:find(L, S#state.cache). %% Note that setting the cache should only be done once. st__set_opnd_cache(L, C, S) -> - S#state{cache = dict:store(L, C, S#state.cache)}. + S#state{cache = maps:put(L, C, S#state.cache)}. st__set_opnd_effect(L, S) -> T = S#state.opnd_flags, diff --git a/lib/compiler/src/cerl_sets.erl b/lib/compiler/src/cerl_sets.erl index f489baf238..0564779f39 100644 --- a/lib/compiler/src/cerl_sets.erl +++ b/lib/compiler/src/cerl_sets.erl @@ -130,8 +130,10 @@ union1(S1, []) -> S1. Set2 :: set(Element), Set3 :: set(Element). +intersection(S1, S2) when map_size(S1) >= map_size(S2) -> + filter(fun (E) -> is_element(E, S1) end, S2); intersection(S1, S2) -> - filter(fun (E) -> is_element(E, S1) end, S2). + intersection(S2, S1). %% intersection([Set]) -> Set. %% Return the intersection of the list of sets. @@ -153,14 +155,21 @@ intersection1(S1, []) -> S1. Set1 :: set(Element), Set2 :: set(Element). -is_disjoint(S1, S2) when map_size(S1) < map_size(S2) -> - fold(fun (_, false) -> false; - (E, true) -> not is_element(E, S2) - end, true, S1); +is_disjoint(S1, S2) when map_size(S1) > map_size(S2) -> + is_disjoint_1(S1, maps:iterator(S2)); is_disjoint(S1, S2) -> - fold(fun (_, false) -> false; - (E, true) -> not is_element(E, S1) - end, true, S2). + is_disjoint_1(S2, maps:iterator(S1)). + +is_disjoint_1(Set, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + case Set of + #{K := _} -> false; + #{} -> is_disjoint_1(Set, NextIter) + end; + none -> + true + end. %% subtract(Set1, Set2) -> Set. %% Return all and only the elements of Set1 which are not also in @@ -180,8 +189,21 @@ subtract(S1, S2) -> Set1 :: set(Element), Set2 :: set(Element). +is_subset(S1, S2) when map_size(S1) > map_size(S2) -> + false; is_subset(S1, S2) -> - fold(fun (E, Sub) -> Sub andalso is_element(E, S2) end, true, S1). + is_subset_1(S2, maps:iterator(S1)). + +is_subset_1(Set, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + case Set of + #{K := _} -> is_subset_1(Set, NextIter); + #{} -> false + end; + none -> + true + end. %% fold(Fun, Accumulator, Set) -> Accumulator. %% Fold function Fun over all elements in Set and return Accumulator. @@ -193,8 +215,16 @@ is_subset(S1, S2) -> AccIn :: Acc, AccOut :: Acc. -fold(F, Init, D) -> - lists:foldl(fun(E,Acc) -> F(E,Acc) end,Init,maps:keys(D)). +fold(Fun, Init, Set) -> + fold_1(Fun, Init, maps:iterator(Set)). + +fold_1(Fun, Acc, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + fold_1(Fun, Fun(K,Acc), NextIter); + none -> + Acc + end. %% filter(Fun, Set) -> Set. %% Filter Set with Fun. @@ -203,5 +233,18 @@ fold(F, Init, D) -> Set1 :: set(Element), Set2 :: set(Element). -filter(F, D) -> - maps:filter(fun(K,_) -> F(K) end, D). +filter(Fun, Set) -> + maps:from_list(filter_1(Fun, maps:iterator(Set))). + +filter_1(Fun, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + case Fun(K) of + true -> + [{K,ok} | filter_1(Fun, NextIter)]; + false -> + filter_1(Fun, NextIter) + end; + none -> + [] + end. diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index 533c984221..a2089b5c1b 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -823,7 +823,7 @@ label(T) -> -spec label(cerl:cerl(), integer()) -> {cerl:cerl(), integer()}. label(T, N) -> - label(T, N, dict:new()). + label(T, N, #{}). label(T, N, Env) -> case type(T) of @@ -831,12 +831,13 @@ label(T, N, Env) -> %% Constant literals are not labeled. {T, N}; var -> + VarName = var_name(T), {As, N1} = - case dict:find(var_name(T), Env) of - {ok, L} -> + case Env of + #{VarName := L} -> {A, _} = label_ann(T, L), {A, N}; - error -> + #{} -> label_ann(T, N) end, {set_ann(T, As), N1}; @@ -974,7 +975,7 @@ label_list([], N, _Env) -> {[], N}. label_vars([T | Ts], N, Env) -> - Env1 = dict:store(var_name(T), N, Env), + Env1 = Env#{var_name(T) => N}, {As, N1} = label_ann(T, N), T1 = set_ann(T, As), {Ts1, N2, Env2} = label_vars(Ts, N1, Env1), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index fd5233d379..e7f58b3783 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -20,6 +20,7 @@ %% Purpose: Run the Erlang compiler. -module(compile). +-compile([{nowarn_deprecated_function,{crypto,block_encrypt,4}}]). %% High-level interface. -export([file/1,file/2,noenv_file/2,format_error/1,iofile/1]). @@ -253,11 +254,11 @@ expand_opt(return, Os) -> [return_errors,return_warnings|Os]; expand_opt(no_bsm3, Os) -> %% The new bsm pass requires bsm3 instructions. - [no_bsm3,no_bsm_opt|Os]; -expand_opt(r16, Os) -> - expand_opt_before_21(Os); -expand_opt(r17, Os) -> - expand_opt_before_21(Os); + [no_bsm3,no_bsm_opt|expand_opt(no_bsm4, Os)]; +expand_opt(no_bsm4, Os) -> + %% bsm4 instructions are only used when type optimization has determined + %% that a match instruction won't fail. + expand_opt(no_type_opt, Os); expand_opt(r18, Os) -> expand_opt_before_21(Os); expand_opt(r19, Os) -> @@ -265,7 +266,11 @@ expand_opt(r19, Os) -> expand_opt(r20, Os) -> expand_opt_before_21(Os); expand_opt(r21, Os) -> - [no_put_tuple2 | expand_opt(no_bsm3, Os)]; + [no_shared_fun_wrappers, + no_swap, no_put_tuple2 | expand_opt(no_bsm3, Os)]; +expand_opt(r22, Os) -> + [no_shared_fun_wrappers, + no_swap | expand_opt(no_bsm4, Os)]; expand_opt({debug_info_key,_}=O, Os) -> [encrypt_debug_info,O|Os]; expand_opt(no_type_opt=O, Os) -> @@ -278,7 +283,8 @@ expand_opt(no_type_opt=O, Os) -> expand_opt(O, Os) -> [O|Os]. expand_opt_before_21(Os) -> - [no_put_tuple2, no_get_hd_tl, no_ssa_opt_record, + [no_shared_fun_wrappers, no_swap, + no_put_tuple2, no_get_hd_tl, no_ssa_opt_record, no_utf8_atoms | expand_opt(no_bsm3, Os)]. %% format_error(ErrorDescriptor) -> string() @@ -597,7 +603,7 @@ passes_1([]) -> {".erl",[?pass(parse_module)|standard_passes()]}. pass(from_core) -> - {".core",[?pass(parse_core)|core_passes(mandatory_core_lint)]}; + {".core",[?pass(parse_core)|core_passes(non_verified_core)]}; pass(from_asm) -> {".S",[?pass(beam_consult_asm)|asm_passes()]}; pass(from_beam) -> @@ -795,33 +801,35 @@ standard_passes() -> ?pass(core), {iff,'dcore',{listing,"core"}}, {iff,'to_core0',{done,"core"}} - | core_passes(optional_core_lint)]. + | core_passes(verified_core)]. -core_passes(LintOpt) -> +core_passes(CoreStatus) -> %% Optimization and transforms of Core Erlang code. - CoreLint = case LintOpt of - mandatory_core_lint -> - ?pass(core_lint_module); - optional_core_lint -> - {iff,clint0,?pass(core_lint_module)} - end, - [CoreLint, - {delay, - [{unless,no_copt, - [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2}, - {iff,doldinline,{listing,"oldinline"}}, - {unless,no_fold,{pass,sys_core_fold}}, - {iff,dcorefold,{listing,"corefold"}}, - {core_inline_module,fun test_core_inliner/1,fun core_inline_module/2}, - {iff,dinline,{listing,"inline"}}, - {core_fold_after_inlining,fun test_any_inliner/1, - fun core_fold_module_after_inlining/2}, - {iff,dcopt,{listing,"copt"}}, - {unless,no_alias,{pass,sys_core_alias}}, - {iff,dalias,{listing,"core_alias"}}, - ?pass(core_transforms)]}, - {iff,'to_core',{done,"core"}}]} - | kernel_passes()]. + case CoreStatus of + non_verified_core -> + [?pass(core_lint_module), + {pass,sys_core_prepare}, + {iff,dprep,{listing,"prepare"}}]; + verified_core -> + [{iff,clint0,?pass(core_lint_module)}] + end ++ + [ + {delay, + [{unless,no_copt, + [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2}, + {iff,doldinline,{listing,"oldinline"}}, + {unless,no_fold,{pass,sys_core_fold}}, + {iff,dcorefold,{listing,"corefold"}}, + {core_inline_module,fun test_core_inliner/1,fun core_inline_module/2}, + {iff,dinline,{listing,"inline"}}, + {core_fold_after_inlining,fun test_any_inliner/1, + fun core_fold_module_after_inlining/2}, + {iff,dcopt,{listing,"copt"}}, + {unless,no_alias,{pass,sys_core_alias}}, + {iff,dalias,{listing,"core_alias"}}, + ?pass(core_transforms)]}, + {iff,'to_core',{done,"core"}}]} + | kernel_passes()]. kernel_passes() -> %% Optimizations that must be done after all other optimizations. @@ -839,7 +847,9 @@ kernel_passes() -> {iff,dssa,{listing,"ssa"}}, {iff,ssalint,{pass,beam_ssa_lint}}, {delay, - [{unless,no_share_opt,{pass,beam_ssa_share}}, + [{unless,no_bool_opt,{pass,beam_ssa_bool}}, + {iff,dbool,{listing,"bool"}}, + {unless,no_share_opt,{pass,beam_ssa_share}}, {iff,dssashare,{listing,"ssashare"}}, {iff,ssalint,{pass,beam_ssa_lint}}, {unless,no_bsm_opt,{pass,beam_ssa_bsm}}, @@ -869,8 +879,6 @@ asm_passes() -> {unless,no_postopt, [{pass,beam_block}, {iff,dblk,{listing,"block"}}, - {unless,no_except,{pass,beam_except}}, - {iff,dexcept,{listing,"except"}}, {unless,no_jopt,{pass,beam_jump}}, {iff,djmp,{listing,"jump"}}, {unless,no_peep_opt,{pass,beam_peep}}, @@ -915,8 +923,6 @@ remove_file(Code, St) -> exports, labels, functions=[], - cfun, - code, attributes=[]}). preprocess_asm_forms(Forms) -> @@ -926,36 +932,30 @@ preprocess_asm_forms(Forms) -> {R1#asm_module.module, R1#asm_module.exports, R1#asm_module.attributes, - R1#asm_module.functions, + reverse(R1#asm_module.functions), R1#asm_module.labels}}. -collect_asm([], R) -> - case R#asm_module.cfun of - undefined -> - R; - {A,B,C} -> - R#asm_module{functions=R#asm_module.functions++ - [{function,A,B,C,R#asm_module.code}]} - end; collect_asm([{module,M} | Rest], R) -> collect_asm(Rest, R#asm_module{module=M}); collect_asm([{exports,M} | Rest], R) -> collect_asm(Rest, R#asm_module{exports=M}); collect_asm([{labels,M} | Rest], R) -> collect_asm(Rest, R#asm_module{labels=M}); -collect_asm([{function,A,B,C} | Rest], R) -> - R1 = case R#asm_module.cfun of - undefined -> - R; - {A0,B0,C0} -> - R#asm_module{functions=R#asm_module.functions++ - [{function,A0,B0,C0,R#asm_module.code}]} - end, - collect_asm(Rest, R1#asm_module{cfun={A,B,C}, code=[]}); +collect_asm([{function,A,B,C} | Rest0], R0) -> + {Code,Rest} = collect_asm_function(Rest0, []), + Func = {function,A,B,C,Code}, + R = R0#asm_module{functions=[Func | R0#asm_module.functions]}, + collect_asm(Rest, R); collect_asm([{attributes, Attr} | Rest], R) -> collect_asm(Rest, R#asm_module{attributes=Attr}); -collect_asm([X | Rest], R) -> - collect_asm(Rest, R#asm_module{code=R#asm_module.code++[X]}). +collect_asm([], R) -> R. + +collect_asm_function([{function,_,_,_}|_]=Is, Acc) -> + {reverse(Acc),Is}; +collect_asm_function([I|Is], Acc) -> + collect_asm_function(Is, [I|Acc]); +collect_asm_function([], Acc) -> + {reverse(Acc),[]}. beam_consult_asm(_Code, St) -> case file:consult(St#compile.ifile) of @@ -2102,15 +2102,17 @@ pre_load() -> L = [beam_a, beam_asm, beam_block, + beam_call_types, beam_clean, beam_dict, - beam_except, + beam_digraph, beam_flatten, beam_jump, beam_kernel_to_ssa, beam_opcodes, beam_peep, beam_ssa, + beam_ssa_bool, beam_ssa_bsm, beam_ssa_codegen, beam_ssa_dead, @@ -2121,6 +2123,7 @@ pre_load() -> beam_ssa_share, beam_ssa_type, beam_trim, + beam_types, beam_utils, beam_validator, beam_z, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index a086a3a8d3..e6f5604d59 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -24,10 +24,11 @@ beam_a, beam_asm, beam_block, + beam_call_types, beam_clean, beam_dict, + beam_digraph, beam_disasm, - beam_except, beam_flatten, beam_jump, beam_kernel_to_ssa, @@ -35,6 +36,7 @@ beam_opcodes, beam_peep, beam_ssa, + beam_ssa_bool, beam_ssa_bsm, beam_ssa_codegen, beam_ssa_dead, @@ -47,6 +49,7 @@ beam_ssa_share, beam_ssa_type, beam_trim, + beam_types, beam_utils, beam_validator, beam_z, @@ -68,6 +71,7 @@ sys_core_fold, sys_core_fold_lists, sys_core_inline, + sys_core_prepare, sys_pre_attributes, v3_core, v3_kernel, @@ -76,5 +80,5 @@ {registered, []}, {applications, [kernel, stdlib]}, {env, []}, - {runtime_dependencies, ["stdlib-2.5","kernel-4.0","hipe-3.12","erts-9.0", + {runtime_dependencies, ["stdlib-@OTP-15251@","kernel-@OTP-15251@","hipe-3.12","erts-@OTP-15251@", "crypto-3.6"]}]}. diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index c1806272bd..c16881cb0d 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -26,6 +26,15 @@ -include("core_parse.hrl"). +%% Removed functions + +-removed([{get_anno,1,"use cerl:get_ann/1 instead"}, + {set_anno,2,"use cerl:set_ann/2 instead"}]). + +-removed([{is_literal,1,"use cerl:is_literal/1 instead"}, + {is_literal_list,1,"use cerl:is_literal_list/1 instead"}, + {literal_value,1,"use cerl:concrete/1 instead"}]). + %% Make a suitable values structure, expr or values, depending on Expr. -spec make_values([cerl:cerl()] | cerl:cerl()) -> cerl:cerl(). @@ -79,8 +88,6 @@ vu_expr(V, #c_seq{arg=Arg,body=B}) -> vu_expr(V, Arg) orelse vu_expr(V, B); vu_expr(V, #c_case{arg=Arg,clauses=Cs}) -> vu_expr(V, Arg) orelse vu_clauses(V, Cs); -vu_expr(V, #c_receive{clauses=Cs,timeout=T,action=A}) -> - vu_clauses(V, Cs) orelse vu_expr(V, T) orelse vu_expr(V, A); vu_expr(V, #c_apply{op=Op,args=As}) -> vu_expr_list(V, [Op|As]); vu_expr(V, #c_call{module=M,name=N,args=As}) -> @@ -115,77 +122,47 @@ vu_seg_list(V, Ss) -> vu_expr(V, Val) orelse vu_expr(V, Size) end, Ss). -%% Have to get the pattern results right. - -spec vu_clause(cerl:var_name(), cerl:c_clause()) -> boolean(). vu_clause(V, #c_clause{pats=Ps,guard=G,body=B}) -> - case vu_pattern_list(V, Ps) of - {true,_Shad} -> true; %It is used - {false,true} -> false; %Shadowed - {false,false} -> %Not affected - %% Neither used nor shadowed. Check guard and body. - vu_expr(V, G) orelse vu_expr(V, B) - end. + vu_pattern_list(V, Ps) orelse vu_expr(V, G) orelse vu_expr(V, B). -spec vu_clauses(cerl:var_name(), [cerl:c_clause()]) -> boolean(). vu_clauses(V, Cs) -> lists:any(fun(C) -> vu_clause(V, C) end, Cs). -%% vu_pattern(VarName, Pattern) -> {Used,Shadow}. -%% vu_pattern_list(VarName, [Pattern]) -> {Used,Shadow}. -%% Binaries complicate patterns as a variable can both be properly -%% used, in a bit segment size, and shadow. They can also do both. - -%% vu_pattern(V, Pat) -> vu_pattern(V, Pat, {false,false}). - -vu_pattern(V, #c_var{name=V2}, {Used,_}) -> - {Used,V =:= V2}; -vu_pattern(V, #c_cons{hd=H,tl=T}, St0) -> - case vu_pattern(V, H, St0) of - {true,_}=St1 -> St1; %Nothing more to know - St1 -> vu_pattern(V, T, St1) - end; -vu_pattern(V, #c_tuple{es=Es}, St) -> - vu_pattern_list(V, Es, St); -vu_pattern(V, #c_binary{segments=Ss}, St) -> - vu_pat_seg_list(V, Ss, St); -vu_pattern(V, #c_map{es=Es}, St) -> - vu_map_pairs(V, Es, St); -vu_pattern(V, #c_alias{var=Var,pat=P}, St0) -> - case vu_pattern(V, Var, St0) of - {true,_}=St1 -> St1; - St1 -> vu_pattern(V, P, St1) - end; -vu_pattern(_, _, St) -> St. - -vu_pattern_list(V, Ps) -> vu_pattern_list(V, Ps, {false,false}). - -vu_pattern_list(V, Ps, St0) -> - lists:foldl(fun(P, St) -> vu_pattern(V, P, St) end, St0, Ps). - -vu_pat_seg_list(V, Ss, St) -> - lists:foldl(fun(_, {true,_}=St0) -> St0; - (#c_bitstr{val=Val,size=Size}, St0) -> - case vu_pattern(V, Val, St0) of - {true,_}=St1 -> St1; - {false,Shad} -> - {vu_expr(V, Size),Shad} - end - end, St, Ss). - -vu_map_pairs(V, [#c_map_pair{key=Key,val=Pat}|T], St0) -> - case vu_expr(V, Key) of - true -> - {true,false}; - false -> - case vu_pattern(V, Pat, St0) of - {true,_}=St -> St; - St -> vu_map_pairs(V, T, St) - end - end; -vu_map_pairs(_, [], St) -> St. +%% vu_pattern(VarName, Pattern) -> Used. +%% vu_pattern_list(VarName, [Pattern]) -> Used. +%% Binary and map patterns can use variables. + +vu_pattern(V, #c_var{name=V2}) -> + V =:= V2; +vu_pattern(V, #c_cons{hd=H,tl=T}) -> + vu_pattern(V, H) orelse vu_pattern(V, T); +vu_pattern(V, #c_tuple{es=Es}) -> + vu_pattern_list(V, Es); +vu_pattern(V, #c_binary{segments=Ss}) -> + vu_pat_seg_list(V, Ss); +vu_pattern(V, #c_map{es=Es}) -> + vu_map_pairs(V, Es); +vu_pattern(V, #c_alias{var=Var,pat=P}) -> + vu_pattern(V, Var) orelse vu_pattern(V, P); +vu_pattern(_V, #c_literal{}) -> false. + +vu_pattern_list(V, Ps) -> + lists:any(fun(P) -> vu_pattern(V, P) end, Ps). + +vu_pat_seg_list(V, Ss) -> + lists:any(fun(#c_bitstr{size=Size}) -> + vu_pattern(V, Size) + end, Ss). + +vu_map_pairs(V, [#c_map_pair{key=Key,val=Pat}|T]) -> + vu_expr(V, Key) orelse + vu_pattern(V, Pat) orelse + vu_map_pairs(V, T); +vu_map_pairs(_, []) -> false. -spec vu_var_list(cerl:var_name(), [cerl:c_var()]) -> boolean(). diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 3f69cb03a9..579fa59487 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -55,9 +55,9 @@ -type fa() :: {atom(), arity()}. -type err_desc() :: 'invalid_attributes' | 'invalid_exports' - | {'arg_mismatch', fa()} | {'bittype_unit', fa()} + | {'arg_mismatch', fa()} | {'illegal_expr', fa()} | {'illegal_guard', fa()} - | {'illegal_pattern', fa()} | {'illegal_try', fa()} + | {'illegal_try', fa()} | {'not_bs_pattern', fa()} | {'not_pattern', fa()} | {'not_var', fa()} | {'pattern_mismatch', fa()} | {'return_mismatch', fa()} | {'undefined_function', fa()} @@ -88,14 +88,10 @@ format_error(invalid_attributes) -> "invalid attributes"; format_error(invalid_exports) -> "invalid exports"; format_error({arg_mismatch,{F,A}}) -> io_lib:format("argument count mismatch in ~w/~w", [F,A]); -format_error({bittype_unit,{F,A}}) -> - io_lib:format("unit without size in bit syntax pattern/expression in ~w/~w", [F,A]); format_error({illegal_expr,{F,A}}) -> io_lib:format("illegal expression in ~w/~w", [F,A]); format_error({illegal_guard,{F,A}}) -> io_lib:format("illegal guard expression in ~w/~w", [F,A]); -format_error({illegal_pattern,{F,A}}) -> - io_lib:format("illegal pattern in ~w/~w", [F,A]); format_error({illegal_try,{F,A}}) -> io_lib:format("illegal try expression in ~w/~w", [F,A]); format_error({not_bs_pattern,{F,A}}) -> @@ -111,9 +107,9 @@ format_error({return_mismatch,{F,A}}) -> format_error({undefined_function,{F,A}}) -> io_lib:format("function ~w/~w undefined", [F,A]); format_error({duplicate_var,N,{F,A}}) -> - io_lib:format("duplicate variable ~s in ~w/~w", [N,F,A]); + io_lib:format("duplicate variable ~p in ~w/~w", [N,F,A]); format_error({unbound_var,N,{F,A}}) -> - io_lib:format("unbound variable ~s in ~w/~w", [N,F,A]); + io_lib:format("unbound variable ~p in ~w/~w", [N,F,A]); format_error({undefined_function,{F1,A1},{F2,A2}}) -> io_lib:format("undefined function ~w/~w in ~w/~w", [F1,A1,F2,A2]); format_error({tail_segment_not_at_end,{F,A}}) -> @@ -201,8 +197,13 @@ module_defs(B, Def, St) -> %% functions([Fdef], Defined, State) -> State. -functions(Fs, Def, St0) -> - foldl(fun (F, St) -> function(F, Def, St) end, St0, Fs). +functions(Fs, Def, Rt, St0) -> + foldl(fun ({_Name,#c_fun{vars=Vs,body=B}}, Sti0) -> + {Vvs,St} = variable_list(Vs, Sti0), + body(B, union(Vvs, Def), Rt, St); + (_, St) -> + add_error({illegal_expr,St#lint.func}, St) + end, St0, Fs). %% function(CoreFunc, Defined, State) -> State. @@ -347,7 +348,7 @@ expr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) -> body(B, union(Lvs, Def), Rt, St2); expr(#c_letrec{defs=Fs,body=B}, Def0, Rt, St0) -> Def1 = union(defined_funcs(Fs), Def0), %All defined stuff - St1 = functions(Fs, Def1, St0), + St1 = functions(Fs, Def1, Rt, St0), body(B, Def1, Rt, St1#lint{func=St0#lint.func}); expr(#c_case{arg=Arg,clauses=Cs}, Def, Rt, St0) -> Pc = case_patcount(Cs), @@ -357,9 +358,9 @@ expr(#c_receive{clauses=Cs,timeout=T,action=A}, Def, Rt, St0) -> St1 = expr(T, Def, 1, St0), St2 = body(A, Def, Rt, St1), clauses(Cs, Def, 1, Rt, St2); -expr(#c_apply{op=Op,args=As}, Def, Rt, St0) -> +expr(#c_apply{op=Op,args=As}, Def, _Rt, St0) -> St1 = apply_op(Op, Def, length(As), St0), - return_match(Rt, 1, expr_list(As, Def, St1)); + return_match(any, 1, expr_list(As, Def, St1)); expr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As}, Def, Rt, St0) when is_atom(Name) -> St1 = expr_list(As, Def, St0), @@ -375,6 +376,7 @@ expr(#c_primop{name=#c_literal{val=A},args=As}, Def, Rt, St0) when is_atom(A) -> St1 = expr_list(As, Def, St0), case A of match_fail -> St1; + recv_peek_message -> return_match(Rt, 2, St1); _ -> return_match(Rt, 1, St1) end; expr(#c_catch{body=B}, Def, Rt, St) -> @@ -513,22 +515,16 @@ pat_var(N, _Def, Ps, St) -> %% pat_bin_list([Elem], Defined, [PatVar], State) -> {[PatVar],State}. -pat_bin(Es, Def0, Ps0, St0) -> - {Ps,_,St} = foldl(fun (E, {Ps,Def,St}) -> - pat_segment(E, Def, Ps, St) - end, {Ps0,Def0,St0}, Es), - {Ps,St}. - -pat_segment(#c_bitstr{val=V,size=S,type=T}, Def0, Ps0, St0) -> - St1 = pat_bit_expr(S, T, Def0, St0), - {Ps,St2} = pattern(V, Def0, Ps0, St1), - Def = case V of - #c_var{name=Name} -> add_element(Name, Def0); - _ -> Def0 - end, - {Ps,Def,St2}; -pat_segment(_, Def, Ps, St) -> - {Ps,Def,add_error({not_bs_pattern,St#lint.func}, St)}. +pat_bin(Es, Def, Ps0, St0) -> + foldl(fun (E, {Ps,St}) -> + pat_segment(E, Def, Ps, St) + end, {Ps0,St0}, Es). + +pat_segment(#c_bitstr{val=V,size=S,type=T}, Def, Ps0, St0) -> + St1 = pat_bit_expr(S, T, Def, St0), + pattern(V, Def, Ps0, St1); +pat_segment(_, _, Ps, St) -> + {Ps,add_error({not_bs_pattern,St#lint.func}, St)}. %% pat_bin_tail_check([Elem], State) -> State. %% There must be at most one tail segment (a size-less segment of diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index cb3f24fd08..19fa11235c 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -214,7 +214,7 @@ format_1(#c_let{anno=Anno0,vars=Vs0,arg=A0,body=B}, #ctxt{clean=Clean}=Ctxt) -> {Vs0,A0,Anno0}; true -> {[cerl:set_ann(V, []) || V <- Vs0], - cerl:set_ann(A0, []), + clean_anno_carefully(A0), []} end, case is_simple_term(A) andalso Anno =:= [] of @@ -546,3 +546,13 @@ segs_from_bitstring(Bitstring) -> unit=#c_literal{val=1}, type=#c_literal{val=integer}, flags=#c_literal{val=[unsigned,big]}}]. + +clean_anno_carefully(Node) -> + Anno = clean_anno_carefully_1(cerl:get_ann(Node)), + cerl:set_ann(Node, Anno). + +clean_anno_carefully_1([letrec_goto=Keep|Annos]) -> + [Keep|clean_anno_carefully_1(Annos)]; +clean_anno_carefully_1([_|Annos]) -> + clean_anno_carefully_1(Annos); +clean_anno_carefully_1([]) -> []. diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 94a5dfe012..caf067fde7 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -80,10 +80,12 @@ is_pure(erlang, 'or', 2) -> true; is_pure(erlang, 'rem', 2) -> true; is_pure(erlang, 'xor', 2) -> true; is_pure(erlang, abs, 1) -> true; +is_pure(erlang, atom_to_binary, 1) -> true; is_pure(erlang, atom_to_binary, 2) -> true; is_pure(erlang, atom_to_list, 1) -> true; is_pure(erlang, binary_part, 2) -> true; is_pure(erlang, binary_part, 3) -> true; +is_pure(erlang, binary_to_atom, 1) -> true; is_pure(erlang, binary_to_atom, 2) -> true; is_pure(erlang, binary_to_float, 1) -> true; is_pure(erlang, binary_to_integer, 1) -> true; @@ -144,6 +146,9 @@ is_pure(erlang, tuple_size, 1) -> true; is_pure(erlang, tuple_to_list, 1) -> true; is_pure(lists, append, 2) -> true; is_pure(lists, subtract, 2) -> true; +is_pure(maps, get, 2) -> true; +is_pure(maps, is_key, 2) -> true; +is_pure(maps, new, 0) -> true; is_pure(math, acos, 1) -> true; is_pure(math, acosh, 1) -> true; is_pure(math, asin, 1) -> true; diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 86590fad87..64680ca1ed 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -596,3 +596,15 @@ BEAM_FORMAT_NUMBER=0 ## @spec bs_set_positon Ctx Pos ## @doc Sets the current position of Ctx to Pos 168: bs_set_position/2 + +# OTP 23 + +## @spec swap Register1 Register2 +## @doc Swaps the contents of two registers. +169: swap/2 + +## @spec bs_start_match4 Fail Bin Live Dst +## @doc As bs_start_match3, but the fail label can be 'no_fail' when we know +## it will never fail at runtime, or 'resume' when we know the input is +## a match context. +170: bs_start_match4/4 diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index eb1f69269c..b8cf4b42ff 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -99,10 +99,6 @@ t=#{} :: map(), %Types in_guard=false}). %In guard or not. --type type_info() :: cerl:cerl() | 'bool' | 'integer' | {'fun', pos_integer()}. --type yes_no_maybe() :: 'yes' | 'no' | 'maybe'. --type sub() :: #sub{}. - -spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module(), [_]}. @@ -315,10 +311,10 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) -> false -> %% Arg cannot be "values" here - only a single value %% make sense here. - case {Ctxt,is_safe_simple(Arg, Sub)} of + case {Ctxt,is_safe_simple(Arg)} of {effect,true} -> B1; {effect,false} -> - case is_safe_simple(B1, Sub) of + case is_safe_simple(B1) of true -> Arg; false -> Seq0#c_seq{arg=Arg,body=B1} end; @@ -384,11 +380,11 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> %% according to the rules above). %% case opt_bool_case(Case0, Sub) of - #c_case{arg=Arg0,clauses=Cs0}=Case1 -> + #c_case{anno=Anno,arg=Arg0,clauses=Cs0}=Case1 -> Arg1 = body(Arg0, value, Sub), LitExpr = cerl:is_literal(Arg1), {Arg2,Cs1} = case_opt(Arg1, Cs0, Sub), - Cs2 = clauses(Arg2, Cs1, Ctxt, Sub, LitExpr), + Cs2 = clauses(Arg2, Cs1, Ctxt, Sub, LitExpr, Anno), Case = Case1#c_case{arg=Arg2,clauses=Cs2}, warn_no_clause_match(Case1, Case), Expr = eval_case(Case, Sub), @@ -396,11 +392,6 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> Other -> expr(Other, Ctxt, Sub) end; -expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) -> - Cs1 = clauses(#c_var{name='_'}, Cs0, Ctxt, Sub, false), - T1 = expr(T0, value, Sub), - A1 = body(A0, Ctxt, Sub), - Recv#c_receive{clauses=Cs1,timeout=T1,action=A1}; expr(#c_apply{anno=Anno,op=Op0,args=As0}=Apply0, _, Sub) -> Op1 = expr(Op0, value, Sub), As1 = expr_list(As0, value, Sub), @@ -442,7 +433,7 @@ expr(#c_catch{anno=Anno,body=B}, effect, Sub) -> expr(#c_catch{body=B0}=Catch, _, Sub) -> %% We can remove catch if the value is simple B1 = body(B0, value, Sub), - case is_safe_simple(B1, Sub) of + case is_safe_simple(B1) of true -> B1; false -> Catch#c_catch{body=B1} end; @@ -458,7 +449,7 @@ expr(#c_try{arg=E0,vars=[#c_var{name=X}],body=#c_var{name=X}, %% We can remove try/catch if the expression is an %% expression that cannot fail. - case is_safe_bool_expr(E2, Sub) orelse is_safe_simple(E2, Sub) of + case is_safe_bool_expr(E2) orelse is_safe_simple(E2) of true -> E2; false -> Try#c_try{arg=E2} end; @@ -472,27 +463,15 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0) E1 = body(E0, value, Sub0), {Vs1,Sub1} = var_list(Vs0, Sub0), B1 = body(B0, value, Sub1), - case is_safe_simple(E1, Sub0) of + case is_safe_simple(E1) of true -> expr(#c_let{anno=A,vars=Vs1,arg=E1,body=B1}, value, Sub0); false -> {Evs1,Sub2} = var_list(Evs0, Sub0), H1 = body(H0, value, Sub2), - H2 = opt_try_handler(H1, lists:last(Evs1)), - Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H2} + Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H1} end. -%% Attempts to convert old erlang:get_stacktrace/0 calls into the new -%% three-argument catch, with possibility of further optimisations. -opt_try_handler(#c_call{anno=A,module=#c_literal{val=erlang},name=#c_literal{val=get_stacktrace},args=[]}, Var) -> - #c_primop{anno=A,name=#c_literal{val=build_stacktrace},args=[Var]}; -opt_try_handler(#c_case{clauses=Cs0} = Case, Var) -> - Cs = [C#c_clause{body=opt_try_handler(B, Var)} || #c_clause{body=B} = C <- Cs0], - Case#c_case{clauses=Cs}; -opt_try_handler(#c_let{arg=Arg} = Let, Var) -> - Let#c_let{arg=opt_try_handler(Arg, Var)}; -opt_try_handler(X, _) -> X. - %% If a fun or its application is used as an argument, then it's unsafe to %% handle it in effect context as the side-effects may rely on its return %% value. The following is a minimal example of where it can go wrong: @@ -545,10 +524,6 @@ ifes_1(FVar, #c_map_pair{key=Key,val=Val}, _Safe) -> ifes_1(FVar, Key, false) andalso ifes_1(FVar, Val, false); ifes_1(FVar, #c_primop{args=Args}, _Safe) -> ifes_list(FVar, Args, false); -ifes_1(FVar, #c_receive{timeout=Timeout,action=Action,clauses=Clauses}, Safe) -> - ifes_1(FVar, Timeout, false) andalso - ifes_1(FVar, Action, Safe) andalso - ifes_list(FVar, Clauses, Safe); ifes_1(FVar, #c_seq{arg=Arg,body=Body}, Safe) -> %% Arg of a #c_seq{} has no effect so it's okay to use FVar there even if %% Safe=false. @@ -602,20 +577,20 @@ is_literal_fun(_) -> false. %% Currently, we don't attempt to check binaries because they %% are difficult to check. -is_safe_simple(#c_var{}=Var, _) -> +is_safe_simple(#c_var{}=Var) -> not cerl:is_c_fname(Var); -is_safe_simple(#c_cons{hd=H,tl=T}, Sub) -> - is_safe_simple(H, Sub) andalso is_safe_simple(T, Sub); -is_safe_simple(#c_tuple{es=Es}, Sub) -> is_safe_simple_list(Es, Sub); -is_safe_simple(#c_literal{}, _) -> true; +is_safe_simple(#c_cons{hd=H,tl=T}) -> + is_safe_simple(H) andalso is_safe_simple(T); +is_safe_simple(#c_tuple{es=Es}) -> is_safe_simple_list(Es); +is_safe_simple(#c_literal{}) -> true; is_safe_simple(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=Name}, - args=Args}, Sub) when is_atom(Name) -> + args=Args}) when is_atom(Name) -> NumArgs = length(Args), case erl_internal:bool_op(Name, NumArgs) of true -> %% Boolean operators are safe if the arguments are boolean. - all(fun(C) -> is_boolean_type(C, Sub) =:= yes end, Args); + all(fun is_bool_expr/1, Args); false -> %% We need a rather complicated test to ensure that %% we only allow safe calls that are allowed in a guard. @@ -624,9 +599,9 @@ is_safe_simple(#c_call{module=#c_literal{val=erlang}, (erl_internal:comp_op(Name, NumArgs) orelse erl_internal:new_type_test(Name, NumArgs)) end; -is_safe_simple(_, _) -> false. +is_safe_simple(_) -> false. -is_safe_simple_list(Es, Sub) -> all(fun(E) -> is_safe_simple(E, Sub) end, Es). +is_safe_simple_list(Es) -> all(fun(E) -> is_safe_simple(E) end, Es). %% will_fail(Expr) -> true|false. %% Determine whether the expression will fail with an exception. @@ -696,15 +671,7 @@ eval_binary(#c_binary{anno=Anno,segments=Ss}=Bin) -> eval_binary_1([#c_bitstr{val=#c_literal{val=Val},size=#c_literal{val=Sz}, unit=#c_literal{val=Unit},type=#c_literal{val=Type}, flags=#c_literal{val=Flags}}|Ss], Acc0) -> - Endian = case member(big, Flags) of - true -> - big; - false -> - case member(little, Flags) of - true -> little; - false -> throw(impossible) %Native endian. - end - end, + Endian = bs_endian(Flags), %% Make sure that the size is reasonable. case Type of @@ -738,10 +705,14 @@ eval_binary_1([#c_bitstr{val=#c_literal{val=Val},size=#c_literal{val=Sz}, end; float when is_float(Val) -> %% Bad float size. - case Sz*Unit of + try Sz*Unit of 32 -> ok; 64 -> ok; - _ -> throw(impossible) + _ -> + throw({badarg,bad_float_size}) + catch + error:_ -> + throw({badarg,bad_float_size}) end; utf8 -> ok; utf16 -> ok; @@ -750,6 +721,11 @@ eval_binary_1([#c_bitstr{val=#c_literal{val=Val},size=#c_literal{val=Sz}, throw(impossible) end, + case Endian =:= native andalso Type =/= binary of + true -> throw(impossible); + false -> ok + end, + %% Evaluate the field. try eval_binary_2(Acc0, Val, Sz, Unit, Type, Endian) of Acc -> eval_binary_1(Ss, Acc) @@ -813,6 +789,11 @@ eval_binary_2(Acc, Val, all, Unit, binary, _) -> eval_binary_2(Acc, Val, Size, Unit, binary, _) -> <<Acc/bitstring,Val:(Size*Unit)/bitstring>>. +bs_endian([big=E|_]) -> E; +bs_endian([little=E|_]) -> E; +bs_endian([native=E|_]) -> E; +bs_endian([_|Fs]) -> bs_endian(Fs). + %% Count the number of bits approximately needed to store Int. %% (We don't need an exact result for this purpose.) @@ -853,7 +834,7 @@ useless_call(_, _) -> no. %% Anything that will not have any effect will be thrown away. make_effect_seq([H|T], Sub) -> - case is_safe_simple(H, Sub) of + case is_safe_simple(H) of true -> make_effect_seq(T, Sub); false -> #c_seq{arg=H,body=make_effect_seq(T, Sub)} end; @@ -880,25 +861,45 @@ fold_apply(Apply, _, _) -> Apply. %% Handling remote calls. The module/name fields have been processed. -call(#c_call{args=As}=Call, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) -> - case get(no_inline_list_funcs) of - true -> - call_1(Call, M0, N0, As, Sub); - false -> - case sys_core_fold_lists:call(Call, M, N, As) of - none -> - call_1(Call, M0, N0, As, Sub); - Core -> - expr(Core, Sub) - end - - end; -call(#c_call{args=As}=Call, M, N, Sub) -> - call_1(Call, M, N, As, Sub). - -call_1(Call, M, N, As0, Sub) -> +call(#c_call{args=As0}=Call0, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) -> As1 = expr_list(As0, value, Sub), - fold_call(Call#c_call{args=As1}, M, N, As1, Sub). + case simplify_call(Call0, M, N, As1) of + #c_literal{}=Lit -> + Lit; + #c_call{args=As}=Call -> + case get(no_inline_list_funcs) of + true -> + fold_call(Call, M0, N0, As, Sub); + false -> + case sys_core_fold_lists:call(Call, M, N, As) of + none -> fold_call(Call, M0, N0, As, Sub); + Core -> expr(Core, Sub) + end + end + end; +call(#c_call{args=As0}=Call, M, N, Sub) -> + As = expr_list(As0, value, Sub), + fold_call(Call#c_call{args=As}, M, N, As, Sub). + +%% Rewrite certain known functions to BIFs, improving performance +%% slightly at the cost of making tracing and stack traces incorrect. +simplify_call(Call, maps, get, [Key, Map]) -> + rewrite_call(Call, erlang, map_get, [Key, Map]); +simplify_call(Call, maps, is_key, [Key, Map]) -> + rewrite_call(Call, erlang, is_map_key, [Key, Map]); +simplify_call(_Call, maps, new, []) -> + #c_literal{val=#{}}; +simplify_call(Call, maps, size, [Map]) -> + rewrite_call(Call, erlang, map_size, [Map]); +simplify_call(Call, _, _, Args) -> + Call#c_call{args=Args}. + +%% rewrite_call(Call0, Mod, Func, Args, Sub) -> Call +%% Rewrites a call to the given MFA. +rewrite_call(Call, Mod, Func, Args) -> + ModLit = #c_literal{val=Mod}, + FuncLit = #c_literal{val=Func}, + Call#c_call{module=ModLit,name=FuncLit,args=Args}. %% fold_call(Call, Mod, Name, Args, Sub) -> Expr. %% Try to safely evaluate the call. Just try to evaluate arguments, @@ -959,138 +960,14 @@ fold_lit_args(Call, Module, Name, Args0) -> %% Attempt to evaluate some pure BIF calls with one or more %% non-literals arguments. %% -fold_non_lit_args(Call, erlang, is_boolean, [Arg], Sub) -> - eval_is_boolean(Call, Arg, Sub); fold_non_lit_args(Call, erlang, length, [Arg], _) -> eval_length(Call, Arg); fold_non_lit_args(Call, erlang, '++', [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); -fold_non_lit_args(Call, erlang, is_function, [Arg1], Sub) -> - eval_is_function_1(Call, Arg1, Sub); -fold_non_lit_args(Call, erlang, is_function, [Arg1,Arg2], Sub) -> - eval_is_function_2(Call, Arg1, Arg2, Sub); -fold_non_lit_args(Call, erlang, N, Args, Sub) -> - NumArgs = length(Args), - case erl_internal:comp_op(N, NumArgs) of - true -> - eval_rel_op(Call, N, Args, Sub); - false -> - case erl_internal:bool_op(N, NumArgs) of - true -> - eval_bool_op(Call, N, Args, Sub); - false -> - Call - end - end; fold_non_lit_args(Call, _, _, _, _) -> Call. -eval_is_function_1(Call, Arg1, Sub) -> - case get_type(Arg1, Sub) of - none -> Call; - {'fun',_} -> #c_literal{anno=cerl:get_ann(Call),val=true}; - _ -> #c_literal{anno=cerl:get_ann(Call),val=false} - end. - -eval_is_function_2(Call, Arg1, #c_literal{val=Arity}, Sub) - when is_integer(Arity), Arity > 0 -> - case get_type(Arg1, Sub) of - none -> Call; - {'fun',Arity} -> #c_literal{anno=cerl:get_ann(Call),val=true}; - _ -> #c_literal{anno=cerl:get_ann(Call),val=false} - end; -eval_is_function_2(Call, _Arg1, _Arg2, _Sub) -> Call. - -%% Evaluate a relational operation using type information. -eval_rel_op(Call, Op, [#c_var{name=V},#c_var{name=V}], _) -> - Bool = erlang:Op(same, same), - #c_literal{anno=cerl:get_ann(Call),val=Bool}; -eval_rel_op(Call, '=:=', [Term,#c_literal{val=true}], Sub) -> - %% BoolVar =:= true ==> BoolVar - case is_boolean_type(Term, Sub) of - yes -> Term; - maybe -> Call; - no -> #c_literal{val=false} - end; -eval_rel_op(Call, '==', Ops, Sub) -> - case is_exact_eq_ok(Ops, Sub) of - true -> - Name = #c_literal{anno=cerl:get_ann(Call),val='=:='}, - Call#c_call{name=Name}; - false -> - Call - end; -eval_rel_op(Call, '/=', Ops, Sub) -> - case is_exact_eq_ok(Ops, Sub) of - true -> - Name = #c_literal{anno=cerl:get_ann(Call),val='=/='}, - Call#c_call{name=Name}; - false -> - Call - end; -eval_rel_op(Call, _, _, _) -> Call. - -is_exact_eq_ok([A,B]=L, Sub) -> - case is_int_type(A, Sub) =:= yes andalso is_int_type(B, Sub) =:= yes of - true -> true; - false -> is_exact_eq_ok_1(L) - end. - -is_exact_eq_ok_1([#c_literal{val=Lit}|_]) -> - is_non_numeric(Lit); -is_exact_eq_ok_1([_|T]) -> - is_exact_eq_ok_1(T); -is_exact_eq_ok_1([]) -> false. - -is_non_numeric([H|T]) -> - is_non_numeric(H) andalso is_non_numeric(T); -is_non_numeric(Tuple) when is_tuple(Tuple) -> - is_non_numeric_tuple(Tuple, tuple_size(Tuple)); -is_non_numeric(Map) when is_map(Map) -> - %% Note that 17.x and 18.x compare keys in different ways. - %% Be very conservative -- require that both keys and values - %% are non-numeric. - is_non_numeric(maps:to_list(Map)); -is_non_numeric(Num) when is_number(Num) -> - false; -is_non_numeric(_) -> true. - -is_non_numeric_tuple(Tuple, El) when El >= 1 -> - is_non_numeric(element(El, Tuple)) andalso - is_non_numeric_tuple(Tuple, El-1); -is_non_numeric_tuple(_Tuple, 0) -> true. - -%% Evaluate a bool op using type information. We KNOW that -%% there must be at least one non-literal argument (i.e. -%% there is no need to handle the case that all argments -%% are literal). - -eval_bool_op(Call, 'and', [#c_literal{val=true},Term], Sub) -> - eval_bool_op_1(Call, Term, Term, Sub); -eval_bool_op(Call, 'and', [Term,#c_literal{val=true}], Sub) -> - eval_bool_op_1(Call, Term, Term, Sub); -eval_bool_op(Call, 'and', [#c_literal{val=false}=Res,Term], Sub) -> - eval_bool_op_1(Call, Res, Term, Sub); -eval_bool_op(Call, 'and', [Term,#c_literal{val=false}=Res], Sub) -> - eval_bool_op_1(Call, Res, Term, Sub); -eval_bool_op(Call, _, _, _) -> Call. - -eval_bool_op_1(Call, Res, Term, Sub) -> - case is_boolean_type(Term, Sub) of - yes -> Res; - no -> eval_failure(Call, badarg); - maybe -> Call - end. - -%% Evaluate is_boolean/1 using type information. -eval_is_boolean(Call, Term, Sub) -> - case is_boolean_type(Term, Sub) of - no -> #c_literal{val=false}; - yes -> #c_literal{val=true}; - maybe -> Call - end. - %% eval_length(Call, List) -> Val. %% Evaluates the length for the prefix of List which has a known %% shape. @@ -1199,10 +1076,6 @@ clause_1(#c_clause{guard=G0,body=B0}=Cl, Ps1, Cexpr, Ctxt, Sub1) -> %% No need for substitution tricks when the guard %% does not contain any variables. Sub1; - {#c_var{name='_'},_,_} -> - %% In a 'receive', Cexpr is the variable '_', which represents the - %% message being matched. We must NOT do any extra substiutions. - Sub1; {#c_var{},[#c_var{}=Var],_} -> %% The idea here is to optimize expressions such as %% @@ -1329,20 +1202,27 @@ map_pair_pattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,{Isub, {V,Osub} = pattern(V0,Isub,Osub0), {Pair#c_map_pair{key=K,val=V},{Isub,Osub}}. -bin_pattern_list(Ps0, Isub, Osub0) -> - {Ps,{_,Osub}} = mapfoldl(fun bin_pattern/2, {Isub,Osub0}, Ps0), - {Ps,Osub}. - -bin_pattern(#c_bitstr{val=E0,size=Size0}=Pat0, {Isub0,Osub0}) -> - Size1 = expr(Size0, Isub0), - {E1,Osub} = pattern(E0, Isub0, Osub0), - Isub = case E0 of - #c_var{} -> sub_set_var(E0, E1, Isub0); - _ -> Isub0 - end, - Pat = Pat0#c_bitstr{val=E1,size=Size1}, +bin_pattern_list(Ps, Isub, Osub0) -> + mapfoldl(fun(P, Osub) -> + bin_pattern(P, Isub, Osub) + end, Osub0, Ps). + +bin_pattern(#c_bitstr{val=E0,size=Size0}=Pat0, Isub, Osub0) -> + Size2 = case {Size0,expr(Size0, Isub)} of + {#c_var{},#c_literal{val=all}} -> + %% The size `all` is used for the size of the final binary + %% segment in a pattern. Using `all` explicitly is not allowed, + %% so we convert it to an obvious invalid size. We also need + %% to add an annotation to get the correct wording of the warning + %% that will soon be issued. + #c_literal{anno=[size_was_all],val=bad_size}; + {_,Size1} -> + Size1 + end, + {E1,Osub} = pattern(E0, Isub, Osub0), + Pat = Pat0#c_bitstr{val=E1,size=Size2}, bin_pat_warn(Pat), - {Pat,{Isub,Osub}}. + {Pat,Osub}. pattern_list(Ps, Sub) -> pattern_list(Ps, Sub, Sub). @@ -1365,7 +1245,7 @@ var_list(Vs, Sub0) -> bin_pat_warn(#c_bitstr{type=#c_literal{val=Type}, val=Val0, - size=#c_literal{val=Sz}, + size=#c_literal{anno=SizeAnno,val=Sz}, unit=#c_literal{val=Unit}, flags=Fl}=Pat) -> case {Type,Sz} of @@ -1375,7 +1255,12 @@ bin_pat_warn(#c_bitstr{type=#c_literal{val=Type}, {utf16,undefined} -> ok; {utf32,undefined} -> ok; {_,_} -> - add_warning(Pat, {nomatch_bit_syntax_size,Sz}), + case member(size_was_all, SizeAnno) of + true -> + add_warning(Pat, {nomatch_bit_syntax_size,all}); + false -> + add_warning(Pat, {nomatch_bit_syntax_size,Sz}) + end, throw(nomatch) end, case {Type,Val0} of @@ -1562,11 +1447,11 @@ warn_no_clause_match(CaseOrig, CaseOpt) -> ok end. -%% clauses(E, [Clause], TopLevel, Context, Sub) -> [Clause]. +%% clauses(E, [Clause], TopLevel, Context, Sub, Anno) -> [Clause]. %% Trim the clauses by removing all clauses AFTER the first one which %% is guaranteed to match. Also remove all trivially false clauses. -clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) -> +clauses(E, [C0|Cs], Ctxt, Sub, LitExpr, Anno) -> #c_clause{pats=Ps,guard=G} = C1 = clause(C0, E, Ctxt, Sub), %%ok = io:fwrite("~w: ~p~n", [?LINE,{E,Ps}]), case {will_match(E, Ps),will_succeed(G)} of @@ -1574,7 +1459,7 @@ clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) -> case LitExpr of false -> Line = get_line(cerl:get_ann(C1)), - shadow_warning(Cs, Line); + shadow_warning(Cs, Line, Anno); true -> %% If the case expression is a literal, %% it is probably OK that some clauses don't match. @@ -1584,19 +1469,24 @@ clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) -> [C1]; %Skip the rest {_Mat,no} -> %Guard fails. add_warning(C1, nomatch_guard), - clauses(E, Cs, Ctxt, Sub, LitExpr); %Skip this clause + clauses(E, Cs, Ctxt, Sub, LitExpr, Anno); %Skip this clause {_Mat,_Suc} -> - [C1|clauses(E, Cs, Ctxt, Sub, LitExpr)] + [C1|clauses(E, Cs, Ctxt, Sub, LitExpr, Anno)] end; -clauses(_, [], _, _, _) -> []. +clauses(_, [], _, _, _, _) -> []. -shadow_warning([C|Cs], none) -> +shadow_warning([C|Cs], none, Anno) -> add_warning(C, nomatch_shadow), - shadow_warning(Cs, none); -shadow_warning([C|Cs], Line) -> - add_warning(C, {nomatch_shadow, Line}), - shadow_warning(Cs, Line); -shadow_warning([], _) -> ok. + shadow_warning(Cs, none, Anno); +shadow_warning([C|Cs], Line, Anno) -> + case keyfind(function, 1, Anno) of + {function, {Name, Arity}} -> + add_warning(C, {nomatch_shadow, Line, {Name, Arity}}); + _ -> + add_warning(C, {nomatch_shadow, Line}) + end, + shadow_warning(Cs, Line, Anno); +shadow_warning([], _, _) -> ok. %% will_succeed(Guard) -> yes | maybe | no. %% Test if we know whether a guard will succeed/fail or just don't @@ -1669,7 +1559,7 @@ opt_bool_clauses(Cs, true, true) -> %% Any remaining clauses cannot possibly match. case Cs of [_|_] -> - shadow_warning(Cs, none), + shadow_warning(Cs, none, []), []; [] -> [] @@ -1771,7 +1661,7 @@ opt_bool_not_invert(#c_clause{pats=[#c_literal{val=Bool}]}=C) -> opt_bool_case_redundant(#c_case{arg=Arg,clauses=Cs}=Case) -> case all(fun opt_bool_case_redundant_1/1, Cs) of true -> Arg; - false -> opt_bool_case_guard(Case) + false -> Case end. opt_bool_case_redundant_1(#c_clause{pats=[#c_literal{val=B}], @@ -1779,45 +1669,6 @@ opt_bool_case_redundant_1(#c_clause{pats=[#c_literal{val=B}], true; opt_bool_case_redundant_1(_) -> false. -%% opt_bool_case_guard(Case) -> Case'. -%% Move a boolean case expression into the guard if we are sure that -%% it cannot fail. -%% -%% case SafeBoolExpr of case <> of -%% true -> TrueClause; ==> <> when SafeBoolExpr -> TrueClause; -%% false -> FalseClause <> when true -> FalseClause -%% end. end. -%% -%% Generally, evaluting a boolean expression in a guard should -%% be faster than evaulating it in the body. -%% -opt_bool_case_guard(#c_case{arg=#c_literal{}}=Case) -> - %% It is not necessary to move a literal case expression into the - %% guard, because it will be handled quite well in other - %% optimizations, and moving the literal into the guard will - %% cause some extra warnings, for instance for this code - %% - %% case true of - %% true -> ...; - %% false -> ... - %% end. - %% - Case; -opt_bool_case_guard(#c_case{arg=Arg,clauses=Cs0}=Case) -> - case is_safe_bool_expr(Arg, sub_new()) of - false -> - Case; - true -> - Cs = opt_bool_case_guard(Arg, Cs0), - Case#c_case{arg=#c_values{anno=cerl:get_ann(Arg),es=[]}, - clauses=Cs} - end. - -opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=true}]}=Tc,Fc]) -> - [Tc#c_clause{pats=[],guard=Arg},Fc#c_clause{pats=[]}]; -opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=false}]}=Fc,Tc]) -> - [Tc#c_clause{pats=[],guard=Arg},Fc#c_clause{pats=[]}]. - %% eval_case(Case) -> #c_case{} | #c_let{}. %% If possible, evaluate a case at compile time. We know that the %% last clause is guaranteed to match so if there is only one clause @@ -1945,7 +1796,7 @@ case_opt_arg(E0, Sub, Cs, LitExpr) -> {error,Cs}; false -> %% If possible, expand this variable to a previously - %% matched term. + %% constructed tuple E = case_expand_var(E0, Sub), case_opt_arg_1(E, Cs, LitExpr) end @@ -2004,13 +1855,8 @@ case_opt_compiler_generated(Core) -> case_expand_var(E, #sub{t=Tdb}) -> Key = cerl:var_name(E), case Tdb of - #{Key:=T} -> - case cerl:is_c_tuple(T) of - false -> E; - true -> T - end; - _ -> - E + #{Key:=T} -> T; + _ -> E end. %% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses' @@ -2302,115 +2148,84 @@ is_simple_case_arg(_) -> false. %% Check whether the Core expression is guaranteed to return %% a boolean IF IT RETURNS AT ALL. %% -is_bool_expr(Core) -> - is_bool_expr(Core, sub_new()). -%% is_bool_expr(Core, Sub) -> true|false -%% Check whether the Core expression is guaranteed to return -%% a boolean IF IT RETURNS AT ALL. Uses type information -%% to be able to identify more expressions as booleans. -%% is_bool_expr(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=Name},args=Args}=Call, _) -> + name=#c_literal{val=Name},args=Args}=Call) -> NumArgs = length(Args), erl_internal:comp_op(Name, NumArgs) orelse erl_internal:new_type_test(Name, NumArgs) orelse erl_internal:bool_op(Name, NumArgs) orelse will_fail(Call); is_bool_expr(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X}, - handler=#c_literal{val=false}}, Sub) -> - is_bool_expr(E, Sub); -is_bool_expr(#c_case{clauses=Cs}, Sub) -> - is_bool_expr_list(Cs, Sub); -is_bool_expr(#c_clause{body=B}, Sub) -> - is_bool_expr(B, Sub); -is_bool_expr(#c_let{vars=[V],arg=Arg,body=B}, Sub0) -> - Sub = case is_bool_expr(Arg, Sub0) of - true -> update_types(V, [bool], Sub0); - false -> Sub0 - end, - is_bool_expr(B, Sub); -is_bool_expr(#c_let{body=B}, Sub) -> - %% Binding of multiple variables. - is_bool_expr(B, Sub); -is_bool_expr(C, Sub) -> - is_boolean_type(C, Sub) =:= yes. - -is_bool_expr_list([C|Cs], Sub) -> - is_bool_expr(C, Sub) andalso is_bool_expr_list(Cs, Sub); -is_bool_expr_list([], _) -> true. + handler=#c_literal{val=false}}) -> + is_bool_expr(E); +is_bool_expr(#c_case{clauses=Cs}) -> + is_bool_expr_list(Cs); +is_bool_expr(#c_clause{body=B}) -> + is_bool_expr(B); +is_bool_expr(#c_let{body=B}) -> + is_bool_expr(B); +is_bool_expr(#c_literal{val=Val}) -> + is_boolean(Val); +is_bool_expr(_) -> false. + +is_bool_expr_list([C|Cs]) -> + is_bool_expr(C) andalso is_bool_expr_list(Cs); +is_bool_expr_list([]) -> true. %% is_safe_bool_expr(Core) -> true|false %% Check whether the Core expression ALWAYS returns a boolean -%% (i.e. it cannot fail). Also make sure that the expression -%% is suitable for a guard (no calls to non-guard BIFs, local -%% functions, or is_record/2). +%% (i.e. it cannot fail). %% -is_safe_bool_expr(Core, Sub) -> - is_safe_bool_expr_1(Core, Sub, cerl_sets:new()). +is_safe_bool_expr(Core) -> + is_safe_bool_expr_1(Core, cerl_sets:new()). is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_record}, - args=[A,#c_literal{val=Tag},#c_literal{val=Size}]}, - Sub, _BoolVars) when is_atom(Tag), is_integer(Size) -> - is_safe_simple(A, Sub); -is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_record}}, - _Sub, _BoolVars) -> - %% The is_record/2 BIF is NOT allowed in guards. - %% The is_record/3 BIF where its second argument is not an atom or its third - %% is not an integer is NOT allowed in guards. - %% - %% NOTE: Calls like is_record(Expr, LiteralTag), where LiteralTag - %% is a literal atom referring to a defined record, have already - %% been rewritten to is_record(Expr, LiteralTag, TupleSize). - false; -is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[A,#c_literal{val=Arity}]}, - Sub, _BoolVars) when is_integer(Arity), Arity >= 0 -> - is_safe_simple(A, Sub); + _BoolVars) when is_integer(Arity), Arity >= 0 -> + is_safe_simple(A); is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}}, - _Sub, _BoolVars) -> + _BoolVars) -> false; is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=Name},args=Args}, - Sub, BoolVars) -> + BoolVars) -> NumArgs = length(Args), case (erl_internal:comp_op(Name, NumArgs) orelse erl_internal:new_type_test(Name, NumArgs)) andalso - is_safe_simple_list(Args, Sub) of + is_safe_simple_list(Args) of true -> true; false -> %% Boolean operators are safe if all arguments are boolean. erl_internal:bool_op(Name, NumArgs) andalso - is_safe_bool_expr_list(Args, Sub, BoolVars) + is_safe_bool_expr_list(Args, BoolVars) end; -is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, Sub, BoolVars) -> - case is_safe_simple(Arg, Sub) of +is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, BoolVars) -> + case is_safe_simple(Arg) of true -> - case {is_safe_bool_expr_1(Arg, Sub, BoolVars),Vars} of + case {is_safe_bool_expr_1(Arg, BoolVars),Vars} of {true,[#c_var{name=V}]} -> - is_safe_bool_expr_1(B, Sub, cerl_sets:add_element(V, BoolVars)); + is_safe_bool_expr_1(B, cerl_sets:add_element(V, BoolVars)); {false,_} -> - is_safe_bool_expr_1(B, Sub, BoolVars) + is_safe_bool_expr_1(B, BoolVars) end; false -> false end; -is_safe_bool_expr_1(#c_literal{val=Val}, _Sub, _) -> +is_safe_bool_expr_1(#c_literal{val=Val}, _BoolVars) -> is_boolean(Val); -is_safe_bool_expr_1(#c_var{name=V}, _Sub, BoolVars) -> +is_safe_bool_expr_1(#c_var{name=V}, BoolVars) -> cerl_sets:is_element(V, BoolVars); -is_safe_bool_expr_1(_, _, _) -> false. +is_safe_bool_expr_1(_, _) -> false. -is_safe_bool_expr_list([C|Cs], Sub, BoolVars) -> - case is_safe_bool_expr_1(C, Sub, BoolVars) of - true -> is_safe_bool_expr_list(Cs, Sub, BoolVars); +is_safe_bool_expr_list([C|Cs], BoolVars) -> + case is_safe_bool_expr_1(C, BoolVars) of + true -> is_safe_bool_expr_list(Cs, BoolVars); false -> false end; -is_safe_bool_expr_list([], _, _) -> true. +is_safe_bool_expr_list([], _) -> true. %% simplify_let(Let, Sub) -> Expr | impossible %% If the argument part of an let contains a complex expression, such @@ -2705,19 +2520,6 @@ delay_build_expr_1(#c_case{clauses=Cs0}=Case, TypeSig) -> delay_build_expr_1(#c_let{body=B0}=Let, TypeSig) -> B = delay_build_expr(B0, TypeSig), Let#c_let{body=B}; -delay_build_expr_1(#c_receive{clauses=Cs0, - timeout=Timeout, - action=A0}=Rec, TypeSig) -> - Cs = delay_build_cs(Cs0, TypeSig), - A = case {Timeout,A0} of - {#c_literal{val=infinity},#c_literal{}} -> - {_Type,Arity} = TypeSig, - Es = lists:duplicate(Arity, A0), - core_lib:make_values(Es); - _ -> - delay_build_expr(A0, TypeSig) - end, - Rec#c_receive{clauses=Cs,action=A}; delay_build_expr_1(#c_seq{body=B0}=Seq, TypeSig) -> B = delay_build_expr(B0, TypeSig), Seq#c_seq{body=B}; @@ -2770,32 +2572,24 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) -> {[],#c_values{es=[]},_} -> %% No variables left. Body; - {[#c_var{name=V}=Var|Vars]=Vars0,Arg1,Body} -> + {[#c_var{name=V}=Var]=Vars0,Arg1,Body} -> case core_lib:is_var_used(V, Body) of - false when Vars =:= [] -> + false -> %% If the variable is not used in the body, we can %% rewrite the let to a sequence: %% let <Var> = Arg in BodyWithoutVar ==> %% seq Arg BodyWithoutVar Arg = maybe_suppress_warnings(Arg1, Var, PrevBody), #c_seq{arg=Arg,body=Body}; - false -> - %% There are multiple values returned by the argument - %% and the first value is not used (this is a 'case' - %% with exported variables, but the return value is - %% ignored). We can remove the first variable and the - %% the first value returned from the 'let' argument. - Arg2 = remove_first_value(Arg1, Sub), - Let1 = Let0#c_let{vars=Vars,arg=Arg2,body=Body}, - post_opt_let(Let1, Sub); true -> Let1 = Let0#c_let{vars=Vars0,arg=Arg1,body=Body}, post_opt_let(Let1, Sub) end; - {[],Arg,Body} -> + {_,_,_} -> %% The argument for a sequence must be a single value (not %% #c_values{}). Therefore, we must keep the let. - post_opt_let(#c_let{vars=[],arg=Arg,body=Body}, Sub) + Let1 = Let0#c_let{vars=Vs0,arg=Arg0,body=Body}, + post_opt_let(Let1, Sub) end. %% post_opt_let(Let, Sub) @@ -2808,39 +2602,6 @@ post_opt_let(Let0, Sub) -> Let1 = opt_bool_case_in_let(Let0, Sub), opt_build_stacktrace(Let1). - -%% remove_first_value(Core0, Sub) -> Core. -%% Core0 is an expression that returns at least two values. -%% Remove the first value returned from Core0. - -remove_first_value(#c_values{es=[V|Vs]}, Sub) -> - Values = core_lib:make_values(Vs), - case is_safe_simple(V, Sub) of - false -> - #c_seq{arg=V,body=Values}; - true -> - Values - end; -remove_first_value(#c_case{clauses=Cs0}=Core, Sub) -> - Cs = remove_first_value_cs(Cs0, Sub), - Core#c_case{clauses=Cs}; -remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core, Sub) -> - Cs = remove_first_value_cs(Cs0, Sub), - Act = remove_first_value(Act0, Sub), - Core#c_receive{clauses=Cs,action=Act}; -remove_first_value(#c_let{body=B}=Core, Sub) -> - Core#c_let{body=remove_first_value(B, Sub)}; -remove_first_value(#c_seq{body=B}=Core, Sub) -> - Core#c_seq{body=remove_first_value(B, Sub)}; -remove_first_value(#c_primop{}=Core, _Sub) -> - Core; -remove_first_value(#c_call{}=Core, _Sub) -> - Core. - -remove_first_value_cs(Cs, Sub) -> - [C#c_clause{body=remove_first_value(B, Sub)} || - #c_clause{body=B}=C <- Cs]. - %% maybe_suppress_warnings(Arg, #c_var{}, PreviousBody) -> Arg' %% Try to suppress false warnings when a variable is not used. %% For instance, we don't expect a warning for useless building in: @@ -2966,54 +2727,6 @@ move_case_into_arg(Expr, _) -> Expr. %%% -%%% Retrieving information about types. -%%% - --spec get_type(cerl:cerl(), #sub{}) -> type_info() | 'none'. - -get_type(#c_var{name=V}, #sub{t=Tdb}) -> - case Tdb of - #{V:=Type} -> Type; - _ -> none - end; -get_type(C, _) -> - case cerl:type(C) of - binary -> C; - map -> C; - _ -> - case cerl:is_data(C) of - true -> C; - false -> none - end - end. - --spec is_boolean_type(cerl:cerl(), sub()) -> yes_no_maybe(). - -is_boolean_type(Var, Sub) -> - case get_type(Var, Sub) of - none -> - maybe; - bool -> - yes; - C -> - B = cerl:is_c_atom(C) andalso - is_boolean(cerl:atom_val(C)), - yes_no(B) - end. - --spec is_int_type(cerl:cerl(), sub()) -> yes_no_maybe(). - -is_int_type(Var, Sub) -> - case get_type(Var, Sub) of - none -> maybe; - integer -> yes; - C -> yes_no(cerl:is_c_int(C)) - end. - -yes_no(true) -> yes; -yes_no(false) -> no. - -%%% %%% Update type information. %%% @@ -3024,70 +2737,14 @@ update_let_types(_Vs, _Arg, Sub) -> %% that returns multiple values. Sub. -update_let_types_1([#c_var{}=V|Vs], [A|As], Sub0) -> - Sub = update_types_from_expr(V, A, Sub0), +update_let_types_1([#c_var{name=V}|Vs], [A|As], Sub0) -> + Sub = update_types(V, A, Sub0), update_let_types_1(Vs, As, Sub); update_let_types_1([], [], Sub) -> Sub. -update_types_from_expr(V, Expr, Sub) -> - Type = extract_type(Expr, Sub), - update_types(V, [Type], Sub). - -extract_type(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=Name}, - args=Args}=Call, Sub) -> - case returns_integer(Name, Args) of - true -> integer; - false -> extract_type_1(Call, Sub) - end; -extract_type(Expr, Sub) -> - extract_type_1(Expr, Sub). - -extract_type_1(Expr, Sub) -> - case is_bool_expr(Expr, Sub) of - false -> Expr; - true -> bool - end. - -returns_integer('band', [_,_]) -> true; -returns_integer('bnot', [_]) -> true; -returns_integer('bor', [_,_]) -> true; -returns_integer('bxor', [_,_]) -> true; -returns_integer(bit_size, [_]) -> true; -returns_integer('bsl', [_,_]) -> true; -returns_integer('bsr', [_,_]) -> true; -returns_integer(byte_size, [_]) -> true; -returns_integer(ceil, [_]) -> true; -returns_integer('div', [_,_]) -> true; -returns_integer(floor, [_]) -> true; -returns_integer(length, [_]) -> true; -returns_integer('rem', [_,_]) -> true; -returns_integer('round', [_]) -> true; -returns_integer(size, [_]) -> true; -returns_integer(tuple_size, [_]) -> true; -returns_integer(trunc, [_]) -> true; -returns_integer(_, _) -> false. - -%% update_types(Expr, Pattern, Sub) -> Sub' -%% Update the type database. - --spec update_types(cerl:c_var(), [type_info()], sub()) -> sub(). - -update_types(#c_var{name=V}, Pat, #sub{t=Tdb0}=Sub) -> - Tdb = update_types_1(V, Pat, Tdb0), - Sub#sub{t=Tdb}. - -update_types_1(V, [#c_tuple{}=P], Types) -> - Types#{V=>P}; -update_types_1(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> - Types#{V=>bool}; -update_types_1(V, [#c_fun{vars=Vars}], Types) -> - Types#{V=>{'fun',length(Vars)}}; -update_types_1(V, [#c_var{name={_,Arity}}], Types) -> - Types#{V=>{'fun',Arity}}; -update_types_1(V, [Type], Types) when is_atom(Type) -> - Types#{V=>Type}; -update_types_1(_, _, Types) -> Types. +update_types(V, #c_tuple{}=P, #sub{t=Tdb}=Sub) -> + Sub#sub{t=Tdb#{V=>P}}; +update_types(_, _, Sub) -> Sub. %% kill_types(V, Tdb) -> Tdb' %% Kill any entries that references the variable, @@ -3103,10 +2760,6 @@ kill_types2(V, [{_,#c_tuple{}=Tuple}=Entry|Tdb]) -> false -> [Entry|kill_types2(V, Tdb)]; true -> kill_types2(V, Tdb) end; -kill_types2(V, [{_, {'fun',_}}=Entry|Tdb]) -> - [Entry|kill_types2(V, Tdb)]; -kill_types2(V, [{_,Atom}=Entry|Tdb]) when is_atom(Atom) -> - [Entry|kill_types2(V, Tdb)]; kill_types2(_, []) -> []. %% copy_type(DestVar, SrcVar, Tdb) -> Tdb' @@ -3198,6 +2851,13 @@ format_error({embedded_unit,Unit,Size}) -> format_error(bad_unicode) -> "binary construction will fail with a 'badarg' exception " "(invalid Unicode code point in a utf8/utf16/utf32 segment)"; +format_error(bad_float_size) -> + "binary construction will fail with a 'badarg' exception " + "(invalid size for a float segment)"; +format_error({nomatch_shadow,Line,{Name, Arity}}) -> + M = io_lib:format("this clause for ~ts/~B cannot match because a previous " + "clause at line ~p always matches", [Name, Arity, Line]), + flatten(M); format_error({nomatch_shadow,Line}) -> M = io_lib:format("this clause cannot match because a previous clause at line ~p " "always matches", [Line]), diff --git a/lib/compiler/src/sys_core_fold_lists.erl b/lib/compiler/src/sys_core_fold_lists.erl index e93b435011..ab5fcb3da4 100644 --- a/lib/compiler/src/sys_core_fold_lists.erl +++ b/lib/compiler/src/sys_core_fold_lists.erl @@ -56,9 +56,8 @@ call(#c_call{anno=Anno}, lists, all, [Arg1,Arg2]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=true}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)}, + body=function_clause(Anno, [F, Xs])}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -90,9 +89,8 @@ call(#c_call{anno=Anno}, lists, any, [Arg1,Arg2]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=false}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^any',1}}|Anno], Err2)}, + body=function_clause(Anno, [F, Xs])}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -113,9 +111,8 @@ call(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=ok}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)}, + body=function_clause(Anno, [F, Xs])}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -143,9 +140,8 @@ call(#c_call{anno=Anno}, lists, map, [Arg1,Arg2]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^map',1}}|Anno], Err)}, + body=function_clause(Anno, [F, Xs])}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -174,9 +170,8 @@ call(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)}, + body=function_clause(Anno, [F, Xs])}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -213,10 +208,9 @@ call(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)}, + body=function_clause(Anno, [F, Xs])}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -241,9 +235,8 @@ call(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=2}]}, body=A}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)}, + body=function_clause(Anno, [F, A, Xs])}, Fun = #c_fun{vars=[Xs, A], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -268,9 +261,8 @@ call(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3]) -> name=#c_literal{val=is_function}, args=[F, #c_literal{val=2}]}, body=A}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)}, + body=function_clause(Anno, [F, A, Xs])}, Fun = #c_fun{vars=[Xs, A], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -321,9 +313,8 @@ call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) -> es=[#c_literal{val=[]}, Avar]}}, %%% Multiple-value version %%% body=#c_values{es=[#c_literal{val=[]}, A]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)}, + body=function_clause(Anno, [F, Avar, Xs])}, Fun = #c_fun{vars=[Xs, Avar], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -382,9 +373,8 @@ call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) -> es=[#c_literal{val=[]}, Avar]}}, %%% Multiple-value version %%% body=#c_values{es=[#c_literal{val=[]}, A]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)}, + body=function_clause(Anno, [F, Avar, Xs])}, Fun = #c_fun{vars=[Xs, Avar], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, @@ -406,3 +396,9 @@ match_fail(Ann, Arg) -> Name = cerl:abstract(match_fail), Args = [Arg], cerl:ann_c_primop(Ann, Name, Args). + +function_clause(Anno, Args) -> + #c_call{anno=Anno, + module=#c_literal{val=erlang}, + name=#c_literal{val=error}, + args=[#c_literal{val=function_clause},cerl:ann_make_list(Anno, Args)]}. diff --git a/lib/compiler/src/sys_core_inline.erl b/lib/compiler/src/sys_core_inline.erl index 3380e3f1bd..f8d26d1c5d 100644 --- a/lib/compiler/src/sys_core_inline.erl +++ b/lib/compiler/src/sys_core_inline.erl @@ -44,7 +44,7 @@ -export([module/2]). --import(lists, [member/2,map/2,foldl/3,mapfoldl/3,keydelete/3]). +-import(lists, [member/2,map/2,foldl/3,mapfoldl/3]). -include("core_parse.hrl"). @@ -116,14 +116,11 @@ inline(Fs0, St0) -> false -> {Fst,Ifs} end end, [], Fs1), - Is1 = map(fun (#ifun{body=B}=If) -> - If#ifun{body=cerl_trees:map(match_fail_fun(), B)} - end, Is0), - Is2 = [inline_inline(If, Is1) || If <- Is1], + Is1 = [inline_inline(If, Is0) || If <- Is0], %% We would like to remove inlined, non-exported functions here, %% but this can be difficult as they may be recursive. %% Use fixed inline functions on all functions. - Fs = [inline_func(F, Is2) || F <- Fs2], + Fs = [inline_func(F, Is1) || F <- Fs2], %% Regenerate module body. [Def || #fstat{def=Def} <- Fs]. @@ -172,17 +169,6 @@ inline_func(#fstat{def={Name,F0}}=Fstat, Is) -> weight_func(_Core, Acc) -> Acc + 1. -%% match_fail_fun() -> fun/1. -%% Return a function to use with map to fix inlineable functions -%% function_clause match_fail (if they have one). - -match_fail_fun() -> - fun (#c_primop{anno=Anno0,name=#c_literal{val=match_fail}}=P) -> - Anno = keydelete(function_name, 1, Anno0), - P#c_primop{anno=Anno}; - (Other) -> Other - end. - %% find_inl(Func, Arity, [Inline]) -> #ifun{} | no. find_inl(F, A, [#ifun{func=F,arity=A}=If|_]) -> If; diff --git a/lib/compiler/src/sys_core_prepare.erl b/lib/compiler/src/sys_core_prepare.erl new file mode 100644 index 0000000000..5d9954e04f --- /dev/null +++ b/lib/compiler/src/sys_core_prepare.erl @@ -0,0 +1,130 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% Purpose: Prepare Core Erlang not generated by v3_core. + +-module(sys_core_prepare). +-export([module/2]). + +-include("core_parse.hrl"). + +-spec module(cerl:c_module(), [compile:option()]) -> + {'ok',cerl:c_module(),[]}. + +module(Mod0, _Opts) -> + Count = cerl_trees:next_free_variable_name(Mod0), + {Mod,_} = cerl_trees:mapfold(fun rewrite_recv/2, Count, Mod0), + {ok,Mod,[]}. + +rewrite_recv(#c_receive{clauses=[],timeout=Timeout0,action=Action}, Count0) -> + %% Lower a receive with only an after blcok to its primitive operations. + False = #c_literal{val=false}, + True = #c_literal{val=true}, + + {TimeoutVal,Count1} = new_var(Count0), + {LoopName,Count2} = new_func_varname(Count1), + LoopFun = #c_var{name={LoopName,0}}, + ApplyLoop = #c_apply{op=LoopFun,args=[]}, + + TimeoutCs = [#c_clause{pats=[True],guard=True, + body=#c_seq{arg=primop(timeout), + body=Action}}, + #c_clause{pats=[False],guard=True, + body=ApplyLoop}], + {TimeoutBool,Count4} = new_var(Count2), + TimeoutCase = #c_case{arg=TimeoutBool,clauses=TimeoutCs}, + TimeoutLet = #c_let{vars=[TimeoutBool], + arg=primop(recv_wait_timeout, [TimeoutVal]), + body=TimeoutCase}, + + Fun = #c_fun{vars=[],body=TimeoutLet}, + + Letrec = #c_letrec{anno=[letrec_goto], + defs=[{LoopFun,Fun}], + body=ApplyLoop}, + + OuterLet = #c_let{vars=[TimeoutVal],arg=Timeout0,body=Letrec}, + {OuterLet,Count4}; +rewrite_recv(#c_receive{clauses=Cs0,timeout=Timeout0,action=Action}, Count0) -> + %% Lower receive to its primitive operations. + False = #c_literal{val=false}, + True = #c_literal{val=true}, + + {TimeoutVal,Count1} = new_var(Count0), + {LoopName,Count2} = new_func_varname(Count1), + LoopFun = #c_var{name={LoopName,0}}, + ApplyLoop = #c_apply{op=LoopFun,args=[]}, + + Cs1 = rewrite_cs(Cs0), + RecvNext = #c_seq{arg=primop(recv_next), + body=ApplyLoop}, + RecvNextC = #c_clause{anno=[compiler_generated], + pats=[#c_var{name='Other'}],guard=True,body=RecvNext}, + Cs = Cs1 ++ [RecvNextC], + {Msg,Count3} = new_var(Count2), + MsgCase = #c_case{arg=Msg,clauses=Cs}, + + TimeoutCs = [#c_clause{pats=[True],guard=True, + body=#c_seq{arg=primop(timeout), + body=Action}}, + #c_clause{pats=[False],guard=True, + body=ApplyLoop}], + {TimeoutBool,Count4} = new_var(Count3), + TimeoutCase = #c_case{arg=TimeoutBool,clauses=TimeoutCs}, + TimeoutLet = #c_let{vars=[TimeoutBool], + arg=primop(recv_wait_timeout, [TimeoutVal]), + body=TimeoutCase}, + + {PeekSucceeded,Count5} = new_var(Count4), + PeekCs = [#c_clause{pats=[True],guard=True, + body=MsgCase}, + #c_clause{pats=[False],guard=True, + body=TimeoutLet}], + PeekCase = #c_case{arg=PeekSucceeded,clauses=PeekCs}, + PeekLet = #c_let{vars=[PeekSucceeded,Msg], + arg=primop(recv_peek_message), + body=PeekCase}, + Fun = #c_fun{vars=[],body=PeekLet}, + + Letrec = #c_letrec{anno=[letrec_goto], + defs=[{LoopFun,Fun}], + body=ApplyLoop}, + + OuterLet = #c_let{vars=[TimeoutVal],arg=Timeout0,body=Letrec}, + {OuterLet,Count5}; +rewrite_recv(Tree, Count) -> + {Tree,Count}. + +rewrite_cs([#c_clause{body=B0}=C|Cs]) -> + B = #c_seq{arg=primop(remove_message),body=B0}, + [C#c_clause{body=B}|rewrite_cs(Cs)]; +rewrite_cs([]) -> []. + +primop(Name) -> + primop(Name, []). + +primop(Name, Args) -> + #c_primop{name=#c_literal{val=Name},args=Args}. + +new_var(Count) -> + {#c_var{name=Count},Count+1}. + +new_func_varname(Count) -> + Name = list_to_atom("@pre" ++ integer_to_list(Count)), + {Name,Count+1}. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 007a0247f4..0efc8f7821 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -22,7 +22,7 @@ %% At this stage all preprocessing has been done. All that is left are %% "pure" Erlang functions. %% -%% Core transformation is done in three stages: +%% Core transformation is done in four stages: %% %% 1. Flatten expressions into an internal core form without doing %% matching. @@ -37,6 +37,12 @@ %% annotations to change implicit exported variables to explicit %% returns. %% +%% 4. Lower receives to more primitive operations. Split binary +%% patterns where a value is matched out and then used used as +%% a size in the same pattern. That simplifies the subsequent +%% passes as all variables are within a single pattern are either +%% new or used, but never both at the same time. +%% %% To ensure the evaluation order we ensure that all arguments are %% safe. A "safe" is basically a core_lib simple with VERY restricted %% binaries. @@ -91,13 +97,16 @@ -record(iapply, {anno=#a{},op,args}). -record(ibinary, {anno=#a{},segments}). %Not used in patterns. +-record(ibitstr, {anno=#a{},val,size,unit,type,flags}). -record(icall, {anno=#a{},module,name,args}). -record(icase, {anno=#a{},args,clauses,fc}). -record(icatch, {anno=#a{},body}). --record(iclause, {anno=#a{},pats,pguard=[],guard,body}). +-record(iclause, {anno=#a{},pats,guard,body}). -record(ifun, {anno=#a{},id,vars,clauses,fc,name=unnamed}). -record(iletrec, {anno=#a{},defs,body}). -record(imatch, {anno=#a{},pat,guard=[],arg,fc}). +-record(imap, {anno=#a{},arg=#c_literal{val=#{}},es,is_pat=false}). +-record(imappair, {anno=#a{},op,key,val}). -record(iprimop, {anno=#a{},name,args}). -record(iprotect, {anno=#a{},body}). -record(ireceive1, {anno=#a{},clauses}). @@ -105,7 +114,7 @@ -record(iset, {anno=#a{},var,arg}). -record(itry, {anno=#a{},args,vars,body,evars,handler}). -record(ifilter, {anno=#a{},arg}). --record(igen, {anno=#a{},ceps=[],acc_pat,acc_guard, +-record(igen, {anno=#a{},acc_pat,acc_guard, skip_pat,tail,tail_pat,arg}). -record(isimple, {anno=#a{},term :: cerl:cerl()}). @@ -118,6 +127,7 @@ -type ifun() :: #ifun{}. -type iletrec() :: #iletrec{}. -type imatch() :: #imatch{}. +-type imap() :: #imap{}. -type iprimop() :: #iprimop{}. -type iprotect() :: #iprotect{}. -type ireceive1() :: #ireceive1{}. @@ -128,19 +138,22 @@ -type igen() :: #igen{}. -type isimple() :: #isimple{}. --type i() :: iapply() | ibinary() | icall() | icase() | icatch() - | iclause() | ifun() | iletrec() | imatch() | iprimop() - | iprotect() | ireceive1() | ireceive2() | iset() | itry() - | ifilter() | igen() | isimple(). +-type i() :: iapply() | ibinary() | icall() | icase() | icatch() + | iclause() | ifun() | iletrec() | imatch() | imap() + | iprimop() | iprotect() | ireceive1() | ireceive2() + | iset() | itry() | ifilter() + | igen() | isimple(). -type warning() :: {file:filename(), [{integer(), module(), term()}]}. -record(core, {vcount=0 :: non_neg_integer(), %Variable counter fcount=0 :: non_neg_integer(), %Function counter + gcount=0 :: non_neg_integer(), %Goto counter function={none,0} :: fa(), %Current function. in_guard=false :: boolean(), %In guard or not. wanted=true :: boolean(), %Result wanted or not. - opts :: [compile:option()], %Options. + opts=[] :: [compile:option()], %Options. + dialyzer=false :: boolean(), %Help dialyzer or not. ws=[] :: [warning()], %Warnings. file=[{file,""}] %File. }). @@ -216,69 +229,61 @@ defined_functions(Forms) -> %% ok. function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) -> - St0 = #core{vcount=0,function={Name,Arity},opts=Opts, - ws=Ws0,file=[{file,File}]}, - {B0,St1} = body(Cs0, Name, Arity, St0), - %% ok = function_dump(Name,Arity,"body:~n~p~n",[B0]), - {B1,St2} = ubody(B0, St1), - %% ok = function_dump(Name,Arity,"ubody:~n~p~n",[B1]), - {B2,#core{ws=Ws}} = cbody(B1, St2), - %% ok = function_dump(Name,Arity,"cbody:~n~p~n",[B2]), - {{#c_var{name={Name,Arity}},B2},Ws}. + try + St0 = #core{vcount=0,function={Name,Arity},opts=Opts, + dialyzer=member(dialyzer, Opts), + ws=Ws0,file=[{file,File}]}, + {B0,St1} = body(Cs0, Name, Arity, St0), + %% ok = function_dump(Name, Arity, "body:~n~p~n",[B0]), + {B1,St2} = ubody(B0, St1), + %% ok = function_dump(Name, Arity, "ubody:~n~p~n",[B1]), + {B2,St3} = cbody(B1, St2), + %% ok = function_dump(Name, Arity, "cbody:~n~p~n",[B2]), + {B3,#core{ws=Ws}} = lbody(B2, St3), + %% ok = function_dump(Name, Arity, "lbody:~n~p~n",[B3]), + {{#c_var{name={Name,Arity}},B3},Ws} + catch + Class:Error:Stack -> + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. body(Cs0, Name, Arity, St0) -> Anno = lineno_anno(element(2, hd(Cs0)), St0), + FunAnno = [{function,{Name,Arity}} | Anno], {Args0,St1} = new_vars(Anno, Arity, St0), Args = reverse(Args0), %Nicer order - case clauses(Cs0, St1) of - {Cs1,[],St2} -> - {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = function_clause(Ps, Anno, {Name,Arity}), - {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}; - {Cs1,Eps,St2} -> - %% We have pre-expressions from patterns and - %% these needs to be letified before matching - %% since only bound variables are allowed - AnnoGen = #a{anno=[compiler_generated]}, - {Ps1,St3} = new_vars(Arity, St2), %Need new variables here - Fc1 = function_clause(Ps1, Anno, {Name,Arity}), - {Ps2,St4} = new_vars(Arity, St3), %Need new variables here - Fc2 = function_clause(Ps2, Anno, {Name,Arity}), - Case = #icase{anno=AnnoGen,args=Args, - clauses=Cs1, - fc=Fc2}, - {#ifun{anno=#a{anno=Anno},id=[],vars=Args, - clauses=[#iclause{anno=AnnoGen,pats=Ps1, - guard=[#c_literal{val=true}], - body=Eps ++ [Case]}], - fc=Fc1},St4} - end. + {Cs1,St2} = clauses(Cs0, St1), + {Ps,St3} = new_vars(Arity, St2), %Need new variables here + Fc = function_clause(Ps, Anno), + {#ifun{anno=#a{anno=FunAnno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}. %% clause(Clause, State) -> {Cclause,State} | noclause. %% clauses([Clause], State) -> {[Cclause],State}. %% Convert clauses. Trap bad pattern aliases and remove clause from %% clause list. -clauses([C0|Cs0],St0) -> +clauses([C0|Cs0], St0) -> case clause(C0, St0) of - {noclause,_,St} -> clauses(Cs0,St); - {C,Eps1,St1} -> - {Cs,Eps2,St2} = clauses(Cs0, St1), - {[C|Cs],Eps1++Eps2,St2} + {noclause,St} -> + clauses(Cs0, St); + {C,St1} -> + {Cs,St2} = clauses(Cs0, St1), + {[C|Cs],St2} end; -clauses([],St) -> {[],[],St}. +clauses([], St) -> {[],St}. clause({clause,Lc,H0,G0,B0}, St0) -> try head(H0, St0) of - {H1,Eps,St1} -> + {H1,St1} -> {G1,St2} = guard(G0, St1), {B1,St3} = exprs(B0, St2), Anno = lineno_anno(Lc, St3), - {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},Eps,St3} + {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},St3} catch throw:nomatch -> St = add_warning(Lc, nomatch, St0), - {noclause,[],St} %Bad pattern + {noclause,St} %Bad pattern end. clause_arity({clause,_,H0,_,_}) -> length(H0). @@ -419,9 +424,21 @@ gexpr_test(E0, Bools0, St0) -> {E1,Eps0,St1} = expr(E0, St0), %% Generate "top-level" test and argument calls. case E1 of + #icall{anno=Anno,module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[_,_]} -> + %% is_function/2 is not a safe type test. We must force + %% it to be protected. + Lanno = Anno#a.anno, + {New,St2} = new_var(Lanno, St1), + {icall_eq_true(New), + Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools0,St2}; #icall{anno=Anno,module=#c_literal{val=erlang},name=#c_literal{val=N},args=As} -> + %% Note that erl_expand_records has renamed type + %% tests to the new names; thus, float/1 as a type + %% test will now be named is_float/1. Ar = length(As), - case erl_internal:type_test(N, Ar) orelse + case erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar) orelse erl_internal:bool_op(N, Ar) of true -> {E1,Eps0,Bools0,St1}; @@ -586,14 +603,14 @@ expr({bin,L,Es0}, St0) -> try expr_bin(Es0, full_anno(L, St0), St0) of {_,_,_}=Res -> Res catch - throw:bad_binary -> - St = add_warning(L, bad_binary, St0), + throw:{bad_binary,Eps,St1} -> + St = add_warning(L, bad_binary, St1), LineAnno = lineno_anno(L, St), As = [#c_literal{anno=LineAnno,val=badarg}], {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} module=#c_literal{anno=LineAnno,val=erlang}, name=#c_literal{anno=LineAnno,val=error}, - args=As},[],St} + args=As},Eps,St} end; expr({block,_,Es0}, St0) -> %% Inline the block directly. @@ -601,26 +618,26 @@ expr({block,_,Es0}, St0) -> {E1,Eps,St2} = expr(last(Es0), St1), {E1,Es1 ++ Eps,St2}; expr({'if',L,Cs0}, St0) -> - {Cs1,Ceps,St1} = clauses(Cs0, St0), + {Cs1,St1} = clauses(Cs0, St0), Lanno = lineno_anno(L, St1), Fc = fail_clause([], Lanno, #c_literal{val=if_clause}), - {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},Ceps,St1}; + {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1}; expr({'case',L,E0,Cs0}, St0) -> {E1,Eps,St1} = novars(E0, St0), - {Cs1,Ceps,St2} = clauses(Cs0, St1), + {Cs1,St2} = clauses(Cs0, St1), {Fpat,St3} = new_var(St2), Lanno = lineno_anno(L, St2), Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])), - {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps++Ceps,St3}; + {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3}; expr({'receive',L,Cs0}, St0) -> - {Cs1,Ceps,St1} = clauses(Cs0, St0), - {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1},Ceps, St1}; + {Cs1,St1} = clauses(Cs0, St0), + {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1},[],St1}; expr({'receive',L,Cs0,Te0,Tes0}, St0) -> {Te1,Teps,St1} = novars(Te0, St0), {Tes1,St2} = exprs(Tes0, St1), - {Cs1,Ceps,St3} = clauses(Cs0, St2), + {Cs1,St3} = clauses(Cs0, St2), {#ireceive2{anno=#a{anno=lineno_anno(L, St3)}, - clauses=Cs1,timeout=Te1,action=Tes1},Teps++Ceps,St3}; + clauses=Cs1,timeout=Te1,action=Tes1},Teps,St3}; expr({'try',L,Es0,[],Ecs,[]}, St0) -> %% 'try ... catch ... end' {Es1,St1} = exprs(Es0, St0), @@ -634,7 +651,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> %% 'try ... of ... catch ... end' {Es1,St1} = exprs(Es0, St0), {V,St2} = new_var(St1), %This name should be arbitrary - {Cs1,Ceps,St3} = clauses(Cs0, St2), + {Cs1,St3} = clauses(Cs0, St2), {Fpat,St4} = new_var(St3), Lanno = lineno_anno(L, St4), Fc = fail_clause([Fpat], Lanno, @@ -643,7 +660,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> {#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1, vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}], evars=Evs,handler=Hs}, - Ceps,St5}; + [],St5}; expr({'try',L,Es0,[],[],As0}, St0) -> %% 'try ... after ... end' {Es1,St1} = exprs(Es0, St0), @@ -652,7 +669,7 @@ expr({'try',L,Es0,[],[],As0}, St0) -> {V,St4} = new_var(St3), % (must not exist in As1) LA = lineno_anno(L, St4), Lanno = #a{anno=LA}, - Fc = function_clause([], LA, {Name,0}), + Fc = function_clause([], LA), Fun = #ifun{anno=Lanno,id=[],vars=[], clauses=[#iclause{anno=Lanno,pats=[], guard=[#c_literal{val=true}], @@ -699,7 +716,7 @@ expr({call,Lc,{atom,Lf,F},As0}, St0) -> Op = #c_var{anno=lineno_anno(Lf, St1),name={F,length(As1)}}, {#iapply{anno=#a{anno=lineno_anno(Lc, St1)},op=Op,args=As1},Aps,St1}; expr({call,L,FunExp,As0}, St0) -> - {Fun,Fps,St1} = safe_fun(length(As0), FunExp, St0), + {Fun,Fps,St1} = safe(FunExp, St0), {As1,Aps,St2} = safe_list(As0, St1), Lanno = lineno_anno(L, St2), {#iapply{anno=#a{anno=Lanno},op=Fun,args=As1},Fps ++ Aps,St2}; @@ -712,12 +729,12 @@ expr({match,L,P0,E0}, St0) -> end, {E2,Eps1,St2} = novars(E1, St1), St3 = St2#core{wanted=St0#core.wanted}, - {P2,Eps2,St4} = try - pattern(P1, St3) - catch - throw:Thrown -> - {Thrown,[],St3} - end, + {P2,St4} = try + pattern(P1, St3) + catch + throw:Thrown -> + {Thrown,St3} + end, {Fpat,St5} = new_var(St4), Lanno = lineno_anno(L, St5), Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])), @@ -746,15 +763,15 @@ expr({match,L,P0,E0}, St0) -> St6 = add_warning(L, nomatch, St5), {Expr,Eps3,St7} = safe(E1, St6), SanPat0 = sanitize(P1), - {SanPat,Eps4,St} = pattern(SanPat0, St7), + {SanPat,St} = pattern(SanPat0, St7), Badmatch = c_tuple([#c_literal{val=badmatch},Expr]), Fail = #iprimop{anno=#a{anno=Lanno}, name=#c_literal{val=match_fail}, args=[Badmatch]}, - Eps = Eps3 ++ Eps4 ++ [Fail], + Eps = Eps3 ++ [Fail], {#imatch{anno=#a{anno=Lanno},pat=SanPat,arg=Expr,fc=Fc},Eps,St}; Other when not is_atom(Other) -> - {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5} + {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1,St5} end; expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> %% Optimise '++' here because of the list comprehension algorithm. @@ -820,6 +837,8 @@ sanitize({tuple,L,Ps0}) -> sanitize({map,L,Ps0}) -> Ps = [sanitize(V) || {map_field_exact,_,_,V} <- Ps0], {tuple,L,Ps}; +sanitize({op,L,_Name,P1,P2}) -> + {tuple,L,[sanitize(P1),sanitize(P2)]}; sanitize(P) -> P. make_bool_switch(L, E, V, T, F, #core{in_guard=true}) -> @@ -924,7 +943,7 @@ is_valid_map_src(_) -> false. try_exception(Ecs0, St0) -> %% Note that Tag is not needed for rethrow - it is already in Info. {Evs,St1} = new_vars(3, St0), % Tag, Value, Info - {Ecs1,Ceps,St2} = clauses(Ecs0, St1), + {Ecs1,St2} = clauses(Ecs0, St1), Ecs2 = try_build_stacktrace(Ecs1, hd(Evs)), [_,Value,Info] = Evs, LA = case Ecs2 of @@ -937,7 +956,7 @@ try_exception(Ecs0, St0) -> name=#c_literal{val=raise}, args=[Info,Value]}]}, Hs = [#icase{anno=#a{anno=LA},args=[c_tuple(Evs)],clauses=Ecs2,fc=Ec}], - {Evs,Ceps++Hs,St2}. + {Evs,Hs,St2}. try_after(As, St0) -> %% See above. @@ -992,14 +1011,30 @@ bin_element({bin_element,Line,Expr,Size0,Type0}) -> make_bit_type(Line, default, Type0) -> case erl_bits:set_bit_type(default, Type0) of - {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)}; + {ok,all,Bt} -> {make_all_size(Line),erl_bits:as_list(Bt)}; {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)}; {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)} end; +make_bit_type(_Line, {atom,Anno,all}=Size, Type0) -> + case erl_anno:generated(Anno) of + true -> + %% This `all` was created by the compiler from a binary + %% segment without a size. + {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0), + {Size,erl_bits:as_list(Bt)}; + false -> + %% This `all` was present in the source code. It is not + %% a valid size. + throw(nomatch) + end; make_bit_type(_Line, Size, Type0) -> %Integer or 'all' {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0), {Size,erl_bits:as_list(Bt)}. +make_all_size(Line) -> + Anno = erl_anno:set_generated(true, Line), + {atom,Anno,all}. + %% constant_bin([{bin_element,_,_,_,_}]) -> binary() | error %% If the binary construction is truly constant (no variables, %% no native fields), and does not contain fields whose expansion @@ -1112,8 +1147,9 @@ expr_bin_1(Es, St) -> end, {[],[],St}, Es). bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> - {E1,Eps,St1} = safe(E0, St0), - {Size1,Eps2,St2} = safe(Size0, St1), + {E1,Eps0,St1} = safe(E0, St0), + {Size1,Eps1,St2} = safe(Size0, St1), + Eps = Eps0 ++ Eps1, case {Type,E1} of {_,#c_var{}} -> ok; {integer,#c_literal{val=I}} when is_integer(I) -> ok; @@ -1123,41 +1159,43 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> {float,#c_literal{val=V}} when is_number(V) -> ok; {binary,#c_literal{val=V}} when is_bitstring(V) -> ok; {_,_} -> - throw(bad_binary) + %% Note that the pre expressions may bind variables that + %% are used later or have side effects. + throw({bad_binary,Eps,St2}) end, case Size1 of #c_var{} -> ok; #c_literal{val=Sz} when is_integer(Sz), Sz >= 0 -> ok; #c_literal{val=undefined} -> ok; #c_literal{val=all} -> ok; - _ -> throw(bad_binary) + _ -> throw({bad_binary,Eps,St2}) end, {#c_bitstr{val=E1,size=Size1, unit=#c_literal{val=Unit}, type=#c_literal{val=Type}, flags=#c_literal{val=Flags}}, - Eps ++ Eps2,St2}. + Eps,St2}. %% fun_tq(Id, [Clauses], Line, State, NameInfo) -> {Fun,[PreExp],State}. fun_tq(Cs0, L, St0, NameInfo) -> Arity = clause_arity(hd(Cs0)), - {Cs1,Ceps,St1} = clauses(Cs0, St0), + {Cs1,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here Anno = full_anno(L, St3), {Name,St4} = new_fun_name(St3), - Fc = function_clause(Ps, Anno, {Name,Arity}), + Fc = function_clause(Ps, Anno), Id = {0,0,Name}, Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! vars=Args,clauses=Cs1,fc=Fc,name=NameInfo}, - {Fun,Ceps,St4}. + {Fun,[],St4}. %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. %% This TQ from Simon PJ pp 127-138. -lc_tq(Line, E, [#igen{anno=#a{anno=GA}=GAnno,ceps=Ceps, +lc_tq(Line, E, [#igen{anno=#a{anno=GA}=GAnno, acc_pat=AccPat,acc_guard=AccGuard, skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, arg={Pre,Arg}}|Qs], Mc, St0) -> @@ -1167,7 +1205,7 @@ lc_tq(Line, E, [#igen{anno=#a{anno=GA}=GAnno,ceps=Ceps, F = #c_var{anno=LA,name={Name,1}}, Nc = #iapply{anno=GAnno,op=F,args=[Tail]}, {Var,St2} = new_var(St1), - Fc = function_clause([Var], GA, {Name,1}), + Fc = function_clause([Var], GA), TailClause = #iclause{anno=LAnno,pats=[TailPat],guard=[],body=[Mc]}, Cs0 = case {AccPat,AccGuard} of {SkipPat,[]} -> @@ -1193,7 +1231,7 @@ lc_tq(Line, E, [#igen{anno=#a{anno=GA}=GAnno,ceps=Ceps, Fun = #ifun{anno=GAnno,id=[],vars=[Var],clauses=Cs,fc=Fc}, {#iletrec{anno=GAnno#a{anno=[list_comprehension|GA]},defs=[{{Name,1},Fun}], body=Pre ++ [#iapply{anno=GAnno,op=F,args=[Arg]}]}, - Ceps,St4}; + [],St4}; lc_tq(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> filter_tq(Line, E, Filter, Mc, St, Qs, fun lc_tq/5); lc_tq(Line, E0, [], Mc0, St0) -> @@ -1218,7 +1256,7 @@ bc_tq(Line, Exp, Qs0, St0) -> args=[Sz]}}] ++ BcPre, {E,Pre,St}. -bc_tq1(Line, E, [#igen{anno=GAnno,ceps=Ceps, +bc_tq1(Line, E, [#igen{anno=GAnno, acc_pat=AccPat,acc_guard=AccGuard, skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, arg={Pre,Arg}}|Qs], Mc, St0) -> @@ -1228,7 +1266,7 @@ bc_tq1(Line, E, [#igen{anno=GAnno,ceps=Ceps, {Vars=[_,AccVar],St2} = new_vars(LA, 2, St1), F = #c_var{anno=LA,name={Name,2}}, Nc = #iapply{anno=GAnno,op=F,args=[Tail,AccVar]}, - Fc = function_clause(Vars, LA, {Name,2}), + Fc = function_clause(Vars, LA), TailClause = #iclause{anno=LAnno,pats=[TailPat,AccVar],guard=[], body=[AccVar]}, Cs0 = case {AccPat,AccGuard} of @@ -1257,14 +1295,14 @@ bc_tq1(Line, E, [#igen{anno=GAnno,ceps=Ceps, Fun = #ifun{anno=LAnno,id=[],vars=Vars,clauses=Cs,fc=Fc}, {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,2},Fun}], body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg,Mc]}]}, - Ceps,St4}; + [],St4}; bc_tq1(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> filter_tq(Line, E, Filter, Mc, St, Qs, fun bc_tq1/5); bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) -> bc_tq_build(Bl, [], AccVar, Elements, St0); bc_tq1(Line, E0, [], AccVar, St0) -> BsFlags = [binary,{unit,1}], - BsSize = {atom,Line,all}, + BsSize = make_all_size(Line), {E1,Pre0,St1} = safe(E0, St0), case E1 of #c_var{name=VarName} -> @@ -1287,7 +1325,7 @@ bc_tq1(Line, E0, [], AccVar, St0) -> end. bc_tq_build(Line, Pre0, #c_var{name=AccVar}, Elements0, St0) -> - Elements = [{bin_element,Line,{var,Line,AccVar},{atom,Line,all}, + Elements = [{bin_element,Line,{var,Line,AccVar},make_all_size(Line), [binary,{unit,1}]}|Elements0], {E,Pre,St} = expr({bin,Line,Elements}, St0), #a{anno=A} = Anno0 = get_anno(E), @@ -1399,7 +1437,7 @@ get_qual_anno(Abstract) -> element(2, Abstract). generator(Line, {generate,Lg,P0,E}, Gs, St0) -> LA = lineno_anno(Line, St0), GA = lineno_anno(Lg, St0), - {Head,Ceps,St1} = list_gen_pattern(P0, Line, St0), + {Head,St1} = list_gen_pattern(P0, Line, St0), {[Tail,Skip],St2} = new_vars(2, St1), {Cg,St3} = lc_guard_tests(Gs, St2), {AccPat,SkipPat} = case Head of @@ -1419,44 +1457,55 @@ generator(Line, {generate,Lg,P0,E}, Gs, St0) -> ann_c_cons(LA, Skip, Tail)} end, {Ce,Pre,St4} = safe(E, St3), - Gen = #igen{anno=#a{anno=GA},ceps=Ceps, + Gen = #igen{anno=#a{anno=GA}, acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Pre,Ce}}, {Gen,St4}; generator(Line, {b_generate,Lg,P,E}, Gs, St0) -> LA = lineno_anno(Line, St0), GA = lineno_anno(Lg, St0), - {Cp = #c_binary{segments=Segs},[],St1} = pattern(P, St0), - - %% The function append_tail_segment/2 keeps variable patterns as-is, making - %% it possible to have the same skip clause removal as with list generators. - {AccSegs,Tail,TailSeg,St2} = append_tail_segment(Segs, St1), - AccPat = Cp#c_binary{segments=AccSegs}, - {Cg,St3} = lc_guard_tests(Gs, St2), - {SkipSegs,St4} = emasculate_segments(AccSegs, St3), - SkipPat = Cp#c_binary{segments=SkipSegs}, - {Ce,Pre,St5} = safe(E, St4), - Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, - tail=Tail,tail_pat=#c_binary{anno=LA,segments=[TailSeg]}, - arg={Pre,Ce}}, - {Gen,St5}. + try pattern(P, St0) of + {#ibinary{segments=Segs}=Cp,St1} -> + %% The function append_tail_segment/2 keeps variable + %% patterns as-is, making it possible to have the same + %% skip clause removal as with list generators. + {AccSegs,Tail,TailSeg,St2} = append_tail_segment(Segs, St1), + AccPat = Cp#ibinary{segments=AccSegs}, + {Cg,St3} = lc_guard_tests(Gs, St2), + {SkipSegs,St4} = emasculate_segments(AccSegs, St3), + SkipPat = Cp#ibinary{segments=SkipSegs}, + {Ce,Pre,St5} = safe(E, St4), + Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg, + skip_pat=SkipPat,tail=Tail, + tail_pat=#ibinary{anno=#a{anno=LA},segments=[TailSeg]}, + arg={Pre,Ce}}, + {Gen,St5} + catch + throw:nomatch -> + {Ce,Pre,St1} = safe(E, St0), + Gen = #igen{anno=#a{anno=GA},acc_pat=nomatch,acc_guard=[], + skip_pat=nomatch, + tail_pat=#c_var{name='_'}, + arg={Pre,Ce}}, + {Gen,St1} + end. append_tail_segment(Segs, St0) -> {Var,St} = new_var(St0), - Tail = #c_bitstr{val=Var,size=#c_literal{val=all}, - unit=#c_literal{val=1}, - type=#c_literal{val=binary}, - flags=#c_literal{val=[unsigned,big]}}, + Tail = #ibitstr{val=Var,size=[#c_literal{val=all}], + unit=#c_literal{val=1}, + type=#c_literal{val=binary}, + flags=#c_literal{val=[unsigned,big]}}, {Segs++[Tail],Var,Tail,St}. emasculate_segments(Segs, St) -> emasculate_segments(Segs, St, []). -emasculate_segments([#c_bitstr{val=#c_var{}}=B|Rest], St, Acc) -> +emasculate_segments([#ibitstr{val=#c_var{}}=B|Rest], St, Acc) -> emasculate_segments(Rest, St, [B|Acc]); emasculate_segments([B|Rest], St0, Acc) -> {Var,St1} = new_var(St0), - emasculate_segments(Rest, St1, [B#c_bitstr{val=Var}|Acc]); + emasculate_segments(Rest, St1, [B#ibitstr{val=Var}|Acc]); emasculate_segments([], St, Acc) -> {reverse(Acc),St}. @@ -1468,9 +1517,9 @@ lc_guard_tests(Gs0, St0) -> list_gen_pattern(P0, Line, St) -> try - pattern(P0,St) - catch - nomatch -> {nomatch,[],add_warning(Line, nomatch, St)} + pattern(P0, St) + catch + nomatch -> {nomatch,add_warning(Line, nomatch, St)} end. %%% @@ -1502,7 +1551,9 @@ bc_initial_size(E0, Q, St0) -> end catch throw:impossible -> - {#c_literal{val=256},[],St0} + {#c_literal{val=256},[],St0}; + throw:nomatch -> + {#c_literal{val=1},[],St0} end. bc_elem_size({bin,_,El}, St0) -> @@ -1737,18 +1788,6 @@ force_novars(#c_map{}=Bin, St) -> {Bin,[],St}; force_novars(Ce, St) -> force_safe(Ce, St). - -%% safe_pattern_expr(Expr, State) -> {Cexpr,[PreExpr],State}. -%% only literals and variables are safe expressions in patterns -safe_pattern_expr(E,St0) -> - case safe(E,St0) of - {#c_var{},_,_}=Safe -> Safe; - {#c_literal{},_,_}=Safe -> Safe; - {Ce,Eps,St1} -> - {V,St2} = new_var(St1), - {V,Eps++[#iset{var=V,arg=Ce}],St2} - end. - %% safe(Expr, State) -> {Safe,[PreExpr],State}. %% Generate an internal safe expression. These are simples without %% binaries which can fail. At this level we do not need to do a @@ -1759,15 +1798,6 @@ safe(E0, St0) -> {Se,Sps,St2} = force_safe(E1, St1), {Se,Eps ++ Sps,St2}. -safe_fun(A0, E0, St0) -> - case safe(E0, St0) of - {#c_var{name={_,A1}}=E1,Eps,St1} when A1 =/= A0 -> - {V,St2} = new_var(St1), - {V,Eps ++ [#iset{var=V,arg=E1}],St2}; - Result -> - Result - end. - safe_list(Es, St) -> foldr(fun (E, {Ces,Esp,St0}) -> {Ce,Ep,St1} = safe(E, St0), @@ -1825,44 +1855,33 @@ fold_match({match,L,P0,E0}, P) -> fold_match(E, P) -> {P,E}. %% pattern(Pattern, State) -> {CorePat,[PreExp],State}. -%% Transform a pattern by removing line numbers. We also normalise -%% aliases in patterns to standard form, {alias,Pat,[Var]}. -%% -%% In patterns we may have expressions -%% 1) Binaries -> #c_bitstr{size=Expr} -%% 2) Maps -> #c_map_pair{key=Expr} -%% -%% Both of these may generate pre-expressions since only bound variables -%% or literals are allowed for these in core patterns. -%% -%% Therefor, we need to drag both the state and the collection of pre-expression -%% around in the whole pattern transformation tree. - -pattern({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},[],St}; -pattern({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},[],St}; -pattern({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},[],St}; -pattern({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},[],St}; -pattern({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},[],St}; -pattern({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},[],St}; -pattern({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},[],St}; +%% Transform a pattern by removing line numbers. We also normalise +%% aliases in patterns to standard form: {alias,Pat,[Var]}. + +pattern({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},St}; +pattern({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},St}; +pattern({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},St}; +pattern({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},St}; +pattern({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},St}; +pattern({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},St}; +pattern({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},St}; pattern({cons,L,H,T}, St) -> - {Ph,Eps1,St1} = pattern(H, St), - {Pt,Eps2,St2} = pattern(T, St1), - {annotate_cons(lineno_anno(L, St), Ph, Pt, St2),Eps1++Eps2,St2}; + {Ph,St1} = pattern(H, St), + {Pt,St2} = pattern(T, St1), + {annotate_cons(lineno_anno(L, St), Ph, Pt, St2),St2}; pattern({tuple,L,Ps}, St) -> - {Ps1,Eps,St1} = pattern_list(Ps,St), - {annotate_tuple(record_anno(L, St), Ps1, St),Eps,St1}; + {Ps1,St1} = pattern_list(Ps, St), + {annotate_tuple(record_anno(L, St), Ps1, St),St1}; pattern({map,L,Pairs}, St0) -> - {Ps,Eps,St1} = pattern_map_pairs(Pairs, St0), - {#c_map{anno=lineno_anno(L, St1),es=Ps,is_pat=true},Eps,St1}; -pattern({bin,L,Ps}, St) -> - %% We don't create a #ibinary record here, since there is - %% no need to hold any used/new annotations in a pattern. - {#c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)},[],St}; + {Ps,St1} = pattern_map_pairs(Pairs, St0), + {#imap{anno=#a{anno=lineno_anno(L, St1)},es=Ps},St1}; +pattern({bin,L,Ps}, St0) -> + {Segments,St} = pat_bin(Ps, St0), + {#ibinary{anno=#a{anno=lineno_anno(L, St)},segments=Segments},St}; pattern({match,_,P1,P2}, St) -> - {Cp1,Eps1,St1} = pattern(P1,St), - {Cp2,Eps2,St2} = pattern(P2,St1), - {pat_alias(Cp1,Cp2),Eps1++Eps2,St2}; + {Cp1,St1} = pattern(P1, St), + {Cp2,St2} = pattern(P2, St1), + {pat_alias(Cp1, Cp2),St2}; %% Evaluate compile-time expressions. pattern({op,_,'++',{nil,_},R}, St) -> pattern(R, St); @@ -1876,57 +1895,76 @@ pattern({op,_Line,_Op,_L,_R}=Op, St) -> pattern(erl_eval:partial_eval(Op), St). %% pattern_map_pairs([MapFieldExact],State) -> [#c_map_pairs{}] -pattern_map_pairs(Ps, St) -> - %% check literal key uniqueness - %% - guaranteed via aliasing map pairs - %% pattern all pairs in two steps - %% 1) Construct Core Pattern - %% 2) Alias Keys in Core Pattern - {CMapPairs, {Eps,St1}} = lists:mapfoldl(fun - (P,{EpsM,Sti0}) -> - {CMapPair,EpsP,Sti1} = pattern_map_pair(P,Sti0), - {CMapPair, {EpsM++EpsP,Sti1}} - end, {[],St}, Ps), - {pat_alias_map_pairs(CMapPairs),Eps,St1}. +pattern_map_pairs(Ps, St0) -> + {CMapPairs,St1} = mapfoldl(fun pattern_map_pair/2, St0, Ps), + {pat_alias_map_pairs(CMapPairs),St1}. pattern_map_pair({map_field_exact,L,K,V}, St0) -> - {Ck,EpsK,St1} = safe_pattern_expr(K, St0), - {Cv,EpsV,St2} = pattern(V, St1), - {#c_map_pair{anno=lineno_anno(L, St2), - op=#c_literal{val=exact}, - key=Ck, - val=Cv},EpsK++EpsV,St2}. + Ck0 = erl_eval:partial_eval(K), + {Ck,St1} = exprs([Ck0], St0), + {Cv,St2} = pattern(V, St1), + {#imappair{anno=#a{anno=lineno_anno(L, St2)}, + op=#c_literal{val=exact}, + key=Ck, + val=Cv},St2}. pat_alias_map_pairs(Ps) -> - D = foldl(fun(#c_map_pair{key=K0}=Pair, D0) -> - K = cerl:set_ann(K0, []), - dict:append(K, Pair, D0) - end, dict:new(), Ps), - pat_alias_map_pairs_1(dict:to_list(D)). - -pat_alias_map_pairs_1([{_,[#c_map_pair{val=V0}=Pair|Vs]}|T]) -> - V = foldl(fun(#c_map_pair{val=V}, Pat) -> + D0 = foldl(fun(#imappair{key=K0}=Pair, A) -> + K = map_sort_key(K0, A), + case A of + #{K:=Aliases} -> + A#{K:=[Pair|Aliases]}; + #{} -> + A#{K=>[Pair]} + end + end, #{}, Ps), + %% We must sort to ensure that the order remains consistent + %% between compilations. + D = sort(maps:to_list(D0)), + pat_alias_map_pairs_1(D). + +pat_alias_map_pairs_1([{_,[#imappair{val=V0}=Pair|Vs]}|T]) -> + V = foldl(fun(#imappair{val=V}, Pat) -> pat_alias(V, Pat) end, V0, Vs), - [Pair#c_map_pair{val=V}|pat_alias_map_pairs_1(T)]; + [Pair#imappair{val=V}|pat_alias_map_pairs_1(T)]; pat_alias_map_pairs_1([]) -> []. +map_sort_key(Key, KeyMap) -> + case Key of + [#c_literal{}=Lit] -> + {atomic,cerl:set_ann(Lit, [])}; + [#c_var{}=Var] -> + {atomic,cerl:set_ann(Var, [])}; + _ -> + {expr,map_size(KeyMap)} + end. + %% pat_bin([BinElement], State) -> [BinSeg]. -pat_bin(Ps, St) -> [pat_segment(P, St) || P <- bin_expand_strings(Ps)]. +pat_bin(Ps0, St) -> + Ps = bin_expand_strings(Ps0), + pat_segments(Ps, St). + +pat_segments([P0|Ps0], St0) -> + {P,St1} = pat_segment(P0, St0), + {Ps,St2} = pat_segments(Ps0, St1), + {[P|Ps],St2}; +pat_segments([], St) -> {[],St}. pat_segment({bin_element,L,Val,Size0,Type0}, St) -> - {Size,Type1} = make_bit_type(L, Size0, Type0), + {Size1,Type1} = make_bit_type(L, Size0, Type0), [Type,{unit,Unit}|Flags] = Type1, Anno = lineno_anno(L, St), - {Pval0,[],St1} = pattern(Val, St), + {Pval0,St1} = pattern(Val, St), Pval = coerce_to_float(Pval0, Type0), - {Psize,[],_St2} = pattern(Size, St1), - #c_bitstr{anno=Anno, - val=Pval,size=Psize, - unit=#c_literal{val=Unit}, - type=#c_literal{val=Type}, - flags=#c_literal{val=Flags}}. + Size = erl_eval:partial_eval(Size1), + {Psize,St2} = exprs([Size], St1), + {#ibitstr{anno=#a{anno=Anno}, + val=Pval,size=Psize, + unit=#c_literal{val=Unit}, + type=#c_literal{val=Type}, + flags=#c_literal{val=Flags}},St2}. coerce_to_float(#c_literal{val=Int}=E, [float|_]) when is_integer(Int) -> try @@ -1964,8 +2002,8 @@ pat_alias(#c_alias{var=#c_var{name=V1}=Var1,pat=P1}, pat_alias(#c_alias{var=#c_var{}=Var,pat=P1}, P2) -> #c_alias{var=Var,pat=pat_alias(P1, P2)}; -pat_alias(#c_map{es=Es1}=M, #c_map{es=Es2}) -> - M#c_map{es=pat_alias_map_pairs(Es1 ++ Es2)}; +pat_alias(#imap{es=Es1}=M, #imap{es=Es2}) -> + M#imap{es=pat_alias_map_pairs(Es1 ++ Es2)}; pat_alias(P1, #c_var{}=Var) -> #c_alias{var=Var,pat=P1}; @@ -1999,11 +2037,11 @@ pat_alias_list(_, _) -> throw(nomatch). %% pattern_list([P], State) -> {[P],Exprs,St} pattern_list([P0|Ps0], St0) -> - {P1,Eps,St1} = pattern(P0, St0), - {Ps1,Epsl,St2} = pattern_list(Ps0, St1), - {[P1|Ps1], Eps ++ Epsl, St2}; + {P1,St1} = pattern(P0, St0), + {Ps1,St2} = pattern_list(Ps0, St1), + {[P1|Ps1],St2}; pattern_list([], St) -> - {[],[],St}. + {[],St}. string_to_conses(Line, Cs, Tail) -> foldr(fun (C, T) -> {cons,Line,{char,Line,C},T} end, Tail, Cs). @@ -2049,9 +2087,8 @@ new_vars_1(N, Anno, St0, Vs) when N > 0 -> new_vars_1(N-1, Anno, St1, [V|Vs]); new_vars_1(0, _, St, Vs) -> {Vs,St}. -function_clause(Ps, LineAnno, Name) -> - FcAnno = [{function_name,Name}|LineAnno], - fail_clause(Ps, FcAnno, +function_clause(Ps, LineAnno) -> + fail_clause(Ps, LineAnno, ann_c_tuple(LineAnno, [#c_literal{val=function_clause}|Ps])). fail_clause(Pats, Anno, Arg) -> @@ -2065,8 +2102,8 @@ right_assoc({op,L1,Op,{op,L2,Op,E1,E2},E3}, Op) -> right_assoc({op,L2,Op,E1,{op,L1,Op,E2,E3}}, Op); right_assoc(E, _Op) -> E. -annotate_tuple(A, Es, St) -> - case member(dialyzer, St#core.opts) of +annotate_tuple(A, Es, #core{dialyzer=Dialyzer}) -> + case Dialyzer of true -> %% Do not coalesce constant tuple elements. A Hack. Node = cerl:ann_c_tuple(A, [cerl:c_var(any)]), @@ -2075,8 +2112,8 @@ annotate_tuple(A, Es, St) -> ann_c_tuple(A, Es) end. -annotate_cons(A, H, T, St) -> - case member(dialyzer, St#core.opts) of +annotate_cons(A, H, T, #core{dialyzer=Dialyzer}) -> + case Dialyzer of true -> %% Do not coalesce constant conses. A Hack. Node= cerl:ann_c_cons(A, cerl:c_var(any), cerl:c_var(any)), @@ -2157,6 +2194,20 @@ uexprs([#imatch{anno=A,pat=P0,arg=Arg,fc=Fc}|Les], Ks, St0) -> uexprs([#icase{anno=A,args=[Arg], clauses=[Mc],fc=Fc}], Ks, St0) end; +uexprs([#ireceive1{clauses=[]}=Le0|_], Ks, St0) -> + %% All clauses have been optimized away because they had impossible patterns. + %% For example: + %% + %% receive + %% a = b -> + %% V = whatever + %% end, + %% V + %% + %% Discard the unreachable code following the receive to ensure + %% that there are no references to unbound variables. + {Le1,St1} = uexpr(Le0, Ks, St0), + {[Le1],St1}; uexprs([Le0|Les0], Ks, St0) -> {Le1,St1} = uexpr(Le0, Ks, St0), {Les1,St2} = uexprs(Les0, union((get_anno(Le1))#a.ns, Ks), St1), @@ -2210,18 +2261,26 @@ uexpr(#icase{anno=#a{anno=Anno}=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> false -> new_in_all(Cs1) end, {#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3}; -uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}, Ks0, St0) -> +uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}=Fun0, Ks0, St0) -> + {Fun1,St2} = case Ks0 of + [] -> + {Fun0,St0}; + [_|_] -> + {Cs1,St1} = rename_shadowing_clauses(Cs0, Ks0, St0), + {Fun0#ifun{clauses=Cs1},St1} + end, + #ifun{clauses=Cs2} = Fun1, Avs = lit_list_vars(As), Ks1 = case Name of unnamed -> Ks0; {named,FName} -> union(subtract([FName], Avs), Ks0) end, Ks2 = union(Avs, Ks1), - {Cs1,St1} = ufun_clauses(Cs0, Ks2, St0), - {Fc1,St2} = ufun_clause(Fc0, Ks2, St1), - Used = subtract(intersection(used_in_any(Cs1), Ks1), Avs), + {Cs3,St3} = ufun_clauses(Cs2, Ks2, St2), + {Fc1,St4} = ufun_clause(Fc0, Ks2, St3), + Used = subtract(intersection(used_in_any(Cs3), Ks1), Avs), A1 = A0#a{us=Used,ns=[]}, - {#ifun{anno=A1,id=Id,vars=As,clauses=Cs1,fc=Fc1,name=Name},St2}; + {#ifun{anno=A1,id=Id,vars=As,clauses=Cs3,fc=Fc1,name=Name},St4}; uexpr(#iapply{anno=A,op=Op,args=As}, _, St) -> Used = union(lit_vars(Op), lit_list_vars(As)), {#iapply{anno=A#a{us=Used},op=Op,args=As},St}; @@ -2318,20 +2377,17 @@ upattern(#c_cons{hd=H0,tl=T0}=Cons, Ks, St0) -> upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0), {Tuple#c_tuple{es=Es1},Esg,Esv,Eus,St1}; -upattern(#c_map{es=Es0}=Map, Ks, St0) -> +upattern(#imap{es=Es0}=Map, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0), - {Map#c_map{es=Es1},Esg,Esv,Eus,St1}; -upattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,Ks,St0) -> + {Map#imap{es=Es1},Esg,Esv,Eus,St1}; +upattern(#imappair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,Ks,St0) -> {V,Vg,Vn,Vu,St1} = upattern(V0, Ks, St0), - % A variable key must be considered used here - Ku = case K0 of - #c_var{name=Name} -> [Name]; - _ -> [] - end, - {Pair#c_map_pair{val=V},Vg,Vn,union(Ku,Vu),St1}; -upattern(#c_binary{segments=Es0}=Bin, Ks, St0) -> + {K,St2} = uexprs(K0, Ks, St1), + Ku = used_in_expr(K), + {Pair#imappair{key=K,val=V},Vg,Vn,union(Ku, Vu),St2}; +upattern(#ibinary{segments=Es0}=Bin, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0), - {Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1}; + {Bin#ibinary{segments=Es1},Esg,Esv,Eus,St1}; upattern(#c_alias{var=V0,pat=P0}=Alias, Ks, St0) -> {V1,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0), {P1,Pg,Pv,Pu,St2} = upattern(P0, union(Vv, Ks), St1), @@ -2377,7 +2433,7 @@ upat_bin([], _, _, St) -> {[],[],[],[],St}. %% upat_element(Segment, [KnownVar], [LocalVar], State) -> %% {Segment,[GuardTest],[NewVar],[UsedVar],[LocalVar],State} -upat_element(#c_bitstr{val=H0,size=Sz0}=Seg, Ks, Bs0, St0) -> +upat_element(#ibitstr{val=H0,size=Sz0}=Seg, Ks, Bs0, St0) -> {H1,Hg,Hv,[],St1} = upattern(H0, Ks, St0), Bs1 = case H0 of #c_var{name=Hname} -> @@ -2390,13 +2446,22 @@ upat_element(#c_bitstr{val=H0,size=Sz0}=Seg, Ks, Bs0, St0) -> _ -> Bs0 end, - {Sz1,Us} = case Sz0 of - #c_var{name=Vname} -> - rename_bitstr_size(Vname, Bs0); - _Other -> - {Sz0,[]} - end, - {Seg#c_bitstr{val=H1,size=Sz1},Hg,Hv,Us,Bs1,St1}. + case Sz0 of + [#c_var{name=Vname}] -> + {Sz1,Us} = rename_bitstr_size(Vname, Bs0), + {Sz2,St2} = uexprs([Sz1], Ks, St1), + {Seg#ibitstr{val=H1,size=Sz2},Hg,Hv,Us,Bs1,St2}; + [#c_literal{}] -> + {Sz1,St2} = uexprs(Sz0, Ks, St1), + Us = [], + {Seg#ibitstr{val=H1,size=Sz1},Hg,Hv,Us,Bs1,St2}; + Expr when is_list(Expr) -> + Sz1 = [#iset{var=#c_var{name=Old},arg=#c_var{name=New}} || + {Old,New} <- Bs0] ++ Expr, + {Sz2,St2} = uexprs(Sz1, Ks, St1), + Us = used_in_expr(Sz2), + {Seg#ibitstr{val=H1,size=Sz2},Hg,Hv,Us,Bs1,St2} + end. rename_bitstr_size(V, [{V,N}|_]) -> New = #c_var{name=N}, @@ -2406,7 +2471,13 @@ rename_bitstr_size(V, [_|Rest]) -> rename_bitstr_size(V, []) -> Old = #c_var{name=V}, {Old,[V]}. - + +used_in_expr([Le|Les]) -> + #a{us=Us,ns=Ns} = get_anno(Le), + Used = used_in_expr(Les), + union(Us, subtract(Used, Ns)); +used_in_expr([]) -> []. + used_in_any(Les) -> foldl(fun (Le, Ns) -> union((get_anno(Le))#a.us, Ns) end, [], Les). @@ -2420,6 +2491,114 @@ new_in_all([Le|Les]) -> (get_anno(Le))#a.ns, Les); new_in_all([]) -> []. +%%% +%%% Rename shadowing variables in fun heads. +%%% +%%% Pattern variables in fun heads always shadow variables bound in +%%% the enclosing environment. Because that is the way that variables +%%% behave in Core Erlang, there was previously no need to rename +%%% the variables. +%%% +%%% However, to support splitting of patterns and/or pattern matching +%%% compilation in Core Erlang, there is a need to rename all +%%% shadowing variables to avoid changing the semantics of the Erlang +%%% program. +%%% + +rename_shadowing_clauses([C0|Cs0], Ks, St0) -> + {C,St1} = rename_shadowing_clause(C0, Ks, St0), + {Cs,St} = rename_shadowing_clauses(Cs0, Ks, St1), + {[C|Cs],St}; +rename_shadowing_clauses([], _Ks, St) -> + {[],St}. + +rename_shadowing_clause(#iclause{pats=Ps0,guard=G0,body=B0}=C, Ks, St0) -> + Subs = {[],[]}, + {Ps,{_Isub,Osub},St} = ren_pats(Ps0, Ks, Subs, St0), + G = case G0 of + [] -> G0; + [_|_] -> Osub ++ G0 + end, + B = Osub ++ B0, + {C#iclause{pats=Ps,guard=G,body=B},St}. + +ren_pats([P0|Ps0], Ks, {_,_}=Subs0, St0) -> + {P,Subs1,St1} = ren_pat(P0, Ks, Subs0, St0), + {Ps,Subs,St} = ren_pats(Ps0, Ks, Subs1, St1), + {[P|Ps],Subs,St}; +ren_pats([], _Ks, {_,_}=Subs, St) -> + {[],Subs,St}. + +ren_pat(#c_var{name='_'}=P, _Ks, Subs, St) -> + {P,Subs,St}; +ren_pat(#c_var{name=V}=Old, Ks, {Isub0,Osub0}=Subs, St0) -> + case member(V, Ks) of + true -> + case ren_is_subst(V, Osub0) of + {yes,New} -> + {New,Subs,St0}; + no -> + {New,St} = new_var(St0), + Osub = [#iset{var=Old,arg=New}|Osub0], + {New,{Isub0,Osub},St} + end; + false -> + {Old,Subs,St0} + end; +ren_pat(#c_literal{}=P, _Ks, {_,_}=Subs, St) -> + {P,Subs,St}; +ren_pat(#c_alias{var=Var0,pat=Pat0}=Alias, Ks, {_,_}=Subs0, St0) -> + {Var,Subs1,St1} = ren_pat(Var0, Ks, Subs0, St0), + {Pat,Subs,St} = ren_pat(Pat0, Ks, Subs1, St1), + {Alias#c_alias{var=Var,pat=Pat},Subs,St}; +ren_pat(#imap{es=Es0}=Map, Ks, {_,_}=Subs0, St0) -> + {Es,Subs,St} = ren_pat_map(Es0, Ks, Subs0, St0), + {Map#imap{es=Es},Subs,St}; +ren_pat(#ibinary{segments=Es0}=P, Ks, {Isub,Osub0}, St0) -> + {Es,_Isub,Osub,St} = ren_pat_bin(Es0, Ks, Isub, Osub0, St0), + {P#ibinary{segments=Es},{Isub,Osub},St}; +ren_pat(P, Ks0, {_,_}=Subs0, St0) -> + Es0 = cerl:data_es(P), + {Es,Subs,St} = ren_pats(Es0, Ks0, Subs0, St0), + {cerl:make_data(cerl:data_type(P), Es),Subs,St}. + +ren_pat_bin([#ibitstr{val=Val0,size=Sz0}=E|Es0], Ks, Isub0, Osub0, St0) -> + Sz = ren_get_subst(Sz0, Isub0), + {Val,{_,Osub1},St1} = ren_pat(Val0, Ks, {Isub0,Osub0}, St0), + Isub1 = case Val0 of + #c_var{} -> + [#iset{var=Val0,arg=Val}|Isub0]; + _ -> + Isub0 + end, + {Es,Isub,Osub,St} = ren_pat_bin(Es0, Ks, Isub1, Osub1, St1), + {[E#ibitstr{val=Val,size=Sz}|Es],Isub,Osub,St}; +ren_pat_bin([], _Ks, Isub, Osub, St) -> + {[],Isub,Osub,St}. + +ren_pat_map([#imappair{val=Val0}=MapPair|Es0], Ks, Subs0, St0) -> + {Val,Subs1,St1} = ren_pat(Val0, Ks, Subs0, St0), + {Es,Subs,St} = ren_pat_map(Es0, Ks, Subs1, St1), + {[MapPair#imappair{val=Val}|Es],Subs,St}; +ren_pat_map([], _Ks, Subs, St) -> + {[],Subs,St}. + +ren_get_subst([#c_var{name=V}]=Old, Sub) -> + case ren_is_subst(V, Sub) of + no -> Old; + {yes,New} -> [New] + end; +ren_get_subst([#c_literal{}]=Old, _Sub) -> + Old; +ren_get_subst(Expr, Sub) when is_list(Expr) -> + Sub ++ Expr. + +ren_is_subst(V, [#iset{var=#c_var{name=V},arg=Arg}|_]) -> + {yes,Arg}; +ren_is_subst(V, [_|Sub]) -> + ren_is_subst(V, Sub); +ren_is_subst(_V, []) -> no. + %% The AfterVars are the variables which are used afterwards. We need %% this to work out which variables are actually exported and used %% from case/receive. In subblocks/clauses the AfterVars of the block @@ -2432,7 +2611,8 @@ cbody(B0, St0) -> %% cclause(Lclause, [AfterVar], State) -> {Cclause,State}. %% The AfterVars are the exported variables. -cclause(#iclause{anno=#a{anno=Anno},pats=Ps,guard=G0,body=B0}, Exp, St0) -> +cclause(#iclause{anno=#a{anno=Anno},pats=Ps0,guard=G0,body=B0}, Exp, St0) -> + Ps = cpattern_list(Ps0), {B1,_Us1,St1} = cexprs(B0, Exp, St0), {G1,St2} = cguard(G0, St1), {#c_clause{anno=Anno,pats=Ps,guard=G1,body=B1},St2}. @@ -2444,7 +2624,36 @@ cguard([], St) -> {#c_literal{val=true},St}; cguard(Gs, St0) -> {G,_,St1} = cexprs(Gs, [], St0), {G,St1}. - + +cpattern_list([P|Ps]) -> + [cpattern(P)|cpattern_list(Ps)]; +cpattern_list([]) -> []. + +cpattern(#c_alias{pat=Pat}=Alias) -> + Alias#c_alias{pat=cpattern(Pat)}; +cpattern(#c_cons{hd=Hd,tl=Tl}=Cons) -> + Cons#c_cons{hd=cpattern(Hd),tl=cpattern(Tl)}; +cpattern(#c_tuple{es=Es}=Tup) -> + Tup#c_tuple{es=cpattern_list(Es)}; +cpattern(#imap{anno=#a{anno=Anno},es=Es}) -> + #c_map{anno=Anno,es=cpat_map_pairs(Es),is_pat=true}; +cpattern(#ibinary{anno=#a{anno=Anno},segments=Segs0}) -> + Segs = [cpat_bin_seg(S) || S <- Segs0], + #c_binary{anno=Anno,segments=Segs}; +cpattern(Other) -> Other. + +cpat_map_pairs([#imappair{anno=#a{anno=Anno},op=Op,key=Key0,val=Val0}|T]) -> + {Key,_,_} = cexprs(Key0, [], #core{}), + Val = cpattern(Val0), + Pair = #c_map_pair{anno=Anno,op=Op,key=Key,val=Val}, + [Pair|cpat_map_pairs(T)]; +cpat_map_pairs([]) -> []. + +cpat_bin_seg(#ibitstr{anno=#a{anno=Anno},val=E,size=Sz0,unit=Unit, + type=Type,flags=Flags}) -> + {Sz,_,_} = cexprs(Sz0, [], #core{}), + #c_bitstr{anno=Anno,val=E,size=Sz,unit=Unit,type=Type,flags=Flags}. + %% cexprs([Lexpr], [AfterVar], State) -> {Cexpr,[AfterVar],State}. %% Must be sneaky here at the last expr when combining exports for the %% whole sequence and exports for that expr. @@ -2625,6 +2834,508 @@ c_call_erl(Fun, Args) -> As = [compiler_generated], cerl:ann_c_call(As, cerl:c_atom(erlang), cerl:c_atom(Fun), Args). +%%% +%%% Lower a `receive` to more primitive operations. Rewrite patterns +%%% that use and bind the same variable as nested cases. +%%% +%%% Here follows an example of how a receive in this Erlang code: +%%% +%%% foo(Timeout) -> +%%% receive +%%% {tag,Msg} -> Msg +%%% after +%%% Timeout -> +%%% no_message +%%% end. +%%% +%%% is translated into Core Erlang: +%%% +%%% 'foo'/1 = +%%% fun (Timeout) -> +%%% ( letrec +%%% 'recv$^0'/0 = +%%% fun () -> +%%% let <PeekSucceeded,Message> = +%%% primop 'recv_peek_message'() +%%% in case PeekSucceeded of +%%% <'true'> when 'true' -> +%%% case Message of +%%% <{'tag',Msg}> when 'true' -> +%%% do primop 'remove_message'() +%%% Msg +%%% ( <Other> when 'true' -> +%%% do primop 'recv_next'() +%%% apply 'recv$^0'/0() +%%% -| ['compiler_generated'] ) +%%% end +%%% <'false'> when 'true' -> +%%% let <TimedOut> = +%%% primop 'recv_wait_timeout'(Timeout) +%%% in case TimedOut of +%%% <'true'> when 'true' -> +%%% do primop 'timeout'() +%%% 'no_message' +%%% <'false'> when 'true' -> +%%% apply 'recv$^0'/0() +%%% end +%%% end +%%% in apply 'recv$^0'/0() +%%% -| ['letrec_goto'] ) + +lbody(B, St) -> + cerl_trees:mapfold(fun lexpr/2, St, B). + +lexpr(#c_case{}=Case, St) -> + %% Split patterns that bind and use the same variable. + split_case(Case, St); +lexpr(#c_receive{clauses=[],timeout=Timeout0,action=Action}, St0) -> + %% Lower a receive with only an after to its primitive operations. + False = #c_literal{val=false}, + True = #c_literal{val=true}, + + {Timeout,Outer0,St1} = + case is_safe(Timeout0) of + true -> + {Timeout0,False,St0}; + false -> + {TimeoutVar,Sti0} = new_var(St0), + OuterLet = #c_let{vars=[TimeoutVar],arg=Timeout0,body=False}, + {TimeoutVar,OuterLet,Sti0} + end, + + MaybeIgnore = case Timeout of + #c_literal{val=infinity} -> [dialyzer_ignore]; + _ -> [] + end, + + {LoopName,St2} = new_fun_name("recv", St1), + LoopFun = #c_var{name={LoopName,0}}, + ApplyLoop = #c_apply{anno=[dialyzer_ignore],op=LoopFun,args=[]}, + + TimeoutCs = [#c_clause{anno=MaybeIgnore,pats=[True],guard=True, + body=#c_seq{arg=primop(timeout), + body=Action}}, + #c_clause{anno=[compiler_generated,dialyzer_ignore], + pats=[False],guard=True, + body=ApplyLoop}], + {TimeoutBool,St3} = new_var(St2), + TimeoutCase = #c_case{anno=[receive_timeout],arg=TimeoutBool, + clauses=TimeoutCs}, + TimeoutLet = #c_let{vars=[TimeoutBool], + arg=primop(recv_wait_timeout, [Timeout]), + body=TimeoutCase}, + + Fun = #c_fun{vars=[],body=TimeoutLet}, + + Letrec = #c_letrec{anno=[letrec_goto], + defs=[{LoopFun,Fun}], + body=ApplyLoop}, + + %% If the 'after' expression is unsafe we evaluate it in an outer 'let'. + Outer = case Outer0 of + #c_let{} -> Outer0#c_let{body=Letrec}; + _ -> Letrec + end, + {Outer,St3}; +lexpr(#c_receive{anno=RecvAnno,clauses=Cs0,timeout=Timeout0,action=Action}, St0) -> + %% Lower receive to its primitive operations. + False = #c_literal{val=false}, + True = #c_literal{val=true}, + + {Timeout,Outer0,St1} = + case is_safe(Timeout0) of + true -> + {Timeout0,False,St0}; + false -> + {TimeoutVar,Sti0} = new_var(St0), + OuterLet = #c_let{vars=[TimeoutVar],arg=Timeout0,body=False}, + {TimeoutVar,OuterLet,Sti0} + end, + + MaybeIgnore = case Timeout of + #c_literal{val=infinity} -> [dialyzer_ignore]; + _ -> [] + end, + + {LoopName,St2} = new_fun_name("recv", St1), + LoopFun = #c_var{name={LoopName,0}}, + ApplyLoop = #c_apply{anno=[dialyzer_ignore],op=LoopFun,args=[]}, + + Cs1 = rewrite_cs(Cs0), + RecvNext = #c_seq{arg=primop(recv_next), + body=ApplyLoop}, + RecvNextC = #c_clause{anno=[compiler_generated,dialyzer_ignore], + pats=[#c_var{name='Other'}],guard=True,body=RecvNext}, + Cs = Cs1 ++ [RecvNextC], + {Msg,St3} = new_var(St2), + {MsgCase,St4} = split_case(#c_case{anno=RecvAnno,arg=Msg,clauses=Cs}, St3), + + TimeoutCs = [#c_clause{pats=[True],guard=True, + body=#c_seq{arg=primop(timeout), + body=Action}}, + #c_clause{anno=[dialyzer_ignore],pats=[False],guard=True, + body=ApplyLoop}], + {TimeoutBool,St5} = new_var(St4), + TimeoutCase = #c_case{arg=TimeoutBool,clauses=TimeoutCs}, + TimeoutLet = #c_let{vars=[TimeoutBool], + arg=primop(recv_wait_timeout, [Timeout]), + body=TimeoutCase}, + + {PeekSucceeded,St6} = new_var(St5), + PeekCs = [#c_clause{pats=[True],guard=True, + body=MsgCase}, + #c_clause{anno=MaybeIgnore, + pats=[False],guard=True, + body=TimeoutLet}], + PeekCase = #c_case{arg=PeekSucceeded,clauses=PeekCs}, + PeekLet = #c_let{vars=[PeekSucceeded,Msg], + arg=primop(recv_peek_message), + body=PeekCase}, + Fun = #c_fun{vars=[],body=PeekLet}, + + Letrec = #c_letrec{anno=[letrec_goto], + defs=[{LoopFun,Fun}], + body=ApplyLoop}, + + %% If the 'after' expression is unsafe we evaluate it in an outer 'let'. + Outer = case Outer0 of + #c_let{} -> Outer0#c_let{body=Letrec}; + _ -> Letrec + end, + {Outer,St6}; +lexpr(Tree, St) -> + {Tree,St}. + +rewrite_cs([#c_clause{body=B0}=C|Cs]) -> + B = #c_seq{arg=primop(remove_message),body=B0}, + [C#c_clause{body=B}|rewrite_cs(Cs)]; +rewrite_cs([]) -> []. + +primop(Name) -> + primop(Name, []). + +primop(Name, Args) -> + #c_primop{name=#c_literal{val=Name},args=Args}. + +%%% +%%% Split patterns such as <<Size:32,Tail:Size>> that bind +%%% and use a variable in the same pattern. Rewrite to a +%%% nested case in a letrec. +%%% + +split_case(#c_case{anno=CaseAnno,arg=Arg,clauses=Cs0}=Case0, St0) -> + Args = case Arg of + #c_values{es=Es} -> Es; + _ -> [Arg] + end, + {VarArgs,St1} = split_var_args(Args, St0), + case split_clauses(Cs0, VarArgs, CaseAnno, St1) of + none -> + {Case0,St0}; + {PreCase,AftCs,St2} -> + AftCase = Case0#c_case{arg=core_lib:make_values(VarArgs), + clauses=AftCs}, + AftFun = #c_fun{vars=[],body=AftCase}, + {Letrec,St3} = split_case_letrec(AftFun, PreCase, St2), + Body = split_letify(VarArgs, Args, Letrec, [], []), + {Body,St3} + end. + +split_var_args(Args, St) -> + mapfoldl(fun(#c_var{}=Var, S0) -> + {Var,S0}; + (#c_literal{}=Lit, S0) -> + {Lit,S0}; + (_, S0) -> + new_var(S0) + end, St, Args). + +split_letify([Same|Vs], [Same|Args], Body, VsAcc, ArgAcc) -> + split_letify(Vs, Args, Body, VsAcc, ArgAcc); +split_letify([V|Vs], [Arg|Args], Body, VsAcc, ArgAcc) -> + split_letify(Vs, Args, Body, [V|VsAcc], [Arg|ArgAcc]); +split_letify([], [], Body, [], []) -> + Body; +split_letify([], [], Body, [_|_]=VsAcc, [_|_]=ArgAcc) -> + #c_let{vars=reverse(VsAcc), + arg=core_lib:make_values(reverse(ArgAcc)), + body=Body}. + +split_case_letrec(#c_fun{anno=FunAnno0}=Fun0, Body, #core{gcount=C}=St0) -> + FunAnno = [compiler_generated|FunAnno0], + Fun = Fun0#c_fun{anno=FunAnno}, + Anno = [letrec_goto], + DefFunName = goto_func(C), + Letrec = #c_letrec{anno=Anno,defs=[{#c_var{name=DefFunName},Fun}],body=Body}, + St = St0#core{gcount=C+1}, + lbody(Letrec, St). + +split_clauses([C0|Cs0], Args, CaseAnno, St0) -> + case split_clauses(Cs0, Args, CaseAnno, St0) of + none -> + case split_clause(C0, St0) of + none -> + none; + {Ps,Nested,St1} -> + {Case,St2} = split_reconstruct(Args, Ps, Nested, + C0, CaseAnno, St1), + {Case,Cs0,St2} + end; + {Case0,Cs,St} -> + #c_case{clauses=NewClauses} = Case0, + Case = Case0#c_case{clauses=[C0|NewClauses]}, + {Case,Cs,St} + end; +split_clauses([], _, _, _) -> + none. + +goto_func(Count) -> + {list_to_atom("label^" ++ integer_to_list(Count)),0}. + +split_reconstruct(Args, Ps, nil, #c_clause{anno=Anno}=C0, CaseAnno, St0) -> + C = C0#c_clause{pats=Ps}, + {Fc,St1} = split_fc_clause(Ps, Anno, St0), + {#c_case{anno=CaseAnno,arg=core_lib:make_values(Args),clauses=[C,Fc]},St1}; +split_reconstruct(Args, Ps, {split,SplitArgs,Pat,Nested}, C, CaseAnno, St) -> + Split = {split,SplitArgs,fun(Body) -> Body end,Pat,Nested}, + split_reconstruct(Args, Ps, Split, C, CaseAnno, St); +split_reconstruct(Args, Ps, {split,SplitArgs,Wrap,Pat,Nested}, + #c_clause{anno=Anno}=C0, CaseAnno, St0) -> + {InnerCase,St1} = split_reconstruct(SplitArgs, [Pat], Nested, C0, + CaseAnno, St0), + {Fc,St2} = split_fc_clause(Args, Anno, St1), + Wrapped = Wrap(InnerCase), + C = C0#c_clause{pats=Ps,guard=#c_literal{val=true},body=Wrapped}, + {#c_case{anno=CaseAnno,arg=core_lib:make_values(Args),clauses=[C,Fc]},St2}. + +split_fc_clause(Args, Anno0, #core{gcount=Count}=St0) -> + Anno = [compiler_generated|Anno0], + Arity = length(Args), + {Vars,St1} = new_vars(Arity, St0), + Op = #c_var{name=goto_func(Count)}, + Apply = #c_apply{anno=Anno,op=Op,args=[]}, + {#c_clause{anno=[dialyzer_ignore|Anno],pats=Vars, + guard=#c_literal{val=true},body=Apply},St1}. + +split_clause(#c_clause{pats=Ps0}, St0) -> + case split_pats(Ps0, St0) of + none -> + none; + {Ps,Case,St} -> + {Ps,Case,St} + end. + +split_pats([P0|Ps0], St0) -> + case split_pats(Ps0, St0) of + none -> + case split_pat(P0, St0) of + none -> + none; + {P,Case,St} -> + {[P|Ps0],Case,St} + end; + {Ps,Case,St} -> + {[P0|Ps],Case,St} + end; +split_pats([], _) -> + none. + +split_pat(#c_binary{segments=Segs0}=Bin, St0) -> + Vars = gb_sets:empty(), + case split_bin_segments(Segs0, Vars, St0, []) of + none -> + none; + {TailVar,Wrap,Bef,Aft,St} -> + BefBin = Bin#c_binary{segments=Bef}, + {BefBin,{split,[TailVar],Wrap,Bin#c_binary{segments=Aft},nil},St} + end; +split_pat(#c_map{es=Es}=Map, St) -> + split_map_pat(Es, Map, St, []); +split_pat(#c_var{}, _) -> + none; +split_pat(#c_alias{pat=Pat}=Alias0, St0) -> + case split_pat(Pat, St0) of + none -> + none; + {Ps,Split,St1} -> + {Var,St} = new_var(St1), + Alias = Alias0#c_alias{pat=Var}, + {Alias,{split,[Var],Ps,Split},St} + end; +split_pat(Data, St0) -> + Type = cerl:data_type(Data), + Es = cerl:data_es(Data), + split_data(Es, Type, St0, []). + +split_map_pat([#c_map_pair{key=Key,val=Val}=E0|Es], Map0, St0, Acc) -> + case eval_map_key(Key, E0, Es, Map0, St0) of + none -> + case split_pat(Val, St0) of + none -> + split_map_pat(Es, Map0, St0, [E0|Acc]); + {Ps,Split,St1} -> + {Var,St} = new_var(St1), + E = E0#c_map_pair{val=Var}, + Map = Map0#c_map{es=reverse(Acc, [E|Es])}, + {Map,{split,[Var],Ps,Split},St} + end; + {MapVar,Split,St1} -> + BefMap0 = Map0#c_map{es=reverse(Acc)}, + BefMap = #c_alias{var=MapVar,pat=BefMap0}, + {BefMap,Split,St1} + end; +split_map_pat([], _, _, _) -> none. + +eval_map_key(#c_var{}, _E, _Es, _Map, _St) -> + none; +eval_map_key(#c_literal{}, _E, _Es, _Map, _St) -> + none; +eval_map_key(Key, E0, Es, Map, St0) -> + {[KeyVar,MapVar],St1} = new_vars(2, St0), + E = E0#c_map_pair{key=KeyVar}, + AftMap0 = Map#c_map{es=[E|Es]}, + {Wrap,CaseArg,AftMap,St2} = wrap_map_key_fun(Key, KeyVar, MapVar, AftMap0, St1), + {MapVar,{split,[CaseArg],Wrap,AftMap,nil},St2}. + +wrap_map_key_fun(Key, KeyVar, MapVar, AftMap, St0) -> + case is_safe(Key) of + true -> + {fun(Body) -> + #c_let{vars=[KeyVar],arg=Key,body=Body} + end,MapVar,AftMap,St0}; + false -> + {[SuccVar|Evars],St} = new_vars(4, St0), + {fun(Body) -> + Try = #c_try{arg=Key,vars=[KeyVar], + body=#c_values{es=[#c_literal{val=true},KeyVar]}, + evars=Evars, + handler=#c_values{es=[#c_literal{val=false}, + #c_literal{val=false}]}}, + #c_let{vars=[SuccVar,KeyVar],arg=Try,body=Body} + end, + #c_tuple{es=[SuccVar,MapVar]}, + #c_tuple{es=[#c_literal{val=true},AftMap]}, + St} + end. + +split_data([E|Es0], Type, St0, Acc) -> + case split_pat(E, St0) of + none -> + split_data(Es0, Type, St0, [E|Acc]); + {Ps,Split,St1} -> + {Var,St} = new_var(St1), + Data = cerl:make_data(Type, reverse(Acc, [Var|Es0])), + {Data,{split,[Var],Ps,Split},St} + end; +split_data([], _, _, _) -> none. + +split_bin_segments([#c_bitstr{val=Val,size=Size}=S0|Segs], Vars0, St0, Acc) -> + Vars = case Val of + #c_var{name=V} -> gb_sets:add(V, Vars0); + _ -> Vars0 + end, + case Size of + #c_literal{} -> + split_bin_segments(Segs, Vars, St0, [S0|Acc]); + #c_var{name=SizeVar} -> + case gb_sets:is_member(SizeVar, Vars0) of + true -> + %% The size variable is variable previously bound + %% in this same segment. Split the clause here to + %% avoid a variable that is both defined and used + %% in the same pattern. + {TailVar,Tail,St} = split_tail_seg(S0, Segs, St0), + Wrap = fun(Body) -> Body end, + {TailVar,Wrap,reverse(Acc, [Tail]),[S0|Segs],St}; + false -> + split_bin_segments(Segs, Vars, St0, [S0|Acc]) + end; + _ -> + %% The size is an expression. Split the clause here, + %% calculate the expression in a try/catch, and finally + %% continue the match in an inner case. + {TailVar,Tail,St1} = split_tail_seg(S0, Segs, St0), + {SizeVar,St2} = new_var(St1), + S = S0#c_bitstr{size=SizeVar}, + {Wrap,St3} = split_wrap(SizeVar, Size, St2), + {TailVar,Wrap,reverse(Acc, [Tail]),[S|Segs],St3} + end; +split_bin_segments(_, _, _, _) -> + none. + +split_tail_seg(#c_bitstr{anno=A}=S, Segs, St0) -> + {TailVar,St} = new_var(St0), + Unit = split_bin_unit([S|Segs], St0), + {TailVar, + #c_bitstr{anno=A,val=TailVar, + size=#c_literal{val=all}, + unit=#c_literal{val=Unit}, + type=#c_literal{val=binary}, + flags=#c_literal{val=[unsigned,big]}}, + St}. + +split_wrap(SizeVar, SizeExpr, St0) -> + {Evars,St1} = new_vars(3, St0), + {fun(Body) -> + Try = #c_try{arg=SizeExpr,vars=[SizeVar],body=SizeVar, + evars=Evars,handler=#c_literal{val=bad_size}}, + #c_let{vars=[SizeVar],arg=Try,body=Body} + end,St1}. + +split_bin_unit(Ss, #core{dialyzer=Dialyzer}) -> + case Dialyzer of + true -> + %% When a binary match has been rewritten to a nested + %% case like this: + %% + %% case Bin of + %% <<Size:32,Tail:Size/bitstring-unit:1>> -> + %% case Tail of + %% <<Result/binary-unit:8>> -> Result; + %% ... + %% end + %% + %% dialyzer will determine the type of Bin based solely on + %% the binary pattern in the outer case. It will not + %% back-propagate any type information for Tail to Bin. For + %% this example, dialyzer would infer the type of Bin to + %% be <<_:8,_:_*1>>. + %% + %% Help dialyzer to infer a better type by calculating the + %% greatest common unit for the segments in the inner case + %% expression. For this example, the greatest common unit + %% for the pattern in the inner case is 8; it will allow + %% dialyzer to infer the type for Bin to be + %% <<_:32,_:_*8>>. + + split_bin_unit_1(Ss, 0); + false -> + %% Return the unit for pattern in the outer case that + %% results in the best code. + + 1 + end. + +split_bin_unit_1([#c_bitstr{type=#c_literal{val=Type},size=Size, + unit=#c_literal{val=U}}|Ss], + GCU) -> + Bits = case {Type,Size} of + {utf8,_} -> 8; + {utf16,_} -> 16; + {utf32,_} -> 32; + {_,#c_literal{val=0}} -> 1; + {_,#c_literal{val=Sz}} when is_integer(Sz) -> Sz * U; + {_,_} -> U + end, + split_bin_unit_1(Ss, gcd(GCU, Bits)); +split_bin_unit_1([], GCU) -> GCU. + +gcd(A, B) -> + case A rem B of + 0 -> B; + X -> gcd(B, X) + end. + %% lit_vars(Literal) -> [Var]. lit_vars(Lit) -> lit_vars(Lit, []). @@ -2649,10 +3360,8 @@ bitstr_vars(Segs, Vs) -> lit_vars(V, lit_vars(S, Vs0)) end, Vs, Segs). -record_anno(L, St) -> - case - erl_anno:record(L) andalso member(dialyzer, St#core.opts) - of +record_anno(L, #core{dialyzer=Dialyzer}=St) -> + case erl_anno:record(L) andalso Dialyzer of true -> [record | lineno_anno(L, St)]; false -> diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index bcdc59699b..733acf7a46 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -29,11 +29,7 @@ %% %% 3. Pattern matching (in cases and receives) has been compiled. %% -%% 4. The annotations contain variable usages. Seeing we have to work -%% this out anyway for funs we might as well pass it on for free to -%% later passes. -%% -%% 5. All remote-calls are to statically named m:f/a. Meta-calls are +%% 4. All remote-calls are to statically named m:f/a. Meta-calls are %% passed via erlang:apply/3. %% %% The translation is done in two passes: @@ -81,13 +77,17 @@ -export([module/2,format_error/1]). --import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, - keyfind/3,partition/2,droplast/1,last/1,sort/1,reverse/1]). --import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). --import(cerl, [c_tuple/1]). +-import(lists, [all/2,droplast/1,flatten/1,foldl/3,foldr/3, + map/2,mapfoldl/3,member/2, + keyfind/3,keyreplace/4, + last/1,partition/2,reverse/1, + sort/1,sort/2,splitwith/2]). +-import(ordsets, [add_element/2,intersection/2, + subtract/2,union/2,union/1]). -include("core_parse.hrl"). -include("v3_kernel.hrl"). +-define(EXPAND_MAX_SIZE_SEGMENT, 1024). %% These are not defined in v3_kernel.hrl. get_kanno(Kthing) -> element(2, Kthing). @@ -105,33 +105,34 @@ copy_anno(Kdst, Ksrc) -> -record(iletrec, {anno=[],defs}). -record(ialias, {anno=[],vars,pat}). -record(iclause, {anno=[],isub,osub,pats,guard,body}). --record(ireceive_accept, {anno=[],arg}). --record(ireceive_next, {anno=[],arg}). --record(ignored, {anno=[]}). -type warning() :: term(). % XXX: REFINE %% State record for kernel translator. -record(kern, {func, %Current host function - ff, %Current function + fargs=[] :: [#k_var{}], %Arguments for current function vcount=0, %Variable counter fcount=0, %Fun counter ds=cerl_sets:new() :: cerl_sets:set(), %Defined variables funs=[], %Fun functions free=#{}, %Free variables ws=[] :: [warning()], %Warnings. - guard_refc=0}). %> 0 means in guard + no_shared_fun_wrappers=false :: boolean(), + labels=cerl_sets:new() + }). -spec module(cerl:c_module(), [compile:option()]) -> {'ok', #k_mdef{}, [warning()]}. -module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) -> +module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) -> Kas = attributes(As), Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es), - St0 = #kern{}, + NoSharedFunWrappers = proplists:get_bool(no_shared_fun_wrappers, + Options), + St0 = #kern{no_shared_fun_wrappers=NoSharedFunWrappers}, {Kfs,St} = mapfoldl(fun function/2, St0, Fs), {ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas, - body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}. + body=Kfs ++ St#kern.funs},sort(St#kern.ws)}. attributes([{#c_literal{val=Name},#c_literal{val=Val}}|As]) -> case include_attribute(Name) of @@ -162,11 +163,11 @@ function({#c_var{name={F,Arity}=FA},Body}, St0) -> %% the function. We use integers as variable names to avoid %% filling up the atom table when compiling huge functions. Count = cerl_trees:next_free_variable_name(Body), - St1 = St0#kern{func=FA,ff=undefined,vcount=Count,fcount=0,ds=cerl_sets:new()}, + St1 = St0#kern{func=FA,vcount=Count,fcount=0,ds=cerl_sets:new()}, {#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1), {B1,_,St3} = ubody(B0, return, St2), %%B1 = B0, St3 = St2, %Null second pass - {make_fdef(#k{us=[],ns=[],a=Ab}, F, Arity, Kvs, B1),St3} + {make_fdef(Ab, F, Arity, Kvs, B1),St3} catch Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [F,Arity]), @@ -180,512 +181,27 @@ function({#c_var{name={F,Arity}=FA},Body}, St0) -> body(#c_values{anno=A,es=Ces}, Sub, St0) -> %% Do this here even if only in bodies. {Kes,Pe,St1} = atomic_list(Ces, Sub, St0), - %%{Kes,Pe,St1} = expr_list(Ces, Sub, St0), {#ivalues{anno=A,args=Kes},Pe,St1}; -body(#ireceive_next{anno=A}, _, St) -> - {#k_receive_next{anno=A},[],St}; body(Ce, Sub, St0) -> expr(Ce, Sub, St0). %% guard(Cexpr, Sub, State) -> {Kexpr,State}. %% We handle guards almost as bodies. The only special thing we %% must do is to make the final Kexpr a #k_test{}. -%% Also, we wrap the entire guard in a try/catch which is -%% not strictly needed, but makes sure that every 'bif' instruction -%% will get a proper failure label. guard(G0, Sub, St0) -> - {G1,St1} = wrap_guard(G0, St0), - {Ge0,Pre,St2} = expr(G1, Sub, St1), - {Ge1,St3} = gexpr_test(Ge0, St2), - {Ge,St} = guard_opt(Ge1, St3), + {Ge0,Pre,St1} = expr(G0, Sub, St0), + {Ge,St} = gexpr_test(Ge0, St1), {pre_seq(Pre, Ge),St}. -%% guard_opt(Kexpr, State) -> {Kexpr,State}. -%% Optimize the Kexpr for the guard. Instead of evaluating a boolean -%% expression comparing it to 'true' in a final #k_test{}, -%% replace BIF calls with #k_test{} in the expression. -%% -%% As an example, take the guard: -%% -%% when is_integer(V0), is_atom(V1) -> -%% -%% The unoptimized Kexpr translated to pseudo BEAM assembly -%% code would look like: -%% -%% bif is_integer V0 => Bool0 -%% bif is_atom V1 => Bool1 -%% bif and Bool0 Bool1 => Bool -%% test Bool =:= true else goto Fail -%% ... -%% Fail: -%% ... -%% -%% The optimized code would look like: -%% -%% test is_integer V0 else goto Fail -%% test is_atom V1 else goto Fail -%% ... -%% Fail: -%% ... -%% -%% An 'or' operation is only slightly more complicated: -%% -%% test is_integer V0 else goto NotFailedYet -%% goto Success -%% -%% NotFailedYet: -%% test is_atom V1 else goto Fail -%% -%% Success: -%% ... -%% Fail: -%% ... - -guard_opt(G, St0) -> - {Root,Forest0,St1} = make_forest(G, St0), - {Exprs,Forest,St} = rewrite_bool(Root, Forest0, false, St1), - E = forest_pre_seq(Exprs, Forest), - {G#k_try{arg=E},St}. - -%% rewrite_bool(Kexpr, Forest, Inv, St) -> {[Kexpr],Forest,St}. -%% Rewrite Kexpr to use #k_test{} operations instead of comparison -%% and type test BIFs. -%% -%% If Kexpr is a #k_test{} operation, the call will always -%% succeed. Otherwise, a 'not_possible' exception will be -%% thrown if Kexpr cannot be rewritten. - -rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, - args=[#k_var{}=V,#k_atom{val=true}]}=Test, Forest0, Inv, St0) -> - try rewrite_bool_var(V, Forest0, Inv, St0) of - {_,_,_}=Res -> - Res - catch - throw:not_possible -> - {[Test],Forest0,St0} - end; -rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, - args=[#k_var{}=V,#k_atom{val=false}]}=Test, Forest0, Inv, St0) -> - try rewrite_bool_var(V, Forest0, not Inv, St0) of - {_,_,_}=Res -> - Res - catch - throw:not_possible -> - {[Test],Forest0,St0} - end; -rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, - args=[#k_atom{val=V1},#k_atom{val=V2}]}, Forest0, false, St0) -> - case V1 =:= V2 of - true -> - {[make_test(is_boolean, [#k_atom{val=true}])],Forest0,St0}; - false -> - {[make_failing_test()],Forest0,St0} - end; -rewrite_bool(#k_test{}=Test, Forest, false, St) -> - {[Test],Forest,St}; -rewrite_bool(#k_try{vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false},ret=[]}=Prot, - Forest0, Inv, St0) -> - {Root,Forest1,St1} = make_forest(Prot, Forest0, St0), - {Exprs,Forest2,St} = rewrite_bool(Root, Forest1, Inv, St1), - InnerForest = maps:without(maps:keys(Forest0), Forest2), - Forest = maps:without(maps:keys(InnerForest), Forest2), - E = forest_pre_seq(Exprs, InnerForest), - {[Prot#k_try{arg=E}],Forest,St}; -rewrite_bool(#k_match{body=Body,ret=[]}, Forest, Inv, St) -> - rewrite_match(Body, Forest, Inv, St); -rewrite_bool(Other, Forest, Inv, St) -> - case extract_bif(Other) of - {Name,Args} -> - rewrite_bif(Name, Args, Forest, Inv, St); - error -> - throw(not_possible) - end. - -%% rewrite_bool_var(Var, Forest, Inv, St) -> {[Kexpr],Forest,St}. -%% Rewrite the boolean expression whose key in Forest is -%% given by Var. Throw a 'not_possible' expression if something -%% prevents the rewriting. - -rewrite_bool_var(Arg, Forest0, Inv, St) -> - {Expr,Forest} = forest_take_expr(Arg, Forest0), - rewrite_bool(Expr, Forest, Inv, St). - -%% rewrite_bool_args([Kexpr], Forest, Inv, St) -> {[[Kexpr]],Forest,St}. -%% Rewrite each Kexpr in the list. The input Kexpr should be variables -%% or boolean values. Throw a 'not_possible' expression if something -%% prevents the rewriting. -%% -%% This function is suitable for handling the arguments for both -%% 'and' and 'or'. - -rewrite_bool_args([#k_atom{val=B}=A|Vs], Forest0, false=Inv, St0) when is_boolean(B) -> - {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0), - Bif = make_bif('=:=', [A,#k_atom{val=true}]), - {Exprs,Forest,St} = rewrite_bool(Bif, Forest1, Inv, St1), - {[Exprs|Tail],Forest,St}; -rewrite_bool_args([#k_var{}=Var|Vs], Forest0, false=Inv, St0) -> - {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0), - {Exprs,Forest,St} = - case is_bool_expr(Var, Forest0) of - true -> - rewrite_bool_var(Var, Forest1, Inv, St1); - false -> - Bif = make_bif('=:=', [Var,#k_atom{val=true}]), - rewrite_bool(Bif, Forest1, Inv, St1) - end, - {[Exprs|Tail],Forest,St}; -rewrite_bool_args([_|_], _Forest, _Inv, _St) -> - throw(not_possible); -rewrite_bool_args([], Forest, _Inv, St) -> - {[],Forest,St}. - -%% rewrite_bif(Name, [Kexpr], Forest, Inv, St) -> {[Kexpr],Forest,St}. -%% Rewrite a BIF. Throw a 'not_possible' expression if something -%% prevents the rewriting. - -rewrite_bif('or', Args, Forest, true, St) -> - rewrite_not_args('and', Args, Forest, St); -rewrite_bif('and', Args, Forest, true, St) -> - rewrite_not_args('or', Args, Forest, St); -rewrite_bif('and', [#k_atom{val=Val},Arg], Forest0, Inv, St0) -> - false = Inv, %Assertion. - case Val of - true -> - %% The result only depends on Arg. - rewrite_bool_var(Arg, Forest0, Inv, St0); - _ -> - %% Will fail. There is no need to evalute the expression - %% represented by Arg. Take it out from the forest and - %% discard the expression. - Failing = make_failing_test(), - try rewrite_bool_var(Arg, Forest0, Inv, St0) of - {_,Forest,St} -> - {[Failing],Forest,St} - catch - throw:not_possible -> - try forest_take_expr(Arg, Forest0) of - {_,Forest} -> - {[Failing],Forest,St0} - catch - throw:not_possible -> - %% Arg is probably a variable bound in an - %% outer scope. - {[Failing],Forest0,St0} - end - end - end; -rewrite_bif('and', [Arg,#k_atom{}=Atom], Forest, Inv, St) -> - false = Inv, %Assertion. - rewrite_bif('and', [Atom,Arg], Forest, Inv, St); -rewrite_bif('and', Args, Forest0, Inv, St0) -> - false = Inv, %Assertion. - {[Es1,Es2],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0), - {Es1 ++ Es2,Forest,St}; -rewrite_bif('or', Args, Forest0, Inv, St0) -> - false = Inv, %Assertion. - {[First,Then],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0), - Alt = make_alt(First, Then), - {[Alt],Forest,St}; -rewrite_bif('xor', [_,_], _Forest, _Inv, _St) -> - %% Rewriting 'xor' is not practical. Fortunately, 'xor' is - %% almost never used in practice. - throw(not_possible); -rewrite_bif('not', [Arg], Forest0, Inv, St) -> - {Expr,Forest} = forest_take_expr(Arg, Forest0), - rewrite_bool(Expr, Forest, not Inv, St); -rewrite_bif(Op, Args, Forest, Inv, St) -> - case is_test(Op, Args) of - true -> - rewrite_bool(make_test(Op, Args, Inv), Forest, false, St); - false -> - throw(not_possible) - end. - -rewrite_not_args(Op, [A0,B0], Forest0, St0) -> - {A,Forest1,St1} = rewrite_not_args_1(A0, Forest0, St0), - {B,Forest2,St2} = rewrite_not_args_1(B0, Forest1, St1), - rewrite_bif(Op, [A,B], Forest2, false, St2). - -rewrite_not_args_1(Arg, Forest, St) -> - Not = make_bif('not', [Arg]), - forest_add_expr(Not, Forest, St). - -%% rewrite_match(Kvar, TypeClause, Forest, Inv, St) -> -%% {[Kexpr],Forest,St}. -%% Try to rewrite a #k_match{} originating from an 'andalso' or an 'orelse'. - -rewrite_match(#k_alt{first=First,then=Then}, Forest, Inv, St) -> - case {First,Then} of - {#k_select{var=#k_var{name=V}=Var,types=[TypeClause]},#k_var{name=V}} -> - rewrite_match_1(Var, TypeClause, Forest, Inv, St); - {_,_} -> - throw(not_possible) - end. - -rewrite_match_1(Var, #k_type_clause{values=Cs0}, Forest0, Inv, St0) -> - Cs = sort([{Val,B} || #k_val_clause{val=#k_atom{val=Val},body=B} <- Cs0]), - case Cs of - [{false,False},{true,True}] -> - rewrite_match_2(Var, False, True, Forest0, Inv, St0); - _ -> - throw(not_possible) - end. - -rewrite_match_2(Var, False, #k_atom{val=true}, Forest0, Inv, St0) -> - %% Originates from an 'orelse'. - case False of - #k_atom{val=NotBool} when not is_boolean(NotBool) -> - rewrite_bool(Var, Forest0, Inv, St0); - _ -> - {CodeVar,Forest1,St1} = add_protected_expr(False, Forest0, St0), - rewrite_bif('or', [Var,CodeVar], Forest1, Inv, St1) - end; -rewrite_match_2(Var, #k_atom{val=false}, True, Forest0, Inv, St0) -> - %% Originates from an 'andalso'. - {CodeVar,Forest1,St1} = add_protected_expr(True, Forest0, St0), - rewrite_bif('and', [Var,CodeVar], Forest1, Inv, St1); -rewrite_match_2(_V, _, _, _Forest, _Inv, _St) -> - throw(not_possible). - -%% is_bool_expr(#k_var{}, Forest) -> true|false. -%% Return true if the variable refers to a boolean expression -%% that does not need an explicit '=:= true' test. - -is_bool_expr(V, Forest) -> - case forest_peek_expr(V, Forest) of - error -> - %% Defined outside of the guard. We can't know. - false; - Expr -> - case extract_bif(Expr) of - {Name,Args} -> - is_test(Name, Args) orelse - erl_internal:bool_op(Name, length(Args)); - error -> - %% Not a BIF. Should be possible to rewrite - %% to a boolean. Definitely does not need - %% a '=:= true' test. - true - end - end. - -make_bif(Op, Args) -> - #k_bif{op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=Op}, - arity=length(Args)}, - args=Args}. - -extract_bif(#k_bif{op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=Name}}, - args=Args}) -> - {Name,Args}; -extract_bif(_) -> - error. - -%% make_alt(First, Then) -> KMatch. -%% Make a #k_alt{} within a #k_match{} to implement -%% 'or' or 'orelse'. - -make_alt(First0, Then0) -> - First1 = pre_seq(droplast(First0), last(First0)), - Then1 = pre_seq(droplast(Then0), last(Then0)), - First2 = make_protected(First1), - Then2 = make_protected(Then1), - Body = #ignored{}, - First3 = #k_guard_clause{guard=First2,body=Body}, - Then3 = #k_guard_clause{guard=Then2,body=Body}, - First = #k_guard{clauses=[First3]}, - Then = #k_guard{clauses=[Then3]}, - Alt = #k_alt{first=First,then=Then}, - #k_match{vars=[],body=Alt}. - -add_protected_expr(#k_atom{}=Atom, Forest, St) -> - {Atom,Forest,St}; -add_protected_expr(#k_var{}=Var, Forest, St) -> - {Var,Forest,St}; -add_protected_expr(E0, Forest, St) -> - E = make_protected(E0), - forest_add_expr(E, Forest, St). - -make_protected(#k_try{}=Try) -> - Try; -make_protected(B) -> - #k_try{arg=B,vars=[#k_var{name=''}],body=#k_var{name=''}, - handler=#k_atom{val=false}}. - -make_failing_test() -> - make_test(is_boolean, [#k_atom{val=fail}]). - -make_test(Op, Args) -> - make_test(Op, Args, false). - -make_test(Op, Args, Inv) -> - Remote = #k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=Op}, - arity=length(Args)}, - #k_test{op=Remote,args=Args,inverted=Inv}. - -is_test(Op, Args) -> - A = length(Args), - erl_internal:new_type_test(Op, A) orelse erl_internal:comp_op(Op, A). - -%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}. -%% Build a forest out of Kexpr. RootKexpr is the final expression -%% nested inside Kexpr. - -make_forest(G, St) -> - make_forest_1(G, #{}, 0, St). - -%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}. -%% Add to Forest from Kexpr. RootKexpr is the final expression -%% nested inside Kexpr. - -make_forest(G, Forest0, St) -> - N = forest_next_index(Forest0), - make_forest_1(G, Forest0, N, St). - -make_forest_1(#k_try{arg=B}, Forest, I, St) -> - make_forest_1(B, Forest, I, St); -make_forest_1(#iset{vars=[]}=Iset0, Forest, I, St0) -> - {UnrefVar,St} = new_var(St0), - Iset = Iset0#iset{vars=[UnrefVar]}, - make_forest_1(Iset, Forest, I, St); -make_forest_1(#iset{vars=[#k_var{name=V}],arg=Arg,body=B}, Forest0, I, St) -> - Forest = Forest0#{V => {I,Arg}, {untaken,V} => true}, - make_forest_1(B, Forest, I+1, St); -make_forest_1(Innermost, Forest, _I, St) -> - {Innermost,Forest,St}. - -%% forest_take_expr(Kexpr, Forest) -> {Expr,Forest}. -%% If Kexpr is a variable, take out the expression corresponding -%% to variable in Forest. Expressions that have been taken out -%% of the forest will not be included the Kexpr returned -%% by forest_pre_seq/2. -%% -%% Throw a 'not_possible' exception if Kexpr is not a variable or -%% if the name of the variable is not a key in Forest. - -forest_take_expr(#k_var{name=V}, Forest0) -> - %% v3_core currently always generates guard expressions that can - %% be represented as a tree. Other code generators (such as LFE) - %% could generate guard expressions that can only be represented - %% as a DAG (i.e. some nodes are referenced more than once). To - %% handle DAGs, we must never remove a node from the forest, but - %% just remove the {untaken,V} marker. That will effectively convert - %% the DAG to a tree by duplicating the shared nodes and their - %% descendants. - - case maps:find(V, Forest0) of - {ok,{_,Expr}} -> - Forest = maps:remove({untaken,V}, Forest0), - {Expr,Forest}; - error -> - throw(not_possible) - end; -forest_take_expr(_, _) -> - throw(not_possible). - -%% forest_peek_expr(Kvar, Forest) -> Kexpr | error. -%% Return the expression corresponding to Kvar in Forest or -%% return 'error' if there is a corresponding expression. - -forest_peek_expr(#k_var{name=V}, Forest0) -> - case maps:find(V, Forest0) of - {ok,{_,Expr}} -> Expr; - error -> error - end. - -%% forest_add_expr(Kexpr, Forest, St) -> {Kvar,Forest,St}. -%% Add a new expression to Forest. - -forest_add_expr(Expr, Forest0, St0) -> - {#k_var{name=V}=Var,St} = new_var(St0), - N = forest_next_index(Forest0), - Forest = Forest0#{V => {N,Expr}}, - {Var,Forest,St}. - -forest_next_index(Forest) -> - 1 + lists:max([N || {N,_} <- maps:values(Forest), - is_integer(N)] ++ [0]). - -%% forest_pre_seq([Kexpr], Forest) -> Kexpr. -%% Package the list of Kexprs into a nested Kexpr, prepending all -%% expressions in Forest that have not been taken out using -%% forest_take_expr/2. - -forest_pre_seq(Exprs, Forest) -> - Es0 = [#k_var{name=V} || {untaken,V} <- maps:keys(Forest)], - Es = Es0 ++ Exprs, - Vs = extract_all_vars(Es, Forest, []), - Pre0 = sort([{maps:get(V, Forest),V} || V <- Vs]), - Pre = [#iset{vars=[#k_var{name=V}],arg=A} || - {{_,A},V} <- Pre0], - pre_seq(Pre++droplast(Exprs), last(Exprs)). - -extract_all_vars(Es, Forest, Acc0) -> - case extract_var_list(Es) of - [] -> - Acc0; - [_|_]=Vs0 -> - Vs = [V || V <- Vs0, maps:is_key(V, Forest)], - NewVs = ordsets:subtract(Vs, Acc0), - NewEs = [begin - {_,E} = maps:get(V, Forest), - E - end || V <- NewVs], - Acc = union(NewVs, Acc0), - extract_all_vars(NewEs, Forest, Acc) - end. - -extract_vars(#iset{arg=A,body=B}) -> - union(extract_vars(A), extract_vars(B)); -extract_vars(#k_bif{args=Args}) -> - ordsets:from_list(lit_list_vars(Args)); -extract_vars(#k_call{}) -> - []; -extract_vars(#k_test{args=Args}) -> - ordsets:from_list(lit_list_vars(Args)); -extract_vars(#k_match{body=Body}) -> - extract_vars(Body); -extract_vars(#k_alt{first=First,then=Then}) -> - union(extract_vars(First), extract_vars(Then)); -extract_vars(#k_guard{clauses=Cs}) -> - extract_var_list(Cs); -extract_vars(#k_guard_clause{guard=G}) -> - extract_vars(G); -extract_vars(#k_select{var=Var,types=Types}) -> - union(ordsets:from_list(lit_vars(Var)), - extract_var_list(Types)); -extract_vars(#k_type_clause{values=Values}) -> - extract_var_list(Values); -extract_vars(#k_val_clause{body=Body}) -> - extract_vars(Body); -extract_vars(#k_try{arg=Arg}) -> - extract_vars(Arg); -extract_vars(Lit) -> - ordsets:from_list(lit_vars(Lit)). - -extract_var_list(L) -> - union([extract_vars(E) || E <- L]). - -%% Wrap the entire guard in a try/catch if needed. - -wrap_guard(#c_try{}=Try, St) -> {Try,St}; -wrap_guard(Core, St0) -> - {VarName,St} = new_var_name(St0), - Var = #c_var{name=VarName}, - Try = #c_try{arg=Core,vars=[Var],body=Var,evars=[],handler=#c_literal{val=false}}, - {Try,St}. - %% gexpr_test(Kexpr, State) -> {Kexpr,State}. %% Builds the final boolean test from the last Kexpr in a guard test. %% Must enter try blocks and isets and find the last Kexpr in them. %% This must end in a recognised BEAM test! -gexpr_test(#k_bif{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=F},arity=Ar}=Op, +gexpr_test(#k_bif{anno=A, + op=#k_remote{mod=#k_literal{val=erlang}, + name=#k_literal{val=F},arity=Ar}=Op, args=Kargs}=Ke, St) -> %% Either convert to test if ok, or add test. %% At this stage, erlang:float/1 is not a type test. (It should @@ -696,7 +212,7 @@ gexpr_test(#k_bif{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, false -> gexpr_test_add(Ke, St) %Add equality test end; gexpr_test(#k_try{arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false}}=Try, St0) -> + handler=#k_literal{val=false}}=Try, St0) -> {B,St} = gexpr_test(B0, St0), %%ok = io:fwrite("~w: ~p~n", [?LINE,{B0,B}]), {Try#k_try{arg=B},St}; @@ -706,42 +222,41 @@ gexpr_test(#iset{body=B0}=Iset, St0) -> gexpr_test(Ke, St) -> gexpr_test_add(Ke, St). %Add equality test gexpr_test_add(Ke, St0) -> - Test = #k_remote{mod=#k_atom{val='erlang'}, - name=#k_atom{val='=:='}, + Test = #k_remote{mod=#k_literal{val='erlang'}, + name=#k_literal{val='=:='}, arity=2}, {Ae,Ap,St1} = force_atomic(Ke, St0), {pre_seq(Ap, #k_test{anno=get_kanno(Ke), - op=Test,args=[Ae,#k_atom{val='true'}]}),St1}. + op=Test,args=[Ae,#k_literal{val='true'}]}),St1}. %% expr(Cexpr, Sub, State) -> {Kexpr,[PreKexpr],State}. %% Convert a Core expression, flattening it at the same time. -expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) -> - %% A local in an expression. - %% For now, these are wrapped into a fun by reverse - %% eta-conversion, but really, there should be exactly one - %% such "lambda function" for each escaping local name, - %% instead of one for each occurrence as done now. +expr(#c_var{anno=A0,name={Name,Arity}}=Fname, Sub, St) -> Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} || - V <- integers(1, Arity)], - Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}}, - expr(Fun, Sub, St); + V <- integers(1, Arity)], + case St#kern.no_shared_fun_wrappers of + false -> + %% Generate a (possibly shared) wrapper function for calling + %% this function. + Wrapper0 = ["-fun.",atom_to_list(Name),"/",integer_to_list(Arity),"-"], + Wrapper = list_to_atom(flatten(Wrapper0)), + Id = {id,{0,0,Wrapper}}, + A = keyreplace(id, 1, A0, Id), + Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}}, + expr(Fun, Sub, St); + true -> + %% For backward compatibility with OTP 22 and earlier, + %% use the pre-generated name for the fun wrapper. + %% There will be one wrapper function for each occurrence + %% of `fun F/A`. + Fun = #c_fun{anno=A0,vars=Vs,body=#c_apply{anno=A0,op=Fname,args=Vs}}, + expr(Fun, Sub, St) + end; expr(#c_var{anno=A,name=V}, Sub, St) -> {#k_var{anno=A,name=get_vsub(V, Sub)},[],St}; expr(#c_literal{anno=A,val=V}, _Sub, St) -> - Klit = case V of - [] -> - #k_nil{anno=A}; - V when is_integer(V) -> - #k_int{anno=A,val=V}; - V when is_float(V) -> - #k_float{anno=A,val=V}; - V when is_atom(V) -> - #k_atom{anno=A,val=V}; - _ -> - #k_literal{anno=A,val=V} - end, - {Klit,[],St}; + {#k_literal{anno=A,val=V},[],St}; expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) -> %% Do cons in two steps, first the expressions left to right, then %% any remaining literals right to left. @@ -768,24 +283,12 @@ expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> Error = #c_call{anno=A,module=Erl,name=Name,args=Args}, expr(Error, Sub, St1) end; -expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0, #kern{ff=OldFF,func=Func}=St0) -> - FA = case OldFF of - undefined -> - Func; - _ -> - case lists:keyfind(id, 1, A) of - {id,{_,_,Name}} -> Name; - _ -> - case lists:keyfind(letrec_name, 1, A) of - {letrec_name,Name} -> Name; - _ -> unknown_fun - end - end - end, - {Kvs,Sub1,St1} = pattern_list(Cvs, Sub0, St0#kern{ff=FA}), +expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0, + #kern{fargs=OldFargs}=St0) -> + {Kvs,Sub1,St1} = pattern_list(Cvs, Sub0, St0), %%ok = io:fwrite("~w: ~p~n", [?LINE,{{Cvs,Sub0,St0},{Kvs,Sub1,St1}}]), - {Kb,Pb,St2} = body(Cb, Sub1, St1#kern{ff=FA}), - {#ifun{anno=A,vars=Kvs,body=pre_seq(Pb, Kb)},[],St2#kern{ff=OldFF}}; + {Kb,Pb,St2} = body(Cb, Sub1, St1#kern{fargs=Kvs}), + {#ifun{anno=A,vars=Kvs,body=pre_seq(Pb, Kb)},[],St2#kern{fargs=OldFargs}}; expr(#c_seq{arg=Ca,body=Cb}, Sub, St0) -> {Ka,Pa,St1} = body(Ca, Sub, St0), {Kb,Pb,St2} = body(Cb, Sub, St1), @@ -806,104 +309,42 @@ expr(#c_let{anno=A,vars=Cvs,arg=Ca,body=Cb}, Sub0, St0) -> end, {Kb,Pb,St3} = body(Cb, Sub1, St2), {Kb,Pa ++ Sets ++ Pb,St3}; -expr(#c_letrec{anno=A,defs=Cfs,body=Cb}, Sub0, St0) -> - %% Make new function names and store substitution. - {Fs0,{Sub1,St1}} = - mapfoldl(fun ({#c_var{name={F,Ar}},B0}, {Sub,S0}) -> - {N,St1} = new_fun_name(atom_to_list(F) - ++ "/" ++ - integer_to_list(Ar), - S0), - B = set_kanno(B0, [{letrec_name,N}]), - {{N,B},{set_fsub(F, Ar, N, Sub),St1}} - end, {Sub0,St0}, Cfs), - %% Run translation on functions and body. - {Fs1,St2} = mapfoldl(fun ({N,Fd0}, S1) -> - {Fd1,[],St2} = expr(Fd0, Sub1, S1#kern{ff=N}), - Fd = set_kanno(Fd1, A), - {{N,Fd},St2} - end, St1, Fs0), - {Kb,Pb,St3} = body(Cb, Sub1, St2#kern{ff=St1#kern.ff}), - {Kb,[#iletrec{anno=A,defs=Fs1}|Pb],St3}; +expr(#c_letrec{anno=A,defs=Cfs,body=Cb}, Sub, St) -> + case member(letrec_goto, A) of + true -> + letrec_goto(Cfs, Cb, Sub, St); + false -> + letrec_local_function(A, Cfs, Cb, Sub, St) + end; expr(#c_case{arg=Ca,clauses=Ccs}, Sub, St0) -> {Ka,Pa,St1} = body(Ca, Sub, St0), %This is a body! {Kvs,Pv,St2} = match_vars(Ka, St1), %Must have variables here! {Km,St3} = kmatch(Kvs, Ccs, Sub, St2), - Match = flatten_seq(build_match(Kvs, Km)), + Match = flatten_seq(build_match(Km)), {last(Match),Pa ++ Pv ++ droplast(Match),St3}; -expr(#c_receive{anno=A,clauses=Ccs0,timeout=Ce,action=Ca}, Sub, St0) -> - {Ke,Pe,St1} = atomic(Ce, Sub, St0), %Force this to be atomic! - {Rvar,St2} = new_var(St1), - %% Need to massage accept clauses and add reject clause before matching. - Ccs1 = map(fun (#c_clause{anno=Banno,body=B0}=C) -> - B1 = #c_seq{arg=#ireceive_accept{anno=A},body=B0}, - C#c_clause{anno=Banno,body=B1} - end, Ccs0), - {Mpat,St3} = new_var_name(St2), - Rc = #c_clause{anno=[compiler_generated|A], - pats=[#c_var{name=Mpat}],guard=#c_literal{anno=A,val=true}, - body=#ireceive_next{anno=A}}, - {Km,St4} = kmatch([Rvar], Ccs1 ++ [Rc], Sub, add_var_def(Rvar, St3)), - {Ka,Pa,St5} = body(Ca, Sub, St4), - {#k_receive{anno=A,var=Rvar,body=Km,timeout=Ke,action=pre_seq(Pa, Ka)}, - Pe,St5}; expr(#c_apply{anno=A,op=Cop,args=Cargs}, Sub, St) -> c_apply(A, Cop, Cargs, Sub, St); -expr(#c_call{anno=A,module=#c_literal{val=erlang},name=#c_literal{val=is_record}, - args=[_,Tag,Sz]=Args0}, Sub, St0) -> - {Args,Ap,St} = atomic_list(Args0, Sub, St0), - Remote = #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=is_record},arity=3}, - case {Tag,Sz} of - {#c_literal{val=Atom},#c_literal{val=Int}} - when is_atom(Atom), is_integer(Int) -> - %% Tag and size are literals. Make it a BIF, which will actually - %% be expanded out in a later pass. - {#k_bif{anno=A,op=Remote,args=Args},Ap,St}; - {_,_} -> - %% (Only in bodies.) Make it into an actual call to the BIF. - {#k_call{anno=A,op=Remote,args=Args},Ap,St} - end; expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) -> Ar = length(Cargs), - {Type,St1} = case call_type(M0, F0, Ar) of - error -> - %% Invalid call (e.g. M:42/3). Issue a warning, - %% and let the generated code use the old explict apply. - {old_apply,add_warning(get_line(A), bad_call, A, St0)}; - Type0 -> - {Type0,St0} - end, - - case Type of - old_apply -> + {[M,F|Kargs],Ap,St1} = atomic_list([M0,F0|Cargs], Sub, St0), + Remote = #k_remote{mod=M,name=F,arity=Ar}, + case call_type(M0, F0, Cargs) of + bif -> + {#k_bif{anno=A,op=Remote,args=Kargs},Ap,St1}; + call -> + {#k_call{anno=A,op=Remote,args=Kargs},Ap,St1}; + error -> + %% Invalid call (e.g. M:42/3). Issue a warning, and let + %% the generated code use the old explict apply. + St = add_warning(get_line(A), bad_call, A, St0), Call = #c_call{anno=A, module=#c_literal{val=erlang}, name=#c_literal{val=apply}, args=[M0,F0,cerl:make_list(Cargs)]}, - expr(Call, Sub, St1); - _ -> - {[M1,F1|Kargs],Ap,St} = atomic_list([M0,F0|Cargs], Sub, St1), - Call = case Type of - bif -> - #k_bif{anno=A,op=#k_remote{mod=M1,name=F1,arity=Ar}, - args=Kargs}; - call -> - #k_call{anno=A,op=#k_remote{mod=M1,name=F1,arity=Ar}, - args=Kargs}; - apply -> - #k_call{anno=A,op=#k_remote{mod=M1,name=F1,arity=Ar}, - args=Kargs} - end, - {Call,Ap,St} + expr(Call, Sub, St) end; -expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=Cargs0}, Sub, St0) -> - Cargs = translate_match_fail(Cargs0, Sub, A, St0), - {Kargs,Ap,St} = atomic_list(Cargs, Sub, St0), - Ar = length(Cargs), - Call = #k_call{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, - name=#k_atom{val=error}, - arity=Ar},args=Kargs}, - {Call,Ap,St}; +expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=[Arg]}, Sub, St) -> + translate_match_fail(Arg, Sub, A, St); expr(#c_primop{anno=A,name=#c_literal{val=N},args=Cargs}, Sub, St0) -> {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), Ar = length(Cargs), @@ -921,60 +362,90 @@ expr(#c_try{anno=A,arg=Ca,vars=Cvs,body=Cb,evars=Evs,handler=Ch}, Sub0, St0) -> evars=Kevs,handler=pre_seq(Ph, Kh)},[],St5}; expr(#c_catch{anno=A,body=Cb}, Sub, St0) -> {Kb,Pb,St1} = body(Cb, Sub, St0), - {#k_catch{anno=A,body=pre_seq(Pb, Kb)},[],St1}; -%% Handle internal expressions. -expr(#ireceive_accept{anno=A}, _Sub, St) -> {#k_receive_accept{anno=A},[],St}. - -%% Translate a function_clause exception to a case_clause exception if -%% it has been moved into another function. (A function_clause exception -%% will not work correctly if it is moved into another function, or -%% even if it is invoked not from the top level in the correct function.) -translate_match_fail(Args, Sub, Anno, St) -> - case Args of - [#c_tuple{es=[#c_literal{val=function_clause}|As]}] -> - translate_match_fail_1(Anno, As, Sub, St); - [#c_literal{val=Tuple}] when is_tuple(Tuple) -> - %% The inliner may have created a literal out of - %% the original #c_tuple{}. - case tuple_to_list(Tuple) of - [function_clause|As0] -> - As = [#c_literal{val=E} || E <- As0], - translate_match_fail_1(Anno, As, Sub, St); - _ -> - Args - end; - _ -> - %% Not a function_clause exception. - Args + {#k_catch{anno=A,body=pre_seq(Pb, Kb)},[],St1}. + +%% Implement letrec in the traditional way as a local +%% function for each definition in the letrec. + +letrec_local_function(A, Cfs, Cb, Sub0, St0) -> + %% Make new function names and store substitution. + {Fs0,{Sub1,St1}} = + mapfoldl(fun ({#c_var{name={F,Ar}},B0}, {Sub,S0}) -> + {N,St1} = new_fun_name(atom_to_list(F) + ++ "/" ++ + integer_to_list(Ar), + S0), + B = set_kanno(B0, [{letrec_name,N}]), + {{N,B},{set_fsub(F, Ar, N, Sub),St1}} + end, {Sub0,St0}, Cfs), + %% Run translation on functions and body. + {Fs1,St2} = mapfoldl(fun ({N,Fd0}, S1) -> + {Fd1,[],St2} = expr(Fd0, Sub1, S1), + Fd = set_kanno(Fd1, A), + {{N,Fd},St2} + end, St1, Fs0), + {Kb,Pb,St3} = body(Cb, Sub1, St2), + {Kb,[#iletrec{anno=A,defs=Fs1}|Pb],St3}. + +%% Implement letrec with the single definition as a label and each +%% apply of it as a goto. + +letrec_goto([{#c_var{name={Label,0}},Cfail}], Cb, Sub0, + #kern{labels=Labels0}=St0) -> + Labels = cerl_sets:add_element(Label, Labels0), + {Kb,Pb,St1} = body(Cb, Sub0, St0#kern{labels=Labels}), + #c_fun{body=FailBody} = Cfail, + {Kfail,Fb,St2} = body(FailBody, Sub0, St1), + case {Kb,Kfail,Fb} of + {#k_goto{label=Label},#k_goto{}=InnerGoto,[]} -> + {InnerGoto,Pb,St2}; + {_,_,_} -> + St3 = St2#kern{labels=Labels0}, + Alt = #k_letrec_goto{label=Label,first=Kb,then=pre_seq(Fb, Kfail)}, + {Alt,Pb,St3} end. -translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) -> - AnnoFunc = case keyfind(function_name, 1, Anno) of - false -> - none; %Force rewrite. - {function_name,{Name,Arity}} -> - {get_fsub(Name, Arity, Sub),Arity} - end, - case {AnnoFunc,FF} of - {Same,Same} -> - %% Still in the correct function. - translate_fc(As); - {{F,_},F} -> - %% Still in the correct function. - translate_fc(As); - _ -> - %% Wrong function or no function_name annotation. - %% - %% The inliner has copied the match_fail(function_clause) - %% primop from another function (or from another instance of - %% the current function). match_fail(function_clause) will - %% only work at the top level of the function it was originally - %% defined in, so we will need to rewrite it to a case_clause. - [c_tuple([#c_literal{val=case_clause},c_tuple(As)])] +%% translate_match_fail(Arg, Sub, Anno, St) -> {Kexpr,[PreKexpr],State}. +%% Translate a match_fail primop to a call erlang:error/1 or +%% erlang:error/2. + +translate_match_fail(Arg, Sub, Anno, St0) -> + Cargs = case {cerl:data_type(Arg),cerl:data_es(Arg)} of + {tuple,[#c_literal{val=function_clause}|As]} -> + translate_fc_args(As, Sub, St0); + {_,_} -> + [Arg] + end, + {Kargs,Ap,St} = atomic_list(Cargs, Sub, St0), + Ar = length(Cargs), + Call = #k_call{anno=Anno, + op=#k_remote{mod=#k_literal{val=erlang}, + name=#k_literal{val=error}, + arity=Ar},args=Kargs}, + {Call,Ap,St}. + +translate_fc_args(As, Sub, #kern{fargs=Fargs}) -> + case same_args(As, Fargs, Sub) of + true -> + %% The arguments for the `function_clause` exception are + %% the arguments for the current function in the correct + %% order. + [#c_literal{val=function_clause},cerl:make_list(As)]; + false -> + %% The arguments in the `function_clause` exception don't + %% match the arguments for the current function because + %% of inlining. Keeping the `function_clause` + %% exception reason would be confusing. Rewrite it to + %% a `case_clause` exception with the arguments in a + %% tuple. + [cerl:c_tuple([#c_literal{val=case_clause}, + cerl:c_tuple(As)])] end. -translate_fc(Args) -> - [#c_literal{val=function_clause},cerl:make_list(Args)]. +same_args([#c_var{name=Cv}|Vs], [#k_var{name=Kv}|As], Sub) -> + get_vsub(Cv, Sub) =:= Kv andalso same_args(Vs, As, Sub); +same_args([], [], _Sub) -> true; +same_args(_, _, _) -> false. expr_map(A,Var0,Ces,Sub,St0) -> {Var,Mps,St1} = expr(Var0, Sub, St0), @@ -1031,45 +502,43 @@ map_group_pairs(A, Var, Pairs0, Esp, St0) -> end. map_remove_dup_keys(Es) -> - dict:to_list(map_remove_dup_keys(Es, dict:new())). + map_remove_dup_keys(Es, #{}). -map_remove_dup_keys([{assoc,K0,V}|Es0],Used0) -> +map_remove_dup_keys([{assoc,K0,V}|Es0], Used0) -> K = map_key_clean(K0), - Op = case dict:find(K, Used0) of - {ok,{exact,_,_}} -> exact; - _ -> assoc - end, - Used1 = dict:store(K, {Op,K0,V}, Used0), + Op = case Used0 of + #{K:={exact,_,_}} -> exact; + #{} -> assoc + end, + Used1 = Used0#{K=>{Op,K0,V}}, map_remove_dup_keys(Es0, Used1); -map_remove_dup_keys([{exact,K0,V}|Es0],Used0) -> +map_remove_dup_keys([{exact,K0,V}|Es0], Used0) -> K = map_key_clean(K0), - Op = case dict:find(K, Used0) of - {ok,{assoc,_,_}} -> assoc; - _ -> exact - end, - Used1 = dict:store(K, {Op,K0,V}, Used0), + Op = case Used0 of + #{K:={assoc,_,_}} -> assoc; + #{} -> exact + end, + Used1 = Used0#{K=>{Op,K0,V}}, map_remove_dup_keys(Es0, Used1); -map_remove_dup_keys([], Used) -> Used. +map_remove_dup_keys([], Used) -> + %% We must sort the map entries to ensure consistent + %% order from compilation to compilation. + sort(maps:to_list(Used)). -%% Be explicit instead of using set_kanno(K, []). +%% Clean a map key from annotations. map_key_clean(#k_var{name=V}) -> {var,V}; -map_key_clean(#k_literal{val=V}) -> {lit,V}; -map_key_clean(#k_int{val=V}) -> {lit,V}; -map_key_clean(#k_float{val=V}) -> {lit,V}; -map_key_clean(#k_atom{val=V}) -> {lit,V}; -map_key_clean(#k_nil{}) -> {lit,[]}. - +map_key_clean(#k_literal{val=V}) -> {lit,V}. -%% call_type(Module, Function, Arity) -> call | bif | apply | error. +%% call_type(Module, Function, Arity) -> call | bif | error. %% Classify the call. -call_type(#c_literal{val=M}, #c_literal{val=F}, Ar) when is_atom(M), is_atom(F) -> - case is_remote_bif(M, F, Ar) of +call_type(#c_literal{val=M}, #c_literal{val=F}, As) when is_atom(M), is_atom(F) -> + case is_remote_bif(M, F, As) of false -> call; true -> bif end; -call_type(#c_var{}, #c_literal{val=A}, _) when is_atom(A) -> apply; -call_type(#c_literal{val=A}, #c_var{}, _) when is_atom(A) -> apply; -call_type(#c_var{}, #c_var{}, _) -> apply; +call_type(#c_var{}, #c_literal{val=A}, _) when is_atom(A) -> call; +call_type(#c_literal{val=A}, #c_var{}, _) when is_atom(A) -> call; +call_type(#c_var{}, #c_var{}, _) -> call; call_type(_, _, _) -> error. %% match_vars(Kexpr, State) -> {[Kvar],[PreKexpr],State}. @@ -1085,13 +554,19 @@ match_vars(Ka, St0) -> {[V],Vp,St1}. %% c_apply(A, Op, [Carg], Sub, State) -> {Kexpr,[PreKexpr],State}. -%% Transform application, detect which are guaranteed to be bifs. +%% Transform application. -c_apply(A, #c_var{anno=Ra,name={F0,Ar}}, Cargs, Sub, St0) -> - {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), - F1 = get_fsub(F0, Ar, Sub), %Has it been rewritten - {#k_call{anno=A,op=#k_local{anno=Ra,name=F1,arity=Ar},args=Kargs}, - Ap,St1}; +c_apply(A, #c_var{anno=Ra,name={F0,Ar}}, Cargs, Sub, #kern{labels=Labels}=St0) -> + case Ar =:= 0 andalso cerl_sets:is_element(F0, Labels) of + true -> + %% This is a goto to a label in a letrec_goto construct. + {#k_goto{label=F0},[],St0}; + false -> + {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), + F1 = get_fsub(F0, Ar, Sub), %Has it been rewritten + {#k_call{anno=A,op=#k_local{anno=Ra,name=F1,arity=Ar},args=Kargs}, + Ap,St1} + end; c_apply(A, Cop, Cargs, Sub, St0) -> {Kop,Op,St1} = variable(Cop, Sub, St0), {Kargs,Ap,St2} = atomic_list(Cargs, Sub, St1), @@ -1125,12 +600,6 @@ force_atomic(Ke, St0) -> {V,[#iset{vars=[V],arg=Ke}],St1} end. -% force_atomic_list(Kes, St) -> -% foldr(fun (Ka, {As,Asp,St0}) -> -% {A,Ap,St1} = force_atomic(Ka, St0), -% {[A|As],Ap ++ Asp,St1} -% end, {[],[],St}, Kes). - atomic_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U0,type=T,flags=Fs0}|Es0], Sub, St0) -> {E,Ap1,St1} = atomic(E0, Sub, St0), @@ -1148,11 +617,14 @@ atomic_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U0,type=T,flags=Fs0}|Es0], atomic_bin([], _Sub, St) -> {#k_bin_end{},[],St}. validate_bin_element_size(#k_var{}) -> ok; -validate_bin_element_size(#k_int{val=V}) when V >= 0 -> ok; -validate_bin_element_size(#k_atom{val=all}) -> ok; -validate_bin_element_size(#k_atom{val=undefined}) -> ok; -validate_bin_element_size(_) -> throw(bad_element_size). - +validate_bin_element_size(#k_literal{val=Val}) -> + case Val of + all -> ok; + undefined -> ok; + _ when is_integer(Val), Val >= 0 -> ok; + _ -> throw(bad_element_size) + end. + %% atomic_list([Cexpr], Sub, State) -> {[Kexpr],[PreKexpr],State}. atomic_list(Ces, Sub, St) -> @@ -1162,15 +634,11 @@ atomic_list(Ces, Sub, St) -> end, {[],[],St}, Ces). %% is_atomic(Kexpr) -> boolean(). -%% Is a Kexpr atomic? Strings are NOT considered atomic! +%% Is a Kexpr atomic? is_atomic(#k_literal{}) -> true; -is_atomic(#k_int{}) -> true; -is_atomic(#k_float{}) -> true; -is_atomic(#k_atom{}) -> true; -%%is_atomic(#k_char{}) -> true; %No characters -is_atomic(#k_nil{}) -> true; is_atomic(#k_var{}) -> true; +%%is_atomic(#k_char{}) -> true; %No characters is_atomic(_) -> false. %% variable(Cexpr, Sub, State) -> {Kvar,[PreKexpr],State}. @@ -1234,7 +702,7 @@ flatten_alias(Pat) -> {[],Pat}. pattern_map_pairs(Ces0, Isub, Osub0, St0) -> %% pattern the pair keys and values as normal - {Kes,{Osub1,St1}} = lists:mapfoldl(fun + {Kes,{Osub1,St1}} = mapfoldl(fun (#c_map_pair{anno=A,key=Ck,val=Cv},{Osubi0,Sti0}) -> {Kk,[],Sti1} = expr(Ck, Isub, Sti0), {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi0, Sti1), @@ -1242,7 +710,7 @@ pattern_map_pairs(Ces0, Isub, Osub0, St0) -> end, {Osub0, St0}, Ces0), %% It is later assumed that these keys are term sorted %% so we need to sort them here - Kes1 = lists:sort(fun + Kes1 = sort(fun (#k_map_pair{key=KkA},#k_map_pair{key=KkB}) -> A = map_key_clean(KkA), B = map_key_clean(KkB), @@ -1250,41 +718,84 @@ pattern_map_pairs(Ces0, Isub, Osub0, St0) -> end, Kes), {Kes1,Osub1,St1}. -pattern_bin(Es, Isub, Osub0, St0) -> - {Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0), - {Kbin,Osub,St}. +pattern_bin(Es, Isub, Osub0, St) -> + pattern_bin_1(Es, Isub, Osub0, St). -pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0], - Isub0, Osub0, St0) -> - {S1,[],St1} = expr(S0, Isub0, St0), +pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U0,type=T,flags=Fs0}|Es0], + Isub, Osub0, St0) -> + {S1,[],St1} = expr(S0, Isub, St0), S = case S1 of - #k_int{} -> S1; #k_var{} -> S1; - #k_atom{} -> S1; + #k_literal{val=Val} when is_integer(Val); is_atom(Val) -> S1; _ -> %% Bad size (coming from an optimization or Core Erlang %% source code) - replace it with a known atom because %% a literal or bit syntax construction can cause further %% problems. - #k_atom{val=bad_size} + #k_literal{val=bad_size} end, - U0 = cerl:concrete(U), - Fs0 = cerl:concrete(Fs), - %%ok= io:fwrite("~w: ~p~n", [?LINE,{B0,S,U0,Fs0}]), - {E,Osub1,St2} = pattern(E0, Isub0, Osub0, St1), - Isub1 = case E0 of - #c_var{name=V} -> - set_vsub(V, E#k_var.name, Isub0); - _ -> Isub0 - end, - {Es,{Isub,Osub},St3} = pattern_bin_1(Es0, Isub1, Osub1, St2), - {#k_bin_seg{anno=A,size=S, - unit=U0, - type=cerl:concrete(T), - flags=Fs0, - seg=E,next=Es}, - {Isub,Osub},St3}; -pattern_bin_1([], Isub, Osub, St) -> {#k_bin_end{},{Isub,Osub},St}. + U = cerl:concrete(U0), + Fs = cerl:concrete(Fs0), + {E,Osub1,St2} = pattern(E0, Isub, Osub0, St1), + {Es,Osub,St3} = pattern_bin_1(Es0, Isub, Osub1, St2), + {build_bin_seg(A, S, U, cerl:concrete(T), Fs, E, Es),Osub,St3}; +pattern_bin_1([], _Isub, Osub, St) -> + {#k_bin_end{},Osub,St}. + +%% build_bin_seg(Anno, Size, Unit, Type, Flags, Seg, Next) -> #k_bin_seg{}. +%% This function normalizes literal integers with size > 8 and literal +%% utf8 segments into integers with size = 8 (and potentially an integer +%% with size less than 8 at the end). This is so further optimizations +%% have a normalized view of literal integers, allowing us to generate +%% more literals and group more clauses. Those integers may be "squeezed" +%% later into the largest integer possible. +%% +build_bin_seg(A, #k_literal{val=Bits} = Sz, U, integer=Type, + [unsigned,big]=Flags, #k_literal{val=Int}=Seg, Next) -> + Size = Bits * U, + case integer_fits_and_is_expandable(Int, Size) of + true -> build_bin_seg_integer_recur(A, Size, Int, Next); + false -> #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next} + end; +build_bin_seg(A, Sz, U, utf8=Type, [unsigned,big]=Flags, #k_literal{val=Utf8} = Seg, Next) -> + case utf8_fits(Utf8) of + {Int, Bits} -> build_bin_seg_integer_recur(A, Bits, Int, Next); + error -> #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next} + end; +build_bin_seg(A, Sz, U, Type, Flags, Seg, Next) -> + #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next}. + +build_bin_seg_integer_recur(A, Bits, Val, Next) when Bits > 8 -> + NextBits = Bits - 8, + NextVal = Val band ((1 bsl NextBits) - 1), + Last = build_bin_seg_integer_recur(A, NextBits, NextVal, Next), + build_bin_seg_integer(A, 8, Val bsr NextBits, Last); + +build_bin_seg_integer_recur(A, Bits, Val, Next) -> + build_bin_seg_integer(A, Bits, Val, Next). + +build_bin_seg_integer(A, Bits, Val, Next) -> + Sz = #k_literal{anno=A,val=Bits}, + Seg = #k_literal{anno=A,val=Val}, + #k_bin_seg{anno=A,size=Sz,unit=1,type=integer,flags=[unsigned,big],seg=Seg,next=Next}. + +integer_fits_and_is_expandable(Int, Size) when 0 < Size, Size =< ?EXPAND_MAX_SIZE_SEGMENT -> + case <<Int:Size>> of + <<Int:Size>> -> true; + _ -> false + end; +integer_fits_and_is_expandable(_Int, _Size) -> + false. + +utf8_fits(Utf8) -> + try + Bin = <<Utf8/utf8>>, + Bits = bit_size(Bin), + <<Int:Bits>> = Bin, + {Int, Bits} + catch + _:_ -> error + end. %% pattern_list([Cexpr], Sub, State) -> {[Kexpr],Sub,State}. @@ -1411,23 +922,25 @@ new_vars(0, St, Vs) -> {Vs,St}. make_vars(Vs) -> [ #k_var{name=V} || V <- Vs ]. -add_var_def(V, St) -> - St#kern{ds=cerl_sets:add_element(V#k_var.name, St#kern.ds)}. - -%%add_vars_def(Vs, St) -> -%% Ds = foldl(fun (#k_var{name=V}, Ds) -> add_element(V, Ds) end, -%% St#kern.ds, Vs), -%% St#kern{ds=Ds}. - %% is_remote_bif(Mod, Name, Arity) -> true | false. %% Test if function is really a BIF. -is_remote_bif(erlang, get, 1) -> true; -is_remote_bif(erlang, N, A) -> - case erl_internal:guard_bif(N, A) of +is_remote_bif(erlang, get, [_]) -> true; +is_remote_bif(erlang, is_record, [_,Tag,Sz]) -> + case {Tag,Sz} of + {#c_literal{val=Atom},#c_literal{val=Int}} + when is_atom(Atom), is_integer(Int) -> + %% Tag and size are literals. This is a guard BIF. + true; + {_,_} -> + false + end; +is_remote_bif(erlang, N, As) -> + Arity = length(As), + case erl_internal:guard_bif(N, Arity) of true -> true; false -> - try erl_internal:op_type(N, A) of + try erl_internal:op_type(N, Arity) of arith -> true; bool -> true; comp -> true; @@ -1445,6 +958,7 @@ is_remote_bif(_, _, _) -> false. %% return multiple values. Only used in bodies where a BIF may be %% called for effect only. +bif_vals(recv_peek_message, 0) -> 2; bif_vals(_, _) -> 1. bif_vals(_, _, _) -> 1. @@ -1488,11 +1002,6 @@ foldr2(_, Acc, [], []) -> Acc. kmatch(Us, Ccs, Sub, St0) -> {Cs,St1} = match_pre(Ccs, Sub, St0), %Convert clauses Def = fail, -%% Def = #k_call{anno=[compiler_generated], -%% op=#k_remote{mod=#k_atom{val=erlang}, -%% name=#k_atom{val=exit}, -%% arity=1}, -%% args=[#k_atom{val=kernel_match_error}]}, match(Us, Cs, Def, St1). %Do the match. %% match_pre([Cclause], Sub, State) -> {[Clause],State}. @@ -1566,7 +1075,7 @@ maybe_add_warning(Ke, MatchAnno, St) -> get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|T]) -> get_line(T); get_line([]) -> none. - + get_file([{file,File}|_]) -> File; get_file([_|T]) -> get_file(T); get_file([]) -> "no_file". % should not happen @@ -1682,31 +1191,27 @@ expand_pat_lit_clause(#iclause{pats=[#k_literal{anno=A,val=Val}|Ps]}=C) -> expand_pat_lit_clause(C) -> C. expand_pat_lit([H|T], A) -> - #k_cons{anno=A,hd=literal(H, A),tl=literal(T, A)}; + #k_cons{anno=A,hd=#k_literal{anno=A,val=H},tl=#k_literal{anno=A,val=T}}; expand_pat_lit(Tuple, A) when is_tuple(Tuple) -> - #k_tuple{anno=A,es=[literal(E, A) || E <- tuple_to_list(Tuple)]}; + #k_tuple{anno=A,es=[#k_literal{anno=A,val=E} || E <- tuple_to_list(Tuple)]}; expand_pat_lit(Lit, A) -> - literal(Lit, A). - -literal([], A) -> - #k_nil{anno=A}; -literal(Val, A) when is_integer(Val) -> - #k_int{anno=A,val=Val}; -literal(Val, A) when is_float(Val) -> - #k_float{anno=A,val=Val}; -literal(Val, A) when is_atom(Val) -> - #k_atom{anno=A,val=Val}; -literal(Val, A) when is_list(Val); is_tuple(Val) -> - #k_literal{anno=A,val=Val}. + #k_literal{anno=A,val=Lit}. %% opt_singled_valued([{Type,Clauses}]) -> [{Type,Clauses}]. -%% If a type only has one clause and if the pattern is literal, -%% the matching can be done more efficiently by directly comparing -%% with the literal (that is especially true for binaries). +%% If a type only has one clause and if the pattern is a complex +%% literal, the matching can be done more efficiently by directly +%% comparing with the literal (that is especially true for binaries). +%% +%% It is important not to do this transformation for atomic literals +%% (such as `[]`), since that would cause the test for an emtpy list +%% to be executed before the test for a nonempty list. opt_single_valued(Ttcs) -> opt_single_valued(Ttcs, [], []). +opt_single_valued([{_,[#iclause{pats=[#k_literal{}|_]}]}=Ttc|Ttcs], TtcAcc, LitAcc) -> + %% This is an atomic literal. + opt_single_valued(Ttcs, [Ttc|TtcAcc], LitAcc); opt_single_valued([{_,[#iclause{pats=[P0|Ps]}=Tc]}=Ttc|Ttcs], TtcAcc, LitAcc) -> try combine_lit_pat(P0) of P -> @@ -1736,26 +1241,13 @@ opt_single_valued([], TtcAcc, LitAcc) -> combine_lit_pat(#ialias{pat=Pat0}=Alias) -> Pat = combine_lit_pat(Pat0), Alias#ialias{pat=Pat}; +combine_lit_pat(#k_literal{}) -> + %% This is an atomic literal. Rewriting would be a pessimization, + %% especially for `[]`. + throw(not_possible); combine_lit_pat(Pat) -> - case do_combine_lit_pat(Pat) of - #k_literal{val=Val} when is_atom(Val) -> - throw(not_possible); - #k_literal{val=Val} when is_number(Val) -> - throw(not_possible); - #k_literal{val=[]} -> - throw(not_possible); - #k_literal{}=Lit -> - Lit - end. + do_combine_lit_pat(Pat). -do_combine_lit_pat(#k_atom{anno=A,val=Val}) -> - #k_literal{anno=A,val=Val}; -do_combine_lit_pat(#k_float{anno=A,val=Val}) -> - #k_literal{anno=A,val=Val}; -do_combine_lit_pat(#k_int{anno=A,val=Val}) -> - #k_literal{anno=A,val=Val}; -do_combine_lit_pat(#k_nil{anno=A}) -> - #k_literal{anno=A,val=[]}; do_combine_lit_pat(#k_binary{anno=A,segs=Segs}) -> Bin = combine_bin_segs(Segs), #k_literal{anno=A,val=Bin}; @@ -1774,27 +1266,10 @@ do_combine_lit_pat(#k_tuple{anno=A,es=Es0}) -> do_combine_lit_pat(_) -> throw(not_possible). -combine_bin_segs(#k_bin_seg{size=Size0,unit=Unit,type=integer, - flags=[unsigned,big],seg=Seg,next=Next}) -> - #k_literal{val=Size1} = do_combine_lit_pat(Size0), - #k_literal{val=Int} = do_combine_lit_pat(Seg), - Size = Size1 * Unit, - if - 0 < Size, Size < 64 -> - Bin = <<Int:Size>>, - case Bin of - <<Int:Size>> -> - NextBin = combine_bin_segs(Next), - <<Bin/bits,NextBin/bits>>; - _ -> - %% The integer Int does not fit in the segment, - %% thus it will not match. - throw(not_possible) - end; - true -> - %% Avoid creating huge binary literals. - throw(not_possible) - end; +combine_bin_segs(#k_bin_seg{size=#k_literal{val=8},unit=1,type=integer, + flags=[unsigned,big],seg=#k_literal{val=Int},next=Next}) + when is_integer(Int), 0 =< Int, Int =< 255 -> + <<Int,(combine_bin_segs(Next))/bits>>; combine_bin_segs(#k_bin_end{}) -> <<>>; combine_bin_segs(_) -> @@ -1862,13 +1337,12 @@ handle_bin_con_not_possible([]) -> []. %% exception is thrown. select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer, - size=#k_int{val=Bits0}=Sz,unit=U, - flags=Fl,seg=#k_literal{val=Val}, - next=N}|Ps]}=C|Cs0]) - when is_integer(Val) -> + size=#k_literal{val=Bits0}=Sz,unit=U, + flags=Fl,seg=#k_literal{val=Val}, + next=N}|Ps]}=C|Cs0]) when is_integer(Bits0) -> Bits = U * Bits0, if - Bits > 1024 -> throw(not_possible); %Expands the code too much. + Bits > ?EXPAND_MAX_SIZE_SEGMENT -> throw(not_possible); %Expands the code too much. true -> ok end, select_assert_match_possible(Bits, Val, Fl), @@ -1879,20 +1353,10 @@ select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer, end, Cs = select_bin_int_1(Cs0, Bits, Fl, Val), [{k_bin_int,[C#iclause{pats=[P|Ps]}|Cs]}]; -select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=utf8, - flags=[unsigned,big]=Fl, - seg=#k_literal{val=Val0}, - next=N}|Ps]}=C|Cs0]) - when is_integer(Val0) -> - {Val,Bits} = select_utf8(Val0), - P = #k_bin_int{anno=A,size=#k_int{val=Bits},unit=1, - flags=Fl,val=Val,next=N}, - Cs = select_bin_int_1(Cs0, Bits, Fl, Val), - [{k_bin_int,[C#iclause{pats=[P|Ps]}|Cs]}]; select_bin_int(_) -> throw(not_possible). select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=integer, - size=#k_int{val=Bits0}=Sz, + size=#k_literal{val=Bits0}=Sz, unit=U, flags=Fl,seg=#k_literal{val=Val}, next=N}|Ps]}=C|Cs], @@ -1903,18 +1367,6 @@ select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=integer, end, P = #k_bin_int{anno=A,size=Sz,unit=U,flags=Fl,val=Val,next=N}, [C#iclause{pats=[P|Ps]}|select_bin_int_1(Cs, Bits, Fl, Val)]; -select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=utf8, - flags=Fl, - seg=#k_literal{val=Val0}, - next=N}|Ps]}=C|Cs], - Bits, Fl, Val) when is_integer(Val0) -> - case select_utf8(Val0) of - {Val,Bits} -> ok; - {_,_} -> throw(not_possible) - end, - P = #k_bin_int{anno=A,size=#k_int{val=Bits},unit=1, - flags=[unsigned,big],val=Val,next=N}, - [C#iclause{pats=[P|Ps]}|select_bin_int_1(Cs, Bits, Fl, Val)]; select_bin_int_1([], _, _, _) -> []; select_bin_int_1(_, _, _, _) -> throw(not_possible). @@ -1940,17 +1392,6 @@ match_fun(Val) -> {match,Bs} end. -select_utf8(Val0) -> - try - Bin = <<Val0/utf8>>, - Size = bit_size(Bin), - <<Val:Size>> = Bin, - {Val,Size} - catch - error:_ -> - throw(not_possible) - end. - %% match_value([Var], Con, [Clause], Default, State) -> {SelectExpr,State}. %% At this point all the clauses have the same constructor, we must %% now separate them according to value. @@ -1961,104 +1402,108 @@ match_value(Us0, T, Cs0, Def, St0) -> %%ok = io:format("match_value ~p ~p~n", [T, Css]), mapfoldl(fun ({Us,Cs}, St) -> match_clause(Us, Cs, Def, St) end, St1, UCss). -%% partition_intersection -%% Partitions a map into two maps with the most common keys to the first map. +%% partition_intersection(Type, Us, [Clause], State) -> {Us,Cs,State}. +%% Partitions a map into two maps with the most common keys to the +%% first map. +%% %% case <M> of -%% <#{a}> %% <#{a,b}> %% <#{a,c}> -%% <#{c}> +%% <#{a}> %% end +%% %% becomes +%% %% case <M,M> of -%% <#{a}, #{ }> %% <#{a}, #{b}> -%% <#{ }, #{c}> %% <#{a}, #{c}> +%% <#{a}, #{ }> %% end -%% The intention is to group as many keys together as possible and thus -%% reduce the number of lookups to that key. -partition_intersection(k_map, [U|_]=Us0, [_,_|_]=Cs0,St0) -> +%% +%% The intention is to group as many keys together as possible and +%% thus reduce the number of lookups to that key. + +partition_intersection(k_map, [U|_]=Us, [_,_|_]=Cs0, St0) -> Ps = [clause_val(C) || C <- Cs0], - case find_key_partition(Ps) of - no_partition -> - {Us0,Cs0,St0}; + case find_key_intersection(Ps) of + none -> + {Us,Cs0,St0}; Ks -> - {Cs1,St1} = mapfoldl(fun(#iclause{pats=[Arg|Args]}=C, Sti) -> - {{Arg1,Arg2},St} = partition_key_intersection(Arg, Ks, Sti), - {C#iclause{pats=[Arg1,Arg2|Args]}, St} - end, St0, Cs0), - {[U|Us0],Cs1,St1} + Cs1 = map(fun(#iclause{pats=[Arg|Args]}=C) -> + {Arg1,Arg2} = partition_keys(Arg, Ks), + C#iclause{pats=[Arg1,Arg2|Args]} + end, Cs0), + {[U|Us],Cs1,St0} end; partition_intersection(_, Us, Cs, St) -> {Us,Cs,St}. -partition_key_intersection(#k_map{es=Pairs}=Map,Ks,St0) -> - F = fun(#k_map_pair{key=Key}) -> member(map_key_clean(Key), Ks) end, +partition_keys(#k_map{es=Pairs}=Map, Ks) -> + F = fun(#k_map_pair{key=Key}) -> + cerl_sets:is_element(map_key_clean(Key), Ks) + end, {Ps1,Ps2} = partition(F, Pairs), - {{Map#k_map{es=Ps1},Map#k_map{es=Ps2}},St0}; -partition_key_intersection(#ialias{pat=Map}=Alias,Ks,St0) -> - %% only alias one of them - {{Map1,Map2},St1} = partition_key_intersection(Map, Ks, St0), - {{Map1,Alias#ialias{pat=Map2}},St1}. - -% Only check for the complete intersection of keys and not commonality -find_key_partition(Ps) -> - Sets = [sets:from_list(Ks)||Ks <- Ps], - Is = sets:intersection(Sets), - case sets:to_list(Is) of - [] -> no_partition; - KeyIntersection -> - %% Check if the intersection are all keys in all clauses. - %% Don't split if they are since this will only - %% infer extra is_map instructions with no gain. - All = foldl(fun (Kset, Bool) -> - Bool andalso sets:is_subset(Kset, Is) - end, true, Sets), - if All -> no_partition; - true -> KeyIntersection + {Map#k_map{es=Ps1},Map#k_map{es=Ps2}}; +partition_keys(#ialias{pat=Map}=Alias, Ks) -> + %% Only alias one of them. + {Map1,Map2} = partition_keys(Map, Ks), + {Map1,Alias#ialias{pat=Map2}}. + +find_key_intersection(Ps) -> + Sets = [cerl_sets:from_list(Ks) || Ks <- Ps], + Intersection = cerl_sets:intersection(Sets), + case cerl_sets:size(Intersection) of + 0 -> + none; + _ -> + All = all(fun (Kset) -> Kset =:= Intersection end, Sets), + case All of + true -> + %% All clauses test the same keys. Partitioning + %% the keys could only make the code worse. + none; + false -> + Intersection end end. %% group_value([Clause]) -> [[Clause]]. %% Group clauses according to value. Here we know that %% 1. Some types are singled valued -%% 2. The clauses in bin_segs cannot be reordered only grouped +%% 2. The clauses in maps and bin_segs cannot be reordered, +%% only grouped %% 3. Other types are disjoint and can be reordered -group_value(k_cons, Us, Cs) -> [{Us,Cs}]; %These are single valued +group_value(k_cons, Us, Cs) -> [{Us,Cs}]; %These are single valued group_value(k_nil, Us, Cs) -> [{Us,Cs}]; group_value(k_binary, Us, Cs) -> [{Us,Cs}]; group_value(k_bin_end, Us, Cs) -> [{Us,Cs}]; -group_value(k_bin_seg, Us, Cs) -> group_bin_seg(Us,Cs); +group_value(k_bin_seg, Us, Cs) -> group_keeping_order(Us, Cs); group_value(k_bin_int, Us, Cs) -> [{Us,Cs}]; -group_value(k_map, Us, Cs) -> group_map(Us,Cs); +group_value(k_map, Us, Cs) -> group_keeping_order(Us, Cs); group_value(_, Us, Cs) -> - %% group_value(Cs). - Cd = foldl(fun (C, Gcs0) -> dict:append(clause_val(C), C, Gcs0) end, - dict:new(), Cs), - dict:fold(fun (_, Vcs, Css) -> [{Us,Vcs}|Css] end, [], Cd). - -group_bin_seg(Us, [C1|Cs]) -> - V1 = clause_val(C1), - {More,Rest} = splitwith(fun (C) -> clause_val(C) == V1 end, Cs), - [{Us,[C1|More]}|group_bin_seg(Us,Rest)]; -group_bin_seg(_, []) -> []. + Map = group_values(Cs, #{}), + %% We must sort the grouped values to ensure consistent + %% order from compilation to compilation. + sort(maps:fold(fun (_, Vcs, Css) -> + [{Us,reverse(Vcs)}|Css] + end, [], Map)). + +group_values([C|Cs], Acc) -> + Val = clause_val(C), + case Acc of + #{Val:=Gcs} -> + group_values(Cs, Acc#{Val:=[C|Gcs]}); + #{} -> + group_values(Cs, Acc#{Val=>[C]}) + end; +group_values([], Acc) -> Acc. -group_map(Us, [C1|Cs]) -> +group_keeping_order(Us, [C1|Cs]) -> V1 = clause_val(C1), {More,Rest} = splitwith(fun (C) -> clause_val(C) =:= V1 end, Cs), - [{Us,[C1|More]}|group_map(Us,Rest)]; -group_map(_, []) -> []. - -%% Profiling shows that this quadratic implementation account for a big amount -%% of the execution time if there are many values. -% group_value([C|Cs]) -> -% V = clause_val(C), -% Same = [ Cv || Cv <- Cs, clause_val(Cv) == V ], %Same value -% Rest = [ Cv || Cv <- Cs, clause_val(Cv) /= V ], % and all the rest -% [[C|Same]|group_value(Rest)]; -% group_value([]) -> []. + [{Us,[C1|More]}|group_keeping_order(Us, Rest)]; +group_keeping_order(_, []) -> []. %% match_clause([Var], [Clause], Default, State) -> {Clause,State}. %% At this point all the clauses have the same "value". Build one @@ -2070,7 +1515,8 @@ match_clause([U|Us], [C|_]=Cs0, Def, St0) -> {Match0,Vs,St1} = get_match(get_con(Cs0), St0), Match = sub_size_var(Match0, Cs0), {Cs1,St2} = new_clauses(Cs0, U, St1), - {B,St3} = match(Vs ++ Us, Cs1, Def, St2), + Cs2 = squeeze_clauses_by_bin_integer_count(Cs1, []), + {B,St3} = match(Vs ++ Us, Cs2, Def, St2), {#k_val_clause{anno=Anno,val=Match,body=B},St3}. sub_size_var(#k_bin_seg{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) -> @@ -2085,17 +1531,14 @@ get_match(#k_cons{}, St0) -> get_match(#k_binary{}, St0) -> {[V]=Mes,St1} = new_vars(1, St0), {#k_binary{segs=V},Mes,St1}; -get_match(#k_bin_seg{size=#k_atom{val=all},next={k_bin_end,[]}}=Seg, St0) -> - {[S,N0],St1} = new_vars(2, St0), - N = set_kanno(N0, [no_usage]), +get_match(#k_bin_seg{size=#k_literal{val=all},next={k_bin_end,[]}}=Seg, St0) -> + {[S,N],St1} = new_vars(2, St0), {Seg#k_bin_seg{seg=S,next=N},[S],St1}; get_match(#k_bin_seg{}=Seg, St0) -> - {[S,N0],St1} = new_vars(2, St0), - N = set_kanno(N0, [no_usage]), + {[S,N],St1} = new_vars(2, St0), {Seg#k_bin_seg{seg=S,next=N},[S,N],St1}; get_match(#k_bin_int{}=BinInt, St0) -> - {N0,St1} = new_var(St0), - N = set_kanno(N0, [no_usage]), + {N,St1} = new_var(St0), {BinInt#k_bin_int{next=N},[N],St1}; get_match(#k_tuple{es=Es}, St0) -> {Mes,St1} = new_vars(length(Es), St0), @@ -2116,7 +1559,7 @@ new_clauses(Cs0, U, St) -> #k_cons{hd=H,tl=T} -> [H,T|As]; #k_tuple{es=Es} -> Es ++ As; #k_binary{segs=E} -> [E|As]; - #k_bin_seg{size=#k_atom{val=all}, + #k_bin_seg{size=#k_literal{val=all}, seg=S,next={k_bin_end,[]}} -> [S|As]; #k_bin_seg{seg=S,next=N} -> @@ -2140,6 +1583,104 @@ new_clauses(Cs0, U, St) -> end, Cs0), {Cs1,St}. +%% group and squeeze +%% The goal of those functions is to group subsequent integer k_bin_seg +%% literals by count so we can leverage bs_get_integer_16 whenever possible. +%% +%% The priority is to create large groups. So if we have three clauses matching +%% on 16-bits/16-bits/8-bits, we will first have a single 8-bits match for all +%% three clauses instead of clauses (one with 16 and another with 8). But note +%% the algorithm is recursive, so the remaining 8-bits for the first two clauses +%% will be grouped next. +%% +%% We also try to not create too large groups. If we have too many clauses, +%% it is preferrable to match on 8-bits, select a branch, then match on the +%% next 8-bits, rather than match on 16-bits which would force us to have +%% to select to many values at the same time, which would not be efficient. +%% +%% Another restriction is that we create groups only if the end of the +%% group is a variadic clause or the end of the binary. That's because +%% if we have 16-bits/16-bits/catch-all, breaking it into a 16-bits lookup +%% will make the catch-all more expensive. +%% +%% Clauses are grouped in reverse when squeezing and then flattened and +%% re-reversed at the end. +squeeze_clauses_by_bin_integer_count([Clause | Clauses], Acc) -> + case clause_count_bin_integer_segments(Clause) of + {literal, N} -> squeeze_clauses_by_bin_integer_count(Clauses, N, 1, [Clause], Acc); + _ -> squeeze_clauses_by_bin_integer_count(Clauses, [[Clause] | Acc]) + end; +squeeze_clauses_by_bin_integer_count(_, Acc) -> + flat_reverse(Acc, []). + +squeeze_clauses_by_bin_integer_count([], N, Count, GroupAcc, Acc) -> + Squeezed = squeeze_clauses(GroupAcc, fix_count_without_variadic_segment(N), Count), + flat_reverse([Squeezed | Acc], []); +squeeze_clauses_by_bin_integer_count([#iclause{pats=[#k_bin_end{} | _]} = Clause], N, Count, GroupAcc, Acc) -> + Squeezed = squeeze_clauses(GroupAcc, fix_count_without_variadic_segment(N), Count), + flat_reverse([[Clause | Squeezed] | Acc], []); +squeeze_clauses_by_bin_integer_count([Clause | Clauses], N, Count, GroupAcc, Acc) -> + case clause_count_bin_integer_segments(Clause) of + {literal, NewN} -> + squeeze_clauses_by_bin_integer_count(Clauses, min(N, NewN), Count + 1, [Clause | GroupAcc], Acc); + + {variadic, NewN} when NewN =< N -> + Squeezed = squeeze_clauses(GroupAcc, NewN, Count), + squeeze_clauses_by_bin_integer_count(Clauses, [[Clause | Squeezed] | Acc]); + + _ -> + squeeze_clauses_by_bin_integer_count(Clauses, [[Clause | GroupAcc] | Acc]) + end. + +clause_count_bin_integer_segments(#iclause{pats=[#k_bin_seg{seg=#k_literal{}} = BinSeg | _]}) -> + count_bin_integer_segments(BinSeg, 0); +clause_count_bin_integer_segments(#iclause{pats=[#k_bin_seg{size=#k_literal{val=Size},unit=Unit, + type=integer,flags=[unsigned,big], + seg=#k_var{}} | _]}) + when ((Size * Unit) rem 8) =:= 0 -> + {variadic, (Size * Unit) div 8}; +clause_count_bin_integer_segments(_) -> + error. + +count_bin_integer_segments(#k_bin_seg{size=#k_literal{val=8},unit=1,type=integer,flags=[unsigned,big], + seg=#k_literal{val=Int},next=Next}, Count) + when is_integer(Int), 0 =< Int, Int =< 255 -> + count_bin_integer_segments(Next, Count + 1); +count_bin_integer_segments(_, Count) when Count > 0 -> + {literal, Count}; +count_bin_integer_segments(_, _Count) -> + error. + +%% Since 4 bytes in on 32-bits systems are bignums, we convert +%% anything more than 3 into 2 bytes lookup. The goal is to convert +%% any multi-clause segment into 2-byte lookups with a potential +%% 3 byte lookup at the end. +fix_count_without_variadic_segment(N) when N > 3 -> 2; +fix_count_without_variadic_segment(N) -> N. + +%% If we have more than 16 clauses, then it is better +%% to branch multiple times than getting a large integer. +%% We also abort if we have nothing to squeeze. +squeeze_clauses(Clauses, Size, Count) when Count >= 16; Size == 1 -> Clauses; +squeeze_clauses(Clauses, Size, _Count) -> squeeze_clauses(Clauses, Size). + +squeeze_clauses([#iclause{pats=[#k_bin_seg{seg=#k_literal{}} = BinSeg | Pats]} = Clause | Clauses], Size) -> + [Clause#iclause{pats=[squeeze_segments(BinSeg, 0, 0, Size) | Pats]} | + squeeze_clauses(Clauses, Size)]; +squeeze_clauses([], _Size) -> + []. + +squeeze_segments(#k_bin_seg{size=Sz, seg=#k_literal{val=Val}=Lit} = BinSeg, Acc, Size, 1) -> + BinSeg#k_bin_seg{size=Sz#k_literal{val=Size + 8}, seg=Lit#k_literal{val=(Acc bsl 8) bor Val}}; +squeeze_segments(#k_bin_seg{seg=#k_literal{val=Val},next=Next}, Acc, Size, Count) -> + squeeze_segments(Next, (Acc bsl 8) bor Val, Size + 8, Count - 1). + +flat_reverse([Head | Tail], Acc) -> flat_reverse(Tail, flat_reverse_1(Head, Acc)); +flat_reverse([], Acc) -> Acc. + +flat_reverse_1([Head | Tail], Acc) -> flat_reverse_1(Tail, [Head | Acc]); +flat_reverse_1([], Acc) -> Acc. + %% build_guard([GuardClause]) -> GuardExpr. build_guard([]) -> fail; @@ -2160,13 +1701,13 @@ build_alt_1st_no_fail(First, fail) -> First; build_alt_1st_no_fail(First, Then) -> copy_anno(#k_alt{first=First,then=Then}, First). -%% build_match([MatchVar], MatchExpr) -> Kexpr. +%% build_match(MatchExpr) -> Kexpr. %% Build a match expr if there is a match. -build_match(Us, #k_alt{}=Km) -> copy_anno(#k_match{vars=Us,body=Km}, Km); -build_match(Us, #k_select{}=Km) -> copy_anno(#k_match{vars=Us,body=Km}, Km); -build_match(Us, #k_guard{}=Km) -> copy_anno(#k_match{vars=Us,body=Km}, Km); -build_match(_, Km) -> Km. +build_match(#k_alt{}=Km) -> copy_anno(#k_match{body=Km}, Km); +build_match(#k_select{}=Km) -> copy_anno(#k_match{body=Km}, Km); +build_match(#k_guard{}=Km) -> copy_anno(#k_match{body=Km}, Km); +build_match(Km) -> Km. %% clause_arg(Clause) -> FirstArg. %% clause_con(Clause) -> Constructor. @@ -2195,26 +1736,26 @@ arg_alias(_Con) -> []. arg_con(Arg) -> case arg_arg(Arg) of - #k_literal{} -> k_literal; - #k_int{} -> k_int; - #k_float{} -> k_float; - #k_atom{} -> k_atom; - #k_nil{} -> k_nil; - #k_cons{} -> k_cons; + #k_cons{} -> k_cons; #k_tuple{} -> k_tuple; #k_map{} -> k_map; #k_binary{} -> k_binary; #k_bin_end{} -> k_bin_end; #k_bin_seg{} -> k_bin_seg; - #k_var{} -> k_var + #k_var{} -> k_var; + #k_literal{val=[]} -> k_nil; + #k_literal{val=Val} -> + if + is_atom(Val) -> k_atom; + is_integer(Val) -> k_int; + is_float(Val) -> k_float; + true -> k_literal + end end. arg_val(Arg, C) -> case arg_arg(Arg) of #k_literal{val=Lit} -> Lit; - #k_int{val=I} -> I; - #k_float{val=F} -> F; - #k_atom{val=A} -> A; #k_tuple{es=Es} -> length(Es); #k_bin_seg{size=S,unit=U,type=T,flags=Fs} -> case S of @@ -2225,7 +1766,7 @@ arg_val(Arg, C) -> {set_kanno(S, []),U,T,Fs} end; #k_map{op=exact,es=Es} -> - lists:sort(fun(A,B) -> + sort(fun(A,B) -> %% on the form K :: {'lit' | 'var', term()} %% lit < var as intended erts_internal:cmp_term(A,B) < 0 @@ -2248,23 +1789,22 @@ ubody(#iset{vars=[],arg=#iletrec{}=Let,body=B0}, Br, St0) -> %% An iletrec{} should never be last. St = iletrec_funs(Let, St0), ubody(B0, Br, St); +ubody(#iset{vars=[],arg=#k_literal{},body=B0}, Br, St0) -> + ubody(B0, Br, St0); ubody(#iset{anno=A,vars=Vs,arg=E0,body=B0}, Br, St0) -> {E1,Eu,St1} = uexpr(E0, {break,Vs}, St0), {B1,Bu,St2} = ubody(B0, Br, St1), Ns = lit_list_vars(Vs), Used = union(Eu, subtract(Bu, Ns)), %Used external vars - {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2}; + {#k_seq{anno=A,arg=E1,body=B1},Used,St2}; ubody(#ivalues{anno=A,args=As}, return, St) -> Au = lit_list_vars(As), - {#k_return{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; + {#k_return{anno=A,args=As},Au,St}; ubody(#ivalues{anno=A,args=As}, {break,_Vbs}, St) -> Au = lit_list_vars(As), - case is_in_guard(St) of - true -> - {#k_guard_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; - false -> - {#k_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St} - end; + {#k_break{anno=A,args=As},Au,St}; +ubody(#k_goto{}=Goto, _Br, St) -> + {Goto,[],St}; ubody(E, return, St0) -> %% Enterable expressions need no trailing return. case is_enter_expr(E) of @@ -2273,27 +1813,14 @@ ubody(E, return, St0) -> {Ea,Pa,St1} = force_atomic(E, St0), ubody(pre_seq(Pa, #ivalues{args=[Ea]}), return, St1) end; -ubody(#ignored{}, {break,_} = Break, St) -> - ubody(#ivalues{args=[]}, Break, St); ubody(E, {break,[_]} = Break, St0) -> - %%ok = io:fwrite("ubody ~w:~p~n", [?LINE,{E,Br}]), - %% Exiting expressions need no trailing break. - case is_exit_expr(E) of - true -> uexpr(E, return, St0); - false -> - {Ea,Pa,St1} = force_atomic(E, St0), - ubody(pre_seq(Pa, #ivalues{args=[Ea]}), Break, St1) - end; + {Ea,Pa,St1} = force_atomic(E, St0), + ubody(pre_seq(Pa, #ivalues{args=[Ea]}), Break, St1); ubody(E, {break,Rs}=Break, St0) -> - case is_exit_expr(E) of - true -> - uexpr(E, return, St0); - false -> - {Vs,St1} = new_vars(length(Rs), St0), - Iset = #iset{vars=Vs,arg=E}, - PreSeq = pre_seq([Iset], #ivalues{args=Vs}), - ubody(PreSeq, Break, St1) - end. + {Vs,St1} = new_vars(length(Rs), St0), + Iset = #iset{vars=Vs,arg=E}, + PreSeq = pre_seq([Iset], #ivalues{args=Vs}), + ubody(PreSeq, Break, St1). iletrec_funs(#iletrec{defs=Fs}, St0) -> %% Use union of all free variables. @@ -2319,20 +1846,13 @@ iletrec_funs_gen(_, _, #kern{funs=ignore}=St) -> iletrec_funs_gen(Fs, FreeVs, St) -> foldl(fun ({N,#ifun{anno=Fa,vars=Vs,body=Fb0}}, Lst0) -> Arity0 = length(Vs), - {Fb1,_,Lst1} = ubody(Fb0, return, Lst0#kern{ff={N,Arity0}}), + {Fb1,_,Lst1} = ubody(Fb0, return, Lst0), Arity = Arity0 + length(FreeVs), - Fun = make_fdef(#k{us=[],ns=[],a=Fa}, N, Arity, - Vs++FreeVs, Fb1), + Fun = make_fdef(Fa, N, Arity, Vs++FreeVs, Fb1), Lst1#kern{funs=[Fun|Lst1#kern.funs]} end, St, Fs). -%% is_exit_expr(Kexpr) -> boolean(). -%% Test whether Kexpr always exits and never returns. - -is_exit_expr(#k_receive_next{}) -> true; -is_exit_expr(_) -> false. - %% is_enter_expr(Kexpr) -> boolean(). %% Test whether Kexpr is "enterable", i.e. can handle return from %% within itself without extra #k_return{}. @@ -2340,95 +1860,77 @@ is_exit_expr(_) -> false. is_enter_expr(#k_try{}) -> true; is_enter_expr(#k_call{}) -> true; is_enter_expr(#k_match{}) -> true; -is_enter_expr(#k_receive{}) -> true; -is_enter_expr(#k_receive_next{}) -> true; +is_enter_expr(#k_letrec_goto{}) -> true; is_enter_expr(_) -> false. %% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}. -%% Tag an expression with its used variables. +%% Calculate the used variables for an expression. %% Break = return | {break,[RetVar]}. uexpr(#k_test{anno=A,op=Op,args=As}=Test, {break,Rs}, St) -> [] = Rs, %Sanity check Used = union(op_vars(Op), lit_list_vars(As)), - {Test#k_test{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}}, - Used,St}; + {Test#k_test{anno=A},Used,St}; uexpr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, {break,_}=Br, St0) -> Ns = lit_list_vars(Vs), {E1,Eu,St1} = uexpr(E0, {break,Vs}, St0), {B1,Bu,St2} = uexpr(B0, Br, St1), Used = union(Eu, subtract(Bu, Ns)), - {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2}; + {#k_seq{anno=A,arg=E1,body=B1},Used,St2}; uexpr(#k_call{anno=A,op=#k_local{name=F,arity=Ar}=Op,args=As0}=Call, Br, St) -> Free = get_free(F, Ar, St), As1 = As0 ++ Free, %Add free variables LAST! Used = lit_list_vars(As1), {case Br of {break,Rs} -> - Call#k_call{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}, + Call#k_call{anno=A, op=Op#k_local{arity=Ar + length(Free)}, args=As1,ret=Rs}; return -> - #k_enter{anno=#k{us=Used,ns=[],a=A}, + #k_enter{anno=A, op=Op#k_local{arity=Ar + length(Free)}, args=As1} end,Used,St}; uexpr(#k_call{anno=A,op=Op,args=As}=Call, {break,Rs}, St) -> Used = union(op_vars(Op), lit_list_vars(As)), - {Call#k_call{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A},ret=Rs}, - Used,St}; + {Call#k_call{anno=A,ret=Rs},Used,St}; uexpr(#k_call{anno=A,op=Op,args=As}, return, St) -> Used = union(op_vars(Op), lit_list_vars(As)), - {#k_enter{anno=#k{us=Used,ns=[],a=A},op=Op,args=As}, - Used,St}; + {#k_enter{anno=A,op=Op,args=As},Used,St}; uexpr(#k_bif{anno=A,op=Op,args=As}=Bif, {break,Rs}, St0) -> Used = union(op_vars(Op), lit_list_vars(As)), {Brs,St1} = bif_returns(Op, Rs, St0), - {Bif#k_bif{anno=#k{us=Used,ns=lit_list_vars(Brs),a=A},ret=Brs}, - Used,St1}; -uexpr(#k_match{anno=A,vars=Vs,body=B0}, Br, St0) -> + {Bif#k_bif{anno=A,ret=Brs},Used,St1}; +uexpr(#k_match{anno=A,body=B0}, Br, St0) -> Rs = break_rets(Br), {B1,Bu,St1} = umatch(B0, Br, St0), - case is_in_guard(St1) of - true -> - {#k_guard_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, - vars=Vs,body=B1,ret=Rs},Bu,St1}; - false -> - {#k_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, - vars=Vs,body=B1,ret=Rs},Bu,St1} - end; -uexpr(#k_receive{anno=A,var=V,body=B0,timeout=T,action=A0}, Br, St0) -> - Rs = break_rets(Br), - Tu = lit_vars(T), %Timeout is atomic - {B1,Bu,St1} = umatch(B0, Br, St0), - {A1,Au,St2} = ubody(A0, Br, St1), - Used = del_element(V#k_var.name, union(Bu, union(Tu, Au))), - {#k_receive{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}, - var=V,body=B1,timeout=T,action=A1,ret=Rs}, - Used,St2}; -uexpr(#k_receive_accept{anno=A}, _, St) -> - {#k_receive_accept{anno=#k{us=[],ns=[],a=A}},[],St}; -uexpr(#k_receive_next{anno=A}, _, St) -> - {#k_receive_next{anno=#k{us=[],ns=[],a=A}},[],St}; + {#k_match{anno=A,body=B1,ret=Rs},Bu,St1}; uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, {break,Rs0}=Br, St0) -> - case is_in_guard(St0) of - true -> - {[#k_var{name=X}],#k_var{name=X}} = {Vs,B0}, %Assertion. - #k_atom{val=false} = H0, %Assertion. - {Avs,St1} = new_vars(length(Rs0), St0), - {A1,Bu,St} = uexpr(A0, {break,Avs}, St1), - {#k_protected{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A}, - arg=A1,ret=Rs0,inner=Avs},Bu,St}; - false -> + case {Vs,B0,H0,Rs0} of + {[#k_var{name=X}],#k_var{name=X},#k_literal{},[]} -> + %% This is a simple try/catch whose return value is + %% ignored: + %% + %% try E of V -> V when _:_:_ -> ignored_literal end, ... + %% + %% This is most probably a try/catch in a guard. To + %% correctly handle the #k_test{} that ends the body of + %% the guard, we MUST pass an empty list of break + %% variables when processing the body. + {A1,Bu,St} = ubody(A0, {break,[]}, St0), + {#k_try{anno=A,arg=A1,vars=[],body=#k_break{}, + evars=[],handler=#k_break{},ret=Rs0}, + Bu,St}; + {_,_,_,_} -> + %% The general try/catch (in a guard or in body). {Avs,St1} = new_vars(length(Vs), St0), {A1,Au,St2} = ubody(A0, {break,Avs}, St1), {B1,Bu,St3} = ubody(B0, Br, St2), {H1,Hu,St4} = ubody(H0, Br, St3), Used = union([Au,subtract(Bu, lit_list_vars(Vs)), subtract(Hu, lit_list_vars(Evs))]), - {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs0),a=A}, - arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs0}, + {#k_try{anno=A,arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs0}, Used,St4} end; uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, @@ -2439,8 +1941,7 @@ uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, {H1,Hu,St4} = ubody(H0, return, St3), Used = union([Au,subtract(Bu, lit_list_vars(Vs)), subtract(Hu, lit_list_vars(Evs))]), - {#k_try_enter{anno=#k{us=Used,ns=[],a=A}, - arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1}, + {#k_try_enter{anno=A,arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1}, Used,St4}; uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) -> {Rb,St1} = new_var(St0), @@ -2448,7 +1949,7 @@ uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) -> %% Guarantee ONE return variable. {Ns,St3} = new_vars(1 - length(Rs0), St2), Rs1 = Rs0 ++ Ns, - {#k_catch{anno=#k{us=Bu,ns=lit_list_vars(Rs1),a=A},body=B1,ret=Rs1},Bu,St3}; + {#k_catch{anno=A,body=B1,ret=Rs1},Bu,St3}; uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) -> {B1,Bu,St1} = ubody(B0, return, St0), %Return out of new function Ns = lit_list_vars(Vs), @@ -2456,37 +1957,55 @@ uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) -> Fvs = make_vars(Free), Arity = length(Vs) + length(Free), {Fname,St} = - case lists:keyfind(id, 1, A) of + case keyfind(id, 1, A) of {id,{_,_,Fname0}} -> {Fname0,St1}; false -> %% No id annotation. Must invent a fun name. new_fun_name(St1) end, - Fun = make_fdef(#k{us=[],ns=[],a=A}, Fname, Arity, Vs++Fvs, B1), - {#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, + Fun = make_fdef(A, Fname, Arity, Vs++Fvs, B1), + Local = #k_local{name=Fname,arity=Arity}, + {#k_bif{anno=A, op=#k_internal{name=make_fun,arity=length(Free)+2}, - args=[#k_atom{val=Fname},#k_int{val=Arity}|Fvs], + args=[Local|Fvs], ret=Rs}, Free,add_local_function(Fun, St)}; +uexpr(#k_letrec_goto{anno=A,first=F0,then=T0}=MatchAlt, Br, St0) -> + Rs = break_rets(Br), + {F1,Fu,St1} = ubody(F0, Br, St0), + {T1,Tu,St2} = ubody(T0, Br, St1), + Used = union(Fu, Tu), + {MatchAlt#k_letrec_goto{anno=A,first=F1,then=T1,ret=Rs},Used,St2}; uexpr(Lit, {break,Rs0}, St0) -> %% Transform literals to puts here. %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,Lit]), Used = lit_vars(Lit), {Rs,St1} = ensure_return_vars(Rs0, St0), - {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)}, - arg=Lit,ret=Rs},Used,St1}. + {#k_put{anno=get_kanno(Lit),arg=Lit,ret=Rs},Used,St1}. + +add_local_function(_, #kern{funs=ignore}=St) -> + St; +add_local_function(#k_fdef{func=Name,arity=Arity}=F, #kern{funs=Funs}=St) -> + case is_defined(Name, Arity, Funs) of + false -> + St#kern{funs=[F|Funs]}; + true -> + St + end. -add_local_function(_, #kern{funs=ignore}=St) -> St; -add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}. +is_defined(Name, Arity, [#k_fdef{func=Name,arity=Arity}|_]) -> + true; +is_defined(Name, Arity, [#k_fdef{}|T]) -> + is_defined(Name, Arity, T); +is_defined(_, _, []) -> false. %% Make a #k_fdef{}, making sure that the body is always a #k_match{}. make_fdef(Anno, Name, Arity, Vs, #k_match{}=Body) -> #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Body}; make_fdef(Anno, Name, Arity, Vs, Body) -> Ka = get_kanno(Body), - Match = #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a}, - vars=Vs,body=Body,ret=[]}, + Match = #k_match{anno=Ka,body=Body,ret=[]}, #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Match}. %% get_free(Name, Arity, State) -> [Free]. @@ -2524,42 +2043,34 @@ ensure_return_vars([], St) -> new_vars(1, St); ensure_return_vars([_]=Rs, St) -> {Rs,St}. %% umatch(Match, Break, State) -> {Match,[UsedVar],State}. -%% Tag a match expression with its used variables. +%% Calculate the used variables for a match expression. umatch(#k_alt{anno=A,first=F0,then=T0}, Br, St0) -> {F1,Fu,St1} = umatch(F0, Br, St0), {T1,Tu,St2} = umatch(T0, Br, St1), Used = union(Fu, Tu), - {#k_alt{anno=#k{us=Used,ns=[],a=A},first=F1,then=T1}, - Used,St2}; + {#k_alt{anno=A,first=F1,then=T1},Used,St2}; umatch(#k_select{anno=A,var=V,types=Ts0}, Br, St0) -> {Ts1,Tus,St1} = umatch_list(Ts0, Br, St0), - Used = case member(no_usage, get_kanno(V)) of - true -> Tus; - false -> add_element(V#k_var.name, Tus) - end, - {#k_select{anno=#k{us=Used,ns=[],a=A},var=V,types=Ts1},Used,St1}; + Used = add_element(V#k_var.name, Tus), + {#k_select{anno=A,var=V,types=Ts1},Used,St1}; umatch(#k_type_clause{anno=A,type=T,values=Vs0}, Br, St0) -> {Vs1,Vus,St1} = umatch_list(Vs0, Br, St0), - {#k_type_clause{anno=#k{us=Vus,ns=[],a=A},type=T,values=Vs1},Vus,St1}; + {#k_type_clause{anno=A,type=T,values=Vs1},Vus,St1}; umatch(#k_val_clause{anno=A,val=P0,body=B0}, Br, St0) -> {U0,Ps} = pat_vars(P0), - P = set_kanno(P0, #k{us=U0,ns=Ps,a=get_kanno(P0)}), {B1,Bu,St1} = umatch(B0, Br, St0), + P = pat_anno_unused(P0, Bu, Ps), Used = union(U0, subtract(Bu, Ps)), - {#k_val_clause{anno=#k{us=Used,ns=[],a=A},val=P,body=B1}, - Used,St1}; + {#k_val_clause{anno=A,val=P,body=B1},Used,St1}; umatch(#k_guard{anno=A,clauses=Gs0}, Br, St0) -> {Gs1,Gus,St1} = umatch_list(Gs0, Br, St0), - {#k_guard{anno=#k{us=Gus,ns=[],a=A},clauses=Gs1},Gus,St1}; + {#k_guard{anno=A,clauses=Gs1},Gus,St1}; umatch(#k_guard_clause{anno=A,guard=G0,body=B0}, Br, St0) -> - %%ok = io:fwrite("~w: ~p~n", [?LINE,G0]), - {G1,Gu,St1} = uexpr(G0, {break,[]}, - St0#kern{guard_refc=St0#kern.guard_refc+1}), - %%ok = io:fwrite("~w: ~p~n", [?LINE,G1]), - {B1,Bu,St2} = umatch(B0, Br, St1#kern{guard_refc=St1#kern.guard_refc-1}), + {G1,Gu,St1} = uexpr(G0, {break,[]}, St0), + {B1,Bu,St2} = umatch(B0, Br, St1), Used = union(Gu, Bu), - {#k_guard_clause{anno=#k{us=Used,ns=[],a=A},guard=G1,body=B1},Used,St2}; + {#k_guard_clause{anno=A,guard=G1,body=B1},Used,St2}; umatch(B0, Br, St0) -> ubody(B0, Br, St0). umatch_list(Ms0, Br, St) -> @@ -2568,6 +2079,19 @@ umatch_list(Ms0, Br, St) -> {[M1|Ms1],union(Mu, Us),Stb} end, {[],[],St}, Ms0). +pat_anno_unused(#k_tuple{es=Es0}=P, Used0, Ps) -> + %% Not extracting unused tuple elements is an optimization for + %% compile time and memory use during compilation. It is probably + %% worthwhile because it is common to extract only a few elements + %% from a huge record. + Used = intersection(Used0, Ps), + Es = [case member(V, Used) of + true -> Var; + false -> set_kanno(Var, [unused|get_kanno(Var)]) + end || #k_var{name=V}=Var <- Es0], + P#k_tuple{es=Es}; +pat_anno_unused(P, _Used, _Ps) -> P. + %% op_vars(Op) -> [VarName]. op_vars(#k_remote{mod=Mod,name=Name}) -> @@ -2579,11 +2103,7 @@ op_vars(Atomic) -> lit_vars(Atomic). %% Return the variables in a literal. lit_vars(#k_var{name=N}) -> [N]; -lit_vars(#k_int{}) -> []; -lit_vars(#k_float{}) -> []; -lit_vars(#k_atom{}) -> []; %%lit_vars(#k_char{}) -> []; -lit_vars(#k_nil{}) -> []; lit_vars(#k_cons{hd=H,tl=T}) -> union(lit_vars(H), lit_vars(T)); lit_vars(#k_map{var=Var,es=Es}) -> @@ -2603,27 +2123,24 @@ lit_list_vars(Ps) -> %% pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}. %% Return variables in a pattern. All variables are new variables -%% except those in the size field of binary segments. -%% and map_pair keys +%% except those in the size field of binary segments and the key +%% field in map_pairs. pat_vars(#k_var{name=N}) -> {[],[N]}; %%pat_vars(#k_char{}) -> {[],[]}; pat_vars(#k_literal{}) -> {[],[]}; -pat_vars(#k_int{}) -> {[],[]}; -pat_vars(#k_float{}) -> {[],[]}; -pat_vars(#k_atom{}) -> {[],[]}; -pat_vars(#k_nil{}) -> {[],[]}; pat_vars(#k_cons{hd=H,tl=T}) -> pat_list_vars([H,T]); pat_vars(#k_binary{segs=V}) -> pat_vars(V); -pat_vars(#k_bin_seg{size=Size,seg=S}) -> - {U1,New} = pat_list_vars([S]), +pat_vars(#k_bin_seg{size=Size,seg=S,next=N}) -> + {U1,New} = pat_list_vars([S,N]), {[],U2} = pat_vars(Size), {union(U1, U2),New}; -pat_vars(#k_bin_int{size=Size}) -> +pat_vars(#k_bin_int{size=Size,next=N}) -> + {[],New} = pat_vars(N), {[],U} = pat_vars(Size), - {U,[]}; + {U,New}; pat_vars(#k_bin_end{}) -> {[],[]}; pat_vars(#k_tuple{es=Es}) -> pat_list_vars(Es); @@ -2646,11 +2163,6 @@ integers(N, M) when N =< M -> [N|integers(N + 1, M)]; integers(_, _) -> []. -%% is_in_guard(State) -> true|false. - -is_in_guard(#kern{guard_refc=Refc}) -> - Refc > 0. - %%% %%% Handling of errors and warnings. %%% @@ -2662,7 +2174,7 @@ is_in_guard(#kern{guard_refc=Refc}) -> format_error({nomatch_shadow,Line}) -> M = io_lib:format("this clause cannot match because a previous clause at line ~p " "always matches", [Line]), - lists:flatten(M); + flatten(M); format_error(nomatch_shadow) -> "this clause cannot match because a previous clause always matches"; format_error(bad_call) -> diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index e26360a6da..582e4f9b12 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -24,19 +24,10 @@ %% this could make including this file difficult. %% N.B. the annotation field is ALWAYS the first field! -%% Kernel annotation record. --record(k, {us, %Used variables - ns, %New variables - a}). %Core annotation - %% Literals %% NO CHARACTERS YET. %%-record(k_char, {anno=[],val}). --record(k_literal, {anno=[],val}). %Only used for complex literals. --record(k_int, {anno=[],val}). --record(k_float, {anno=[],val}). --record(k_atom, {anno=[],val}). --record(k_nil, {anno=[]}). +-record(k_literal, {anno=[],val}). -record(k_tuple, {anno=[],es}). -record(k_map, {anno=[],var=#k_literal{val=#{}},op,es}). @@ -58,19 +49,17 @@ -record(k_seq, {anno=[],arg,body}). -record(k_put, {anno=[],arg,ret=[]}). -record(k_bif, {anno=[],op,args,ret=[]}). --record(k_test, {anno=[],op,args,inverted=false}). +-record(k_test, {anno=[],op,args}). -record(k_call, {anno=[],op,args,ret=[]}). -record(k_enter, {anno=[],op,args}). --record(k_receive, {anno=[],var,body,timeout,action,ret=[]}). --record(k_receive_accept, {anno=[]}). --record(k_receive_next, {anno=[]}). -record(k_try, {anno=[],arg,vars,body,evars,handler,ret=[]}). -record(k_try_enter, {anno=[],arg,vars,body,evars,handler}). --record(k_protected, {anno=[],arg,ret=[],inner}). -record(k_catch, {anno=[],body,ret=[]}). --record(k_guard_match, {anno=[],vars,body,ret=[]}). --record(k_match, {anno=[],vars,body,ret=[]}). +-record(k_letrec_goto, {anno=[],label,first,then,ret=[]}). +-record(k_goto, {anno=[],label}). + +-record(k_match, {anno=[],body,ret=[]}). -record(k_alt, {anno=[],first,then}). -record(k_select, {anno=[],var,types}). -record(k_type_clause, {anno=[],type,values}). @@ -79,7 +68,6 @@ -record(k_guard_clause, {anno=[],guard,body}). -record(k_break, {anno=[],args=[]}). --record(k_guard_break, {anno=[],args=[]}). -record(k_return, {anno=[],args=[]}). %%k_get_anno(Thing) -> element(2, Thing). diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index c12c301ee2..f7479e6b15 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -57,8 +57,6 @@ format(Node, Ctxt) -> format_1(Node, Ctxt); [L,{file,_}] when is_integer(L) -> format_1(Node, Ctxt); - #k{a=Anno}=K when Anno =/= [] -> - format(setelement(2, Node, K#k{a=[]}), Ctxt); List -> format_anno(List, Ctxt, fun (Ctxt1) -> format_1(Node, Ctxt1) @@ -83,11 +81,7 @@ format_anno(Anno, Ctxt0, ObjFun) -> %% format_1(Kexpr, Context) -> string(). -format_1(#k_atom{val=A}, _Ctxt) -> core_atom(A); %%format_1(#k_char{val=C}, _Ctxt) -> io_lib:write_char(C); -format_1(#k_float{val=F}, _Ctxt) -> float_to_list(F); -format_1(#k_int{val=I}, _Ctxt) -> integer_to_list(I); -format_1(#k_nil{}, _Ctxt) -> "[]"; format_1(#k_var{name=V}, _Ctxt) -> if is_atom(V) -> case atom_to_list(V) of @@ -135,10 +129,13 @@ format_1(#k_bin_seg{next=Next}=S, Ctxt) -> [format_bin_seg_1(S, Ctxt), format_bin_seg(Next, ctxt_bump_indent(Ctxt, 2))]; format_1(#k_bin_int{size=Sz,unit=U,flags=Fs,val=Val,next=Next}, Ctxt) -> - S = #k_bin_seg{size=Sz,unit=U,type=integer,flags=Fs,seg=#k_int{val=Val},next=Next}, + S = #k_bin_seg{size=Sz,unit=U,type=integer,flags=Fs, + seg=#k_literal{val=Val},next=Next}, [format_bin_seg_1(S, Ctxt), format_bin_seg(Next, ctxt_bump_indent(Ctxt, 2))]; format_1(#k_bin_end{}, _Ctxt) -> "#<>#"; +format_1(#k_literal{val=A}, _Ctxt) when is_atom(A) -> + core_atom(A); format_1(#k_literal{val=Term}, _Ctxt) -> io_lib:format("~p", [Term]); format_1(#k_local{name=N,arity=A}, Ctxt) -> @@ -158,20 +155,9 @@ format_1(#k_seq{arg=A,body=B}, Ctxt) -> nl_indent(Ctxt) | format(B, Ctxt) ]; -format_1(#k_match{vars=Vs,body=Bs,ret=Rs}, Ctxt) -> +format_1(#k_match{body=Bs,ret=Rs}, Ctxt) -> Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.item_indent), - ["match ", - format_hseq(Vs, ",", ctxt_bump_indent(Ctxt, 6), fun format/2), - nl_indent(Ctxt1), - format(Bs, Ctxt1), - nl_indent(Ctxt), - "end", - format_ret(Rs, Ctxt1) - ]; -format_1(#k_guard_match{vars=Vs,body=Bs,ret=Rs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.item_indent), - ["guard_match ", - format_hseq(Vs, ",", ctxt_bump_indent(Ctxt, 6), fun format/2), + ["match", nl_indent(Ctxt1), format(Bs, Ctxt1), nl_indent(Ctxt), @@ -185,6 +171,20 @@ format_1(#k_alt{first=O,then=T}, Ctxt) -> format(O, Ctxt1), nl_indent(Ctxt1), format(T, Ctxt1)]; +format_1(#k_letrec_goto{label=Label,first=First,then=Then,ret=Rs}, Ctxt) -> + Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.item_indent), + ["letrec_goto ", + atom_to_list(Label), + nl_indent(Ctxt1), + format(Then, Ctxt1), + nl_indent(Ctxt1), + format(First, Ctxt1), + nl_indent(Ctxt), + "end", + format_ret(Rs, Ctxt1) + ]; +format_1(#k_goto{label=Label}, _Ctxt) -> + ["goto ",atom_to_list(Label)]; format_1(#k_select{var=V,types=Cs}, Ctxt) -> Ctxt1 = ctxt_bump_indent(Ctxt, 2), ["select ", @@ -235,13 +235,8 @@ format_1(#k_bif{op=Op,args=As,ret=Rs}, Ctxt) -> [Txt,format_args(As, Ctxt1), format_ret(Rs, Ctxt1) ]; -format_1(#k_test{op=Op,args=As,inverted=Inverted}, Ctxt) -> - Txt = case Inverted of - false -> - ["test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)]; - true -> - ["inverted_test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)] - end, +format_1(#k_test{op=Op,args=As}, Ctxt) -> + Txt = ["test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)], Ctxt1 = ctxt_bump_indent(Ctxt, 2), [Txt,format_args(As, Ctxt1)]; format_1(#k_put{arg=A,ret=Rs}, Ctxt) -> @@ -285,15 +280,6 @@ format_1(#k_try_enter{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) -> nl_indent(Ctxt), "end" ]; -format_1(#k_protected{arg=A,ret=Rs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), - ["protected", - nl_indent(Ctxt1), - format(A, Ctxt1), - nl_indent(Ctxt), - "end", - format_ret(Rs, ctxt_bump_indent(Ctxt, 1)) - ]; format_1(#k_catch{body=B,ret=Rs}, Ctxt) -> Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent), ["catch", @@ -303,34 +289,11 @@ format_1(#k_catch{body=B,ret=Rs}, Ctxt) -> "end", format_ret(Rs, Ctxt1) ]; -format_1(#k_receive{var=V,body=B,timeout=T,action=A,ret=Rs}, Ctxt) -> - Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.item_indent), - ["receive ", - format(V, Ctxt), - nl_indent(Ctxt1), - format(B, Ctxt1), - nl_indent(Ctxt), - "after ", - format(T, ctxt_bump_indent(Ctxt, 6)), - " ->", - nl_indent(Ctxt1), - format(A, Ctxt1), - nl_indent(Ctxt), - "end", - format_ret(Rs, Ctxt1) - ]; -format_1(#k_receive_accept{}, _Ctxt) -> "receive_accept"; -format_1(#k_receive_next{}, _Ctxt) -> "receive_next"; format_1(#k_break{args=As}, Ctxt) -> ["<", format_hseq(As, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), ">" ]; -format_1(#k_guard_break{args=As}, Ctxt) -> - [":<", - format_hseq(As, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), - ">:" - ]; format_1(#k_return{args=As}, Ctxt) -> ["<<", format_hseq(As, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), @@ -347,7 +310,7 @@ format_1(#k_fdef{func=F,arity=A,vars=Vs,body=B}, Ctxt) -> ]; format_1(#k_mdef{name=N,exports=Es,attributes=As,body=B}, Ctxt) -> ["module ", - format(#k_atom{val=N}, ctxt_bump_indent(Ctxt, 7)), + format(#k_literal{val=N}, ctxt_bump_indent(Ctxt, 7)), nl_indent(Ctxt), "export [", format_vseq(Es, @@ -437,17 +400,17 @@ format_fa_pair({F,A}, _Ctxt) -> [core_atom(F),$/,integer_to_list(A)]. %% format_attribute({Name,Val}, Context) -> Txt. format_attribute({Name,Val}, Ctxt) when is_list(Val) -> - Txt = format(#k_atom{val=Name}, Ctxt), + Txt = format(#k_literal{val=Name}, Ctxt), Ctxt1 = ctxt_bump_indent(Ctxt, width(Txt,Ctxt)+4), [Txt," = ", $[,format_vseq(Val, "", ",", Ctxt1, fun (A, _C) -> io_lib:write(A) end),$] ]; format_attribute({Name,Val}, Ctxt) -> - Txt = format(#k_atom{val=Name}, Ctxt), + Txt = format(#k_literal{val=Name}, Ctxt), [Txt," = ",io_lib:write(Val)]. -format_list_tail(#k_nil{anno=[]}, _Ctxt) -> "]"; +format_list_tail(#k_literal{anno=[],val=[]}, _Ctxt) -> "]"; format_list_tail(#k_cons{anno=[],hd=H,tl=T}, Ctxt) -> Txt = [$,|format(H, Ctxt)], Ctxt1 = ctxt_bump_indent(Ctxt, width(Txt, Ctxt)), diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 7be23fbb93..1a6628fc9f 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -16,12 +16,14 @@ MODULES= \ beam_reorder_SUITE \ beam_ssa_SUITE \ beam_type_SUITE \ + beam_types_SUITE \ beam_utils_SUITE \ bif_SUITE \ bs_bincomp_SUITE \ bs_bit_binaries_SUITE \ bs_construct_SUITE \ bs_match_SUITE \ + bs_size_expr_SUITE \ bs_utf_SUITE \ core_alias_SUITE \ core_fold_SUITE \ @@ -59,6 +61,7 @@ NO_OPT= \ bif \ bs_construct \ bs_match \ + bs_size_expr \ bs_utf \ core_fold \ float \ @@ -84,6 +87,7 @@ INLINE= \ bs_bit_binaries \ bs_construct \ bs_match \ + bs_size_expr \ bs_utf \ core_fold \ float \ @@ -101,6 +105,8 @@ R21= \ bs_construct \ bs_match +DIALYZER = bs_match + CORE_MODULES = \ lfe_andor_SUITE \ lfe_guard_SUITE @@ -125,6 +131,8 @@ NO_SSA_OPT_MODULES= $(NO_SSA_OPT:%=%_no_ssa_opt_SUITE) NO_SSA_OPT_ERL_FILES= $(NO_SSA_OPT_MODULES:%=%.erl) NO_TYPE_OPT_MODULES= $(NO_TYPE_OPT:%=%_no_type_opt_SUITE) NO_TYPE_OPT_ERL_FILES= $(NO_TYPE_OPT_MODULES:%=%.erl) +DIALYZER_MODULES= $(DIALYZER:%=%_dialyzer_SUITE) +DIALYZER_ERL_FILES= $(DIALYZER_MODULES:%=%.erl) ERL_FILES= $(MODULES:%=%.erl) CORE_FILES= $(CORE_MODULES:%=%.core) @@ -154,7 +162,8 @@ EBIN = . # ---------------------------------------------------- make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(NO_SSA_OPT_ERL_FILES) \ - $(INLINE_ERL_FILES) $(R21_ERL_FILES) $(NO_MOD_OPT_ERL_FILES) $(NO_TYPE_OPT_ERL_FILES) + $(INLINE_ERL_FILES) $(R21_ERL_FILES) $(NO_MOD_OPT_ERL_FILES) $(NO_TYPE_OPT_ERL_FILES) \ + $(DIALYZER_ERL_FILES) $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ > $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +no_copt +no_postopt \ @@ -175,6 +184,8 @@ make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(NO_SSA_OPT_ERL_FILES -o$(EBIN) $(CORE_MODULES) >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +no_type_opt $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(NO_TYPE_OPT_MODULES) >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile +dialyzer $(ERL_COMPILE_FLAGS) \ + -o$(EBIN) $(DIALYZER_MODULES) >> $(EMAKEFILE) tests debug opt: make_emakefile erl $(ERL_MAKE_FLAGS) -make @@ -211,6 +222,8 @@ docs: %_no_type_opt_SUITE.erl: %_SUITE.erl sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ +%_dialyzer_SUITE.erl: %_SUITE.erl + sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ # ---------------------------------------------------- # Release Target @@ -227,7 +240,8 @@ release_tests_spec: make_emakefile $(INLINE_ERL_FILES) $(R21_ERL_FILES) \ $(NO_MOD_OPT_ERL_FILES) \ $(NO_SSA_OPT_ERL_FILES) \ - $(NO_TYPE_OPT_ERL_FILES) "$(RELSYSDIR)" + $(NO_TYPE_OPT_ERL_FILES) \ + $(DIALYZER_ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(CORE_FILES) "$(RELSYSDIR)" for file in $(ERL_DUMMY_FILES); do \ module=`basename $$file .erl`; \ @@ -236,6 +250,6 @@ release_tests_spec: make_emakefile $(INSTALL_DATA) $(ERL_DUMMY_FILES) "$(RELSYSDIR)" rm $(ERL_DUMMY_FILES) chmod -R u+w "$(RELSYSDIR)" - @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) + @tar cf - *_SUITE_data property_test | (cd "$(RELSYSDIR)"; tar xf -) release_docs_spec: diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index 5c463063c1..7232eb0ffd 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -66,6 +66,17 @@ t_case(Config) when is_list(Config) -> true = (catch t_case_e({a,b}, {a,b})), false = (catch t_case_e({a,b}, 42)), + {true,false} = t_case_f1(true, pos), + {false,true} = t_case_f1(true, whatever), + {false,true} = t_case_f1(false, pos), + {false,true} = t_case_f1(false, whatever), + {false,false} = t_case_f1(not_boolean, pos), + {false,false} = t_case_f1(not_boolean, whatever), + + false = t_case_f2(true), + true = t_case_f2(false), + false = t_case_f2(whatever), + true = t_case_xy(42, 100, 700), true = t_case_xy(42, 100, whatever), false = t_case_xy(42, wrong, 700), @@ -109,6 +120,25 @@ t_case_e(A, B) -> Bool when is_tuple(A) -> id(Bool) end. +t_case_f1(IsInt, Eval) -> + B = case IsInt of + true -> Eval =:= pos; + false -> false; + _ -> IsInt + end, + + %% The above is the same as `IsInt andalso Eval =:= pos` in a guard. + %% In a real guard, variable `B` will only be used once. + {B =:= true, B =:= false}. + +t_case_f2(IsInt) -> + B = case IsInt of + true -> false; + false -> true; + _ -> IsInt + end, + B =:= true. + t_case_xy(X, Y, Z) -> Res = t_case_x(X, Y, Z), Res = t_case_y(X, Y, Z). diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index c8dfc81969..7ffaf54609 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -127,19 +127,26 @@ coverage(_) -> {'EXIT',{function_clause,[{?MODULE,foobar,[[fail],1,2], [{file,"fake.erl"},{line,16}]}|_]}} = (catch foobar([fail], 1, 2)), - {'EXIT',{function_clause,[{?MODULE,fake_function_clause,[{a,b},42.0],_}|_]}} = - (catch fake_function_clause({a,b})), + {'EXIT',{function_clause,[{?MODULE,fake_function_clause1,[{a,b},42.0],_}|_]}} = + (catch fake_function_clause1({a,b})), + + {'EXIT',{function_clause,[{?MODULE,fake_function_clause2,[42|bad_tl],_}|_]}} = + (catch fake_function_clause2(42, bad_tl)), + {'EXIT',{function_clause,[{?MODULE,fake_function_clause3,[x,y],_}|_]}} = + (catch fake_function_clause3(42, id([x,y]))), {'EXIT',{{badmatch,0.0},_}} = (catch coverage_1(id(42))), {'EXIT',{badarith,_}} = (catch coverage_1(id(a))), + ok. coverage_1(X) -> %% ERL-1167: Would crash beam_except. true = 0 / X. -fake_function_clause(A) -> error(function_clause, [A,42.0]). - +fake_function_clause1(A) -> error(function_clause, [A,42.0]). +fake_function_clause2(A, Tl) -> error(function_clause, [A|Tl]). +fake_function_clause3(_, Stk) -> error(function_clause, Stk). binary_construction_allocation(_Config) -> ok = do_binary_construction_allocation("PUT"), diff --git a/lib/compiler/test/beam_ssa_SUITE.erl b/lib/compiler/test/beam_ssa_SUITE.erl index 26676644b7..d687fcfab7 100644 --- a/lib/compiler/test/beam_ssa_SUITE.erl +++ b/lib/compiler/test/beam_ssa_SUITE.erl @@ -23,7 +23,7 @@ init_per_group/2,end_per_group/2, calls/1,tuple_matching/1,recv/1,maps/1, cover_ssa_dead/1,combine_sw/1,share_opt/1, - beam_ssa_dead_crash/1,stack_init/1]). + beam_ssa_dead_crash/1,stack_init/1,grab_bag/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -40,7 +40,8 @@ groups() -> combine_sw, share_opt, beam_ssa_dead_crash, - stack_init + stack_init, + grab_bag ]}]. init_per_suite(Config) -> @@ -208,6 +209,8 @@ recv(_Config) -> %% tricky_recv_6/0 is a compile-time error. tricky_recv_6(), + recv_coverage(), + ok. sync_wait_mon({Pid, Ref}, Timeout) -> @@ -357,7 +360,7 @@ tricky_recv_5a() -> %% When fixing tricky_recv_5, we introduced a compiler crash when the common -%% exit block was ?BADARG_BLOCK and floats were in the picture. +%% exit block was ?EXCEPTION_BLOCK and floats were in the picture. tricky_recv_6() -> RefA = make_ref(), RefB = make_ref(), @@ -368,6 +371,69 @@ tricky_recv_6() -> ok end. +recv_coverage() -> + self() ! 1, + a = recv_coverage_1(), + self() ! 2, + b = recv_coverage_1(), + + self() ! 1, + a = recv_coverage_2(), + self() ! 2, + b = recv_coverage_2(), + + ok. + +%% Similar to tricky_recv_5/0, but provides test coverage for the #b_switch{} +%% terminator. +recv_coverage_1() -> + receive + X=1 -> + %% Jump to common exit block through #b_switch{list=L} + case id(0) of + 0 -> a; + 1 -> b; + 2 -> c; + 3 -> d + end; + X=2 -> + %% Jump to common exit block through #b_switch{fail=F} + case id(42) of + 0 -> exit(quit); + 1 -> exit(quit); + 2 -> exit(quit); + 3 -> exit(quit); + _ -> b + end + end, + case X of + 1 -> a; + 2 -> b + end. + +%% Similar to recv_coverage_1/0, providing test coverage for #b_br{}. +recv_coverage_2() -> + receive + X=1 -> + A = id(1), + %% Jump to common exit block through #b_br{succ=S}. + if + A =:= 1 -> a; + true -> exit(quit) + end; + X=2 -> + A = id(2), + %% Jump to common exit block through #b_br{fail=F}. + if + A =:= 1 -> exit(quit); + true -> a + end + end, + case X of + 1 -> a; + 2 -> b + end. + maps(_Config) -> {'EXIT',{{badmatch,#{}},_}} = (catch maps_1(any)), ok. @@ -419,48 +485,8 @@ cover_ssa_dead(_Config) -> 40.0 = percentage(4.0, 10.0), 60.0 = percentage(6, 10), - %% Cover '=:=', followed by '=/='. - false = 'cover__=:=__=/='(41), - true = 'cover__=:=__=/='(42), - false = 'cover__=:=__=/='(43), - - %% Cover '<', followed by '=/='. - true = 'cover__<__=/='(41), - false = 'cover__<__=/='(42), - false = 'cover__<__=/='(43), - - %% Cover '=<', followed by '=/='. - true = 'cover__=<__=/='(41), - true = 'cover__=<__=/='(42), - false = 'cover__=<__=/='(43), - - %% Cover '>=', followed by '=/='. - false = 'cover__>=__=/='(41), - true = 'cover__>=__=/='(42), - true = 'cover__>=__=/='(43), - - %% Cover '>', followed by '=/='. - false = 'cover__>__=/='(41), - false = 'cover__>__=/='(42), - true = 'cover__>__=/='(43), - ok. -'cover__=:=__=/='(X) when X =:= 42 -> X =/= 43; -'cover__=:=__=/='(_) -> false. - -'cover__<__=/='(X) when X < 42 -> X =/= 42; -'cover__<__=/='(_) -> false. - -'cover__=<__=/='(X) when X =< 42 -> X =/= 43; -'cover__=<__=/='(_) -> false. - -'cover__>=__=/='(X) when X >= 42 -> X =/= 41; -'cover__>=__=/='(_) -> false. - -'cover__>__=/='(X) when X > 42 -> X =/= 42; -'cover__>__=/='(_) -> false. - format_str(Str, FormatData, IoList, EscChars) -> Escapable = FormatData =:= escapable, case id(Str) of @@ -668,5 +694,72 @@ stack_init(Key, Map) -> %% (if the second clause was executed). id(Res). +grab_bag(_Config) -> + {'EXIT',_} = (catch grab_bag_1()), + {'EXIT',_} = (catch grab_bag_2()), + {'EXIT',_} = (catch grab_bag_3()), + {'EXIT',_} = (catch grab_bag_4()), + ok. + +grab_bag_1() -> + %% beam_kernel_to_ssa would crash when attempting to translate a make_fun + %% instruction without a destination variable. + (catch fun () -> 15 end)(true#{}). + +grab_bag_2() -> + %% is_guard_cg_safe/1 will be called with #cg_unreachable{}, which was + %% not handled. + 27 + or + try + try + x#{} + catch + _:_ -> + [] + end + after + false + end. + +grab_bag_3() -> + case + fun (V0) + when + %% The only thing left after optimizations would be + %% a bs_add instruction not followed by succeeded, + %% which would crash beam_ssa_codegen because there + %% was no failure label available. + binary_part(<<>>, + <<V0:V0/unit:196>>) -> + [] + end + of + <<>> -> + [] + end. + +grab_bag_4() -> + %% beam_kernel_to_ssa would crash because there was a #cg_phi{} + %% instruction that was not referenced from any #cg_break{}. + case $f of + V0 -> + try + try fy of + V0 -> + fu + catch + throw:$s -> + fy + end + catch + error:#{#{[] + [] => []} := false} when [] -> + fy + after + ok + end + end. + + %% The identity function. id(I) -> I. diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index a99dee48aa..4ec427cdec 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -85,6 +85,8 @@ integers(_Config) -> two = do_integers_5(0, 2), three = do_integers_5(0, 3), + {'EXIT',{badarith,_}} = (catch do_integers_6()), + ok. do_integers_1(B0) -> @@ -131,6 +133,9 @@ do_integers_5(X0, Y0) -> 3 -> three end. +do_integers_6() -> + try b after 1 end band 0. + numbers(_Config) -> Int = id(42), true = is_integer(Int), diff --git a/lib/compiler/test/beam_types_SUITE.erl b/lib/compiler/test/beam_types_SUITE.erl new file mode 100644 index 0000000000..4fbf6a130e --- /dev/null +++ b/lib/compiler/test/beam_types_SUITE.erl @@ -0,0 +1,166 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_types_SUITE). + +-define(BEAM_TYPES_INTERNAL, true). +-include_lib("compiler/src/beam_types.hrl"). + +-export([all/0, suite/0, groups/0, + init_per_suite/1, end_per_suite/1]). + +-export([absorption/1, + associativity/1, + commutativity/1, + idempotence/1, + identity/1, + subtraction/1]). + +-export([binary_absorption/1, + integer_absorption/1, + integer_associativity/1, + tuple_absorption/1, + tuple_set_limit/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group,property_tests}, + binary_absorption, + integer_absorption, + integer_associativity, + tuple_absorption, + tuple_set_limit]. + +groups() -> + [{property_tests,[parallel], + [absorption, + associativity, + commutativity, + idempotence, + identity, + subtraction]}]. + +init_per_suite(Config) -> + ct_property_test:init_per_suite(Config). + +end_per_suite(Config) -> + Config. + +absorption(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:absorption()). + true = ct_property_test:quickcheck(beam_types_prop:absorption(), Config). + +associativity(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:associativity()). + true = ct_property_test:quickcheck(beam_types_prop:associativity(), Config). + +commutativity(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:commutativity()). + true = ct_property_test:quickcheck(beam_types_prop:commutativity(), Config). + +idempotence(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:idempotence()). + true = ct_property_test:quickcheck(beam_types_prop:idempotence(), Config). + +identity(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:identity()). + true = ct_property_test:quickcheck(beam_types_prop:identity(), Config). + +subtraction(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:subtraction()). + true = ct_property_test:quickcheck(beam_types_prop:subtraction(), Config). + +binary_absorption(Config) when is_list(Config) -> + %% These binaries should meet into {binary,12} as that's the best common + %% unit for both types. + A = #t_bitstring{size_unit=4}, + B = #t_bitstring{size_unit=6}, + + #t_bitstring{size_unit=12} = beam_types:meet(A, B), + #t_bitstring{size_unit=2} = beam_types:join(A, B), + + A = beam_types:meet(A, beam_types:join(A, B)), + A = beam_types:join(A, beam_types:meet(A, B)), + + ok. + +integer_absorption(Config) when is_list(Config) -> + %% Integers that don't overlap at all should never meet. + A = #t_integer{elements={2,3}}, + B = #t_integer{elements={4,5}}, + + none = beam_types:meet(A, B), + #t_integer{elements={2,5}} = beam_types:join(A, B), + + A = beam_types:meet(A, beam_types:join(A, B)), + A = beam_types:join(A, beam_types:meet(A, B)), + + ok. + +integer_associativity(Config) when is_list(Config) -> + A = #t_integer{elements={3,5}}, + B = #t_integer{elements={4,6}}, + C = #t_integer{elements={5,5}}, + + %% a ∨ (b ∨ c) = (a ∨ b) ∨ c, + LHS_Join = beam_types:join(A, beam_types:join(B, C)), + RHS_Join = beam_types:join(beam_types:join(A, B), C), + #t_integer{elements={3,6}} = LHS_Join = RHS_Join, + + %% a ∧ (b ∧ c) = (a ∧ b) ∧ c. + LHS_Meet = beam_types:meet(A, beam_types:meet(B, C)), + RHS_Meet = beam_types:meet(beam_types:meet(A, B), C), + #t_integer{elements={5,5}} = LHS_Meet = RHS_Meet, + + ok. + +tuple_absorption(Config) when is_list(Config) -> + %% An inexact tuple can't meet an exact one that's smaller + + A = #t_tuple{size=3,exact=true, + elements=#{1 => #t_atom{elements=[gurka]}}}, + B = #t_tuple{size=5,exact=false, + elements=#{3 => #t_atom{elements=[gaffel]}}}, + + A = beam_types:meet(A, beam_types:join(A, B)), + A = beam_types:join(A, beam_types:meet(A, B)), + + ok. + +tuple_set_limit(Config) when is_list(Config) -> + %% When joining two tuple sets of differing sizes, the resulting set could + %% become larger than ?TUPLE_SET_LIMIT. + + As = [#t_tuple{size=N,exact=true, + elements=#{ 1 => #t_integer{elements={N,N}} }} || + N <- lists:seq(1, ?TUPLE_SET_LIMIT)], + + Bs = [#t_tuple{size=1,exact=true, + elements=#{ 1 => #t_integer{elements={N,N}} }} || + N <- lists:seq(1, ?TUPLE_SET_LIMIT)], + + A = beam_types:join(As), + B = beam_types:join(Bs), + + beam_types:verified_type(beam_types:join(A, B)), + + ok. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index a3f42213e8..89981f1992 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -35,7 +35,8 @@ map_field_lists/1,cover_bin_opt/1, val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1, receive_stacked/1,aliased_types/1,type_conflict/1, - infer_on_eq/1,infer_dead_value/1, + infer_on_eq/1,infer_dead_value/1,infer_on_ne/1, + branch_to_try_handler/1,call_without_stack/1, receive_marker/1,safe_instructions/1, missing_return_type/1]). @@ -67,8 +68,10 @@ groups() -> map_field_lists,cover_bin_opt,val_dsetel, bad_tuples,bad_try_catch_nesting, receive_stacked,aliased_types,type_conflict, - infer_on_eq,infer_dead_value,receive_marker, - safe_instructions,missing_return_type]}]. + infer_on_eq,infer_dead_value,infer_on_ne, + branch_to_try_handler,call_without_stack, + receive_marker,safe_instructions, + missing_return_type]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -151,19 +154,34 @@ stack(Config) when is_list(Config) -> call_last(Config) when is_list(Config) -> Errors = do_val(call_last, Config), - [{{t,a,1},{{call_last,1,{f,8},2},9,{allocated,1}}}, + [{{t,a,1}, + {{call_last,1,{f,8},2},9,{allocated,1}}}, {{t,b,1}, - {{call_ext_last,2,{extfunc,lists,seq,2},2}, - 10, - {allocated,1}}}] = Errors, + {{call_ext_last,2,{extfunc,lists,seq,2},2},10,{allocated,1}}}, + {{t,baz,2}, + {{call_ext_only,2,{extfunc,erlang,put,2}},5,{allocated,0}}}, + {{t,biz,2}, + {{call_only,2,{f,10}},5,{allocated,0}}}] = Errors, + ok. + +call_without_stack(Config) when is_list(Config) -> + Errors = do_val(call_without_stack, Config), + [{{t,local,2}, + {{call,2,{f,2}},4,{allocated,none}}}, + {{t,remote,2}, + {{call_ext,2,{extfunc,lists,seq,2}},4,{allocated,none}}}] = Errors, ok. merge_undefined(Config) when is_list(Config) -> Errors = do_val(merge_undefined, Config), - [{{t,handle_call,2}, + [{{t,undecided,2}, {{call_ext,2,{extfunc,debug,filter,2}}, 22, - {uninitialized_reg,{y,_}}}}] = Errors, + {allocated,undecided}}}, + {{t,uninitialized,2}, + {{call_ext,2,{extfunc,io,format,2}}, + 17, + {uninitialized_reg,{y,1}}}}] = Errors, ok. uninit(Config) when is_list(Config) -> @@ -220,11 +238,11 @@ bad_catch_try(Config) when is_list(Config) -> {{catch_end,{x,9}}, 8,{invalid_tag_register,{x,9}}}}, {{bad_catch_try,bad_3,1}, - {{catch_end,{y,1}},9,{invalid_tag,{y,1},{atom,kalle}}}}, + {{catch_end,{y,1}},9,{invalid_tag,{y,1},{t_atom,[kalle]}}}}, {{bad_catch_try,bad_4,1}, {{'try',{x,0},{f,15}},5,{invalid_tag_register,{x,0}}}}, {{bad_catch_try,bad_5,1}, - {{try_case,{y,1}},12,{invalid_tag,{y,1},term}}}, + {{try_case,{y,1}},12,{invalid_tag,{y,1},any}}}, {{bad_catch_try,bad_6,1}, {{move,{integer,1},{y,1}},7, {invalid_store,{y,1}}}}] = Errors, @@ -235,7 +253,7 @@ cons_guard(Config) when is_list(Config) -> [{{cons,foo,1}, {{get_list,{x,0},{x,1},{x,2}}, 5, - {bad_type,{needed,cons},{actual,term}}}}] = Errors, + {bad_type,{needed,{t_cons,any,any}},{actual,any}}}}] = Errors, ok. freg_range(Config) when is_list(Config) -> @@ -266,7 +284,7 @@ freg_uninit(Config) when is_list(Config) -> {uninitialized_reg,{fr,1}}}}, {{t,sum_2,2}, {{bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,0}}, - 9, + 10, {uninitialized_reg,{fr,0}}}}] = Errors, ok. @@ -523,9 +541,9 @@ bad_tuples(Config) -> {{bad_tuples,long,2}, {{put,{atom,too_long}},8,not_building_a_tuple}}, {{bad_tuples,self_referential,1}, - {{put,{x,1}},7,{tuple_in_progress,{x,1}}}}, + {{put,{x,1}},7,{unfinished_tuple,{x,1}}}}, {{bad_tuples,short,1}, - {{move,{x,1},{x,0}},7,{tuple_in_progress,{x,1}}}}] = Errors, + {{move,{x,1},{x,0}},7,{unfinished_tuple,{x,1}}}}] = Errors, ok. @@ -708,6 +726,25 @@ idv_1({_A, _B, _C, _D, _E, F, G}, idv_1(_A, _B) -> error. +%% ERL-998; type inference for select_val (#b_switch{}) was more clever than +%% that for is_ne_exact (#b_br{}), sometimes failing validation when the type +%% optimization pass acted on the former and the validator got the latter. + +-record(ion, {state}). + +infer_on_ne(Config) when is_list(Config) -> + #ion{state = closing} = ion_1(#ion{ state = id(open) }), + #ion{state = closing} = ion_close(#ion{ state = open }), + ok. + +ion_1(State = #ion{state = open}) -> ion_2(State); +ion_1(State = #ion{state = closing}) -> ion_2(State). + +ion_2(State = #ion{state = open}) -> ion_close(State); +ion_2(#ion{state = closing}) -> ok. + +ion_close(State = #ion{}) -> State#ion{state = closing}. + %% ERL-995: The first solution to ERIERL-348 was incomplete and caused %% validation to fail when living values depended on delayed type inference on %% "dead" values. @@ -725,6 +762,17 @@ idv_2(State) -> idv_called_once(_State) -> ok. +%% Direct jumps to try/catch handlers crash the emulator and must fail +%% validation. This is provoked by OTP-15945. + +branch_to_try_handler(Config) -> + Errors = do_val(branch_to_try_handler, Config), + [{{branch_to_try_handler,main,1}, + {{bif,tuple_size,{f,3},[{y,0}],{x,0}}, + 12, + {illegal_branch,try_handler,3}}}] = Errors, + ok. + receive_marker(Config) when is_list(Config) -> Errors = do_val(receive_marker, Config), diff --git a/lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S b/lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S new file mode 100644 index 0000000000..6d43ec7b54 --- /dev/null +++ b/lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S @@ -0,0 +1,48 @@ +{module, branch_to_try_handler}. %% version = 0 + +{exports, [{main,1}]}. + +{attributes, []}. + +{labels, 11}. + +{function, main, 1, 2}. + {label,1}. + {line,[{location,"t.erl",4}]}. + {func_info,{atom,branch_to_try_handler},{atom,main},1}. + {label,2}. + {allocate,2,1}. + {move,{x,0},{y,0}}. + {'try',{y,1},{f,3}}. + {move,{atom,ignored},{x,0}}. + {line,[{location,"t.erl",6}]}. + {call,1,{f,6}}. + {'%',{type_info,{x,0},{t_atom,[ignored]}}}. + {line,[{location,"t.erl",7}]}. + %% + %% Fail directly to the try handler instead of throwing an exception; this + %% will crash the emulator. + %% + {bif,tuple_size,{f,3},[{y,0}],{x,0}}. + %% + {test,is_eq_exact,{f,4},[{x,0},{integer,1}]}. + {move,{atom,error},{x,0}}. + {try_end,{y,1}}. + {deallocate,2}. + return. + {label,3}. + {try_case,{y,1}}. + {move,{atom,ok},{x,0}}. + {deallocate,2}. + return. + {label,4}. + {line,[{location,"t.erl",7}]}. + {badmatch,{x,0}}. + +{function, id, 1, 6}. + {label,5}. + {line,[{location,"t.erl",13}]}. + {func_info,{atom,branch_to_try_handler},{atom,id},1}. + {label,6}. + {'%',{type_info,{x,0},{t_atom,[ignored]}}}. + return. diff --git a/lib/compiler/test/beam_validator_SUITE_data/call_last.S b/lib/compiler/test/beam_validator_SUITE_data/call_last.S index 827b6c0ae6..ff81da1b57 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/call_last.S +++ b/lib/compiler/test/beam_validator_SUITE_data/call_last.S @@ -1,6 +1,6 @@ {module, call_last}. %% version = 0 -{exports, [{a,1},{b,1},{bar,1},{foo,1},{module_info,0},{module_info,1}]}. +{exports, [{a,1},{b,1},{bar,1},{foo,1},{baz,2},{biz,2}]}. {attributes, []}. @@ -53,19 +53,16 @@ {'%live',1}. return. - -{function, module_info, 0, 10}. +{function, baz, 2, 10}. {label,9}. - {func_info,{atom,t},{atom,module_info},0}. + {func_info,{atom,t},{atom,baz},2}. {label,10}. - {move,{atom,t},{x,0}}. - {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. - + {allocate,0,2}. + {call_ext_only,2,{extfunc,erlang,put,2}}. -{function, module_info, 1, 12}. +{function, biz, 2, 12}. {label,11}. - {func_info,{atom,t},{atom,module_info},1}. + {func_info,{atom,t},{atom,biz},2}. {label,12}. - {move,{x,0},{x,1}}. - {move,{atom,t},{x,0}}. - {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. + {allocate,0,2}. + {call_only,2,{f,10}}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/call_without_stack.S b/lib/compiler/test/beam_validator_SUITE_data/call_without_stack.S new file mode 100644 index 0000000000..9ccbc163e3 --- /dev/null +++ b/lib/compiler/test/beam_validator_SUITE_data/call_without_stack.S @@ -0,0 +1,21 @@ +{module, call_without_stack}. %% version = 0 + +{exports, [{remote,2},{local,2}]}. + +{attributes, []}. + +{labels, 9}. + +{function, remote, 2, 2}. + {label,1}. + {func_info,{atom,t},{atom,remote},2}. + {label,2}. + {call_ext,2,{extfunc,lists,seq,2}}. + if_end. + +{function, local, 2, 4}. + {label,3}. + {func_info,{atom,t},{atom,local},2}. + {label,4}. + {call,2,{f,2}}. + if_end. diff --git a/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S b/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S index 71e833446a..2d4cbc9388 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S +++ b/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S @@ -21,12 +21,14 @@ {label,3}. {func_info,{atom,t},{atom,sum_2},2}. {label,4}. + {allocate,0,2}. {fconv,{x,0},{fr,0}}. {fconv,{x,1},{fr,1}}. fclearerror. {fcheckerror,{f,0}}. {call,2,{f,6}}. {bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,0}}. + {deallocate,0}. return. {function, foo, 2, 6}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S b/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S index aa344807e4..3035471f04 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S +++ b/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S @@ -1,15 +1,14 @@ {module, merge_undefined}. %% version = 0 -{exports, [{bar,2},{foo,1},{handle_call,2},{module_info,0},{module_info,1}]}. +{exports, [{uninitialized,2},{undecided,2}]}. {attributes, []}. {labels, 15}. - -{function, handle_call, 2, 2}. +{function, uninitialized, 2, 2}. {label,1}. - {func_info,{atom,t},{atom,handle_call},2}. + {func_info,{atom,t},{atom,uninitialized},2}. {label,2}. {test,is_atom,{f,1},[{x,0}]}. {select_val,{x,0},{f,1},{list,[{atom,gurka},{f,3},{atom,delete},{f,4}]}}. @@ -21,7 +20,7 @@ {move,{atom,nisse},{x,0}}. {call_ext,1,{extfunc,erlang,exit,1}}. {label,4}. - {allocate_heap,1,6,2}. + {allocate_heap,2,6,2}. {move,{x,1},{y,0}}. {put_list,{integer,112},nil,{x,0}}. {put_list,{integer,126},{x,0},{x,0}}. @@ -51,37 +50,57 @@ {call_ext,1,{extfunc,erlang,exit,1}}. {label,6}. {move,{y,0},{x,0}}. - {call_last,1,{f,8},1}. + {call_last,1,{f,14},1}. - -{function, foo, 1, 8}. +{function, undecided, 2, 8}. {label,7}. - {func_info,{atom,t},{atom,foo},1}. + {func_info,{atom,t},{atom,undecided},2}. {label,8}. - {move,{atom,ok},{x,0}}. - return. - - -{function, bar, 2, 10}. + {test,is_atom,{f,7},[{x,0}]}. + {select_val,{x,0},{f,1},{list,[{atom,gurka},{f,9},{atom,delete},{f,10}]}}. {label,9}. - {func_info,{atom,t},{atom,bar},2}. + {allocate_heap,2,6,2}. + {test,is_eq_exact,{f,11},[{x,0},{atom,ok}]}. + %% This is unreachable since {x,0} is known not to be 'ok'. We should not + %% fail with "uninitialized y registers" on erlang:exit/1 + {move,{atom,nisse},{x,0}}. + {call_ext,1,{extfunc,erlang,exit,1}}. {label,10}. - {move,{atom,ok},{x,0}}. - return. - - -{function, module_info, 0, 12}. + {allocate_heap,1,6,2}. + {move,{x,1},{y,0}}. + {put_list,{integer,112},nil,{x,0}}. + {put_list,{integer,126},{x,0},{x,0}}. + {put_list,{y,0},nil,{x,1}}. + {'%live',2}. + {call_ext,2,{extfunc,io,format,2}}. + {test,is_ne_exact,{f,12},[{x,0},{atom,ok}]}. {label,11}. - {func_info,{atom,t},{atom,module_info},0}. + %% The number of allocated Y registers are in conflict here. + {move,{atom,logReader},{x,1}}. + {move,{atom,console},{x,0}}. + {call_ext,2,{extfunc,debug,filter,2}}. + {test_heap,14,1}. + {put_list,{atom,logReader},nil,{x,1}}. + {put_list,{atom,console},{x,1},{x,1}}. + {put_tuple,3,{x,2}}. + {put,{atom,debug}}. + {put,{atom,filter}}. + {put,{x,1}}. + {put_tuple,2,{x,1}}. + {put,{x,2}}. + {put,{x,0}}. + {put_tuple,2,{x,0}}. + {put,{atom,badmatch}}. + {put,{x,1}}. + {'%live',1}. + {call_ext,1,{extfunc,erlang,exit,1}}. {label,12}. - {move,{atom,t},{x,0}}. - {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. - + {move,{y,0},{x,0}}. + {call_last,1,{f,8},1}. -{function, module_info, 1, 14}. +{function, foo, 1, 14}. {label,13}. - {func_info,{atom,t},{atom,module_info},1}. + {func_info,{atom,t},{atom,foo},1}. {label,14}. - {move,{x,0},{x,1}}. - {move,{atom,t},{x,0}}. - {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. + {move,{atom,ok},{x,0}}. + return. diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl index 0419b16eea..eade3ff93f 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_SUITE.erl @@ -191,7 +191,13 @@ coverage_trimmer(Params) -> coverage_summer(A, B, C, D) -> A+B+C+D. nomatch(Config) when is_list(Config) -> + Bin = id(<<1,2,3,4,5>>), <<>> = << <<X:8>> || X = {_,_} = [_|_] <- [1,2,3] >>, + [] = [X || <<X:all/binary>> <= Bin], + [] = [X || <<X:bad/binary>> <= Bin], + <<>> = << <<X:32>> || <<X:all/binary>> <= Bin >>, + <<>> = << <<X:32>> || <<X:bad/binary>> <= Bin >>, + ok. sizes(Config) when is_list(Config) -> diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index bccd70d6cb..1c61d6cce4 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -31,7 +31,7 @@ two/1,test1/1,fail/1,float_bin/1,in_guard/1,in_catch/1, nasty_literals/1,coerce_to_float/1,side_effect/1, opt/1,otp_7556/1,float_arith/1,otp_8054/1, - cover/1]). + cover/1,bad_size/1]). -include_lib("common_test/include/ct.hrl"). @@ -47,7 +47,7 @@ groups() -> [verify_highest_opcode, two,test1,fail,float_bin,in_guard,in_catch, nasty_literals,side_effect,opt,otp_7556,float_arith, - otp_8054,cover]}]. + otp_8054,cover,bad_size]}]. init_per_suite(Config) -> @@ -332,6 +332,24 @@ fail(Config) when is_list(Config) -> %% Unaligned sizes with literal binaries. {'EXIT',{badarg,_}} = (catch <<0,(<<7777:17>>)/binary>>), + %% Make sure that variables are bound even if binary + %% construction fails. + {'EXIT',{badarg,_}} = (catch case <<face:(V0 = 42)>> of + _Any -> V0 + end), + {'EXIT',{badarg,_}} = (catch case <<face:(V1 = 3)>> of + a when V1 -> + office + end), + {'EXIT',{badarg,_}} = (catch <<13:(put(?FUNCTION_NAME, 17))>>), + 17 = erase(?FUNCTION_NAME), + + %% Size exceeds length of binary. 'native' is redundant for + %% binaries, but when it was present sys_core_fold would not + %% detect the overlong binary and beam_ssa_opt would crash. + {'EXIT',{badarg,_}} = (catch << <<$t/little-signed>>:42/native-bytes >>), + {'EXIT',{badarg,_}} = (catch << <<$t/little-signed>>:42/bytes >>), + ok. float_bin(Config) when is_list(Config) -> @@ -559,6 +577,7 @@ otp_7556(Bin, A, B, C) -> float_arith(Config) when is_list(Config) -> {<<1,2,3,64,69,0,0,0,0,0,0>>,21.0} = do_float_arith(<<1,2,3>>, 42, 2), + ok. do_float_arith(Bin0, X, Y) -> @@ -597,3 +616,30 @@ cover(Config) -> Bin = id(<<L:32,?LONG_STRING>>), <<L:32,?LONG_STRING>> = Bin, ok. + +bad_size(_Config) -> + {'EXIT',{badarg,_}} = (catch bad_float_size()), + {'EXIT',{badarg,_}} = (catch bad_float_size(<<"abc">>)), + {'EXIT',{badarg,_}} = (catch bad_integer_size()), + {'EXIT',{badarg,_}} = (catch bad_integer_size(<<"xyz">>)), + {'EXIT',{badarg,_}} = (catch bad_binary_size()), + {'EXIT',{badarg,_}} = (catch bad_binary_size(<<"xyz">>)), + ok. + +bad_float_size() -> + <<4.087073429964284:case 0 of 0 -> art end/float>>. + +bad_float_size(Bin) -> + <<Bin/binary,4.087073429964284:case 0 of 0 -> art end/float>>. + +bad_integer_size() -> + <<0:case 0 of 0 -> art end/integer>>. + +bad_integer_size(Bin) -> + <<Bin/binary,0:case 0 of 0 -> art end/integer>>. + +bad_binary_size() -> + <<<<"abc">>:case 0 of 0 -> art end/binary>>. + +bad_binary_size(Bin) -> + <<Bin/binary,<<"abc">>:case 0 of 0 -> art end/binary>>. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index a789b82910..226d526534 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -24,7 +24,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, - verify_highest_opcode/1, + verify_highest_opcode/1, expand_and_squeeze/1, size_shadow/1,int_float/1,otp_5269/1,null_fields/1,wiger/1, bin_tail/1,save_restore/1, partitioned_bs_match/1,function_clause/1, @@ -45,7 +45,8 @@ expression_before_match/1,erl_689/1,restore_on_call/1, restore_after_catch/1,matches_on_parameter/1,big_positions/1, matching_meets_apply/1,bs_start_match2_defs/1, - exceptions_after_match_failure/1, bad_phi_paths/1]). + exceptions_after_match_failure/1, + bad_phi_paths/1,many_clauses/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -61,10 +62,10 @@ all() -> [{group,p}]. groups() -> - [{p,[], + [{p,test_lib:parallel(), [verify_highest_opcode, size_shadow,int_float,otp_5269,null_fields,wiger, - bin_tail,save_restore, + bin_tail,save_restore,expand_and_squeeze, partitioned_bs_match,function_clause,unit, shared_sub_bins,bin_and_float,dec_subidentifiers, skip_optional_tag,decode_integer,wfbm,degenerated_match,bs_sum, @@ -82,8 +83,8 @@ groups() -> expression_before_match,erl_689,restore_on_call, matches_on_parameter,big_positions, matching_meets_apply,bs_start_match2_defs, - exceptions_after_match_failure,bad_phi_paths]}]. - + exceptions_after_match_failure,bad_phi_paths, + many_clauses]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -137,22 +138,59 @@ size_shadow(Config) when is_list(Config) -> size_shadow_1() -> L = 8, - F = fun(<<L:L,B:L>>) -> B end, - F(<<16:8, 7:16>>). + Fs = [fun(<<L:L,B:L>>) -> B end, + fun(A) -> + (fun([<<L:L,B:L>>]) -> B end)([A]) + end, + fun(A) -> + (fun([<<L:L,B:L>>,<<L:L,B:L>>]) -> B end)([A,A]) + end, + fun(A) -> + <<Size:L,_/bits>> = A, + Inner = fun([L], {#{key1 := <<L:L,B:L>>, + key2 := <<L:L,B:L>>}, L}) -> B end, + Inner([Size], {#{key1 => A,key2 => A},Size}) + end], + size_shadow_apply(Fs, <<16:8, 7:16>>). size_shadow_2(L) -> - F = fun(<<L:L,B:L>>) -> B end, - F(<<16:8, 7:16>>). + Fs = [fun(<<L:L,B:L>>) -> B end, + fun(A) -> + (fun([<<L:L,B:L>>]) -> B end)([A]) + end, + fun(A) -> + (fun({<<L:L,B:L>>,<<L:L,B:L>>}) -> B end)({A,A}) + end], + size_shadow_apply(Fs, <<16:8, 7:16>>). size_shadow_3() -> L = 8, - F = fun(<<L:L,B:L,L:L>>) -> B end, - F(<<16:8, 7:16,16:16>>). + Fs = [fun(<<L:L,B:L,L:L>>) -> B end, + fun(A) -> + (fun({tag,[<<L:L,B:L,L:L>>]}) -> B end)({tag,[A]}) + end, + fun(A) -> + (fun({tag,<<L:L,B:L,L:L>>,<<L:L,B:L,L:L>>}) -> B end)({tag,A,A}) + end], + size_shadow_apply(Fs, <<16:8, 7:16,16:16>>). size_shadow_4(L) -> - F = fun(<<L:L,B:L,L:L>>) -> B; - (_) -> no end, - F(<<16:8, 7:16,15:16>>). + Fs = [fun(<<L:L,B:L,L:L>>) -> B; + (_) -> no + end, + fun(A) -> + Inner = fun([<<L:L,B:L,L:L>>]) -> B; + (_) -> no + end, + Inner([A]) + end, + fun(A) -> + Inner = fun({<<L:L,B:L,L:L>>,<<L:L,B:L,L:L>>}) -> B; + (_) -> no + end, + Inner({A,A}) + end], + size_shadow_apply(Fs, <<16:8, 7:16,15:16>>). size_shadow_5(X, Y) -> fun (<< A:Y >>, Y, B) -> fum(A, X, Y, B) end. @@ -166,6 +204,14 @@ fum(A, B, C, D) -> size_shadow_7({int,N}, <<N:16,B:N/binary,T/binary>>) -> {B,T}. +size_shadow_apply([F|Fs], Arg) when is_function(F, 1) -> + size_shadow_apply(Fs, Arg, F(Arg)). + +size_shadow_apply([F|Fs], Arg, Res) when is_function(F, 1) -> + Res = F(Arg), + size_shadow_apply(Fs, Arg, Res); +size_shadow_apply([], _, Res) -> + Res. int_float(Config) when is_list(Config) -> %% OTP-5323 @@ -502,6 +548,9 @@ unit(Config) when is_list(Config) -> {'EXIT',_} = (catch unit_opt_2(<<1:32,33:7>>)), {'EXIT',_} = (catch unit_opt_2(<<2:32,55:7>>)), + <<0:64>> = unit_opt_3(<<1:128>>), + <<1:64>> = unit_opt_3(<<1:64>>), + ok. peek1(<<B:8,_/bitstring>>) -> B. @@ -533,6 +582,13 @@ unit_opt_2(<<St:32,KO/binary>> = Bin0) -> end, id(Bin). +unit_opt_3(A) when is_binary(A) -> + %% There should be no test_unit instruction after the first segment, since + %% we already know A is a binary and its tail will still be a binary after + %% matching 8 bytes from it. + <<Bin:8/binary, _/binary>> = A, + Bin. + shared_sub_bins(Config) when is_list(Config) -> {15,[<<>>,<<5>>,<<4,5>>,<<3,4,5>>,<<2,3,4,5>>]} = sum(<<1,2,3,4,5>>, [], 0), ok. @@ -1256,11 +1312,80 @@ zero_width(Config) when is_list(Config) -> %% OTP_7650: A invalid size for binary segments could crash the compiler. bad_size(Config) when is_list(Config) -> Tuple = {a,b,c}, - {'EXIT',{{badmatch,<<>>},_}} = (catch <<32:Tuple>> = id(<<>>)), Binary = <<1,2,3>>, + Atom = an_atom, + + {'EXIT',{{badmatch,<<>>},_}} = (catch <<32:Tuple>> = id(<<>>)), {'EXIT',{{badmatch,<<>>},_}} = (catch <<32:Binary>> = id(<<>>)), + {'EXIT',{{badmatch,<<>>},_}} = (catch <<32:Atom>> = id(<<>>)), + + {'EXIT',{{badmatch,<<>>},_}} = (catch <<42.0:Tuple/float>> = id(<<>>)), + {'EXIT',{{badmatch,<<>>},_}} = (catch <<42.0:Binary/float>> = id(<<>>)), + {'EXIT',{{badmatch,<<>>},_}} = (catch <<42.0:Atom/float>> = id(<<>>)), + + %% Matched out value is ignored. + {'EXIT',{{badmatch,<<>>},_}} = (catch <<_:Binary>> = id(<<>>)), + {'EXIT',{{badmatch,<<>>},_}} = (catch <<_:Tuple>> = id(<<>>)), + {'EXIT',{{badmatch,<<>>},_}} = (catch <<_:Atom>> = id(<<>>)), + + no_match = bad_all_size(<<>>), + no_match = bad_all_size(<<1,2,3>>), + ok. +bad_all_size(Bin) -> + Res = bad_all_size_1(Bin), + Res = bad_all_size_2(Bin), + Res = bad_all_size_3(Bin), + Res = bad_all_size_4(Bin), + Res = bad_all_size_5(Bin), + Res = bad_all_size_6(Bin), + Res. + +bad_all_size_1(Bin) -> + case Bin of + <<B:all/binary>> -> B; + _ -> no_match + end. + +bad_all_size_2(Bin) -> + case Bin of + <<_:all/binary>> -> ok; + _ -> no_match + end. + +bad_all_size_3(Bin) -> + All = all, + case Bin of + <<B:All/binary>> -> B; + _ -> no_match + end. + +bad_all_size_4(Bin) -> + All = all, + case Bin of + <<_:All/binary>> -> ok; + _ -> no_match + end. + +bad_all_size_5(Bin) -> + All = case 0 of + 0 -> all + end, + case Bin of + <<B:All/binary>> -> B; + _ -> no_match + end. + +bad_all_size_6(Bin) -> + All = case 0 of + 0 -> all + end, + case Bin of + <<_:All/binary>> -> ok; + _ -> no_match + end. + haystack(Config) when is_list(Config) -> <<0:10/unit:8>> = haystack_1(<<0:10/unit:8>>), [<<0:10/unit:8>>, @@ -1324,23 +1449,182 @@ matched_out_size(Config) when is_list(Config) -> {<<1,2,3,7>>,19,42} = mos_bin(<<4,1,2,3,7,19,4,42>>), <<1,2,3,7>> = mos_bin(<<4,1,2,3,7,"abcdefghij">>), - ok. + false = mos_verify_sig(not_a_binary), + false = mos_verify_sig(<<>>), + false = mos_verify_sig(<<42:32>>), + <<"123456789">> = mos_verify_sig(<<77:32,0:77/unit:8,9:32,"123456789">>), + + ok. + +mos_int(B) -> + Res = mos_int_plain(B), + Res = mos_int_list([B]), + Res = mos_int_tuple({a,[B],z}), + + Res = mos_int_mixed([B]), + Res = mos_int_mixed({a,[B],z}), + 42 = mos_int_mixed({30,12}), + no_match = mos_int_mixed([B,B,B]), + + Res = mos_int_pats1({tag,[B]}, {0,1,2,3,4,5,6,7,8,9}), + Res = mos_int_pats2({tag,[B]}, {a,a,a,a,a,a,a,a,a,a}, [z]), + {I,X} = Res, + Res = mos_int_pats3({tag,[B]}, [I,{X,B,X},I]), + Res = mos_int_map(#{key => [B]}), + Key = {my,key}, + Res = mos_int_map(Key, #{Key => [B]}), + {I,X,B} = mos_int_alias([[B]]), + Res = {I,X}, + Res = mos_int_try([B]), + Res = mos_int_receive(B), + Res = mos_int_fun([B]), + Res = mos_int_exported(B), + Res = mos_int_utf(B), + Res. + +mos_int_plain(<<L,I:L,X:32>>) -> + {I,X}; +mos_int_plain(<<L,I:L,X:64>>) -> + {I,X}. + +mos_int_list([<<L,I:L,X:32>>]) -> + {I,X}; +mos_int_list([<<L,I:L,X:64>>]) -> + {I,X}. -mos_int(<<L,I:L,X:32>>) -> +mos_int_tuple({a,[<<L,I:L,X:32>>],z}) -> {I,X}; -mos_int(<<L,I:L,X:64>>) -> +mos_int_tuple({a,[<<L,I:L,X:64>>],z}) -> {I,X}. -mos_bin(<<L,Bin:L/binary,X:8,L>>) -> +mos_int_mixed({a,[<<L,I:L,X:32>>],z}) -> + {I,X}; +mos_int_mixed({a,[<<L,I:L,X:64>>],z}) -> + {I,X}; +mos_int_mixed([<<L,I:L,X:32>>]) -> + {I,X}; +mos_int_mixed([<<L,I:L,X:64>>]) -> + {I,X}; +mos_int_mixed({A,B}) when is_integer(A), is_integer(B) -> + A + B; +mos_int_mixed(_) -> + no_match. + +mos_int_pats1({tag,[<<L,I:L,X:32>>]}, {_,_,_,_,_,_,_,_,_,_}) -> + {I,X}; +mos_int_pats1({tag,[<<L,I:L,X:64>>]}, {_,_,_,_,_,_,_,_,_,_}) -> + {I,X}. + +mos_int_pats2({tag,[<<L,I:L,X:32>>]}, {S,S,S,S,S,S,S,S,S,S}, [_|_]) -> + {I,X}; +mos_int_pats2({tag,[<<L,I:L,X:64>>]}, {S,S,S,S,S,S,S,S,S,S}, [_|_]) -> + {I,X}. + +mos_int_pats3({tag,[<<L,I:L,X:32>>]}, [I,{X,<<L,I:L,X:32>>,X},I]) -> + {I,X}; +mos_int_pats3({tag,[<<L,I:L,X:64>>]}, [I,{X,<<L,I:L,X:64>>,X},I]) -> + {I,X}. + +mos_int_map(#{key := [<<L,I:L,X:32>>]}) -> + {I,X}; +mos_int_map(#{key := [<<L,I:L,X:64>>]}) -> + {I,X}. + +mos_int_map(Key, Map) -> + case Map of + #{Key := [<<L,I:L,X:32>>]} -> {I,X}; + #{Key := [<<L,I:L,X:64>>]} -> {I,X} + end. + +mos_int_alias([[<<L,I:L,X:32>> = B]]) -> + {I,X,B}; +mos_int_alias([[<<L,I:L,X:64>> = B]]) -> + {I,X,B}. + +mos_int_try(B) -> + try id(B) of + [<<L,I:L,X:32>>] -> {I,X}; + [<<L,I:L,X:64>>] -> {I,X} + after + ok + end. + +mos_int_receive(Msg) -> + Res = (fun() -> + self() ! Msg, + receive + <<L,I:L,X:32>> -> {I,X}; + <<L,I:L,X:64>> -> {I,X} + end + end)(), + self() ! Msg, + Res = receive + <<L,I:L,X:32>> -> {I,X}; + <<L,I:L,X:64>> -> {I,X} + end, + self() ! {tag,[Msg]}, + Res = receive + {tag,[<<L,I:L,X:32>>]} -> {I,X}; + {tag,[<<L,I:L,X:64>>]} -> {I,X} + end, + Res. + +mos_int_fun(B) -> + L = ignore_me, + F = fun ([<<L,I:L,X:32>>]) -> {I,X}; + ([<<L,I:L,X:64>>]) -> {I,X} + end, + F(B). + +mos_int_exported(B) -> + case B of + <<L,I:L,X:32>> -> ok; + <<L,I:L,X:64>> -> ok + end, + {I,X}. + +mos_int_utf(B0) -> + B = id(<<B0/bits,777/utf8,7777/utf16,9999/utf32>>), + case B of + <<L,I:L,X:32,777/utf8,7777/utf16,9999/utf32>> -> {I,X}; + <<L,I:L,X:64,777/utf8,7777/utf16,9999/utf32>> -> {I,X} + end. + +mos_bin(B) -> + Res = mos_bin_plain(B), + Res = mos_bin_tuple({outer,{inner,B}}), + Res. + +mos_bin_plain(<<L,Bin:L/binary,X:8,L>>) -> L = byte_size(Bin), {Bin,X}; -mos_bin(<<L,Bin:L/binary,X:8,L,Y:8>>) -> +mos_bin_plain(<<L,Bin:L/binary,X:8,L,Y:8>>) -> L = byte_size(Bin), {Bin,X,Y}; -mos_bin(<<L,Bin:L/binary,"abcdefghij">>) -> +mos_bin_plain(<<L,Bin:L/binary,"abcdefghij">>) -> L = byte_size(Bin), Bin. +mos_bin_tuple({outer,{inner,<<L,Bin:L/binary,X:8,L>>}}) -> + L = byte_size(Bin), + {Bin,X}; +mos_bin_tuple({outer,{inner,<<L,Bin:L/binary,X:8,L,Y:8>>}}) -> + L = byte_size(Bin), + {Bin,X,Y}; +mos_bin_tuple({outer,{inner,<<L,Bin:L/binary,"abcdefghij">>}}) -> + L = byte_size(Bin), + Bin. + +mos_verify_sig(AlgSig) -> + try + <<AlgLen:32, _Alg:AlgLen/binary, + SigLen:32, Sig:SigLen/binary>> = AlgSig, + Sig + catch + _:_ -> + false + end. + follow_fail_branch(_) -> 42 = ffb_1(<<0,1>>, <<0>>), 8 = ffb_1(<<0,1>>, [a]), @@ -2034,3 +2318,187 @@ bad_phi_paths_1(Arg) -> id(B). id(I) -> I. + +expand_and_squeeze(Config) when is_list(Config) -> + %% UTF8 literals are expanded and then squeezed into integer16 + [ + {test,bs_get_integer2,_,_,[_,{integer,16}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<$á/utf8,_/binary>>"), + ?Q("<<$é/utf8,_/binary>>") + ]), + + %% Sized integers are expanded and then squeezed into integer16 + [ + {test,bs_get_integer2,_,_,[_,{integer,16}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<0:32,_/binary>>"), + ?Q("<<\"bbbb\",_/binary>>") + ]), + + %% Groups of 8 bits are squeezed into integer16 + [ + {test,bs_get_integer2,_,_,[_,{integer,16}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aaaa\",_/binary>>"), + ?Q("<<\"bbbb\",_/binary>>") + ]), + + %% Groups of 8 bits with empty binary are also squeezed + [ + {test,bs_get_integer2,_,_,[_,{integer,16}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aaaa\",_/binary>>"), + ?Q("<<\"bbbb\",_/binary>>"), + ?Q("<<>>") + ]), + + %% Groups of 8 bits with float lookup are not squeezed + [ + {test,bs_get_integer2,_,_,[_,{integer,8}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aaaa\",_/binary>>"), + ?Q("<<\"bbbb\",_/binary>>"), + ?Q("<<_/float>>") + ]), + + %% Groups of diverse bits go with minimum possible + [ + {test,bs_get_integer2,_,_,[_,{integer,8}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aa\",_/binary>>"), + ?Q("<<\"bb\",_/binary>>"), + ?Q("<<\"c\",_/binary>>") + ]), + + %% Groups of diverse bits go with minimum possible but are recursive... + [ + {test,bs_get_integer2,_,_,[_,{integer,8}|_],_} + | RestDiverse + ] = binary_match_to_asm([ + ?Q("<<\"aaa\",_/binary>>"), + ?Q("<<\"abb\",_/binary>>"), + ?Q("<<\"c\",_/binary>>") + ]), + + %% so we still perform a 16 bits lookup for the remaining + true = lists:any(fun({test,bs_get_integer2,_,_,[_,{integer,16}|_],_}) -> true; + (_) -> false end, RestDiverse), + + %% Large match is kept as is if there is a sized match later + [ + {test,bs_get_integer2,_,_,[_,{integer,64}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<255,255,255,255,255,255,255,255>>"), + ?Q("<<_:64>>") + ]), + + %% Large match is kept as is with large matches before and after + [ + {test,bs_get_integer2,_,_,[_,{integer,32}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<A:32,_:A>>"), + ?Q("<<0:32>>"), + ?Q("<<_:32>>") + ]), + + %% Large match is kept as is with large matches before and after + [ + {test,bs_get_integer2,_,_,[_,{integer,32}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<A:32,_:A>>"), + ?Q("<<0,0,0,0>>"), + ?Q("<<_:32>>") + ]), + + %% Large match is kept as is with smaller but still large matches before and after + [ + {test,bs_get_integer2,_,_,[_,{integer,32}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<A:32, _:A>>"), + ?Q("<<0:64>>"), + ?Q("<<_:32>>") + ]), + + %% There is no squeezing for groups with more than 16 matches + [ + {test,bs_get_integer2,_,_,[_,{integer,8}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aa\", _/binary>>"), + ?Q("<<\"bb\", _/binary>>"), + ?Q("<<\"cc\", _/binary>>"), + ?Q("<<\"dd\", _/binary>>"), + ?Q("<<\"ee\", _/binary>>"), + ?Q("<<\"ff\", _/binary>>"), + ?Q("<<\"gg\", _/binary>>"), + ?Q("<<\"hh\", _/binary>>"), + ?Q("<<\"ii\", _/binary>>"), + ?Q("<<\"jj\", _/binary>>"), + ?Q("<<\"kk\", _/binary>>"), + ?Q("<<\"ll\", _/binary>>"), + ?Q("<<\"mm\", _/binary>>"), + ?Q("<<\"nn\", _/binary>>"), + ?Q("<<\"oo\", _/binary>>"), + ?Q("<<\"pp\", _/binary>>") + ]), + + ok. + +binary_match_to_asm(Matches) -> + Clauses = [ + begin + Ann = element(2, Match), + {clause,Ann,[Match],[],[{integer,Ann,Return}]} + end || {Match,Return} <- lists:zip(Matches, lists:seq(1, length(Matches))) + ], + + Module = [ + {attribute,1,module,match_to_asm}, + {attribute,2,export,[{example,1}]}, + {function,3,example,1,Clauses} + ], + + {ok,match_to_asm,{match_to_asm,_Exports,_Attrs,Funs,_},_} = + compile:forms(Module, [return, to_asm]), + + [{function,example,1,2,AllInstructions}|_] = Funs, + [{label,_},{line,_},{func_info,_,_,_},{label,_},{'%',_}, + {test,bs_start_match3,_,_,_,_},{bs_get_position,_,_,_}|Instructions] = AllInstructions, + Instructions. + +many_clauses(_Config) -> + Mod = list_to_atom(?MODULE_STRING ++ "_" ++ + atom_to_list(?FUNCTION_NAME)), + Seq = lists:seq(1, 200), + S = [one_clause(I) || I <- Seq], + Code = ?Q(["-module('@Mod@').\n" + "-export([f/1]).\n" + "f(Bin) ->\n" + "case Bin of\n" + " dummy -> _@_@S\n" + "end.\n"]), + %% merl:print(Code), + Opts = test_lib:opt_opts(?MODULE), + {ok,_} = merl:compile_and_load(Code, Opts), + _ = [begin + H = erlang:phash2(I), + Sz = 16, + <<Res0:Sz>> = <<H:Sz>>, + Res = I + Res0, + Res = Mod:f({I,<<Sz:8,H:Sz>>}) + end || I <- Seq], + ok. + +one_clause(I) -> + ?Q(<<"{_@I@,<<L:8,Val:L>>} -> _@I@ + Val">>). diff --git a/lib/compiler/test/bs_size_expr_SUITE.erl b/lib/compiler/test/bs_size_expr_SUITE.erl new file mode 100644 index 0000000000..a9e562313b --- /dev/null +++ b/lib/compiler/test/bs_size_expr_SUITE.erl @@ -0,0 +1,286 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(bs_size_expr_SUITE). +-compile(nowarn_shadow_vars). + +-export([all/0,suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, + basic/1,size_shadow/1,complex/1, + recv/1,no_match/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. + +all() -> + [{group,p}]. + +groups() -> + [{p,test_lib:parallel(), + [basic, + size_shadow, + complex, + recv, + no_match]}]. + +init_per_suite(Config) -> + test_lib:recompile(?MODULE), + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + Config. + +end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + ok. + +basic(_Config) -> + <<>> = do_basic(<<1:32>>), + <<"abcd">> = do_basic(<<2:32,"abcd">>), + no_match = do_basic(<<0:32>>), + no_match = do_basic(<<777:32>>), + ok. + +do_basic(Bin) -> + Res = do_basic_1(Bin), + + Res = do_basic_2({tag,Bin}), + Res = do_basic_2([list,Bin]), + 6 = do_basic_2({2,4}), + + Res = do_basic_3(Bin), + Res = do_basic_4(Bin), + + {result,Res} = do_basic_5(Bin), + case Res of + no_match -> + ok; + _ -> + {result,{Res,7777777}} = do_basic_5(<<Bin/binary,7777777:32>>) + end, + + Res. + +do_basic_1(<<Sz:32,Tail:(4*Sz-4)/binary>>) -> + Tail; +do_basic_1(<<_/binary>>) -> + no_match. + +do_basic_2({tag,<<Sz:32,Tail:(4*Sz-4)/binary>>}) -> + Tail; +do_basic_2([list,<<Sz:32,Tail:((Sz-1)*4)/binary>>]) -> + Tail; +do_basic_2({A,B}) when is_integer(A), is_integer(B) -> + A + B; +do_basic_2(_) -> + no_match. + +do_basic_3(Bin) -> + WordSize = id(4), + case Bin of + <<Sz:32,Tail:(WordSize*Sz-WordSize)/binary>> -> + Tail; + _ -> + no_match + end. + +do_basic_4(Bin) -> + WordSize = id(4), + F = fun() -> + case Bin of + <<Sz:32,Tail:(WordSize*Sz-WordSize)/binary>> -> + Tail; + _ -> + no_match + end + end, + F(). + +do_basic_5(Bin) -> + WordSize = id(4), + F = fun() -> + Res = case Bin of + <<Sz:32,Tail:(WordSize*Sz-WordSize)/binary,More:(8*WordSize)>> -> + {Tail,More}; + <<Sz:32,Tail:(WordSize*Sz-WordSize)/binary>> -> + Tail; + _ -> + no_match + end, + {result,Res} + end, + F(). + +size_shadow(_Config) -> + 12345678 = size_shadow_1(), + ok. + +size_shadow_1() -> + L = 8, + Offset = 16, + Fs = [fun(<<L:L,B:(L+16)>>) -> B end, + fun(<<L:L,B:(L+Offset)>>) -> B end, + fun(A) -> + Res = (fun([<<L:L,B:(L+16)>>]) -> B end)([A]), + Res = (fun([<<L:L,B:(L+Offset)>>]) -> B end)([A]) + end, + fun(A) -> + Res = (fun({<<L:L,B:(L+16)>>,<<L:L,B:(L+16)>>}) -> B end)({A,A}), + Res = (fun({<<L:L,B:(L+Offset)>>,<<L:L,B:(L+16)>>}) -> B end)({A,A}), + Res = (fun({<<L:L,B:(L+16)>>,<<L:L,B:(L+Offset)>>}) -> B end)({A,A}), + Res = (fun({<<L:L,B:(L+Offset)>>,<<L:L,B:(L+Offset)>>}) -> B end)({A,A}) + end, + fun(A) -> + <<Size:L,_/bits>> = A, + Inner = fun([L], {#{key1 := <<L:L,B:(L+Offset)>>, + key2 := <<L:L,B:(L+Offset)>>}, L}) -> B end, + Inner([Size], {#{key1 => A,key2 => A},Size}) + end], + size_shadow_apply(Fs, <<16:8, 12345678:32>>). + +size_shadow_apply([F|Fs], Arg) when is_function(F, 1) -> + size_shadow_apply(Fs, Arg, F(Arg)). + +size_shadow_apply([F|Fs], Arg, Res) when is_function(F, 1) -> + Res = F(Arg), + size_shadow_apply(Fs, Arg, Res); +size_shadow_apply([], _, Res) -> + Res. + +-record(r, {a,b,c}). +complex(Config) -> + (fun() -> + Len = length(id(Config)), + Bin = << <<I:13>> || I <- lists:seq(1, Len) >>, + <<Bin:(length(Config))/binary-unit:13>> = Bin + end)(), + + (fun() -> + V = id([a,b,c]), + F = fun(<<V:(bit_size(<<0:(length(V))>>)*8)/signed-integer>>) -> + V; + ({A,B}) -> + A + B + end, + -1 = F(<<-1:(length(V)*8)>>), + 7 = F({3,4}) + end)(), + + (fun() -> + A = a, + B = b, + F = fun(<<A:16,B:16,C:(A+B),D/bits>>) -> + {A,B,C,D}; + (<<A:16,B:16>>) -> + {A,B}; + (<<A:8,B:8>>) -> + {A,B} + end, + {13,21,16#cafebeef,<<"more">>} = F(<<13:16,21:16,16#cafebeef:34,"more">>), + {100,500} = F(<<100:16,500:16>>), + {157,77} = F(<<157:8,77:8>>), + {A,B} + end)(), + + (fun() -> + Two = id(2), + F = fun(a, <<_:(#r.a - Two)/binary,Int:8,_/binary>>) -> Int; + (b, <<_:(#r.b - Two)/binary,Int:8,_/binary>>) -> Int; + (c, <<_:(#r.c - Two)/binary,Int:8,_/binary>>) -> Int + end, + 1 = F(a, <<1,2,3>>), + 2 = F(b, <<1,2,3>>), + 3 = F(c, <<1,2,3>>) + end)(), + + (fun() -> + Bin = <<1,2,3,4>>, + F = fun(R) -> + <<First:(R#r.a)/binary,Tail/binary>> = Bin, + {First,Tail} + end, + {<<>>,<<1,2,3,4>>} = F(#r{a=0}), + {<<1>>,<<2,3,4>>} = F(#r{a=1}), + {<<1,2>>,<<3,4>>} = F(#r{a=2}), + {<<1,2,3>>,<<4>>} = F(#r{a=3}), + {<<1,2,3,4>>,<<>>} = F(#r{a=4}) + end)(), + + ok. + +recv(_Config) -> + R = fun(Msg) -> + self() ! Msg, + Res = receive + <<L,I:(L-1)/unit:8,X:32>> -> {I,X}; + <<L,I:(L-1)/unit:8,X:64>> -> {I,X} + end, + self() ! {tag,[Msg]}, + Res = receive + {tag,[<<L,I:(8*(L-1)),X:32>>]} -> {I,X}; + {tag,[<<L,I:(8*(L-1)),X:64>>]} -> {I,X} + end + end, + {1234,16#deadbeef} = R(<<3,1234:16,16#deadbeef:32>>), + {99,16#cafebeeff00d} = R(<<2,99:8,16#cafebeeff00d:64>>), + ok. + +no_match(_Config) -> + B = id(<<1,2,3,4>>), + no_match = case B of + <<Int:(bit_size(B)-1)>> -> Int; + <<Int:(bit_size(B)*2)>> -> Int; + <<Int:(length(B))>> -> Int; + _ -> no_match + end, + no_match = case B of + <<L:8,Int2:(is_integer(L))>> -> Int2; + <<L:8,Int2:(L+3.0)>> -> Int2; + _ -> no_match + end, + + no_match = case B of + <<Int3:(1/0)>> -> Int3; + _ -> no_match + end, + + no_match = case B of + <<Int4:all>> -> Int4; + <<Int4:bad_size>> -> Int4; + _ -> no_match + end, + + [] = [X || <<X:(is_list(B))/binary>> <= B], + <<>> = << <<X:32>> || <<X:(is_list(B))/binary>> <= B >>, + + ok. + +id(I) -> + I. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 53627b9d81..c634c5841a 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -374,11 +374,12 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> {dcbsm, ".core_bsm"}, {dkern, ".kernel"}, {dssa, ".ssa"}, + {dbool, ".bool"}, + {dssashare, ".ssashare"}, {dssaopt, ".ssaopt"}, {dprecg, ".precodegen"}, {dcg, ".codegen"}, {dblk, ".block"}, - {dexcept, ".except"}, {djmp, ".jump"}, {dclean, ".clean"}, {dpeep, ".peep"}, @@ -1383,36 +1384,47 @@ env_compiler_options(_Config) -> bc_options(Config) -> DataDir = proplists:get_value(data_dir, Config), - L = [{101, small_float, [no_get_hd_tl,no_line_info]}, - {103, big, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, + L = [{101, small_float, [no_shared_fun_wrappers, + no_get_hd_tl,no_line_info]}, + {103, big, [no_shared_fun_wrappers, + no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, no_line_info,no_stack_trimming]}, - {125, small_float, [no_get_hd_tl,no_line_info,no_ssa_opt_float]}, + {125, small_float, [no_shared_fun_wrappers,no_get_hd_tl, + no_line_info, + no_ssa_opt_float]}, - {132, small, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, + {132, small, [no_shared_fun_wrappers, + no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, no_ssa_opt_float,no_line_info,no_bsm3]}, + {136, big, [no_shared_fun_wrappers,no_put_tuple2,no_get_hd_tl, + no_ssa_opt_record,no_line_info]}, + {153, small, [r20]}, {153, small, [r21]}, - {136, big, [no_put_tuple2,no_get_hd_tl, - no_ssa_opt_record,no_line_info]}, - - {153, big, [no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]}, - {153, big, [r16]}, - {153, big, [r17]}, + {153, big, [no_shared_fun_wrappers, + no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]}, {153, big, [r18]}, {153, big, [r19]}, - {153, small_float, [r16]}, - {153, small_float, []}, + {153, small_float, [no_shared_fun_wrappers]}, - {158, small_maps, [r17]}, {158, small_maps, [r18]}, {158, small_maps, [r19]}, {158, small_maps, [r20]}, {158, small_maps, [r21]}, - {164, small_maps, []}, - {164, big, []} + {164, small_maps, [r22]}, + {164, big, [r22]}, + {164, small_maps, [no_shared_fun_wrappers]}, + {164, big, [no_shared_fun_wrappers]}, + + {168, small, [r22]}, + {170, small, [no_shared_fun_wrappers]}, + + {169, small_maps, []}, + {169, big, []}, + {170, small, []} ], Test = fun({Expected,Mod,Options}) -> diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index 72016c6d76..e20744f9cb 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -30,7 +30,8 @@ cover_v3_kernel_1/1,cover_v3_kernel_2/1,cover_v3_kernel_3/1, cover_v3_kernel_4/1,cover_v3_kernel_5/1, non_variable_apply/1,name_capture/1,fun_letrec_effect/1, - get_map_element/1]). + get_map_element/1,receive_tests/1, + core_lint/1]). -include_lib("common_test/include/ct.hrl"). @@ -59,7 +60,8 @@ groups() -> cover_v3_kernel_1,cover_v3_kernel_2,cover_v3_kernel_3, cover_v3_kernel_4,cover_v3_kernel_5, non_variable_apply,name_capture,fun_letrec_effect, - get_map_element + get_map_element,receive_tests, + core_lint ]}]. @@ -98,6 +100,7 @@ end_per_group(_GroupName, Config) -> ?comp(name_capture). ?comp(fun_letrec_effect). ?comp(get_map_element). +?comp(receive_tests). try_it(Mod, Conf) -> Src = filename:join(proplists:get_value(data_dir, Conf), @@ -112,3 +115,58 @@ compile_and_load(Src, Opts) -> _ = code:delete(Mod), _ = code:purge(Mod), ok. + +core_lint(_Config) -> + OK = cerl:c_atom(ok), + core_lint_function(illegal), + core_lint_function(cerl:c_let([OK], OK, OK)), + core_lint_function(cerl:c_let([cerl:c_var(var)], cerl:c_var(999), OK)), + core_lint_function(cerl:c_let([cerl:c_var(var)], cerl:c_var(unknown), OK)), + core_lint_function(cerl:c_try(OK, [], OK, [], handler)), + core_lint_function(cerl:c_apply(cerl:c_var({OK,0}), [OK])), + + core_lint_function([], [OK], OK), + core_lint_function([cerl:c_var({cerl:c_char($*),OK})], [], OK), + + core_lint_pattern([cerl:c_var(99),cerl:c_var(99)]), + core_lint_pattern([cerl:c_let([cerl:c_var(var)], OK, OK)]), + core_lint_bs_pattern([OK]), + Flags = cerl:make_list([big,unsigned]), + core_lint_bs_pattern([cerl:c_bitstr(cerl:c_var(tail), cerl:c_atom(binary), Flags), + cerl:c_bitstr(cerl:c_var(value), cerl:c_atom(binary), Flags)]), + + BadGuard1 = cerl:c_call(OK, OK, []), + BadGuard2 = cerl:c_call(cerl:c_atom(erlang), OK, []), + BadGuard3 = cerl:c_call(cerl:c_atom(erlang), cerl:c_atom(is_record), [OK,OK,OK]), + PatMismatch = cerl:c_case(cerl:c_nil(), + [cerl:c_clause([], OK), + cerl:c_clause([OK], OK), + cerl:c_clause([OK], BadGuard1, OK), + cerl:c_clause([OK], BadGuard2, OK), + cerl:c_clause([OK], BadGuard3, OK)]), + core_lint_function(PatMismatch), + + ok. + +core_lint_bs_pattern(Ps) -> + core_lint_pattern([cerl:c_binary(Ps)]). + +core_lint_pattern(Ps) -> + Cs = [cerl:c_clause(Ps, cerl:c_float(42))], + core_lint_function(cerl:c_case(cerl:c_nil(), Cs)). + +core_lint_function(Body) -> + core_lint_function([], [], Body). + +core_lint_function(Exports, Attributes, Body) -> + ModName = cerl:c_atom(core_lint_test), + MainFun = cerl:c_fun([], Body), + MainVar = cerl:c_var({main,0}), + Mod = cerl:c_module(ModName, Exports, Attributes, [{MainVar,MainFun}]), + {error,[{core_lint_test,Errors}],[]} = + compile:forms(Mod, [from_core,clint0,return]), + io:format("~p\n", [Errors]), + [] = lists:filter(fun({none,core_lint,_}) -> false; + (_) -> true + end, Errors), + error = compile:forms(Mod, [from_core,clint0,report]). diff --git a/lib/compiler/test/core_SUITE_data/bs_shadowed_size_var.core b/lib/compiler/test/core_SUITE_data/bs_shadowed_size_var.core index 0ade037e05..2e59f9efde 100644 --- a/lib/compiler/test/core_SUITE_data/bs_shadowed_size_var.core +++ b/lib/compiler/test/core_SUITE_data/bs_shadowed_size_var.core @@ -52,8 +52,14 @@ module 'bs_shadowed_size_var' case T of %% Variable 'Sz' repeated here. Should work. <#{#<Sz>(32,1,'integer',['unsigned','big']), - #<Data>(Sz,8,'binary',['unsigned','big'])}#> when 'true' -> - Data + #<Tail>('all',1,'binary',['unsigned','big'])}#> when 'true' -> + case Tail of + <#{#<Data>(Sz,8,'binary',['unsigned','big'])}#> when 'true' -> + Data + <_cor5> when 'true' -> + primop 'match_fail' + ({'case_clause',{_cor5}}) + end <_cor5> when 'true' -> primop 'match_fail' ({'case_clause',{_cor5}}) diff --git a/lib/compiler/test/core_SUITE_data/receive_tests.core b/lib/compiler/test/core_SUITE_data/receive_tests.core new file mode 100644 index 0000000000..8e56af8cd4 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/receive_tests.core @@ -0,0 +1,1761 @@ +%% Derived from receive_SUITE, with the ref_opt/1 test case removed. +%% The purpose if this module is to make sure that the traditional +%% syntax for receive in Core Erlang continues to work and is properly +%% lowered. + +module 'receive_tests' ['module_info'/0, + 'module_info'/1, + 'receive_tests'/0] + attributes [] +'receive_tests'/0 = + %% Line 27 + fun () -> + case <> of + <> when 'true' -> + do %% Line 28 + apply 'recv'/0 + () + do %% Line 28 + apply 'coverage'/0 + () + do %% Line 28 + apply 'otp_7980'/0 + () + do %% Line 28 + apply 'export'/0 + () + do %% Line 28 + apply 'wait'/0 + () + do %% Line 29 + apply 'recv_in_try'/0 + () + do %% Line 29 + apply 'double_recv'/0 + () + do %% Line 29 + apply 'receive_var_zero'/0 + () + do %% Line 30 + apply 'match_built_terms'/0 + () + do %% Line 30 + apply 'elusive_common_exit'/0 + () + do %% Line 31 + apply 'after_expression'/0 + () + %% Line 32 + 'ok' + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'recv'/0 = + %% Line 36 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + fun () -> + %% Line 37 + case <> of + <> when 'true' -> + apply 'loop'/1 + ({'state','true'}) + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end + in let <Pid> = + call %% Line 37 + 'erlang':%% Line 37 + 'spawn_link' + (_0) + in let <Self> = + call %% Line 38 + 'erlang':%% Line 38 + 'self' + () + in do %% Line 39 + call 'erlang':'!' + (Pid, {Self,'test'}) + do %% Line 40 + receive + %% Line 41 + <{'ok','test'}> when 'true' -> + 'ok' + %% Line 42 + <{'error',Other}> when 'true' -> + do %% Line 43 + call 'io':'format' + ([71|[111|[116|[32|[117|[110|[112|[101|[120|[101|[99|[116|[101|[100|[32|[126|[112]]]]]]]]]]]]]]]]], [Other|[]]) + %% Line 44 + call 'ct':'fail' + ('unexpected') + after %% Line 45 + 10000 -> + %% Line 46 + call 'ct':'fail' + ('no_answer') + do %% Line 48 + receive + %% Line 49 + <X> when 'true' -> + do %% Line 50 + call 'io':'format' + ([85|[110|[101|[120|[112|[101|[99|[116|[101|[100|[32|[101|[120|[116|[114|[97|[32|[109|[101|[115|[115|[97|[103|[101|[58|[32|[126|[112]]]]]]]]]]]]]]]]]]]]]]]]]]]], [X|[]]) + %% Line 51 + call 'ct':'fail' + ('unexpected') + after %% Line 52 + 10 -> + do %% Line 53 + call 'erlang':'unlink' + (Pid) + do %% Line 54 + call 'erlang':'exit' + (Pid, 'kill') + %% Line 55 + 'ok' + %% Line 57 + 'ok' + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'loop'/1 = + %% Line 59 + fun (_0) -> + case _0 of + <S> when 'true' -> + %% Line 60 + receive + %% Line 61 + <_8> + when ( try + ( let <_3> = + case ( call ( 'erlang' + -| ['compiler_generated'] ):( 'is_record' + -| ['compiler_generated'] ) + (S, ( 'state' + -| ['compiler_generated'] ), ( 2 + -| ['compiler_generated'] )) + -| ['compiler_generated'] ) of + ( <( 'true' + -| ['compiler_generated'] )> when 'true' -> + ( 'true' + -| ['compiler_generated'] ) + -| ['compiler_generated'] ) + ( <( 'false' + -| ['compiler_generated'] )> when 'true' -> + ( 'fail' + -| ['compiler_generated'] ) + -| ['compiler_generated'] ) + ( <( _1 + -| ['compiler_generated'] )> when 'true' -> + ( _1 + -| ['compiler_generated'] ) + -| ['compiler_generated'] ) + ( <_2> when 'true' -> + ( primop 'match_fail' + ({'case_clause',_2}) + -| ['compiler_generated'] ) + -| ['compiler_generated'] ) + end + in let <_4> = + call 'erlang':'=:=' + (( _3 + -| ['compiler_generated'] ), 'true') + in let <_5> = + call 'erlang':'element' + (2, S) + in let <_6> = + call 'erlang':'==' + (_5, 'false') + in ( call ( 'erlang' + -| ['compiler_generated'] ):( 'and' + -| ['compiler_generated'] ) + (_4, _6) + -| ['compiler_generated'] ) + -| ['compiler_generated'] ) + of <Try> -> + Try + catch <T,R> -> + 'false' + -| ['compiler_generated'] ) -> + %% Line 62 + apply 'loop'/1 + (S) + %% Line 63 + <{P,'test'}> when 'true' -> + do %% Line 64 + call 'erlang':'!' + (P, {'ok','test'}) + %% Line 65 + apply 'loop'/1 + (S) + %% Line 66 + <_X_X> when 'true' -> + %% Line 67 + apply 'loop'/1 + (S) + after 'infinity' -> + 'true' + ( <_7> when 'true' -> + primop 'match_fail' + ({'function_clause',_7}) + -| ['compiler_generated'] ) + end +'coverage'/0 = + %% Line 70 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 71 + 'erlang':%% Line 71 + 'self' + () + in do %% Line 71 + apply 'do_link'/1 + (_0) + let <_1> = + call %% Line 72 + 'erlang':%% Line 72 + 'self' + () + in do %% Line 72 + apply 'do_unlink'/1 + (_1) + let <_2> = + call %% Line 73 + 'erlang':%% Line 73 + 'node' + () + in do %% Line 73 + apply 'do_monitor_node'/2 + (_2, 'true') + let <_3> = + call %% Line 74 + 'erlang':%% Line 74 + 'node' + () + in do %% Line 74 + apply 'do_monitor_node'/2 + (_3, 'false') + let <_5> = + call %% Line 75 + 'erlang':%% Line 75 + 'group_leader' + () + in let <_4> = + call %% Line 75 + 'erlang':%% Line 75 + 'self' + () + in do %% Line 75 + apply 'do_group_leader'/2 + (_5, _4) + let <_6> = + call %% Line 76 + 'erlang':%% Line 76 + 'self' + () + in let <_7> = + call %% Line 76 + 'erlang':%% Line 76 + 'node' + (_6) + in do %% Line 76 + apply 'id'/1 + (_7) + let <_8> = + call %% Line 78 + 'erlang':%% Line 78 + 'self' + () + in do %% Line 78 + call 'erlang':'!' + (_8, {'a',10}) + let <_9> = + call %% Line 79 + 'erlang':%% Line 79 + 'self' + () + in do %% Line 79 + call 'erlang':'!' + (_9, {'b',20}) + %% Line 80 + case apply 'receive_all'/0 + () of + <[{'a',10}|[{'b',20}]]> when 'true' -> + let <_11> = + call %% Line 81 + 'erlang':%% Line 81 + 'self' + () + in do %% Line 81 + call 'erlang':'!' + (_11, {'c',42}) + do %% Line 82 + receive + %% Line 83 + <{'c',42}> when 'true' -> + %% Line 84 + 'ok' + after %% Line 85 + 'infinity' -> + %% Line 86 + call 'erlang':'exit' + ('cant_happen') + let <_12> = + call %% Line 89 + 'erlang':%% Line 89 + 'self' + () + in do %% Line 89 + call 'erlang':'!' + (_12, 17) + let <_13> = + call %% Line 90 + 'erlang':%% Line 90 + 'self' + () + in do %% Line 90 + call 'erlang':'!' + (_13, 19) + %% Line 91 + case apply 'tuple_to_values'/2 + ('infinity', 'x') of + <59> when 'true' -> + %% Line 92 + case apply 'tuple_to_values'/2 + (999999, 'x') of + <61> when 'true' -> + %% Line 93 + case apply 'tuple_to_values'/2 + (1, 'x') of + <0> when 'true' -> + let <_18> = + catch + let <_17> = + call %% Line 95 + 'erlang':%% Line 95 + 'self' + () + in %% Line 95 + apply 'monitor_plus_badmap'/1 + (_17) + in %% Line 95 + case _18 of + <{'EXIT',{{'badmap',[]},_23}}> when 'true' -> + let <_20> = + call %% Line 98 + 'erlang':%% Line 98 + 'self' + () + in do %% Line 98 + call 'erlang':'!' + (_20, {'data','no_data'}) + %% Line 99 + case apply 'receive_sink_tuple'/1 + ({'any','pattern'}) of + <'ok'> when 'true' -> + %% Line 100 + case apply 'receive_sink_tuple'/1 + ({'a','b'}) of + <{'b','a'}> when 'true' -> + %% Line 102 + 'ok' + ( <_22> when 'true' -> + primop 'match_fail' + ({'badmatch',_22}) + -| ['compiler_generated'] ) + end + ( <_21> when 'true' -> + primop 'match_fail' + ({'badmatch',_21}) + -| ['compiler_generated'] ) + end + ( <_19> when 'true' -> + primop 'match_fail' + ({'badmatch',_19}) + -| ['compiler_generated'] ) + end + ( <_16> when 'true' -> + primop 'match_fail' + ({'badmatch',_16}) + -| ['compiler_generated'] ) + end + ( <_15> when 'true' -> + primop 'match_fail' + ({'badmatch',_15}) + -| ['compiler_generated'] ) + end + ( <_14> when 'true' -> + primop 'match_fail' + ({'badmatch',_14}) + -| ['compiler_generated'] ) + end + ( <_10> when 'true' -> + primop 'match_fail' + ({'badmatch',_10}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'monitor_plus_badmap'/1 = + %% Line 104 + fun (_0) -> + case _0 of + <Pid> when 'true' -> + let <_2> = + call %% Line 105 + 'erlang':%% Line 105 + 'monitor' + (%% Line 105 + 'process', %% Line 105 + Pid) + in let <_1> = + primop 'match_fail' + ({'badmap',[]}) + in %% Line 105 + call 'erlang':'+' + (_2, _1) + ( <_3> when 'true' -> + primop 'match_fail' + ({'function_clause',_3}) + -| ['compiler_generated'] ) + end +'receive_all'/0 = + %% Line 107 + fun () -> + case <> of + <> when 'true' -> + %% Line 108 + receive + %% Line 109 + <Any> when 'true' -> + let <_0> = + apply %% Line 110 + 'receive_all'/0 + () + in %% Line 110 + [Any|_0] + after %% Line 111 + 0 -> + %% Line 112 + [] + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'do_monitor_node'/2 = + %% Line 115 + fun (_0,_1) -> + case <_0,_1> of + <Node,Bool> when 'true' -> + %% Line 116 + call 'erlang':'monitor_node' + (Node, Bool) + ( <_3,_2> when 'true' -> + primop 'match_fail' + ({'function_clause',_3,_2}) + -| ['compiler_generated'] ) + end +'do_link'/1 = + %% Line 118 + fun (_0) -> + case _0 of + <Pid> when 'true' -> + %% Line 119 + call 'erlang':'link' + (Pid) + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +'do_unlink'/1 = + %% Line 121 + fun (_0) -> + case _0 of + <Pid> when 'true' -> + %% Line 122 + call 'erlang':'unlink' + (Pid) + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +'do_group_leader'/2 = + %% Line 124 + fun (_0,_1) -> + case <_0,_1> of + <Leader,Pid> when 'true' -> + %% Line 125 + call 'erlang':'group_leader' + (Leader, Pid) + ( <_3,_2> when 'true' -> + primop 'match_fail' + ({'function_clause',_3,_2}) + -| ['compiler_generated'] ) + end +'tuple_to_values'/2 = + %% Line 129 + fun (_0,_1) -> + case <_0,_1> of + <'infinity',X> when 'true' -> + let <_3> = + case %% Line 130 + X of + %% Line 131 + <'x'> when 'true' -> + %% Line 132 + receive + %% Line 133 + <Any> when 'true' -> + %% Line 134 + {42,Any} + after 'infinity' -> + 'true' + ( <_2> when 'true' -> + %% Line 130 + primop 'match_fail' + ({'case_clause',_2}) + -| ['compiler_generated'] ) + end + in %% Line 130 + case _3 of + <{A,B}> when 'true' -> + %% Line 137 + call 'erlang':'+' + (A, B) + ( <_4> when 'true' -> + primop 'match_fail' + ({'badmatch',_4}) + -| ['compiler_generated'] ) + end + %% Line 138 + <Timeout,X> when 'true' -> + let <_6> = + case %% Line 139 + X of + %% Line 140 + <'x'> when 'true' -> + %% Line 141 + receive + %% Line 142 + <Any> when 'true' -> + %% Line 143 + {42,Any} + after %% Line 144 + Timeout -> + %% Line 145 + {0,0} + ( <_5> when 'true' -> + %% Line 139 + primop 'match_fail' + ({'case_clause',_5}) + -| ['compiler_generated'] ) + end + in %% Line 139 + case _6 of + <{A,B}> when 'true' -> + %% Line 148 + call 'erlang':'+' + (A, B) + ( <_7> when 'true' -> + primop 'match_fail' + ({'badmatch',_7}) + -| ['compiler_generated'] ) + end + ( <_9,_8> when 'true' -> + primop 'match_fail' + ({'function_clause',_9,_8}) + -| ['compiler_generated'] ) + end +'receive_sink_tuple'/1 = + %% Line 151 + fun (_0) -> + case _0 of + <{Line,Pattern}> when 'true' -> + %% Line 152 + receive + %% Line 153 + <{'data',_2}> when 'true' -> + %% Line 154 + 'ok' + after %% Line 155 + 1 -> + %% Line 156 + apply 'id'/1 + ({Pattern,Line}) + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +'otp_7980'/0 = + %% Line 163 + fun () -> + case <> of + <> when 'true' -> + %% Line 164 + case apply 'otp_7980_add_clients'/1 + (10) of + <7> when 'true' -> + %% Line 165 + 'ok' + ( <_0> when 'true' -> + primop 'match_fail' + ({'badmatch',_0}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'otp_7980_add_clients'/1 = + %% Line 167 + fun (_0) -> + case _0 of + <Count> when 'true' -> + let <Timeout> = 42 + in let <_7> = + fun (_4,_3) -> + %% Line 169 + case <_4,_3> of + <_9,N> when 'true' -> + do %% Line 170 + case N of + %% Line 171 + <1> when 'true' -> + 'ok' + %% Line 172 + <_10> when 'true' -> + receive + + after Timeout -> + 'ok' + ( <_2> when 'true' -> + primop 'match_fail' + ({'case_clause',_2}) + -| ['compiler_generated'] ) + end + %% Line 174 + call 'erlang':'-' + (N, 1) + ( <_6,_5> when 'true' -> + primop 'match_fail' + ({'function_clause',_6,_5}) + -| ['compiler_generated'] ) + end + in %% Line 169 + call 'lists':'foldl' + (_7, %% Line 175 + Count, %% Line 175 + [1|[2|[3]]]) + ( <_8> when 'true' -> + primop 'match_fail' + ({'function_clause',_8}) + -| ['compiler_generated'] ) + end +'export'/0 = + %% Line 177 + fun () -> + case <> of + <> when 'true' -> + let <Ref> = + call %% Line 178 + 'erlang':%% Line 178 + 'make_ref' + () + in let <_1> = + call %% Line 179 + 'erlang':%% Line 179 + 'self' + () + in do %% Line 179 + call 'erlang':'!' + (_1, {'result',Ref,42}) + %% Line 180 + case apply 'export_1'/1 + (Ref) of + <42> when 'true' -> + %% Line 181 + case apply 'export_1'/1 + (Ref) of + <{'error','timeout'}> when 'true' -> + let <_4> = + call %% Line 183 + 'erlang':%% Line 183 + 'self' + () + in do %% Line 183 + call 'erlang':'!' + (_4, {'result',Ref}) + %% Line 184 + case apply 'export_2'/0 + () of + <{'ok',_6}> + when call 'erlang':'=:=' + (_6, + Ref) -> + %% Line 186 + 'ok' + ( <_5> when 'true' -> + primop 'match_fail' + ({'badmatch',_5}) + -| ['compiler_generated'] ) + end + ( <_3> when 'true' -> + primop 'match_fail' + ({'badmatch',_3}) + -| ['compiler_generated'] ) + end + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',_2}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'export_1'/1 = + %% Line 188 + fun (_0) -> + case _0 of + <Reference> when 'true' -> + do %% Line 189 + apply 'id'/1 + (Reference) + let <_5,Result> = + receive + %% Line 191 + <{'result',_4,Result}> + when call 'erlang':'=:=' + (_4, + Reference) -> + %% Line 192 + <Result,Result> + after %% Line 193 + 1 -> + let <Result> = + {'error','timeout'} + in %% Line 194 + <Result,Result> + in let <_2> = + call %% Line 199 + 'erlang':%% Line 199 + 'self' + () + in do %% Line 199 + apply 'id'/1 + ({'build',_2}) + %% Line 200 + Result + ( <_3> when 'true' -> + primop 'match_fail' + ({'function_clause',_3}) + -| ['compiler_generated'] ) + end +'export_2'/0 = + %% Line 202 + fun () -> + case <> of + <> when 'true' -> + let <_0,Result> = + receive + %% Line 203 + <{'result',Result}> when 'true' -> + <'ok',Result> + after 'infinity' -> + <'true','true'> + in %% Line 204 + {'ok',Result} + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'wait'/0 = + %% Line 206 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 207 + 'erlang':%% Line 207 + 'self' + () + in do %% Line 207 + call 'erlang':'!' + (_0, #{#<42>(8,1,'integer',['unsigned'|['big']])}#) + %% Line 208 + case apply 'wait_1'/3 + ('r', 1, 2) of + <#{#<42>(8,1,'integer',['unsigned'|['big']])}#> when 'true' -> + %% Line 209 + case apply 'wait_1'/3 + (1, 2, 3) of + <{1,2,3}> when 'true' -> + let <_3> = + catch + %% Line 210 + receive + + after [] -> + 'timeout' + in %% Line 210 + case _3 of + <{'EXIT',{'timeout_value',_5}}> when 'true' -> + %% Line 211 + 'ok' + ( <_4> when 'true' -> + primop 'match_fail' + ({'badmatch',_4}) + -| ['compiler_generated'] ) + end + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',_2}) + -| ['compiler_generated'] ) + end + ( <_1> when 'true' -> + primop 'match_fail' + ({'badmatch',_1}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'wait_1'/3 = + %% Line 213 + fun (_0,_1,_2) -> + case <_0,_1,_2> of + <'r',_7,_8> when 'true' -> + %% Line 214 + receive + %% Line 215 + <B> + when try + let <_3> = + call 'erlang':'byte_size' + (B) + in call 'erlang':'>' + (_3, 0) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + %% Line 216 + B + after 'infinity' -> + 'true' + %% Line 220 + <A,B,C> when 'true' -> + %% Line 221 + {A,B,C} + ( <_6,_5,_4> when 'true' -> + primop 'match_fail' + ({'function_clause',_6,_5,_4}) + -| ['compiler_generated'] ) + end +'recv_in_try'/0 = + %% Line 223 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 224 + 'erlang':%% Line 224 + 'self' + () + in do %% Line 224 + call 'erlang':'!' + (_0, {'ok','fh'}) + %% Line 224 + case apply 'recv_in_try'/2 + ('infinity', 'native') of + <{'ok','fh'}> when 'true' -> + let <_2> = + call %% Line 225 + 'erlang':%% Line 225 + 'self' + () + in do %% Line 225 + call 'erlang':'!' + (_2, {'ok','ignored'}) + %% Line 225 + case apply 'recv_in_try'/2 + ('infinity', 'plain') of + <{'ok',42}> when 'true' -> + let <_4> = + call %% Line 226 + 'erlang':%% Line 226 + 'self' + () + in do %% Line 226 + call 'erlang':'!' + (_4, {'error','ignored'}) + %% Line 226 + case apply 'recv_in_try'/2 + ('infinity', 'plain') of + <'nok'> when 'true' -> + %% Line 227 + case apply 'recv_in_try'/2 + (1, 'plain') of + <'timeout'> when 'true' -> + %% Line 228 + 'ok' + ( <_6> when 'true' -> + primop 'match_fail' + ({'badmatch',_6}) + -| ['compiler_generated'] ) + end + ( <_5> when 'true' -> + primop 'match_fail' + ({'badmatch',_5}) + -| ['compiler_generated'] ) + end + ( <_3> when 'true' -> + primop 'match_fail' + ({'badmatch',_3}) + -| ['compiler_generated'] ) + end + ( <_1> when 'true' -> + primop 'match_fail' + ({'badmatch',_1}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'recv_in_try'/2 = + %% Line 230 + fun (_0,_1) -> + case <_0,_1> of + <Timeout,Format> when 'true' -> + %% Line 231 + try + %% Line 232 + receive + %% Line 233 + <{Status,History}> when 'true' -> + let <_3> = + case %% Line 244 + Format of + %% Line 245 + <'native'> when 'true' -> + %% Line 246 + apply 'id'/1 + (History) + %% Line 247 + <'plain'> when 'true' -> + %% Line 248 + apply 'id'/1 + (42) + ( <_2> when 'true' -> + %% Line 244 + primop 'match_fail' + ({'case_clause',_2}) + -| ['compiler_generated'] ) + end + in let <FH> = _3 + in %% Line 250 + case Status of + %% Line 251 + <'ok'> when 'true' -> + %% Line 252 + {'ok',FH} + %% Line 253 + <'error'> when 'true' -> + %% Line 254 + 'nok' + ( <_5> when 'true' -> + primop 'match_fail' + ({'case_clause',_5}) + -| ['compiler_generated'] ) + end + after %% Line 256 + Timeout -> + %% Line 257 + 'timeout' + of <_6> -> + _6 + catch <_9,_8,_7> -> + %% Line 262 + case {_9,_8,_7} of + <{'throw',{'error',Reason},_12}> when 'true' -> + %% Line 263 + {'nok',Reason} + ( <{_9,_8,_7}> when 'true' -> + primop 'raise' + (_7, _8) + -| ['compiler_generated'] ) + end + ( <_11,_10> when 'true' -> + primop 'match_fail' + ({'function_clause',_11,_10}) + -| ['compiler_generated'] ) + end +'double_recv'/0 = + %% Line 270 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 271 + 'erlang':%% Line 271 + 'self' + () + in do %% Line 271 + call 'erlang':'!' + (_0, {'more',{'a','term'}}) + %% Line 272 + case apply 'do_double_recv'/2 + ({'more',{'a','term'}}, 'any') of + <'ok'> when 'true' -> + let <_2> = + call %% Line 273 + 'erlang':%% Line 273 + 'self' + () + in do %% Line 273 + call 'erlang':'!' + (_2, 'message') + %% Line 274 + case apply 'do_double_recv'/2 + ('whatever', 'message') of + <'ok'> when 'true' -> + %% Line 276 + case apply 'do_double_recv'/2 + ({'more',42}, 'whatever') of + <'error'> when 'true' -> + %% Line 277 + case apply 'do_double_recv'/2 + ('whatever', 'whatever') of + <'error'> when 'true' -> + %% Line 278 + 'ok' + ( <_5> when 'true' -> + primop 'match_fail' + ({'badmatch',_5}) + -| ['compiler_generated'] ) + end + ( <_4> when 'true' -> + primop 'match_fail' + ({'badmatch',_4}) + -| ['compiler_generated'] ) + end + ( <_3> when 'true' -> + primop 'match_fail' + ({'badmatch',_3}) + -| ['compiler_generated'] ) + end + ( <_1> when 'true' -> + primop 'match_fail' + ({'badmatch',_1}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'do_double_recv'/2 = + %% Line 280 + fun (_0,_1) -> + case <_0,_1> of + <{'more',Rest},_X_Msg> when 'true' -> + %% Line 281 + receive + %% Line 282 + <{'more',_4}> + when call 'erlang':'=:=' + (_4, + Rest) -> + %% Line 283 + 'ok' + after %% Line 284 + 0 -> + %% Line 285 + 'error' + %% Line 287 + <_5,Msg> when 'true' -> + %% Line 288 + receive + %% Line 289 + <_6> + when call 'erlang':'=:=' + (_6, + Msg) -> + %% Line 290 + 'ok' + after %% Line 291 + 0 -> + %% Line 292 + 'error' + ( <_3,_2> when 'true' -> + primop 'match_fail' + ({'function_clause',_3,_2}) + -| ['compiler_generated'] ) + end +'receive_var_zero'/0 = + %% Line 297 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 298 + 'erlang':%% Line 298 + 'self' + () + in do %% Line 298 + call 'erlang':'!' + (_0, 'x') + let <_1> = + call %% Line 299 + 'erlang':%% Line 299 + 'self' + () + in do %% Line 299 + call 'erlang':'!' + (_1, 'y') + let <Z> = + apply %% Line 300 + 'zero'/0 + () + in let <_3> = + receive + %% Line 302 + <'z'> when 'true' -> + 'ok' + after %% Line 303 + Z -> + %% Line 303 + 'timeout' + in %% Line 301 + case _3 of + <'timeout'> when 'true' -> + let <_5> = + receive + + after %% Line 306 + Z -> + %% Line 306 + 'timeout' + in %% Line 305 + case _5 of + <'timeout'> when 'true' -> + let <_7> = + call %% Line 308 + 'erlang':%% Line 308 + 'self' + () + in do %% Line 308 + call 'erlang':'!' + (_7, 'w') + %% Line 309 + receive + %% Line 310 + <'x'> when 'true' -> + do %% Line 311 + receive + <'y'> when 'true' -> + 'ok' + after 'infinity' -> + 'true' + do %% Line 312 + receive + <'w'> when 'true' -> + 'ok' + after 'infinity' -> + 'true' + %% Line 313 + 'ok' + %% Line 314 + <Other> when 'true' -> + %% Line 315 + call 'ct':'fail' + ({'bad_message',Other}) + after 'infinity' -> + 'true' + ( <_6> when 'true' -> + primop 'match_fail' + ({'badmatch',_6}) + -| ['compiler_generated'] ) + end + ( <_4> when 'true' -> + primop 'match_fail' + ({'badmatch',_4}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'zero'/0 = + %% Line 318 + fun () -> + case <> of + <> when 'true' -> + 0 + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'match_built_terms'/0 = + %% Line 339 + fun () -> + case <> of + <> when 'true' -> + let <_5> = + fun () -> + %% Line 340 + case <> of + <> when 'true' -> + let <Ref> = + call 'erlang':'make_ref' + () + in let <A> = + apply 'id'/1 + (97) + in let <B> = + apply 'id'/1 + (98) + in let <Built> = + apply 'id'/1 + ([A|[B|[]]]) + in let <_4> = + call 'erlang':'self' + () + in do call 'erlang':'!' + (_4, {Ref,A,B}) + receive + <{_28,_29,_30}> + when let <_35> = + call 'erlang':'=:=' + (_28, Ref) + in let <_33> = + call 'erlang':'=:=' + (_29, A) + in let <_31> = + call 'erlang':'=:=' + (_30, B) + in let <_32> = + call 'erlang':'=:=' + ([A|[B|[]]], Built) + in let <_34> = + call 'erlang':'and' + (_31, _32) + in let <_36> = + call 'erlang':'and' + (_33, _34) + in call 'erlang':'and' + (_35, _36) -> + 'ok' + after 5000 -> + call 'ct':'fail' + ([70|[97|[105|[108|[101|[100|[32|[116|[111|[32|[109|[97|[116|[99|[104|[32|[109|[101|[115|[115|[97|[103|[101|[32|[119|[105|[116|[104|[32|[116|[101|[114|[109|[32|[98|[117|[105|[108|[116|[32|[105|[110|[32|[114|[101|[99|[101|[105|[118|[101|[32|[103|[117|[97|[114|[100|[46]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]) + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end + in do %% Line 340 + apply _5 + () + let <_11> = + fun () -> + %% Line 341 + case <> of + <> when 'true' -> + let <Ref> = + call 'erlang':'make_ref' + () + in let <A> = + apply 'id'/1 + (97) + in let <B> = + apply 'id'/1 + (98) + in let <Built> = + apply 'id'/1 + ({A,B}) + in let <_10> = + call 'erlang':'self' + () + in do call 'erlang':'!' + (_10, {Ref,A,B}) + receive + <{_37,_38,_39}> + when let <_44> = + call 'erlang':'=:=' + (_37, Ref) + in let <_42> = + call 'erlang':'=:=' + (_38, A) + in let <_40> = + call 'erlang':'=:=' + (_39, B) + in let <_41> = + call 'erlang':'=:=' + ({A,B}, Built) + in let <_43> = + call 'erlang':'and' + (_40, _41) + in let <_45> = + call 'erlang':'and' + (_42, _43) + in call 'erlang':'and' + (_44, _45) -> + 'ok' + after 5000 -> + call 'ct':'fail' + ([70|[97|[105|[108|[101|[100|[32|[116|[111|[32|[109|[97|[116|[99|[104|[32|[109|[101|[115|[115|[97|[103|[101|[32|[119|[105|[116|[104|[32|[116|[101|[114|[109|[32|[98|[117|[105|[108|[116|[32|[105|[110|[32|[114|[101|[99|[101|[105|[118|[101|[32|[103|[117|[97|[114|[100|[46]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]) + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end + in do %% Line 341 + apply _11 + () + let <_19> = + fun () -> + %% Line 342 + case <> of + <> when 'true' -> + let <Ref> = + call 'erlang':'make_ref' + () + in let <A> = + apply 'id'/1 + (97) + in let <B> = + apply 'id'/1 + (98) + in let <_15> = + #{#<A>(8,1,'integer',['unsigned'|['big']]), + #<B>(8,1,'integer',['unsigned'|['big']])}# + in let <Built> = + apply 'id'/1 + (_15) + in let <_17> = + call 'erlang':'self' + () + in do call 'erlang':'!' + (_17, {Ref,A,B}) + receive + <{_46,_47,_48}> + when let <_53> = + call 'erlang':'=:=' + (_46, Ref) + in let <_51> = + call 'erlang':'=:=' + (_47, A) + in let <_49> = + call 'erlang':'=:=' + (_48, B) + in let <_50> = + try + let <_18> = + #{#<A>(8,1,'integer',['unsigned'|['big']]), + #<B>(8,1,'integer',['unsigned'|['big']])}# + in call 'erlang':'=:=' + (_18, Built) + of <Try> -> + Try + catch <T,R> -> + 'false' + in let <_52> = + call 'erlang':'and' + (_49, _50) + in let <_54> = + call 'erlang':'and' + (_51, _52) + in call 'erlang':'and' + (_53, _54) -> + 'ok' + after 5000 -> + call 'ct':'fail' + ([70|[97|[105|[108|[101|[100|[32|[116|[111|[32|[109|[97|[116|[99|[104|[32|[109|[101|[115|[115|[97|[103|[101|[32|[119|[105|[116|[104|[32|[116|[101|[114|[109|[32|[98|[117|[105|[108|[116|[32|[105|[110|[32|[114|[101|[99|[101|[105|[118|[101|[32|[103|[117|[97|[114|[100|[46]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]) + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end + in do %% Line 342 + apply _19 + () + let <_27> = + fun () -> + %% Line 343 + case <> of + <> when 'true' -> + let <Ref> = + call 'erlang':'make_ref' + () + in let <A> = + apply 'id'/1 + (97) + in let <B> = + apply 'id'/1 + (98) + in let <_23> = + ~{1=>A,2=>B}~ + in let <Built> = + apply 'id'/1 + (_23) + in let <_25> = + call 'erlang':'self' + () + in do call 'erlang':'!' + (_25, {Ref,A,B}) + receive + <{_55,_56,_57}> + when let <_62> = + call 'erlang':'=:=' + (_55, Ref) + in let <_60> = + call 'erlang':'=:=' + (_56, A) + in let <_58> = + call 'erlang':'=:=' + (_57, B) + in let <_59> = + try + let <_26> = + ~{1=>A,2=>B}~ + in call 'erlang':'=:=' + (_26, Built) + of <Try> -> + Try + catch <T,R> -> + 'false' + in let <_61> = + call 'erlang':'and' + (_58, _59) + in let <_63> = + call 'erlang':'and' + (_60, _61) + in call 'erlang':'and' + (_62, _63) -> + 'ok' + after 5000 -> + call 'ct':'fail' + ([70|[97|[105|[108|[101|[100|[32|[116|[111|[32|[109|[97|[116|[99|[104|[32|[109|[101|[115|[115|[97|[103|[101|[32|[119|[105|[116|[104|[32|[116|[101|[114|[109|[32|[98|[117|[105|[108|[116|[32|[105|[110|[32|[114|[101|[99|[101|[105|[118|[101|[32|[103|[117|[97|[114|[100|[46]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]) + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end + in %% Line 343 + apply _27 + () + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'elusive_common_exit'/0 = + %% Line 345 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 346 + 'erlang':%% Line 346 + 'self' + () + in do %% Line 346 + call 'erlang':'!' + (_0, {1,'a'}) + let <_1> = + call %% Line 347 + 'erlang':%% Line 347 + 'self' + () + in do %% Line 347 + call 'erlang':'!' + (_1, {2,'b'}) + %% Line 348 + case apply 'elusive_loop'/3 + (['x'|['y'|['z']]], 2, []) of + <{['z'],[{2,'b'}|[{1,'a'}]]}> when 'true' -> + let <CodeServer> = + call %% Line 350 + 'erlang':%% Line 350 + 'whereis' + (%% Line 350 + 'code_server') + in let <Self> = + call %% Line 351 + 'erlang':%% Line 351 + 'self' + () + in do %% Line 352 + call 'erlang':'!' + (Self, {Self,'abc'}) + do %% Line 353 + call 'erlang':'!' + (Self, {CodeServer,[]}) + do %% Line 354 + call 'erlang':'!' + (Self, {Self,'other'}) + do %% Line 355 + try + apply 'elusive2'/1 + ([]) + of <_5> -> + case _5 of + %% Line 356 + <Unexpected> when 'true' -> + %% Line 357 + call 'ct':'fail' + ([69|[120|[112|[101|[99|[116|[101|[100|[32|[97|[110|[32|[101|[120|[99|[101|[112|[116|[105|[111|[110|[59|[32|[103|[111|[116|[32|[126|[112|[10]]]]]]]]]]]]]]]]]]]]]]]]]]]]]], [Unexpected|[]]) + ( <_6> when 'true' -> + primop 'match_fail' + ({'try_clause',_6}) + -| ['compiler_generated'] ) + end + catch <_9,_8,_7> -> + %% Line 359 + case {_9,_8,_7} of + <{'throw',['other'|[_10|[_11|[]]]],_12}> + when let <_13> = + call 'erlang':'=:=' + (_10, CodeServer) + in let <_14> = + call 'erlang':'=:=' + (_11, Self) + in call 'erlang':'and' + (_13, _14) -> + %% Line 360 + 'ok' + ( <{_9,_8,_7}> when 'true' -> + primop 'raise' + (_7, _8) + -| ['compiler_generated'] ) + end + %% Line 363 + 'ok' + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',_2}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'elusive_loop'/3 = + %% Line 365 + fun (_0,_1,_2) -> + case <_0,_1,_2> of + <List,0,Results> when 'true' -> + %% Line 366 + {List,Results} + %% Line 367 + <List,ToReceive,Results> when 'true' -> + let <_4> = + receive + %% Line 370 + <Res = {_X_Pos,_X_R}> + when call 'erlang':'=/=' + (List, + []) -> + %% Line 371 + case List of + <[_X_H|T]> when 'true' -> + %% Line 372 + {Res,T} + ( <_3> when 'true' -> + primop 'match_fail' + ({'badmatch',_3}) + -| ['compiler_generated'] ) + end + %% Line 373 + <Res = {_X_Pos,_X_R}> + when call 'erlang':'=:=' + (List, + []) -> + %% Line 374 + {Res,[]} + after 'infinity' -> + 'true' + in %% Line 368 + case _4 of + <{Result,RemList}> when 'true' -> + let <_6> = + call %% Line 379 + 'erlang':%% Line 379 + '-' + (%% Line 379 + ToReceive, %% Line 379 + 1) + in %% Line 379 + apply 'elusive_loop'/3 + (RemList, _6, [Result|Results]) + ( <_5> when 'true' -> + primop 'match_fail' + ({'badmatch',_5}) + -| ['compiler_generated'] ) + end + ( <_9,_8,_7> when 'true' -> + primop 'match_fail' + ({'function_clause',_9,_8,_7}) + -| ['compiler_generated'] ) + end +'elusive2'/1 = + %% Line 382 + fun (_0) -> + case _0 of + <Acc> when 'true' -> + let <_2,Pid> = + receive + %% Line 384 + <{Pid,'abc'}> when 'true' -> + %% Line 385 + <'ok',Pid> + %% Line 386 + <{Pid,[]}> when 'true' -> + %% Line 387 + <'ok',Pid> + %% Line 388 + <{Pid,Res}> when 'true' -> + %% Line 397 + <call 'erlang':'throw' + ([Res|Acc]),Pid> + after 'infinity' -> + <'true','true'> + in %% Line 400 + apply 'elusive2'/1 + ([Pid|Acc]) + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +'after_expression'/0 = + %% Line 402 + fun () -> + case <> of + <> when 'true' -> + let <_0> = + call %% Line 403 + 'erlang':%% Line 403 + 'self' + () + in do %% Line 403 + call 'erlang':'!' + (_0, {'a','message'}) + %% Line 404 + case apply 'after_expr'/1 + (0) of + <{'a','message'}> when 'true' -> + %% Line 405 + case apply 'after_expr'/1 + (0) of + <'timeout'> when 'true' -> + %% Line 406 + case apply 'after_expr'/1 + (10) of + <'timeout'> when 'true' -> + %% Line 407 + 'ok' + ( <_3> when 'true' -> + primop 'match_fail' + ({'badmatch',_3}) + -| ['compiler_generated'] ) + end + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',_2}) + -| ['compiler_generated'] ) + end + ( <_1> when 'true' -> + primop 'match_fail' + ({'badmatch',_1}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'after_expr'/1 = + %% Line 409 + fun (_0) -> + case _0 of + <Timeout> when 'true' -> + %% Line 410 + receive + %% Line 411 + <Msg> when 'true' -> + Msg + after %% Line 412 + apply 'id'/1 + (Timeout) -> + %% Line 413 + 'timeout' + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +'id'/1 = + %% Line 416 + fun (_0) -> + case _0 of + <I> when 'true' -> + I + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +'module_info'/0 = + fun () -> + case <> of + <> when 'true' -> + call 'erlang':'get_module_info' + ('receive_tests') + ( <> when 'true' -> + primop 'match_fail' + ({'function_clause'}) + -| ['compiler_generated'] ) + end +'module_info'/1 = + fun (_0) -> + case _0 of + <X> when 'true' -> + call 'erlang':'get_module_info' + ('receive_tests', X) + ( <_1> when 'true' -> + primop 'match_fail' + ({'function_clause',_1}) + -| ['compiler_generated'] ) + end +end
\ No newline at end of file diff --git a/lib/compiler/test/core_alias_SUITE.erl b/lib/compiler/test/core_alias_SUITE.erl index 737b1567d4..094d3c8557 100644 --- a/lib/compiler/test/core_alias_SUITE.erl +++ b/lib/compiler/test/core_alias_SUITE.erl @@ -47,11 +47,10 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - id(X) -> X. tuples(Config) when is_list(Config) -> - Tuple = {ok,id(value)}, + Tuple = id({ok,id(value)}), true = erts_debug:same(Tuple, simple_tuple(Tuple)), true = erts_debug:same(Tuple, simple_tuple_in_map(#{hello => Tuple})), @@ -59,24 +58,24 @@ tuples(Config) when is_list(Config) -> true = erts_debug:same(Tuple, simple_tuple_fun_repeated(Tuple, Tuple)), true = erts_debug:same(Tuple, simple_tuple_twice_head(Tuple, Tuple)), - {Tuple1, Tuple2} = simple_tuple_twice_body(Tuple), + {Tuple1, Tuple2} = id(simple_tuple_twice_body(Tuple)), true = erts_debug:same(Tuple, Tuple1), true = erts_debug:same(Tuple, Tuple2), - Nested = {nested,Tuple}, + Nested = id({nested,Tuple}), true = erts_debug:same(Tuple, nested_tuple_part(Nested)), true = erts_debug:same(Nested, nested_tuple_whole(Nested)), true = erts_debug:same(Nested, nested_tuple_with_alias(Nested)), true = erts_debug:same(Tuple, tuple_rebinding_after(Tuple)), - Tuple = unaliased_tuple_rebinding_before(Tuple), + Tuple = id(unaliased_tuple_rebinding_before(Tuple)), false = erts_debug:same(Tuple, unaliased_tuple_rebinding_before(Tuple)), - Nested = unaliased_literal_tuple_head(Nested), + Nested = id(unaliased_literal_tuple_head(Nested)), false = erts_debug:same(Nested, unaliased_literal_tuple_head(Nested)), - Nested = unaliased_literal_tuple_body(Nested), + Nested = id(unaliased_literal_tuple_body(Nested)), false = erts_debug:same(Nested, unaliased_literal_tuple_body(Nested)), - Nested = unaliased_different_var_tuple(Nested, Tuple), + Nested = id(unaliased_different_var_tuple(Nested, Tuple)), false = erts_debug:same(Nested, unaliased_different_var_tuple(Nested, Tuple)). simple_tuple({ok,X}) -> @@ -119,7 +118,7 @@ unaliased_different_var_tuple({nested,{ok,value}=X}, Y) -> {nested,Y}. cons(Config) when is_list(Config) -> - Cons = [ok|id(value)], + Cons = id([ok|id(value)]), true = erts_debug:same(Cons, simple_cons(Cons)), true = erts_debug:same(Cons, simple_cons_in_map(#{hello => Cons})), @@ -127,27 +126,27 @@ cons(Config) when is_list(Config) -> true = erts_debug:same(Cons, simple_cons_fun_repeated(Cons, Cons)), true = erts_debug:same(Cons, simple_cons_twice_head(Cons, Cons)), - {Cons1,Cons2} = simple_cons_twice_body(Cons), + {Cons1,Cons2} = id(simple_cons_twice_body(Cons)), true = erts_debug:same(Cons, Cons1), true = erts_debug:same(Cons, Cons2), - Nested = [nested,Cons], + Nested = id([nested,Cons]), true = erts_debug:same(Cons, nested_cons_part(Nested)), true = erts_debug:same(Nested, nested_cons_whole(Nested)), true = erts_debug:same(Nested, nested_cons_with_alias(Nested)), true = erts_debug:same(Cons, cons_rebinding_after(Cons)), Unstripped = id([a,b]), - Stripped = cons_with_binary([<<>>|Unstripped]), + Stripped = id(cons_with_binary([<<>>|Unstripped])), true = erts_debug:same(Unstripped, Stripped), - Cons = unaliased_cons_rebinding_before(Cons), + Cons = id(unaliased_cons_rebinding_before(Cons)), false = erts_debug:same(Cons, unaliased_cons_rebinding_before(Cons)), - Nested = unaliased_literal_cons_head(Nested), + Nested = id(unaliased_literal_cons_head(Nested)), false = erts_debug:same(Nested, unaliased_literal_cons_head(Nested)), - Nested = unaliased_literal_cons_body(Nested), + Nested = id(unaliased_literal_cons_body(Nested)), false = erts_debug:same(Nested, unaliased_literal_cons_body(Nested)), - Nested = unaliased_different_var_cons(Nested, Cons), + Nested = id(unaliased_different_var_cons(Nested, Cons)), false = erts_debug:same(Nested, unaliased_different_var_cons(Nested, Cons)). simple_cons([ok|X]) -> diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index 8b9dbe4aa0..9436ad5d53 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -270,8 +270,7 @@ maps_warnings(Config) when is_list(Config) -> id(I) -> I. ">>, [return], - {error,[{3,erl_lint,{unbound_var,'K'}}, - {6,erl_lint,illegal_map_key}],[]}} + {error,[{3,erl_lint,{unbound_var,'K'}}],[]}} ], [] = run2(Config, Ts1), ok. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index a61c56e331..c039da93f0 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -19,7 +19,7 @@ %% -module(guard_SUITE). --include_lib("common_test/include/ct.hrl"). +-include_lib("syntax_tools/include/merl.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, @@ -31,7 +31,8 @@ old_guard_tests/1,complex_guard/1, build_in_guard/1,gbif/1, t_is_boolean/1,is_function_2/1, - tricky/1,rel_ops/1,rel_op_combinations/1,literal_type_tests/1, + tricky/1,rel_ops/1,rel_op_combinations/1, + generated_combinations/1,literal_type_tests/1, basic_andalso_orelse/1,traverse_dcd/1, check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, bad_constants/1,bad_guards/1, @@ -56,7 +57,7 @@ groups() -> check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE, repeated_type_tests]}, - {slow,[],[literal_type_tests]}]. + {slow,[],[literal_type_tests,generated_combinations]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -1222,6 +1223,10 @@ tricky(Config) when is_list(Config) -> error = tricky_3(#{}), error = tricky_3({a,b}), + {'EXIT',_} = (catch tricky_4(x)), + {'EXIT',_} = (catch tricky_4(42)), + {'EXIT',_} = (catch tricky_4(true)), + ok. tricky_1(X, Y) when abs((X == 1) or (Y == 2)) -> ok; @@ -1239,6 +1244,13 @@ tricky_3(X) tricky_3(_) -> error. +tricky_4(X) -> + B = (abs(X) or abs(X)) =:= true, + case B of + true -> ok; + false -> error + end. + %% From dets_v9:read_buckets/11, simplified. rb(Size, ToRead, SoFar) when SoFar + Size < 81920; ToRead == [] -> true; @@ -1589,6 +1601,116 @@ redundant_12(X) when X >= 50, X =< 80 -> 2*X; redundant_12(X) when X < 51 -> 5*X; redundant_12(_) -> none. +%% Exhaustively test all combinations of relational operators +%% to ensure the correctness of the optimizations in beam_ssa_dead. + +generated_combinations(Config) -> + Mod = ?FUNCTION_NAME, + RelOps = ['=:=','=/=','==','/=','<','=<','>=','>'], + Combinations0 = [{Op1,Op2} || Op1 <- RelOps, Op2 <- RelOps], + Combinations1 = gen_lit_combs(Combinations0), + Combinations2 = [{neq,Comb} || + {_Op1,_Lit1,Op2,_Lit2}=Comb <- Combinations1, + Op2 =:= '=/=' orelse Op2 =:= '/='] ++ Combinations1, + Combinations = gen_func_names(Combinations2, 0), + Fs = gen_rel_op_functions(Combinations), + Tree = ?Q(["-module('@Mod@').", + "-compile([export_all,nowarn_export_all])."]) ++ Fs, + %%merl:print(Tree), + Opts = test_lib:opt_opts(?MODULE), + {ok,_Bin} = merl:compile_and_load(Tree, Opts), + test_combinations(Combinations, Mod). + +gen_lit_combs([{Op1,Op2}|T]) -> + [{Op1,7,Op2,6}, + {Op1,7.0,Op2,6}, + {Op1,7,Op2,6.0}, + {Op1,7.0,Op2,6.0}, + + {Op1,7,Op2,7}, + {Op1,7.0,Op2,7}, + {Op1,7,Op2,7.0}, + {Op1,7.0,Op2,7.0}, + + {Op1,6,Op2,7}, + {Op1,6.0,Op2,7}, + {Op1,6,Op2,7.0}, + {Op1,6.0,Op2,7.0}|gen_lit_combs(T)]; +gen_lit_combs([]) -> []. + +gen_func_names([E|Es], I) -> + Name = list_to_atom("f" ++ integer_to_list(I)), + [{Name,E}|gen_func_names(Es, I+1)]; +gen_func_names([], _) -> []. + +gen_rel_op_functions([{Name,{neq,{Op1,Lit1,Op2,Lit2}}}|T]) -> + %% Note that in the translation to SSA, '=/=' will be + %% translated to '=:=' in a guard (with switched success + %% and failure labels). Therefore, to test the optimization, + %% we must use '=/=' (or '/=') in a body context. + %% + %% Here is an example of a generated function: + %% + %% f160(A) when erlang:'>='(A, 7) -> + %% one; + %% f160(A) -> + %% true = erlang:'/='(A, 7), + %% two. + [?Q("'@Name@'(A) when erlang:'@Op1@'(A, _@Lit1@) -> one; + '@Name@'(A) -> true = erlang:'@Op2@'(A, _@Lit2@), two. ")| + gen_rel_op_functions(T)]; +gen_rel_op_functions([{Name,{Op1,Lit1,Op2,Lit2}}|T]) -> + %% Example of a generated function: + %% + %% f721(A) when erlang:'=<'(A, 7.0) -> one; + %% f721(A) when erlang:'<'(A, 6) -> two; + %% f721(_) -> three. + [?Q("'@Name@'(A) when erlang:'@Op1@'(A, _@Lit1@) -> one; + '@Name@'(A) when erlang:'@Op2@'(A, _@Lit2@) -> two; + '@Name@'(_) -> three.")|gen_rel_op_functions(T)]; +gen_rel_op_functions([]) -> []. + +test_combinations([{Name,E}|T], Mod) -> + try + test_combinations_1([5,6,7,8,9], E, fun Mod:Name/1), + test_combination(6.5, E, fun Mod:Name/1) + catch + error:Reason:Stk -> + io:format("~p: ~p\n", [Name,E]), + erlang:raise(error, Reason, Stk) + end, + test_combinations(T, Mod); +test_combinations([], _Mod) -> ok. + +test_combinations_1([V|Vs], E, Fun) -> + test_combination(V, E, Fun), + test_combination(float(V), E, Fun), + test_combinations_1(Vs, E, Fun); +test_combinations_1([], _, _) -> ok. + +test_combination(Val, {neq,Expr}, Fun) -> + Result = eval_combination_expr(Expr, Val), + Result = try + Fun(Val) %Returns 'one' or 'two'. + catch + error:{badmatch,_} -> + three + end; +test_combination(Val, Expr, Fun) -> + Result = eval_combination_expr(Expr, Val), + Result = Fun(Val). + +eval_combination_expr({Op1,Lit1,Op2,Lit2}, Val) -> + case erlang:Op1(Val, Lit1) of + true -> + one; + false -> + case erlang:Op2(Val, Lit2) of + true -> two; + false -> three + end + end. + %% Test type tests on literal values. (From emulator test suites.) literal_type_tests(Config) when is_list(Config) -> %% Generate an Erlang module with all different type of type tests. @@ -1818,6 +1940,15 @@ andalso_semi(Config) when is_list(Config) -> ok = andalso_semi_bar([a,b,c]), ok = andalso_semi_bar(1), fc(catch andalso_semi_bar([a,b])), + + ok = andalso_semi_dispatch(name, fun andalso_semi/1), + ok = andalso_semi_dispatch(name, fun ?MODULE:andalso_semi/1), + ok = andalso_semi_dispatch(name, {?MODULE,andalso_semi,1}), + fc(catch andalso_semi_dispatch(42, fun andalso_semi/1)), + fc(catch andalso_semi_dispatch(name, not_fun)), + fc(catch andalso_semi_dispatch(name, fun andalso_semi_dispatch/2)), + fc(catch andalso_semi_dispatch(42, {a,b})), + ok. andalso_semi_foo(Bar) when is_integer(Bar) andalso Bar =:= 0; Bar =:= 1 -> @@ -1826,6 +1957,10 @@ andalso_semi_foo(Bar) when is_integer(Bar) andalso Bar =:= 0; Bar =:= 1 -> andalso_semi_bar(Bar) when is_list(Bar) andalso length(Bar) =:= 3; Bar =:= 1 -> ok. +andalso_semi_dispatch(Registry, MFAOrFun) when + is_atom(Registry) andalso is_function(MFAOrFun, 1); + is_atom(Registry) andalso tuple_size(MFAOrFun) == 3 -> + ok. t_tuple_size(Config) when is_list(Config) -> 10 = do_tuple_size({1,2,3,4}), @@ -2121,7 +2256,8 @@ do_guard_in_catch_bin(From) -> %%% %%% The beam_bool pass has been eliminated. Here are the tests from -%%% beam_bool_SUITE. +%%% beam_bool_SUITE, as well as new tests to test the new beam_ssa_bool +%%% module. %%% beam_bool_SUITE(_Config) -> @@ -2130,6 +2266,11 @@ beam_bool_SUITE(_Config) -> y_registers(), protected(), maps(), + cover_shortcut_branches(), + wrong_order(), + megaco(), + looks_like_a_guard(), + fail_in_guard(), ok. before_and_inside_if() -> @@ -2267,6 +2408,115 @@ maps() -> evidence(#{0 := Charge}) when 0; #{[] => Charge} == #{[] => 42} -> ok. +cover_shortcut_branches() -> + ok = cover_shortcut_branches({r1}, 0, 42, false), + ok = cover_shortcut_branches({r1}, 42, 42, true), + error = cover_shortcut_branches({r1}, same, same, false), + error = cover_shortcut_branches({r1}, x, y, true), + error = cover_shortcut_branches({r2}, 0, 42, false), + error = cover_shortcut_branches({}, 0, 42, false), + error = cover_shortcut_branches(not_tuple, 0, 42, false), + ok. + +cover_shortcut_branches(St, X, Y, Z) -> + if + %% The ((Y =:= X) =:= Z) part will test handling of a comparison + %% operator followed by a one-way `br`. + ((element(1, St) =:= r1) orelse fail) and ((Y =:= X) =:= Z) -> + ok; + true -> + error + end. + +wrong_order() -> + ok = wrong_order(repeat_until_fail, true), + ok = wrong_order(repeat_until_fail, whatever), + error = wrong_order(repeat_until_fail, false), + error = wrong_order(nope, true), + ok. + +wrong_order(RepeatType, Mode) -> + Parallel = Mode =/= false, + RepeatStop = RepeatType =:= repeat_until_fail, + if + Parallel andalso RepeatStop -> + ok; + true -> + error + end. + +megaco() -> + ok = megaco('NULL', 0), + ok = megaco('NULL', 7), + ok = megaco('NULL', 15), + ok = megaco('NULL', asn1_NOVALUE), + ok = megaco(asn1_NOVALUE, 0), + ok = megaco(asn1_NOVALUE, 7), + ok = megaco(asn1_NOVALUE, 15), + ok = megaco(asn1_NOVALUE, asn1_NOVALUE), + + error = megaco(bad, 0), + error = megaco(bad, 7), + error = megaco(bad, 15), + error = megaco(bad, asn1_NOVALUE), + + error = megaco('NULL', not_integer), + error = megaco('NULL', -1), + error = megaco('NULL', 16), + error = megaco(asn1_NOVALUE, not_integer), + error = megaco(asn1_NOVALUE, -1), + error = megaco(asn1_NOVALUE, 16), + + error = megaco(bad, bad), + error = megaco(bad, -1), + error = megaco(bad, 42), + + ok. + +megaco(Top, SelPrio) + when (Top =:= 'NULL' orelse Top =:= asn1_NOVALUE) andalso + ((is_integer(SelPrio) andalso ((0 =< SelPrio) and (SelPrio =< 15))) orelse + SelPrio =:= asn1_NOVALUE) -> + ok; +megaco(_, _) -> + error. + +%% ERL-1054. +looks_like_a_guard() -> + ok = looks_like_a_guard(0), + ok = looks_like_a_guard(1), + ok. + +looks_like_a_guard(N) -> + GuessPosition = id(42), + %% The matching of `true` would look like a guard to + %% beam_ssa_bool. The optimized code would not be safe. + case {1 >= N, GuessPosition == 0} of + {true, _} -> ok; + {_, true} -> ok; + _ -> looks_like_a_guard(N) + end. + +fail_in_guard() -> + false = struct_or_map(a, "foo"), + false = struct_or_map(a, foo), + false = struct_or_map(#{}, "foo"), + true = struct_or_map(#{}, foo), + ok. + +%% ERL-1183. If Name is not an atom, the `fail` atom must cause the +%% entire guard to fail. +struct_or_map(Arg, Name) when + (is_map(Arg) andalso (is_atom(Name) orelse fail) andalso + is_map_key(struct, Arg)) orelse is_map(Arg) -> true; +struct_or_map(_Arg, _Name) -> + false. + + +%%% +%%% End of beam_bool_SUITE tests. +%%% + repeated_type_tests(_Config) -> binary = repeated_type_test(<<42>>), bitstring = repeated_type_test(<<1:1>>), diff --git a/lib/compiler/test/lfe_andor_SUITE.core b/lib/compiler/test/lfe_andor_SUITE.core index df58b39ae6..e8cb0919a0 100644 --- a/lib/compiler/test/lfe_andor_SUITE.core +++ b/lib/compiler/test/lfe_andor_SUITE.core @@ -34,6 +34,8 @@ module 'lfe_andor_SUITE' ['$handle_undefined_function'/2, 'init_per_suite'/1 = %% Line 48 fun (_config) -> + do + call 'test_lib':'recompile_core'('lfe_andor_SUITE') _config 'end_per_suite'/1 = %% Line 50 diff --git a/lib/compiler/test/lfe_guard_SUITE.core b/lib/compiler/test/lfe_guard_SUITE.core index 920be82f61..9d184ed166 100644 --- a/lib/compiler/test/lfe_guard_SUITE.core +++ b/lib/compiler/test/lfe_guard_SUITE.core @@ -53,6 +53,8 @@ module 'lfe_guard_SUITE' ['$handle_undefined_function'/2, 'init_per_suite'/1 = %% Line 62 fun (_config) -> + do + call 'test_lib':'recompile_core'('lfe_guard_SUITE') _config 'end_per_suite'/1 = %% Line 64 diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 2bcb6133da..46c1acef4c 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -74,7 +74,10 @@ %% new in OTP 22 t_mixed_clause/1,cover_beam_trim/1, - t_duplicate_keys/1 + t_duplicate_keys/1, + + %% new in OTP 23 + t_key_expressions/1 ]). suite() -> []. @@ -132,7 +135,10 @@ all() -> %% new in OTP 22 t_mixed_clause,cover_beam_trim, - t_duplicate_keys + t_duplicate_keys, + + %% new in OTP 23 + t_key_expressions ]. groups() -> []. @@ -2193,6 +2199,92 @@ do_cover_beam_trim(Id, OldMax, Max, Id, M) -> #{Id:=Val} = id(M), Val. +t_key_expressions(_Config) -> + Int = id(42), + #{{tag,Int} := 42} = id(#{{tag,Int} => 42}), + #{{tag,Int+1} := 42} = id(#{{tag,Int+1} => 42}), + #{{a,b} := x, {tag,Int} := 42, Int := 0} = + id(#{{a,b} => x, {tag,Int} => 42, Int => 0}), + + F1 = fun(#{Int + 1 := Val}) -> Val end, + val = F1(#{43 => val}), + {'EXIT',_} = (catch F1(a)), + + F2 = fun(M, X, Y) -> + case M of + #{element(X, Y) := <<Sz:16,Bin:Sz/binary>>} -> + Bin; + #{} -> + not_found; + {A,B} -> + A + B + end + end, + <<"xyz">> = F2(#{b => <<3:16,"xyz">>}, 2, {a,b,c}), + not_found = F2(#{b => <<3:16,"xyz">>}, 999, {a,b,c}), + 13 = F2({6,7}, 1, 2), + + #{<<"Спутник"/utf8>> := 1} = id(#{<<"Спутник"/utf8>> => 1}), + + F3 = fun(Arg) -> + erase(once), + RunOnce = fun(I) -> + undefined = put(once, twice), + id(I) + end, + case RunOnce(Arg) of + #{{tag,<<Int:42>>} := Value} -> Value; + {X,Y} -> X + Y + end + end, + 10 = F3({7,3}), + whatever = F3(#{{tag,<<Int:42>>} => whatever}), + + F4 = fun(K1, K2, M) -> + case M of + #{K1 div K2 := V} -> V; + #{} -> no_match + end + end, + value = F4(42, 21, #{2 => value}), + no_match = F4(42, 21, #{}), + no_match = F4(42, 0, #{2 => value}), + no_match = F4(42, a, #{2 => value}), + + F5 = fun(Term) -> + self() ! Term, + receive + #{[<<(3 bsr 30 + 2):0,$k:[]/signed-integer>>] := _} -> + ok; + 0.5 -> + error + end + end, + error = F5(0.5), + + F6 = fun(Term) -> + self() ! Term, + receive + #{<<a/utf8>> := {a,b,c}} -> ok; + Other -> {error,Other} + end + end, + {error,any} = F6(any), + + F7 = fun(Term) -> + self() ! Term, + (?MODULE:all()):a(catch + receive + <<1.14:{<<"a":(tuple_size(1))>>}>> -> + 4; + Other -> + Other + end) + end, + {'EXIT',{badarg,_}} = (catch F7(whatever)), + + ok. + t_duplicate_keys(Config) when is_list(Config) -> Map = #{ gurka => gaffel }, Map = dup_keys_1(id(Map)), diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index bc74ec4984..d1da114d3f 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -26,7 +26,7 @@ selectify/1,deselectify/1,underscore/1,match_map/1,map_vars_used/1, coverage/1,grab_bag/1,literal_binary/1, unary_op/1,eq_types/1,match_after_return/1,match_right_tuple/1, - tuple_size_in_try/1]). + tuple_size_in_try/1,match_boolean_list/1]). -include_lib("common_test/include/ct.hrl"). @@ -43,7 +43,7 @@ groups() -> underscore,match_map,map_vars_used,coverage, grab_bag,literal_binary,unary_op,eq_types, match_after_return,match_right_tuple, - tuple_size_in_try]}]. + tuple_size_in_try,match_boolean_list]}]. init_per_suite(Config) -> @@ -260,6 +260,7 @@ non_matching_aliases(_Config) -> none = mixed_aliases(<<6789:16>>), none = mixed_aliases(#{key=>value}), + {'EXIT',{{badmatch,bar},_}} = (catch plus_plus_prefix()), {'EXIT',{{badmatch,42},_}} = (catch nomatch_alias(42)), {'EXIT',{{badmatch,job},_}} = (catch entirely()), {'EXIT',{{badmatch,associates},_}} = (catch printer()), @@ -294,8 +295,12 @@ mixed_aliases([X] = #{key:=X}) -> {k,X}; mixed_aliases(#{key:=X} = [X]) -> {l,X}; mixed_aliases({a,X} = #{key:=X}) -> {m,X}; mixed_aliases(#{key:=X} = {a,X}) -> {n,X}; +mixed_aliases([] ++ (foo = [])) -> o; mixed_aliases(_) -> none. +plus_plus_prefix() -> + [] ++ (foo = []) = bar. + nomatch_alias(I) -> {ok={A,B}} = id(I), {A,B}. @@ -939,4 +944,17 @@ tsit(A) -> _:_ -> ok end. +match_boolean_list(Config) when is_list(Config) -> + BoolList = [N rem 2 =:= 0 || N <- lists:seq(1, 8)], + %% The compiler knows that all list elements are booleans, so it translates + %% the expression below to a #b_br{} on the list head. + %% + %% This is fine, but since the value was only used in that branch, + %% reserve_zregs/3 (pre_codegen) would place the variable in a z register, + %% crashing the compiler in a later pass. + ok = case BoolList of + [true | _] -> error; + [false | _] -> ok + end. + id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 6e81bafd61..883c713a79 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -164,6 +164,11 @@ md5_1(Beam) -> %% Cover some code that handles internal errors. silly_coverage(Config) when is_list(Config) -> + %% v3_core + BadAbstr = [{attribute,0,module,bad_module}, + {function,0,foo,2,[bad_clauses]}], + expect_error(fun() -> v3_core:module(BadAbstr, []) end), + %% sys_core_fold, sys_core_alias, sys_core_bsm, v3_kernel BadCoreErlang = {c_module,[], name,[],[], @@ -184,6 +189,7 @@ silly_coverage(Config) when is_list(Config) -> expect_error(fun() -> beam_kernel_to_ssa:module(BadKernel, []) end), %% beam_ssa_lint + %% beam_ssa_bool %% beam_ssa_recv %% beam_ssa_share %% beam_ssa_pre_codegen @@ -191,6 +197,7 @@ silly_coverage(Config) when is_list(Config) -> BadSSA = {b_module,#{},a,b,c, [{b_function,#{func_info=>{mod,foo,0}},args,bad_blocks,0}]}, expect_error(fun() -> beam_ssa_lint:module(BadSSA, []) end), + expect_error(fun() -> beam_ssa_bool:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_recv:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_share:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_pre_codegen:module(BadSSA, []) end), @@ -198,7 +205,7 @@ silly_coverage(Config) when is_list(Config) -> %% beam_ssa_opt BadSSABlocks = #{0 => {b_blk,#{},[bad_code],{b_ret,#{},arg}}}, - BadSSAOpt = {b_module,#{},a,[],c, + BadSSAOpt = {b_module,#{},a,[],[], [{b_function,#{func_info=>{mod,foo,0}},[], BadSSABlocks,0}]}, expect_error(fun() -> beam_ssa_opt:module(BadSSAOpt, []) end), @@ -230,15 +237,6 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_block:module(BlockInput, []) end), - %% beam_except - ExceptInput = {?MODULE,[{foo,0}],[], - [{function,foo,0,2, - [{label,1}, - {line,loc}, - {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}|non_proper_list]}],99}, - expect_error(fun() -> beam_except:module(ExceptInput, []) end), - %% beam_jump JumpInput = BlockInput, expect_error(fun() -> beam_jump:module(JumpInput, []) end), @@ -286,14 +284,34 @@ silly_coverage(Config) when is_list(Config) -> bad_ssa_lint_input() -> {b_module,#{},t, - [{foobar,1},{module_info,0},{module_info,1}], + [{a,1},{b,1},{c,1},{module_info,0},{module_info,1}], [], [{b_function, - #{func_info => {t,foobar,1},location => {"t.erl",4}}, + #{func_info => {t,a,1},location => {"t.erl",4}}, [{b_var,0}], #{0 => {b_blk,#{},[],{b_ret,#{},{b_var,'@undefined_var'}}}}, 3}, {b_function, + #{func_info => {t,b,1},location => {"t.erl",5}}, + [{b_var,0}], + #{0 => + {b_blk,#{}, + [{b_set,#{},{b_var,'@first_var'},first_op,[]}, + {b_set,#{},{b_var,'@second_var'},second_op,[]}, + {b_set,#{},{b_var,'@ret'},succeeded,[{b_var,'@first_var'}]}], + {b_ret,#{},{b_var,'@ret'}}}}, + 3}, + {b_function, + #{func_info => {t,c,1},location => {"t.erl",6}}, + [{b_var,0}], + #{0 => + {b_blk,#{}, + [{b_set,#{},{b_var,'@first_var'},first_op,[]}, + {b_set,#{},{b_var,'@ret'},succeeded,[{b_var,'@first_var'}]}, + {b_set,#{},{b_var,'@second_var'},second_op,[]}], + {b_ret,#{},{b_var,'@ret'}}}}, + 3}, + {b_function, #{func_info => {t,module_info,0}}, [], #{0 => diff --git a/lib/compiler/test/property_test/beam_types_prop.erl b/lib/compiler/test/property_test/beam_types_prop.erl new file mode 100644 index 0000000000..1e5da10aa0 --- /dev/null +++ b/lib/compiler/test/property_test/beam_types_prop.erl @@ -0,0 +1,315 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_types_prop). + +-compile([export_all, nowarn_export_all]). + +%% This module only supports proper, as we don't have an eqc license to test +%% with. + +-proptest([proper]). + +-ifdef(PROPER). + +-define(BEAM_TYPES_INTERNAL, true). +-include_lib("compiler/src/beam_types.hrl"). + +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc,proper). + +-import(lists, [duplicate/2,foldl/3]). + +%% The default repetitions of 100 is a bit too low to reliably cover all type +%% combinations, so we crank it up a bit. +-define(REPETITIONS, 5000). + +absorption() -> + numtests(?REPETITIONS, absorption_1()). + +absorption_1() -> + ?FORALL({TypeA, TypeB}, + ?LET(TypeA, type(), + ?LET(TypeB, type(), {TypeA, TypeB})), + absorption_check(TypeA, TypeB)). + +absorption_check(A, B) -> + verified_type(A), + verified_type(B), + + %% a ∨ (a ∧ b) = a + A = join(A, meet(A, B)), + + %% a ∧ (a ∨ b) = a + A = meet(A, join(A, B)), + + true. + +associativity() -> + numtests(?REPETITIONS, associativity_1()). + +associativity_1() -> + ?FORALL({TypeA, TypeB, TypeC}, + ?LET(TypeA, type(), + ?LET(TypeB, type(), + ?LET(TypeC, type(), {TypeA, TypeB, TypeC}))), + associativity_check(TypeA, TypeB, TypeC)). + +associativity_check(A, B, C) -> + verified_type(A), + verified_type(B), + verified_type(C), + + %% a ∨ (b ∨ c) = (a ∨ b) ∨ c + LHS_Join = join(A, join(B, C)), + RHS_Join = join(join(A, B), C), + LHS_Join = RHS_Join, + + %% a ∧ (b ∧ c) = (a ∧ b) ∧ c + LHS_Meet = meet(A, meet(B, C)), + RHS_Meet = meet(meet(A, B), C), + LHS_Meet = RHS_Meet, + + true. + +commutativity() -> + numtests(?REPETITIONS, commutativity_1()). + +commutativity_1() -> + ?FORALL({TypeA, TypeB}, + ?LET(TypeA, type(), + ?LET(TypeB, type(), {TypeA, TypeB})), + commutativity_check(TypeA, TypeB)). + +commutativity_check(A, B) -> + verified_type(A), + verified_type(B), + + %% a ∨ b = b ∨ a + true = join(A, B) =:= join(B, A), + + %% a ∧ b = b ∧ a + true = meet(A, B) =:= meet(B, A), + + true. + +idempotence() -> + numtests(?REPETITIONS, idempotence_1()). + +idempotence_1() -> + ?FORALL(Type, type(), idempotence_check(Type)). + +idempotence_check(Type) -> + verified_type(Type), + + %% a ∨ a = a + Type = join(Type, Type), + + %% a ∧ a = a + Type = meet(Type, Type), + + true. + +identity() -> + ?FORALL(Type, type(), identity_check(Type)). + +identity_check(Type) -> + verified_type(Type), + + %% a ∨ [bottom element] = a + Type = join(Type, none), + + %% a ∧ [top element] = a + Type = meet(Type, any), + + true. + +subtraction() -> + numtests(?REPETITIONS, subtraction_1()). + +subtraction_1() -> + ?FORALL({TypeA, TypeB}, + ?LET(TypeA, type(), + ?LET(TypeB, type(), {TypeA, TypeB})), + subtraction_check(TypeA, TypeB)). + +subtraction_check(A, B) -> + verified_type(A), + verified_type(B), + + %% Subtraction can be thought of as `a ∧ ¬b`, so the result must be at + %% least as specific as `a`. + Res = subtract(A, B), + Res = meet(A, Res), + + true. + +meet(A, B) -> beam_types:meet(A, B). +join(A, B) -> beam_types:join(A, B). +subtract(A, B) -> beam_types:subtract(A, B). +verified_type(T) -> beam_types:verified_type(T). + +%%% +%%% Generators +%%% + +type() -> + type(?MAX_TYPE_DEPTH). + +type(Depth) -> + ?SHRINK(?LAZY(oneof([any, none] ++ term_types(Depth))), + [nil, any, none]). + +term_type(Depth) -> + ?SHRINK(?LAZY(oneof([any | term_types(Depth)])), + [nil, any]). + +term_types(Depth) -> + nested_generators(Depth) ++ + numerical_generators() ++ + [gen_atom(), gen_bs_matchable()]. + +numerical_generators() -> + [gen_integer(), gen_float(), number]. + +nested_generators(Depth) when Depth =< 0 -> + [nil]; +nested_generators(Depth) -> + [gen_list(Depth - 1), + gen_fun(Depth - 1), + gen_map(Depth - 1), + ?LAZY(gen_tuple(Depth - 1)), + ?LAZY(gen_union(Depth - 1))]. + +%% Proper's atom generator is far too wide, generating strings like 'û\2144Bò}' +%% which are both hard to read and fill up the atom table really fast. +readable_atom() -> + ?LET(Atom, range($0, $~), list_to_atom([Atom])). + +%% + +gen_atom() -> + ?LET(Size, range(0, ?ATOM_SET_SIZE), + ?LET(Set, duplicate(Size, readable_atom()), + case ordsets:from_list(Set) of + [_|_]=Vs -> #t_atom{elements=ordsets:from_list(Vs)}; + [] -> #t_atom{} + end)). + +gen_bs_matchable() -> + oneof([?LET(Unit, range(1, 16), #t_bs_matchable{tail_unit=Unit}), + ?LET(Unit, range(1, 16), #t_bs_context{tail_unit=Unit}), + ?LET(Unit, range(1, 16), #t_bitstring{size_unit=Unit})]). + +gen_float() -> + oneof([?LET({A, B}, {integer(), integer()}, + begin + Min = float(min(A,B)), + Max = float(max(A,B)), + #t_float{elements={Min,Max}} + end), + #t_float{}]). + +gen_fun(Depth) -> + ?SHRINK(?LET({Type, Arity}, {type(Depth), oneof([any, range(1, 4)])}, + #t_fun{type=Type,arity=Arity}), + [#t_fun{}]). + +gen_integer() -> + oneof([?LET({A, B}, {integer(), integer()}, + #t_integer{elements={min(A,B), max(A,B)}}), + #t_integer{}]). + +gen_list(Depth) -> + ?SHRINK(oneof([?LET({Type, Term}, {term_type(Depth), term_type(Depth)}, + #t_list{type=Type,terminator=Term}), + ?LET({Type, Term}, {term_type(Depth), term_type(Depth)}, + #t_cons{type=Type,terminator=Term}), + nil]), + [nil]). + +gen_map(Depth) -> + ?SHRINK(?LET({SKey, SValue}, {term_type(Depth), term_type(Depth)}, + #t_map{super_key=SKey,super_value=SValue}), + [#t_map{}]). + +gen_tuple(Depth) -> + ?SHRINK(oneof([gen_tuple_plain(Depth), gen_tuple_record(Depth)]), + [#t_tuple{}]). + +gen_tuple_record(Depth) -> + ?LET({Start, Size}, {range(2, ?TUPLE_ELEMENT_LIMIT), + range(1, ?TUPLE_ELEMENT_LIMIT * 2)}, + ?LET({Tag, Es0}, {readable_atom(), + gen_tuple_elements(Start, Size, Depth)}, + begin + Es = Es0#{ 1 => #t_atom{elements=[Tag]} }, + #t_tuple{exact=true,size=Size,elements=Es} + end)). + +gen_tuple_plain(Depth) -> + ?LET({Start, Size}, {range(1, ?TUPLE_ELEMENT_LIMIT), + range(0, ?TUPLE_ELEMENT_LIMIT * 2)}, + ?LET({Exact, Es}, {boolean(), gen_tuple_elements(Start, Size, Depth)}, + #t_tuple{exact=Exact,size=Size,elements=Es})). + +gen_tuple_elements(Start, Size, Depth) -> + End = min(Size, ?TUPLE_ELEMENT_LIMIT), + ?SHRINK(?LET(Types, gen_tuple_elements_1(Start, End, term_type(Depth)), + foldl(fun({Index, Type}, Acc) -> + beam_types:set_tuple_element(Index, Type, Acc) + end, #{}, Types)), + [#{}]). + +gen_tuple_elements_1(Index, End, _Gen) when Index > End -> + []; +gen_tuple_elements_1(Index, End, Gen) -> + case rand:uniform(2) of + 1 -> [{Index, Gen} | gen_tuple_elements_1(Index + 1, End, Gen)]; + 2 -> gen_tuple_elements_1(Index + 1, End, Gen) + end. + +gen_union(Depth) -> + ?SHRINK(oneof([gen_union_wide(Depth), gen_union_record(Depth)]), + [gen_union_record(?MAX_TYPE_DEPTH)]). + +%% Creates a union with most (if not all) slots filled. +gen_union_wide(Depth) -> + ?LET({A, B, C, D, E, F}, {gen_atom(), + gen_bs_matchable(), + gen_list(Depth), + gen_tuple(Depth), + oneof(nested_generators(Depth)), + oneof(numerical_generators())}, + begin + T0 = join(A, B), + T1 = join(T0, C), + T2 = join(T1, D), + T3 = join(T2, E), + join(T3, F) + end). + +%% Creates a union consisting solely of records +gen_union_record(Depth) -> + ?LET(Size, range(2, ?TUPLE_SET_LIMIT), + ?LET(Tuples, duplicate(Size, gen_tuple_record(Depth)), + foldl(fun join/2, none, Tuples))). + +-endif. diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index db84d16b06..b1f1099095 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -27,7 +27,8 @@ export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1, wait/1,recv_in_try/1,double_recv/1,receive_var_zero/1, match_built_terms/1,elusive_common_exit/1, - return_before_receive/1,trapping/1]). + return_before_receive/1,trapping/1, + after_expression/1,in_after/1]). -include_lib("common_test/include/ct.hrl"). @@ -49,7 +50,8 @@ groups() -> [recv,coverage,otp_7980,export,wait, recv_in_try,double_recv,receive_var_zero, match_built_terms,elusive_common_exit, - return_before_receive,trapping]}, + return_before_receive,trapping, + after_expression,in_after]}, {slow,[],[ref_opt]}]. init_per_suite(Config) -> @@ -94,6 +96,8 @@ recv(Config) when is_list(Config) -> io:format("Unexpected extra message: ~p", [X]), ct:fail(unexpected) after 10 -> + unlink(Pid), + exit(Pid, kill), ok end, ok. @@ -136,6 +140,16 @@ coverage(Config) when is_list(Config) -> {'EXIT',{{badmap,[]},_}} = (catch monitor_plus_badmap(self())), + + self() ! {data,no_data}, + ok = receive_sink_tuple({any,pattern}), + {b,a} = receive_sink_tuple({a,b}), + + %% Basically a smoke test of no_clauses_left/0. + NoClausesLeft = spawn(fun no_clauses_left/0), + receive after 1 -> ok end, + exit(NoClausesLeft, kill), + ok. monitor_plus_badmap(Pid) -> @@ -184,6 +198,26 @@ tuple_to_values(Timeout, X) -> end, A+B. +no_clauses_left() -> + receive + %% This clause would be removed because it cannot match... + a = b -> + V = whatever + end, + %% ... leaving a reference to an unbound variable. Crash. + V. + + +%% Cover a help function for beam_ssa_opt:ssa_opt_sink/1. +receive_sink_tuple({Line,Pattern}) -> + receive + {data,_} -> + ok + after 1 -> + id({Pattern,Line}) + end. + + %% OTP-7980. Thanks to Vincent de Phily. The following code would %% be inccorrectly optimized by beam_jump. @@ -401,7 +435,9 @@ receive_var_zero(Config) when is_list(Config) -> end, self() ! w, receive - x -> ok; + x -> + receive y -> ok end, + receive w -> ok end; Other -> ct:fail({bad_message,Other}) end. @@ -541,4 +577,52 @@ do_trapping(N) -> receive Ref -> ok end, receive after 1 -> ok end. +after_expression(_Config) -> + self() ! {a,message}, + {a,message} = after_expr(0), + timeout = after_expr(0), + timeout = after_expr(10), + ok = after_expr_timeout(0), + ok = after_expr_timeout(1), + ok. + +after_expr(Timeout) -> + receive + Msg -> Msg + after id(Timeout) -> + timeout + end. + +after_expr_timeout(Timeout) -> + receive + after id(Timeout) -> + ok + end. + +in_after(_Config) -> + self() ! first, + self() ! message, + do_in_after(fun() -> ok end), + do_in_after(fun() -> ok end), + self() ! message, + catch do_in_after(fun() -> error(bad) end), + catch do_in_after(fun() -> error(bad) end), + self() ! last, + first = receive M1 -> M1 end, + last = receive M2 -> M2 end, + ok. + +do_in_after(E) -> + try + E() + after + receive + message -> + ok + after 1 -> + ok + end + end, + ok. + id(I) -> I. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_19.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_19.erl new file mode 100644 index 0000000000..470bef54ae --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_19.erl @@ -0,0 +1,15 @@ +-module(yes_19). +-export([?MODULE/0,f/2]). + +?MODULE() -> + ok. + +f(Pid, Msg) -> + MyRef = make_ref(), + Pid ! Msg, + receive + {Ref,Reply} when Ref == MyRef -> + Reply + after 0 -> + ok + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_20.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_20.erl new file mode 100644 index 0000000000..e85f1b99ca --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_20.erl @@ -0,0 +1,16 @@ +-module(yes_20). +-compile(export_all). + +?MODULE() -> + ok. + +f() -> + Ref = spawn_request(fun () -> ok end), + Pid = receive + {spawn_reply, Ref, _, P} -> + P + end, + receive + {'DOWN', Ref, process, Pid, normal} -> + ok + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_21.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_21.erl new file mode 100644 index 0000000000..5e0a92b10d --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_21.erl @@ -0,0 +1,16 @@ +-module(yes_21). +-compile(export_all). + +?MODULE() -> + ok. + +f() -> + Ref = spawn_request(fun () -> ok end), + receive + {spawn_reply, Ref, _, _} -> + ok + end, + receive + {'DOWN', Ref, _, _, _} -> + ok + end. diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index 94804529b6..e272d95f2d 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -589,6 +589,7 @@ nested_access(Config) when is_list(Config) -> ok. -record(rr, {a,b,c}). +-record(fileheader, {read_md5,md5,eof,trailer}). coverage(Config) when is_list(Config) -> %% There should only remain one record test in the code below. @@ -600,8 +601,23 @@ coverage(Config) when is_list(Config) -> ok end, #rr{a=1,b=2,c=42} = id(R), %Test for correctness. + + %% Cover beam_ssa_opt:ssa_opt_element/1 and friends. + error1 = check_file_header(#fileheader{read_md5=1,md5=2}), + error2 = check_file_header(#fileheader{trailer=true,eof=false}), + error3 = check_file_header(#fileheader{}), + ok. +check_file_header(FH) -> + if + FH#fileheader.read_md5 =/= FH#fileheader.md5 -> + error1; + FH#fileheader.trailer =/= FH#fileheader.eof -> + error2; + true -> + error3 + end. -record(default_fun, {a = fun(X) -> X*X end}). @@ -609,8 +625,9 @@ coverage(Config) when is_list(Config) -> -record(gb_nil, {}). -record(gb_foo, {hello=1}). -record(gb_bar, {hello=2,there=3}). +-record(gb_rh, {mod,mid}). -%% Taken from compilation_SUITE. +%% Taken from compilation_SUITE and other places. grab_bag(_Config) -> T1 = fun() -> X = #foo{}, @@ -654,6 +671,23 @@ grab_bag(_Config) -> end, T4(), + %% Used to crash beam_ssa_bool during its development. + T5 = fun(RH) -> + if + is_record(RH, gb_rh) andalso + is_atom(RH#gb_rh.mod) andalso + RH#gb_rh.mid /= 42 -> ok; + true -> error + end + end, + ok = T5(#gb_rh{}), + ok = T5(#gb_rh{mod=atom,mid=0}), + error = T5(#gb_rh{mod=100,mid=0}), + error = T5(#gb_rh{mod=atom,mid=42}), + error = T5(#gb_nil{}), + error = T5(#gb_bar{}), + error = T5(atom), + ok. %% ERIERL-436; the following code used to be very slow to compile. diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 34410e4b2a..f3eeae9ccd 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -21,7 +21,8 @@ -include_lib("common_test/include/ct.hrl"). -compile({no_auto_import,[binary_part/2]}). --export([id/1,recompile/1,parallel/0,uniq/0,opt_opts/1,get_data_dir/1, +-export([id/1,recompile/1,recompile_core/1,parallel/0, + uniq/0,opt_opts/1,get_data_dir/1, is_cloned_mod/1,smoke_disasm/1,p_run/2, highest_opcode/1]). @@ -45,6 +46,21 @@ recompile(Mod) when is_atom(Mod) -> %% Smoke-test of beam disassembler. smoke_disasm(Mod). +recompile_core(Mod) when is_atom(Mod) -> + case whereis(cover_server) of + undefined -> ok; + _ -> + %% Re-compile the test suite if the cover server is running. + Beam = code:which(Mod), + Src = filename:rootname(Beam, ".beam"), + Opts = [bin_opt_info|opt_opts(Mod)], + io:format("Recompiling ~p (~p)\n", [Mod,Opts]), + c:c(Src, [from_core,{outdir,filename:dirname(Src)}|Opts]) + end, + + %% Smoke-test of beam disassembler. + smoke_disasm(Mod). + smoke_disasm(Mod) when is_atom(Mod) -> smoke_disasm(code:which(Mod)); smoke_disasm(File) when is_list(File) -> @@ -69,6 +85,7 @@ opt_opts(Mod) -> {options,Opts} = lists:keyfind(options, 1, Comp), lists:filter(fun (debug_info) -> true; + (dialyzer) -> true; (inline) -> true; (no_bsm3) -> true; (no_bsm_opt) -> true; @@ -79,9 +96,11 @@ opt_opts(Mod) -> (no_put_tuple2) -> true; (no_recv_opt) -> true; (no_share_opt) -> true; + (no_shared_fun_wrappers) -> true; (no_ssa_float) -> true; (no_ssa_opt) -> true; (no_stack_trimming) -> true; + (no_swap) -> true; (no_type_opt) -> true; (_) -> false end, Opts). diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 539f9d69fa..4cff129d1f 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -1079,7 +1079,7 @@ stacktrace(_Config) -> error:{badmatch,_}:Stk2 -> [{?MODULE,stacktrace_2,0,_}, {?MODULE,stacktrace,1,_}|_] = Stk2, - Stk2 = erlang:get_stacktrace(), + [] = erlang:get_stacktrace(), ok end, @@ -1087,7 +1087,7 @@ stacktrace(_Config) -> stacktrace_3(a, b) catch error:function_clause:Stk3 -> - Stk3 = erlang:get_stacktrace(), + [] = erlang:get_stacktrace(), case lists:module_info(native) of false -> [{lists,prefix,[a,b],_}|_] = Stk3; @@ -1108,14 +1108,16 @@ stacktrace_1(X, C1, Y) -> C1 -> value1 catch C1:D1:Stk1 -> - Stk1 = erlang:get_stacktrace(), + [] = erlang:get_stacktrace(), {caught1,D1,Stk1} after foo(Y) end of V2 -> {value2,V2} catch - C2:D2:Stk2 -> {caught2,{C2,D2},Stk2=erlang:get_stacktrace()} + C2:D2:Stk2 -> + [] = erlang:get_stacktrace(), + {caught2,{C2,D2},Stk2} end. stacktrace_2() -> @@ -1160,12 +1162,10 @@ nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> V1 -> value1 catch C1:V1:S1 -> - S1 = erlang:get_stacktrace(), T2 = try foo(X2) of V2 -> value2 catch C2:V2:S2 -> - S2 = erlang:get_stacktrace(), {caught2,S2} end, {caught1,S1,T2} diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 70b7100451..a91d8399ff 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -121,7 +121,7 @@ pattern2(Config) when is_list(Config) -> Ts = [{pattern2, Source, [nowarn_unused_vars], - {warnings,[{2,sys_core_fold,{nomatch_shadow,1}}, + {warnings,[{2,sys_core_fold,{nomatch_shadow,1,{f,1}}}, {4,sys_core_fold,no_clause_match}, {5,sys_core_fold,nomatch_clause_type}, {6,sys_core_fold,nomatch_clause_type}]}}], @@ -786,7 +786,7 @@ latin1_fallback(Conf) when is_list(Conf) -> ">>, [], {warnings,[{1,compile,reparsing_invalid_unicode}, - {3,sys_core_fold,{nomatch_shadow,2}}]}}], + {3,sys_core_fold,{nomatch_shadow,2,{t,1}}}]}}], [] = run(Conf, Ts1), Ts2 = [{latin1_fallback2, diff --git a/lib/crypto/Makefile b/lib/crypto/Makefile index afe56aa7d6..e5812bee15 100644 --- a/lib/crypto/Makefile +++ b/lib/crypto/Makefile @@ -38,3 +38,4 @@ SPECIAL_TARGETS = include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index f922c3fb9b..20c32cb8d6 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -37,13 +37,14 @@ LIBS = @DED_LIBS@ LDFLAGS += @DED_LDFLAGS@ CFLAGS = @DED_CFLAGS@ @SSL_FLAGS@ -# From erts/configure +# From configure SSL_LIBDIR = @SSL_LIBDIR@ SSL_INCLUDE = @SSL_INCLUDE@ SSL_CRYPTO_LIBNAME = @SSL_CRYPTO_LIBNAME@ SSL_SSL_LIBNAME = @SSL_SSL_LIBNAME@ INCLUDES = $(SSL_INCLUDE) @DED_INCLUDE@ +SSL_EXTRA_LIBS=@SSL_EXTRA_LIBS@ ifeq ($(TYPE),debug) TYPEMARKER = .debug @@ -164,7 +165,7 @@ $(LIBDIR)/otp_test_engine$(TYPEMARKER).so: $(TEST_ENGINE_OBJS) $(LIBDIR)/otp_test_engine$(TYPEMARKER).dll: $(TEST_ENGINE_OBJS) $(V_at)$(INSTALL_DIR) $(LIBDIR) - $(V_LD) $(LDFLAGS) -o $@ $(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) $(TEST_ENGINE_OBJS) -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME) + $(V_LD) $(LDFLAGS) -o $@ $(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) $(TEST_ENGINE_OBJS) -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME) $(SSL_EXTRA_LIBS) $(OBJDIR)/%$(TYPEMARKER).o: %.c $(V_at)$(INSTALL_DIR) $(OBJDIR) @@ -184,7 +185,7 @@ $(LIBDIR)/crypto$(TYPEMARKER).a: $(CRYPTO_STATIC_OBJS) $(LIBDIR)/crypto$(TYPEMARKER).dll: $(CRYPTO_OBJS) $(V_at)$(INSTALL_DIR) $(LIBDIR) - $(V_LD) $(LDFLAGS) -o $@ $(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) $(CRYPTO_OBJS) -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME) + $(V_LD) $(LDFLAGS) -o $@ $(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) $(CRYPTO_OBJS) -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME) $(SSL_EXTRA_LIBS) ifeq ($(DYNAMIC_CRYPTO_LIB),yes) $(LIBDIR)/crypto_callback$(TYPEMARKER).so: $(CALLBACK_OBJS) diff --git a/lib/crypto/c_src/api_ng.c b/lib/crypto/c_src/api_ng.c index 5fc161f382..0b6960c022 100644 --- a/lib/crypto/c_src/api_ng.c +++ b/lib/crypto/c_src/api_ng.c @@ -29,6 +29,9 @@ ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); ERL_NIF_TERM ng_crypto_one_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +/*************************************************************************/ +/* Compatibility functions. */ +/*************************************************************************/ #ifdef HAVE_ECB_IVEC_BUG /* <= 0.9.8l returns faulty ivec length */ # define GET_IV_LEN(Ciph) ((Ciph)->flags & ECB_BUG_0_9_8L) ? 0 : EVP_CIPHER_iv_length((Ciph)->cipher.p) @@ -36,6 +39,48 @@ ERL_NIF_TERM ng_crypto_one_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg # define GET_IV_LEN(Ciph) EVP_CIPHER_iv_length((Ciph)->cipher.p) #endif +#if !defined(HAVE_EVP_CIPHER_CTX_COPY) +/* + The EVP_CIPHER_CTX_copy is not available in older cryptolibs although + the function is needed. + Instead of implement it in-place, we have a copy here as a compatibility + function +*/ + +int EVP_CIPHER_CTX_copy(EVP_CIPHER_CTX *out, const EVP_CIPHER_CTX *in); + +int EVP_CIPHER_CTX_copy(EVP_CIPHER_CTX *out, const EVP_CIPHER_CTX *in) +{ + if ((in == NULL) || (in->cipher == NULL)) + { + return 0; + } +#ifdef HAS_ENGINE_SUPPORT + /* Make sure it's safe to copy a cipher context using an ENGINE */ + if (in->engine && !ENGINE_init(in->engine)) + return 0; +#endif + + EVP_CIPHER_CTX_cleanup(out); + memcpy(out,in,sizeof *out); + + if (in->cipher_data && in->cipher->ctx_size) + { + out->cipher_data=OPENSSL_malloc(in->cipher->ctx_size); + if (!out->cipher_data) + return 0; + memcpy(out->cipher_data,in->cipher_data,in->cipher->ctx_size); + } + +#if defined(EVP_CIPH_CUSTOM_COPY) && defined(EVP_CTRL_COPY) + if (in->cipher->flags & EVP_CIPH_CUSTOM_COPY) + return in->cipher->ctrl((EVP_CIPHER_CTX *)in, EVP_CTRL_COPY, 0, out); +#endif + return 1; +} +/****** End of !defined(HAVE_EVP_CIPHER_CTX_COPY) ******/ +#endif + /*************************************************************************/ /* Get the arguments for the initialization of the EVP_CIPHER_CTX. Check */ /* them and initialize that context. */ @@ -46,27 +91,30 @@ static int get_init_args(ErlNifEnv* env, const ERL_NIF_TERM key_arg, const ERL_NIF_TERM ivec_arg, const ERL_NIF_TERM encflg_arg, + const ERL_NIF_TERM padding_arg, const struct cipher_type_t **cipherp, ERL_NIF_TERM *return_term) { int ivec_len; ErlNifBinary key_bin; ErlNifBinary ivec_bin; - int encflg; ctx_res->ctx = NULL; /* For testing if *ctx should be freed after errors */ #if !defined(HAVE_EVP_AES_CTR) ctx_res->env = NULL; /* For testing if *env should be freed after errors */ #endif - + ctx_res->padding = atom_undefined; + ctx_res->padded_size = -1; + ctx_res->size = 0; + /* Fetch the flag telling if we are going to encrypt (=true) or decrypt (=false) */ if (encflg_arg == atom_true) - encflg = 1; + ctx_res->encflag = 1; else if (encflg_arg == atom_false) - encflg = 0; + ctx_res->encflag = 0; else if (encflg_arg == atom_undefined) /* For compat funcs in crypto.erl */ - encflg = -1; + ctx_res->encflag = -1; else { *return_term = EXCP_BADARG(env, "Bad enc flag"); @@ -193,7 +241,7 @@ static int get_init_args(ErlNifEnv* env, goto err; } - if (!EVP_CipherInit_ex(ctx_res->ctx, (*cipherp)->cipher.p, NULL, NULL, NULL, encflg)) + if (!EVP_CipherInit_ex(ctx_res->ctx, (*cipherp)->cipher.p, NULL, NULL, NULL, ctx_res->encflag)) { *return_term = EXCP_ERROR(env, "Can't initialize context, step 1"); goto err; @@ -232,7 +280,20 @@ static int get_init_args(ErlNifEnv* env, goto err; } - EVP_CIPHER_CTX_set_padding(ctx_res->ctx, 0); + /* Set padding */ + if ((padding_arg == atom_undefined) || + (padding_arg == atom_none) || + (padding_arg == atom_zero) || + (padding_arg == atom_random) ) + EVP_CIPHER_CTX_set_padding(ctx_res->ctx, 0); + + else if (padding_arg != atom_pkcs_padding) /* pkcs_padding is default */ + { + *return_term = EXCP_BADARG(env, "Bad padding flag"); + goto err; + } + + ctx_res->padding = padding_arg; *return_term = atom_ok; @@ -266,8 +327,11 @@ static int get_update_args(ErlNifEnv* env, ASSERT(in_data_bin.size <= INT_MAX); + ctx_res->size += in_data_bin.size; + #if !defined(HAVE_EVP_AES_CTR) if (ctx_res->state != atom_undefined) { + /* Use AES_CTR compatibility code */ ERL_NIF_TERM state0, newstate_and_outdata; const ERL_NIF_TERM *tuple_argv; int tuple_argc; @@ -288,6 +352,17 @@ static int get_update_args(ErlNifEnv* env, } } else #endif +#if defined(HAVE_UPDATE_EMPTY_DATA_BUG) + if (in_data_bin.size == 0) + { + if (!enif_alloc_binary(0, &out_data_bin)) + { + *return_term = EXCP_ERROR(env, "Can't allocate outdata"); + goto err; + } + *return_term = enif_make_binary(env, &out_data_bin); + } else +#endif { block_size = EVP_CIPHER_CTX_block_size(ctx_res->ctx); @@ -324,22 +399,186 @@ static int get_update_args(ErlNifEnv* env, } /*************************************************************************/ +/* Get the arguments for the EVP_CipherFinal function, and call it. */ +/*************************************************************************/ + +static int get_final_args(ErlNifEnv* env, + struct evp_cipher_ctx *ctx_res, + ERL_NIF_TERM *return_term + ) +{ + ErlNifBinary out_data_bin; + int block_size, pad_size; + int out_len, pad_offset; + +#if !defined(HAVE_EVP_AES_CTR) + if (ctx_res->state != atom_undefined) { + /* Use AES_CTR compatibility code */ + /* Padding size is always 0, because the block_size is 1 and therefore + always filled + */ + ctx_res->padded_size = 0; + out_len = 0; + + if (!enif_alloc_binary(out_len, &out_data_bin)) + { + *return_term = EXCP_ERROR(env, "Can't allocate empty outdata"); + goto err0; + } + } else +#endif + { + block_size = EVP_CIPHER_CTX_block_size(ctx_res->ctx); + + pad_size = ctx_res->size % block_size; + if (pad_size) + pad_size = block_size - pad_size; + + if (!enif_alloc_binary((size_t)block_size, &out_data_bin)) + { + *return_term = EXCP_ERROR(env, "Can't allocate final outdata"); + goto err0; + } + + if (ctx_res->encflag) + {/* Maybe do padding */ + + /* First set lengths etc and do the otp_padding */ + if (ctx_res->padding == atom_undefined) + { + ctx_res->padded_size = pad_size; + pad_offset = 0; + } + + else if (ctx_res->padding == atom_none) + { + ASSERT(pad_size == 0); + ctx_res->padded_size = pad_size; + pad_offset = 0; + } + + else if (ctx_res->padding == atom_pkcs_padding) + { + ctx_res->padded_size = pad_size ? pad_size : block_size; + pad_offset = 0; + } + + else if ((ctx_res->padding == atom_zero) || + (ctx_res->padding == atom_random)) + { + if (pad_size) + { + unsigned char padding[EVP_MAX_BLOCK_LENGTH]; + int i; + if (ctx_res->padding == atom_zero) + for(i=0; i<pad_size; i++) padding[i] = (unsigned char)0; + else + RAND_bytes(padding, pad_size); + if (!EVP_CipherUpdate(ctx_res->ctx, out_data_bin.data, &out_len, padding, pad_size)) + { + *return_term = EXCP_ERROR(env, "Can't pad"); + goto err; + } + } + else + out_len = 0; + + ctx_res->padded_size = pad_size; + pad_offset = out_len; + } + + else + { + *return_term = EXCP_ERROR(env, "Bad padding flg"); + goto err; + } + + /* Decide how many bytes that are to be returned and set out_len to that value */ + if (ctx_res->padding == atom_undefined) + { + out_len = 0; + } + + else + { + if (!EVP_CipherFinal_ex(ctx_res->ctx, out_data_bin.data+pad_offset, &out_len)) + { + if (ctx_res->padding == atom_none) + *return_term = EXCP_ERROR(env, "Padding 'none' but unfilled last block"); + else if (ctx_res->padding == atom_pkcs_padding) + *return_term = EXCP_ERROR(env, "Can't finalize"); + else + *return_term = EXCP_ERROR(env, "Padding failed"); + goto err; + } + else + out_len += pad_offset; + } + + /* (end of encryption part) */ + } + else + { /* decryption. */ + /* Decide how many bytes that are to be returned and set out_len to that value */ + if (ctx_res->padding == atom_undefined) + { + out_len = 0; + } + + else if ((ctx_res->padding == atom_none) || + (ctx_res->padding == atom_pkcs_padding) || + (ctx_res->padding == atom_zero) || + (ctx_res->padding == atom_random) ) + { + if (!EVP_CipherFinal_ex(ctx_res->ctx, out_data_bin.data, &out_len)) + { + *return_term = EXCP_ERROR(env, "Can't finalize"); + goto err; + } + } + else + { + *return_term = EXCP_ERROR(env, "Bad padding flg"); + goto err; + } + /* (end of decryption part) */ + } + } + + /* success: */ + if (!enif_realloc_binary(&out_data_bin, (size_t)out_len)) + { + *return_term = EXCP_ERROR(env, "Can't reallocate"); + goto err; + } + + *return_term = enif_make_binary(env, &out_data_bin); + + return 1; + + err: + enif_release_binary(&out_data_bin); + err0: + return 0; +} + + +/*************************************************************************/ /* Initialize the state for (de/en)cryption */ /*************************************************************************/ ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Cipher, Key, IVec, Encrypt) % if no IV for the Cipher, set IVec = <<>> +{/* (Cipher, Key, IVec, Encrypt, Padding) % if no IV for the Cipher, set IVec = <<>> */ struct evp_cipher_ctx *ctx_res = NULL; const struct cipher_type_t *cipherp; ERL_NIF_TERM ret; - int encflg; if (enif_is_atom(env, argv[0])) { if ((ctx_res = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) return EXCP_ERROR(env, "Can't allocate resource"); - if (get_init_args(env, ctx_res, argv[0], argv[1], argv[2], argv[argc-1], + if (get_init_args(env, ctx_res, argv[0], argv[1], argv[2], argv[3], argv[4], &cipherp, &ret)) ret = enif_make_resource(env, ctx_res); /* else error msg in ret */ @@ -349,16 +588,16 @@ ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg } else if (enif_get_resource(env, argv[0], (ErlNifResourceType*)evp_cipher_ctx_rtype, (void**)&ctx_res)) { /* Fetch the flag telling if we are going to encrypt (=true) or decrypt (=false) */ if (argv[3] == atom_true) - encflg = 1; + ctx_res->encflag = 1; else if (argv[3] == atom_false) - encflg = 0; + ctx_res->encflag = 0; else { ret = EXCP_BADARG(env, "Bad enc flag"); goto ret; } if (ctx_res->ctx) { /* It is *not* a ctx_res for the compatibility handling of non-EVP aes_ctr */ - if (!EVP_CipherInit_ex(ctx_res->ctx, NULL, NULL, NULL, NULL, encflg)) { + if (!EVP_CipherInit_ex(ctx_res->ctx, NULL, NULL, NULL, NULL, ctx_res->encflag)) { ret = EXCP_ERROR(env, "Can't initialize encflag"); goto ret; } @@ -378,49 +617,6 @@ ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg /* Encrypt/decrypt */ /*************************************************************************/ -#if !defined(HAVE_EVP_CIPHER_CTX_COPY) -/* - The EVP_CIPHER_CTX_copy is not available in older cryptolibs although - the function is needed. - Instead of implement it in-place, we have a copy here as a compatibility - function -*/ - -int EVP_CIPHER_CTX_copy(EVP_CIPHER_CTX *out, const EVP_CIPHER_CTX *in); - -int EVP_CIPHER_CTX_copy(EVP_CIPHER_CTX *out, const EVP_CIPHER_CTX *in) -{ - if ((in == NULL) || (in->cipher == NULL)) - { - return 0; - } -#ifdef HAS_ENGINE_SUPPORT - /* Make sure it's safe to copy a cipher context using an ENGINE */ - if (in->engine && !ENGINE_init(in->engine)) - return 0; -#endif - - EVP_CIPHER_CTX_cleanup(out); - memcpy(out,in,sizeof *out); - - if (in->cipher_data && in->cipher->ctx_size) - { - out->cipher_data=OPENSSL_malloc(in->cipher->ctx_size); - if (!out->cipher_data) - return 0; - memcpy(out->cipher_data,in->cipher_data,in->cipher->ctx_size); - } - -#if defined(EVP_CIPH_CUSTOM_COPY) && defined(EVP_CTRL_COPY) - if (in->cipher->flags & EVP_CIPH_CUSTOM_COPY) - return in->cipher->ctrl((EVP_CIPHER_CTX *)in, EVP_CTRL_COPY, 0, out); -#endif - return 1; -} -/****** End of compatibility function ******/ -#endif - - ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data [, IV]) */ struct evp_cipher_ctx *ctx_res; @@ -433,6 +629,7 @@ ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ return EXCP_BADARG(env, "Bad 1:st arg"); if (argc == 3) { + /* We have an IV in this call. Make a copy of the context */ ErlNifBinary ivec_bin; memcpy(&ctx_res_copy, ctx_res, sizeof ctx_res_copy); @@ -449,8 +646,6 @@ ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ } } - ctx_res = &ctx_res_copy; - if (!enif_inspect_iolist_as_binary(env, argv[2], &ivec_bin)) { ret = EXCP_BADARG(env, "Bad iv type"); @@ -483,7 +678,9 @@ ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ } get_update_args(env, &ctx_res_copy, argv[1], &ret); + ctx_res->size = ctx_res_copy.size; } else + /* argc != 3, that is, argc = 2 (we don't have an IV in this call) */ get_update_args(env, ctx_res, argv[1], &ret); err: @@ -498,8 +695,6 @@ ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a {/* (Context, Data [, IV]) */ ErlNifBinary data_bin; - ASSERT(argc <= 3); - if (!enif_inspect_binary(env, argv[1], &data_bin)) return EXCP_BADARG(env, "expected binary as data"); @@ -517,26 +712,78 @@ ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a } /*************************************************************************/ +/* Final */ +/*************************************************************************/ + +ERL_NIF_TERM ng_crypto_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context) */ + /* No need for enif_schedule_nif since maximum BlockSize-1 bytes are handled */ + struct evp_cipher_ctx *ctx_res; + ERL_NIF_TERM ret; + + if (!enif_get_resource(env, argv[0], (ErlNifResourceType*)evp_cipher_ctx_rtype, (void**)&ctx_res)) + return EXCP_BADARG(env, "Bad arg"); + + get_final_args(env, ctx_res, &ret); + + return ret; +} + +/*************************************************************************/ /* One shot */ /*************************************************************************/ ERL_NIF_TERM ng_crypto_one_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Cipher, Key, IVec, Data, Encrypt) */ +{/* (Cipher, Key, IVec, Data, Encrypt, PaddingType) */ struct evp_cipher_ctx ctx_res; const struct cipher_type_t *cipherp; ERL_NIF_TERM ret; - + ErlNifBinary out_data_bin, final_data_bin; + unsigned char *append_buf; + ctx_res.ctx = NULL; #if !defined(HAVE_EVP_AES_CTR) ctx_res.env = NULL; #endif - if (!get_init_args(env, &ctx_res, argv[0], argv[1], argv[2], argv[4], &cipherp, &ret)) - goto ret; + /* EVP_CipherInit */ + if (!get_init_args(env, &ctx_res, argv[0], argv[1], argv[2], argv[4], argv[5], &cipherp, &ret)) + goto out; - get_update_args(env, &ctx_res, argv[3], &ret); + /* out_data = EVP_CipherUpdate */ + if (!get_update_args(env, &ctx_res, argv[3], &ret)) + /* Got an exception as result in &ret */ + goto out; - ret: + if (!enif_inspect_binary(env, ret, &out_data_bin) ) + { + ret = EXCP_ERROR(env, "Can't inspect first"); + goto out; + } + + /* final_data = EVP_CipherFinal_ex */ + if (!get_final_args(env, &ctx_res, &ret)) + /* Got an exception as result in &ret */ + goto out; + + if (!enif_inspect_binary(env, ret, &final_data_bin) ) + { + ret = EXCP_ERROR(env, "Can't inspect final"); + goto out; + } + + /* Concatenate out_data and final_date into a new binary kept in the variable ret. */ + append_buf = enif_make_new_binary(env, out_data_bin.size + final_data_bin.size, &ret); + if (!append_buf) + { + ret = EXCP_ERROR(env, "Can't append"); + goto out; + } + + memcpy(append_buf, out_data_bin.data, out_data_bin.size); + memcpy(append_buf+out_data_bin.size, final_data_bin.data, final_data_bin.size); + + out: if (ctx_res.ctx) EVP_CIPHER_CTX_free(ctx_res.ctx); @@ -550,12 +797,10 @@ ERL_NIF_TERM ng_crypto_one_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg ERL_NIF_TERM ng_crypto_one_time_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Cipher, Key, IVec, Data, Encrypt) % if no IV for the Cipher, set IVec = <<>> +{/* (Cipher, Key, IVec, Data, Encrypt, Padding) % if no IV for the Cipher, set IVec = <<>> */ ErlNifBinary data_bin; - ASSERT(argc == 5); - if (!enif_inspect_binary(env, argv[3], &data_bin)) return EXCP_BADARG(env, "expected binary as data"); @@ -571,3 +816,37 @@ ERL_NIF_TERM ng_crypto_one_time_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM return ng_crypto_one_time(env, argc, argv); } + + +/*************************************************************************/ +/* Get data from the cipher resource */ +/*************************************************************************/ + +ERL_NIF_TERM ng_crypto_get_data_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Context) -> map */ + struct evp_cipher_ctx *ctx_res; + ERL_NIF_TERM ret; + + if (!enif_get_resource(env, argv[0], (ErlNifResourceType*)evp_cipher_ctx_rtype, (void**)&ctx_res)) + return EXCP_BADARG(env, "Bad arg"); + + ret = enif_make_new_map(env); + + enif_make_map_put(env, ret, atom_size, + enif_make_int(env, ctx_res->size), + &ret); + + enif_make_map_put(env, ret, atom_padding_size, + enif_make_int(env, ctx_res->padded_size), + &ret); + + enif_make_map_put(env, ret, atom_padding_type, + ctx_res->padding, + &ret); + + enif_make_map_put(env, ret, atom_encrypt, + (ctx_res->encflag) ? atom_true : atom_false, + &ret); + + return ret; +} diff --git a/lib/crypto/c_src/api_ng.h b/lib/crypto/c_src/api_ng.h index aaf67524ae..2803ae72ec 100644 --- a/lib/crypto/c_src/api_ng.h +++ b/lib/crypto/c_src/api_ng.h @@ -25,6 +25,8 @@ ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM ng_crypto_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); ERL_NIF_TERM ng_crypto_one_time_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM ng_crypto_get_data_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #endif /* E_AES_H__ */ diff --git a/lib/crypto/c_src/atoms.c b/lib/crypto/c_src/atoms.c index bbeb329fa2..db7ba084ed 100644 --- a/lib/crypto/c_src/atoms.c +++ b/lib/crypto/c_src/atoms.c @@ -24,6 +24,9 @@ ERL_NIF_TERM atom_true; ERL_NIF_TERM atom_false; ERL_NIF_TERM atom_sha; ERL_NIF_TERM atom_error; +ERL_NIF_TERM atom_pkcs_padding; +ERL_NIF_TERM atom_zero; +ERL_NIF_TERM atom_random; ERL_NIF_TERM atom_rsa_pkcs1_padding; ERL_NIF_TERM atom_rsa_pkcs1_oaep_padding; ERL_NIF_TERM atom_rsa_no_padding; @@ -52,6 +55,9 @@ ERL_NIF_TERM atom_block_size; ERL_NIF_TERM atom_key_length; ERL_NIF_TERM atom_iv_length; ERL_NIF_TERM atom_mode; +ERL_NIF_TERM atom_encrypt; +ERL_NIF_TERM atom_padding_size; +ERL_NIF_TERM atom_padding_type; ERL_NIF_TERM atom_ecb_mode; ERL_NIF_TERM atom_cbc_mode; ERL_NIF_TERM atom_cfb_mode; @@ -89,6 +95,8 @@ ERL_NIF_TERM atom_ecdsa; #ifdef HAVE_ED_CURVE_DH ERL_NIF_TERM atom_x25519; ERL_NIF_TERM atom_x448; +ERL_NIF_TERM atom_ed25519; +ERL_NIF_TERM atom_ed448; #endif ERL_NIF_TERM atom_eddsa; @@ -154,6 +162,9 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM atom_sha = enif_make_atom(env,"sha"); atom_error = enif_make_atom(env,"error"); + atom_pkcs_padding = enif_make_atom(env,"pkcs_padding"); + atom_zero = enif_make_atom(env,"zero"); + atom_random = enif_make_atom(env,"random"); atom_rsa_pkcs1_padding = enif_make_atom(env,"rsa_pkcs1_padding"); atom_rsa_pkcs1_oaep_padding = enif_make_atom(env,"rsa_pkcs1_oaep_padding"); atom_rsa_no_padding = enif_make_atom(env,"rsa_no_padding"); @@ -176,6 +187,9 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM atom_key_length = enif_make_atom(env,"key_length"); atom_iv_length = enif_make_atom(env,"iv_length"); atom_mode = enif_make_atom(env,"mode"); + atom_encrypt = enif_make_atom(env, "encrypt"); + atom_padding_size = enif_make_atom(env, "padding_size"); + atom_padding_type = enif_make_atom(env, "padding_type"); atom_ecb_mode = enif_make_atom(env,"ecb_mode"); atom_cbc_mode = enif_make_atom(env,"cbc_mode"); atom_cfb_mode = enif_make_atom(env,"cfb_mode"); @@ -219,6 +233,8 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM #ifdef HAVE_ED_CURVE_DH atom_x25519 = enif_make_atom(env,"x25519"); atom_x448 = enif_make_atom(env,"x448"); + atom_ed25519 = enif_make_atom(env,"ed25519"); + atom_ed448 = enif_make_atom(env,"ed448"); #endif atom_eddsa = enif_make_atom(env,"eddsa"); #ifdef HAVE_EDDSA diff --git a/lib/crypto/c_src/atoms.h b/lib/crypto/c_src/atoms.h index 0e2f1a0022..4f77fd9d01 100644 --- a/lib/crypto/c_src/atoms.h +++ b/lib/crypto/c_src/atoms.h @@ -28,6 +28,9 @@ extern ERL_NIF_TERM atom_true; extern ERL_NIF_TERM atom_false; extern ERL_NIF_TERM atom_sha; extern ERL_NIF_TERM atom_error; +extern ERL_NIF_TERM atom_pkcs_padding; +extern ERL_NIF_TERM atom_zero; +extern ERL_NIF_TERM atom_random; extern ERL_NIF_TERM atom_rsa_pkcs1_padding; extern ERL_NIF_TERM atom_rsa_pkcs1_oaep_padding; extern ERL_NIF_TERM atom_rsa_no_padding; @@ -56,6 +59,9 @@ extern ERL_NIF_TERM atom_block_size; extern ERL_NIF_TERM atom_key_length; extern ERL_NIF_TERM atom_iv_length; extern ERL_NIF_TERM atom_mode; +extern ERL_NIF_TERM atom_encrypt; +extern ERL_NIF_TERM atom_padding_size; +extern ERL_NIF_TERM atom_padding_type; extern ERL_NIF_TERM atom_ecb_mode; extern ERL_NIF_TERM atom_cbc_mode; extern ERL_NIF_TERM atom_cfb_mode; @@ -93,6 +99,8 @@ extern ERL_NIF_TERM atom_ecdsa; #ifdef HAVE_ED_CURVE_DH extern ERL_NIF_TERM atom_x25519; extern ERL_NIF_TERM atom_x448; +extern ERL_NIF_TERM atom_ed25519; +extern ERL_NIF_TERM atom_ed448; #endif extern ERL_NIF_TERM atom_eddsa; diff --git a/lib/crypto/c_src/cipher.h b/lib/crypto/c_src/cipher.h index c23e128824..b7cea017cc 100644 --- a/lib/crypto/c_src/cipher.h +++ b/lib/crypto/c_src/cipher.h @@ -62,9 +62,13 @@ extern ErlNifResourceType* evp_cipher_ctx_rtype; struct evp_cipher_ctx { EVP_CIPHER_CTX* ctx; int iv_len; + ERL_NIF_TERM padding; /* id of the padding to add by get_final_args() */ + int padded_size; /* Length of the padding that was added */ + int encflag; /* 1 if encrypting, 0 if decrypting */ + unsigned int size; /* The sum of all sizes of input texts to get_update_args() */ #if !defined(HAVE_EVP_AES_CTR) ErlNifEnv* env; - ERL_NIF_TERM state; + ERL_NIF_TERM state; /* Is == atom_undefined if not handling an aes_ctr crypto */ #endif }; diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 802818541b..589f79e672 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -79,10 +79,12 @@ static ErlNifFunc nif_funcs[] = { {"mac_final_nif", 1, mac_final_nif, 0}, {"cipher_info_nif", 1, cipher_info_nif, 0}, {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif, 0}, - {"ng_crypto_init_nif", 4, ng_crypto_init_nif, 0}, + {"ng_crypto_init_nif", 5, ng_crypto_init_nif, 0}, {"ng_crypto_update_nif", 2, ng_crypto_update_nif, 0}, {"ng_crypto_update_nif", 3, ng_crypto_update_nif, 0}, - {"ng_crypto_one_time_nif", 5, ng_crypto_one_time_nif, 0}, + {"ng_crypto_final_nif", 1, ng_crypto_final_nif, 0}, + {"ng_crypto_get_data_nif", 1, ng_crypto_get_data_nif, 0}, + {"ng_crypto_one_time_nif", 6, ng_crypto_one_time_nif, 0}, {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif, 0}, {"strong_rand_range_nif", 1, strong_rand_range_nif, 0}, {"rand_uniform_nif", 2, rand_uniform_nif, 0}, @@ -95,7 +97,7 @@ static ErlNifFunc nif_funcs[] = { {"dh_generate_key_nif", 4, dh_generate_key_nif, 0}, {"dh_compute_key_nif", 3, dh_compute_key_nif, 0}, {"evp_compute_key_nif", 3, evp_compute_key_nif, 0}, - {"evp_generate_key_nif", 1, evp_generate_key_nif, 0}, + {"evp_generate_key_nif", 2, evp_generate_key_nif, 0}, {"privkey_to_pubkey_nif", 2, privkey_to_pubkey_nif, 0}, {"srp_value_B_nif", 5, srp_value_B_nif, 0}, {"srp_user_secret_nif", 7, srp_user_secret_nif, 0}, @@ -130,7 +132,11 @@ ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload) static int verify_lib_version(void) { +#if OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) const unsigned long libv = SSLeay(); +#else + const unsigned long libv = OpenSSL_version_num(); +#endif const unsigned long hdrv = OPENSSL_VERSION_NUMBER; # define MAJOR_VER(V) ((unsigned long)(V) >> (7*4)) @@ -145,9 +151,11 @@ static int verify_lib_version(void) static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) { +#if OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) #ifdef OPENSSL_THREADS ErlNifSysInfo sys_info; #endif +#endif get_crypto_callbacks_t* funcp; struct crypto_callbacks* ccb; int nlocks = 0; @@ -217,6 +225,7 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) funcp = &get_crypto_callbacks; #endif +#if OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) #ifdef OPENSSL_THREADS enif_system_info(&sys_info, sizeof(sys_info)); if (sys_info.scheduler_threads > 1) { @@ -224,6 +233,7 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) } /* else no need for locks */ #endif +#endif ccb = (*funcp)(nlocks); @@ -237,6 +247,7 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) return __LINE__; #endif +#if OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) #ifdef OPENSSL_THREADS if (nlocks > 0) { CRYPTO_set_locking_callback(ccb->locking_function); @@ -246,6 +257,7 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) CRYPTO_set_dynlock_destroy_callback(ccb->dyn_destroy_function); } #endif /* OPENSSL_THREADS */ +#endif init_digest_types(env); init_mac_types(env); diff --git a/lib/crypto/c_src/crypto_callback.c b/lib/crypto/c_src/crypto_callback.c index 0141ccd840..46b73cd996 100644 --- a/lib/crypto/c_src/crypto_callback.c +++ b/lib/crypto/c_src/crypto_callback.c @@ -22,10 +22,16 @@ #include <string.h> #include <openssl/opensslconf.h> #include <stdint.h> - #include <erl_nif.h> + #include "crypto_callback.h" +#define PACKED_OPENSSL_VERSION(MAJ, MIN, FIX, P) \ + ((((((((MAJ << 8) | MIN) << 8 ) | FIX) << 8) | (P-'a'+1)) << 4) | 0xf) + +#define PACKED_OPENSSL_VERSION_PLAIN(MAJ, MIN, FIX) \ + PACKED_OPENSSL_VERSION(MAJ,MIN,FIX,('a'-1)) + #ifdef DEBUG # define ASSERT(e) \ ((void) ((e) ? 1 : (fprintf(stderr,"Assert '%s' failed at %s:%d\n",\ @@ -100,8 +106,9 @@ static void crypto_free(void* ptr CCB_FILE_LINE_ARGS) #ifdef OPENSSL_THREADS /* vvvvvvvvvvvvvvv OPENSSL_THREADS vvvvvvvvvvvvvvvv */ - +#if OPENSSL_VERSION_NUMBER < 0x10100000 static ErlNifRWLock** lock_vec = NULL; /* Static locks used by openssl */ +#endif #include <openssl/crypto.h> @@ -125,6 +132,7 @@ static INLINE void locking(int mode, ErlNifRWLock* lock) } } +#if OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) static void locking_function(int mode, int n, const char *file, int line) { locking(mode, lock_vec[n]); @@ -149,7 +157,7 @@ static void dyn_destroy_function(struct CRYPTO_dynlock_value *ptr, const char *f { enif_rwlock_destroy((ErlNifRWLock*)ptr); } - +#endif /* ^^^^^^^^^^^^ OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) ^^^^^^^^^^^ */ #endif /* ^^^^^^^^^^^^^^^^^^^^^^ OPENSSL_THREADS ^^^^^^^^^^^^^^^^^^^^^^ */ DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks) @@ -161,7 +169,8 @@ DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks) &crypto_alloc, &crypto_realloc, &crypto_free, - + +#if OPENSSL_VERSION_NUMBER < 0x10100000 #ifdef OPENSSL_THREADS &locking_function, &id_function, @@ -169,9 +178,11 @@ DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks) &dyn_lock_function, &dyn_destroy_function #endif /* OPENSSL_THREADS */ +#endif }; if (!is_initialized) { +#if OPENSSL_VERSION_NUMBER < 0x10100000 #ifdef OPENSSL_THREADS if (nlocks > 0) { int i; @@ -189,12 +200,17 @@ DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks) } } #endif +#endif is_initialized = 1; } return &the_struct; +#if OPENSSL_VERSION_NUMBER < 0x10100000 +#ifdef OPENSSL_THREADS err: return NULL; +#endif +#endif } #ifdef HAVE_DYNAMIC_CRYPTO_LIB diff --git a/lib/crypto/c_src/crypto_callback.h b/lib/crypto/c_src/crypto_callback.h index d46266fd8b..f59165886b 100644 --- a/lib/crypto/c_src/crypto_callback.h +++ b/lib/crypto/c_src/crypto_callback.h @@ -34,6 +34,7 @@ struct crypto_callbacks void (*crypto_free)(void* ptr CCB_FILE_LINE_ARGS); /* openssl callbacks */ +#if OPENSSL_VERSION_NUMBER < 0x10100000 #ifdef OPENSSL_THREADS void (*locking_function)(int mode, int n, const char *file, int line); unsigned long (*id_function)(void); @@ -44,6 +45,7 @@ struct crypto_callbacks void (*dyn_destroy_function)(struct CRYPTO_dynlock_value *ptr, const char *file, int line); #endif /* OPENSSL_THREADS */ +#endif }; typedef struct crypto_callbacks* get_crypto_callbacks_t(int nlocks); diff --git a/lib/crypto/c_src/evp.c b/lib/crypto/c_src/evp.c index 3bf66bfffe..fb6495a640 100644 --- a/lib/crypto/c_src/evp.c +++ b/lib/crypto/c_src/evp.c @@ -106,25 +106,34 @@ ERL_NIF_TERM evp_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a EVP_PKEY_CTX *ctx = NULL; EVP_PKEY *pkey = NULL; ERL_NIF_TERM ret_pub, ret_prv, ret; + ErlNifBinary prv_key; size_t key_len; unsigned char *out_pub = NULL, *out_priv = NULL; - ASSERT(argc == 1); - if (argv[0] == atom_x25519) type = EVP_PKEY_X25519; else if (argv[0] == atom_x448) type = EVP_PKEY_X448; + else if (argv[0] == atom_ed25519) + type = EVP_PKEY_ED25519; + else if (argv[0] == atom_ed448) + type = EVP_PKEY_ED448; else goto bad_arg; - if ((ctx = EVP_PKEY_CTX_new_id(type, NULL)) == NULL) - goto bad_arg; - - if (EVP_PKEY_keygen_init(ctx) != 1) - goto err; - if (EVP_PKEY_keygen(ctx, &pkey) != 1) - goto err; + if (argv[1] == atom_undefined) { + if ((ctx = EVP_PKEY_CTX_new_id(type, NULL)) == NULL) + goto bad_arg; + if (EVP_PKEY_keygen_init(ctx) != 1) + goto err; + if (EVP_PKEY_keygen(ctx, &pkey) != 1) + goto err; + } else { + if (!enif_inspect_binary(env, argv[1], &prv_key)) + goto bad_arg; + if ((pkey = EVP_PKEY_new_raw_private_key(type, NULL, prv_key.data, prv_key.size)) == NULL) + goto bad_arg; + } if (EVP_PKEY_get_raw_public_key(pkey, NULL, &key_len) != 1) goto err; diff --git a/lib/crypto/c_src/openssl_config.h b/lib/crypto/c_src/openssl_config.h index 32a0830717..2634d70f16 100644 --- a/lib/crypto/c_src/openssl_config.h +++ b/lib/crypto/c_src/openssl_config.h @@ -28,6 +28,7 @@ #include <openssl/des.h> /* #include <openssl/idea.h> This is not supported on the openssl OTP requires */ +#include <openssl/dh.h> #include <openssl/dsa.h> #include <openssl/rsa.h> #include <openssl/aes.h> @@ -275,6 +276,7 @@ #if OPENSSL_VERSION_NUMBER <= PACKED_OPENSSL_VERSION(0,9,8,'l') # define HAVE_ECB_IVEC_BUG +# define HAVE_UPDATE_EMPTY_DATA_BUG #endif #ifndef HAS_LIBRESSL @@ -294,8 +296,10 @@ /* If OPENSSL_NO_EC is set, there will be an error in ec.h included from engine.h So if EC is disabled, you can't use Engine either.... */ +#if !defined(OPENSSL_NO_ENGINE) # define HAS_ENGINE_SUPPORT #endif +#endif #if defined(HAS_ENGINE_SUPPORT) diff --git a/lib/crypto/c_src/otp_test_engine.c b/lib/crypto/c_src/otp_test_engine.c index c3bd9dfb55..7f70fdf5fc 100644 --- a/lib/crypto/c_src/otp_test_engine.c +++ b/lib/crypto/c_src/otp_test_engine.c @@ -50,8 +50,10 @@ && !defined(OPENSSL_NO_EC) \ && !defined(OPENSSL_NO_ECDH) \ && !defined(OPENSSL_NO_ECDSA) +#if !defined(OPENSSL_NO_ENGINE) # define HAVE_EC #endif +#endif #if defined(HAVE_EC) /* If OPENSSL_NO_EC is set, there will be an error in ec.h included from engine.h diff --git a/lib/crypto/configure.in b/lib/crypto/configure.in index a3b6673f29..1c36357ebd 100644 --- a/lib/crypto/configure.in +++ b/lib/crypto/configure.in @@ -84,7 +84,7 @@ elif test "x$with_ssl_zlib" = "xyes" || test "x$with_ssl_zlib" = "x"; then AC_MSG_WARN([Cannot search for zlib; missing cross system root (erl_xcomp_sysroot).]) SSL_LINK_WITH_ZLIB=no STATIC_ZLIB_LIBS= - elif test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then + elif test "$host_os" = "win32"; then SSL_LINK_WITH_ZLIB=no STATIC_ZLIB_LIBS= else @@ -216,46 +216,18 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in # of Shining Light OpenSSL, which can be found by poking in # the uninstall section in the registry, it's worth a try... extra_dir="" - if test "x$MIXED_CYGWIN" = "xyes"; then - AC_CHECK_PROG(REGTOOL, regtool, regtool, false) - if test "$ac_cv_prog_REGTOOL" != false; then - wrp="/machine/software/microsoft/windows/currentversion/" - if test "x$ac_cv_sizeof_void_p" = "x8"; then - urp="uninstall/openssl (64-bit)_is1/inno setup: app path" - regtool_subsystem=-w - else - urp="uninstall/openssl (32-bit)_is1/inno setup: app path" - regtool_subsystem=-W - fi - rp="$wrp$urp" - if regtool -q $regtool_subsystem get "$rp" > /dev/null; then - true - else - # Fallback to unspecified wordlength - urp="uninstall/openssl_is1/inno setup: app path" - rp="$wrp$urp" - fi - if regtool -q $regtool_subsystem get "$rp" > /dev/null; then - ssl_install_dir=`regtool -q $regtool_subsystem get "$rp"` - # Try hard to get rid of spaces... - if cygpath -d "$ssl_install_dir" > /dev/null 2>&1; then - ssl_install_dir=`cygpath -d "$ssl_install_dir"` - fi - extra_dir=`cygpath $ssl_install_dir` - fi - fi - elif test "x$MIXED_MSYS" = "xyes"; then + if test "$host_os" = "win32"; then AC_CHECK_PROG(REGTOOL, reg_query.sh, reg_query.sh, false) if test "$ac_cv_prog_REGTOOL" != false; then if test "x$ac_cv_sizeof_void_p" = "x8"; then rp="HKLM/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/OpenSSL (64-bit)_is1" else rp="HKLM/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/OpenSSL_is1" - fi + fi key="Inno Setup: App Path" if "$ac_cv_prog_REGTOOL" "$rp" "$key" > /dev/null; then ssl_install_dir=`"$ac_cv_prog_REGTOOL" "$rp" "$key"` - extra_dir=`win2msys_path.sh "$ssl_install_dir"` + extra_dir=`w32_path.sh -u "$ssl_install_dir"` fi fi fi @@ -266,12 +238,15 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in SSL_CRYPTO_LIBNAME=crypto SSL_SSL_LIBNAME=ssl + SSL_EXTRA_LIBS="" - if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then + if test "$host_os" = "win32" ; then if test "x$ac_cv_sizeof_void_p" = "x8"; then - std_win_ssl_locations="/cygdrive/c/OpenSSL-Win64 /c/OpenSSL-Win64 /opt/local64/pgm/OpenSSL" + std_win_ssl_locations="/mnt/c/OpenSSL-Win64 /c/OpenSSL-Win64 /mnt/c/opt/local64/pgm/OpenSSL /opt/local64/pgm/OpenSSL /cygdrive/c/OpenSSL-Win64" + lib_bits=64 else - std_win_ssl_locations="/cygdrive/c/OpenSSL-Win32 /c/OpenSSL-Win32 /cygdrive/c/OpenSSL /c/OpenSSL /opt/local/pgm/OpenSSL" + std_win_ssl_locations="/mnt/c/OpenSSL-Win32 /c/OpenSSL-Win32 /mnt/c/OpenSSL /c/OpenSSL /cygdrive/c/OpenSSL /opt/local/pgm/OpenSSL /opt/local32/pgm/OpenSSL /mnt/c/opt/local/pgm/OpenSSL /mnt/c/opt/local32/pgm/OpenSSL /cygdrive/c/OpenSSL-Win32" + lib_bits=32 fi else std_win_ssl_locations="" @@ -279,12 +254,12 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in AC_MSG_CHECKING(for OpenSSL >= 0.9.8c in standard locations) - for rdir in $extra_dir $std_win_ssl_locations $std_ssl_locations; do + for rdir in "$extra_dir" $std_win_ssl_locations $std_ssl_locations; do dir="$erl_xcomp_sysroot$rdir" if test -f "$erl_xcomp_isysroot$rdir/include/openssl/opensslv.h"; then is_real_ssl=yes SSL_INCDIR="$dir" - if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then + if test "$host_os" = "win32" ; then if test -f "$dir/lib/VC/libeay32.lib"; then SSL_RUNTIME_LIBDIR="$rdir/lib/VC" SSL_LIBDIR="$dir/lib/VC" @@ -293,11 +268,11 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in elif test -f "$dir/lib/VC/openssl.lib"; then SSL_RUNTIME_LIBDIR="$rdir/lib/VC" SSL_LIBDIR="$dir/lib/VC" - elif test -f $dir/lib/VC/libeay32MD.lib; then + elif test -f "$dir/lib/VC/libeay32MD.lib"; then SSL_CRYPTO_LIBNAME=libeay32MD SSL_SSL_LIBNAME=ssleay32MD if test "x$enable_dynamic_ssl" = "xno" && \ - test -f $dir/lib/VC/static/libeay32MD.lib; then + test -f "$dir/lib/VC/static/libeay32MD.lib"; then SSL_RUNTIME_LIBDIR="$rdir/lib/VC/static" SSL_LIBDIR="$dir/lib/VC/static" else @@ -309,6 +284,19 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in SSL_LIBDIR="$dir/lib" SSL_CRYPTO_LIBNAME=libeay32 SSL_SSL_LIBNAME=ssleay32 + elif test -f "$dir/lib/VC/libcrypto${lib_bits}MD.lib"; then + SSL_CRYPTO_LIBNAME=libcrypto${lib_bits}MD + # NOTE: Additional ugly extra libs at the end + SSL_SSL_LIBNAME="libssl${lib_bits}MD" + if test "x$enable_dynamic_ssl" = "xno" && \ + test -f "$dir/lib/VC/static/$SSL_CRYPTO_LIBNAME.lib"; then + SSL_EXTRA_LIBS="-lCRYPT32 -lWS2_32" + SSL_RUNTIME_LIBDIR="$rdir/lib/VC/static" + SSL_LIBDIR="$dir/lib/VC/static" + else + SSL_RUNTIME_LIBDIR="$rdir/lib/VC" + SSL_LIBDIR="$dir/lib/VC" + fi elif test -f "$dir/lib/openssl.lib"; then SSL_RUNTIME_LIBDIR="$rdir/lib" SSL_LIBDIR="$dir/lib" @@ -352,7 +340,7 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in SSL_INCLUDE="-I$dir/include" old_CPPFLAGS=$CPPFLAGS CPPFLAGS=$SSL_INCLUDE - AC_EGREP_CPP(^yes$,[ + AC_EGREP_CPP(^yes.?$,[ #include <openssl/opensslv.h> #if OPENSSL_VERSION_NUMBER >= 0x0090803fL yes @@ -365,7 +353,7 @@ yes ]) CPPFLAGS=$old_CPPFLAGS if test "x$ssl_found" = "xyes"; then - if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then + if test "x$host_os" = "xwin32" ; then ssl_linkable=yes elif test "x${SSL_CRYPTO_LIBNAME}" = "xsslcrypto"; then # This should only be triggered seen OSE @@ -485,7 +473,8 @@ dnl so it is - be adoptable SSL_INCDIR="$with_ssl_incl" SSL_CRYPTO_LIBNAME=crypto SSL_SSL_LIBNAME=ssl - if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes" && test -d "$with_ssl/lib/VC"; then + SSL_EXTRA_LIBS="" + if test "x$host_os" = "xwin32" && test -d "$with_ssl/lib/VC"; then if test -f "$with_ssl/lib/VC/libeay32.lib"; then SSL_LIBDIR="$with_ssl/lib/VC" SSL_CRYPTO_LIBNAME=libeay32 @@ -500,15 +489,33 @@ dnl so it is - be adoptable SSL_LIBDIR="$with_ssl/lib/VC/static" else SSL_LIBDIR="$with_ssl/lib/VC" - fi + fi + elif test -f "$dir/lib/VC/libcrypto${lib_bits}MD.lib"; then + SSL_CRYPTO_LIBNAME=libcrypto${lib_bits}MD + # NOTE: Additional ugly extra libs at the end + SSL_SSL_LIBNAME="libssl${lib_bits}MD" + if test "x$enable_dynamic_ssl" = "xno" && \ + test -f "$dir/lib/VC/static/$SSL_CRYPTO_LIBNAME.lib"; then + SSL_EXTRA_LIBS="-lCRYPT32 -lWS2_32" + SSL_RUNTIME_LIBDIR="$rdir/lib/VC/static" + SSL_LIBDIR="$dir/lib/VC/static" + else + SSL_RUNTIME_LIBDIR="$rdir/lib/VC" + SSL_LIBDIR="$dir/lib/VC" + fi elif test -f "$with_ssl/lib/libeay32.lib"; then SSL_LIBDIR="$with_ssl/lib" SSL_CRYPTO_LIBNAME=libeay32 SSL_SSL_LIBNAME=ssleay32 + elif test -f "$dir/lib/openssl.lib"; then + SSL_RUNTIME_LIBDIR="$rdir/lib" + SSL_LIBDIR="$dir/lib" + SSL_CRYPTO_LIBNAME=libcrypto + SSL_SSL_LIBNAME=openssl else # This probably wont work, but that's what the user said, so... SSL_LIBDIR="$with_ssl/lib" - fi + fi elif test -f "$dir/lib/powerpc/libsslcrypto.a"; then SSL_CRYPTO_LIBNAME=sslcrypto SSL_LIBDIR="$with_ssl/lib/powerpc/" @@ -530,7 +537,7 @@ dnl so it is - be adoptable if test '!' -f "${SSL_LIBDIR}/lib${SSL_CRYPTO_LIBNAME}.a"; then SSL_DYNAMIC_ONLY=yes elif test '!' -f ${SSL_LIBDIR}/lib${SSL_CRYPTO_LIBNAME}.so -a '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.dylib"; then - SSL_STATIC_ONLY=yes + SSL_STATIC_ONLY=yes fi SSL_INCLUDE="-I$with_ssl_incl/include" SSL_APP=ssl @@ -764,6 +771,7 @@ AC_SUBST(SSL_LIBDIR) AC_SUBST(SSL_FLAGS) AC_SUBST(SSL_CRYPTO_LIBNAME) AC_SUBST(SSL_SSL_LIBNAME) +AC_SUBST(SSL_EXTRA_LIBS) AC_SUBST(SSL_DED_LD_RUNTIME_LIBRARY_PATH) AC_SUBST(SSL_DYNAMIC_ONLY) AC_SUBST(SSL_LINK_WITH_KERBEROS) diff --git a/lib/crypto/doc/src/Makefile b/lib/crypto/doc/src/Makefile index 8da494dad6..5460129c64 100644 --- a/lib/crypto/doc/src/Makefile +++ b/lib/crypto/doc/src/Makefile @@ -27,11 +27,6 @@ VSN=$(CRYPTO_VSN) APPLICATION=crypto # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -47,78 +42,8 @@ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES) \ $(XML_PART_FILES) $(XML_CHAPTER_FILES) -GIF_FILES = - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) +IMAGE_FILES = TOP_SPECS_FILE = specs.xml -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -#in ssh it looks like this: SPECS_FLAGS = -I../../../public_key/include -I../../../public_key/src -I../../.. - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt valgrind: - -clean clean_docs clean_tex: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(MAN6DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f $(SPECS_FILES) - rm -f errs core *~ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6DIR)/* "$(RELEASE_PATH)/man/man6" - - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index ff7479f605..e6c4bba129 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -215,6 +215,42 @@ </desc> </datatype> + <datatype> + <name name="crypto_opts"/> + <name name="crypto_opt"/> + <desc> + <p>Selects encryption (<c>{encrypt,true}</c>) or decryption (<c>{encrypt,false}</c>) + in the <seealso marker="crypto:new_api#the-new-api"><i>New API</i></seealso>. + </p> + </desc> + </datatype> + + <datatype> + <name name="padding"/> + <desc> + <p>This option handles padding in the last block. If not set, no padding is done + and any bytes in the last unfilled block is silently discarded. + </p> + </desc> + </datatype> + <datatype> + <name name="cryptolib_padding"/> + <desc> + <p>The <c>cryptolib_padding</c> are paddings that may be present in the underlying cryptolib + linked to the Erlang/OTP crypto app. + </p> + <p>For OpenSSL, see the <url href="http:www.openssl.org">OpenSSL documentation</url>. + and find <c>EVP_CIPHER_CTX_set_padding()</c> in cryptolib for your linked version. + </p> + </desc> + </datatype> + <datatype> + <name name="otp_padding"/> + <desc> + <p>Erlang/OTP adds a either padding of zeroes or padding with random bytes.</p> + </desc> + </datatype> + <datatype_title>Ciphers, old API</datatype_title> <datatype> <name name="block_cipher_with_iv"/> @@ -647,7 +683,7 @@ <tag><c>error</c></tag> <item><p>An error condition that should not occur, for example a memory allocation failed or the underlying cryptolib returned an error code, for example "Can't initialize context, step 1". - Thoose text usually needs searching the C-code to be understood.</p> + Those text usually needs searching the C-code to be understood.</p> </item> </taglist> <p>To catch the exception, use for example:</p> @@ -674,7 +710,12 @@ <name name="crypto_init" arity="3" since="OTP 22.0"/> <fsummary>Initializes a series of encryptions or decryptions</fsummary> <desc> - <p>As <seealso marker="#crypto_init/4">crypto_init/4</seealso> but for ciphers without IVs.</p> + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + </p> + <p>Equivalent to the call + <seealso marker="#crypto_init/4"><c>crypto_init(Cipher, Key, <<>>, FlagOrOptions)</c></seealso>. + It is intended for ciphers without an IV (nounce). + </p> </desc> </func> @@ -685,10 +726,48 @@ <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. Initializes a series of encryptions or decryptions and creates an internal state with a reference that is returned. + </p> + <p>If <c>IV = <<>></c>, no IV is used. This is intended for ciphers without an IV (nounce). + See <seealso marker="#crypto_init/3">crypto_init/3</seealso>. + </p> + <p> + If <c>IV = undefined</c>, the IV must be added by calls to + <seealso marker="crypto#crypto_dyn_iv_update/3">crypto_dyn_iv_update/3</seealso>. This is intended + for cases where the IV (nounce) need to be changed for each encryption and decryption. + See <seealso marker="#crypto_dyn_iv_init/3">crypto_dyn_iv_init/3</seealso>. + </p> + <p> The actual encryption or decryption is done by - <seealso marker="crypto#crypto_update/2">crypto_update/2</seealso>. + <seealso marker="crypto#crypto_update/2">crypto_update/2</seealso> (or + <seealso marker="crypto#crypto_dyn_iv_update/3">crypto_dyn_iv_update/3</seealso> + ). + </p> + <p>For encryption, set the <c>FlagOrOptions</c> to <c>true</c> or <c>[{encrypt,true}]</c>. + For decryption, set it to <c>false</c> or <c>[{encrypt,false}]</c>. + </p> + <p>Padding could be enabled with the option + <seealso marker="#type-padding">{padding,Padding}</seealso>. The + <seealso marker="#type-cryptolib_padding">cryptolib_padding</seealso> enables + <c>pkcs_padding</c> or no padding (<c>none</c>). + The paddings <c>zero</c> or <c>random</c> fills the last part of the last block with zeroes or random bytes. + If the last block is already full, nothing is added. + </p> + <p>In decryption, the <seealso marker="#type-cryptolib_padding">cryptolib_padding</seealso> removes + such padding, if present. + The <seealso marker="#type-otp_padding">otp_padding</seealso> is not + removed - it has to be done elsewhere. + </p> + <p>If padding is <c>{padding,none}</c> or not specifed and the total data from all subsequent + <seealso marker="crypto#crypto_update/2">crypto_updates</seealso> does + not fill the last block fully, that last data is lost. In case of <c>{padding,none}</c> there will + be an error in this case. If padding is not specified, the bytes of the unfilled block is silently + discarded. + </p> + <p>The actual padding is performed by + <seealso marker="crypto#crypto_final/1">crypto_final/1</seealso>. </p> - <p>For encryption, set the <c>EncryptFlag</c> to <c>true</c>. For decryption, set it to <c>false</c>. + <p> + For blocksizes call <seealso marker="#cipher_info/1">cipher_info/1</seealso>. </p> <p>See <seealso marker="crypto:new_api#examples-of-crypto_init-4-and-crypto_update-2"> examples in the User's Guide.</seealso> @@ -720,12 +799,59 @@ <fsummary>Initializes a series of encryptions or decryptions where the IV is provided later</fsummary> <desc> <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. - Initializes a series of encryptions or decryptions where the IV is provided later. + </p> + <p>Initializes a series of encryptions or decryptions where the IV is provided later. The actual encryption or decryption is done by <seealso marker="crypto#crypto_dyn_iv_update/3">crypto_dyn_iv_update/3</seealso>. </p> - <p>For encryption, set the <c>EncryptFlag</c> to <c>true</c>. For decryption, set it to <c>false</c>. + <p>The function is equivalent to + <seealso marker="#crypto_init/4"><c>crypto_init(Cipher, Key, undefined, FlagOrOptions)</c></seealso>. + </p> + </desc> + </func> + + <func> + <name name="crypto_final" arity="1" since=""/> + <fsummary>Ends a series of encryptions or decryptions</fsummary> + <desc> + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + </p> + <p> + Finalizes a series of encryptions or decryptions and delivers the final bytes of the final block. + The data returned from this function may be empty if no padding was enabled in + <seealso marker="#crypto_init/3">crypto_init/3,4</seealso> or + <seealso marker="#crypto_dyn_iv_init/3">crypto_dyn_iv_init/3</seealso>. + </p> + </desc> + </func> + + <func> + <name name="crypto_get_data" arity="1" since=""/> + <fsummary>Get information about crypto states</fsummary> + <desc> + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + </p> + <p> + Returns information about the State in the argument. The information is the form of a map, + which currently contains at least: </p> + <taglist> + <tag><c>size</c></tag> + <item>The number of bytes encrypted or decrypted so far. + </item> + <tag><c>padding_size</c></tag> + <item>After a call to + <seealso marker="#crypto_final/1">crypto_final/1</seealso> it contains + the number of bytes padded. Otherwise 0. + </item> + <tag><c>padding_type</c></tag> + <item>The type of the padding as provided in the call ot + <seealso marker="#crypto_init/3">crypto_init/3,4</seealso>. + </item> + <tag><c>encrypt</c></tag> + <item>Is <c>true</c> if encryption is performed. It is <c>false</c> otherwise. + </item> + </taglist> </desc> </func> @@ -756,7 +882,9 @@ <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. Do a complete encrypt or decrypt of the full text in the argument <c>Data</c>. </p> - <p>For encryption, set the <c>EncryptFlag</c> to <c>true</c>. For decryption, set it to <c>false</c>. + <p>For encryption, set the <c>FlagOrOptions</c> to <c>true</c>. For decryption, set it to <c>false</c>. + For setting other options, see + <seealso marker="crypto#crypto_init/4">crypto_init/4</seealso>. </p> <p>See <seealso marker="crypto:new_api#example-of-crypto_one_time-5">examples in the User's Guide.</seealso> </p> diff --git a/lib/crypto/doc/src/insidecover.xml b/lib/crypto/doc/src/insidecover.xml deleted file mode 100644 index bf2427afdf..0000000000 --- a/lib/crypto/doc/src/insidecover.xml +++ /dev/null @@ -1,26 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE bookinsidecover SYSTEM "bookinsidecover.dtd"> - -<bookinsidecover> - - The Erlang/OTP SSL application includes software developed by the - OpenSSL Project for use in the OpenSSL Toolkit - (http://www.openssl.org/). Copyright (c) 1998-2002 The OpenSSL - Project. All rights reserved. - - <br/> - This product includes cryptographic software written by Eric Young - (eay@cryptsoft.com). This product includes software written by Tim - Hudson (tjh@cryptsoft.com). Copyright (C) 1995-1998 Eric Young - (eay@cryptsoft.com). All rights reserved. - - <br/> - For further OpenSSL and SSLeay license information se the chapter - <bold>Licenses</bold>. - - <vfill/> - <br/> - <tt>http://www.erlang.org</tt> - <br/> -</bookinsidecover> - diff --git a/lib/crypto/doc/src/new_api.xml b/lib/crypto/doc/src/new_api.xml index aacf5e4f76..009f29584f 100644 --- a/lib/crypto/doc/src/new_api.xml +++ b/lib/crypto/doc/src/new_api.xml @@ -59,6 +59,8 @@ <item><seealso marker="crypto#stream_init-2">stream_init/3</seealso></item> <item><seealso marker="crypto#stream_encrypt-2">stream_encrypt/2</seealso></item> <item><seealso marker="crypto#stream_decrypt-2">stream_decrypt/2</seealso></item> + <item><seealso marker="crypto#next_iv-2">next_iv/2</seealso></item> + <item><seealso marker="crypto#next_iv-3">next_iv/3</seealso></item> </list> <p>for lists of supported algorithms:</p> <list> @@ -76,7 +78,7 @@ <item><seealso marker="crypto#hmac_final_n-2">hmac_final_n/2</seealso></item> <item><seealso marker="crypto#poly1305-2">poly1305/2</seealso></item> </list> - <p>They are not deprecated for now, but may be in a future release. + <p>They are deprecated from 23.0 and for removal in 24.0. </p> </section> @@ -108,6 +110,7 @@ <item><seealso marker="crypto#crypto_init/4">crypto_init/4</seealso></item> <item><seealso marker="crypto#crypto_init/3">crypto_init/3</seealso></item> <item><seealso marker="crypto#crypto_update/2">crypto_update/2</seealso></item> + <item><seealso marker="crypto#crypto_final/1">crypto_final/1</seealso></item> </list> <p>The <c>crypto_init</c> initialies an internal cipher state, and one or more calls of <c>crypto_update</c> does the acual encryption or decryption. Note that AEAD ciphers @@ -122,6 +125,10 @@ <item><seealso marker="crypto#crypto_dyn_iv_update/3">crypto_dyn_iv_update/3</seealso></item> </list> <p>An example of where those functions are needed, is when handling the TLS protocol.</p> + <p>If padding was not enabled, the call to + <seealso marker="crypto#crypto_final/1">crypto_final/1</seealso> + may be excluded. + </p> <p>For information about available algorithms, use: </p> <list> @@ -129,6 +136,12 @@ <item><seealso marker="crypto#hash_info-1">hash_info/1</seealso></item> <item><seealso marker="crypto#cipher_info-1">cipher_info/1</seealso></item> </list> + + <p>The <seealso marker="crypto#next_iv-2">next_iv/2</seealso> and + <seealso marker="crypto#next_iv-3">next_iv/3</seealso> is not needed since the + <c>crypto_init</c> and <c>crypto_update</c> includes this functionality. + </p> + </section> <section> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index b19fdadfcd..1557d80db4 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -38,17 +38,170 @@ -export([rand_plugin_uniform/2]). -export([rand_cache_plugin_next/1]). -export([rand_uniform/2]). --export([next_iv/2, next_iv/3]). -export([public_encrypt/4, private_decrypt/4]). -export([private_encrypt/4, public_decrypt/4]). -export([privkey_to_pubkey/2]). -export([ec_curve/1, ec_curves/0]). -export([rand_seed/1]). +%%%---------------------------------------------------------------- +%% Removed functions. +%% +-removed([{rand_bytes,1,"use crypto:strong_rand_bytes/1 instead"}]). + +-removed([{md4,1,"use crypto:hash/2 instead"}]). +-removed([{md5,1,"use crypto:hash/2 instead"}]). +-removed([{sha,1,"use crypto:hash/2 instead"}]). + +-removed([{md4_init,0,"use crypto:hash_init/1 instead"}]). +-removed([{md5_init,0,"use crypto:hash_init/1 instead"}]). +-removed([{sha_init,0,"use crypto:hash_init/1 instead"}]). + +-removed([{md4_update,2,"use crypto:hash_update/2 instead"}]). +-removed([{md5_update,2,"use crypto:hash_update/2 instead"}]). +-removed([{sha_update,2,"use crypto:hash_update/2 instead"}]). + +-removed([{md4_final,1,"use crypto:hash_final/1 instead"}]). +-removed([{md5_final,1,"use crypto:hash_final/1 instead"}]). +-removed([{sha_final,1,"use crypto:hash_final/1 instead"}]). + +-removed([{md5_mac,2,"use crypto:hmac/3 instead"}]). +-removed([{md5_mac_96,2,"use crypto:hmac/4 instead"}]). + +-removed([{sha_mac,2,"use crypto:hmac/3 instead"}]). +-removed([{sha_mac,3,"use crypto:hmac/4 instead"}]). +-removed([{sha_mac_96,2,"use crypto:hmac/4 instead"}]). + +-removed([{rsa_sign,'_',"use crypto:sign/4 instead"}]). +-removed([{rsa_verify,'_',"use crypto:verify/5 instead"}]). + +-removed([{dss_sign,'_',"use crypto:sign/4 instead"}]). +-removed([{dss_verify,'_',"use crypto:verify/5 instead"}]). + +-removed([{mod_exp,3,"use crypto:mod_pow/3 instead"}]). + +-removed([{dh_compute_key,3,"use crypto:compute_key/4 instead"}]). +-removed([{dh_generate_key,1,"use crypto:generate_key/2 instead"}]). +-removed([{dh_generate_key,2,"use crypto:generate_key/3 instead"}]). + +%% DES + +-removed([{des_cfb_ivec,2,"use crypto:next_iv/3 instead"}]). +-removed([{des_cbc_ivec,2,"use crypto:next_iv/2 instead"}]). + +-removed([{des_ecb_encrypt,2,"use crypto:block_encrypt/3 instead"}]). +-removed([{des_cbc_encrypt,3,"use crypto:block_encrypt/4 instead"}]). +-removed([{des_ede3_cbc_encrypt,5,"use crypto:block_encrypt/4 instead"}]). +-removed([{des_cfb_encrypt,3,"use crypto:block_encrypt/4 instead"}]). + +-removed([{des_ecb_decrypt,2,"use crypto:block_decrypt/3 instead"}]). +-removed([{des_cbc_decrypt,3,"use crypto:block_decrypt/4 instead"}]). +-removed([{des_cfb_decrypt,3,"use crypto:block_decrypt/4 instead"}]). + +%% Triple-DES + +-removed([{des3_cbc_encrypt,5,"use crypto:block_encrypt/4 instead"}]). +-removed([{des3_cfb_encrypt,5,"use crypto:block_encrypt/4 instead"}]). + +-removed([{des3_cbc_decrypt,5,"use crypto:block_decrypt/4 instead"}]). +-removed([{des3_cfb_decrypt,5,"use crypto:block_decrypt/4 instead"}]). +-removed([{des3_ede3_cbc_decrypt,5,"use crypto:block_decrypt/4 instead"}]). + +%% Blowfish + +-removed([{blowfish_ecb_encrypt,2,"use crypto:block_encrypt/3 instead"}]). +-removed([{blowfish_cbc_encrypt,3,"use crypto:block_encrypt/4 instead"}]). +-removed([{blowfish_cfb64_encrypt,3,"use crypto:block_encrypt/4 instead"}]). +-removed([{blowfish_ofb64_encrypt,3,"use crypto:block_encrypt/4 instead"}]). + +-removed([{blowfish_ecb_decrypt,2,"use crypto:block_decrypt/3 instead"}]). +-removed([{blowfish_cbc_decrypt,3,"use crypto:block_decrypt/4 instead"}]). +-removed([{blowfish_cfb64_decrypt,3,"use crypto:block_decrypt/4 instead"}]). +-removed([{blowfish_ofb64_decrypt,3,"use crypto:block_decrypt/4 instead"}]). + +%% AES + +-removed([{aes_cfb_128_encrypt,3,"use crypto:block_encrypt/4 instead"}]). +-removed([{aes_cbc_128_encrypt,3,"use crypto:block_encrypt/4 instead"}]). +-removed([{aes_cbc_256_encrypt,3,"use crypto:block_encrypt/4 instead"}]). + +-removed([{aes_cfb_128_decrypt,3,"use crypto:block_decrypt/4 instead"}]). +-removed([{aes_cbc_128_decrypt,3,"use crypto:block_decrypt/4 instead"}]). +-removed([{aes_cbc_256_decrypt,3,"use crypto:block_decrypt/4 instead"}]). + +-removed([{aes_ctr_stream_init,2,"use crypto:stream_init/3 instead"}]). +-removed([{aes_ctr_stream_encrypt,2,"use crypto:stream_encrypt/2 instead"}]). +-removed([{aes_ctr_encrypt,3,"use crypto:stream_encrypt/2 instead"}]). +-removed([{aes_ctr_stream_decrypt,2,"use crypto:stream_decrypt/2 instead"}]). +-removed([{aes_ctr_decrypt,3,"use crypto:stream_decrypt/2 instead"}]). + +-removed([{aes_cbc_ivec,2,"use crypto:next_iv/2 instead"}]). + +%% RC2 + +-removed([{rc2_cbc_encrypt,3,"use crypto:block_encrypt/4 instead"}]). +-removed([{rc2_40_cbc_encrypt,3,"use crypto:block_encrypt/4 instead"}]). + +-removed([{rc2_cbc_decrypt,3,"use crypto:block_decrypt/4 instead"}]). +-removed([{rc2_40_cbc_decrypt,3,"use crypto:block_decrypt/4 instead"}]). + +%% RC4 + +-removed([{rc4_set_key,2,"use crypto:stream_init/2 instead"}]). +-removed([{rc4_encrypt,2,"use crypto:stream_encrypt/2 instead"}]). +-removed([{rc4_encrypt_with_state,2,"use crypto:stream_encrypt/2 instead"}]). + +%% Other + +-removed([{info,0,"use crypto:module_info/0 instead"}]). + +-removed([{strong_rand_mpint,3,"only needed by other removed functions"}]). +-removed([{erlint,1,"only needed by other removed functions"}]). +-removed([{mpint,1,"only needed by other removed functions"}]). + +%%%---------------------------------------------------------------- %% Old interface. Now implemented with the New interface + +-deprecated([{next_iv, '_', + "see the 'New and Old API' chapter of the CRYPTO User's guide"}]). +-export([next_iv/2, next_iv/3]). + +-deprecated([{hmac, 3, "use crypto:mac/4 instead"}, + {hmac, 4, "use crypto:macN/5 instead"}, + {hmac_init, 2, "use crypto:mac_init/3 instead"}, + {hmac_update, 2, "use crypto:mac_update/2 instead"}, + {hmac_final, 1, "use crypto:mac_final/1 instead"}, + {hmac_final_n, 2, "use crypto:mac_finalN/2 instead"}]). + -export([hmac/3, hmac/4, hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]). + +-deprecated([{cmac, 3, "use crypto:mac/4 instead"}, + {cmac, 4, "use crypto:macN/5 instead"}]). -export([cmac/3, cmac/4]). + +-deprecated([{poly1305, 2, "use crypto:mac/3 instead"}]). -export([poly1305/2]). + +-deprecated([{stream_init, '_', + "use crypto:crypto_init/3 + crypto:crypto_update/2 + " + "crypto:crypto_final/1 or crypto:crypto_one_time/4 instead"}, + {stream_encrypt, 2, "use crypto:crypto_update/2 instead"}, + {stream_decrypt, 2, "use crypto:crypto_update/2 instead"}, + {block_encrypt, 3, + "use crypto:crypto_one_time/4 or crypto:crypto_init/3 + " + "crypto:crypto_update/2 + crypto:crypto_final/1 instead"}, + {block_encrypt, 4, + "use crypto:crypto_one_time/5, crypto:crypto_one_time_aead/6,7 " + "or crypto:crypto_(dyn_iv)?_init + " + "crypto:crypto_(dyn_iv)?_update + crypto:crypto_final instead"}, + {block_decrypt, 3, + "use crypto:crypto_one_time/4 or crypto:crypto_init/3 + " + "crypto:crypto_update/2 + crypto:crypto_final/1 instead"}, + {block_decrypt, 4, + "use crypto:crypto_one_time/5, crypto:crypto_one_time_aead/6,7 " + "or crypto:crypto_(dyn_iv)?_init + " + "crypto:crypto_(dyn_iv)?_update + crypto:crypto_final instead"} + ]). -export([stream_init/2, stream_init/3, stream_encrypt/2, stream_decrypt/2, @@ -56,19 +209,25 @@ block_decrypt/3, block_decrypt/4 ]). +%%%---------------------------------------------------------------- %% New interface -export([crypto_init/4, crypto_init/3, crypto_update/2, + crypto_one_time/4, crypto_one_time/5, crypto_one_time_aead/6, crypto_one_time_aead/7, + crypto_dyn_iv_init/3, crypto_dyn_iv_update/3, + crypto_final/1, + crypto_get_data/1, + supports/1, mac/3, mac/4, macN/4, macN/5, mac_init/2, mac_init/3, mac_update/2, mac_final/1, mac_finalN/2 ]). - +%%%---------------------------------------------------------------- %% Engine -export([ engine_get_all_methods/0, @@ -121,7 +280,7 @@ get_test_engine/0]). -export([rand_plugin_aes_jump_2pow20/1]). --deprecated({rand_uniform, 2, next_major_release}). +-deprecated({rand_uniform, 2, "use rand:rand_uniform/1 instead"}). %% This should correspond to the similar macro in crypto.c -define(MAX_BYTES_TO_NIF, 20000). %% Current value is: erlang:system_info(context_reductions) * 10 @@ -923,7 +1082,7 @@ block_encrypt(Type, Key0, Ivec, Data) -> {AAD, PlainText, TagLength} -> crypto_one_time_aead(alias(Type,Key), Key, Ivec, PlainText, AAD, TagLength, true); PlainText -> - crypto_one_time(alias(Type,Key), Key, Ivec, PlainText, true) + block_crypt(alias(Type,Key), Key, Ivec, PlainText, true) end). -spec block_encrypt(Type::block_cipher_without_iv(), Key::key(), PlainText::iodata()) -> @@ -931,7 +1090,7 @@ block_encrypt(Type, Key0, Ivec, Data) -> block_encrypt(Type, Key0, PlainText) -> Key = iolist_to_binary(Key0), - ?COMPAT(crypto_one_time(alias(Type,Key), Key, PlainText, true)). + ?COMPAT(block_crypt(alias(Type,Key), Key, undefined, PlainText, true)). %%%---------------------------------------------------------------- @@ -952,7 +1111,7 @@ block_decrypt(Type, Key0, Ivec, Data) -> {AAD, CryptoText, Tag} -> crypto_one_time_aead(alias(Type,Key), Key, Ivec, CryptoText, AAD, Tag, false); CryptoText -> - crypto_one_time(alias(Type,Key), Key, Ivec, CryptoText, false) + block_crypt(alias(Type,Key), Key, Ivec, CryptoText, false) end). @@ -961,7 +1120,16 @@ block_decrypt(Type, Key0, Ivec, Data) -> block_decrypt(Type, Key0, CryptoText) -> Key = iolist_to_binary(Key0), - ?COMPAT(crypto_one_time(alias(Type,Key), Key, CryptoText, false)). + ?COMPAT(block_crypt(alias(Type,Key), Key, undefined, CryptoText, false)). + + + +block_crypt(Cipher, Key, IV, Data, EncryptFlag) -> + Ctx = case IV of + undefined -> crypto_init(Cipher, Key, EncryptFlag); + _ -> crypto_init(Cipher, Key, IV, EncryptFlag) + end, + crypto_update(Ctx, Data). %%%-------- Stream ciphers API @@ -979,7 +1147,7 @@ stream_init(Type, Key0, IVec) when is_binary(IVec) -> Key = iolist_to_binary(Key0), Ref = ?COMPAT(ng_crypto_init_nif(alias(Type,Key), Key, iolist_to_binary(IVec), - undefined) + get_crypto_opts([{encrypt,undefined}])) ), {Type, {Ref,flg_undefined}}. @@ -992,7 +1160,7 @@ stream_init(rc4 = Type, Key0) -> Key = iolist_to_binary(Key0), Ref = ?COMPAT(ng_crypto_init_nif(alias(Type,Key), Key, <<>>, - undefined) + get_crypto_opts([{encrypt,undefined}])) ), {Type, {Ref,flg_undefined}}. @@ -1017,7 +1185,8 @@ stream_decrypt(State, Data) -> %%%-------- helpers crypto_stream_emulate({Cipher,{Ref0,flg_undefined}}, Data, EncryptFlag) when is_reference(Ref0) -> ?COMPAT(begin - Ref = ng_crypto_init_nif(Ref0, <<>>, <<>>, EncryptFlag), + Ref = ng_crypto_init_nif(Ref0, <<>>, <<>>, + get_crypto_opts([{encrypt,EncryptFlag}])), {{Cipher,Ref}, crypto_update(Ref, Data)} end); @@ -1059,42 +1228,83 @@ next_iv(Type, Data, _Ivec) -> -opaque crypto_state() :: reference() . +-type crypto_opts() :: boolean() + | [ crypto_opt() ] . +-type crypto_opt() :: {encrypt,boolean()} + | {padding, padding()} . +-type padding() :: cryptolib_padding() | otp_padding(). +-type cryptolib_padding() :: none | pkcs_padding . +-type otp_padding() :: zero | random . + %%%---------------------------------------------------------------- %%% %%% Create and initialize a new state for encryption or decryption %%% --spec crypto_init(Cipher, Key, EncryptFlag) -> State | descriptive_error() +-spec crypto_init(Cipher, Key, FlagOrOptions) -> State | descriptive_error() when Cipher :: cipher_no_iv(), Key :: iodata(), - EncryptFlag :: boolean(), + FlagOrOptions :: crypto_opts() | boolean(), State :: crypto_state() . -crypto_init(Cipher, Key, EncryptFlag) -> - %% The IV is supposed to be supplied by calling crypto_update/3 - ng_crypto_init_nif(Cipher, iolist_to_binary(Key), <<>>, EncryptFlag). +crypto_init(Cipher, Key, FlagOrOptions) -> + crypto_init(Cipher, Key, <<>>, FlagOrOptions). --spec crypto_init(Cipher, Key, IV, EncryptFlag) -> State | descriptive_error() +-spec crypto_init(Cipher, Key, IV, FlagOrOptions) -> State | descriptive_error() when Cipher :: cipher_iv(), Key :: iodata(), IV :: iodata(), - EncryptFlag :: boolean(), + FlagOrOptions :: crypto_opts() | boolean(), State :: crypto_state() . -crypto_init(Cipher, Key, IV, EncryptFlag) -> - ng_crypto_init_nif(Cipher, iolist_to_binary(Key), iolist_to_binary(IV), EncryptFlag). +crypto_init(Cipher, Key, IV, FlagOrOptions) -> + ng_crypto_init_nif(Cipher, + iolist_to_binary(Key), + iolist_to_binary(IV), + get_crypto_opts(FlagOrOptions)). + +%%%---------------------------------------------------------------- +get_crypto_opts(Options) when is_list(Options) -> + lists:foldl(fun chk_opt/2, + #{encrypt => true, + padding => undefined + }, + Options); +get_crypto_opts(Flag) when is_boolean(Flag) -> + #{encrypt => Flag, + padding => undefined + }; +get_crypto_opts(X) -> + error({badarg,{bad_option,X}}). + + +chk_opt({Tag,Val}, A) -> + case ok_opt(Tag,Val) of + true -> + A#{Tag => Val}; + false -> + error({badarg,{bad_option,{Tag,Val}}}) + end; +chk_opt(X, _) -> + error({badarg,{bad_option,X}}). +ok_opt(encrypt, V) -> lists:member(V, [true, false, undefined]); +ok_opt(padding, V) -> lists:member(V, [none, pkcs_padding, zero, random, undefined]); +ok_opt(_, _) -> false. %%%---------------------------------------------------------------- --spec crypto_dyn_iv_init(Cipher, Key, EncryptFlag) -> State | descriptive_error() +-spec crypto_dyn_iv_init(Cipher, Key, FlagOrOptions) -> State | descriptive_error() when Cipher :: cipher_iv(), Key :: iodata(), - EncryptFlag :: boolean(), + FlagOrOptions :: crypto_opts() | boolean(), State :: crypto_state() . -crypto_dyn_iv_init(Cipher, Key, EncryptFlag) -> +crypto_dyn_iv_init(Cipher, Key, FlagOrOptions) -> %% The IV is supposed to be supplied by calling crypto_update/3 - ng_crypto_init_nif(Cipher, iolist_to_binary(Key), undefined, EncryptFlag). + ng_crypto_init_nif(Cipher, + iolist_to_binary(Key), + undefined, + get_crypto_opts(FlagOrOptions)). %%%---------------------------------------------------------------- %%% @@ -1107,14 +1317,8 @@ crypto_dyn_iv_init(Cipher, Key, EncryptFlag) -> when State :: crypto_state(), Data :: iodata(), Result :: binary() . -crypto_update(State, Data0) -> - case iolist_to_binary(Data0) of - <<>> -> - <<>>; % Known to fail on OpenSSL 0.9.8h - Data -> - ng_crypto_update_nif(State, Data) - end. - +crypto_update(State, Data) -> + ng_crypto_update_nif(State, iolist_to_binary(Data)). %%%---------------------------------------------------------------- -spec crypto_dyn_iv_update(State, Data, IV) -> Result | descriptive_error() @@ -1122,14 +1326,30 @@ crypto_update(State, Data0) -> Data :: iodata(), IV :: iodata(), Result :: binary() . -crypto_dyn_iv_update(State, Data0, IV) -> - %% When State is from State = crypto_init(Cipher, Key, undefined, EncryptFlag) - case iolist_to_binary(Data0) of - <<>> -> - <<>>; % Known to fail on OpenSSL 0.9.8h - Data -> - ng_crypto_update_nif(State, Data, iolist_to_binary(IV)) - end. +crypto_dyn_iv_update(State, Data, IV) -> + ng_crypto_update_nif(State, iolist_to_binary(Data), iolist_to_binary(IV)). + +%%%---------------------------------------------------------------- +%%% +%%% Finalize encrypt/decrypt bytes. If the size of the bytes in +%%% to crypto_uptate was not an integer number of blocks, the rest +%%% is returned from this function. + +-spec crypto_final(State) -> FinalResult | descriptive_error() + when State :: crypto_state(), + FinalResult :: binary() . +crypto_final(State) -> + ng_crypto_final_nif(State). + +%%%---------------------------------------------------------------- +%%% +%%% Get result of padding etc + +-spec crypto_get_data(State) -> Result + when State :: crypto_state(), + Result :: map() . +crypto_get_data(State) -> + ng_crypto_get_data_nif(State). %%%---------------------------------------------------------------- %%% @@ -1137,44 +1357,34 @@ crypto_dyn_iv_update(State, Data0, IV) -> %%% The size must be an integer multiple of the crypto's blocksize. %%% --spec crypto_one_time(Cipher, Key, Data, EncryptFlag) -> +-spec crypto_one_time(Cipher, Key, Data, FlagOrOptions) -> Result | descriptive_error() when Cipher :: cipher_no_iv(), Key :: iodata(), Data :: iodata(), - EncryptFlag :: boolean(), + FlagOrOptions :: crypto_opts() | boolean(), Result :: binary() . -crypto_one_time(Cipher, Key, Data0, EncryptFlag) -> - case iolist_to_binary(Data0) of - <<>> -> - <<>>; % Known to fail on OpenSSL 0.9.8h - Data -> - ng_crypto_one_time_nif(Cipher, - iolist_to_binary(Key), <<>>, Data, - EncryptFlag) - end. +crypto_one_time(Cipher, Key, Data, FlagOrOptions) -> + crypto_one_time(Cipher, Key, <<>>, Data, FlagOrOptions). --spec crypto_one_time(Cipher, Key, IV, Data, EncryptFlag) -> +-spec crypto_one_time(Cipher, Key, IV, Data, FlagOrOptions) -> Result | descriptive_error() when Cipher :: cipher_iv(), Key :: iodata(), IV :: iodata(), Data :: iodata(), - EncryptFlag :: boolean(), + FlagOrOptions :: crypto_opts() | boolean(), Result :: binary() . -crypto_one_time(Cipher, Key, IV, Data0, EncryptFlag) -> - case iolist_to_binary(Data0) of - <<>> -> - <<>>; % Known to fail on OpenSSL 0.9.8h - Data -> - ng_crypto_one_time_nif(Cipher, - iolist_to_binary(Key), iolist_to_binary(IV), Data, - EncryptFlag) - end. - +crypto_one_time(Cipher, Key, IV, Data, FlagOrOptions) -> + ng_crypto_one_time_nif(Cipher, + iolist_to_binary(Key), + iolist_to_binary(IV), + iolist_to_binary(Data), + get_crypto_opts(FlagOrOptions)). +%%%---------------------------------------------------------------- -spec crypto_one_time_aead(Cipher, Key, IV, InText, AAD, EncFlag::true) -> Result | descriptive_error() when Cipher :: cipher_aead(), @@ -1227,26 +1437,25 @@ aead_tag_len(_) -> error({badarg, "Not an AEAD cipher"}). %%%---------------------------------------------------------------- %%% NIFs --spec ng_crypto_init_nif(atom(), binary(), binary()|undefined, boolean()|undefined ) -> - crypto_state() | descriptive_error() - ; (crypto_state(), <<>>, <<>>, boolean()) - -> crypto_state() | descriptive_error(). - -ng_crypto_init_nif(_Cipher, _Key, _IVec, _EncryptFlg) -> ?nif_stub. +ng_crypto_init_nif(Cipher, Key, IVec, #{encrypt := EncryptFlag, + padding := Padding}) -> + ng_crypto_init_nif(Cipher, Key, IVec, EncryptFlag, Padding). + +ng_crypto_init_nif(_Cipher, _Key, _IVec, _EncryptFlag, _Padding) -> ?nif_stub. --spec ng_crypto_update_nif(crypto_state(), binary()) -> - binary() | descriptive_error() . ng_crypto_update_nif(_State, _Data) -> ?nif_stub. - --spec ng_crypto_update_nif(crypto_state(), binary(), binary()) -> - binary() | descriptive_error() . ng_crypto_update_nif(_State, _Data, _IV) -> ?nif_stub. +ng_crypto_final_nif(_State) -> ?nif_stub. + +ng_crypto_get_data_nif(_State) -> ?nif_stub. + +ng_crypto_one_time_nif(Cipher, Key, IVec, Data, #{encrypt := EncryptFlag, + padding := Padding}) -> + ng_crypto_one_time_nif(Cipher, Key, IVec, Data, EncryptFlag, Padding). --spec ng_crypto_one_time_nif(atom(), binary(), binary(), binary(), boolean() ) -> - binary() | descriptive_error(). -ng_crypto_one_time_nif(_Cipher, _Key, _IVec, _Data, _EncryptFlg) -> ?nif_stub. +ng_crypto_one_time_nif(_Cipher, _Key, _IVec, _Data, _EncryptFlag, _Padding) -> ?nif_stub. %%%---------------------------------------------------------------- %%% Cipher aliases @@ -1461,7 +1670,7 @@ rand_plugin_aes_next({Key,GenWords,F,_JumpBase,Count}) -> %% rand_plugin_aes_next(Key, GenWords, F, Count) -> {Cleartext,NewCount} = aes_cleartext(<<>>, F, Count, GenWords), - Encrypted = crypto:block_encrypt(aes_ecb, Key, Cleartext), + Encrypted = block_encrypt(aes_ecb, Key, Cleartext), [V|Cache] = aes_cache(Encrypted, {Key,GenWords,F,Count,NewCount}), {V,Cache}. @@ -1791,21 +2000,21 @@ pkey_crypt_nif(_Algorithm, _In, _Key, _Options, _IsPrivate, _IsEncrypt) -> ?nif_ -spec generate_key(Type, Params) -> {PublicKey, PrivKeyOut} - when Type :: dh | ecdh | rsa | srp, + when Type :: dh | ecdh | eddsa | rsa | srp, PublicKey :: dh_public() | ecdh_public() | rsa_public() | srp_public(), PrivKeyOut :: dh_private() | ecdh_private() | rsa_private() | {srp_public(),srp_private()}, - Params :: dh_params() | ecdh_params() | rsa_params() | srp_gen_params() + Params :: dh_params() | ecdh_params() | eddsa_params() | rsa_params() | srp_gen_params() . generate_key(Type, Params) -> generate_key(Type, Params, undefined). -spec generate_key(Type, Params, PrivKeyIn) -> {PublicKey, PrivKeyOut} - when Type :: dh | ecdh | rsa | srp, + when Type :: dh | ecdh | eddsa | rsa | srp, PublicKey :: dh_public() | ecdh_public() | rsa_public() | srp_public(), PrivKeyIn :: undefined | dh_private() | ecdh_private() | rsa_private() | {srp_public(),srp_private()}, PrivKeyOut :: dh_private() | ecdh_private() | rsa_private() | {srp_public(),srp_private()}, - Params :: dh_params() | ecdh_params() | rsa_params() | srp_comp_params() + Params :: dh_params() | ecdh_params() | eddsa_params() | rsa_params() | srp_comp_params() . generate_key(dh, DHParameters0, PrivateKey) -> @@ -1843,15 +2052,17 @@ generate_key(rsa, {ModulusSize, PublicExponent}, undefined) -> {lists:sublist(Private, 2), Private} end; - -generate_key(ecdh, Curve, undefined) when Curve == x448 ; - Curve == x25519 -> - evp_generate_key_nif(Curve); +generate_key(ecdh, Curve, PrivKey) when Curve == x448 ; + Curve == x25519 -> + evp_generate_key_nif(Curve, ensure_int_as_bin(PrivKey)); generate_key(ecdh, Curve, PrivKey) -> - ec_key_generate(nif_curve_params(Curve), ensure_int_as_bin(PrivKey)). + ec_key_generate(nif_curve_params(Curve), ensure_int_as_bin(PrivKey)); +generate_key(eddsa, Curve, PrivKey) when Curve == ed448 ; + Curve == ed25519 -> + evp_generate_key_nif(Curve, ensure_int_as_bin(PrivKey)). -evp_generate_key_nif(_Curve) -> ?nif_stub. +evp_generate_key_nif(_Curve, _PrivKey) -> ?nif_stub. -spec compute_key(Type, OthersPublicKey, MyPrivateKey, Params) diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index ce515a9ba0..bb1ea2df20 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -35,6 +35,7 @@ all() -> appup, {group, fips}, {group, non_fips}, + cipher_padding, mod_pow, exor, rand_uniform, @@ -200,11 +201,13 @@ groups() -> {ecdsa, [], [sign_verify %% Does not work yet: ,public_encrypt, private_encrypt ]}, - {ed25519, [], [sign_verify + {ed25519, [], [sign_verify, %% Does not work yet: ,public_encrypt, private_encrypt + generate ]}, - {ed448, [], [sign_verify + {ed448, [], [sign_verify, %% Does not work yet: ,public_encrypt, private_encrypt + generate ]}, {dh, [], [generate_compute, compute_bug]}, {ecdh, [], [use_all_elliptic_curves, compute, generate]}, @@ -551,7 +554,8 @@ api_ng_cipher_increment({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> RefEnc = crypto:crypto_init(Type, Key, IV, true), RefDec = crypto:crypto_init(Type, Key, IV, false), EncTexts = api_ng_cipher_increment_loop(RefEnc, PlainTexts), - Enc = iolist_to_binary(EncTexts), + EncFinal = crypto:crypto_final(RefEnc), + Enc = iolist_to_binary(EncTexts++[EncFinal]), case ExpectedEncText of undefined -> ok; @@ -562,7 +566,9 @@ api_ng_cipher_increment({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> ct:fail("api_ng_cipher_increment (encode)",[]) end, Plain = iolist_to_binary(PlainTexts), - case iolist_to_binary(api_ng_cipher_increment_loop(RefDec, EncTexts)) of + DecTexts = api_ng_cipher_increment_loop(RefDec, EncTexts), + DecFinal = crypto:crypto_final(RefDec), + case iolist_to_binary(DecTexts++[DecFinal]) of Plain -> ok; OtherPT -> @@ -697,6 +703,60 @@ do_api_ng_tls({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> end. %%-------------------------------------------------------------------- +cipher_padding(_Config) -> + Ciphers = [{C,pkcs_padding} + || C <- crypto:supports(ciphers), + C =/= aes_ige256, + C =/= chacha20_poly1305, + case crypto:cipher_info(C) of + #{mode := ccm_mode} -> false; + #{mode := gcm_mode} -> false; + _ -> true + end], + lists:foreach(fun cipher_padding_test/1, Ciphers). + +cipher_padding_test({Cipher, Padding}) -> + #{block_size := Sblock, + iv_length := Siv, + key_length := Skey} = Inf = crypto:cipher_info(Cipher), + ct:log("~p ~p", [Cipher,Inf]), + + Key = <<1:Skey/unit:8>>, + IV = <<0:Siv/unit:8>>, + MsgLen = 5*Sblock + 3, + Tplain = crypto:strong_rand_bytes(MsgLen), + PadSize = if + (Padding == zero) ; (Padding == random) -> + (Sblock - (MsgLen rem Sblock)) rem Sblock; + true -> + 0 + end, + Tcrypt = + case Siv of + 0 -> + crypto:crypto_one_time(Cipher, Key, Tplain, [{encrypt,true},{padding,Padding}]); + _ -> + crypto:crypto_one_time(Cipher, Key, IV, Tplain, [{encrypt,true},{padding,Padding}]) + end, + + TdecryptPadded = + case Siv of + 0 -> + crypto:crypto_one_time(Cipher, Key, Tcrypt, [{encrypt,false},{padding,Padding}]); + _ -> + crypto:crypto_one_time(Cipher, Key, IV, Tcrypt, [{encrypt,false},{padding,Padding}]) + end, + + case split_binary(TdecryptPadded, size(TdecryptPadded) - PadSize) of + {Tplain, _} -> + ok; + {Tdecrypt,Tpad} -> + ct:log("Key = ~p~nIV = ~p~nTplain = ~p~nTcrypt = ~p~nTdecrypt = ~p~nPadding = ~p", + [Key, IV, Tplain, Tcrypt, Tdecrypt, Tpad]), + ct:fail("~p", [Cipher]) + end. + +%%-------------------------------------------------------------------- no_aead() -> [{doc, "Test disabled aead ciphers"}]. no_aead(Config) when is_list(Config) -> @@ -1584,7 +1644,7 @@ do_compute({ecdh = Type, Pub, Priv, Curve, SharedSecret}) -> ct:fail({{crypto, compute_key, [Type, Pub, Priv, Curve]}, {expected, SharedSecret}, {got, Other}}) end. -do_generate({ecdh = Type, Curve, Priv, Pub}) -> +do_generate({Type, Curve, Priv, Pub}) when Type == ecdh ; Type == eddsa -> case crypto:generate_key(Type, Curve, Priv) of {Pub, _} -> ok; @@ -2011,7 +2071,10 @@ group_config(ecdsa = Type, Config) -> [{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config]; group_config(Type, Config) when Type == ed25519 ; Type == ed448 -> TestVectors = eddsa(Type), - [{sign_verify,TestVectors} | Config]; + Generate = lists:map(fun({Curve, _Hash, Priv, Pub, _Msg, _Signature}) -> + {eddsa, Curve, Priv, Pub} + end, TestVectors), + [{sign_verify,TestVectors}, {generate, Generate} | Config]; group_config(srp, Config) -> GenerateCompute = [srp3(), srp6(), srp6a(), srp6a_smaller_prime()], [{generate_compute, GenerateCompute} | Config]; @@ -3508,7 +3571,7 @@ srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPriv eddsa(ed25519) -> %% https://tools.ietf.org/html/rfc8032#section-7.1 - %% {ALGORITHM, (SHA)}, SECRET KEY, PUBLIC KEY, MESSAGE, SIGNATURE} + %% {ALGORITHM, (SHA), SECRET KEY, PUBLIC KEY, MESSAGE, SIGNATURE} [ %% TEST 1 {ed25519, undefined, @@ -4074,12 +4137,31 @@ ecc() -> "782C37E372BA4520AA62E0FED121D49EF3B543660CFD05FD")}, {ecdh,secp192r1,4, hexstr2point("35433907297CC378B0015703374729D7A4FE46647084E4BA", - "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}], + "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}, + %% RFC 7748, 6.2 + {ecdh, x448, + hexstr2bin("9a8f4925d1519f5775cf46b04b5800d4ee9ee8bae8bc5565d498c28d" + "d9c9baf574a9419744897391006382a6f127ab1d9ac2d8c0a598726b"), + hexstr2bin("9b08f7cc31b7e3e67d22d5aea121074a273bd2b83de09c63faa73d2c" + "22c5d9bbc836647241d953d40c5b12da88120d53177f80e532c41fa0")}, + {ecdh, x448, + hexstr2bin("1c306a7ac2a0e2e0990b294470cba339e6453772b075811d8fad0d1d" + "6927c120bb5ee8972b0d3e21374c9c921b09d1b0366f10b65173992d"), + hexstr2bin("3eb7a829b0cd20f5bcfc0b599b6feccf6da4627107bdb0d4f345b430" + "27d8b972fc3e34fb4232a13ca706dcb57aec3dae07bdc1c67bf33609")}, + %% RFC 7748, 6.1 + {ecdh, x25519, + hexstr2bin("77076d0a7318a57d3c16c17251b26645df4c2f87ebc0992ab177fba51db92c2a"), + hexstr2bin("8520f0098930a754748b7ddcb43ef75a0dbf3a0d26381af4eba4a98eaa9b4e6a")}, + {ecdh, x25519, + hexstr2bin("5dab087e624a8a4b79e17f8b83800ee66f3bb1292618b6fd1c2f8b27ff88e0eb"), + hexstr2bin("de9edb7d7b7dc1b4d35b61c2ece435373f8343c85b78674dadfc7e146f882b4f")}], lists:filter(fun ({_Type, Curve, _Priv, _Pub}) -> lists:member(Curve, Curves) end, TestCases). + int_to_bin(X) when X < 0 -> int_to_bin_neg(X, []); int_to_bin(X) -> int_to_bin_pos(X, []). diff --git a/lib/crypto/test/crypto_property_test_SUITE.erl b/lib/crypto/test/crypto_property_test_SUITE.erl index bcfd5d3de1..03d030c702 100644 --- a/lib/crypto/test/crypto_property_test_SUITE.erl +++ b/lib/crypto/test/crypto_property_test_SUITE.erl @@ -61,7 +61,7 @@ encrypt_decrypt_one_time(Config) -> init_update(Config) -> ct_property_test:quickcheck( - crypto_ng_api:prop__crypto_init_update(), + crypto_ng_api:prop__crypto_init_update_final(), Config ). diff --git a/lib/crypto/test/property_test/crypto_ng_api.erl b/lib/crypto/test/property_test/crypto_ng_api.erl index 14753a4eba..20c6db4dd7 100644 --- a/lib/crypto/test/property_test/crypto_ng_api.erl +++ b/lib/crypto/test/property_test/crypto_ng_api.erl @@ -32,27 +32,28 @@ prop__crypto_one_time() -> numtests(10000, - ?FORALL({TextPlain, Cipher, Key, IV}, ?LET(Ciph,cipher(), - {text_plain(), Ciph, key(Ciph), iv(Ciph)}), + ?FORALL({TextPlain, Cipher, Key, IV, Padding}, ?LET(Ciph,cipher(), + {text_plain(), Ciph, key(Ciph), iv(Ciph), padding()}), begin R = equal(TextPlain, - full_blocks(TextPlain, Cipher), - decrypt_encrypt_one_time(Cipher, Key, IV, TextPlain)), + full_blocks(TextPlain, Cipher, Padding), + decrypt_encrypt_one_time(Cipher, Key, IV, TextPlain, Padding)), prt_inf(Cipher, TextPlain, R) end ) ). -prop__crypto_init_update() -> +prop__crypto_init_update_final() -> numtests(10000, - ?FORALL({TextPlain, Cipher, Key, IV}, ?LET(Ciph,cipher(), - {text_plain(), Ciph, key(Ciph), iv(Ciph)}), + ?FORALL({TextPlain, Cipher, Key, IV, Padding}, ?LET(Ciph,cipher(), + {text_plain(), Ciph, key(Ciph), iv(Ciph), padding()}), begin R = equal(TextPlain, - full_blocks(TextPlain, Cipher), - decrypt_encrypt_init_update(Cipher, Key, IV, TextPlain)), + full_blocks(TextPlain, Cipher, Padding), + decrypt_encrypt_init_update_final(Cipher, Key, IV, TextPlain, Padding)), prt_inf(Cipher, TextPlain, R) - end) + end + ) ). prt_inf(Cipher, TextPlain, R) -> @@ -69,6 +70,7 @@ prt_inf(Cipher, TextPlain, R) -> %%%================================================================ %%% Lib +equal(_, _, correct_exception) -> true; equal(_, T, T) -> true; equal(F, Tp, Td) -> ct:pal("Full: ~p~n" @@ -78,42 +80,94 @@ equal(F, Tp, Td) -> false. -decrypt_encrypt_one_time(Cipher, Key, IV, TextPlain) -> - io:format("~p:~p Cipher: ~p, BlockSize: ~p, Key: ~p, IV: ~p, TextPlain: ~p (~p chunks)", +decrypt_encrypt_one_time(Cipher, Key, IV, TextPlain, Padding) -> + io:format("~p:~p Cipher: ~p, BlockSize: ~p, Key: ~p, IV: ~p, TextPlain: ~p (~p chunks), Padding: ~p", [?MODULE,?LINE, Cipher, block_size(Cipher), size(Key), size(IV), size(iolist_to_binary(TextPlain)), - num_chunks(TextPlain)]), - TextCrypto = crypto:crypto_one_time(Cipher, Key, IV, TextPlain, true), - io:format("~p:~p TextCrypto: ~p", [?MODULE,?LINE, size(TextCrypto)]), - TextDecrypt = crypto:crypto_one_time(Cipher, Key, IV, TextCrypto, false), - io:format("~p:~p TextDecrypt: ~p", [?MODULE,?LINE, size(TextDecrypt)]), - TextDecrypt. - + num_chunks(TextPlain), Padding]), + Sblock = block_size(Cipher), + ExcessBytesLastBlock = size(iolist_to_binary(TextPlain)) rem Sblock, + PadSize = if + (Padding == zero) ; (Padding == random) -> + (Sblock - ExcessBytesLastBlock) rem Sblock; + true -> + 0 + end, + try + crypto:crypto_one_time(Cipher, Key, IV, TextPlain, [{encrypt,true},{padding,Padding}]) + of + TextCrypto -> + io:format("~p:~p PadSize: ~p, TextCrypto: ~p", + [?MODULE,?LINE, PadSize, size(TextCrypto)]), + TextDecryptPadded = + crypto:crypto_one_time(Cipher, Key, IV, TextCrypto, [{encrypt,false},{padding,Padding}]), + io:format("~p:~p TextDecryptPadded: ~p", + [?MODULE,?LINE, size(TextDecryptPadded)]), + element(1, split_binary(TextDecryptPadded, size(TextDecryptPadded) - PadSize)) + catch + error:{error,{"api_ng.c",Line},Msg} when ExcessBytesLastBlock>0, + Padding == none, + Msg == "Padding 'none' but unfilled last block" -> + io:format("~p:~p Correct exception: ~p", + [?MODULE,?LINE, {error,{"api_ng.c",Line},Msg}]), + correct_exception + end. + -decrypt_encrypt_init_update(Cipher, Key, IV, TextPlain) when is_binary(TextPlain) -> - decrypt_encrypt_init_update(Cipher, Key, IV, [TextPlain]); +decrypt_encrypt_init_update_final(Cipher, Key, IV, TextPlain, Padding) when is_binary(TextPlain) -> + decrypt_encrypt_init_update_final(Cipher, Key, IV, [TextPlain], Padding); -decrypt_encrypt_init_update(Cipher, Key, IV, TextPlain) -> - io:format("~p:~p Cipher: ~p, BlockSize: ~p, Key: ~p, IV: ~p, TextPlain: ~p (~p chunks)", +decrypt_encrypt_init_update_final(Cipher, Key, IV, TextPlain, Padding) -> + io:format("~p:~p Cipher: ~p, BlockSize: ~p, Key: ~p, IV: ~p, TextPlain: ~p (~p chunks), Padding: ~p", [?MODULE,?LINE, Cipher, block_size(Cipher), size(Key), size(IV), size(iolist_to_binary(TextPlain)), - num_chunks(TextPlain)]), - Cenc = crypto:crypto_init(Cipher, Key, IV, true), + num_chunks(TextPlain), Padding]), + Sblock = block_size(Cipher), + ExcessBytesLastBlock = size(iolist_to_binary(TextPlain)) rem Sblock, + + Cenc = crypto:crypto_init(Cipher, Key, IV, [{encrypt,true},{padding,Padding}]), TextOut = lists:foldl(fun(TextIn, TextOutAcc) -> [crypto:crypto_update(Cenc,TextIn) | TextOutAcc] end, [], TextPlain), - TextCrypto = lists:reverse(TextOut), - io:format("~p:~p TextCrypto: ~p", - [?MODULE,?LINE, size(iolist_to_binary(TextCrypto))]), + try + Rf = crypto:crypto_final(Cenc), + Rps = maps:get(padding_size,crypto:crypto_get_data(Cenc)), + {Rps,Rf} + of + {PadSize0,LastTextOut} -> + TextCrypto = lists:reverse([LastTextOut|TextOut]), + io:format("~p:~p PadSize0: ~p, TextCrypto: ~p", + [?MODULE,?LINE, PadSize0, size(iolist_to_binary(TextCrypto))]), + PadSize = case Padding of + pkcs_padding -> 0; + none -> 0; + undefined -> 0; + _ -> PadSize0 + end, - Cdec = crypto:crypto_init(Cipher, Key, IV, false), - TextDec = lists:foldl(fun(TextC, TextDecAcc) -> - [crypto:crypto_update(Cdec,TextC) | TextDecAcc] - end, [], TextCrypto), - iolist_to_binary(lists:reverse(TextDec)). - -full_blocks(TextPlain, Cipher) -> + Cdec = crypto:crypto_init(Cipher, Key, IV, [{encrypt,false},{padding,Padding}]), + TextDec = lists:foldl(fun(TextC, TextDecAcc) -> + [crypto:crypto_update(Cdec,TextC) | TextDecAcc] + end, [], TextCrypto), + LastDecOut = crypto:crypto_final(Cdec), + TextDecryptPadded = iolist_to_binary(lists:reverse([LastDecOut|TextDec])), + io:format("~p:~p TextDecryptPadded: ~p", + [?MODULE,?LINE, size(TextDecryptPadded)]), + element(1, split_binary(TextDecryptPadded, size(TextDecryptPadded) - PadSize)) + catch + error:{error,{"api_ng.c",Line},Msg} when ExcessBytesLastBlock>0, + Padding == none -> + io:format("~p:~p Correct exception: ~p", + [?MODULE,?LINE, {error,{"api_ng.c",Line},Msg}]), + correct_exception + end. + + +full_blocks(TextPlain, Cipher, Pad) when Pad == undefined ; Pad == none -> TextPlainBin = iolist_to_binary(TextPlain), {Head,_Tail} = split_binary(TextPlainBin, (size(TextPlainBin) - num_rest_bytes(TextPlainBin,Cipher))), - Head. + Head; +full_blocks(TextPlain, _Cipher, _) -> + iolist_to_binary(TextPlain). + num_chunks(B) when is_binary(B) -> 1; num_chunks(L) when is_list(L) -> length(L). diff --git a/lib/crypto/test/property_test/crypto_prop_generators.erl b/lib/crypto/test/property_test/crypto_prop_generators.erl index 3a7e9ecb87..0b363aab36 100644 --- a/lib/crypto/test/property_test/crypto_prop_generators.erl +++ b/lib/crypto/test/property_test/crypto_prop_generators.erl @@ -27,6 +27,7 @@ iv/1, iolist/0, mybinary/1, + padding/0, non_aead_ciphers/0, block_size/1, key_length/1, @@ -58,6 +59,9 @@ iolist() -> frequency([{5, list( oneof([list(byte()), mybinary(MaxSize) -> ?LET(Sz, integer(0,MaxSize), binary(Sz)). +padding() -> oneof([pkcs_padding, none, + zero, random, + undefined]). %%%================================================================ non_aead_ciphers() -> diff --git a/lib/crypto/test/property_test/crypto_prop_generators.hrl b/lib/crypto/test/property_test/crypto_prop_generators.hrl index 56a762e651..81e95a4d82 100644 --- a/lib/crypto/test/property_test/crypto_prop_generators.hrl +++ b/lib/crypto/test/property_test/crypto_prop_generators.hrl @@ -28,6 +28,7 @@ iv/1, iolist/0, mybinary/1, + padding/0, non_aead_ciphers/0, block_size/1, diff --git a/lib/debugger/Makefile b/lib/debugger/Makefile index 8c8b617831..3a06d72c5d 100644 --- a/lib/debugger/Makefile +++ b/lib/debugger/Makefile @@ -34,3 +34,7 @@ SPECIAL_TARGETS = # Default Subdir Targets # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk + +DIA_PLT_APPS=wx + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/debugger/doc/src/Makefile b/lib/debugger/doc/src/Makefile index 49b5a4be57..b02d35b802 100644 --- a/lib/debugger/doc/src/Makefile +++ b/lib/debugger/doc/src/Makefile @@ -30,11 +30,6 @@ VSN=$(DEBUGGER_VSN) APPLICATION=debugger # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -49,74 +44,13 @@ XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) $(XML_PART_FILES) \ $(XML_REF3_FILES) $(XML_APPLICATION_FILES) -GIF_FILES = \ - images/attach.jpg \ - images/cond_break_dialog.jpg \ - images/function_break_dialog.jpg \ - images/interpret.jpg \ - images/line_break_dialog.jpg \ - images/monitor.jpg \ - images/view.jpg - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.jpg: %.jpg - $(INSTALL_DIR) $(HTMLDIR)/images - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -debug opt: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR_DATA) $(HTMLDIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" +IMAGE_FILES = \ + attach.jpg \ + cond_break_dialog.jpg \ + function_break_dialog.jpg \ + interpret.jpg \ + line_break_dialog.jpg \ + monitor.jpg \ + view.jpg -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/debugger/doc/src/images/attach.jpg b/lib/debugger/doc/src/attach.jpg Binary files differindex 95f227d21b..95f227d21b 100644 --- a/lib/debugger/doc/src/images/attach.jpg +++ b/lib/debugger/doc/src/attach.jpg diff --git a/lib/debugger/doc/src/images/cond_break_dialog.jpg b/lib/debugger/doc/src/cond_break_dialog.jpg Binary files differindex 40bcb299a9..40bcb299a9 100644 --- a/lib/debugger/doc/src/images/cond_break_dialog.jpg +++ b/lib/debugger/doc/src/cond_break_dialog.jpg diff --git a/lib/debugger/doc/src/debugger_chapter.xml b/lib/debugger/doc/src/debugger_chapter.xml index 3c37d4b924..fc7edf07a0 100644 --- a/lib/debugger/doc/src/debugger_chapter.xml +++ b/lib/debugger/doc/src/debugger_chapter.xml @@ -153,7 +153,7 @@ <p>A line breakpoint is created at a certain line in a module.</p> - <image file="images/line_break_dialog.jpg"> + <image file="line_break_dialog.jpg"> <icaption>Line Break Dialog Window</icaption> </image> @@ -185,7 +185,7 @@ <seealso marker="int#get_binding/2"><c>int:get_binding(Variable,Bindings)</c></seealso>. The function returns <c>unbound</c> or <c>{value,Value}</c>.</p> - <image file="images/cond_break_dialog.jpg"> + <image file="cond_break_dialog.jpg"> <icaption>Conditional Break Dialog Window</icaption> </image> @@ -225,7 +225,7 @@ c_break(Bindings) -> <p>A function breakpoint is a set of line breakpoints, one at the first line of each clause in the specified function.</p> - <image file="images/function_break_dialog.jpg"> + <image file="function_break_dialog.jpg"> <icaption>Function Break Dialog Window</icaption> </image> @@ -307,7 +307,7 @@ c_break(Bindings) -> modules</p></item> </list> - <image file="images/monitor.jpg"> + <image file="monitor.jpg"> <icaption>Monitor Window</icaption> </image> @@ -593,7 +593,7 @@ c_break(Bindings) -> <pre> 4> c(module, debug_info).</pre> - <image file="images/interpret.jpg"> + <image file="interpret.jpg"> <icaption>Interpret Modules Window</icaption> </image> @@ -624,7 +624,7 @@ c_break(Bindings) -> been attached to. Notice that when attaching to a process, its execution is automatically stopped.</p> - <image file="images/attach.jpg"> + <image file="attach.jpg"> <icaption>Attach Process Window</icaption> </image> @@ -819,7 +819,7 @@ c_break(Bindings) -> <p>The View Module window displays the contents of an interpreted module and makes it possible to set breakpoints.</p> - <image file="images/view.jpg"> + <image file="view.jpg"> <icaption>View Module Window</icaption> </image> diff --git a/lib/debugger/doc/src/images/function_break_dialog.jpg b/lib/debugger/doc/src/function_break_dialog.jpg Binary files differindex db56d5a096..db56d5a096 100644 --- a/lib/debugger/doc/src/images/function_break_dialog.jpg +++ b/lib/debugger/doc/src/function_break_dialog.jpg diff --git a/lib/debugger/doc/src/images/interpret.jpg b/lib/debugger/doc/src/interpret.jpg Binary files differindex 030c06fa23..030c06fa23 100644 --- a/lib/debugger/doc/src/images/interpret.jpg +++ b/lib/debugger/doc/src/interpret.jpg diff --git a/lib/debugger/doc/src/images/line_break_dialog.jpg b/lib/debugger/doc/src/line_break_dialog.jpg Binary files differindex 18ac6a9f81..18ac6a9f81 100644 --- a/lib/debugger/doc/src/images/line_break_dialog.jpg +++ b/lib/debugger/doc/src/line_break_dialog.jpg diff --git a/lib/debugger/doc/src/images/monitor.jpg b/lib/debugger/doc/src/monitor.jpg Binary files differindex 32f210cbf2..32f210cbf2 100644 --- a/lib/debugger/doc/src/images/monitor.jpg +++ b/lib/debugger/doc/src/monitor.jpg diff --git a/lib/debugger/doc/src/images/view.jpg b/lib/debugger/doc/src/view.jpg Binary files differindex 7ffd511eff..7ffd511eff 100644 --- a/lib/debugger/doc/src/images/view.jpg +++ b/lib/debugger/doc/src/view.jpg diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index b6703d5d9e..38c2035c5c 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -693,7 +693,7 @@ expr({'try',Line,Es,CaseCs,CatchCs,[]}, Bs0, Ieval0) -> end catch Class:Reason when CatchCs =/= [] -> - catch_clauses({Class,Reason,[]}, CatchCs, Bs0, Ieval) + catch_clauses({Class,Reason,get_stacktrace()}, CatchCs, Bs0, Ieval) end; expr({'try',Line,Es,CaseCs,CatchCs,As}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, @@ -706,7 +706,7 @@ expr({'try',Line,Es,CaseCs,CatchCs,As}, Bs0, Ieval0) -> end catch Class:Reason when CatchCs =/= [] -> - catch_clauses({Class,Reason,[]}, CatchCs, Bs0, Ieval) + catch_clauses({Class,Reason,get_stacktrace()}, CatchCs, Bs0, Ieval) after seq(As, Bs0, Ieval#ieval{top=false}) end; @@ -905,14 +905,9 @@ expr({dbg,Line,self,[]}, Bs, #ieval{level=Le}) -> Self = get(self), trace(return, {Le,Self}), {value,Self,Bs}; -expr({dbg,Line,get_stacktrace,[]}, Bs, #ieval{level=Le}) -> - trace(bif, {Le,Line,erlang,get_stacktrace,[]}), - Stacktrace = get_stacktrace(), - trace(return, {Le,Stacktrace}), - {value,Stacktrace,Bs}; expr({dbg,Line,raise,As0}, Bs0, #ieval{level=Le}=Ieval0) -> - %% Since erlang:get_stacktrace/0 is emulated, we will - %% need to emulate erlang:raise/3 too so that we can + %% Since stacktraces are emulated, we will + %% need to emulate erlang:raise/3 so that we can %% capture the stacktrace. Ieval = Ieval0#ieval{line=Line}, {[Class,Reason,Stk0]=As,Bs} = eval_list(As0, Bs0, Ieval), @@ -1383,7 +1378,7 @@ catch_clauses(Exception, [{clause,_,[P],G,B}|CatchCs], Bs0, Ieval) -> nomatch -> catch_clauses(Exception, CatchCs, Bs0, Ieval) end; -catch_clauses({Class,Reason,[]}, [], _Bs, _Ieval) -> +catch_clauses({Class,Reason,_}, [], _Bs, _Ieval) -> erlang:Class(Reason). receive_clauses(Cs, Bs0, [Msg|Msgs]) -> @@ -1592,12 +1587,17 @@ match_tuple([], _, _, Bs, _BBs) -> {match,Bs}. match_map([{map_field_exact,_,K0,Pat}|Fs], Map, Bs0, BBs) -> - {value,K,BBs} = expr(K0, BBs, #ieval{}), - case maps:find(K, Map) of - {ok,Value} -> - {match,Bs} = match1(Pat, Value, Bs0, BBs), - match_map(Fs, Map, Bs, BBs); - error -> throw(nomatch) + try guard_expr(K0, BBs) of + {value,K} -> + case Map of + #{K := Value} -> + {match,Bs} = match1(Pat, Value, Bs0, BBs), + match_map(Fs, Map, Bs, BBs); + #{} -> + throw(nomatch) + end + catch _:_ -> + throw(nomatch) end; match_map([], _, Bs, _BBs) -> {match,Bs}. diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index 468f6a809f..d15292d51d 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -204,7 +204,7 @@ pattern({tuple,Anno,Ps0}) -> {tuple,ln(Anno),Ps1}; pattern({map,Anno,Fs0}) -> Fs1 = lists:map(fun ({map_field_exact,L,K,V}) -> - {map_field_exact,L,expr(K, false),pattern(V)} + {map_field_exact,L,gexpr(K),pattern(V)} end, Fs0), {map,ln(Anno),Fs1}; pattern({op,_,'-',{integer,Anno,I}}) -> @@ -226,7 +226,7 @@ pattern({bin_element,Anno,Expr0,Size0,Type0}) -> {Size1,Type} = make_bit_type(Anno, Size0, Type0), Expr1 = pattern(Expr0), Expr = coerce_to_float(Expr1, Type0), - Size = pattern(Size1), + Size = expr(Size1, false), {bin_element,ln(Anno),Expr,Size,Type}; %% Evaluate compile-time expressions. pattern({op,_,'++',{nil,_},R}) -> @@ -438,8 +438,6 @@ expr({'fun',Anno,{function,M,F,A}}, _Lc) -> {make_ext_fun,ln(Anno),MFA}; expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,self}},[]}, _Lc) -> {dbg,ln(Anno),self,[]}; -expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,get_stacktrace}},[]}, _Lc) -> - {dbg,ln(Anno),get_stacktrace,[]}; expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,throw}},[_]=As}, _Lc) -> {dbg,ln(Anno),throw,expr_list(As)}; expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,error}},[_]=As}, _Lc) -> diff --git a/lib/debugger/test/Makefile b/lib/debugger/test/Makefile index efb6d9ed8b..0f942923f3 100644 --- a/lib/debugger/test/Makefile +++ b/lib/debugger/test/Makefile @@ -32,6 +32,7 @@ MODULES= \ bs_match_int_SUITE \ bs_match_misc_SUITE \ bs_match_tail_SUITE \ + bs_size_expr_SUITE \ bs_utf_SUITE \ bug_SUITE \ erl_eval_SUITE \ diff --git a/lib/debugger/test/bs_size_expr_SUITE.erl b/lib/debugger/test/bs_size_expr_SUITE.erl new file mode 100644 index 0000000000..864233f282 --- /dev/null +++ b/lib/debugger/test/bs_size_expr_SUITE.erl @@ -0,0 +1,273 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(bs_size_expr_SUITE). +-compile(nowarn_shadow_vars). + +-export([all/0,suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, + basic/1,size_shadow/1,complex/1, + recv/1,no_match/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. + +all() -> + [{group,p}]. + +groups() -> + [{p,[], + [basic, + size_shadow, + complex, + recv, + no_match]}]. + +init_per_suite(Config) -> + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + test_lib:interpret(?MODULE), + Config. + +end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + ok. + +basic(_Config) -> + <<>> = do_basic(<<1:32>>), + <<"abcd">> = do_basic(<<2:32,"abcd">>), + no_match = do_basic(<<0:32>>), + no_match = do_basic(<<777:32>>), + ok. + +do_basic(Bin) -> + Res = do_basic_1(Bin), + + Res = do_basic_2({tag,Bin}), + Res = do_basic_2([list,Bin]), + 6 = do_basic_2({2,4}), + + Res = do_basic_3(Bin), + Res = do_basic_4(Bin), + + {result,Res} = do_basic_5(Bin), + case Res of + no_match -> + ok; + _ -> + {result,{Res,7777777}} = do_basic_5(<<Bin/binary,7777777:32>>) + end, + + Res. + +do_basic_1(<<Sz:32,Tail:(4*Sz-4)/binary>>) -> + Tail; +do_basic_1(<<_/binary>>) -> + no_match. + +do_basic_2({tag,<<Sz:32,Tail:(4*Sz-4)/binary>>}) -> + Tail; +do_basic_2([list,<<Sz:32,Tail:((Sz-1)*4)/binary>>]) -> + Tail; +do_basic_2({A,B}) when is_integer(A), is_integer(B) -> + A + B; +do_basic_2(_) -> + no_match. + +do_basic_3(Bin) -> + WordSize = id(4), + case Bin of + <<Sz:32,Tail:(WordSize*Sz-WordSize)/binary>> -> + Tail; + _ -> + no_match + end. + +do_basic_4(Bin) -> + WordSize = id(4), + F = fun() -> + case Bin of + <<Sz:32,Tail:(WordSize*Sz-WordSize)/binary>> -> + Tail; + _ -> + no_match + end + end, + F(). + +do_basic_5(Bin) -> + WordSize = id(4), + F = fun() -> + Res = case Bin of + <<Sz:32,Tail:(WordSize*Sz-WordSize)/binary,More:(8*WordSize)>> -> + {Tail,More}; + <<Sz:32,Tail:(WordSize*Sz-WordSize)/binary>> -> + Tail; + _ -> + no_match + end, + {result,Res} + end, + F(). + +size_shadow(_Config) -> + 12345678 = size_shadow_1(), + ok. + +size_shadow_1() -> + L = 8, + Offset = 16, + Fs = [fun(<<L:L,B:(L+16)>>) -> B end, + fun(<<L:L,B:(L+Offset)>>) -> B end, + fun(A) -> + Res = (fun([<<L:L,B:(L+16)>>]) -> B end)([A]), + Res = (fun([<<L:L,B:(L+Offset)>>]) -> B end)([A]) + end, + fun(A) -> + Res = (fun({<<L:L,B:(L+16)>>,<<L:L,B:(L+16)>>}) -> B end)({A,A}), + Res = (fun({<<L:L,B:(L+Offset)>>,<<L:L,B:(L+16)>>}) -> B end)({A,A}), + Res = (fun({<<L:L,B:(L+16)>>,<<L:L,B:(L+Offset)>>}) -> B end)({A,A}), + Res = (fun({<<L:L,B:(L+Offset)>>,<<L:L,B:(L+Offset)>>}) -> B end)({A,A}) + end, + fun(A) -> + <<Size:L,_/bits>> = A, + Inner = fun([L], {#{key1 := <<L:L,B:(L+Offset)>>, + key2 := <<L:L,B:(L+Offset)>>}, L}) -> B end, + Inner([Size], {#{key1 => A,key2 => A},Size}) + end], + size_shadow_apply(Fs, <<16:8, 12345678:32>>). + +size_shadow_apply([F|Fs], Arg) when is_function(F, 1) -> + size_shadow_apply(Fs, Arg, F(Arg)). + +size_shadow_apply([F|Fs], Arg, Res) when is_function(F, 1) -> + Res = F(Arg), + size_shadow_apply(Fs, Arg, Res); +size_shadow_apply([], _, Res) -> + Res. + +-record(r, {a,b,c}). +complex(Config) -> + (fun() -> + Len = length(id(Config)), + Bin = << <<I:13>> || I <- lists:seq(1, Len) >>, + <<Bin:(length(Config))/binary-unit:13>> = Bin + end)(), + + (fun() -> + V = id([a,b,c]), + F = fun(<<V:(bit_size(<<0:(length(V))>>)*8)/signed-integer>>) -> + V; + ({A,B}) -> + A + B + end, + -1 = F(<<-1:(length(V)*8)>>), + 7 = F({3,4}) + end)(), + + (fun() -> + A = a, + B = b, + F = fun(<<A:16,B:16,C:(A+B),D/bits>>) -> + {A,B,C,D}; + (<<A:16,B:16>>) -> + {A,B}; + (<<A:8,B:8>>) -> + {A,B} + end, + {13,21,16#cafebeef,<<"more">>} = F(<<13:16,21:16,16#cafebeef:34,"more">>), + {100,500} = F(<<100:16,500:16>>), + {157,77} = F(<<157:8,77:8>>), + {A,B} + end)(), + + (fun() -> + Two = id(2), + F = fun(a, <<_:(#r.a - Two)/binary,Int:8,_/binary>>) -> Int; + (b, <<_:(#r.b - Two)/binary,Int:8,_/binary>>) -> Int; + (c, <<_:(#r.c - Two)/binary,Int:8,_/binary>>) -> Int + end, + 1 = F(a, <<1,2,3>>), + 2 = F(b, <<1,2,3>>), + 3 = F(c, <<1,2,3>>) + end)(), + + (fun() -> + Bin = <<1,2,3,4>>, + F = fun(R) -> + <<First:(R#r.a)/binary,Tail/binary>> = Bin, + {First,Tail} + end, + {<<>>,<<1,2,3,4>>} = F(#r{a=0}), + {<<1>>,<<2,3,4>>} = F(#r{a=1}), + {<<1,2>>,<<3,4>>} = F(#r{a=2}), + {<<1,2,3>>,<<4>>} = F(#r{a=3}), + {<<1,2,3,4>>,<<>>} = F(#r{a=4}) + end)(), + + ok. + +recv(_Config) -> + R = fun(Msg) -> + self() ! Msg, + Res = receive + <<L,I:(L-1)/unit:8,X:32>> -> {I,X}; + <<L,I:(L-1)/unit:8,X:64>> -> {I,X} + end, + self() ! {tag,[Msg]}, + Res = receive + {tag,[<<L,I:(8*(L-1)),X:32>>]} -> {I,X}; + {tag,[<<L,I:(8*(L-1)),X:64>>]} -> {I,X} + end + end, + {1234,16#deadbeef} = R(<<3,1234:16,16#deadbeef:32>>), + {99,16#cafebeeff00d} = R(<<2,99:8,16#cafebeeff00d:64>>), + ok. + +no_match(_Config) -> + B = id(<<1,2,3,4>>), + no_match = case B of + <<Int:(bit_size(B)-1)>> -> Int; + <<Int:(bit_size(B)*2)>> -> Int; + <<Int:(length(B))>> -> Int; + _ -> no_match + end, + no_match = case B of + <<L:8,Int2:(is_integer(L))>> -> Int2; + <<L:8,Int2:(L+3.0)>> -> Int2; + _ -> no_match + end, + ok. + +id(I) -> + I. diff --git a/lib/debugger/test/exception_SUITE.erl b/lib/debugger/test/exception_SUITE.erl index ef824b00be..506d4d0366 100644 --- a/lib/debugger/test/exception_SUITE.erl +++ b/lib/debugger/test/exception_SUITE.erl @@ -275,67 +275,43 @@ ba_bnot(A) -> {'EXIT', {badarith, _}} = (catch bnot A). stacktrace(Conf) when is_list(Conf) -> - Tag = make_ref(), - {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), - {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, V = [make_ref()|self()], {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} = stacktrace_1({'abs',V}, error, {value,V}), - St1 = erase(stacktrace1), - St1 = erase(stacktrace2), - St1 = erlang:get_stacktrace(), {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} = stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), - [{?MODULE,my_div,2,_}|_] = erase(stacktrace1), - St2 = erase(stacktrace2), - St2 = erlang:get_stacktrace(), {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} = stacktrace_1({value,V}, error, {value,V}), - St3 = erase(stacktrace1), - St3 = erase(stacktrace2), - St3 = erlang:get_stacktrace(), {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} = stacktrace_1({value,V}, error, {throw,V}), - [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1), - St4 = erase(stacktrace2), - St4 = erlang:get_stacktrace(), ok. stacktrace_1(X, C1, Y) -> - erase(stacktrace1), - erase(stacktrace2), try try foo(X) of C1 -> value1 catch - C1:D1 -> {caught1,D1,erlang:get_stacktrace()} + C1:D1:S1 -> {caught1,D1,S1} after - put(stacktrace1, erlang:get_stacktrace()), foo(Y) end of V2 -> {value2,V2} catch - C2:D2 -> {caught2,{C2,D2},erlang:get_stacktrace()} - after - put(stacktrace2, erlang:get_stacktrace()) + C2:D2:S2 -> {caught2,{C2,D2},S2} end. nested_stacktrace(Conf) when is_list(Conf) -> V = [{make_ref()}|[self()]], - value1 = - nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, - {void,void,void}), + value1 = nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, + {void,void,void}), {caught1, [{?MODULE,my_add,2,_}|_], - value2, - [{?MODULE,my_add,2,_}|_]} = - nested_stacktrace_1({{'add',{V,x1}},error,badarith}, - {{value,{V,x2}},void,{V,x2}}), + value2} = nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{value,{V,x2}},void,{V,x2}}), {caught1, [{?MODULE,my_add,2,_}|_], - {caught2,[{erlang,abs,[V],_}|_]}, - [{erlang,abs,[V],_}|_]} = + {caught2,[{erlang,abs,[V],_}|_]}} = nested_stacktrace_1({{'add',{V,x1}},error,badarith}, {{'abs',V},error,badarg}), ok. @@ -344,15 +320,13 @@ nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> try foo(X1) of V1 -> value1 catch - C1:V1 -> - S1 = erlang:get_stacktrace(), - T2 = - try foo(X2) of - V2 -> value2 - catch - C2:V2 -> {caught2,erlang:get_stacktrace()} + C1:V1:S1 -> + T2 = try foo(X2) of + V2 -> value2 + catch + C2:V2:S2 -> {caught2,S2} end, - {caught1,S1,T2,erlang:get_stacktrace()} + {caught1,S1,T2} end. @@ -363,17 +337,14 @@ raise(Conf) when is_list(Conf) -> try try foo({'div',{1,0}}) catch - error:badarith -> - put(raise, A0 = erlang:get_stacktrace()), + error:badarith:A0 -> + put(raise, A0), erlang:raise(error, badarith, A0) end catch - error:badarith -> - A1 = erlang:get_stacktrace(), + error:badarith:A1 -> A1 = get(raise) end, - A = erlang:get_stacktrace(), - A = get(raise), [{?MODULE,my_div,2,_}|_] = A, %% N = 8, % Must be even @@ -381,19 +352,18 @@ raise(Conf) when is_list(Conf) -> try even(N) catch error:function_clause -> ok end, - B = odd_even(N, []), - B = erlang:get_stacktrace(), %% - C0 = odd_even(N+1, []), - C = lists:sublist(C0, N), - try odd(N+1) - catch error:function_clause -> ok + C = odd_even(N+1, []), + try + odd(N+1) + catch + error:function_clause -> ok end, - C = erlang:get_stacktrace(), - try erlang:raise(error, function_clause, C0) - catch error:function_clause -> ok + try + erlang:raise(error, function_clause, C) + catch + error:function_clause -> ok end, - C = erlang:get_stacktrace(), ok. odd_even(N, R) when is_integer(N), N > 1 -> @@ -436,7 +406,6 @@ my_abs(X) -> abs(X). gunilla(Config) when is_list(Config) -> {throw,kalle} = gunilla_1(), - [] = erlang:get_stacktrace(), ok. gunilla_1() -> diff --git a/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl b/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl index 3380178fdc..591841ada3 100644 --- a/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl +++ b/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl @@ -3,10 +3,15 @@ ?MODULE() -> OldDepth = erlang:system_flag(backtrace_depth, 32), - done = (catch do_try()), - Stk = trim(erlang:get_stacktrace()), - erlang:system_flag(backtrace_depth, OldDepth), - {done,Stk}. + try + do_try() + catch + throw:done:Stk0 -> + Stk = trim(Stk0), + {done,Stk} + after + erlang:system_flag(backtrace_depth, OldDepth) + end. trim([{int_eval_SUITE,_,_,_}|_]) -> []; diff --git a/lib/debugger/test/line_number_SUITE.erl b/lib/debugger/test/line_number_SUITE.erl index 276473b95f..4ad84b5a3b 100644 --- a/lib/debugger/test/line_number_SUITE.erl +++ b/lib/debugger/test/line_number_SUITE.erl @@ -90,8 +90,8 @@ close_calls(Where) -> %Line 86 call2(), %Line 90 call3(), %Line 91 no_crash %Line 92 - catch error:crash -> - erlang:get_stacktrace() %Line 94 + catch error:crash:Stk -> + Stk %Line 94 end. %Line 95 call1() -> %Line 97 diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl index 4d8a86f5a2..7c4ded5082 100644 --- a/lib/debugger/test/map_SUITE.erl +++ b/lib/debugger/test/map_SUITE.erl @@ -88,7 +88,10 @@ %% misc t_pdict/1, - t_ets/1 + t_ets/1, + + %% new in OTP 23 + t_key_expressions/1 ]). -include_lib("stdlib/include/ms_transform.hrl"). @@ -150,7 +153,10 @@ all() -> [ %% Other functions t_pdict, - t_ets + t_ets, + + %% new in OTP 23 + t_key_expressions ]. groups() -> []. @@ -2233,6 +2239,48 @@ validate_frequency([{T,C}|Fs],Tf) -> end; validate_frequency([], _) -> ok. +t_key_expressions(_Config) -> + Int = id(42), + #{{tag,Int} := 42} = id(#{{tag,Int} => 42}), + #{{tag,Int+1} := 42} = id(#{{tag,Int+1} => 42}), + #{{a,b} := x, {tag,Int} := 42, Int := 0} = + id(#{{a,b} => x, {tag,Int} => 42, Int => 0}), + + F1 = fun(#{Int + 1 := Val}) -> Val end, + val = F1(#{43 => val}), + {'EXIT',_} = (catch F1(a)), + + F2 = fun(M, X, Y) -> + case M of + #{element(X, Y) := <<Sz:16,Bin:Sz/binary>>} -> + Bin; + #{} -> + not_found; + {A,B} -> + A + B + end + end, + <<"xyz">> = F2(#{b => <<3:16,"xyz">>}, 2, {a,b,c}), + not_found = F2(#{b => <<3:16,"xyz">>}, 999, {a,b,c}), + 13 = F2({6,7}, 1, 2), + + #{<<"Спутник"/utf8>> := 1} = id(#{<<"Спутник"/utf8>> => 1}), + + F3 = fun(Arg) -> + erase(once), + RunOnce = fun(I) -> + undefined = put(once, twice), + id(I) + end, + case RunOnce(Arg) of + #{{tag,<<Int:42>>} := Value} -> Value; + {X,Y} -> X + Y + end + end, + 10 = F3({7,3}), + whatever = F3(#{{tag,<<Int:42>>} => whatever}), + + ok. %% aux diff --git a/lib/dialyzer/Makefile b/lib/dialyzer/Makefile index e4f681dcd9..53083f267d 100644 --- a/lib/dialyzer/Makefile +++ b/lib/dialyzer/Makefile @@ -42,3 +42,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=compiler syntax_tools hipe wx + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/dialyzer/doc/src/Makefile b/lib/dialyzer/doc/src/Makefile index 3ce777392b..bcceb3b661 100644 --- a/lib/dialyzer/doc/src/Makefile +++ b/lib/dialyzer/doc/src/Makefile @@ -26,15 +26,11 @@ VSN=$(DIALYZER_VSN) APPLICATION=dialyzer # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = dialyzer.xml typer.xml +XML_REF3_FILES = dialyzer.xml +XML_REF1_FILES = typer_cmd.xml XML_PART_FILES = part.xml XML_CHAPTER_FILES = dialyzer_chapter.xml notes.xml @@ -43,72 +39,10 @@ BOOK_FILES = book.xml XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ - $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) - - -# ---------------------------------------------------- - -TEXT_FILES = \ - ../about.txt \ - ../manual.txt \ - ../warnings.txt + $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF1_FILES) \ + $(XML_APPLICATION_FILES) -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += # ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/dialyzer/doc/src/ref_man.xml b/lib/dialyzer/doc/src/ref_man.xml index d8cf324232..74455143b1 100644 --- a/lib/dialyzer/doc/src/ref_man.xml +++ b/lib/dialyzer/doc/src/ref_man.xml @@ -31,6 +31,5 @@ <description> </description> <xi:include href="dialyzer.xml"/> - <xi:include href="typer.xml"/> + <xi:include href="typer_cmd.xml"/> </application> - diff --git a/lib/dialyzer/doc/src/typer.xml b/lib/dialyzer/doc/src/typer_cmd.xml index 524956ed4b..b9e75bdd2a 100644 --- a/lib/dialyzer/doc/src/typer.xml +++ b/lib/dialyzer/doc/src/typer_cmd.xml @@ -1,7 +1,7 @@ <?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> +<!DOCTYPE comref SYSTEM "comref.dtd"> -<erlref> +<comref> <header> <copyright> <year>2006</year><year>2017</year> @@ -29,9 +29,9 @@ <rev></rev> <file>type.xml</file> </header> - <module>typer</module> - <modulesummary>Typer, a Type annotator for ERlang programs. - </modulesummary> + <com>typer</com> + <comsummary>Typer, a Type annotator for ERlang programs. + </comsummary> <description> <p>TypEr shows type information for Erlang modules to the user. Additionally, it can annotate the code of files with such type @@ -154,4 +154,4 @@ typer [--help] [--version] [--plt PLT] [--edoc] </section> -</erlref> +</comref> diff --git a/lib/dialyzer/src/Makefile b/lib/dialyzer/src/Makefile index bddd761705..1f5b308c7d 100644 --- a/lib/dialyzer/src/Makefile +++ b/lib/dialyzer/src/Makefile @@ -53,6 +53,7 @@ MODULES = \ dialyzer_callgraph \ dialyzer_cl \ dialyzer_cl_parse \ + dialyzer_clean_core \ dialyzer_codeserver \ dialyzer_contracts \ dialyzer_dataflow \ diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index e3a0fc967d..36f5d96ea6 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -28,6 +28,7 @@ dialyzer_callgraph, dialyzer_cl, dialyzer_cl_parse, + dialyzer_clean_core, dialyzer_codeserver, dialyzer_contracts, dialyzer_coordinator, diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 5e680062fb..f887f661bd 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -320,6 +320,12 @@ report_analysis_start(#options{analysis_type = Type, end end. +report_native_comp(#options{report_mode = ReportMode}) -> + case ReportMode of + quiet -> ok; + _ -> io:format(" Compiling some key modules to native code...") + end. + report_elapsed_time(T1, T2, #options{report_mode = ReportMode}) -> case ReportMode of quiet -> ok; @@ -369,6 +375,7 @@ do_analysis(Options) -> do_analysis(Files, Options, Plt, PltInfo) -> assert_writable(Options#options.output_plt), + hipe_compile(Files, Options), report_analysis_start(Options), State0 = new_state(), State1 = init_output(State0, Options), @@ -477,6 +484,106 @@ expand_dependent_modules_1([Mod|Mods], Included, ModDeps) -> expand_dependent_modules_1([], Included, _ModDeps) -> Included. +-define(MIN_PARALLELISM, 7). +-define(MIN_FILES_FOR_NATIVE_COMPILE, 20). + +-spec hipe_compile([file:filename()], #options{}) -> 'ok'. + +hipe_compile(Files, #options{erlang_mode = ErlangMode} = Options) -> + NoNative = (get(dialyzer_options_native) =:= false), + FewFiles = (length(Files) < ?MIN_FILES_FOR_NATIVE_COMPILE), + case NoNative orelse FewFiles orelse ErlangMode of + true -> ok; + false -> + case erlang:system_info(hipe_architecture) of + undefined -> ok; + _ -> + Mods = [lists, dict, digraph, digraph_utils, ets, + gb_sets, gb_trees, ordsets, sets, sofs, + cerl, erl_types, cerl_trees, erl_bif_types, + dialyzer_analysis_callgraph, dialyzer, dialyzer_behaviours, + dialyzer_codeserver, dialyzer_contracts, + dialyzer_coordinator, dialyzer_dataflow, dialyzer_dep, + dialyzer_plt, dialyzer_succ_typings, dialyzer_typesig, + dialyzer_worker], + report_native_comp(Options), + {T1, _} = statistics(wall_clock), + Cache = (get(dialyzer_options_native_cache) =/= false), + native_compile(Mods, Cache), + {T2, _} = statistics(wall_clock), + report_elapsed_time(T1, T2, Options) + end + end. + +native_compile(Mods, Cache) -> + case dialyzer_utils:parallelism() > ?MIN_PARALLELISM of + true -> + Parent = self(), + Pids = [spawn(fun () -> Parent ! {self(), hc(M, Cache)} end) || M <- Mods], + lists:foreach(fun (Pid) -> receive {Pid, Res} -> Res end end, Pids); + false -> + lists:foreach(fun (Mod) -> hc(Mod, Cache) end, Mods) + end. + +hc(Mod, Cache) -> + {module, Mod} = code:ensure_loaded(Mod), + case code:is_module_native(Mod) of + true -> ok; + false -> + %% io:format(" ~w", [Mod]), + case Cache of + false -> + {ok, Mod} = hipe:c(Mod), + ok; + true -> + hc_cache(Mod) + end + end. + +hc_cache(Mod) -> + CacheBase = cache_base_dir(), + %% Use HiPE architecture, version and erts checksum in directory name, + %% to avoid clashes between incompatible binaries. + HipeArchVersion = + lists:concat( + [erlang:system_info(hipe_architecture), "-", + hipe:version(), "-", + hipe:erts_checksum()]), + CacheDir = filename:join(CacheBase, HipeArchVersion), + OrigBeamFile = code:which(Mod), + {ok, {Mod, <<Checksum:128>>}} = beam_lib:md5(OrigBeamFile), + CachedBeamFile = filename:join(CacheDir, lists:concat([Mod, "-", Checksum, ".beam"])), + ok = filelib:ensure_dir(CachedBeamFile), + ModBin = + case filelib:is_file(CachedBeamFile) of + true -> + {ok, BinFromFile} = file:read_file(CachedBeamFile), + BinFromFile; + false -> + {ok, Mod, CompiledBin} = compile:file(OrigBeamFile, [from_beam, native, binary]), + ok = file:write_file(CachedBeamFile, CompiledBin), + CompiledBin + end, + code:unstick_dir(filename:dirname(OrigBeamFile)), + {module, Mod} = code:load_binary(Mod, CachedBeamFile, ModBin), + true = code:is_module_native(Mod), + ok. + +cache_base_dir() -> + %% http://standards.freedesktop.org/basedir-spec/basedir-spec-0.7.html + %% If XDG_CACHE_HOME is set to an absolute path, use it as base. + XdgCacheHome = os:getenv("XDG_CACHE_HOME"), + CacheHome = + case is_list(XdgCacheHome) andalso filename:pathtype(XdgCacheHome) =:= absolute of + true -> + XdgCacheHome; + false -> + %% Otherwise, the default is $HOME/.cache. + {ok, [[Home]]} = init:get_argument(home), + filename:join(Home, ".cache") + end, + filename:join([CacheHome, "dialyzer_hipe_cache"]). + new_state() -> #cl_state{}. diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl index cadc2116b0..a3ec1b92f1 100644 --- a/lib/dialyzer/src/dialyzer_cl_parse.erl +++ b/lib/dialyzer/src/dialyzer_cl_parse.erl @@ -330,12 +330,16 @@ get_lib_dir(Apps) -> get_lib_dir([H|T], Acc) -> NewElem = case code:lib_dir(list_to_atom(H)) of - {error, bad_name} -> - case H =:= "erts" of % hack for including erts in an un-installed system - true -> filename:join(code:root_dir(), "erts/preloaded/ebin"); - false -> H - end; - LibDir -> LibDir ++ "/ebin" + {error, bad_name} -> H; + LibDir when H =:= "erts" -> % hack for including erts in an un-installed system + EbinDir = filename:join([LibDir,"ebin"]), + case file:read_file_info(EbinDir) of + {error,enoent} -> + filename:join([LibDir,"preloaded","ebin"]); + _ -> + EbinDir + end; + LibDir -> filename:join(LibDir,"ebin") end, get_lib_dir(T, [NewElem|Acc]); get_lib_dir([], Acc) -> diff --git a/lib/dialyzer/src/dialyzer_clean_core.erl b/lib/dialyzer/src/dialyzer_clean_core.erl new file mode 100644 index 0000000000..d591ad3473 --- /dev/null +++ b/lib/dialyzer/src/dialyzer_clean_core.erl @@ -0,0 +1,225 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +-module(dialyzer_clean_core). +-export([clean/1]). + +-spec clean(cerl:cerl()) -> cerl:cerl(). + +clean(Tree) -> + case cerl:type(Tree) of + apply -> + Op = clean(cerl:apply_op(Tree)), + Args = clean_list(cerl:apply_args(Tree)), + cerl:update_c_apply(Tree, Op, Args); + binary -> + Segments = clean_list(cerl:binary_segments(Tree)), + cerl:update_c_binary(Tree, Segments); + bitstr -> + Val = clean(cerl:bitstr_val(Tree)), + Size = clean(cerl:bitstr_size(Tree)), + Unit = cerl:bitstr_unit(Tree), + Type = cerl:bitstr_type(Tree), + Flags = cerl:bitstr_flags(Tree), + cerl:update_c_bitstr(Tree, Val, Size, Unit, Type, Flags); + 'case' -> + Arg = clean(cerl:case_arg(Tree)), + Clauses = clean_clauses(cerl:case_clauses(Tree)), + cerl:update_c_case(Tree, Arg, Clauses); + call -> + Args = clean_list(cerl:call_args(Tree)), + Module = clean(cerl:call_module(Tree)), + Name = clean(cerl:call_name(Tree)), + cerl:update_c_call(Tree, Module, Name, Args); + 'catch' -> + Body = clean(cerl:catch_body(Tree)), + cerl:update_c_catch(Tree, Body); + cons -> + Hd = clean(cerl:cons_hd(Tree)), + Tl = clean(cerl:cons_tl(Tree)), + cerl:update_c_cons_skel(Tree, Hd, Tl); + 'fun' -> + Body = clean(cerl:fun_body(Tree)), + Vars = cerl:fun_vars(Tree), + cerl:update_c_fun(Tree, Vars, Body); + 'let' -> + Arg = clean(cerl:let_arg(Tree)), + Body = clean(cerl:let_body(Tree)), + Vars = cerl:let_vars(Tree), + cerl:update_c_let(Tree, Vars, Arg, Body); + letrec -> + clean_letrec(Tree); + literal -> + Tree; + module -> + Defs = clean_defs(cerl:module_defs(Tree)), + Name = cerl:module_name(Tree), + Exports = cerl:module_exports(Tree), + Attrs = cerl:module_attrs(Tree), + cerl:update_c_module(Tree, Name, Exports, Attrs, Defs); + primop -> + Args = clean_list(cerl:primop_args(Tree)), + Name = cerl:primop_name(Tree), + cerl:update_c_primop(Tree, Name, Args); + 'receive' -> + Clauses = clean_clauses(cerl:receive_clauses(Tree)), + Timeout = clean(cerl:receive_timeout(Tree)), + Action = clean(cerl:receive_action(Tree)), + cerl:update_c_receive(Tree, Clauses, Timeout, Action); + seq -> + Arg = clean(cerl:seq_arg(Tree)), + Body = clean(cerl:seq_body(Tree)), + cerl:update_c_seq(Tree, Arg, Body); + 'try' -> + Arg = clean(cerl:try_arg(Tree)), + Body = clean(cerl:try_body(Tree)), + Handler = clean(cerl:try_handler(Tree)), + Vs = cerl:try_vars(Tree), + Evs = cerl:try_evars(Tree), + Try = cerl:update_c_try(Tree, Arg, Vs, Body, Evs, Handler), + Try; + tuple -> + Elements = clean_list(cerl:tuple_es(Tree)), + cerl:update_c_tuple_skel(Tree, Elements); + map -> + Arg = clean(cerl:map_arg(Tree)), + Entries = clean_map_pairs(cerl:map_es(Tree)), + cerl:update_c_map(Tree, Arg, Entries); + values -> + Elements = clean_list(cerl:values_es(Tree)), + cerl:update_c_values(Tree, Elements); + var -> + Tree + end. + +clean_letrec(Tree) -> + case lists:member(letrec_goto, cerl:get_ann(Tree)) of + true -> + %% This is a restricted form of letrec used to allow rewriting + %% pattern matching without duplicating code. When a letrec is + %% used in this way, Dialyzer will not be able to infer much + %% type information, so we will need to eliminate the letrec. + [{_Name, Fun}] = cerl:letrec_defs(Tree), + FunBody = cerl:fun_body(Fun), + FunBody1 = clean(FunBody), + Body = clean(cerl:letrec_body(Tree)), + case dialyzer_ignore(Body) of + true -> + %% The body of the letrec directly transfer controls to + %% defined function in the letrec. We only need to keep + %% the body of that function. (This is is the code for + %% a receive construct.) + FunBody1; + false -> + %% The body is non-trivial. Here is an example: + %% + %% letrec 'more_matching'/0 = + %% fun () -> + %% case CaseExpr of . . . end + %% end + %% in case CaseExpr of + %% <<..., Tail>> -> + %% case Tail of + %% <<...>> -> . . . + %% _ -> apply 'more_matching'/0() + %% end + %% _ -> apply 'more_matching'/0() + %% end + %% + %% The clauses that invoke `apply` are marked with + %% a `dialyzer_ignore` annotation to indicate that + %% Dialyzer should ignore them. + %% + %% The example is translated like this: + %% + %% case primop:dialyzer_unknown() of + %% 'a' -> + %% case Var of + %% <<..., Tail>> -> + %% case Tail of + %% <<...>> -> . . . + %% end + %% end + %% 'b' -> + %% %% Body of more_matching/0. + %% case Var of . . . end + %% end + %% + PrimopUnknown = cerl:c_primop(cerl:abstract(dialyzer_unknown), []), + Clauses = [cerl:c_clause([cerl:abstract(a)], Body), + cerl:c_clause([cerl:abstract(b)], FunBody1)], + cerl:c_case(PrimopUnknown, Clauses) + end; + false -> + %% This is a plain letrec. (Originating from a list or binary comprehension.) + Defs = clean_defs(cerl:letrec_defs(Tree)), + Body = clean(cerl:letrec_body(Tree)), + cerl:update_c_letrec(Tree, Defs, Body) + end. + +clean_defs(Defs) -> + [{Name, clean(Fun)} || {Name, Fun} <- Defs]. + +clean_clauses([Clause|Tail]) -> + case clean_clause(Clause) of + ignore -> + %% The clause is either annotated with `dialyzer_ignore` or its + %% body is primop that raises an exception. + clean_clauses(Tail); + Clause1 -> + Tail1 = clean_clauses(Tail), + [Clause1|Tail1] + end; +clean_clauses([]) -> + []. + +clean_clause(Clause) -> + Body = cerl:clause_body(Clause), + case dialyzer_ignore(Clause) orelse is_raising_body(Body) of + true -> + ignore; + false -> + G = clean(cerl:clause_guard(Clause)), + Body1 = clean(Body), + Pats = cerl:clause_pats(Clause), + cerl:update_c_clause(Clause, Pats, G, Body1) + end. + +is_raising_body(Body) -> + case cerl:type(Body) of + primop -> + case cerl:atom_val(cerl:primop_name(Body)) of + match_fail -> true; + raise -> true; + _ -> false + end; + _ -> + false + end. + +clean_list(Trees) -> + [clean(Tree) || Tree <- Trees]. + +clean_map_pairs([Pair|Pairs]) -> + Key = clean(cerl:map_pair_key(Pair)), + Val = clean(cerl:map_pair_val(Pair)), + Pairs1 = clean_map_pairs(Pairs), + Op = cerl:map_pair_op(Pair), + Pair1 = cerl:update_c_map_pair(Pair, Op, Key, Val), + [Pair1|Pairs1]; +clean_map_pairs([]) -> + []. + +dialyzer_ignore(Tree) -> + lists:member(dialyzer_ignore, cerl:get_ann(Tree)). diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 55c77814f8..cff3981393 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -298,15 +298,36 @@ traverse(Tree, Map, State) -> module -> handle_module(Tree, Map, State); primop -> - Type = - case cerl:atom_val(cerl:primop_name(Tree)) of - match_fail -> t_none(); - raise -> t_none(); - bs_init_writable -> t_from_term(<<>>); - build_stacktrace -> erl_bif_types:type(erlang, build_stacktrace, 0); - Other -> erlang:error({'Unsupported primop', Other}) - end, - {State, Map, Type}; + case cerl:atom_val(cerl:primop_name(Tree)) of + match_fail -> + {State, Map, t_none()}; + raise -> + {State, Map, t_none()}; + bs_init_writable -> + {State, Map, t_from_term(<<>>)}; + build_stacktrace -> + {State, Map, erl_bif_types:type(erlang, build_stacktrace, 0)}; + dialyzer_unknown -> + {State, Map, t_any()}; + recv_peek_message -> + {State, Map, t_product([t_boolean(), t_any()])}; + recv_wait_timeout -> + [Arg] = cerl:primop_args(Tree), + {State1, Map1, TimeoutType} = traverse(Arg, Map, State), + Opaques = State1#state.opaques, + case t_is_atom(TimeoutType, Opaques) andalso + t_atom_vals(TimeoutType, Opaques) =:= ['infinity'] of + true -> + {State1, Map1, t_boolean()}; + false -> + {State1, Map1, t_boolean()} + end; + remove_message -> + {State, Map, t_any()}; + timeout -> + {State, Map, t_any()}; + Other -> erlang:error({'Unsupported primop', Other}) + end; 'receive' -> handle_receive(Tree, Map, State); seq -> @@ -967,7 +988,7 @@ handle_call(Tree, Map, State) -> handle_case(Tree, Map, State) -> Arg = cerl:case_arg(Tree), - Clauses = filter_match_fail(cerl:case_clauses(Tree)), + Clauses = cerl:case_clauses(Tree), {State1, Map1, ArgType} = SMA = traverse(Arg, Map, State), case t_is_none_or_unit(ArgType) of true -> SMA; @@ -1084,7 +1105,7 @@ handle_module(Tree, Map, State) -> %%---------------------------------------- handle_receive(Tree, Map, State) -> - Clauses = filter_match_fail(cerl:receive_clauses(Tree)), + Clauses = cerl:receive_clauses(Tree), Timeout = cerl:receive_timeout(Tree), State1 = case is_race_analysis_enabled(State) of @@ -3019,24 +3040,6 @@ is_lc_simple_list(Tree, TreeType, State) -> andalso t_is_list(TreeType) andalso t_is_simple(t_list_elements(TreeType, Opaques), State). -filter_match_fail([Clause] = Cls) -> - Body = cerl:clause_body(Clause), - case cerl:type(Body) of - primop -> - case cerl:atom_val(cerl:primop_name(Body)) of - match_fail -> []; - raise -> []; - _ -> Cls - end; - _ -> Cls - end; -filter_match_fail([H|T]) -> - [H|filter_match_fail(T)]; -filter_match_fail([]) -> - %% This can actually happen, for example in - %% receive after 1 -> ok end - []. - %%% =========================================================================== %%% %%% The State. @@ -3819,7 +3822,20 @@ find_terminals(Tree) -> %% We cannot make assumptions. Say that both are true. {true, true} end; - 'case' -> find_terminals_list(cerl:case_clauses(Tree)); + 'case' -> + case cerl:case_clauses(Tree) of + [] -> + case lists:member(receive_timeout, cerl:get_ann(Tree)) of + true -> + %% Handle a never ending receive without any + %% clauses specially. (Not sure why.) + {false, true}; + false -> + {false, false} + end; + [_|_] -> + find_terminals_list(cerl:case_clauses(Tree)) + end; 'catch' -> find_terminals(cerl:catch_body(Tree)); clause -> find_terminals(cerl:clause_body(Tree)); cons -> {false, true}; diff --git a/lib/dialyzer/src/dialyzer_dep.erl b/lib/dialyzer/src/dialyzer_dep.erl index 36cdc0876c..c8e9256bc8 100644 --- a/lib/dialyzer/src/dialyzer_dep.erl +++ b/lib/dialyzer/src/dialyzer_dep.erl @@ -87,7 +87,8 @@ traverse(Tree, Out, State, CurrentFun) -> true -> %% Op is a variable and should not be marked as escaping %% based on its use. - OpFuns = case map__lookup(cerl_trees:get_label(Op), Out) of + OpLabel = cerl_trees:get_label(Op), + OpFuns = case map__lookup(OpLabel, Out) of none -> output(none); {value, OF} -> OF end, @@ -96,7 +97,13 @@ traverse(Tree, Out, State, CurrentFun) -> State4 = state__add_deps(CurrentFun, OpFuns, State3), State5 = state__store_callsite(cerl_trees:get_label(Tree), OpFuns, length(Args), State4), - {output(set__singleton(external)), State5} + case state__get_rvals(OpLabel, State5) of + 1 -> + {output(set__singleton(external)), State5}; + NumRvals -> + List = lists:duplicate(NumRvals, output(set__singleton(external))), + {output(List), State5} + end end; binary -> {output(none), State}; @@ -137,9 +144,12 @@ traverse(Tree, Out, State, CurrentFun) -> Vars = cerl:let_vars(Tree), Arg = cerl:let_arg(Tree), Body = cerl:let_body(Tree), - {ArgFuns, State1} = traverse(Arg, Out, State, CurrentFun), + OldNumRvals = state__num_rvals(State), + State1 = state__store_num_rvals(length(Vars), State), + {ArgFuns, State2} = traverse(Arg, Out, State1, CurrentFun), Out1 = bind_list(Vars, ArgFuns, Out), - traverse(Body, Out1, State1, CurrentFun); + State3 = state__store_num_rvals(OldNumRvals, State2), + traverse(Body, Out1, State3, CurrentFun); letrec -> Defs = cerl:letrec_defs(Tree), Body = cerl:letrec_body(Tree), @@ -147,14 +157,15 @@ traverse(Tree, Out, State, CurrentFun) -> state__add_letrecs(cerl_trees:get_label(Var), cerl_trees:get_label(Fun), Acc) end, State, Defs), Out1 = bind_defs(Defs, Out), - State2 = traverse_defs(Defs, Out1, State1, CurrentFun), + NumRvals = state__num_rvals(State1), + State2 = traverse_defs(Defs, Out1, State1, CurrentFun, NumRvals), traverse(Body, Out1, State2, CurrentFun); literal -> {output(none), State}; module -> Defs = cerl:module_defs(Tree), Out1 = bind_defs(Defs, Out), - State1 = traverse_defs(Defs, Out1, State, CurrentFun), + State1 = traverse_defs(Defs, Out1, State, CurrentFun, 1), {output(none), State1}; primop -> Args = cerl:primop_args(Tree), @@ -223,14 +234,15 @@ traverse_list([Tree|Left], Out, State, CurrentFun, Acc) -> traverse_list([], _Out, State, _CurrentFun, Acc) -> {output(lists:reverse(Acc)), State}. -traverse_defs([{_, Fun}|Left], Out, State, CurrentFun) -> - {_, State1} = traverse(Fun, Out, State, CurrentFun), - traverse_defs(Left, Out, State1, CurrentFun); -traverse_defs([], _Out, State, _CurrentFun) -> +traverse_defs([{_, Fun}|Left], Out, State, CurrentFun, NumRvals) -> + State1 = state__store_num_rvals(NumRvals, State), + {_, State2} = traverse(Fun, Out, State1, CurrentFun), + traverse_defs(Left, Out, State2, CurrentFun, NumRvals); +traverse_defs([], _Out, State, _CurrentFun, _NumRvals) -> State. traverse_clauses(Clauses, ArgFuns, Out, State, CurrentFun) -> - case filter_match_fail(Clauses) of + case Clauses of [] -> %% Can happen for example with receives used as timouts. {output(none), State}; @@ -249,24 +261,6 @@ traverse_clauses([Clause|Left], ArgFuns, Out, State, CurrentFun, Acc) -> traverse_clauses([], _ArgFuns, _Out, State, _CurrentFun, Acc) -> {merge_outs(Acc), State}. -filter_match_fail([Clause]) -> - Body = cerl:clause_body(Clause), - case cerl:type(Body) of - primop -> - case cerl:atom_val(cerl:primop_name(Body)) of - match_fail -> []; - raise -> []; - _ -> [Clause] - end; - _ -> [Clause] - end; -filter_match_fail([H|T]) -> - [H|filter_match_fail(T)]; -filter_match_fail([]) -> - %% This can actually happen, for example in - %% receive after 1 -> ok end - []. - remote_call(Tree, ArgFuns, State) -> M = cerl:call_module(Tree), F = cerl:call_name(Tree), @@ -483,12 +477,16 @@ all_vars(Tree, AccIn) -> %% -type local_set() :: 'none' | #set{}. +-type rvals() :: #{label() => non_neg_integer()}. -record(state, {deps :: deps(), esc :: local_set(), calls :: calls(), arities :: dict:dict(label() | 'top', arity()), - letrecs :: letrecs()}). + letrecs :: letrecs(), + num_rvals = 1 :: non_neg_integer(), + rvals = #{} :: rvals() + }). state__new(Tree) -> Exports = set__from_list([X || X <- cerl:module_exports(Tree)]), @@ -526,8 +524,11 @@ state__add_deps(From, #output{type = single, content = To}, %% io:format("Adding deps from ~w to ~w\n", [From, set__to_ordsets(To)]), State#state{deps = map__add(From, To, Map)}. -state__add_letrecs(Var, Fun, #state{letrecs = Map} = State) -> - State#state{letrecs = map__store(Var, Fun, Map)}. +state__add_letrecs(Var, Fun, #state{letrecs = Map, + num_rvals = NumRvals, + rvals = Rvals} = State) -> + State#state{letrecs = map__store(Var, Fun, Map), + rvals = Rvals#{Var => NumRvals}}. state__deps(#state{deps = Deps}) -> Deps. @@ -539,6 +540,10 @@ state__add_esc(#output{content = none}, State) -> State; state__add_esc(#output{type = single, content = Set}, #state{esc = Esc} = State) -> + State#state{esc = set__union(Set, Esc)}; +state__add_esc(#output{type = list, content = [H|T]}, + #state{esc = Esc} = State) -> + #output{type = single, content = Set} = merge_outs(T, H), State#state{esc = set__union(Set, Esc)}. state__esc(#state{esc = Esc}) -> @@ -559,6 +564,19 @@ state__store_callsite(From, To, CallArity, state__calls(#state{calls = Calls}) -> Calls. +state__store_num_rvals(NumRval, State) -> + State#state{num_rvals = NumRval}. + +state__num_rvals(#state{num_rvals = NumRvals}) -> + NumRvals. + +state__get_rvals(FunLabel, #state{rvals = Rvals}) -> + case Rvals of + #{FunLabel := NumRvals} -> NumRvals; + #{} -> 1 + end. + + %%------------------------------------------------------------ %% A test function. Not part of the intended interface. %% diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 2af4534396..fe85fa81de 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -539,7 +539,7 @@ compute_md5_from_file(File) -> Filtered = [[ID, Chunk] || {ID, Chunk} <- Chunks, ID =/= "CInf", ID =/= "Docs"], erlang:md5(lists:sort(Filtered)); {error, beam_lib, {file_error, _, enoent}} -> - Msg = io_lib:format("Not a regular file: ~ts\n", [File]), + Msg = io_lib:format("File not found: ~ts\n", [File]), throw({dialyzer_error, Msg}); {error, beam_lib, _} -> Msg = io_lib:format("Could not compute MD5 for .beam: ~ts\n", [File]), diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index dede475f98..5f40f80ae7 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -296,7 +296,7 @@ traverse(Tree, DefinedVars, State) -> {State4, mk_var(Tree)}; 'case' -> Arg = cerl:case_arg(Tree), - Clauses = filter_match_fail(cerl:case_clauses(Tree)), + Clauses = cerl:case_clauses(Tree), {State1, ArgVar} = traverse(Arg, DefinedVars, State), handle_clauses(Clauses, mk_var(Tree), ArgVar, DefinedVars, State1); call -> @@ -423,10 +423,31 @@ traverse(Tree, DefinedVars, State) -> Type = erl_bif_types:type(erlang, build_stacktrace, 0), State1 = state__store_conj(V, sub, Type, State), {State1, V}; + dialyzer_unknown -> + %% See dialyzer_clean_core:clean_letrec/1. + {State, mk_var(Tree)}; + recv_peek_message -> + {State1, Vars} = state__mk_vars(2, State), + {State1, t_product(Vars)}; + recv_wait_timeout -> + [Timeout] = cerl:primop_args(Tree), + case cerl:is_c_atom(Timeout) andalso + cerl:atom_val(Timeout) =:= infinity of + true -> + {State, t_none()}; + false -> + {State1, TimeoutVar} = traverse(Timeout, DefinedVars, State), + State2 = state__store_conj(TimeoutVar, sub, t_timeout(), State1), + {State2, mk_var(Tree)} + end; + remove_message -> + {State, t_any()}; + timeout -> + {State, t_any()}; Other -> erlang:error({'Unsupported primop', Other}) end; 'receive' -> - Clauses = filter_match_fail(cerl:receive_clauses(Tree)), + Clauses = cerl:receive_clauses(Tree), Timeout = cerl:receive_timeout(Tree), case (cerl:is_c_atom(Timeout) andalso (cerl:atom_val(Timeout) =:= infinity)) of @@ -829,24 +850,6 @@ get_plt_constr(MFA, Dst, ArgVars, State) -> get_contract_return(C, ArgTypes) -> dialyzer_contracts:get_contract_return(C, ArgTypes). -filter_match_fail([Clause] = Cls) -> - Body = cerl:clause_body(Clause), - case cerl:type(Body) of - primop -> - case cerl:atom_val(cerl:primop_name(Body)) of - match_fail -> []; - raise -> []; - _ -> Cls - end; - _ -> Cls - end; -filter_match_fail([H|T]) -> - [H|filter_match_fail(T)]; -filter_match_fail([]) -> - %% This can actually happen, for example in - %% receive after 1 -> ok end - []. - %% If there is a significant number of clauses, we cannot apply the %% list subtraction scheme since it causes the analysis to be too %% slow. Typically, this only affects automatically generated files. diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 245c099fef..f679f146cc 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -99,7 +99,7 @@ get_core_from_src(File, Opts) -> case compile:noenv_file(File, Opts ++ src_compiler_opts()) of error -> {error, []}; {error, Errors, _} -> {error, format_errors(Errors)}; - {ok, _, Core} -> {ok, Core} + {ok, _, Core} -> {ok, dialyzer_clean_core:clean(Core)} end. -type get_core_from_beam_ret() :: {'ok', cerl:c_module()} | {'error', string()}. @@ -116,7 +116,7 @@ get_core_from_beam(File, Opts) -> {ok, {Module, [{debug_info, {debug_info_v1, Backend, Metadata}}]}} -> case Backend:debug_info(core_v1, Module, Metadata, Opts ++ src_compiler_opts()) of {ok, Core} -> - {ok, Core}; + {ok, dialyzer_clean_core:clean(Core)}; {error, _} -> {error, " Could not get Core Erlang code for: " ++ File ++ "\n"} end; diff --git a/lib/dialyzer/test/map_SUITE_data/results/maps_remove b/lib/dialyzer/test/map_SUITE_data/results/maps_remove new file mode 100644 index 0000000000..32e43466b0 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/maps_remove @@ -0,0 +1,4 @@ + +maps_remove.erl:22: Function get/2 has no local return +maps_remove.erl:23: The call maps:get(K::'a',M::#{}) will never return since the success typing arguments are (any(),map()) +maps_remove.erl:7: Function t1/0 has no local return diff --git a/lib/dialyzer/test/map_SUITE_data/src/maps_remove.erl b/lib/dialyzer/test/map_SUITE_data/src/maps_remove.erl new file mode 100644 index 0000000000..b913e389f8 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/maps_remove.erl @@ -0,0 +1,23 @@ +%% ERL-1002, maps:remove + +-module(maps_remove). + +-export([t1/0]). + +t1() -> + A = new(), + B = put(a, 1, A), + C = remove(a, B), + get(a, C). + +new() -> + maps:new(). + +put(K, V, M) -> + maps:put(K, V, M). + +remove(K, M) -> + maps:remove(K, M). + +get(K, M) -> + maps:get(K, M). diff --git a/lib/dialyzer/test/small_SUITE_data/results/stacktrace b/lib/dialyzer/test/small_SUITE_data/results/stacktrace index fd60881953..5126a88297 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/stacktrace +++ b/lib/dialyzer/test/small_SUITE_data/results/stacktrace @@ -1,5 +1,5 @@ stacktrace.erl:11: The pattern {'a', 'b'} can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}] stacktrace.erl:19: The pattern ['a', 'b'] can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}] -stacktrace.erl:44: The pattern {'a', 'b'} can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}] -stacktrace.erl:53: The pattern ['a', 'b'] can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}] +stacktrace.erl:43: The pattern {'a', 'b'} can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}] +stacktrace.erl:51: The pattern ['a', 'b'] can never match the type [{atom(),atom(),[any()] | byte(),[{'file',string()} | {'line',pos_integer()}]}] diff --git a/lib/dialyzer/test/small_SUITE_data/src/stacktrace.erl b/lib/dialyzer/test/small_SUITE_data/src/stacktrace.erl index de79e710e9..b2a0c04554 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/stacktrace.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/stacktrace.erl @@ -39,8 +39,7 @@ t4() -> s1() -> try foo:bar() catch - E:P -> - S = erlang:get_stacktrace(), + E:P:S -> {a,b} = S, % can never match {E, P} end. @@ -48,8 +47,7 @@ s1() -> s2() -> try foo:bar() catch - E:P -> - S = erlang:get_stacktrace(), + E:P:S -> [a,b] = S, % can never match {E, P} end. @@ -57,8 +55,7 @@ s2() -> s3() -> try foo:bar() catch - E:P -> - S = erlang:get_stacktrace(), + E:P:S -> [{m,f,[],[]}] = S, {E, P} end. @@ -66,8 +63,7 @@ s3() -> s4() -> try foo:bar() catch - E:P -> - S = erlang:get_stacktrace(), + E:P:S -> [{m,f,1,[{file,"tjo"},{line,95}]}] = S, {E, P} end. diff --git a/lib/diameter/Makefile b/lib/diameter/Makefile index a0195a0988..a25baeb929 100644 --- a/lib/diameter/Makefile +++ b/lib/diameter/Makefile @@ -27,7 +27,6 @@ SPECIAL_TARGETS = include $(ERL_TOP)/make/otp_subdir.mk -info: - @echo "APP_VSN = $(APP_VSN)" +DIA_PLT_APPS=ssl runtime_tools syntax_tools -.PHONY: info +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/diameter/doc/src/Makefile b/lib/diameter/doc/src/Makefile index 7c7fbeafef..3553b68510 100644 --- a/lib/diameter/doc/src/Makefile +++ b/lib/diameter/doc/src/Makefile @@ -24,8 +24,6 @@ include ../../vsn.mk VSN = $(DIAMETER_VSN) -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- @@ -35,118 +33,29 @@ XML_REF_FILES = $(XML_REF1_FILES) $(XML_REF3_FILES) $(XML_REF4_FILES) XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) \ $(XML_REF_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) \ - $(XML_EXTRA_FILES) - -INFO_FILE = ../../info + $(XML_PART_FILES) $(XML_CHAPTER_FILES) -MAN1_FILES = $(XML_REF1_FILES:%.xml=$(MAN1DIR)/%.1) -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN4_FILES = $(XML_REF4_FILES:%.xml=$(MAN4DIR)/%.4) +XML_GEN_FILES = $(XMLDIR)/seehere.ent $(patsubst %.ent,$(XMLDIR)/%.ent,$(XML_EXTRA_FILES)) -PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +EXTRA_FILES=depend.mk $(XMLDIR)/seehere.ent -STANDARD_DIR = ../standard +NO_CHUNKS = diameter_app.xml diameter_transport.xml # ---------------------------------------------------- # Targets # ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ +include $(ERL_TOP)/make/doc.mk -docs: pdf html man +$(XMLDIR)/seehere.ent: Makefile seealso.ent + $(gen_verbose) sed -f seehere.sed seealso.ent > $@ +$(XMLDIR)/%.ent: %.ent + $(gen_verbose) cp $< $@ ldocs: local_docs $(INDEX_TARGET) -$(PDF_FILE): $(XML_FILES) - -pdf: $(PDF_FILE) - -html: gifs $(HTMLDIR)/index.html - -clean clean_docs: clean_pdf clean_html clean_man - rm -f errs core *~ - rm -f depend.mk seehere.ent - -clean_pdf: - rm -f $(PDFDIR)/* - -clean_man: - rm -f $(MAN1DIR)/* $(MAN3DIR)/* $(MAN4DIR)/* - -clean_html: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -man: $(MAN1_FILES) $(MAN3_FILES) $(MAN4_FILES) - -$(INDEX_TARGET): $(INDEX_SRC) $(APP_FILE) +depend.mk: depend.sed Makefile $(XMLDIR)/seehere.ent $(XMLDIR)/seealso.ent $(XML_REF_FILES) $(XML_CHAPTER_FILES) $(gen_verbose) \ - sed -e 's/%VSN%/$(VSN)/; \ - s/%ERLANG_SITE%/www\.erlang\.se\//; \ - s/%UP_ONE_LEVEL%/..\/..\/..\/doc\/index.html/; \ - s/%OFF_PRINT%/pdf\/diameter-$(VSN).pdf/' $< > $@ - -depend: depend.mk - -debug opt: - -info: - @echo "" - @echo "INDEX_FILE = $(INDEX_FILE)" - @echo "INDEX_SRC = $(INDEX_SRC)" - @echo "INDEX_TARGET = $(INDEX_TARGET)" - @echo "" - @echo "XML_APPLICATION_FILES = $(XML_APPLICATION_FILES)" - @echo "XML_PART_FILES = $(XML_PART_FILES)" - @echo "XML_REF1_FILES = $(XML_REF1_FILES)" - @echo "XML_REF3_FILES = $(XML_REF3_FILES)" - @echo "XML_REF4_FILES = $(XML_REF4_FILES)" - @echo "XML_CHAPTER_FILES = $(XML_CHAPTER_FILES)" - @echo "" - @echo "GIF_FILES = $(GIF_FILES)" - @echo "" - @echo "MAN1_FILES = $(MAN1_FILES)" - @echo "MAN3_FILES = $(MAN3_FILES)" - @echo "MAN4_FILES = $(MAN4_FILES)" - @echo "" - @echo "DEFAULT_HTML_FILES = $(DEFAULT_HTML_FILES)" - @echo "DEFAULT_GIF_FILES = $(DEFAULT_GIF_FILES)" - @echo "" - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- - -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: $(LOCAL)docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man1" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man4" - $(INSTALL_DATA) $(PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(HTMLDIR)/*.* "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DATA) $(MAN1_FILES) "$(RELEASE_PATH)/man/man1" - $(INSTALL_DATA) $(MAN3_FILES) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN4_FILES) "$(RELEASE_PATH)/man/man4" - [ -z "$(LOCAL)" ] || cp -r $(HTMLDIR)/js "$(RELSYSDIR)/doc/html" - echo $(LOCAL) - -release_spec: - -depend.mk: depend.sed Makefile seealso.ent \ - $(XML_REF_FILES) $(XML_CHAPTER_FILES) - $(gen_verbose) - $(V_at) \ - sed -f seehere.sed seealso.ent > seehere.ent - $(V_at) \ (for f in $(XML_REF_FILES) $(XML_CHAPTER_FILES); do \ sed -f $< $$f | sed "s@%FILE%@`basename $$f .xml`@g"; \ done) \ @@ -154,7 +63,4 @@ depend.mk: depend.sed Makefile seealso.ent \ -include depend.mk -.PHONY: clean clean_html clean_man clean_pdf \ - depend debug opt info \ - docs gifs html ldocs man pdf \ - release_docs_spec release_spec +.PHONY: depend ldocs diff --git a/lib/diameter/doc/src/diameterc.xml b/lib/diameter/doc/src/diameterc_cmd.xml index 8f1c660989..8f1c660989 100644 --- a/lib/diameter/doc/src/diameterc.xml +++ b/lib/diameter/doc/src/diameterc_cmd.xml diff --git a/lib/diameter/doc/src/files.mk b/lib/diameter/doc/src/files.mk index 4c1297f6cc..ab47beb99e 100644 --- a/lib/diameter/doc/src/files.mk +++ b/lib/diameter/doc/src/files.mk @@ -22,7 +22,7 @@ XML_APPLICATION_FILES = \ ref_man.xml XML_REF1_FILES = \ - diameterc.xml + diameterc_cmd.xml XML_REF3_FILES = \ diameter.xml \ @@ -52,4 +52,4 @@ XML_CHAPTER_FILES = \ BOOK_FILES = \ book.xml -GIF_FILES = +IMAGE_FILES = diff --git a/lib/diameter/doc/src/ref_man.xml b/lib/diameter/doc/src/ref_man.xml index a0ef28844d..d57e121c60 100644 --- a/lib/diameter/doc/src/ref_man.xml +++ b/lib/diameter/doc/src/ref_man.xml @@ -40,7 +40,7 @@ applications on top of the Diameter protocol. </p> </description> <xi:include href="diameter.xml"/> -<xi:include href="diameterc.xml"/> +<xi:include href="diameterc_cmd.xml"/> <xi:include href="diameter_app.xml"/> <xi:include href="diameter_codec.xml"/> <xi:include href="diameter_dict.xml"/> diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index d6854cfd27..36e8fefd4c 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -96,6 +96,12 @@ APPUP_FILE = diameter.appup APPUP_SRC = $(APPUP_FILE).src APPUP_TARGET = $(EBIN)/$(APPUP_FILE) +ifeq ($(TARGET),win32) + EXE_SUFFIX=.exe +else + EXE_SUFFIX= +endif + # ---------------------------------------------------- # Flags # ---------------------------------------------------- @@ -123,7 +129,7 @@ ERL_COMPILE_FLAGS += \ # erl/hrl from dictionary file. gen/diameter_gen_%.erl gen/diameter_gen_%.hrl: dict/%.dia $(dia_verbose) \ - escript ../bin/diameterc -o gen -i $(EBIN) $< + escript$(EXE_SUFFIX) ../bin/diameterc -o gen -i $(EBIN) $< opt: $(TARGET_FILES) diff --git a/lib/edoc/Makefile b/lib/edoc/Makefile index 70bf1f3d48..a8258015b1 100644 --- a/lib/edoc/Makefile +++ b/lib/edoc/Makefile @@ -69,7 +69,7 @@ SPECIAL_TARGETS = include $(ERL_TOP)/make/otp_subdir.mk -.PHONY: info version +.PHONY: version version: @@ -92,9 +92,6 @@ edocs: -pa $(XMERL_DIR)/ebin -run edoc_run application \ "'$(APPNAME)'" '"."' '$(DOC_OPTS)' -info: - @echo $(HTML_FILES) - app_release: tar @@ -124,3 +121,7 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) + +DIA_PLT_APPS=syntax_tools xmerl inets + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/edoc/doc/src/Makefile b/lib/edoc/doc/src/Makefile index 3e53e75c75..29244467f9 100644 --- a/lib/edoc/doc/src/Makefile +++ b/lib/edoc/doc/src/Makefile @@ -25,22 +25,10 @@ VSN=$(EDOC_VSN) APPLICATION=edoc # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- -# Man page source directory (with .erl files) -# ---------------------------------------------------- -SRC_DIR = $(ERL_TOP)/lib/edoc/src -INC_DIR = $(ERL_TOP)/lib/edoc/include - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = \ - edoc.xml \ +EDOC_REF3_FILES = edoc.xml \ edoc_doclet.xml \ edoc_extract.xml \ edoc_layout.xml \ @@ -48,7 +36,7 @@ XML_REF3_FILES = \ edoc_run.xml XML_PART_FILES = part.xml -XML_CHAPTER_FILES = chapter.xml +EDOC_CHAPTER_FILE = chapter.xml XML_NOTES_FILES = notes.xml BOOK_FILES = book.xml @@ -57,89 +45,12 @@ XML_FILES=\ $(BOOK_FILES) $(XML_APPLICATION_FILES) \ $(XML_PART_FILES) $(XML_NOTES_FILES) -XML_GEN_FILES=$(XML_REF3_FILES:%=$(XMLDIR)/%) $(XML_CHAPTER_FILES:%=$(XMLDIR)/%) - -# ---------------------------------------------------- -INFO_FILE = ../../info - -HTML_FILES = \ - $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -EXTRA_FILES = \ - $(DEFAULT_GIF_FILES) \ - $(DEFAULT_HTML_FILES) \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_NOTES_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - INCLUDES_DIR = ../../include INCLUDES = $(INCLUDES_DIR)/edoc_doclet.hrl DTDS_DIR = ../../priv DTDS = $(DTDS_DIR)/edoc.dtd -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) - -$(XML_REF3_FILES:%=$(XMLDIR)/%): - $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EDOC_VSN) -i $(ERL_TOP)/lib/edoc/include -dir $(XMLDIR) $(SRC_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) - -$(XML_CHAPTER_FILES:%=$(XMLDIR)/%): ../overview.edoc - $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EDOC_VSN) -chapter -dir $(XMLDIR) $< - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(XML_REF3_FILES) $(XML_CHAPTER_FILES) *.html - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(INCLUDES) $(DTDS) "$(RELSYSDIR)/doc/html" +HTML_EXTRA_FILES = $(DTDS) $(INCLUDES) -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/edoc/src/edoc.app.src b/lib/edoc/src/edoc.app.src index 43343e2ae8..834c0eb005 100644 --- a/lib/edoc/src/edoc.app.src +++ b/lib/edoc/src/edoc.app.src @@ -23,4 +23,4 @@ {applications, [compiler,kernel,stdlib,syntax_tools]}, {env, []}, {runtime_dependencies, ["xmerl-1.3.7","syntax_tools-1.6.14","stdlib-2.5", - "kernel-3.0","inets-5.10","erts-6.0"]}]}. + "kernel-3.0","erts-6.0"]}]}. diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 62483602aa..0fdc818fae 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -259,10 +259,9 @@ opt_negations() -> %% </dd> %% <dt>{@type {doc_path, [string()]@}} %% </dt> -%% <dd>Specifies a list of URI:s pointing to directories that contain -%% EDoc-generated documentation. URI without a `scheme://' part are -%% taken as relative to `file://'. (Note that such paths must use -%% `/' as separator, regardless of the host operating system.) +%% <dd>Specifies a list of file system paths pointing to directories that +%% contain EDoc-generated documentation. All paths for applications +%% in the code path are automatically added. %% </dd> %% <dt>{@type {doclet, Module::atom()@}} %% </dt> diff --git a/lib/edoc/src/edoc_data.erl b/lib/edoc/src/edoc_data.erl index a8373d6536..ed81c9f4c3 100644 --- a/lib/edoc/src/edoc_data.erl +++ b/lib/edoc/src/edoc_data.erl @@ -328,8 +328,6 @@ get_deprecated(Ts, F, A, Env) -> case otp_internal:obsolete(M, F, A) of {Tag, Text} when Tag =:= deprecated; Tag =:= removed -> deprecated([Text]); - {Tag, Repl, _Rel} when Tag =:= deprecated; Tag =:= removed -> - deprecated(Repl, Env); _ -> [] end; @@ -337,24 +335,9 @@ get_deprecated(Ts, F, A, Env) -> Es end. -deprecated(Repl, Env) -> - {Text, Ref} = replacement_function(Env#env.module, Repl), - Desc = ["Use ", {a, href(Ref, Env), [{code, [Text]}]}, " instead."], - deprecated(Desc). - deprecated(Desc) -> [{deprecated, description(Desc)}]. --dialyzer({no_match, replacement_function/2}). - -replacement_function(M0, {M,F,A}) when is_list(A) -> - %% refer to the largest listed arity - the most general version - replacement_function(M0, {M,F,lists:last(lists:sort(A))}); -replacement_function(M, {M,F,A}) -> - {io_lib:fwrite("~w/~w", [F, A]), edoc_refs:function(F, A)}; -replacement_function(_, {M,F,A}) -> - {io_lib:fwrite("~w:~w/~w", [M, F, A]), edoc_refs:function(M, F, A)}. - get_expr_ref(Expr) -> case catch {ok, erl_syntax_lib:analyze_application(Expr)} of {ok, {F, A}} when is_atom(F), is_integer(A) -> diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl index d00a283794..5959fa6f08 100644 --- a/lib/edoc/src/edoc_lib.erl +++ b/lib/edoc/src/edoc_lib.erl @@ -32,12 +32,12 @@ -export([count/2, lines/1, split_at/2, split_at_stop/1, split_at_space/1, filename/1, transpose/1, segment/2, get_first_sentence/1, is_space/1, strip_space/1, parse_expr/2, - parse_contact/2, escape_uri/1, join_uri/2, is_relative_uri/1, + parse_contact/2, escape_uri/1, join_uri/2, is_name/1, to_label/1, find_doc_dirs/0, find_sources/2, find_file/2, try_subdir/2, unique/1, write_file/3, write_file/4, write_info_file/3, read_info_file/1, get_doc_env/1, get_doc_env/3, copy_file/2, - uri_get/1, run_doclet/2, run_layout/2, + run_doclet/2, run_layout/2, simplify_path/1, timestr/1, datestr/1, read_encoding/2]). -import(edoc_report, [report/2, warning/2]). @@ -438,128 +438,6 @@ join_uri("", Path) -> join_uri(Base, Path) -> Base ++ "/" ++ Path. -%% Check for relative URI; "network paths" ("//...") not included! - -%% @private -is_relative_uri([$: | _]) -> - false; -is_relative_uri([$/, $/ | _]) -> - false; -is_relative_uri([$/ | _]) -> - true; -is_relative_uri([$? | _]) -> - true; -is_relative_uri([$# | _]) -> - true; -is_relative_uri([_ | Cs]) -> - is_relative_uri(Cs); -is_relative_uri([]) -> - true. - -%% @private -uri_get("file:///" ++ Path) -> - uri_get_file(Path); -uri_get("file://localhost/" ++ Path) -> - uri_get_file(Path); -uri_get("file://" ++ Path) -> - Msg = io_lib:format("cannot handle 'file:' scheme with " - "nonlocal network-path: 'file://~ts'.", - [Path]), - {error, Msg}; -uri_get("file:/" ++ Path) -> - uri_get_file(Path); -uri_get("file:" ++ Path) -> - Msg = io_lib:format("ignoring malformed URI: 'file:~ts'.", [Path]), - {error, Msg}; -uri_get("http:" ++ Path) -> - uri_get_http("http:" ++ Path); -uri_get("ftp:" ++ Path) -> - uri_get_ftp("ftp:" ++ Path); -uri_get("//" ++ Path) -> - Msg = io_lib:format("cannot access network-path: '//~ts'.", [Path]), - {error, Msg}; -uri_get([C, $:, $/ | _]=Path) when C >= $A, C =< $Z; C >= $a, C =< $z -> - uri_get_file(Path); % special case for Windows -uri_get([C, $:, $\ | _]=Path) when C >= $A, C =< $Z; C >= $a, C =< $z -> - uri_get_file(Path); % special case for Windows -uri_get(URI) -> - case is_relative_uri(URI) of - true -> - uri_get_file(URI); - false -> - Msg = io_lib:format("cannot handle URI: '~ts'.", [URI]), - {error, Msg} - end. - -uri_get_file(File0) -> - File = filename:join(?FILE_BASE, File0), - case read_file(File) of - {ok, Text} -> - {ok, Text}; - {error, R} -> - {error, file:format_error(R)} - end. - -uri_get_http(URI) -> - %% Try using option full_result=false - case catch {ok, httpc:request(get, {URI,[]}, [], - [{full_result, false}])} of - {'EXIT', _} -> - uri_get_http_r10(URI); - Result -> - uri_get_http_1(Result, URI) - end. - -uri_get_http_r10(URI) -> - %% Try most general form of request - Result = (catch {ok, httpc:request(get, {URI,[]}, [], [])}), - uri_get_http_1(Result, URI). - -uri_get_http_1(Result, URI) -> - case Result of - {ok, {ok, {200, Text}}} when is_list(Text) -> - %% new short result format - {ok, Text}; - {ok, {ok, {Status, Text}}} when is_integer(Status), is_list(Text) -> - %% new short result format when status /= 200 - Phrase = httpd_util:reason_phrase(Status), - {error, http_errmsg(Phrase, URI)}; - {ok, {ok, {{_Vsn, 200, _Phrase}, _Hdrs, Text}}} when is_list(Text) -> - %% new long result format - {ok, Text}; - {ok, {ok, {{_Vsn, _Status, Phrase}, _Hdrs, Text}}} when is_list(Text) -> - %% new long result format when status /= 200 - {error, http_errmsg(Phrase, URI)}; - {ok, {200,_Hdrs,Text}} when is_list(Text) -> - %% old result format - {ok, Text}; - {ok, {Status,_Hdrs,Text}} when is_list(Text) -> - %% old result format when status /= 200 - Phrase = httpd_util:reason_phrase(Status), - {error, http_errmsg(Phrase, URI)}; - {ok, {error, R}} -> - Reason = inet:format_error(R), - {error, http_errmsg(Reason, URI)}; - {ok, R} -> - Reason = io_lib:format("bad return value ~tP", [R, 5]), - {error, http_errmsg(Reason, URI)}; - {'EXIT', R} -> - Reason = io_lib:format("crashed with reason ~tw", [R]), - {error, http_errmsg(Reason, URI)}; - R -> - Reason = io_lib:format("uncaught throw: ~tw", [R]), - {error, http_errmsg(Reason, URI)} - end. - -http_errmsg(Reason, URI) -> - io_lib:format("http error: ~ts: '~ts'", [Reason, URI]). - -%% TODO: implement ftp access method - -uri_get_ftp(URI) -> - Msg = io_lib:format("cannot access ftp scheme yet: '~ts'.", [URI]), - {error, Msg}. - %% @private to_label([$\s | Cs]) -> to_label(Cs); @@ -754,18 +632,6 @@ read_info_file(Dir) -> {?NO_APP, []} end. -%% URI access - -uri_get_info_file(Base) -> - URI = join_uri(Base, ?INFO_FILE), - case uri_get(URI) of - {ok, Text} -> - parse_info_file(Text, URI); - {error, Msg} -> - warning("could not read '~ts': ~ts.", [URI, Msg]), - {?NO_APP, []} - end. - parse_info_file(Text, Name) -> case parse_terms(Text) of {ok, Vs} -> @@ -897,7 +763,7 @@ find_doc_dirs([]) -> get_doc_links(App, Modules, Opts) -> Path = proplists:append_values(doc_path, Opts) ++ find_doc_dirs(), - Ds = [{P, uri_get_info_file(P)} || P <- Path], + Ds = [{P, read_info_file(P)} || P <- Path], Ds1 = [{"", {App, Modules}} | Ds], D = dict:new(), make_links(Ds1, D, D). diff --git a/lib/eldap/Makefile b/lib/eldap/Makefile index 28f995e068..30a8f778ab 100644 --- a/lib/eldap/Makefile +++ b/lib/eldap/Makefile @@ -38,3 +38,6 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=asn ssl + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/eldap/doc/src/Makefile b/lib/eldap/doc/src/Makefile index bf1eca267a..3eaee276a0 100644 --- a/lib/eldap/doc/src/Makefile +++ b/lib/eldap/doc/src/Makefile @@ -27,11 +27,6 @@ VSN=$(ELDAP_VSN) APPLICATION=eldap # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -45,73 +40,6 @@ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES) \ $(XML_PART_FILES) $(XML_CHAPTER_FILES) -GIF_FILES = - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt valgrind: - -clean clean_docs clean_tex: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(MAN6DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" -# $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" -# $(INSTALL_DATA) $(MAN6DIR)/* "$(RELEASE_PATH)/man/man6" - - -release_spec: +IMAGE_FILES = +include $(ERL_TOP)/make/doc.mk diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index 790a2f4e26..4a8c2d1647 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -317,7 +317,7 @@ </type> <desc> <p> Modify the DN of an entry. <c>DeleteOldRDN</c> indicates - whether the current RDN should be removed from the attribute list after the after operation. + whether the current RDN should be removed from the attribute list after the operation. <c>NewSupDN</c> is the new parent that the RDN shall be moved to. If the old parent should remain as parent, <c>NewSupDN</c> shall be "".</p> <code> diff --git a/lib/erl_docgen/Makefile b/lib/erl_docgen/Makefile index 30ff2bf16e..7e9cc824ec 100644 --- a/lib/erl_docgen/Makefile +++ b/lib/erl_docgen/Makefile @@ -36,4 +36,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=edoc xmerl +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/erl_docgen/doc/src/Makefile b/lib/erl_docgen/doc/src/Makefile index d6d2550425..33eb44a049 100644 --- a/lib/erl_docgen/doc/src/Makefile +++ b/lib/erl_docgen/doc/src/Makefile @@ -29,11 +29,6 @@ VSN=$(ERL_DOCGEN_VSN) APPLICATION=erl_docgen # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -52,7 +47,8 @@ XML_CHAPTER_FILES = \ inline_tags.xml \ header_tags.xml \ character_entities.xml \ - block_tags.xml + block_tags.xml \ + doc_storage.xml BOOK_FILES = book.xml @@ -64,75 +60,9 @@ TECHNICAL_DESCR_FILES = EXAMPLE_FILES = \ example.txt -GIF_FILES = \ +IMAGE_FILES = \ man.gif # ---------------------------------------------------- -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -docs: pdf html man - -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -$(HTMLDIR)/example.txt: example.txt - $(INSTALL_DATA) $< $@ - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs examples $(HTML_REF_MAN_FILE) - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN6DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - rm -f $(JD_HTML) $(JD_PACK) - -man: $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -examples: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6DIR)/* "$(RELEASE_PATH)/man/man6" - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/erl_docgen/doc/src/block_tags.xml b/lib/erl_docgen/doc/src/block_tags.xml index ceed9305f4..bcaec0fbd1 100644 --- a/lib/erl_docgen/doc/src/block_tags.xml +++ b/lib/erl_docgen/doc/src/block_tags.xml @@ -42,7 +42,6 @@ <seealso marker="#listTAG"><list></seealso>, <seealso marker="#taglistTAG"><taglist></seealso>, <seealso marker="#codeincludeTAG"><codeinclude></seealso> and - <seealso marker="#erlevalTAG"><erleval></seealso>. </p> <section> @@ -131,21 +130,6 @@ start(Pid) -> </section> <section> - <marker id="erlevalTAG"></marker> - <title><erleval> - Erlang Evaluation</title> - - <p>Include the result from evaluating an Erlang expression. Example: - </p> - <code><![CDATA[ -<erleval expr="{A,b,C}={a,b,c}. "/> - ]]></code> - <p>results in:</p> - <erleval expr="{A,b,C}={a,b,c}. "></erleval> - - <p>Note the '.' and space after the expression.</p> - </section> - - <section> <marker id="listTAG"></marker> <title><list> - List</title> diff --git a/lib/erl_docgen/doc/src/doc_storage.xml b/lib/erl_docgen/doc/src/doc_storage.xml new file mode 100644 index 0000000000..9eee863e3d --- /dev/null +++ b/lib/erl_docgen/doc/src/doc_storage.xml @@ -0,0 +1,61 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1997</year><year>2016</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + <title>Documentation Storage</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + <file>doc_storage.xml</file> + </header> + + <section> + <title>EEP-48: Documentation storage and format</title> + <p><url href="https://www.erlang.org/erlang-enhancement-proposals/eep-0048.html">EEP-48</url> + defines a common documentation storage format for module documentation in the Erlang/OTP + ecosystem. Erl_Docgen can generate documentation in this format from XML files following + the DTD's descibed in the other User's Guides in this application.</p> + <p>Some special considerations have to be taken when writing documentation that + should also be available through EEP-48 style storage.</p> + <list> + <item>The <c>#PCDATA</c> within <c><name></c> tags must be parseable to figure out the arity of the function.</item> + <item>It is not allowed to mix <c><name></c> tags with #PCDATA and attributes.</item> + <item>All <c><name></c> tags within <c><func></c> has to have a <c>since</c> attribute.</item> + <item>All callback function documentations have to start with a <c>Module</c> prefix.</item> + </list> + </section> + + <section> + <title>Erlang Documentation Format</title> + <p>When generating documentation for generic storage</p> + </section> + + <section> + <title>See Also</title> + <p> + <seealso marker="stdlib:shell_docs"><c>shell_docs(3)</c></seealso>, + <seealso marker="kernel:code#get_doc-1"><c>code:get_doc(3)</c></seealso> + </p> + </section> + +</chapter> diff --git a/lib/erl_docgen/doc/src/inline_tags.xml b/lib/erl_docgen/doc/src/inline_tags.xml index 25b0cd4d87..2b5239c855 100644 --- a/lib/erl_docgen/doc/src/inline_tags.xml +++ b/lib/erl_docgen/doc/src/inline_tags.xml @@ -171,45 +171,5 @@ </p> </section> - <section> - <marker id="termTAG"></marker> - <marker id="termdefTAG"></marker> - <title><term>, <termdef> - Glossary</title> - - <p>Used to highlight a term with a local (for this document only) or - global definition. The identity of the term is given by - the <c>id</c> attribute.</p> - - <p>For a locally defined term, the tag contains a - <c><termdef></c>, which in turn contains an explanation of - the term as plain text. Example:</p> - <pre><![CDATA[ -<term id="HTML"><termdef>Hyper-Text Markup Language</termdef></term> - ]]></pre> - - <p>In the generated HTML, it is the term name which will be visible. - For locally defined terms, the id and the name are the same. - The name has a hypertext link to the definition in the glossary. - Example:</p> - <pre><![CDATA[ -<term id="HTML"><termdef>Hyper-Text Markup Language</termdef></term> - ]]></pre> - <p>results in: <term id="HTML"><termdef>Hyper-Text Markup Language</termdef></term> - </p> - - <p>If a term is defined both locally and globally, the global - definition takes precedence.</p> - </section> - - <section> - <marker id="citeTAG"></marker> - <marker id="citedefTAG"></marker> - <title><cite>, <citedef> - Bibliography</title> - - <p>Works the same way as <c><term></c> and - <c><termdef></c>, but for a bibliography list rather than - a glossary.</p> - - </section> </chapter> diff --git a/lib/erl_docgen/doc/src/part.xml b/lib/erl_docgen/doc/src/part.xml index 0e97af7169..91ff979af5 100644 --- a/lib/erl_docgen/doc/src/part.xml +++ b/lib/erl_docgen/doc/src/part.xml @@ -40,5 +40,6 @@ <xi:include href="block_tags.xml"/> <xi:include href="inline_tags.xml"/> <xi:include href="character_entities.xml"/> + <xi:include href="doc_storage.xml"/> </part> diff --git a/lib/erl_docgen/priv/bin/chunk.escript b/lib/erl_docgen/priv/bin/chunk.escript new file mode 100644 index 0000000000..a9ea6b9b73 --- /dev/null +++ b/lib/erl_docgen/priv/bin/chunk.escript @@ -0,0 +1,30 @@ +#!/usr/bin/env escript +%% -*- erlang -*- +%%! +A 1 +SDio 1 +S 1 -mode minimal +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2020. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%%---------------------------------------------------------------------- +%% File : chunk.escript +%% +%% Created : 1 Nov 2018 by Kenneth Lundin <uabkeld@elxa31hr002> +%% +%% Trampoline to xml to chunk creation. +%%---------------------------------------------------------------------- + +main(Args) -> + docgen_xml_to_chunk:main(Args). diff --git a/lib/erl_docgen/priv/bin/specs_gen.escript b/lib/erl_docgen/priv/bin/specs_gen.escript index 859f3c21f5..96b63aa667 100644 --- a/lib/erl_docgen/priv/bin/specs_gen.escript +++ b/lib/erl_docgen/priv/bin/specs_gen.escript @@ -48,7 +48,8 @@ main(Args) -> parse(["-o"++Dir | Opts], InclFs, _, Module) -> parse(Opts, InclFs, Dir, Module); parse(["-I"++I | Opts], InclFs, Dir, Module) -> - parse(Opts, [I | InclFs], Dir, Module); + Is = filelib:wildcard(I), + parse(Opts, Is ++ InclFs, Dir, Module); parse(["-module", Module | Opts], InclFs, Dir, _) -> parse(Opts, InclFs, Dir, Module); parse([File], InclFs, Dir, no_module) -> @@ -131,7 +132,7 @@ write_text(Text, File, Dir) -> ok; {error, R} -> R1 = file:format_error(R), - io:format("could not write file '~s': ~s\n", [File, R1]), + io:format("could not write file '~s': ~s\n", [OutFile, R1]), halt(2) end. diff --git a/lib/erl_docgen/priv/css/Makefile b/lib/erl_docgen/priv/css/Makefile index e3d2ee7e3f..da2ef5ad15 100644 --- a/lib/erl_docgen/priv/css/Makefile +++ b/lib/erl_docgen/priv/css/Makefile @@ -53,7 +53,9 @@ CSS_FILES = \ # ---------------------------------------------------- debug opt: -docs: +DOC_TARGETS?=html + +docs: $(DOC_TARGETS) clean: $(RM) $(TARGET_FILES) @@ -64,16 +66,17 @@ clean: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk - release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/priv/css" $(INSTALL_DATA) $(CSS_FILES) "$(RELSYSDIR)/priv/css" -release_docs_spec: +release_html_spec: html $(INSTALL_DIR) "$(RELEASE_PATH)/doc" $(INSTALL_DATA) $(CSS_FILES) ../nyi.html "$(RELEASE_PATH)/doc" +release_docs_spec: $(DOC_TARGETS:%=release_%_spec) + release_tests_spec: diff --git a/lib/erl_docgen/priv/dtd/Makefile b/lib/erl_docgen/priv/dtd/Makefile index e35e5f8826..fd8d8a43c7 100644 --- a/lib/erl_docgen/priv/dtd/Makefile +++ b/lib/erl_docgen/priv/dtd/Makefile @@ -46,7 +46,6 @@ DTD_FILES = \ fileref.dtd \ xhtml1-frameset.dtd \ appref.dtd \ - cites.dtd \ common.image.dtd \ cref.dtd \ part.dtd \ @@ -55,13 +54,9 @@ DTD_FILES = \ common.dtd \ common.refs.dtd \ erlref.dtd \ - report.dtd \ xhtml1-transitional.dtd \ - bookinsidecover.dtd \ common.entities.dtd \ - common.table.dtd \ - fascicules.dtd \ - terms.dtd + common.table.dtd ENT_FILES = \ xhtml-special.ent \ diff --git a/lib/erl_docgen/priv/dtd/bookinsidecover.dtd b/lib/erl_docgen/priv/dtd/bookinsidecover.dtd deleted file mode 100644 index ae22c45884..0000000000 --- a/lib/erl_docgen/priv/dtd/bookinsidecover.dtd +++ /dev/null @@ -1,37 +0,0 @@ -<!-- - ``Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - Portions created by Ericsson are Copyright 1999-2007, Ericsson AB. - All Rights Reserved.'' - - $Id$ ---> -<!ENTITY % ISOlat1 SYSTEM "xhtml-lat1.ent" > -%ISOlat1; - -<!ENTITY amp "&" > -<!ENTITY gt ">" > -<!ENTITY lt "<" > - -<!ELEMENT bookinsidecover (#PCDATA|br|theheader|vfill|tt|bold)* > - -<!ELEMENT tt (#PCDATA|br|theheader|vfill)* > -<!ELEMENT bold (#PCDATA|br|theheader|vfill)* > -<!ELEMENT vfill EMPTY > -<!ELEMENT theheader EMPTY > -<!ATTLIST theheader tag (title|prepared|responsible|docno| - approved|checked|date|rev|file| - none) "none" > - -<!ELEMENT br EMPTY > diff --git a/lib/erl_docgen/priv/dtd/cites.dtd b/lib/erl_docgen/priv/dtd/cites.dtd deleted file mode 100644 index 4558947db0..0000000000 --- a/lib/erl_docgen/priv/dtd/cites.dtd +++ /dev/null @@ -1,36 +0,0 @@ -<!-- - ``Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - Portions created by Ericsson are Copyright 1999-2007, Ericsson AB. - All Rights Reserved.'' - - $Id$ ---> -<!ENTITY % ISOlat1 SYSTEM "xhtml-lat1.ent" > -%ISOlat1; - -<!ENTITY amp "&" > -<!ENTITY gt ">" > -<!ENTITY lt "<" > - -<!-- Structure --> - -<!ELEMENT cites (cite)* > -<!ELEMENT cite (id, shortdef, def, resp?) > -<!ELEMENT id (#PCDATA) > -<!ELEMENT shortdef (#PCDATA) > -<!ELEMENT def (#PCDATA|c|i|em)* > -<!ELEMENT resp (#PCDATA) > -<!ELEMENT c (#PCDATA) > -<!ELEMENT em (#PCDATA|c)* > diff --git a/lib/erl_docgen/priv/dtd/common.dtd b/lib/erl_docgen/priv/dtd/common.dtd index 0ccd52068b..ca680c15b6 100644 --- a/lib/erl_docgen/priv/dtd/common.dtd +++ b/lib/erl_docgen/priv/dtd/common.dtd @@ -22,9 +22,8 @@ <!ENTITY % common.entities SYSTEM "common.entities.dtd" > %common.entities; -<!ENTITY % block "p|pre|code|list|taglist|codeinclude| - erleval" > -<!ENTITY % inline "#PCDATA|c|i|em|strong|term|cite|br|path|seealso| +<!ENTITY % block "p|pre|code|list|taglist|codeinclude" > +<!ENTITY % inline "#PCDATA|c|i|em|strong|term|br|seealso| url|marker|anno|image" > <!-- XXX --> <!ELEMENT p (%inline;)* > @@ -43,33 +42,16 @@ <!ELEMENT strong (#PCDATA|c|anno)* > <!ELEMENT anno (#PCDATA) > -<!-- XXX --> -<!ELEMENT term (termdef?) > -<!ATTLIST term id CDATA #REQUIRED > -<!ELEMENT termdef (#PCDATA) > -<!ELEMENT cite (citedef?) > -<!ATTLIST cite id CDATA #REQUIRED > -<!ELEMENT citedef (ctitle,cauthor,chowpublished) > -<!ELEMENT ctitle (#PCDATA) > -<!ELEMENT cauthor (#PCDATA) > -<!ELEMENT chowpublished (#PCDATA) > - <!-- XXX --> <!ELEMENT br EMPTY > -<!-- Path --> - -<!ELEMENT path (#PCDATA) > -<!ATTLIST path unix CDATA "" - windows CDATA "" > - <!-- List --> <!ELEMENT list (item+) > <!ATTLIST list type (ordered|bulleted) "bulleted" > -<!ELEMENT taglist (tag,item+)+ > +<!ELEMENT taglist (marker*,tag,item+)+ > <!ELEMENT tag (#PCDATA|c|i|em|br|seealso|url|marker|anno)* > -<!ELEMENT item (%inline;|%block;|warning|note|dont|do|quote)* > +<!ELEMENT item (%inline;|%block;|warning|note|dont|do|quote|table)* > <!-- References --> @@ -86,8 +68,3 @@ <!ATTLIST codeinclude file CDATA #REQUIRED tag CDATA "" type (erl|c|none) "none" > - -<!-- ErlEval --> - -<!ELEMENT erleval EMPTY > -<!ATTLIST erleval expr CDATA #REQUIRED > diff --git a/lib/erl_docgen/priv/dtd/fascicules.dtd b/lib/erl_docgen/priv/dtd/fascicules.dtd deleted file mode 100644 index 073d0cc1d9..0000000000 --- a/lib/erl_docgen/priv/dtd/fascicules.dtd +++ /dev/null @@ -1,36 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!-- - ``Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - Portions created by Ericsson are Copyright 1999-2007, Ericsson AB. - All Rights Reserved.'' - - $Id$ ---> - -<!ENTITY % ISOlat1 SYSTEM "xhtml-lat1.ent" > -%ISOlat1; - -<!ENTITY amp "&" > -<!ENTITY gt ">" > -<!ENTITY lt "<" > - -<!-- Structure --> - -<!ELEMENT fascicules (fascicule)+ > -<!ELEMENT fascicule (#PCDATA) > -<!ATTLIST fascicule file CDATA #REQUIRED - href CDATA #REQUIRED - entry (yes|no) "no" > - diff --git a/lib/erl_docgen/priv/dtd/report.dtd b/lib/erl_docgen/priv/dtd/report.dtd deleted file mode 100644 index 3dd1c3d347..0000000000 --- a/lib/erl_docgen/priv/dtd/report.dtd +++ /dev/null @@ -1,141 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!-- - ``Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - Portions created by Ericsson are Copyright 1999-2007, Ericsson AB. - All Rights Reserved.'' - - $Id$ ---> - -<!ENTITY % ISOlat1 SYSTEM "xhtml-lat1.ent" > -%ISOlat1; - -<!ENTITY amp "&" > -<!ENTITY gt ">" > -<!ENTITY lt "<" > - -<!ENTITY % header "title,prepared,responsible,docno,approved, - checked,date,rev,file" > -<!ENTITY % block "p|pre|code|list|taglist|erlinclude| - codeinclude|erleval" > -<!ENTITY % inline "#PCDATA|i|b|c|em|term|cite|br|path|seealso| - url|marker" > - -<!-- Structure --> - -<!ELEMENT report (header,section+) > -<!ELEMENT header (title,prepared,responsible?,docno,approved?, - checked?,date,rev,file?) > -<!ELEMENT title (#PCDATA) > -<!ELEMENT prepared (#PCDATA) > -<!ELEMENT responsible (#PCDATA) > -<!ELEMENT docno (#PCDATA) > -<!ELEMENT approved (#PCDATA) > -<!ELEMENT checked (#PCDATA) > -<!ELEMENT date (#PCDATA) > -<!ELEMENT rev (#PCDATA) > -<!ELEMENT file (#PCDATA) > - -<!ELEMENT section (marker*,title, - (%block;|quote|warning|note|dont|do|br|image|marker| - table|section)*) > -<!ELEMENT p (%inline;|index)* > -<!ELEMENT pre (#PCDATA|seealso|url|input)* > -<!ELEMENT input (#PCDATA|seealso|url)* > -<!ELEMENT code (#PCDATA) > -<!ATTLIST code type (erl|c|none) "none" > -<!ELEMENT quote (p)* > -<!ELEMENT warning (%block;|quote|br|image|marker|table)* > -<!ELEMENT note (%block;|quote|br|image|marker|table)* > -<!ELEMENT dont (%block;|quote|br|image|marker|table)* > -<!ELEMENT do (%block;|quote|br|image|marker|table)* > -<!ELEMENT i (#PCDATA|b|c|em)* > -<!ELEMENT b (#PCDATA|i|c|em)* > -<!ELEMENT c (#PCDATA) > -<!ELEMENT em (#PCDATA|i|b|c)* > -<!ELEMENT term (termdef?) > -<!ATTLIST term id CDATA #REQUIRED > -<!ELEMENT termdef (#PCDATA) > -<!ELEMENT cite (citedef?) > -<!ATTLIST cite id CDATA #REQUIRED > -<!ELEMENT citedef (ctitle,cauthor,chowpublished) > -<!ELEMENT ctitle (#PCDATA) > -<!ELEMENT cauthor (#PCDATA) > -<!ELEMENT chowpublished (#PCDATA) > -<!ELEMENT br EMPTY > - -<!-- Path --> - -<!ELEMENT path (#PCDATA) > -<!ATTLIST path unix CDATA "" - windows CDATA "" > - -<!-- List --> - -<!ELEMENT list (item+) > -<!ATTLIST list type (ordered|bulleted) "bulleted" > -<!ELEMENT taglist (tag,item)+ > -<!ELEMENT tag (#PCDATA|i|b|c|em|seealso|url)* > -<!ELEMENT item (%inline;|%block;)* > - -<!-- Image --> - -<!ELEMENT image (icaption?) > -<!ATTLIST image file CDATA #REQUIRED > -<!ELEMENT icaption (#PCDATA) > - -<!-- References --> - -<!ELEMENT seealso (#PCDATA) > -<!ATTLIST seealso marker CDATA #REQUIRED > -<!ELEMENT url (#PCDATA) > -<!ATTLIST url href CDATA #REQUIRED > -<!ELEMENT marker EMPTY > -<!ATTLIST marker id CDATA #REQUIRED > - -<!-- Table --> - -<!ELEMENT table (row+,tcaption?) > -<!ATTLIST table width CDATA "0" - colspec CDATA "" > -<!ELEMENT row (cell+) > -<!ELEMENT cell (%inline;)* > -<!ATTLIST cell align (left|center|right) "left" - valign (top|middle|bottom) "middle" > -<!ELEMENT tcaption (#PCDATA) > - -<!-- ErlInclude --> - -<!ELEMENT erlinclude EMPTY > -<!ATTLIST erlinclude file CDATA #REQUIRED - tag CDATA #REQUIRED > - -<!-- CodeInclude --> - -<!ELEMENT codeinclude EMPTY > -<!ATTLIST codeinclude file CDATA #REQUIRED - tag CDATA "" - type (erl|c|none) "none" > - -<!-- ErlEval --> - -<!ELEMENT erleval EMPTY > -<!ATTLIST erleval expr CDATA #REQUIRED > - -<!-- Index FOR COMPATIBILITY --> - -<!ELEMENT index EMPTY > -<!ATTLIST index txt CDATA #REQUIRED > - diff --git a/lib/erl_docgen/priv/dtd/terms.dtd b/lib/erl_docgen/priv/dtd/terms.dtd deleted file mode 100644 index c2965eb61c..0000000000 --- a/lib/erl_docgen/priv/dtd/terms.dtd +++ /dev/null @@ -1,37 +0,0 @@ -<!-- - ``Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - Portions created by Ericsson are Copyright 1999-2007, Ericsson AB. - All Rights Reserved.'' - - $Id$ ---> -<!ENTITY % ISOlat1 SYSTEM "xhtml-lat1.ent" > -%ISOlat1; - -<!ENTITY amp "&" > -<!ENTITY gt ">" > -<!ENTITY lt "<" > - -<!-- Structure --> - -<!ELEMENT terms (term)* > -<!ELEMENT term (id, shortdef, def, resp?) > -<!ELEMENT id (#PCDATA) > -<!ELEMENT shortdef (#PCDATA) > -<!ELEMENT def (#PCDATA|c|i|em)* > -<!ELEMENT resp (#PCDATA) > -<!ELEMENT c (#PCDATA) > -<!ELEMENT em (#PCDATA|c)* > - diff --git a/lib/erl_docgen/priv/images/Makefile b/lib/erl_docgen/priv/images/Makefile index cd98399b6a..b0263524fb 100644 --- a/lib/erl_docgen/priv/images/Makefile +++ b/lib/erl_docgen/priv/images/Makefile @@ -54,7 +54,9 @@ PNG_FILES = \ # ---------------------------------------------------- debug opt: -docs: +DOC_TARGETS?=html + +docs: $(DOC_TARGETS) clean: $(RM) $(TARGET_FILES) @@ -70,11 +72,12 @@ release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/priv/images" $(INSTALL_DATA) $(GIF_FILES) $(PNG_FILES) "$(RELSYSDIR)/priv/images" - -release_docs_spec: +release_html_spec: $(INSTALL_DIR) "$(RELEASE_PATH)/doc" $(INSTALL_DATA) $(PNG_FILES) "$(RELEASE_PATH)/doc" +release_docs_spec: $(DOC_TARGETS:%=release_%_spec) + release_tests_spec: diff --git a/lib/erl_docgen/priv/js/flipmenu/Makefile b/lib/erl_docgen/priv/js/flipmenu/Makefile index ad6d4acb6c..be0bed74fb 100644 --- a/lib/erl_docgen/priv/js/flipmenu/Makefile +++ b/lib/erl_docgen/priv/js/flipmenu/Makefile @@ -56,7 +56,9 @@ JS_FILES = \ # ---------------------------------------------------- debug opt: -docs: +DOC_TARGETS?=html + +docs: $(DOC_TARGETS) clean: $(RM) $(TARGET_FILES) @@ -67,17 +69,17 @@ clean: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk - release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/priv/js/flipmenu" $(INSTALL_DATA) $(JS_FILES) $(GIF_FILES) "$(RELSYSDIR)/priv/js/flipmenu" - -release_docs_spec: +release_html_spec: html $(INSTALL_DIR) "$(RELEASE_PATH)/doc/js/flipmenu" $(INSTALL_DATA) $(JS_FILES) $(GIF_FILES) "$(RELEASE_PATH)/doc/js/flipmenu" $(INSTALL_DATA) ../highlight.js ../highlight.pack.js "$(RELEASE_PATH)/doc/js/" +release_docs_spec: $(DOC_TARGETS:%=release_%_spec) + release_tests_spec: diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index aee496b948..8408d634bd 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -2532,30 +2532,6 @@ </xsl:template> - <xsl:template match="term"> - <xsl:value-of select="@id"/> - <!-- xsl:choose> - <xsl:when test="boolean(termdef)"> - <xsl:choose> - <xsl:when test="ancestor::parts"> - <a href="users_guide_glossary.html#{@id}"><xsl:value-of select="@id"/></a> - </xsl:when> - <xsl:when test="ancestor::applications"> - <a href="ref_man_glossary.html#{@id}"><xsl:value-of select="@id"/></a> - </xsl:when> - </xsl:choose> - </xsl:when> - <xsl:otherwise> - <a href="{$topdocdir}/glossary.html#{@id}"><xsl:value-of select="@id"/></a> - </xsl:otherwise> - </xsl:choose --> - </xsl:template> - - <xsl:template match="cite"> - <xsl:value-of select="@id"/> - </xsl:template> - - <!-- Release Notes --> <xsl:template match="releasenotes"> @@ -2609,118 +2585,6 @@ </div> </xsl:template> - <!-- Glossary --> - <xsl:template name="glossary"> - <xsl:param name="type"/> - <xsl:document href="{$outdir}/{$type}_glossary.html" method="html" encoding="UTF-8" indent="yes" doctype-public="-//W3C//DTD HTML 4.01 Transitional//EN"> - <html> - <head> - <link rel="stylesheet" href="{$topdocdir}/otp_doc.css" type="text/css"/> - <title>Erlang Documentation -- <xsl:value-of select="header/title"/></title> - </head> - <body bgcolor="white" text="#000000" link="#0000ff" vlink="#ff00ff" alink="#ff0000"> - - <div id="container"> - <script id="js" type="text/javascript" language="JavaScript" src="{$topdocdir}/js/flipmenu/flipmenu.js"/> - <script id="js2" type="text/javascript" src="{$topdocdir}/js/erlresolvelinks.js"></script> - - <!-- Generate menu --> - <xsl:call-template name="menu"/> - - <div id="content"> - <div class="innertube"> - <h1>Glossary</h1> - </div> - - <dl> - <xsl:for-each select="descendant::term"> - <xsl:sort select="@id"/> - <xsl:if test="boolean(termdef)"> - <dt><a name="{@id}"><strong><xsl:value-of select="@id"/></strong></a></dt> - <dd><xsl:value-of select="termdef"/></dd> - </xsl:if> - </xsl:for-each> - </dl> - - <div class="footer"> - <hr/> - <p> - <xsl:value-of select="$copyright"/> - <xsl:value-of select="header/copyright/year[1]"/> - <xsl:text>-</xsl:text> - <xsl:value-of select="header/copyright/year[2]"/> - <xsl:text> </xsl:text> - <xsl:value-of select="header/copyright/holder"/> - </p> - </div> - - </div> - </div> - - </body> - </html> - - </xsl:document> - </xsl:template> - - <!-- Bibliography --> - <xsl:template name="bibliography"> - - <xsl:param name="type"/> - <xsl:document href="{$outdir}/{$type}_bibliography.html" method="html" encoding="UTF-8" indent="yes" doctype-public="-//W3C//DTD HTML 4.01 Transitional//EN"> - <html> - <head> - <link rel="stylesheet" href="{$topdocdir}/otp_doc.css" type="text/css"/> - <title>Erlang Documentation -- <xsl:value-of select="header/title"/></title> - </head> - <body bgcolor="white" text="#000000" link="#0000ff" vlink="#ff00ff" alink="#ff0000"> - - <div id="container"> - <script id="js" type="text/javascript" language="JavaScript" src="{$topdocdir}/js/flipmenu/flipmenu.js"/> - <script id="js2" type="text/javascript" src="{$topdocdir}/js/erlresolvelinks.js"></script> - - <!-- Generate menu --> - <xsl:call-template name="menu"/> - - <div id="content"> - <div class="innertube"> - <h1>Bibliography</h1> - </div> - - <table> - <xsl:for-each select="descendant::cite"> - <xsl:sort select="@id"/> - <xsl:if test="boolean(citedef)"> - <tr> - <td><xsl:value-of select="@id"/></td> - <td><xsl:value-of select="citedef"/></td> - </tr> - </xsl:if> - </xsl:for-each> - </table> - - <div class="footer"> - <hr/> - <p> - <xsl:value-of select="$copyright"/> - <xsl:value-of select="header/copyright/year[1]"/> - <xsl:text>-</xsl:text> - <xsl:value-of select="header/copyright/year[2]"/> - <xsl:text> </xsl:text> - <xsl:value-of select="header/copyright/holder"/> - </p> - </div> - - </div> - </div> - - </body> - </html> - - </xsl:document> - </xsl:template> - - <!-- Special templates to calculate the arity of functions --> <xsl:template name="calc-arity"> <xsl:param name="string"/> diff --git a/lib/erl_docgen/priv/xsl/db_pdf.xsl b/lib/erl_docgen/priv/xsl/db_pdf.xsl index 7080394298..0e559f6067 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf.xsl @@ -980,7 +980,7 @@ </fo:block> - <xsl:apply-templates select="section|quote|warning|note|br|image|marker|table|p|pre|code|list|taglist|codeinclude|erleval"> + <xsl:apply-templates select="section|quote|warning|note|br|image|marker|table|p|pre|code|list|taglist|codeinclude"> <xsl:with-param name="partnum" select="$partnum"/> <xsl:with-param name="chapnum"><xsl:number/></xsl:with-param> </xsl:apply-templates> diff --git a/lib/erl_docgen/src/Makefile b/lib/erl_docgen/src/Makefile index 82d051e9bb..4c6f542ebb 100644 --- a/lib/erl_docgen/src/Makefile +++ b/lib/erl_docgen/src/Makefile @@ -38,7 +38,8 @@ RELSYSDIR = $(RELEASE_PATH)/lib/erl_docgen-$(VSN) MODULES = \ docgen_otp_specs \ docgen_edoc_xml_cb \ - docgen_xmerl_xml_cb + docgen_xmerl_xml_cb \ + docgen_xml_to_chunk HRL_FILES = diff --git a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl index 5342d02947..3354597de8 100644 --- a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl +++ b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl @@ -781,7 +781,7 @@ functions(Fs) -> function(_Name, E=#xmlElement{content = Es}) -> TypeSpec = get_content(typespec, Es), [?NL,{func, [ ?NL, - {name, + {name, [{since,""}], case funcheader(TypeSpec) of [] -> signature(get_content(args, Es), diff --git a/lib/erl_docgen/src/docgen_xml_to_chunk.erl b/lib/erl_docgen/src/docgen_xml_to_chunk.erl new file mode 100644 index 0000000000..32bfe980ef --- /dev/null +++ b/lib/erl_docgen/src/docgen_xml_to_chunk.erl @@ -0,0 +1,757 @@ +%% -*- erlang -*- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2020. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%%---------------------------------------------------------------------- +%% File : docgen_xml_to_chunk +%% +%% Created : 1 Nov 2018 by Kenneth Lundin <uabkeld@elxa31hr002> +%% +%% Does translation of Erlang XML docs to EEP-48 doc chunks. +%%---------------------------------------------------------------------- +-module(docgen_xml_to_chunk). +-export([main/1]). + +-include_lib("kernel/include/eep48.hrl"). + +main([FromBeam, _Escript, ToChunk]) -> + %% The given module is not documented, generate a hidden beam chunk file + Name = filename:basename(filename:rootname(FromBeam)) ++ ".erl", + + EmptyDocs = #docs_v1{ anno = erl_anno:set_file(Name, erl_anno:new(0)), + module_doc = hidden, docs = []}, + ok = file:write_file(ToChunk, term_to_binary(EmptyDocs,[compressed])), + ok; +main([FromXML, FromBeam, _Escript, ToChunk]) -> + _ = erlang:process_flag(max_heap_size,20 * 1000 * 1000), + case docs(FromXML, FromBeam) of + {error, Reason} -> + io:format("Failed to create chunks: ~p~n",[Reason]), + erlang:halt(1); + {docs_v1,_,_,_,_,#{ source := S },[]} when + %% This is a list of all modules that do are known not have any functions + S =/= "../xml/gen_fsm.xml", + S =/= "../xml/shell_default.xml", + S =/= "../xml/user.xml", + S =/= "../xml/wxClipboardTextEvent.xml", + S =/= "../xml/wxDisplayChangedEvent.xml", + S =/= "../xml/wxGBSizerItem.xml", + S =/= "../xml/wxGraphicsBrush.xml", + S =/= "../xml/wxGraphicsFont.xml", + S =/= "../xml/wxGraphicsPen.xml", + S =/= "../xml/wxInitDialogEvent.xml", + S =/= "../xml/wxMaximizeEvent.xml", + S =/= "../xml/wxMouseCaptureLostEvent.xml", + S =/= "../xml/wxPaintEvent.xml", + S =/= "../xml/wxPreviewCanvas.xml", + S =/= "../xml/wxSysColourChangedEvent.xml", + S =/= "../xml/wxTaskBarIconEvent.xml", + S =/= "../xml/wxWindowCreateEvent.xml", + S =/= "../xml/wxWindowDestroyEvent.xml", + S =/= "../xml/wxDataObject.xml" + -> + io:format("Failed to create chunks: no functions found ~s~n",[S]), + erlang:halt(1), + ok; + Docs -> + ok = file:write_file(ToChunk, term_to_binary(Docs,[compressed])) + end. + +%% Error handling +%%---------------------------------------------------------------------- + +-define(error(Reason), + throw({dom_error, Reason})). + +%%---------------------------------------------------------------------- + +%%====================================================================== +%% Records +%%====================================================================== + +%%---------------------------------------------------------------------- +%% State record for the validator +%%---------------------------------------------------------------------- +-record(state, { + tags=[], %% Tag stack + cno=[], %% Current node number + namespaces = [], %% NameSpace stack + dom=[] %% DOM structure + }). + +%%====================================================================== +%% External functions +%%====================================================================== + +%%---------------------------------------------------------------------- +%% Function: initial_state() -> Result +%% Parameters: +%% Result: +%% Description: +%%---------------------------------------------------------------------- +initial_state() -> + #state{}. + +%%---------------------------------------------------------------------- +%% Function: get_dom(State) -> Result +%% Parameters: +%% Result: +%% Description: +%%---------------------------------------------------------------------- +get_dom(#state{dom=Dom}) -> + Dom. + +%%---------------------------------------------------------------------- +%% Function: event(Event, LineNo, State) -> Result +%% Parameters: +%% Result: +%% Description: +%%---------------------------------------------------------------------- +event(Event, _LineNo, State) -> + build_dom(Event, State). + + +%%====================================================================== +%% Internal functions +%%====================================================================== + +%%---------------------------------------------------------------------- +%% Function : build_dom(Event, State) -> Result +%% Parameters: Event = term() +%% State = #xmerl_sax_simple_dom_state{} +%% Result : #xmerl_sax_simple_dom_state{} | +%% Description: +%%---------------------------------------------------------------------- + +%% Document +%%---------------------------------------------------------------------- +build_dom(startDocument, State) -> + State#state{dom=[startDocument]}; +build_dom(endDocument, + #state{dom=[{Tag, Attributes, Content} |D]} = State) -> + case D of + [startDocument] -> + State#state{dom=[{Tag, Attributes, + lists:reverse(Content)}]}; + [Decl, startDocument] -> + State#state{dom=[Decl, {Tag, Attributes, + lists:reverse(Content)}]}; + _ -> + %% endDocument is also sent by the parser when a fault occur to tell + %% the event receiver that no more input will be sent + State + end; + +%% Element +%%---------------------------------------------------------------------- +build_dom({startElement, _Uri, LocalName, _QName, Attributes}, + #state{tags=T, dom=D} = State) -> + + A = parse_attributes(LocalName, Attributes), + CName = list_to_atom(LocalName), + + State#state{tags=[CName |T], + dom=[{CName, + lists:reverse(A), + [] + } | D]}; +build_dom({endElement, _Uri, LocalName, _QName}, + #state{tags=[_ |T], + dom=[{CName, CAttributes, CContent}, + {PName, PAttributes, PContent} = _Parent | D]} = State) -> + case list_to_atom(LocalName) of + CName -> + SectionDepth = length([E || E <- T, E =:= section]), + MappedCName = + case CName of + title -> + lists:nth(SectionDepth+1,[h1,h2,h3]); + section when SectionDepth > 0 -> + p; + CName -> CName + end, + + State#state{tags=T, + dom=[{PName, PAttributes, + [{MappedCName, CAttributes, + lists:reverse(CContent)} + |PContent] + } | D]}; + _ -> + ?error("Got end of element: " ++ LocalName ++ " but expected: " ++ + CName) + end; + +%% Text +%%---------------------------------------------------------------------- +build_dom({characters, String}, + #state{dom=[{Name, Attributes, Content}| D]} = State) -> + HtmlEnts = [{" ",[160]}, + {"×",[215]}, + {"±",[177]}, + {"ö","ö"}, + {"ä","ä"}, + {"å","å"} + ], + + NoHtmlEnt = + lists:foldl( + fun({Pat,Sub},Str) -> + re:replace(Str,Pat,Sub,[global,unicode]) + end,String,HtmlEnts), + + case re:run(NoHtmlEnt,"&[a-z]*;",[{capture,first,binary},unicode]) of + nomatch -> ok; + {match,[<<"<">>]} -> ok; + {match,[<<">">>]} -> ok; + Else -> throw({found_illigal_thing,Else,String}) + end, + NewContent = + [unicode:characters_to_binary(NoHtmlEnt,utf8)| Content], + State#state{dom=[{Name, Attributes, NewContent} | D]}; + +build_dom({ignorableWhitespace, String}, + #state{dom=[{Name,_,_} = _E|_]} = State) -> + case lists:member(Name, + [p,pre,input,code,quote,warning, + note,dont,do,c,i,em,strong, + seealso,tag,item]) of + true -> +% io:format("Keep ign white: ~p ~p~n",[String, _E]), + build_dom({characters, String}, State); + false -> + State + end; + +build_dom({startEntity, SysId}, State) -> + io:format("startEntity:~p~n",[SysId]), + State; + +%% Default +%%---------------------------------------------------------------------- +build_dom(_E, State) -> + State. + +%%---------------------------------------------------------------------- +%% Function : parse_attributes(ElName, Attributes) -> Result +%% Parameters: +%% Result : +%% Description: +%%---------------------------------------------------------------------- +parse_attributes(ElName, Attributes) -> + parse_attributes(ElName, Attributes, 1, []). + +parse_attributes(_, [], _, Acc) -> + Acc; +parse_attributes(ElName, [{_Uri, _Prefix, LocalName, AttrValue} |As], N, Acc) -> + parse_attributes(ElName, As, N+1, [{list_to_atom(LocalName), AttrValue} |Acc]). + +docs(OTPXml, FromBEAM)-> + case xmerl_sax_parser:file(OTPXml, + [skip_external_dtd, + {event_fun,fun event/3}, + {event_state,initial_state()}]) of + {ok,Tree,_} -> + {ok, {Module, Chunks}} = beam_lib:chunks(FromBEAM,[exports,abstract_code]), + Dom = get_dom(Tree), + NewDom = transform(Dom,[]), + Chunk = to_chunk(NewDom, OTPXml, Module, proplists:get_value(abstract_code, Chunks)), + verify_chunk(Module,proplists:get_value(exports, Chunks), Chunk), + Chunk; + Else -> + {error,Else} + end. + +verify_chunk(M, Exports, #docs_v1{ docs = Docs } = Doc) -> + + %% Make sure that each documented function actually is exported + Exported = [begin + FA = {F,A}, + {M,F,A,lists:member(FA,Exports)} + end || {{function,F,A},_,_,_,_} <- Docs], + lists:foreach(fun({_M,_F,_A,true}) -> + ok + end,Exported), + + try + shell_docs:validate(Doc) + catch Err -> + throw({maps:get(<<"en">>,Doc#docs_v1.module_doc), Err}) + end. + +%% skip <erlref> but transform and keep its content +transform([{erlref,_Attr,Content}|T],Acc) -> + Module = [Mod || Mod = {module,_,_} <- Content], + NewContent = Content -- Module, + [{module,SinceAttr,[Mname]}] = Module, + Since = case proplists:get_value(since,SinceAttr) of + undefined -> []; + [] -> []; + Vsn -> [{since,Vsn}] + end, + transform([{module,[{name,Mname}|Since],NewContent}|T],Acc); + +%% skip <header> and all of its content +transform([{header,_Attr,_Content}|T],Acc) -> + transform(T,Acc); +transform([{section,Attr,Content}|T],Acc) -> + transform(T,[{section,Attr,transform(Content,[])}|Acc]); + +%% transform <list><item> to <ul><li> or <ol><li> depending on type attribute +transform([{list,Attr,Content}|T],Acc) -> + transform([transform_list(Attr,Content)|T],Acc); + +%% transform <taglist>(tag,item+)+ to <dl>(dt,item+)+ +transform([{taglist,Attr,Content}|T],Acc) -> + transform([transform_taglist(Attr,Content)|T],Acc); + +%% remove <anno> as it is only used to validate specs vs xml src +transform([{anno,[],Content}|T],Acc) -> + transform([Content|T],Acc); + +%% transform <c> to <code> +transform([{c,[],Content}|T],Acc) -> + transform(T, [{code,[],transform(Content,[])}|Acc]); + +%% transform <code> to <pre><code> +transform([{code,Attr,Content}|T],Acc) -> + transform(T, [{pre,[],[{code,Attr,transform(Content,[])}]}|Acc]); +%% transform <pre> to <pre><code> +transform([{pre,Attr,Content}|T],Acc) -> + transform(T, [{pre,[],[{code,Attr,transform(Content,[])}]}|Acc]); + +%% transform <funcs> with <func> as children +transform([{funcs,_Attr,Content}|T],Acc) -> + Fns = {functions,[],transform_funcs(Content, [])}, + transform(T,[Fns|Acc]); +%% transform <datatypes> with <datatype> as children +transform([{datatypes,_Attr,Content}|T],Acc) -> + Dts = transform(Content, []), + transform(T,[{datatypes,[],Dts}|Acc]); +transform([{datatype,_Attr,Content}|T],Acc) -> + transform(T,transform_datatype(Content, []) ++ Acc); +%% Ignore <datatype_title> +transform([{datatype_title,_Attr,_Content}|T],Acc) -> + transform(T,Acc); +%% transform <desc>Content</desc> to Content +transform([{desc,_Attr,Content}|T],Acc) -> + transform(T,[transform(Content,[])|Acc]); +transform([{strong,Attr,Content}|T],Acc) -> + transform([{em,Attr,Content}|T],Acc); +%% transform <marker id="name"/> to <a id="name"/>.... +transform([{marker,Attr,Content}|T],Acc) -> + transform(T,[{a,Attr,transform(Content,[])}|Acc]); +%% transform <url href="external URL"> Content</url> to <a href.... +transform([{url,Attr,Content}|T],Acc) -> + transform(T,[{a,Attr,transform(Content,[])}|Acc]); +%% transform note/warning/do/don't to <p class="thing"> +transform([{What,[],Content}|T],Acc) + when What =:= note; What =:= warning; What =:= do; What =:= dont -> + WhatP = {p,[{class,atom_to_list(What)}], transform(Content,[])}, + transform(T,[WhatP|Acc]); + +transform([{type,_,[]}|_] = Dom,Acc) -> + %% Types are laid out sequentially in the source xml so we need to + %% parse them like that here too. + case transform_types(Dom,[]) of + {[],T} -> + transform(T,Acc); + {Types,T} -> + %% We sort the types here because in the source xml + %% the description and the declaration do not have + %% to be next to each other. But we want to have that + %% for the doc chunks. + NameSort = fun({li,A,_},{li,B,_}) -> + NameA = proplists:get_value(name,A), + NameB = proplists:get_value(name,B), + if NameA == NameB -> + length(A) =< length(B); + true -> + NameA < NameB + end + end, + transform(T,[{ul,[{class,"types"}],lists:sort(NameSort,Types)}|Acc]) + end; +transform([{type_desc,Attr,_Content}|T],Acc) -> + %% We skip any type_desc with the variable attribute + true = proplists:is_defined(variable, Attr), + transform(T,Acc); +transform([{type,[],Content}|T],Acc) -> + transform(T,[{ul,[{class,"types"}],transform(Content,[])}|Acc]); +transform([{v,[],Content}|T],Acc) -> + transform(T, [{li,[{class,"type"}],transform(Content,[])}|Acc]); +transform([{d,[],Content}|T],Acc) -> + transform(T, [{li,[{class,"description"}],transform(Content,[])}|Acc]); + +transform([Tag = {seealso,_Attr,_Content}|T],Acc) -> + transform([transform_seealso(Tag)|T],Acc); + +transform([{term,Attr,[]}|T],Acc) -> + transform([list_to_binary(proplists:get_value(id,Attr))|T],Acc); + +transform([{fsummary,_,_}|T],Acc) -> + %% We skip fsummary as it many times is just a duplicate of the + %% first line of the docs. + transform(T,Acc); + +transform([{input,_,Content}|T],Acc) -> + %% Just remove input as it is not used by anything + transform(T,[transform(Content,[])|Acc]); + +%% Tag and Attr is used as is but Content is transformed +transform([{Tag,Attr,Content}|T],Acc) -> + transform(T,[{Tag,Attr,transform(Content,[])}|Acc]); +transform([Binary|T],Acc) -> + transform(T,[Binary|Acc]); +transform([],Acc) -> + lists:flatten(lists:reverse(Acc)). + +transform_list([{type,"ordered"}],Content) -> + {ol,[],[{li,A2,C2}||{item,A2,C2}<-Content]}; +transform_list(_,Content) -> + {ul,[],[{li,A2,C2}||{item,A2,C2}<-Content]}. + +transform_types([{type,Attr,[]}|T],Acc) -> + case proplists:is_defined(name,Attr) of + true -> + transform_types(T, [{li,Attr,[]}|Acc]); + false -> + true = proplists:is_defined(variable, Attr), + transform_types(T, Acc) + end; +transform_types([{type_desc,Attr,Content}|T],Acc) -> + case proplists:is_defined(name,Attr) of + true -> + TypeDesc = transform(Content,[]), + transform_types(T, [{li,Attr ++ [{class,"description"}],TypeDesc}|Acc]); + false -> + true = proplists:is_defined(variable, Attr), + transform_types(T, Acc) + end; +transform_types([{type,_,_}|_T],_Acc) -> + throw(mixed_type_declarations); +transform_types(Dom,Acc) -> + {lists:reverse(Acc),Dom}. + +transform_taglist(Attr,Content) -> + Items = + lists:map(fun({tag,A,C}) -> + {dt,A,C}; + ({item,A,C}) -> + {dd,A,C} + end, Content), + {dl,Attr,Items}. + +%% if we have {func,[],[{name,...},{name,....},...]} +%% we convert it to one {func,[],[{name,...}] per arity lowest first. +transform_funcs([Func|T],Acc) -> + transform_funcs(T,func2func(Func) ++ Acc); +transform_funcs([],Acc) -> + lists:reverse(Acc). + +func2func({func,Attr,Contents}) -> + + ContentsNoName = [NC||NC <- Contents, element(1,NC) /= name], + + EditLink = + case proplists:get_value(ghlink,Attr) of + undefined -> + #{}; + GhLink -> + #{ edit_url => + iolist_to_binary(["https://github.com/erlang/otp/edit/",GhLink]) } + end, + + VerifyNameList = + fun(NameList, Test) -> + %% Assert that we don't mix ways to write <name> + [begin + ok = Test(C), + {proplists:get_value(name,T),proplists:get_value(arity,T)} + end || {name,T,C} <- NameList] + end, + + NameList = [Name || {name,_,_} = Name <- Contents], + + %% "Since" is hard to accurately as there can be multiple <name> per <func> and they + %% can refer to the same or other arities. This should be improved in the future but + %% for now we set since to a comma separated list of all since attributes. + SinceMD = + case [proplists:get_value(since, SinceAttr) || + {name,SinceAttr,_} <- NameList, proplists:get_value(since, SinceAttr) =/= []] of + [] -> EditLink; + Sinces -> + EditLink#{ since => unicode:characters_to_binary( + lists:join(",",lists:usort(Sinces))) } + end, + + Functions = + case NameList of + [{name,_,[]}|_] -> + %% Spec style function docs + TagsToFA = + fun(Tags) -> + {proplists:get_value(name,Tags), + proplists:get_value(arity,Tags)} + end, + + _ = VerifyNameList(NameList,fun([]) -> ok end), + + FAs = [TagsToFA(FAttr) || {name,FAttr,[]} <- NameList ], + FAClauses = lists:usort([{TagsToFA(FAttr),proplists:get_value(clause_i,FAttr)} + || {name,FAttr,[]} <- NameList ]), + Signature = [iolist_to_binary([F,"/",A]) || {F,A} <- FAs], + lists:map( + fun({F,A}) -> + Specs = [{func_to_atom(CF),list_to_integer(CA),C} + || {{CF,CA},C} <- FAClauses, + F =:= CF, A =:= CA], + {function,[{name,F},{arity,list_to_integer(A)}, + {signature,Signature}, + {meta,SinceMD#{ signature => Specs }}], + ContentsNoName} + end, lists:usort(FAs)); + NameList -> + %% Manual style function docs + FAs = lists:flatten([func_to_tuple(NameString) || {name, _Attr, NameString} <- NameList]), + + _ = VerifyNameList(NameList,fun([_|_]) -> ok end), + + Signature = [strip_tags(NameString) || {name, _Attr, NameString} <- NameList], + [{function,[{name,F},{arity,A}, + {signature,Signature}, + {meta,SinceMD}],ContentsNoName} + || {F,A} <- lists:usort(FAs)] + end, + transform(Functions,[]). + +func_to_tuple(Chars) -> + try + [Name,Args] = string:split(strip_tags(Chars),"("), + Arities = parse_args(unicode:characters_to_list(Args)), + [{unicode:characters_to_list(Name),Arity} || Arity <- Arities] + catch E:R:ST -> + io:format("Failed to parse: ~p~n",[Chars]), + erlang:raise(E,R,ST) + end. + +%% This function parses a documentation <name> attribute to figure +%% out the arities if that function. Example: +%% "start([go,Mode] [,Extra])" returns [1, 2]. +%% +%% This assumes that when a single <name> describes many arities +%% the arities are listed with [, syntax. +parse_args(")" ++ _) -> + [0]; +parse_args(Args) -> + parse_args(unicode:characters_to_list(Args),1,[]). +parse_args([$[,$,|T],Arity,[]) -> + parse_args(T,Arity,[$[]) ++ parse_args(T,Arity+1,[]); +parse_args([$,|T],Arity,[]) -> + parse_args(T,Arity+1,[]); +parse_args([Open|T],Arity,Stack) + when Open =:= $[; Open =:= ${; Open =:= $( -> + parse_args(T,Arity,[Open|Stack]); +parse_args([$]|T],Arity,[$[|Stack]) -> + parse_args(T,Arity,Stack); +parse_args([$}|T],Arity,[${|Stack]) -> + parse_args(T,Arity,Stack); +parse_args([$)|T],Arity,[$(|Stack]) -> + parse_args(T,Arity,Stack); +parse_args([$)|_T],Arity,[]) -> + [Arity]; +parse_args([_H|T],Arity,Stack) -> + parse_args(T,Arity,Stack). + +strip_tags([{_Tag,_Attr,Content}|T]) -> + [Content | strip_tags(T)]; +strip_tags([H|T]) when not is_tuple(H) -> + [H | strip_tags(T)]; +strip_tags([]) -> + []. + +transform_datatype(Dom,_Acc) -> + ContentsNoName = transform([NC||NC <- Dom, element(1,NC) /= name],[]), + [case N of + {name,NameAttr,[]} -> + {datatype,NameAttr,ContentsNoName}; + {name,[],Content} -> + [{Name,Arity}] = func_to_tuple(Content), + Signature = strip_tags(Content), + {datatype,[{name,Name},{n_vars,integer_to_list(Arity)}, + {signature,Signature}],ContentsNoName} + end || N = {name,_,_} <- Dom]. + +transform_seealso({seealso,Attr,_Content}) -> + {a, Attr, _Content}. + +to_chunk(Dom, Source, Module, AST) -> + [{module,MAttr,Mcontent}] = Dom, + + ModuleDocs = lists:flatmap( + fun({Tag,_,Content}) when Tag =:= description; + Tag =:= section -> + Content; + ({_,_,_}) -> + [] + end, Mcontent), + + TypeMeta = add_types(AST, maps:from_list([{source,Source}|MAttr])), + + TypeMap = maps:get(types, TypeMeta, []), + + Anno = erl_anno:set_file(atom_to_list(Module)++".erl",erl_anno:new(0)), + + Types = lists:flatten([Types || {datatypes,[],Types} <- Mcontent]), + + TypeEntries = + lists:map( + fun({datatype,Attr,Descr}) -> + TypeName = func_to_atom(proplists:get_value(name,Attr)), + TypeArity = case proplists:get_value(n_vars,Attr) of + undefined -> + find_type_arity(TypeName, TypeMap); + Arity -> + list_to_integer(Arity) + end, + TypeArgs = lists:join(",",[lists:concat(["Arg",I]) || I <- lists:seq(1,TypeArity)]), + PlaceholderSig = io_lib:format("-type ~p(~s) :: term().",[TypeName,TypeArgs]), + TypeSignature = proplists:get_value( + signature,Attr,[iolist_to_binary(PlaceholderSig)]), + MetaSig = + case maps:get({TypeName, TypeArity}, TypeMap, undefined) of + undefined -> + #{}; + Sig -> + #{ signature => [Sig] } + end, + docs_v1_entry(type, Anno, TypeName, TypeArity, TypeSignature, MetaSig, Descr) + end, Types), + + Functions = lists:flatten([Functions || {functions,[],Functions} <- Mcontent]), + + FuncEntrys = + lists:flatmap( + fun({function,Attr,Fdoc}) -> + case func_to_atom(proplists:get_value(name,Attr)) of + callback -> + []; + Name -> + Arity = proplists:get_value(arity,Attr), + Signature = proplists:get_value(signature,Attr), + FMeta = proplists:get_value(meta,Attr), + MetaWSpec = add_spec(AST,FMeta), + [docs_v1_entry(function, Anno, Name, Arity, Signature, MetaWSpec, Fdoc)] + end + end, Functions), + + docs_v1(ModuleDocs, Anno, TypeMeta, FuncEntrys ++ TypeEntries). + +docs_v1(DocContents, Anno, Metadata, Docs) -> + #docs_v1{ anno = Anno, + module_doc = #{<<"en">> => shell_docs:normalize(DocContents)}, + metadata = maps:merge(Metadata, (#docs_v1{})#docs_v1.metadata), + docs = Docs }. + +docs_v1_entry(Kind, Anno, Name, Arity, Signature, Metadata, DocContents) -> + AnnoWLine = + case Metadata of + #{ signature := [Sig|_] } -> + erl_anno:set_line(element(2, Sig), Anno); + _NoSignature -> + Anno + end, + {{Kind, Name, Arity}, AnnoWLine, lists:flatten(Signature), + #{ <<"en">> => shell_docs:normalize(DocContents)}, Metadata}. + +%% A special list_to_atom that handles +%% 'and' +%% Destroy +%% 'begin' +func_to_atom(List) -> + case erl_scan:string(List) of + {ok,[{atom,_,Fn}],_} -> Fn; + {ok,[{var,_,Fn}],_} -> Fn; + {ok,[{Fn,_}],_} -> Fn; + {ok,[{var,_,_},{':',_},_],_} -> + callback + end. + +-define(IS_TYPE(TO),(TO =:= type orelse TO =:= opaque)). + +add_spec(no_abstract_code, Meta) -> + Meta; +add_spec({raw_abstract_v1, AST}, Meta = #{ signature := Specs } ) -> + Meta#{ signature := add_spec_clauses(AST, merge_clauses(Specs,#{})) }; +add_spec(_, Meta) -> + Meta. + +add_types(no_abstract_code, Meta) -> + Meta; +add_types({raw_abstract_v1, AST}, Meta) -> + Meta#{ types => + maps:from_list( + [{{Name,length(Args)},T} || T = {attribute,_,TO,{Name, _, Args}} <- AST, + ?IS_TYPE(TO)]) }. + +add_spec_clauses(AST, [{{F,A},Clauses}|T]) -> + [filter_clauses(find_spec(AST,F,A),Clauses) | add_spec_clauses(AST,T)]; +add_spec_clauses(_AST, []) -> + []. + +filter_clauses(Spec,[undefined]) -> + Spec; +filter_clauses({attribute,Ln,spec,{FA,Clauses}},ClauseIds) -> + {_,FilteredClauses} = + lists:foldl( + fun({TO,_,_,_} = C,{Cnt,Acc}) when ?IS_TYPE(TO) -> + case lists:member(integer_to_list(Cnt),ClauseIds) of + true -> + {Cnt+1,[C | Acc]}; + false -> + {Cnt+1,Acc} + end + end, {1, []}, Clauses), + {attribute,Ln,spec,{FA,lists:reverse(FilteredClauses)}}. + +merge_clauses([{F,A,Clause}|T],Acc) -> + merge_clauses(T,Acc#{ {F,A} => [Clause | maps:get({F,A},Acc,[])]}); +merge_clauses([],Acc) -> + maps:to_list(Acc). + +find_type_arity(Name, [{{Name,_},{attribute,_,TO,{Name,_,Args}}}|_T]) when ?IS_TYPE(TO) -> + length(Args); +find_type_arity(Name, [_|T]) -> + find_type_arity(Name,T); +find_type_arity(Name, Map) when is_map(Map) -> + find_type_arity(Name, maps:to_list(Map)). + +find_spec(AST, Func, Arity) -> + Specs = lists:filter(fun({attribute,_,spec,{{F,A},_}}) -> + F =:= Func andalso A =:= Arity; + ({attribute,_,spec,{{_,F,A},_}}) -> + F =:= Func andalso A =:= Arity; + (_) -> + false + end, AST), + case Specs of + [S] -> + S; + [] -> + io:format("Could not find spec for ~p/~p~n",[Func,Arity]), + exit(1) + end. diff --git a/lib/erl_docgen/src/erl_docgen.app.src b/lib/erl_docgen/src/erl_docgen.app.src index 171c697585..c2641f30df 100644 --- a/lib/erl_docgen/src/erl_docgen.app.src +++ b/lib/erl_docgen/src/erl_docgen.app.src @@ -3,7 +3,8 @@ {vsn, "%VSN%"}, {modules, [docgen_otp_specs, docgen_edoc_xml_cb, - docgen_xmerl_xml_cb + docgen_xmerl_xml_cb, + docgen_xml_to_chunk ] }, {registered,[]}, diff --git a/lib/erl_interface/Makefile b/lib/erl_interface/Makefile index 9471b0df18..633e705b3f 100644 --- a/lib/erl_interface/Makefile +++ b/lib/erl_interface/Makefile @@ -31,3 +31,5 @@ SPECIAL_TARGETS = # Default Subdir Targets # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/erl_interface/configure.in b/lib/erl_interface/configure.in index 230dba25d6..55baae7479 100644 --- a/lib/erl_interface/configure.in +++ b/lib/erl_interface/configure.in @@ -336,6 +336,10 @@ if test "X$host" = "Xwin32"; then LIB_CFLAGS="$CFLAGS" else if test "x$GCC" = xyes; then + # Remove all PIE stuff + CFLAGS=`echo $CFLAGS | sed 's/-f\(no-\)\?PIE//g'` + LDFLAGS=`echo $LDFLAGS | sed 's/-\(no-\)\?pie//g'` + LIB_CFLAGS="$CFLAGS -fPIC" else LIB_CFLAGS="$CFLAGS" diff --git a/lib/erl_interface/doc/src/Makefile b/lib/erl_interface/doc/src/Makefile index 03044a0ddd..95f3e77c61 100644 --- a/lib/erl_interface/doc/src/Makefile +++ b/lib/erl_interface/doc/src/Makefile @@ -36,93 +36,24 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- -XML_REF1_FILES = erl_call.xml -XML_REF3_FILES = erl_connect.xml \ - erl_error.xml \ - erl_eterm.xml \ - erl_format.xml \ - erl_malloc.xml \ - erl_marshal.xml \ - erl_global.xml \ +XML_REF1_FILES = erl_call_cmd.xml +XML_REF3_FILES = ei_global.xml \ ei.xml \ ei_connect.xml \ registry.xml BOOK_FILES = book.xml XML_APPLICATION_FILES = ref_man.xml -#ref_man_ei.xml ref_man_erl_interface.xml + XML_PART_FILES = \ part.xml XML_CHAPTER_FILES = ei_users_guide.xml notes.xml XML_FILES = $(XML_REF1_FILES) $(XML_REF3_FILES) $(BOOK_FILES) \ $(XML_APPLICATION_FILES) $(XML_PART_FILES) $(XML_CHAPTER_FILES) -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -GIF_FILES = - -MAN1_FILES = $(XML_REF1_FILES:%.xml=$(MAN1DIR)/%.1) -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +NO_CHUNKS=$(XML_REF3_FILES) # ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN1_FILES) $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt lcnt: - -clean clean_docs clean_tex: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN1DIR)/* - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man1" - $(INSTALL_DATA) $(MAN1_FILES) "$(RELEASE_PATH)/man/man1" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3_FILES) "$(RELEASE_PATH)/man/man3" - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml index 70af5642da..232871e864 100644 --- a/lib/erl_interface/doc/src/ei.xml +++ b/lib/erl_interface/doc/src/ei.xml @@ -49,14 +49,9 @@ <p><c>ei</c> also handles C-nodes, C-programs that talks Erlang distribution with Erlang nodes (or other C-nodes) using the - Erlang distribution format. The difference between <c>ei</c> - and <c>erl_interface</c> is that <c>ei</c> uses - the binary format directly when sending and receiving terms. It is also + Erlang distribution format.The <c>ei</c> library is thread safe, and using threads, one process can handle multiple - C-nodes. The <c>erl_interface</c> library is built on top of - <c>ei</c>, but of legacy reasons, it does not allow for - multiple C-nodes. In general, <c>ei</c> is the preferred way - of doing C-nodes.</p> + C-nodes.</p> <p>The decode and encode functions use a buffer and an index into the buffer, which points at the point where to encode and @@ -378,22 +373,6 @@ typedef enum { </func> <func> - <name since=""><ret>int</ret><nametext>ei_decode_term(const char *buf, int *index, void *t)</nametext></name> - <fsummary>Decode a <c>ETERM</c>.</fsummary> - <desc> - <p>Decodes a term from the binary format. The term - is return in <c>t</c> as a <c>ETERM*</c>, so - <c>t</c> is actually an <c>ETERM**</c> (see - <seealso marker="erl_eterm"><c>erl_eterm</c></seealso>). - The term is later to be deallocated.</p> - <note><p>This function is deprecated as of OTP 22 and will be removed in - OTP 23 together with the old legacy <c>erl_interface</c> library (functions - with prefix <c>erl_</c>).</p> - </note> - </desc> - </func> - - <func> <name since=""><ret>int</ret><nametext>ei_decode_trace(const char *buf, int *index, erlang_trace *p)</nametext></name> <fsummary>Decode a trace token.</fsummary> <desc> @@ -707,22 +686,6 @@ ei_x_encode_string(&x, "Banana");</pre> the <c>ei_x_encode_string_len()</c> function.</p> </desc> </func> - - <func> - <name since=""><ret>int</ret><nametext>ei_encode_term(char *buf, int *index, void *t)</nametext></name> - <name since=""><ret>int</ret><nametext>ei_x_encode_term(ei_x_buff* x, void *t)</nametext></name> - <fsummary>Encode an <c>erl_interface</c> term.</fsummary> - <desc> - <p>Encodes an <c>ETERM</c>, as obtained from - <c>erl_interface</c>. Parameter <c>t</c> is - actually an <c>ETERM</c> pointer. This function - does not free the <c>ETERM</c>.</p> - <note><p>These functions are deprecated as of OTP 22 and will be removed in - OTP 23 together with the old legacy <c>erl_interface</c> library - (functions with prefix <c>erl_</c>).</p> - </note> - </desc> - </func> <func> <name since=""><ret>int</ret><nametext>ei_encode_trace(char *buf, int *index, const erlang_trace *p)</nametext></name> <name since=""><ret>int</ret><nametext>ei_x_encode_trace(ei_x_buff* x, const erlang_trace *p)</nametext></name> @@ -806,11 +769,7 @@ ei_encode_tuple_header(buf, &i, 0);</pre> <desc> <p>Initialize the <c>ei</c> library. This function should be called once (and only once) before calling any other functionality in the <c>ei</c> - library. However, note the exception below.</p> - <p>If the <c>ei</c> library is used together with the <c>erl_interface</c> - library, this function should <em>not</em> be called directly. It will be - called by the <c>erl_init()</c> function which should be used to initialize - the combination of the two libraries instead.</p> + library.</p> <p>On success zero is returned. On failure a posix error code is returned.</p> </desc> </func> @@ -990,8 +949,4 @@ encodes the tuple {numbers,12,3.14159}</pre> </list> </section> - <section> - <title>See Also</title> - <p><seealso marker="erl_eterm"><c>erl_eterm</c></seealso></p> - </section> </cref> diff --git a/lib/erl_interface/doc/src/ei_connect.xml b/lib/erl_interface/doc/src/ei_connect.xml index 795f1249b3..06fe9d1960 100644 --- a/lib/erl_interface/doc/src/ei_connect.xml +++ b/lib/erl_interface/doc/src/ei_connect.xml @@ -422,6 +422,8 @@ typedef struct { <func> <name since=""><ret>int</ret><nametext>ei_connect(ei_cnode* ec, char *nodename)</nametext></name> <name since=""><ret>int</ret><nametext>ei_xconnect(ei_cnode* ec, Erl_IpAddr adr, char *alivename)</nametext></name> + <name since="OTP @OTP-16251@"><ret>int</ret><nametext>ei_connect_host_port(ei_cnode* ec, char *hostname, int port)</nametext></name> + <name since="OTP @OTP-16251@"><ret>int</ret><nametext>ei_xconnect_host_port(ei_cnode* ec, Erl_IpAddr adr, int port)</nametext></name> <fsummary>Establish a connection to an Erlang node.</fsummary> <desc> <p>Sets up a connection to an Erlang node.</p> @@ -429,13 +431,21 @@ typedef struct { remote host and the alive name of the remote node to be specified. <c>ei_connect()</c> provides an alternative interface and determines the information from the node name - provided.</p> + provided. The <c>ei_xconnect_host_port()</c> function provides + yet another alternative that will work even if there is no + EPMD instance on the host where the remote node is running. The + <c>ei_xconnect_host_port()</c> function requires the IP + address and port of the remote node to be specified. + The <c>ei_connect_host_port()</c> function is an alternative + to <c>ei_xconnect_host_port()</c> that lets the user specify + a hostname instead of an IP address.</p> <list type="bulleted"> - <item><c>addr</c> is the 32-bit IP address of the remote + <item><c>adr</c> is the 32-bit IP address of the remote host.</item> <item><c>alive</c> is the alivename of the remote node. </item> <item><c>node</c> is the name of the remote node.</item> + <item><c>port</c> is the port number of the remote node.</item> </list> <p>These functions return an open file descriptor on success, or a negative value indicating that an error occurred. In the latter @@ -571,13 +581,16 @@ if (ei_connect_init(&ec, "madonna", "cookie...", n++) < 0) { <func> <name since=""><ret>int</ret><nametext>ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned timeout_ms)</nametext></name> <name since=""><ret>int</ret><nametext>ei_xconnect_tmo(ei_cnode* ec, Erl_IpAddr adr, char *alivename, unsigned timeout_ms)</nametext></name> + <name since="OTP @OTP-16251@"><ret>int</ret><nametext>ei_connect_host_port_tmo(ei_cnode* ec, char *hostname, int port, unsigned ms)</nametext></name> + <name since="OTP @OTP-16251@"><ret>int</ret><nametext>ei_xconnect_host_port_tmo(ei_cnode* ec, Erl_IpAddr adr, int port, unsigned ms)</nametext></name> <fsummary>Establish a connection to an Erlang node with optional time-out.</fsummary> <desc> - <p>Equivalent to - <c>ei_connect</c> and <c>ei_xconnect</c> with an optional time-out - argument, see the description at the beginning of this manual - page.</p> + <p>Equivalent to <c>ei_connect</c>, <c>ei_xconnect</c>, + <c>ei_connect_host_port</c> and + <c>ei_xconnect_host_port</c> with an optional time-out + argument, see the description at the beginning of this manual + page.</p> </desc> </func> diff --git a/lib/erl_interface/doc/src/erl_global.xml b/lib/erl_interface/doc/src/ei_global.xml index 39085b46f0..4c6b94f7dd 100644 --- a/lib/erl_interface/doc/src/erl_global.xml +++ b/lib/erl_interface/doc/src/ei_global.xml @@ -22,7 +22,7 @@ </legalnotice> - <title>erl_global</title> + <title>ei_global</title> <prepared>Gordon Beaton</prepared> <responsible>Gordon Beaton</responsible> <docno></docno> @@ -30,20 +30,14 @@ <checked>Gordon Beaton</checked> <date>1998-07-03</date> <rev>A</rev> - <file>erl_global.xml</file> + <file>ei_global.xml</file> </header> - <lib>erl_global</lib> + <lib>ei_global</lib> <libsummary>Access globally registered names.</libsummary> <description> <note><p>The support for VxWorks is deprecated as of OTP 22, and will be removed in OTP 23.</p></note> - <note><p>The old legacy <c>erl_interface</c> library (functions - with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be - removed in OTP 23. This does not apply to the <c>ei</c> - library. Reasonably new <c>gcc</c> compilers will issue deprecation - warnings. In order to disable these warnings, define the macro - <c>EI_NO_DEPR_WARN</c>.</p></note> - + <p>This module provides support for registering, looking up, and unregistering names in the <c>global</c> module. For more information, see @@ -57,15 +51,17 @@ <funcs> <func> - <name since=""><ret>char **</ret><nametext>erl_global_names(fd,count)</nametext></name> + <name since=""><ret>char **</ret><nametext>ei_global_names(ec,fd,count)</nametext></name> <fsummary>Obtain list of global names.</fsummary> <type> + <v>ei_cnode *ec;</v> <v>int fd;</v> <v>int *count;</v> </type> <desc> <p>Retrieves a list of all known global names.</p> <list type="bulleted"> + <item><c>ec</c> is the ei_cnode representing the current cnode.</item> <item><c>fd</c> is an open descriptor to an Erlang connection.</item> <item><c>count</c> is the address of an integer, or @@ -88,12 +84,12 @@ </func> <func> - <name since=""><ret>int</ret><nametext>erl_global_register(fd,name,pid)</nametext></name> + <name since=""><ret>int</ret><nametext>ei_global_register(fd,name,pid)</nametext></name> <fsummary>Register a name in global.</fsummary> <type> <v>int fd;</v> <v>const char *name;</v> - <v>ETERM *pid;</v> + <v>erlang_pid *pid;</v> </type> <desc> <p>Registers a name in <c>global</c>.</p> @@ -112,15 +108,17 @@ </func> <func> - <name since=""><ret>int</ret><nametext>erl_global_unregister(fd,name)</nametext></name> + <name since=""><ret>int</ret><nametext>ei_global_unregister(ec,fd,name)</nametext></name> <fsummary>Unregister a name from global.</fsummary> <type> + <v>ei_cnode *ec;</v> <v>int fd;</v> <v>const char *name;</v> </type> <desc> <p>Unregisters a name from <c>global</c>.</p> <list type="bulleted"> + <item><c>ec</c> is the ei_cnode representing the current cnode.</item> <item><c>fd</c> is an open descriptor to an Erlang connection.</item> <item><c>name</c> is the name to unregister from @@ -131,30 +129,35 @@ </func> <func> - <name since=""><ret>ETERM *</ret><nametext>erl_global_whereis(fd,name,node)</nametext></name> + <name since=""><ret>int</ret><nametext>ei_global_whereis(ec,fd,name,pid,node)</nametext></name> <fsummary>Look up a name in global.</fsummary> <type> + <v>ei_cnode *ec;</v> <v>int fd;</v> <v>const char *name;</v> + <v>erlang_pid* pid;</v> <v>char *node;</v> </type> <desc> <p>Looks up a name in <c>global</c>.</p> <list type="bulleted"> + <item><c>ec</c> is the ei_cnode representing the current cnode.</item> <item><c>fd</c> is an open descriptor to an Erlang connection.</item> <item><c>name</c> is the name that is to be looked up in <c>global</c>.</item> </list> + <p>The <c>pid</c> parameter is a pointer to a + <c>erlang_pid</c> that the function will update with the pid associated + with the global name, if successful.</p> <p>If <c>node</c> is not <c>NULL</c>, it is a pointer to a buffer where the function can fill in the name of the node where <c>name</c> is found. <c>node</c> can be - passed directly to <c>erl_connect()</c> if necessary.</p> - <p>On success, the function returns an Erlang pid containing the address - of the specified name, and the node is initialized to + passed directly to <c>ei_connect()</c> if necessary.</p> + <p>On success, the function returns 0, updates the <c>erlang_pid</c> + pointed to by the pid parameter, and the <c>node</c> parameter is initialized to the node name where <c>name</c> is found. On failure, - <c>NULL</c> is returned and <c>node</c> is not - modified.</p> + a negative number is returned.</p> </desc> </func> </funcs> diff --git a/lib/erl_interface/doc/src/ei_users_guide.xml b/lib/erl_interface/doc/src/ei_users_guide.xml index 7ca10d1a99..4ce8b9237f 100644 --- a/lib/erl_interface/doc/src/ei_users_guide.xml +++ b/lib/erl_interface/doc/src/ei_users_guide.xml @@ -37,12 +37,6 @@ <title>Deprecation and Removal</title> <note><p>The support for VxWorks is deprecated as of OTP 22, and will be removed in OTP 23.</p></note> - <note><p>The old legacy <c>erl_interface</c> library (functions - with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be - removed in OTP 23. This does not apply to the <c>ei</c> - library. Reasonably new <c>gcc</c> compilers will issue deprecation - warnings. In order to disable these warnings, define the macro - <c>EI_NO_DEPR_WARN</c>.</p></note> </section> <section> @@ -60,14 +54,12 @@ <seealso marker="mnesia:mnesia">Mnesia</seealso></item> </list> <note> - <p>By default, the <c>Erl_Interface</c> libraries are only guaranteed + <p>By default, the <c>Erl_Interface</c> library is only guaranteed to be compatible with other Erlang/OTP components from the same release as the libraries themselves. For information about how to communicate with Erlang/OTP components from earlier releases, see function <seealso marker="ei#ei_set_compat_rel"> - <c>ei:ei_set_compat_rel</c></seealso> and - <seealso marker="erl_eterm#erl_set_compat_rel"> - <c>erl_eterm:erl_set_compat_rel</c></seealso>.</p> + <c>ei_set_compat_rel</c></seealso>.</p> </note> <section> @@ -98,10 +90,9 @@ <section> <title>Compiling and Linking Your Code</title> <p>To use any of the <c>Erl_Interface</c> functions, include the - following lines in your code:</p> + following line in your code:</p> <code type="none"><![CDATA[ -#include "erl_interface.h" #include "ei.h" ]]></code> <p>Determine where the top directory of your OTP installation is. @@ -114,7 +105,7 @@ Eshell V4.7.4 (abort with ^G) /usr/local/otp ]]></code> <p>To compile your code, ensure that your C compiler knows where - to find <c>erl_interface.h</c> by specifying an appropriate + to find <c>ei.h</c> by specifying an appropriate <c>-I</c> argument on the command line, or add it to the <c>CFLAGS</c> definition in your <c>Makefile</c>. The correct value for this path is @@ -140,11 +131,9 @@ $ cc -c -I/usr/local/otp/lib/erl_interface-3.2.3/include myprog.c ]]></code> <p>When linking:</p> <list type="bulleted"> - <item>Specify the path to <c>liberl_interface.a</c> and - <c>libei.a</c> with + <item>Specify the path to <c>libei.a</c> with <c>-L$OTPROOT/lib/erl_interface-3.2.3/lib</c>.</item> - <item>Specify the name of the libraries with - <c>-lerl_interface -lei</c>.</item> + <item>Specify the name of the library with <c>-lei</c>.</item> </list> <p>Do this on the command line or add the flags to the @@ -155,7 +144,7 @@ $ cc -c -I/usr/local/otp/lib/erl_interface-3.2.3/include myprog.c ]]></code> <code type="none"><![CDATA[ $ ld -L/usr/local/otp/lib/erl_interface-3.2.3/ - lib myprog.o -lerl_interface -lei -o myprog ]]></code> + lib myprog.o -lei -o myprog ]]></code> <p>On some systems it can be necessary to link with some more libraries (for example, <c>libnsl.a</c> and @@ -174,19 +163,11 @@ $ ld -L/usr/local/otp/lib/erl_interface-3.2.3/ </section> <section> - <title>Initializing the Libraries</title> + <title>Initializing the Library</title> <p> - Before calling any of the other functions in the <c>erl_interface</c> - and <c>ei</c> libraries, call <c>erl_init()</c> exactly once to initialize - both libraries. - <c>erl_init()</c> takes two arguments. However, the arguments - are no longer used by <c>erl_interface</c> and are therefore to be - specified as <c>erl_init(NULL,0)</c>. - </p> - <p> - If you only use the <c>ei</c> library, instead initialize it by calling - <c>ei_init()</c> exactly once before calling any other functions in - the <c>ei</c> library. + Before calling any of the other functions in the library, + initialize it by calling + <c>ei_init()</c> exactly once. </p> </section> @@ -199,187 +180,93 @@ $ ld -L/usr/local/otp/lib/erl_interface-3.2.3/ <p>The <c>Erl_Interface</c> library supports this activity. It has several C functions that create and manipulate Erlang data - structures. The library also contains an encode and a decode function. - The following example shows how to create and encode an Erlang tuple - <c>{tobbe,3928}</c>:</p> + structures. The following example shows how to create and encode + an Erlang tuple <c>{tobbe,3928}</c>:</p> <code type="none"><![CDATA[ -ETERM *arr[2], *tuple; -char buf[BUFSIZ]; -int i; - -arr[0] = erl_mk_atom("tobbe"); -arr[1] = erl_mk_integer(3928); -tuple = erl_mk_tuple(arr, 2); -i = erl_encode(tuple, buf); ]]></code> - - <p>Alternatively, you can use <c>erl_send()</c> and - <c>erl_receive_msg</c>, which handle the encoding and - decoding of messages transparently.</p> - - <p>For a complete description, see the following modules:</p> - <list type="bulleted"> - <item><seealso marker="erl_eterm"><c>erl_eterm</c></seealso> - for creating Erlang terms</item> - <item><seealso marker="erl_marshal"><c>erl_marshal</c></seealso> - for encoding and decoding routines</item> - </list> +ei_x_buff buf; +ei_x_new(&buf); +int i = 0; +ei_x_encode_tuple_header(&buf, 2); +ei_x_encode_atom(&buf, "tobbe"); +ei_x_encode_long(&buf, 3928); ]]></code> + + <p>For a complete description, see the + <seealso marker="ei"><c>ei</c></seealso> module.</p> </section> <section> <marker id="building_terms_and_patterns"/> - <title>Building Terms and Patterns</title> + <title>Building Terms</title> <p>The previous example can be simplified by using the - <seealso marker="erl_format"><c>erl_format</c></seealso> module + <seealso marker="ei#ei_x_format_wo_ver"><c>ei_x_format_wo_ver</c></seealso> function to create an Erlang term:</p> <code type="none"><![CDATA[ -ETERM *ep; -ep = erl_format("{~a,~i}", "tobbe", 3928); ]]></code> +ei_x_buff buf; +ei_x_new(&buf); +ei_x_format_wo_ver(&buf, "{~a,~i}", "tobbe", 3928); ]]></code> - <p>For a complete description of the different format directives, see - the <seealso marker="erl_format"><c>erl_format</c></seealso> module.</p> + <p>For a complete description of the different format directives, see the + the <seealso marker="ei#ei_x_format_wo_ver"><c>ei_x_format_wo_ver</c></seealso> function.</p> <p>The following example is more complex:</p> <code type="none"><![CDATA[ -ETERM *ep; -ep = erl_format("[{name,~a},{age,~i},{data,~w}]", - "madonna", - 21, - erl_format("[{adr,~s,~i}]", "E-street", 42)); -erl_free_compound(ep); ]]></code> +ei_x_buff buf; +int i = 0; +ei_x_new(&buf); +ei_x_format_wo_ver(&buf, + "[{name,~a},{age,~i},{data,[{adr,~s,~i}]}]", + "madonna", + 21, + "E-street", 42); +ei_print_term(stdout, buf.buff, &i); +ei_x_free(&buf); ]]></code> <p>As in the previous examples, it is your responsibility to free the memory allocated for Erlang terms. In this example, - <c>erl_free_compound()</c> ensures that the complete term - pointed to by <c>ep</c> is released. This is necessary - because the pointer from the second call to <c>erl_format</c> is lost.</p> - - <p>The following example shows a slightly different solution:</p> - - <code type="none"><![CDATA[ -ETERM *ep,*ep2; -ep2 = erl_format("[{adr,~s,~i}]","E-street",42); -ep = erl_format("[{name,~a},{age,~i},{data,~w}]", - "madonna", 21, ep2); -erl_free_term(ep); -erl_free_term(ep2); ]]></code> - - <p>In this case, you free the two terms independently. The order in - which you free the terms <c>ep</c> and <c>ep2</c> - is not important, - because the <c>Erl_Interface</c> library uses reference counting to - determine when it is safe to remove objects.</p> - - <p>If you are unsure whether you have freed the terms properly, you - can use the following function to see the status of the fixed term - allocator:</p> - - <code type="none"><![CDATA[ -long allocated, freed; - -erl_eterm_statistics(&allocated,&freed); -printf("currently allocated blocks: %ld\n",allocated); -printf("length of freelist: %ld\n",freed); - -/* really free the freelist */ -erl_eterm_release(); - ]]></code> - - <p>For more information, see the - <seealso marker="erl_malloc"><c>erl_malloc</c></seealso> module.</p> - </section> - - <section> - <title>Pattern Matching</title> - <p>An Erlang pattern is a term that can contain unbound variables or - <c>"do not care"</c> symbols. Such a pattern can be matched - against a - term and, if the match is successful, any unbound variables in the - pattern will be bound as a side effect. The content of a bound - variable can then be retrieved:</p> - - <code type="none"><![CDATA[ -ETERM *pattern; -pattern = erl_format("{madonna,Age,_}"); ]]></code> - - <p>The <seealso marker="erl_format#erl_match"> - <c>erl_format:erl_match</c></seealso> function - performs pattern matching. It takes a - pattern and a term and tries to match them. As a side effect any unbound - variables in the pattern will be bound. In the following example, a - pattern is created with a variable <c>Age</c>, which is included at two - positions in the tuple. The pattern match is performed as follows:</p> - - <list type="bulleted"> - <item> - <p><c>erl_match</c> binds the contents of <c>Age</c> to <c>21</c> - the first time it reaches the variable.</p> - </item> - <item> - <p>The second occurrence of <c>Age</c> causes a test for - equality between the terms, as <c>Age</c> is already bound to - <c>21</c>. As <c>Age</c> is bound to <c>21</c>, the equality test - succeeds and the match continues until the end of the pattern.</p> - </item> - <item> - <p>If the end of the pattern is reached, the match succeeds and you - can retrieve the contents of the variable.</p> - </item> - </list> - - <code type="none"><![CDATA[ -ETERM *pattern,*term; -pattern = erl_format("{madonna,Age,Age}"); -term = erl_format("{madonna,21,21}"); -if (erl_match(pattern, term)) { - fprintf(stderr, "Yes, they matched: Age = "); - ep = erl_var_content(pattern, "Age"); - erl_print_term(stderr, ep); - fprintf(stderr,"\n"); - erl_free_term(ep); -} -erl_free_term(pattern); -erl_free_term(term); ]]></code> + <c>ei_x_free()</c> ensures that the data + pointed to by <c>buf</c> is released.</p> - <p>For more information, see the - <seealso marker="erl_format#erl_match"> - <c>erl_format:erl_match</c></seealso> function.</p> </section> <section> <title>Connecting to a Distributed Erlang Node</title> <p>To connect to a distributed Erlang node, you must first - initialize the connection routine with - <seealso marker="erl_connect#erl_connect_init"> - <c>erl_connect:erl_connect_init</c></seealso>, - which stores information, such as the hostname, node name, and IP - address for later use:</p> + initialize the connection routine with one of the + <seealso marker="ei_connect#ei_connect_init"> + <c>ei_connect_init_*</c></seealso> functions, + which stores information, such as the hostname, and node name + for later use:</p> <code type="none"><![CDATA[ int identification_number = 99; int creation=1; char *cookie="a secret cookie string"; /* An example */ -erl_connect_init(identification_number, cookie, creation); ]]></code> +const char* node_name = "einode@durin"; +const char *cookie = NULL; +short creation = time(NULL) + 1; +ei_cnode ec; +ei_connect_init(ec, + node_name, + cookie, + creation); ]]></code> <p>For more information, see the - <seealso marker="erl_connect"><c>erl_connect</c></seealso> module.</p> + <seealso marker="ei_connect"><c>ei_connect</c></seealso> module.</p> <p>After initialization, you set up the connection to the Erlang node. - To specify the Erlang node you want to connect to, use - <c>erl_connect()</c>. The following example sets up the + To specify the Erlang node you want to connect to, use the + <c>ei_connect_*()</c> family of functions. The following example sets up the connection and is to result in a valid socket file descriptor:</p> <code type="none"><![CDATA[ int sockfd; -char *nodename="xyz@chivas.du.etx.ericsson.se"; /* An example */ -if ((sockfd = erl_connect(nodename)) < 0) - erl_err_quit("ERROR: erl_connect failed"); ]]></code> +const char* node_name = "einode@durin"; /* An example */ +if ((sockfd = ei_connect(ec, nodename)) < 0) + fprintf(stderr, "ERROR: ei_connect failed"); ]]></code> - <p><c>erl_err_quit()</c> prints the specified string and - terminates the program. For more information, see the - <seealso marker="erl_error"><c>erl_error</c></seealso> module.</p> </section> <section> @@ -394,7 +281,7 @@ if ((sockfd = erl_connect(nodename)) < 0) correct port number to connect to.</p> <p>When you use - <seealso marker="erl_connect"><c>erl_connect</c></seealso> + <seealso marker="ei_connect"><c>ei_connect</c></seealso> to connect to an Erlang node, a connection is first made to <c>epmd</c> and, if the node is known, a connection is then made to the Erlang node.</p> @@ -409,7 +296,7 @@ if ((sockfd = erl_connect(nodename)) < 0) <code type="none"><![CDATA[ int pub; -pub = erl_publish(port); ]]></code> +pub = ei_publish(ec, port); ]]></code> <p><c>pub</c> is a file descriptor now connected to <c>epmd</c>. <c>epmd</c> @@ -424,17 +311,9 @@ pub = erl_publish(port); ]]></code> failed. If a node has failed in this way, <c>epmd</c> prevents you from registering a new node with the old name, as it thinks that the old - name is still in use. In this case, you must unregister the name - explicitly:</p> + name is still in use. In this case, you must close the port + explicitly</p> - <code type="none"><![CDATA[ -erl_unpublish(node); ]]></code> - - <p>This causes <c>epmd</c> to close the connection from the - far end. Notice - that if the name was in fact still in use by a node, the results of - this operation are unpredictable. Also, doing this does not cause the - local end of the connection to close, so resources can be consumed.</p> </section> <section> @@ -442,10 +321,10 @@ erl_unpublish(node); ]]></code> <p>Use one of the following two functions to send messages:</p> <list type="bulleted"> - <item><seealso marker="erl_connect#erl_send"> - <c>erl_connect:erl_send</c></seealso></item> - <item><seealso marker="erl_connect#erl_reg_send"> - <c>erl_connect:erl_reg_send</c></seealso></item> + <item><seealso marker="ei_connect#ei_send"> + <c>ei_send</c></seealso></item> + <item><seealso marker="ei_connect#ei_reg_send"> + <c>ei_reg_send</c></seealso></item> </list> <p>As in Erlang, messages can be sent to a @@ -456,82 +335,79 @@ erl_unpublish(node); ]]></code> <p>Use one of the following two functions to receive messages:</p> <list type="bulleted"> - <item><seealso marker="erl_connect#erl_receive"> - <c>erl_connect:erl_receive</c></seealso></item> - <item><seealso marker="erl_connect#erl_receive_msg"> - <c>erl_connect:erl_receive_msg</c></seealso></item> + <item><seealso marker="ei_connect#ei_receive"> + <c>ei_receive</c></seealso></item> + <item><seealso marker="ei_connect#ei_receive_msg"> + <c>ei_receive_msg</c></seealso></item> </list> - <p><c>erl_receive()</c> receives the message into a buffer, - while <c>erl_receive_msg()</c> decodes the message into an - Erlang term.</p> - <section> <title>Example of Sending Messages</title> <p>In the following example, <c>{Pid, hello_world}</c> is - sent to a registered process <c>my_server</c>. The message - is encoded by <c>erl_send()</c>:</p> + sent to a registered process <c>my_server</c>:</p> <code type="none"><![CDATA[ -extern const char *erl_thisnodename(void); -extern short erl_thiscreation(void); -#define SELF(fd) erl_mk_pid(erl_thisnodename(),fd,0,erl_thiscreation()) -ETERM *arr[2], *emsg; -int sockfd, creation=1; - -arr[0] = SELF(sockfd); -arr[1] = erl_mk_atom("Hello world"); -emsg = erl_mk_tuple(arr, 2); - -erl_reg_send(sockfd, "my_server", emsg); -erl_free_term(emsg); ]]></code> +ei_x_buff buf; +ei_x_new_with_version(&buf); + +ei_x_encode_tuple_header(&buf, 2); +ei_x_encode_pid(&buf, ei_self(ec)); +ei_x_encode_atom(&buf, "Hello world"); + +ei_reg_send(ec,fd,"my_server",buf,buf.index);]]></code> <p>The first element of the tuple that is sent is your own pid. This enables <c>my_server</c> to reply. For more information about the primitives, see the - <seealso marker="erl_connect"><c>erl_connect</c></seealso> module.</p> + <seealso marker="ei_connect"><c>ei_connect</c></seealso> module.</p> </section> <section> <title>Example of Receiving Messages</title> - <p>In this example, <c>{Pid, Something}</c> is received. The - received pid is then used to return - <c>{goodbye,Pid}</c>.</p> - - <code type="none"><![CDATA[ -ETERM *arr[2], *answer; -int sockfd,rc; -char buf[BUFSIZE]; -ErlMessage emsg; - -if ((rc = erl_receive_msg(sockfd , buf, BUFSIZE, &emsg)) == ERL_MSG) { - arr[0] = erl_mk_atom("goodbye"); - arr[1] = erl_element(1, emsg.msg); - answer = erl_mk_tuple(arr, 2); - erl_send(sockfd, arr[1], answer); - erl_free_term(answer); - erl_free_term(emsg.msg); - erl_free_term(emsg.to); -} ]]></code> + <p>In this example, <c>{Pid, Something}</c> is received.</p> + + <code type="none"><![CDATA[ +erlang_msg msg; +int index = 0; +int version; +int arity = 0; +erlang_pid pid; +ei_x_buff buf; +ei_x_new(&buf); +for (;;) { + int got = ei_xreceive_msg(fd, &msg, &x); + if (got == ERL_TICK) + continue; + if (got == ERL_ERROR) { + fprintf(stderr, "ei_xreceive_msg, got==%d", got); + exit(1); + } + break; +} +ei_decode_version(buf.buff, &index, &version); +ei_decode_tuple_header(buf.buff, &index, &arity); +if (arity != 2) { + fprintf(stderr, "got wrong message"); + exit(1); +} +ei_decode_pid(buf.buff, &index, &pid); ]]></code> <p>To provide robustness, a distributed Erlang node occasionally polls all its connected neighbors in an attempt to detect failed nodes or communication links. A node that receives such a message is expected to respond immediately with an <c>ERL_TICK</c> message. This is done automatically by - <c>erl_receive()</c>. However, when this has occurred, - <c>erl_receive</c> returns <c>ERL_TICK</c> to + <c>ei_xreceive_msg()</c>. However, when this has occurred, + <c>ei_xreceive_msg</c> returns <c>ERL_TICK</c> to the caller without storing a message into the - <c>ErlMessage</c> structure.</p> + <c>erlang_msg</c> structure.</p> <p>When a message has been received, it is the caller's responsibility - to free the received message <c>emsg.msg</c> and - <c>emsg.to</c> or <c>emsg.from</c>, - depending on the type of message received.</p> + to free the received message.</p> <p>For more information, see the - <seealso marker="erl_connect"><c>erl_connect</c></seealso> and - <seealso marker="erl_eterm"><c>erl_eterm</c></seealso> modules.</p> + <seealso marker="ei_connect"><c>ei_connect</c></seealso> and + <seealso marker="ei"><c>ei</c></seealso> modules.</p> </section> </section> @@ -542,31 +418,30 @@ if ((rc = erl_receive_msg(sockfd , buf, BUFSIZE, &emsg)) == ERL_MSG) { included in a function call at a remote node and is called a remote procedure call.</p> - <p>The following example shows how the - <c>Erl_Interface</c> library supports remote procedure calls:</p> + <p>The following example checks if a specific Erlang process is alive:</p> <code type="none"><![CDATA[ -char modname[]=THE_MODNAME; -ETERM *reply,*ep; -ep = erl_format("[~a,[]]", modname); -if (!(reply = erl_rpc(fd, "c", "c", ep))) - erl_err_msg("<ERROR> when compiling file: %s.erl !\n", modname); -erl_free_term(ep); -ep = erl_format("{ok,_}"); -if (!erl_match(ep, reply)) - erl_err_msg("<ERROR> compiler errors !\n"); -erl_free_term(ep); -erl_free_term(reply); ]]></code> - - <p><c>c:c/1</c> is called to compile the specified module on - the remote node. <c>erl_match()</c> checks that the - compilation was - successful by testing for the expected <c>ok</c>.</p> - - <p>For more information about <c>erl_rpc()</c> and its - companions <c>erl_rpc_to()</c> and - <c>erl_rpc_from()</c>, see the - <seealso marker="erl_connect"><c>erl_connect</c></seealso> module.</p> +int index = 0, is_alive; +ei_x_buff args, result; + +ei_x_new(&result); +ei_x_new(&args); +ei_x_encode_list_header(&args, 1); +ei_x_encode_pid(&args, &check_pid); +ei_x_encode_empty_list(&args); + +if (ei_rpc(&ec, fd, "erlang", "is_process_alive", + args.buff, args.index, &result) < 0) + handle_error(); + +if (ei_decode_version(result.buff, &index) < 0 + || ei_decode_bool(result.buff, &index, &is_alive) < 0) + handle_error(); ]]></code> + + <p>For more information about <c>ei_rpc()</c> and its + companions <c>ei_rpc_to()</c> and + <c>ei_rpc_from()</c>, see the + <seealso marker="ei_connect"><c>ei_connect</c></seealso> module.</p> </section> <section> @@ -590,7 +465,7 @@ char **names; int count; int i; -names = erl_global_names(fd,&count); +names = ei_global_names(ec,fd,&count); if (names) for (i=0; i<count; i++) @@ -598,8 +473,8 @@ if (names) free(names); ]]></code> - <p><seealso marker="erl_global#erl_global_names"> - <c>erl_global:erl_global_names</c></seealso> + <p><seealso marker="ei_global#ei_global_names"> + <c>ei_global_names</c></seealso> allocates and returns a buffer containing all the names known to the <c>global</c> module in <c>Kernel</c>. <c>count</c> is initialized to @@ -608,7 +483,7 @@ free(names); ]]></code> <c>count</c> to determine when the last name is reached.</p> <p>It is the caller's responsibility to free the array. - <c>erl_global_names</c> allocates the array and all the strings + <c>ei_global_names</c> allocates the array and all the strings using a single call to <c>malloc()</c>, so <c>free(names)</c> is all that is necessary.</p> @@ -617,16 +492,18 @@ free(names); ]]></code> <code type="none"><![CDATA[ ETERM *pid; char node[256]; +erlang_pid the_pid; -pid = erl_global_whereis(fd,"schedule",node); ]]></code> +if (ei_global_whereis(ec,fd,"schedule",&the_pid,node) < 0) + fprintf(stderr, "ei_global_whereis error\n"); ]]></code> <p>If <c>"schedule"</c> is known to the <c>global</c> module in <c>Kernel</c>, an Erlang pid is - returned that can be used to send messages to the schedule service. + written to the_pid. This pid that can be used to send messages to the schedule service. Also, <c>node</c> is initialized to contain the name of the node where the service is registered, so that you can make a connection to it by simply passing the variable to - <seealso marker="erl_connect"><c>erl_connect</c></seealso>.</p> + <seealso marker="ei_connect"><c>ei_connect</c></seealso>.</p> <p>Before registering a name, you should already have registered your port number with <c>epmd</c>. This is not strictly necessary, @@ -634,30 +511,27 @@ pid = erl_global_whereis(fd,"schedule",node); ]]></code> neglect to do so, then other nodes wishing to communicate with your service cannot find or connect to your process.</p> - <p>Create a pid that Erlang processes can use to communicate with your + <p>Create a name that Erlang processes can use to communicate with your service:</p> <code type="none"><![CDATA[ -ETERM *pid; - -pid = erl_mk_pid(thisnode,14,0,0); -erl_global_register(fd,servicename,pid); ]]></code> +ei_global_register(fd,servicename,ei_self(ec)); ]]></code> <p>After registering the name, use - <seealso marker="erl_connect#erl_accept"> - <c>erl_connect:erl_accept</c></seealso> + <seealso marker="ei_connect#ei_accept"> + <c>ei_accept</c></seealso> to wait for incoming connections.</p> <note> <p>Remember to free <c>pid</c> later with - <seealso marker="erl_malloc#erl_free_term"> - <c>erl_malloc:erl_free_term</c></seealso>.</p> + <seealso marker="ei#ei_x_free"> + <c>ei_x_free</c></seealso>.</p> </note> <p>To unregister a name:</p> <code type="none"><![CDATA[ -erl_global_unregister(fd,servicename); ]]></code> +ei_global_unregister(ec,fd,servicename); ]]></code> </section> <section> @@ -755,7 +629,7 @@ ei_reg_close(reg); ]]></code> <p>The contents of a registry can be backed up to <seealso marker="mnesia:mnesia"><c>Mnesia</c></seealso> on a "nearby" Erlang node. You must provide an open connection to the Erlang node - (see <seealso marker="erl_connect"><c>erl_connect</c></seealso>). + (see <seealso marker="ei_connect"><c>ei_connect</c></seealso>). Also, <c>Mnesia</c> 3.0 or later must be running on the Erlang node before the backup is initiated:</p> @@ -818,9 +692,9 @@ ei_reg_restore(fd, reg, "mtab"); ]]></code> <c>Mnesia</c> backup of the registry contents. This can be avoided if you mark the object as dirty after any such changes with <seealso marker="registry#ei_reg_markdirty"> - <c>registry:ei_reg_markdirty</c></seealso>, or pass appropriate flags to + <c>ei_reg_markdirty</c></seealso>, or pass appropriate flags to <seealso marker="registry#ei_reg_dump"> - <c>registry:ei_reg_dump</c></seealso>.</p> + <c>ei_reg_dump</c></seealso>.</p> </section> </section> </chapter> diff --git a/lib/erl_interface/doc/src/erl_call.xml b/lib/erl_interface/doc/src/erl_call_cmd.xml index 73b9b13e4d..91cb9dbd32 100644 --- a/lib/erl_interface/doc/src/erl_call.xml +++ b/lib/erl_interface/doc/src/erl_call_cmd.xml @@ -78,6 +78,22 @@ <c>Fun</c>, and <c>Args</c> in a manner dependent on the behavior of your command shell.</p> </item> + <tag><c>-address [Hostname:]Port</c></tag> + <item> + <p>(One of <c>-n</c>, <c>-name</c>, <c>-sname</c> or + <c>-address</c> is required.) <c>Hostname</c> is the + hostname of the machine that is running the node that + <c>erl_call</c> shall communicate with. The default + hostname is the hostname of the local machine. <c>Port</c> + is the port number of the node that <c>erl_call</c> shall + communicate with. The <c>-address</c> flag cannot be + combined with any of the flags <c>-n</c>, <c>-name</c>, + <c>-sname</c> or <c>-s</c>.</p> + <p>The <c>-address</c> flag is typically useful when one + wants to call a node that is running on machine without an + accessible <seealso marker="erts:epmd">epmd</seealso> + instance.</p> + </item> <tag><c>-c Cookie</c></tag> <item> <p>(<em>Optional.</em>) Use this option to specify a certain cookie. @@ -112,13 +128,15 @@ </item> <tag><c>-n Node</c></tag> <item> - <p>(One of <c>-n, -name, -sname</c> is required.) + <p>(One of <c>-n</c>, <c>-name</c>, <c>-sname</c> or + <c>-address</c> is required.) Has the same meaning as <c>-name</c> and can still be used for backward compatibility reasons.</p> </item> <tag><c>-name Node</c></tag> <item> - <p>(One of <c>-n, -name, -sname</c> is required.) + <p>(One of <c>-n</c>, <c>-name</c>, <c>-sname</c> or + <c>-address</c> is required.) <c>Node</c> is the name of the node to be started or communicated with. It is assumed that <c>Node</c> is started with @@ -149,7 +167,8 @@ </item> <tag><c>-sname Node</c></tag> <item> - <p>(One of <c>-n, -name, -sname</c> is required.) + <p>(One of <c>-n</c>, <c>-name</c>, <c>-sname</c> or + <c>-address</c> is required.) <c>Node</c> is the name of the node to be started or communicated with. It is assumed that <c>Node</c> is started with <c>erl -sname</c>, which means that diff --git a/lib/erl_interface/doc/src/erl_connect.xml b/lib/erl_interface/doc/src/erl_connect.xml deleted file mode 100644 index 9492a82864..0000000000 --- a/lib/erl_interface/doc/src/erl_connect.xml +++ /dev/null @@ -1,662 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE cref SYSTEM "cref.dtd"> - -<cref> - <header> - <copyright> - <year>1996</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>erl_connect</title> - <prepared>Torbjörn Törnkvist</prepared> - <responsible>Torbjörn Törnkvist</responsible> - <docno></docno> - <approved>Bjarne Däcker</approved> - <checked>Torbjörn Törnkvist</checked> - <date>1998-07-03</date> - <rev>A</rev> - <file>erl_connect.xml</file> - </header> - <lib>erl_connect</lib> - <libsummary>Communicate with distributed Erlang.</libsummary> - <description> - <note><p>The support for VxWorks is deprecated as of OTP 22, and - will be removed in OTP 23.</p></note> - <note><p>The old legacy <c>erl_interface</c> library (functions - with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be - removed in OTP 23. This does not apply to the <c>ei</c> - library. Reasonably new <c>gcc</c> compilers will issue deprecation - warnings. In order to disable these warnings, define the macro - <c>EI_NO_DEPR_WARN</c>.</p></note> - - <p>This module provides support for communication between distributed - Erlang nodes and C-nodes, in a manner that is transparent to Erlang - processes.</p> - - <p>A C-node appears to Erlang as a <em>hidden node</em>. - That is, Erlang processes that know the name of the - C-node can communicate with it in a normal manner, but - the node name does not appear in the listing provided by - <seealso marker="erts:erlang#nodes/0"><c>erlang:nodes/0</c></seealso> - in <c>ERTS</c>.</p> - </description> - - <funcs> - <func> - <name since=""><ret>int</ret><nametext>erl_accept(listensock, conp)</nametext></name> - <fsummary>Accept a connection.</fsummary> - <type> - <v>int listensock;</v> - <v>ErlConnect *conp;</v> - </type> - <desc> - <p>This function is used by a server process to accept a - connection from a client process.</p> - <list type="bulleted"> - <item><c>listensock</c> is an open socket descriptor on - which <c>listen()</c> has previously been called.</item> - <item><c>conp</c> is a pointer to an - <c>ErlConnect</c> struct, described as follows:</item> - </list> - <code type="none"><![CDATA[ -typedef struct { - char ipadr[4]; - char nodename[MAXNODELEN]; -} ErlConnect; - ]]></code> - <p>On success, <c>conp</c> is filled in with the address and - node name of the connecting client and a file descriptor is - returned. On failure, <c>ERL_ERROR</c> is returned and - <c>erl_errno</c> is set to <c>EIO</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_close_connection(fd)</nametext></name> - <fsummary>Close a connection to an Erlang node.</fsummary> - <type> - <v>int fd;</v> - </type> - <desc> - <p>Closes an open connection to an Erlang node.</p> - <p><c>Fd</c> is a file descriptor obtained from - <c>erl_connect()</c> or - <c>erl_xconnect()</c>.</p> - <p>Returns <c>0</c> on success. If the call fails, a non-zero value - is returned, and the reason for the error can be obtained with the - appropriate platform-dependent call.</p> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_connect(node)</nametext></name> - <name since=""><ret>int</ret><nametext>erl_xconnect(addr, alive)</nametext></name> - <fsummary>Establish a connection to an Erlang node.</fsummary> - <type> - <v>char *node, *alive;</v> - <v>struct in_addr *addr;</v> - </type> - <desc> - <p>Sets up a connection to an Erlang node.</p> - <p><c>erl_xconnect()</c> requires the IP address of the - remote host and the alivename of the remote node to be - specified. <c>erl_connect()</c> provides an alternative - interface, and determines the information from the node name - provided.</p> - <list type="bulleted"> - <item><c>addr</c> is the 32-bit IP address of the remote - host.</item> - <item><c>alive</c> is the alivename of the remote node. - </item> - <item><c>node</c> is the name of the remote node.</item> - </list> - <p>Returns an open file descriptor on success, otherwise a negative - value. In the latter case <c>erl_errno</c> is set to one - of:</p> - <taglist> - <tag><c>EHOSTUNREACH</c></tag> - <item>The remote host <c>node</c> is unreachable.</item> - <tag><c>ENOMEM</c></tag> - <item>No more memory is available.</item> - <tag><c>EIO</c></tag> - <item>I/O error.</item> - </taglist> - <p>Also, <c>errno</c> values from - <c>socket</c><em>(2)</em> and - <c>connect</c><em>(2)</em> - system calls can be propagated into <c>erl_errno</c>.</p> - <p><em>Example:</em></p> - <code type="none"><![CDATA[ -#define NODE "madonna@chivas.du.etx.ericsson.se" -#define ALIVE "madonna" -#define IP_ADDR "150.236.14.75" - -/*** Variant 1 ***/ -erl_connect( NODE ); - -/*** Variant 2 ***/ -struct in_addr addr; -addr = inet_addr(IP_ADDR); -erl_xconnect( &addr , ALIVE ); - ]]></code> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_connect_init(number, cookie, creation)</nametext></name> - <name since=""><ret>int</ret><nametext>erl_connect_xinit(host, alive, node, addr, cookie, creation)</nametext></name> - <fsummary>Initialize communication.</fsummary> - <type> - <v>int number;</v> - <v>char *cookie;</v> - <v>short creation;</v> - <v>char *host,*alive,*node;</v> - <v>struct in_addr *addr;</v> - </type> - <desc> - <p>Initializes the <c>erl_connect</c> module. - In particular, these functions are used to identify the name of the - C-node from which they are called. One of these functions must - be called before any of the other functions in the <c>erl_connect</c> - module are used.</p> - <p><c>erl_connect_xinit()</c> stores for later use - information about:</p> - <list type="bulleted"> - <item>Hostname of the node, <c>host</c></item> - <item>Alivename, <c>alive</c></item> - <item>Node name, <c>node</c></item> - <item>IP address, <c>addr</c></item> - <item>Cookie, <c>cookie</c></item> - <item>Creation number, <c>creation</c></item> - </list> - <p><c>erl_connect_init()</c> - provides an alternative interface that does not require as much - information from the caller. Instead, - <c>erl_connect_init()</c> - uses <c>gethostbyname()</c> to obtain default values.</p> - <p>If you use <c>erl_connect_init()</c>, your node will - have a short name, that is, it will not be fully qualified. If you - need to use fully qualified (long) names, use - <c>erl_connect_xinit()</c> instead.</p> - <list type="bulleted"> - <item> - <p><c>host</c> is the name of the host on which the node - is running.</p> - </item> - <item> - <p><c>alive</c> is the alivename of the node.</p> - </item> - <item> - <p><c>node</c> is the node name. It is to - be of the form <em>alivename@hostname</em>.</p> - </item> - <item> - <p><c>addr</c> is the 32-bit IP address of - <c>host</c>.</p> - </item> - <item> - <p><c>cookie</c> is the authorization string required - for access to the remote node. If <c>NULL</c>, the user - <c>HOME</c> directory is searched for a cookie file - <c>.erlang.cookie</c>. The path to - the home directory is retrieved from environment variable - <c>HOME</c> on Unix and from the - <c>HOMEDRIVE</c> and - <c>HOMEPATH</c> variables on Windows. For more - details, see the <seealso marker="kernel:auth"> - <c>auth</c></seealso> module in Kernel.</p> - </item> - <item> - <p><c>creation</c> helps identifying a particular - instance of a C-node. In particular, it can help prevent us from - receiving messages sent to an earlier process with the same - registered name.</p> - </item> - </list> - <p>A C-node acting as a server is assigned a creation number - when it calls <c>erl_publish()</c>.</p> - <p><c>number</c> is used by - <c>erl_connect_init()</c> to - construct the actual node name. In Example 2 - below, <em>"c17@a.DNS.name"</em> is the resulting node name.</p> - <p><em>Example 1:</em></p> - <code type="none"><![CDATA[ -struct in_addr addr; -addr = inet_addr("150.236.14.75"); -if (!erl_connect_xinit("chivas", - "madonna", - "madonna@chivas.du.etx.ericsson.se", - &addr; - "samplecookiestring..."), - 0) - erl_err_quit("<ERROR> when initializing !"); - ]]></code> - <p><em>Example 2:</em></p> - <code type="none"><![CDATA[ -if (!erl_connect_init(17, "samplecookiestring...", 0)) - erl_err_quit("<ERROR> when initializing !"); - ]]></code> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_publish(port)</nametext></name> - <fsummary>Publish a node name.</fsummary> - <type> - <v>int port;</v> - </type> - <desc> - <p>This function is used by a server process to register - with the local name server EPMD, thereby allowing - other processes to send messages by using the registered name. - Before calling this function, the process should - have called <c>bind()</c> and <c>listen()</c> - on an open socket.</p> - <p><c>port</c> is the local name to register, and is to be - the same as the port number that was previously bound to the - socket.</p> - <p>To unregister with EPMD, simply close the returned descriptor.</p> - <p>On success, a descriptor connecting the calling process to EPMD is - returned. On failure, <c>-1</c> is returned and - <c>erl_errno</c> is set to:</p> - <taglist> - <tag><c>EIO</c></tag> - <item>I/O error.</item> - </taglist> - <p>Also, <c>errno</c> values from - <c>socket</c><em>(2)</em> - and <c>connect</c><em>(2)</em> system calls can be - propagated into <c>erl_errno</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_receive(fd, bufp, bufsize)</nametext></name> - <fsummary>Receive a message.</fsummary> - <type> - <v>int fd;</v> - <v>char *bufp;</v> - <v>int bufsize;</v> - </type> - <desc> - <p>Receives a message consisting of a sequence - of bytes in the Erlang external format.</p> - <list type="bulleted"> - <item><c>fd</c> is an open descriptor to an Erlang - connection.</item> - <item><c>bufp</c> is a buffer large enough to hold the - expected message.</item> - <item><c>bufsize</c> indicates the size of - <c>bufp</c>.</item> - </list> - <p>If a <em>tick</em> occurs, that is, the Erlang node on the - other end of the connection has polled this node to see if it - is still alive, the function returns <c>ERL_TICK</c> and - no message is placed in the buffer. Also, - <c>erl_errno</c> is set to <c>EAGAIN</c>.</p> - <p>On success, the message is placed in the specified buffer - and the function returns the number of bytes actually read. On - failure, the function returns a negative value and sets - <c>erl_errno</c> to one of:</p> - <taglist> - <tag><c>EAGAIN</c></tag> - <item>Temporary error: Try again.</item> - <tag><c>EMSGSIZE</c></tag> - <item>Buffer is too small.</item> - <tag><c>EIO</c></tag> - <item>I/O error.</item> - </taglist> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_receive_msg(fd, bufp, bufsize, emsg)</nametext></name> - <fsummary>Receive and decode a message.</fsummary> - <type> - <v>int fd;</v> - <v>unsigned char *bufp;</v> - <v>int bufsize;</v> - <v>ErlMessage *emsg;</v> - </type> - <desc> - <p>Receives the message into the specified buffer - and decodes into <c>(ErlMessage *) emsg</c>.</p> - <list type="bulleted"> - <item><c>fd</c> is an open descriptor to an Erlang - connection.</item> - <item><c>bufp</c> is a buffer large enough to hold the - expected message.</item> - <item><c>bufsize</c> indicates the size of - <c>bufp</c>.</item> - <item>><c>emsg</c> is a pointer to an - <c>ErlMessage</c> structure - into which the message will be decoded. - <c>ErlMessage</c> is defined as follows:</item> - </list> - <code type="none"><![CDATA[ -typedef struct { - int type; - ETERM *msg; - ETERM *to; - ETERM *from; - char to_name[MAXREGLEN]; -} ErlMessage; - ]]></code> - <note> - <p>The definition of <c>ErlMessage</c> has changed since - earlier versions of <c>Erl_Interface</c>.</p> - </note> - <p><c>type</c> identifies the type of message, one of the - following:</p> - <taglist> - <tag><c>ERL_SEND</c></tag> - <item> - <p>An ordinary send operation has occurred and - <c>emsg->to</c> contains the pid of the recipient. - The message is in <c>emsg->msg</c>.</p> - </item> - <tag><c>ERL_REG_SEND</c></tag> - <item> - <p>A registered send operation has occurred and - <c>emsg->from</c> contains the pid of the sender. - The message is in <c>emsg->msg</c>.</p> - </item> - <tag><c>ERL_LINK</c> or <c>ERL_UNLINK</c> - </tag> - <item> - <p><c>emsg->to</c> and <c>emsg->from</c> - contain the pids of the sender and recipient of the link or - unlink. <c>emsg->msg</c> is not used.</p> - </item> - <tag><c>ERL_EXIT</c></tag> - <item> - <p>A link is broken. <c>emsg->to</c> and - <c>emsg->from</c> contain the pids of the linked - processes, and <c>emsg->msg</c> contains the reason - for the exit.</p> - </item> - </taglist> - <note> - <p>It is the caller's responsibility to release the - memory pointed to by <c>emsg->msg</c>, - <c>emsg->to</c>, and - <c>emsg->from</c>.</p> - </note> - <p>If a <em>tick</em> occurs, that is, the Erlang node on the - other end of the connection has polled this node to see if it - is still alive, the function returns <c>ERL_TICK</c> - indicating that the tick has been received and responded to, - but no message is placed in the buffer. In this case you - are to call <c>erl_receive_msg()</c> again.</p> - <p>On success, the function returns <c>ERL_MSG</c> and the - <c>Emsg</c> struct is initialized as described above, or - <c>ERL_TICK</c>, in which case no message is returned. On - failure, the function returns <c>ERL_ERROR</c> and sets - <c>erl_errno</c> to one of:</p> - <taglist> - <tag><c>EMSGSIZE</c></tag> - <item>Buffer is too small.</item> - <tag><c>ENOMEM</c></tag> - <item>No more memory is available.</item> - <tag><c>EIO</c></tag> - <item>I/O error.</item> - </taglist> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_reg_send(fd, to, msg)</nametext></name> - <fsummary>Send a message to a registered name.</fsummary> - <type> - <v>int fd;</v> - <v>char *to;</v> - <v>ETERM *msg;</v> - </type> - <desc> - <p>Sends an Erlang term to a registered process.</p> - <list type="bulleted"> - <item><c>fd</c> is an open descriptor to an Erlang - connection.</item> - <item><c>to</c> is a string containing the registered name - of the intended recipient of the message.</item> - <item><c>msg</c> is the Erlang term to be sent.</item> - </list> - <p>Returns <c>1</c> on success, otherwise <c>0</c>. In - the latter case <c>erl_errno</c> is set to one of:</p> - <taglist> - <tag><c>ENOMEM</c></tag> - <item>No more memory is available.</item> - <tag><c>EIO</c></tag> - <item>I/O error.</item> - </taglist> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_rpc(fd, mod, fun, args)</nametext></name> - <name since=""><ret>int</ret><nametext>erl_rpc_from(fd, timeout, emsg)</nametext></name> - <name since=""><ret>int</ret><nametext>erl_rpc_to(fd, mod, fun, args)</nametext></name> - <fsummary>Remote Procedure Call.</fsummary> - <type> - <v>int fd, timeout;</v> - <v>char *mod, *fun;</v> - <v>ETERM *args;</v> - <v>ErlMessage *emsg;</v> - </type> - <desc> - <p>Supports calling Erlang functions on remote nodes. - <c>erl_rpc_to()</c> sends an RPC request to a remote node - and <c>erl_rpc_from()</c> receives the results of such a - call. <c>erl_rpc()</c> combines the functionality of - these two functions by sending an RPC request and waiting for the - results. See also <seealso marker="kernel:rpc#call/4"> - <c>rpc:call/4</c></seealso> in <c>Kernel</c>.</p> - <list type="bulleted"> - <item><c>fd</c> is an open descriptor to an Erlang - connection.</item> - <item><c>timeout</c> is the maximum time (in milliseconds) - to wait for - results. To wait forever, specify <c>ERL_NO_TIMEOUT</c>. - When <c>erl_rpc()</c> calls <c>erl_rpc_from()</c>, the call will - never timeout.</item> - <item><c>mod</c> is the name of the module containing the - function to be run on the remote node.</item> - <item><c>fun</c> is the name of the function to run. - </item> - <item><c>args</c> is an Erlang list, containing the - arguments to be passed to the function.</item> - <item><c>emsg</c> is a message containing the result of - the function call.</item> - </list> - <p>The actual message returned by the RPC server - is a 2-tuple <c>{rex,Reply}</c>. If you use - <c>erl_rpc_from()</c> in your code, this is the message - you will need to parse. If you use <c>erl_rpc()</c>, the - tuple itself is parsed for you, and the message returned to your - program is the Erlang term containing <c>Reply</c> only. - Replies to RPC requests are always <c>ERL_SEND</c> messages.</p> - <note> - <p>It is the caller's responsibility to free the returned - <c>ETERM</c> structure and the memory pointed to by - <c>emsg->msg</c> and <c>emsg->to</c>.</p> - </note> - <p><c>erl_rpc()</c> returns the remote function's return - value on success, otherwise <c>NULL</c>.</p> - <p><c>erl_rpc_to()</c> returns <c>0</c> on - success, otherwise a negative number.</p> - <p><c>erl_rcp_from()</c> returns <c>ERL_MSG</c> - on success (with <c>Emsg</c> now - containing the reply tuple), otherwise one of - <c>ERL_TICK</c>, <c>ERL_TIMEOUT</c>, or - <c>ERL_ERROR</c>.</p> - <p>When failing, - all three functions set <c>erl_errno</c> to one of:</p> - <taglist> - <tag><c>ENOMEM</c></tag> - <item>No more memory is available.</item> - <tag><c>EIO</c></tag> - <item>I/O error.</item> - <tag><c>ETIMEDOUT</c></tag> - <item>Timeout has expired.</item> - <tag><c>EAGAIN</c></tag> - <item>Temporary error: Try again.</item> - </taglist> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_send(fd, to, msg)</nametext></name> - <fsummary>Send a message.</fsummary> - <type> - <v>int fd;</v> - <v>ETERM *to, *msg;</v> - </type> - <desc> - <p>Sends an Erlang term to a process.</p> - <list type="bulleted"> - <item><c>fd</c> is an open descriptor to an Erlang - connection.</item> - <item><c>to</c> is an Erlang term containing the pid of - the intended recipient of the message.</item> - <item>><c>msg</c> is the Erlang term to be sent.</item> - </list> - <p>Returns <c>1</c> on success, otherwise <c>0</c>. In - the latter case <c>erl_errno</c> is set to one of:</p> - <taglist> - <tag><c>EINVAL</c></tag> - <item>Invalid argument: <c>to</c> is not a valid Erlang - pid.</item> - <tag><c>ENOMEM</c></tag> - <item>No more memory is available.</item> - <tag><c>EIO</c></tag> - <item>I/O error.</item> - </taglist> - </desc> - </func> - - <func> - <name since=""><ret>const char *</ret><nametext>erl_thisalivename()</nametext></name> - <name since=""><ret>const char *</ret><nametext>erl_thiscookie()</nametext></name> - <name since=""><ret>short</ret><nametext>erl_thiscreation()</nametext></name> - <name since=""><ret>const char *</ret><nametext>erl_thishostname()</nametext></name> - <name since=""><ret>const char *</ret><nametext>erl_thisnodename()</nametext></name> - <fsummary>Retrieve some values.</fsummary> - <desc> - <p>Retrieves information about - the C-node. These values are initially set with - <c>erl_connect_init()</c> or - <c>erl_connect_xinit()</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_unpublish(alive)</nametext></name> - <fsummary>Forcefully unpublish a node name.</fsummary> - <type> - <v>char *alive;</v> - </type> - <desc> - <p>This function can be called by a process to unregister a - specified node from EPMD on the local host. This is, however, usually - not allowed, unless EPMD was started with flag - <c>-relaxed_command_check</c>, which it normally is not.</p> - <p>To unregister a node you have published, you should instead - close the descriptor that was returned by - <c>ei_publish()</c>.</p> - <warning> - <p>This function is deprecated and will be removed in a future - release.</p> - </warning> - <p><c>alive</c> is the name of the node to unregister, that - is, the first component of the node name, without - <c>@hostname</c>.</p> - <p>If the node was successfully unregistered from EPMD, <c>0</c> is - returned, otherwise <c>-1</c> is returned and - <c>erl_errno</c> is set to <c>EIO</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_xreceive_msg(fd, bufpp, bufsizep, emsg)</nametext></name> - <fsummary>Receive and decode a message.</fsummary> - <type> - <v>int fd;</v> - <v>unsigned char **bufpp;</v> - <v>int *bufsizep;</v> - <v>ErlMessage *emsg;</v> - </type> - <desc> - <p>Similar to <c>erl_receive_msg</c>. The difference is - that <c>erl_xreceive_msg</c> expects the buffer to - have been allocated by <c>malloc</c>, and reallocates it - if the received - message does not fit into the original buffer. Therefore - both buffer and buffer length are given as pointers; their values - can change by the call.</p> - <p>On success, the function returns <c>ERL_MSG</c> and the - <c>Emsg</c> struct is initialized as described above, or - <c>ERL_TICK</c>, in which case no message is returned. On - failure, the function returns <c>ERL_ERROR</c> and sets - <c>erl_errno</c> to one of:</p> - <taglist> - <tag><c>EMSGSIZE</c></tag> - <item>Buffer is too small.</item> - <tag><c>ENOMEM</c></tag> - <item>No more memory is available.</item> - <tag><c>EIO</c></tag> - <item>I/O error.</item> - </taglist> - </desc> - </func> - - <func> - <name since=""><ret>struct hostent *</ret><nametext>erl_gethostbyaddr(addr, length, type)</nametext></name> - <name since=""><ret>struct hostent *</ret><nametext>erl_gethostbyaddr_r(addr, length, type, hostp, buffer, buflen, h_errnop)</nametext></name> - <name since=""><ret>struct hostent *</ret><nametext>erl_gethostbyname(name)</nametext></name> - <name since=""><ret>struct hostent *</ret><nametext>erl_gethostbyname_r(name, hostp, buffer, buflen, h_errnop)</nametext></name> - - <fsummary>Name lookup functions.</fsummary> - <type> - <v>const char *name;</v> - <v>const char *addr;</v> - <v>int length;</v> - <v>int type;</v> - <v>struct hostent *hostp;</v> - <v>char *buffer;</v> - <v>int buflen;</v> - <v>int *h_errnop;</v> - </type> - <desc> - <p>Convenience functions for some common name lookup functions.</p> - </desc> - </func> - </funcs> - - <section> - <title>Debug Information</title> - <p>If a connection attempt fails, the following can be checked:</p> - - <list type="bulleted"> - <item><c>erl_errno</c></item> - <item>That the correct cookie was used</item> - <item>That EPMD is running</item> - <item>That the remote Erlang node on the other side is running the same - version of Erlang as the <c>erl_interface</c> library</item> - </list> - </section> -</cref> diff --git a/lib/erl_interface/doc/src/erl_error.xml b/lib/erl_interface/doc/src/erl_error.xml deleted file mode 100644 index 6fac94e442..0000000000 --- a/lib/erl_interface/doc/src/erl_error.xml +++ /dev/null @@ -1,145 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE cref SYSTEM "cref.dtd"> - -<cref> - <header> - <copyright> - <year>1996</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>erl_error</title> - <prepared>Torbjörn Törnkvist</prepared> - <responsible>Torbjörn Törnkvist</responsible> - <docno></docno> - <approved>Bjarne Däcker</approved> - <checked>Torbjörn Törnkvist</checked> - <date>1996-10-14</date> - <rev>A</rev> - <file>erl_error.xml</file> - </header> - <lib>erl_error</lib> - <libsummary>Error print routines.</libsummary> - <description> - <p>This module contains some error printing routines taken - from "Advanced Programming in the UNIX Environment" - by W. Richard Stevens.</p> - - <p>These functions are all called in the same manner as - <c>printf()</c>, that is, with a string containing format - specifiers followed by a list of corresponding arguments. All output from - these functions is to <c>stderr</c>.</p> - </description> - - <funcs> - <func> - <name since=""><ret>void</ret><nametext>erl_err_msg(FormatStr, ... )</nametext></name> - <fsummary>Non-fatal error, and not system call error.</fsummary> - <type> - <v>const char *FormatStr;</v> - </type> - <desc> - <p>The message provided by the caller is printed. This - function is simply a wrapper for <c>fprintf()</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>void</ret><nametext>erl_err_quit(FormatStr, ... )</nametext></name> - <fsummary>Fatal error, but not system call error.</fsummary> - <type> - <v>const char *FormatStr;</v> - </type> - <desc> - <p>Use this function when a fatal error has occurred that - is not because of a system call. The message provided by the - caller is printed and the process terminates with exit - value <c>1</c>. This function does not return.</p> - </desc> - </func> - - <func> - <name since=""><ret>void</ret><nametext>erl_err_ret(FormatStr, ... )</nametext></name> - <fsummary>Non-fatal system call error.</fsummary> - <type> - <v>const char *FormatStr;</v> - </type> - <desc> - <p>Use this function after a failed system call. The message - provided by the caller is printed followed by a string - describing the reason for failure.</p> - </desc> - </func> - - <func> - <name since=""><ret>void</ret><nametext>erl_err_sys(FormatStr, ... )</nametext></name> - <fsummary>Fatal system call error.</fsummary> - <type> - <v>const char *FormatStr;</v> - </type> - <desc> - <p>Use this function after a failed system call. The message - provided by the caller is printed followed by a string - describing the reason for failure, and the process - terminates with exit value <c>1</c>. This function does not - return.</p> - </desc> - </func> - </funcs> - - <section> - <title>Error Reporting</title> - <p>Most functions in <c>Erl_Interface</c> report failures to the caller by - returning some otherwise meaningless value (typically - <c>NULL</c> - or a negative number). As this only tells you that things did not - go well, examine the error code in <c>erl_errno</c> if you - want to find out more about the failure.</p> - </section> - - <funcs> - <func> - <name since=""><ret>volatile int</ret><nametext>erl_errno</nametext></name> - <fsummary>Variable <c>erl_errno</c> contains the - Erl_Interface error number. You can change the value if you wish. - </fsummary> - <desc> - <p><c>erl_errno</c> is initially (at program startup) zero - and is then set by many <c>Erl_Interface</c> functions on failure to - a non-zero error code to indicate what kind of error it - encountered. A successful function call can change - <c>erl_errno</c> (by calling some other function that - fails), but no function does never set it to zero. This means - that you cannot use <c>erl_errno</c> to see <em>if</em> a - function call failed. Instead, each function reports failure - in its own way (usually by returning a negative number or - <c>NULL</c>), in which case you can examine - <c>erl_errno</c> for details.</p> - <p><c>erl_errno</c> uses the error codes defined in your - system's <c><errno.h></c>.</p> - <note> - <p><c>erl_errno</c> is a "modifiable lvalue" (just - like ISO C defines <c>errno</c> to be) rather than a - variable. This means it can be implemented as a macro - (expanding to, for example, <c>*_erl_errno()</c>). - For reasons of thread safety (or task safety), this is exactly what - we do on most platforms.</p> - </note> - </desc> - </func> - </funcs> -</cref> diff --git a/lib/erl_interface/doc/src/erl_eterm.xml b/lib/erl_interface/doc/src/erl_eterm.xml deleted file mode 100644 index 295760b4e6..0000000000 --- a/lib/erl_interface/doc/src/erl_eterm.xml +++ /dev/null @@ -1,776 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE cref SYSTEM "cref.dtd"> - -<cref> - <header> - <copyright> - <year>1996</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>erl_eterm</title> - <prepared>Torbjörn Törnkvist</prepared> - <responsible>Torbjörn Törnkvist</responsible> - <docno></docno> - <approved>Bjarne Däcker</approved> - <checked>Torbjörn Törnkvist</checked> - <date>1998-07-03</date> - <rev>A</rev> - <file>erl_eterm.xml</file> - </header> - <lib>erl_eterm</lib> - <libsummary>Functions for Erlang term construction.</libsummary> - <description> - <note><p>The support for VxWorks is deprecated as of OTP 22, and - will be removed in OTP 23.</p></note> - <note><p>The old legacy <c>erl_interface</c> library (functions - with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be - removed in OTP 23. This does not apply to the <c>ei</c> - library. Reasonably new <c>gcc</c> compilers will issue deprecation - warnings. In order to disable these warnings, define the macro - <c>EI_NO_DEPR_WARN</c>.</p></note> - - <p>This module provides functions for creating and manipulating - Erlang terms.</p> - - <p>An Erlang term is represented by a C structure of type - <c>ETERM</c>. Applications should not reference any fields - in this structure directly, as it can be changed in future releases - to provide faster and more compact term storage. Instead, - applications should use the macros and functions provided.</p> - - <p>Each of the following macros takes a single <c>ETERM</c> pointer as an - argument. The macros return a non-zero value if the test is true, - otherwise <c>0</c>.</p> - - <taglist> - <tag><c>ERL_IS_INTEGER(t)</c></tag> - <item>True if <c>t</c> is an integer.</item> - <tag><c>ERL_IS_UNSIGNED_INTEGER(t)</c></tag> - <item>True if <c>t</c> is an integer.</item> - <tag><c>ERL_IS_FLOAT(t)</c></tag> - <item>True if <c>t</c> is a floating point number.</item> - <tag><c>ERL_IS_ATOM(t)</c></tag> - <item>True if <c>t</c> is an atom.</item> - <tag><c>ERL_IS_PID(t)</c></tag> - <item>True if <c>t</c> is a pid (process identifier).</item> - <tag><c>ERL_IS_PORT(t)</c></tag> - <item>True if <c>t</c> is a port.</item> - <tag><c>ERL_IS_REF(t)</c></tag> - <item>True if <c>t</c> is a reference.</item> - <tag><c>ERL_IS_TUPLE(t)</c></tag> - <item>True if <c>t</c> is a tuple.</item> - <tag><c>ERL_IS_BINARY(t)</c></tag> - <item>True if <c>t</c> is a binary.</item> - <tag><c>ERL_IS_LIST(t)</c></tag> - <item>True if <c>t</c> is a list with zero or more - elements.</item> - <tag><c>ERL_IS_EMPTY_LIST(t)</c></tag> - <item>True if <c>t</c> is an empty list.</item> - <tag><c>ERL_IS_CONS(t)</c></tag> - <item>True if <c>t</c> is a list with at least one - element.</item> - </taglist> - - <p>The following macros can be used for retrieving parts of Erlang - terms. None of these do any type checking. Results are undefined - if you pass an <c>ETERM*</c> containing the wrong type. For example, - passing a tuple to <c>ERL_ATOM_PTR()</c> likely results in garbage.</p> - - <taglist> - <tag><c>char *ERL_ATOM_PTR(t)</c></tag> - <item></item> - <tag><c>char *ERL_ATOM_PTR_UTF8(t)</c></tag> - <item>A string representing atom <c>t</c>.</item> - <tag><c>int ERL_ATOM_SIZE(t)</c></tag> - <item></item> - <tag><c>int ERL_ATOM_SIZE_UTF8(t)</c></tag> - <item>The length (in bytes) of atom <c>t</c>.</item> - <tag><c>void *ERL_BIN_PTR(t)</c></tag> - <item>A pointer to the contents of <c>t</c>.</item> - <tag><c>int ERL_BIN_SIZE(t)</c></tag> - <item>The length (in bytes) of binary object <c>t</c>.</item> - <tag><c>int ERL_INT_VALUE(t)</c></tag> - <item>The integer of <c>t</c>.</item> - <tag><c>unsigned int ERL_INT_UVALUE(t)</c></tag> - <item>The unsigned integer value of <c>t</c>.</item> - <tag><c>double ERL_FLOAT_VALUE(t)</c></tag> - <item>The floating point value of <c>t</c>.</item> - <tag><c>ETERM *ERL_PID_NODE(t)</c></tag> - <item></item> - <tag><c>ETERM *ERL_PID_NODE_UTF8(t)</c></tag> - <item>The node in pid <c>t</c>.</item> - <tag><c>int ERL_PID_NUMBER(t)</c></tag> - <item>The sequence number in pid <c>t</c>.</item> - <tag><c>int ERL_PID_SERIAL(t)</c></tag> - <item>The serial number in pid <c>t</c>.</item> - <tag><c>int ERL_PID_CREATION(t)</c></tag> - <item>The creation number in pid <c>t</c>.</item> - <tag><c>int ERL_PORT_NUMBER(t)</c></tag> - <item>The sequence number in port <c>t</c>.</item> - <tag><c>int ERL_PORT_CREATION(t)</c></tag> - <item>The creation number in port <c>t</c>.</item> - <tag><c>ETERM *ERL_PORT_NODE(t)</c></tag> - <item></item> - <tag><c>ETERM *ERL_PORT_NODE_UTF8(t)</c></tag> - <item>The node in port <c>t</c>.</item> - <tag><c>int ERL_REF_NUMBER(t)</c></tag> - <item>The first part of the reference number in ref <c>t</c>. - Use only for compatibility.</item> - <tag><c>int ERL_REF_NUMBERS(t)</c></tag> - <item>Pointer to the array of reference numbers in ref - <c>t</c>.</item> - <tag><c>int ERL_REF_LEN(t)</c></tag> - <item>The number of used reference numbers in ref - <c>t</c>.</item> - <tag><c>int ERL_REF_CREATION(t)</c></tag> - <item>The creation number in ref <c>t</c>.</item> - <tag><c>int ERL_TUPLE_SIZE(t)</c></tag> - <item>The number of elements in tuple <c>t</c>.</item> - <tag><c>ETERM *ERL_CONS_HEAD(t)</c></tag> - <item>The head element of list <c>t</c>.</item> - <tag><c>ETERM *ERL_CONS_TAIL(t)</c></tag> - <item>A list representing the tail elements of list - <c>t</c>.</item> - </taglist> - </description> - - <funcs> - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_cons(head, tail)</nametext></name> - <fsummary>Prepend a term to the head of a list.</fsummary> - <type> - <v>ETERM *head;</v> - <v>ETERM *tail;</v> - </type> - <desc> - <p>Concatenates two Erlang terms, prepending <c>head</c> - onto <c>tail</c> and thereby creating a - <c>cons</c> cell. - To make a proper list, <c>tail</c> is always to be a list - or an empty list. Notice that <c>NULL</c> is not a valid list.</p> - <list type="bulleted"> - <item><c>head</c> is the new term to be added.</item> - <item><c>tail</c> is the existing list to which - <c>head</c> is concatenated.</item> - </list> - <p>The function returns a new list.</p> - <p><c>ERL_CONS_HEAD(list)</c> and - <c>ERL_CONS_TAIL(list)</c> - can be used to retrieve the head and tail components - from the list. <c>erl_hd(list)</c> and - <c>erl_tl(list)</c> do - the same thing, but check that the argument really is a list.</p> - <p><em>Example:</em></p> - <code type="none"><![CDATA[ -ETERM *list,*anAtom,*anInt; -anAtom = erl_mk_atom("madonna"); -anInt = erl_mk_int(21); -list = erl_mk_empty_list(); -list = erl_cons(anAtom, list); -list = erl_cons(anInt, list); - ... /* do some work */ -erl_free_compound(list); - ]]></code> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_copy_term(term)</nametext></name> - <fsummary>Create a copy of an Erlang term.</fsummary> - <type> - <v>ETERM *term;</v> - </type> - <desc> - <p>Creates and returns a copy of the Erlang term - <c>term</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_element(position, tuple)</nametext></name> - <fsummary>Extract an element from an Erlang tuple.</fsummary> - <type> - <v>int position;</v> - <v>ETERM *tuple;</v> - </type> - <desc> - <p>Extracts a specified element from an Erlang tuple.</p> - <list type="bulleted"> - <item><c>position</c> specifies which element to retrieve - from <c>tuple</c>. The elements are numbered starting - from 1.</item> - <item><c>tuple</c> is an Erlang term containing at least - <c>position</c> elements.</item> - </list> - <p>Returns a new Erlang term corresponding to the requested element, or - <c>NULL</c> if <c>position</c> was greater - than the arity of <c>tuple</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_hd(list)</nametext></name> - <fsummary>Extract the first element from a list.</fsummary> - <type> - <v>ETERM *list;</v> - </type> - <desc> - <p>Extracts the first element from a list.</p> - <p><c>list</c> is an Erlang term containing a list.</p> - <p>Returns an Erlang term corresponding to the head - head element in the list, or a <c>NULL</c> pointer if - <c>list</c> was not a list.</p> - </desc> - </func> - - <func> - <name since=""><ret>void</ret><nametext>erl_init(NULL, 0)</nametext></name> - <fsummary>Initialization routine.</fsummary> - <type> - <v>void *NULL;</v> - <v>int 0;</v> - </type> - <desc> - <p>This function must be called before any of the others in the - <c>Erl_Interface</c> library to initialize the - library functions. The arguments must be specified as - <c>erl_init(NULL,0)</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_iolist_length(list)</nametext></name> - <fsummary>Return the length of an I/O list.</fsummary> - <type> - <v>ETERM *list;</v> - </type> - <desc> - <p>Returns the length of an I/O list.</p> - <p><c>list</c> is an Erlang term containing an I/O list.</p> - <p>Returns the length of <c>list</c>, or - <c>-1</c> if <c>list</c> is not an I/O list.</p> - <p>For the definition of an I/O list, see - <seealso marker="#erl_iolist_to_binary"> - <c>erl_iolist_to_binary</c></seealso>.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_iolist_to_binary(term)</nametext></name> - <fsummary>Convert an I/O list to a binary.</fsummary> - <type> - <v>ETERM *list;</v> - </type> - <desc> - <p>Converts an I/O list to a binary term.</p> - <p><c>list</c> is an Erlang term containing a list.</p> - <p>Returns an Erlang binary term, or <c>NULL</c> if - <c>list</c> was not an I/O list.</p> - <p>Informally, an I/O list is a deep list of characters and - binaries that can be sent to an Erlang port. In BNF, an I/O - list is formally defined as follows:</p> - <code type="none"><![CDATA[ -iolist ::= [] - | Binary - | [iohead | iolist] - ; -iohead ::= Binary - | Byte (integer in the range [0..255]) - | iolist - ; - ]]></code> - </desc> - </func> - - <func> - <name since=""><ret>char *</ret><nametext>erl_iolist_to_string(list)</nametext></name> - <fsummary>Convert an I/O list to a <c>NULL</c>-terminated string.</fsummary> - <type> - <v>ETERM *list;</v> - </type> - <desc> - <p>Converts an I/O list to a <c>NULL</c>-terminated C string.</p> - <p><c>list</c> is an Erlang term containing an I/O list. - The I/O list must not contain the integer 0, as C strings may not - contain this value except as a terminating marker.</p> - <p>Returns a pointer to a dynamically allocated - buffer containing a string. If <c>list</c> is not an I/O - list, or if <c>list</c> contains the integer 0, - <c>NULL</c> is returned. It - is the caller's responsibility to free the allocated buffer - with <c>erl_free()</c>.</p> - <p>For the definition of an I/O list, see - <seealso marker="#erl_iolist_to_binary"> - <c>erl_iolist_to_binary</c></seealso>.</p> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_length(list)</nametext></name> - <fsummary>Determine the length of a list.</fsummary> - <type> - <v>ETERM *list;</v> - </type> - <desc> - <p>Determines the length of a proper list.</p> - <p><c>list</c> is an Erlang term containing a proper list. - In a proper list, all tails except the last point to another list - cell, and the last tail points to an empty list.</p> - <p>Returns <c>-1</c> if <c>list</c> is not a proper - list.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_atom(string)</nametext></name> - <fsummary>Create an atom.</fsummary> - <type> - <v>const char *string;</v> - </type> - <desc> - <p>Creates an atom.</p> - <p><c>string</c> is the sequence of characters that will be - used to create the atom.</p> - <p>Returns an Erlang term containing an atom. Notice that it is - the caller's responsibility to ensure that <c>string</c> - contains a valid name for an atom.</p> - <p><c>ERL_ATOM_PTR(atom)</c> and - <c>ERL_ATOM_PTR_UTF8(atom)</c> - can be used to retrieve the atom name (as a <c>NULL</c>-terminated string). - <c>ERL_ATOM_SIZE(atom)</c> - and <c>ERL_ATOM_SIZE_UTF8(atom)</c> return the length - of the atom name.</p> - <note> - <p>The UTF-8 variants were introduced in Erlang/OTP R16 and the - string returned by <c>ERL_ATOM_PTR(atom)</c> was not - <c>NULL</c>-terminated on older releases.</p> - </note> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_binary(bptr, size)</nametext></name> - <fsummary>Create a binary object.</fsummary> - <type> - <v>char *bptr;</v> - <v>int size;</v> - </type> - <desc> - <p>Produces an Erlang binary object from a - buffer containing a sequence of bytes.</p> - <list type="bulleted"> - <item><c>bptr</c> is a pointer to a buffer containing - data to be converted.</item> - <item><c>size</c> indicates the length of - <c>bptr</c>.</item> - </list> - <p>Returns an Erlang binary object.</p> - <p><c>ERL_BIN_PTR(bin)</c> retrieves a pointer to - the binary data. <c>ERL_BIN_SIZE(bin)</c> retrieves the - size.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_empty_list()</nametext></name> - <fsummary>Create an empty Erlang list.</fsummary> - <desc> - <p>Creates and returns an empty Erlang list. - Notice that <c>NULL</c> is not used to represent an empty list; - Use this function instead.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_estring(string, len)</nametext></name> - <fsummary>Create an Erlang string.</fsummary> - <type> - <v>char *string;</v> - <v>int len;</v> - </type> - <desc> - <p>Creates a list from a sequence of bytes.</p> - <list type="bulleted"> - <item><c>string</c> is a buffer containing a sequence of - bytes. The buffer does not need to be <c>NULL</c>-terminated.</item> - <item><c>len</c> is the length of - <c>string</c>.</item> - </list> - <p>Returns an Erlang list object corresponding to - the character sequence in <c>string</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_float(f)</nametext></name> - <fsummary>Create an Erlang float.</fsummary> - <type> - <v>double f;</v> - </type> - <desc> - <p>Creates an Erlang float.</p> - <p><c>f</c> is a value to be converted to an Erlang - float.</p> - <p>Returns an Erlang float object with the value - specified in <c>f</c> or <c>NULL</c> if - <c>f</c> is not finite.</p> - <p><c>ERL_FLOAT_VALUE(t)</c> can be used to retrieve the - value from an Erlang float.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_int(n)</nametext></name> - <fsummary>Create an Erlang integer.</fsummary> - <type> - <v>int n;</v> - </type> - <desc> - <p>Creates an Erlang integer.</p> - <p><c>n</c> is a value to be converted to an Erlang - integer.</p> - <p>Returns an Erlang integer object with the - value specified in <c>n</c>.</p> - <p><c>ERL_INT_VALUE(t)</c> can be used to retrieve the - value from an Erlang integer.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_list(array, arrsize)</nametext></name> - <fsummary>Create a list from an array.</fsummary> - <type> - <v>ETERM **array;</v> - <v>int arrsize;</v> - </type> - <desc> - <p>Creates an Erlang list from an array of Erlang terms, such - that each element in the list corresponds to one element in - the array.</p> - <list type="bulleted"> - <item><c>array</c> is an array of Erlang terms.</item> - <item><c>arrsize</c> is the number of elements in - <c>array</c>.</item> - </list> - <p>The function creates an Erlang list object, whose length - <c>arrsize</c> and whose elements are taken from the - terms in <c>array</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_long_ref(node, n1, n2, n3, creation)</nametext></name> - <fsummary>Create an Erlang reference.</fsummary> - <type> - <v>const char *node;</v> - <v>unsigned int n1, n2, n3;</v> - <v>unsigned int creation;</v> - </type> - <desc> - <p>Creates an Erlang reference, with 82 bits.</p> - <list type="bulleted"> - <item><c>node</c> is the name of the C-node.</item> - <item><c>n1</c>, <c>n2</c>, and - <c>n3</c> can be seen as one big number - <c>n1*2^64+n2*2^32+n3</c>, which is to be chosen - uniquely for each reference created for a given C-node.</item> - <item><c>creation</c> is an arbitrary number.</item> - </list> - <p>Notice that <c>n3</c> and <c>creation</c> - are limited in precision, so only the low 18 and 2 bits of these - numbers are used.</p> - <p>Returns an Erlang reference object.</p> - <p><c>ERL_REF_NODE(ref)</c>, - <c>ERL_REF_NUMBERS(ref)</c>, - <c>ERL_REF_LEN(ref)</c>, and - <c>ERL_REF_CREATION(ref)</c> can be used to retrieve the - values used to create the reference.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_pid(node, number, serial, creation)</nametext></name> - <fsummary>Create a process identifier.</fsummary> - <type> - <v>const char *node;</v> - <v>unsigned int number;</v> - <v>unsigned int serial;</v> - <v>unsigned int creation;</v> - </type> - <desc> - <p>Creates an Erlang process identifier (pid). The - resulting pid can be used by Erlang processes wishing to - communicate with the C-node.</p> - <list type="bulleted"> - <item><c>node</c> is the name of the C-node.</item> - <item><c>number</c>, <c>serial</c>, and - <c>creation</c> are - arbitrary numbers. Notice that these are limited in - precision, so only the low 15, 3, and 2 bits of these numbers - are used.</item> - </list> - <p>Returns an Erlang pid object.</p> - <p><c>ERL_PID_NODE(pid)</c>, - <c>ERL_PID_NUMBER(pid)</c>, - <c>ERL_PID_SERIAL(pid)</c>, and - <c>ERL_PID_CREATION(pid)</c> - can be used to retrieve the four values used to create the pid.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_port(node, number, creation)</nametext></name> - <fsummary>Create a port identifier.</fsummary> - <type> - <v>const char *node;</v> - <v>unsigned int number;</v> - <v>unsigned int creation;</v> - </type> - <desc> - <p>Creates an Erlang port identifier.</p> - <list type="bulleted"> - <item><c>node</c> is the name of the C-node.</item> - <item><c>number</c> and <c>creation</c> are - arbitrary numbers. Notice that these are limited in - precision, so only the low 18 and 2 bits of these numbers - are used.</item> - </list> - <p>Returns an Erlang port object.</p> - <p><c>ERL_PORT_NODE(port)</c>, - <c>ERL_PORT_NUMBER(port)</c>, - and <c>ERL_PORT_CREATION</c> can be used to retrieve the - three values used to create the port.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_ref(node, number, creation)</nametext></name> - <fsummary>Create an old Erlang reference.</fsummary> - <type> - <v>const char *node;</v> - <v>unsigned int number;</v> - <v>unsigned int creation;</v> - </type> - <desc> - <p>Creates an old Erlang reference, with - only 18 bits - use <c>erl_mk_long_ref</c> instead.</p> - <list type="bulleted"> - <item><c>node</c> is the name of the C-node.</item> - <item><c>number</c> is to be chosen uniquely for each - reference created for a given C-node.</item> - <item><c>creation</c> is an arbitrary number.</item> - </list> - <p>Notice that <c>number</c> and <c>creation</c> - are limited in precision, so only the low 18 and 2 bits of these - numbers are used.</p> - <p>Returns an Erlang reference object.</p> - <p><c>ERL_REF_NODE(ref)</c>, - <c>ERL_REF_NUMBER(ref)</c>, and - <c>ERL_REF_CREATION(ref)</c> can be used to retrieve the - three values used to create the reference.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_string(string)</nametext></name> - <fsummary>Create a string.</fsummary> - <type> - <v>char *string;</v> - </type> - <desc> - <p>Creates a list from a <c>NULL</c>-terminated string.</p> - <p><c>string</c> is a <c>NULL</c>-terminated sequence of - characters - (that is, a C string) from which the list will be created.</p> - <p>Returns an Erlang list.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_tuple(array, arrsize)</nametext></name> - <fsummary>Create an Erlang tuple from an array.</fsummary> - <type> - <v>ETERM **array;</v> - <v>int arrsize;</v> - </type> - <desc> - <p>Creates an Erlang tuple from an array of Erlang terms.</p> - <list type="bulleted"> - <item><c>array</c> is an array of Erlang terms.</item> - <item><c>arrsize</c> is the number of elements in - <c>array</c>.</item> - </list> - <p>The function creates an Erlang tuple, whose arity is - <c>size</c> and whose elements are taken from the terms - in <c>array</c>.</p> - <p>To retrieve the size of a tuple, either use function - <c>erl_size</c> (which checks the type of the - checked term and works for a binary as well as for a tuple) or - <c>ERL_TUPLE_SIZE(tuple)</c> returns the arity of a tuple. - <c>erl_size()</c> does the same thing, but it checks - that the argument is a tuple. - <c>erl_element(index,tuple)</c> returns the element - corresponding to a given position in the tuple.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_uint(n)</nametext></name> - <fsummary>Create an unsigned integer.</fsummary> - <type> - <v>unsigned int n;</v> - </type> - <desc> - <p>Creates an Erlang unsigned integer.</p> - <p><c>n</c> is a value to be converted to an Erlang - unsigned integer.</p> - <p>Returns an Erlang unsigned integer object with - the value specified in <c>n</c>.</p> - <p><c>ERL_INT_UVALUE(t)</c> can be used to retrieve the - value from an Erlang unsigned integer.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_mk_var(name)</nametext></name> - <fsummary>Create an Erlang variable.</fsummary> - <type> - <v>char *name;</v> - </type> - <desc> - <p>Creates an unbound Erlang variable. The variable can later be bound - through pattern matching or assignment.</p> - <p><c>name</c> specifies a name for the variable.</p> - <p>Returns an Erlang variable object with the - name <c>name</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_print_term(stream, term)</nametext></name> - <fsummary>Print an Erlang term.</fsummary> - <type> - <v>FILE *stream;</v> - <v>ETERM *term;</v> - </type> - <desc> - <p>Prints the specified Erlang term to the specified output stream.</p> - <list type="bulleted"> - <item><c>stream</c> indicates where the function is to - send its output.</item> - <item><c>term</c> is the Erlang term to print.</item> - </list> - <p>Returns the number of characters written on success, otherwise a - negative value.</p> - </desc> - </func> - - <func> - <name since=""><ret>void</ret><nametext>erl_set_compat_rel(release_number)</nametext></name> - <fsummary>Set the Erl_Interface library in compatibility mode.</fsummary> - <type> - <v>unsigned release_number;</v> - </type> - <desc> - <p>By default, the <c>Erl_Interface</c> library is only - guaranteed to be compatible with other Erlang/OTP components from the - same release as the <c>Erl_Interface</c> library itself. - For example, <c>Erl_Interface</c> from Erlang/OTP R10 - is not compatible - with an Erlang emulator from Erlang/OTP R9 by default.</p> - <p>A call to <c>erl_set_compat_rel(release_number)</c> sets - the <c>Erl_Interface</c> library in compatibility mode of - release <c>release_number</c>. Valid range of - <c>release_number</c> - is [7, current release]. This makes it possible to - communicate with Erlang/OTP components from earlier releases.</p> - <note> - <p>If this function is called, it may only be called once - directly after the call to function - <seealso marker="#erl_init">erl_init()</seealso>.</p> - </note> - <warning> - <p>You may run into trouble if this feature is used - carelessly. Always ensure that all communicating - components are either from the same Erlang/OTP release, or - from release X and release Y where all components - from release Y are in compatibility mode of release X.</p> - </warning> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_size(term)</nametext></name> - <fsummary>Return the arity of a tuple or binary.</fsummary> - <type> - <v>ETERM *term;</v> - </type> - <desc> - <p>Returns either the arity of an Erlang tuple or the - number of bytes in an Erlang binary object.</p> - <p><c>term</c> is an Erlang tuple or an Erlang binary - object.</p> - <p>Returns the size of <c>term</c> as described - above, or <c>-1</c> if <c>term</c> is not one of the two - supported types.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_tl(list)</nametext></name> - <fsummary>Extract the tail from a list.</fsummary> - <type> - <v>ETERM *list;</v> - </type> - <desc> - <p>Extracts the tail from a list.</p> - <p><c>list</c> is an Erlang term containing a list.</p> - <p>Returns an Erlang list corresponding to the - original list minus the first element, or <c>NULL</c> pointer if - <c>list</c> was not a list.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_var_content(term, name)</nametext></name> - <fsummary>Extract the content of a variable.</fsummary> - <type> - <v>ETERM *term;</v> - <v>char *name;</v> - </type> - <desc> - <p>Returns the contents of the specified variable in an Erlang term.</p> - <list type="bulleted"> - <item><c>term</c> is an Erlang term. In order for this - function to succeed, - <c>term</c> must either be an Erlang variable with - the specified name, or it must be an Erlang list or tuple - containing a variable with the specified name. Other Erlang - types cannot contain variables.</item> - <item><c>name</c> is the name of an Erlang variable. - </item> - </list> - <p>Returns the Erlang object corresponding to the value of - <c>name</c> in <c>term</c>. If no variable - with the name <c>name</c> is found in - <c>term</c>, or if <c>term</c> is - not a valid Erlang term, <c>NULL</c> is returned.</p> - </desc> - </func> - </funcs> -</cref> diff --git a/lib/erl_interface/doc/src/erl_format.xml b/lib/erl_interface/doc/src/erl_format.xml deleted file mode 100644 index b5e895c720..0000000000 --- a/lib/erl_interface/doc/src/erl_format.xml +++ /dev/null @@ -1,138 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE cref SYSTEM "cref.dtd"> - -<cref> - <header> - <copyright> - <year>1996</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>erl_format</title> - <prepared>Torbjörn Törnkvist</prepared> - <responsible>Torbjörn Törnkvist</responsible> - <docno></docno> - <approved>Bjarne Däcker</approved> - <checked>Torbjörn Törnkvist</checked> - <date>1996-10-16</date> - <rev>A</rev> - <file>erl_format.xml</file> - </header> - <lib>erl_format</lib> - <libsummary>Create and match Erlang terms.</libsummary> - <description> - <p>This module contains two routines: one general function for - creating Erlang terms and one for pattern matching Erlang terms.</p> - </description> - - <funcs> - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_format(FormatStr, ...)</nametext></name> - <fsummary>Create an Erlang term.</fsummary> - <type> - <v>char *FormatStr;</v> - </type> - <desc> - <p>A general function for creating Erlang terms using - a format specifier and a corresponding set of arguments, much - in the way <c>printf()</c> works.</p> - <p><c>FormatStr</c> is a format specification string. - The valid format specifiers are as follows:</p> - <list type="bulleted"> - <item><c>~i</c> - Integer</item> - <item><c>~f</c> - Floating point</item> - <item><c>~a</c> - Atom</item> - <item><c>~s</c> - String</item> - <item><c>~w</c> - Arbitrary Erlang term</item> - </list> - <p>For each format specifier included in <c>FormatStr</c>, - there must be a corresponding argument following - <c>FormatStr</c>. An Erlang term is built according to - <c>FormatStr</c> with values and Erlang terms substituted - from the corresponding arguments, and according to the individual - format specifiers. For example:</p> - <code type="none"><![CDATA[ -erl_format("[{name,~a},{age,~i},{data,~w}]", - "madonna", - 21, - erl_format("[{adr,~s,~i}]","E-street",42)); - ]]></code> - <p>This creates an <c>(ETERM *)</c> structure corresponding - to the Erlang term - <c>[{name,madonna},{age,21},{data,[{adr,"E-street",42}]}]</c></p> - <p>The function returns an Erlang term, or <c>NULL</c> if - <c>FormatStr</c> does not describe a valid Erlang - term.</p> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_match(Pattern, Term)</nametext></name> - <fsummary>Perform pattern matching.</fsummary> - <type> - <v>ETERM *Pattern,*Term;</v> - </type> - <desc> - <p>This function is used to perform pattern matching similar - to that done in Erlang. For matching rules and more examples, see - section <seealso marker="doc/reference_manual:patterns"> - Pattern Matching</seealso> in the Erlang Reference Manual.</p> - <list type="bulleted"> - <item><c>Pattern</c> is an Erlang term, possibly - containing unbound variables.</item> - <item><c>Term</c> is an Erlang term that we wish to match - against <c>Pattern</c>.</item> - </list> - <p><c>Term</c> and <c>Pattern</c> are compared - and any unbound variables in <c>Pattern</c> are bound to - corresponding values in <c>Term</c>.</p> - <p>If <c>Term</c> and <c>Pattern</c> can be - matched, the function returns a non-zero value and binds any unbound - variables in <c>Pattern</c>. If <c>Term</c> - and <c>Pattern</c> do - not match, <c>0</c> is returned. For example:</p> - <code type="none"><![CDATA[ -ETERM *term, *pattern, *pattern2; -term1 = erl_format("{14,21}"); -term2 = erl_format("{19,19}"); -pattern1 = erl_format("{A,B}"); -pattern2 = erl_format("{F,F}"); -if (erl_match(pattern1, term1)) { - /* match succeeds: - * A gets bound to 14, - * B gets bound to 21 - */ - ... -} -if (erl_match(pattern2, term1)) { - /* match fails because F cannot be - * bound to two separate values, 14 and 21 - */ - ... -} -if (erl_match(pattern2, term2)) { - /* match succeeds and F gets bound to 19 */ - ... -} - ]]></code> - <p><c>erl_var_content()</c> can be used to retrieve the - content of any variables bound as a result of a call to - <c>erl_match()</c>.</p> - </desc> - </func> - </funcs> -</cref> diff --git a/lib/erl_interface/doc/src/erl_interface.xml b/lib/erl_interface/doc/src/erl_interface.xml deleted file mode 100644 index decd66046a..0000000000 --- a/lib/erl_interface/doc/src/erl_interface.xml +++ /dev/null @@ -1,637 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>1996</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>The Erl_Interface Library</title> - <prepared>Torbjörn Törnkvist</prepared> - <responsible>Torbjörn Törnkvist</responsible> - <docno></docno> - <approved>Bjarne Däcker</approved> - <checked>K.Lundin</checked> - <date>990113</date> - <rev>A</rev> - <file>erl_interface.sgml</file> - </header> - <p>The Erl_Interface library contains functions. which help you - integrate programs written in C and Erlang. The functions in - Erl_Interface support the following:</p> - <list type="bulleted"> - <item>manipulation of data represented as Erlang data types</item> - <item>conversion of data between C and Erlang formats</item> - <item>encoding and decoding of Erlang data types for transmission or storage</item> - <item>communication between C nodes and Erlang processes</item> - <item>backup and restore of C node state to and from Mnesia</item> - </list> - <p>In the following sections, these topics are described:</p> - <list type="bulleted"> - <item>compiling your code for use with Erl_Interface</item> - <item>initializing Erl_Interface</item> - <item>encoding, decoding, and sending Erlang terms</item> - <item>building terms and patterns</item> - <item>pattern matching</item> - <item>connecting to a distributed Erlang node</item> - <item>using EPMD</item> - <item>sending and receiving Erlang messages</item> - <item>remote procedure calls</item> - <item>global names</item> - <item>the registry</item> - </list> - - <section> - <title>Deprecation and Removal</title> - <note><p>The support for VxWorks is deprecated as of OTP 22, and - will be removed in OTP 23.</p></note> - <note><p>The old legacy <c>erl_interface</c> library (functions - with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be - removed in OTP 23. This does not apply to the <c>ei</c> - library. Reasonably new <c>gcc</c> compilers will issue deprecation - warnings. In order to disable these warnings, define the macro - <c>EI_NO_DEPR_WARN</c>.</p></note> - </section> - - <section> - <title>Compiling and Linking Your Code</title> - <p>In order to use any of the Erl_Interface functions, include the - following lines in your code:</p> - <code type="none"><![CDATA[ -#include "erl_interface.h" -#include "ei.h" ]]></code> - <p>Determine where the top directory of your OTP installation is. You - can find this out by starting Erlang and entering the following - command at the Eshell prompt:</p> - <code type="none"><![CDATA[ -Eshell V4.7.4 (abort with ^G) -1> code:root_dir(). -/usr/local/otp ]]></code> - <p>To compile your code, make sure that your C compiler knows where - to find <c>erl_interface.h</c> by specifying an appropriate <c>-I</c> - argument on the command line, or by adding it to the <c>CFLAGS</c> - definition in your <c>Makefile</c>. The correct value for this path is - <c>$OTPROOT/lib/erl_interface</c><em>Vsn</em><c>/include</c>, where <c>$OTPROOT</c> is the path - reported by <c>code:root_dir/0</c> in the above example, and <em>Vsn</em> is - the version of the Erl_interface application, for example - <c>erl_interface-3.2.3</c></p> - <code type="none"><![CDATA[ -$ cc -c -I/usr/local/otp/lib/erl_interface-3.2.3/include myprog.c ]]></code> - <p>When linking, you will need to specify the path to - <c>liberl_interface.a</c> and <c>libei.a</c> with - <c>-L$OTPROOT/lib/erl_interface-3.2.3/lib</c>, and you will need to specify the - name of the libraries with <c>-lerl_interface -lei</c>. You can do - this on the command line or by adding the flags to the <c>LDFLAGS</c> - definition in your <c>Makefile</c>.</p> - <code type="none"><![CDATA[ -$ ld -L/usr/local/otp/lib/erl_interface-3.2.3/ - lib myprog.o -lerl_interface -lei -o myprog ]]></code> - <p>Also, on some systems it may be necessary to link with some - additional libraries (e.g. <c>libnsl.a</c> and <c>libsocket.a</c> on - Solaris, or <c>wsock32.lib</c> on Windows) in order to use the - communication facilities of Erl_Interface.</p> - <p>If you are using Erl_Interface functions in a threaded - application based on POSIX threads or Solaris threads, then - Erl_Interface needs access to some of the synchronization - facilities in your threads package, and you will need to specify - additional compiler flags in order to indicate which of the packages - you are using. Define <c>_REENTRANT</c> and either <c>STHREADS</c> or - <c>PTHREADS</c>. The default is to use POSIX threads if - <c>_REENTRANT</c> is specified.</p> - <p>Note that both single threaded and default versions of the Erl_interface - and Ei libraries are provided. (The single threaded versions are named - <c>liberl_interface_st</c> and <c>libei_st</c>). Whether the default - versions of the libraries have support for threads or not is determined by if - the platform in question has support for POSIX or Solaris threads. To check this, - have a look in the <c>eidefs.mk</c> file in the erl_interface src directory.</p> - </section> - - <section> - <title>Initializing the erl_interface Library</title> - <p>Before calling any of the other Erl_Interface functions, you - must call <c>erl_init()</c> exactly once to initialize the library. - <c>erl_init()</c> takes two arguments, however the arguments are no - longer used by Erl_Interface, and should therefore be specified - as <c>erl_init(NULL,0)</c>.</p> - </section> - - <section> - <title>Encoding, Decoding and Sending Erlang Terms</title> - <p>Data sent between distributed Erlang nodes is encoded in the - Erlang external format. Consequently, you have to encode and decode - Erlang terms into byte streams if you want to use the distribution - protocol to communicate between a C program and Erlang. </p> - <p>The Erl_Interface library supports this activity. It has a - number of C functions which create and manipulate Erlang data - structures. The library also contains an encode and a decode function. - The example below shows how to create and encode an Erlang tuple - <c>{tobbe,3928}</c>:</p> - <code type="none"><![CDATA[ - -ETERM *arr[2], *tuple; -char buf[BUFSIZ]; -int i; - -arr[0] = erl_mk_atom("tobbe"); -arr[1] = erl_mk_integer(3928); -tuple = erl_mk_tuple(arr, 2); -i = erl_encode(tuple, buf); ]]></code> - <p>Alternatively, you can use <c>erl_send()</c> and - <c>erl_receive_msg</c>, which handle the encoding and decoding of - messages transparently.</p> - <p>Refer to the Reference Manual for a complete description of the - following modules:</p> - <list type="bulleted"> - <item>the <c>erl_eterm</c> module for creating Erlang terms</item> - <item>the <c>erl_marshal</c> module for encoding and decoding routines.</item> - </list> - </section> - - <section> - <title>Building Terms and Patterns</title> - <p>The previous example can be simplified by using - <c>erl_format()</c> to create an Erlang term.</p> - <code type="none"><![CDATA[ - -ETERM *ep; -ep = erl_format("{~a,~i}", "tobbe", 3928); ]]></code> - <p>Refer to the Reference Manual, the <c>erl_format</c> module, for a - full description of the different format directives. The following - example is more complex:</p> - <code type="none"><![CDATA[ - -ETERM *ep; -ep = erl_format("[{name,~a},{age,~i},{data,~w}]", - "madonna", - 21, - erl_format("[{adr,~s,~i}]", "E-street", 42)); -erl_free_compound(ep); ]]></code> - <p>As in previous examples, it is your responsibility to free the - memory allocated for Erlang terms. In this example, - <c>erl_free_compound()</c> ensures that the complete term pointed to - by <c>ep</c> is released. This is necessary, because the pointer from - the second call to <c>erl_format()</c> is lost. </p> - <p>The following - example shows a slightly different solution:</p> - <code type="none"><![CDATA[ - -ETERM *ep,*ep2; -ep2 = erl_format("[{adr,~s,~i}]","E-street",42); -ep = erl_format("[{name,~a},{age,~i},{data,~w}]", - "madonna", 21, ep2); -erl_free_term(ep); -erl_free_term(ep2); ]]></code> - <p>In this case, you free the two terms independently. The order in - which you free the terms <c>ep</c> and <c>ep2</c> is not important, - because the Erl_Interface library uses reference counting to - determine when it is safe to actually remove objects. </p> - <p>If you are not sure whether you have freed the terms properly, you - can use the following function to see the status of the fixed term - allocator:</p> - <code type="none"><![CDATA[ -long allocated, freed; - -erl_eterm_statistics(&allocated,&freed); -printf("currently allocated blocks: %ld\ -",allocated); -printf("length of freelist: %ld\ -",freed); - -/* really free the freelist */ -erl_eterm_release(); - ]]></code> - <p>Refer to the Reference Manual, the <c>erl_malloc</c> module for more - information.</p> - </section> - - <section> - <title>Pattern Matching</title> - <p>An Erlang pattern is a term that may contain unbound variables or - <c>"do not care"</c> symbols. Such a pattern can be matched against a - term and, if the match is successful, any unbound variables in the - pattern will be bound as a side effect. The content of a bound - variable can then be retrieved.</p> - <code type="none"><![CDATA[ - -ETERM *pattern; -pattern = erl_format("{madonna,Age,_}"); ]]></code> - <p><c>erl_match()</c> is used to perform pattern matching. It takes a - pattern and a term and tries to match them. As a side effect any unbound - variables in the pattern will be bound. In the following example, we - create a pattern with a variable <em>Age</em> which appears at two - positions in the tuple. The pattern match is performed as follows:</p> - <list type="ordered"> - <item><c>erl_match()</c> will bind the contents of - <em>Age</em> to <em>21</em> the first time it reaches the variable</item> - <item>the second occurrence of <em>Age</em> will cause a test for - equality between the terms since <em>Age</em> is already bound to - <em>21</em>. Since <em>Age</em> is bound to 21, the equality test will - succeed and the match continues until the end of the pattern.</item> - <item>if the end of the pattern is reached, the match succeeds and you - can retrieve the contents of the variable</item> - </list> - <code type="none"><![CDATA[ -ETERM *pattern,*term; -pattern = erl_format("{madonna,Age,Age}"); -term = erl_format("{madonna,21,21}"); -if (erl_match(pattern, term)) { - fprintf(stderr, "Yes, they matched: Age = "); - ep = erl_var_content(pattern, "Age"); - erl_print_term(stderr, ep); - fprintf(stderr,"\ -"); - erl_free_term(ep); -} -erl_free_term(pattern); -erl_free_term(term); ]]></code> - <p>Refer to the Reference Manual, the <c>erl_match()</c> function for - more information.</p> - </section> - - <section> - <title>Connecting to a Distributed Erlang Node</title> - <p>In order to connect to a distributed Erlang node you need to first - initialize the connection routine with <c>erl_connect_init()</c>, - which stores information such as the host name, node name, and IP - address for later use:</p> - <code type="none"><![CDATA[ -int identification_number = 99; -int creation=1; -char *cookie="a secret cookie string"; /* An example */ -erl_connect_init(identification_number, cookie, creation); ]]></code> - <p>Refer to the Reference Manual, the <c>erl_connect</c> module for more information.</p> - <p>After initialization, you set up the connection to the Erlang node. - Use <c>erl_connect()</c> to specify the Erlang node you want to - connect to. The following example sets up the connection and should - result in a valid socket file descriptor:</p> - <code type="none"><![CDATA[ -int sockfd; -char *nodename="xyz@chivas.du.etx.ericsson.se"; /* An example */ -if ((sockfd = erl_connect(nodename)) < 0) - erl_err_quit("ERROR: erl_connect failed"); ]]></code> - <p><c>erl_err_quit()</c> prints the specified string and terminates - the program. Refer to the Reference Manual, the <c>erl_error()</c> - function for more information.</p> - </section> - - <section> - <title>Using EPMD</title> - <p><c>Epmd</c> is the Erlang Port Mapper Daemon. Distributed Erlang nodes - register with <c>epmd</c> on the localhost to indicate to other nodes that - they exist and can accept connections. <c>Epmd</c> maintains a register of - node and port number information, and when a node wishes to connect to - another node, it first contacts <c>epmd</c> in order to find out the correct - port number to connect to.</p> - <p>When you use <c>erl_connect()</c> to connect to an Erlang node, a - connection is first made to <c>epmd</c> and, if the node is known, a - connection is then made to the Erlang node.</p> - <p>C nodes can also register themselves with <c>epmd</c> if they want other - nodes in the system to be able to find and connect to them.</p> - <p>Before registering with <c>epmd</c>, you need to first create a listen socket - and bind it to a port. Then:</p> - <code type="none"><![CDATA[ -int pub; - -pub = erl_publish(port); ]]></code> - <p><c>pub</c> is a file descriptor now connected to <c>epmd</c>. <c>Epmd</c> - monitors the other end of the connection, and if it detects that the - connection has been closed, the node will be unregistered. So, if you - explicitly close the descriptor or if your node fails, it will be - unregistered from <c>epmd</c>.</p> - <p>Be aware that on some systems (such as VxWorks), a failed node will - not be detected by this mechanism since the operating system does not - automatically close descriptors that were left open when the node - failed. If a node has failed in this way, <c>epmd</c> will prevent you from - registering a new node with the old name, since it thinks that the old - name is still in use. In this case, you must unregister the name - explicitly:</p> - <code type="none"><![CDATA[ -erl_unpublish(node); ]]></code> - <p>This will cause <c>epmd</c> to close the connection from the far end. Note - that if the name was in fact still in use by a node, the results of - this operation are unpredictable. Also, doing this does not cause the - local end of the connection to close, so resources may be consumed.</p> - </section> - - <section> - <title>Sending and Receiving Erlang Messages</title> - <p>Use one of the following two functions to send messages:</p> - <list type="bulleted"> - <item><c>erl_send()</c></item> - <item><c>erl_reg_send()</c></item> - </list> - <p>As in Erlang, it is possible to send messages to a - <em>Pid</em> or to a registered name. It is easier to send a - message to a registered name because it avoids the problem of finding - a suitable <em>Pid</em>.</p> - <p>Use one of the following two functions to receive messages:</p> - <list type="bulleted"> - <item><c>erl_receive()</c></item> - <item><c>erl_receive_msg()</c></item> - </list> - <p><c>erl_receive()</c> receives the message into a buffer, while - <c>erl_receive_msg()</c> decodes the message into an Erlang term. </p> - - <section> - <title>Example of Sending Messages</title> - <p>In the following example, <c>{Pid, hello_world}</c> is - sent to a registered process <c>my_server</c>. The message is encoded - by <c>erl_send()</c>:</p> - <code type="none"><![CDATA[ -extern const char *erl_thisnodename(void); -extern short erl_thiscreation(void); -#define SELF(fd) erl_mk_pid(erl_thisnodename(),fd,0,erl_thiscreation()) -ETERM *arr[2], *emsg; -int sockfd, creation=1; - -arr[0] = SELF(sockfd); -arr[1] = erl_mk_atom("Hello world"); -emsg = erl_mk_tuple(arr, 2); - -erl_reg_send(sockfd, "my_server", emsg); -erl_free_term(emsg); ]]></code> - <p>The first element of the tuple that is sent is your own - <em>Pid</em>. This enables <c>my_server</c> to reply. Refer to the - Reference Manual, the <c>erl_connect</c> module for more information - about send primitives.</p> - </section> - - <section> - <title>Example of Receiving Messages</title> - <p>In this example <c>{Pid, Something}</c> is received. The - received Pid is then used to return <c>{goodbye,Pid}</c></p> - <code type="none"><![CDATA[ -ETERM *arr[2], *answer; -int sockfd,rc; -char buf[BUFSIZE]; -ErlMessage emsg; - -if ((rc = erl_receive_msg(sockfd , buf, BUFSIZE, &emsg)) == ERL_MSG) { - arr[0] = erl_mk_atom("goodbye"); - arr[1] = erl_element(1, emsg.msg); - answer = erl_mk_tuple(arr, 2); - erl_send(sockfd, arr[1], answer); - erl_free_term(answer); - erl_free_term(emsg.msg); - erl_free_term(emsg.to); -} -} ]]></code> - <p>In order to provide robustness, a distributed Erlang node - occasionally polls all its connected neighbours in an attempt to - detect failed nodes or communication links. A node which receives such - a message is expected to respond immediately with an <c>ERL_TICK</c> message. - This is done automatically by <c>erl_receive()</c>, however when this - has occurred <c>erl_receive</c> returns <c>ERL_TICK</c> to the caller - without storing a message into the <c>ErlMessage</c> structure.</p> - <p>When a message has been received, it is the caller's responsibility - to free the received message <c>emsg.msg</c> as well as <c>emsg.to</c> - or <c>emsg.from</c>, depending on the type of message received.</p> - <p>Refer to the Reference Manual for additional information about the - following modules:</p> - <list type="bulleted"> - <item><c>erl_connect</c></item> - <item><c>erl_eterm</c>.</item> - </list> - </section> - </section> - - <section> - <title>Remote Procedure Calls</title> - <p>An Erlang node acting as a client to another Erlang node - typically sends a request and waits for a reply. Such a request is - included in a function call at a remote node and is called a remote - procedure call. The following example shows how the - Erl_Interface library supports remote procedure calls:</p> - <code type="none"><![CDATA[ - -char modname[]=THE_MODNAME; -ETERM *reply,*ep; -ep = erl_format("[~a,[]]", modname); -if (!(reply = erl_rpc(fd, "c", "c", ep))) - erl_err_msg("<ERROR> when compiling file: %s.erl !\ -", modname); -erl_free_term(ep); -ep = erl_format("{ok,_}"); -if (!erl_match(ep, reply)) - erl_err_msg("<ERROR> compiler errors !\ -"); -erl_free_term(ep); -erl_free_term(reply); ]]></code> - <p><c>c:c/1</c> is called to compile the specified module on the - remote node. <c>erl_match()</c> checks that the compilation was - successful by testing for the expected <c>ok</c>.</p> - <p>Refer to the Reference Manual, the <c>erl_connect</c> module for - more information about <c>erl_rpc()</c>, and its companions - <c>erl_rpc_to()</c> and <c>erl_rpc_from()</c>.</p> - </section> - - <section> - <title>Using Global Names</title> - <p>A C node has access to names registered through the Erlang Global - module. Names can be looked up, allowing the C node to send messages - to named Erlang services. C nodes can also register global names, - allowing them to provide named services to Erlang processes or other C - nodes. </p> - <p>Erl_Interface does not provide a native implementation of the global - service. Instead it uses the global services provided by a "nearby" - Erlang node. In order to use the services described in this section, - it is necessary to first open a connection to an Erlang node.</p> - <p>To see what names there are:</p> - <code type="none"><![CDATA[ -char **names; -int count; -int i; - -names = erl_global_names(fd,&count); - -if (names) - for (i=0; i<count; i++) - printf("%s\ -",names[i]); - -free(names); ]]></code> - <p><c>erl_global_names()</c> allocates and returns a buffer containing - all the names known to global. <c>count</c> will be initialized to - indicate how many names are in the array. The array of strings in - names is terminated by a NULL pointer, so it is not necessary to use - <c>count</c> to determine when the last name is reached.</p> - <p>It is the caller's responsibility to free the array. - <c>erl_global_names()</c> allocates the array and all of the strings - using a single call to <c>malloc()</c>, so <c>free(names)</c> is all - that is necessary.</p> - <p>To look up one of the names:</p> - <code type="none"><![CDATA[ -ETERM *pid; -char node[256]; - -pid = erl_global_whereis(fd,"schedule",node); ]]></code> - <p>If <c>"schedule"</c> is known to global, an Erlang pid is returned - that can be used to send messages to the schedule service. - Additionally, <c>node</c> will be initialized to contain the name of - the node where the service is registered, so that you can make a - connection to it by simply passing the variable to <c>erl_connect()</c>.</p> - <p>Before registering a name, you should already have registered your - port number with <c>epmd</c>. This is not strictly necessary, but if you - neglect to do so, then other nodes wishing to communicate with your - service will be unable to find or connect to your process.</p> - <p>Create a pid that Erlang processes can use to communicate with your - service:</p> - <code type="none"><![CDATA[ -ETERM *pid; - -pid = erl_mk_pid(thisnode,14,0,0); -erl_global_register(fd,servicename,pid); ]]></code> - <p>After registering the name, you should use <c>erl_accept()</c> to wait for - incoming connections.</p> - <p>Do not forget to free <c>pid</c> later with <c>erl_free_term()</c>!</p> - <p>To unregister a name:</p> - <code type="none"><![CDATA[ -erl_global_unregister(fd,servicename); ]]></code> - </section> - - <section> - <title>The Registry</title> - <p>This section describes the use of the registry, a simple mechanism - for storing key-value pairs in a C-node, as well as backing them up or - restoring them from a Mnesia table on an Erlang node. More detailed - information about the individual API functions can be found in the - Reference Manual.</p> - <p>Keys are strings, i.e. <c>NULL</c>-terminated arrays of characters, and values - are arbitrary objects. Although integers and floating point numbers - are treated specially by the registry, you can store strings or binary - objects of any type as pointers.</p> - <p>To start, you need to open a registry:</p> - <code type="none"><![CDATA[ -ei_reg *reg; - -reg = ei_reg_open(45); ]]></code> - <p>The number 45 in the example indicates the approximate number of - objects that you expect to store in the registry. Internally the - registry uses hash tables with collision chaining, so there is no - absolute upper limit on the number of objects that the registry can - contain, but if performance or memory usage are important, then you - should choose a number accordingly. The registry can be resized later.</p> - <p>You can open as many registries as you like (if memory permits).</p> - <p>Objects are stored and retrieved through set and get functions. In - the following examples you see how to store integers, floats, strings - and arbitrary binary objects:</p> - <code type="none"><![CDATA[ -struct bonk *b = malloc(sizeof(*b)); -char *name = malloc(7); - -ei_reg_setival(reg,"age",29); -ei_reg_setfval(reg,"height",1.85); - -strcpy(name,"Martin"); -ei_reg_setsval(reg,"name",name); - -b->l = 42; -b->m = 12; -ei_reg_setpval(reg,"jox",b,sizeof(*b)); ]]></code> - <p>If you attempt to store an object in the registry and there is an - existing object with the same key, the new value will replace the old - one. This is done regardless of whether the new object and the old one - have the same type, so you can, for example, replace a string with an - integer. If the existing value is a string or binary, it will be freed - before the new value is assigned.</p> - <p>Stored values are retrieved from the registry as follows:</p> - <code type="none"><![CDATA[ -long i; -double f; -char *s; -struct bonk *b; -int size; - -i = ei_reg_getival(reg,"age"); -f = ei_reg_getfval(reg,"height"); -s = ei_reg_getsval(reg,"name"); -b = ei_reg_getpval(reg,"jox",&size); ]]></code> - <p>In all of the above examples, the object must exist and it must be of - the right type for the specified operation. If you do not know the - type of a given object, you can ask:</p> - <code type="none"><![CDATA[ -struct ei_reg_stat buf; - -ei_reg_stat(reg,"name",&buf); ]]></code> - <p>Buf will be initialized to contain object attributes.</p> - <p>Objects can be removed from the registry:</p> - <code type="none"><![CDATA[ -ei_reg_delete(reg,"name"); ]]></code> - <p>When you are finished with a registry, close it to remove all the - objects and free the memory back to the system:</p> - <code type="none"><![CDATA[ -ei_reg_close(reg); ]]></code> - - <section> - <title>Backing Up the Registry to Mnesia</title> - <p>The contents of a registry can be backed up to Mnesia on a "nearby" - Erlang node. You need to provide an open connection to the Erlang node - (see <c>erl_connect()</c>). Also, Mnesia 3.0 or later must be running - on the Erlang node before the backup is initiated:</p> - <code type="none"><![CDATA[ -ei_reg_dump(fd, reg, "mtab", dumpflags); ]]></code> - <p>The example above will backup the contents of the registry to the - specified Mnesia table <c>"mtab"</c>. Once a registry has been backed - up to Mnesia in this manner, additional backups will only affect - objects that have been modified since the most recent backup, i.e. - objects that have been created, changed or deleted. The backup - operation is done as a single atomic transaction, so that the entire - backup will be performed or none of it will.</p> - <p>In the same manner, a registry can be restored from a Mnesia table:</p> - <code type="none"><![CDATA[ -ei_reg_restore(fd, reg, "mtab"); ]]></code> - <p>This will read the entire contents of <c>"mtab"</c> into the specified - registry. After the restore, all of the objects in the registry will - be marked as unmodified, so a subsequent backup will only affect - objects that you have modified since the restore.</p> - <p>Note that if you restore to a non-empty registry, objects in the - table will overwrite objects in the registry with the same keys. Also, - the <em>entire</em> contents of the registry is marked as unmodified - after the restore, including any modified objects that were not - overwritten by the restore operation. This may not be your intention.</p> - </section> - - <section> - <title>Storing Strings and Binaries</title> - <p>When string or binary objects are stored in the registry it is - important that a number of simple guidelines are followed. </p> - <p>Most importantly, the object must have been created with a single call - to <c>malloc()</c> (or similar), so that it can later be removed by a - single call to <c>free()</c>. Objects will be freed by the registry - when it is closed, or when you assign a new value to an object that - previously contained a string or binary.</p> - <p>You should also be aware that if you store binary objects that are - context-dependent (e.g. containing pointers or open file descriptors), - they will lose their meaning if they are backed up to a Mnesia table - and subsequently restored in a different context.</p> - <p>When you retrieve a stored string or binary value from the registry, - the registry maintains a pointer to the object and you are passed a - copy of that pointer. You should never free an object retrieved in - this manner because when the registry later attempts to free it, a - runtime error will occur that will likely cause the C-node to crash.</p> - <p>You are free to modify the contents of an object retrieved this way. - However when you do so, the registry will not be aware of the changes - you make, possibly causing it to be missed the next time you make a - Mnesia backup of the registry contents. This can be avoided if you - mark the object as dirty after any such changes with - <c>ei_reg_markdirty()</c>, or pass appropriate flags to - <c>ei_reg_dump()</c>.</p> - </section> - </section> -</chapter> diff --git a/lib/erl_interface/doc/src/erl_malloc.xml b/lib/erl_interface/doc/src/erl_malloc.xml deleted file mode 100644 index 6650620064..0000000000 --- a/lib/erl_interface/doc/src/erl_malloc.xml +++ /dev/null @@ -1,212 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE cref SYSTEM "cref.dtd"> - -<cref> - <header> - <copyright> - <year>1996</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>erl_malloc</title> - <prepared>Torbjörn Törnkvist</prepared> - <responsible>Torbjörn Törnkvist</responsible> - <docno></docno> - <approved>Bjarne Däcker</approved> - <checked>Torbjörn Törnkvist</checked> - <date>1998-07-03</date> - <rev>A</rev> - <file>erl_malloc.xml</file> - </header> - <lib>erl_malloc</lib> - <libsummary>Memory allocation functions.</libsummary> - <description> - <note><p>The support for VxWorks is deprecated as of OTP 22, and - will be removed in OTP 23.</p></note> - <note><p>The old legacy <c>erl_interface</c> library (functions - with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be - removed in OTP 23. This does not apply to the <c>ei</c> - library. Reasonably new <c>gcc</c> compilers will issue deprecation - warnings. In order to disable these warnings, define the macro - <c>EI_NO_DEPR_WARN</c>.</p></note> - <p>This module provides functions for allocating and deallocating - memory.</p> - </description> - - <funcs> - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_alloc_eterm(etype)</nametext></name> - <fsummary>Allocate an ETERM structure.</fsummary> - <type> - <v>unsigned char etype;</v> - </type> - <desc> - <p>Allocates an <c>(ETERM)</c> structure.</p> - <p>Specify <c>etype</c> as one of the following - constants:</p> - <list type="bulleted"> - <item><c>ERL_INTEGER</c> - </item> - <item><c>ERL_U_INTEGER</c> (unsigned integer) - </item> - <item><c>ERL_ATOM</c> - </item> - <item><c>ERL_PID</c> (Erlang process identifier) - </item> - <item><c>ERL_PORT</c> - </item> - <item><c>ERL_REF</c> (Erlang reference) - </item> - <item><c>ERL_LIST</c> - </item> - <item><c>ERL_EMPTY_LIST</c> - </item> - <item><c>ERL_TUPLE</c> - </item> - <item><c>ERL_BINARY</c> - </item> - <item><c>ERL_FLOAT</c> - </item> - <item><c>ERL_VARIABLE</c> - </item> - <item><c>ERL_SMALL_BIG</c> (bignum) - </item> - <item><c>ERL_U_SMALL_BIG</c> (bignum) - </item> - </list> - <p><c>ERL_SMALL_BIG</c> and - <c>ERL_U_SMALL_BIG</c> are for - creating Erlang <c>bignums</c>, which can contain integers - of any size. The size of an integer in Erlang is machine-dependent, - but any integer > 2^28 requires a bignum.</p> - </desc> - </func> - - <func> - <name since=""><ret>void</ret><nametext>erl_eterm_release(void)</nametext></name> - <fsummary>Clear the ETERM freelist.</fsummary> - <desc> - <p>Clears the freelist, where blocks are placed when they are - released by <c>erl_free_term()</c> and - <c>erl_free_compound()</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>void</ret><nametext>erl_eterm_statistics(allocated, freed)</nametext></name> - <fsummary>Report term allocation statistics.</fsummary> - <type> - <v>long *allocated;</v> - <v>long *freed;</v> - </type> - <desc> - <p>Reports term allocation statistics.</p> - <p><c>allocated</c> and <c>freed</c> are - initialized to - contain information about the fix-allocator used to allocate - <c>ETERM</c> components.</p> - <list type="bulleted"> - <item> - <p><c>allocated</c> is the number of blocks currently - allocated to <c>ETERM</c> objects.</p> - </item> - <item> - <p><c>freed</c> is the length of the freelist, where - blocks are placed when they are - released by <c>erl_free_term()</c> and - <c>erl_free_compound()</c>.</p> - </item> - </list> - </desc> - </func> - - <func> - <name since=""><ret>void</ret><nametext>erl_free(ptr)</nametext></name> - <fsummary>Free some memory.</fsummary> - <type> - <v>void *ptr;</v> - </type> - <desc> - <p>Calls the standard - <c>free()</c> function.</p> - </desc> - </func> - - <func> - <name since=""><ret>void</ret><nametext>erl_free_array(array, size)</nametext></name> - <fsummary>Free an array of ETERM structures.</fsummary> - <type> - <v>ETERM **array;</v> - <v>int size;</v> - </type> - <desc> - <p>Frees an array of Erlang terms.</p> - <list type="bulleted"> - <item><c>array</c> is an array of ETERM* objects.</item> - <item><c>size</c> is the number of terms in the array. - </item> - </list> - </desc> - </func> - - <func> - <name since=""><ret>void</ret><nametext>erl_free_compound(t)</nametext></name> - <fsummary>Free an array of ETERM structures.</fsummary> - <type> - <v>ETERM *t;</v> - </type> - <desc> - <p>Normally it is the programmer's responsibility to free each - Erlang term that has been returned from any of the - <c>Erl_Interface</c> functions. However, as many of the - functions that build new Erlang terms in fact share objects - with other existing terms, it can be difficult for the - programmer to maintain pointers to all such terms to - free them individually.</p> - <p><c>erl_free_compound()</c> recursively frees all of the - subterms associated with a specified Erlang term, regardless of - whether we are still holding pointers to the subterms.</p> - <p>For an example, see section - <seealso marker="ei_users_guide#building_terms_and_patterns">Building Terms and Patterns</seealso> - in the User's Guide.</p> - </desc> - </func> - - <func> - <name since=""><ret>void</ret><nametext>erl_free_term(t)</nametext></name> - <fsummary>Free an ETERM structure.</fsummary> - <type> - <v>ETERM *t;</v> - </type> - <desc> - <p>Frees an Erlang term.</p> - </desc> - </func> - - <func> - <name since=""><ret>void</ret><nametext>erl_malloc(size)</nametext></name> - <fsummary>Allocate some memory.</fsummary> - <type> - <v>long size;</v> - </type> - <desc> - <p>Calls the standard - <c>malloc()</c> function.</p> - </desc> - </func> - </funcs> -</cref> diff --git a/lib/erl_interface/doc/src/erl_marshal.xml b/lib/erl_interface/doc/src/erl_marshal.xml deleted file mode 100644 index 33d359d871..0000000000 --- a/lib/erl_interface/doc/src/erl_marshal.xml +++ /dev/null @@ -1,276 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE cref SYSTEM "cref.dtd"> - -<cref> - <header> - <copyright> - <year>1996</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>erl_marshal</title> - <prepared>Torbjörn Törnkvist</prepared> - <responsible>Torbjörn Törnkvist</responsible> - <docno></docno> - <approved>Bjarne Däcker</approved> - <checked>Torbjörn Törnkvist</checked> - <date>1998-07-03</date> - <rev>A</rev> - <file>erl_marshal.xml</file> - </header> - <lib>erl_marshal</lib> - <libsummary>Encoding and decoding of Erlang terms.</libsummary> - <description> - <note><p>The support for VxWorks is deprecated as of OTP 22, and - will be removed in OTP 23.</p></note> - <note><p>The old legacy <c>erl_interface</c> library (functions - with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be - removed in OTP 23. This does not apply to the <c>ei</c> - library. Reasonably new <c>gcc</c> compilers will issue deprecation - warnings. In order to disable these warnings, define the macro - <c>EI_NO_DEPR_WARN</c>.</p></note> - <p>This module contains functions for encoding Erlang terms into - a sequence of bytes, and for decoding Erlang terms from a - sequence of bytes.</p> - </description> - - <funcs> - <func> - <name since=""><ret>int</ret><nametext>erl_compare_ext(bufp1, bufp2)</nametext></name> - <fsummary>Compare encoded byte sequences.</fsummary> - <type> - <v>unsigned char *bufp1,*bufp2;</v> - </type> - <desc> - <p>Compares two encoded terms.</p> - <list type="bulleted"> - <item><c>bufp1</c> is a buffer containing an encoded - Erlang term term1.</item> - <item><c>bufp2</c> is a buffer containing an encoded - Erlang term term2.</item> - </list> - <p>Returns <c>0</c> if the terms are equal, <c>-1</c> if - <c>term1</c> < <c>term2</c>, or <c>1</c> if <c>term2</c> < - <c>term1</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>ETERM *</ret><nametext>erl_decode(bufp)</nametext></name> - <name since=""><ret>ETERM *</ret><nametext>erl_decode_buf(bufpp)</nametext></name> - <fsummary>Convert a term from Erlang external format.</fsummary> - <type> - <v>unsigned char *bufp;</v> - <v>unsigned char **bufpp;</v> - </type> - <desc> - <p><c>erl_decode()</c> and - <c>erl_decode_buf()</c> decode - the contents of a buffer and return the corresponding - Erlang term. <c>erl_decode_buf()</c> provides a simple - mechanism for dealing with several encoded terms stored - consecutively in the buffer.</p> - <list type="bulleted"> - <item> - <p><c>bufp</c> is a pointer to a buffer containing one - or more encoded Erlang terms.</p> - </item> - <item> - <p><c>bufpp</c> is the address of a buffer pointer. The - buffer contains one or more consecutively encoded Erlang terms. - Following a successful call to - <c>erl_decode_buf()</c>, <c>bufpp</c> is - updated so that it points to the next encoded term.</p> - </item> - </list> - <p><c>erl_decode()</c> returns an Erlang term - corresponding to the contents of <c>bufp</c> on success, - otherwise <c>NULL</c>. <c>erl_decode_buf()</c> - returns an Erlang - term corresponding to the first of the consecutive terms in - <c>bufpp</c> and moves <c>bufpp</c> forward - to point to the - next term in the buffer. On failure, each of the functions - return <c>NULL</c>.</p> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_encode(term, bufp)</nametext></name> - <name since=""><ret>int</ret><nametext>erl_encode_buf(term, bufpp)</nametext></name> - <fsummary>Convert a term into Erlang external format.</fsummary> - <type> - <v>ETERM *term;</v> - <v>unsigned char *bufp;</v> - <v>unsigned char **bufpp;</v> - </type> - <desc> - <p><c>erl_encode()</c> and - <c>erl_encode_buf()</c> encode - Erlang terms into external format for storage or transmission. - <c>erl_encode_buf()</c> provides a simple mechanism for - encoding several terms consecutively in the same buffer.</p> - <list type="bulleted"> - <item> - <p><c>term</c> is an Erlang term to be encoded.</p> - </item> - <item> - <p><c>bufp</c> is a pointer to a buffer containing one or - more encoded Erlang terms.</p> - </item> - <item> - <p><c>bufpp</c> is a pointer to a pointer to a buffer - containing one or more consecutively encoded Erlang terms. - Following a successful call to - <c>erl_encode_buf()</c>, <c>bufpp</c> is updated so - that it points to the - position for the next encoded term.</p> - </item> - </list> - <p>These functions return the number of bytes written to buffer - on success, otherwise <c>0</c>.</p> - <p>Notice that no bounds checking is done on the buffer. It is - the caller's responsibility to ensure that the buffer is - large enough to hold the encoded terms. You can either use a - static buffer that is large enough to hold the terms you expect - to need in your program, or use <c>erl_term_len()</c> - to determine the exact requirements for a given term.</p> - <p>The following can help you estimate the buffer - requirements for a term. Notice that this information is - implementation-specific, and can change in future versions. - If you are unsure, use <c>erl_term_len()</c>.</p> - <p>Erlang terms are encoded with a 1 byte tag that - identifies the type of object, a 2- or 4-byte length field, - and then the data itself. Specifically:</p> - <taglist> - <tag><c>Tuples</c></tag> - <item>Need 5 bytes, plus the space for each element.</item> - <tag><c>Lists</c></tag> - <item>Need 5 bytes, plus the space for each element, and 1 - more byte for the empty list at the end.</item> - <tag><c>Strings and atoms</c></tag> - <item>Need 3 bytes, plus 1 byte for each character (the - terminating 0 is not encoded). Really long strings (more - than 64k characters) are encoded as lists. Atoms cannot - contain more than 256 characters.</item> - <tag><c>Integers</c></tag> - <item>Need 5 bytes.</item> - <tag><c>Characters</c></tag> - <item>(Integers < 256) need 2 bytes.</item> - <tag><c>Floating point numbers</c></tag> - <item>Need 32 bytes.</item> - <tag><c>Pids</c></tag> - <item>Need 10 bytes, plus the space for the node name, which - is an atom.</item> - <tag><c>Ports and Refs</c></tag> - <item>Need 6 bytes, plus the space for the node name, which - is an atom.</item> - </taglist> - <p>The total space required is the result calculated - from the information above, plus 1 more byte for a - version identifier.</p> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_ext_size(bufp)</nametext></name> - <fsummary>Count elements in encoded term.</fsummary> - <type> - <v>unsigned char *bufp;</v> - </type> - <desc> - <p>Returns the number of elements in an encoded term.</p> - </desc> - </func> - - <func> - <name since=""><ret>unsigned char</ret><nametext>erl_ext_type(bufp)</nametext></name> - <fsummary>Determine type of an encoded byte sequence.</fsummary> - <type> - <v>unsigned char *bufp;</v> - </type> - <desc> - <p>Identifies and returns the type of Erlang term encoded - in a buffer. It skips a trailing <em>magic</em> identifier.</p> - <p>Returns <c>0</c> if the type cannot be determined or - one of:</p> - <list type="bulleted"> - <item><c>ERL_INTEGER</c> - </item> - <item><c>ERL_ATOM</c> - </item> - <item><c>ERL_PID</c> (Erlang process identifier) - </item> - <item><c>ERL_PORT</c> - </item> - <item><c>ERL_REF</c> (Erlang reference) - </item> - <item><c>ERL_EMPTY_LIST</c> - </item> - <item><c>ERL_LIST</c> - </item> - <item><c>ERL_TUPLE</c> - </item> - <item><c>ERL_FLOAT</c> - </item> - <item><c>ERL_BINARY</c> - </item> - <item><c>ERL_FUNCTION</c> - </item> - </list> - </desc> - </func> - - <func> - <name since=""><ret>unsigned char *</ret><nametext>erl_peek_ext(bufp, pos)</nametext></name> - <fsummary>Step over encoded term.</fsummary> - <type> - <v>unsigned char *bufp;</v> - <v>int pos;</v> - </type> - <desc> - <p>This function is used for stepping over one or more - encoded terms in a buffer, to directly access later term.</p> - <list type="bulleted"> - <item><c>bufp</c> is a pointer to a buffer containing one - or more encoded Erlang terms.</item> - <item><c>pos</c> indicates how many terms to step over in - the buffer.</item> - </list> - <p>Returns a pointer to a subterm that can be - used in a later call to <c>erl_decode()</c> to retrieve - the term at that position. If there is no term, or - <c>pos</c> would exceed the size of the terms in the - buffer, <c>NULL</c> is returned.</p> - </desc> - </func> - - <func> - <name since=""><ret>int</ret><nametext>erl_term_len(t)</nametext></name> - <fsummary>Determine encoded size of term.</fsummary> - <type> - <v>ETERM *t;</v> - </type> - <desc> - <p>Determines the buffer space that would be - needed by <c>t</c> if it were encoded into Erlang external - format by <c>erl_encode()</c>.</p> - <p>Returns the size in bytes.</p> - </desc> - </func> - </funcs> -</cref> diff --git a/lib/erl_interface/doc/src/part_erl_interface.xml b/lib/erl_interface/doc/src/part_erl_interface.xml deleted file mode 100644 index e256cfa193..0000000000 --- a/lib/erl_interface/doc/src/part_erl_interface.xml +++ /dev/null @@ -1,33 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>1996</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Erl_Interface User's Guide</title> - <prepared>Gordon Beaton</prepared> - <docno></docno> - <date>1998-11-30</date> - <rev>1.2</rev> - <file>part_erl_interface.sgml</file> - </header> - <xi:include href="erl_interface.xml"/> -</part> diff --git a/lib/erl_interface/doc/src/ref_man.xml b/lib/erl_interface/doc/src/ref_man.xml index a4f947c79f..d00868562f 100644 --- a/lib/erl_interface/doc/src/ref_man.xml +++ b/lib/erl_interface/doc/src/ref_man.xml @@ -31,22 +31,10 @@ <description> <note><p>The support for VxWorks is deprecated as of OTP 22, and will be removed in OTP 23.</p></note> - <note><p>The old legacy <c>erl_interface</c> library (functions - with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be - removed in OTP 23. This does not apply to the <c>ei</c> - library. Reasonably new <c>gcc</c> compilers will issue deprecation - warnings. In order to disable these warnings, define the macro - <c>EI_NO_DEPR_WARN</c>.</p></note> </description> <xi:include href="ei.xml"/> <xi:include href="ei_connect.xml"/> <xi:include href="registry.xml"/> - <xi:include href="erl_connect.xml"/> - <xi:include href="erl_error.xml"/> - <xi:include href="erl_eterm.xml"/> - <xi:include href="erl_format.xml"/> - <xi:include href="erl_global.xml"/> - <xi:include href="erl_malloc.xml"/> - <xi:include href="erl_marshal.xml"/> - <xi:include href="erl_call.xml"/> + <xi:include href="ei_global.xml"/> + <xi:include href="erl_call_cmd.xml"/> </application> diff --git a/lib/erl_interface/doc/src/ref_man_ei.xml b/lib/erl_interface/doc/src/ref_man_ei.xml deleted file mode 100644 index d8d1deaea1..0000000000 --- a/lib/erl_interface/doc/src/ref_man_ei.xml +++ /dev/null @@ -1,53 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE application SYSTEM "application.dtd"> - -<application xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2002</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>EI Library Reference</title> - <prepared>Gordon Beaton</prepared> - <docno></docno> - <date>1998-11-30</date> - <rev>1.2</rev> - <file>ref_man_ei.xml</file> - </header> - <description> - <note><p>The support for VxWorks is deprecated as of OTP 22, and - will be removed in OTP 23.</p></note> - <note><p>The old legacy <c>erl_interface</c> library (functions - with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be - removed in OTP 23. This does not apply to the <c>ei</c> - library. Reasonably new <c>gcc</c> compilers will issue deprecation - warnings. In order to disable these warnings, define the macro - <c>EI_NO_DEPR_WARN</c>.</p></note> - <note> - <p>By default, the <c>ei</c> library is only guaranteed - to be compatible with other Erlang/OTP components from the same - release as the <c>ei</c> library itself. See the documentation of the - <seealso marker="ei#ei_set_compat_rel">ei_set_compat_rel()</seealso> - function on how to communicate with Erlang/OTP components from earlier - releases.</p> - </note> - </description> - <xi:include href="ei.xml"/> - <xi:include href="ei_connect.xml"/> - <xi:include href="registry.xml"/> -</application> diff --git a/lib/erl_interface/doc/src/ref_man_erl_interface.xml b/lib/erl_interface/doc/src/ref_man_erl_interface.xml deleted file mode 100644 index 2b69d0fa74..0000000000 --- a/lib/erl_interface/doc/src/ref_man_erl_interface.xml +++ /dev/null @@ -1,60 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE application SYSTEM "application.dtd"> - -<application xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>1996</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Erl_Interface Library Reference</title> - <prepared>Gordon Beaton</prepared> - <docno></docno> - <date>1998-11-30</date> - <rev>1.2</rev> - <file>ref_man_erl_interface.xml</file> - </header> - <description> - <note><p>The support for VxWorks is deprecated as of OTP 22, and - will be removed in OTP 23.</p></note> - <note><p>The old legacy <c>erl_interface</c> library (functions - with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be - removed in OTP 23. This does not apply to the <c>ei</c> - library. Reasonably new <c>gcc</c> compilers will issue deprecation - warnings. In order to disable these warnings, define the macro - <c>EI_NO_DEPR_WARN</c>.</p></note> - <p>The <c>erl_interface</c> library is a <c>C</c> interface library - for communication with <c>Erlang</c>.</p> - <note> - <p>By default, the <c>erl_interface</c> library is only guaranteed - to be compatible with other Erlang/OTP components from the same - release as the <c>erl_interface</c> library. See the documentation - of the - <seealso marker="erl_eterm#erl_set_compat_rel">erl_set_compat_rel()</seealso> - function on how to communicate with Erlang/OTP components from earlier - releases.</p> - </note> - </description> - <xi:include href="erl_connect.xml"/> - <xi:include href="erl_error.xml"/> - <xi:include href="erl_eterm.xml"/> - <xi:include href="erl_format.xml"/> - <xi:include href="erl_global.xml"/> - <xi:include href="erl_malloc.xml"/> - <xi:include href="erl_marshal.xml"/> -</application> diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h index b138118f04..7d96dac560 100644 --- a/lib/erl_interface/include/ei.h +++ b/lib/erl_interface/include/ei.h @@ -43,7 +43,7 @@ typedef LONG_PTR ssize_t; /* Sigh... */ #include <stdio.h> /* Need type FILE */ #include <errno.h> /* Need EHOSTUNREACH, ENOMEM, ... */ -#if !(defined(__WIN32__) || defined(_WIN32)) && !defined(VXWORKS) || (defined(VXWORKS) && defined(HAVE_SENS)) +#if !(defined(__WIN32__) || defined(_WIN32)) # include <netdb.h> #endif @@ -188,20 +188,20 @@ extern "C" { * the 'ei' interface as well.... :-( */ -#if defined(_REENTRANT) || defined(VXWORKS) || defined(__WIN32__) +#if defined(_REENTRANT) || defined(__WIN32__) /* 'erl_errno' as a function return value */ volatile int* __erl_errno_place(void) __attribute__ ((__const__)); #define erl_errno (*__erl_errno_place ()) -#else /* !_REENTRANT && !VXWORKS && !__WIN32__ */ +#else /* !_REENTRANT && !__WIN32__ */ extern volatile int __erl_errno; #define erl_errno __erl_errno -#endif /* !_REENTRANT && !VXWORKS && !__WIN32__ */ +#endif /* !_REENTRANT && !__WIN32__ */ /* -------------------------------------------------------------------- */ @@ -323,13 +323,24 @@ typedef struct { #define EI_SCLBK_FLG_FULL_IMPL (1 << 0) +/* + * HACK: AIX defines many socket functions like accept to be naccept, which + * pollutes the global namespace. Set up an ugly ifdef for consumers of this + * API here so they get a mangled name for AIX and the sane name elsewhere. + */ +#ifdef _AIX +#define EI_ACCEPT_NAME accept_ei +#else +#define EI_ACCEPT_NAME accept +#endif + typedef struct { int flags; int (*socket)(void **ctx, void *setup_ctx); int (*close)(void *ctx); int (*listen)(void *ctx, void *addr, int *len, int backlog); - int (*accept)(void **ctx, void *addr, int *len, unsigned tmo); + int (*EI_ACCEPT_NAME)(void **ctx, void *addr, int *len, unsigned tmo); int (*connect)(void *ctx, void *addr, int len, unsigned tmo); int (*writev)(void *ctx, const void *iov, int iovcnt, ssize_t *len, unsigned tmo); int (*write)(void *ctx, const char *buf, ssize_t *len, unsigned tmo); @@ -351,7 +362,7 @@ typedef struct ei_cnode_s { /* Currently this_ipaddr isn't used */ /* struct in_addr this_ipaddr; */ char ei_connect_cookie[EI_MAX_COOKIE_SIZE+1]; - short creation; + unsigned int creation; erlang_pid self; ei_socket_callbacks *cbs; void *setup_context; @@ -393,8 +404,12 @@ int ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname, int ei_connect(ei_cnode* ec, char *nodename); int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms); +int ei_connect_host_port(ei_cnode* ec, char *hostname, int port); +int ei_connect_host_port_tmo(ei_cnode* ec, char *hostname, int port, unsigned ms); int ei_xconnect(ei_cnode* ec, Erl_IpAddr adr, char *alivename); int ei_xconnect_tmo(ei_cnode* ec, Erl_IpAddr adr, char *alivename, unsigned ms); +int ei_xconnect_host_port(ei_cnode* ec, Erl_IpAddr adr, int port); +int ei_xconnect_host_port_tmo(ei_cnode* ec, Erl_IpAddr adr, int port, unsigned ms); int ei_receive(int fd, unsigned char *bufp, int bufsize); int ei_receive_tmo(int fd, unsigned char *bufp, int bufsize, unsigned ms); @@ -444,41 +459,6 @@ int ei_get_tracelevel(void); * We have erl_gethost*() so we include ei versions as well. */ -#if defined(VXWORKS) - -extern int h_errno; - -/* - * We need these definitions - if the user has SENS then he gets them - * from netdb.h, otherwise we define them ourselves. - * - * If you are getting "multiple definition" errors here, - * make sure you have included <netdb.h> BEFORE "erl_interface.h" - * or define HAVE_SENS in your CFLAGS. - */ - -#if !defined(HAVE_SENS) && !defined(HOST_NOT_FOUND) /* just in case */ - -struct hostent { - char *h_name; /* official name of host */ - char **h_aliases; /* alias list */ - int h_addrtype; /* host address type */ - int h_length; /* length of address */ - char **h_addr_list; /* list of addresses from name server */ -#define h_addr h_addr_list[0] /* address, for backward compatiblity */ - unsigned int unused; /* SENS defines this as ttl */ -}; - -#define HOST_NOT_FOUND 1 /* Authoritative Answer Host not found */ -#define TRY_AGAIN 2 /* Non-Authoritive Host not found, or SERVERFAIL */ -#define NO_RECOVERY 3 /* Non recoverable errors, FORMERR, REFUSED, NOTIMP */ -#define NO_DATA 4 /* Valid name, no data record of requested type */ -#define NO_ADDRESS NO_DATA /* no address, look for MX record */ - -#endif /* !HAVE_SENS && !HOST_NOT_FOUND */ -#endif /* VXWORKS */ - - struct hostent *ei_gethostbyname(const char *name); struct hostent *ei_gethostbyaddr(const char *addr, int len, int type); struct hostent *ei_gethostbyname_r(const char *name, @@ -537,8 +517,6 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p); int ei_x_encode_port(ei_x_buff* x, const erlang_port *p); int ei_encode_ref(char *buf, int *index, const erlang_ref *p); int ei_x_encode_ref(ei_x_buff* x, const erlang_ref *p); -int ei_encode_term(char *buf, int *index, void *t) EI_DEPRECATED_ATTR; -int ei_x_encode_term(ei_x_buff* x, void* t) EI_DEPRECATED_ATTR; int ei_encode_trace(char *buf, int *index, const erlang_trace *p); int ei_x_encode_trace(ei_x_buff* x, const erlang_trace *p); int ei_encode_tuple_header(char *buf, int *index, int arity); @@ -586,7 +564,6 @@ void free_fun(erlang_fun* f); int ei_decode_pid(const char *buf, int *index, erlang_pid *p); int ei_decode_port(const char *buf, int *index, erlang_port *p); int ei_decode_ref(const char *buf, int *index, erlang_ref *p); -int ei_decode_term(const char *buf, int *index, void *t) EI_DEPRECATED_ATTR; int ei_decode_trace(const char *buf, int *index, erlang_trace *p); int ei_decode_tuple_header(const char *buf, int *index, int *arity); int ei_decode_list_header(const char *buf, int *index, int *arity); @@ -802,6 +779,13 @@ int ei_reg_dump(int fd, ei_reg *reg, const char *mntab, int flags); int ei_reg_restore(int fd, ei_reg *reg, const char *mntab); int ei_reg_purge(ei_reg *reg); +/* -------------------------------------------------------------------- */ +/* The ei_global functions */ +/* -------------------------------------------------------------------- */ +char **ei_global_names(ei_cnode *ec, int fd, int *count); +int ei_global_whereis(ei_cnode *ec, int fd, const char *name, erlang_pid* pid, char *node); +int ei_global_register(int fd, const char *name, erlang_pid *self); +int ei_global_unregister(ei_cnode *ec, int fd, const char *name); /* -------------------------------------------------------------------- */ /* Encoding/decoding bugnums to GNU MP format */ @@ -832,14 +816,12 @@ int ei_x_encode_bignum(ei_x_buff *x, mpz_t obj); #define EI_ULONGLONG unsigned long long #endif -#ifndef VXWORKS int ei_decode_longlong(const char *buf, int *index, EI_LONGLONG *p); int ei_decode_ulonglong(const char *buf, int *index, EI_ULONGLONG *p); int ei_encode_longlong(char *buf, int *index, EI_LONGLONG p); int ei_encode_ulonglong(char *buf, int *index, EI_ULONGLONG p); int ei_x_encode_longlong(ei_x_buff* x, EI_LONGLONG n); int ei_x_encode_ulonglong(ei_x_buff* x, EI_ULONGLONG n); -#endif #ifdef USE_EI_UNDOCUMENTED diff --git a/lib/erl_interface/src/legacy/erl_global.h b/lib/erl_interface/include/ei_global.h index d2eec08b35..b85a31217d 100644 --- a/lib/erl_interface/src/legacy/erl_global.h +++ b/lib/erl_interface/include/ei_global.h @@ -17,12 +17,13 @@ * * %CopyrightEnd% */ -#ifndef _ERL_GLOBAL_H -#define _ERL_GLOBAL_H +#ifndef _EI_GLOBAL_H +#define _EI_GLOBAL_H +#include "ei.h" -char **erl_global_names(int fd, int *count); -ETERM *erl_global_whereis(int fd, const char *name, char *node); -int erl_global_register(int fd, const char *name, ETERM *pid); -int erl_global_unregister(int fd, const char *name); +char **ei_global_names(ei_cnode *ec, int fd, int *count); +int ei_global_whereis(ei_cnode *ec, int fd, const char *name, erlang_pid* pid, char *node); +int ei_global_register(int fd, const char *name, erlang_pid *self); +int ei_global_unregister(ei_cnode *ec, int fd, const char *name); -#endif /* _ERL_GLOBAL_H */ +#endif /* _EI_GLOBAL_H */ diff --git a/lib/erl_interface/include/erl_interface.h b/lib/erl_interface/include/erl_interface.h deleted file mode 100644 index 7c87223a38..0000000000 --- a/lib/erl_interface/include/erl_interface.h +++ /dev/null @@ -1,473 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef _ERL_INTERFACE_H -#define _ERL_INTERFACE_H - -/************************************************************************/ -/* This file defines the complete interface to erl_interface */ -/* Note: the 'ei' interface is the prefered C API. */ -/************************************************************************/ - -#include "ei.h" /* ei is the base */ - -/* -------------------------------------------------------------------- */ -/* Public defines */ -/* -------------------------------------------------------------------- */ - -#define ERL_COMPOUND (1 << 7) - -#define ERL_UNDEF 0 -#define ERL_INTEGER 1 -#define ERL_U_INTEGER 2 /* unsigned int */ -#define ERL_ATOM 3 -#define ERL_PID 4 -#define ERL_PORT 5 -#define ERL_REF 6 -#define ERL_CONS (7 | ERL_COMPOUND) -#define ERL_LIST ERL_CONS -#define ERL_NIL 8 -#define ERL_EMPTY_LIST ERL_NIL -#define ERL_TUPLE (9 | ERL_COMPOUND) -#define ERL_BINARY 10 -#define ERL_FLOAT 11 -#define ERL_VARIABLE (12 | ERL_COMPOUND) /* used in patterns */ -#define ERL_SMALL_BIG 13 -#define ERL_U_SMALL_BIG 14 -#define ERL_FUNCTION (15 | ERL_COMPOUND) -#define ERL_BIG 16 -#define ERL_LONGLONG 17 -#define ERL_U_LONGLONG 18 - - -#define ERL_TYPE(x) (ERL_HEADER(x)->type) - -/* FIXME some macros left in erl_eterm.h should probably be documented */ - -#define ERL_IS_INTEGER(x) (ERL_TYPE(x) == ERL_INTEGER) -#define ERL_IS_UNSIGNED_INTEGER(x) (ERL_TYPE(x) == ERL_U_INTEGER) -#define ERL_IS_LONGLONG(x) (ERL_TYPE(x) == ERL_LONGLONG) -#define ERL_IS_UNSIGNED_LONGLONG(x) (ERL_TYPE(x) == ERL_U_LONGLONG) -#define ERL_IS_FLOAT(x) (ERL_TYPE(x) == ERL_FLOAT) -#define ERL_IS_ATOM(x) (ERL_TYPE(x) == ERL_ATOM) -#define ERL_IS_PID(x) (ERL_TYPE(x) == ERL_PID) -#define ERL_IS_PORT(x) (ERL_TYPE(x) == ERL_PORT) -#define ERL_IS_REF(x) (ERL_TYPE(x) == ERL_REF) -#define ERL_IS_TUPLE(x) (ERL_TYPE(x) == ERL_TUPLE) -#define ERL_IS_BINARY(x) (ERL_TYPE(x) == ERL_BINARY) -#define ERL_IS_NIL(x) (ERL_TYPE(x) == ERL_NIL) -#define ERL_IS_EMPTY_LIST(x) ERL_IS_NIL(x) -#define ERL_IS_CONS(x) (ERL_TYPE(x) == ERL_CONS) -#define ERL_IS_LIST(x) (ERL_IS_CONS(x) || ERL_IS_EMPTY_LIST(x)) - -/* - * Macros used for XXXX - */ - -#define ERL_HEADER(x) ((Erl_Header *)x) -#define ERL_COUNT(x) (ERL_HEADER(x)->count) - -/* - * Macros used for retrieving values from Erlang terms. - */ - -#define ERL_INT_VALUE(x) ((x)->uval.ival.i) -#define ERL_INT_UVALUE(x) ((x)->uval.uival.u) -#define ERL_LL_VALUE(x) ((x)->uval.llval.i) -#define ERL_LL_UVALUE(x) ((x)->uval.ullval.u) - -#define ERL_FLOAT_VALUE(x) ((x)->uval.fval.f) - -#define ERL_ATOM_PTR(x) erl_atom_ptr_latin1((Erl_Atom_data*) &(x)->uval.aval.d) -#define ERL_ATOM_PTR_UTF8(x) erl_atom_ptr_utf8((Erl_Atom_data*) &(x)->uval.aval.d) -#define ERL_ATOM_SIZE(x) erl_atom_size_latin1((Erl_Atom_data*) &(x)->uval.aval.d) -#define ERL_ATOM_SIZE_UTF8(x) erl_atom_size_utf8((Erl_Atom_data*) &(x)->uval.aval.d) - -#define ERL_PID_NODE(x) erl_atom_ptr_latin1((Erl_Atom_data*) &(x)->uval.pidval.node) -#define ERL_PID_NODE_UTF8(x) erl_atom_ptr_utf8((Erl_Atom_data*) &(x)->uval.pidval.node) -#define ERL_PID_NUMBER(x) ((x)->uval.pidval.number) -#define ERL_PID_SERIAL(x) ((x)->uval.pidval.serial) -#define ERL_PID_CREATION(x) ((x)->uval.pidval.creation) - -#define ERL_PORT_NODE(x) erl_atom_ptr_latin1((Erl_Atom_data*) &(x)->uval.portval.node) -#define ERL_PORT_NODE_UTF8(x) erl_atom_ptr_utf8((Erl_Atom_data*) &(x)->uval.portval.node) -#define ERL_PORT_NUMBER(x) ((x)->uval.portval.number) -#define ERL_PORT_CREATION(x) ((x)->uval.portval.creation) - -#define ERL_REF_NODE(x) erl_atom_ptr_latin1((Erl_Atom_data*) &(x)->uval.refval.node) -#define ERL_REF_NODE_UTF8(x) erl_atom_ptr_utf8((Erl_Atom_data*) &(x)->uval.refval.node) -#define ERL_REF_NUMBER(x) ((x)->uval.refval.n[0]) -#define ERL_REF_NUMBERS(x) ((x)->uval.refval.n) -#define ERL_REF_LEN(x) ((x)->uval.refval.len) -#define ERL_REF_CREATION(x) ((x)->uval.refval.creation) - -#define ERL_TUPLE_SIZE(x) ((x)->uval.tval.size) - -/* NOTE!!! This is 0-based!! (first item is number 0) - * Note too that element/2 (in Erlang) and - * erl_element() are both 1-based. - */ -#define ERL_TUPLE_ELEMS(x) ((x)->uval.tval.elems) -#define ERL_TUPLE_ELEMENT(x, i) (ERL_TUPLE_ELEMS(x)[(i)]) - -#define ERL_BIN_SIZE(x) ((x)->uval.bval.size) -#define ERL_BIN_PTR(x) ((x)->uval.bval.b) - -#define ERL_CONS_HEAD(x) ((x)->uval.lval.head) -#define ERL_CONS_TAIL(x) ((x)->uval.lval.tail) - -#define ERL_VAR_LEN(x) ((x)->uval.vval.len) -#define ERL_VAR_NAME(x) ((x)->uval.vval.name) -#define ERL_VAR_VALUE(x) ((x)->uval.vval.v) - -#define ERL_CLOSURE_SIZE(x) ((x)->uval.funcval.size) -#define ERL_FUN_CREATOR(x) ((x)->uval.funcval.creator) -#define ERL_FUN_MODULE(x) ((x)->uval.funcval.module) -#define ERL_FUN_UNIQ(x) ((x)->uval.funcval.uniq) -#define ERL_FUN_INDEX(x) ((x)->uval.funcval.index) -#define ERL_FUN_ARITY(x) ((x)->uval.funcval.arity) -#define ERL_FUN_NEW_INDEX(x) ((x)->uval.funcval.new_index) -#define ERL_FUN_MD5(x) ((x)->uval.funcval.md5) -#define ERL_CLOSURE(x) ((x)->uval.funcval.closure) -#define ERL_CLOSURE_ELEMENT(x,i) (ERL_CLOSURE(x)[(i)]) - - -#ifdef __cplusplus -extern "C" { -#endif - -/* -------------------------------------------------------------------- */ -/* Type definitions of Erlang terms in C */ -/* -------------------------------------------------------------------- */ - -typedef struct { - unsigned int count:24; /* reference counter */ - unsigned int type:8; /* type of Erlang term */ -} Erl_Header; - -typedef struct { - Erl_Header h; - int i; -} Erl_Integer; - -typedef struct { - Erl_Header h; - unsigned int u; -} Erl_Uinteger; - -typedef struct { - Erl_Header h; - long long i; -} Erl_LLInteger; - -typedef struct { - Erl_Header h; - unsigned long long u; -} Erl_ULLInteger; - -typedef struct { - Erl_Header h; - double f; -} Erl_Float; - -typedef struct { - char *utf8; - int lenU; - char *latin1; - int lenL; -} Erl_Atom_data; - -char* erl_atom_ptr_latin1(Erl_Atom_data*) EI_DEPRECATED_ATTR; -char* erl_atom_ptr_utf8(Erl_Atom_data*) EI_DEPRECATED_ATTR; -int erl_atom_size_latin1(Erl_Atom_data*) EI_DEPRECATED_ATTR; -int erl_atom_size_utf8(Erl_Atom_data*) EI_DEPRECATED_ATTR; -char* erl_atom_init_latin1(Erl_Atom_data*, const char*) EI_DEPRECATED_ATTR; - -typedef struct { - Erl_Header h; - Erl_Atom_data d; -} Erl_Atom; - -typedef struct { - Erl_Header h; - Erl_Atom_data node; - unsigned int number; - unsigned int serial; - unsigned int creation; -} Erl_Pid; - -typedef struct { - Erl_Header h; - Erl_Atom_data node; - unsigned int number; - unsigned int creation; -} Erl_Port; - -typedef struct { - Erl_Header h; - Erl_Atom_data node; - int len; - unsigned int n[3]; - unsigned int creation; -} Erl_Ref; - -typedef struct { - Erl_Header h; - int arity; - int is_neg; - unsigned short *digits; -} Erl_Big; - -struct _eterm; /* forward */ - -typedef struct { - Erl_Header h; - struct _eterm *head; - struct _eterm *tail; -} Erl_List; - -typedef struct { - Erl_Header h; -} Erl_EmptyList; - -typedef struct { - Erl_Header h; - int size; - struct _eterm **elems; -} Erl_Tuple; - -typedef struct { - Erl_Header h; - int size; - unsigned char *b; -} Erl_Binary; - -/* Variables may only exist in patterns. - * Note: identical variable names in a pattern - * denotes the same value. - */ -typedef struct { - Erl_Header h; - int len; - char *name; - struct _eterm *v; -} Erl_Variable; - - -typedef struct { - Erl_Header h; - int size; /* size of closure */ - int arity; /* arity for new (post R7) external funs */ - unsigned char md5[16]; /* md5 for new funs */ - int new_index; /* new funs */ - struct _eterm* creator; /* pid */ - struct _eterm* module; /* module */ - struct _eterm* index; - struct _eterm* uniq; - struct _eterm** closure; -} Erl_Function; - -typedef struct _eterm { - union { - Erl_Integer ival; - Erl_Uinteger uival; - Erl_LLInteger llval; - Erl_ULLInteger ullval; - Erl_Float fval; - Erl_Atom aval; - Erl_Pid pidval; - Erl_Port portval; - Erl_Ref refval; - Erl_List lval; - Erl_EmptyList nval; - Erl_Tuple tval; - Erl_Binary bval; - Erl_Variable vval; - Erl_Function funcval; - Erl_Big bigval; - } uval; -} ETERM; - - -#define MAXREGLEN (255*4) /* max length of registered (atom) name */ - -typedef struct { - int type; /* one of the message type constants in eiext.h */ - ETERM *msg; /* the actual message */ - ETERM *from; - ETERM *to; - char to_name[MAXREGLEN+1]; -} ErlMessage; - -typedef unsigned char Erl_Heap; - - -/* -------------------------------------------------------------------- */ -/* The functions */ -/* -------------------------------------------------------------------- */ - -void erl_init(void *x, long y) EI_DEPRECATED_ATTR; -void erl_set_compat_rel(unsigned) EI_DEPRECATED_ATTR; -int erl_connect_init(int, char*,short) EI_DEPRECATED_ATTR; -int erl_connect_xinit(char*,char*,char*,struct in_addr*,char*,short) EI_DEPRECATED_ATTR; -int erl_connect(char*) EI_DEPRECATED_ATTR; -int erl_xconnect(struct in_addr*,char *) EI_DEPRECATED_ATTR; -int erl_close_connection(int) EI_DEPRECATED_ATTR; -int erl_receive(int, unsigned char*, int) EI_DEPRECATED_ATTR; -int erl_receive_msg(int, unsigned char*, int, ErlMessage*) EI_DEPRECATED_ATTR; -int erl_xreceive_msg(int, unsigned char**, int*, ErlMessage*) EI_DEPRECATED_ATTR; -int erl_send(int, ETERM*, ETERM*) EI_DEPRECATED_ATTR; -int erl_reg_send(int, char*, ETERM*) EI_DEPRECATED_ATTR; -ETERM *erl_rpc(int,char*,char*,ETERM*) EI_DEPRECATED_ATTR; -int erl_rpc_to(int,char*,char*,ETERM*) EI_DEPRECATED_ATTR; -int erl_rpc_from(int,int,ErlMessage*) EI_DEPRECATED_ATTR; - -/* erl_publish returns open descriptor on success, or -1 */ -int erl_publish(int port) EI_DEPRECATED_ATTR; -int erl_accept(int,ErlConnect*) EI_DEPRECATED_ATTR; - -const char *erl_thiscookie(void) EI_DEPRECATED_ATTR; -const char *erl_thisnodename(void) EI_DEPRECATED_ATTR; -const char *erl_thishostname(void) EI_DEPRECATED_ATTR; -const char *erl_thisalivename(void) EI_DEPRECATED_ATTR; -short erl_thiscreation(void) EI_DEPRECATED_ATTR; - -/* returns 0 on success, -1 if node not known to epmd or epmd not reached */ -int erl_unpublish(const char *alive) EI_DEPRECATED_ATTR; - -#ifdef EI_HAVE_DEPRECATED_ATTR__ -#define EI_DEPR_ATTR_EXTRA , EI_DEPRECATED_ATTR_NAME -#else -#define EI_DEPR_ATTR_EXTRA -#endif - - -/* Report generic error to stderr. */ -void erl_err_msg(const char * __template, ...) - __attribute__ ((__format__ (printf, 1, 2) EI_DEPR_ATTR_EXTRA)) ; -/* Report generic error to stderr and die. */ -void erl_err_quit(const char * __template, ...) - __attribute__ ((__format__ (printf, 1, 2), __noreturn__ EI_DEPR_ATTR_EXTRA)); -/* Report system/libc error to stderr. */ -void erl_err_ret(const char * __template, ...) - __attribute__ ((__format__ (printf, 1, 2) EI_DEPR_ATTR_EXTRA)); -/* Report system/libc error to stderr and die. */ -void erl_err_sys(const char * __template, ...) - __attribute__ ((__format__ (printf, 1, 2), __noreturn__ EI_DEPR_ATTR_EXTRA)); - -ETERM *erl_cons(ETERM*,ETERM*) EI_DEPRECATED_ATTR; -ETERM *erl_copy_term(const ETERM*) EI_DEPRECATED_ATTR; -ETERM *erl_element(int,const ETERM*) EI_DEPRECATED_ATTR; - -ETERM *erl_hd(const ETERM*) EI_DEPRECATED_ATTR; -ETERM* erl_iolist_to_binary(const ETERM* term) EI_DEPRECATED_ATTR; -char* erl_iolist_to_string(const ETERM* term) EI_DEPRECATED_ATTR; -int erl_iolist_length(const ETERM*) EI_DEPRECATED_ATTR; -int erl_length(const ETERM*) EI_DEPRECATED_ATTR; -ETERM *erl_mk_atom(const char*) EI_DEPRECATED_ATTR; -ETERM *erl_mk_binary(const char*,int) EI_DEPRECATED_ATTR; -ETERM *erl_mk_empty_list(void) EI_DEPRECATED_ATTR; -ETERM *erl_mk_estring(const char*, int) EI_DEPRECATED_ATTR; -ETERM *erl_mk_float(double) EI_DEPRECATED_ATTR; -ETERM *erl_mk_int(int) EI_DEPRECATED_ATTR; -ETERM *erl_mk_longlong(long long) EI_DEPRECATED_ATTR; -ETERM *erl_mk_list(ETERM**,int) EI_DEPRECATED_ATTR; -ETERM *erl_mk_pid(const char*,unsigned int,unsigned int,unsigned char) EI_DEPRECATED_ATTR; -ETERM *erl_mk_port(const char*,unsigned int,unsigned char) EI_DEPRECATED_ATTR; -ETERM *erl_mk_ref(const char*,unsigned int,unsigned char) EI_DEPRECATED_ATTR; -ETERM *erl_mk_long_ref(const char*,unsigned int,unsigned int, - unsigned int,unsigned char) EI_DEPRECATED_ATTR; -ETERM *erl_mk_string(const char*) EI_DEPRECATED_ATTR; -ETERM *erl_mk_tuple(ETERM**,int) EI_DEPRECATED_ATTR; -ETERM *erl_mk_uint(unsigned int) EI_DEPRECATED_ATTR; -ETERM *erl_mk_ulonglong(unsigned long long) EI_DEPRECATED_ATTR; -ETERM *erl_mk_var(const char*) EI_DEPRECATED_ATTR; -int erl_print_term(FILE*,const ETERM*) EI_DEPRECATED_ATTR; -/* int erl_sprint_term(char*,const ETERM*) EI_DEPRECATED_ATTR; */ -int erl_size(const ETERM*) EI_DEPRECATED_ATTR; -ETERM *erl_tl(const ETERM*) EI_DEPRECATED_ATTR; -ETERM *erl_var_content(const ETERM*, const char*) EI_DEPRECATED_ATTR; - -ETERM *erl_format(char*, ... ) EI_DEPRECATED_ATTR; -int erl_match(ETERM*, ETERM*) EI_DEPRECATED_ATTR; - -char **erl_global_names(int fd, int *count) EI_DEPRECATED_ATTR; -int erl_global_register(int fd, const char *name, ETERM *pid) EI_DEPRECATED_ATTR; -int erl_global_unregister(int fd, const char *name) EI_DEPRECATED_ATTR; -ETERM *erl_global_whereis(int fd, const char *name, char *node) EI_DEPRECATED_ATTR; - -void erl_init_malloc(Erl_Heap*,long) EI_DEPRECATED_ATTR; -ETERM *erl_alloc_eterm(unsigned char) EI_DEPRECATED_ATTR; -void erl_eterm_release(void) EI_DEPRECATED_ATTR; -void erl_eterm_statistics(unsigned long*,unsigned long*) EI_DEPRECATED_ATTR; -void erl_free_array(ETERM**,int) EI_DEPRECATED_ATTR; -void erl_free_term(ETERM*) EI_DEPRECATED_ATTR; -void erl_free_compound(ETERM*) EI_DEPRECATED_ATTR; -void *erl_malloc(long) EI_DEPRECATED_ATTR; -void erl_free(void*) EI_DEPRECATED_ATTR; - -int erl_compare_ext(unsigned char*, unsigned char*) EI_DEPRECATED_ATTR; -ETERM *erl_decode(unsigned char*) EI_DEPRECATED_ATTR; -ETERM *erl_decode_buf(unsigned char**) EI_DEPRECATED_ATTR; -int erl_encode(ETERM*,unsigned char*t) EI_DEPRECATED_ATTR; -int erl_encode_buf(ETERM*,unsigned char**) EI_DEPRECATED_ATTR; -int erl_ext_size(unsigned char*) EI_DEPRECATED_ATTR; -unsigned char erl_ext_type(unsigned char*) EI_DEPRECATED_ATTR; /* Note: returned 'char' before R9C */ -unsigned char *erl_peek_ext(unsigned char*,int) EI_DEPRECATED_ATTR; -int erl_term_len(ETERM*) EI_DEPRECATED_ATTR; - -int cmp_latin1_vs_utf8(const char* sL, int lenL, const char* sU, int lenU) EI_DEPRECATED_ATTR; - -/* -------------------------------------------------------------------- */ -/* Wrappers around ei functions */ -/* -------------------------------------------------------------------- */ - -/* - * Undocumented before R9C, included for compatibility with old code - */ - -struct hostent *erl_gethostbyname(const char *name) EI_DEPRECATED_ATTR; -struct hostent *erl_gethostbyaddr(const char *addr, int len, int type) EI_DEPRECATED_ATTR; -struct hostent *erl_gethostbyname_r(const char *name, - struct hostent *hostp, - char *buffer, - int buflen, - int *h_errnop) EI_DEPRECATED_ATTR; -struct hostent *erl_gethostbyaddr_r(const char *addr, - int length, - int type, - struct hostent *hostp, - char *buffer, - int buflen, - int *h_errnop) EI_DEPRECATED_ATTR; - -/* - * Undocumented, included for compatibility with old code - */ - -void erl_init_resolve(void) EI_DEPRECATED_ATTR; -int erl_distversion(int fd) EI_DEPRECATED_ATTR; -int erl_epmd_connect(struct in_addr *inaddr) EI_DEPRECATED_ATTR; -int erl_epmd_port(struct in_addr *inaddr, const char *alive, int *dist) EI_DEPRECATED_ATTR; - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in index 6e0d3476c7..122cc560cc 100644 --- a/lib/erl_interface/src/Makefile.in +++ b/lib/erl_interface/src/Makefile.in @@ -52,9 +52,7 @@ APPUP_FILE= erl_interface.appup APPUP_SRC= $(APPUP_FILE).src APPUP_TARGET= $(EBINDIR)/$(APPUP_FILE) -USING_MINGW=@MIXED_CYGWIN_MINGW@ -USING_MSYS_VC==@MIXED_MSYS_VC@ -USING_CYGWIN_VC==@MIXED_MSYS_VC@ +USING_MINGW=@MIXED_MINGW@ USING_VC=@MIXED_VC@ ifdef TESTROOT @@ -130,12 +128,7 @@ endif WARNFLAGS += -DEI_NO_DEPR_WARN CFLAGS = @LIB_CFLAGS@ $(WARNFLAGS) $(INCFLAGS) $(TYPE_FLAGS) -PROG_CFLAGS = @CFLAGS@ $(WARNFLAGS) $(INCFLAGS) $(TYPE_FLAGS) -Ilegacy - -ifeq ($(findstring vxworks,$(TARGET)),vxworks) -PROG_CFLAGS += -nostartfiles -Wl,-r,-d -endif - +PROG_CFLAGS = @CFLAGS@ $(WARNFLAGS) $(INCFLAGS) $(TYPE_FLAGS) -Iglobal INSTALL = @INSTALL@ INSTALL_DIR = @INSTALL_DIR@ @@ -161,7 +154,7 @@ BINDIR = $(ERL_TOP)/lib/erl_interface/bin/$(TARGET) # -Wno-char-subscripts # -Wshadow -vpath %.c connect:encode:decode:misc:epmd:legacy:registry +vpath %.c connect:encode:decode:misc:epmd:global:registry ########################################################################### # List targets @@ -193,17 +186,12 @@ ERL_CALL = $(BINDIR)/erl_call$(EXE) ifdef THR_DEFS ST_EILIB = $(OBJDIR)/$(LIBPRE)ei_st$(LIBEXT) -ST_ERLLIB = $(OBJDIR)/$(LIBPRE)erl_interface_st$(LIBEXT) MT_EILIB = $(OBJDIR)/$(LIBPRE)ei$(LIBEXT) -MT_ERLLIB = $(OBJDIR)/$(LIBPRE)erl_interface$(LIBEXT) else ST_EILIB = $(OBJDIR)/$(LIBPRE)ei$(LIBEXT) -ST_ERLLIB = $(OBJDIR)/$(LIBPRE)erl_interface$(LIBEXT) endif MD_EILIB = $(OBJDIR)/$(LIBPRE)ei_md$(LIBEXT) MDD_EILIB = $(OBJDIR)/$(LIBPRE)ei_mdd$(LIBEXT) -MD_ERLLIB = $(OBJDIR)/$(LIBPRE)erl_interface_md$(LIBEXT) -MDD_ERLLIB = $(OBJDIR)/$(LIBPRE)erl_interface_mdd$(LIBEXT) ########################################################################### # Specify targets to build @@ -225,10 +213,7 @@ TARGETS = \ OBJ_TARGETS = \ $(MT_EILIB) \ $(MD_EILIB) \ - $(MDD_EILIB) \ - $(MT_ERLLIB) \ - $(MD_ERLLIB) \ - $(MDD_ERLLIB) + $(MDD_EILIB) FAKE_TARGETS = \ $(OBJDIR)/erl_fake_prog_mt$(EXE) \ @@ -254,8 +239,7 @@ TARGETS = \ $(APPUP_TARGET) OBJ_TARGETS = \ - $(MD_EILIB) \ - $(MD_ERLLIB) + $(MD_EILIB) FAKE_TARGETS = \ $(OBJDIR)/erl_fake_prog_md$(EXE) \ @@ -275,9 +259,7 @@ TARGETS = \ OBJ_TARGETS = \ $(ST_EILIB) \ - $(ST_ERLLIB) \ - $(MT_EILIB) \ - $(MT_ERLLIB) + $(MT_EILIB) FAKE_TARGETS = \ $(ST_OBJDIR)/erl_fake_prog_st$(EXE) \ @@ -298,8 +280,7 @@ TARGETS = \ $(APPUP_TARGET) OBJ_TARGETS = \ - $(ST_EILIB) \ - $(ST_ERLLIB) + $(ST_EILIB) FAKE_TARGETS = \ $(ST_OBJDIR)/erl_fake_prog_st$(EXE) \ @@ -321,8 +302,7 @@ endif HEADERS = \ ../include/ei.h \ ../include/ei_connect.h \ - ../include/eicode.h \ - ../include/erl_interface.h + ../include/eicode.h EISOURCES = \ $(CONNECTSRC) \ @@ -330,7 +310,8 @@ EISOURCES = \ $(ENCODESRC) \ $(EPMDSRC) \ $(MISCSRC) \ - $(REGISTRYSRC) + $(REGISTRYSRC) \ + $(GLOBALSOURCES) CONNECTSRC = \ connect/ei_connect.c \ @@ -363,14 +344,9 @@ DECODESRC = \ decode/decode_version.c \ $(DECODESRC_LONGLONG) -ifneq ($(findstring vxworks,$(TARGET)),vxworks) DECODESRC_LONGLONG = \ decode/decode_longlong.c \ decode/decode_ulonglong.c -else -DECODESRC_LONGLONG = -endif - ENCODESRC = \ encode/encode_atom.c \ @@ -393,13 +369,9 @@ ENCODESRC = \ encode/encode_version.c \ $(ENCODESRC_LONGLONG) -ifneq ($(findstring vxworks,$(TARGET)),vxworks) ENCODESRC_LONGLONG = \ encode/encode_longlong.c \ encode/encode_ulonglong.c -else -ENCODESRC_LONGLONG = -endif EPMDSRC = \ @@ -457,24 +429,13 @@ REGISTRYSRC = \ registry/reg_stat.c \ registry/reg_tabstat.c -ERLSOURCES = \ - legacy/decode_term.c \ - legacy/encode_term.c \ - legacy/erl_connect.c \ - legacy/erl_error.c \ - legacy/erl_eterm.c \ - legacy/erl_fix_alloc.c \ - legacy/erl_format.c \ - legacy/erl_malloc.c \ - legacy/erl_marshal.c \ - legacy/erl_resolve.c \ - legacy/erl_timeout.c \ - legacy/global_names.c \ - legacy/global_register.c \ - legacy/global_unregister.c \ - legacy/global_whereis.c - -SOURCES = $(EISOURCES) $(ERLSOURCES) +GLOBALSOURCES = \ + global/global_names.c \ + global/global_register.c \ + global/global_unregister.c \ + global/global_whereis.c + +SOURCES = $(EISOURCES) NEVERUSED = \ whereis.c \ @@ -491,13 +452,9 @@ ERLCALL = \ # located in the erl_interface library, not ei library. ST_EIOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(EISOURCES:.c=.o))) -ST_ERLOBJECTS = $(addprefix $(ST_OBJDIR)/,$(notdir $(ERLSOURCES:.c=.o))) MT_EIOBJECTS = $(addprefix $(MT_OBJDIR)/,$(notdir $(EISOURCES:.c=.o))) -MT_ERLOBJECTS = $(addprefix $(MT_OBJDIR)/,$(notdir $(ERLSOURCES:.c=.o))) MD_EIOBJECTS = $(addprefix $(MD_OBJDIR)/,$(notdir $(EISOURCES:.c=.o))) -MD_ERLOBJECTS = $(addprefix $(MD_OBJDIR)/,$(notdir $(ERLSOURCES:.c=.o))) MDD_EIOBJECTS = $(addprefix $(MDD_OBJDIR)/,$(notdir $(EISOURCES:.c=.o))) -MDD_ERLOBJECTS = $(addprefix $(MDD_OBJDIR)/,$(notdir $(ERLSOURCES:.c=.o))) ########################################################################### # Main targets @@ -513,10 +470,10 @@ docs: tests: clean: - rm -f $(ST_EIOBJECTS) $(ST_ERLOBJECTS) $(ST_EILIB) $(ST_ERLLIB) - rm -f $(MT_EIOBJECTS) $(MT_ERLOBJECTS) $(MT_EILIB) $(MT_ERLLIB) - rm -f $(MD_EIOBJECTS) $(MD_ERLOBJECTS) $(MD_EILIB) $(MD_ERLLIB) - rm -f $(MDD_EIOBJECTS) $(MDD_ERLOBJECTS) $(MDD_EILIB) $(MDD_ERLLIB) + rm -f $(ST_EIOBJECTS) $(ST_EILIB) + rm -f $(MT_EIOBJECTS) $(MT_EILIB) + rm -f $(MD_EIOBJECTS) $(MD_EILIB) + rm -f $(MDD_EIOBJECTS) $(MDD_EILIB) rm -f $(ERL_CALL) rm -f $(FAKE_TARGETS) rm -f $(APP_TARGET) @@ -527,20 +484,6 @@ distclean: clean ########################################################################### -# FIXME move this VxWorks stuff to configure or something -########################################################################### - -# FIXME depend on $(TARGET)/Makefile ??? - -ifeq ($(findstring vxworks,$(TARGET)),vxworks) -$(TARGET)/config.h: - $(gen_verbose) - $(V_at)echo "/* Generated by Makefile */" > $@ - $(V_at)echo "#define HAVE_STRERROR 1" >> $@ - $(V_at)echo "#define HAVE_SOCKLEN_T 1" >> $@ -endif - -########################################################################### # Default rules, normal and threaded ########################################################################### @@ -582,34 +525,18 @@ $(ST_EILIB) : $(ST_EIOBJECTS) $(V_AR) -out:$@ $(ST_EIOBJECTS) $(V_RANLIB) $@ -$(ST_ERLLIB) : $(ST_ERLOBJECTS) - $(V_AR) -out:$@ $(ST_ERLOBJECTS) - $(V_RANLIB) $@ - $(MT_EILIB) : $(MT_EIOBJECTS) $(V_AR) -out:$@ $(MT_EIOBJECTS) $(V_RANLIB) $@ -$(MT_ERLLIB) : $(MT_ERLOBJECTS) - $(V_AR) -out:$@ $(MT_ERLOBJECTS) - $(V_RANLIB) $@ - $(MD_EILIB) : $(MD_EIOBJECTS) $(V_AR) -out:$@ $(MD_EIOBJECTS) $(V_RANLIB) $@ -$(MD_ERLLIB) : $(MD_ERLOBJECTS) - $(V_AR) -out:$@ $(MD_ERLOBJECTS) - $(V_RANLIB) $@ - $(MDD_EILIB) : $(MDD_EIOBJECTS) $(V_AR) -out:$@ $(MDD_EIOBJECTS) $(V_RANLIB) $@ -$(MDD_ERLLIB) : $(MDD_ERLOBJECTS) - $(V_AR) -out:$@ $(MDD_ERLOBJECTS) - $(V_RANLIB) $@ - else # Unix archive creation @@ -621,12 +548,6 @@ ifdef RANLIB $(V_RANLIB) $@ endif -$(ST_ERLLIB) : $(ST_ERLOBJECTS) - $(V_at)rm -f $@ - $(V_AR) $(AR_FLAGS) $@ $(ST_ERLOBJECTS) -ifdef RANLIB - $(V_RANLIB) $@ -endif $(MT_EILIB) : $(MT_EIOBJECTS) $(V_at)rm -f $@ @@ -635,13 +556,6 @@ ifdef RANLIB $(V_RANLIB) $@ endif -$(MT_ERLLIB) : $(MT_ERLOBJECTS) - $(V_at)rm -f $@ - $(V_AR) $(AR_FLAGS) $@ $(MT_ERLOBJECTS) -ifdef RANLIB - $(V_RANLIB) $@ -endif - endif ########################################################################### @@ -653,17 +567,6 @@ $(ERL_CALL): $(ERLCALL) ../include/ei.h $(MD_EILIB) $(ld_verbose)$(PURIFY) $(CC) -MD $(PROG_CFLAGS) $(THR_DEFS) -o $@ $(ERLCALL) \ -L$(OBJDIR) -lei_md $(THR_LIBS) $(LIBS) -lsocket else -ifeq ($(findstring vxworks,$(TARGET)),vxworks) -$(ERL_CALL): $(ST_OBJDIR)/erl_call.o $(ST_OBJDIR)/erl_start.o ../include/ei.h $(ST_EILIB) - $(V_LD) -r -d -o $@ $(ST_OBJDIR)/erl_call.o $(ST_OBJDIR)/erl_start.o -L$(OBJDIR) -lei $(LIBS) - -$(ST_OBJDIR)/erl_call.o: prog/erl_call.c - $(V_CC) $(CFLAGS) -c $< -o $@ - -$(ST_OBJDIR)/erl_start.o: prog/erl_start.c - $(V_CC) $(CFLAGS) -c $< -o $@ - -else ifdef THR_DEFS $(ERL_CALL): $(ERLCALL) ../include/ei.h $(MT_EILIB) $(ld_verbose)$(PURIFY) $(CC) $(PROG_CFLAGS) $(THR_DEFS) $(LDFLAGS) -o $@ $(ERLCALL) \ @@ -674,7 +577,6 @@ $(ERL_CALL): $(ERLCALL) ../include/ei.h $(ST_EILIB) -L$(OBJDIR) -lei $(LIBS) endif endif -endif ########################################################################### # Fake application targets used to test header files and linking @@ -683,7 +585,7 @@ endif check: $(FAKE_TARGETS) ifndef THR_DEFS -$(ST_OBJDIR)/erl_fake_prog_st$(EXE): prog/erl_fake_prog.c $(ST_ERLLIB) $(ST_EILIB) +$(ST_OBJDIR)/erl_fake_prog_st$(EXE): prog/erl_fake_prog.c $(ST_EILIB) $(V_CC) $(PROG_CFLAGS) -o $@ $< -L$(OBJDIR) -lerl_interface -lei \ $(LIBS) @@ -691,7 +593,7 @@ $(ST_OBJDIR)/ei_fake_prog_st$(EXE): prog/ei_fake_prog.c $(ST_EILIB) $(V_CC) $(PROG_CFLAGS) -o $@ $< -L$(OBJDIR) -lei $(LIBS) $(ST_OBJDIR)/erl_fake_prog_cxx_st$(EXE): prog/erl_fake_prog.c \ - $(ST_ERLLIB) $(ST_EILIB) + $(ST_EILIB) $(V_CC) $(PROG_CFLAGS) -o $@ -xc++ $< -L$(OBJDIR) \ -lerl_interface -lei $(LIBS) @@ -700,7 +602,7 @@ $(ST_OBJDIR)/ei_fake_prog_cxx_st$(EXE): prog/ei_fake_prog.c $(ST_EILIB) else -$(ST_OBJDIR)/erl_fake_prog_st$(EXE): prog/erl_fake_prog.c $(ST_ERLLIB) $(ST_EILIB) +$(ST_OBJDIR)/erl_fake_prog_st$(EXE): prog/erl_fake_prog.c $(ST_EILIB) $(V_CC) $(PROG_CFLAGS) -o $@ $< -L$(OBJDIR) -lerl_interface_st -lei_st \ $(LIBS) @@ -708,7 +610,7 @@ $(ST_OBJDIR)/ei_fake_prog_st$(EXE): prog/ei_fake_prog.c $(ST_EILIB) $(V_CC) $(PROG_CFLAGS) -o $@ $< -L$(OBJDIR) -lei_st $(LIBS) $(ST_OBJDIR)/erl_fake_prog_cxx_st$(EXE): prog/erl_fake_prog.c \ - $(ST_ERLLIB) $(ST_EILIB) + $(ST_EILIB) $(V_CC) $(PROG_CFLAGS) -o $@ -xc++ $< -L$(OBJDIR) \ -lerl_interface_st -lei_st $(LIBS) @@ -720,7 +622,7 @@ endif #### $(MT_OBJDIR)/erl_fake_prog_mt$(EXE): prog/erl_fake_prog.c \ - $(MT_ERLLIB) $(MT_EILIB) + $(MT_EILIB) $(V_CC) $(MTFLAG) $(PROG_CFLAGS) $(THR_DEFS) -o $@ $< -L$(OBJDIR) \ -lerl_interface -lei $(THR_LIBS) $(LIBS) @@ -729,7 +631,7 @@ $(MT_OBJDIR)/ei_fake_prog_mt$(EXE): prog/ei_fake_prog.c $(MT_EILIB) -L$(OBJDIR) -lei $(THR_LIBS) $(LIBS) $(MT_OBJDIR)/erl_fake_prog_mt_cxx$(EXE): prog/erl_fake_prog.c \ - $(MT_ERLLIB) $(MT_EILIB) + $(MT_EILIB) $(V_CC) $(MTFLAG) $(PROG_CFLAGS) $(THR_DEFS) -o $@ -xc++ $< \ -L$(OBJDIR) -lerl_interface -lei \ $(THR_LIBS) $(LIBS) @@ -741,7 +643,7 @@ $(MT_OBJDIR)/ei_fake_prog_mt_cxx$(EXE): prog/ei_fake_prog.c $(MT_EILIB) #### $(MD_OBJDIR)/erl_fake_prog_md$(EXE): prog/erl_fake_prog.c \ - $(MD_ERLLIB) $(MD_EILIB) + $(MD_EILIB) $(V_CC) -MD $(PROG_CFLAGS) $(THR_DEFS) -o $@ $< -L$(OBJDIR) \ -lerl_interface_r -lei_r $(THR_LIBS) $(LIBS) @@ -750,7 +652,7 @@ $(MD_OBJDIR)/ei_fake_prog_md$(EXE): prog/ei_fake_prog.c $(MD_EILIB) -L$(OBJDIR) -lei_r $(THR_LIBS) $(LIBS) $(MD_OBJDIR)/erl_fake_prog_md_cxx$(EXE): prog/erl_fake_prog.c \ - $(MD_ERLLIB) $(MD_EILIB) + $(MD_EILIB) $(V_CC) -MD $(PROG_CFLAGS) $(THR_DEFS) -o $@ -xc++ $< \ -L$(OBJDIR) -lerl_interface_r -lei_r \ $(THR_LIBS) $(LIBS) @@ -762,7 +664,7 @@ $(MD_OBJDIR)/ei_fake_prog_md_cxx$(EXE): prog/ei_fake_prog.c $(MD_EILIB) #### $(MDD_OBJDIR)/erl_fake_prog_mdd$(EXE): prog/erl_fake_prog.c \ - $(MDD_ERLLIB) $(MDD_EILIB) + $(MDD_EILIB) $(V_CC) -MDD $(PROG_CFLAGS) $(THR_DEFS) -o $@ $< -L$(OBJDIR) \ -lerl_interface_r -lei_r $(THR_LIBS) $(LIBS) @@ -771,7 +673,7 @@ $(MDD_OBJDIR)/ei_fake_prog_mdd$(EXE): prog/ei_fake_prog.c $(MDD_EILIB) -L$(OBJDIR) -lei_r $(THR_LIBS) $(LIBS) $(MDD_OBJDIR)/erl_fake_prog_mdd_cxx$(EXE): prog/erl_fake_prog.c \ - $(MDD_ERLLIB) $(MDD_EILIB) + $(MDD_EILIB) $(V_CC) -MDD $(PROG_CFLAGS) $(THR_DEFS) -o $@ -xc++ $< \ -L$(OBJDIR) -lerl_interface_r -lei_r \ $(THR_LIBS) $(LIBS) @@ -784,32 +686,30 @@ $(MDD_OBJDIR)/ei_fake_prog_mdd_cxx$(EXE): prog/ei_fake_prog.c $(MDD_EILIB) # Create dependency file using gcc -MM ########################################################################### +ifneq ($(ERTS_SKIP_DEPEND),true) depend: $(TARGET)/depend.mk $(TARGET)/depend.mk: $(TARGET)/config.h $(gen_verbose) $(V_colon)echo "Generating dependency file depend.mk..." @echo "# Generated dependency rules" > $@ - $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ - sed 's&$(TARGET)&\$$\(TARGET\)&g' | \ - sed 's/^.*:/\$$\(ST_OBJDIR\)\/&/' >> $@ - @echo >> $@ - $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ - sed 's&$(TARGET)&\$$\(TARGET\)&g' | \ - sed 's/^.*:/\$$\(MT_OBJDIR\)\/&/' >> $@ - @echo >> $@ - $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ - sed 's&$(TARGET)&\$$\(TARGET\)&g' | \ - sed 's/^.*:/\$$\(MD_OBJDIR\)\/&/' >> $@ - @echo >> $@ - $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ - sed 's&$(TARGET)&\$$\(TARGET\)&g' | \ - sed 's/^.*:/\$$\(MDD_OBJDIR\)\/&/' >> $@ - @echo >> $@ + $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ + sed 's&$(TARGET)&\$$\(TARGET\)&g' > $@.$$$$; \ + sed 's/^.*:/\$$\(ST_OBJDIR\)\/&/' < $@.$$$$ >> $@; \ + echo >> $@; \ + sed 's/^.*:/\$$\(MT_OBJDIR\)\/&/' < $@.$$$$ >> $@; \ + echo >> $@; \ + sed 's/^.*:/\$$\(MD_OBJDIR\)\/&/' < $@.$$$$ >> $@; \ + echo >> $@; \ + sed 's/^.*:/\$$\(MDD_OBJDIR\)\/&/' < $@.$$$$ >> $@; \ + echo >> $@; \ + rm -f $@.$$$$ # For some reason this has to be after 'opt' target -include $(TARGET)/depend.mk - +else +depend: +endif # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -832,7 +732,7 @@ release: opt $(INSTALL_DIR) "$(RELSYSDIR)/src/decode" $(INSTALL_DIR) "$(RELSYSDIR)/src/encode" $(INSTALL_DIR) "$(RELSYSDIR)/src/epmd" - $(INSTALL_DIR) "$(RELSYSDIR)/src/legacy" + $(INSTALL_DIR) "$(RELSYSDIR)/src/global" $(INSTALL_DIR) "$(RELSYSDIR)/src/misc" $(INSTALL_DIR) "$(RELSYSDIR)/src/prog" $(INSTALL_DIR) "$(RELSYSDIR)/src/registry" @@ -854,7 +754,7 @@ endif $(INSTALL_DATA) epmd/*.[ch] "$(RELSYSDIR)/src/epmd" $(INSTALL_DATA) misc/*.[ch] "$(RELSYSDIR)/src/misc" $(INSTALL_DATA) registry/*.[ch] "$(RELSYSDIR)/src/registry" - $(INSTALL_DATA) legacy/*.[ch] "$(RELSYSDIR)/src/legacy" + $(INSTALL_DATA) global/*.[ch] "$(RELSYSDIR)/src/global" $(INSTALL_DATA) prog/*.[ch] "$(RELSYSDIR)/src/prog" release_docs: diff --git a/lib/erl_interface/src/README b/lib/erl_interface/src/README index 7591615f78..823575c6b7 100644 --- a/lib/erl_interface/src/README +++ b/lib/erl_interface/src/README @@ -21,7 +21,7 @@ The cause of an assertion can be either errors in the application program (for instance, passing NULL pointers to any function that expects an ETERM pointer) or in erl_interface itself. -If you encounter any assertion failures which think you originate in +If you encounter any assertion failures which you think originate in erl_interface, I'll need the following information to track it down: 1a) The printout from the assertion, especially filename and line number. @@ -35,7 +35,7 @@ erl_interface, I'll need the following information to track it down: Changes in this version ----------------------- -There is now *one* representation for an empty list, not two as is used +There is now *one* representation for an empty list, not two as it used to be. An empty list is represented by the Erl_EmptyList structure. There are new macros, ERL_IS_EMPTY_LIST(ep), to test for an empty list, and ERL_IS_CONS(ep) to test for a cons cell (more on that below). diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 96823b4ee7..d97b77d3e8 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -32,26 +32,7 @@ #include <windows.h> #include <winbase.h> -#elif VXWORKS -#include <vxWorks.h> -#include <hostLib.h> -#include <selectLib.h> -#include <ifLib.h> -#include <sockLib.h> -#include <taskLib.h> -#include <inetLib.h> - -#include <unistd.h> -#include <sys/times.h> -#include <unistd.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netinet/tcp.h> -#include <timers.h> - -#define getpid() taskIdSelf() - -#else /* some other unix */ +#else /* some unix */ #include <unistd.h> #include <sys/times.h> @@ -106,7 +87,8 @@ int ei_tracelevel = 0; (offsetof(ei_socket_callbacks, get_fd) \ + sizeof(int (*)(void *))) -/* FIXME why not macro? */ +typedef EI_ULONGLONG DistFlags; + static char *null_cookie = ""; static int get_cookie(char *buf, int len); @@ -120,15 +102,17 @@ static int send_status(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, char *status, unsigned ms); static int recv_status(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, unsigned ms); -static int send_challenge(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, - char *nodename, unsigned challenge, - unsigned version, unsigned ms); +static int send_challenge(ei_cnode *ec, void *ctx, int pkt_sz, + unsigned challenge, + DistFlags version, unsigned ms); static int recv_challenge(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, unsigned *challenge, unsigned *version, - unsigned *flags, char *namebuf, unsigned ms); + DistFlags *flags, char *namebuf, unsigned ms); static int send_challenge_reply(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, unsigned char digest[16], unsigned challenge, unsigned ms); +static int recv_complement(ei_socket_callbacks *cbs, void *ctx, + int pkt_sz, unsigned ms); static int recv_challenge_reply(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, unsigned our_challenge, char cookie[], @@ -139,12 +123,20 @@ static int send_challenge_ack(ei_socket_callbacks *cbs, void *ctx, static int recv_challenge_ack(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, unsigned our_challenge, char cookie[], unsigned ms); -static int send_name(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, - char *nodename, unsigned version, unsigned ms); - +static int send_name(ei_cnode *ec, void *ctx, int pkt_sz, + unsigned version, unsigned ms); +static int send_complement(ei_cnode *ec, void *ctx, int pkt_sz, + unsigned epmd_says_version, DistFlags her_flags, + unsigned ms); static int recv_name(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, - unsigned *version, unsigned *flags, char *namebuf, - unsigned ms); + char* send_name_tag, DistFlags *flags, + char *namebuf, unsigned ms); +static int ei_connect_helper(ei_cnode* ec, + Erl_IpAddr ip_addr, + char *alivename, + unsigned ms, + int rport, + int epmd_says_version); static struct hostent* dyn_gethostbyname_r(const char *name, struct hostent *hostp, char **buffer_p, @@ -659,7 +651,7 @@ int ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname, return ERL_ERROR; } - ec->creation = creation & 0x3; /* 2 bits */ + ec->creation = creation; if (cookie) { if (strlen(cookie) >= sizeof(ec->ei_connect_cookie)) { @@ -698,7 +690,7 @@ int ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname, strcpy(ec->self.node,thisnodename); ec->self.num = 0; ec->self.serial = 0; - ec->self.creation = creation & 0x3; /* 2 bits */ + ec->self.creation = creation; ec->cbs = cbs; ec->setup_context = setup_context; @@ -874,78 +866,57 @@ struct hostent *dyn_gethostbyname_r(const char *name, #endif } - /* - * Set up a connection to a given Node, and - * interchange hand shake messages with it. - * Returns a valid file descriptor at success, - * otherwise a negative error code. -*/ -int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms) +/* Finds the the IP address for hostname and saves that IP address at + the location that ip_wb points to. Returns a negative error code if + the IP address cannot be found for the hostname. */ +static int ip_address_from_hostname(char* hostname, + char** buffer_p, + size_t buffer_size, + Erl_IpAddr* ip_wb) { - char *hostname, alivename[BUFSIZ]; struct hostent *hp; -#if !defined (__WIN32__) +#ifndef __WIN32__ /* these are needed for the call to gethostbyname_r */ struct hostent host; - char buffer[1024]; - char *buf = buffer; int ei_h_errno; -#endif /* !win32 */ - int res; - - if (strlen(nodename) > MAXNODELEN) { - EI_TRACE_ERR0("ei_connect","Too long nodename"); - return ERL_ERROR; - } - - /* extract the host and alive parts from nodename */ - if (!(hostname = strchr(nodename,'@'))) { - EI_TRACE_ERR0("ei_connect","Node name has no @ in name"); - return ERL_ERROR; - } else { - strncpy(alivename, nodename, hostname - nodename); - alivename[hostname - nodename] = 0x0; - hostname++; - } - -#ifndef __WIN32__ - hp = dyn_gethostbyname_r(hostname,&host,&buf,sizeof(buffer),&ei_h_errno); + hp = dyn_gethostbyname_r(hostname,&host,buffer_p,buffer_size,&ei_h_errno); if (hp == NULL) { char thishostname[EI_MAXHOSTNAMELEN+1]; /* gethostname requies len to be max(hostname) + 1*/ if (gethostname(thishostname,EI_MAXHOSTNAMELEN+1) < 0) { - EI_TRACE_ERR0("ei_connect_tmo", + EI_TRACE_ERR0("ip_address_from_hostname", "Failed to get name of this host"); erl_errno = EHOSTUNREACH; return ERL_ERROR; } else { char *ct; - /* We use a short node name */ + /* We use a short node name */ if ((ct = strchr(thishostname, '.')) != NULL) *ct = '\0'; } if (strcmp(hostname,thishostname) == 0) /* Both nodes on same standalone host, use loopback */ - hp = dyn_gethostbyname_r("localhost",&host,&buf,sizeof(buffer),&ei_h_errno); + hp = dyn_gethostbyname_r("localhost",&host,buffer_p,buffer_size,&ei_h_errno); if (hp == NULL) { EI_TRACE_ERR2("ei_connect", - "Can't find host for %s: %d\n",nodename,ei_h_errno); + "Can't find host for %s: %d\n",hostname,ei_h_errno); erl_errno = EHOSTUNREACH; return ERL_ERROR; } } + *ip_wb = (Erl_IpAddr) *hp->h_addr_list; #else /* __WIN32__ */ if ((hp = ei_gethostbyname(hostname)) == NULL) { char thishostname[EI_MAXHOSTNAMELEN+1]; /* gethostname requires len to be max(hostname) + 1 */ if (gethostname(thishostname,EI_MAXHOSTNAMELEN+1) < 0) { - EI_TRACE_ERR1("ei_connect_tmo", - "Failed to get name of this host: %d", + EI_TRACE_ERR1("ip_address_from_hostname", + "Failed to get name of this host: %d", WSAGetLastError()); erl_errno = EHOSTUNREACH; return ERL_ERROR; } else { char *ct; - /* We use a short node name */ + /* We use a short node name */ if ((ct = strchr(thishostname, '.')) != NULL) *ct = '\0'; } if (strcmp(hostname,thishostname) == 0) @@ -955,42 +926,29 @@ int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms) char reason[1024]; win32_error(reason,sizeof(reason)); EI_TRACE_ERR2("ei_connect", - "Can't find host for %s: %s",nodename,reason); + "Can't find host for %s: %s",hostname,reason); erl_errno = EHOSTUNREACH; return ERL_ERROR; } } + *ip_wb = (Erl_IpAddr) *hp->h_addr_list; #endif /* win32 */ - - res = ei_xconnect_tmo(ec, (Erl_IpAddr) *hp->h_addr_list, alivename, ms); - -#ifndef __WIN32__ - if (buf != buffer) - free(buf); -#endif - return res; -} /* ei_connect */ - -int ei_connect(ei_cnode* ec, char *nodename) -{ - return ei_connect_tmo(ec, nodename, 0); + return 0; } - - /* ip_addr is now in network byte order - * - * first we have to get hold of the portnumber to - * the node through epmd at that host - * -*/ -int ei_xconnect_tmo(ei_cnode* ec, Erl_IpAddr ip_addr, char *alivename, unsigned ms) +/* Helper function for ei_connect family of functions */ +static int ei_connect_helper(ei_cnode* ec, + Erl_IpAddr ip_addr, /* network byte order */ + char *alivename, + unsigned ms, + int rport, + int epmd_says_version) { ei_socket_callbacks *cbs = ec->cbs; void *ctx; - int rport = 0; /*uint16 rport = 0;*/ int sockd; - int dist = 0; - unsigned her_flags, her_version; + unsigned her_version; + DistFlags her_flags; unsigned our_challenge, her_challenge; unsigned char our_digest[16]; int err; @@ -999,18 +957,18 @@ int ei_xconnect_tmo(ei_cnode* ec, Erl_IpAddr ip_addr, char *alivename, unsigned unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; erl_errno = EIO; /* Default error code */ - - EI_TRACE_CONN1("ei_xconnect","-> CONNECT attempt to connect to %s", - alivename); - - if ((rport = ei_epmd_port_tmo(ip_addr,alivename,&dist, tmo)) < 0) { - EI_TRACE_ERR0("ei_xconnect","-> CONNECT can't get remote port"); - /* ei_epmd_port_tmo() has set erl_errno */ - return ERL_NO_PORT; + + if (alivename != NULL) { + EI_TRACE_CONN1("ei_xconnect","-> CONNECT attempt to connect to %s", + alivename); + } else { + EI_TRACE_CONN1("ei_xconnect","-> CONNECT attempt to connect to port %d", + rport); } - if (dist <= 4) { - EI_TRACE_ERR0("ei_xconnect","-> CONNECT remote version not compatible"); + if (epmd_says_version < EI_DIST_LOW) { + EI_TRACE_ERR1("ei_xconnect","-> CONNECT remote version %d not compatible", + epmd_says_version); return ERL_ERROR; } @@ -1050,21 +1008,24 @@ int ei_xconnect_tmo(ei_cnode* ec, Erl_IpAddr ip_addr, char *alivename, unsigned goto error; } - if (send_name(cbs, ctx, pkt_sz, ec->thisnodename, (unsigned) dist, tmo)) + if (send_name(ec, ctx, pkt_sz, epmd_says_version, tmo)) goto error; if (recv_status(cbs, ctx, pkt_sz, tmo)) goto error; - if (recv_challenge(cbs, ctx, pkt_sz, &her_challenge, - &her_version, &her_flags, NULL, tmo)) + if (recv_challenge(cbs, ctx, pkt_sz, &her_challenge, &her_version, + &her_flags, NULL, tmo)) goto error; + her_version = (her_flags & DFLAG_HANDSHAKE_23) ? EI_DIST_6 : EI_DIST_5; our_challenge = gen_challenge(); gen_digest(her_challenge, ec->ei_connect_cookie, our_digest); + if (send_complement(ec, ctx, pkt_sz, epmd_says_version, her_flags, tmo)) + goto error; if (send_challenge_reply(cbs, ctx, pkt_sz, our_digest, our_challenge, tmo)) goto error; if (recv_challenge_ack(cbs, ctx, pkt_sz, our_challenge, ec->ei_connect_cookie, tmo)) goto error; - if (put_ei_socket_info(sockd, dist, null_cookie, ec, cbs, ctx) != 0) + if (put_ei_socket_info(sockd, her_version, null_cookie, ec, cbs, ctx) != 0) goto error; if (cbs->connect_handshake_complete) { @@ -1077,8 +1038,12 @@ int ei_xconnect_tmo(ei_cnode* ec, Erl_IpAddr ip_addr, char *alivename, unsigned return ERL_ERROR; } } - - EI_TRACE_CONN1("ei_xconnect","-> CONNECT (ok) remote = %s",alivename); + + if (alivename != NULL) { + EI_TRACE_CONN1("ei_xconnect","-> CONNECT (ok) remote = %s",alivename); + } else { + EI_TRACE_CONN1("ei_xconnect","-> CONNECT (ok) remote port = %d",rport); + } erl_errno = 0; return sockd; @@ -1089,11 +1054,103 @@ error: return ERL_ERROR; } /* ei_xconnect */ + /* + * Set up a connection to a given Node, and + * interchange hand shake messages with it. + * Returns a valid file descriptor at success, + * otherwise a negative error code. +*/ +int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms) +{ + char *hostname, alivename[BUFSIZ]; + Erl_IpAddr ip; + int res; + char buffer[1024]; + char* buf = buffer; + + if (strlen(nodename) > MAXNODELEN) { + EI_TRACE_ERR0("ei_connect","Too long nodename"); + return ERL_ERROR; + } + + /* extract the host and alive parts from nodename */ + if (!(hostname = strchr(nodename,'@'))) { + EI_TRACE_ERR0("ei_connect","Node name has no @ in name"); + return ERL_ERROR; + } else { + strncpy(alivename, nodename, hostname - nodename); + alivename[hostname - nodename] = 0x0; + hostname++; + } + + res = ip_address_from_hostname(hostname, &buf, sizeof(buffer), &ip); + + if (res < 0) { + return res; + } + + res = ei_xconnect_tmo(ec, ip, alivename, ms); + + if(buf != buffer) { + free(buf); + } + + return res; +} /* ei_connect */ + +int ei_connect(ei_cnode* ec, char *nodename) +{ + return ei_connect_tmo(ec, nodename, 0); +} + +int ei_connect_host_port_tmo(ei_cnode* ec, char *host, int port, unsigned ms) +{ + Erl_IpAddr ip; + char buffer[1024]; + char* buf = buffer; + int res = ip_address_from_hostname(host, &buf, sizeof(buffer), &ip); + if (res < 0) { + return res; + } + if(buf != buffer) { + free(buf); + } + return ei_xconnect_host_port_tmo(ec, ip, port, ms); +} + +int ei_connect_host_port(ei_cnode* ec, char *host, int port) +{ + return ei_connect_host_port_tmo(ec, host, port, 0); +} + +int ei_xconnect_tmo(ei_cnode* ec, Erl_IpAddr ip_addr, char *alivename, unsigned ms) +{ + int epmd_says_version = 0; + int port; + unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; + if ((port = ei_epmd_port_tmo(ip_addr,alivename,&epmd_says_version, tmo)) < 0) { + EI_TRACE_ERR0("ei_xconnect","-> CONNECT can't get remote port"); + /* ei_epmd_port_tmo() has set erl_errno */ + return ERL_NO_PORT; + } + return ei_connect_helper(ec, ip_addr, alivename, ms, port, epmd_says_version); +} + int ei_xconnect(ei_cnode* ec, Erl_IpAddr ip_addr, char *alivename) { return ei_xconnect_tmo(ec, ip_addr, alivename, 0); } +int ei_xconnect_host_port_tmo(ei_cnode* ec, Erl_IpAddr ip_addr, int port, unsigned ms) +{ + return ei_connect_helper(ec, ip_addr, NULL, ms, port, EI_DIST_LOW); +} + +int ei_xconnect_host_port(ei_cnode* ec, Erl_IpAddr ip_addr, int port) +{ + return ei_xconnect_host_port_tmo(ec, ip_addr, port, 0); +} + int ei_listen(ei_cnode *ec, int *port, int backlog) { struct in_addr ip_addr; @@ -1209,8 +1266,9 @@ int ei_accept(ei_cnode* ec, int lfd, ErlConnect *conp) int ei_accept_tmo(ei_cnode* ec, int lfd, ErlConnect *conp, unsigned ms) { int fd; - unsigned her_version, her_flags; + DistFlags her_flags; char tmp_nodename[MAXNODELEN+1]; + char send_name_tag; char *her_name; int pkt_sz, err; struct sockaddr_in addr; @@ -1235,6 +1293,10 @@ int ei_accept_tmo(ei_cnode* ec, int lfd, ErlConnect *conp, unsigned ms) ctx = EI_FD_AS_CTX__(lfd); } + if (ec->cbs != cbs) { + EI_CONN_SAVE_ERRNO__(EINVAL); + return ERL_ERROR; + } EI_TRACE_CONN0("ei_accept","<- ACCEPT waiting for connection"); @@ -1281,16 +1343,14 @@ int ei_accept_tmo(ei_cnode* ec, int lfd, ErlConnect *conp, unsigned ms) EI_TRACE_CONN0("ei_accept","<- ACCEPT connected to remote"); - if (recv_name(cbs, ctx, pkt_sz, &her_version, &her_flags, her_name, tmo)) { + if (recv_name(cbs, ctx, pkt_sz, &send_name_tag, &her_flags, + her_name, tmo)) { EI_TRACE_ERR0("ei_accept","<- ACCEPT initial ident failed"); goto error; } - if (her_version <= 4) { - EI_TRACE_ERR0("ei_accept","<- ACCEPT remote version not compatible"); - goto error; - } - else { + { + unsigned her_version = (her_flags & DFLAG_HANDSHAKE_23) ? 6 : 5; unsigned our_challenge; unsigned her_challenge; unsigned char our_digest[16]; @@ -1298,9 +1358,12 @@ int ei_accept_tmo(ei_cnode* ec, int lfd, ErlConnect *conp, unsigned ms) if (send_status(cbs, ctx, pkt_sz, "ok", tmo)) goto error; our_challenge = gen_challenge(); - if (send_challenge(cbs, ctx, pkt_sz, ec->thisnodename, - our_challenge, her_version, tmo)) + if (send_challenge(ec, ctx, pkt_sz, our_challenge, her_flags, tmo)) goto error; + if (send_name_tag == 'n' && (her_flags & DFLAG_HANDSHAKE_23)) { + if (recv_complement(cbs, ctx, pkt_sz, tmo)) + goto error; + } if (recv_challenge_reply(cbs, ctx, pkt_sz, our_challenge, ec->ei_connect_cookie, &her_challenge, tmo)) goto error; @@ -1629,21 +1692,6 @@ unsigned int gen_challenge(void) return md_32((char*) &s, sizeof(s)); } -#elif defined(VXWORKS) - -static unsigned int gen_challenge(void) -{ - struct { - struct timespec tv; - clock_t cpu; - int pid; - } s; - s.cpu = clock(); - clock_gettime(CLOCK_REALTIME, &s.tv); - s.pid = getpid(); - return md_32((char*) &s, sizeof(s)); -} - #else /* some unix */ static unsigned int gen_challenge(void) @@ -1846,26 +1894,50 @@ error: return -1; } -static int send_name_or_challenge(ei_socket_callbacks *cbs, - void *ctx, - int pkt_sz, - char *nodename, - int f_chall, - unsigned challenge, - unsigned version, - unsigned ms) +static DistFlags preferred_flags(void) +{ + DistFlags flags = + DFLAG_EXTENDED_REFERENCES + | DFLAG_DIST_MONITOR + | DFLAG_EXTENDED_PIDS_PORTS + | DFLAG_FUN_TAGS + | DFLAG_NEW_FUN_TAGS + | DFLAG_NEW_FLOATS + | DFLAG_SMALL_ATOM_TAGS + | DFLAG_UTF8_ATOMS + | DFLAG_MAP_TAG + | DFLAG_BIG_CREATION + | DFLAG_EXPORT_PTR_TAG + | DFLAG_BIT_BINARIES + | DFLAG_HANDSHAKE_23; + if (ei_internal_use_21_bitstr_expfun()) { + flags &= ~(DFLAG_EXPORT_PTR_TAG + | DFLAG_BIT_BINARIES); + } + return flags; +} + +static int send_name(ei_cnode *ec, + void *ctx, + int pkt_sz, + unsigned version, + unsigned ms) { char *buf; unsigned char *s; char dbuf[DEFBUF_SIZ]; - int siz = pkt_sz + 1 + 2 + 4 + strlen(nodename); - const char* function[] = {"SEND_NAME", "SEND_CHALLENGE"}; + const unsigned int nodename_len = strlen(ec->thisnodename); + int siz; int err; ssize_t len; - unsigned int flags; + DistFlags flags; + const char tag = (version == EI_DIST_5) ? 'n' : 'N'; + + if (tag == 'n') + siz = pkt_sz + 1 + 2 + 4 + nodename_len; + else + siz = pkt_sz + 1 + 8 + 4 + 2 + nodename_len; - if (f_chall) - siz += 4; buf = (siz > DEFBUF_SIZ) ? malloc(siz) : dbuf; if (!buf) { erl_errno = ENOMEM; @@ -1882,35 +1954,95 @@ static int send_name_or_challenge(ei_socket_callbacks *cbs, default: return -1; } - put8(s, 'n'); - put16be(s, version); - flags = (DFLAG_EXTENDED_REFERENCES - | DFLAG_DIST_MONITOR - | DFLAG_EXTENDED_PIDS_PORTS - | DFLAG_FUN_TAGS - | DFLAG_NEW_FUN_TAGS - | DFLAG_NEW_FLOATS - | DFLAG_SMALL_ATOM_TAGS - | DFLAG_UTF8_ATOMS - | DFLAG_MAP_TAG - | DFLAG_BIG_CREATION - | DFLAG_EXPORT_PTR_TAG - | DFLAG_BIT_BINARIES); - if (ei_internal_use_21_bitstr_expfun()) { - flags &= ~(DFLAG_EXPORT_PTR_TAG - | DFLAG_BIT_BINARIES); + flags = preferred_flags(); + + put8(s, tag); + if (tag == 'n') { + put16be(s, EI_DIST_5); /* some impl (jinterface) demand ver==5 */ + put32be(s, flags); + } + else { /* tag == 'N' */ + put64be(s, flags); + put32be(s, ec->creation); + put16be(s, nodename_len); } - put32be(s, flags); - if (f_chall) - put32be(s, challenge); - memcpy(s, nodename, strlen(nodename)); + memcpy(s, ec->thisnodename, nodename_len); len = (ssize_t) siz; - err = ei_write_fill_ctx_t__(cbs, ctx, buf, &len, ms); + err = ei_write_fill_ctx_t__(ec->cbs, ctx, buf, &len, ms); if (!err && len != (ssize_t) siz) err = EIO; if (err) { - EI_TRACE_ERR1("send_name_or_challenge", - "-> %s socket write failed", function[f_chall]); + EI_TRACE_ERR0("send_name", "SEND_NAME -> socket write failed"); + if (buf != dbuf) + free(buf); + EI_CONN_SAVE_ERRNO__(err); + return -1; + } + + if (buf != dbuf) + free(buf); + return 0; +} + +static int send_challenge(ei_cnode *ec, + void *ctx, + int pkt_sz, + unsigned challenge, + DistFlags her_flags, + unsigned ms) +{ + char *buf; + unsigned char *s; + char dbuf[DEFBUF_SIZ]; + const unsigned int nodename_len = strlen(ec->thisnodename); + int siz; + int err; + ssize_t len; + DistFlags flags; + const char tag = (her_flags & DFLAG_HANDSHAKE_23) ? 'N' : 'n'; + + if (tag == 'n') + siz = pkt_sz + 1 + 2 + 4 + 4 + nodename_len; + else + siz = pkt_sz + 1 + 8 + 4 + 4 + 2 + nodename_len; + + buf = (siz > DEFBUF_SIZ) ? malloc(siz) : dbuf; + if (!buf) { + erl_errno = ENOMEM; + return -1; + } + s = (unsigned char *)buf; + switch (pkt_sz) { + case 2: + put16be(s,siz - 2); + break; + case 4: + put32be(s,siz - 4); + break; + default: + return -1; + } + + flags = preferred_flags(); + put8(s, tag); + if (tag == 'n') { + put16be(s, EI_DIST_5); /* choosen version */ + put32be(s, flags); + put32be(s, challenge); + } + else { + put64be(s, flags); + put32be(s, challenge); + put32be(s, ec->creation); + put16be(s, nodename_len); + } + memcpy(s, ec->thisnodename, nodename_len); + len = (ssize_t) siz; + err = ei_write_fill_ctx_t__(ec->cbs, ctx, buf, &len, ms); + if (!err && len != (ssize_t) siz) + err = EIO; + if (err) { + EI_TRACE_ERR0("send_challenge", "-> SEND_CHALLENGE socket write failed"); if (buf != dbuf) free(buf); EI_CONN_SAVE_ERRNO__(err); @@ -1924,13 +2056,13 @@ static int send_name_or_challenge(ei_socket_callbacks *cbs, static int recv_challenge(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, unsigned *challenge, unsigned *version, - unsigned *flags, char *namebuf, unsigned ms) + DistFlags *flags, char *namebuf, unsigned ms) { char dbuf[DEFBUF_SIZ]; char *buf = dbuf; int is_static = 1; int buflen = DEFBUF_SIZ; - int rlen; + int rlen, nodename_len; char *s; char tag; char tmp_nodename[MAXNODELEN+1]; @@ -1943,21 +2075,57 @@ static int recv_challenge(ei_socket_callbacks *cbs, void *ctx, "<- RECV_CHALLENGE socket read failed (%d)",rlen); goto error; } - if ((rlen - 11) > MAXNODELEN) { - EI_TRACE_ERR1("recv_challenge", - "<- RECV_CHALLENGE nodename too long (%d)",rlen - 11); - goto error; - } s = buf; - if ((tag = get8(s)) != 'n') { + tag = get8(s); + if (tag != 'n' && tag != 'N') { EI_TRACE_ERR2("recv_challenge", "<- RECV_CHALLENGE incorrect tag, " - "expected 'n' got '%c' (%u)",tag,tag); + "expected 'n' or 'N', got '%c' (%u)",tag,tag); goto error; } - *version = get16be(s); - *flags = get32be(s); - *challenge = get32be(s); + if (tag == 'n') { /* OLD */ + unsigned int version; + if (rlen < 1+2+4+4) { + EI_TRACE_ERR1("recv_challenge","<- RECV_CHALLENGE 'n' packet too short (%d)", + rlen) + goto error; + } + + version = get16be(s); + if (version != EI_DIST_5) { + EI_TRACE_ERR1("recv_challenge", + "<- RECV_CHALLENGE 'n' incorrect version=%d", + version); + goto error; + } + *flags = get32be(s); + *challenge = get32be(s); + nodename_len = (buf + rlen) - s; + } + else { /* NEW */ + if (rlen < 1+8+4+4+2) { + EI_TRACE_ERR1("recv_challenge","<- RECV_CHALLENGE 'N' packet too short (%d)", + rlen) + goto error; + } + *version = EI_DIST_6; + *flags = get64be(s); + *challenge = get32be(s); + s += 4; /* ignore peer 'creation' */ + nodename_len = get16be(s); + if (nodename_len > (buf + rlen) - s) { + EI_TRACE_ERR1("recv_challenge", + "<- RECV_CHALLENGE 'N' nodename too long (%d)", + nodename_len); + goto error; + } + } + + if (nodename_len > MAXNODELEN) { + EI_TRACE_ERR1("recv_challenge", + "<- RECV_CHALLENGE nodename too long (%d)", nodename_len); + goto error; + } if (!(*flags & DFLAG_EXTENDED_REFERENCES)) { EI_TRACE_ERR0("recv_challenge","<- RECV_CHALLENGE peer cannot " @@ -1981,8 +2149,8 @@ static int recv_challenge(ei_socket_callbacks *cbs, void *ctx, if (!namebuf) namebuf = &tmp_nodename[0]; - memcpy(namebuf, s, rlen - 11); - namebuf[rlen - 11] = '\0'; + memcpy(namebuf, s, nodename_len); + namebuf[nodename_len] = '\0'; if (!is_static) free(buf); @@ -2003,6 +2171,63 @@ error: return -1; } +static int send_complement(ei_cnode *ec, + void *ctx, + int pkt_sz, + unsigned epmd_says_version, + DistFlags her_flags, + unsigned ms) +{ + if (epmd_says_version == EI_DIST_5 && (her_flags & DFLAG_HANDSHAKE_23)) { + char *buf; + unsigned char *s; + char dbuf[DEFBUF_SIZ]; + int err; + ssize_t len; + unsigned int flagsHigh; + const int siz = pkt_sz + 1 + 4 + 4; + + buf = (siz > DEFBUF_SIZ) ? malloc(siz) : dbuf; + if (!buf) { + erl_errno = ENOMEM; + return -1; + } + s = (unsigned char *)buf; + switch (pkt_sz) { + case 2: + put16be(s,siz - 2); + break; + case 4: + put32be(s,siz - 4); + break; + default: + return -1; + } + flagsHigh = preferred_flags() >> 32; + + put8(s, 'c'); + put32be(s, flagsHigh); + put32be(s, ec->creation); + + len = (ssize_t) siz; + err = ei_write_fill_ctx_t__(ec->cbs, ctx, buf, &len, ms); + if (!err && len != (ssize_t) siz) + err = EIO; + if (err) { + EI_TRACE_ERR0("send_name", "SEND_NAME -> socket write failed"); + if (buf != dbuf) + free(buf); + EI_CONN_SAVE_ERRNO__(err); + return -1; + } + + if (buf != dbuf) + free(buf); + } + return 0; +} + + static int send_challenge_reply(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, unsigned char digest[16], unsigned challenge, unsigned ms) @@ -2049,6 +2274,54 @@ static int send_challenge_reply(ei_socket_callbacks *cbs, void *ctx, return 0; } +static int recv_complement(ei_socket_callbacks *cbs, + void *ctx, + int pkt_sz, + unsigned ms) +{ + char dbuf[DEFBUF_SIZ]; + char *buf = dbuf; + int is_static = 1; + int buflen = DEFBUF_SIZ; + int rlen; + char *s; + char tag; + unsigned int creation; + + erl_errno = EIO; /* Default */ + + if ((rlen = read_hs_package(cbs, ctx, pkt_sz, &buf, &buflen, &is_static, ms)) != 21) { + EI_TRACE_ERR1("recv_complement", + "<- RECV_COMPLEMENT socket read failed (%d)",rlen); + goto error; + } + + s = buf; + if ((tag = get8(s)) != 'c') { + EI_TRACE_ERR2("recv_complement", + "<- RECV_COMPLEMENT incorrect tag, " + "expected 'c' got '%c' (%u)",tag,tag); + goto error; + } + creation = get32be(s); + if (!is_static) + free(buf); + + if (ei_tracelevel >= 3) { + EI_TRACE_CONN1("recv_complement", + "<- RECV_COMPLEMENT (ok) creation = %u", + creation); + } + /* We don't have any use for 'creation' of other node, so we drop it */ + erl_errno = 0; + return 0; + +error: + if (!is_static) + free(buf); + return -1; +} + static int recv_challenge_reply(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, @@ -2204,30 +2477,16 @@ error: return -1; } -static int send_name(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, - char *nodename, unsigned version, unsigned ms) -{ - return send_name_or_challenge(cbs, ctx, pkt_sz, nodename, 0, - 0, version, ms); -} - -static int send_challenge(ei_socket_callbacks *cbs, void *ctx, int pkt_sz, - char *nodename, unsigned challenge, unsigned version, - unsigned ms) -{ - return send_name_or_challenge(cbs, ctx, pkt_sz, nodename, 1, - challenge, version, ms); -} - static int recv_name(ei_socket_callbacks *cbs, void *ctx, - int pkt_sz, unsigned *version, - unsigned *flags, char *namebuf, unsigned ms) + int pkt_sz, char *send_name_tag, + DistFlags *flags, char *namebuf, unsigned ms) { char dbuf[DEFBUF_SIZ]; char *buf = dbuf; int is_static = 1; int buflen = DEFBUF_SIZ; int rlen; + unsigned int namelen; char *s; char tmp_nodename[MAXNODELEN+1]; char tag; @@ -2239,19 +2498,40 @@ static int recv_name(ei_socket_callbacks *cbs, void *ctx, EI_TRACE_ERR1("recv_name","<- RECV_NAME socket read failed (%d)",rlen); goto error; } - if ((rlen - 7) > MAXNODELEN) { - EI_TRACE_ERR1("recv_name","<- RECV_NAME nodename too long (%d)",rlen-7); - goto error; - } s = buf; tag = get8(s); - if (tag != 'n') { + *send_name_tag = tag; + if (tag != 'n' && tag != 'N') { EI_TRACE_ERR2("recv_name","<- RECV_NAME incorrect tag, " - "expected 'n' got '%c' (%u)",tag,tag); + "expected 'n' or 'N', got '%c' (%u)",tag,tag); goto error; } - *version = get16be(s); - *flags = get32be(s); + if (tag == 'n') { + unsigned int version; + if (rlen < 1+2+4) { + EI_TRACE_ERR1("recv_name","<- RECV_NAME 'n' packet too short (%d)", + rlen) + goto error; + } + version = get16be(s); + if (version < EI_DIST_5) { + EI_TRACE_ERR1("recv_name","<- RECV_NAME 'n' invalid version=%d", + version) + goto error; + } + *flags = get32be(s); + namelen = rlen - (1+2+4); + } + else { /* tag == 'N' */ + if (rlen < 1+8+4+2) { + EI_TRACE_ERR1("recv_name","<- RECV_NAME 'N' packet too short (%d)", + rlen) + goto error; + } + *flags = get64be(s); + s += 4; /* ignore peer 'creation' */ + namelen = get16be(s); + } if (!(*flags & DFLAG_EXTENDED_REFERENCES)) { EI_TRACE_ERR0("recv_name","<- RECV_NAME peer cannot handle" @@ -2269,14 +2549,20 @@ static int recv_name(ei_socket_callbacks *cbs, void *ctx, if (!namebuf) namebuf = &tmp_nodename[0]; - memcpy(namebuf, s, rlen - 7); - namebuf[rlen - 7] = '\0'; + if (namelen > MAXNODELEN || s+namelen > buf+rlen) { + EI_TRACE_ERR2("recv_name","<- RECV_NAME '%c' nodename too long (%d)", + tag, namelen); + goto error; + } + + memcpy(namebuf, s, namelen); + namebuf[namelen] = '\0'; if (!is_static) free(buf); EI_TRACE_CONN3("recv_name", - "<- RECV_NAME (ok) node = %s, version = %u, flags = %u", - namebuf,*version,*flags); + "<- RECV_NAME (ok) node = %s, tag = %c, flags = %u", + namebuf,tag,*flags); erl_errno = 0; return 0; diff --git a/lib/erl_interface/src/connect/ei_connect_int.h b/lib/erl_interface/src/connect/ei_connect_int.h index b41a5f2b23..05cec3c824 100644 --- a/lib/erl_interface/src/connect/ei_connect_int.h +++ b/lib/erl_interface/src/connect/ei_connect_int.h @@ -38,30 +38,7 @@ #include <windows.h> #include <winbase.h> -#elif VXWORKS -#include <vxWorks.h> -#include <hostLib.h> -#include <selectLib.h> -#include <ifLib.h> -#include <sockLib.h> -#include <taskLib.h> -#include <inetLib.h> -#include <ioLib.h> - -#include <unistd.h> -#include <sys/types.h> -#include <sys/times.h> -#include <unistd.h> -#include <sys/types.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netinet/tcp.h> -#include <timers.h> - -#define getpid() taskIdSelf() -extern int h_errno; - -#else /* some other unix */ +#else /* some unix */ #include <unistd.h> #include <sys/types.h> #include <sys/times.h> @@ -109,6 +86,8 @@ extern int h_errno; #define DFLAG_UTF8_ATOMS 0x10000 #define DFLAG_MAP_TAG 0x20000 #define DFLAG_BIG_CREATION 0x40000 +#define DFLAG_HANDSHAKE_23 0x1000000 +#define DFLAG_HANDSHAKE_XX 0xfe000000 /* bits reserved for handshake changes */ ei_cnode *ei_fd_to_cnode(int fd); int ei_distversion(int fd); diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index 225fddc784..f6182ccaf0 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -21,19 +21,7 @@ * Interface functions to different versions of gethostbyname */ -#ifdef VXWORKS -#include <vxWorks.h> -#include <stdio.h> -#include <semLib.h> -#include <hostLib.h> -#include <resolvLib.h> -#include <string.h> -#include <sys/socket.h> -#include <errno.h> -#include <symLib.h> -#include <sysSymTbl.h> - -#elif __WIN32__ +#ifdef __WIN32__ #include <winsock2.h> #include <windows.h> #include <winbase.h> @@ -55,6 +43,16 @@ #include "ei_resolve.h" #include "ei_locking.h" +/* AIX has a totally different signature (allegedly shared with some other + * Unices) that isn't compatible. It turns out that the _r version isn't + * thread-safe according to curl - but bizarrely, since AIX 4.3, libc + * is thread-safe in a manner that makes the normal gethostbyname OK + * for re-entrant use. + */ +#ifdef _AIX +#undef HAVE_GETHOSTBYNAME_R +#endif + #ifdef HAVE_GETHOSTBYNAME_R int ei_init_resolve(void) @@ -75,7 +73,7 @@ int ei_init_resolve(void) static ei_mutex_t *ei_gethost_sem = NULL; #endif /* _REENTRANT */ static int ei_resolve_initialized = 0; -#ifndef __WIN32__ +#if !defined(__WIN32__) && !defined(_AIX) int h_errno; #endif @@ -85,18 +83,6 @@ int h_errno; #define DEBUGF(X) /* Nothing */ #endif -#ifdef VXWORKS -/* FIXME problem for threaded ? */ -static struct hostent *(*sens_gethostbyname)(const char *name, - char *, int) = NULL; -static struct hostent *(*sens_gethostbyaddr)(const char *addr, - char *, int) = NULL; -#endif - -#ifdef VXWORKS -static int verify_dns_configuration(void); -#endif - /* * If we find SENS resolver, use the functions found there, i.e. * resolvGetHostByName() and resolvGetHostByAddr(). Otherwise we use @@ -106,32 +92,6 @@ static int verify_dns_configuration(void); int ei_init_resolve(void) { -#ifdef VXWORKS - void *sym; - SYM_TYPE symtype; - - if (symFindByName(sysSymTbl,"resolvGetHostByName", - (char **)&sym,&symtype) == OK && - verify_dns_configuration()) { - sens_gethostbyname = sym; - DEBUGF((stderr,"found SENS resolver - using it for gethostbyname()\n")); - if (symFindByName(sysSymTbl,"resolvGetHostByAddr", - (char **)&sym,&symtype) == OK) { - sens_gethostbyaddr = sym; - DEBUGF((stderr,"found SENS resolver - " - "using it for gethostbyaddr()\n")); - } - else { - DEBUGF((stderr,"SENS resolver not found - " - "using default gethostbyaddr()\n")); - } - } - else { - DEBUGF((stderr,"SENS resolver not found - " - "using default gethostbyname()\n")); - } -#endif /* VXWORKS */ - #ifdef _REENTRANT ei_gethost_sem = ei_mutex_create(); if (!ei_gethost_sem) @@ -142,42 +102,7 @@ int ei_init_resolve(void) return 0; } -#ifdef VXWORKS -/* -** Function to verify the DNS configuration on VwXorks SENS. -** Actually configures to a default value if unconfigured... -*/ -static int verify_dns_configuration(void) -{ - /* FIXME problem for threaded ? */ - static char resolv_params[sizeof(RESOLV_PARAMS_S)]; - void (*rpg)(char *); - STATUS (*rps)(char *); - SYM_TYPE dummy; - int get_result, set_result; - - get_result = symFindByName(sysSymTbl,"resolvParamsGet", (char **) &rpg, &dummy); - set_result = symFindByName(sysSymTbl,"resolvParamsSet", (char **) &rps, &dummy); - - if (!(get_result == OK && - set_result == OK)) - return -1; - (*rpg)(resolv_params); - if (*resolv_params == '\0') { - /* It exists, but is not configured, ei_connect would fail - if we left it this way... The best we can do is to configure - it to use the local host database on the card, as a fallback */ - *resolv_params = (char) 1; - fprintf(stderr,"Trying to fix up DNS configuration.\n"); - if (((*rps)(resolv_params)) != OK) - return -1; - } - return 0; -} - -#endif - -#if defined(VXWORKS) || _REENTRANT +#if _REENTRANT /* * Copy the contents of one struct hostent to another, i.e. don't just @@ -365,9 +290,9 @@ static struct hostent *my_gethostbyname_r(const char *name, return rval; } -#endif /* defined(VXWORKS) || _REENTRANT */ +#endif /* _REENTRANT */ -#if defined(VXWORKS) || EI_THREADS != false +#if EI_THREADS != false static struct hostent *my_gethostbyaddr_r(const char *addr, int length, @@ -433,7 +358,7 @@ static struct hostent *my_gethostbyaddr_r(const char *addr, return rval; } -#endif /* defined(VXWORKS) || EI_THREADS != false */ +#endif /* EI_THREADS != false */ #endif /* !HAVE_GETHOSTBYNAME_R */ @@ -449,154 +374,6 @@ struct hostent *ei_gethostbyaddr(const char *addr, int len, int type) return gethostbyaddr(addr, len, type); } -#elif VXWORKS - - -/* these are a couple of substitutes for the real thing when we run on - * stock vxworks (i.e. no sens). - * - * len and type are ignored, but we make up some reasonable values and - * insert them - */ -static struct hostent *my_gethostbyname(const char *name) -{ - /* FIXME problem for threaded ? */ - static struct hostent h; - static char hostname[EI_MAXHOSTNAMELEN+1]; - static char *aliases[1] = {NULL}; - static char *addrp[2] = {NULL,NULL}; - static unsigned long addr = 0; - - strcpy(hostname,name); - if ((addr = (unsigned long)hostGetByName(hostname)) == ERROR) { - h_errno = HOST_NOT_FOUND; - return NULL; - } - - h_errno = 0; - h.h_name = hostname; - h.h_aliases = aliases; - h.h_length = 4; - h.h_addrtype = AF_INET; - addrp[0] = (char *)&addr; - h.h_addr_list = addrp; - - return &h; -} - -static struct hostent *my_gethostbyaddr(const char *addr, int len, int type) -{ - /* FIXME problem for threaded ? */ - static struct hostent h; - static char hostname[EI_MAXHOSTNAMELEN+1]; - static char *aliases[1] = { NULL }; - static unsigned long inaddr; - static char *addrp[2] = {(char *)&inaddr, NULL}; - - memmove(&inaddr,addr,sizeof(inaddr)); - - if ((hostGetByAddr(inaddr,hostname)) == ERROR) { - h_errno = HOST_NOT_FOUND; - return NULL; - } - - h_errno = 0; - h.h_name = hostname; - h.h_aliases = aliases; - h.h_length = 4; - h.h_addrtype = AF_INET; - h.h_addr_list = addrp; - - return &h; -} - -/* use sens functions for these, if found. */ -struct hostent *ei_gethostbyname(const char *name) -{ - struct hostent *h = NULL; - - if (!sens_gethostbyname) { - h = my_gethostbyname(name); - } - else { - /* FIXME problem for threaded ? */ - static char buf[1024]; - h = sens_gethostbyname(name,buf,1024); - } - - return h; -} - -struct hostent *ei_gethostbyaddr(const char *addr, int len, int type) -{ - struct hostent *h = NULL; - - if (!sens_gethostbyaddr) { - h = my_gethostbyaddr(addr,len,type); - } - else { - /* FIXME problem for threaded ? */ - static char buf[1024]; - h = sens_gethostbyaddr(addr,buf,1024); - } - - return h; -} - -struct hostent *ei_gethostbyaddr_r(const char *addr, - int length, - int type, - struct hostent *hostp, - char *buffer, - int buflen, - int *h_errnop) -{ - struct hostent *h = NULL; - - /* use own func if sens function not available */ - if (!sens_gethostbyaddr) { - h = my_gethostbyaddr_r(addr,length,type,hostp,buffer,buflen,h_errnop); - } - else { - if (!(h = sens_gethostbyaddr(addr,buffer,buflen))) { - /* sens returns status via errno */ - *h_errnop = errno; - } - else { - *hostp = *h; - *h_errnop = 0; - } - } - - return h; -} - -struct hostent *ei_gethostbyname_r(const char *name, - struct hostent *hostp, - char *buffer, - int buflen, - int *h_errnop) -{ - struct hostent *h = NULL; - - /* use own func if sens function not available */ - if (!sens_gethostbyname) { - h = my_gethostbyname_r(name,hostp,buffer,buflen,h_errnop); - } - else { - if (!(h = sens_gethostbyname(name,buffer,buflen))) { - /* sens returns status via errno */ - *h_errnop = errno; - } - else { - *hostp = *h; - *h_errnop = 0; - } - } - - return h; -} - #else /* unix of some kind */ struct hostent *ei_gethostbyname(const char *name) @@ -667,5 +444,5 @@ struct hostent *ei_gethostbyname_r(const char *name, #endif } -#endif /* vxworks, win, unix */ +#endif /* win, unix */ diff --git a/lib/erl_interface/src/connect/send.c b/lib/erl_interface/src/connect/send.c index d97532d123..8535b2a206 100644 --- a/lib/erl_interface/src/connect/send.c +++ b/lib/erl_interface/src/connect/send.c @@ -24,13 +24,6 @@ # include <windows.h> # include <winbase.h> -#elif VXWORKS - -# include <sys/types.h> -# include <unistd.h> -# include <sysLib.h> -# include <tickLib.h> - #else /* unix */ # include <sys/types.h> diff --git a/lib/erl_interface/src/connect/send_reg.c b/lib/erl_interface/src/connect/send_reg.c index 80d61e57b5..b34432fb6e 100644 --- a/lib/erl_interface/src/connect/send_reg.c +++ b/lib/erl_interface/src/connect/send_reg.c @@ -22,10 +22,6 @@ #include <windows.h> #include <winbase.h> -#elif VXWORKS -#include <sys/types.h> -#include <unistd.h> - #else /* unix */ #include <sys/types.h> #include <unistd.h> diff --git a/lib/erl_interface/src/decode/decode_big.c b/lib/erl_interface/src/decode/decode_big.c index cbbbd3f0b7..bd2d6662a5 100644 --- a/lib/erl_interface/src/decode/decode_big.c +++ b/lib/erl_interface/src/decode/decode_big.c @@ -144,13 +144,6 @@ int ei_big_comp(erlang_big *x, erlang_big *y) * Handling of floating point exceptions. */ -#if defined(VXWORKS) && CPU == PPC860 -#undef NO_FPE_SIGNALS -#define NO_FPE_SIGNALS 1 -#undef INLINED_FP_CONVERSION -#define INLINED_FP_CONVERSION 1 -#endif - #ifdef NO_FPE_SIGNALS # define ERTS_FP_CHECK_INIT() do {} while (0) # define ERTS_FP_ERROR(f, Action) if (!isfinite(f)) { Action; } else {} diff --git a/lib/erl_interface/src/encode/encode_pid.c b/lib/erl_interface/src/encode/encode_pid.c index d14746b40f..0dfdb16372 100644 --- a/lib/erl_interface/src/encode/encode_pid.c +++ b/lib/erl_interface/src/encode/encode_pid.c @@ -25,7 +25,6 @@ int ei_encode_pid(char *buf, int *index, const erlang_pid *p) { char* s = buf + *index; - const char tag = (p->creation > 3) ? ERL_NEW_PID_EXT : ERL_PID_EXT; ++(*index); /* skip ERL_PID_EXT */ if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), @@ -33,21 +32,17 @@ int ei_encode_pid(char *buf, int *index, const erlang_pid *p) return -1; if (buf) { - put8(s, tag); + put8(s, ERL_NEW_PID_EXT); s = buf + *index; /* now the integers */ put32be(s,p->num & 0x7fff); /* 15 bits */ put32be(s,p->serial & 0x1fff); /* 13 bits */ - if (tag == ERL_PID_EXT) { - put8(s,(p->creation & 0x03)); /* 2 bits */ - } else { - put32be(s, p->creation); /* 32 bits */ - } + put32be(s, p->creation); /* 32 bits */ } - *index += 4 + 4 + (tag == ERL_PID_EXT ? 1 : 4); + *index += 4 + 4 + 4; return 0; } diff --git a/lib/erl_interface/src/encode/encode_port.c b/lib/erl_interface/src/encode/encode_port.c index eb464380c0..0fb4018db1 100644 --- a/lib/erl_interface/src/encode/encode_port.c +++ b/lib/erl_interface/src/encode/encode_port.c @@ -25,7 +25,6 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p) { char *s = buf + *index; - const char tag = p->creation > 3 ? ERL_NEW_PORT_EXT : ERL_PORT_EXT; ++(*index); /* skip ERL_PORT_EXT */ if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), ERLANG_UTF8, @@ -33,19 +32,15 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p) return -1; } if (buf) { - put8(s, tag); + put8(s, ERL_NEW_PORT_EXT); s = buf + *index; /* now the integers */ put32be(s,p->id & 0x0fffffff /* 28 bits */); - if (tag == ERL_PORT_EXT) { - put8(s,(p->creation & 0x03)); - } else { - put32be(s, p->creation); - } + put32be(s, p->creation); } - *index += 4 + (tag == ERL_PORT_EXT ? 1 : 4); + *index += 4 + 4; return 0; } diff --git a/lib/erl_interface/src/encode/encode_ref.c b/lib/erl_interface/src/encode/encode_ref.c index 5ccfc32c6d..8c2e0a25f7 100644 --- a/lib/erl_interface/src/encode/encode_ref.c +++ b/lib/erl_interface/src/encode/encode_ref.c @@ -24,7 +24,6 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) { - const char tag = (p->creation > 3) ? ERL_NEWER_REFERENCE_EXT : ERL_NEW_REFERENCE_EXT; char *s = buf + *index; int i; @@ -37,7 +36,7 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) /* Always encode as an extended reference; all participating parties are now expected to be able to decode extended references. */ if (buf) { - put8(s, tag); + put8(s, ERL_NEWER_REFERENCE_EXT); /* first, number of integers */ put16be(s, p->len); @@ -46,15 +45,12 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) s = buf + *index; /* now the integers */ - if (tag == ERL_NEW_REFERENCE_EXT) - put8(s,(p->creation & 0x03)); - else - put32be(s, p->creation); + put32be(s, p->creation); for (i = 0; i < p->len; i++) put32be(s,p->n[i]); } - *index += p->len*4 + (tag == ERL_NEW_REFERENCE_EXT ? 1 : 4); + *index += p->len*4 + 4; return 0; } diff --git a/lib/erl_interface/src/epmd/ei_epmd.h b/lib/erl_interface/src/epmd/ei_epmd.h index ac153b6e66..e3cb041dc9 100644 --- a/lib/erl_interface/src/epmd/ei_epmd.h +++ b/lib/erl_interface/src/epmd/ei_epmd.h @@ -24,9 +24,12 @@ #define INADDR_LOOPBACK ((u_long) 0x7F000001) #endif +#define EI_DIST_5 5 /* OTP R4 - 22 */ +#define EI_DIST_6 6 /* OTP 23 and later */ + #ifndef EI_DIST_HIGH -#define EI_DIST_HIGH 5 /* R4 and later */ -#define EI_DIST_LOW 1 /* R3 and earlier */ +#define EI_DIST_HIGH EI_DIST_6 +#define EI_DIST_LOW EI_DIST_5 #endif #ifndef EPMD_PORT @@ -45,6 +48,7 @@ #ifndef EI_EPMD_ALIVE2_REQ #define EI_EPMD_ALIVE2_REQ 120 #define EI_EPMD_ALIVE2_RESP 121 +#define EI_EPMD_ALIVE2_X_RESP 118 #define EI_EPMD_PORT2_REQ 122 #define EI_EPMD_PORT2_RESP 119 #define EI_EPMD_STOP_REQ 's' diff --git a/lib/erl_interface/src/epmd/epmd_port.c b/lib/erl_interface/src/epmd/epmd_port.c index 492c3fb3aa..1ea2f7b9df 100644 --- a/lib/erl_interface/src/epmd/epmd_port.c +++ b/lib/erl_interface/src/epmd/epmd_port.c @@ -25,16 +25,6 @@ #include <windows.h> #include <winbase.h> -#elif VXWORKS -#include <vxWorks.h> -#include <ifLib.h> -#include <sockLib.h> -#include <inetLib.h> -#include <unistd.h> -#include <sys/types.h> -#include <sys/socket.h> -#include <netinet/in.h> - #else #include <unistd.h> #include <sys/types.h> @@ -114,9 +104,6 @@ static int ei_epmd_r4_port (struct in_addr *addr, const char *alive, int err; ssize_t dlen; unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; -#if defined(VXWORKS) - char ntoabuf[32]; -#endif if (len > sizeof(buf) - 3) { @@ -144,17 +131,8 @@ static int ei_epmd_r4_port (struct in_addr *addr, const char *alive, return -1; } -#ifdef VXWORKS - /* FIXME use union/macro for level. Correct level? */ - if (ei_tracelevel > 2) { - inet_ntoa_b(*addr,ntoabuf); - EI_TRACE_CONN2("ei_epmd_r4_port", - "-> PORT2_REQ alive=%s ip=%s",alive,ntoabuf); - } -#else EI_TRACE_CONN2("ei_epmd_r4_port", "-> PORT2_REQ alive=%s ip=%s",alive,inet_ntoa(*addr)); -#endif dlen = (ssize_t) 2; err = ei_read_fill_t__(fd, buf, &dlen, tmo); diff --git a/lib/erl_interface/src/epmd/epmd_publish.c b/lib/erl_interface/src/epmd/epmd_publish.c index 20b8e867e8..f2c7abbd1a 100644 --- a/lib/erl_interface/src/epmd/epmd_publish.c +++ b/lib/erl_interface/src/epmd/epmd_publish.c @@ -25,16 +25,6 @@ #include <windows.h> #include <winbase.h> -#elif VXWORKS -#include <vxWorks.h> -#include <ifLib.h> -#include <sockLib.h> -#include <inetLib.h> -#include <unistd.h> -#include <sys/types.h> -#include <sys/socket.h> -#include <netinet/in.h> - #else #include <unistd.h> #include <sys/types.h> @@ -68,7 +58,8 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms) int nlen = strlen(alive); int len = elen + nlen + 13; /* hard coded: be careful! */ int n; - int err, res, creation; + int err, response, res; + unsigned creation; ssize_t dlen; unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; @@ -124,8 +115,10 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms) /* Don't close fd here! It keeps us registered with epmd */ s = buf; - if (((res=get8(s)) != EI_EPMD_ALIVE2_RESP)) { /* response */ - EI_TRACE_ERR1("ei_epmd_r4_publish","<- unknown (%d)",res); + response = get8(s); + if (response != EI_EPMD_ALIVE2_RESP && + response != EI_EPMD_ALIVE2_X_RESP) { + EI_TRACE_ERR1("ei_epmd_r4_publish","<- unknown (%d)",response); EI_TRACE_ERR0("ei_epmd_r4_publish","-> CLOSE"); ei_close__(fd); erl_errno = EIO; @@ -141,18 +134,21 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms) return -1; } - creation = get16be(s); + if (response == EI_EPMD_ALIVE2_RESP) + creation = get16be(s); + else /* EI_EPMD_ALIVE2_X_RESP */ + creation = get32be(s); EI_TRACE_CONN2("ei_epmd_r4_publish", - " result=%d (ok) creation=%d",res,creation); - - /* probably should save fd so we can close it later... */ - /* epmd_saveconn(OPEN,fd,alive); */ + " result=%d (ok) creation=%u",res,creation); - /* return the creation number, for no good reason */ - /* return creation;*/ + /* + * Would be nice to somehow use the nice "unique" creation value + * received here from epmd instead of using the crappy one + * passed (already) to ei_connect_init. + */ - /* no - return the descriptor */ + /* return the descriptor */ return fd; } diff --git a/lib/erl_interface/src/epmd/epmd_unpublish.c b/lib/erl_interface/src/epmd/epmd_unpublish.c index c112f74147..592cc0371e 100644 --- a/lib/erl_interface/src/epmd/epmd_unpublish.c +++ b/lib/erl_interface/src/epmd/epmd_unpublish.c @@ -22,16 +22,6 @@ #include <windows.h> #include <winbase.h> -#elif VXWORKS -#include <vxWorks.h> -#include <ifLib.h> -#include <sockLib.h> -#include <inetLib.h> -#include <unistd.h> -#include <sys/types.h> -#include <sys/socket.h> -#include <netinet/in.h> - #else #include <unistd.h> #include <sys/types.h> diff --git a/lib/erl_interface/src/legacy/global_names.c b/lib/erl_interface/src/global/global_names.c index ee808620fb..bcbe740223 100644 --- a/lib/erl_interface/src/legacy/global_names.c +++ b/lib/erl_interface/src/global/global_names.c @@ -24,8 +24,8 @@ #include "eisend.h" #include "eirecv.h" #include "ei_connect_int.h" -#include "erl_interface.h" -#include "erl_connect.h" +#include "ei.h" +#include "ei_connect.h" #define GLOBALNAMEBUF (16*1024) /* not very small actually */ @@ -36,14 +36,14 @@ * caller can make one call to free(). */ /* global:registered_names() -> [name1,name2,...] */ -char **erl_global_names(int fd, int *count) +char **ei_global_names(ei_cnode *ec, int fd, int *count) { char buf[GLOBALNAMEBUF]; char *bufp=buf; char tmpbuf[64]; int size = 0; int index = 0; - erlang_pid *self = erl_self(); + erlang_pid *self = ei_self(ec); erlang_msg msg; int i; int version; diff --git a/lib/erl_interface/src/legacy/global_register.c b/lib/erl_interface/src/global/global_register.c index 4cb6d8071f..c260ce091c 100644 --- a/lib/erl_interface/src/legacy/global_register.c +++ b/lib/erl_interface/src/global/global_register.c @@ -22,15 +22,14 @@ #include "eiext.h" #include "eisend.h" #include "eirecv.h" -#include "erl_interface.h" +#include "ei.h" -int erl_global_register(int fd, const char *name, ETERM *pid) +int ei_global_register(int fd, const char *name, erlang_pid *self) { char buf[EISMALLBUF]; char *bufp=buf; char tmpbuf[64]; int index = 0; - erlang_pid self; erlang_msg msg; int needlink, needatom, needmonitor; int arity; @@ -38,24 +37,19 @@ int erl_global_register(int fd, const char *name, ETERM *pid) int msglen; int i; - /* get that pid into a better format */ - if (!erl_encode(pid,(unsigned char*)buf)) return -1; - if (ei_decode_version(buf,&index,&version) - || ei_decode_pid(buf,&index,&self)) return -1; - /* set up rpc arguments */ /* { PidFrom, { call, Mod, Fun, Args, user }} */ index = 0; ei_encode_version(buf,&index); ei_encode_tuple_header(buf,&index,2); - ei_encode_pid(buf,&index,&self); /* PidFrom */ + ei_encode_pid(buf,&index,self); /* PidFrom */ ei_encode_tuple_header(buf,&index,5); ei_encode_atom(buf,&index,"call"); /* call */ ei_encode_atom(buf,&index,"global"); /* Mod */ ei_encode_atom(buf,&index,"register_name_external"); /* Fun */ ei_encode_list_header(buf,&index,3); /* Args: [ name, self(), cnode ] */ ei_encode_atom(buf,&index,name); - ei_encode_pid(buf,&index,&self); + ei_encode_pid(buf,&index,self); ei_encode_tuple_header(buf,&index,2); ei_encode_atom(buf,&index,"global"); /* special "resolve" treatment */ ei_encode_atom(buf,&index,"cnode"); /* i.e. we get a SEND when conflict */ @@ -63,7 +57,7 @@ int erl_global_register(int fd, const char *name, ETERM *pid) ei_encode_atom(buf,&index,"user"); /* user */ /* make the rpc call */ - if (ei_send_reg_encoded(fd,&self,"rex",buf,index)) return -1; + if (ei_send_reg_encoded(fd,self,"rex",buf,index)) return -1; /* get the reply: expect link and an atom, or just an atom */ needlink = needatom = needmonitor = 1; diff --git a/lib/erl_interface/src/legacy/global_unregister.c b/lib/erl_interface/src/global/global_unregister.c index 27f68670ca..ee785a2abd 100644 --- a/lib/erl_interface/src/legacy/global_unregister.c +++ b/lib/erl_interface/src/global/global_unregister.c @@ -23,18 +23,18 @@ #include "eisend.h" #include "eirecv.h" #include "ei_connect_int.h" -#include "erl_interface.h" -#include "erl_connect.h" +#include "ei_connect.h" +#include "ei.h" /* remove the association between name and its pid */ /* global:unregister_name(name) -> ok */ -int erl_global_unregister(int fd, const char *name) +int ei_global_unregister(ei_cnode *ec, int fd, const char *name) { char buf[EISMALLBUF]; char *bufp=buf; char tmpbuf[64]; int index = 0; - erlang_pid *self = erl_self(); + erlang_pid *self = ei_self(ec); erlang_msg msg; int i; int version,arity,msglen; diff --git a/lib/erl_interface/src/legacy/global_whereis.c b/lib/erl_interface/src/global/global_whereis.c index 13c4c93ca7..afedc98030 100644 --- a/lib/erl_interface/src/legacy/global_whereis.c +++ b/lib/erl_interface/src/global/global_whereis.c @@ -24,23 +24,22 @@ #include "eisend.h" #include "eirecv.h" #include "ei_connect_int.h" -#include "erl_interface.h" -#include "erl_connect.h" +#include "ei.h" +#include "ei_connect.h" /* return the ETERM pid corresponding to name. If caller * provides non-NULL node, nodename will be returned there */ /* global:whereis_name(name) -> pid */ -ETERM *erl_global_whereis(int fd, const char *name, char *node) +int ei_global_whereis(ei_cnode *ec, int fd, const char *name, erlang_pid* pid, char *node) { char buf[EISMALLBUF]; char *bufp=buf; char tmpbuf[64]; int index = 0; - erlang_pid *self = erl_self(); + erlang_pid *self = ei_self(ec); erlang_pid epid; - ETERM *opid; erlang_msg msg; int i; int version,arity,msglen; @@ -60,7 +59,7 @@ ETERM *erl_global_whereis(int fd, const char *name, char *node) ei_encode_atom(buf,&index,"user"); /* user */ /* make the rpc call */ - if (ei_send_reg_encoded(fd,self,"rex",buf,index)) return NULL; + if (ei_send_reg_encoded(fd,self,"rex",buf,index)) return -1; while (1) { index = EISMALLBUF; @@ -68,7 +67,7 @@ ETERM *erl_global_whereis(int fd, const char *name, char *node) else break; } - if (i != ERL_SEND) return NULL; + if (i != ERL_SEND) return -1; /* expecting { rex, pid } */ index = 0; @@ -78,24 +77,18 @@ ETERM *erl_global_whereis(int fd, const char *name, char *node) || ei_decode_atom(buf,&index,tmpbuf) || strcmp(tmpbuf,"rex") || ei_decode_pid(buf,&index,&epid)) - return NULL; /* bad response from other side */ - - /* put the pid into a format for the caller */ - index = 0; - ei_encode_pid(buf,&index,&epid); - opid = erl_decode((unsigned char*)buf); + return -1; /* bad response from other side */ /* extract the nodename for the caller */ if (node) { - char* node_str = ERL_PID_NODE(opid); + char* node_str = epid.node; if (node_str) { strcpy(node, node_str); } else { - erl_free_term(opid); - return NULL; + return -1; } } - - return opid; + *pid = epid; + return 0; } diff --git a/lib/erl_interface/src/legacy/decode_term.c b/lib/erl_interface/src/legacy/decode_term.c deleted file mode 100644 index 72bacc3123..0000000000 --- a/lib/erl_interface/src/legacy/decode_term.c +++ /dev/null @@ -1,144 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#include "eidef.h" -#include "eiext.h" -#include "putget.h" -#include "erl_interface.h" - -/* - * This file is actually part of the erl_interface library, - * not the newer 'ei' library. The header file is still in "ei.h" - */ - -/* FIXME: is this to be completed? */ - -#if (0) -int ei_decode_term(const char *buf, int *index, void *t) -{ - const char *s = buf + *index; - const char *s0 = s; - - if (t) { - ETERM *tmp; - - /* this decodes and advances s */ - if (!(tmp = erl_decode_buf((unsigned char **)&s))) return -1; - - *(ETERM **)t = tmp; - *index += s - s0; - - return 0; - } - else { - int tmpindex = *index; - long ttype; - int arity; - int i; - - /* these are all the external types */ - switch ((ttype = get8(s))) { - case ERL_SMALL_INTEGER_EXT: - case ERL_INTEGER_EXT: - case ERL_SMALL_BIG_EXT: - return ei_decode_long(buf,index,NULL); - - case ERL_FLOAT_EXT: - case NEW_FLOAT_EXT: - return ei_decode_double(buf,index,NULL); - - case ERL_ATOM_EXT: - return ei_decode_atom(buf,index,NULL); - - case ERL_REFERENCE_EXT: - case ERL_NEW_REFERENCE_EXT: - return ei_decode_ref(buf,index,NULL); - - case ERL_PORT_EXT: - return ei_decode_port(buf,index,NULL); - - case ERL_PID_EXT: - return ei_decode_pid(buf,index,NULL); - - case ERL_SMALL_TUPLE_EXT: - case ERL_LARGE_TUPLE_EXT: - if (ei_decode_tuple_header(buf,index,&arity) < 0) - return -1; - - for (i=0; i<arity; i++) { - if (ei_decode_term(buf,index,NULL)) { - /* restore possibly changed index before returning */ - *index = tmpindex; - return -1; - } - } - return 0; - - case ERL_STRING_EXT: - return ei_decode_string(buf,index,NULL); - - case ERL_LIST_EXT: - case ERL_NIL_EXT: - if (ei_decode_list_header(buf,index,&arity) < 0) - return -1; - - if (arity) { - for (i=0; i<arity; i++) { - if (ei_decode_term(buf,index,NULL) < 0) { - /* restore possibly changed index before returning */ - *index = tmpindex; - return -1; - } - } - if (ei_decode_list_header(buf,index,&arity) < 0) { - *index = tmpindex; - return -1; - } - } - return 0; - - case ERL_BINARY_EXT: - return ei_decode_binary(buf,index,NULL,NULL); - - case ERL_LARGE_BIG_EXT: - default: - break; - } - } - - return -1; -} -#else -int ei_decode_term(const char *buf, int *index, void *t) -{ - const char *s = buf + *index; - const char *s0 = s; - ETERM *tmp; - - /* this decodes and advances s */ - if (!(tmp = erl_decode_buf((unsigned char **)&s))) return -1; - - if (t) *(ETERM **)t = tmp; - else erl_free_term(tmp); - - *index += s - s0; - - return 0; -} -#endif diff --git a/lib/erl_interface/src/legacy/encode_term.c b/lib/erl_interface/src/legacy/encode_term.c deleted file mode 100644 index df740ab487..0000000000 --- a/lib/erl_interface/src/legacy/encode_term.c +++ /dev/null @@ -1,54 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#include "eidef.h" -#include "eiext.h" -#include "putget.h" -#include "ei_x_encode.h" -#include "erl_interface.h" -#include "erl_marshal.h" - -/* FIXME: depends on old erl_interface */ - -int ei_x_encode_term(ei_x_buff* x, void* t) -{ - int i = x->index; - ei_encode_term(NULL, &i, t); - if (!x_fix_buff(x, i)) - return -1; - return ei_encode_term(x->buff, &x->index, t); -} - -int ei_encode_term(char *buf, int *index, void *t) -{ - char *s = buf + *index; - char *s0 = s; - - if (!buf) s += erl_term_len(t) -1; /* -1 for version */ - else { - /* this encodes all but the version at the start */ - /* and it will move s forward the right number of bytes */ - if (erl_encode_it(t,(unsigned char **)&s, 5)) return -1; - } - - *index += s - s0; - - return 0; -} - diff --git a/lib/erl_interface/src/legacy/erl_config.h b/lib/erl_interface/src/legacy/erl_config.h deleted file mode 100644 index fb72169f23..0000000000 --- a/lib/erl_interface/src/legacy/erl_config.h +++ /dev/null @@ -1,23 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef _ERL_CONFIG_H -#define _ERL_CONFIG_H - -#endif /* _ERL_CONFIG_H */ diff --git a/lib/erl_interface/src/legacy/erl_connect.c b/lib/erl_interface/src/legacy/erl_connect.c deleted file mode 100644 index e2fd4611c0..0000000000 --- a/lib/erl_interface/src/legacy/erl_connect.c +++ /dev/null @@ -1,467 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Purpose: Connect to any node at any host. - */ - -/*************************************************************************** - * - * 'erl_interface' node connection handling is to use 'ei' for all - * operations without access to the internal structure of saved data, - * e.i. it should use the public interface functions. The connection - * handling can be seen as a restricted node interface where only one - * node can be used in one operating system process. - * - ***************************************************************************/ - -#include "eidef.h" - -#include <stdlib.h> -#include <sys/types.h> -#include <fcntl.h> - -#ifdef __WIN32__ -#include <winsock2.h> -#include <windows.h> -#include <winbase.h> - -#elif VXWORKS -#include <vxWorks.h> -#include <hostLib.h> -#include <selectLib.h> -#include <ifLib.h> -#include <sockLib.h> -#include <taskLib.h> -#include <inetLib.h> - -#include <unistd.h> -#include <sys/types.h> -#include <sys/times.h> -#include <unistd.h> -#include <sys/types.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netinet/tcp.h> -#include <timers.h> - -#include "erl_error.h" - -#else /* some other unix */ -#include <unistd.h> -#include <sys/types.h> -#include <sys/times.h> - -#if TIME_WITH_SYS_TIME -# include <sys/time.h> -# include <time.h> -#else -# if HAVE_SYS_TIME_H -# include <sys/time.h> -# else -# include <time.h> -# endif -#endif - -#include <sys/socket.h> -#include <netinet/in.h> -#include <netinet/tcp.h> -#include <arpa/inet.h> -#include <netdb.h> -#include <sys/utsname.h> /* for gen_challenge (NEED FIX?) */ -#endif - -/* common includes */ -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <errno.h> - -/* FIXME include less */ -#include "erl_interface.h" -#include "erl_connect.h" -#include "erl_eterm.h" -#include "erl_malloc.h" -#include "putget.h" -#include "ei.h" -#include "ei_connect_int.h" -#include "ei_locking.h" -#include "ei_epmd.h" -#include "ei_internal.h" - -/* rpc_from() uses a buffer this size */ -#ifndef MAX_RECEIVE_BUF -#define MAX_RECEIVE_BUF 32*1024 -#endif - -/* This is the global state of the old erl_* API */ - -static ei_cnode erl_if_ec; - -/*************************************************************************** - * - * API: erl_connect_init() - * API: erl_connect_xinit() - * - * Returns 1 on success and 0 on failure. - * Not documented to set erl_errno. - * - ***************************************************************************/ - -int erl_connect_init(int this_node_number, char *cookie, short creation) -{ - char nn[MAXATOMLEN]; - - sprintf(nn, "c%d", this_node_number); - - return ei_connect_init(&erl_if_ec, nn, cookie, creation) == 0; -} - -/* FIXME documented to use struct in_addr as addr */ - -int erl_connect_xinit(char *thishostname, - char *thisalivename, - char *thisnodename, - struct in_addr *thisipaddr, - char *cookie, - short creation) -{ - return ei_connect_xinit(&erl_if_ec, thishostname, thisalivename, - thisnodename, thisipaddr, cookie, creation) >= 0; -} - -/*************************************************************************** - * - * API: erl_connect() - * API: erl_xconnect() - * - * Set up a connection to a given Node, and interchange hand shake - * messages with it. - * - * Returns valid file descriptor on success and < 0 on failure. - * Set erl_errno to EHOSTUNREACH, ENOMEM, EIO or errno from socket(2) - * or connect(2). - * - ***************************************************************************/ - -int erl_connect(char *nodename) -{ - int res = ei_connect(&erl_if_ec, nodename); - if (res < 0) erl_errno = EIO; - return res; -} - -/* FIXME documented to use struct in_addr as addr */ - -int erl_xconnect(Erl_IpAddr addr, char *alivename) -{ - return ei_xconnect(&erl_if_ec, addr, alivename); -} - - -/*************************************************************************** - * - * API: erl_close_connection() - * - * Returns 0 on success and -1 on failure. - * - ***************************************************************************/ - -int erl_close_connection(int fd) -{ - return ei_close_connection(fd); -} - -/* - * Accept and initiate a connection from another - * Erlang node. Return a file descriptor at success, - * otherwise -1; - */ -int erl_accept(int lfd, ErlConnect *conp) -{ - return ei_accept(&erl_if_ec, lfd, conp); -} - - -/* Receives a message from an Erlang socket. - * If the message was a TICK it is immediately - * answered. Returns: ERL_ERROR, ERL_TICK or - * the number of bytes read. - */ -int erl_receive(int s, unsigned char *bufp, int bufsize) -{ - return ei_receive(s, bufp, bufsize); -} - -/* - * Send an Erlang message to a registered process - * at the Erlang node, connected with a socket. - */ -int erl_reg_send(int fd, char *server_name, ETERM *msg) -{ - ei_x_buff x; - int r; - - if (ei_x_new_with_version(&x) < 0) { - erl_errno = ENOMEM; - return 0; - } - if (ei_x_encode_term(&x, msg) < 0) { - erl_errno = EINVAL; - r = 0; - } else { - r = ei_reg_send(&erl_if_ec, fd, server_name, x.buff, x.index); - } - ei_x_free(&x); - return r == 0; -} - -/* - * Sends an Erlang message to a process at an Erlang node - */ -int erl_send(int fd, ETERM *to ,ETERM *msg) -{ - erlang_pid topid; - ei_x_buff x; - int r; - - ei_x_new_with_version(&x); - ei_x_encode_term(&x, msg); - /* make the to-pid */ - if (!ERL_IS_PID(to)) { - ei_x_free(&x); - erl_errno = EINVAL; - return -1; - } - - if (to->uval.pidval.node.latin1) { - strcpy(topid.node, to->uval.pidval.node.latin1); - } - else { - strcpy(topid.node, to->uval.pidval.node.utf8); - } - topid.num = ERL_PID_NUMBER(to); - topid.serial = ERL_PID_SERIAL(to); - topid.creation = ERL_PID_CREATION(to); - r = ei_send(fd, &topid, x.buff, x.index); - ei_x_free(&x); - return r == 0; -} - -static int erl_do_receive_msg(int fd, ei_x_buff* x, ErlMessage* emsg) -{ - erlang_msg msg; - - int r; - msg.from.node[0] = msg.to.node[0] = msg.toname[0] = '\0'; - r = ei_do_receive_msg(fd, 0, &msg, x, 0); - - if (r == ERL_MSG) { - int index = 0; - emsg->type = msg.msgtype; - - /* - We can't call ei_decode_term for cases where there are no - data following the type information. If there are other - types added later where there are data this case has to be - extended. - */ - - switch (msg.msgtype) { - case ERL_SEND: - case ERL_REG_SEND: - case ERL_EXIT: - case ERL_EXIT2: - if (ei_decode_term(x->buff, &index, &emsg->msg) < 0) - r = ERL_ERROR; - break; - default: - emsg->msg = NULL; /* Not needed but may avoid problems for unsafe caller */ - break; - } - } else - emsg->msg = NULL; - if (msg.from.node[0] != '\0') - emsg->from = erl_mk_pid(msg.from.node, msg.from.num, msg.from.serial, msg.from.creation); - else - emsg->from = NULL; - if (msg.to.node[0] != '\0') - emsg->to = erl_mk_pid(msg.to.node, msg.to.num, msg.to.serial, msg.to.creation); - else - emsg->to = NULL; - strcpy(emsg->to_name, msg.toname); - return r; -} - -int erl_receive_msg(int fd, unsigned char *buf, int bufsize, ErlMessage *emsg) -{ - ei_x_buff x; - int r; - - ei_x_new(&x); - r = erl_do_receive_msg(fd, &x, emsg); - /* FIXME what is this about? */ - if (bufsize > x.index) - bufsize = x.index; - memcpy(buf, x.buff, bufsize); - ei_x_free(&x); - return r; -} - -int erl_xreceive_msg(int fd, unsigned char **buf, int *bufsize, - ErlMessage *emsg) -{ - ei_x_buff x; - int r; - - ei_x_new(&x); - r = erl_do_receive_msg(fd, &x, emsg); - if (*bufsize < x.index) - *buf = erl_realloc(*buf, x.index); - *bufsize = x.index; - memcpy(*buf, x.buff, *bufsize); - ei_x_free(&x); - return r; -} - -/* - * The RPC consists of two parts, send and receive. - * Here is the send part ! - * { PidFrom, { call, Mod, Fun, Args, user }} - */ -/* - * Now returns non-negative number for success, negative for failure. - */ -int erl_rpc_to(int fd, char *mod, char *fun, ETERM *args) -{ - int r; - ei_x_buff x; - - ei_x_new(&x); - ei_x_encode_term(&x, args); - r = ei_rpc_to(&erl_if_ec, fd, mod, fun, x.buff, x.index); - ei_x_free(&x); - return r; -} /* rpc_to */ - - /* - * And here is the rpc receiving part. A negative - * timeout means 'infinity'. Returns either of: ERL_MSG, - * ERL_TICK, ERL_ERROR or ERL_TIMEOUT. -*/ -int erl_rpc_from(int fd, int timeout, ErlMessage *emsg) -{ - fd_set readmask; - struct timeval tv; - struct timeval *t = NULL; - unsigned char rbuf[MAX_RECEIVE_BUF]; - - if (timeout >= 0) { - tv.tv_sec = timeout / 1000; - tv.tv_usec = (timeout % 1000) * 1000; - t = &tv; - } - - FD_ZERO(&readmask); - FD_SET(fd,&readmask); - - switch (select(fd+1, &readmask, NULL, NULL, t)) { - case -1: - erl_errno = EIO; - return ERL_ERROR; - case 0: - erl_errno = ETIMEDOUT; - return ERL_TIMEOUT; - default: - if (FD_ISSET(fd, &readmask)) - return erl_receive_msg(fd, rbuf, MAX_RECEIVE_BUF, emsg); - else { - erl_errno = EIO; - return ERL_ERROR; - } - } -} /* rpc_from */ - -/* - * A true RPC. It return a NULL pointer - * in case of failure, otherwise a valid - * (ETERM *) pointer containing the reply - */ -ETERM *erl_rpc(int fd, char *mod, char *fun, ETERM *args) -{ - int i; - ETERM *ep; - ErlMessage emsg; - - if (erl_rpc_to(fd, mod, fun, args) < 0) { - return NULL; } - while ((i=erl_rpc_from(fd, ERL_NO_TIMEOUT, &emsg)) == ERL_TICK); - - if (i == ERL_ERROR) return NULL; - - ep = erl_element(2,emsg.msg); /* {RPC_Tag, RPC_Reply} */ - erl_free_term(emsg.msg); - erl_free_term(emsg.to); - return ep; -} /* rpc */ - - -/* - ** Handshake - */ - -int erl_publish(int port) -{ - return ei_publish(&erl_if_ec, port); -} - -int erl_unpublish(const char *alive) -{ - return ei_unpublish_tmo(alive,0); -} - -erlang_pid *erl_self(void) -{ - return ei_self(&erl_if_ec); -} - -const char *erl_thisnodename(void) -{ - return ei_thisnodename(&erl_if_ec); -} - -const char *erl_thishostname(void) -{ - return ei_thishostname(&erl_if_ec); -} - -const char *erl_thisalivename(void) -{ - return ei_thisalivename(&erl_if_ec); -} - -const char *erl_thiscookie(void) -{ - return ei_thiscookie(&erl_if_ec); -} - -short erl_thiscreation(void) -{ - return ei_thiscreation(&erl_if_ec); -} diff --git a/lib/erl_interface/src/legacy/erl_error.c b/lib/erl_interface/src/legacy/erl_error.c deleted file mode 100644 index a3bbfbc58f..0000000000 --- a/lib/erl_interface/src/legacy/erl_error.c +++ /dev/null @@ -1,181 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Function: Some nice error routines taken from: - * "Advanced Programming in the UNIX Environment", - * by W.Richard Stevens - * - * void erl_err_sys(const char *fmt, ... ) fatal, sys-error - * void erl_err_ret(const char *fmt, ... ) non-fatal, sys-error - * void erl_err_quit(const char *fmt, ...) fatal, non-sys-error - * void erl_err_msg(const char *fmt, ... ) non-fatal, non-sys-error - */ - -#include <stdio.h> -#include <stdarg.h> -#include <stdlib.h> -#include <string.h> - -#ifdef VRTX /* What's VRIX? [sverkerw] */ -#define __READY_EXTENSIONS__ -#endif -#include <errno.h> - -#if defined(VXWORKS) -#include <taskLib.h> -#include <taskVarLib.h> -#endif - -#include "eidef.h" -#include "erl_interface.h" -#include "erl_error.h" - -/* Forward */ -static void err_doit(int, const char*, va_list); -/* __attribute__ ((format (printf, 2, 0)))*/ - -/* - * Some thoughts on flushing stdout/stderr: - * - * The defaults are reasonable (linebuffered stdout, unbuffered - * stderr). If they are in effect (the user neither knows nor cares), - * there's no need to flush. - * - * If the user changes these defaults (and knows what he's doing, so - * he knows and cares) we shouldn't surprise him by - * second-guessing. So there's a need to not flush. - * - * If the user doesn't know what he's doing, he's hosed anyway. - */ - -/* Fatal error related to a system call. - * Print a message and terminate. - */ -void erl_err_sys(const char *fmt, ... ) -{ - va_list ap; - - va_start(ap, fmt); - err_doit(1, fmt, ap); - va_end(ap); - exit(1); -} /* erl_err_sys */ - -/* Nonfatal error related to a system call. - * Print a message and return - */ -void erl_err_ret(const char *fmt, ... ) -{ - va_list ap; - - va_start(ap, fmt); - err_doit(1, fmt, ap); - va_end(ap); - return; -} /* erl_err_ret */ - -/* Nonfatal error unrelated to a system call. - * Print a message and return - */ -void erl_err_msg(const char *fmt, ... ) -{ - va_list ap; - - va_start(ap, fmt); - err_doit(0, fmt, ap); - va_end(ap); - return; -} /* erl_err_msg */ - -/* Fatal error unrelated to a system call. - * Print a message and terminate - */ -void erl_err_quit(const char *fmt, ... ) -{ - va_list ap; - - va_start(ap, fmt); - err_doit(0, fmt, ap); - va_end(ap); - exit(1); -} /* erl_err_quit */ - - - -/* - * For example on SunOS we don't have the ANSI C strerror. - * - * maybe move to a convenince lib [sverkerw] - */ -#ifndef HAVE_STRERROR - -/* FIXME: move to configure */ -/* CONFIG: probe for sys_nerr/_sys_nerr */ -extern int sys_nerr; - -/* CONFIG: probe for sys_errlist/_sys_errlist and maybe for const-ness */ -#ifdef FREEBSD -extern const char * const sys_errlist[]; -#else -extern char * sys_errlist[]; -#endif - -/* Should be in string.h */ -/* Is supposed to return 'char *' (no const-ness in ANSI's prototype), - but if you rewrite the returned string in place you deserve to - lose. */ -static const char *strerror(int errnum) -{ - if (errnum >= 0 && errnum < sys_nerr) { - return sys_errlist[errnum]; - } else { - /* Enough buffer for 64 bits of error. It should last a while. */ - /* FIXME problem for threaded ? */ - static char b[] = "(error -9223372036854775808)"; - sprintf(b, "(error %d)", errnum); - buf[sizeof(b)-1] = '\0'; - return b; - } -} -#endif /* !HAVE_STRERROR */ - - -/* Print a message and return to caller. - * Caller specifies "errnoflag". - */ -static void err_doit(int errnoflag, const char *fmt, va_list ap) -{ -#ifndef NO_ERR_MSG - int errno_save; - - errno_save = errno; - - vfprintf(stderr, fmt, ap); - if (errnoflag) - { - fputs(": ", stderr); - fputs(strerror(errno_save), stderr); - } - fputs("\n", stderr); -#endif - - return; -} /* err_doit */ - diff --git a/lib/erl_interface/src/legacy/erl_error.h b/lib/erl_interface/src/legacy/erl_error.h deleted file mode 100644 index 0cce083ae7..0000000000 --- a/lib/erl_interface/src/legacy/erl_error.h +++ /dev/null @@ -1,26 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef _ERL_ERROR_H -#define _ERL_ERROR_H - -/* Initialize thread/task-safe erl_errno handling */ -void erl_init_errno(void); - -#endif /* _ERL_ERROR_H */ diff --git a/lib/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c deleted file mode 100644 index 7ecea83b1a..0000000000 --- a/lib/erl_interface/src/legacy/erl_eterm.c +++ /dev/null @@ -1,1413 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2017. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Purpose: Representation of Erlang terms. - */ - -#include "eidef.h" - -#include <stddef.h> -#include <stdlib.h> -#include <string.h> -#include <ctype.h> -#if defined(HAVE_ISFINITE) -#include <math.h> -#endif - -#include "ei_locking.h" -#include "ei_resolve.h" -#include "erl_interface.h" -#include "erl_eterm.h" -#include "erl_malloc.h" -#include "erl_marshal.h" -#include "erl_error.h" -#include "erl_internal.h" -#include "ei_internal.h" -#include "putget.h" - -#define ERL_IS_BYTE(x) (ERL_IS_INTEGER(x) && (ERL_INT_VALUE(x) & ~0xFF) == 0) - -/* FIXME use unsigned char, or uint8 for buffers, cast (int) really needed? */ - -static void iolist_to_buf(const ETERM* term, char** bufp); -static char* strsave(const char *src); - -/*************************************************************************** - * - * API: erl_init() - * - * Not documented to set erl_errno. - * - ***************************************************************************/ - -/* all initialisation of erl_interface modules should be called from here */ -/* order is important: erl_malloc and erl_resolve depend on ei_locking */ -/* NOTE: don't call this directly - please use erl_init() macro defined - in ei_locking.h! */ -void erl_init(void *hp,long heap_size) -{ - erl_init_malloc(hp, heap_size); - erl_init_marshal(); - (void) ei_init(); -} - -void erl_set_compat_rel(unsigned rel) -{ - ei_set_compat_rel(rel); -} - -/* - * Create an INTEGER. Depending on its value it - * may end up as a BigNum. - */ -ETERM *erl_mk_int (int i) -{ - ETERM *ep; - - ep = erl_alloc_eterm(ERL_INTEGER); - ERL_COUNT(ep) = 1; - ERL_INT_VALUE(ep) = i; - return ep; -} - -ETERM *erl_mk_longlong (long long i) -{ - ETERM *ep; - - ep = erl_alloc_eterm(ERL_LONGLONG); - ERL_COUNT(ep) = 1; - ERL_LL_VALUE(ep) = i; - return ep; -} - -/* - * Create an UNSIGNED INTEGER. Depending on its - * value it may end up as a BigNum. - */ - -ETERM *erl_mk_uint (unsigned int u) -{ - ETERM *ep; - - ep = erl_alloc_eterm(ERL_U_INTEGER); - ERL_COUNT(ep) = 1; - ERL_INT_UVALUE(ep) = u; - return ep; -} - -ETERM *erl_mk_ulonglong (unsigned long long i) -{ - ETERM *ep; - - ep = erl_alloc_eterm(ERL_U_LONGLONG); - ERL_COUNT(ep) = 1; - ERL_LL_UVALUE(ep) = i; - return ep; -} - -/* - * Create a FLOAT. - */ -ETERM *erl_mk_float (double d) -{ - ETERM *ep; - -#if defined(HAVE_ISFINITE) - /* Erlang does not handle Inf and NaN, so we return an error - * rather than letting the Erlang VM complain about a bad external - * term. */ - if(!isfinite(d)) { - return NULL; - } -#endif - - ep = erl_alloc_eterm(ERL_FLOAT); - ERL_COUNT(ep) = 1; - ERL_FLOAT_VALUE(ep) = d; - return ep; -} - -/* - * Create an ATOM - */ -ETERM *erl_mk_atom (const char *s) -{ - ETERM *ep; - - /* ASSERT(s != NULL); */ - if (!s) return NULL; - - ep = erl_alloc_eterm(ERL_ATOM); - ERL_COUNT(ep) = 1; - if (erl_atom_init_latin1(&ep->uval.aval.d, s) == NULL) { - erl_free_term(ep); - erl_errno = ENOMEM; - return NULL; - } - return ep; -} - -char* erl_atom_ptr_latin1(Erl_Atom_data* a) -{ - if (a->latin1 == NULL) { - erlang_char_encoding enc; - a->lenL = utf8_to_latin1(NULL, a->utf8, a->lenU, a->lenU, &enc); - if (a->lenL < 0) { - a->lenL = 0; - return NULL; - } - if (enc == ERLANG_ASCII) { - a->latin1 = a->utf8; - } - else { - a->latin1 = malloc(a->lenL+1); - utf8_to_latin1(a->latin1, a->utf8, a->lenU, a->lenL, NULL); - a->latin1[a->lenL] = '\0'; - } - } - return a->latin1; -} - -char* erl_atom_ptr_utf8(Erl_Atom_data* a) -{ - if (a->utf8 == NULL) { - erlang_char_encoding enc; - a->lenU = latin1_to_utf8(NULL, a->latin1, a->lenL, a->lenL*2, &enc); - if (enc == ERLANG_ASCII) { - a->utf8 = a->latin1; - } - else { - a->utf8 = malloc(a->lenU + 1); - latin1_to_utf8(a->utf8, a->latin1, a->lenL, a->lenU, NULL); - a->utf8[a->lenU] = '\0'; - } - } - return a->utf8; -} - -int erl_atom_size_latin1(Erl_Atom_data* a) -{ - if (a->latin1 == NULL) { - erl_atom_ptr_latin1(a); - } - return a->lenL; -} -int erl_atom_size_utf8(Erl_Atom_data* a) -{ - if (a->utf8 == NULL) { - erl_atom_ptr_utf8(a); - } - return a->lenU; -} -char* erl_atom_init_latin1(Erl_Atom_data* a, const char* s) -{ - a->lenL = strlen(s); - if ((a->latin1 = strsave(s)) == NULL) - { - return NULL; - } - a->utf8 = NULL; - a->lenU = 0; - return a->latin1; -} - - -/* - * Given a string as input, creates a list. - */ -ETERM *erl_mk_string(const char *s) -{ - /* ASSERT(s != NULL); */ - if (!s) return NULL; - - return erl_mk_estring(s, strlen(s)); -} - -ETERM *erl_mk_estring(const char *s, int len) -{ - ETERM *ep; - int i; - - if ((!s) || (len < 0)) return NULL; - - /* - * ASSERT(s != NULL); - * ASSERT(len >= 0); - */ - - ep = erl_mk_empty_list(); - for (i = len-1; i >= 0; i--) { - ETERM* integer; - ETERM* cons; - - integer = erl_alloc_eterm(ERL_INTEGER); - ERL_COUNT(integer) = 1; - ERL_INT_VALUE(integer) = (unsigned char)s[i]; - - cons = erl_alloc_eterm(ERL_LIST); - ERL_COUNT(cons) = 1; - HEAD(cons) = integer; - TAIL(cons) = ep; - ep = cons; - } - return ep; -} - -/* - * Create a PID. - */ -ETERM *erl_mk_pid(const char *node, - unsigned int number, - unsigned int serial, - unsigned char creation) -{ - ETERM *ep; - - if (!node) return NULL; - /* ASSERT(node != NULL); */ - - ep = erl_alloc_eterm(ERL_PID); - ERL_COUNT(ep) = 1; - if (erl_atom_init_latin1(&ep->uval.pidval.node, node) == NULL) - { - erl_free_term(ep); - erl_errno = ENOMEM; - return NULL; - } - erl_mk_pid_helper(ep, number, serial, creation & 0x03); - return ep; -} - -void erl_mk_pid_helper(ETERM *ep, unsigned int number, - unsigned int serial, unsigned int creation) -{ - ERL_PID_NUMBER(ep) = number & 0x7fff; /* 15 bits */ - ERL_PID_SERIAL(ep) = serial & 0x1fff; /* 13 bits */ - ERL_PID_CREATION(ep) = creation; /* 32 bits */ -} - -/* - * Create a PORT. - */ -ETERM *erl_mk_port(const char *node, - unsigned int number, - unsigned char creation) -{ - ETERM *ep; - - if (!node) return NULL; - /* ASSERT(node != NULL); */ - - ep = erl_alloc_eterm(ERL_PORT); - ERL_COUNT(ep) = 1; - if (erl_atom_init_latin1(&ep->uval.portval.node, node) == NULL) - { - erl_free_term(ep); - erl_errno = ENOMEM; - return NULL; - } - erl_mk_port_helper(ep, number, creation); - return ep; -} - -void erl_mk_port_helper(ETERM* ep, unsigned number, unsigned int creation) -{ - ERL_PORT_NUMBER(ep) = number & 0x0fffffff; /* 18 bits */ - ERL_PORT_CREATION(ep) = creation; /* 32 bits */ -} - -/* - * Create any kind of reference. - */ -ETERM *__erl_mk_reference (ETERM* t, - const char *node, - size_t len, - unsigned int n[], - unsigned int creation) -{ - if (t == NULL) { - if (node == NULL) return NULL; - - t = erl_alloc_eterm(ERL_REF); - ERL_COUNT(t) = 1; - - if (erl_atom_init_latin1(&t->uval.refval.node, node) == NULL) - { - erl_free_term(t); - erl_errno = ENOMEM; - return NULL; - } - } - ERL_REF_LEN(t) = len; - ERL_REF_NUMBERS(t)[0] = n[0] & 0x3ffff; /* 18 bits */ - ERL_REF_NUMBERS(t)[1] = n[1]; - ERL_REF_NUMBERS(t)[2] = n[2]; - ERL_REF_CREATION(t) = creation; /* 32 bits */ - - return t; -} - -/* - * Create a REFERENCE. - */ -ETERM *erl_mk_ref (const char *node, - unsigned int number, - unsigned char creation) -{ - unsigned int n[3] = {0, 0, 0}; - n[0] = number; - return __erl_mk_reference(NULL, node, 1, n, creation); -} - -/* - * Create a long REFERENCE. - */ -ETERM * -erl_mk_long_ref (const char *node, - unsigned int n1, unsigned int n2, unsigned int n3, - unsigned char creation) -{ - unsigned int n[3] = {0, 0, 0}; - n[0] = n3; n[1] = n2; n[2] = n1; - return __erl_mk_reference(NULL, node, 3, n, creation); -} - -/* - * Create a BINARY. - */ -ETERM *erl_mk_binary (const char *b, int size) -{ - ETERM *ep; - - if ((!b) || (size < 0)) return NULL; - /* ASSERT(b != NULL); */ - - ep = erl_alloc_eterm(ERL_BINARY); - ERL_COUNT(ep) = 1; - ERL_BIN_SIZE(ep) = size; - ERL_BIN_PTR(ep) = (unsigned char *) erl_malloc(size); - memcpy(ERL_BIN_PTR(ep), b, size); - return ep; -} - -/* - * Create a TUPLE. For each element in the tuple - * bump its reference counter. - */ -ETERM *erl_mk_tuple (ETERM **arr,int size) -{ - ETERM *ep; - int i; - - if ((!arr) || (size < 0)) return NULL; - for (i=0; i<size; i++) if (!arr[i]) return NULL; - /* ASSERT(arr != NULL); */ - - ep = erl_alloc_eterm(ERL_TUPLE); - ERL_COUNT(ep) = 1; - ERL_TUPLE_SIZE(ep) = size; - ERL_TUPLE_ELEMS(ep) = (ETERM**) erl_malloc((size) * (sizeof(ETERM*))); - for (i = 0; i < size; i++) { - /* ASSERT(arr[i] != NULL); */ - ERL_COUNT(arr[i])++; - ERL_TUPLE_ELEMENT(ep, i) = arr[i]; - } - return ep; -} - -/* - * SET an ELEMENT in a TUPLE. Free the old element - * and bump the reference counter of the new one. - * Return 1 on success, otherwise 0. - */ -#if 0 -int erl_setelement (int ix, ETERM *ep, ETERM *vp) -{ - if ((!ep) || (!vp)) return 0; - /* ASSERT(ep != NULL); - * ASSERT(vp != NULL); - */ - - if ((ERL_TYPE(ep) == ERL_TUPLE) && (ix <= ERL_TUPLE_SIZE(ep))) { - erl_free_term(ERL_TUPLE_ELEMENT(ep, ix-1)); - ERL_TUPLE_ELEMENT(ep, ix-1) = vp; - ERL_COUNT(vp)++; - return 1; - } - erl_err_msg("<ERROR> erl_setelement: Bad type to setelement or out of range \n"); - return 0; -} -#endif - -/* - * Extract an ELEMENT from a TUPLE. Bump the - * reference counter on the extracted object. - */ -ETERM *erl_element (int ix, const ETERM *ep) -{ - if ((!ep) || (ix < 0)) return NULL; - /* - * ASSERT(ep != NULL); - * ASSERT(ix >= 0); - */ - - if ((ERL_TYPE(ep) == ERL_TUPLE) && (ix <= ERL_TUPLE_SIZE(ep))) { - ERL_COUNT(ERL_TUPLE_ELEMENT(ep, ix-1))++; - return ERL_TUPLE_ELEMENT(ep, ix-1); - } - else - return NULL; -} /* erl_element */ - -ETERM *erl_mk_empty_list(void) -{ - ETERM *ep; - - ep = erl_alloc_eterm(ERL_EMPTY_LIST); - ERL_COUNT(ep) = 1; - return ep; -} - -/* - * Construct a new list by CONS'ing a HEAD on - * to the TAIL. Bump the reference counter on - * the head and tail object. Note that we allow - * non-well formed lists to be created. - */ -ETERM *erl_cons(ETERM *hd, ETERM *tl) -{ - ETERM *ep; - - if ((!hd) || (!tl)) return NULL; - - /* - * ASSERT(hd != NULL); - * ASSERT(tl != NULL); - */ - - ep = erl_alloc_eterm(ERL_LIST); - ERL_COUNT(ep) = 1; - HEAD(ep) = hd; - TAIL(ep) = tl; - ERL_COUNT(hd)++; - ERL_COUNT(tl)++; - return ep; -} - -/* - * Extract the HEAD of a LIST. Bump the reference - * counter on the head object. - */ -ETERM *erl_hd (const ETERM *ep) -{ - if (!ep) return NULL; - /* ASSERT(ep != NULL); */ - - if (ERL_TYPE(ep) != ERL_LIST) { - return (ETERM *) NULL; - } - ERL_COUNT(ERL_CONS_HEAD(ep))++; - return ERL_CONS_HEAD(ep); -} - -/* - * Extract the TAIL of a LIST. Bump the reference - * counter on the tail object. - */ -ETERM *erl_tl (const ETERM *ep) -{ - ETERM *tl; - - if (!ep) return NULL; - /* ASSERT(ep != NULL); */ - - if (ERL_TYPE(ep) != ERL_LIST) { - return (ETERM *) NULL; - } - - tl = TAIL(ep); - ERL_COUNT(tl)++; - return tl; -} - -/* - * Create a LIST from an array of elements. Note that - * we create it from the last element in the array to - * the first. Also, note that we decrement the reference - * counter for each member in the list but the first one. - * This is done because of the use of erl_cons. - */ - -ETERM *erl_mk_list (ETERM **arr, int size) -{ - ETERM *ep; - int i; - - if ((!arr) || (size < 0)) return NULL; - for (i=0; i<size; i++) if (!arr[i]) return NULL; - - /* ASSERT(arr != NULL); */ - ep = erl_mk_empty_list(); - if (size > 0) { - ERL_COUNT(ep)--; - } - - for (i = size-1; i >= 0; i--) { - /* ASSERT(arr[i] != NULL); */ - ep = erl_cons(arr[i], ep); - if (i > 0) - ERL_COUNT(ep)--; /* Internal reference */ - } - return ep; -} - -/* - * Create an empty VARIABLE. - */ -ETERM *erl_mk_var(const char *s) -{ - ETERM *ep; - - if (!s) return NULL; - - /* ASSERT(s != NULL); */ - - ep = erl_alloc_eterm(ERL_VARIABLE); - ERL_COUNT(ep) = 1; - ERL_VAR_LEN(ep) = strlen(s); - if ((ERL_VAR_NAME(ep) = strsave(s)) == NULL) - { - erl_free_term(ep); - erl_errno = ENOMEM; - return NULL; - } - ERL_VAR_VALUE(ep) = (ETERM *) NULL; - return ep; -} - -/* - * Return the CONTENT of a VARIABLE with NAME. - * If the content is non-nil then bump its - * reference counter. - */ -ETERM *erl_var_content (const ETERM *ep, const char *name) -{ - int i; - ETERM *vp; - - if ((!ep) || (!name)) return NULL; - - /* ASSERT(ep != NULL); */ - - switch(ERL_TYPE(ep)) - { - case ERL_VARIABLE: - if (strcmp(ERL_VAR_NAME(ep), name) == 0) { - if ((vp = ERL_VAR_VALUE(ep)) != NULL) { - ERL_COUNT(vp)++; - return vp; - } - } - break; - - case ERL_LIST: - while (ep && (ERL_TYPE(ep) != ERL_EMPTY_LIST)) { - if ((vp = erl_var_content(HEAD(ep), name))) return vp; - ep = TAIL(ep); - } - break; - - case ERL_TUPLE: - for (i=0; i < ERL_TUPLE_SIZE(ep); i++) - if ((vp = erl_var_content(ERL_TUPLE_ELEMENT(ep, i), name))) - { - return vp; - } - break; - - default: - /* variables can't occur in other types */ - break; - } - - /* nothing found ! */ - return NULL; -} - -/* - * Return the SIZE of a TUPLE or a BINARY. - * At failure -1 is returned. - */ -int erl_size (const ETERM *ep) -{ - if (!ep) return -1; - - /* ASSERT(ep != NULL); */ - - switch (ERL_TYPE(ep)) { - case ERL_TUPLE: - return ERL_TUPLE_SIZE(ep); - - case ERL_BINARY: - return ERL_BIN_SIZE(ep); - - default: - return -1; - - } -} - -/* - * Return the LENGTH of a LIST. - * At failure -1 is returned (this include non-proper lists like [a|b]). - */ -int erl_length(const ETERM *ep) -{ - int n = 0; - - if (!ep) return -1; - /* ASSERT(ep != NULL); */ - - while (ERL_TYPE(ep) == ERL_LIST) { - n++; - ep = TAIL(ep); - } - - if (!ERL_IS_EMPTY_LIST(ep)) return -1; - - return n; -} - - -/*********************************************************************** - * I o l i s t f u n c t i o n s - * - * The following functions handles I/O lists. - * - * Informally, an I/O list is a deep list of characters and binaries, - * which can be sent to an Erlang port. - * - * Formally, in BNF, an I/O list is defined as: - * - * iolist ::= [] - * | Binary - * | [iohead | iolist] - * ; - * - * iohead ::= Binary - * | Byte (integer in the range [0..255]) - * | iolist - * ; - * - * Note that versions of Erlang/OTP prior to R2 had a slightly more - * restricted definition of I/O lists, in that the tail of a an I/O list - * was not allowed to be a binary. The erl_interface functions - * for I/O lists follows the more liberal rules described by the BNF - * description above. - ***********************************************************************/ - -/* - * This function converts an I/O list to a '\0' terminated C string. - * The I/O list must not contain any occurrences of the integer 0. - * - * The string will be in memory allocated by erl_malloc(). It is the - * responsibility of the caller to eventually call erl_free() to free - * the memory. - * - * Returns: NULL if the list was not an I/O list or contained - * the integer 0, otherwise a pointer to '\0' terminated string. - */ - -char* erl_iolist_to_string(const ETERM* term) -{ - ETERM* bin; - - if ((bin = erl_iolist_to_binary(term)) == NULL) { - return NULL; - } else { - char* result = NULL; - - if (memchr(ERL_BIN_PTR(bin), '\0', ERL_BIN_SIZE(bin)) == NULL) { - result = (char *) erl_malloc(ERL_BIN_SIZE(bin)+1); - memcpy(result, ERL_BIN_PTR(bin), ERL_BIN_SIZE(bin)); - result[ERL_BIN_SIZE(bin)] = '\0'; - } - erl_free_term(bin); - return result; - } -} - -/* - * This function converts an I/O list to a binary term. - * - * Returns: NULL if the list was not an I/O list, otherwise - * an ETERM pointer pointing to a binary term. - */ - -ETERM *erl_iolist_to_binary (const ETERM* term) -{ - ETERM *dest; - int size; - char* ptr; - - if (!term) return NULL; - /* ASSERT(term != NULL); */ - - /* - * Verify that the term is an I/O list and get its length. - */ - - size = erl_iolist_length(term); - if (size == -1) { - return NULL; - } - - /* - * Allocate the binary and copy the contents of the I/O list into it. - */ - - dest = erl_alloc_eterm(ERL_BINARY); - ERL_COUNT(dest) = 1; - ERL_BIN_SIZE(dest) = size; - ptr = (char *)erl_malloc(size); - ERL_BIN_PTR(dest) = (unsigned char *)ptr; - iolist_to_buf(term, &ptr); - - /* - * If ptr doesn't point exactly one byte beyond the end of the - * binary, something must be seriously wrong. - */ - - if (ERL_BIN_PTR(dest) + size != (unsigned char *) ptr) return NULL; - /* ASSERT(ERL_BIN_PTR(dest) + size == (unsigned char *) ptr); */ - - return dest; -} - -/* - * Returns the length of an I/O list. - * - * Returns: -1 if the term if the given term is not a I/O list, - * or the length otherwise. - */ - -int erl_iolist_length (const ETERM* term) -{ - int len = 0; - - while (ERL_IS_CONS(term)) { - ETERM* obj = HEAD(term); - - if (ERL_IS_BYTE(obj)) { - len++; - } else if (ERL_IS_CONS(obj)) { - int i; - if ((i = erl_iolist_length(obj)) < 0) - return i; - len += i; - } else if (ERL_IS_BINARY(obj)) { - len += ERL_BIN_SIZE(obj); - } else if (!ERL_IS_EMPTY_LIST(obj)) { - return(-1); - } - term = TAIL(term); - } - if (ERL_IS_EMPTY_LIST(term)) - return len; - else if (ERL_IS_BINARY(term)) - return len + ERL_BIN_SIZE(term); - else - return -1; -} - -static int erl_atom_copy(Erl_Atom_data* dst, const Erl_Atom_data* src) -{ - if (src->latin1 == src->utf8) { - dst->latin1 = dst->utf8 = strsave(src->latin1); - dst->lenL = dst->lenU = strlen(src->latin1); - } - else if (src->latin1) { - dst->latin1 = strsave(src->latin1); - dst->lenL = strlen(src->latin1); - dst->utf8 = NULL; - dst->lenU = 0; - } - else { - dst->utf8 = strsave(src->utf8); - dst->lenU = strlen(src->utf8); - dst->latin1 = NULL; - dst->lenL = 0; - } - return (dst->latin1 != NULL || dst->utf8 == NULL); -} - - -/* - * Return a brand NEW COPY of an ETERM. - */ -/* - * FIXME: Deep (the whole tree) or shallow (just the top term) copy? - * The documentation never says, but the code as written below will - * make a deep copy. This should be documented. - */ -ETERM *erl_copy_term(const ETERM *ep) -{ - int i; - ETERM *cp; - - if (!ep) return NULL; - /* ASSERT(ep != NULL); */ - - cp = erl_alloc_eterm(ERL_TYPE(ep)); - ERL_COUNT(cp) = 1; - - switch(ERL_TYPE(cp)) { - case ERL_INTEGER: - case ERL_SMALL_BIG: - ERL_INT_VALUE(cp) = ERL_INT_VALUE(ep); - break; - case ERL_U_INTEGER: - case ERL_U_SMALL_BIG: - ERL_INT_UVALUE(cp) = ERL_INT_UVALUE(ep); - break; - case ERL_LONGLONG: - ERL_LL_VALUE(cp) = ERL_LL_VALUE(ep); - break; - case ERL_U_LONGLONG: - ERL_LL_UVALUE(cp) = ERL_LL_UVALUE(ep); - break; - case ERL_FLOAT: - ERL_FLOAT_VALUE(cp) = ERL_FLOAT_VALUE(ep); - break; - case ERL_ATOM: - if (!erl_atom_copy(&cp->uval.aval.d, &ep->uval.aval.d)) - { - erl_free_term(cp); - erl_errno = ENOMEM; - return NULL; - } - break; - case ERL_PID: - /* FIXME: First copy the bit pattern, then duplicate the node - name and plug in. Somewhat ugly (also done with port and - ref below). */ - memcpy(&cp->uval.pidval, &ep->uval.pidval, sizeof(Erl_Pid)); - erl_atom_copy(&cp->uval.pidval.node, &ep->uval.pidval.node); - ERL_COUNT(cp) = 1; - break; - case ERL_PORT: - memcpy(&cp->uval.portval, &ep->uval.portval, sizeof(Erl_Port)); - erl_atom_copy(&cp->uval.portval.node, &ep->uval.portval.node); - ERL_COUNT(cp) = 1; - break; - case ERL_REF: - memcpy(&cp->uval.refval, &ep->uval.refval, sizeof(Erl_Ref)); - erl_atom_copy(&cp->uval.refval.node, &ep->uval.refval.node); - ERL_COUNT(cp) = 1; - break; - case ERL_LIST: - HEAD(cp) = erl_copy_term(HEAD(ep)); - TAIL(cp) = erl_copy_term(TAIL(ep)); - break; - case ERL_EMPTY_LIST: - break; - case ERL_TUPLE: - i = ERL_TUPLE_SIZE(cp) = ERL_TUPLE_SIZE(ep); - ERL_TUPLE_ELEMS(cp) = (ETERM**) erl_malloc(i * sizeof(ETERM*)); - for(i=0; i < ERL_TUPLE_SIZE(ep); i++) - ERL_TUPLE_ELEMENT(cp,i) = erl_copy_term(ERL_TUPLE_ELEMENT(ep, i)); - break; - case ERL_BINARY: - ERL_BIN_SIZE(cp) = ERL_BIN_SIZE(ep); - ERL_BIN_PTR(cp) = (unsigned char *) erl_malloc(ERL_BIN_SIZE(ep)); - memcpy(ERL_BIN_PTR(cp), ERL_BIN_PTR(ep), ERL_BIN_SIZE(ep)); - break; - case ERL_FUNCTION: - i = ERL_CLOSURE_SIZE(cp) = ERL_CLOSURE_SIZE(ep); - ERL_FUN_ARITY(cp) = ERL_FUN_ARITY(ep); - ERL_FUN_NEW_INDEX(cp) = ERL_FUN_NEW_INDEX(ep); - ERL_FUN_INDEX(cp) = erl_copy_term(ERL_FUN_INDEX(ep)); - ERL_FUN_UNIQ(cp) = erl_copy_term(ERL_FUN_UNIQ(ep)); - ERL_FUN_CREATOR(cp) = erl_copy_term(ERL_FUN_CREATOR(ep)); - ERL_FUN_MODULE(cp) = erl_copy_term(ERL_FUN_MODULE(ep)); - memcpy(ERL_FUN_MD5(cp), ERL_FUN_MD5(ep), sizeof(ERL_FUN_MD5(ep))); - ERL_CLOSURE(cp) = (ETERM**) erl_malloc(i * sizeof(ETERM*)); - for(i=0; i < ERL_CLOSURE_SIZE(ep); i++) - ERL_CLOSURE_ELEMENT(cp,i) = - erl_copy_term(ERL_CLOSURE_ELEMENT(ep, i)); - break; - default: - erl_err_msg("<ERROR> erl_copy_term: wrong type encountered !"); - erl_free_term(cp); - return (ETERM *) NULL; - } - - return cp; -} - -#ifndef SILENT - -static int print_string(FILE* fp, const ETERM* ep); -static int is_printable_list(const ETERM* term); - -/* - * PRINT out an ETERM. - */ - -int erl_print_term(FILE *fp, const ETERM *ep) -{ - int j,i,doquote; - int ch_written = 0; /* counter of written chars */ - - if ((!fp) || (!ep)) return 0; - /* ASSERT(ep != NULL); */ - - j = i = doquote = 0; - switch(ERL_TYPE(ep)) - { - case ERL_ATOM: { - char* adata = ERL_ATOM_PTR(ep); - /* FIXME: what if some weird locale is in use? */ - if (!islower(adata[0])) - doquote = 1; - - for (i = 0; !doquote && i < ERL_ATOM_SIZE(ep); i++) - { - doquote = !(isalnum(adata[i]) || (adata[i] == '_')); - } - - if (doquote) { - putc('\'', fp); - ch_written++; - } - fputs(adata, fp); - ch_written += ERL_ATOM_SIZE(ep); - if (doquote) { - putc('\'', fp); - ch_written++; - } - break; - } - case ERL_VARIABLE: - if (!isupper((int)ERL_VAR_NAME(ep)[0])) { - doquote = 1; - putc('\'', fp); - ch_written++; - } - - fputs(ERL_VAR_NAME(ep), fp); - ch_written += ERL_VAR_LEN(ep); - - if (doquote) { - putc('\'', fp); - ch_written++; - } - break; - - case ERL_PID: - ch_written += fprintf(fp, "<%s.%d.%d>", - ERL_PID_NODE(ep), - ERL_PID_NUMBER(ep), ERL_PID_SERIAL(ep)); - break; - case ERL_PORT: - ch_written += fprintf(fp, "#Port"); - break; - case ERL_REF: - ch_written += fprintf(fp, "#Ref"); - break; - case ERL_EMPTY_LIST: - ch_written += fprintf(fp, "[]"); - break; - case ERL_LIST: - if (is_printable_list(ep)) { - ch_written += print_string(fp, ep); - } else { - putc('[', fp); - ch_written++; - while (ERL_IS_CONS(ep)) { - ch_written += erl_print_term(fp, HEAD(ep)); - ep = TAIL(ep); - if (ERL_IS_CONS(ep)) { - putc(',', fp); - ch_written++; - } - } - if (!ERL_IS_EMPTY_LIST(ep)) { - putc('|', fp); - ch_written++; - ch_written += erl_print_term(fp, ep); - } - putc(']', fp); - ch_written++; - } - break; - case ERL_TUPLE: - putc('{', fp); - ch_written++; - for (i=0; i < ERL_TUPLE_SIZE(ep); i++) { - ch_written += erl_print_term(fp, ERL_TUPLE_ELEMENT(ep, j++) ); - if (i != ERL_TUPLE_SIZE(ep)-1) { - putc(',', fp); - ch_written++; - } - } - putc('}', fp); - ch_written++; - break; - case ERL_BINARY: { - int sz = (ERL_BIN_SIZE(ep) > 20) ? 20 : ERL_BIN_SIZE(ep); - unsigned char *ptr = ERL_BIN_PTR(ep); - ch_written += fprintf(fp, "#Bin<"); - for (i = 0; i < sz; i++) { - putc(ptr[i], fp); ch_written++; - } - if (sz == 20) ch_written += fprintf(fp, "(%d)....>", ERL_BIN_SIZE(ep)-20); - else ch_written += fprintf(fp, ">"); - break; - } - case ERL_INTEGER: - case ERL_SMALL_BIG: - ch_written += fprintf(fp, "%d", ERL_INT_VALUE(ep)); - break; - case ERL_U_INTEGER: - case ERL_U_SMALL_BIG: - ch_written += fprintf(fp, "%d", ERL_INT_UVALUE(ep)); - break; - case ERL_LONGLONG: - case ERL_U_LONGLONG: - ch_written += fprintf(fp, "%lld", ERL_LL_UVALUE(ep)); - break; - case ERL_FLOAT: - ch_written += fprintf(fp, "%f", ERL_FLOAT_VALUE(ep)); - break; - case ERL_FUNCTION: - ch_written += fprintf(fp, "#Fun<"); - ch_written += erl_print_term(fp, ERL_FUN_MODULE(ep)); - putc('.', fp); - ch_written++; - ch_written += erl_print_term(fp, ERL_FUN_INDEX(ep)); - putc('.', fp); - ch_written++; - ch_written += erl_print_term(fp, ERL_FUN_UNIQ(ep)); - putc('>', fp); - ch_written++; - break; - default: - ch_written = -10000; - erl_err_msg("<ERROR> erl_print_term: Bad type of term !"); - } - return ch_written; -} - -/* - * FIXME not done yet.... - */ - -#if 0 - -int erl_sprint_term(char *buf, const ETERM *ep) -{ - int j,i,doquote; - int ch_written = 0; /* counter of written chars */ - - if ((!buf) || (!ep)) return 0; - /* ASSERT(ep != NULL); */ - - j = i = doquote = 0; - switch(ERL_TYPE(ep)) - { - case ERL_ATOM: - /* FIXME: what if some weird locale is in use? */ - if (!islower((int)ERL_ATOM_PTR(ep)[0])) - doquote = 1; - - for (i = 0; !doquote && i < ERL_ATOM_SIZE(ep); i++) - { - doquote = !(isalnum((int)ERL_ATOM_PTR(ep)[i]) - || (ERL_ATOM_PTR(ep)[i] == '_')); - } - - if (doquote) { - *buf++ = '\''; - ch_written++; - } - { - int len = ERL_ATOM_SIZE(ep); - strncpy(buf, ERL_ATOM_PTR(ep), len); - buf += len; - ch_written += len; - } - if (doquote) { - *buf++ = '\''; - ch_written++; - } - break; - - case ERL_VARIABLE: - if (!isupper((int)ERL_VAR_NAME(ep)[0])) { - doquote = 1; - *buf++ = '\''; - ch_written++; - } - len = ERL_VAR_LEN(ep); - strncpy(buf, ERL_VAR_NAME(ep), len); - buf += len; - ch_written += len; - - if (doquote) { - *buf++ = '\''; - ch_written++; - } - break; - - case ERL_PID: - len = sprintf(buf, "<%s.%d.%d>", - ERL_PID_NODE(ep), - ERL_PID_NUMBER(ep), ERL_PID_SERIAL(ep)); - buf += len; - ch_written += len; - break; - case ERL_PORT: - len = sprintf(buf , "#Port"); - buf += len; - ch_written += len; - break; - case ERL_REF: - len = sprintf(buf , "#Ref"); - buf += len; - ch_written += len; - break; - case ERL_EMPTY_LIST: - len = sprintf(buf , "[]"); - buf += len; - ch_written += len; - break; - case ERL_LIST: - if (is_printable_list(ep)) { - ch_written += print_string(fp, ep); - } else { - putc('[', fp); - ch_written++; - while (ERL_IS_CONS(ep)) { - ch_written += erl_sprint_term(fp, HEAD(ep)); - ep = TAIL(ep); - if (ERL_IS_CONS(ep)) { - putc(',', fp); - ch_written++; - } - } - if (!ERL_IS_EMPTY_LIST(ep)) { - putc('|', fp); - ch_written++; - ch_written += erl_sprint_term(fp, ep); - } - putc(']', fp); - ch_written++; - } - break; - case ERL_TUPLE: - putc('{', fp); - ch_written++; - for (i=0; i < ERL_TUPLE_SIZE(ep); i++) { - ch_written += erl_sprint_term(fp, ERL_TUPLE_ELEMENT(ep, j++) ); - if (i != ERL_TUPLE_SIZE(ep)-1) { - putc(',', fp); - ch_written++; - } - } - putc('}', fp); - ch_written++; - break; - case ERL_BINARY: - len = sprintf(buf , "#Bin"); - buf += len; - ch_written += len; - break; - case ERL_INTEGER: - case ERL_SMALL_BIG: - len = sprintf(buf , "%d", ERL_INT_VALUE(ep)); - buf += len; - ch_written += len; - break; - case ERL_U_INTEGER: - case ERL_U_SMALL_BIG: - len = sprintf(buf , "%d", ERL_INT_UVALUE(ep)); - buf += len; - ch_written += len; - break; - case ERL_FLOAT: - len = sprintf(buf , "%f", ERL_FLOAT_VALUE(ep)); - buf += len; - ch_written += len; - break; - case ERL_FUNCTION: - len = sprintf(buf , "#Fun<"); - buf += len; - ch_written += len; - ch_written += erl_sprint_term(fp, ERL_FUN_MODULE(ep)); - putc('.', fp); - ch_written++; - ch_written += erl_sprint_term(fp, ERL_FUN_INDEX(ep)); - putc('.', fp); - ch_written++; - ch_written += erl_sprint_term(fp, ERL_FUN_UNIQ(ep)); - putc('>', fp); - ch_written++; - break; - default: - ch_written = -10000; - erl_err_msg("<ERROR> erl_sprint_term: Bad type of term !"); - } - return ch_written; -} -#endif - -static int print_string(FILE* fp, const ETERM* ep) -{ - int ch_written = 0; /* counter of written chars */ - - putc('"', fp); - ch_written++; - while (ERL_IS_CONS(ep)) { - int c = ERL_INT_VALUE(HEAD(ep)); - - if (c >= ' ') { - putc(c, fp); - ch_written++; - } - else { - switch (c) { - case '\n': fputs("\\n", fp); ch_written += 2; break; - case '\r': fputs("\\r", fp); ch_written += 2; break; - case '\t': fputs("\\t", fp); ch_written += 2; break; - case '\v': fputs("\\v", fp); ch_written += 2; break; - case '\b': fputs("\\b", fp); ch_written += 2; break; - case '\f': fputs("\\f", fp); ch_written += 2; break; - break; - default: - ch_written += fprintf(fp, "\\%o", c); - break; - } - } - ep = TAIL(ep); - } - putc('"', fp); - ch_written++; - return ch_written; -} - -/* - * Returns 1 if term is a list of printable character, otherwise 0. - */ - -static int is_printable_list(const ETERM* term) -{ - while (ERL_TYPE(term) == ERL_LIST) { - ETERM* head = HEAD(term); - - if (!ERL_IS_BYTE(head)) { - return 0; - } - if (ERL_INT_VALUE(head) < ' ') { - switch (ERL_INT_VALUE(head)) { - case '\n': - case '\r': - case '\t': - case '\v': - case '\b': - case '\f': - break; - default: - return 0; - } - } - term = TAIL(term); - } - - return ERL_IS_EMPTY_LIST(term); -} - -#endif - -/* - * Retrieves the bytes from an I/O list and copy into a buffer. - * - * NOTE! It is the responsibility of the caller to ensure that - * that the buffer is big enough (typically by calling - * erl_iolist_length()), and that the term is an I/O list. - * - * ETERM* term; Term to convert to bytes. - * char** bufp; Pointer to pointer to buffer - * where the bytes should be stored. - * On return, the pointer will point beyond - * the last byte stored. - */ - -static void iolist_to_buf(const ETERM* term, char** bufp) -{ - char* dest = *bufp; - - while (ERL_IS_CONS(term)) { - ETERM* obj = HEAD(term); - - if (ERL_IS_BYTE(obj)) { - *dest++ = ERL_INT_VALUE(obj); - } else if (ERL_IS_CONS(obj)) { - iolist_to_buf(obj, &dest); - } else if (ERL_IS_BINARY(obj)) { - memcpy(dest, ERL_BIN_PTR(obj), ERL_BIN_SIZE(obj)); - dest += ERL_BIN_SIZE(obj); - } else { - /* - * Types have been checked by caller. - */ - if (!ERL_IS_EMPTY_LIST(obj)) return; - /* ASSERT(ERL_IS_EMPTY_LIST(obj)); */ - } - term = TAIL(term); - } - if (ERL_IS_BINARY(term)) { - memcpy(dest, ERL_BIN_PTR(term), ERL_BIN_SIZE(term)); - dest += ERL_BIN_SIZE(term); - } else { - /* - * Types have been checked by caller. - */ - if (!ERL_IS_EMPTY_LIST(term)) return; - /* ASSERT(ERL_IS_EMPTY_LIST(term));*/ - } - *bufp = dest; -} - -static char* strsave(const char *src) -{ - char * dest = malloc(strlen(src)+1); - - if (dest != NULL) - strcpy(dest, src); - return dest; -} - - -/* - * Local Variables: - * compile-command: "cd ..; ERL_TOP=/clearcase/otp/erts make -k" - * End: - */ diff --git a/lib/erl_interface/src/legacy/erl_eterm.h b/lib/erl_interface/src/legacy/erl_eterm.h deleted file mode 100644 index e2f3a90531..0000000000 --- a/lib/erl_interface/src/legacy/erl_eterm.h +++ /dev/null @@ -1,64 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef _ERL_ETERM_H -#define _ERL_ETERM_H - -#ifndef SILENT -#include <stdio.h> -#endif - -#include "portability.h" - -#define ERL_MAX_COUNT 0xffffff -#define ERL_MAX ((1 << 27)-1) -#define ERL_MIN -(1 << 27) - -/* FIXME should this be documented and in erl_interface.h ??? */ -#define ERL_BIG_ARITY(x) ((x)->uval.bigval.arity) -#define ERL_BIG_IS_NEG(x) ((x)->uval.bigval.is_neg) -#define ERL_BIG_DIGITS(x) ((x)->uval.bigval.digits) -#define ERL_BIG_DIGIT(x,i) (ERL_BIG_DIGITS(x)[(i)]) - -/* - * Typing checking macros. - */ - -/* FIXME should this be documented and in erl_interface.h ??? */ -#define ERL_IS_DEFINED(x) (ERL_TYPE(x) != 0) -#define ERL_IS_COMPOUND(x) (ERL_TYPE(x) & ERL_COMPOUND) -#define ERL_IS_FUNCTION(x) (ERL_TYPE(x) == ERL_FUNCTION) -#define ERL_IS_BIG(x) (ERL_TYPE(x) == ERL_BIG) - - -typedef struct _heapmark { - unsigned long mark; /* id */ - int size; /* size of buffer */ - Erl_Heap *base; /* points to start of buffer */ - Erl_Heap *cur; /* points into buffer */ - struct _heapmark *prev; /* previous heapmark */ -} Erl_HeapMark; - - -void erl_mk_port_helper(ETERM* ep, unsigned number, unsigned int creation); -void erl_mk_pid_helper(ETERM*, unsigned,unsigned, unsigned int); -ETERM * __erl_mk_reference(ETERM*, const char *, size_t, unsigned int n[], unsigned int); -int erl_current_fix_desc(void); - -#endif /* _ERL_ETERM_H */ diff --git a/lib/erl_interface/src/legacy/erl_fix_alloc.c b/lib/erl_interface/src/legacy/erl_fix_alloc.c deleted file mode 100644 index 890a9ce291..0000000000 --- a/lib/erl_interface/src/legacy/erl_fix_alloc.c +++ /dev/null @@ -1,198 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Function: General purpose Memory allocator for fixed block - * size objects. This allocater is at least an order of - * magnitude faster than malloc(). - */ -#include "eidef.h" - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include "ei_locking.h" -#include "erl_interface.h" -#include "erl_error.h" -#include "erl_malloc.h" -#include "erl_fix_alloc.h" -#include "erl_eterm.h" - -#define WIPE_CHAR ((char)0xaa) /* 10101010 */ - -/* the freelist is a singly linked list of these */ -/* i.e. the user structure and a link pointer */ -struct fix_block { - ETERM term; - struct fix_block *next; - int free; -}; - -/* this is a struct just to keep namespace pollution low on VxWorks */ -struct eterm_stateinfo { - struct fix_block *freelist; - unsigned long freed; - unsigned long allocated; -#ifdef _REENTRANT - ei_mutex_t *lock; -#endif /* _REENTRANT */ -}; -/* FIXME problem for threaded ? */ -static struct eterm_stateinfo *erl_eterm_state=NULL; - - -int erl_init_eterm_alloc (void) -{ -#if defined(PURIFY) && defined (DEBUG) - fprintf(stderr,"erl_fix_alloc() compiled for Purify - using \"real\" malloc()"); -#endif - - erl_eterm_state = malloc(sizeof(*erl_eterm_state)); - if (erl_eterm_state == NULL) goto err1; - - erl_eterm_state->freelist = NULL; - erl_eterm_state->freed = 0; - erl_eterm_state->allocated = 0; -#ifdef _REENTRANT - erl_eterm_state->lock = ei_mutex_create(); - if (erl_eterm_state->lock == NULL) goto err2; -#endif /* _REENTRANT */ - - return 1; - - /* Error cleanup */ -#ifdef _REENTRANT - err2: - /* FIXME ENOMEM is not what went wrong... */ - free(erl_eterm_state); -#endif /* _REENTRANT */ - err1: - erl_errno = ENOMEM; - return 0; -} - -/* get an eterm, from the freelist if possible or from malloc() */ -void *erl_eterm_alloc (void) -{ -#ifdef PURIFY - ETERM *p; - - if ((p = malloc(sizeof(*p)))) { - memset(p, WIPE_CHAR, sizeof(*p)); - } - return p; -#else - struct fix_block *b; - -#ifdef _REENTRANT - ei_mutex_lock(erl_eterm_state->lock, 0); -#endif /* _REENTRANT */ - - /* try to pop block from head of freelist */ - if ((b = erl_eterm_state->freelist) != NULL) { - erl_eterm_state->freelist = b->next; - erl_eterm_state->freed--; - } else if ((b = malloc(sizeof(*b))) == NULL) { - erl_errno = ENOMEM; -#ifdef _REENTRANT - ei_mutex_unlock(erl_eterm_state->lock); -#endif /* _REENTRANT */ - return NULL; - } - erl_eterm_state->allocated++; - b->free = 0; - b->next = NULL; -#ifdef _REENTRANT - ei_mutex_unlock(erl_eterm_state->lock); -#endif /* _REENTRANT */ - return (void *) &b->term; -#endif /* !PURIFY */ -} - -/* free an eterm back to the freelist */ -void erl_eterm_free(void *p) -{ -#ifdef PURIFY - if (p) { - memset(p, WIPE_CHAR, sizeof(ETERM)); - } - free(p); -#else - struct fix_block *b = p; - - if (b) { - if (b->free) { -#ifdef DEBUG - fprintf(stderr,"erl_eterm_free: attempt to free already freed block %p\n",b); -#endif - return; - } - -#ifdef _REENTRANT - ei_mutex_lock(erl_eterm_state->lock,0); -#endif /* _REENTRANT */ - b->free = 1; - b->next = erl_eterm_state->freelist; - erl_eterm_state->freelist = b; - erl_eterm_state->freed++; - erl_eterm_state->allocated--; -#ifdef _REENTRANT - ei_mutex_unlock(erl_eterm_state->lock); -#endif /* _REENTRANT */ - } -#endif /* !PURIFY */ -} - -/* really free the freelist */ -void erl_eterm_release (void) -{ -#if !defined(PURIFY) - struct fix_block *b; - -#ifdef _REENTRANT - ei_mutex_lock(erl_eterm_state->lock,0); -#endif /* _REENTRANT */ - { - while (erl_eterm_state->freelist != NULL) { - b = erl_eterm_state->freelist; - erl_eterm_state->freelist = b->next; - free(b); - erl_eterm_state->freed--; - } - } -#ifdef _REENTRANT - ei_mutex_unlock(erl_eterm_state->lock); -#endif /* _REENTRANT */ -#endif /* !PURIFY */ -} - -void erl_eterm_statistics (unsigned long *allocd, unsigned long *freed) -{ - if (allocd) *allocd = erl_eterm_state->allocated; - if (freed) *freed = erl_eterm_state->freed; - - return; -} - - -/* - * Local Variables: - * compile-command: "cd ..; ERL_TOP=/clearcase/otp/erts make -k" - * End: - */ diff --git a/lib/erl_interface/src/legacy/erl_fix_alloc.h b/lib/erl_interface/src/legacy/erl_fix_alloc.h deleted file mode 100644 index 50d1368e34..0000000000 --- a/lib/erl_interface/src/legacy/erl_fix_alloc.h +++ /dev/null @@ -1,27 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef _ERL_FIX_ALLOC_H -#define _ERL_FIX_ALLOC_H - -int erl_init_eterm_alloc(void); -void erl_eterm_free(void*); -void *erl_eterm_alloc(void); - -#endif /* _ERL_FIX_ALLOC_H */ diff --git a/lib/erl_interface/src/legacy/erl_format.c b/lib/erl_interface/src/legacy/erl_format.c deleted file mode 100644 index 45f5489e54..0000000000 --- a/lib/erl_interface/src/legacy/erl_format.c +++ /dev/null @@ -1,742 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Function: Provides two primitives: erl_format to build - * Erlang terms in an easy way, and erl_match to perform - * pattern match similar to what is done in Erlang. - * - */ - -#include "eidef.h" - -#include <stdio.h> -#include <stdlib.h> -#include <stdarg.h> -#include <string.h> -#include <ctype.h> - -#ifdef VRTX -#define __READY_EXTENSIONS__ -#include <errno.h> -#endif -#include "erl_interface.h" -#include "erl_eterm.h" -#include "erl_malloc.h" -#include "erl_error.h" -#include "erl_internal.h" - -#define ERL_TRUE 1 -#define ERL_FALSE 0 -#define ERL_OK 0 -#define ERL_FORMAT_ERROR -1 - -#define ERL_MAX_ENTRIES 255 /* Max entries in a tuple/list term */ -#define ERL_MAX_NAME_LENGTH 255 /* Max length of variable names */ - -#define PRINT(t) \ -{ \ - print_term(stderr,t); \ - fprintf(stderr,"\n"); \ - } - - -typedef struct lvar { - ETERM *var; - struct lvar *next; -} lvar; - - -/* Forward */ -static ETERM *eformat(char**, va_list*); -static int ematch(ETERM*, ETERM*); - -/* FIXME not thread safe */ -struct _ef { - lvar *chain; /* Chain of local variables */ - lvar *idle; /* Idle list of lvar's */ -} ef; - -/* Find local variable in term. - */ -static ETERM *find_lvar(char *name) -{ - lvar *tmp=ef.chain; - - while (tmp != NULL) { - if (strcmp(tmp->var->uval.vval.name,name) == 0) - return tmp->var->uval.vval.v; - tmp = tmp->next; - } - return (ETERM *) NULL; - -} /* find_lvar */ - -static void lvar_free(lvar *lv) -{ - lvar *tmp=ef.chain; - - /* Link in the chain into the idle list */ - if (ef.idle == NULL) - ef.idle = lv; - else { - tmp = ef.idle; - while (tmp->next != NULL) - tmp = tmp->next; - tmp->next = lv; - } - - - /* Clear out the variable information */ - tmp = lv; - while (tmp != NULL) { - tmp->var = (ETERM *) NULL; - tmp = tmp->next; - } - -} /* lvar_free */ - -static lvar *lvar_alloc(void) -{ - lvar *tmp; - - if ((tmp = ef.idle) == NULL) { - tmp = (lvar *) erl_malloc(sizeof(lvar)); - } - else { - tmp = ef.idle; - ef.idle = tmp->next; - } - return tmp; - -} /* lvar_alloc */ - -static void undo_bindings(void) -{ - lvar *tmp=ef.chain; - - while (tmp != NULL) { - erl_free_term(tmp->var->uval.vval.v); - tmp->var->uval.vval.v = (ETERM *) NULL; - tmp = tmp->next; - } - -} /* undo_bindings */ - -static void release_chain(void) -{ - - lvar_free(ef.chain); - ef.chain = (lvar *) NULL; - -} /* release_chain */ - -static void add_lvar(ETERM *t) -{ - lvar *lv; - - lv = lvar_alloc(); - lv->var = t; - lv->next = ef.chain; - ef.chain = lv; - -} /* add_lvar */ - -static char *pvariable(char **fmt, char *buf) -{ - char *start=*fmt; - char c; - int len; - - while (1) { - c = *(*fmt)++; - if (isalnum((int) c) || (c == '_')) - continue; - else - break; - } - (*fmt)--; - len = *fmt - start; - memcpy(buf, start, len); - buf[len] = 0; - - return buf; - -} /* pvariable */ - -static char *patom(char **fmt, char *buf) -{ - char *start=*fmt; - char c; - int len; - - while (1) { - c = *(*fmt)++; - if (isalnum((int) c) || (c == '_') || (c == '@')) - continue; - else - break; - } - (*fmt)--; - len = *fmt - start; - memcpy(buf, start, len); - buf[len] = 0; - - return buf; - -} /* patom */ - -/* Check if integer or float - */ -static char *pdigit(char **fmt, char *buf) -{ - char *start=*fmt; - char c; - int len,dotp=0; - - while (1) { - c = *(*fmt)++; - if (isdigit((int) c)) - continue; - else if (!dotp && (c == '.')) { - dotp = 1; - continue; - } - else - break; - } - (*fmt)--; - len = *fmt - start; - memcpy(buf, start, len); - buf[len] = 0; - - return buf; - -} /* pdigit */ - -static char *pstring(char **fmt, char *buf) -{ - char *start=++(*fmt); /* skip first quote */ - char c; - int len; - - while (1) { - c = *(*fmt)++; - if (c == '"') { - if (*((*fmt)-1) == '\\') - continue; - else - break; - } else - continue; - } - len = *fmt - 1 - start; /* skip last quote */ - memcpy(buf, start, len); - buf[len] = 0; - - return buf; - -} /* pstring */ - -static char *pquotedatom(char **fmt, char *buf) -{ - char *start=++(*fmt); /* skip first quote */ - char c; - int len; - - while (1) { - c = *(*fmt)++; - if (c == '\'') { - if (*((*fmt)-1) == '\\') - continue; - else - break; - } else - continue; - } - len = *fmt - 1 - start; /* skip last quote */ - memcpy(buf, start, len); - buf[len] = 0; - - return buf; - -} /* pquotedatom */ - - -/* - * The format letters are: - * w - Any Erlang term - * a - An Atom - * b - A Binary - * s - A String - * i - An Integer - * f - A Float (double) - */ -static int pformat(char **fmt, va_list *pap, ETERM *v[], int size) -{ - int rc=ERL_OK; - - /* this next section hacked to remove the va_arg calls */ - switch (*(*fmt)++) { - - case 'w': - v[size] = va_arg(*pap, ETERM*); - ERL_COUNT(v[size])++; - break; - - case 'a': - v[size] = erl_mk_atom(va_arg(*pap, char *)); - break; - - case 's': - v[size] = erl_mk_string(va_arg(*pap, char *)); - break; - - case 'i': - v[size] = erl_mk_int(va_arg(*pap, int)); - break; - - case 'f': - v[size] = erl_mk_float(va_arg(*pap, double)); - break; - - case 'b': { - char *sarg = va_arg(*pap, char *); - v[size] = erl_mk_binary(sarg, strlen(sarg)); - break; - } - - default: - rc = ERL_FORMAT_ERROR; - break; - } - - return rc; - -} /* pformat */ - -static int ptuple(char **fmt, va_list *pap, ETERM *v[], int size) -{ - int res=ERL_FORMAT_ERROR; - - switch (*(*fmt)++) { - - case '}': - res = size; - break; - - case ',': - res = ptuple(fmt, pap, v, size); - break; - - case '~': - - if (pformat(fmt, pap, v, size) == ERL_OK) - res = ptuple(fmt, pap, v, ++size); - else - erl_err_msg("ptuple(1): Wrong format sequence !"); - break; - - case ' ': - return ptuple(fmt, pap, v, size); - break; - - default: { - (*fmt)--; - if ((v[size++] = eformat(fmt, pap)) != (ETERM *) NULL) - res = ptuple(fmt, pap, v, size); - break; - - /* - if (isupper(**fmt)) { - v[size++] = erl_mk_var(pvariable(fmt, wbuf)); - res = ptuple(fmt, pap, v, size); - } - else if ((v[size++] = eformat(fmt, pap)) != (ETERM *) NULL) - res = ptuple(fmt, pap, v, size); - break; - */ - } - - } /* switch */ - - return res; - -} /* ptuple */ - - -static int plist(char **fmt, va_list *pap, ETERM *v[], int size) -{ - int res=ERL_FORMAT_ERROR; - - switch (*(*fmt)++) { - - case ']': - res = size; - break; - - case ',': - res = plist(fmt, pap, v, size); - break; - - case '~': - - if (pformat(fmt, pap, v, size) == ERL_OK) - res = plist(fmt, pap, v, ++size); - else - erl_err_msg("plist(1): Wrong format sequence !"); - break; - - case ' ': - return plist(fmt, pap, v, size); - break; - - default: { - (*fmt)--; - if ((v[size++] = eformat(fmt, pap)) != (ETERM *) NULL) - res = plist(fmt, pap, v, size); - break; - - /* - if (isupper(**fmt)) { - v[size++] = erl_mk_var(pvariable(fmt, wbuf)); - res = plist(fmt, pap, v, size); - } - else if ((v[size++] = eformat(fmt, pap)) != (ETERM *) NULL) - res = plist(fmt, pap, v, size); - break; - */ - } - - } /* switch */ - - return res; - -} /* plist */ - - -static ETERM *eformat(char **fmt, va_list *pap) -{ - int size; - ETERM *v[ERL_MAX_ENTRIES],*ep; - - switch (*(*fmt)++) { - case '{': - if ((size = ptuple(fmt, pap , v, 0)) != ERL_FORMAT_ERROR) { - ep = erl_mk_tuple(v, size); - erl_free_array(v, size); - return ep; - } - else - return (ETERM *) NULL; - break; - - case '[': - if (**fmt == ']') { - (*fmt)++; - return erl_mk_empty_list(); - } else if ((size = plist(fmt, pap , v, 0)) != ERL_FORMAT_ERROR) { - ep = erl_mk_list(v, size); - erl_free_array(v, size); - return ep; - } else - return (ETERM *) NULL; - break; - - case '$': /* char-value? */ - return erl_mk_int((int)(*(*fmt)++)); - break; - - case '~': - if (pformat(fmt, pap, v, 0) == ERL_OK) { - ep = erl_copy_term(v[0]); - erl_free_term(v[0]); - return ep; - } - break; - - case ' ': - return eformat(fmt, pap); - break; - - /* handle negative numbers too... - * case '-': - * { - * ETERM *tmp; - * - * tmp = eformat(fmt,pap); - * if (ERL_IS_INTEGER(tmp)) ERL_INT_VALUE(tmp) = -(ERL_INT_VALUE(tmp)); - * return tmp; - * } - * - * - * break; - */ - - default: - { - char wbuf[BUFSIZ]; /* now local to this function for reentrancy */ - - (*fmt)--; - if (islower((int)**fmt)) { /* atom ? */ - char *atom=patom(fmt, wbuf); - return erl_mk_atom(atom); - } - else if (isupper((int)**fmt) || (**fmt == '_')) { - char *var=pvariable(fmt, wbuf); - return erl_mk_var(var); - } - else if (isdigit((int)**fmt)) { /* integer/float ? */ - char *digit=pdigit(fmt, wbuf); - if (strchr(digit,(int) '.') == NULL) - return erl_mk_int(atoi((const char *) digit)); - else - return erl_mk_float(atof((const char *) digit)); - } - else if (**fmt == '"') { /* string ? */ - char *string=pstring(fmt, wbuf); - return erl_mk_string(string); - } - else if (**fmt == '\'') { /* quoted atom ? */ - char *qatom=pquotedatom(fmt, wbuf); - return erl_mk_atom(qatom); - } - } - break; - - } - - erl_err_msg("<ERROR> Syntax error in eformat, char was: %c !", **fmt); - return (ETERM *) NULL; - -} /* eformat */ - - -ETERM *erl_format(char *fmt, ... ) -{ - ETERM *res=NULL; - va_list ap; - - va_start(ap, fmt); - res = eformat(&fmt, &ap); - va_end(ap); - - return res; -} /* erl_format */ - - -/* - * Perform a pattern match between a pattern p and a term t. - * As a side effect bind any unbound variables in p. - * Return true or false. - */ -static int ematch(ETERM *p, ETERM *t) -{ - unsigned int type_p; - unsigned int type_t; - ETERM *tmp; - - /* two NULLs are equal, one is not... */ - if (!p && !t) return ERL_TRUE; - if (!p || !t) return ERL_FALSE; - /* - * ASSERT(p != NULL); - * ASSERT(t != NULL); - */ - - type_p = ERL_TYPE(p); - type_t = ERL_TYPE(t); - - if (type_t == ERL_VARIABLE) { - if (t->uval.vval.v == NULL) - return ERL_FALSE; /* Can't have an unbound variable here ! */ - else - t = t->uval.vval.v; - } - - if (type_p != ERL_VARIABLE && type_p != type_t) - return ERL_FALSE; - - switch (type_p) { - - case ERL_ATOM: { - Erl_Atom_data* pa = &p->uval.aval.d; - Erl_Atom_data* ta = &t->uval.aval.d; - if (pa->utf8 && ta->utf8) { - return pa->lenU == ta->lenU && memcmp(pa->utf8, ta->utf8, pa->lenU)==0; - } - else if (pa->latin1 && ta->latin1) { - return pa->lenL == ta->lenL && memcmp(pa->latin1, ta->latin1, pa->lenL)==0; - } - else if (pa->latin1) { - return cmp_latin1_vs_utf8(pa->latin1, pa->lenL, ta->utf8, ta->lenU)==0; - } - else { - return cmp_latin1_vs_utf8(ta->latin1, ta->lenL, pa->utf8, pa->lenU)==0; - } - } - case ERL_VARIABLE: - if (strcmp(p->uval.vval.name, "_") == 0) /* anon. variable */ - return ERL_TRUE; - else if ((tmp = find_lvar(p->uval.vval.name)) != (ETERM *) NULL) { - /* v points to NULL in cases like erl_format("{X,X}") for the - second variable */ - if (p->uval.vval.v == NULL) - p->uval.vval.v = erl_copy_term(tmp); - return ematch(p->uval.vval.v, t); - } - else { - /* check if the variable is bound already */ - if (p->uval.vval.v != NULL) { - if (ematch(p->uval.vval.v, t) == ERL_TRUE ){ - add_lvar(p); - return ERL_TRUE; - } - else - return ERL_FALSE; - } - else { - p->uval.vval.v = erl_copy_term(t); - add_lvar(p); - return ERL_TRUE; - } - } - break; - - case ERL_PID: - if ((strcmp(ERL_PID_NODE(p), ERL_PID_NODE(t)) == 0) && - (ERL_PID_NUMBER(p) == ERL_PID_NUMBER(t)) && - (ERL_PID_SERIAL(p) == ERL_PID_SERIAL(t)) && - (ERL_PID_CREATION(p) == ERL_PID_CREATION(t))) - return ERL_TRUE; - else - return ERL_FALSE; - break; - - case ERL_PORT: - if ((strcmp(ERL_PORT_NODE(p), ERL_PORT_NODE(t)) == 0) && - (ERL_PORT_NUMBER(p) == ERL_PORT_NUMBER(t)) && - (ERL_PORT_CREATION(p) == ERL_PORT_CREATION(t))) - return ERL_TRUE; - else - return ERL_FALSE; - break; - - case ERL_REF: { - int i, len; - - if (strcmp(ERL_REF_NODE(p), ERL_REF_NODE(t)) != 0 || - ERL_REF_CREATION(p) != ERL_REF_CREATION(t)) - return ERL_FALSE; - - /* FIXME: {len=1, n={42}} and {len=3, n={42, 17, 13}} tests equal. */ - len = ERL_REF_LEN(p); - if (len > ERL_REF_LEN(t)) - len = ERL_REF_LEN(t); - - for (i = 0; i < len; i++) - if (ERL_REF_NUMBERS(p)[i] != ERL_REF_NUMBERS(t)[i]) - return ERL_FALSE; - - return ERL_TRUE; - break; - } - - case ERL_EMPTY_LIST: - return ERL_TRUE; - - case ERL_LIST: - while (ERL_IS_CONS(p) && ERL_IS_CONS(t)) { - if (ematch(p->uval.lval.head, t->uval.lval.head) == ERL_FALSE) - return ERL_FALSE; - p = p->uval.lval.tail; - t = t ->uval.lval.tail; - } - return ematch(p, t); - - case ERL_TUPLE: - { - int i; - if (erl_size(p) != erl_size(t)) - return ERL_FALSE; - else { - for(i=0; i<erl_size(p); i++) - if (ematch(p->uval.tval.elems[i],t->uval.tval.elems[i]) == ERL_FALSE) - return ERL_FALSE; - return ERL_TRUE; - } - } - break; - - case ERL_BINARY: - { - int i; - if ((i = p->uval.bval.size) != t->uval.bval.size) - return ERL_FALSE; - else - return (memcmp(p->uval.bval.b,t->uval.bval.b,i)==0) ? ERL_TRUE : ERL_FALSE; - } - break; - - case ERL_INTEGER: - return (p->uval.ival.i == t->uval.ival.i) ? ERL_TRUE : ERL_FALSE; - break; - - case ERL_SMALL_BIG: - case ERL_U_SMALL_BIG: - /* This case can't happend since it is impossible - * to create a bignum from the C code. - */ - return ERL_FALSE; - break; - - case ERL_FLOAT: -#if defined(VXWORKS) && CPU == PPC860 - { - return (erl_fp_compare((unsigned *)&(p->uval.fval.f), - (unsigned *)&(t->uval.fval.f)) == 0) - ? ERL_TRUE : ERL_FALSE; - } -#else - return (p->uval.fval.f == t->uval.fval.f) ? ERL_TRUE : ERL_FALSE; -#endif - break; - default: - return ERL_FALSE; - break; - } - - /* erl_err_msg("ematch: Unknown type == %c\n", type_p); */ - return ERL_FALSE; - -} /* ematch */ - - -int erl_match(ETERM *p, ETERM *t) -{ - int i; - - if ((i = ematch(p, t)) == ERL_FALSE) - undo_bindings(); - release_chain(); - return i; - -} /* erl_match */ - - diff --git a/lib/erl_interface/src/legacy/erl_format.h b/lib/erl_interface/src/legacy/erl_format.h deleted file mode 100644 index 92fa068206..0000000000 --- a/lib/erl_interface/src/legacy/erl_format.h +++ /dev/null @@ -1,23 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef _ERL_FORMAT_H -#define _ERL_FORMAT_H - -#endif /* _ERL_FORMAT_H */ diff --git a/lib/erl_interface/src/legacy/erl_internal.h b/lib/erl_interface/src/legacy/erl_internal.h deleted file mode 100644 index 25cf3e4f42..0000000000 --- a/lib/erl_interface/src/legacy/erl_internal.h +++ /dev/null @@ -1,48 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef _ERL_INTERNAL_H -#define _ERL_INTERNAL_H - -/* - * Function: Some useful stuff not to be exported to users. - */ - -#define HEAD(ep) ep->uval.lval.head -#define TAIL(ep) ep->uval.lval.tail -#define ERL_NO_REF(x) (ERL_COUNT(x) == 0) - -#ifdef DEBUG -#define ASSERT(e) \ - if (e) { \ - ; \ - } else { \ - erl_assert_error(#e, __FILE__, __LINE__); \ - } - -extern void erl_assert_error(char* expr, char* file, int line) - __attribute__ ((__noreturn__)); - -#else - -#define ASSERT(e) - -#endif - -#endif /* _ERL_INTERNAL_H */ diff --git a/lib/erl_interface/src/legacy/erl_malloc.c b/lib/erl_interface/src/legacy/erl_malloc.c deleted file mode 100644 index 27ef8c4b32..0000000000 --- a/lib/erl_interface/src/legacy/erl_malloc.c +++ /dev/null @@ -1,252 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#include "eidef.h" - -#include <stddef.h> -#include <stdlib.h> - -#include "erl_interface.h" -#include "erl_fix_alloc.h" -#include "erl_malloc.h" -#include "erl_internal.h" -#include "erl_eterm.h" -#include "ei_malloc.h" - -void erl_init_malloc(Erl_Heap *hp, long heap_size) -{ - erl_init_eterm_alloc(); -} /* erl_init_malloc */ - -ETERM *erl_alloc_eterm(unsigned char type) -{ - ETERM *e; - - /* Use fix size allocator */ - if (!(e = (ETERM *) erl_eterm_alloc())) - erl_err_sys("<ERROR> erl_alloc_eterm: Failed to allocate more memory\n"); - - ERL_HEADER(e)->count = 0; - ERL_HEADER(e)->type = type; - return e; - -} /* erl_alloc_eterm */ - -#define EXTERNAL 1 -#define INTERNAL 0 -#define COMPOUND 1 -#define NOT_COMPOUND 0 - -static void _erl_free_term (ETERM *ep, int external, int compound); - -/* - * Free a term, but don't deallocate it until - * the reference counter triggers. - */ -void erl_free_term(ETERM *ep) -{ - _erl_free_term(ep, EXTERNAL, NOT_COMPOUND); -} /* erl_free_term */ - -/* - * Free a term regardless of its reference - * counter value. Use this when you have - * built compound terms such as lists or tuples. - */ - -/* - * FIXME is this true?! - * Tearing down term structures no-matter-what is a horrible idea if - * any term happens to be shared (with some other structure or even - * with yourself). - */ - -void erl_free_compound (ETERM *ep) -{ - _erl_free_term(ep, EXTERNAL, COMPOUND); -} /* erl_free_compound */ - - -/* -** The actual free'ing is done here in _erl_free_term. -** It is by nature recursive, but does not recurse -** on the CDR of a list, which makes it usable for large lists. -*/ - -/* -** Convenience macro, called for variables and lists, -** avoids deep recursions. -*/ -#define RESTART(Eterm, External, Compound) \ -do { \ - ETERM *sep; \ - sep = (Eterm); \ - external = (External); \ - compound = (Compound); \ - /* Clear header info */ \ - ERL_TYPE(ep) = ERL_UNDEF; \ - erl_eterm_free((unsigned int *) ep); \ - ep = sep; \ - goto restart; \ -} while(0) - -#define FREE_AND_CLEAR(ptr) \ -do { \ - erl_free(ptr); \ - (ptr) = NULL; \ -} while (0) - -static void erl_atom_free(Erl_Atom_data* p) -{ - erl_free(p->latin1); - if (p->utf8 != p->latin1) { - erl_free(p->utf8); - } - p->latin1 = NULL; - p->utf8 = NULL; - p->lenL = 0; - p->lenU = 0; -} - -static void _erl_free_term (ETERM *ep, int external, int compound) -{ -restart: - if (ep == NULL) - return; - if (compound || ERL_NO_REF(ep)) { - /* Yes, it's time to *really* free this one ! */ - switch(ERL_TYPE(ep)) - { - case ERL_ATOM: - erl_atom_free(&ep->uval.aval.d); - break; - case ERL_VARIABLE: - FREE_AND_CLEAR(ERL_VAR_NAME(ep)); - /* Note: It may be unbound ! */ - if (ERL_VAR_VALUE(ep) != NULL) { - ERL_COUNT(ERL_VAR_VALUE(ep))--; - /* Cleanup and Restart with the actual value */ - RESTART(ERL_VAR_VALUE(ep), INTERNAL, compound); - } - break; - case ERL_LIST: - if (HEAD(ep)) { - ERL_COUNT(HEAD(ep))--; - /* FIXME added cast, is this correct? */ - _erl_free_term((ETERM *)HEAD(ep), INTERNAL, compound); - } - if (TAIL(ep)) { - ERL_COUNT(TAIL(ep))--; - /* Clean up and walk on to CDR in list */ - RESTART(TAIL(ep), INTERNAL, compound); - } - break; - case ERL_TUPLE: - { - int i; - for (i=0; i < ERL_TUPLE_SIZE(ep); i++) - if (ERL_TUPLE_ELEMENT(ep, i)) { - ERL_COUNT(ERL_TUPLE_ELEMENT(ep, i))--; - _erl_free_term(ERL_TUPLE_ELEMENT(ep, i), - INTERNAL, compound); - } - FREE_AND_CLEAR(ERL_TUPLE_ELEMS(ep)); - } - break; - case ERL_BINARY: - FREE_AND_CLEAR(ERL_BIN_PTR(ep)); - break; - case ERL_PID: - erl_atom_free(&ep->uval.pidval.node); - break; - case ERL_PORT: - erl_atom_free(&ep->uval.portval.node); - break; - case ERL_REF: - erl_atom_free(&ep->uval.refval.node); - break; - case ERL_EMPTY_LIST: - case ERL_INTEGER: - case ERL_SMALL_BIG: - case ERL_U_SMALL_BIG: - case ERL_FLOAT: - break; - case ERL_FUNCTION: - { - int i; - - _erl_free_term(ERL_FUN_INDEX(ep), INTERNAL, compound); - _erl_free_term(ERL_FUN_UNIQ(ep), INTERNAL, compound); - _erl_free_term(ERL_FUN_CREATOR(ep), INTERNAL, compound); - _erl_free_term(ERL_FUN_MODULE(ep), INTERNAL, compound); - if (ERL_CLOSURE(ep) != NULL) { - for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) - _erl_free_term(ERL_CLOSURE_ELEMENT(ep,i), - INTERNAL, compound); - } - } - break; - } /* switch */ - - /* Clear header info for those cases where we are done */ - ERL_TYPE(ep) = ERL_UNDEF; - erl_eterm_free(ep); - } else if (external) { - ERL_COUNT(ep)--; - external = INTERNAL; - goto restart; - } -} /* _erl_free_term */ -#undef RESTART -#undef FREE_AND_CLEAR - -void erl_free_array(ETERM **arr, int size) -{ - int i; - - for (i=0; i<size; i++) - erl_free_term(arr[i]); - -} /* erl_free_array */ - - -void* erl_malloc (long size) -{ - void *res; - - if ((res = ei_malloc(size)) == NULL) - erl_err_sys("<ERROR> erl_malloc: Failed to allocate more memory"); - - return res; -} - -void* erl_realloc(void* orig, long size) -{ - void *res; - - if ((res = ei_realloc(orig, size)) == NULL) - erl_err_sys("<ERROR> erl_realloc: Failed to allocate more memory"); - return res; -} - -void erl_free (void *ptr) -{ - ei_free(ptr); -} diff --git a/lib/erl_interface/src/legacy/erl_malloc.h b/lib/erl_interface/src/legacy/erl_malloc.h deleted file mode 100644 index 6cbc01faba..0000000000 --- a/lib/erl_interface/src/legacy/erl_malloc.h +++ /dev/null @@ -1,27 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef _ERL_MALLOC_H -#define _ERL_MALLOC_H - -/* FIXME: not documented */ -void *erl_realloc(void*, long); -int erl_current_fix_desc(void); - -#endif /* _ERL_MALLOC_H */ diff --git a/lib/erl_interface/src/legacy/erl_marshal.c b/lib/erl_interface/src/legacy/erl_marshal.c deleted file mode 100644 index 932bba43bf..0000000000 --- a/lib/erl_interface/src/legacy/erl_marshal.c +++ /dev/null @@ -1,2267 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2018. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* - * Purpose: Decoding and encoding Erlang terms. - */ -#include "eidef.h" - -#include <stdio.h> -#include <stdlib.h> -#include <ctype.h> -#include <sys/types.h> -#include <string.h> -#include <limits.h> - -#include "erl_interface.h" -#include "erl_marshal.h" -#include "erl_eterm.h" -#include "erl_malloc.h" -#include "erl_error.h" -#include "erl_internal.h" - -#include "eiext.h" /* replaces external.h */ -#include "putget.h" - -static int is_string(ETERM* term); -#if defined(VXWORKS) && CPU == PPC860 -int erl_fp_compare(unsigned *a, unsigned *b); -static void erl_long_to_fp(long l, unsigned *d); -#endif - -static int cmpbytes(unsigned char* s1,int l1,unsigned char* s2,int l2); -static int cmpatoms(unsigned char* s1, int l1, unsigned char tag1, unsigned char* s2, int l2, unsigned char tag2); - -/* Used when comparing two encoded byte arrays */ -/* this global data is ok (from threading point of view) since it is - * initialized once and never changed - */ - -#define CMP_ARRAY_SIZE 256 -/* FIXME problem for threaded ? */ - -static enum -{ - ERL_NUM_CMP=1, ERL_ATOM_CMP, ERL_REF_CMP, ERL_FUN_CMP, ERL_PORT_CMP, - ERL_PID_CMP, ERL_TUPLE_CMP, ERL_NIL_CMP, ERL_LIST_CMP, ERL_BIN_CMP -}cmp_array[CMP_ARRAY_SIZE]; - -static int init_cmp_array_p=1; /* initialize array, the first time */ - -#if defined(VXWORKS) && CPU == PPC860 -#include <limits.h> -#endif - -#if defined(__GNUC__) -# define INLINE __inline__ -#elif defined(__WIN32__) -# define INLINE __inline -#else -# define INLINE -#endif - -static int cmp_floats(double f1, double f2); -static INLINE double to_float(long l); - -#define IS_ERL_NUM(t) (cmp_array[t]==ERL_NUM_CMP) -#define IS_ERL_ATOM(t) (cmp_array[t]==ERL_ATOM_CMP) - -#define CMP_NUM_CLASS_SIZE 256 -static unsigned char cmp_num_class[CMP_NUM_CLASS_SIZE]; -static int init_cmp_num_class_p=1; /* initialize array, the first time */ - -#define MK_CMP_NUM_CODE(x,y) (((x)<<2)|(y)) -#define CMP_NUM_CLASS(x) (cmp_num_class[x] & 0x03) -#define CMP_NUM_CODE(x,y) (MK_CMP_NUM_CODE(CMP_NUM_CLASS(x),CMP_NUM_CLASS(y))) - -#define SMALL 1 -#define FLOAT 2 -#define BIG 3 - -#define SMALL_SMALL MK_CMP_NUM_CODE(SMALL,SMALL) -#define SMALL_FLOAT MK_CMP_NUM_CODE(SMALL,FLOAT) -#define SMALL_BIG MK_CMP_NUM_CODE(SMALL,BIG) -#define FLOAT_SMALL MK_CMP_NUM_CODE(FLOAT,SMALL) -#define FLOAT_FLOAT MK_CMP_NUM_CODE(FLOAT,FLOAT) -#define FLOAT_BIG MK_CMP_NUM_CODE(FLOAT,BIG) -#define BIG_SMALL MK_CMP_NUM_CODE(BIG,SMALL) -#define BIG_FLOAT MK_CMP_NUM_CODE(BIG,FLOAT) -#define BIG_BIG MK_CMP_NUM_CODE(BIG,BIG) - -void erl_init_marshal(void) -{ - if (init_cmp_array_p) { - memset(cmp_array, 0, sizeof cmp_array); - cmp_array[ERL_SMALL_INTEGER_EXT] = ERL_NUM_CMP; - cmp_array[ERL_INTEGER_EXT] = ERL_NUM_CMP; - cmp_array[ERL_FLOAT_EXT] = ERL_NUM_CMP; - cmp_array[NEW_FLOAT_EXT] = ERL_NUM_CMP; - cmp_array[ERL_SMALL_BIG_EXT] = ERL_NUM_CMP; - cmp_array[ERL_LARGE_BIG_EXT] = ERL_NUM_CMP; - cmp_array[ERL_ATOM_EXT] = ERL_ATOM_CMP; - cmp_array[ERL_ATOM_UTF8_EXT] = ERL_ATOM_CMP; - cmp_array[ERL_SMALL_ATOM_EXT] = ERL_ATOM_CMP; - cmp_array[ERL_SMALL_ATOM_UTF8_EXT] = ERL_ATOM_CMP; - cmp_array[ERL_REFERENCE_EXT] = ERL_REF_CMP; - cmp_array[ERL_NEW_REFERENCE_EXT] = ERL_REF_CMP; - cmp_array[ERL_NEWER_REFERENCE_EXT]=ERL_REF_CMP; - cmp_array[ERL_FUN_EXT] = ERL_FUN_CMP; - cmp_array[ERL_NEW_FUN_EXT] = ERL_FUN_CMP; - cmp_array[ERL_PORT_EXT] = ERL_PORT_CMP; - cmp_array[ERL_NEW_PORT_EXT] = ERL_PORT_CMP; - cmp_array[ERL_PID_EXT] = ERL_PID_CMP; - cmp_array[ERL_NEW_PID_EXT] = ERL_PID_CMP; - cmp_array[ERL_SMALL_TUPLE_EXT] = ERL_TUPLE_CMP; - cmp_array[ERL_LARGE_TUPLE_EXT] = ERL_TUPLE_CMP; - cmp_array[ERL_NIL_EXT] = ERL_NIL_CMP; - cmp_array[ERL_STRING_EXT] = ERL_LIST_CMP; - cmp_array[ERL_LIST_EXT] = ERL_LIST_CMP; - cmp_array[ERL_BINARY_EXT] = ERL_BIN_CMP; - init_cmp_array_p = 0; - } - if (init_cmp_num_class_p) { - memset(cmp_num_class, 0, CMP_NUM_CLASS_SIZE); - cmp_num_class[ERL_SMALL_INTEGER_EXT] = SMALL; - cmp_num_class[ERL_INTEGER_EXT] = SMALL; - cmp_num_class[ERL_FLOAT_EXT] = FLOAT; - cmp_num_class[NEW_FLOAT_EXT] = FLOAT; - cmp_num_class[ERL_SMALL_BIG_EXT] = BIG; - cmp_num_class[ERL_LARGE_BIG_EXT] = BIG; - init_cmp_num_class_p = 0; - } -} - -/* The encoder calls length, if erl_length() should return */ -/* -1 for dotted pairs (why !!!!) we can't use erl_length() */ -/* from the encoder in erl_marshal.c */ - -static int erl_length_x(const ETERM *ep) { - int n = 0; - - if (!ep) return -1; - - while (ERL_TYPE(ep) == ERL_LIST) { - n++; - ep = TAIL(ep); - } - - return n; -} - - -/*============================================================== - * Marshalling routines. - *============================================================== - */ - -static void encode_atom(Erl_Atom_data* a, unsigned char **ext) -{ - int ix = 0; - if (a->latin1) { - ei_encode_atom_len_as((char*)*ext, &ix, a->latin1, a->lenL, - ERLANG_LATIN1, ERLANG_UTF8); - } - else { - ei_encode_atom_len_as((char*)*ext, &ix, a->utf8, a->lenU, - ERLANG_UTF8, ERLANG_UTF8); - } - *ext += ix; -} - -/* - * The actual ENCODE engine. - * Returns 0 on success, otherwise 1. - */ -int erl_encode_it(ETERM *ep, unsigned char **ext, int dist) -{ - int i; - unsigned int u; - long long l; - unsigned long long ul; - - switch(ERL_TYPE(ep)) - { - case ERL_ATOM: - encode_atom(&ep->uval.aval.d, ext); - return 0; - - case ERL_INTEGER: - i = ep->uval.ival.i; - /* SMALL_INTEGER */ - if ((i < 256) && (i >= 0)) { - *(*ext)++ = ERL_SMALL_INTEGER_EXT; - *(*ext)++ = i & 0xff; - return 0; - } - /* R14B: Use all 32 bits of INTEGER_EXT */ - *(*ext)++ = ERL_INTEGER_EXT; - *(*ext)++ = (i >> 24) & 0xff; - *(*ext)++ = (i >> 16) & 0xff; - *(*ext)++ = (i >> 8) & 0xff; - *(*ext)++ = i & 0xff; - return 0; - - case ERL_U_INTEGER: - u = ep->uval.uival.u; - /* ERL_U_SMALL_BIG */ - if ((int)u < 0) { - *(*ext)++ = ERL_SMALL_BIG_EXT; - *(*ext)++ = 4; /* four bytes */ - *(*ext)++ = 0; /* sign byte */ - *(*ext)++ = u & 0xff; /* LSB first */ - *(*ext)++ = (u >> 8) & 0xff; - *(*ext)++ = (u >> 16) & 0xff; - *(*ext)++ = (u >> 24) & 0xff; - return 0; - } - /* SMALL_INTEGER */ - if (u < 256) { - *(*ext)++ = ERL_SMALL_INTEGER_EXT; - *(*ext)++ = u & 0xff; - return 0; - } - /* R14B: Use all 32 bits of INTEGER_EXT */ - *(*ext)++ = ERL_INTEGER_EXT; - *(*ext)++ = (u >> 24) & 0xff; - *(*ext)++ = (u >> 16) & 0xff; - *(*ext)++ = (u >> 8) & 0xff; - *(*ext)++ = u & 0xff; - return 0; - case ERL_LONGLONG: - l = ep->uval.llval.i; - /* ERL_SMALL_BIG */ - if (l > ((long long) INT_MAX) || l < ((long long) INT_MIN)) { - *(*ext)++ = ERL_SMALL_BIG_EXT; - *(*ext)++ = 8; - if ((*(*ext)++ = (l<0))) /* sign byte */ - l = -l; - *(*ext)++ = l & 0xff; /* LSB first */ - *(*ext)++ = (l >> 8) & 0xff; - *(*ext)++ = (l >> 16) & 0xff; - *(*ext)++ = (l >> 24) & 0xff; - *(*ext)++ = (l >> 32) & 0xff; - *(*ext)++ = (l >> 40) & 0xff; - *(*ext)++ = (l >> 48) & 0xff; - *(*ext)++ = (l >> 56) & 0xff; - return 0; - } - /* SMALL_INTEGER */ - if ((l < 256) && (l >= 0)) { - *(*ext)++ = ERL_SMALL_INTEGER_EXT; - *(*ext)++ = l & 0xff; - return 0; - } - /* R14B: Use all 32 bits of INTEGER_EXT */ - *(*ext)++ = ERL_INTEGER_EXT; - *(*ext)++ = (l >> 24) & 0xff; - *(*ext)++ = (l >> 16) & 0xff; - *(*ext)++ = (l >> 8) & 0xff; - *(*ext)++ = l & 0xff; - return 0; - - case ERL_U_LONGLONG: - ul = ep->uval.ullval.u; - /* ERL_U_SMALL_BIG */ - if (ul > ((unsigned long long) INT_MAX)) { - *(*ext)++ = ERL_SMALL_BIG_EXT; - *(*ext)++ = 8; /* eight bytes */ - *(*ext)++ = 0; /* sign byte */ - *(*ext)++ = ul & 0xff; /* LSB first */ - *(*ext)++ = (ul >> 8) & 0xff; - *(*ext)++ = (ul >> 16) & 0xff; - *(*ext)++ = (ul >> 24) & 0xff; - *(*ext)++ = (ul >> 32) & 0xff; - *(*ext)++ = (ul >> 40) & 0xff; - *(*ext)++ = (ul >> 48) & 0xff; - *(*ext)++ = (ul >> 56) & 0xff; - return 0; - } - /* SMALL_INTEGER */ - if (ul < 256) { - *(*ext)++ = ERL_SMALL_INTEGER_EXT; - *(*ext)++ = ul & 0xff; - return 0; - } - /* R14B: Use all 32 bits of INTEGER_EXT */ - *(*ext)++ = ERL_INTEGER_EXT; - *(*ext)++ = (ul >> 24) & 0xff; - *(*ext)++ = (ul >> 16) & 0xff; - *(*ext)++ = (ul >> 8) & 0xff; - *(*ext)++ = ul & 0xff; - return 0; - - case ERL_PID: { - unsigned char* tagp = (*ext)++; - /* First poke in node as an atom */ - encode_atom(&ep->uval.pidval.node, ext); - /* And then fill in the integer fields */ - i = ERL_PID_NUMBER(ep); - *(*ext)++ = (i >> 24) &0xff; - *(*ext)++ = (i >> 16) &0xff; - *(*ext)++ = (i >> 8) &0xff; - *(*ext)++ = i &0xff; - i = ERL_PID_SERIAL(ep); - *(*ext)++ = (i >> 24) &0xff; - *(*ext)++ = (i >> 16) &0xff; - *(*ext)++ = (i >> 8) &0xff; - *(*ext)++ = i &0xff; - - i = ERL_PID_CREATION(ep); - if ((unsigned int)i <= 3) { - *tagp = ERL_PID_EXT; - *(*ext)++ = i; - } else { - *tagp = ERL_NEW_PID_EXT; - *(*ext)++ = (i >> 24) &0xff; - *(*ext)++ = (i >> 16) &0xff; - *(*ext)++ = (i >> 8) &0xff; - *(*ext)++ = i &0xff; - } - return 0; - } - case ERL_REF: { - unsigned char* tagp = (*ext)++; - - int len, j; - - /* Always encode as an extended reference; all - participating parties are now expected to be - able to decode extended references. */ - - i = strlen((char *)ERL_REF_NODE(ep)); - len = ERL_REF_LEN(ep); - *(*ext)++ = (len >> 8) &0xff; - *(*ext)++ = len &0xff; - - encode_atom(&ep->uval.refval.node, ext); - - i = ERL_REF_CREATION(ep); - if ((unsigned int)i <= 3) { - *tagp = ERL_NEW_REFERENCE_EXT; - *(*ext)++ = i; - } else { - *tagp = ERL_NEWER_REFERENCE_EXT; - *(*ext)++ = (i >> 24) &0xff; - *(*ext)++ = (i >> 16) &0xff; - *(*ext)++ = (i >> 8) &0xff; - *(*ext)++ = i &0xff; - } - - /* Then the integer fields */ - for (j = 0; j < ERL_REF_LEN(ep); j++) { - i = ERL_REF_NUMBERS(ep)[j]; - *(*ext)++ = (i >> 24) &0xff; - *(*ext)++ = (i >> 16) &0xff; - *(*ext)++ = (i >> 8) &0xff; - *(*ext)++ = i &0xff; - } - } - return 0; - case ERL_PORT: { - unsigned char* tagp = (*ext)++; - /* First poke in node as an atom */ - encode_atom(&ep->uval.portval.node, ext); - /* Then the integer fields */ - i = ERL_PORT_NUMBER(ep); - *(*ext)++ = (i >> 24) &0xff; - *(*ext)++ = (i >> 16) &0xff; - *(*ext)++ = (i >> 8) &0xff; - *(*ext)++ = i &0xff; - - i = ERL_PORT_CREATION(ep); - if ((unsigned int)i <= 3) { - *tagp = ERL_PORT_EXT; - *(*ext)++ = i; - } else { - *tagp = ERL_NEW_PORT_EXT; - *(*ext)++ = (i >> 24) &0xff; - *(*ext)++ = (i >> 16) &0xff; - *(*ext)++ = (i >> 8) &0xff; - *(*ext)++ = i &0xff; - } - return 0; - } - case ERL_EMPTY_LIST: - *(*ext)++ = ERL_NIL_EXT; - break; - case ERL_LIST: - i = is_string(ep); - if (0 < i && i < 0x10000) { /* String. */ - *(*ext)++ = ERL_STRING_EXT; - *(*ext)++ = (i >>8) &0xff; - *(*ext)++ = i &0xff; - while (ERL_TYPE(ep) == ERL_LIST) { - *(*ext)++ = HEAD(ep)->uval.ival.i; - ep = TAIL(ep); - } - break; - } else { /* List. */ - i = erl_length_x(ep); - *(*ext)++ = ERL_LIST_EXT; - *(*ext)++ = (i >> 24) &0xff; - *(*ext)++ = (i >> 16) &0xff; - *(*ext)++ = (i >> 8) &0xff; - *(*ext)++ = i &0xff; - while (ERL_TYPE(ep) == ERL_LIST) { - if (erl_encode_it(HEAD(ep), ext, dist)) - return 1; - ep = TAIL(ep); - } - i = erl_encode_it(ep, ext, dist); - return i; - } - case ERL_TUPLE: - i = ep->uval.tval.size; - if (i <= 0xff) { - *(*ext)++ = ERL_SMALL_TUPLE_EXT; - *(*ext)++ = i & 0xff; - } - else { - *(*ext)++ = ERL_LARGE_TUPLE_EXT; - *(*ext)++ = (i >> 24) & 0xff; - *(*ext)++ = (i >> 16) & 0xff; - *(*ext)++ = (i >> 8) & 0xff; - *(*ext)++ = i & 0xff; - } - for (i=0; i<ep->uval.tval.size; i++) - if (erl_encode_it(ep->uval.tval.elems[i], ext, dist)) - return 1; - break; - case ERL_FLOAT: - *(*ext)++ = ERL_FLOAT_EXT; - memset(*ext, 0, 31); - sprintf((char *) *ext, "%.20e", ep->uval.fval.f); - *ext += 31; - break; - case ERL_BINARY: - *(*ext)++ = ERL_BINARY_EXT; - i = ep->uval.bval.size; - *(*ext)++ = (i >> 24) & 0xff; - *(*ext)++ = (i >> 16) & 0xff; - *(*ext)++ = (i >> 8) & 0xff; - *(*ext)++ = i & 0xff; - memcpy((char *) *ext, (char*) ep->uval.bval.b, i); - *ext += i; - break; - case ERL_FUNCTION: - if (ERL_FUN_ARITY(ep) != -1) { - unsigned char *size_p = *ext + 1; - *(*ext)++ = ERL_NEW_FUN_EXT; - *ext += 4; - i = ERL_FUN_ARITY(ep); - put8(*ext, i); - memcpy(*ext, ERL_FUN_MD5(ep), 16); - *ext += 16; - i = ERL_FUN_NEW_INDEX(ep); - put32be(*ext, i); - i = ERL_CLOSURE_SIZE(ep); - put32be(*ext, i); - erl_encode_it(ERL_FUN_MODULE(ep), ext, dist); - erl_encode_it(ERL_FUN_INDEX(ep), ext, dist); - erl_encode_it(ERL_FUN_UNIQ(ep), ext, dist); - erl_encode_it(ERL_FUN_CREATOR(ep), ext, dist); - for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) - erl_encode_it(ep->uval.funcval.closure[i], ext, dist); - if (size_p != NULL) { - i = *ext - size_p; - put32be(size_p, i); - } - } else { - *(*ext)++ = ERL_FUN_EXT; - i = ERL_CLOSURE_SIZE(ep); - *(*ext)++ = (i >> 24) & 0xff; - *(*ext)++ = (i >> 16) & 0xff; - *(*ext)++ = (i >> 8) & 0xff; - *(*ext)++ = i & 0xff; - erl_encode_it(ERL_FUN_CREATOR(ep), ext, dist); - erl_encode_it(ERL_FUN_MODULE(ep), ext, dist); - erl_encode_it(ERL_FUN_INDEX(ep), ext, dist); - erl_encode_it(ERL_FUN_UNIQ(ep), ext, dist); - for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) - erl_encode_it(ep->uval.funcval.closure[i], ext, dist); - } - break; - default: - return 1; - } - return 0; -} - -/* - * ENCODE an ETERM into a BUFFER, assuming BUFFER is of - * enough size. At success return number of bytes written - * into it, otherwise return 0. - */ -static int erl_encode3(ETERM *ep, unsigned char *t, int dist) -{ - unsigned char *x = t; - - *x++ = ERL_VERSION_MAGIC; - if (erl_encode_it(ep, &x, dist)) { -#ifdef DEBUG - erl_err_msg("<ERROR> erl_encode: Error while encoding"); -#endif - return 0; - } - return (x - t); - -} - -/* API */ - -int erl_encode(ETERM *ep, unsigned char *t) -{ - return erl_encode3(ep, t, 4); -} - -/* determine the buffer size that will be required for the eterm */ -static int erl_term_len_helper(ETERM *ep, int dist); - -/* FIXME hard coded dist version */ -int erl_term_len(ETERM *ep) -{ - return 1+erl_term_len_helper(ep, 4); -} - -static int atom_len_helper(Erl_Atom_data* a) -{ - (void) erl_atom_ptr_utf8(a); - return 1 + 1 + (a->lenU > 255) + a->lenU; -} - -static int erl_term_len_helper(ETERM *ep, int dist) -{ - int len = 0; - int i; - unsigned int u; - long long l; - unsigned long long ul; - - if (ep) { - switch (ERL_TYPE(ep)) { - case ERL_ATOM: - len = atom_len_helper(&ep->uval.aval.d); - break; - - case ERL_INTEGER: - i = ep->uval.ival.i; - if ((i < 256) && (i >= 0)) len = 2; - else len = 5; - break; - - case ERL_U_INTEGER: - u = ep->uval.uival.u; - if ((int)u < 0) len = 7; - else if (u < 256) len = 2; - else len = 5; - break; - - case ERL_LONGLONG: - l = ep->uval.llval.i; - if ((l > ((long long) INT_MAX)) || - (l < ((long long) INT_MIN))) len = 11; - else if ((l < 256) && (l >= 0)) len = 2; - else len = 5; - break; - - case ERL_U_LONGLONG: - ul = ep->uval.ullval.u; - if (ul > ((unsigned long long) INT_MAX)) len = 11; - else if (ul < 256) len = 2; - else len = 5; - break; - - case ERL_PID: - len = 1 + atom_len_helper(&ep->uval.pidval.node) + 4 + 4 + 1; - break; - - case ERL_REF: - len = 1 + 2 + atom_len_helper(&ep->uval.refval.node) + 1 + ERL_REF_LEN(ep) * 4; - break; - - case ERL_PORT: - len = 1 + atom_len_helper(&ep->uval.portval.node) + 4 + 1; - break; - - case ERL_EMPTY_LIST: - len = 1; - break; - - case ERL_LIST: - i = is_string(ep); - if ((i > 0) && (i < 0x10000)) { /* string: 3 + strlen */ - for (len = 3; ERL_TYPE(ep) == ERL_LIST; ep = TAIL(ep)) { - len++; - } - } - else { /* list: 5 + len(elem1) + len(elem2) ... */ - for (len = 5; ERL_TYPE(ep) == ERL_LIST; ep = TAIL(ep)) { - len += erl_term_len_helper(HEAD(ep), dist); - } - len += erl_term_len_helper(ep, dist); /* last element */ - } - break; - - case ERL_TUPLE: - /* (2 or 5) + len(elem1) + len(elem2) ... */ - i = ep->uval.tval.size; - if (i <= 0xff) len = 2; - else len = 5; - - for (i=0; i<ep->uval.tval.size; i++) { - len += erl_term_len_helper(ep->uval.tval.elems[i], dist); - } - break; - - case ERL_FLOAT: - len = 32; - break; - - case ERL_BINARY: - i = ep->uval.bval.size; - len = 5 + i; - break; - - case ERL_FUNCTION: - if (ERL_FUN_ARITY(ep) == -1) { - len = 1 + 4; - len += erl_term_len_helper(ERL_FUN_CREATOR(ep),dist); - len += erl_term_len_helper(ERL_FUN_MODULE(ep),dist); - len += erl_term_len_helper(ERL_FUN_INDEX(ep),dist); - len += erl_term_len_helper(ERL_FUN_UNIQ(ep),dist); - for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) - len += erl_term_len_helper(ERL_CLOSURE_ELEMENT(ep,i), dist); - } else { - len = 1 + 4 + 16 + 4 + 4; - len += erl_term_len_helper(ERL_FUN_MODULE(ep),dist); - len += erl_term_len_helper(ERL_FUN_INDEX(ep),dist); - len += erl_term_len_helper(ERL_FUN_UNIQ(ep),dist); - len += erl_term_len_helper(ERL_FUN_CREATOR(ep),dist); - for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) - len += erl_term_len_helper(ERL_CLOSURE_ELEMENT(ep,i), dist); - } - break; - - default: -#ifdef DEBUG - fprintf(stderr, "Shouldn't happen: erl_term_len, unknown term type: '%c'\n",ERL_TYPE(ep)); -#endif - erl_errno = EINVAL; - exit(1); - } - } - - return len; -} - -/* - * This one makes it easy to ENCODE several CONSECUTIVE - * ETERM's into the same buffer. - */ -int erl_encode_buf(ETERM *ep, unsigned char **ext) -{ - unsigned char *start=*ext; - - *(*ext)++ = ERL_VERSION_MAGIC; - if (erl_encode_it(ep, ext, 0)) { -#ifdef DEBUG - erl_err_msg("<ERROR> erl_encode_buf: Error while encoding\n"); -#endif - return 0; - } - return (*ext - start); - -} /* erl_encode_buf */ - - -static int read_atom(unsigned char** ext, Erl_Atom_data* a) -{ - char buf[MAXATOMLEN_UTF8]; - int offs = 0; - erlang_char_encoding enc; - int ret = ei_decode_atom_as((char*)*ext, &offs, buf, MAXATOMLEN_UTF8, - ERLANG_LATIN1|ERLANG_UTF8, NULL, &enc); - *ext += offs; - - if (ret == 0) { - int i = strlen(buf); - char* clone = erl_malloc(i+1); - memcpy(clone, buf, i+1); - - a->latin1 = NULL; - a->lenL = 0; - a->utf8 = NULL; - a->lenU = 0; - if (enc & (ERLANG_LATIN1 | ERLANG_ASCII)) { - a->latin1 = clone; - a->lenL = i; - } - if (enc & (ERLANG_UTF8 | ERLANG_ASCII)) { - a->utf8 = clone; - a->lenU = i; - } - } - return ret; -} - -/* - * The actual DECODE engine. - * Returns NULL in case of failure. - */ -static ETERM *erl_decode_it(unsigned char **ext) -{ - char *cp; - ETERM *ep,*tp,*np; - unsigned int u,sign; - int i,j,arity; - double ff; - unsigned char tag; - - /* Assume we are going to decode an integer */ - ep = erl_alloc_eterm(ERL_INTEGER); - ERL_COUNT(ep) = 1; - - tag = *(*ext)++; - switch (tag) - { - case ERL_INTEGER_EXT: - i = (int) (**ext << 24) | ((*ext)[1] << 16) | - ((*ext)[2] << 8) | (*ext)[3]; - *ext += 4; - ep->uval.ival.i = i; - return ep; - - case ERL_SMALL_INTEGER_EXT: - i = *(*ext)++; - ep->uval.ival.i = i; - return ep; - - /* NOTE: The arity below for bigs is not really the arity (= number of digits) */ - /* It is the byte count and this might cause problems in other parts... */ - case ERL_SMALL_BIG_EXT: - arity = *(*ext)++; - goto big_cont; - case ERL_LARGE_BIG_EXT: - arity = (**ext << 24) | ((*ext)[1])<< 16 | - ((*ext)[2]) << 8 |((*ext)[3]); - *ext += 4; - big_cont: - -#ifdef _MSC_VER -#define MAX_TO_NEGATE 0x8000000000000000Ui64 -#else -#define MAX_TO_NEGATE 0x8000000000000000ULL -#endif - - sign = *(*ext)++; - if (arity > 8) - goto big_truncate; - - if (arity == 4 && ((*ext)[3] & 0x80) && !sign) { - /* It will fit into an unsigned int !! */ - u = (((*ext)[3] << 24)|((*ext)[2])<< 16|((*ext)[1]) << 8 |(**ext)); - ERL_TYPE(ep) = ERL_U_INTEGER; - ep->uval.uival.u = u; - /* *ext += i; */ - *ext += arity; - return ep; - } else if (arity == 4 && !((*ext)[3] & 0x80)) { - /* It will fit into an int !! - */ - i = (int) (((*ext)[3] << 24) | ((*ext)[2])<< 16 | - ((*ext)[1]) << 8 | (**ext)); - if (sign) i = -i; - ERL_TYPE(ep) = ERL_INTEGER; - ep->uval.ival.i = i; - *ext += arity; - return ep; - } else if (arity == 8 && ((*ext)[7] & 0x80) && !sign) { - /* Fits in an unsigned long long */ - int x; - unsigned long long ul = 0LL; - - for(x = 0 ; x < arity ; x++) { - ul |= ((unsigned long long)(*ext)[x]) << ((unsigned long long)(8*x)); - } - - ERL_TYPE(ep) = ERL_U_LONGLONG; - ep->uval.ullval.u = ul; - *ext += arity; - return ep; - } else { - /* Fits in a signed long long */ - int x; - unsigned long long l = 0LL; - long long sl; - - for(x = 0 ; x < arity ; x++) { - l |= ((unsigned long long)(*ext)[x]) << ((unsigned long long)(8*x)); - } - - sl = (long long)l; - - if (sign && l != MAX_TO_NEGATE) { - sl = -sl; - if (sl > 0) goto big_truncate; - } - - ERL_TYPE(ep) = ERL_LONGLONG; - ep->uval.llval.i = sl; - *ext += arity; - return ep; - } -#undef MAX_TO_NEGATE - big_truncate: - /* truncate to: (+/-) 1 */ -#ifdef DEBUG - erl_err_msg("<WARNING> erl_decode_it: Integer truncated..."); -#endif - ERL_TYPE(ep) = ERL_INTEGER; - ep->uval.ival.i = sign?-1:1; - *ext += arity; - return ep; - - case ERL_ATOM_EXT: - case ERL_SMALL_ATOM_EXT: - case ERL_ATOM_UTF8_EXT: - case ERL_SMALL_ATOM_UTF8_EXT: - - ERL_TYPE(ep) = ERL_ATOM; - --(*ext); - if (read_atom(ext, &ep->uval.aval.d) < 0) return NULL; - return ep; - - case ERL_PID_EXT: - case ERL_NEW_PID_EXT: - { - unsigned int number, serial; - unsigned int creation; - - ERL_TYPE(ep) = ERL_PID; - if (read_atom(ext, &ep->uval.pidval.node) < 0) return NULL; - - /* get the integers */ - number = ((*ext)[0] << 24) | ((*ext)[1]) << 16 | - ((*ext)[2]) << 8 | ((*ext)[3]); - *ext += 4; - serial = ((*ext)[0] << 24) | ((*ext)[1]) << 16 | - ((*ext)[2]) << 8 | ((*ext)[3]); - *ext += 4; - if (tag == ERL_PID_EXT) - creation = *(*ext)++; - else { - creation = ((*ext)[0] << 24) | ((*ext)[1]) << 16 | - ((*ext)[2]) << 8 | ((*ext)[3]); - *ext += 4; - } - erl_mk_pid_helper(ep, number, serial, creation); - return ep; - } - case ERL_REFERENCE_EXT: - { - unsigned int n[3] = {0, 0, 0}; - unsigned char creation; - - ERL_TYPE(ep) = ERL_REF; - if (read_atom(ext, &ep->uval.refval.node) < 0) return NULL; - - /* get the integers */ - n[0] = ((*ext)[0] << 24) | ((*ext)[1]) << 16 | - ((*ext)[2]) << 8 | ((*ext)[3]); - *ext += 4; - creation = *(*ext)++; - __erl_mk_reference(ep, NULL, 1, n, creation); - return ep; - } - - case ERL_NEW_REFERENCE_EXT: - case ERL_NEWER_REFERENCE_EXT: - { - size_t cnt, i; - unsigned int n[3]; - unsigned int creation; - - ERL_TYPE(ep) = ERL_REF; - cnt = ((*ext)[0] << 8) | (*ext)[1]; - *ext += 2; - - if (read_atom(ext, &ep->uval.refval.node) < 0) return NULL; - - /* get the integers */ - if (tag == ERL_NEW_REFERENCE_EXT) - creation = *(*ext)++; - else { - creation = ((*ext)[0] << 24) | ((*ext)[1]) << 16 | - ((*ext)[2]) << 8 | ((*ext)[3]); - *ext += 4; - } - for(i = 0; i < cnt; i++) - { - n[i] = ((*ext)[0] << 24) | ((*ext)[1]) << 16 | - ((*ext)[2]) << 8 | ((*ext)[3]); - *ext += 4; - } - __erl_mk_reference(ep, NULL, cnt, n, creation); - return ep; - } - - case ERL_PORT_EXT: - case ERL_NEW_PORT_EXT: - { - unsigned int number; - unsigned int creation; - - ERL_TYPE(ep) = ERL_PORT; - if (read_atom(ext, &ep->uval.portval.node) < 0) return NULL; - - /* get the integers */ - number = ((*ext)[0] << 24) | ((*ext)[1]) << 16 | - ((*ext)[2]) << 8 | ((*ext)[3]); - *ext += 4; - if (tag == ERL_PORT_EXT) - creation = *(*ext)++; - else { - creation = (((*ext)[0] << 24) | ((*ext)[1]) << 16 | - ((*ext)[2]) << 8 | ((*ext)[3])); - *ext += 4; - } - erl_mk_port_helper(ep, number, creation); - return ep; - } - - case ERL_NIL_EXT: - ERL_TYPE(ep) = ERL_EMPTY_LIST; - return ep; - - case ERL_LIST_EXT: - ERL_TYPE(ep) = ERL_LIST; - i = (**ext << 24) | ((*ext)[1] << 16) |((*ext)[2] << 8) | (*ext)[3]; - *ext += 4; - /* ASSERT(i != 0); */ /* Should be represented by ERL_NIL_EXT. */ - tp = ep; - for (j = 0; j < i; j++) - if ((HEAD(tp) = erl_decode_it(ext)) == NULL) - goto failure; - else if (j + 1 < i) { - /* We have to watch out for how we allocates the - * last tail element since we may encounter non- - * well formed lists. - */ - np = erl_alloc_eterm(ERL_LIST); - ERL_COUNT(np) = 1; - TAIL(np) = NULL; /* in case of failure */ - TAIL(tp) = np; - tp = np; - } - if ((TAIL(tp) = erl_decode_it(ext)) == NULL) - goto failure; - return ep; - - case ERL_STRING_EXT: - { - unsigned char* s; - - ERL_TYPE(ep) = ERL_EMPTY_LIST; - i = (**ext << 8) | ((*ext)[1]); - *ext += 2; - s = *ext+i; - - while (*ext < s) { - ETERM* integer; - ETERM* cons; - - integer = erl_alloc_eterm(ERL_INTEGER); - ERL_COUNT(integer) = 1; - integer->uval.ival.i = *--s; - - cons = erl_alloc_eterm(ERL_LIST); - ERL_COUNT(cons) = 1; - HEAD(cons) = integer; - TAIL(cons) = ep; - ep = cons; - } - *ext += i; - return ep; - } - - case ERL_SMALL_TUPLE_EXT: - ERL_TYPE(ep) = ERL_TUPLE; - i = *(*ext)++; - goto decode_tuple; - - case ERL_LARGE_TUPLE_EXT: - i = (**ext << 24) | ((*ext)[1]) << 16 | - ((*ext)[2]) << 8 | ((*ext)[3]) ; - *ext += 4; - decode_tuple: - ep->uval.tval.size = i; - j = (i + 1) * sizeof(ETERM*); - ep->uval.tval.elems = (ETERM**) erl_malloc(j); - memset(ep->uval.tval.elems, 0, j); /* in case of failure below... */ - for (i=0; i<ep->uval.tval.size; i++) - if ((tp = erl_decode_it(ext)) == NULL) - goto failure; - else - ep->uval.tval.elems[i] = tp; - return ep; - - case ERL_FLOAT_EXT: - case NEW_FLOAT_EXT: - ERL_TYPE(ep) = ERL_FLOAT; - cp = (char *) *ext; - i = -1; - if (ei_decode_double(cp, &i, &ff) == -1) - goto failure; - *ext += i; - ep->uval.fval.f = ff; - return ep; - - case ERL_BINARY_EXT: - ERL_TYPE(ep) = ERL_BINARY; - i = (**ext << 24) | ((*ext)[1] << 16) | - ((*ext)[2] << 8) | (*ext)[3]; - *ext += 4; - ep->uval.bval.size = i; - ep->uval.bval.b = (unsigned char *) erl_malloc(i); - memcpy(ep->uval.bval.b, *ext, i); - *ext += i; - return ep; - - case ERL_FUN_EXT: /* FIXME: error checking */ - ERL_TYPE(ep) = ERL_FUNCTION; - i = get32be(*ext); - /*i = *(**ext << 24) | ((*ext)[1] << 16) | ((*ext)[2] << 8) | (*ext)[3]; - *ext += 4; */ - ERL_FUN_ARITY(ep) = -1; - ERL_CLOSURE_SIZE(ep) = i; - ERL_FUN_CREATOR(ep) = erl_decode_it(ext); - ERL_FUN_MODULE(ep) = erl_decode_it(ext); - ERL_FUN_INDEX(ep) = erl_decode_it(ext); - ERL_FUN_UNIQ(ep) = erl_decode_it(ext); - j = i * sizeof(ETERM*); - ERL_CLOSURE(ep) = (ETERM**) erl_malloc(j); - memset(ERL_CLOSURE(ep), 0, j); - for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) - ERL_CLOSURE_ELEMENT(ep,i) = erl_decode_it(ext); - return ep; - - case ERL_NEW_FUN_EXT: /* FIXME: error checking */ - ERL_TYPE(ep) = ERL_FUNCTION; - i = get32be(*ext); /* size, we don't use it here */ - ERL_FUN_ARITY(ep) = get8(*ext); - memcpy(ERL_FUN_MD5(ep), *ext, 16); - *ext += 16; - ERL_FUN_NEW_INDEX(ep) = get32be(*ext); - i = get32be(*ext); - ERL_CLOSURE_SIZE(ep) = i; - ERL_FUN_MODULE(ep) = erl_decode_it(ext); - ERL_FUN_INDEX(ep) = erl_decode_it(ext); - ERL_FUN_UNIQ(ep) = erl_decode_it(ext); - ERL_FUN_CREATOR(ep) = erl_decode_it(ext); - j = i * sizeof(ETERM*); - ERL_CLOSURE(ep) = (ETERM**) erl_malloc(j); - memset(ERL_CLOSURE(ep), 0, j); - for (i = 0; i < ERL_CLOSURE_SIZE(ep); i++) - ERL_CLOSURE_ELEMENT(ep,i) = erl_decode_it(ext); - return ep; - - } /* switch */ - - failure: - erl_free_term(ep); - return (ETERM *) NULL; - -} /* erl_decode_it */ - -/* - * DECODE a buffer of BYTES into an ETERM. - * Returns NULL in case of failure. - */ -ETERM *erl_decode(unsigned char *t) -{ - ETERM *ep; - unsigned char *ext; - - ext = t; - - /* We ignore the version magic since it might be - * possible that the buffer has been manipulated - * with erl_peek_ext. - */ - if (*ext == ERL_VERSION_MAGIC) - ext++; - - ep = NULL; - ep = erl_decode_it(&ext); -#ifdef DEBUG - if (!ep) erl_err_msg("<ERROR> erl_decode: Error while decoding"); -#endif - return ep; - -} /* erl_decode */ - -/* - * This one makes it possible to DECODE two CONSECUTIVE - * ETERM's in the same buffer. - */ -ETERM *erl_decode_buf(unsigned char **ext) -{ - ETERM *ep; - - /* We ignore the version magic since it might be - * possible that the buffer has been manipulated - * with erl_peek_ext. - */ - if (**ext == ERL_VERSION_MAGIC) - (*ext)++; - - ep = NULL; - ep = erl_decode_it(ext); -#ifdef DEBUG - if (!ep) erl_err_msg("<ERROR> erl_decode_buf: Error while decoding"); -#endif - return ep; - -} /* erl_decode_buf */ - - -/*============================================================== - * Ok, here comes routines for inspecting/manipulating - * an encoded buffer of bytes. - *============================================================== - */ - -/* - * Return 1 if the VERSION MAGIC in the BUFFER is the - * same as the this library version. - */ -int erl_verify_magic(unsigned char *ext) -{ - - if (*ext == ERL_VERSION_MAGIC) - return 1; - else - return 0; - -} /* erl_verify_magic */ - -/* - * Return the TYPE of an ENCODED ETERM. - * At failure, return 0. - */ -unsigned char erl_ext_type(unsigned char *ext) -{ - /* FIXME old code could skip multiple magic */ - - /* Move over magic number if any */ - if (*ext == ERL_VERSION_MAGIC) ext++; - - switch (*ext) { - case ERL_SMALL_INTEGER_EXT: - case ERL_INTEGER_EXT: - return ERL_INTEGER; - case ERL_ATOM_EXT: - case ERL_ATOM_UTF8_EXT: - case ERL_SMALL_ATOM_EXT: - case ERL_SMALL_ATOM_UTF8_EXT: - return ERL_ATOM; - case ERL_PID_EXT: - case ERL_NEW_PID_EXT: - return ERL_PID; - case ERL_PORT_EXT: - case ERL_NEW_PORT_EXT: - return ERL_PORT; - case ERL_REFERENCE_EXT: - case ERL_NEW_REFERENCE_EXT: - case ERL_NEWER_REFERENCE_EXT: - return ERL_REF; - case ERL_NIL_EXT: - return ERL_EMPTY_LIST; - case ERL_LIST_EXT: - return ERL_LIST; - case ERL_SMALL_TUPLE_EXT: - case ERL_LARGE_TUPLE_EXT: - return ERL_TUPLE; - case ERL_FLOAT_EXT: - case NEW_FLOAT_EXT: - return ERL_FLOAT; - case ERL_BINARY_EXT: - return ERL_BINARY; - case ERL_FUN_EXT: - case ERL_NEW_FUN_EXT: - return ERL_FUNCTION; - case ERL_SMALL_BIG_EXT: - case ERL_LARGE_BIG_EXT: - return ERL_BIG; - default: - return 0; - - } /* switch */ - -} /* erl_ext_type */ - -/* - * Returns the number of elements in compund - * terms. For other kind of terms zero is returned. - * At failure -1 is returned. - */ -int erl_ext_size(unsigned char *t) -{ - int i; - unsigned char *v; - - if (*t == ERL_VERSION_MAGIC) - return erl_ext_size(t+1); - - v = t+1; - switch(*t) { - case ERL_SMALL_INTEGER_EXT: - case ERL_INTEGER_EXT: - case ERL_ATOM_EXT: - case ERL_ATOM_UTF8_EXT: - case ERL_SMALL_ATOM_EXT: - case ERL_SMALL_ATOM_UTF8_EXT: - case ERL_PID_EXT: - case ERL_NEW_PID_EXT: - case ERL_PORT_EXT: - case ERL_NEW_PORT_EXT: - case ERL_REFERENCE_EXT: - case ERL_NEW_REFERENCE_EXT: - case ERL_NEWER_REFERENCE_EXT: - case ERL_NIL_EXT: - case ERL_BINARY_EXT: - case ERL_STRING_EXT: - case ERL_FLOAT_EXT: - case NEW_FLOAT_EXT: - case ERL_SMALL_BIG_EXT: - case ERL_LARGE_BIG_EXT: - return 0; - break; - case ERL_SMALL_TUPLE_EXT: - i = v[0]; - return i; - break; - case ERL_LIST_EXT: - case ERL_LARGE_TUPLE_EXT: - i = (v[0] << 24) | (v[1] << 16) | (v[2] << 8) | v[3]; - return i; - break; - case ERL_FUN_EXT: - i = (v[0] << 24) | (v[1] << 16) | (v[2] << 8) | v[3]; - return i+4; - break; - case ERL_NEW_FUN_EXT: - v += 4 + 1 + 16 + 4; - i = get32be(v); - return i + 4; - break; - default: - return -1; - break; - } /* switch */ - -} /* ext_size */ - - -static int jump_atom(unsigned char** ext) -{ - unsigned char* e = *ext; - int len; - - switch (*e++) { - case ERL_ATOM_EXT: - case ERL_ATOM_UTF8_EXT: - len = (e[0] << 8) | e[1]; - e += (len + 2); - break; - - case ERL_SMALL_ATOM_EXT: - case ERL_SMALL_ATOM_UTF8_EXT: - len = e[0]; - e += (len + 1); - break; - - default: - return 0; - } - *ext = e; - return 1; -} - - -/* - * MOVE the POINTER PAST the ENCODED ETERM we - * are currently pointing at. Returns 1 at - * success, otherwise 0. - */ -static int jump(unsigned char **ext) -{ - int j,k,i=0; - int n; - const int tag = *(*ext)++; - - switch (tag) { - case ERL_VERSION_MAGIC: - return jump(ext); - case ERL_INTEGER_EXT: - *ext += 4; - break; - case ERL_SMALL_INTEGER_EXT: - *ext += 1; - break; - case ERL_ATOM_EXT: - case ERL_ATOM_UTF8_EXT: - case ERL_SMALL_ATOM_EXT: - case ERL_SMALL_ATOM_UTF8_EXT: - jump_atom(ext); - break; - case ERL_PID_EXT: - if (!jump_atom(ext)) return 0; - *ext += 4 + 4 + 1; - break; - case ERL_NEW_PID_EXT: - if (!jump_atom(ext)) return 0; - *ext += 4 + 4 + 4; - break; - case ERL_REFERENCE_EXT: - case ERL_PORT_EXT: - if (!jump_atom(ext)) return 0; - *ext += 4 + 1; - break; - case ERL_NEW_PORT_EXT: - if (!jump_atom(ext)) return 0; - *ext += 4 + 4; - break; - case ERL_NEW_REFERENCE_EXT: - case ERL_NEWER_REFERENCE_EXT: - n = (**ext << 8) | (*ext)[1]; - *ext += 2; - /* first field is an atom */ - if (!jump_atom(ext)) return 0; - *ext += 4*n + (tag == ERL_NEW_REFERENCE_EXT ? 1 : 4); - break; - case ERL_NIL_EXT: - /* We just passed it... */ - break; - case ERL_LIST_EXT: - i = j = 0; - j = (**ext << 24) | ((*ext)[1] << 16) |((*ext)[2] << 8) | (*ext)[3]; - *ext += 4; - for(k=0; k<j; k++) - if ((i = jump(ext)) == 0) - return(0); - if (**ext == ERL_NIL_EXT) { - *ext += 1; - break; - } - if (jump(ext) == 0) return 0; - break; - case ERL_STRING_EXT: - i = **ext << 8 | (*ext)[1]; - *ext += 2 + i; - break; - case ERL_SMALL_TUPLE_EXT: - i = *(*ext)++; - goto jump_tuple; - case ERL_LARGE_TUPLE_EXT: - i = (**ext << 24) | ((*ext)[1] << 16) |((*ext)[2] << 8) | (*ext)[3]; - *ext += 4; - jump_tuple: - for (j = 0; j < i; j++) - if ((k = jump(ext)) == 0) - return(0); - break; - case ERL_FLOAT_EXT: - *ext += 31; - break; - case NEW_FLOAT_EXT: - *ext += 8; - break; - case ERL_BINARY_EXT: - i = (**ext << 24) | ((*ext)[1] << 16) |((*ext)[2] << 8) | (*ext)[3]; - *ext += 4+i; - break; - case ERL_FUN_EXT: - i = (**ext << 24) | ((*ext)[1] << 16) |((*ext)[2] << 8) | (*ext)[3]; - *ext += 4; - i += 4; - for (j = 0; j < i; j++) - if ((k = jump(ext)) == 0) - return(0); - break; - case ERL_NEW_FUN_EXT: - i = get32be(*ext); - *ext += i + 4; - break; - case ERL_SMALL_BIG_EXT: - i = *(*ext); - *ext += i + 1; - break; - case ERL_LARGE_BIG_EXT: - i = get32be(*ext); - *ext += i + 4; - break; - default: - return 0; - } /* switch */ - - return 1; - -} /* jump */ - -/* - * The actual PEEK engine. - */ -static unsigned char *peek_ext(unsigned char **ext, int jumps) -{ - int i; - - switch (*(*ext)++) - { - case ERL_VERSION_MAGIC: - return peek_ext(ext, jumps); - case ERL_SMALL_TUPLE_EXT: - i = *(*ext)++; - goto do_the_peek_stuff; - case ERL_LARGE_TUPLE_EXT: - case ERL_LIST_EXT: - i = (**ext << 24) | ((*ext)[1]) << 16| ((*ext)[2]) << 8| ((*ext)[3]) ; - *ext += 4; - do_the_peek_stuff: - if (i <= jumps) { -#ifdef DEBUG - erl_err_msg("<ERROR> peek_ext: Out of range"); -#endif - return NULL; - } - for(i=0; i<jumps; i++) - if (!jump(ext)) { -#ifdef DEBUG - erl_err_msg("<ERROR> peek_ext: Bad data"); -#endif - return NULL; - } - return *ext; - default: -#ifdef DEBUG - erl_err_msg("<ERROR> peek_ext: Can't peek in non list/tuple type"); -#endif - return NULL; - } /* switch */ - -} /* peek_ext */ - -/* - * Return a POINTER TO the N:TH ELEMENT in a - * COMPUND ENCODED ETERM. - */ -unsigned char *erl_peek_ext(unsigned char *ext, int jumps) -{ - unsigned char *x=ext; - - return peek_ext(&x, jumps); - -} /* erl_peek_ext */ - -/* - * Lexically compare two strings of bytes, - * (string s1 length l1 and s2 l2). - * Return: -1 if s1 < s2 - * 0 if s1 = s2 - * 1 if s1 > s2 - */ -static int cmpbytes(unsigned char* s1,int l1,unsigned char* s2,int l2) -{ - int i; - i = 0; - while((i < l1) && (i < l2)) { - if (s1[i] < s2[i]) return(-1); - if (s1[i] > s2[i]) return(1); - i++; - } - if (l1 < l2) return(-1); - if (l1 > l2) return(1); - return(0); - -} /* cmpbytes */ - -#define tag2enc(T) ((T)==ERL_ATOM_EXT || (T)==ERL_SMALL_ATOM_EXT ? ERLANG_LATIN1 : ERLANG_UTF8) - -static int cmpatoms(unsigned char* s1, int l1, unsigned char tag1, - unsigned char* s2, int l2, unsigned char tag2) -{ - erlang_char_encoding enc1 = tag2enc(tag1); - erlang_char_encoding enc2 = tag2enc(tag2); - - if (enc1 == enc2) { - return cmpbytes(s1, l1,s2,l2); - } - - if (enc1 == ERLANG_LATIN1) { - return cmp_latin1_vs_utf8((char*)s1, l1, (char*)s2, l2); - } - else { - return -cmp_latin1_vs_utf8((char*)s2, l2, (char*)s1, l1); - } -} - -int cmp_latin1_vs_utf8(const char* strL, int lenL, const char* strU, int lenU) -{ - unsigned char* sL = (unsigned char*)strL; - unsigned char* sU = (unsigned char*)strU; - unsigned char* sL_end = sL + lenL; - unsigned char* sU_end = sU + lenU; - - while(sL < sL_end && sU < sU_end) { - unsigned char UasL; - if (*sL >= 0x80) { - if (*sU < 0xC4 && (sU+1) < sU_end) { - UasL = ((sU[0] & 0x3) << 6) | (sU[1] & 0x3F); - } - else return -1; - } - else { - UasL = *sU; - } - if (*sL < UasL) return -1; - if (*sL > UasL) return 1; - - sL++; - if (*sU < 0x80) sU++; - else if (*sU < 0xE0) sU += 2; - else if (*sU < 0xF0) sU += 3; - else /*if (*sU < 0xF8)*/ sU += 4; - } - - return (sU >= sU_end) - (sL >= sL_end); /* -1, 0 or 1 */ -} - - -#define CMP_EXT_ERROR_CODE 4711 - -#define CMP_EXT_INT32_BE(AP, BP) \ -do { \ - if ((AP)[0] != (BP)[0]) return (AP)[0] < (BP)[0] ? -1 : 1; \ - if ((AP)[1] != (BP)[1]) return (AP)[1] < (BP)[1] ? -1 : 1; \ - if ((AP)[2] != (BP)[2]) return (AP)[2] < (BP)[2] ? -1 : 1; \ - if ((AP)[3] != (BP)[3]) return (AP)[3] < (BP)[3] ? -1 : 1; \ -} while (0) - -#define CMP_EXT_SKIP_ATOM(EP) \ -do { \ - if (!jump_atom(&(EP))) \ - return CMP_EXT_ERROR_CODE; \ -} while (0) - -/* - * We now know that both byte arrays are of the same type. - */ -static int compare_top_ext(unsigned char**, unsigned char **); /* forward */ -static int cmp_exe2(unsigned char **e1, unsigned char **e2); - -static int cmp_refs(unsigned char **e1, unsigned char **e2) -{ - int tmp, n1, n2; - unsigned char *node1, *node2, *id1, *id2, cre1, cre2; - - if (*((*e1)++) == ERL_REFERENCE_EXT) { - node1 = *e1; - CMP_EXT_SKIP_ATOM(*e1); - n1 = 1; - id1 = *e1; - cre1 = (*e1)[4]; - *e1 += 5; - } else { - n1 = get16be(*e1); - node1 = *e1; - CMP_EXT_SKIP_ATOM(*e1); - cre1 = **e1; - id1 = (*e1) + 1 + (n1 - 1)*4; - *e1 = id1 + 4; - } - - if (*((*e2)++) == ERL_REFERENCE_EXT) { - node2 = *e2; - CMP_EXT_SKIP_ATOM(*e2); - n2 = 1; - id2 = *e2; - cre2 = (*e2)[4]; - *e2 += 5; - } else { - n2 = get16be(*e2); - node2 = *e2; - CMP_EXT_SKIP_ATOM(*e2); - cre2 = **e2; - id2 = (*e2) + 1 + (n2 - 1)*4; - *e2 = id2 + 4; - } - - /* First compare node names... */ - tmp = cmp_exe2(&node1, &node2); - if (tmp != 0) - return tmp; - - /* ... then creations ... */ - if (cre1 != cre2) - return cre1 < cre2 ? -1 : 1; - - /* ... and then finally ids. */ - if (n1 != n2) { - unsigned char zero[] = {0, 0, 0, 0}; - if (n1 > n2) - do { - CMP_EXT_INT32_BE(id1, zero); - id1 -= 4; - n1--; - } while (n1 > n2); - else - do { - CMP_EXT_INT32_BE(zero, id2); - id2 -= 4; - n2--; - } while (n2 > n1); - } - - for (; n1 > 0; n1--, id1 -= 4, id2 -= 4) - CMP_EXT_INT32_BE(id1, id2); - - return 0; -} - -static int cmp_string_list(unsigned char **e1, unsigned char **e2) { - - /* we need to compare a string in **e1 and a list in **e2 */ - /* convert the string to list representation and convert that with e2 */ - /* we need a temporary buffer of: */ - /* 5 (list tag + length) + 2*string length + 1 (end of list tag) */ - /* for short lists we use a stack allocated buffer, otherwise we malloc */ - - unsigned char *bp; - unsigned char buf[5+2*255+1]; /* used for short lists */ - int i,e1_len; - int res; - - e1_len = ((*e1)[1] << 8) | ((*e1)[2]); - if ( e1_len < 256 ) { - bp = buf; - } else { - bp = erl_malloc(5+(2*e1_len)+1); - } - - bp[0] = ERL_LIST_EXT; - bp[1] = bp[2] = 0; - bp[3] = (*e1)[1]; - bp[4] = (*e1)[2]; - - for(i=0;i<e1_len;i++) { - bp[5+2*i] = ERL_SMALL_INTEGER_EXT; - bp[5+2*i+1] = (*e1)[3+i]; - } - - bp[5+2*e1_len] = ERL_NIL_EXT; - - res = cmp_exe2(&bp, e2); - - if ( e1_len >= 256 ) free(bp); - - return res; -} - -static int cmp_exe2(unsigned char **e1, unsigned char **e2) -{ - int min, ret,i,j,k; - double ff1, ff2; - unsigned char tag1, tag2; - - if ( ((*e1)[0] == ERL_STRING_EXT) && ((*e2)[0] == ERL_LIST_EXT) ) { - return cmp_string_list(e1, e2); - } else if ( ((*e1)[0] == ERL_LIST_EXT) && ((*e2)[0] == ERL_STRING_EXT) ) { - return -cmp_string_list(e2, e1); - } - - tag1 = *(*e1)++; - tag2 = *(*e2)++; - i = j = 0; - switch (tag1) - { - case ERL_SMALL_INTEGER_EXT: - if (**e1 < **e2) ret = -1; - else if (**e1 > **e2) ret = 1; - else ret = 0; - *e1 += 1; *e2 += 1; - return ret; - case ERL_INTEGER_EXT: - i = (int) (**e1 << 24) | ((*e1)[1] << 16) |((*e1)[2] << 8) | (*e1)[3]; - j = (int) (**e2 << 24) | ((*e2)[1] << 16) |((*e2)[2] << 8) | (*e2)[3]; - if ( i < j) - ret = -1; - else if ( i > j) - ret = 1; - else - ret = 0; - *e1 += 4; *e2 += 4; - return ret; - case ERL_ATOM_EXT: - case ERL_ATOM_UTF8_EXT: - i = (**e1) << 8; (*e1)++; - j = (**e2) << 8; (*e2)++; - /*fall through*/ - case ERL_SMALL_ATOM_EXT: - case ERL_SMALL_ATOM_UTF8_EXT: - i |= (**e1); (*e1)++; - j |= (**e2); (*e2)++; - ret = cmpatoms(*e1, i, tag1, *e2, j, tag2); - *e1 += i; - *e2 += j; - return ret; - case ERL_PID_EXT: - case ERL_NEW_PID_EXT: { - erlang_pid pid1, pid2; - unsigned char* buf1 = *e1 - 1; - unsigned char* buf2 = *e2 - 1; - int ix1 = 0, ix2 = 0; - - if (ei_decode_pid((char*)buf1, &ix1, &pid1) || - ei_decode_pid((char*)buf2, &ix2, &pid2)) - return CMP_EXT_ERROR_CODE; - - *e1 = buf1 + ix1; - *e2 = buf2 + ix2; - - /* First compare serials ... */ - if (pid1.serial < pid2.serial) return -1; - else if (pid1.serial > pid2.serial) return 1; - - /* ... then ids ... */ - if (pid1.num < pid2.num) return -1; - else if (pid1.num > pid2.num) return 1; - - /* ... then node names ... */ - j = strcmp(pid1.node, pid2.node); - if (j < 0) return -1; - else if (j > 0) return 1; - - /* ... and then finaly creations. */ - if (pid1.creation < pid2.creation) return -1; - else if (pid1.creation > pid2.creation) return 1; - - return 0; - } - case ERL_PORT_EXT: - case ERL_NEW_PORT_EXT: { - erlang_port port1, port2; - unsigned char* buf1 = *e1 - 1; - unsigned char* buf2 = *e2 - 1; - int ix1 = 0, ix2 = 0; - - if (ei_decode_port((char*)buf1, &ix1, &port1) || - ei_decode_port((char*)buf2, &ix2, &port2)) - return CMP_EXT_ERROR_CODE; - - *e1 = buf1 + ix1; - *e2 = buf2 + ix2; - - /* First compare node names ... */ - j = strcmp(port1.node, port2.node); - if (j < 0) return -1; - else if (j > 0) return 1; - - /* ... then creations ... */ - if (port1.creation < port2.creation) return -1; - else if (port1.creation > port2.creation) return 1; - - /* ... and then finally ids. */ - if (port1.id < port2.id) return -1; - else if (port1.id > port2.id) return 1; - - return 0; - } - case ERL_NIL_EXT: return 0; - case ERL_LIST_EXT: - i = (**e1 << 24) | ((*e1)[1] << 16) |((*e1)[2] << 8) | (*e1)[3]; - *e1 += 4; - j = (**e2 << 24) | ((*e2)[1] << 16) |((*e2)[2] << 8) | (*e2)[3]; - *e2 += 4; - if ( i == j && j == 0 ) return 0; - min = (i < j) ? i : j; - k = 0; - while (1) { - if (k++ == min){ - if (i == j) return compare_top_ext(e1 , e2); - if (i < j) return -1; - return 1; - } - if ((ret = compare_top_ext(e1 , e2)) == 0) - continue; - return ret; - } - case ERL_STRING_EXT: - i = (**e1 << 8) | ((*e1)[1]); - *e1 += 2; - j = (**e2 << 8) | ((*e2)[1]); - *e2 += 2; - ret = cmpbytes(*e1, i, *e2, j); - *e1 += i; - *e2 += j; - return ret; - case ERL_SMALL_TUPLE_EXT: - i = *(*e1)++; j = *(*e2)++; - if (i < j) return -1; - if (i > j ) return 1; - while (i--) { - if ((j = compare_top_ext(e1, e2))) return j; - } - return 0; - case ERL_LARGE_TUPLE_EXT: - i = (**e1 << 24) | ((*e1)[1]) << 16| ((*e1)[2]) << 8| ((*e1)[3]) ; - *e1 += 4; - j = (**e2 << 24) | ((*e2)[1]) << 16| ((*e2)[2]) << 8| ((*e2)[3]) ; - *e2 += 4; - if (i < j) return -1; - if (i > j ) return 1; - while (i--) { - if ((j = compare_top_ext(e1, e2))) return j; - } - return 0; - case ERL_FLOAT_EXT: - case NEW_FLOAT_EXT: - i = -1; - if (ei_decode_double((char *) *e1, &i, &ff1) != 0) - return -1; - *e1 += i; - j = -1; - if (ei_decode_double((char *) *e2, &j, &ff2) != 0) - return -1; - *e2 += j; - return cmp_floats(ff1,ff2); - - case ERL_BINARY_EXT: - i = (**e1 << 24) | ((*e1)[1] << 16) |((*e1)[2] << 8) | (*e1)[3]; - *e1 += 4; - j = (**e2 << 24) | ((*e2)[1] << 16) |((*e2)[2] << 8) | (*e2)[3]; - *e2 += 4; - ret = cmpbytes(*e1, i , *e2 , j); - *e1 += i; *e2 += j; - return ret; - - case ERL_FUN_EXT: /* FIXME: */ - case ERL_NEW_FUN_EXT: /* FIXME: */ - return -1; - - default: - return cmpbytes(*e1, 1, *e2, 1); - - } /* switch */ - -} /* cmp_exe2 */ - -/* Number compare */ - -static int cmp_floats(double f1, double f2) -{ -#if defined(VXWORKS) && CPU == PPC860 - return erl_fp_compare((unsigned *) &f1, (unsigned *) &f2); -#else - if (f1<f2) return -1; - else if (f1>f2) return 1; - else return 0; -#endif -} - -static INLINE double to_float(long l) -{ - double f; -#if defined(VXWORKS) && CPU == PPC860 - erl_long_to_fp(l, (unsigned *) &f); -#else - f = l; -#endif - return f; -} - - -static int cmp_small_big(unsigned char**e1, unsigned char **e2) -{ - int i1,i2; - int t2; - int n2; - long l1; - int res; - - erlang_big *b1,*b2; - - i1 = i2 = 0; - if ( ei_decode_long((char *)*e1,&i1,&l1) < 0 ) return -1; - - ei_get_type((char *)*e2,&i2,&t2,&n2); - - /* any small will fit in two digits */ - if ( (b1 = ei_alloc_big(2)) == NULL ) return -1; - if ( ei_small_to_big(l1,b1) < 0 ) { - ei_free_big(b1); - return -1; - } - - if ( (b2 = ei_alloc_big(n2)) == NULL ) { - ei_free_big(b1); - return 1; - } - - if ( ei_decode_big((char *)*e2,&i2,b2) < 0 ) { - ei_free_big(b1); - ei_free_big(b2); - return 1; - } - - res = ei_big_comp(b1,b2); - - ei_free_big(b1); - ei_free_big(b2); - - *e1 += i1; - *e2 += i2; - - return res; -} - -static int cmp_small_float(unsigned char**e1, unsigned char **e2) -{ - int i1,i2; - long l1; - double f1,f2; - - /* small -> float -> float_comp */ - - i1 = i2 = 0; - if ( ei_decode_long((char *)*e1,&i1,&l1) < 0 ) return -1; - if ( ei_decode_double((char *)*e2,&i2,&f2) < 0 ) return 1; - - f1 = to_float(l1); - - *e1 += i1; - *e2 += i2; - - return cmp_floats(f1,f2); -} - -static int cmp_float_big(unsigned char**e1, unsigned char **e2) -{ - int res; - int i1,i2; - int t2,n2; - double f1,f2; - erlang_big *b2; - - /* big -> float if overflow return big sign else float_comp */ - - i1 = i2 = 0; - if ( ei_decode_double((char *)*e1,&i1,&f1) < 0 ) return -1; - - if (ei_get_type((char *)*e2,&i2,&t2,&n2) < 0) return 1; - if ((b2 = ei_alloc_big(n2)) == NULL) return 1; - if (ei_decode_big((char *)*e2,&i2,b2) < 0) return 1; - - /* convert the big to float */ - if ( ei_big_to_double(b2,&f2) < 0 ) { - /* exception look at the sign */ - res = b2->is_neg ? 1 : -1; - ei_free_big(b2); - return res; - } - - ei_free_big(b2); - - *e1 += i1; - *e2 += i2; - - return cmp_floats(f1,f2); -} - -static int cmp_small_small(unsigned char**e1, unsigned char **e2) -{ - int i1,i2; - long l1,l2; - - i1 = i2 = 0; - if ( ei_decode_long((char *)*e1,&i1,&l1) < 0 ) { - fprintf(stderr,"Failed to decode 1\r\n"); - return -1; - } - if ( ei_decode_long((char *)*e2,&i2,&l2) < 0 ) { - fprintf(stderr,"Failed to decode 2\r\n"); - return 1; - } - - *e1 += i1; - *e2 += i2; - - if ( l1 < l2 ) return -1; - else if ( l1 > l2 ) return 1; - else return 0; -} - -static int cmp_float_float(unsigned char**e1, unsigned char **e2) -{ - int i1,i2; - double f1,f2; - - i1 = i2 = 0; - if ( ei_decode_double((char *)*e1,&i1,&f1) < 0 ) return -1; - if ( ei_decode_double((char *)*e2,&i2,&f2) < 0 ) return 1; - - *e1 += i1; - *e2 += i2; - - return cmp_floats(f1,f2); -} - -static int cmp_big_big(unsigned char**e1, unsigned char **e2) -{ - int res; - int i1,i2; - int t1,t2; - int n1,n2; - erlang_big *b1,*b2; - - i1 = i2 = 0; - ei_get_type((char *)*e1,&i1,&t1,&n1); - ei_get_type((char *)*e2,&i2,&t2,&n2); - - if ( (b1 = ei_alloc_big(n1)) == NULL) return -1; - if ( (b2 = ei_alloc_big(n2)) == NULL) { - ei_free_big(b1); - return 1; - } - - ei_decode_big((char *)*e1,&i1,b1); - ei_decode_big((char *)*e2,&i2,b2); - - res = ei_big_comp(b1,b2); - - ei_free_big(b1); - ei_free_big(b2); - - *e1 += i1; - *e2 += i2; - - return res; -} - -static int cmp_number(unsigned char**e1, unsigned char **e2) -{ - switch (CMP_NUM_CODE(**e1,**e2)) { - - case SMALL_BIG: - /* fprintf(stderr,"compare small_big\r\n"); */ - return cmp_small_big(e1,e2); - - case BIG_SMALL: - /* fprintf(stderr,"compare sbig_small\r\n"); */ - return -cmp_small_big(e2,e1); - - case SMALL_FLOAT: - /* fprintf(stderr,"compare small_float\r\n"); */ - return cmp_small_float(e1,e2); - - case FLOAT_SMALL: - /* fprintf(stderr,"compare float_small\r\n"); */ - return -cmp_small_float(e2,e1); - - case FLOAT_BIG: - /* fprintf(stderr,"compare float_big\r\n"); */ - return cmp_float_big(e1,e2); - - case BIG_FLOAT: - /* fprintf(stderr,"compare big_float\r\n"); */ - return -cmp_float_big(e2,e1); - - case SMALL_SMALL: - /* fprintf(stderr,"compare small_small\r\n"); */ - return cmp_small_small(e1,e2); - - case FLOAT_FLOAT: - /* fprintf(stderr,"compare float_float\r\n"); */ - return cmp_float_float(e1,e2); - - case BIG_BIG: - /* fprintf(stderr,"compare big_big\r\n"); */ - return cmp_big_big(e1,e2); - - default: - /* should never get here ... */ - /* fprintf(stderr,"compare standard\r\n"); */ - return cmp_exe2(e1,e2); - } - -} - -/* - * If the arrays are of the same type, then we - * have to do a real compare. - */ -/* - * COMPARE TWO encoded BYTE ARRAYS e1 and e2. - * Return: -1 if e1 < e2 - * 0 if e1 == e2 - * 1 if e2 > e1 - */ -static int compare_top_ext(unsigned char**e1, unsigned char **e2) -{ - if (**e1 == ERL_VERSION_MAGIC) (*e1)++; - if (**e2 == ERL_VERSION_MAGIC) (*e2)++; - - if (cmp_array[**e1] < cmp_array[**e2]) return -1; - if (cmp_array[**e1] > cmp_array[**e2]) return 1; - - if (IS_ERL_NUM(**e1)) - return cmp_number(e1,e2); - - if (cmp_array[**e1] == ERL_REF_CMP) - return cmp_refs(e1, e2); - - return cmp_exe2(e1, e2); -} - -int erl_compare_ext(unsigned char *e1, unsigned char *e2) -{ - return compare_top_ext(&e1, &e2); -} /* erl_compare_ext */ - -#if defined(VXWORKS) && CPU == PPC860 -/* FIXME we have no floating point but don't we have emulation?! */ -int erl_fp_compare(unsigned *a, unsigned *b) -{ - /* Big endian mode of powerPC, IEEE floating point. */ - unsigned a_split[4] = {a[0] >> 31, /* Sign bit */ - (a[0] >> 20) & 0x7FFU, /* Exponent */ - a[0] & 0xFFFFFU, /* Mantissa MS bits */ - a[1]}; /* Mantissa LS bits */ - unsigned b_split[4] = {b[0] >> 31, - (b[0] >> 20) & 0x7FFU, - b[0] & 0xFFFFFU, - b[1]}; - int a_is_infinite, b_is_infinite; - int res; - - - /* Make -0 be +0 */ - if (a_split[1] == 0 && a_split[2] == 0 && a_split[3] == 0) - a_split[0] = 0; - if (b_split[1] == 0 && b_split[2] == 0 && b_split[3] == 0) - b_split[0] = 0; - /* Check for infinity */ - a_is_infinite = (a_split[1] == 0x7FFU && a_split[2] == 0 && - a_split[3] == 0); - b_is_infinite = (b_split[1] == 0x7FFU && b_split[2] == 0 && - b_split[3] == 0); - - if (a_is_infinite && !b_is_infinite) - return (a_split[0]) ? -1 : 1; - if (b_is_infinite && !a_is_infinite) - return (b_split[0]) ? 1 : -1; - if (a_is_infinite && b_is_infinite) - return b[0] - a[0]; - /* Check for indeterminate or nan, infinite is already handled, - so we only check the exponent. */ - if((a_split[1] == 0x7FFU) || (b_split[1] == 0x7FFU)) - return INT_MAX; /* Well, they are not equal anyway, - abort() could be an alternative... */ - - if (a_split[0] && !b_split[0]) - return -1; - if (b_split[0] && !a_split[0]) - return 1; - /* Compare */ - res = memcmp(a_split + 1, b_split + 1, 3 * sizeof(unsigned)); - /* Make -1, 0 or 1 */ - res = (!!res) * ((res < 0) ? -1 : 1); - /* Turn sign if negative values */ - if (a_split[0]) /* Both are negative */ - res = -1 * res; - return res; -} - -static void join(unsigned d_split[4], unsigned *d) -{ - d[0] = (d_split[0] << 31) | /* Sign bit */ - ((d_split[1] & 0x7FFU) << 20) | /* Exponent */ - (d_split[2] & 0xFFFFFU); /* Mantissa MS bits */ - d[1] = d_split[3]; /* Mantissa LS bits */ -} - -static int blength(unsigned long l) -{ - int i; - for(i = 0; l; ++i) - l >>= 1; - return i; -} - -static void erl_long_to_fp(long l, unsigned *d) -{ - unsigned d_split[4]; - unsigned x; - if (l < 0) { - d_split[0] = 1; - x = -l; - } else { - d_split[0] = 0; - x = l; - } - - if (!l) { - memset(d_split,0,sizeof(d_split)); - } else { - int len = blength(x); - x <<= (33 - len); - d_split[2] = (x >> 12); - d_split[3] = (x << 20); - d_split[1] = 1023 + len - 1; - } - join(d_split,d); -} - -#endif - - -/* - * Checks if a term is a "string": a flat list of byte-sized integers. - * - * Returns: 0 if the term is not a string, otherwise the length is returned. - */ - -static int is_string(ETERM* term) -{ - int len = 0; - - while (ERL_TYPE(term) == ERL_LIST) { - ETERM* head = HEAD(term); - - if (!ERL_IS_INTEGER(head) || ((unsigned)head->uval.ival.i) > 255) { - return 0; - } - len++; - term = TAIL(term); - } - - if (ERL_IS_EMPTY_LIST(term)) { - return len; - } - return 0; -} diff --git a/lib/erl_interface/src/legacy/erl_marshal.h b/lib/erl_interface/src/legacy/erl_marshal.h deleted file mode 100644 index c1963b832d..0000000000 --- a/lib/erl_interface/src/legacy/erl_marshal.h +++ /dev/null @@ -1,30 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef _ERL_MARSHALL_H -#define _ERL_MARSHALL_H - -#include "erl_eterm.h" /* FIXME don't want to include this here */ - -/* FIXME: not documented, may be internal */ -int erl_verify_magic(unsigned char*); -void erl_init_marshal(void); -int erl_encode_it(ETERM *ep, unsigned char **ext, int dist); - -#endif /* _ERL_MARSHALL_H */ diff --git a/lib/erl_interface/src/legacy/erl_resolve.c b/lib/erl_interface/src/legacy/erl_resolve.c deleted file mode 100644 index bb09caec85..0000000000 --- a/lib/erl_interface/src/legacy/erl_resolve.c +++ /dev/null @@ -1,107 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2003-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/*************************************************************************** - * - * Compatibility with the old erl_interface library that had some - * undocumented functions. - * - ***************************************************************************/ - -#include "eidef.h" - -#include "erl_interface.h" -#include "ei_resolve.h" -#include "ei_connect_int.h" -#include "ei_epmd.h" - -struct hostent *erl_gethostbyname(const char *name) -{ - return ei_gethostbyname(name); -} - - -void erl_init_resolve(void) -{ - ei_init_resolve(); -} - - -struct hostent *erl_gethostbyaddr(const char *addr, int len, int type) -{ - return ei_gethostbyaddr(addr, len, type); -} - - -struct hostent *erl_gethostbyname_r(const char *name, - struct hostent *hostp, - char *buffer, - int buflen, - int *h_errnop) -{ - return ei_gethostbyname_r(name,hostp,buffer,buflen,h_errnop); -} - - -struct hostent *erl_gethostbyaddr_r(const char *addr, - int length, - int type, - struct hostent *hostp, - char *buffer, - int buflen, - int *h_errnop) -{ - return ei_gethostbyaddr_r(addr,length,type,hostp,buffer,buflen,h_errnop); -} - - -int erl_distversion(int fd) -{ - return ei_distversion(fd); -} - -int erl_epmd_connect(struct in_addr *inaddr) -{ - return ei_epmd_connect_tmo(inaddr,0); -} - -int erl_epmd_port(struct in_addr *inaddr, const char *alive, int *dist) -{ - return ei_epmd_port(inaddr, alive, dist); -} - - - -/* FIXME !!!!! -erl_epmd_port ei_epmd_port -erl_mutex_lock ei_mutex_lock -erl_malloc erl_free ???? -erl_publish erl_unpublish -< extern int erl_epmd_connect(struct in_addr *inaddr); -< extern int erl_epmd_publish(int port, const char *alive); -< extern int erl_epmd_port(struct in_addr *inaddr, const char *alive, int *dist); - -< int erl_unpublish(const char *alive) ---- -> int ei_unpublish_alive(const char *alive) - -erl_self -erl_getfdcookie -*/ diff --git a/lib/erl_interface/src/legacy/erl_timeout.c b/lib/erl_interface/src/legacy/erl_timeout.c deleted file mode 100644 index e36ea0e250..0000000000 --- a/lib/erl_interface/src/legacy/erl_timeout.c +++ /dev/null @@ -1,163 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -/* timeout.c - * - * todo: use posix timers (timer_create etc) instead of setitimer. - * - */ -#if !defined(__WIN32__) && !defined(VXWORKS) - -/* FIXME: well, at least I can compile now... */ - -#include "eidef.h" - -#include <stdio.h> -#include <stdlib.h> -#include <setjmp.h> -#include <signal.h> - -#if TIME_WITH_SYS_TIME -# include <sys/time.h> -# include <time.h> -#else -# if HAVE_SYS_TIME_H -# include <sys/time.h> -# else -# include <time.h> -# endif -#endif - -#include "erl_interface.h" -#include "erl_timeout.h" - -typedef struct jmp_s { - jmp_buf jmpbuf; - struct itimerval timerinfo; - void *siginfo; - struct jmp_s *next; -} *jmp_t; - -static jmp_t push(jmp_t j); -static jmp_t pop(void); -static void timeout_handler(int dummy); - -jmp_buf *timeout_setup(int ms) -{ - struct itimerval t; - jmp_t j; - void *s; - -#ifdef DEBUG - fprintf(stderr,"timeout setup\n"); -#endif - s=signal(SIGALRM,timeout_handler); - - /* set the timer */ - t.it_interval.tv_sec = 0; - t.it_interval.tv_usec = 0; - t.it_value.tv_sec = ms / 1000; - t.it_value.tv_usec = (ms % 1000) * 1000; - - /* get a jump buffer and save it */ - j = erl_malloc(sizeof(*j)); - j->siginfo = s; - push(j); - - setitimer(ITIMER_REAL,&t,&(j->timerinfo)); - - return &(j->jmpbuf); -} - - -int timeout_cancel(void) -{ - jmp_t j; - -#ifdef DEBUG - fprintf(stderr,"timeout cancel\n"); -#endif - /* retrieve the jump buffer */ - j=pop(); - /* restore the timer and signal disposition */ - setitimer(ITIMER_REAL,&(j->timerinfo),NULL); - signal(SIGALRM,j->siginfo); - - free(j); - - return 0; -} - -void timeout_handler(int dummy) -{ - jmp_t j; - -#ifdef DEBUG - fprintf(stderr,"timeout handler\n"); -#endif - - /* retrieve the jump buffer */ - j=pop(); - - /* restore the timer and signal disposition */ - setitimer(ITIMER_REAL,&(j->timerinfo),NULL); - signal(SIGALRM,j->siginfo); - - free(j); - longjmp(j->jmpbuf,JMPVAL); - return; /* not reached */ -} - - -/* a simple stack for saving the jump buffer allows us to pass a - * variable between functions that don't call each other, in a way - * that will survive the longjmp(). - */ - -/* FIXME problem for threaded ? */ -static jmp_t jmp_head=NULL; -#ifdef DEBUG -static int depth = 0; -static int maxdepth = 0; -#endif - -static jmp_t push(jmp_t j) -{ - j->next = jmp_head; - jmp_head = j; - -#ifdef DEBUG - depth++; - if (depth > maxdepth) maxdepth = depth; -#endif - - return j; -} - -static jmp_t pop(void) -{ - jmp_t j = jmp_head; - if (j) jmp_head = j->next; -#ifdef DEBUG - depth--; -#endif - return j; -} - -#endif /* platform */ diff --git a/lib/erl_interface/src/legacy/erl_timeout.h b/lib/erl_interface/src/legacy/erl_timeout.h deleted file mode 100644 index 6bcfa5ecbb..0000000000 --- a/lib/erl_interface/src/legacy/erl_timeout.h +++ /dev/null @@ -1,75 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ -#ifndef _ERL_TIMEOUT_H -#define _ERL_TIMEOUT_H - -#if !defined (__WIN32__) && !defined (VXWORKS) - -#include <setjmp.h> - -/* - use timeout like this (delay in ms): - - if (timeout(delay,fun(a,b,c))) { - printf("timeout occurred\n"); - } - else { - ... - } - -If the call to fun() has not returned before 'delay' ms, it will be -interrupted and and timeout() will return a non-zero value. - -If fun() finishes before 'delay' ms, then timeout will return 0. - -If you need the return value from fun then assign it like this: - - if (timeout(delay,(x = fun(...)))) { - } - -These functions work by setting and catching SIGALRM, and although it -saves and restores the signal handler, it may not work in situations -where you are already using SIGALRM (this includes calls to sleep(3)). - -Note that although recursive calls to timeout will not fail, they may -not give the expected results. All invocations of timeout use the same -timer, which is set on entrance to timeout and restored on exit from -timeout. So although an inner call to timeout will restart the timer -for any pending outer call when it exits, any time that has already -elapsed against the outer timeout is forgotten. In addition, the alarm -signal will always go to the innermost (last called) timeout, which -may or may not be the intention in recursive cases. - -*/ - -#define JMPVAL 997 /* magic */ - -#define timeout(ms,funcall) \ - (setjmp(*timeout_setup(ms)) == JMPVAL ? -1: \ - ((void)(funcall), timeout_cancel())) - - -/* don't call any of these directly - use the macro! see above! */ -jmp_buf *timeout_setup(int ms); -int timeout_cancel(void); - -#endif /* WIN32 && VXWORKS */ - -#endif /* _ERL_TIMEOUT_H */ diff --git a/lib/erl_interface/src/legacy/portability.h b/lib/erl_interface/src/legacy/portability.h deleted file mode 100644 index 42a78662d5..0000000000 --- a/lib/erl_interface/src/legacy/portability.h +++ /dev/null @@ -1,34 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2000-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifndef _PORTABILITY_H -#define _PORTABILITY_H - -#if !defined(__GNUC__) || __GNUC__ < 2 - -/* - * GCC's attributes are too useful to not use. Other compilers - * just lose opportunities to optimize and warn. - */ -# define __attribute__(foo) /* nothing */ - -#endif - -#endif /* _PORTABILITY_H */ diff --git a/lib/erl_interface/src/misc/ei_format.c b/lib/erl_interface/src/misc/ei_format.c index a188171f40..695c3404f7 100644 --- a/lib/erl_interface/src/misc/ei_format.c +++ b/lib/erl_interface/src/misc/ei_format.c @@ -24,10 +24,6 @@ * ei_format to build binary format terms a bit like printf */ -#ifdef VXWORKS -#include <vxWorks.h> -#endif - #include <stdio.h> #include <stdlib.h> #include <stdarg.h> diff --git a/lib/erl_interface/src/misc/ei_locking.c b/lib/erl_interface/src/misc/ei_locking.c index a5ddbb85f2..20464869ad 100644 --- a/lib/erl_interface/src/misc/ei_locking.c +++ b/lib/erl_interface/src/misc/ei_locking.c @@ -26,7 +26,7 @@ /* Note that these locks are NOT recursive on Win32 or Solaris, * i.e. self-deadlock will occur if a thread tries to obtain a lock it - * is already holding. The primitives used on VxWorks are recursive however. + * is already holding. */ #include "eidef.h" @@ -36,10 +36,6 @@ #include <windows.h> #include <winbase.h> -#elif VXWORKS -#include <vxWorks.h> -#include <semLib.h> - #else /* unix */ #include <stdlib.h> #include <unistd.h> @@ -63,12 +59,6 @@ ei_mutex_t *ei_mutex_create(void) #ifdef __WIN32__ l->lock = CreateMutex(NULL,FALSE,NULL); - -#elif VXWORKS - if (!(l->lock = semMCreate(SEM_DELETE_SAFE))) { - ei_free(l); - return NULL; - } #else /* unix */ l->lock = ei_m_create(); #endif @@ -97,10 +87,6 @@ int ei_mutex_free(ei_mutex_t *l, int nblock) /* we are now holding the lock */ #ifdef __WIN32__ CloseHandle(l->lock); - -#elif VXWORKS - if (semDelete(l->lock) == ERROR) return -1; - #else /* unix */ ei_m_destroy(l->lock); #endif @@ -131,11 +117,6 @@ int ei_mutex_lock(ei_mutex_t *l, int nblock) /* check valid values for timeout: is 0 ok? */ if (WaitForSingleObject(l->lock,(nblock? 0 : INFINITE)) != WAIT_OBJECT_0) return -1; - -#elif VXWORKS - if (semTake(l->lock,(nblock? NO_WAIT : WAIT_FOREVER)) == ERROR) - return -1; - #else /* unix */ if (nblock) { if (ei_m_trylock(l->lock) < 0) return -1; @@ -151,10 +132,6 @@ int ei_mutex_unlock(ei_mutex_t *l) { #ifdef __WIN32__ ReleaseMutex(l->lock); - -#elif VXWORKS - semGive(l->lock); - #else /* unix */ ei_m_unlock(l->lock); #endif diff --git a/lib/erl_interface/src/misc/ei_locking.h b/lib/erl_interface/src/misc/ei_locking.h index 1bbee2d499..93aade6b2d 100644 --- a/lib/erl_interface/src/misc/ei_locking.h +++ b/lib/erl_interface/src/misc/ei_locking.h @@ -24,11 +24,6 @@ #include "config.h" -#if defined(VXWORKS) -#include <taskLib.h> -#include <taskVarLib.h> -#endif - #ifdef __WIN32__ #include <winsock2.h> #include <windows.h> @@ -45,8 +40,6 @@ typedef struct ei_mutex_s { #ifdef __WIN32__ HANDLE lock; -#elif VXWORKS - SEM_ID lock; #else /* unix */ #if defined(HAVE_MIT_PTHREAD_H) || defined(HAVE_PTHREAD_H) pthread_mutex_t *lock; @@ -64,7 +57,7 @@ int ei_mutex_lock(ei_mutex_t *l, int nblock); int ei_mutex_unlock(ei_mutex_t *l); -#if defined(_REENTRANT) && !defined(VXWORKS) && !defined(__WIN32__) +#if defined(_REENTRANT) && !defined(__WIN32__) void *ei_m_create(void); int ei_m_destroy(void *l); @@ -72,6 +65,6 @@ int ei_m_lock(void *l); int ei_m_trylock(void *l); int ei_m_unlock(void *l); -#endif /* _REENTRANT && !VXWORKS && !__WIN32__ */ +#endif /* _REENTRANT && !__WIN32__ */ #endif /* _EI_LOCKING_H */ diff --git a/lib/erl_interface/src/misc/ei_portio.c b/lib/erl_interface/src/misc/ei_portio.c index bccc86c1b1..afa766a776 100644 --- a/lib/erl_interface/src/misc/ei_portio.c +++ b/lib/erl_interface/src/misc/ei_portio.c @@ -42,29 +42,7 @@ static unsigned long param_one = 1; #define MEANS_SOCKET_ERROR(Ret) ((Ret == SOCKET_ERROR)) #define IS_INVALID_SOCKET(Sock) ((Sock) == INVALID_SOCKET) -#elif VXWORKS -#include <vxWorks.h> -#include <hostLib.h> -#include <ifLib.h> -#include <sockLib.h> -#include <taskLib.h> -#include <inetLib.h> -#include <selectLib.h> -#include <ioLib.h> -#include <unistd.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netinet/tcp.h> -#include <timers.h> - -static unsigned long param_zero = 0; -static unsigned long param_one = 1; -#define SET_BLOCKING(Sock) ioctl((Sock),FIONBIO,(int)¶m_zero) -#define SET_NONBLOCKING(Sock) ioctl((Sock),FIONBIO,(int)¶m_one) -#define MEANS_SOCKET_ERROR(Ret) ((Ret) == ERROR) -#define IS_INVALID_SOCKET(Sock) ((Sock) < 0) - -#else /* other unix */ +#else /* unix */ #include <stdlib.h> #include <sys/socket.h> #include <unistd.h> @@ -622,7 +600,7 @@ int ei_accept_ctx_t__(ei_socket_callbacks *cbs, void **ctx, } while (error == EINTR); } do { - error = cbs->accept(ctx, addr, len, ms); + error = cbs->EI_ACCEPT_NAME(ctx, addr, len, ms); } while (error == EINTR); return error; } diff --git a/lib/erl_interface/src/misc/ei_portio.h b/lib/erl_interface/src/misc/ei_portio.h index 5172d085b4..b47b220d51 100644 --- a/lib/erl_interface/src/misc/ei_portio.h +++ b/lib/erl_interface/src/misc/ei_portio.h @@ -23,7 +23,7 @@ #define _EI_PORTIO_H #undef EI_HAVE_STRUCT_IOVEC__ -#if !defined(__WIN32__) && !defined(VXWORKS) && defined(HAVE_SYS_UIO_H) +#if !defined(__WIN32__) && defined(HAVE_SYS_UIO_H) /* Declaration of struct iovec *iov should be visible in this scope. */ # include <sys/uio.h> # define EI_HAVE_STRUCT_IOVEC__ diff --git a/lib/erl_interface/src/misc/ei_printterm.c b/lib/erl_interface/src/misc/ei_printterm.c index aee7f7eeb0..0dfecb6d4b 100644 --- a/lib/erl_interface/src/misc/ei_printterm.c +++ b/lib/erl_interface/src/misc/ei_printterm.c @@ -24,10 +24,6 @@ * ei_print_term to print out a binary coded term */ -#ifdef VXWORKS -#include <vxWorks.h> -#endif - #include <stdio.h> #include <stdlib.h> #include <stdarg.h> diff --git a/lib/erl_interface/src/misc/ei_pthreads.c b/lib/erl_interface/src/misc/ei_pthreads.c index c6d07a9a0a..df7a7fbb8f 100644 --- a/lib/erl_interface/src/misc/ei_pthreads.c +++ b/lib/erl_interface/src/misc/ei_pthreads.c @@ -38,25 +38,6 @@ static LONG volatile tls_init_mutex = 0; #endif #endif -#if defined(VXWORKS) - -/* - Moved to each of the erl_*threads.c files, as they seem to know how - to get thread-safety. -*/ -static volatile int __erl_errno; -volatile int *__erl_errno_place(void) -{ - /* This check is somewhat insufficient, double task var entries will occur - if __erl_errno is actually -1, which on the other hand is an invalid - error code. */ - if (taskVarGet(taskIdSelf(), &__erl_errno) == ERROR) { - taskVarAdd(taskIdSelf(), &__erl_errno); - } - return &__erl_errno; -} -#endif /* VXWORKS */ - #if defined(__WIN32__) #ifdef USE_DECLSPEC_THREAD @@ -106,7 +87,7 @@ volatile int *__erl_errno_place(void) #endif /* __WIN32__ */ -#if defined(_REENTRANT) && !defined(VXWORKS) && !defined(__WIN32__) +#if defined(_REENTRANT) && !defined(__WIN32__) #if defined(HAVE_PTHREAD_H) || defined(HAVE_MIT_PTHREAD_H) @@ -219,9 +200,9 @@ volatile int *__erl_errno_place(void) #endif /* HAVE_PTHREAD_H || HAVE_MIT_PTHREAD_H */ -#endif /* _REENTRANT && !VXWORKS && !__WIN32__ */ +#endif /* _REENTRANT && !__WIN32__ */ -#if !defined(_REENTRANT) && !defined(VXWORKS) && !defined(__WIN32__) +#if !defined(_REENTRANT) && !defined(__WIN32__) volatile int __erl_errno; diff --git a/lib/erl_interface/src/misc/ei_x_encode.c b/lib/erl_interface/src/misc/ei_x_encode.c index 8e77679d2a..fe3c20faff 100644 --- a/lib/erl_interface/src/misc/ei_x_encode.c +++ b/lib/erl_interface/src/misc/ei_x_encode.c @@ -23,10 +23,6 @@ * ei_x_encode to encode in a self-expanding buffer */ -#ifdef VXWORKS -#include <vxWorks.h> -#endif - #include <stdio.h> #include <stdlib.h> #include <string.h> diff --git a/lib/erl_interface/src/misc/eidef.h b/lib/erl_interface/src/misc/eidef.h index f38824d826..f1fdafaa08 100644 --- a/lib/erl_interface/src/misc/eidef.h +++ b/lib/erl_interface/src/misc/eidef.h @@ -27,11 +27,6 @@ #include "config.h" /* Central include of config.h */ -/* vxWorks.h needs to be before stddef.h */ -#ifdef VXWORKS -#include <vxWorks.h> -#endif - #include <stddef.h> /* We want to get definition of NULL */ #include "ei.h" /* Want the API function declarations */ diff --git a/lib/erl_interface/src/not_used/ei_send.c b/lib/erl_interface/src/not_used/ei_send.c deleted file mode 100644 index 8071876677..0000000000 --- a/lib/erl_interface/src/not_used/ei_send.c +++ /dev/null @@ -1,105 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2001-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - * - - */ -#ifdef __WIN32__ -#include <winsock2.h> -#include <windows.h> -#include <winbase.h> - -#elif VXWORKS -#include <sys/types.h> -#include <unistd.h> - -#else /* unix */ -#include <sys/types.h> -#include <unistd.h> -#include <sys/uio.h> -#endif - -#include "eidef.h" -#include "eiext.h" -#include "ei_connect.h" -#include "ei_internal.h" -#include "putget.h" -#include "ei_trace.h" -#include "show_msg.h" - -/* FIXME this is not useed !!!!! */ - -/* length (4), PASS_THROUGH (1), header, message */ -int ei_ei_send_encoded(ei_cnode* ec, int fd, const erlang_pid *to, - const char *msg, int msglen) -{ - char *s, header[1200]; /* see size calculation below */ - erlang_trace *token = NULL; - int index = 5; /* reserve 5 bytes for control message */ -#ifdef HAVE_WRITEV - struct iovec v[2]; -#endif - - /* are we tracing? */ - /* check that he can receive trace tokens first */ - if (ei_distversion(fd) > 0) - token = ei_trace(0,(erlang_trace *)NULL); - - /* header = SEND, cookie, to max sizes: */ - ei_encode_version(header,&index); /* 1 */ - if (token) { - ei_encode_tuple_header(header,&index,4); /* 2 */ - ei_encode_long(header,&index,ERL_SEND_TT); /* 2 */ - } else { - ei_encode_tuple_header(header,&index,3); - ei_encode_long(header,&index,ERL_SEND); - } - ei_encode_atom(header,&index, "" /*ei_getfdcookie(ec, fd)*/); /* 258 */ - ei_encode_pid(header,&index,to); /* 268 */ - - if (token) ei_encode_trace(header,&index,token); /* 534 */ - - /* control message (precedes header actually) */ - /* length = 1 ('p') + header len + message len */ - s = header; - put32be(s, index + msglen - 4); /* 4 */ - put8(s, ERL_PASS_THROUGH); /* 1 */ - /*** sum: 1070 */ - -#ifdef DEBUG_DIST - if (ei_trace_distribution > 0) ei_show_sendmsg(stderr,header,msg); -#endif - -#ifdef HAVE_WRITEV - - v[0].iov_base = (char *)header; - v[0].iov_len = index; - v[1].iov_base = (char *)msg; - v[1].iov_len = msglen; - - if (writev(fd,v,2) != index+msglen) return -1; - -#else /* !HAVE_WRITEV */ - - if (writesocket(fd,header,index) != index) return -1; - if (writesocket(fd,msg,msglen) != msglen) return -1; - -#endif /* !HAVE_WRITEV */ - - return 0; -} diff --git a/lib/erl_interface/src/not_used/ei_send_reg.c b/lib/erl_interface/src/not_used/ei_send_reg.c deleted file mode 100644 index ba9c7348f9..0000000000 --- a/lib/erl_interface/src/not_used/ei_send_reg.c +++ /dev/null @@ -1,108 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2001-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - * - - */ -#ifdef __WIN32__ -#include <winsock2.h> -#include <windows.h> -#include <winbase.h> - -#elif VXWORKS -#include <sys/types.h> -#include <unistd.h> - -#else /* unix */ -#include <sys/types.h> -#include <unistd.h> -#include <sys/uio.h> -#endif - -#include "eidef.h" -#include "eiext.h" -#include "ei_connect.h" -#include "ei_internal.h" -#include "putget.h" -#include "ei_trace.h" -#include "show_msg.h" - -/* FIXME this is not useed !!!!! */ -/* FIXME merge with ei_send.c */ - -/* length (4), PASS_THROUGH (1), header, message */ -int ei_ei_send_reg_encoded(ei_cnode* ec, int fd, const erlang_pid *from, - const char *to, const char *msg, int msglen) -{ - char *s, header[1400]; /* see size calculation below */ - erlang_trace *token = NULL; - int index = 5; /* reserve 5 bytes for control message */ -#ifdef HAVE_WRITEV - struct iovec v[2]; -#endif - - /* are we tracing? */ - /* check that he can receive trace tokens first */ - if (ei_distversion(fd) > 0) - token = ei_trace(0,(erlang_trace *)NULL); - - /* header = REG_SEND, from, cookie, toname max sizes: */ - ei_encode_version(header,&index); /* 1 */ - if (token) { - ei_encode_tuple_header(header,&index,5); /* 2 */ - ei_encode_long(header,&index,ERL_REG_SEND_TT); /* 2 */ - } else { - ei_encode_tuple_header(header,&index,4); - ei_encode_long(header,&index,ERL_REG_SEND); - } - ei_encode_pid(header,&index,from); /* 268 */ - ei_encode_atom(header,&index,"" /*ei_getfdcookie(ec, fd)*/ ); /* 258 */ - ei_encode_atom(header,&index,to); /* 268 */ - - if (token) ei_encode_trace(header,&index,token); /* 534 */ - - /* control message (precedes header actually) */ - /* length = 1 ('p') + header len + message len */ - s = header; - put32be(s, index + msglen - 4); /* 4 */ - put8(s, ERL_PASS_THROUGH); /* 1 */ - /*** sum: 1336 */ - -#ifdef DEBUG_DIST - if (ei_trace_distribution > 0) ei_show_sendmsg(stderr,header,msg); -#endif - -#ifdef HAVE_WRITEV - - v[0].iov_base = (char *)header; - v[0].iov_len = index; - v[1].iov_base = (char *)msg; - v[1].iov_len = msglen; - - if (writev(fd,v,2) != index+msglen) return -1; - -#else - - /* no writev() */ - if (writesocket(fd,header,index) != index) return -1; - if (writesocket(fd,msg,msglen) != msglen) return -1; - -#endif - - return 0; -} diff --git a/lib/erl_interface/src/not_used/send_link.c b/lib/erl_interface/src/not_used/send_link.c deleted file mode 100644 index 38fae27df4..0000000000 --- a/lib/erl_interface/src/not_used/send_link.c +++ /dev/null @@ -1,104 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - * - - */ -#ifdef __WIN32__ -#include <winsock2.h> -#include <windows.h> -#include <winbase.h> - -#elif VXWORKS -#include <unistd.h> - -#else /* unix */ -#include <unistd.h> - -#endif - -#include <string.h> -#include <stdlib.h> -#include "eidef.h" -#include "eiext.h" -#include "eisend.h" -#include "ei_internal.h" -#include "putget.h" -#include "erl_rport.h" - - -/* this sends either link or unlink ('which' decides) */ -static int link_unlink(int fd, const erlang_pid *from, const erlang_pid *to, - int which, unsigned ms) -{ - char msgbuf[EISMALLBUF]; - char *s; - int index = 0; - int n; - unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; - - index = 5; /* max sizes: */ - ei_encode_version(msgbuf,&index); /* 1 */ - ei_encode_tuple_header(msgbuf,&index,3); - ei_encode_long(msgbuf,&index,which); - ei_encode_pid(msgbuf,&index,from); /* 268 */ - ei_encode_pid(msgbuf,&index,to); /* 268 */ - - /* 5 byte header missing */ - s = msgbuf; - put32be(s, index - 4); /* 4 */ - put8(s, ERL_PASS_THROUGH); /* 1 */ - /* sum: 542 */ - - -#ifdef DEBUG_DIST - if (ei_trace_distribution > 1) ei_show_sendmsg(stderr,msgbuf,NULL); -#endif - - n = ei_write_fill_t__(fd,msgbuf,index,tmo); - - return (n==index ? 0 : -1); -} - -/* FIXME not used? */ -#if 0 -/* use this to send a link */ -int ei_send_unlink(int fd, const erlang_pid *from, const erlang_pid *to) -{ - return link_unlink(fd, from, to, ERL_UNLINK,0); -} - -/* use this to send an unlink */ -int ei_send_link(int fd, const erlang_pid *from, const erlang_pid *to) -{ - return link_unlink(fd, from, to, ERL_LINK,0); -} -/* use this to send a link */ -int ei_send_unlink_tmo(int fd, const erlang_pid *from, const erlang_pid *to, - unsigned ms) -{ - return link_unlink(fd, from, to, ERL_UNLINK,ms); -} - -/* use this to send an unlink */ -int ei_send_link_tmo(int fd, const erlang_pid *from, const erlang_pid *to, - unsigned ms) -{ - return link_unlink(fd, from, to, ERL_LINK,ms); -} -#endif diff --git a/lib/erl_interface/src/not_used/whereis.c b/lib/erl_interface/src/not_used/whereis.c deleted file mode 100644 index 4072fa7b33..0000000000 --- a/lib/erl_interface/src/not_used/whereis.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - * - - */ -#ifdef __WIN32__ -#include <winsock2.h> -#include <windows.h> -#include <winbase.h> - -#elif VXWORKS -#include <unistd.h> - -#else /* unix */ -#include <unistd.h> - -#endif - -#include <string.h> -#include <stdlib.h> -#include "erl_interface.h" -#include "erl_connect.h" -#include "erl_format.h" -#include "erl_eterm.h" -#include "erl_malloc.h" - -/* FIXME rewrite to ei functions */ -/* FIXME not used */ - -erlang_pid *erl_whereis(int fd, const char *name) -{ - ETERM *reply; - ETERM *n; - /* FIXME problem for threaded ? */ - static erlang_pid pid; - - n = erl_format("[~a]",name); - reply = erl_rpc(fd,"erlang","whereis",n); - erl_free_term(n); - - if (reply && (ERL_IS_PID(reply))) { - char *node; - node = ERL_PID_NODE(reply); - strcpy(pid.node,node); - pid.num = ERL_PID_NUMBER(reply); - pid.serial = ERL_PID_SERIAL(reply); - pid.creation = ERL_PID_CREATION(reply); - erl_free_term(reply); - return &pid; - } - - if (reply) erl_free_term(reply); - return NULL; -} - diff --git a/lib/erl_interface/src/prog/ei_fake_prog.c b/lib/erl_interface/src/prog/ei_fake_prog.c index 6f58c9833d..c483859c8b 100644 --- a/lib/erl_interface/src/prog/ei_fake_prog.c +++ b/lib/erl_interface/src/prog/ei_fake_prog.c @@ -54,11 +54,7 @@ /* #include <netdb.h> now included by ei.h */ #include "ei.h" -#ifdef VXWORKS -int ei_fake_prog_main(void) -#else int main(void) -#endif { ErlConnect conp; Erl_IpAddr thisipaddr = (Erl_IpAddr)0; @@ -91,12 +87,10 @@ int main(void) unsigned long *ulongp = NULL; unsigned long ulongx = 0; void *voidp = NULL; -#ifndef VXWORKS EI_LONGLONG *longlongp = (EI_LONGLONG*)NULL; EI_LONGLONG longlongx = 0; EI_ULONGLONG *ulonglongp = (EI_ULONGLONG*)NULL; EI_ULONGLONG ulonglongx = 0; -#endif erlang_char_encoding enc; ei_socket_callbacks cbs; @@ -260,8 +254,6 @@ int main(void) } #endif /* HAVE_GMP_H && HAVE_LIBGMP */ -#ifndef VXWORKS - ei_decode_longlong(charp, intp, longlongp); ei_decode_ulonglong(charp, intp, ulonglongp); ei_encode_longlong(charp, intp, longlongx); @@ -269,8 +261,6 @@ int main(void) ei_x_encode_longlong(&eix, longlongx); ei_x_encode_ulonglong(&eix, ulonglongx); -#endif - #ifdef USE_EI_UNDOCUMENTED ei_decode_intlist(charp, intp, longp, intp); diff --git a/lib/erl_interface/src/prog/erl_call.c b/lib/erl_interface/src/prog/erl_call.c index ab91157035..f3d025d30f 100644 --- a/lib/erl_interface/src/prog/erl_call.c +++ b/lib/erl_interface/src/prog/erl_call.c @@ -33,23 +33,6 @@ #include <windows.h> #include <winbase.h> -#elif VXWORKS - -#include <stdio.h> -#include <string.h> -#include <vxWorks.h> -#include <hostLib.h> -#include <selectLib.h> -#include <ifLib.h> -#include <sockLib.h> -#include <taskLib.h> -#include <inetLib.h> -#include <unistd.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netinet/tcp.h> -#include <time.h> - #else /* unix */ #include <sys/types.h> @@ -104,6 +87,8 @@ struct call_flags { int debugp; int verbosep; int haltp; + long port; + char *hostname; char *cookie; char *node; char *hidden; @@ -131,13 +116,7 @@ static char* ei_chk_strdup(char *s); * ***************************************************************************/ -/* FIXME isn't VxWorks to handle arguments differently? */ - -#if !defined(VXWORKS) int main(int argc, char *argv[]) -#else -int erl_call(int argc, char **argv) -#endif { int i = 1,fd,creation; struct hostent *hp; @@ -152,6 +131,8 @@ int erl_call(int argc, char **argv) struct call_flags flags = {0}; /* Default 0 and NULL in all fields */ char* progname = argv[0]; ei_cnode ec; + flags.port = -1; + flags.hostname = NULL; ei_init(); @@ -177,6 +158,29 @@ int erl_call(int argc, char **argv) flags.node = ei_chk_strdup(argv[i+1]); i++; flags.use_long_name = 1; + } else if (strcmp(argv[i], "-address") == 0) { /* -address [HOST:]PORT */ + if (i+1 >= argc) { + usage_arg(progname, "-address "); + } + { + char* hostname_port_arg = ei_chk_strdup(argv[i+1]); + char* address_string_end = strchr(hostname_port_arg, ':'); + if (address_string_end == NULL) { + flags.port = strtol(hostname_port_arg, NULL, 10); + } else { + flags.port = strtol(address_string_end + 1, NULL, 10); + /* Remove port part from hostname_port_arg*/ + *address_string_end = '\0'; + if (strlen(hostname_port_arg) > 0) { + flags.hostname = hostname_port_arg; + } + } + + if (flags.port < 1 || flags.port > 65535) { + usage_error(progname, "-address"); + } + i++; + } } else { if (strlen(argv[i]) != 2) { usage_error(progname, argv[i]); @@ -251,11 +255,12 @@ int erl_call(int argc, char **argv) } /* while */ - /* * Can't have them both ! */ - if (flags.modp && flags.evalp) { + if ((flags.modp && flags.evalp) || + (flags.port != -1 && flags.startp) || + (flags.port != -1 && flags.node)) { usage(progname); } @@ -284,7 +289,7 @@ int erl_call(int argc, char **argv) /* * What we, at least, requires ! */ - if (flags.node == NULL) { + if (flags.node == NULL && flags.port == -1) { usage(progname); } @@ -292,20 +297,14 @@ int erl_call(int argc, char **argv) flags.cookie = NULL; } - /* FIXME decide how many bits etc or leave to connect_xinit? */ - creation = (time(NULL) % 3) + 1; /* "random" */ + creation = time(NULL) + 1; /* "random" */ if (flags.hidden == NULL) { /* As default we are c17@gethostname */ i = flags.randomp ? (time(NULL) % 997) : 17; flags.hidden = (char *) ei_chk_malloc(10 + 2 ); /* c17 or cXYZ */ -#if defined(VXWORKS) - sprintf(flags.hidden, "c%d", - i < 0 ? (int) taskIdSelf() : i); -#else sprintf(flags.hidden, "c%d", i < 0 ? (int) getpid() : i); -#endif } { /* A name for our hidden node was specified */ @@ -346,10 +345,15 @@ int erl_call(int argc, char **argv) } } - if ((p = strchr((const char *)flags.node, (int) '@')) == 0) { + if (flags.port != -1 && flags.hostname != NULL) { + host = flags.hostname; + strcpy(host_name, flags.hostname); + } else if ((flags.port != -1 && flags.hostname == NULL) || + (strchr((const char *)flags.node, (int) '@') == 0)) { strcpy(host_name, ei_thishostname(&ec)); host = host_name; } else { + p = strchr((const char *)flags.node, (int) '@'); *p = 0; host = p+1; } @@ -368,28 +372,45 @@ int erl_call(int argc, char **argv) } strncpy(host_name, hp->h_name, EI_MAXHOSTNAMELEN); host_name[EI_MAXHOSTNAMELEN] = '\0'; - if (strlen(flags.node) + strlen(host_name) + 2 > sizeof(nodename)) { - fprintf(stderr,"erl_call: nodename too long: %s\n", flags.node); - exit(1); + if (flags.port == -1) { + if (strlen(flags.node) + strlen(host_name) + 2 > sizeof(nodename)) { + fprintf(stderr,"erl_call: nodename too long: %s\n", flags.node); + exit(1); + } + sprintf(nodename, "%s@%s", flags.node, host_name); } - sprintf(nodename, "%s@%s", flags.node, host_name); - /* * Try to connect. Start an Erlang system if the * start option is on and no system is running. */ if (flags.startp && !flags.haltp) { fd = do_connect(&ec, nodename, &flags); - } else if ((fd = ei_connect(&ec, nodename)) < 0) { - /* We failed to connect ourself */ - /* FIXME do we really know we failed because of node not up? */ - if (flags.haltp) { - exit(0); - } else { - fprintf(stderr,"erl_call: failed to connect to node %s\n", - nodename); - exit(1); - } + } else if (flags.port == -1) { + if ((fd = ei_connect(&ec, nodename)) < 0) { + /* We failed to connect ourself */ + /* FIXME do we really know we failed because of node not up? */ + if (flags.haltp) { + exit(0); + } else { + fprintf(stderr,"erl_call: failed to connect to node %s\n", + nodename); + exit(1); + } + } + } else { + /* Connect using address:port */ + if ((fd = ei_connect_host_port(&ec, host, (int)flags.port)) < 0) { + /* We failed to connect ourself */ + /* FIXME do we really know we failed because of node not up? */ + if (flags.haltp) { + exit(0); + } else { + fprintf(stderr,"erl_call: failed to connect to node with address \"%s:%ld\"\n", + flags.hostname == NULL ? "" : flags.hostname, + flags.port); + exit(1); + } + } } /* If we are connected and the halt switch is set */ @@ -415,8 +436,14 @@ int erl_call(int argc, char **argv) } if (flags.verbosep) { - fprintf(stderr,"erl_call: we are now connected to node \"%s\"\n", - nodename); + if (flags.port == -1) { + fprintf(stderr,"erl_call: we are now connected to node \"%s\"\n", + nodename); + } else { + fprintf(stderr,"erl_call: we are now connected to node with address \"%s:%ld\"\n", + flags.hostname == NULL ? "": flags.hostname, + flags.port); + } } /* @@ -809,7 +836,7 @@ static int get_module(char **mbuf, char **mname) static void usage_noexit(const char *progname) { fprintf(stderr,"\nUsage: %s [-[demqrsv]] [-c Cookie] [-h HiddenName] \n", progname); fprintf(stderr," [-x ErlScript] [-a [Mod [Fun [Args]]]]\n"); - fprintf(stderr," (-n Node | -sname Node | -name Node)\n\n"); + fprintf(stderr," (-n Node | -sname Node | -name Node | -address [HOSTNAME:]PORT)\n\n"); #ifdef __WIN32__ fprintf(stderr," where: -a apply(Mod,Fun,Args) (e.g -a \"erlang length [[a,b,c]]\"\n"); #else @@ -817,12 +844,18 @@ static void usage_noexit(const char *progname) { #endif fprintf(stderr," -c cookie string; by default read from ~/.erlang.cookie\n"); fprintf(stderr," -d direct Erlang output to ~/.erl_call.out.<Nodename>\n"); - fprintf(stderr," -e evaluate contents of standard input (e.g echo \"X=1,Y=2,{X,Y}.\"|erl_call -e ...)\n"); + fprintf(stderr," -e evaluate contents of standard input (e.g., echo \"X=1,Y=2,{X,Y}.\"|%s -e ...)\n", + progname); fprintf(stderr," -h specify a name for the erl_call client node\n"); fprintf(stderr," -m read and compile Erlang module from stdin\n"); fprintf(stderr," -n name of Erlang node, same as -name\n"); fprintf(stderr," -name name of Erlang node, expanded to a fully qualified\n"); fprintf(stderr," -sname name of Erlang node, short form will be used\n"); + fprintf(stderr," -address [HOSTNAME:]PORT of Erlang node\n" + " (the default hostname is the hostname of the local manchine)\n" + " (e.g., %s -address my_host:36303 ...)\n" + " (cannot be combinated with -s, -n, -name and -sname)\n", + progname); fprintf(stderr," -q halt the Erlang node (overrides the -s switch)\n"); fprintf(stderr," -r use a random name for the erl_call client node\n"); fprintf(stderr," -s start a new Erlang node if necessary\n"); diff --git a/lib/erl_interface/src/prog/erl_fake_prog.c b/lib/erl_interface/src/prog/erl_fake_prog.c deleted file mode 100644 index 093bad8d7c..0000000000 --- a/lib/erl_interface/src/prog/erl_fake_prog.c +++ /dev/null @@ -1,251 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2002-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/*************************************************************************** - * - * This is a fake program that contains all functions, variables and - * defined symbols mentioned in the manual. We compile this file to see - * that the header files and created library is complete. - * - * You can't run this program, it is for compiling and linking only. - * - ***************************************************************************/ - -/* Use most of - * CFLAGS="-I../include -g -O2 - * -ansi -pedantic - * -Wall - * -Wshadow - * -Wstrict-prototypes - * -Wmissing-prototypes - * -Wmissing-declarations - * -Wnested-externs - * -Winline - * -Werror" - */ - -/* #include <netdb.h> now included by ei.h */ -#include "erl_interface.h" - -#ifdef VXWORKS -int erl_fake_prog_main(void) -#else -int main(void) -#endif -{ - ei_x_buff eix; - int index = 0; - ETERM **etermpp = NULL, *etermp = NULL; - char *charp = NULL; - unsigned char uchar, **ucharpp = NULL, *ucharp = NULL; - void *voidp = NULL; - Erl_Heap *erl_heapp = NULL; - int intx = 0; - int *intp = NULL; - unsigned int uintx, *uintp; - unsigned long *ulongp = NULL; - long longx = 0; - double doublex = 0.0; - short shortx = 42; - FILE *filep = NULL; - Erl_IpAddr erl_ipaddr = NULL; - ErlMessage *erlmessagep = NULL; - ErlConnect *erlconnectp = NULL; - struct hostent *hostp = NULL; - struct in_addr *inaddrp = NULL; - - /* Converion to erl_interface format is in liberl_interface */ - - intx = erl_errno; - - ei_encode_term(charp, &index, voidp); - ei_x_encode_term(&eix, voidp); - ei_decode_term(charp, &index, voidp); - - erl_init(voidp, longx); - erl_connect_init(intx, charp,shortx); - erl_connect_xinit(charp,charp,charp,erl_ipaddr,charp,shortx); - erl_connect(charp); - erl_xconnect(erl_ipaddr,charp); - erl_close_connection(intx); - erl_receive(intx, ucharp, intx); - erl_receive_msg(intx, ucharp, intx, erlmessagep); - erl_xreceive_msg(intx, ucharpp, intp, erlmessagep); - erl_send(intx, etermp, etermp); - erl_reg_send(intx, charp, etermp); - erl_rpc(intx,charp,charp,etermp); - erl_rpc_to(intx,charp,charp,etermp); - erl_rpc_from(intx,intx,erlmessagep); - - erl_publish(intx); - erl_accept(intx,erlconnectp); - - erl_thiscookie(); - erl_thisnodename(); - erl_thishostname(); - erl_thisalivename(); - erl_thiscreation(); - erl_unpublish(charp); - erl_err_msg(charp); - erl_err_quit(charp); - erl_err_ret(charp); - erl_err_sys(charp); - - erl_cons(etermp,etermp); - erl_copy_term(etermp); - erl_element(intx,etermp); - - erl_hd(etermp); - erl_iolist_to_binary(etermp); - erl_iolist_to_string(etermp); - erl_iolist_length(etermp); - erl_length(etermp); - erl_mk_atom(charp); - erl_mk_binary(charp,intx); - erl_mk_empty_list(); - erl_mk_estring(charp, intx); - erl_mk_float(doublex); - erl_mk_int(intx); - erl_mk_list(etermpp,intx); - erl_mk_pid(charp,uintx,uintx,uchar); - erl_mk_port(charp,uintx,uchar); - erl_mk_ref(charp,uintx,uchar); - erl_mk_long_ref(charp,uintx,uintx,uintx,uchar); - erl_mk_string(charp); - erl_mk_tuple(etermpp,intx); - erl_mk_uint(uintx); - erl_mk_var(charp); - erl_print_term(filep,etermp); - /* erl_sprint_term(charp,etermp); */ - erl_size(etermp); - erl_tl(etermp); - erl_var_content(etermp, charp); - - erl_format(charp); - erl_match(etermp, etermp); - - erl_global_names(intx, intp); - erl_global_register(intx, charp, etermp); - erl_global_unregister(intx, charp); - erl_global_whereis(intx, charp, charp); - - erl_init_malloc(erl_heapp,longx); - erl_alloc_eterm(uchar); - erl_eterm_release(); - erl_eterm_statistics(ulongp,ulongp); - erl_free_array(etermpp,intx); - erl_free_term(etermp); - erl_free_compound(etermp); - erl_malloc(longx); - erl_free(voidp); - - erl_compare_ext(ucharp, ucharp); - erl_decode(ucharp); - erl_decode_buf(ucharpp); - erl_encode(etermp,ucharp); - erl_encode_buf(etermp,ucharpp); - erl_ext_size(ucharp); - erl_ext_type(ucharp); - erl_peek_ext(ucharp,intx); - erl_term_len(etermp); - - erl_gethostbyname(charp); - erl_gethostbyaddr(charp, intx, intx); - erl_gethostbyname_r(charp, hostp, charp, intx, intp); - erl_gethostbyaddr_r(charp, intx, intx, hostp, charp, intx, intp); - - erl_init_resolve(); - erl_distversion(intx); - - erl_epmd_connect(inaddrp); - erl_epmd_port(inaddrp, charp, intp); - - charp = ERL_ATOM_PTR(etermp); - intx = ERL_ATOM_SIZE(etermp); - ucharp = ERL_BIN_PTR(etermp); - intx = ERL_BIN_SIZE(etermp); - etermp = ERL_CONS_HEAD(etermp); - etermp = ERL_CONS_TAIL(etermp); - intx = ERL_COUNT(etermp); - doublex= ERL_FLOAT_VALUE(etermp); - uintx = ERL_INT_UVALUE(etermp); - intx = ERL_INT_VALUE(etermp); - intx = ERL_IS_ATOM(etermp); - intx = ERL_IS_BINARY(etermp); - intx = ERL_IS_CONS(etermp); - intx = ERL_IS_EMPTY_LIST(etermp); - intx = ERL_IS_FLOAT(etermp); - intx = ERL_IS_INTEGER(etermp); - intx = ERL_IS_LIST(etermp); - intx = ERL_IS_PID(etermp); - intx = ERL_IS_PORT(etermp); - intx = ERL_IS_REF(etermp); - intx = ERL_IS_TUPLE(etermp); - intx = ERL_IS_UNSIGNED_INTEGER(etermp); - uchar = ERL_PID_CREATION(etermp); - charp = ERL_PID_NODE(etermp); - uintx = ERL_PID_NUMBER(etermp); - uintx = ERL_PID_SERIAL(etermp); - uchar = ERL_PORT_CREATION(etermp); - charp = ERL_PORT_NODE(etermp); - uintx = ERL_PORT_NUMBER(etermp); - uchar = ERL_REF_CREATION(etermp); - intx = ERL_REF_LEN(etermp); - charp = ERL_REF_NODE(etermp); - uintx = ERL_REF_NUMBER(etermp); - uintp = ERL_REF_NUMBERS(etermp); - etermp = ERL_TUPLE_ELEMENT(etermp,intx); - intx = ERL_TUPLE_SIZE(etermp); - - return - BUFSIZ + - EAGAIN + - EHOSTUNREACH + - EINVAL + - EIO + - EMSGSIZE + - ENOMEM + - ERL_ATOM + - ERL_BINARY + - ERL_ERROR + - ERL_EXIT + - ERL_FLOAT + - ERL_INTEGER + - ERL_LINK + - ERL_LIST + - ERL_MSG + - ERL_NO_TIMEOUT + - ERL_PID + - ERL_PORT + - ERL_REF + - ERL_REG_SEND + - ERL_SEND + - ERL_SMALL_BIG + - ERL_TICK + - ERL_TIMEOUT + - ERL_TUPLE + - ERL_UNLINK + - ERL_U_INTEGER + - ERL_U_SMALL_BIG + - ERL_VARIABLE + - ETIMEDOUT + - MAXNODELEN + - MAXREGLEN; -} diff --git a/lib/erl_interface/src/prog/erl_start.c b/lib/erl_interface/src/prog/erl_start.c index b7aa451946..a4930443d4 100644 --- a/lib/erl_interface/src/prog/erl_start.c +++ b/lib/erl_interface/src/prog/erl_start.c @@ -31,40 +31,7 @@ #include <windows.h> #include <winbase.h> -#elif VXWORKS -#include <stdio.h> -#include <string.h> -#include <vxWorks.h> -#include <hostLib.h> -#include <selectLib.h> -#include <ifLib.h> -#include <sockLib.h> -#include <taskLib.h> -#include <inetLib.h> -#include <unistd.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netinet/tcp.h> -#include <symLib.h> -#include <sysSymTbl.h> -#include <sysLib.h> -#include <tickLib.h> - -#if TIME_WITH_SYS_TIME -# include <sys/time.h> -# include <time.h> -#else -# if HAVE_SYS_TIME_H -# include <sys/time.h> -# else -# include <time.h> -# endif -#endif - -#include <a_out.h> - -/* #include "netdb.h" */ -#else /* other unix */ +#else /* unix */ #include <errno.h> #include <netdb.h> #include <netinet/in.h> @@ -111,7 +78,7 @@ typedef socklen_t SocklenType; static struct in_addr *get_addr(const char *hostname, struct in_addr *oaddr); static int wait_for_erlang(int sockd, int magic, struct timeval *timeout); -#if defined(VXWORKS) || defined(__WIN32__) +#if defined(__WIN32__) static int unique_id(void); static unsigned long spawn_erlang_epmd(ei_cnode *ec, char *alive, @@ -148,7 +115,7 @@ int erl_start_sys(ei_cnode *ec, char *alive, Erl_IpAddr adr, int flags, int port; int sockd = 0; int one = 1; -#if defined(VXWORKS) || defined(__WIN32__) +#if defined(__WIN32__) unsigned long pid = 0; #else int pid = 0; @@ -177,7 +144,7 @@ int erl_start_sys(ei_cnode *ec, char *alive, Erl_IpAddr adr, int flags, listen(sockd,5); -#if defined(VXWORKS) || defined(__WIN32__) +#if defined(__WIN32__) if((pid = spawn_erlang_epmd(ec,alive,adr,flags,erl,args,port,1)) == 0) return ERL_SYS_ERROR; @@ -185,15 +152,9 @@ int erl_start_sys(ei_cnode *ec, char *alive, Erl_IpAddr adr, int flags, timeout.tv_sec = 10; /* ignoring ERL_START_TIME */ if((r = wait_for_erlang(sockd,unique_id(),&timeout)) == ERL_TIMEOUT) { -#if defined(VXWORKS) - taskDelete((int) pid); - if(taskIdVerify((int) pid) != ERROR) - taskDeleteForce((int) pid); -#else /* Windows */ /* Well, this is not a nice way to do it, and it does not always kill the emulator, but the alternatives are few.*/ TerminateProcess((HANDLE) pid,1); -#endif /* defined(VXWORKS) */ } #else /* Unix */ switch ((pid = fork())) { @@ -229,7 +190,7 @@ int erl_start_sys(ei_cnode *ec, char *alive, Erl_IpAddr adr, int flags, } } -#endif /* defined(VXWORKS) || defined(__WIN32__) */ +#endif /* defined(__WIN32__) */ done: #if defined(__WIN32__) @@ -240,18 +201,10 @@ done: return r; } /* erl_start_sys() */ -#if defined(VXWORKS) || defined(__WIN32__) -#if defined(VXWORKS) -#define DEF_ERL_COMMAND "" -#define DEF_EPMD_COMMAND "" -#define ERLANG_SYM "start_erl" -#define EPMD_SYM "start_epmd" -#define ERL_REPLY_FMT "-s erl_reply reply %s %d %d" -#else +#if defined(__WIN32__) #define DEF_ERL_COMMAND "erl" #define DEF_EPMD_COMMAND "epmd" #define ERL_REPLY_FMT "-s erl_reply reply \"%s\" \"%d\" \"%d\"" -#endif #define ERL_NAME_FMT "-noinput -name %s" #define ERL_SNAME_FMT "-noinput -sname %s" @@ -259,11 +212,7 @@ done: #define FORMATTED_INT_LEN 10 static int unique_id(void){ -#if defined(VXWORKS) - return taskIdSelf(); -#else return (int) GetCurrentThreadId(); -#endif } static int enquote_args(char **oargs, char ***qargs){ @@ -317,20 +266,7 @@ static void free_args(char **args){ free(args); } -#if defined(VXWORKS) -static FUNCPTR lookup_function(char *symname){ - char *value; - SYM_TYPE type; - if(symFindByName(sysSymTbl, - symname, - &value, - &type) == ERROR /*|| type != N_TEXT*/) - return NULL; - return (FUNCPTR) value; -} -#endif /* defined(VXWORKS) */ - -/* In NT and VxWorks, we cannot fork(), Erlang and Epmd gets +/* In NT we cannot fork(), Erlang and Epmd gets spawned by this function instead. */ static unsigned long spawn_erlang_epmd(ei_cnode *ec, @@ -342,13 +278,9 @@ static unsigned long spawn_erlang_epmd(ei_cnode *ec, int port, int is_erlang) { -#if defined(VXWORKS) - FUNCPTR erlfunc; -#else /* Windows */ STARTUPINFO sinfo; SECURITY_ATTRIBUTES sa; PROCESS_INFORMATION pinfo; -#endif char *cmdbuf; int cmdlen; char *ptr; @@ -362,14 +294,10 @@ static unsigned long spawn_erlang_epmd(ei_cnode *ec, if(is_erlang){ get_addr(ei_thishostname(ec), &myaddr); -#if defined(VXWORKS) - inet_ntoa_b(myaddr, iaddrbuf); -#else /* Windows */ if((ptr = inet_ntoa(myaddr)) == NULL) return 0; else strcpy(iaddrbuf,ptr); -#endif } if ((flags & ERL_START_REMOTE) || (is_erlang && (hisaddr->s_addr != myaddr.s_addr))) { @@ -378,11 +306,7 @@ static unsigned long spawn_erlang_epmd(ei_cnode *ec, num_args = enquote_args(args, &args); for(cmdlen = i = 0; args[i] != NULL; ++i) cmdlen += strlen(args[i]) + 1; -#if !defined(VXWORKS) - /* On VxWorks, we dont actually run a command, - we call start_erl() */ if(!erl_or_epmd) -#endif erl_or_epmd = (is_erlang) ? DEF_ERL_COMMAND : DEF_EPMD_COMMAND; if(is_erlang){ @@ -417,23 +341,6 @@ static unsigned long spawn_erlang_epmd(ei_cnode *ec, fprintf(stderr,"erl_call: commands are %s\n",cmdbuf); } /* OK, one single command line... */ -#if defined(VXWORKS) - erlfunc = lookup_function((is_erlang) ? ERLANG_SYM : - EPMD_SYM); - if(erlfunc == NULL){ - if (flags & ERL_START_VERBOSE) { - fprintf(stderr,"erl_call: failed to find symbol %s\n", - (is_erlang) ? ERLANG_SYM : EPMD_SYM); - } - ret = 0; - } else { - /* Just call it, it spawns itself... */ - ret = (unsigned long) - (*erlfunc)((int) cmdbuf,0,0,0,0,0,0,0,0,0); - if(ret == (unsigned long) ERROR) - ret = 0; - } -#else /* Windows */ /* Hmmm, hidden or unhidden window??? */ memset(&sinfo,0,sizeof(sinfo)); sinfo.cb = sizeof(STARTUPINFO); @@ -460,7 +367,6 @@ static unsigned long spawn_erlang_epmd(ei_cnode *ec, ret = 0; else ret = (unsigned long) pinfo.hProcess; -#endif free(cmdbuf); return ret; } @@ -488,7 +394,7 @@ static int exec_erlang(ei_cnode *ec, char *args[], int port) { -#if !defined(__WIN32__) && !defined(VXWORKS) +#if !defined(__WIN32__) int fd,len,l,i; char **s; char *argv[4]; @@ -587,7 +493,7 @@ static int exec_erlang(ei_cnode *ec, return ERL_SYS_ERROR; } /* exec_erlang() */ -#endif /* defined(VXWORKS) || defined(WINDOWS) */ +#endif /* defined(WINDOWS) */ #if defined(__WIN32__) static void gettimeofday(struct timeval *now,void *dummy){ @@ -601,13 +507,6 @@ static void gettimeofday(struct timeval *now,void *dummy){ now->tv_usec = x % 1000000; } -#elif defined(VXWORKS) -static void gettimeofday(struct timeval *now, void *dummy){ - int rate = sysClkRateGet(); /* Ticks per second */ - unsigned long ctick = tickGet(); - now->tv_sec = ctick / rate; /* secs since reboot */ - now->tv_usec = ((ctick - (now->tv_sec * rate))*1000000)/rate; -} #endif diff --git a/lib/erl_interface/src/registry/reg_get.c b/lib/erl_interface/src/registry/reg_get.c index 67d99e231e..73975f6a91 100644 --- a/lib/erl_interface/src/registry/reg_get.c +++ b/lib/erl_interface/src/registry/reg_get.c @@ -19,10 +19,6 @@ * */ -#ifdef VXWORKS -#include <vxWorks.h> -#endif - #include <stdarg.h> #include "reg.h" diff --git a/lib/erl_interface/src/registry/reg_set.c b/lib/erl_interface/src/registry/reg_set.c index 95b90adb87..3846df1cb5 100644 --- a/lib/erl_interface/src/registry/reg_set.c +++ b/lib/erl_interface/src/registry/reg_set.c @@ -19,10 +19,6 @@ * */ -#ifdef VXWORKS -#include <vxWorks.h> -#endif - #include <stdarg.h> #include "reg.h" diff --git a/lib/erl_interface/test/Makefile b/lib/erl_interface/test/Makefile index f8f2ef0156..3e3213d3e1 100644 --- a/lib/erl_interface/test/Makefile +++ b/lib/erl_interface/test/Makefile @@ -34,12 +34,7 @@ MODULES= \ ei_print_SUITE \ ei_tmo_SUITE \ erl_call_SUITE \ - erl_connect_SUITE \ - erl_global_SUITE \ - erl_eterm_SUITE \ - erl_ext_SUITE \ - erl_format_SUITE \ - erl_match_SUITE \ + ei_global_SUITE \ port_call_SUITE \ runner diff --git a/lib/erl_interface/test/all_SUITE_data/Makefile.src b/lib/erl_interface/test/all_SUITE_data/Makefile.src index 4f27b097c8..0d242663ea 100644 --- a/lib/erl_interface/test/all_SUITE_data/Makefile.src +++ b/lib/erl_interface/test/all_SUITE_data/Makefile.src @@ -23,7 +23,7 @@ CC0 = @CC@ CC = .@DS@gccifier@exe@ -CC"$(CC0)" CFLAGS0 = @CFLAGS@ -I@erl_interface_include@ CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -EI_COMMON_OBJS = runner@obj@ ei_runner@obj@ +EI_COMMON_OBJS = runner@obj@ ei_runner@obj@ my_ussi@obj@ ALL_OBJS = gccifier@exe@ $(EI_COMMON_OBJS) CP=cp diff --git a/lib/erl_interface/test/all_SUITE_data/init_tc.erl b/lib/erl_interface/test/all_SUITE_data/init_tc.erl index d9ad291f3d..da3d8053a0 100644 --- a/lib/erl_interface/test/all_SUITE_data/init_tc.erl +++ b/lib/erl_interface/test/all_SUITE_data/init_tc.erl @@ -77,11 +77,7 @@ generate_c(Cases, File, TcName) -> lists:foreach(fun(Case) -> io:format(File, " ~s,~n", [Case]) end, Cases), io:format(File, "~s", [["};\n\n", - "#ifdef VXWORKS\n", - "int ", TcName, "(int argc, char* argv[])\n", - "#else\n", "int main(int argc, char* argv[])\n", - "#endif\n", "{\n", " run_tests(argv[0], test_cases, ", "sizeof(test_cases)/sizeof(test_cases[0]));\n", diff --git a/lib/erl_interface/test/all_SUITE_data/my_ussi.c b/lib/erl_interface/test/all_SUITE_data/my_ussi.c new file mode 100644 index 0000000000..5f8c79b7cf --- /dev/null +++ b/lib/erl_interface/test/all_SUITE_data/my_ussi.c @@ -0,0 +1,198 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2019. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +/* + * User Supplied Socket Implementation (ussi) + * for test purpose. + */ +#include <stdlib.h> +#include <string.h> +#include "ei.h" + +struct my_ctx +{ + void* ctx; +}; + +/* + * To minimize effort but still test a different context format + * we cheat and wrap the existing TCP default callbacks. + */ +extern ei_socket_callbacks ei_default_socket_callbacks; + +static int my_socket(void **ctx, void *setup_ctx) +{ + struct my_ctx *myctx = malloc(sizeof(struct my_ctx)); + int ret; + ret = ei_default_socket_callbacks.socket(&myctx->ctx, NULL); + *ctx = myctx; + return ret; +} + +static int my_close(void *ctx) +{ + struct my_ctx *myctx = ctx; + int ret = ei_default_socket_callbacks.close(myctx->ctx); + free(myctx); + return ret; +} + +static int my_get_fd(void *ctx, int *fd) +{ + struct my_ctx *myctx = ctx; + return ei_default_socket_callbacks.get_fd(myctx->ctx, fd); +} + +static int my_hs_packet_header_size(void *ctx, int *sz) +{ + struct my_ctx *myctx = ctx; + return ei_default_socket_callbacks.handshake_packet_header_size(myctx->ctx, sz); +} + +static int my_connect_handshake_complete(void *ctx) +{ + struct my_ctx *myctx = ctx; + return ei_default_socket_callbacks.connect_handshake_complete(myctx->ctx); +} + +static int my_accept_handshake_complete(void *ctx) +{ + struct my_ctx *myctx = ctx; + return ei_default_socket_callbacks.accept_handshake_complete(myctx->ctx); +} + +static int my_listen(void *ctx, void *addr, int *len, int backlog) +{ + struct my_ctx *myctx = ctx; + return ei_default_socket_callbacks.listen(myctx->ctx, addr, len, backlog); +} + +static int my_accept(void **ctx, void *addr, int *len, unsigned tmo) +{ + struct my_ctx *listen_ctx = *ctx; + struct my_ctx *conn_ctx = malloc(sizeof(struct my_ctx)); + int ret; + *conn_ctx = *listen_ctx; + ret = ei_default_socket_callbacks.accept(&conn_ctx->ctx, addr, len, tmo); + if (ret == 0) + *ctx = conn_ctx; + else + free(conn_ctx); + return ret; +} + +static int my_connect(void *ctx, void *addr, int len, unsigned tmo) +{ + struct my_ctx *myctx = ctx; + return ei_default_socket_callbacks.connect(myctx->ctx, addr, len, tmo); +} + +static void* memdup(const void* mem, int nbytes) +{ + void *p = malloc(nbytes); + memcpy(p, mem, nbytes); + return p; +} + +static void scramble(void* bytes, int nbytes) +{ +/* Would be nice to really test that only our callbacks are used + and the default ones are not. + Need corresponding Erlang distribution impl to work. + + unsigned char *p = bytes; + int i; + for (i=0; i < nbytes; ++i) + p[i] = ~p[i]; +*/ +} + +/* our own iovec struct to avoid config dependency HAVE_WRITEV */ +struct my_iovec { + void *iov_base; /* Starting address */ + size_t iov_len; /* Number of bytes to transfer */ +}; + +static int my_writev(void *ctx, const void *viov, int iovcnt, ssize_t *len, unsigned tmo) +{ + struct my_ctx *myctx = ctx; + struct my_iovec *iov; + int i, ret; + + /* create mutable copy of both iovec and data */ + iov = memdup(viov, sizeof(struct my_iovec) * iovcnt); + for (i=0; i < iovcnt; ++i) { + iov[i].iov_base = memdup(iov[i].iov_base, iov[i].iov_len); + scramble(iov[i].iov_base, iov[i].iov_len); + } + + ret = ei_default_socket_callbacks.writev(myctx->ctx, viov, iovcnt, len, tmo); + + for (i=0; i < iovcnt; ++i) + free(iov[i].iov_base); + free(iov); + return ret; +} + +static int my_write(void *ctx, const char* buf, ssize_t *len, unsigned tmo) +{ + struct my_ctx *myctx = ctx; + unsigned char* copy = memdup(buf, *len); + int i, ret; + + scramble(copy, *len); + ret = ei_default_socket_callbacks.write(myctx->ctx, copy, len, tmo); + free(copy); + return ret; +} + +static int my_read(void *ctx, char* buf, ssize_t *len, unsigned tmo) +{ + struct my_ctx *myctx = ctx; + int ret, i; + + ret = ei_default_socket_callbacks.read(myctx->ctx, buf, len, tmo); + if (ret == 0) + scramble(buf, *len); + return ret; +} + +ei_socket_callbacks my_ussi = { + 0, /* flags */ + my_socket, + my_close, + my_listen, + my_accept, + my_connect, + my_writev, + my_write, + my_read, + my_hs_packet_header_size, + my_connect_handshake_complete, + my_accept_handshake_complete, + my_get_fd +}; + +void my_ussi_init(void) +{ + my_ussi.flags = ei_default_socket_callbacks.flags; + if (!ei_default_socket_callbacks.writev) + my_ussi.writev = NULL; +} diff --git a/lib/erl_interface/src/legacy/erl_connect.h b/lib/erl_interface/test/all_SUITE_data/my_ussi.h index 6cb5d5cd1b..0db07c990e 100644 --- a/lib/erl_interface/src/legacy/erl_connect.h +++ b/lib/erl_interface/test/all_SUITE_data/my_ussi.h @@ -1,8 +1,8 @@ /* * %CopyrightBegin% - * - * Copyright Ericsson AB 1996-2016. All Rights Reserved. - * + * + * Copyright Ericsson AB 2019. All Rights Reserved. + * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. * You may obtain a copy of the License at @@ -14,12 +14,15 @@ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. * See the License for the specific language governing permissions and * limitations under the License. - * + * * %CopyrightEnd% */ -#ifndef _ERL_CONNECT_H -#define _ERL_CONNECT_H -erlang_pid *erl_self(void); +/* + * User Supplied Socket Implementation (ussi) + * for test purpose. + */ + +extern ei_socket_callbacks my_ussi; -#endif /* _ERL_CONNECT_H */ +extern void my_ussi_init(void); diff --git a/lib/erl_interface/test/all_SUITE_data/runner.c b/lib/erl_interface/test/all_SUITE_data/runner.c deleted file mode 100644 index 42e8bb03e5..0000000000 --- a/lib/erl_interface/test/all_SUITE_data/runner.c +++ /dev/null @@ -1,459 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#include <stdio.h> -#include <stdlib.h> -#include <errno.h> -#include <sys/types.h> -#include <sys/stat.h> -#include <fcntl.h> -#ifndef __WIN32__ -#include <unistd.h> -#endif -#include <stdarg.h> - -#include "runner.h" - -#ifndef __WIN32__ -#define _O_BINARY 0 -#define _setmode(fd, mode) -#endif - -#define HEADER_SIZE 4 - -static char* progname; /* Name of this program (from argv[0]). */ -static int fd_from_erl; /* File descriptor from Erlang. */ -static int fd_to_erl; /* File descriptor to Erlang. */ - -static int packet_loop(); -static void ensure_buf_big_enough(); -static int readn(); -static void reply(char* buf, unsigned size); -static void dump(); - -void -run_tests(char* argv0, TestCase test_cases[], unsigned number) -{ - int i; - int n; - char* packet; - - progname = argv0; - _setmode(0, _O_BINARY); - _setmode(1, _O_BINARY); - fd_from_erl = 0; - fd_to_erl = 1; - - packet = read_packet(&n); - - /* - * Dispatch to the appropriate test function. - */ - - i = packet[0] * 256 + packet[1]; - if (i >= number) { - fprintf(stderr, "%s: bad test case number %d", - progname, i); - free(packet); - exit(1); - } else { - (*test_cases[i])(); - free(packet); - } -} - - -/*********************************************************************** - * - * R e a d i n g p a c k e t s - * - ************************************************************************/ - -/* - * Reads an Erlang term. - * - * Returns: A pointer to a term (an ETERM structure) if there was - * at term available, or a NULL pointer if there was an 'eot' (end-of-test) - * packet. Aborts if anything else received. - */ - -ETERM* -get_term(void) -{ - char* encoded; - ETERM* term; - int n; - - encoded = read_packet(&n); - - switch (encoded[0]) { - case 'e': - free(encoded); - return NULL; - case 't': - term = erl_decode(encoded+1); - free(encoded); - if (term == NULL) { - fail("Failed to decode term"); - exit(0); - } - return term; - default: - fprintf(stderr, "Garbage received: "); - dump(encoded, n, 16); - putc('\n', stderr); - fail("C program received garbage"); - free(encoded); - exit(1); - } -} - - -/* - * Reads a packet from Erlang. The packet must be a standard {packet, 2} - * packet. This function aborts if any error is detected (including EOF). - * - * Returns: The number of bytes in the packet. - */ - -char *read_packet(int *len) -{ - - unsigned char* io_buf = NULL; /* Buffer for file i/o. */ - int i; - unsigned char header[HEADER_SIZE]; - unsigned packet_length; /* Length of current packet. */ - int bytes_read; - - /* - * Read the packet header. - */ - - bytes_read = readn(fd_from_erl, header, HEADER_SIZE); - - if (bytes_read == 0) { - fprintf(stderr, "%s: Unexpected end of file\n", progname); - exit(1); - } - if (bytes_read != HEADER_SIZE) { - fprintf(stderr, "%s: Failed to read packet header\n", progname); - exit(1); - } - - /* - * Get the length of this packet. - */ - - packet_length = 0; - - for (i = 0; i < HEADER_SIZE; i++) - packet_length = (packet_length << 8) | header[i]; - - if (len) *len=packet_length; /* report length only if caller requested it */ - - if ((io_buf = (char *) malloc(packet_length)) == NULL) { - fprintf(stderr, "%s: insufficient memory for i/o buffer of size %d\n", - progname, packet_length); - exit(1); - } - - /* - * Read the packet itself. - */ - - bytes_read = readn(fd_from_erl, io_buf, packet_length); - if (bytes_read != packet_length) { - fprintf(stderr, "%s: couldn't read packet of length %d\r\n", - progname, packet_length); - free(io_buf); - exit(1); - } - - return io_buf; -} - - -/*********************************************************************** - * S e n d i n g r e p l i e s - * - * The functions below send various types of replies back to Erlang. - * Each reply start with a letter indicating the type of reply. - * - * Reply Translated to on Erlang side - * ----- ---------------------------- - * [$b|Bytes] {bytes, Bytes} - * [$e] eot - * [$f] ct:fail() - * [$f|Reason] ct:fail(Reason) - * [$t|EncodedTerm] {term, Term} - * [$N] 'NULL' - * [$m|Message] io:format("~s", [Message]) (otherwise ignored) - * - ***********************************************************************/ - -/* - * This function reports the outcome of a test fail. It is useful if - * you implement a test case entirely in C code. - * - * If the ok argument is zero, a [$f] reply will be sent to the - * Erlang side (causing ct:fail() to be called); otherwise, - * the atom 'eot' will be sent to Erlang. - * - * If you need to provide more details on a failure, use the fail() function. - */ - -void -do_report(file, line, ok) - char* file; - int line; - int ok; /* Zero if failed; non-zero otherwise. */ -{ - char reason; - unsigned long ab; - unsigned long fb; - - reason = ok ? 'e' : 'f'; - - if (!ok) { - do_fail(file, line, "Generic failure"); - } else { - /* release all unallocated blocks */ - erl_eterm_release(); - /* check mem usage stats */ - erl_eterm_statistics(&ab, &fb); - if ((ab == 0) && (fb == 0) ) { - reply(&reason, 1); - } - else { - char sbuf[128]; - - sprintf(sbuf, "still %lu terms allocated," - " %lu on freelist at end of test", ab, fb); - do_fail(file, line, sbuf); - } - } -} - - -/* - * This function causes a call to ct:fail(Reason) on the - * Erlang side. - */ - -void -do_fail(char* file, int line, char* reason) -{ - char sbuf[2048]; - - sbuf[0] = 'f'; - sprintf(sbuf+1, "%s, line %d: %s", file, line, reason); - reply(sbuf, 1+strlen(sbuf+1)); -} - -/* - * This function sends a message to the Erlang side. - * The message will be written to the test servers log file, - * but will otherwise be completly ignored. - */ - -void -message(char* format, ...) -{ - va_list ap; - char sbuf[1024]; - - sbuf[0] = 'm'; - va_start(ap, format); - vsprintf(sbuf+1, format, ap); - va_end(ap); - - reply(sbuf, 1+strlen(sbuf+1)); -} - -/* - * This function sends the given term to the Erlang side, - * where it will be received as {term, Term}. - * - * If the given pointer is NULL (indicating an invalid term), - * the result on the Erlang side will be the atom 'NULL'. - * - * After sending the term, this function frees the term by - * calling erl_free_term(). - */ - -void -send_term(term) - ETERM* term; /* Term to be sent to Erlang side. */ -{ - char encoded[64*1024]; - int n; - - if (term == NULL) { - encoded[0] = 'N'; - n = 1; - } else { - encoded[0] = 't'; - n = 1 + erl_encode(term, encoded+1); - erl_free_term(term); - } - reply(encoded, n); -} - -#if 0 - -/* Seriously broken!!! */ - -void -send_bin_term(x_ei_buff* x) -{ - x_ei_buff x2; - x_ei_new(&x2); - x2.buff[x2.index++] = 't'; - x_ei_append(&x2, x); - reply(x2.buff, x2.index); - free(x2.buff); -} -#endif - -/* - * This function sends a raw buffer of data to the - * Erlang side, where it will be received as {bytes, Bytes}. - */ - -void -send_buffer(buf, size) - char* buf; /* Buffer with bytes to send to Erlang. */ - int size; /* Size of data to send to Erlang. */ -{ - char* send_buf; - - send_buf = (char *) malloc(size+1); - send_buf[0] = 'b'; - memcpy(send_buf+1, buf, size); - reply(send_buf, size+1); - free(send_buf); -} - -/*********************************************************************** - * - * P r i v a t e h e l p e r s - * - ***********************************************************************/ - -/* - * Sends a packet back to Erlang. - */ - -static void -reply(reply_buf, size) - char* reply_buf; /* Buffer with reply. */ - unsigned size; /* Size of reply. */ -{ - int n; /* Temporary to hold size. */ - int i; /* Loop counter. */ - char* buf; - - - buf = (char *) malloc(size+HEADER_SIZE); - memcpy(buf+HEADER_SIZE, reply_buf, size); - - /* - * Fill the header starting with the least significant byte. - */ - - n = size; - for (i = HEADER_SIZE-1; i >= 0; i--) { - buf[i] = (char) n; /* Store least significant byte. */ - n = n >> 8; - } - - size += HEADER_SIZE; -/* - fprintf(stderr, "\r\nReply size: %u\r\n", - (unsigned)buf[0] << 8 + (unsigned)buf[1]); - - for (i = 0; i < size; i++) { - fprintf(stderr,"%u %c\r\n",buf[i],buf[i]); - } - - fprintf(stderr, "\r\n"); -*/ - write(fd_to_erl, buf, size); - free(buf); -} - - -/* - * Reads len number of bytes. - */ - -static int -readn(fd, buf, len) - int fd; /* File descriptor to read from. */ - unsigned char *buf; /* Store in this buffer. */ - int len; /* Number of bytes to read. */ -{ - int n; /* Byte count in last read call. */ - int sofar = 0; /* Bytes read so far. */ - - do { - if ((n = read(fd, buf+sofar, len-sofar)) <= 0) - /* error or EOF in read */ - return(n); - sofar += n; - } while (sofar < len); - return sofar; -} - -void -dump(buf, sz, max) - unsigned char* buf; - int sz; - int max; -{ - int i, imax; - char comma[5] = ","; - - if (!sz) - return; - if (sz > max) - imax = max; - else - imax = sz; - - for (i=0; i<imax; i++) { - if (i == imax-1) { - if (sz > max) - strcpy(comma, ",..."); - else - comma[0] = 0; - } - if (isdigit(buf[i])) - fprintf(stderr, "%u%s", (int)(buf[i]), comma); - else { - if (isalpha(buf[i])) { - fprintf(stderr, "%c%s", buf[i], comma); - } - else - fprintf(stderr, "%u%s", (int)(buf[i]), comma); - } - } -} - diff --git a/lib/erl_interface/test/all_SUITE_data/runner.h b/lib/erl_interface/test/all_SUITE_data/runner.h deleted file mode 100644 index 493602869f..0000000000 --- a/lib/erl_interface/test/all_SUITE_data/runner.h +++ /dev/null @@ -1,51 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#include "erl_interface.h" - -typedef void (*TestCase)(void); - -#define TESTCASE(name) void name(void) -#define ASIZE(a) (sizeof(a)/sizeof(a[0])) - -void run_tests(char* argv0, TestCase cases[], unsigned number); - -/* - * Reading. - */ - -ETERM* get_term(void); -char *read_packet(int *len); - -/* - * Sending replies. - */ - -#define fail(reason) do_fail(__FILE__, __LINE__, reason) -#define report(ok) do_report(__FILE__, __LINE__, ok) - -void do_report(char* file, int line, int ok); -void do_fail(char* file, int line, char* reason); -void send_term(ETERM* term); -void send_buffer(char* buf, int size); -void message(char* format, ...); - -void send_bin_term(ei_x_buff* x); - diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl index f40c67375b..c49b8a358a 100644 --- a/lib/erl_interface/test/ei_accept_SUITE.erl +++ b/lib/erl_interface/test/ei_accept_SUITE.erl @@ -43,12 +43,15 @@ init_per_testcase(Case, Config) -> runner:init_per_testcase(?MODULE, Case, Config). ei_accept(Config) when is_list(Config) -> - ei_accept_do(Config, 0), % default - ei_accept_do(Config, 21). % ei_set_compat_rel + [ei_accept_do(Config, CR, SI) + || CR <- [0,21], + SI <- [default, ussi]], + ok. -ei_accept_do(Config, CompatRel) -> +ei_accept_do(Config, CompatRel, SockImpl) -> + io:format("CompatRel=~p, SockImpl=~p\n", [CompatRel, SockImpl]), P = runner:start(Config, ?interpret), - 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, CompatRel), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, CompatRel, SockImpl), Myname = hd(tl(string:tokens(atom_to_list(node()), "@"))), io:format("Myname ~p ~n", [Myname]), @@ -72,7 +75,8 @@ ei_accept_do(Config, CompatRel) -> {ok, ListenFd} = ei_publish(P, Port), {any, EINode} ! TermToSend, - {ok, Fd, _Node} = ei_accept(P, ListenFd), + {ok, Fd, Node} = ei_accept(P, ListenFd), + Node = node(), Got1 = ei_receive(P, Fd), %% Send again, now without auto-connect @@ -88,9 +92,13 @@ ei_accept_do(Config, CompatRel) -> ei_threaded_accept(Config) when is_list(Config) -> Einode = filename:join(proplists:get_value(data_dir, Config), "eiaccnode"), + ei_threaded_accept_do(Einode, default), + ei_threaded_accept_do(Einode, ussi), + ok. + +ei_threaded_accept_do(Einode, SockImpl) -> N = 3, - Host = atom_to_list(node()), - start_einode(Einode, N, Host), + start_einode(Einode, N, SockImpl), io:format("started eiaccnode"), TestServerPid = self(), [spawn_link(fun() -> send_rec_einode(I, TestServerPid) end) || I <- lists:seq(0, N-1)], @@ -101,7 +109,7 @@ ei_threaded_accept(Config) when is_list(Config) -> %% Test erlang:monitor toward erl_interface "processes" monitor_ei_process(Config) when is_list(Config) -> P = runner:start(Config, ?interpret), - 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, 0, default), Myname = hd(tl(string:tokens(atom_to_list(node()), "@"))), io:format("Myname ~p ~n", [Myname]), @@ -125,10 +133,19 @@ monitor_ei_process(Config) when is_list(Config) -> runner:finish(P), - [{'DOWN', MRef1, process, {any, EINode}, noconnection}, - {'DOWN', MRef2, process, {any, EINode}, noconnection} - ] = lists:sort(flush(2, 1000)), - + ok =receive + {'DOWN', MRef1, process, {any, EINode}, noconnection} -> + ok + after 1000 -> + timeout + end, + ok = receive + {'DOWN', MRef2, process, {any, EINode}, noconnection} -> + ok + after 1000 -> + timeout + end, + [] = flush(0, 1000), ok. waitfornode(String,0) -> @@ -164,9 +181,10 @@ send_rec_einode(N, TestServerPid) -> ct:fail(EINode) end. -start_einode(Einode, N, Host) -> +start_einode(Einode, N, SockImpl) -> Einodecmd = Einode ++ " " ++ atom_to_list(erlang:get_cookie()) - ++ " " ++ integer_to_list(N) ++ " " ++ Host, + ++ " " ++ integer_to_list(N) + ++ " " ++ atom_to_list(SockImpl), io:format("Einodecmd ~p ~n", [Einodecmd]), open_port({spawn, Einodecmd}, []), ok. @@ -174,8 +192,8 @@ start_einode(Einode, N, Host) -> %%% Interface functions for ei (erl_interface) functions. -ei_connect_init(P, Num, Cookie, Creation, Compat) -> - send_command(P, ei_connect_init, [Num,Cookie,Creation,Compat]), +ei_connect_init(P, Num, Cookie, Creation, Compat, SockImpl) -> + send_command(P, ei_connect_init, [Num,Cookie,Creation,Compat,SockImpl]), case get_term(P) of {term,Int} when is_integer(Int) -> Int end. diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/Makefile.src b/lib/erl_interface/test/ei_accept_SUITE_data/Makefile.src index 10ef437f8b..7fd0a123b4 100644 --- a/lib/erl_interface/test/ei_accept_SUITE_data/Makefile.src +++ b/lib/erl_interface/test/ei_accept_SUITE_data/Makefile.src @@ -25,6 +25,7 @@ CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)" LD = @LD@ LIBEI = @erl_interface_eilib@ LIBFLAGS = ../all_SUITE_data/ei_runner@obj@ \ + ../all_SUITE_data/my_ussi@obj@ \ $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \ @erl_interface_threadlib@ CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c index 09b0b5440b..64cb2dc447 100644 --- a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c +++ b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c @@ -27,9 +27,6 @@ #include <stdio.h> #include <string.h> -#ifdef VXWORKS -#include "reclaim.h" -#endif #ifdef __WIN32__ #include <winsock2.h> @@ -41,6 +38,7 @@ #endif #include "ei_runner.h" +#include "my_ussi.h" static void cmd_ei_connect_init(char* buf, int len); static void cmd_ei_publish(char* buf, int len); @@ -58,7 +56,7 @@ static struct { int num_args; /* Number of arguments. */ void (*func)(char* buf, int len); } commands[] = { - "ei_connect_init", 4, cmd_ei_connect_init, + "ei_connect_init", 5, cmd_ei_connect_init, "ei_publish", 1, cmd_ei_publish, "ei_accept", 1, cmd_ei_accept, "ei_receive", 1, cmd_ei_receive, @@ -110,10 +108,11 @@ static void cmd_ei_connect_init(char* buf, int len) unsigned long compat; char node_name[100]; char cookie[MAXATOMLEN], * cp = cookie; + char socket_impl[10]; ei_x_buff res; if (ei_decode_long(buf, &index, &num) < 0) fail("expected int"); - sprintf(node_name, "c%d", num); + sprintf(node_name, "c%ld", num); if (ei_decode_atom(buf, &index, cookie) < 0) fail("expected atom (cookie)"); if (cookie[0] == '\0') @@ -124,7 +123,18 @@ static void cmd_ei_connect_init(char* buf, int len) fail("expected uint"); if (compat) ei_set_compat_rel(compat); - r = ei_connect_init(&ec, node_name, cp, creation); + if (ei_decode_atom_as(buf, &index, socket_impl, sizeof(socket_impl), + ERLANG_ASCII, NULL, NULL) < 0) + fail("expected atom (socket_impl)"); + if (strcmp(socket_impl,"default") == 0) + r = ei_connect_init(&ec, node_name, cp, creation); + else if (strcmp(socket_impl,"ussi") == 0) + r = ei_connect_init_ussi(&ec, node_name, cp, creation, + &my_ussi, sizeof(my_ussi), NULL); + else + fail1("unknown socket_impl atom '%s'", socket_impl); + + ei_x_new_with_version(&res); ei_x_encode_long(&res, r); send_bin_term(&res); @@ -152,9 +162,6 @@ static void cmd_ei_publish(char* buf, int len) if ((i = ei_publish(&ec, lport)) == -1) fail("ei_publish"); -#ifdef VXWORKS - save_fd(i); -#endif /* send listen-fd, result and errno */ ei_x_new_with_version(&x); ei_x_encode_tuple_header(&x, 3); @@ -179,9 +186,6 @@ static void cmd_ei_accept(char* buf, int len) fail("expected int (listen fd)"); r = ei_accept(&ec, listen, &conn); -#ifdef VXWORKS - save_fd(r); -#endif /* send result, errno and nodename */ ei_x_new_with_version(&x); ei_x_encode_tuple_header(&x, 3); diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c b/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c index 90c7a2259f..4ce55cacef 100644 --- a/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c +++ b/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c @@ -22,35 +22,28 @@ #include <stdlib.h> #include <stdio.h> +#include <string.h> #ifdef __WIN32__ #include <winsock2.h> #include <windows.h> #include <process.h> #else -#ifndef VXWORKS #include <pthread.h> -#endif #include <sys/types.h> #include <sys/socket.h> #include <netinet/in.h> #endif #include "ei.h" +#include "my_ussi.h" -#ifdef VXWORKS -#include <vxWorks.h> -#include <sockLib.h> -#include <inetLib.h> -#define MAIN cnode -#else #define MAIN main -#endif /* A small einode. To be called from the test case ei_accept_SUITE:multi_thread - usage: eiaccnode <cookie> <n> + usage: eiaccnode <cookie> <n> <default|ussi> - start threads 0..n-1 - in each thread @@ -61,7 +54,8 @@ - shutdown gracefully */ -static const char* cookie, * desthost; +static const char* cookie; +static int use_ussi; #ifndef SD_SEND #ifdef SHUTWR @@ -78,7 +72,7 @@ static void* #endif einode_thread(void* num) { - int n = (int)num; + int n = (int)(long)num; int port; ei_cnode ec; char myname[100], destname[100], filename[100]; @@ -88,10 +82,15 @@ static void* FILE* file; sprintf(filename, "eiacc%d_trace.txt", n); - file = fopen(filename, "w"); + file = fopen(filename, "a"); sprintf(myname, "eiacc%d", n); fflush(file); - r = ei_connect_init(&ec, myname, cookie, 0); + fprintf(file, "---- use_ussi = %d ----\n", use_ussi); fflush(file); + if (use_ussi) + r = ei_connect_init_ussi(&ec, myname, cookie, 0, + &my_ussi, sizeof(my_ussi), NULL); + else + r = ei_connect_init(&ec, myname, cookie, 0); port = 0; listen = ei_listen(&ec, &port, 5); if (listen <= 0) { @@ -151,54 +150,52 @@ static void* return 0; } +int MAIN(int argc, char *argv[]) { int i, n, no_threads; -#ifndef VXWORKS #ifdef __WIN32__ HANDLE threads[100]; #else pthread_t threads[100]; #endif -#endif - if (argc < 3) + if (argc < 4) exit(1); cookie = argv[1]; n = atoi(argv[2]); if (n > 100) exit(2); - desthost = argv[3]; - if (argc == 3) + + if (strcmp(argv[3], "default") == 0) + use_ussi = 0; + else if (strcmp(argv[3], "ussi") == 0) + use_ussi = 1; + else + printf("bad argv[3] '%s'", argv[3]); + + if (argc == 4) no_threads = 0; else no_threads = argv[4] != NULL && strcmp(argv[4], "nothreads") == 0; -#ifdef VXWORKS - no_threads = 1; -#endif ei_init(); for (i = 0; i < n; ++i) { if (!no_threads) { -#ifndef VXWORKS #ifdef __WIN32__ unsigned tid; threads[i] = (HANDLE)_beginthreadex(NULL, 0, einode_thread, - (void*)i, 0, &tid); -#else - pthread_create(&threads[i], NULL, einode_thread, (void*)i); -#endif + (void*)(size_t)i, 0, &tid); #else - ; + pthread_create(&threads[i], NULL, einode_thread, (void*)(size_t)i); #endif } else - einode_thread((void*)i); + einode_thread((void*)(size_t)i); } if (!no_threads) -#ifndef VXWORKS for (i = 0; i < n; ++i) { #ifdef __WIN32__ if (WaitForSingleObject(threads[i], INFINITE) != WAIT_OBJECT_0) @@ -207,9 +204,6 @@ MAIN(int argc, char *argv[]) #endif printf("bad wait thread %d\n", i); } -#else - ; -#endif printf("ok\n"); return 0; } diff --git a/lib/erl_interface/test/ei_connect_SUITE.erl b/lib/erl_interface/test/ei_connect_SUITE.erl index 6184ce801b..2ec1237e8e 100644 --- a/lib/erl_interface/test/ei_connect_SUITE.erl +++ b/lib/erl_interface/test/ei_connect_SUITE.erl @@ -24,7 +24,7 @@ -include_lib("common_test/include/ct.hrl"). -include("ei_connect_SUITE_data/ei_connect_test_cases.hrl"). --export([all/0, suite/0, +-export([all/0, suite/0, groups/0, init_per_testcase/2, ei_send/1, ei_reg_send/1, @@ -33,7 +33,8 @@ rpc_test/1, ei_send_funs/1, ei_threaded_send/1, - ei_set_get_tracelevel/1]). + ei_set_get_tracelevel/1, + ei_connect_host_port_test/1]). -import(runner, [get_term/1,send_term/2]). @@ -42,15 +43,30 @@ suite() -> {timetrap, {seconds, 30}}]. all() -> - [ei_send, ei_reg_send, ei_rpc, ei_format_pid, ei_send_funs, - ei_threaded_send, ei_set_get_tracelevel]. + [ei_threaded_send, + ei_connect_host_port_test, + {group, default}, + {group, ussi}]. + +groups() -> + Members = [ei_send, + ei_format_pid, + ei_send_funs, + ei_set_get_tracelevel, + ei_reg_send, + ei_rpc], + [{default, [], Members}, + {ussi, [], Members}]. + +get_group(Config) -> + proplists:get_value(name, proplists:get_value(tc_group_properties,Config)). init_per_testcase(Case, Config) -> runner:init_per_testcase(?MODULE, Case, Config). ei_send(Config) when is_list(Config) -> P = runner:start(Config, ?interpret), - 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, get_group(Config)), {ok,Fd} = ei_connect(P, node()), ok = ei_send(P, Fd, self(), AMsg={a,message}), @@ -63,7 +79,7 @@ ei_send(Config) when is_list(Config) -> ei_format_pid(Config) when is_list(Config) -> S = self(), P = runner:start(Config, ?interpret), - 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, get_group(Config)), {ok,Fd} = ei_connect(P, node()), ok = ei_format_pid(P, Fd, S), @@ -75,7 +91,7 @@ ei_format_pid(Config) when is_list(Config) -> ei_send_funs(Config) when is_list(Config) -> P = runner:start(Config, ?interpret), - 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, get_group(Config)), {ok,Fd} = ei_connect(P, node()), Fun1 = fun ei_send/1, @@ -94,7 +110,7 @@ ei_send_funs(Config) when is_list(Config) -> ei_reg_send(Config) when is_list(Config) -> P = runner:start(Config, ?interpret), - 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, get_group(Config)), {ok,Fd} = ei_connect(P, node()), ARegName = a_strange_registred_name, @@ -143,7 +159,7 @@ start_einode(Einode, N, Host) -> ei_rpc(Config) when is_list(Config) -> P = runner:start(Config, ?interpret), - 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, get_group(Config)), {ok,Fd} = ei_connect(P, node()), S= "Hej du glade!", SRev = lists:reverse(S), @@ -157,7 +173,7 @@ ei_rpc(Config) when is_list(Config) -> ei_set_get_tracelevel(Config) when is_list(Config) -> P = runner:start(Config, ?interpret), 5 = ei_set_get_tracelevel(P, 5), - 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, get_group(Config)), {ok,Fd} = ei_connect(P, node()), S= "Hej du glade!", SRev = lists:reverse(S), @@ -171,10 +187,31 @@ ei_set_get_tracelevel(Config) when is_list(Config) -> ok. +ei_connect_host_port_test(Config) when is_list(Config) -> + P = runner:start(Config, ?interpret), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, default), + [NodeName, Hostname] = string:lexemes(atom_to_list(node()), "@"), + {ok, NamePortList} = net_adm:names(), + {value, {_, Port}} + = lists:search(fun({N, _}) -> + string:equal(N, NodeName) + end, + NamePortList), + {ok,Fd} = ei_connect_host_port(P, + erlang:list_to_atom(Hostname), + Port), + ok = ei_send(P, Fd, self(), AMsg={a,message}), + receive AMsg -> ok end, + + runner:send_eot(P), + runner:recv_eot(P), + ok. + + %%% Interface functions for ei (erl_interface) functions. -ei_connect_init(P, Num, Cookie, Creation) -> - send_command(P, ei_connect_init, [Num,Cookie,Creation]), +ei_connect_init(P, Num, Cookie, Creation, SockImpl) -> + send_command(P, ei_connect_init, [Num,Cookie,Creation,SockImpl]), case get_term(P) of {term,Int} when is_integer(Int) -> Int end. @@ -186,6 +223,13 @@ ei_connect(P, Node) -> {term,{-1,Errno}} -> {error,Errno} end. +ei_connect_host_port(P, Hostname, Port) -> + send_command(P, ei_connect_host_port, [Hostname, Port]), + case get_term(P) of + {term,{Fd,_}} when Fd >= 0 -> {ok,Fd}; + {term,{-1,Errno}} -> {error,Errno} + end. + ei_set_get_tracelevel(P, Tracelevel) -> send_command(P, ei_set_get_tracelevel, [Tracelevel]), case get_term(P) of diff --git a/lib/erl_interface/test/ei_connect_SUITE_data/Makefile.src b/lib/erl_interface/test/ei_connect_SUITE_data/Makefile.src index c2d8261dd8..bbea076ebd 100644 --- a/lib/erl_interface/test/ei_connect_SUITE_data/Makefile.src +++ b/lib/erl_interface/test/ei_connect_SUITE_data/Makefile.src @@ -23,10 +23,9 @@ include @erl_interface_mk_include@ CC0 = @CC@ CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)" LD = @LD@ -LIBERL = @erl_interface_lib@ LIBEI = @erl_interface_eilib@ LIBFLAGS = ../all_SUITE_data/ei_runner@obj@ \ - $(LIBERL) $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \ + $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \ @erl_interface_threadlib@ CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data EI_CONNECT_OBJS = ei_connect_test@obj@ ei_connect_test_decl@obj@ @@ -39,7 +38,8 @@ clean: $(RM) ei_connect_test@exe@ einode@exe@ ei_connect_test@exe@: $(EI_CONNECT_OBJS) $(LIBEI) - $(LD) @CROSSLDFLAGS@ -o $@ $(EI_CONNECT_OBJS) $(LIBFLAGS) + $(LD) @CROSSLDFLAGS@ -o $@ $(EI_CONNECT_OBJS) \ + ../all_SUITE_data/my_ussi@obj@ $(LIBFLAGS) einode@exe@: $(EINODE_OBJS) $(LIBEI) diff --git a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c index 385bcdd422..54e78253a0 100644 --- a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c +++ b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c @@ -27,14 +27,13 @@ #include <stdio.h> #include <string.h> -#ifdef VXWORKS -#include "reclaim.h" -#endif #include "ei_runner.h" +#include "my_ussi.h" static void cmd_ei_connect_init(char* buf, int len); static void cmd_ei_connect(char* buf, int len); +static void cmd_ei_connect_host_port(char* buf, int len); static void cmd_ei_send(char* buf, int len); static void cmd_ei_format_pid(char* buf, int len); static void cmd_ei_send_funs(char* buf, int len); @@ -52,8 +51,9 @@ static struct { int num_args; /* Number of arguments. */ void (*func)(char* buf, int len); } commands[] = { - "ei_connect_init", 3, cmd_ei_connect_init, + "ei_connect_init", 4, cmd_ei_connect_init, "ei_connect", 1, cmd_ei_connect, + "ei_connect_host_port", 2, cmd_ei_connect_host_port, "ei_send", 3, cmd_ei_send, "ei_send_funs", 3, cmd_ei_send_funs, "ei_reg_send", 3, cmd_ei_reg_send, @@ -107,9 +107,11 @@ TESTCASE(interpret) static void cmd_ei_connect_init(char* buf, int len) { int index = 0, r = 0; - long l; + long l, creation; char b[100]; char cookie[MAXATOMLEN], * cp = cookie; + char socket_impl[10]; + int use_ussi; ei_x_buff res; if (ei_decode_long(buf, &index, &l) < 0) fail("expected int"); @@ -118,7 +120,23 @@ static void cmd_ei_connect_init(char* buf, int len) fail("expected atom (cookie)"); if (cookie[0] == '\0') cp = NULL; - r = ei_connect_init(&ec, b, cp, 0); + if (ei_decode_long(buf, &index, &creation) < 0) + fail("expected int (creation)"); + if (ei_decode_atom_as(buf, &index, socket_impl, + sizeof(socket_impl), ERLANG_ASCII, NULL, NULL) < 0) + fail("expected atom (socket_impl)"); + if (strcmp(socket_impl, "default") == 0) + use_ussi = 0; + else if (strcmp(socket_impl, "ussi") == 0) + use_ussi = 1; + else + fail1("expected atom 'default' or 'ussi', got '%s'", socket_impl); + + if (use_ussi) + r = ei_connect_init_ussi(&ec, b, cp, (short)creation, + &my_ussi, sizeof(my_ussi), NULL); + else + r = ei_connect_init(&ec, b, cp, (short)creation); ei_x_new_with_version(&res); ei_x_encode_long(&res, r); send_bin_term(&res); @@ -133,11 +151,20 @@ static void cmd_ei_connect(char* buf, int len) if (ei_decode_atom(buf, &index, node) < 0) fail("expected atom"); i=ei_connect(&ec, node); -#ifdef VXWORKS - if(i >= 0) { - save_fd(i); - } -#endif + send_errno_result(i); +} + +static void cmd_ei_connect_host_port(char* buf, int len) +{ + int index = 0; + char hostname[256]; + int i; + long port; + if (ei_decode_atom(buf, &index, hostname) < 0) + fail("expected atom"); + if (ei_decode_long(buf, &index, &port) < 0) + fail("expected int"); + i = ei_connect_host_port(&ec, hostname, (int)port); send_errno_result(i); } @@ -225,7 +252,7 @@ static void cmd_ei_send_funs(char* buf, int len) fail("expected Fun1"); if (ei_decode_fun(buf, &index, &fun2) < 0) fail("expected Fun2"); - if (ei_decode_bitstring(buf, &index, &bitstring, &bitoffs, &bits) < 0) + if (ei_decode_bitstring(buf, &index, (const char**)&bitstring, &bitoffs, &bits) < 0) fail("expected bitstring"); if (ei_x_new_with_version(&x) < 0) fail("ei_x_new_with_version"); diff --git a/lib/erl_interface/test/ei_connect_SUITE_data/einode.c b/lib/erl_interface/test/ei_connect_SUITE_data/einode.c index bb71575740..083ca1d372 100644 --- a/lib/erl_interface/test/ei_connect_SUITE_data/einode.c +++ b/lib/erl_interface/test/ei_connect_SUITE_data/einode.c @@ -28,20 +28,13 @@ #include <windows.h> #include <process.h> #else -#ifndef VXWORKS #include <pthread.h> -#endif #include <sys/socket.h> #endif #include "ei.h" -#include "erl_interface.h" -#ifdef VXWORKS -#define MAIN cnode -#else #define MAIN main -#endif /* A small einode. @@ -105,32 +98,25 @@ static void* MAIN(int argc, char *argv[]) { int i, n, no_threads; -#ifndef VXWORKS #ifdef __WIN32__ HANDLE threads[100]; #else pthread_t threads[100]; #endif -#endif if (argc < 3) exit(1); - erl_init(NULL, 0); + ei_init(); cookie = argv[1]; n = atoi(argv[2]); if (n > 100) exit(2); desthost = argv[3]; -#ifndef VXWORKS no_threads = argv[4] != NULL && strcmp(argv[4], "nothreads") == 0; -#else - no_threads = 1; -#endif for (i = 0; i < n; ++i) { if (!no_threads) { -#ifndef VXWORKS #ifdef __WIN32__ unsigned tid; threads[i] = (HANDLE)_beginthreadex(NULL, 0, einode_thread, @@ -138,14 +124,10 @@ MAIN(int argc, char *argv[]) #else pthread_create(&threads[i], NULL, einode_thread, (void*)i); #endif -#else - ; -#endif } else einode_thread((void*)i); } if (!no_threads) -#ifndef VXWORKS for (i = 0; i < n; ++i) { #ifdef __WIN32__ if (WaitForSingleObject(threads[i], INFINITE) != WAIT_OBJECT_0) @@ -154,9 +136,6 @@ MAIN(int argc, char *argv[]) #endif printf("bad wait thread %d\n", i); } -#else - ; -#endif printf("ok\n"); return 0; } diff --git a/lib/erl_interface/test/ei_decode_SUITE.erl b/lib/erl_interface/test/ei_decode_SUITE.erl index e005ec89c7..35feeea42c 100644 --- a/lib/erl_interface/test/ei_decode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_SUITE.erl @@ -77,29 +77,19 @@ test_ei_decode_ulong(Config) when is_list(Config) -> %% ######################################################################## %% test_ei_decode_longlong(Config) when is_list(Config) -> - case os:type() of - vxworks -> - {skip,"Skipped on VxWorks"}; - _ -> - P = runner:start(Config, ?test_ei_decode_longlong), - send_integers2(P), - runner:recv_eot(P), - ok - end. + P = runner:start(Config, ?test_ei_decode_longlong), + send_integers2(P), + runner:recv_eot(P), + ok. %% ######################################################################## %% test_ei_decode_ulonglong(Config) when is_list(Config) -> - case os:type() of - vxworks -> - {skip,"Skipped on VxWorks"}; - _ -> - P = runner:start(Config, ?test_ei_decode_ulonglong), - send_integers2(P), - runner:recv_eot(P), - ok - end. + P = runner:start(Config, ?test_ei_decode_ulonglong), + send_integers2(P), + runner:recv_eot(P), + ok. %% ######################################################################## %% @@ -128,13 +118,8 @@ test_ei_decode_nonoptimal(Config) when is_list(Config) -> send_non_optimal_pos(P), % decode_char send_non_optimal(P), % decode_long send_non_optimal_pos(P), % decode_ulong - case os:type() of - vxworks -> - ok; - _ -> - send_non_optimal(P), % decode_longlong - send_non_optimal_pos(P) % decode_ulonglong - end, + send_non_optimal(P), % decode_longlong + send_non_optimal_pos(P), % decode_ulonglong runner:recv_eot(P), ok. diff --git a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c index 46d6b8f2af..b27c3c589c 100644 --- a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c +++ b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c @@ -20,10 +20,6 @@ #include <string.h> -#ifdef VXWORKS -#include "reclaim.h" -#endif - #include "ei_runner.h" /* @@ -31,15 +27,9 @@ * Author: Kent */ -#ifdef VXWORKS -#define MESSAGE_BACK(SIZE) \ - message("err = %d, size2 = %d, expected size = %d", \ - err, size1, SIZE); -#else #define MESSAGE_BACK(SIZE) \ message("err = %d, size2 = %d, expected size = %d, long long val = %lld", \ err, size1, SIZE, (EI_LONGLONG)p); -#endif #define ERLANG_ANY (ERLANG_ASCII|ERLANG_LATIN1|ERLANG_UTF8) @@ -483,7 +473,6 @@ TESTCASE(test_ei_decode_longlong) { ei_init(); -#ifndef VXWORKS EI_DECODE_2 (decode_longlong, 2, EI_LONGLONG, 0); EI_DECODE_2 (decode_longlong, 2, EI_LONGLONG, 255); EI_DECODE_2 (decode_longlong, 5, EI_LONGLONG, 256); @@ -509,7 +498,6 @@ TESTCASE(test_ei_decode_longlong) EI_DECODE_2_FAIL(decode_longlong, 11, EI_LONGLONG, ll(0xffffffffffffffff)); EI_DECODE_2_FAIL(decode_longlong, 1, EI_LONGLONG, 0); /* Illegal type */ -#endif report(1); } @@ -519,7 +507,6 @@ TESTCASE(test_ei_decode_ulonglong) { ei_init(); -#ifndef VXWORKS EI_DECODE_2 (decode_ulonglong, 2, EI_ULONGLONG, 0); EI_DECODE_2 (decode_ulonglong, 2, EI_ULONGLONG, 255); EI_DECODE_2 (decode_ulonglong, 5, EI_ULONGLONG, 256); @@ -545,7 +532,6 @@ TESTCASE(test_ei_decode_ulonglong) EI_DECODE_2 (decode_ulonglong,11, EI_ULONGLONG, ll(0xffffffffffffffff)); EI_DECODE_2_FAIL(decode_ulonglong, 1, EI_ULONGLONG, 0); /* Illegal type */ -#endif report(1); } @@ -637,8 +623,6 @@ TESTCASE(test_ei_decode_nonoptimal) /* ---------------------------------------------------------------- */ -#ifndef VXWORKS - EI_DECODE_2(decode_longlong, 2, EI_LONGLONG, 42); EI_DECODE_2(decode_longlong, 5, EI_LONGLONG, 42); EI_DECODE_2(decode_longlong, 4, EI_LONGLONG, 42); @@ -681,8 +665,6 @@ TESTCASE(test_ei_decode_nonoptimal) /* EI_DECODE_2(decode_ulonglong, EI_ULONGLONG, -42); */ /* EI_DECODE_2(decode_ulonglong, EI_ULONGLONG, -42); */ -#endif /* !VXWORKS */ - /* ---------------------------------------------------------------- */ report(1); diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c index 512f9ed0c7..5594bec757 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c +++ b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c @@ -18,10 +18,6 @@ * %CopyrightEnd% */ -#ifdef VXWORKS -#include "reclaim.h" -#endif - #include "ei_runner.h" /* diff --git a/lib/erl_interface/test/ei_encode_SUITE.erl b/lib/erl_interface/test/ei_encode_SUITE.erl index 0267a5126f..10fcd6b871 100644 --- a/lib/erl_interface/test/ei_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_encode_SUITE.erl @@ -101,59 +101,49 @@ test_ei_encode_ulong(Config) when is_list(Config) -> %% ######################################################################## %% test_ei_encode_longlong(Config) when is_list(Config) -> - case os:type() of - vxworks -> - {skip,"Skipped on VxWorks"}; - _ -> - P = runner:start(Config, ?test_ei_encode_longlong), - - {<<97,0>> ,0} = get_buf_and_term(P), - {<<97,255>> ,255} = get_buf_and_term(P), - {<<98,256:32/big-signed-integer>>,256} = get_buf_and_term(P), - {<<98,-1:32/big-signed-integer>> ,-1} = get_buf_and_term(P), - - {<<98, 16#07ffffff:32/big-signed-integer>>, 16#07ffffff} = get_buf_and_term(P), - {<<98,-16#08000000:32/big-signed-integer>>,-16#08000000} = get_buf_and_term(P), - {<<110,4,0, 0,0,0,8>> , 16#08000000} = get_buf_and_term(P), - {<<110,4,1, 1,0,0,8>> ,-16#08000001} = get_buf_and_term(P), - - {<<110,4,0, 255,255,255,127>> , 16#7fffffff} = get_buf_and_term(P), - {<<110,4,1, 0,0,0,128>> ,-16#80000000} = get_buf_and_term(P), - {<<110,6,0, 255,255,255,255,255,127>> , 16#7fffffffffff} = get_buf_and_term(P), - {<<110,6,1, 0,0,0,0,0,128>> ,-16#800000000000} = get_buf_and_term(P), - {<<110,8,0, 255,255,255,255,255,255,255,127>>,16#7fffffffffffffff} = get_buf_and_term(P), - {<<110,8,1, 0,0,0,0,0,0,0,128>> ,-16#8000000000000000} = get_buf_and_term(P), - - runner:recv_eot(P), - ok - end. + P = runner:start(Config, ?test_ei_encode_longlong), + + {<<97,0>> ,0} = get_buf_and_term(P), + {<<97,255>> ,255} = get_buf_and_term(P), + {<<98,256:32/big-signed-integer>>,256} = get_buf_and_term(P), + {<<98,-1:32/big-signed-integer>> ,-1} = get_buf_and_term(P), + + {<<98, 16#07ffffff:32/big-signed-integer>>, 16#07ffffff} = get_buf_and_term(P), + {<<98,-16#08000000:32/big-signed-integer>>,-16#08000000} = get_buf_and_term(P), + {<<110,4,0, 0,0,0,8>> , 16#08000000} = get_buf_and_term(P), + {<<110,4,1, 1,0,0,8>> ,-16#08000001} = get_buf_and_term(P), + + {<<110,4,0, 255,255,255,127>> , 16#7fffffff} = get_buf_and_term(P), + {<<110,4,1, 0,0,0,128>> ,-16#80000000} = get_buf_and_term(P), + {<<110,6,0, 255,255,255,255,255,127>> , 16#7fffffffffff} = get_buf_and_term(P), + {<<110,6,1, 0,0,0,0,0,128>> ,-16#800000000000} = get_buf_and_term(P), + {<<110,8,0, 255,255,255,255,255,255,255,127>>,16#7fffffffffffffff} = get_buf_and_term(P), + {<<110,8,1, 0,0,0,0,0,0,0,128>> ,-16#8000000000000000} = get_buf_and_term(P), + + runner:recv_eot(P), + ok. %% ######################################################################## %% test_ei_encode_ulonglong(Config) when is_list(Config) -> - case os:type() of - vxworks -> - {skip,"Skipped on VxWorks"}; - _ -> - P = runner:start(Config, ?test_ei_encode_ulonglong), - - {<<97,0>> ,0} = get_buf_and_term(P), - {<<97,255>> ,255} = get_buf_and_term(P), - {<<98,256:32/big-unsigned-integer>>,256} = get_buf_and_term(P), - - {<<98, 16#07ffffff:32/big-signed-integer>>,16#07ffffff} = get_buf_and_term(P), - {<<110,4,0, 0,0,0,8>> ,16#08000000} = get_buf_and_term(P), - - {<<110,4,0, 255,255,255,127>> ,16#7fffffff} = get_buf_and_term(P), - {<<110,4,0, 0,0,0,128>> ,16#80000000} = get_buf_and_term(P), - {<<110,4,0, 255,255,255,255>> ,16#ffffffff} = get_buf_and_term(P), - {<<110,6,0, 255,255,255,255,255,255>>,16#ffffffffffff} = get_buf_and_term(P), - {<<110,8,0, 255,255,255,255,255,255,255,255>>,16#ffffffffffffffff} = get_buf_and_term(P), + P = runner:start(Config, ?test_ei_encode_ulonglong), - runner:recv_eot(P), - ok - end. + {<<97,0>> ,0} = get_buf_and_term(P), + {<<97,255>> ,255} = get_buf_and_term(P), + {<<98,256:32/big-unsigned-integer>>,256} = get_buf_and_term(P), + + {<<98, 16#07ffffff:32/big-signed-integer>>,16#07ffffff} = get_buf_and_term(P), + {<<110,4,0, 0,0,0,8>> ,16#08000000} = get_buf_and_term(P), + + {<<110,4,0, 255,255,255,127>> ,16#7fffffff} = get_buf_and_term(P), + {<<110,4,0, 0,0,0,128>> ,16#80000000} = get_buf_and_term(P), + {<<110,4,0, 255,255,255,255>> ,16#ffffffff} = get_buf_and_term(P), + {<<110,6,0, 255,255,255,255,255,255>>,16#ffffffffffff} = get_buf_and_term(P), + {<<110,8,0, 255,255,255,255,255,255,255,255>>,16#ffffffffffffffff} = get_buf_and_term(P), + + runner:recv_eot(P), + ok. %% ######################################################################## %% diff --git a/lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c b/lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c index 6f63cc5d7e..6f1276e016 100644 --- a/lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c +++ b/lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c @@ -18,10 +18,6 @@ * %CopyrightEnd% */ -#ifdef VXWORKS -#include "reclaim.h" -#endif - #include "ei_runner.h" /* @@ -460,8 +456,6 @@ TESTCASE(test_ei_encode_longlong) { ei_init(); -#ifndef VXWORKS - EI_ENCODE_1(encode_longlong, 0); EI_ENCODE_1(encode_longlong, 255); @@ -490,8 +484,6 @@ TESTCASE(test_ei_encode_longlong) EI_ENCODE_1(encode_longlong, -ll(0x8000000000000000)); -#endif /* !VXWORKS */ - report(1); } @@ -501,8 +493,6 @@ TESTCASE(test_ei_encode_ulonglong) { ei_init(); -#ifndef VXWORKS - EI_ENCODE_1(encode_ulonglong, 0); EI_ENCODE_1(encode_ulonglong, 255); @@ -523,8 +513,6 @@ TESTCASE(test_ei_encode_ulonglong) EI_ENCODE_1(encode_ulonglong, ll(0xffffffffffffffff)); -#endif /* !VXWORKS */ - report(1); } diff --git a/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c b/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c index 1c0443c0f4..19d2cc1510 100644 --- a/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c +++ b/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c @@ -18,10 +18,6 @@ * %CopyrightEnd% */ -#ifdef VXWORKS -#include "reclaim.h" -#endif - #include "ei_runner.h" #include <string.h> diff --git a/lib/erl_interface/test/erl_global_SUITE.erl b/lib/erl_interface/test/ei_global_SUITE.erl index 6d3a75c8d7..da80ab24cd 100644 --- a/lib/erl_interface/test/erl_global_SUITE.erl +++ b/lib/erl_interface/test/ei_global_SUITE.erl @@ -19,22 +19,27 @@ %% %% --module(erl_global_SUITE). +-module(ei_global_SUITE). -include_lib("common_test/include/ct.hrl"). --include("erl_global_SUITE_data/erl_global_test_cases.hrl"). +-include("ei_global_SUITE_data/ei_global_test_cases.hrl"). -export([all/0,suite/0, init_per_testcase/2, - erl_global_registration/1, - erl_global_whereis/1, erl_global_names/1]). + ei_global_registration/1, + ei_global_whereis/1, + ei_global_names/1 + ]). -import(runner, [get_term/1,send_term/2]). -define(GLOBAL_NAME, global_register_node_test). all() -> - [erl_global_registration, erl_global_whereis, erl_global_names]. + [ei_global_registration, ei_global_whereis, ei_global_names]. + +get_group(Config) -> + proplists:get_value(name, proplists:get_value(tc_group_properties,Config)). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -43,82 +48,76 @@ suite() -> init_per_testcase(Case, Config) -> runner:init_per_testcase(?MODULE, Case, Config). -erl_global_registration(Config) when is_list(Config) -> +ei_global_registration(Config) when is_list(Config) -> P = runner:start(Config, ?interpret), - {ok, Fd} = erl_connect(P, node(), 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, ussi), + {ok,Fd} = ei_connect(P, node()), - ok = erl_global_register(P, Fd, ?GLOBAL_NAME), - ok = erl_global_unregister(P, Fd, ?GLOBAL_NAME), + ok = ei_global_register(P, Fd, ?GLOBAL_NAME), + ok = ei_global_unregister(P, Fd, ?GLOBAL_NAME), - 0 = erl_close_connection(P,Fd), runner:send_eot(P), runner:recv_eot(P), ok. -erl_global_whereis(Config) when is_list(Config) -> +ei_global_whereis(Config) when is_list(Config) -> P = runner:start(Config, ?interpret), - {ok, Fd} = erl_connect(P, node(), 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, ussi), + {ok,Fd} = ei_connect(P, node()), Self = self(), yes = global:register_name(?GLOBAL_NAME, Self), - Self = erl_global_whereis(P, Fd, ?GLOBAL_NAME), + Self = ei_global_whereis(P, Fd, ?GLOBAL_NAME), global:unregister_name(?GLOBAL_NAME), - 0 = erl_close_connection(P, Fd), runner:send_eot(P), runner:recv_eot(P), ok. -erl_global_names(Config) when is_list(Config) -> +ei_global_names(Config) when is_list(Config) -> P = runner:start(Config, ?interpret), - {ok, Fd} = erl_connect(P, node(), 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, ussi), + {ok,Fd} = ei_connect(P, node()), Self = self(), global:register_name(?GLOBAL_NAME, Self), - {Names1, _N1} = erl_global_names(P, Fd), + {Names1, _N1} = ei_global_names(P, Fd), true = lists:member(atom_to_list(?GLOBAL_NAME), Names1), global:unregister_name(?GLOBAL_NAME), - {Names2, _N2} = erl_global_names(P, Fd), + {Names2, _N2} = ei_global_names(P, Fd), false = lists:member(atom_to_list(?GLOBAL_NAME), Names2), - 0 = erl_close_connection(P, Fd), runner:send_eot(P), runner:recv_eot(P), ok. -%%% Interface functions for erl_interface functions. - -erl_connect(P, Node, Num, Cookie, Creation) -> - send_command(P, erl_connect, [Num, Node, Cookie, Creation]), - case get_term(P) of - {term,{Fd,_}} when Fd >= 0 -> {ok,Fd}; - {term,{-1,Errno}} -> {error,Errno} - end. +%% %%% Interface functions for erl_interface functions. -erl_close_connection(P, FD) -> - send_command(P, erl_close_connection, [FD]), - case get_term(P) of - {term,Int} when is_integer(Int) -> Int - end. +%% erl_connect(P, Node, Num, Cookie, Creation) -> +%% send_command(P, erl_connect, [Num, Node, Cookie, Creation]), +%% case get_term(P) of +%% {term,{Fd,_}} when Fd >= 0 -> {ok,Fd}; +%% {term,{-1,Errno}} -> {error,Errno} +%% end. -erl_global_register(P, Fd, Name) -> - send_command(P, erl_global_register, [Fd,Name]), +ei_global_register(P, Fd, Name) -> + send_command(P, ei_global_register, [Fd,Name]), get_send_result(P). -erl_global_whereis(P, Fd, Name) -> - send_command(P, erl_global_whereis, [Fd,Name]), +ei_global_whereis(P, Fd, Name) -> + send_command(P, ei_global_whereis, [Fd,Name]), case get_term(P) of {term, What} -> What end. -erl_global_names(P, Fd) -> - send_command(P, erl_global_names, [Fd]), +ei_global_names(P, Fd) -> + send_command(P, ei_global_names, [Fd]), case get_term(P) of {term, What} -> What end. -erl_global_unregister(P, Fd, Name) -> - send_command(P, erl_global_unregister, [Fd,Name]), +ei_global_unregister(P, Fd, Name) -> + send_command(P, ei_global_unregister, [Fd,Name]), get_send_result(P). get_send_result(P) -> @@ -132,3 +131,17 @@ get_send_result(P) -> send_command(P, Name, Args) -> runner:send_term(P, {Name,list_to_tuple(Args)}). + + +ei_connect_init(P, Num, Cookie, Creation, SockImpl) -> + send_command(P, ei_connect_init, [Num,Cookie,Creation,SockImpl]), + case get_term(P) of + {term,Int} when is_integer(Int) -> Int + end. + +ei_connect(P, Node) -> + send_command(P, ei_connect, [Node]), + case get_term(P) of + {term,{Fd,_}} when Fd >= 0 -> {ok,Fd}; + {term,{-1,Errno}} -> {error,Errno} + end. diff --git a/lib/erl_interface/test/erl_global_SUITE_data/Makefile.first b/lib/erl_interface/test/ei_global_SUITE_data/Makefile.first index b2c62be1f2..5ec0c06af8 100644 --- a/lib/erl_interface/test/erl_global_SUITE_data/Makefile.first +++ b/lib/erl_interface/test/ei_global_SUITE_data/Makefile.first @@ -18,5 +18,5 @@ # %CopyrightEnd% # -erl_global_test_decl.c: erl_global_test.c - erl -noinput -pa ../all_SUITE_data -s init_tc run erl_global_test -s erlang halt +erl_global_test_decl.c: ei_global_test.c + erl -noinput -pa ../all_SUITE_data -s init_tc run ei_global_test -s erlang halt diff --git a/lib/erl_interface/test/erl_global_SUITE_data/Makefile.src b/lib/erl_interface/test/ei_global_SUITE_data/Makefile.src index 1c1530d1b6..43c9095ab4 100644 --- a/lib/erl_interface/test/erl_global_SUITE_data/Makefile.src +++ b/lib/erl_interface/test/ei_global_SUITE_data/Makefile.src @@ -25,17 +25,18 @@ CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)" LD = @LD@ LIBERL = @erl_interface_lib@ LIBEI = @erl_interface_eilib@ -LIBFLAGS = ../all_SUITE_data/runner@obj@ \ - $(LIBERL) $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \ +LIBFLAGS = ../all_SUITE_data/ei_runner@obj@ \ + $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \ @erl_interface_threadlib@ CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data -OBJS = erl_global_test@obj@ erl_global_test_decl@obj@ +EI_GLOBAL_OBJS = ei_global_test@obj@ ei_global_test_decl@obj@ -all: erl_global_test@exe@ - -erl_global_test@exe@: $(OBJS) $(LIBERL) $(LIBEI) - $(LD) @CROSSLDFLAGS@ -o $@ $(OBJS) $(LIBFLAGS) +all: ei_global_test@exe@ clean: - $(RM) $(OBJS) - $(RM) erl_global_test@exe@ + $(RM) $(EI_GLOBAL_OBJS) + $(RM) ei_global_test@exe@ + +ei_global_test@exe@: $(EI_GLOBAL_OBJS) $(LIBEI) + $(LD) @CROSSLDFLAGS@ -o $@ $(EI_GLOBAL_OBJS) \ + ../all_SUITE_data/my_ussi@obj@ $(LIBFLAGS) diff --git a/lib/erl_interface/test/ei_global_SUITE_data/ei_global_test.c b/lib/erl_interface/test/ei_global_SUITE_data/ei_global_test.c new file mode 100644 index 0000000000..4c018667fe --- /dev/null +++ b/lib/erl_interface/test/ei_global_SUITE_data/ei_global_test.c @@ -0,0 +1,239 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +/* + * Purpose: Tests the functions in erl_global.c. + * + * See the ei_global_SUITE.erl file for a "table of contents". + */ + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +#include "ei_runner.h" +#include "my_ussi.h" +#include "ei_connect.h" + +static void cmd_ei_connect_init(char* buf, int len); +static void cmd_ei_connect(char* buf, int len); +static void cmd_ei_global_register(char* buf, int len); +static void cmd_ei_global_whereis(char* buf, int len); +static void cmd_ei_global_names(char* buf, int len); +static void cmd_ei_global_unregister(char* buf, int len); +static void cmd_ei_close_connection(char* buf, int len); + +static void send_errno_result(int value); + +ei_cnode ec; + +static struct { + char* name; + int num_args; /* Number of arguments. */ + void (*func)(char* buf, int len); +} commands[] = { + "ei_connect_init", 4, cmd_ei_connect_init, + "ei_connect", 1, cmd_ei_connect, + "ei_global_register", 2, cmd_ei_global_register, + "ei_global_whereis", 2, cmd_ei_global_whereis, + "ei_global_names", 1, cmd_ei_global_names, + "ei_global_unregister", 2, cmd_ei_global_unregister +}; + + +/* + * Sends a list contaning all data types to the Erlang side. + */ + +TESTCASE(interpret) +{ + ei_x_buff x; + int i; + ei_term term; + + ei_init(); + + ei_x_new(&x); + while (get_bin_term(&x, &term) == 0) { + char* buf = x.buff, func[MAXATOMLEN]; + int index = x.index, arity; + if (term.ei_type != ERL_SMALL_TUPLE_EXT || term.arity != 2) + fail("term should be a tuple of size 2"); + if (ei_decode_atom(buf, &index, func) < 0) + fail("function name should be an atom"); + if (ei_decode_tuple_header(buf, &index, &arity) != 0) + fail("function arguments should be a tuple"); + for (i = 0; i < sizeof(commands)/sizeof(commands[0]); i++) { + if (strcmp(func, commands[i].name) == 0) { + if (arity != commands[i].num_args) + fail("wrong number of arguments"); + commands[i].func(buf + index, x.buffsz - index); + break; + } + } + if (i >= sizeof(commands)/sizeof(commands[0])) { + message("\"%d\" \n", func); + fail("bad command"); + } + } + report(1); + ei_x_free(&x); + return; +} + +static void cmd_ei_connect_init(char* buf, int len) +{ + int index = 0, r = 0; + long l, creation; + char b[100]; + char cookie[MAXATOMLEN], * cp = cookie; + char socket_impl[10]; + int use_ussi; + ei_x_buff res; + if (ei_decode_long(buf, &index, &l) < 0) + fail("expected int"); + sprintf(b, "c%ld", l); + if (ei_decode_atom(buf, &index, cookie) < 0) + fail("expected atom (cookie)"); + if (cookie[0] == '\0') + cp = NULL; + if (ei_decode_long(buf, &index, &creation) < 0) + fail("expected int (creation)"); + if (ei_decode_atom_as(buf, &index, socket_impl, + sizeof(socket_impl), ERLANG_ASCII, NULL, NULL) < 0) + fail("expected atom (socket_impl)"); + if (strcmp(socket_impl, "default") == 0) + use_ussi = 0; + else if (strcmp(socket_impl, "ussi") == 0) + use_ussi = 1; + else + fail1("expected atom 'default' or 'ussi', got '%s'", socket_impl); + + if (use_ussi) + r = ei_connect_init_ussi(&ec, b, cp, (short)creation, + &my_ussi, sizeof(my_ussi), NULL); + else + r = ei_connect_init(&ec, b, cp, (short)creation); + ei_x_new_with_version(&res); + ei_x_encode_long(&res, r); + send_bin_term(&res); + ei_x_free(&res); +} + +static void cmd_ei_connect(char* buf, int len) +{ + int index = 0; + char node[256]; + int i; + if (ei_decode_atom(buf, &index, node) < 0) + fail("expected atom"); + i=ei_connect(&ec, node); + send_errno_result(i); +} + +static void +cmd_ei_global_register(char* buf, int len) +{ + int index = 0; + long fd; + char name[256]; + if (ei_decode_long(buf, &index, &fd) < 0) + fail("expected long"); + if (ei_decode_atom(buf, &index, name) < 0) + fail("expected atom"); + send_errno_result(ei_global_register((int)fd, name, ei_self(&ec))); +} + +static void +cmd_ei_global_whereis(char* buf, int len) +{ + int index = 0; + long fd; + char name[512]; + char node_name[512]; + erlang_pid pid; + if (ei_decode_long(buf, &index, &fd) < 0) + fail("expected long"); + if (ei_decode_atom(buf, &index, name) < 0) + fail("expected atom"); + + if (ei_global_whereis(&ec, fd, name, &pid, node_name) < 0) + fail("ei_global_whereis error code"); + + { + ei_x_buff x; + ei_x_new_with_version(&x); + ei_x_encode_pid(&x, &pid); + send_bin_term(&x); + ei_x_free(&x); + } +} + +static void +cmd_ei_global_names(char* buf, int len) +{ + int index = 0; + long fd; + char** names = NULL; + int count = 0, i; + if (ei_decode_long(buf, &index, &fd) < 0) + fail("expected long"); + + names = ei_global_names(&ec, (int)fd, &count); + + { + ei_x_buff x; + ei_x_new_with_version(&x); + ei_x_encode_tuple_header(&x, 2); + ei_x_encode_list_header(&x, count); + for(i=0; i<count; i++) { + ei_x_encode_string(&x, names[i]); + } + ei_x_encode_empty_list(&x); + ei_x_encode_long(&x, count); + send_bin_term(&x); + ei_x_free(&x); + } +} + +static void +cmd_ei_global_unregister(char* buf, int len) +{ + int index = 0; + long fd; + char name[256]; + if (ei_decode_long(buf, &index, &fd) < 0) + fail("expected long"); + if (ei_decode_atom(buf, &index, name) < 0) + fail("expected atom"); + + send_errno_result(ei_global_unregister(&ec, (int)fd, name)); +} + +static void send_errno_result(int value) +{ + ei_x_buff x; + ei_x_new_with_version(&x); + ei_x_encode_tuple_header(&x, 2); + ei_x_encode_long(&x, value); + ei_x_encode_long(&x, erl_errno); + send_bin_term(&x); + ei_x_free(&x); +} diff --git a/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c b/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c index 27d4153250..2d332c8b0c 100644 --- a/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c +++ b/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c @@ -37,13 +37,9 @@ send_printed_buf(ei_x_buff* x) FILE* f; int n, index = 0, ver; -#ifdef VXWORKS - tmp = "."; -#else if (tmp == NULL) { tmp = "/tmp"; } -#endif strcpy(fn, tmp); strcat(fn, "/ei_print_test.txt"); f = fopen(fn, "w+"); diff --git a/lib/erl_interface/test/ei_tmo_SUITE.erl b/lib/erl_interface/test/ei_tmo_SUITE.erl index 5b9de80128..8d8776949c 100644 --- a/lib/erl_interface/test/ei_tmo_SUITE.erl +++ b/lib/erl_interface/test/ei_tmo_SUITE.erl @@ -25,10 +25,12 @@ -include_lib("kernel/include/inet.hrl"). -include("ei_tmo_SUITE_data/ei_tmo_test_cases.hrl"). --export([all/0, suite/0, +-export([all/0, groups/0, suite/0, init_per_testcase/2, end_per_testcase/2, - framework_check/1, ei_accept_tmo/1, ei_connect_tmo/1, ei_send_tmo/1, - ei_connect_tmo/0, + framework_check/1, ei_accept_tmo/1, ei_connect_tmo/1, + ei_send_tmo/1, + ei_send_failure_tmo/1, + ei_connect_unreachable_tmo/0, ei_connect_unreachable_tmo/1, ei_recv_tmo/1]). suite() -> @@ -36,19 +38,25 @@ suite() -> {timetrap, {minutes, 1}}]. all() -> - [framework_check, ei_accept_tmo, ei_connect_tmo, - ei_send_tmo, ei_recv_tmo]. + [framework_check, + ei_connect_unreachable_tmo, + ei_send_failure_tmo, + {group, default}, + {group, ussi}]. + +groups() -> + Members = [ei_recv_tmo, + ei_accept_tmo, + ei_connect_tmo, + ei_send_tmo], + [{default, [], Members}, + {ussi, [], Members}]. + +get_group(Config) -> + proplists:get_value(name, proplists:get_value(tc_group_properties,Config)). init_per_testcase(Case, Config) -> - Config1 = runner:init_per_testcase(?MODULE, Case, Config), - - % test if platform is vxworks_simso - {_,Host} = split(node()), - Bool = case atom_to_list(Host) of - [$v,$x,$s,$i,$m | _] -> true; - _ -> false - end, - [{vxsim,Bool} | Config1]. + runner:init_per_testcase(?MODULE, Case, Config). end_per_testcase(_Case, _Config) -> ok. @@ -76,7 +84,8 @@ do_one_recv(Config,CNode) -> P1 = runner:start(Config, ?recv_tmo), runner:send_term(P1,{CNode, erlang:get_cookie(), - node()}), + node(), + get_group(Config)}), {term, X} = runner:get_term(P1, 10000), true = is_integer(X), CNode1 = join(CNode,Host), @@ -89,24 +98,22 @@ do_one_recv_failure(Config,CNode) -> P1 = runner:start(Config, ?recv_tmo), runner:send_term(P1,{CNode, erlang:get_cookie(), - node()}), + node(), + get_group(Config)}), {term, X} = runner:get_term(P1, 10000), true = is_integer(X), {term, {Ret,ETimedout,ETimedout}} = runner:get_term(P1, 10000), true = (Ret < 0), runner:recv_eot(P1). +-define(EI_DIST_LOW, 5). +-define(EI_DIST_HIGH, 6). %% Check send with timeouts. ei_send_tmo(Config) when is_list(Config) -> - %dbg:tracer(), - %dbg:p(self()), - VxSim = proplists:get_value(vxsim, Config), register(ei_send_tmo_1,self()), do_one_send(Config,self(),c_node_send_tmo_1), do_one_send(Config,ei_send_tmo_1,c_node_send_tmo_2), - do_one_send_failure(Config,self(),cccc1,c_nod_send_tmo_3,VxSim), - do_one_send_failure(Config,ei_send_tmo_1,cccc2,c_nod_send_tmo_4,VxSim), ok. @@ -115,7 +122,8 @@ do_one_send(Config,From,CNode) -> P1 = runner:start(Config, ?send_tmo), runner:send_term(P1,{CNode, erlang:get_cookie(), - node()}), + node(), + get_group(Config)}), {term, X} = runner:get_term(P1, 10000), true = is_integer(X), CNode1 = join(CNode,Host), @@ -130,7 +138,17 @@ do_one_send(Config,From,CNode) -> {term, 0} = runner:get_term(P1, 10000), runner:recv_eot(P1). -do_one_send_failure(Config,From,FakeName,CName,VxSim) -> +ei_send_failure_tmo(Config) when is_list(Config) -> + register(ei_send_tmo_1,self()), + [begin + io:format("Test dist version ~p\n", [Ver]), + do_one_send_failure(Config,self(),cccc1,c_nod_send_tmo_3, Ver), + do_one_send_failure(Config,ei_send_tmo_1,cccc2,c_nod_send_tmo_4, Ver) + end + || Ver <- lists:seq(?EI_DIST_LOW, ?EI_DIST_HIGH)], + ok. + +do_one_send_failure(Config,From,FakeName,CName, OurVer) -> {_,Host} = split(node()), OurName = join(FakeName,Host), Node = join(CName,Host), @@ -140,22 +158,23 @@ do_one_send_failure(Config,From,FakeName,CName,VxSim) -> Else -> exit(Else) end, - EpmdSocket = register(OurName, LSocket, 1, 5), + EpmdSocket = epmd_register(OurName, LSocket, OurVer), P3 = runner:start(Config, ?send_tmo), Cookie = kaksmula_som_ingen_bryr_sig_om, runner:send_term(P3,{CName, Cookie, - OurName}), + OurName, + default}), SocketB = case gen_tcp:accept(LSocket) of {ok, Socket1} -> Socket1; Else2 -> exit(Else2) end, - {hidden,Node,5} = recv_name(SocketB), % See 1) + {hidden,Node} = recv_name(SocketB, OurVer), % See 1) send_status(SocketB, ok), MyChallengeB = gen_challenge(), - send_challenge(SocketB, OurName, MyChallengeB, 5), + send_challenge(SocketB, OurName, MyChallengeB, OurVer), HisChallengeB = recv_challenge_reply(SocketB, MyChallengeB, Cookie), @@ -178,53 +197,43 @@ do_one_send_failure(Config,From,FakeName,CName,VxSim) -> %% must be large enough so there's time for the select() to time out and %% the test program to return the error tuple (below). - Res0 = if VxSim == false -> - {term,{Res,ETO,Iters,ETO}} = runner:get_term(P3, 20000), - Res; - true -> % relax the test for vxsim - case runner:get_term(P3, 20000) of - {term,{Res,ETO,Iters,ETO}} -> - Res; - {term,{Res,_,Iters,_ETO}} -> % EIO? - Res - end - end, + {term,{Res,ETO,Iters,ETO}} = runner:get_term(P3, 20000), runner:recv_eot(P3), - true = ((Res0 < 0) and (Iters > 0)), + true = ((Res < 0) and (Iters > 0)), gen_tcp:close(SocketB), gen_tcp:close(EpmdSocket), ok. %% Check accept with timeouts. -ei_connect_tmo() -> [{require, test_host_not_reachable}]. +ei_connect_unreachable_tmo() -> [{require, test_host_not_reachable}]. -ei_connect_tmo(Config) when is_list(Config) -> - %dbg:tracer(), - %dbg:p(self()), - VxSim = proplists:get_value(vxsim, Config), +ei_connect_unreachable_tmo(Config) when is_list(Config) -> DummyNode = make_and_check_dummy(), P = runner:start(Config, ?connect_tmo), runner:send_term(P,{c_nod_connect_tmo_1, kaksmula_som_ingen_bryr_sig_om, - DummyNode}), - ETimedout = - if VxSim == false -> - {term,{-3,ETO,ETO}} = runner:get_term(P, 10000), - ETO; - true -> % relax the test for vxsim - case runner:get_term(P, 10000) of - {term,{-3,ETO,ETO}} -> - ETO; - {term,{-1,_,ETO}} -> % EHOSTUNREACH = ok - ETO - end - end, + DummyNode, + default}), + {term,{-3,ETimedout,ETimedout}} = runner:get_term(P, 10000), runner:recv_eot(P), + ok. + +ei_connect_tmo(Config) when is_list(Config) -> + [begin + io:format("Test dist version ~p published as ~p\n", [OurVer,OurEpmdVer]), + do_ei_connect_tmo(Config, OurVer, OurEpmdVer) + end + || OurVer <- lists:seq(?EI_DIST_LOW, ?EI_DIST_HIGH), + OurEpmdVer <- lists:seq(?EI_DIST_LOW, ?EI_DIST_HIGH), + OurVer >= OurEpmdVer]. + +do_ei_connect_tmo(Config, OurVer, OurEpmdVer) -> P2 = runner:start(Config, ?connect_tmo), runner:send_term(P2,{c_nod_connect_tmo_2, erlang:get_cookie(), - node()}), + node(), + get_group(Config)}), {term, X} = runner:get_term(P2, 10000), runner:recv_eot(P2), true = is_integer(X), @@ -238,22 +247,24 @@ ei_connect_tmo(Config) when is_list(Config) -> Else -> exit(Else) end, - EpmdSocket = register(OurName, LSocket, 1, 5), + EpmdSocket = epmd_register(OurName, LSocket, OurEpmdVer), P3 = runner:start(Config, ?connect_tmo), Cookie = kaksmula_som_ingen_bryr_sig_om, runner:send_term(P3,{c_nod_connect_tmo_3, Cookie, - OurName}), + OurName, + get_group(Config)}), SocketB = case gen_tcp:accept(LSocket) of {ok, Socket1} -> Socket1; Else2 -> exit(Else2) end, - {hidden,Node,5} = recv_name(SocketB), % See 1) + {hidden,Node} = recv_name(SocketB, OurEpmdVer), % See 1) send_status(SocketB, ok), MyChallengeB = gen_challenge(), - send_challenge(SocketB, OurName, MyChallengeB, 5), + send_challenge(SocketB, OurName, MyChallengeB, OurVer), + recv_complement(SocketB, OurVer, OurEpmdVer), _HisChallengeB = recv_challenge_reply(SocketB, MyChallengeB, Cookie), @@ -266,16 +277,27 @@ ei_connect_tmo(Config) when is_list(Config) -> %% Check accept with timeouts. ei_accept_tmo(Config) when is_list(Config) -> - %%dbg:tracer(), - %%dbg:p(self()), + [begin + io:format("Test our dist ver=~p and assumed ver=~p\n", + [OurVer, AssumedVer]), + do_ei_accept_tmo(Config, OurVer, AssumedVer) + end + || OurVer <- lists:seq(?EI_DIST_LOW, ?EI_DIST_HIGH), + AssumedVer <- lists:seq(?EI_DIST_LOW, ?EI_DIST_HIGH), + OurVer >= AssumedVer], + ok. + +do_ei_accept_tmo(Config, OurVer, AssumedVer) -> P = runner:start(Config, ?accept_tmo), runner:send_term(P,{c_nod_som_ingen_kontaktar_1, - kaksmula_som_ingen_bryr_sig_om}), + kaksmula_som_ingen_bryr_sig_om, + get_group(Config)}), {term,{-1,ETimedout,ETimedout}} = runner:get_term(P, 10000), runner:recv_eot(P), P2 = runner:start(Config, ?accept_tmo), runner:send_term(P2,{c_nod_som_vi_kontaktar_1, - erlang:get_cookie()}), + erlang:get_cookie(), + get_group(Config)}), receive after 1000 -> ok end, CNode1 = make_node(c_nod_som_vi_kontaktar_1), {ignored,CNode1} ! tjenare, @@ -284,19 +306,20 @@ ei_accept_tmo(Config) when is_list(Config) -> true = is_integer(X), P3 = runner:start(Config, ?accept_tmo), runner:send_term(P3,{c_nod_som_vi_kontaktar_2, - erlang:get_cookie()}), + erlang:get_cookie(), + get_group(Config)}), receive after 1000 -> ok end, CNode2 = make_node(c_nod_som_vi_kontaktar_2), {NA,NB} = split(CNode2), {_,Host} = split(node()), OurName = join(ccc,Host), - {port,PortNo,_} = erl_epmd:port_please(NA,NB), + {port,PortNo,?EI_DIST_HIGH} = erl_epmd:port_please(NA,NB), {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, [{active,false}, {packet,2}]), - send_name(SocketA,OurName,5), + send_name(SocketA,OurName,OurVer,AssumedVer), ok = recv_status(SocketA), - {hidden,_Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1) + {hidden,_Node,HisChallengeA} = recv_challenge(SocketA,OurVer), % See 1) _OurChallengeA = gen_challenge(), _OurDigestA = gen_digest(HisChallengeA, erlang:get_cookie()), %% Dont do the last two steps of the connection setup... @@ -342,6 +365,7 @@ make_and_check_dummy() -> -define(DFLAG_EXTENDED_PIDS_PORTS,16#100). -define(DFLAG_NEW_FLOATS,16#800). -define(DFLAG_DIST_MONITOR,8). +-define(DFLAG_HANDSHAKE_23,16#1000000). %% From R9 and forward extended references is compulsory %% From 14 and forward new float is compulsory @@ -405,31 +429,61 @@ recv_status(Socket) -> exit(Bad) end. -send_challenge(Socket, Node, Challenge, Version) -> - send_challenge(Socket, Node, Challenge, Version, ?COMPULSORY_DFLAGS). -send_challenge(Socket, Node, Challenge, Version, Flags) -> - {ok, {{_Ip1,_Ip2,_Ip3,_Ip4}, _}} = inet:sockname(Socket), - ?to_port(Socket, [$n,?int16(Version),?int32(Flags), - ?int32(Challenge), atom_to_list(Node)]). - -recv_challenge(Socket) -> +send_challenge(Socket, Node, Challenge, OurVer) -> + send_challenge(Socket, Node, Challenge, OurVer, ?COMPULSORY_DFLAGS). + +send_challenge(Socket, Node, Challenge, OurVer, Flags) -> + if OurVer =:= 5 -> + ?to_port(Socket, [$n, ?int16(OurVer), ?int32(Flags), + ?int32(Challenge), atom_to_list(Node)]); + OurVer >= 6 -> + NodeName = atom_to_binary(Node, latin1), + NameLen = byte_size(NodeName), + Creation = erts_internal:get_creation(), + ?to_port(Socket, [$N, + <<(Flags bor ?DFLAG_HANDSHAKE_23):64, + Challenge:32, + Creation:32, + NameLen:16>>, + NodeName]) + end. + +recv_challenge(Socket, OurVer) -> case gen_tcp:recv(Socket, 0) of {ok,[$n,V1,V0,Fl1,Fl2,Fl3,Fl4,CA3,CA2,CA1,CA0 | Ns]} -> + 5 = OurVer, Flags = ?u32(Fl1,Fl2,Fl3,Fl4), - Type = case Flags band ?DFLAG_PUBLISHED of - 0 -> - hidden; - _ -> - normal - end, + Type = flags_to_type(Flags), Node =list_to_atom(Ns), - Version = ?u16(V1,V0), + OurVer = ?u16(V1,V0), % echoed back + Challenge = ?u32(CA3,CA2,CA1,CA0), + {Type,Node,Challenge}; + + {ok,[$N, F7,F6,F5,F4,F3,F2,F1,F0, CA3,CA2,CA1,CA0, + _Cr3,_Cr2,_Cr1,_Cr0, NL1,NL0 | Rest]} -> + true = (OurVer >= 6), + <<Flags:64>> = <<F7,F6,F5,F4,F3,F2,F1,F0>>, + Type = flags_to_type(Flags), + NameLen = ?u16(NL1,NL0), + {NodeName,_} = lists:split(NameLen, Rest), + Node = list_to_atom(NodeName), Challenge = ?u32(CA3,CA2,CA1,CA0), - {Type,Node,Version,Challenge}; + %%Creation = ?u32(Cr3,Cr2,Cr1,Cr0), + %%true = (Creation =/= 0), + {Type,Node,Challenge}; + _ -> ?shutdown(no_node) end. +flags_to_type(Flags) -> + case Flags band ?DFLAG_PUBLISHED of + 0 -> + hidden; + _ -> + normal + end. + %send_challenge_reply(Socket, Challenge, Digest) -> % ?to_port(Socket, [$r,?int32(Challenge),Digest]). @@ -443,8 +497,8 @@ recv_challenge_reply(Socket, ChallengeA, Cookie) -> true -> ?shutdown(bad_challenge_reply) end; - _ -> - ?shutdown(no_node) + Other -> + ?shutdown({recv_challenge_reply,Other}) end. send_challenge_ack(Socket, Digest) -> @@ -463,37 +517,53 @@ send_challenge_ack(Socket, Digest) -> % ?shutdown(bad_challenge_ack) % end. -send_name(Socket, MyNode0, Version) -> - send_name(Socket, MyNode0, Version, ?COMPULSORY_DFLAGS). -send_name(Socket, MyNode0, Version, Flags) -> - MyNode = atom_to_list(MyNode0), - ?to_port(Socket, [$n,?int16(Version),?int32(Flags)] ++ - MyNode). +send_name(Socket, MyNode, OurVer, AssumedVer) -> + Flags = ?COMPULSORY_DFLAGS bor (case OurVer of + 5 -> 0; + 6 -> ?DFLAG_HANDSHAKE_23 + end), + send_name(Socket, MyNode, OurVer, AssumedVer, Flags). + +send_name(Socket, MyNode, OurVer, AssumedVer, Flags) -> + NodeName = atom_to_binary(MyNode, latin1), + if AssumedVer =:= 5 -> + ?to_port(Socket, [$n,?int16(OurVer),?int32(Flags),NodeName]); + AssumedVer >= 6 -> + Creation = erts_internal:get_creation(), + ?to_port(Socket, [$N, + <<Flags:64, + Creation:32, + (byte_size(NodeName)):16>>, + NodeName]) + end. -%% -%% recv_name is common for both old and new handshake. -%% -recv_name(Socket) -> +recv_name(Socket, OurEpmdVer) -> case gen_tcp:recv(Socket, 0) of - {ok,Data} -> - get_name(Data); + {ok,[$n, V1,V0, F3,F2,F1,F0 | OtherNode]} -> + 5 = OurEpmdVer, + 5 = ?u16(V1,V0), + Type = flags_to_type(?u32(F3,F2,F1,F0)), + {Type, list_to_atom(OtherNode)}; + {ok,[$N, F7,F6,F5,F4,F3,F2,F1,F0, _Cr3,_Cr2,_Cr1,_Cr0, NL1, NL0 | Rest]} -> + true = (OurEpmdVer >= 6), + {OtherNode, _Residue} = lists:split(?u16(NL1,NL0), Rest), + <<Flags:64>> = <<F7,F6,F5,F4,F3,F2,F1,F0>>, + Type = flags_to_type(Flags), + {Type, list_to_atom(OtherNode)}; Res -> ?shutdown({no_node,Res}) end. -get_name([$m,VersionA,VersionB,_Ip1,_Ip2,_Ip3,_Ip4|OtherNode]) -> - {normal, list_to_atom(OtherNode), ?u16(VersionA,VersionB)}; -get_name([$h,VersionA,VersionB,_Ip1,_Ip2,_Ip3,_Ip4|OtherNode]) -> - {hidden, list_to_atom(OtherNode), ?u16(VersionA,VersionB)}; -get_name([$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4 | OtherNode]) -> - Type = case ?u32(Flag1, Flag2, Flag3, Flag4) band ?DFLAG_PUBLISHED of - 0 -> hidden; - _ -> normal - end, - {Type, list_to_atom(OtherNode), - ?u16(VersionA,VersionB)}; -get_name(Data) -> - ?shutdown(Data). +recv_complement(Socket, OurVer, 5) when OurVer > 5 -> + case gen_tcp:recv(Socket, 0) of + {ok,[$c, _F7,_F6,_F5,_F4, _Cr3,_Cr2,_Cr1,_Cr0]} -> + ok; + Res -> + ?shutdown({no_node,Res}) + end; +recv_complement(_, _OurVer, _OurEpmdVer) -> + ok. + %% %% tell_name is for old handshake @@ -538,13 +608,10 @@ wait_for_reg_reply(Socket, SoFar) -> receive {tcp, Socket, Data0} -> case SoFar ++ Data0 of - [$y, Result, A, B] -> - case Result of - 0 -> - {alive, Socket, ?u16(A, B)}; - _ -> - {error, duplicate_name} - end; + [$y, 0, Cr1,Cr0] -> + {alive, Socket, ?u16(Cr1,Cr0)}; + [$v, 0, Cr3,Cr2,Cr1,Cr0] -> + {alive, Socket, ?u32(Cr3,Cr2,Cr1,Cr0)}; Data when length(Data) < 4 -> wait_for_reg_reply(Socket, Data); Garbage -> @@ -558,9 +625,9 @@ wait_for_reg_reply(Socket, SoFar) -> end. -register(NodeName, ListenSocket, VLow, VHigh) -> +epmd_register(NodeName, ListenSocket, OurVer) -> {ok,{_,TcpPort}} = inet:sockname(ListenSocket), - case do_register_node(NodeName, TcpPort, VLow, VHigh) of + case do_register_node(NodeName, TcpPort, ?EI_DIST_LOW, OurVer) of {alive, Socket, _Creation} -> Socket; Other -> diff --git a/lib/erl_interface/test/ei_tmo_SUITE_data/Makefile.src b/lib/erl_interface/test/ei_tmo_SUITE_data/Makefile.src index b4ee361939..378e276524 100644 --- a/lib/erl_interface/test/ei_tmo_SUITE_data/Makefile.src +++ b/lib/erl_interface/test/ei_tmo_SUITE_data/Makefile.src @@ -25,7 +25,8 @@ CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)" LD = @LD@ LIBEI = @erl_interface_eilib@ LIBFLAGS = ../all_SUITE_data/ei_runner@obj@ \ - $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \ + ../all_SUITE_data/my_ussi@obj@ \ + $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \ @erl_interface_threadlib@ CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data EI_TMO_OBJS = ei_tmo_test@obj@ ei_tmo_test_decl@obj@ diff --git a/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c b/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c index 693e405f75..3c20e94c02 100644 --- a/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c +++ b/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c @@ -21,9 +21,6 @@ #include <stdio.h> #include <stdlib.h> #include <string.h> -#ifdef VXWORKS -#include "reclaim.h" -#endif #ifdef __WIN32__ #include <winsock2.h> @@ -35,6 +32,7 @@ #endif #include "ei_runner.h" +#include "my_ussi.h" #ifndef __WIN32__ #define closesocket(X) close(X) @@ -67,7 +65,7 @@ static void debugf_open(int number) { char filename[1024]; sprintf(filename,"ei_tmo_test%d.debug",number); -#if !defined(VXWORKS) && !defined(__WIN32__) +#if !defined(__WIN32__) close(2); #endif debugfile = fopen(filename,"a"); @@ -86,6 +84,7 @@ static void debugf_close(void) #define DEBUGF(X) /* noop */ #endif + TESTCASE(framework_check) { char *ptr = NULL; @@ -128,19 +127,26 @@ TESTCASE(framework_check) report(1); } -int decode_request(char **nodename_p, char **cookie_p, char **peername_p) +int decode_request(char **nodename_p, char **cookie_p, char **peername_p, + int *use_ussi_p) { char *nodename = NULL; char *cookie = NULL; char *peername = NULL; + char socket_impl[10]; char *ptr = NULL; ei_x_buff x; int len; int version; int type; int size; - int expected_size = (peername_p == NULL) ? 2 : 3; + int expected_size = 2; int ret = -1; + + if (peername_p) + ++expected_size; + if (use_ussi_p) + ++expected_size; ptr = read_packet(&len); ei_x_new(&x); @@ -180,7 +186,6 @@ int decode_request(char **nodename_p, char **cookie_p, char **peername_p) } nodename = malloc(size+1); ei_decode_atom(x.buff,&len,nodename); - nodename[size] = '\0'; /* needed????? */ if (ei_get_type(x.buff,&len,&type,&size) != 0) { DEBUGF(("Failure at line %d\n",__LINE__)); goto cleanup; @@ -191,8 +196,7 @@ int decode_request(char **nodename_p, char **cookie_p, char **peername_p) } cookie = malloc(size + 1); ei_decode_atom(x.buff,&len,cookie); - cookie[size] = '\0'; /* needed????? */ - if (expected_size > 2) { + if (peername_p) { if (ei_get_type(x.buff,&len,&type,&size) != 0) { DEBUGF(("Failure at line %d\n",__LINE__)); goto cleanup; @@ -212,6 +216,22 @@ int decode_request(char **nodename_p, char **cookie_p, char **peername_p) DEBUGF(("nodename = %s, cookie = %s\n", nodename, cookie)); } + + if (use_ussi_p) { + if (ei_decode_atom_as(x.buff,&len,socket_impl,sizeof(socket_impl), + ERLANG_ASCII, NULL, NULL)) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } + if (strcmp(socket_impl,"default") == 0) + *use_ussi_p = 0; + else if (strcmp(socket_impl,"ussi") == 0) + *use_ussi_p = 1; + else { + DEBUGF(("Unkown socket_impl '%s' at %d\n",socket_impl,__LINE__)); + goto cleanup; + } + } *nodename_p = nodename; nodename = NULL; *cookie_p = cookie; @@ -339,6 +359,7 @@ TESTCASE(recv_tmo) char *nodename = NULL; char *cookie = NULL; char *peername = NULL; + int use_ussi; int com_sock = -1; ei_cnode nodeinfo; @@ -346,12 +367,22 @@ TESTCASE(recv_tmo) OPEN_DEBUGFILE(5); - if (decode_request(&nodename,&cookie,&peername) != 0) { + if (decode_request(&nodename,&cookie,&peername,&use_ussi) != 0) { goto cleanup; } - if (ei_connect_init(&nodeinfo, nodename, cookie, 0) < 0) { - DEBUGF(("Failure at line %d\n",__LINE__)); - goto cleanup; + if (use_ussi) { + my_ussi_init(); + if (ei_connect_init_ussi(&nodeinfo, nodename, cookie, 0, + &my_ussi, sizeof(my_ussi), NULL) < 0) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } + } + else { + if (ei_connect_init(&nodeinfo, nodename, cookie, 0) < 0) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } } if ((com_sock = ei_connect_tmo(&nodeinfo, peername, 5000)) < 0) { @@ -451,18 +482,29 @@ TESTCASE(send_tmo) char *cookie = NULL; char *peername = NULL; int com_sock = -1; + int use_ussi; ei_cnode nodeinfo; ei_init(); OPEN_DEBUGFILE(4); - if (decode_request(&nodename,&cookie,&peername) != 0) { + if (decode_request(&nodename,&cookie,&peername,&use_ussi) != 0) { goto cleanup; } - if (ei_connect_init(&nodeinfo, nodename, cookie, 0) < 0) { - DEBUGF(("Failure at line %d\n",__LINE__)); - goto cleanup; + if (use_ussi) { + my_ussi_init(); + if (ei_connect_init_ussi(&nodeinfo, nodename, cookie, 0, + &my_ussi, sizeof(my_ussi), NULL) < 0) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } + } + else { + if (ei_connect_init(&nodeinfo, nodename, cookie, 0) < 0) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } } if ((com_sock = ei_connect_tmo(&nodeinfo, peername, 5000)) < 0) { @@ -593,18 +635,29 @@ TESTCASE(connect_tmo) char *cookie = NULL; char *peername = NULL; int com_sock = -1; + int use_ussi; ei_cnode nodeinfo; ei_init(); OPEN_DEBUGFILE(3); - if (decode_request(&nodename,&cookie,&peername) != 0) { + if (decode_request(&nodename,&cookie,&peername,&use_ussi) != 0) { goto cleanup; } - if (ei_connect_init(&nodeinfo, nodename, cookie, 0) < 0) { - DEBUGF(("Failure at line %d\n",__LINE__)); - goto cleanup; + if (use_ussi) { + my_ussi_init(); + if (ei_connect_init_ussi(&nodeinfo, nodename, cookie, 0, + &my_ussi, sizeof(my_ussi), NULL) < 0) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } + } + else { + if (ei_connect_init(&nodeinfo, nodename, cookie, 0) < 0) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } } if ((com_sock = ei_connect_tmo(&nodeinfo, peername, 5000)) < 0) { @@ -679,10 +732,12 @@ TESTCASE(accept_tmo) int listen_sock = -1; int epmd_sock = -1; int com_sock = -1; + int use_ussi; struct sockaddr_in sin; int sin_siz = sizeof(sin); ErlConnect peer; ei_cnode nodeinfo; + int port_no; ei_init(); @@ -690,38 +745,55 @@ TESTCASE(accept_tmo) putenv("EI_TRACELEVEL=10"); - if (decode_request(&nodename,&cookie,NULL) != 0) { - goto cleanup; - } - if (ei_connect_init(&nodeinfo, nodename, cookie, 0) < 0) { - DEBUGF(("Failure at line %d\n",__LINE__)); + if (decode_request(&nodename,&cookie,NULL,&use_ussi) != 0) { goto cleanup; } + if (use_ussi) { + my_ussi_init(); + if (ei_connect_init_ussi(&nodeinfo, nodename, cookie, 0, + &my_ussi, sizeof(my_ussi), NULL) < 0) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } + port_no = 0; + listen_sock = ei_listen(&nodeinfo, &port_no, 5); + if (listen_sock == ERL_ERROR) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } + } + else { + if (ei_connect_init(&nodeinfo, nodename, cookie, 0) < 0) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } - if ((listen_sock = socket(AF_INET, SOCK_STREAM, 0)) < 0) { - DEBUGF(("Failure at line %d\n",__LINE__)); - goto cleanup; - } - memset(&sin, 0, sizeof(sin)); - sin.sin_family = AF_INET; - sin.sin_addr.s_addr = INADDR_ANY; - - if (bind(listen_sock,(struct sockaddr *) &sin, sizeof(sin)) != 0) { - DEBUGF(("Failure at line %d\n",__LINE__)); - goto cleanup; - } - if (getsockname(listen_sock, - (struct sockaddr *) &sin, &sin_siz) != 0) { - DEBUGF(("Failure at line %d\n",__LINE__)); - goto cleanup; - } - if (listen(listen_sock, 5) != 0) { - DEBUGF(("Failure at line %d\n",__LINE__)); - goto cleanup; - } - - if ((epmd_sock = ei_publish(&nodeinfo, ntohs(sin.sin_port))) < 0) { - DEBUGF(("Failure at line %d[%d,%d]\n",__LINE__,sin.sin_port,erl_errno)); + if ((listen_sock = socket(AF_INET, SOCK_STREAM, 0)) < 0) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } + memset(&sin, 0, sizeof(sin)); + sin.sin_family = AF_INET; + sin.sin_addr.s_addr = INADDR_ANY; + + if (bind(listen_sock,(struct sockaddr *) &sin, sizeof(sin)) != 0) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } + if (getsockname(listen_sock, + (struct sockaddr *) &sin, &sin_siz) != 0) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } + if (listen(listen_sock, 5) != 0) { + DEBUGF(("Failure at line %d\n",__LINE__)); + goto cleanup; + } + port_no = ntohs(sin.sin_port); + } + + if ((epmd_sock = ei_publish(&nodeinfo, port_no)) < 0) { + DEBUGF(("Failure at line %d[%d,%d]\n",__LINE__,port_no,erl_errno)); goto cleanup; } diff --git a/lib/erl_interface/test/erl_call_SUITE.erl b/lib/erl_interface/test/erl_call_SUITE.erl index 9e2b2e4251..0d95a1361b 100644 --- a/lib/erl_interface/test/erl_call_SUITE.erl +++ b/lib/erl_interface/test/erl_call_SUITE.erl @@ -23,42 +23,88 @@ -include_lib("common_test/include/ct.hrl"). --export([all/0, smoke/1]). +-export([all/0, smoke/1, test_connect_to_host_port/1]). -all() -> - [smoke]. +all() -> + [smoke, + test_connect_to_host_port]. smoke(Config) when is_list(Config) -> - ErlCall = find_erl_call(), - NameSwitch = case net_kernel:longnames() of - true -> - "-name"; - false -> - "-sname" - end, Name = atom_to_list(?MODULE) ++ "-" ++ integer_to_list(erlang:system_time(microsecond)), - ArgsList = ["-s", "-a", "erlang node", NameSwitch, Name], - io:format("erl_call: \"~ts\"\n~nargs list: ~p~n", [ErlCall, ArgsList]), - CmdRes = get_smoke_port_res(open_port({spawn_executable, ErlCall}, - [{args, ArgsList}, eof]), []), - io:format("CmdRes: ~p~n", [CmdRes]), + RetNodeName = start_node_and_get_node_name(Name), + + halt_node(Name), [_, Hostname] = string:lexemes(atom_to_list(node()), "@"), NodeName = list_to_atom(Name ++ "@" ++ Hostname), - io:format("NodeName: ~p~n~n", [NodeName]), + NodeName = list_to_atom(RetNodeName), + ok. - pong = net_adm:ping(NodeName), - rpc:cast(NodeName, erlang, halt, []), - NodeName = list_to_atom(string:trim(CmdRes, both, "'")), + +test_connect_to_host_port(Config) when is_list(Config) -> + Name = atom_to_list(?MODULE) + ++ "-" + ++ integer_to_list(erlang:system_time(microsecond)), + Port = start_node_and_get_port(Name), + AddressCaller = + fun(Address) -> + get_erl_call_result(["-address", + Address, + "-a", + "erlang length [[1,2,3,4,5,6,7,8,9]]"]) + end, + "9" = AddressCaller(erlang:integer_to_list(Port)), + "9" = AddressCaller(":" ++ erlang:integer_to_list(Port)), + [_, Hostname] = string:lexemes(atom_to_list(node()), "@"), + "9" = AddressCaller(Hostname ++ ":" ++ erlang:integer_to_list(Port)), + FailedRes = AddressCaller("80"), + case string:find(FailedRes, "80") of + nomatch -> ct:fail("Incorrect error message"); + _ -> ok + end, + halt_node(Name), ok. % % Utility functions... % + +halt_node(Name) -> + [_, Hostname] = string:lexemes(atom_to_list(node()), "@"), + NodeName = list_to_atom(Name ++ "@" ++ Hostname), + io:format("NodeName: ~p~n~n", [NodeName]), + + pong = net_adm:ping(NodeName), + rpc:cast(NodeName, erlang, halt, []). + +start_node_and_get_node_name(Name) -> + NameSwitch = case net_kernel:longnames() of + true -> + "-name"; + false -> + "-sname" + end, + string:trim(get_erl_call_result(["-s", + NameSwitch, + Name, "-a", + "erlang node"]), + both, + "'"). + +start_node_and_get_port(Name) -> + start_node_and_get_node_name(Name), + {ok, NamePortList} = net_adm:names(), + {value, {_, Port}} + = lists:search(fun({N, _}) -> + string:equal(N, Name) + end, + NamePortList), + Port. + find_erl_call() -> ErlCallName = case os:type() of {win32, _} -> "erl_call.exe"; @@ -86,10 +132,19 @@ find_erl_call() -> ErlCall end. -get_smoke_port_res(Port, Acc) when is_port(Port) -> + +get_erl_call_result(ArgsList) -> + ErlCall = find_erl_call(), + io:format("erl_call: \"~ts\"\n~nargs list: ~p~n", [ErlCall, ArgsList]), + CmdRes = get_port_res(open_port({spawn_executable, ErlCall}, + [{args, ArgsList}, eof, stderr_to_stdout]), []), + io:format("CmdRes: ~p~n", [CmdRes]), + CmdRes. + +get_port_res(Port, Acc) when is_port(Port) -> receive {Port, {data, Data}} -> - get_smoke_port_res(Port, [Acc|Data]); + get_port_res(Port, [Acc|Data]); {Port, eof} -> lists:flatten(Acc) end. diff --git a/lib/erl_interface/test/erl_connect_SUITE.erl b/lib/erl_interface/test/erl_connect_SUITE.erl deleted file mode 100644 index 782691b8fb..0000000000 --- a/lib/erl_interface/test/erl_connect_SUITE.erl +++ /dev/null @@ -1,131 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(erl_connect_SUITE). - --include_lib("common_test/include/ct.hrl"). --include("erl_connect_SUITE_data/erl_connect_test_cases.hrl"). - --export([all/0, suite/0, - init_per_testcase/2, - erl_send/1, erl_reg_send/1, - erl_send_cookie_file/1]). - --import(runner, [get_term/1,send_term/2]). - -suite() -> - [{ct_hooks,[ts_install_cth]}, - {timetrap, {seconds, 30}}]. - -all() -> - [erl_send, erl_reg_send, erl_send_cookie_file]. - - -init_per_testcase(Case, Config) -> - runner:init_per_testcase(?MODULE, Case, Config). - -erl_send(Config) when is_list(Config) -> - P = runner:start(Config, ?interpret), - 1 = erl_connect_init(P, 42, erlang:get_cookie(), 0), - {ok,Fd} = erl_connect(P, node()), - - ok = erl_send(P, Fd, self(), AMsg={a,message}), - receive AMsg -> ok end, - - 0 = erl_close_connection(P,Fd), - runner:send_eot(P), - runner:recv_eot(P), - ok. - -erl_send_cookie_file(Config) when is_list(Config) -> - case os:type() of - vxworks -> - {skip,"Skipped on VxWorks"}; - _ -> - P = runner:start(Config, ?interpret), - 1 = erl_connect_init(P, 42, '', 0), - {ok,Fd} = erl_connect(P, node()), - - ok = erl_send(P, Fd, self(), AMsg={a,message}), - receive AMsg -> ok end, - - 0 = erl_close_connection(P,Fd), - runner:send_eot(P), - runner:recv_eot(P), - ok - end. - -erl_reg_send(Config) when is_list(Config) -> - P = runner:start(Config, ?interpret), - 1 = erl_connect_init(P, 42, erlang:get_cookie(), 0), - {ok,Fd} = erl_connect(P, node()), - - ARegName = a_strange_registred_name, - register(ARegName, self()), - ok = erl_reg_send(P, Fd, ARegName, AMsg={another,[strange],message}), - receive AMsg -> ok end, - - 0 = erl_close_connection(P,Fd), - runner:send_eot(P), - runner:recv_eot(P), - ok. - - -%%% Interface functions for erl_interface functions. - -erl_connect_init(P, Num, Cookie, Creation) -> - send_command(P, erl_connect_init, [Num,Cookie,Creation]), - case get_term(P) of - {term,Int} when is_integer(Int) -> Int - end. - -erl_connect(P, Node) -> - send_command(P, erl_connect, [Node]), - case get_term(P) of - {term,{Fd,_}} when Fd >= 0 -> {ok,Fd}; - {term,{-1,Errno}} -> {error,Errno} - end. - -erl_close_connection(P, FD) -> - send_command(P, erl_close_connection, [FD]), - case get_term(P) of - {term,Int} when is_integer(Int) -> Int - end. - -erl_send(P, Fd, To, Msg) -> - send_command(P, erl_send, [Fd,To,Msg]), - get_send_result(P). - -erl_reg_send(P, Fd, To, Msg) -> - send_command(P, erl_reg_send, [Fd,To,Msg]), - get_send_result(P). - -get_send_result(P) -> - case get_term(P) of - {term,{1,_}} -> ok; - {term,{-1,Errno}} -> {error,Errno}; - {term,{Res,Errno}}-> - io:format("Return value: ~p\nerl_errno: ~p", [Res,Errno]), - ct:fail(bad_return_value) - end. - -send_command(P, Name, Args) -> - runner:send_term(P, {Name,list_to_tuple(Args)}). diff --git a/lib/erl_interface/test/erl_connect_SUITE_data/Makefile.first b/lib/erl_interface/test/erl_connect_SUITE_data/Makefile.first deleted file mode 100644 index 21a7aac0b0..0000000000 --- a/lib/erl_interface/test/erl_connect_SUITE_data/Makefile.first +++ /dev/null @@ -1,22 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2001-2016. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -erl_connect_test_decl.c: erl_connect_test.c - erl -noinput -pa ../all_SUITE_data -s init_tc run erl_connect_test -s erlang halt diff --git a/lib/erl_interface/test/erl_connect_SUITE_data/Makefile.src b/lib/erl_interface/test/erl_connect_SUITE_data/Makefile.src deleted file mode 100644 index ff4c382c97..0000000000 --- a/lib/erl_interface/test/erl_connect_SUITE_data/Makefile.src +++ /dev/null @@ -1,41 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2000-2016. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -include @erl_interface_mk_include@ - -CC0 = @CC@ -CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)" -LD = @LD@ -LIBERL = @erl_interface_lib@ -LIBEI = @erl_interface_eilib@ -LIBFLAGS = ../all_SUITE_data/runner@obj@ \ - $(LIBERL) $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \ - @erl_interface_threadlib@ -CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data -OBJS = erl_connect_test@obj@ erl_connect_test_decl@obj@ - -all: erl_connect_test@exe@ - -erl_connect_test@exe@: $(OBJS) $(LIBERL) $(LIBEI) - $(LD) @CROSSLDFLAGS@ -o $@ $(OBJS) $(LIBFLAGS) - -clean: - $(RM) $(OBJS) - $(RM) erl_connect_test@exe@ diff --git a/lib/erl_interface/test/erl_connect_SUITE_data/erl_connect_test.c b/lib/erl_interface/test/erl_connect_SUITE_data/erl_connect_test.c deleted file mode 100644 index 0adaa79a33..0000000000 --- a/lib/erl_interface/test/erl_connect_SUITE_data/erl_connect_test.c +++ /dev/null @@ -1,203 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2000-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * Purpose: Tests the functions in erl_connect.c. - * Author: Bjorn Gustavsson - * - * See the erl_connect_SUITE.erl file for a "table of contents". - */ - -#include <stdio.h> -#include <string.h> - -#include "runner.h" - -static void cmd_erl_connect_init(ETERM* args); -static void cmd_erl_connect(ETERM* args); -static void cmd_erl_send(ETERM* args); -static void cmd_erl_reg_send(ETERM* args); -static void cmd_erl_close_connection(ETERM *args); - -static void send_errno_result(int value); - -static struct { - char* name; - int num_args; /* Number of arguments. */ - void (*func)(ETERM* args); -} commands[] = { - "erl_connect_init", 3, cmd_erl_connect_init, - "erl_connect", 1, cmd_erl_connect, - "erl_close_connection", 1, cmd_erl_close_connection, - "erl_send", 3, cmd_erl_send, - "erl_reg_send", 3, cmd_erl_reg_send, -}; - - -/* - * Sends a list contaning all data types to the Erlang side. - */ - -TESTCASE(interpret) -{ - ETERM* term; - - erl_init(NULL, 0); - - outer_loop: - - term = get_term(); - - if (term == NULL) { - report(1); - return; - } else { - ETERM* Func; - ETERM* Args; - int i; - - if (!ERL_IS_TUPLE(term) || ERL_TUPLE_SIZE(term) != 2) { - fail("term should be a tuple of size 2"); - } - - Func = erl_element(1, term); - if (!ERL_IS_ATOM(Func)) { - fail("function name should be an atom"); - } - Args = erl_element(2, term); - if (!ERL_IS_TUPLE(Args)) { - fail("function arguments should be a tuple"); - } - erl_free_term(term); - for (i = 0; i < sizeof(commands)/sizeof(commands[0]); i++) { - int n = strlen(commands[i].name); - if (ERL_ATOM_SIZE(Func) != n) { - continue; - } - if (memcmp(ERL_ATOM_PTR(Func), commands[i].name, n) == 0) { - erl_free_term(Func); - if (ERL_TUPLE_SIZE(Args) != commands[i].num_args) { - fail("wrong number of arguments"); - } - commands[i].func(Args); - erl_free_term(Args); - goto outer_loop; - } - } - fail("bad command"); - } -} - -#define VERIFY_TYPE(Test, Term) \ -if (!Test(Term)) { \ - fail("wrong type for " #Term); \ -} else { \ -} - -static void -cmd_erl_connect_init(ETERM* args) -{ - ETERM* number; - ETERM* res; - ETERM* cookie; - char cookie_buffer[256]; - - number = ERL_TUPLE_ELEMENT(args, 0); - VERIFY_TYPE(ERL_IS_INTEGER, number); - cookie = ERL_TUPLE_ELEMENT(args, 1); - VERIFY_TYPE(ERL_IS_ATOM, cookie); - if (ERL_ATOM_SIZE(cookie) == 0) { - res = erl_mk_int(erl_connect_init(ERL_INT_VALUE(number), 0, 0)); - } else { - memcpy(cookie_buffer, ERL_ATOM_PTR(cookie), ERL_ATOM_SIZE(cookie)); - cookie_buffer[ERL_ATOM_SIZE(cookie)] = '\0'; - res = erl_mk_int(erl_connect_init(ERL_INT_VALUE(number), - cookie_buffer, 0)); - } - send_term(res); - erl_free_term(res); -} - -static void -cmd_erl_connect(ETERM* args) -{ - ETERM* node; - char node_buffer[256]; - - node = ERL_TUPLE_ELEMENT(args, 0); - VERIFY_TYPE(ERL_IS_ATOM, node); - memcpy(node_buffer, ERL_ATOM_PTR(node), ERL_ATOM_SIZE(node)); - node_buffer[ERL_ATOM_SIZE(node)] = '\0'; - send_errno_result(erl_connect(node_buffer)); -} - -static void -cmd_erl_close_connection(ETERM* args) -{ - ETERM* number; - ETERM* res; - - number = ERL_TUPLE_ELEMENT(args, 0); - VERIFY_TYPE(ERL_IS_INTEGER, number); - res = erl_mk_int(erl_close_connection(ERL_INT_VALUE(number))); - send_term(res); - erl_free_term(res); -} - -static void -cmd_erl_send(ETERM* args) -{ - ETERM* fd_term = ERL_TUPLE_ELEMENT(args, 0); - ETERM* to = ERL_TUPLE_ELEMENT(args, 1); - ETERM* msg = ERL_TUPLE_ELEMENT(args, 2); - - VERIFY_TYPE(ERL_IS_INTEGER, fd_term); - send_errno_result(erl_send(ERL_INT_VALUE(fd_term), to, msg)); -} - -static void -cmd_erl_reg_send(ETERM* args) -{ - ETERM* fd_term = ERL_TUPLE_ELEMENT(args, 0); - ETERM* to = ERL_TUPLE_ELEMENT(args, 1); - ETERM* msg = ERL_TUPLE_ELEMENT(args, 2); - char reg_name[256]; - - VERIFY_TYPE(ERL_IS_INTEGER, fd_term); - VERIFY_TYPE(ERL_IS_ATOM, to); - memcpy(reg_name, ERL_ATOM_PTR(to), ERL_ATOM_SIZE(to)); - reg_name[ERL_ATOM_SIZE(to)] = '\0'; - send_errno_result(erl_reg_send(ERL_INT_VALUE(fd_term), reg_name, msg)); -} - -static void -send_errno_result(int value) -{ - ETERM* res_array[2]; - ETERM* res_tuple; - - res_array[0] = erl_mk_int(value); - res_array[1] = erl_mk_int(erl_errno); - res_tuple = erl_mk_tuple(res_array, 2); - send_term(res_tuple); - erl_free_term(res_array[0]); - erl_free_term(res_array[1]); - erl_free_term(res_tuple); -} diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl deleted file mode 100644 index 77910a9fc7..0000000000 --- a/lib/erl_interface/test/erl_eterm_SUITE.erl +++ /dev/null @@ -1,1084 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(erl_eterm_SUITE). - --include_lib("common_test/include/ct.hrl"). --include("erl_eterm_SUITE_data/eterm_test_cases.hrl"). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% The tests are organised as follows: -%%% -%%% 1. Basic tests (encoding, decoding, memory allocation). -%%% 2. Constructing terms (the erl_mk_xxx() functions and erl_copy_term()). -%%% 3. Extracting & info functions (erl_hd(), erl_length() etc). -%%% 4. I/O list functions. -%%% 5. Miscellaneous functions. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - --export([all/0, suite/0, - init_per_testcase/2, - build_terms/1, round_trip_conversion/1, - decode_terms/1, decode_float/1, - t_erl_mk_int/1, t_erl_mk_list/1, - basic_copy/1, - t_erl_cons/1, - t_erl_mk_atom/1, - t_erl_mk_binary/1, - t_erl_mk_empty_list/1, - t_erl_mk_float/1, - t_erl_mk_pid/1, - t_erl_mk_xpid/1, - t_erl_mk_port/1, - t_erl_mk_xport/1, - t_erl_mk_ref/1, - t_erl_mk_long_ref/1, - t_erl_mk_string/1, - t_erl_mk_estring/1, - t_erl_mk_tuple/1, - t_erl_mk_uint/1, - t_erl_mk_var/1, - t_erl_size/1, - t_erl_var_content/1, - t_erl_element/1, - t_erl_length/1, t_erl_hd/1, t_erl_tl/1, - type_checks/1, extractor_macros/1, - t_erl_iolist_length/1, t_erl_iolist_to_binary/1, - t_erl_iolist_to_string/1, - erl_print_term/1, print_string/1, - t_erl_free_compound/1, - high_chaparal/1, - broken_data/1, - cnode_1/1]). - --export([start_cnode/1]). - --import(runner, [get_term/1]). - -%% This test suite controls the running of the C language functions -%% in eterm_test.c and print_term.c. - -suite() -> - [{ct_hooks,[ts_install_cth]}]. - -all() -> - [build_terms, round_trip_conversion, decode_terms, - decode_float, t_erl_mk_int, t_erl_mk_list, basic_copy, - t_erl_mk_atom, t_erl_mk_binary, t_erl_mk_empty_list, - t_erl_mk_float, t_erl_mk_pid, t_erl_mk_xpid, - t_erl_mk_port, t_erl_mk_xport, t_erl_mk_ref, - t_erl_mk_long_ref, t_erl_mk_string, t_erl_mk_estring, - t_erl_mk_tuple, t_erl_mk_uint, t_erl_mk_var, t_erl_size, - t_erl_var_content, t_erl_element, t_erl_cons, - t_erl_length, t_erl_hd, t_erl_tl, type_checks, - extractor_macros, t_erl_iolist_length, - t_erl_iolist_to_binary, t_erl_iolist_to_string, - erl_print_term, print_string, t_erl_free_compound, - high_chaparal, broken_data, cnode_1]. - - -init_per_testcase(Case, Config) -> - runner:init_per_testcase(?MODULE, Case, Config). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% -%%% 1. B a s i c t e s t s -%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% This test asks the C function to construct all data types in -%% a list and verifies that the result is as expected. - -build_terms(Config) when is_list(Config) -> - P = runner:start(Config, ?build_terms), - {term, Term} = get_term(P), - io:format("Received: ~p", [Term]), - [ARefLN, ARef, APortLN, APort, APidLN, APid, - {element1, 42, 767}, "A string", - 1, -1, 0, 3.0, ABin, 'I am an atom'] = Term, - "A binary" = binary_to_list(ABin), - case ARef of - R when is_reference(R), node(R) == kalle@localhost -> ok - end, - case ARefLN of - R1 when is_reference(R1), node(R1) == abcdefghijabcdefghij@localhost -> ok - end, - case APort of - Port when is_port(Port), node(Port) == kalle@localhost -> ok - end, - case APortLN of - Port1 when is_port(Port1), node(Port1) == abcdefghijabcdefghij@localhost -> ok - end, - case APid of - Pid when is_pid(Pid), node(Pid) == kalle@localhost -> ok - end, - case APidLN of - Pid1 when is_pid(Pid1), node(Pid1) == abcdefghijabcdefghij@localhost -> ok - end, - - runner:recv_eot(P), - ok. - -%% This test is run entirely in C code. - -round_trip_conversion(Config) when is_list(Config) -> - runner:test(Config, ?round_trip_conversion), - ok. - -%% This test sends a list of all data types to the C code function, -%% which decodes it and verifies it. - -decode_terms(Config) when is_list(Config) -> - Dummy1 = list_to_atom(filename:join(proplists:get_value(priv_dir, Config), - dummy_file1)), - Dummy2 = list_to_atom(filename:join(proplists:get_value(priv_dir, Config), - dummy_file2)), - Port1 = open_port(Dummy1, [out]), - Port2 = open_port(Dummy2, [out]), - ABinary = list_to_binary("A binary"), - Terms = [make_ref(), make_ref(), - Port1, Port2, - self(), self(), - {element1, 42, 767}, "A string", - 1, -1, 0, 3.0, ABinary, 'I am an atom'], - - P = runner:start(Config, ?decode_terms), - runner:send_term(P, Terms), - runner:recv_eot(P), - - ok. - -%% Decodes the floating point number 3.1415. - -decode_float(Config) when is_list(Config) -> - P = runner:start(Config, ?decode_float), - runner:send_term(P, 3.1415), - runner:recv_eot(P), - ok. - -%% Tests the erl_free_compound() function. - -t_erl_free_compound(Config) when is_list(Config) -> - runner:test(Config, ?t_erl_free_compound), - ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% -%%% 2. C o n s t r u c t i n g t e r m s -%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% This tests the erl_mk_list() function. - -t_erl_mk_list(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_list), - - {term, []} = get_term(P), - {term, [abc]} = get_term(P), - {term, [abcdef, 42]} = get_term(P), - {term, [0.0, 23, [], 3.1415]} = get_term(P), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_mk_int() function. - -t_erl_mk_int(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_int), - - {term, 0} = get_term(P), - {term, 127} = get_term(P), - {term, 128} = get_term(P), - {term, 255} = get_term(P), - {term, 256} = get_term(P), - - {term, 16#FFFF} = get_term(P), - {term, 16#10000} = get_term(P), - - {term, 16#07FFFFFF} = get_term(P), - {term, 16#0FFFFFFF} = get_term(P), - {term, 16#1FFFFFFF} = get_term(P), - {term, 16#3FFFFFFF} = get_term(P), - {term, 16#7FFFFFFF} = get_term(P), - - {term, 16#08000000} = get_term(P), - {term, 16#10000000} = get_term(P), - {term, 16#20000000} = get_term(P), - {term, 16#40000000} = get_term(P), - - - {term, -16#07FFFFFF} = get_term(P), - {term, -16#0FFFFFFF} = get_term(P), - {term, -16#1FFFFFFF} = get_term(P), - {term, -16#3FFFFFFF} = get_term(P), - {term, -16#7FFFFFFF} = get_term(P), - - {term, -16#08000000} = get_term(P), - {term, -16#10000000} = get_term(P), - {term, -16#20000000} = get_term(P), - {term, -16#40000000} = get_term(P), - - {term, -16#08000001} = get_term(P), - {term, -16#10000001} = get_term(P), - {term, -16#20000001} = get_term(P), - {term, -16#40000001} = get_term(P), - - {term, -16#08000002} = get_term(P), - {term, -16#10000002} = get_term(P), - {term, -16#20000002} = get_term(P), - {term, -16#40000002} = get_term(P), - - {term, -1999999999} = get_term(P), - {term, -2000000000} = get_term(P), - {term, -2000000001} = get_term(P), - - runner:recv_eot(P), - ok. - - -%% Basic test of erl_copy_term(). - -basic_copy(Config) when is_list(Config) -> - runner:test(Config, ?basic_copy), - ok. - - -%% This tests the erl_mk_tuple() function. - -t_erl_mk_tuple(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_tuple), - - {term, {madonna, 21, 'mad donna', 12}} = get_term(P), - {term, {'Madonna',21,{children,{"Isabella",2}}, - {'home page',"http://www.madonna.com/"}}} = get_term(P), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_mk_atom() function. - -t_erl_mk_atom(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_atom), - - {term, madonna} = (get_term(P)), - {term, 'Madonna'} = (get_term(P)), - {term, 'mad donna'} = (get_term(P)), - {term, '_madonna_'} = (get_term(P)), - {term, '/home/madonna/tour_plan'} = (get_term(P)), - {term, 'http://www.madonna.com/tour_plan'} = (get_term(P)), - {term, '\'madonna\''} = (get_term(P)), - {term, '\"madonna\"'} = (get_term(P)), - {term, '\\madonna\\'} = (get_term(P)), - {term, '{madonna,21,\'mad donna\',12}'} = (get_term(P)), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_mk_binary() function. - -t_erl_mk_binary(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_binary), - - {term, Bin} = (get_term(P)), - "{madonna,21,'mad donna',1234.567.890, !#$%&/()=?+-@, \" \\}" = binary_to_list(Bin), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_mk_empty_list() function. - -t_erl_mk_empty_list(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_empty_list), - - {term, []} = get_term(P), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_mk_float() function. - -t_erl_mk_float(Config) when is_list(Config) -> - case os:type() of - vxworks -> - {skipped, "Floating point numbers never compare equal on PPC"}; - _ -> - P = runner:start(Config, ?t_erl_mk_float), - {term, {3.1415, 1.999999, 2.000000, 2.000001, - 2.000002, 12345.67890}} = get_term(P), - runner:recv_eot(P), - ok - end. - - -%% This tests the erl_mk_pid() function. - -t_erl_mk_pid(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_pid), - - {term, A_pid} = (get_term(P)), - {pid, kalle@localhost, 3, 2} = nc2vinfo(A_pid), - - runner:recv_eot(P), - ok. - -t_erl_mk_xpid(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_xpid), - - {term, A_pid} = (get_term(P)), - {pid, kalle@localhost, 32767, 8191} = nc2vinfo(A_pid), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_mk_port() function. - -t_erl_mk_port(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_port), - - {term, A_port} = (get_term(P)), - {port, kalle@localhost, 4} = nc2vinfo(A_port), - - runner:recv_eot(P), - ok. - -t_erl_mk_xport(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_xport), - - {term, A_port} = (get_term(P)), - {port, kalle@localhost, 268435455} = nc2vinfo(A_port), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_mk_ref() function. - -t_erl_mk_ref(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_ref), - - {term, A_ref} = (get_term(P)), - {ref, kalle@localhost, _Length, [6]} = nc2vinfo(A_ref), - - runner:recv_eot(P), - ok. - -t_erl_mk_long_ref(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_long_ref), - - {term, A_ref} = (get_term(P)), - {ref, kalle@localhost, _Length, [4294967295,4294967295,262143]} - = nc2vinfo(A_ref), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_mk_string() function. - -t_erl_mk_string(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_string), - - {term, "madonna"} = (get_term(P)), - {term, "Madonna"} = (get_term(P)), - {term, "mad donna"} = (get_term(P)), - {term, "_madonna_"} = (get_term(P)), - {term, "/home/madonna/tour_plan"} = (get_term(P)), - {term, "http://www.madonna.com/tour_plan"} = (get_term(P)), - {term, "\'madonna\'"} = (get_term(P)), - {term, "\"madonna\""} = (get_term(P)), - {term, "\\madonna\\"} = (get_term(P)), - {term, "{madonna,21,'mad donna',12}"} = (get_term(P)), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_mk_estring() function. - -t_erl_mk_estring(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_estring), - - {term, "madonna"} = (get_term(P)), - {term, "Madonna"} = (get_term(P)), - {term, "mad donna"} = (get_term(P)), - {term, "_madonna_"} = (get_term(P)), - {term, "/home/madonna/tour_plan"} = (get_term(P)), - {term, "http://www.madonna.com/tour_plan"} = (get_term(P)), - {term, "\'madonna\'"} = (get_term(P)), - {term, "\"madonna\""} = (get_term(P)), - {term, "\\madonna\\"} = (get_term(P)), - {term, "{madonna,21,'mad donna',12}"} = (get_term(P)), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_mk_uint() function. - -t_erl_mk_uint(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_uint), - - {term, 54321} = (get_term(P)), - {term, 2147483647} = (get_term(P)), - {term, 2147483648} = (get_term(P)), - {term, 2147483649} = (get_term(P)), - {term, 2147483650} = (get_term(P)), - {term, 4294967295} = (get_term(P)), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_mk_var() function. - -t_erl_mk_var(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_mk_var), - - {term, 1} = (get_term(P)), - {term, 0} = (get_term(P)), - {term, 1} = (get_term(P)), - {term, 0} = (get_term(P)), - {term, 1} = (get_term(P)), - {term, 0} = (get_term(P)), - {term, 1} = (get_term(P)), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_cons() function. - -t_erl_cons(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_cons), - - {term, [madonna, 21]} = get_term(P), - - runner:recv_eot(P), - ok. - - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% -%%% 3. E x t r a c t i n g & i n f o f u n c t i o n s -%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% Tests the erl_length() function. - -t_erl_length(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_length), - - 0 = erl_length(P, []), - 1 = erl_length(P, [a]), - 2 = erl_length(P, [a, b]), - 3 = erl_length(P, [a, b, c]), - - 4 = erl_length(P, [a, [x, y], c, []]), - - -1 = erl_length(P, [a|b]), - -1 = erl_length(P, a), - - runner:finish(P), - ok. - -%% Invokes the erl_length() function. - -erl_length(Port, List) -> - call_erl_function(Port, List). - -%% Tests the erl_hd() function. - -t_erl_hd(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_hd), - - 'NULL' = erl_hd(P, 42), - 'NULL' = erl_hd(P, abc), - 'NULL' = erl_hd(P, []), - - [] = erl_hd(P, [[], a]), - a = erl_hd(P, [a]), - a = erl_hd(P, [a, b]), - a = erl_hd(P, [a, b, c]), - a = erl_hd(P, [a|b]), - - runner:send_eot(P), - runner:recv_eot(P), - ok. - -%% Invokes the erl_hd() function. - -erl_hd(Port, List) -> - call_erl_function(Port, List). - -%% Tests the erl_tail() function. - -t_erl_tl(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_tl), - - 'NULL' = erl_tl(P, 42), - 'NULL' = erl_tl(P, abc), - 'NULL' = erl_tl(P, []), - - [] = erl_tl(P, [a]), - [b] = erl_tl(P, [a, b]), - [b, c] = erl_tl(P, [a, b, c]), - - b = erl_tl(P, [a|b]), - - runner:send_eot(P), - runner:recv_eot(P), - ok. - -%% Invokes the erl_tail() function in erl_interface. - -erl_tl(Port, List) -> - call_erl_function(Port, List). - -%% Tests the type checking macros (done in the C program). - -type_checks(Config) when is_list(Config) -> - runner:test(Config, ?type_checks), - ok. - -%% Tests the extractor macros (done in the C program). - -extractor_macros(Config) when is_list(Config) -> - runner:test(Config, ?extractor_macros), - ok. - - -%% This tests the erl_size() function. - -t_erl_size(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_size), - - {term, 0} = (get_term(P)), - {term, 4} = (get_term(P)), - - {term, 0} = (get_term(P)), - {term, 27} = (get_term(P)), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_var_content() function. - -t_erl_var_content(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_var_content), - - {term, 17} = (get_term(P)), - {term, "http://www.madonna.com"} = (get_term(P)), - {term, 2} = (get_term(P)), - {term, "http://www.madonna.com"} = (get_term(P)), - {term, 2} = (get_term(P)), - - runner:recv_eot(P), - ok. - - -%% This tests the erl_element() function. - -t_erl_element(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_element), - - {term, madonna} = get_term(P), - {term, 21} = get_term(P), - {term, 'mad donna'} = get_term(P), - {term, 12} = get_term(P), - - {term, 'Madonna'} = get_term(P), - {term, 21} = get_term(P), - {term, {children,{"Isabella",2}}} = get_term(P), - {term, {'home page',"http://www.madonna.com/"}} = get_term(P), - - runner:recv_eot(P), - ok. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% -%%% 4. I / O l i s t f u n c t i o n s -%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% Tests the erl_iolist_length() function. - -t_erl_iolist_length(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_iolist_length), - - %% Flat lists. - - 0 = erl_iolist_length(P, []), - 1 = erl_iolist_length(P, [10]), - 2 = erl_iolist_length(P, [10, 20]), - 3 = erl_iolist_length(P, [10, 20, 30]), - 256 = erl_iolist_length(P, lists:seq(0, 255)), - - %% Deep lists. - - 0 = erl_iolist_length(P, [[]]), - 1 = erl_iolist_length(P, [[], 42]), - 1 = erl_iolist_length(P, [42, []]), - 2 = erl_iolist_length(P, [42, [], 45]), - - 3 = erl_iolist_length(P, [42, [90], 45]), - 3 = erl_iolist_length(P, [[42, [90]], 45]), - 3 = erl_iolist_length(P, [[42, [90]], 45]), - - %% List with binaries. - - 0 = erl_iolist_length(P, [list_to_binary([])]), - 0 = erl_iolist_length(P, [[], list_to_binary([])]), - 1 = erl_iolist_length(P, [[1], list_to_binary([])]), - 1 = erl_iolist_length(P, [[], list_to_binary([2])]), - 2 = erl_iolist_length(P, [[42], list_to_binary([2])]), - 4 = erl_iolist_length(P, [[42], list_to_binary([2, 3, 4])]), - - %% Binaries as tail. - - 0 = erl_iolist_length(P, [[]| list_to_binary([])]), - 1 = erl_iolist_length(P, [[1]| list_to_binary([])]), - 1 = erl_iolist_length(P, [[]| list_to_binary([2])]), - 2 = erl_iolist_length(P, [[42]| list_to_binary([2])]), - - %% Binaries only. - - 0 = erl_iolist_length(P, list_to_binary("")), - 1 = erl_iolist_length(P, list_to_binary([1])), - 2 = erl_iolist_length(P, list_to_binary([1, 2])), - - %% Illegal cases. - - -1 = erl_iolist_length(P, [42|43]), - -1 = erl_iolist_length(P, a), - - -1 = erl_iolist_length(P, [a]), - -1 = erl_iolist_length(P, [256]), - -1 = erl_iolist_length(P, [257]), - -1 = erl_iolist_length(P, [-1]), - -1 = erl_iolist_length(P, [-2]), - -1 = erl_iolist_length(P, [-127]), - -1 = erl_iolist_length(P, [-128]), - - runner:finish(P), - ok. - -%% Invokes the erl_iolist_length() function. - -erl_iolist_length(Port, List) -> - call_erl_function(Port, List). - -%% Tests the erl_iolist_to_binary() function. - -t_erl_iolist_to_binary(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_iolist_to_binary), - - %% Flat lists. - - [] = iolist_to_list(P, []), - [10] = iolist_to_list(P, [10]), - [10, 20] = iolist_to_list(P, [10, 20]), - [10, 20, 30] = iolist_to_list(P, [10, 20, 30]), - AllBytes = lists:seq(0, 255), - AllBytes = iolist_to_list(P, AllBytes), - - %% Deep lists. - - [] = iolist_to_list(P, [[]]), - [42] = iolist_to_list(P, [[], 42]), - [42] = iolist_to_list(P, [42, []]), - [42, 45] = iolist_to_list(P, [42, [], 45]), - - [42, 90, 45] = iolist_to_list(P, [42, [90], 45]), - [42, 90, 45] = iolist_to_list(P, [[42, [90]], 45]), - [42, 90, 45] = iolist_to_list(P, [[42, [90]], 45]), - - %% List with binaries. - - [] = iolist_to_list(P, [list_to_binary([])]), - [] = iolist_to_list(P, [[], list_to_binary([])]), - [1] = iolist_to_list(P, [[1], list_to_binary([])]), - [2] = iolist_to_list(P, [[], list_to_binary([2])]), - [42, 2] = iolist_to_list(P, [[42], list_to_binary([2])]), - [42, 2, 3, 4] = iolist_to_list(P, [[42], list_to_binary([2, 3, 4])]), - - %% Binaries as tail. - - [] = iolist_to_list(P, [[]| list_to_binary([])]), - [1] = iolist_to_list(P, [[1]| list_to_binary([])]), - [2] = iolist_to_list(P, [[]| list_to_binary([2])]), - [42, 2] = iolist_to_list(P, [[42]| list_to_binary([2])]), - - %% Binaries only. - - [] = iolist_to_list(P, list_to_binary("")), - [1] = iolist_to_list(P, list_to_binary([1])), - [1, 2] = iolist_to_list(P, list_to_binary([1, 2])), - - %% Illegal cases. - - 'NULL' = iolist_to_list(P, [42|43]), - 'NULL' = iolist_to_list(P, a), - - 'NULL' = iolist_to_list(P, [a]), - 'NULL' = iolist_to_list(P, [256]), - 'NULL' = iolist_to_list(P, [257]), - 'NULL' = iolist_to_list(P, [-1]), - 'NULL' = iolist_to_list(P, [-2]), - 'NULL' = iolist_to_list(P, [-127]), - 'NULL' = iolist_to_list(P, [-128]), - - runner:finish(P), - ok. - -iolist_to_list(Port, Term) -> - case call_erl_function(Port, Term) of - 'NULL' -> - 'NULL'; - Bin when is_binary(Bin) -> - binary_to_list(Bin) - end. - -%% Tests the erl_iolist_to_string() function. - -t_erl_iolist_to_string(Config) when is_list(Config) -> - P = runner:start(Config, ?t_erl_iolist_to_string), - - %% Flat lists. - - [0] = iolist_to_string(P, []), - [10, 0] = iolist_to_string(P, [10]), - [10, 20, 0] = iolist_to_string(P, [10, 20]), - [10, 20, 30, 0] = iolist_to_string(P, [10, 20, 30]), - AllBytes = lists:seq(1, 255)++[0], - AllBytes = iolist_to_string(P, lists:seq(1, 255)), - - %% Deep lists. - - [0] = iolist_to_string(P, [[]]), - [42, 0] = iolist_to_string(P, [[], 42]), - [42, 0] = iolist_to_string(P, [42, []]), - [42, 45, 0] = iolist_to_string(P, [42, [], 45]), - - [42, 90, 45, 0] = iolist_to_string(P, [42, [90], 45]), - [42, 90, 45, 0] = iolist_to_string(P, [[42, [90]], 45]), - [42, 90, 45, 0] = iolist_to_string(P, [[42, [90]], 45]), - - %% List with binaries. - - [0] = iolist_to_string(P, [list_to_binary([])]), - [0] = iolist_to_string(P, [[], list_to_binary([])]), - [1, 0] = iolist_to_string(P, [[1], list_to_binary([])]), - [2, 0] = iolist_to_string(P, [[], list_to_binary([2])]), - [42, 2, 0] = iolist_to_string(P, [[42], list_to_binary([2])]), - [42, 2, 3, 4, 0] = iolist_to_string(P, [[42], - list_to_binary([2, 3, 4])]), - - %% Binaries as tail. - - [0] = iolist_to_string(P, [[]| list_to_binary([])]), - [1, 0] = iolist_to_string(P, [[1]| list_to_binary([])]), - [2, 0] = iolist_to_string(P, [[]| list_to_binary([2])]), - [42, 2, 0] = iolist_to_string(P, [[42]| list_to_binary([2])]), - - %% Binaries only. - - [0] = iolist_to_string(P, list_to_binary("")), - [1, 0] = iolist_to_string(P, list_to_binary([1])), - [1, 2, 0] = iolist_to_string(P, list_to_binary([1, 2])), - - %% Illegal cases. - - 'NULL' = iolist_to_string(P, [0]), - 'NULL' = iolist_to_string(P, [65, 0, 66]), - 'NULL' = iolist_to_string(P, [65, 66, 67, 0]), - - 'NULL' = iolist_to_string(P, [42|43]), - 'NULL' = iolist_to_string(P, a), - - 'NULL' = iolist_to_string(P, [a]), - 'NULL' = iolist_to_string(P, [256]), - 'NULL' = iolist_to_string(P, [257]), - 'NULL' = iolist_to_string(P, [-1]), - 'NULL' = iolist_to_string(P, [-2]), - 'NULL' = iolist_to_string(P, [-127]), - 'NULL' = iolist_to_string(P, [-128]), - - runner:finish(P), - ok. - -%% Invokes the erl_iolist_to_string() function. - -iolist_to_string(Port, Term) -> - runner:send_term(Port, Term), - case get_term(Port) of - {bytes, Result} -> Result; - 'NULL' -> 'NULL' - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% -%%% 5. M i s c e l l a n o u s T e s t s -%%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% Tests the erl_print_term() function -erl_print_term(Config) when is_list(Config) -> - PrintTerm = print_term(Config), - P = open_port({spawn, PrintTerm}, [stream]), - - %% Lists. - - print(P, "[]", []), - print(P, "[a]", [a]), - print(P, "[[a]]", [[a]]), - print(P, "[[]]", [[]]), - print(P, "[a,b,c]", [a,b,c]), - print(P, "[a,b|c]", [a,b|c]), - print(P, "[a,[],c]", [a,[],c]), - print(P, "[a,[1000,1],c]", [a,[1000,1],c]), - - %% Tuples. - - print(P, "{}", {}), - print(P, "{ok}", {ok}), - print(P, "{1,2,3}", {1, 2, 3}), - - %% Pids. - - {_X, Y, Z} = split_pid(self()), - PidString = lists:flatten(io_lib:format("<~s.~w.~w>", - [node(), Y, Z])), - print(P, PidString, self()), - - unlink(P), - exit(P, die), - ok. - -split_pid(Pid) when is_pid(Pid) -> - split_pid(pid_to_list(Pid), 0, []). - -split_pid([$<|Rest], Cur, Result) -> - split_pid(Rest, Cur, Result); -split_pid([Digit|Rest], Cur, Result) when $0 =< Digit, Digit =< $9 -> - split_pid(Rest, 10*Cur+Digit-$0, Result); -split_pid([$.|Rest], Cur, Result) -> - split_pid(Rest, 0, Result++[Cur]); -split_pid([$>], Cur, Result) -> - list_to_tuple(Result++[Cur]). - -%% Test printing a string with erl_print_term() -print_string(Config) when is_list(Config) -> - PrintTerm = print_term(Config), - P = open_port({spawn, PrintTerm}, [stream]), - - %% Strings. - - print(P, "\"ABC\"", "ABC"), - {11, "\"\\tABC\\r\\n\""} = print(P, "\tABC\r\n"), - - %% Not strings. - - print(P, "[65,66,67,0]", "ABC\000"), - - unlink(P), - exit(P, die), - ok. - -print(Port, TermString, Term) -> - Length = length(TermString), - {Length, TermString} = print(Port, Term). - -%% This function uses the erl_print_term() function in erl_interface -%% to print a term. -%% Returns: {NumChars, Chars} - -print(Port, Term) -> - Bin = term_to_binary(Term), - Size = size(Bin), - Port ! {self(), {command, [Size div 256, Size rem 256, Bin]}}, - collect_line(Port, []). - -collect_line(Port, Result) -> - receive - {Port, {data, Data}} -> - case lists:reverse(Data) of - [$\n|Rest] -> - collect_line1(Rest++Result, []); - Chars -> - collect_line(Port, Chars++Result) - end - after 5000 -> - ct:fail("No response from C program") - end. - -collect_line1([$\r|Rest], Result) -> - {list_to_integer(Result), lists:reverse(Rest)}; -collect_line1([C|Rest], Result) -> - collect_line1(Rest, [C|Result]). - -%% Test case submitted by Per Lundgren, ERV. - -high_chaparal(Config) when is_list(Config) -> - P = runner:start(Config, ?high_chaparal), - {term, [hello, world]} = get_term(P), - runner:recv_eot(P), - ok. - -%% OTP-7448 -broken_data(Config) when is_list(Config) -> - P = runner:start(Config, ?broken_data), - runner:recv_eot(P), - ok. - -%% This calls a C function with one parameter and returns the result. - -call_erl_function(Port, Term) -> - runner:send_term(Port, Term), - case get_term(Port) of - {term, Result} -> Result; - 'NULL' -> 'NULL' - end. - -print_term(Config) when is_list(Config) -> - filename:join(proplists:get_value(data_dir, Config), "print_term"). - - - -%%% We receive a ref from the cnode, and expect it to be a long ref. -%%% We also send a ref we created ourselves, and expect to get it -%%% back, without having been mutated into short form. We must take -%%% care then to check the actual returned ref, and not the original -%%% one, which is equal to it. - -%% Tests involving cnode: sends a long ref from a cnode to us -cnode_1(Config) when is_list(Config) -> - Cnode = filename:join(proplists:get_value(data_dir, Config), "cnode"), - register(mip, self()), - spawn_link(?MODULE, start_cnode, [Cnode]), - Ref1 = get_ref(), - io:format("Ref1 ~p~n", [Ref1]), - check_ref(Ref1), - Ref2 = make_ref(), - Pid = receive - Msg -> Msg %% pid - end, - Fun1 = fun(X) -> {Pid, X} end, % sneak in a fun test here - %Fun1 = {wait_with_funs, new_dist_format}, - Term = {Ref2, Fun1, {1,2,3,4,5,6,7,8,9,10}}, - %% A term which will overflow the original buffer used in 'cnode'. - Pid ! Term, - receive - Term2 -> - io:format("received ~p~n", [Term2]), - case Term2 of - Term -> - {Ref22,_,_} = Term2, - check_ref(Ref22); - X -> - ct:fail({receive1,X}) - end - after 5000 -> - ct:fail(receive1) - end, - receive - Pid -> - ok; - Y -> - ct:fail({receive1,Y}) - after 5000 -> - ct:fail(receive2) - end, - io:format("ref = ~p~n", [Ref1]), - check_ref(Ref1), - ok. - -check_ref(Ref) -> - case bin_ext_type(Ref) of - 101 -> - ct:fail(oldref); - 114 -> - ok; - Type -> - ct:fail({type, Type}) - end. - -bin_ext_type(T) -> - [131, Type | _] = binary_to_list(term_to_binary(T)), - Type. - -get_ref() -> - receive - X when is_reference(X) -> - X - after 5000 -> - ct:fail({cnode, timeout}) - end. - -start_cnode(Cnode) -> - open_port({spawn, Cnode ++ " " ++ atom_to_list(erlang:get_cookie())}, []), - rec_cnode(). - -rec_cnode() -> - receive - X -> - io:format("from cnode: ~p~n", [X]), - rec_cnode() - end. - -nc2vinfo(Pid) when is_pid(Pid) -> - [_NodeStr, NumberStr, SerialStr] - = string:tokens(pid_to_list(Pid), "<.>"), - Number = list_to_integer(NumberStr), - Serial = list_to_integer(SerialStr), - {pid, node(Pid), Number, Serial}; -nc2vinfo(Port) when is_port(Port) -> - ["#Port", _NodeStr, NumberStr] - = string:tokens(erlang:port_to_list(Port), "<.>"), - Number = list_to_integer(NumberStr), - {port, node(Port), Number}; -nc2vinfo(Ref) when is_reference(Ref) -> - ["#Ref", _NodeStr | NumStrList] - = string:tokens(erlang:ref_to_list(Ref), "<.>"), - {Len, RevNumList} = lists:foldl(fun ("0", {N, []}) -> - {N+1, []}; - (IStr, {N, Is}) -> - {N+1, - [list_to_integer(IStr)|Is]} - end, - {0, []}, - NumStrList), - {ref, node(Ref), Len, lists:reverse(RevNumList)}; -nc2vinfo(Other) -> - {badarg, Other}. diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.first b/lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.first deleted file mode 100644 index 0ea872ef49..0000000000 --- a/lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.first +++ /dev/null @@ -1,22 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2000-2016. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -eterm_test_decl.c: eterm_test.c - erl -noinput -pa ../all_SUITE_data -s init_tc run eterm_test -s erlang halt diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.src b/lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.src deleted file mode 100644 index 4b1ddf77b6..0000000000 --- a/lib/erl_interface/test/erl_eterm_SUITE_data/Makefile.src +++ /dev/null @@ -1,50 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2016. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -include @erl_interface_mk_include@ - -CC0 = @CC@ -CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)" -LD = @LD@ -LIBERL = @erl_interface_lib@ -LIBEI = @erl_interface_eilib@ -LIBFLAGS = ../all_SUITE_data/runner@obj@ \ - $(LIBERL) $(LIBEI) @erl_interface_sock_libs@ @LIBS@ \ - @erl_interface_threadlib@ -CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data -ETERM_OBJS = eterm_test@obj@ eterm_test_decl@obj@ -CNODE_OBJS = cnode@obj@ -PRINT_OBJS = print_term@obj@ -EXE_FILES = eterm_test@exe@ print_term@exe@ cnode@exe@ - -all: $(EXE_FILES) - -eterm_test@exe@: $(ETERM_OBJS) $(LIBERL) $(LIBEI) - $(LD) @CROSSLDFLAGS@ -o $@ $(ETERM_OBJS) $(LIBFLAGS) - -cnode@exe@: $(CNODE_OBJS) $(LIBERL) $(LIBEI) - $(LD) @CROSSLDFLAGS@ -o $@ $(CNODE_OBJS) $(LIBFLAGS) - -print_term@exe@: print_term@obj@ $(LIBERL) $(LIBEI) - $(LD) @CROSSLDFLAGS@ -o $@ $(PRINT_OBJS) $(LIBFLAGS) - -clean: - $(RM) $(ETERM_OBJS) $(CNODE_OBJS) $(PRINT_OBJS) - $(RM) $(EXE_FILES) diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/cnode.c b/lib/erl_interface/test/erl_eterm_SUITE_data/cnode.c deleted file mode 100644 index b87feb9dfc..0000000000 --- a/lib/erl_interface/test/erl_eterm_SUITE_data/cnode.c +++ /dev/null @@ -1,173 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include "ei.h" -#include "erl_interface.h" - -#define MSGSIZE 13 - -#define SELF(fd) erl_mk_pid(erl_thisnodename(),fd,0,erl_thiscreation()) - -#ifdef VXWORKS -#define MAIN cnode -#else -#define MAIN main -#endif - -/* FIXME uses mix och ei and erl_interface */ - -/* - A small cnode. - To be called from the test case erl_eterm_SUITE:cnode_1. - - 1) Set up connection to node 'test_server' on the same host. - All sends are done to a registered process named 'mip'. - 2) Create a long ref and send it. - 3) Create a pid for ourselves and send it. - 4) Receive a message. - 5) Send back the message part of the message. - 6) Send back the 'to' part of the message. - 7) Exit. -*/ - -MAIN(int argc, char **argv) - -{ - unsigned char *msgbufp; - int msgsize; - ErlMessage msg; - char msgbuf[MSGSIZE]; - char buf[100]; - char buf1[100]; - char buf2[100]; - int ix; - int s; - int fd; - char node[80]; - char server[80]; - char host[80]; - int number; - ETERM *ref, *ref1, *ref2; - FILE *dfile = fopen("cnode_debug_printout", "w"); - - erl_init(NULL, 0); - - number = 1; - if (argc >= 2) { - s = erl_connect_init(number, argv[1], 0); - } else { - s = erl_connect_init(number, (char *) 0, 0); - } - gethostname(host, sizeof(host)); - sprintf(node, "c%d@%s", number, host); - - fprintf(dfile, "s = %d\n", s); fflush(dfile); - - sprintf(server, "test_server@%s", host); - fd = erl_connect(server); - fprintf(dfile, "fd = %d\n", fd); - -/* fprintf(dfile, "dist = %d\n", erl_distversion(fd)); */ - -#if 1 - ref = erl_mk_long_ref(node, 4711, 113, 98, 0); -#else - ref = erl_mk_ref(node, 4711, 0); -#endif - fprintf(dfile, "ref = %p\n", ref); fflush(dfile); - - s = erl_reg_send(fd, "mip", ref); - fprintf(dfile, "s = %d\n", s); fflush(dfile); - - { - ETERM* emsg; - emsg = SELF(fd); - fprintf(dfile, "pid = %p\n", emsg); fflush(dfile); - s = erl_reg_send(fd,"mip",emsg); - fprintf(dfile, "s2 = %d\n", s); fflush(dfile); - erl_free_term(emsg); - } - - msgsize = 4; - msgbufp = (unsigned char *) malloc(msgsize); - - do { -#if 0 - s = erl_receive_msg(fd, msgbuf, MSGSIZE, &msg); -#else - s = erl_xreceive_msg(fd, &msgbufp, &msgsize, &msg); -#endif - switch (s) { - case ERL_TICK: - fprintf(dfile, "tick\n"); - break; - case ERL_ERROR: - fprintf(dfile, "error: %s (%d)\n", strerror(erl_errno), erl_errno); - break; - case ERL_MSG: - fprintf(dfile, "msg %d\n", msgsize); - break; - default: - fprintf(dfile, "unknown result %d\n", s); - break; - } - fflush(dfile); - } while (s == ERL_TICK); - - s = erl_reg_send(fd, "mip", msg.msg); - fprintf(dfile, "s = %d\n", s); fflush(dfile); - s = erl_reg_send(fd, "mip", msg.to); - fprintf(dfile, "s = %d\n", s); fflush(dfile); -#if 0 - /* from = NULL! */ - s = erl_reg_send(fd, "mip", msg.from); - fprintf(dfile, "s = %d\n", s); fflush(dfile); -#endif - -#if 0 - /* Unused code which tests refs in some ways. */ - ix = 0; - s = ei_encode_term(buf, &ix, ref); - printf ("ei encode = %d, ix = %d\n", s, ix); - - /* Compare old and new ref equal */ - ref1 = erl_mk_long_ref(node, 4711, 113, 98, 0); - ref2 = erl_mk_ref(node, 4711, 0); - s = erl_encode(ref1, buf1); - fprintf(dfile, "enc1 s = %d\n", s); fflush(dfile); - s = erl_encode(ref2, buf2); - fprintf(dfile, "enc2 s = %d\n", s); fflush(dfile); - s = erl_compare_ext(buf1, buf2); - fprintf(dfile, "comp s = %d\n", s); fflush(dfile); - - /* Compare, in another way */ - s = erl_match(ref1, ref2); - fprintf(dfile, "match s = %d\n", s); fflush(dfile); -#endif - - fclose(dfile); - - erl_close_connection(fd); - - return 0; -} diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c b/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c deleted file mode 100644 index d97f218a26..0000000000 --- a/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c +++ /dev/null @@ -1,1604 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * Purpose: Tests the functions in erl_eterm.c and erl_malloc.c. - * Author: Bjorn Gustavsson - * - * See the erl_eterm_SUITE.erl file for a "table of contents". - */ - -#include <stdio.h> -#include <string.h> - -#include "runner.h" - -/* - * Find out which version of erl_interface we are using. - */ - -#ifdef ERL_IS_STRING -#undef NEW_ERL_INTERFACE -#else -#define NEW_ERL_INTERFACE -#endif - -void dump_term (FILE *fp, ETERM *t); - -static ETERM* all_types(); - -/*********************************************************************** - * - * 1. B a s i c t e s t s - * - ***********************************************************************/ - -/* - * Sends a list contaning all data types to the Erlang side. - */ - -TESTCASE(build_terms) -{ - ETERM* t; - - erl_init(NULL, 0); - t = all_types(); - send_term(t); - report(1); -} - -static int abs_and_sign(ETERM* v, unsigned long long* av, int* sign) -{ - long long sv; - switch (ERL_TYPE(v)) { - case ERL_INTEGER: sv = ERL_INT_VALUE(v); break; - case ERL_U_INTEGER: *av = ERL_INT_UVALUE(v); *sign = 0; return 1; - case ERL_LONGLONG: sv = ERL_LL_VALUE(v); break; - case ERL_U_LONGLONG: *av = ERL_LL_UVALUE(v); *sign = 0; return 1; - default: return 0; - } - if (sv < 0) { - *av = -sv; - *sign = 1; - } - else { - *av = sv; - *sign = 0; - } - return 1; -} - -/* Shouldn't erl_match() cope with this? -*/ -static int eq_ints(ETERM* a, ETERM* b) -{ - unsigned long long a_abs, b_abs; - int a_sign, b_sign; - return abs_and_sign(a, &a_abs, &a_sign) && abs_and_sign(b, &b_abs, &b_sign) - && (a_abs == b_abs) && (a_sign == b_sign); -} - -static void encode_decode(ETERM* original, const char* text) -{ - static unsigned char encoded[16*1024]; - ETERM* new_terms; - ETERM* head; - int bytes; - int len; - - /* If a list, check the elements one by one first */ - head = erl_hd(original); - if (head != NULL) { - encode_decode(head, "CAR"); - encode_decode(erl_tl(original), "CDR"); - } - - bytes = erl_encode(original, encoded); - if (bytes == 0) { - fail("failed to encode terms"); - } - else if (bytes > sizeof(encoded)) { - fail("encoded terms buffer overflow"); - } - else if (bytes != (len=erl_term_len(original))) { - fprintf(stderr, "bytes(%d) != len(%d) for term ", bytes, len); - erl_print_term(stderr, original); - fprintf(stderr, " [%s]\r\n", text); - fail("erl_encode and erl_term_len do not agree"); - } - else if ((new_terms = erl_decode(encoded)) == NULL) { - fail("failed to decode terms"); - } - else if (!erl_match(original, new_terms) && !eq_ints(original, new_terms)) { - erl_print_term(stderr, original); - fprintf(stderr, "(%i) != (%i)", ERL_TYPE(original), ERL_TYPE(new_terms)); - erl_print_term(stderr, new_terms); - fprintf(stderr, " [%s]\r\n", text); - fail("decoded terms didn't match original"); - } - erl_free_term(original); - erl_free_term(new_terms); -} -/* - * Converts an Erlang term to the external term format and back again. - */ - -TESTCASE(round_trip_conversion) -{ - int n, i; - - erl_init(NULL, 0); - encode_decode(all_types(), "ALL"); - - { - int v; - for (v = 8, n = 0; n < (sizeof(v)*8-4-1); v <<= 1, n++) { - for (i=-4; i<4; i++) { - encode_decode(erl_mk_int(v+i), "INT"); - encode_decode(erl_mk_int(-(v+i)), "NEG INT"); - } - } - } - { - unsigned int v; - for (v = 8; v; v <<= 1) { - for (i=-4; i<4; i++) { - encode_decode(erl_mk_uint(v+i), "UINT"); - } - } - } - { - long long v; - for (v = 8, n = 0; n < (sizeof(v)*8-4-1); v <<= 1, n++) { - for (i=-4; i<4; i++) { - encode_decode(erl_mk_longlong(v+i), "LONGLONG"); - encode_decode(erl_mk_longlong(-(v+i)), "NEG LONGLONG"); - } - } - } - { - unsigned long long v; - for (v = 8; v; v <<= 1) { - for (i=-4; i<4; i++) { - encode_decode(erl_mk_ulonglong(v+i), "ULONGLONG"); - } - } - } - - report(1); -} - -/* - * Decodes data from the Erlang side and verifies. - */ - -TESTCASE(decode_terms) -{ - ETERM* terms; - char* message; - - erl_init(NULL, 0); - terms = get_term(); - if (terms == NULL) { - fail("unexpected end of file"); - } else { - ETERM* all; - ETERM* p; - ETERM* t; - int i; - - all = p = all_types(); - t = terms; - - /* - * XXX For now, skip the reference, pid, and port, because - * the match will fail. Must write code here to do some other - * validating. - */ - - for (i=0; i<6; i++) { - - p = erl_tl(p); - t = erl_tl(t); - erl_free_term(p); - erl_free_term(t); - - } - - /* - * Match the tail of the lists. - */ - - if (!erl_match(p, t)) - { - fail("Received terms didn't match expected"); - } - erl_free_term(all); - erl_free_term(terms); - report(1); - } -} - -/* - * Decodes a float from the Erlang side and verifies. - */ - -TESTCASE(decode_float) -{ - ETERM* afnum; - ETERM* efnum; - int result; - - erl_init(NULL, 0); - afnum = get_term(); - efnum = erl_mk_float(3.1415); - result = erl_match(efnum, afnum); - erl_free_term(afnum); - erl_free_term(efnum); - report(result); -} - -/* - * Tests the erl_free_compound() function. - */ - -TESTCASE(t_erl_free_compound) -{ - ETERM* t; - - erl_init(NULL, 0); - - t = all_types(); - erl_free_compound(t); - report(1); -} - - -/*********************************************************************** - * - * 2. C o n s t r u c t i n g t e r m s - * - ***********************************************************************/ - -/* - * Makes various integers, and sends them to Erlang for verification. - */ - -TESTCASE(t_erl_mk_int) -{ -#define SEND_INT(i) \ - do { \ - ETERM* t = erl_mk_int(i); \ - send_term(t); \ - } while (0); - - erl_init(NULL, 0); - - SEND_INT(0); - SEND_INT(127); - SEND_INT(128); - SEND_INT(255); - SEND_INT(256); - - SEND_INT(0xFFFF); - SEND_INT(0x10000); - - SEND_INT(0x07FFFFFF); - SEND_INT(0x0FFFFFFF); - SEND_INT(0x1FFFFFFF); - SEND_INT(0x3FFFFFFF); - SEND_INT(0x7FFFFFFF); - - SEND_INT(0x08000000); - SEND_INT(0x10000000); - SEND_INT(0x20000000); - SEND_INT(0x40000000); - - SEND_INT(-0x07FFFFFF); - SEND_INT(-0x0FFFFFFF); - SEND_INT(-0x1FFFFFFF); - SEND_INT(-0x3FFFFFFF); - SEND_INT(-0x7FFFFFFF); - - SEND_INT(-0x08000000); - SEND_INT(-0x10000000); - SEND_INT(-0x20000000); - SEND_INT(-0x40000000); - - SEND_INT(-0x08000001); - SEND_INT(-0x10000001); - SEND_INT(-0x20000001); - SEND_INT(-0x40000001); - - SEND_INT(-0x08000002); - SEND_INT(-0x10000002); - SEND_INT(-0x20000002); - SEND_INT(-0x40000002); - - SEND_INT(-1999999999); - SEND_INT(-2000000000); - SEND_INT(-2000000001); - - report(1); -} - - -/* - * Makes lists of various sizes, and sends them to Erlang for verification. - */ - -TESTCASE(t_erl_mk_list) -{ - ETERM* a[4]; - - erl_init(NULL, 0); - - /* - * Empty list. - */ - - send_term(erl_mk_list(a, 0)); - - /* - * One element: [abc] - */ - - a[0] = erl_mk_atom("abc"); - send_term(erl_mk_list(a, 1)); - erl_free_term(a[0]); - - /* - * Two elements: [abcdef, 42]. - */ - - a[0] = erl_mk_atom("abcdef"); - a[1] = erl_mk_int(42); - send_term(erl_mk_list(a, 2)); - erl_free_term(a[0]); - erl_free_term(a[1]); - - /* - * Four elements. - */ - - a[0] = erl_mk_float(0.0); - a[1] = erl_mk_int(23); - a[2] = erl_mk_empty_list(); - a[3] = erl_mk_float(3.1415); - send_term(erl_mk_list(a, 4)); - erl_free_term(a[0]); - erl_free_term(a[1]); - erl_free_term(a[2]); - erl_free_term(a[3]); - - report(1); -} - -/* - * A basic test of erl_copy_term(). - */ - -TESTCASE(basic_copy) -{ - ETERM* original; - ETERM* copy; - int result; - - erl_init(NULL, 0); - original = all_types(); - copy = erl_copy_term(original); - if (copy == NULL) { - fail("erl_copy_term() failed"); - } else if (!erl_match(original, copy)) - { - fail("copy doesn't match original"); - } - - erl_free_term(original); - erl_free_term(copy); - report(1); -} - - -/* - * A basic test of erl_mk_atom(). - */ - -TESTCASE(t_erl_mk_atom) -{ - erl_init(NULL, 0); - - send_term(erl_mk_atom("madonna")); - send_term(erl_mk_atom("Madonna")); - send_term(erl_mk_atom("mad donna")); - send_term(erl_mk_atom("_madonna_")); - send_term(erl_mk_atom("/home/madonna/tour_plan")); - send_term(erl_mk_atom("http://www.madonna.com/tour_plan")); - send_term(erl_mk_atom("\'madonna\'")); - send_term(erl_mk_atom("\"madonna\"")); - send_term(erl_mk_atom("\\madonna\\")); - send_term(erl_mk_atom("{madonna,21,'mad donna',12}")); - - report(1); -} - - -/* - * A basic test of erl_mk_binary(). - */ - -TESTCASE(t_erl_mk_binary) -{ - - char* string; - erl_init(NULL, 0); - - string = "{madonna,21,'mad donna',1234.567.890, !#$%&/()=?+-@, \" \\}"; - send_term(erl_mk_binary(string,strlen(string))); - - report(1); -} - - -/* - * A basic test of erl_mk_empty_list(). - */ - -TESTCASE(t_erl_mk_empty_list) -{ - erl_init(NULL, 0); - - send_term(erl_mk_empty_list()); - report(1); -} - - -/* - * A basic test of erl_mk_float(). - */ - -TESTCASE(t_erl_mk_float) -{ - ETERM* arr[6]; - ETERM* emsg; - - erl_init(NULL, 0); - - arr[0] = erl_mk_float(3.1415); - arr[1] = erl_mk_float(1.999999); - arr[2] = erl_mk_float(2.000000); - arr[3] = erl_mk_float(2.000001); - arr[4] = erl_mk_float(2.000002); - arr[5] = erl_mk_float(12345.67890); - emsg = (erl_mk_tuple(arr,6)); - - send_term(emsg); - - erl_free_array(arr,6); - /* emsg already freed by send_term() */ - /* erl_free_term(emsg); */ - - report(1); -} - - -/* - * A basic test of erl_mk_pid(). - */ - -TESTCASE(t_erl_mk_pid) -{ - erl_init(NULL, 0); - - send_term(erl_mk_pid("kalle@localhost", 3, 2, 1)); - report(1); -} - -/* - * A basic test of erl_mk_pid(). - */ - -TESTCASE(t_erl_mk_xpid) -{ - erl_init(NULL, 0); - - send_term(erl_mk_pid("kalle@localhost", 32767, 8191, 1)); - report(1); -} - - -/* - * A basic test of erl_mk_port(). - */ - -TESTCASE(t_erl_mk_port) -{ - erl_init(NULL, 0); - - send_term(erl_mk_port("kalle@localhost", 4, 1)); - report(1); -} - -/* - * A basic test of erl_mk_port(). - */ - -TESTCASE(t_erl_mk_xport) -{ - erl_init(NULL, 0); - - send_term(erl_mk_port("kalle@localhost", 268435455, 1)); - report(1); -} - -/* - * A basic test of erl_mk_ref(). - */ - -TESTCASE(t_erl_mk_ref) -{ - erl_init(NULL, 0); - - send_term(erl_mk_ref("kalle@localhost", 6, 1)); - report(1); -} - -/* - * A basic test of erl_mk_long_ref(). - */ - - -TESTCASE(t_erl_mk_long_ref) -{ - erl_init(NULL, 0); - - send_term(erl_mk_long_ref("kalle@localhost", - 4294967295, 4294967295, 262143, - 1)); - report(1); -} - - -/* - * A basic test of erl_mk_string(). - */ - -TESTCASE(t_erl_mk_string) -{ - - erl_init(NULL, 0); - - send_term(erl_mk_string("madonna")); - send_term(erl_mk_string("Madonna")); - send_term(erl_mk_string("mad donna")); - send_term(erl_mk_string("_madonna_")); - send_term(erl_mk_string("/home/madonna/tour_plan")); - send_term(erl_mk_string("http://www.madonna.com/tour_plan")); - send_term(erl_mk_string("\'madonna\'")); - send_term(erl_mk_string("\"madonna\"")); - send_term(erl_mk_string("\\madonna\\")); - send_term(erl_mk_string("{madonna,21,'mad donna',12}")); - - report(1); -} - - -/* - * A basic test of erl_mk_estring(). - */ - -TESTCASE(t_erl_mk_estring) -{ - char* string; - erl_init(NULL, 0); - - string = "madonna"; - send_term(erl_mk_estring(string,strlen(string))); - string = "Madonna"; - send_term(erl_mk_estring(string,strlen(string))); - string = "mad donna"; - send_term(erl_mk_estring(string,strlen(string))); - string = "_madonna_"; - send_term(erl_mk_estring(string,strlen(string))); - string = "/home/madonna/tour_plan"; - send_term(erl_mk_estring(string,strlen(string))); - string = "http://www.madonna.com/tour_plan"; - send_term(erl_mk_estring(string,strlen(string))); - string = "\'madonna\'"; - send_term(erl_mk_estring(string,strlen(string))); - string = "\"madonna\""; - send_term(erl_mk_estring(string,strlen(string))); - string = "\\madonna\\"; - send_term(erl_mk_estring(string,strlen(string))); - string = "{madonna,21,'mad donna',12}"; - send_term(erl_mk_estring(string,strlen(string))); - - report(1); -} - - -/* - * A basic test of erl_mk_tuple(). - */ - -TESTCASE(t_erl_mk_tuple) -{ - ETERM* arr[4]; - ETERM* arr2[2]; - ETERM* arr3[2]; - ETERM* arr4[2]; - - erl_init(NULL, 0); - - /* {madonna,21,'mad donna',12} */ - arr[0] = erl_mk_atom("madonna"); - arr[1] = erl_mk_int(21); - arr[2] = erl_mk_atom("mad donna"); - arr[3] = erl_mk_int(12); - - send_term(erl_mk_tuple(arr,4)); - - erl_free_array(arr,4); - - - /* {'Madonna',21,{children,{"Isabella",2}},{'home page',"http://www.madonna.com/"} */ - arr4[0] = erl_mk_atom("home page"); - arr4[1] = erl_mk_string("http://www.madonna.com/"); - - arr3[0] = erl_mk_string("Isabella"); - arr3[1] = erl_mk_int(2); - - arr2[0] = erl_mk_atom("children"); - arr2[1] = erl_mk_tuple(arr3,2); - - arr[0] = erl_mk_atom("Madonna"); - arr[1] = erl_mk_int(21); - arr[2] = erl_mk_tuple(arr2,2); - arr[3] = erl_mk_tuple(arr4,2); - - send_term(erl_mk_tuple(arr,4)); - - erl_free_array(arr,4); - erl_free_array(arr2,2); - erl_free_array(arr3,2); - erl_free_array(arr4,2); - - - report(1); -} - - -/* - * A basic test of erl_mk_uint(). - */ - -TESTCASE(t_erl_mk_uint) -{ - unsigned i; - - erl_init(NULL, 0); - - send_term(erl_mk_uint(54321)); - i = 2147483647; - send_term(erl_mk_uint(i)); - send_term(erl_mk_uint(i+1)); - send_term(erl_mk_uint(i+2)); - send_term(erl_mk_uint(i+3)); - send_term(erl_mk_uint(i+i+1)); - - report(1); -} - - -/* - * A basic test of erl_mk_var(). - */ - -TESTCASE(t_erl_mk_var) -{ - ETERM* mk_var; - ETERM* term; - ETERM* term2; - ETERM* arr[4]; - ETERM* arr_term[2]; - ETERM* mk_var_tuple; - ETERM* term_tuple; - - erl_init(NULL, 0); - - - /* match unbound/bound variable against an integer */ - term = erl_mk_int(17); - term2 = erl_mk_int(2); - mk_var = erl_mk_var("New_var"); - send_term(erl_mk_int(erl_match(mk_var, term))); /* should be ok */ - send_term(erl_mk_int(erl_match(mk_var, term2))); /* should fail */ - send_term(erl_mk_int(erl_match(mk_var, term))); /* should be ok */ - send_term(erl_mk_int(erl_match(mk_var, term2))); /* should fail */ - erl_free_term(mk_var); - erl_free_term(term); - erl_free_term(term2); - - /* match unbound variable against a tuple */ - arr[0] = erl_mk_atom("madonna"); - arr[1] = erl_mk_int(21); - arr[2] = erl_mk_atom("mad donna"); - arr[3] = erl_mk_int(12); - mk_var = erl_mk_var("New_var"); - term = erl_mk_tuple(arr,4); - send_term(erl_mk_int(erl_match(mk_var, term))); /* should be ok */ - erl_free_term(mk_var); - erl_free_term(term); - erl_free_array(arr,4); - - - /* match (twice) unbound variable against an incorrect tuple */ - arr[0] = erl_mk_var("New_var"); - arr[1] = erl_mk_var("New_var"); - arr_term[0] = erl_mk_int(17); - arr_term[1] = erl_mk_int(27); - mk_var_tuple = erl_mk_tuple(arr,2); - term_tuple = erl_mk_tuple(arr_term,2); - send_term(erl_mk_int(erl_match(mk_var_tuple, term_tuple))); /* should fail */ - erl_free_array(arr,2); - erl_free_array(arr_term,2); - erl_free_term(mk_var_tuple); - erl_free_term(term_tuple); - - - /* match (twice) unbound variable against a correct tuple */ - arr[0] = erl_mk_var("New_var"); - arr[1] = erl_mk_var("New_var"); - arr_term[0] = erl_mk_int(17); - arr_term[1] = erl_mk_int(17); - mk_var_tuple = erl_mk_tuple(arr,2); - term_tuple = erl_mk_tuple(arr_term,2); - send_term(erl_mk_int(erl_match(mk_var_tuple, term_tuple))); /* should be ok */ - erl_free_array(arr,2); - erl_free_array(arr_term,2); - erl_free_term(mk_var_tuple); - erl_free_term(term_tuple); - - report(1); -} - - -/* - * A basic test of erl_size(). - */ - -TESTCASE(t_erl_size) -{ - ETERM* arr[4]; - ETERM* tuple; - ETERM* bin; - char* string; - - erl_init(NULL, 0); - - /* size of a tuple */ - tuple = erl_format("{}"); - send_term(erl_mk_int(erl_size(tuple))); - erl_free_term(tuple); - - arr[0] = erl_mk_atom("madonna"); - arr[1] = erl_mk_int(21); - arr[2] = erl_mk_atom("mad donna"); - arr[3] = erl_mk_int(12); - tuple = erl_mk_tuple(arr,4); - - send_term(erl_mk_int(erl_size(tuple))); - - erl_free_array(arr,4); - erl_free_term(tuple); - - /* size of a binary */ - string = ""; - bin = erl_mk_binary(string,strlen(string)); - send_term(erl_mk_int(erl_size(bin))); - erl_free_term(bin); - - string = "{madonna,21,'mad donna',12}"; - bin = erl_mk_binary(string,strlen(string)); - send_term(erl_mk_int(erl_size(bin))); - erl_free_term(bin); - - report(1); -} - - -/* - * A basic test of erl_var_content(). - */ - -TESTCASE(t_erl_var_content) -{ - ETERM* mk_var; - ETERM* term; - ETERM* tuple; - ETERM* list; - ETERM* a; - ETERM* b; - ETERM* arr[4]; - ETERM* arr2[2]; - ETERM* arr3[2]; - ETERM* arr4[2]; - - erl_init(NULL, 0); - - term = erl_mk_int(17); - mk_var = erl_mk_var("Var"); - - /* unbound, should return NULL */ - if (erl_var_content(mk_var,"Var") != NULL) - fail("t_erl_var_content() failed"); - - erl_match(mk_var, term); - send_term(erl_var_content(mk_var,"Var")); /* should return 17 */ - - /* integer, should return NULL */ - if (erl_var_content(term,"Var") != NULL) - fail("t_erl_var_content() failed"); - - /* unknown variable, should return NULL */ - if (erl_var_content(mk_var,"Unknown_Var") != NULL) - fail("t_erl_var_content() failed"); - - erl_free_term(mk_var); - erl_free_term(term); - - /* {'Madonna',21,{children,{"Name","Age"}},{"Home_page","Tel_no"}} */ - arr4[0] = erl_mk_var("Home_page"); - arr4[1] = erl_mk_var("Tel_no"); - a = erl_mk_string("http://www.madonna.com"); - erl_match(arr4[0], a); - - arr3[0] = erl_mk_var("Name"); - arr3[1] = erl_mk_var("Age"); - b = erl_mk_int(2); - erl_match(arr3[1], b); - - arr2[0] = erl_mk_atom("children"); - arr2[1] = erl_mk_tuple(arr3,2); - - arr[0] = erl_mk_atom("Madonna"); - arr[1] = erl_mk_int(21); - arr[2] = erl_mk_tuple(arr2,2); - arr[3] = erl_mk_tuple(arr4,2); - - tuple = erl_mk_tuple(arr,4); - - /* should return "http://www.madonna.com" */ - send_term(erl_var_content(tuple,"Home_page")); - - /* unbound, should return NULL */ - if (erl_var_content(tuple,"Tel_no") != NULL) - fail("t_erl_var_content() failed"); - - /* unbound, should return NULL */ - if (erl_var_content(tuple,"Name") != NULL) - fail("t_erl_var_content() failed"); - - /* should return 2 */ - send_term(erl_var_content(tuple,"Age")); - - erl_free_array(arr,4); - erl_free_array(arr2,2); - erl_free_array(arr3,2); - erl_free_array(arr4,2); - erl_free_term(tuple); - erl_free_term(a); - erl_free_term(b); - - - /* [] */ - list = erl_mk_empty_list(); - if (erl_var_content(list,"Tel_no") != NULL) - fail("t_erl_var_content() failed"); - erl_free_term(list); - - - /* ['Madonna',[],{children,{"Name","Age"}},{"Home_page","Tel_no"}] */ - arr4[0] = erl_mk_var("Home_page"); - arr4[1] = erl_mk_var("Tel_no"); - a = erl_mk_string("http://www.madonna.com"); - erl_match(arr4[0], a); - - arr3[0] = erl_mk_var("Name"); - arr3[1] = erl_mk_var("Age"); - b = erl_mk_int(2); - erl_match(arr3[1], b); - - arr2[0] = erl_mk_atom("children"); - arr2[1] = erl_mk_tuple(arr3,2); - - arr[0] = erl_mk_atom("Madonna"); - arr[1] = erl_mk_empty_list(); - arr[2] = erl_mk_tuple(arr2,2); - arr[3] = erl_mk_tuple(arr4,2); - - list = erl_mk_list(arr,4); - - /* should return "http://www.madonna.com" */ - send_term(erl_var_content(list,"Home_page")); - - /* unbound, should return NULL */ - if (erl_var_content(list,"Tel_no") != NULL) - fail("t_erl_var_content() failed"); - - /* unbound, should return NULL */ - if (erl_var_content(list,"Name") != NULL) - fail("t_erl_var_content() failed"); - - /* should return 2 */ - send_term(erl_var_content(list,"Age")); - - erl_free_array(arr,4); - erl_free_array(arr2,2); - erl_free_array(arr3,2); - erl_free_array(arr4,2); - erl_free_term(list); - erl_free_term(a); - erl_free_term(b); - - report(1); -} - - -/* - * A basic test of erl_element(). - */ - -TESTCASE(t_erl_element) -{ - ETERM* arr[4]; - ETERM* arr2[2]; - ETERM* arr3[2]; - ETERM* arr4[2]; - ETERM* tuple; - - erl_init(NULL, 0); - - arr[0] = erl_mk_atom("madonna"); - arr[1] = erl_mk_int(21); - arr[2] = erl_mk_atom("mad donna"); - arr[3] = erl_mk_int(12); - tuple = erl_mk_tuple(arr,4); - - send_term(erl_element(1,tuple)); - send_term(erl_element(2,tuple)); - send_term(erl_element(3,tuple)); - send_term(erl_element(4,tuple)); - - erl_free_array(arr,4); - erl_free_term(tuple); - - /* {'Madonna',21,{children,{"Isabella",2}},{'home page',"http://www.madonna.com/"} */ - arr4[0] = erl_mk_atom("home page"); - arr4[1] = erl_mk_string("http://www.madonna.com/"); - - arr3[0] = erl_mk_string("Isabella"); - arr3[1] = erl_mk_int(2); - - arr2[0] = erl_mk_atom("children"); - arr2[1] = erl_mk_tuple(arr3,2); - - arr[0] = erl_mk_atom("Madonna"); - arr[1] = erl_mk_int(21); - arr[2] = erl_mk_tuple(arr2,2); - arr[3] = erl_mk_tuple(arr4,2); - - tuple = erl_mk_tuple(arr,4); - send_term(erl_element(1,tuple)); - send_term(erl_element(2,tuple)); - send_term(erl_element(3,tuple)); - send_term(erl_element(4,tuple)); - - erl_free_term(tuple); - erl_free_array(arr,4); - erl_free_array(arr2,2); - erl_free_array(arr3,2); - erl_free_array(arr4,2); - - report(1); -} - - -/* - * A basic test of erl_cons(). - */ - -TESTCASE(t_erl_cons) -{ - ETERM* list; - ETERM* anAtom; - ETERM* anInt; - - erl_init(NULL, 0); - - anAtom = erl_mk_atom("madonna"); - anInt = erl_mk_int(21); - list = erl_mk_empty_list(); - list = erl_cons(anInt, list); - send_term(erl_cons(anAtom, list)); - - erl_free_term(anAtom); - erl_free_term(anInt); - erl_free_compound(list); - - report(1); -} - - - - -/*********************************************************************** - * - * 3. E x t r a c t i n g & i n f o f u n c t i o n s - * - ***********************************************************************/ - -/* - * Calculates the length of each list sent to it and sends back the result. - */ - -TESTCASE(t_erl_length) -{ - erl_init(NULL, 0); - - for (;;) { - ETERM* term = get_term(); - - if (term == NULL) { - report(1); - return; - } else { - ETERM* len_term; - - len_term = erl_mk_int(erl_length(term)); - erl_free_term(term); - send_term(len_term); - } - } -} - -/* - * Gets the head of each term and sends the result back. - */ - -TESTCASE(t_erl_hd) -{ - erl_init(NULL, 0); - - for (;;) { - ETERM* term = get_term(); - - if (term == NULL) { - report(1); - return; - } else { - ETERM* head; - - head = erl_hd(term); - send_term(head); - erl_free_term(term); - } - } -} - -/* - * Gets the tail of each term and sends the result back. - */ - -TESTCASE(t_erl_tl) -{ - erl_init(NULL, 0); - - for (;;) { - ETERM* term = get_term(); - - if (term == NULL) { - report(1); - return; - } else { - ETERM* tail; - - tail = erl_tl(term); - send_term(tail); - erl_free_term(term); - } - } -} - -/* - * Checks the type checking macros. - */ - -TESTCASE(type_checks) -{ - ETERM* t; - ETERM* atom; - - erl_init(NULL, 0); - atom = erl_mk_atom("an_atom"); - -#define TYPE_CHECK(macro, term) \ - { ETERM* t = term; \ - if (macro(t)) { \ - erl_free_term(t); \ - } else { \ - fail("Macro " #macro " failed on " #term); \ - } \ - } - - TYPE_CHECK(ERL_IS_INTEGER, erl_mk_int(0x7FFFFFFF)); -#ifdef NEW_ERL_INTERFACE - TYPE_CHECK(ERL_IS_UNSIGNED_INTEGER, erl_mk_uint(0x7FFFFFFF)); -#endif - TYPE_CHECK(ERL_IS_FLOAT, erl_mk_float(5.5)); - TYPE_CHECK(ERL_IS_ATOM, erl_mk_atom("another_atom")); - - TYPE_CHECK(ERL_IS_EMPTY_LIST, erl_mk_empty_list()); - TYPE_CHECK(!ERL_IS_EMPTY_LIST, erl_cons(atom, atom)); - -#ifdef NEW_ERL_INTERFACE - TYPE_CHECK(!ERL_IS_CONS, erl_mk_empty_list()); - TYPE_CHECK(ERL_IS_CONS, erl_cons(atom, atom)); -#endif - - TYPE_CHECK(ERL_IS_LIST, erl_mk_empty_list()); - TYPE_CHECK(ERL_IS_LIST, erl_cons(atom, atom)); - - TYPE_CHECK(ERL_IS_PID, erl_mk_pid("a@a", 42, 1, 1)); - TYPE_CHECK(ERL_IS_PORT, erl_mk_port("a@a", 42, 1)); - TYPE_CHECK(ERL_IS_REF, erl_mk_ref("a@a", 42, 1)); - - TYPE_CHECK(ERL_IS_BINARY, erl_mk_binary("a", 1)); - TYPE_CHECK(ERL_IS_TUPLE, erl_mk_tuple(&atom, 1)); -#undef TYPE_CHECK - - erl_free_term(atom); - - report(1); -} - -/* - * Checks the extractor macros. - */ - -TESTCASE(extractor_macros) -{ - ETERM* t; - - erl_init(NULL, 0); - -#ifdef NEW_ERL_INTERFACE -#define MATCH(a, b) ((a) == (b) ? 1 : fail("bad match: " #a)) -#define STR_MATCH(a, b) (strcmp((a), (b)) ? fail("bad match: " #a) : 0) - - { /* Integer */ - int anInt = 0x7FFFFFFF; - t = erl_mk_int(anInt); - MATCH(ERL_INT_VALUE(t), anInt); - MATCH(ERL_INT_UVALUE(t), anInt); - erl_free_term(t); - } - - { /* Float */ - double aFloat = 3.1415; - t = erl_mk_float(aFloat); - MATCH(ERL_FLOAT_VALUE(t), aFloat); - erl_free_term(t); - } - - { /* Atom. */ - char* aString = "nisse"; - t = erl_mk_atom(aString); - if (memcmp(ERL_ATOM_PTR(t), aString, strlen(aString)) != 0) - fail("bad match"); - MATCH(ERL_ATOM_SIZE(t), strlen(aString)); - erl_free_term(t); - } - - { /* Pid. */ - char* node = "arne@strider"; - int number = 42; - int serial = 5; - int creation = 1; - - t = erl_mk_pid(node, number, serial, creation); - STR_MATCH(ERL_PID_NODE(t), node); - MATCH(ERL_PID_NUMBER(t), number); - MATCH(ERL_PID_SERIAL(t), serial); - MATCH(ERL_PID_CREATION(t), creation); - erl_free_term(t); - } - - { /* Port. */ - char* node = "kalle@strider"; - int number = 45; - int creation = 1; - - t = erl_mk_port(node, number, creation); - STR_MATCH(ERL_PORT_NODE(t), node); - MATCH(ERL_PORT_NUMBER(t), number); - MATCH(ERL_PORT_CREATION(t), creation); - erl_free_term(t); - } - - { /* Reference. */ - char* node = "kalle@strider"; - int number = 48; - int creation = 1; - - t = erl_mk_ref(node, number, creation); - STR_MATCH(ERL_REF_NODE(t), node); - MATCH(ERL_REF_NUMBER(t), number); - MATCH(ERL_REF_CREATION(t), creation); - erl_free_term(t); - } - - { /* Tuple. */ - ETERM* arr[2]; - - arr[0] = erl_mk_int(51); - arr[1] = erl_mk_int(52); - t = erl_mk_tuple(arr, ASIZE(arr)); - MATCH(ERL_TUPLE_SIZE(t), ASIZE(arr)); - MATCH(ERL_TUPLE_ELEMENT(t, 0), arr[0]); - MATCH(ERL_TUPLE_ELEMENT(t, 1), arr[1]); - erl_free_array(arr, ASIZE(arr)); - erl_free_term(t); - } - - { /* Binary. */ - static char bin[] = {1, 2, 3, 0, 4, 5}; - - t = erl_mk_binary(bin, ASIZE(bin)); - MATCH(ERL_BIN_SIZE(t), ASIZE(bin)); - if (memcmp(ERL_BIN_PTR(t), bin, ASIZE(bin)) != 0) - fail("bad match"); - erl_free_term(t); - } - - { - ETERM* head = erl_mk_atom("head"); - ETERM* tail = erl_mk_atom("tail"); - - t = erl_cons(head, tail); - MATCH(ERL_CONS_HEAD(t), head); - MATCH(ERL_CONS_TAIL(t), tail); - erl_free_term(head); - erl_free_term(tail); - erl_free_term(t); - } -#undef MATCH -#undef STR_MATCH -#endif - - report(1); -} - - - -/*********************************************************************** - * - * 4. I / O l i s t f u n c t i o n s - * - ***********************************************************************/ - -/* - * Invokes erl_iolist_length() on each term and send backs the result. - */ - -TESTCASE(t_erl_iolist_length) -{ - erl_init(NULL, 0); - - for (;;) { - ETERM* term = get_term(); - - if (term == NULL) { - report(1); - return; - } else { -#ifndef NEW_ERL_INTERFACE - fail("Function not present in this version of erl_interface"); -#else - ETERM* len_term; - - len_term = erl_mk_int(erl_iolist_length(term)); - erl_free_term(term); - send_term(len_term); -#endif - } - } -} - -/* - * Invokes erl_iolist_to_binary() on each term and send backs the result. - */ - -TESTCASE(t_erl_iolist_to_binary) -{ - erl_init(NULL, 0); - - for (;;) { - ETERM* term = get_term(); - - if (term == NULL) { - report(1); - return; - } else { -#ifndef NEW_ERL_INTERFACE - fail("Function not present in this version of erl_interface"); -#else - ETERM* new_term; - - new_term = erl_iolist_to_binary(term); - - erl_free_term(term); - send_term(new_term); -#endif - } - } -} - -/* - * Invokes erl_iolist_to_string() on each term and send backs the result. - */ - -TESTCASE(t_erl_iolist_to_string) -{ - erl_init(NULL, 0); - - for (;;) { - ETERM* term = get_term(); - - if (term == NULL) { - report(1); - return; - } else { -#ifndef NEW_ERL_INTERFACE - fail("Function not present in this version of erl_interface"); -#else - char* result; - - result = erl_iolist_to_string(term); - erl_free_term(term); - if (result != NULL) { - send_buffer(result, strlen(result)+1); - erl_free(result); - } else { - send_term(NULL); - } -#endif - } - } -} - - -/*********************************************************************** - * - * 5. M i s c e l l a n o u s T e s t s - * - ***********************************************************************/ - -/* - * Test some combinations of operations to verify that the reference pointers - * are handled correctly. - * - * "Det verkar vara lite High Chaparal med minneshanteringen i erl_interface" - * Per Lundgren, ERV. - */ - -TESTCASE(high_chaparal) -{ - ETERM *L1, *A1, *L2, *A2, *L3; - - erl_init(NULL, 0); - - L1 = erl_mk_empty_list(); - A1 = erl_mk_atom("world"); - L2 = erl_cons(A1, L1); - A2 = erl_mk_atom("hello"); - L3 = erl_cons(A2, L2); - - erl_free_term(L1); - erl_free_term(A1); - erl_free_term(L2); - erl_free_term(A2); - - send_term(L3); - - /* already freed by send_term() */ - /* erl_free_term(L3);*/ - - report(1); -} - -/* - * Test erl_decode to recover from broken list data (OTP-7448) - */ -TESTCASE(broken_data) -{ - ETERM* original; - ETERM* new_terms; - char encoded[16*1024]; - int n; - - erl_init(NULL, 0); - original = all_types(); - if ((n=erl_encode(original, encoded)) == 0) - { - fail("failed to encode terms"); - } else - { - int offs = n/2; - memset(encoded+offs,0,n-offs); /* destroy */ - - if ((new_terms = erl_decode(encoded)) != NULL) - { - fail("decode accepted broken data"); - erl_free_term(new_terms); - } - } - erl_free_term(original); - report(1); -} - -/* - * Returns a list containing instances of all types. - * - * Be careful changing the contents of the list returned, because both - * the build_terms() and decode_terms() test cases depend on it. - */ - -static ETERM* -all_types(void) -{ - ETERM* t; - ETERM* terms[3]; - int i; - static char a_binary[] = "A binary"; - -#define CONS_AND_FREE(expr, tail) \ - do { \ - ETERM* term = expr; \ - ETERM* nl = erl_cons(term, tail); \ - erl_free_term(term); \ - erl_free_term(tail); \ - tail = nl; \ - } while (0) - - t = erl_mk_empty_list(); - - CONS_AND_FREE(erl_mk_atom("I am an atom"), t); - CONS_AND_FREE(erl_mk_binary("A binary", sizeof(a_binary)-1), t); - CONS_AND_FREE(erl_mk_float(3.0), t); - CONS_AND_FREE(erl_mk_int(0), t); - CONS_AND_FREE(erl_mk_int(-1), t); - CONS_AND_FREE(erl_mk_int(1), t); - - CONS_AND_FREE(erl_mk_string("A string"), t); - - terms[0] = erl_mk_atom("element1"); - terms[1] = erl_mk_int(42); - terms[2] = erl_mk_int(767); - CONS_AND_FREE(erl_mk_tuple(terms, ASIZE(terms)), t); - for (i = 0; i < ASIZE(terms); i++) { - erl_free_term(terms[i]); - } - - CONS_AND_FREE(erl_mk_pid("kalle@localhost", 3, 2, 1), t); - CONS_AND_FREE(erl_mk_pid("abcdefghijabcdefghij@localhost", 3, 2, 1), t); - CONS_AND_FREE(erl_mk_port("kalle@localhost", 4, 1), t); - CONS_AND_FREE(erl_mk_port("abcdefghijabcdefghij@localhost", 4, 1), t); - CONS_AND_FREE(erl_mk_ref("kalle@localhost", 6, 1), t); - CONS_AND_FREE(erl_mk_ref("abcdefghijabcdefghij@localhost", 6, 1), t); - return t; - -#undef CONS_AND_FREE -} - -/* - * Dump (print for debugging) a term. Useful if/when things go wrong. - */ -void -dump_term (FILE *fp, ETERM *t) -{ - if (fp == NULL) return; - - fprintf(fp, "#<%p ", t); - - if(t != NULL) - { - fprintf(fp, "count:%d, type:%d", ERL_COUNT(t), ERL_TYPE(t)); - - switch(ERL_TYPE(t)) - { - case ERL_UNDEF: - fprintf(fp, "==undef"); - break; - case ERL_INTEGER: - fprintf(fp, "==int, val:%d", ERL_INT_VALUE(t)); - break; - case ERL_U_INTEGER: - fprintf(fp, "==uint, val:%u", ERL_INT_UVALUE(t)); - break; - case ERL_FLOAT: - fprintf(fp, "==float, val:%g", ERL_FLOAT_VALUE(t)); - break; - case ERL_ATOM: - fprintf(fp, "==atom, name:%p \"%s\"", - ERL_ATOM_PTR(t), ERL_ATOM_PTR(t)); - break; - case ERL_BINARY: - fprintf(fp, "==binary, data:%p,%u", - ERL_BIN_PTR(t), ERL_BIN_SIZE(t)); - break; - case ERL_PID: - fprintf(fp, "==pid, node:%p \"%s\"", - ERL_PID_NODE(t), ERL_PID_NODE(t)); - break; - case ERL_PORT: - fprintf(fp, "==port, node:%p \"%s\"", - ERL_PORT_NODE(t), ERL_PORT_NODE(t)); - break; - case ERL_REF: - fprintf(fp, "==ref, node:%p \"%s\"", - ERL_REF_NODE(t), ERL_REF_NODE(t)); - break; - case ERL_CONS: - fprintf(fp, "==cons"); - fprintf(fp, ", car:"); - dump_term(fp, ERL_CONS_HEAD(t)); - fprintf(fp, ", cdr:"); - dump_term(fp, ERL_CONS_TAIL(t)); - break; - case ERL_NIL: - fprintf(fp, "==nil"); - break; - case ERL_TUPLE: - fprintf(fp, "==tuple, elems:%p,%u", - ERL_TUPLE_ELEMS(t), ERL_TUPLE_SIZE(t)); - { - size_t i; - for(i = 0; i < ERL_TUPLE_SIZE(t); i++) - { - fprintf(fp, "elem[%u]:", i); - dump_term(fp, ERL_TUPLE_ELEMENT(t, i)); - } - } - break; - case ERL_VARIABLE: - fprintf(fp, "==variable, name:%p \"%s\"", - ERL_VAR_NAME(t), ERL_VAR_NAME(t)); - fprintf(fp, ", value:"); - dump_term(fp, ERL_VAR_VALUE(t)); - break; - - default: - break; - } - } - fprintf(fp, ">"); -} - diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/print_term.c b/lib/erl_interface/test/erl_eterm_SUITE_data/print_term.c deleted file mode 100644 index 5b7cb1aec8..0000000000 --- a/lib/erl_interface/test/erl_eterm_SUITE_data/print_term.c +++ /dev/null @@ -1,131 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * Purpose: Test the erl_print_term() function. - * Author: Bjorn Gustavsson - */ - -#include <stdio.h> -#include <stdlib.h> -#include <errno.h> -#include <sys/types.h> -#include <sys/stat.h> -#include <fcntl.h> -#ifndef __WIN32__ -#include <unistd.h> -#endif - -#include "erl_interface.h" - -#ifndef __WIN32__ -#define _O_BINARY 0 -#define _setmode(fd, mode) -#endif - -#define HEADER_SIZE 2 - -static int readn(int, unsigned char*, int); - -/* - * This program doesn't use the runner, because it needs a packet - * on input, but the result will be as a stream of bytes (since - * erl_print_term() prints directly on a file). - * - * Input is a package of with a packet header size of two bytes. - * - * +------------------------------------------------------------+ - * | length | Encoded term... | - * | (2 bytes) | (as given by "length") | - * +------------------------------------------------------------+ - * - * <------------------- length ---------------------> - * - * This program decodes the encoded terms and passes it to - * erl_print_term(). Then this program prints - * - * CR <result> LF - * - * and waits for a new package. <result> is the return value from - * erl_print_term(), formatted as an ASCII string. - */ - -#ifdef VXWORKS -int print_term() -#else -int main() -#endif -{ - _setmode(0, _O_BINARY); - _setmode(1, _O_BINARY); - - erl_init(NULL, 0); - - for (;;) { - char buf[4*1024]; - ETERM* term; - char* message; - int n; - - if (readn(0, buf, 2) <= 0) { - /* fprintf(stderr, "error reading message header\n"); */ - /* actually this is where we leave the infinite loop */ - exit(1); - } - n = buf[0] * 256 + buf[1]; - if (readn(0, buf, n) < 0) { - fprintf(stderr, "error reading message contents\n"); - exit(1); - } - - term = erl_decode(buf); - if (term == NULL) { - fprintf(stderr, "erl_decode() failed\n"); - exit(1); - } - n = erl_print_term(stdout, term); - erl_free_compound(term); - fprintf(stdout,"\r%d\n", n); - fflush(stdout); - } -} - -/* - * Reads len number of bytes. - */ - -static int -readn(fd, buf, len) - int fd; /* File descriptor to read from. */ - unsigned char *buf; /* Store in this buffer. */ - int len; /* Number of bytes to read. */ -{ - int n; /* Byte count in last read call. */ - int sofar = 0; /* Bytes read so far. */ - - do { - if ((n = read(fd, buf+sofar, len-sofar)) <= 0) - /* error or EOF in read */ - return(n); - sofar += n; - } while (sofar < len); - return sofar; -} - diff --git a/lib/erl_interface/test/erl_format_SUITE.erl b/lib/erl_interface/test/erl_format_SUITE.erl deleted file mode 100644 index 69dfdcc4c8..0000000000 --- a/lib/erl_interface/test/erl_format_SUITE.erl +++ /dev/null @@ -1,135 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(erl_format_SUITE). - --include_lib("common_test/include/ct.hrl"). --include("erl_format_SUITE_data/format_test_cases.hrl"). - --export([all/0, suite/0, - init_per_testcase/2, - atoms/1, tuples/1, lists/1]). - --import(runner, [get_term/1]). - -%% This test suite test the erl_format() function. -%% It uses the port program "format_test". - -suite() -> - [{ct_hooks,[ts_install_cth]}]. - -all() -> - [atoms, tuples, lists]. - -init_per_testcase(Case, Config) -> - runner:init_per_testcase(?MODULE, Case, Config). - -%% Tests formatting various atoms. - -atoms(Config) when is_list(Config) -> - P = runner:start(Config, ?atoms), - - {term, ''} = get_term(P), - {term, 'a'} = get_term(P), - {term, 'A'} = get_term(P), - {term, 'abc'} = get_term(P), - {term, 'Abc'} = get_term(P), - {term, 'ab@c'} = get_term(P), - {term, 'The rain in Spain stays mainly in the plains'} = get_term(P), - - {term, a} = get_term(P), - {term, ab} = get_term(P), - {term, abc} = get_term(P), - {term, ab@c} = get_term(P), - {term, abcdefghijklmnopq} = get_term(P), - - {term, ''} = get_term(P), - {term, 'a'} = get_term(P), - {term, 'A'} = get_term(P), - {term, 'abc'} = get_term(P), - {term, 'Abc'} = get_term(P), - {term, 'ab@c'} = get_term(P), - {term, 'The rain in Spain stays mainly in the plains'} = get_term(P), - - {term, a} = get_term(P), - {term, ab} = get_term(P), - {term, abc} = get_term(P), - {term, ab@c} = get_term(P), - {term, ' abcdefghijklmnopq '} = get_term(P), - - runner:recv_eot(P), - ok. - - - -%% Tests formatting various tuples - -tuples(Config) when is_list(Config) -> - P = runner:start(Config, ?tuples), - - {term, {}} = get_term(P), - {term, {a}} = get_term(P), - {term, {a, b}} = get_term(P), - {term, {a, b, c}} = get_term(P), - {term, {1}} = get_term(P), - {term, {[]}} = get_term(P), - {term, {[], []}} = get_term(P), - {term, {[], a, b, c}} = get_term(P), - {term, {[], a, [], b, c}} = get_term(P), - {term, {[], a, '', b, c}} = get_term(P), - - runner:recv_eot(P), - ok. - - - -%% Tests formatting various lists - -lists(Config) when is_list(Config) -> - P = runner:start(Config, ?lists), - - {term, []} = get_term(P), - {term, [a]} = get_term(P), - {term, [a, b]} = get_term(P), - {term, [a, b, c]} = get_term(P), - {term, [1]} = get_term(P), - {term, [[]]} = get_term(P), - {term, [[], []]} = get_term(P), - {term, [[], a, b, c]} = get_term(P), - {term, [[], a, [], b, c]} = get_term(P), - {term, [[], a, '', b, c]} = get_term(P), - - {term, [{name, 'Madonna'}, {age, 21}, {data, [{addr, "E-street", 42}]}]} = get_term(P), - case os:type() of - vxworks -> - {term, [{pi, _}, {'cos(70)', _}]} = get_term(P), - {term, [[pi, _], ['cos(70)', _]]} = get_term(P), - {term, [[pi, _], [], ["cos(70)", _]]} = get_term(P); - _ -> - {term, [{pi, 3.1415}, {'cos(70)', 0.34202}]} = get_term(P), - {term, [[pi, 3.1415], ['cos(70)', 0.34202]]} = get_term(P), - {term, [[pi, 3.1415], [], ["cos(70)", 0.34202]]} = get_term(P) - end, - - {term, [-1]} = get_term(P), - - runner:recv_eot(P), - ok. diff --git a/lib/erl_interface/test/erl_format_SUITE_data/Makefile.first b/lib/erl_interface/test/erl_format_SUITE_data/Makefile.first deleted file mode 100644 index acbb8c98bb..0000000000 --- a/lib/erl_interface/test/erl_format_SUITE_data/Makefile.first +++ /dev/null @@ -1,22 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2000-2016. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -format_test_decl.c: format_test.c - erl -noinput -pa ../all_SUITE_data -s init_tc run format_test -s erlang halt diff --git a/lib/erl_interface/test/erl_format_SUITE_data/Makefile.src b/lib/erl_interface/test/erl_format_SUITE_data/Makefile.src deleted file mode 100644 index 2ba59ab651..0000000000 --- a/lib/erl_interface/test/erl_format_SUITE_data/Makefile.src +++ /dev/null @@ -1,43 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2016. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -include @erl_interface_mk_include@ - -CC0 = @CC@ -CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)" -LD = @LD@ -LIBERL = @erl_interface_lib@ -LIBEI = @erl_interface_eilib@ -LIBFLAGS = ../all_SUITE_data/runner@obj@ \ - $(LIBERL) $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \ - @erl_interface_threadlib@ -CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data -FORMAT_OBJS = format_test@obj@ format_test_decl@obj@ - -all: format_test@exe@ - -clean: - $(RM) $(FORMAT_OBJS) - $(RM) format_test@exe@ - -format_test@exe@: $(FORMAT_OBJS) $(LIBERL) $(LIBEI) - $(LD) @CROSSLDFLAGS@ -o $@ $(FORMAT_OBJS) $(LIBFLAGS) - - diff --git a/lib/erl_interface/test/erl_format_SUITE_data/format_test.c b/lib/erl_interface/test/erl_format_SUITE_data/format_test.c deleted file mode 100644 index 258ae92e0f..0000000000 --- a/lib/erl_interface/test/erl_format_SUITE_data/format_test.c +++ /dev/null @@ -1,133 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#include "runner.h" - -/* - * Purpose: Tests the erl_format() function. - * Author: Bjorn Gustavsson - */ - -static void -send_format(char* format) -{ - send_term(erl_format(format)); -} - -TESTCASE(atoms) -{ - erl_init(NULL, 0); - - send_format("''"); - send_format("'a'"); - send_format("'A'"); - send_format("'abc'"); - send_format("'Abc'"); - send_format("'ab@c'"); - send_format("'The rain in Spain stays mainly in the plains'"); - - send_format("a"); - send_format("ab"); - send_format("abc"); - send_format("ab@c"); - send_format(" abcdefghijklmnopq "); - - send_term(erl_format("~a", "")); - send_term(erl_format("~a", "a")); - send_term(erl_format("~a", "A")); - send_term(erl_format("~a", "abc")); - send_term(erl_format("~a", "Abc")); - send_term(erl_format("~a", "ab@c")); - send_term(erl_format("~a", "The rain in Spain stays mainly in the plains")); - - send_term(erl_format("~a", "a")); - send_term(erl_format("~a", "ab")); - send_term(erl_format("~a", "abc")); - send_term(erl_format("~a","ab@c")); - send_term(erl_format("~a", " abcdefghijklmnopq ")); - - - report(1); -} - -TESTCASE(tuples) -{ - erl_init(NULL, 0); - - send_format("{}"); - send_format("{a}"); - send_format("{a, b}"); - send_format("{a, b, c}"); - send_format("{1}"); - send_format("{[]}"); - send_format("{[], []}"); - send_format("{[], a, b, c}"); - send_format("{[], a, [], b, c}"); - send_format("{[], a, '', b, c}"); - - report(1); -} - - - -TESTCASE(lists) -{ - ETERM* a; - ETERM* b; - ETERM* c; - - erl_init(NULL, 0); - - send_format("[]"); - send_format("[a]"); - send_format("[a, b]"); - send_format("[a, b, c]"); - send_format("[1]"); - send_format("[[]]"); - send_format("[[], []]"); - send_format("[[], a, b, c]"); - send_format("[[], a, [], b, c]"); - send_format("[[], a, '', b, c]"); - - b = erl_format("[{addr, ~s, ~i}]", "E-street", 42); - a = erl_format("[{name, ~a}, {age, ~i}, {data, ~w}]", "Madonna", 21, b); - send_term(a); - erl_free_term(b); - - send_term(erl_format("[{pi, ~f}, {'cos(70)', ~f}]", 3.1415, 0.34202)); - - a = erl_mk_float(3.1415); - b = erl_mk_float(0.34202); - send_term(erl_format("[[pi, ~w], ['cos(70)', ~w]]", a, b)); - erl_free_term(a); - erl_free_term(b); - - a = erl_mk_float(3.1415); - b = erl_mk_float(0.34202); - c = erl_mk_empty_list(); - send_term(erl_format("[[~a, ~w], ~w, [~s, ~w]]", "pi", a, c, "cos(70)", b)); - erl_free_term(a); - erl_free_term(b); - erl_free_term(c); - - send_term(erl_format("[~i]", -1)); - - report(1); -} diff --git a/lib/erl_interface/test/erl_global_SUITE_data/erl_global_test.c b/lib/erl_interface/test/erl_global_SUITE_data/erl_global_test.c deleted file mode 100644 index 0f08727225..0000000000 --- a/lib/erl_interface/test/erl_global_SUITE_data/erl_global_test.c +++ /dev/null @@ -1,264 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2000-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * Purpose: Tests the functions in erl_global.c. - * - * See the erl_global_SUITE.erl file for a "table of contents". - */ - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> - -#include "runner.h" - -static void cmd_erl_connect(ETERM* args); -static void cmd_erl_global_register(ETERM *args); -static void cmd_erl_global_whereis(ETERM *args); -static void cmd_erl_global_names(ETERM *args); -static void cmd_erl_global_unregister(ETERM *args); -static void cmd_erl_close_connection(ETERM *args); - -static void send_errno_result(int value); - -static struct { - char* name; - int num_args; /* Number of arguments. */ - void (*func)(ETERM* args); -} commands[] = { - "erl_connect", 4, cmd_erl_connect, - "erl_close_connection", 1, cmd_erl_close_connection, - "erl_global_register", 2, cmd_erl_global_register, - "erl_global_whereis", 2, cmd_erl_global_whereis, - "erl_global_names", 1, cmd_erl_global_names, - "erl_global_unregister", 2, cmd_erl_global_unregister, -}; - - -/* - * Sends a list contaning all data types to the Erlang side. - */ - -TESTCASE(interpret) -{ - ETERM* term; - - erl_init(NULL, 0); - - outer_loop: - - term = get_term(); - - if (term == NULL) { - report(1); - return; - } else { - ETERM* Func; - ETERM* Args; - int i; - - if (!ERL_IS_TUPLE(term) || ERL_TUPLE_SIZE(term) != 2) { - fail("term should be a tuple of size 2"); - } - - Func = erl_element(1, term); - if (!ERL_IS_ATOM(Func)) { - fail("function name should be an atom"); - } - Args = erl_element(2, term); - if (!ERL_IS_TUPLE(Args)) { - fail("function arguments should be a tuple"); - } - erl_free_term(term); - for (i = 0; i < sizeof(commands)/sizeof(commands[0]); i++) { - int n = strlen(commands[i].name); - if (ERL_ATOM_SIZE(Func) != n) { - continue; - } - if (memcmp(ERL_ATOM_PTR(Func), commands[i].name, n) == 0) { - erl_free_term(Func); - if (ERL_TUPLE_SIZE(Args) != commands[i].num_args) { - fail("wrong number of arguments"); - } - commands[i].func(Args); - erl_free_term(Args); - goto outer_loop; - } - } - fail("bad command"); - } -} - -#define VERIFY_TYPE(Test, Term) \ -if (!Test(Term)) { \ - fail("wrong type for " #Term); \ -} else { \ -} - -static void -cmd_erl_connect(ETERM* args) -{ - ETERM* number; - ETERM* node; - ETERM* cookie; - - int res; - char buffer[256]; - - number = ERL_TUPLE_ELEMENT(args, 0); - VERIFY_TYPE(ERL_IS_INTEGER, number); - node = ERL_TUPLE_ELEMENT(args, 1); - VERIFY_TYPE(ERL_IS_ATOM, node); - cookie = ERL_TUPLE_ELEMENT(args, 2); - VERIFY_TYPE(ERL_IS_ATOM, cookie); - - if (ERL_ATOM_SIZE(cookie) == 0) { - res = erl_connect_init(ERL_INT_VALUE(number), 0, 0); - } else { - memcpy(buffer, ERL_ATOM_PTR(cookie), ERL_ATOM_SIZE(cookie)); - buffer[ERL_ATOM_SIZE(cookie)] = '\0'; - res = erl_connect_init(ERL_INT_VALUE(number), buffer, 0); - } - - if(!res) { - send_errno_result(res); - return; - } - - memcpy(buffer, ERL_ATOM_PTR(node), ERL_ATOM_SIZE(node)); - buffer[ERL_ATOM_SIZE(node)] = '\0'; - send_errno_result(erl_connect(buffer)); -} - -static void -cmd_erl_close_connection(ETERM* args) -{ - ETERM* number; - ETERM* res; - - number = ERL_TUPLE_ELEMENT(args, 0); - VERIFY_TYPE(ERL_IS_INTEGER, number); - res = erl_mk_int(erl_close_connection(ERL_INT_VALUE(number))); - send_term(res); - erl_free_term(res); -} - -static void -cmd_erl_global_register(ETERM* args) -{ - ETERM* fd_term = ERL_TUPLE_ELEMENT(args, 0); - ETERM* name = ERL_TUPLE_ELEMENT(args, 1); - ETERM* pid = erl_mk_pid(erl_thisnodename(), 14, 0, 0); - - char buffer[256]; - - VERIFY_TYPE(ERL_IS_INTEGER, fd_term); - VERIFY_TYPE(ERL_IS_ATOM, name); - - memcpy(buffer, ERL_ATOM_PTR(name), ERL_ATOM_SIZE(name)); - buffer[ERL_ATOM_SIZE(name)] = '\0'; - - send_errno_result(erl_global_register(ERL_INT_VALUE(fd_term), buffer, pid)); - erl_free_term(pid); -} - -static void -cmd_erl_global_whereis(ETERM* args) -{ - ETERM* fd_term = ERL_TUPLE_ELEMENT(args, 0); - ETERM* name = ERL_TUPLE_ELEMENT(args, 1); - ETERM* pid = NULL; - - char buffer[256]; - - VERIFY_TYPE(ERL_IS_INTEGER, fd_term); - VERIFY_TYPE(ERL_IS_ATOM, name); - - memcpy(buffer, ERL_ATOM_PTR(name), ERL_ATOM_SIZE(name)); - buffer[ERL_ATOM_SIZE(name)] = '\0'; - - pid = erl_global_whereis(ERL_INT_VALUE(fd_term), buffer, NULL); - send_term(pid); - erl_free_term(pid); -} - -static void -cmd_erl_global_names(ETERM* args) -{ - ETERM* fd_term = ERL_TUPLE_ELEMENT(args, 0); - - ETERM* res_array[2], *res_tuple, *name; - char** names = NULL; - int count = 0, i; - - VERIFY_TYPE(ERL_IS_INTEGER, fd_term); - - names = erl_global_names(ERL_INT_VALUE(fd_term), &count); - - res_array[0] = erl_mk_empty_list(); - for(i=0; i<count; i++) { - name = erl_mk_string(names[i]); - res_array[0] = erl_cons(name, res_array[0]); - } - - free(names); - - res_array[1] = erl_mk_int(count); - res_tuple = erl_mk_tuple(res_array, 2); - - send_term(res_tuple); - - erl_free_compound(res_array[0]); - erl_free_term(res_array[1]); - erl_free_term(res_tuple); -} - -static void -cmd_erl_global_unregister(ETERM* args) -{ - ETERM* fd_term = ERL_TUPLE_ELEMENT(args, 0); - ETERM* name = ERL_TUPLE_ELEMENT(args, 1); - - char buffer[256]; - - VERIFY_TYPE(ERL_IS_INTEGER, fd_term); - VERIFY_TYPE(ERL_IS_ATOM, name); - - memcpy(buffer, ERL_ATOM_PTR(name), ERL_ATOM_SIZE(name)); - buffer[ERL_ATOM_SIZE(name)] = '\0'; - - send_errno_result(erl_global_unregister(ERL_INT_VALUE(fd_term), buffer)); -} - -static void -send_errno_result(int value) -{ - ETERM* res_array[2]; - ETERM* res_tuple; - - res_array[0] = erl_mk_int(value); - res_array[1] = erl_mk_int(erl_errno); - res_tuple = erl_mk_tuple(res_array, 2); - send_term(res_tuple); - erl_free_term(res_array[0]); - erl_free_term(res_array[1]); - erl_free_term(res_tuple); -} diff --git a/lib/erl_interface/test/erl_match_SUITE.erl b/lib/erl_interface/test/erl_match_SUITE.erl deleted file mode 100644 index bb62d6288d..0000000000 --- a/lib/erl_interface/test/erl_match_SUITE.erl +++ /dev/null @@ -1,280 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% --module(erl_match_SUITE). - --include_lib("common_test/include/ct.hrl"). --include("erl_match_SUITE_data/match_test_cases.hrl"). - --export([all/0, suite/0, - init_per_testcase/2, - atoms/1, lists/1, tuples/1, references/1, pids/1, ports/1, - bind/1, integers/1, floats/1, binaries/1, strings/1]). - -%% For interactive running of matcher. --export([start_matcher/1, erl_match/3]). - -%% This test suite tests the erl_match() function. - -suite() -> - [{ct_hooks,[ts_install_cth]}]. - -all() -> - [atoms, lists, tuples, references, pids, ports, bind, - integers, floats, binaries, strings]. - -init_per_testcase(Case, Config) -> - runner:init_per_testcase(?MODULE, Case, Config). - -atoms(Config) when is_list(Config) -> - P = start_matcher(Config), - - eq(P, '', ''), - eq(P, a, a), - ne(P, a, b), - ne(P, a, aa), - eq(P, kalle, kalle), - ne(P, kalle, arne), - - ne(P, kalle, 42), - ne(P, 42, kalle), - - runner:finish(P), - ok. - -lists(Config) when is_list(Config) -> - P = start_matcher(Config), - eq(P, [], []), - - ne(P, [], [a]), - ne(P, [a], []), - - eq(P, [a], [a]), - ne(P, [a], [b]), - - eq(P, [a|b], [a|b]), - ne(P, [a|b], [a|x]), - - eq(P, [a, b], [a, b]), - ne(P, [a, b], [a, x]), - - eq(P, [a, b, c], [a, b, c]), - ne(P, [a, b|c], [a, b|x]), - ne(P, [a, b, c], [a, b, x]), - ne(P, [a, b|c], [a, b|x]), - ne(P, [a, x|c], [a, b|c]), - ne(P, [a, b, c], [a, x, c]), - - runner:finish(P), - ok. - -tuples(Config) when is_list(Config) -> - P = start_matcher(Config), - - ne(P, {}, {a, b}), - ne(P, {a, b}, {}), - ne(P, {a}, {a, b}), - ne(P, {a, b}, {a}), - - eq(P, {}, {}), - - eq(P, {a}, {a}), - ne(P, {a}, {b}), - - eq(P, {1}, {1}), - ne(P, {1}, {2}), - - eq(P, {a, b}, {a, b}), - ne(P, {x, b}, {a, b}), - - ne(P, {error, x}, {error, y}), - ne(P, {error, {undefined, {subscriber, last}}}, - {error, {undefined, {subscriber, name}}}), - - runner:finish(P), - ok. - - -references(Config) when is_list(Config) -> - P = start_matcher(Config), - Ref1 = make_ref(), - Ref2 = make_ref(), - - eq(P, Ref1, Ref1), - eq(P, Ref2, Ref2), - ne(P, Ref1, Ref2), - ne(P, Ref2, Ref1), - - runner:finish(P), - ok. - - -pids(Config) when is_list(Config) -> - P = start_matcher(Config), - Pid1 = c:pid(0,1,2), - Pid2 = c:pid(0,1,3), - - eq(P, self(), self()), - eq(P, Pid1, Pid1), - ne(P, Pid1, self()), - ne(P, Pid2, Pid1), - - runner:finish(P), - ok. - - -ports(Config) when is_list(Config) -> - case os:type() of - vxworks -> - {skipped,"not on vxworks, pucko"}; - _ -> - P = start_matcher(Config), - P2 = start_matcher(Config), - - eq(P, P, P), - ne(P, P, P2), - - runner:finish(P), - runner:finish(P2), - ok - end. - -integers(Config) when is_list(Config) -> - P = start_matcher(Config), - I1 = 123, - I2 = 12345, - I3 = -123, - I4 = 2234, - - eq(P, I1, I1), - eq(P, I2, I2), - ne(P, I1, I2), - ne(P, I1, I3), - eq(P, I4, I4), - - runner:finish(P), - ok. - - - -floats(Config) when is_list(Config) -> - P = start_matcher(Config), - F1 = 3.1414, - F2 = 3.1415, - F3 = 3.1416, - - S1 = "string", - S2 = "string2", - - eq(P, F1, F1), - eq(P, F2, F2), - ne(P, F1, F2), - ne(P, F3, F2), - - eq(P, S2, S2), - ne(P, S1, S2), - - runner:finish(P), - ok. - - - -binaries(Config) when is_list(Config) -> - P = start_matcher(Config), - Bin1 = term_to_binary({kalle, 146015, {kungsgatan, 23}}), - Bin2 = term_to_binary(sune), - Bin3 = list_to_binary("sune"), - - eq(P, Bin1, Bin1), - eq(P, Bin2, Bin2), - eq(P, Bin3, Bin3), - ne(P, Bin1, Bin2), - ne(P, Bin1, Bin3), - ne(P, Bin2, Bin3), - - runner:finish(P), - ok. - - -strings(Config) when is_list(Config) -> - P = start_matcher(Config), - - S1 = "string", - S2 = "streng", - S3 = "String", - - eq(P, S1, S1), - ne(P, S1, S2), - ne(P, S1, S3), - - runner:finish(P), - ok. - - -bind(Config) when is_list(Config) -> - P = start_bind(Config), - S = "[X,Y,Z]", - L1 = [301,302,302], - L2 = [65,66,67], - - bind_ok(P, S, L1), - bind_ok(P, S, L2), - - runner:finish(P), - ok. - -start_bind(Config) -> - runner:start(Config, ?erl_match_bind). - -bind_ok(Port, Bind, Term) -> - true = erl_bind(Port, Bind, Term). - -%bind_nok(Port, Bind, Term) -> -% false = erl_bind(Port, Bind, Term). - -erl_bind(Port, Pattern, Term) -> - Port ! {self(), {command, [$b, Pattern, 0]}}, - runner:send_term(Port, Term), - case runner:get_term(Port) of - {term, 0} -> false; - {term, 1} -> true - end. - - - -start_matcher(Config) -> - runner:start(Config, ?erl_match_server). - -eq(Port, Pattern, Term) -> - true = erl_match(Port, Pattern, Term). - -ne(Port, Pattern, Term) -> - false = erl_match(Port, Pattern, Term). - - - -erl_match(Port, Pattern, Term) -> - runner:send_term(Port, Pattern), - runner:send_term(Port, Term), - case runner:get_term(Port) of - {term, 0} -> false; - {term, 1} -> true - end. diff --git a/lib/erl_interface/test/erl_match_SUITE_data/Makefile.first b/lib/erl_interface/test/erl_match_SUITE_data/Makefile.first deleted file mode 100644 index 459b5c14c2..0000000000 --- a/lib/erl_interface/test/erl_match_SUITE_data/Makefile.first +++ /dev/null @@ -1,22 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2000-2016. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -match_test_decl.c: match_test.c - erl -noinput -pa ../all_SUITE_data -s init_tc run match_test -s erlang halt diff --git a/lib/erl_interface/test/erl_match_SUITE_data/Makefile.src b/lib/erl_interface/test/erl_match_SUITE_data/Makefile.src deleted file mode 100644 index 156214a269..0000000000 --- a/lib/erl_interface/test/erl_match_SUITE_data/Makefile.src +++ /dev/null @@ -1,42 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2016. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -include @erl_interface_mk_include@ - -CC0 = @CC@ -CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)" -LD = @LD@ -LIBERL = @erl_interface_lib@ -LIBEI = @erl_interface_eilib@ -LIBFLAGS = ../all_SUITE_data/runner@obj@ \ - $(LIBERL) $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \ - @erl_interface_threadlib@ -CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data -MATCH_OBJS = match_test@obj@ match_test_decl@obj@ - -all: match_test@exe@ - -clean: - $(RM) $(MATCH_OBJS) - $(RM) match_test@exe@ - -match_test@exe@: $(MATCH_OBJS) $(LIBERL) $(LIBEI) - $(LD) @CROSSLDFLAGS@ -o $@ $(MATCH_OBJS) $(LIBFLAGS) - diff --git a/lib/erl_interface/test/erl_match_SUITE_data/match_test.c b/lib/erl_interface/test/erl_match_SUITE_data/match_test.c deleted file mode 100644 index d577417f5b..0000000000 --- a/lib/erl_interface/test/erl_match_SUITE_data/match_test.c +++ /dev/null @@ -1,114 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -/* - * Purpose: Tests the erl_match() function. - * Author: Bjorn Gustavsson - */ - -#include "runner.h" - -TESTCASE(erl_match_server) -{ - erl_init(NULL, 0); - - for (;;) { - ETERM* pattern; - ETERM* term; - - pattern = get_term(); - if (pattern == NULL) { - report(1); - return; - } else { - term = get_term(); - if (term == NULL) { - fail("Unexpected EOF term"); - } else { - send_term(erl_mk_int(erl_match(pattern, term))); - erl_free_term(pattern); - erl_free_term(term); - } - } - } - -} - -TESTCASE(erl_match_bind) -{ - erl_init(NULL, 0); - - for (;;) { - char* pattern; - ETERM* term; - - pattern=read_packet(NULL); - - switch (pattern[0]) { - case 'e': - free(pattern); - report(1); - return; - - case 'b': - { - ETERM* patt_term; - - /* - * Get the pattern string and convert it using erl_format(). - * - * Note that the call to get_term() below destroys the buffer - * that the pattern variable points to. Therefore, it is - * essential to call erl_format() here, before - * calling get_term(). - */ - - message("Pattern: %s", pattern+1); - patt_term = erl_format(pattern+1); - free(pattern); - - if (patt_term == NULL) { - fail("erl_format() failed"); - } - - /* - * Get the term and send back the result of the erl_match() - * call. - */ - - term = get_term(); - if (term == NULL) { - fail("Unexpected eof term"); - } - else { - send_term(erl_mk_int(erl_match(patt_term, term))); - } - erl_free_term(patt_term); - erl_free_term(term); - } - break; - - default: - free(pattern); - fail("Illegal character received"); - } - - } -} diff --git a/lib/erl_interface/test/port_call_SUITE_data/Makefile.src b/lib/erl_interface/test/port_call_SUITE_data/Makefile.src index 0f97ce9f70..0088c11a14 100644 --- a/lib/erl_interface/test/port_call_SUITE_data/Makefile.src +++ b/lib/erl_interface/test/port_call_SUITE_data/Makefile.src @@ -23,10 +23,9 @@ include @erl_interface_mk_include@ CC0 = @CC@ CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)" LD = @LD@ -LIBERL = @erl_interface_lib_drv@ LIBEI = @erl_interface_eilib_drv@ -SHLIB_EXTRA_LDLIBS = $(LIBERL) $(LIBEI) @erl_interface_threadlib@ +SHLIB_EXTRA_LDLIBS = $(LIBEI) @erl_interface_threadlib@ SHLIB_EXTRA_CFLAGS = -I@erl_interface_include@ -I../all_SUITE_data diff --git a/lib/erl_interface/test/port_call_SUITE_data/port_call_drv.c b/lib/erl_interface/test/port_call_SUITE_data/port_call_drv.c index 4617cb0316..8f7303d645 100644 --- a/lib/erl_interface/test/port_call_SUITE_data/port_call_drv.c +++ b/lib/erl_interface/test/port_call_SUITE_data/port_call_drv.c @@ -21,7 +21,7 @@ #include <stdio.h> #include <string.h> #include <stdlib.h> -#include "erl_interface.h" +#include "ei.h" #include "erl_driver.h" static ErlDrvPort my_erlang_port; diff --git a/lib/et/Makefile b/lib/et/Makefile index f0bb7be211..1b89cff83e 100644 --- a/lib/et/Makefile +++ b/lib/et/Makefile @@ -35,3 +35,6 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=runtime_tools wx + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/et/doc/src/Makefile b/lib/et/doc/src/Makefile index 93e2f8eeee..fb13e07d9e 100644 --- a/lib/et/doc/src/Makefile +++ b/lib/et/doc/src/Makefile @@ -29,87 +29,11 @@ include ../../vsn.mk VSN=$(ET_VSN) APPLICATION=et -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - include files.mk -# ---------------------------------------------------- - XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) + $(XML_PART_FILES) $(XML_CHAPTER_FILES) XML_GEN_FILES = $(GEN_XML:%=$(XMLDIR)/%) -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(GEN_XML:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%: % - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: images $(HTML_REF_MAN_FILE) - -clean clean_docs: - for file in $(XML_FILES); do \ - if [ -f $$file\src ]; then \ - rm -f $$file; \ - fi \ - done - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -man: $(MAN3_FILES) - -images: $(IMAGE_FILES:%=$(HTMLDIR)/%) - -debug opt: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: - +include $(ERL_TOP)/make/doc.mk diff --git a/lib/et/doc/src/et_collector.xml b/lib/et/doc/src/et_collector.xml index f908612797..d258be2d40 100644 --- a/lib/et/doc/src/et_collector.xml +++ b/lib/et/doc/src/et_collector.xml @@ -139,19 +139,6 @@ </desc> </func> <func> - <name since="">load_event_file(CollectorPid, FileName) -> {ok, BadBytes} | exit(Reason)</name> - <fsummary>Load the event table from a file</fsummary> - <type> - <v>CollectorPid = pid()</v> - <v>FileName = string()</v> - <v>BadBytes = integer(X) where X >= 0</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Load the event table from a file.</p> - </desc> - </func> - <func> <name since="">report(Handle, TraceOrEvent) -> {ok, Continuation} | exit(Reason)</name> <name since="">report_event(Handle, DetailLevel, FromTo, Label, Contents) -> {ok, Continuation} | exit(Reason)</name> <name since="">report_event(Handle, DetailLevel, From, To, Label, Contents) -> {ok, Continuation} | exit(Reason)</name> @@ -193,17 +180,6 @@ </desc> </func> <func> - <name since="">get_table_handle(CollectorPid) -> Handle</name> - <fsummary>Return a table handle</fsummary> - <type> - <v>CollectorPid = pid()</v> - <v>Handle = record(table_handle)</v> - </type> - <desc> - <p>Return a table handle.</p> - </desc> - </func> - <func> <name since="">get_global_pid() -> CollectorPid | exit(Reason)</name> <fsummary>Return a the identity of the globally registered collector if there is any</fsummary> <type> diff --git a/lib/et/doc/src/files.mk b/lib/et/doc/src/files.mk index c9041caa81..24815d0674 100644 --- a/lib/et/doc/src/files.mk +++ b/lib/et/doc/src/files.mk @@ -38,7 +38,6 @@ GEN_XML = \ et_desc.xml \ et_examples.xml - BOOK_FILES = book.xml IMAGE_FILES = \ @@ -53,4 +52,3 @@ IMAGE_FILES = \ sim_trans_mgr_actors.png \ sim_trans_move_actor.png \ sim_trans_write_lock.png - diff --git a/lib/et/src/et_collector.erl b/lib/et/src/et_collector.erl index 3609238509..7fa5dbda38 100644 --- a/lib/et/src/et_collector.erl +++ b/lib/et/src/et_collector.erl @@ -40,12 +40,10 @@ start_trace_client/3, start_trace_port/1, - %% load_event_file/2, save_event_file/3, clear_table/1, get_global_pid/0, - %% get_table_handle/1, get_table_size/1, change_pattern/2, make_key/2, diff --git a/lib/eunit/Makefile b/lib/eunit/Makefile index 15dae19896..d0dd447a6c 100644 --- a/lib/eunit/Makefile +++ b/lib/eunit/Makefile @@ -48,13 +48,7 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk - -.PHONY: info version - -info: - @echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)" - @echo "APP_DIR: $(APP_DIR)" - @echo "APP_TAR_FILE: $(APP_TAR_FILE)" +.PHONY: version version: @echo "$(VSN)" @@ -94,3 +88,5 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/eunit/doc/overview.edoc b/lib/eunit/doc/overview.edoc index dc9f858812..8ab89fca73 100644 --- a/lib/eunit/doc/overview.edoc +++ b/lib/eunit/doc/overview.edoc @@ -277,6 +277,9 @@ while testing, you can write to the `user' output stream, as in `io:format(user, "~w", [Term])'. The recommended way of doing this is to use the EUnit {@section Debugging macros}, which make it much simpler. +For checking the output produced by the unit under test, see +{@section Macros for checking output}. + === Writing test generating functions === A drawback of simple test functions is that you must write a separate @@ -415,6 +418,7 @@ your code is compiled with testing enabled or disabled. <li>{@section Compilation control macros}</li> <li>{@section Utility macros}</li> <li>{@section Assert macros}</li> +<li>{@section Macros for checking output}</li> <li>{@section Macros for running external commands}</li> <li>{@section Debugging macros}</li> </ul> @@ -608,6 +612,22 @@ Examples: </dd> </dl> +=== Macros for checking output === + +The following macro can be used within a test case to retreive the +output written to standard output. + +<dl> +<dt>`capturedOutput'</dt> +<dd>The output captured by EUnit in the current test case, as a string. + +Examples: + +```io:format("Hello~n"), + ?assertEqual("Hello\n", ?capturedOutput)''' +</dd> +</dl> + === Macros for running external commands === Keep in mind that external commands are highly dependent on the diff --git a/lib/eunit/doc/src/Makefile b/lib/eunit/doc/src/Makefile index 117542cb37..22f2460fe9 100644 --- a/lib/eunit/doc/src/Makefile +++ b/lib/eunit/doc/src/Makefile @@ -29,43 +29,22 @@ VSN=$(EUNIT_VSN) APPLICATION=eunit # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- -# Help application directory specification -# ---------------------------------------------------- - -EDOC_DIR = $(ERL_TOP)/lib/edoc -SYNTAX_TOOLS_DIR = $(ERL_TOP)/lib/syntax_tools - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- -EUNIT_DIR = $(ERL_TOP)/lib/eunit/src -EUNIT_INC_DIR = $(ERL_TOP)/lib/eunit/include - -EUNIT_MODULES = \ - eunit eunit_surefire XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = $(EUNIT_MODULES:=.xml) - -XML_PART_FILES = \ - part.xml +EDOC_REF3_FILES = \ + eunit.xml eunit_surefire.xml -XML_CHAPTER_FILES = \ +EDOC_CHAPTER_FILE = \ chapter.xml XML_NOTES_FILES = \ notes.xml -HTML_EXAMPLE_FILES = - -HTML_STYLESHEET_FILES = \ - ../stylesheet.css +XML_PART_FILES = \ + part.xml BOOK_FILES = book.xml @@ -73,100 +52,6 @@ XML_FILES = \ $(BOOK_FILES) $(XML_NOTES_FILES) \ $(XML_PART_FILES) $(XML_APPLICATION_FILES) -XML_GEN_FILES = $(XML_REF3_FILES:%=$(XMLDIR)/%) $(XML_CHAPTER_FILES:%=$(XMLDIR)/%) - -# ---------------------------------------------------- -INFO_FILE = ../../info - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - - -EXTRA_FILES = \ - $(DEFAULT_HTML_FILES) \ - $(DEFAULT_GIF_FILES) \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html)\ - $(XML_NOTES_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - - # ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -$(XML_REF3_FILES:%=$(XMLDIR)/%): - $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EUNIT_VSN) -i $(EUNIT_INC_DIR) -dir $(XMLDIR) $(EUNIT_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) - -$(XML_CHAPTER_FILES:%=$(XMLDIR)/%): - $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(EUNIT_VSN) -chapter -dir $(XMLDIR) ../overview.edoc - -info: - @echo "XML_PART_FILES: $(XML_PART_FILES)" - @echo "XML_APPLICATION_FILES: $(XML_APPLICATION_FILES)" - @echo "EUNIT_XML_FILES: $(EUNIT_XML_FILES)" - @echo "EUNIT_MODULES: $(EUNIT_MODULES)" - @echo "HTML_FILES: $(HTML_FILES)" - @echo "HTMLDIR: $(HTMLDIR)" - @echo "DEFAULT_GIF_FILES: $(DEFAULT_GIF_FILES)" - @echo "DEFAULT_HTML_FILES: $(DEFAULT_HTML_FILES)" - @echo "EXTRA_FILES: $(EXTRA_FILES)" - -xml: $(XML_REF3_FILES) $(XML_CHAPTER_FILES) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(XML_REF3_FILES) $(XML_CHAPTER_FILES) *.html - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/eunit/include/eunit.hrl b/lib/eunit/include/eunit.hrl index 3cc36a27bc..6842147fda 100644 --- a/lib/eunit/include/eunit.hrl +++ b/lib/eunit/include/eunit.hrl @@ -147,6 +147,16 @@ -define(_assertNotException(Class, Term, Expr), ?_test(?assertNotException(Class, Term, Expr))). +%% Macros for retrieving the output of a test case + +-ifndef(capturedOutput). +-define(capturedOutput, + case ?UNDER_EUNIT of + true -> eunit_proc:get_output(); + false -> "" + end). +-endif. + %% Macros for running operating system commands. (Note that these %% require EUnit to be present at runtime, or at least eunit_lib.) diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl index 6e702543d0..fb6619a6d4 100644 --- a/lib/eunit/src/eunit_proc.erl +++ b/lib/eunit/src/eunit_proc.erl @@ -29,7 +29,7 @@ -include("eunit.hrl"). -include("eunit_internal.hrl"). --export([start/4]). +-export([start/4, get_output/0]). %% This must be exported; see new_group_leader/1 for details. -export([group_leader_process/1]). @@ -52,6 +52,18 @@ start(Tests, Order, Super, Reference) order = Order}, spawn_group(local, #group{tests = Tests}, St). +%% Fetches the output captured by the eunit group leader. This is +%% provided to allow test cases to check the captured output. + +-spec get_output() -> string(). +get_output() -> + group_leader() ! {get_output, self()}, + receive + {output, Output} -> Output + after 100 -> + %% The group leader is not an eunit_proc + abort_task(get_output) + end. %% Status messages sent to the supervisor process. (A supervisor does %% not have to act on these messages - it can e.g. just log them, or @@ -594,6 +606,9 @@ group_leader_loop(Runner, Wait, Buf) -> receive after 2 -> ok end, process_flag(priority, low), group_leader_loop(Runner, 0, Buf); + {get_output, From} -> + From ! {output, lists:flatten(lists:reverse(Buf))}, + group_leader_loop(Runner, Wait, Buf); _ -> %% discard any other messages group_leader_loop(Runner, Wait, Buf) @@ -669,4 +684,9 @@ io_error_test_() -> [?_assertMatch({error, enotsup}, io:getopts()), ?_assertMatch({error, enotsup}, io:columns()), ?_assertMatch({error, enotsup}, io:rows())]. + +get_output_test() -> + io:format("Hello"), + Output = get_output(), + ?assertEqual("Hello", Output). -endif. diff --git a/lib/eunit/src/eunit_tests.erl b/lib/eunit/src/eunit_tests.erl index 07a415eeb1..f43f4cca09 100644 --- a/lib/eunit/src/eunit_tests.erl +++ b/lib/eunit/src/eunit_tests.erl @@ -45,3 +45,10 @@ if_test_() -> matches_test_() -> [?_assert(?MATCHES("hel"++_, "hello")), ?_assertNot(?MATCHES("hal"++_, "hello"))]. + +get_output_test() -> + io:format(<<"Hello ~p!~n">>, [eunit]), + ?assertEqual("Hello eunit!\n", ?capturedOutput), + io:format("System working?~n~s~n", ["Seems to be."]), + ?assertEqual("Hello eunit!\nSystem working?\nSeems to be.\n", + ?capturedOutput). diff --git a/lib/ftp/Makefile b/lib/ftp/Makefile index e0c9de42e4..a26d1de0a0 100644 --- a/lib/ftp/Makefile +++ b/lib/ftp/Makefile @@ -32,47 +32,11 @@ VSN = $(FTP_VSN) SPECIAL_TARGETS = -DIA_PLT = ./priv/plt/$(APPLICATION).plt -DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis - - # ---------------------------------------------------- # Default Subdir Targets # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk -.PHONY: info gclean dialyzer dialyzer_plt dclean - -info: - @echo "OS: $(OS)" - @echo "DOCB: $(DOCB)" - @echo "" - @echo "FTP_VSN: $(FTP_VSN)" - @echo "APP_VSN: $(APP_VSN)" - @echo "" - @echo "DIA_PLT: $(DIA_PLT)" - @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)" - @echo "" - -gclean: - git clean -fXd - -dclean: - rm -f $(DIA_PLT) - rm -f $(DIA_ANALYSIS) - -dialyzer_plt: $(DIA_PLT) - -$(DIA_PLT): - @echo "Building $(APPLICATION) plt file" - @dialyzer --build_plt \ - --output_plt $@ \ - -r ../$(APPLICATION)/ebin \ - --output $(DIA_ANALYSIS) \ - --verbose +DIA_PLT_APPS = runtime_tools ssl -dialyzer: $(DIA_PLT) - @echo "Running dialyzer on $(APPLICATION)" - @dialyzer --plt $< \ - ../$(APPLICATION)/ebin \ - --verbose +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/ftp/doc/src/Makefile b/lib/ftp/doc/src/Makefile index 20fbbc73a9..fc95e83ae8 100644 --- a/lib/ftp/doc/src/Makefile +++ b/lib/ftp/doc/src/Makefile @@ -26,12 +26,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # ---------------------------------------------------- include ../../vsn.mk VSN=$(FTP_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - +APPLICATION=ftp # ---------------------------------------------------- # Target Specs @@ -59,97 +54,6 @@ XML_FILES = \ $(XML_REF3_FILES) \ $(XML_APPLICATION_FILES) -# GIF_FILES = ftp.gif - - -# ---------------------------------------------------- - -HTML_FILES = \ - $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info -EXTRA_FILES = \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -ldocs: local_docs - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -clean clean_docs: clean_html clean_man clean_pdf - rm -rf $(XMLDIR) - rm -f errs core *~ - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -clean_pdf: - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - -clean_html: - rm -rf $(TOP_HTML_FILES) $(HTMLDIR)/* - -clean_man: - rm -f $(MAN3_FILES) - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: +# IMAGE_FILES = ftp.gif -info: - @echo "GIF_FILES:\n$(GIF_FILES)" - @echo "" - @echo "EXTRA_FILES:\n$(EXTRA_FILES)" - @echo "" - @echo "HTML_FILES:\n$(HTML_FILES)" - @echo "" - @echo "TOP_HTML_FILES:\n$(TOP_HTML_FILES)" - @echo "" - @echo "XML_REF3_FILES:\n$(XML_REF3_FILES)" - @echo "" - @echo "XML_REF6_FILES:\n$(XML_REF6_FILES)" - @echo "" - @echo "XML_CHAPTER_FILES:\n$(XML_CHAPTER_FILES)" - @echo "" +include $(ERL_TOP)/make/doc.mk diff --git a/lib/ftp/doc/src/ftp.xml b/lib/ftp/doc/src/ftp.xml index 9645b03364..5a1f289b57 100644 --- a/lib/ftp/doc/src/ftp.xml +++ b/lib/ftp/doc/src/ftp.xml @@ -58,7 +58,7 @@ binaries (see <c>recv_bin/2</c>) and for sending binaries to be stored as remote files (see <c>send_bin/3</c>).</p> - <p>A set of functions is provvided for sending and receiving + <p>A set of functions is provided for sending and receiving contiguous parts of a file to be stored in a remote file. For send, see <c>send_chunk_start/2</c>, <c>send_chunk/2</c>, and <c>send_chunk_end/1</c>. For receive, see diff --git a/lib/ftp/test/Makefile b/lib/ftp/test/Makefile index 147f8e5dd6..41f23ac7ba 100644 --- a/lib/ftp/test/Makefile +++ b/lib/ftp/test/Makefile @@ -115,7 +115,7 @@ SOURCE = $(ERL_FILES) $(HRL_FILES) TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) -FTP_SPECS = ftp.spec ftp_bench.spec +FTP_SPECS = ftp.spec COVER_FILE = ftp.cover FTP_FILES = ftp.config $(FTP_SPECS) diff --git a/lib/ftp/test/ftp_bench.spec b/lib/ftp/test/ftp_bench.spec deleted file mode 100644 index 4d1ecf8891..0000000000 --- a/lib/ftp/test/ftp_bench.spec +++ /dev/null @@ -1 +0,0 @@ -{suites,"../ftp_test",[]}. diff --git a/lib/hipe/Makefile b/lib/hipe/Makefile index 0676484fca..4998522943 100644 --- a/lib/hipe/Makefile +++ b/lib/hipe/Makefile @@ -75,3 +75,6 @@ distclean: realclean: $(V_at)$(MAKE) MAKETARGET="realclean" all-subdirs all-subdirs-x +DIA_PLT_APPS=compiler syntax_tools + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/hipe/cerl/cerl_closurean.erl b/lib/hipe/cerl/cerl_closurean.erl index a2bd7fe0f0..583c5d624a 100644 --- a/lib/hipe/cerl/cerl_closurean.erl +++ b/lib/hipe/cerl/cerl_closurean.erl @@ -797,7 +797,8 @@ take_work({Queue0, Set0}) -> -spec is_escape_op(atom(), arity()) -> boolean(). -is_escape_op(match_fail, 1) -> false; +is_escape_op(match_fail, 1) -> false; +is_escape_op(recv_wait_timeout, 1) -> false; is_escape_op(F, A) when is_atom(F), is_integer(A) -> true. -spec is_escape_op(atom(), atom(), arity()) -> boolean(). @@ -814,6 +815,7 @@ is_escape_op(M, F, A) when is_atom(M), is_atom(F), is_integer(A) -> true. -spec is_literal_op(atom(), arity()) -> boolean(). +is_literal_op(recv_wait_timeout, 1) -> true; is_literal_op(match_fail, 1) -> true; is_literal_op(F, A) when is_atom(F), is_integer(A) -> false. diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 0b6db544ca..bac489c07c 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -115,6 +115,7 @@ t_map_is_key/3, t_map_entries/2, t_map_put/3, + t_map_remove/3, t_map_update/3, t_map_pairwise_merge/4 ]). @@ -1700,6 +1701,11 @@ type(maps, put, 3, Xs, Opaques) -> fun ([Key, Value, Map]) -> t_map_put({Key, Value}, Map, Opaques) end, Opaques); +type(maps, remove, 2, Xs, Opaques) -> + strict(maps, remove, 2, Xs, + fun ([Key, Map]) -> + t_map_remove(Key, Map, Opaques) + end, Opaques); type(maps, size, 1, Xs, Opaques) -> strict(maps, size, 1, Xs, fun ([Map]) -> @@ -2648,6 +2654,8 @@ arg_types(maps, merge, 2) -> [t_map(), t_map()]; arg_types(maps, put, 3) -> [t_any(), t_any(), t_map()]; +arg_types(maps, remove, 2) -> + [t_any(), t_map()]; arg_types(maps, size, 1) -> [t_map()]; arg_types(maps, update, 3) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index badf58936f..5f5612fcd3 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -154,6 +154,7 @@ t_map_update/2, t_map_update/3, t_map_pairwise_merge/4, t_map_put/2, t_map_put/3, + t_map_remove/3, t_matchstate/0, t_matchstate/2, t_matchstate_present/1, @@ -1925,6 +1926,27 @@ map_put({Key, Value}, ?map(Pairs,DefK,DefV), Opaques) -> end end. +-spec t_map_remove(erl_type(), erl_type(), opaques()) -> erl_type(). + +t_map_remove(Key, Map, Opaques) -> + do_opaque(Map, Opaques, fun(UM) -> map_remove(Key, UM) end). + +map_remove(_, ?none) -> ?none; +map_remove(_, ?unit) -> ?none; +map_remove(Key, Map) -> + %% ?map(lists:keydelete(Key, 1, Pairs), DefK, DefV). + case is_singleton_type(Key) of + false -> Map; + true -> + ?map(Pairs,DefK,DefV) = Map, + case lists:keyfind(Key, 1, Pairs) of + false -> Map; + {Key, _, _} -> + Pairs1 = lists:keydelete(Key, 1, Pairs), + t_map(Pairs1, DefK, DefV) + end + end. + -spec t_map_update({erl_type(), erl_type()}, erl_type()) -> erl_type(). t_map_update(KV, Map) -> diff --git a/lib/hipe/doc/src/Makefile b/lib/hipe/doc/src/Makefile index 104c15f2bb..e517e90fd0 100644 --- a/lib/hipe/doc/src/Makefile +++ b/lib/hipe/doc/src/Makefile @@ -28,11 +28,6 @@ VSN=$(HIPE_VSN) APPLICATION=hipe # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -47,73 +42,4 @@ XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) -GIF_FILES = - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info -EXTRA_FILES = \ - $(DEFAULT_GIF_FILES) \ - $(DEFAULT_HTML_FILES) \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -distclean: clean -realclean: clean - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index efdaeecca3..97d50eb472 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -689,8 +689,8 @@ trans_fun([{call_fun,N}|Instructions], Env) -> Dst = [mk_var({r,0})], [hipe_icode:mk_comment('call_fun'), hipe_icode:mk_primop(Dst,call_fun,Args) | trans_fun(Instructions,Env)]; -%%--- patched_make_fun --- make_fun/make_fun2 after fixes -trans_fun([{patched_make_fun,MFA,Magic,FreeVarNum,Index}|Instructions], Env) -> +%%--- make_fun2 --- +trans_fun([{make_fun2,MFA,Index,Magic,FreeVarNum}|Instructions], Env) -> Args = extract_fun_args(FreeVarNum), Dst = [mk_var({r,0})], Fun = hipe_icode:mk_primop(Dst, @@ -1204,6 +1204,17 @@ trans_fun([{bs_get_position=Name,_,_,_}|_Instructions], _Env) -> trans_fun([{bs_set_position=Name,_,_}|_Instructions], _Env) -> nyi(Name); %%-------------------------------------------------------------------- +%% New instructions added in OTP 23. +%%-------------------------------------------------------------------- +%%--- swap --- +trans_fun([{swap,Reg1,Reg2}|Instructions], Env) -> + Var1 = mk_var(Reg1), + Var2 = mk_var(Reg2), + Temp = mk_var(new), + [hipe_icode:mk_move(Temp, Var1), + hipe_icode:mk_move(Var1, Var2), + hipe_icode:mk_move(Var2, Temp) | trans_fun(Instructions, Env)]; +%%-------------------------------------------------------------------- %%--- ERROR HANDLING --- %%-------------------------------------------------------------------- trans_fun([X|_], _) -> @@ -1946,7 +1957,7 @@ mod_find_closure_info([FunCode|Fs], CI) -> mod_find_closure_info([], CI) -> CI. -find_closure_info([{patched_make_fun,MFA={_M,_F,A},_Magic,FreeVarNum,_Index}|BeamCode], +find_closure_info([{make_fun2,{_M,_F,A}=MFA,_Index,_Magic,FreeVarNum}|BeamCode], ClosureInfo) -> NewClosure = %% A-FreeVarNum+1 (The real arity + 1 for the closure) #closure_info{mfa=MFA, arity=A-FreeVarNum+1, fv_arity=FreeVarNum}, @@ -2024,41 +2035,8 @@ split_params(N, [ArgN|OrgArgs], Args) -> %%----------------------------------------------------------------------- preprocess_code(ModuleCode) -> - PatchedCode = patch_R7_funs(ModuleCode), - ClosureInfo = find_closure_info(PatchedCode), - {PatchedCode, ClosureInfo}. - -%%----------------------------------------------------------------------- -%% Patches the "make_fun" BEAM instructions of R7 so that they also -%% contain the index that the BEAM loader generates for funs. -%% -%% The index starts from 0 and is incremented by 1 for each make_fun -%% instruction encountered. -%% -%% Retained only for compatibility with BEAM code prior to R8. -%% -%% Temporarily, it also rewrites R8-PRE-RELEASE "make_fun2" -%% instructions, since their embedded indices don't work. -%%----------------------------------------------------------------------- - -patch_R7_funs(ModuleCode) -> - patch_make_funs(ModuleCode, 0). - -patch_make_funs([FunCode0|Fs], FunIndex0) -> - {PatchedFunCode,FunIndex} = patch_make_funs(FunCode0, FunIndex0, []), - [PatchedFunCode|patch_make_funs(Fs, FunIndex)]; -patch_make_funs([], _) -> []. - -patch_make_funs([{make_fun,MFA,Magic,FreeVarNum}|Is], FunIndex, Acc) -> - Patched = {patched_make_fun,MFA,Magic,FreeVarNum,FunIndex}, - patch_make_funs(Is, FunIndex+1, [Patched|Acc]); -patch_make_funs([{make_fun2,MFA,_BogusIndex,Magic,FreeVarNum}|Is], FunIndex, Acc) -> - Patched = {patched_make_fun,MFA,Magic,FreeVarNum,FunIndex}, - patch_make_funs(Is, FunIndex+1, [Patched|Acc]); -patch_make_funs([I|Is], FunIndex, Acc) -> - patch_make_funs(Is, FunIndex, [I|Acc]); -patch_make_funs([], FunIndex, Acc) -> - {lists:reverse(Acc),FunIndex}. + ClosureInfo = find_closure_info(ModuleCode), + {ModuleCode, ClosureInfo}. %%----------------------------------------------------------------------- @@ -2358,9 +2336,8 @@ catch_handler('catch', [TagVar,ValueVar,TraceVar], OldCatchLbl) -> ValueVar]), hipe_icode:mk_goto(Cont), ErrorLbl, - %% We use the trace variable to hold the symbolic trace. Its previous - %% value is just that in p->ftrace, so get_stacktrace() works fine. - hipe_icode:mk_call([TraceVar],erlang,get_stacktrace,[],remote), + %% We use the trace variable to hold the symbolic trace. + hipe_icode:mk_primop([TraceVar],build_stacktrace,[TraceVar]), hipe_icode:mk_primop([ValueVar],mktuple, [ValueVar, TraceVar]), hipe_icode:mk_goto(hipe_icode:label_name(ExitLbl)), OldCatchLbl, % normal execution paths must go through end_try diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl index 63b34f23a4..2941cf15fc 100644 --- a/lib/hipe/icode/hipe_icode_primops.erl +++ b/lib/hipe/icode/hipe_icode_primops.erl @@ -436,14 +436,8 @@ type(Primop, Args) -> #element{} -> erl_bif_types:type(erlang, element, 2, Args); #unsafe_element{index = N} -> - [Type] = Args, - case erl_types:t_is_tuple(Type) of - false -> - erl_types:t_none(); - true -> - Index = erl_types:t_from_term(N), - erl_bif_types:type(erlang, element, 2, [Index|Args]) - end; + Index = erl_types:t_from_term(N), + erl_bif_types:type(erlang, element, 2, [Index | Args]); #unsafe_update_element{index = N} -> %% Same, same erl_bif_types:type(erlang, setelement, 3, [erl_types:t_integer(N)|Args]); diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl index 430e097b91..c6bec39632 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl @@ -8,6 +8,9 @@ -export([test/0]). +% Ensure type optimization is turned off for id/1 +-export([id/1]). + test() -> ok = test_ets_bifs(), ok = test_szar_bug(), @@ -19,6 +22,7 @@ test() -> ok = test_switch_neg_int(), ok = test_icode_range_anal(), ok = test_icode_range_call(), + ok = test_icode_type_miscompile(), ok. %%----------------------------------------------------------------------- @@ -503,3 +507,25 @@ range_client(Server, N) -> receive proceed -> ok end, range_client(Server, N - 1), % non-tailrecursive call with ignored result ok. + +test_icode_type_miscompile() -> + List0 = id([{1,1},{1,1}]), + + %% The expressions below produce a list that the SSA type pass knows is + %% a list of two-tuples, but hipe_icode_type does not. + %% + %% Changing the `F(X)` call to just `X` helps the icode type pass figure + %% things out, making the bug disappear. + F = fun({_, _}=X) -> X end, + List = [F(X) || {_,_}=X <- List0], + + type_miscompile(List, List, []). + +type_miscompile([{Same, Same} | As], [{Same, Same} | Bs], Acc) -> + type_miscompile(As, Bs, [gaffel | Acc]); +type_miscompile([], [], Acc) -> + %% Acc is non-empty when everything works as expected. + true = Acc =/= [], + ok. + +id(I) -> I. diff --git a/lib/inets/Makefile b/lib/inets/Makefile index 872df9d055..a7723dc0d8 100644 --- a/lib/inets/Makefile +++ b/lib/inets/Makefile @@ -32,47 +32,11 @@ VSN = $(INETS_VSN) SPECIAL_TARGETS = -DIA_PLT = ./priv/plt/$(APPLICATION).plt -DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis - - # ---------------------------------------------------- # Default Subdir Targets # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk -.PHONY: info gclean dialyzer dialyzer_plt dclean - -info: - @echo "OS: $(OS)" - @echo "DOCB: $(DOCB)" - @echo "" - @echo "INETS_VSN: $(INETS_VSN)" - @echo "APP_VSN: $(APP_VSN)" - @echo "" - @echo "DIA_PLT: $(DIA_PLT)" - @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)" - @echo "" - -gclean: - git clean -fXd - -dclean: - rm -f $(DIA_PLT) - rm -f $(DIA_ANALYSIS) - -dialyzer_plt: $(DIA_PLT) - -$(DIA_PLT): - @echo "Building $(APPLICATION) plt file" - @dialyzer --build_plt \ - --output_plt $@ \ - -r ../$(APPLICATION)/ebin \ - --output $(DIA_ANALYSIS) \ - --verbose +DIA_PLT_APPS=runtime_tools ftp mnesia ssl tftp -dialyzer: $(DIA_PLT) - @echo "Running dialyzer on $(APPLICATION)" - @dialyzer --plt $< \ - ../$(APPLICATION)/ebin \ - --verbose +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/inets/doc/src/Makefile b/lib/inets/doc/src/Makefile index cbc0e384d8..a4405c5728 100644 --- a/lib/inets/doc/src/Makefile +++ b/lib/inets/doc/src/Makefile @@ -26,12 +26,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # ---------------------------------------------------- include ../../vsn.mk VSN=$(INETS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - +APPLICATION=inets # ---------------------------------------------------- # Target Specs @@ -71,97 +66,8 @@ XML_FILES = \ $(XML_REF3_FILES) \ $(XML_APPLICATION_FILES) -# GIF_FILES = inets.gif - - -# ---------------------------------------------------- - -HTML_FILES = \ - $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info -EXTRA_FILES = \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -ldocs: local_docs - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -clean clean_docs: clean_html clean_man clean_pdf - rm -rf $(XMLDIR) - rm -f errs core *~ - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) +NO_CHUNKS = httpd_custom_api.xml -debug opt: - -clean_pdf: - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - -clean_html: - rm -rf $(TOP_HTML_FILES) $(HTMLDIR)/* - -clean_man: - rm -f $(MAN3_FILES) - - -# ---------------------------------------------------- -# Release Target # ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: -info: - @echo "GIF_FILES:\n$(GIF_FILES)" - @echo "" - @echo "EXTRA_FILES:\n$(EXTRA_FILES)" - @echo "" - @echo "HTML_FILES:\n$(HTML_FILES)" - @echo "" - @echo "TOP_HTML_FILES:\n$(TOP_HTML_FILES)" - @echo "" - @echo "XML_REF3_FILES:\n$(XML_REF3_FILES)" - @echo "" - @echo "XML_REF6_FILES:\n$(XML_REF6_FILES)" - @echo "" - @echo "XML_CHAPTER_FILES:\n$(XML_CHAPTER_FILES)" - @echo "" +include $(ERL_TOP)/make/doc.mk diff --git a/lib/inets/doc/src/http_server.xml b/lib/inets/doc/src/http_server.xml index 65b3dcde95..865abc6f5f 100644 --- a/lib/inets/doc/src/http_server.xml +++ b/lib/inets/doc/src/http_server.xml @@ -49,9 +49,7 @@ </list> <p>The configuration of the server is provided as an Erlang - property list. For backwards compatibility, a configuration - file using apache-style configuration directives is - supported.</p> + property list.</p> <p>As of <c>Inets</c> 5.0 the HTTP server is an easy to start/stop and customize web server providing the most basic @@ -77,16 +75,13 @@ <p>The server is configured using an Erlang property list. For the available properties, see <seealso marker="httpd">httpd(3)</seealso>. - For backwards compatibility, apache-like configuration files - are also supported. </p> <p>The available configuration properties are as follows:</p> <code type="none"> httpd_service() -> {httpd, httpd()} httpd() -> [httpd_config()] - httpd_config() -> {file, file()} | - {proplist_file, file()} + httpd_config() -> {proplist_file, file()} {debug, debug()} | {accept_timeout, integer()} debug() -> disable | [debug_options()] @@ -95,13 +90,11 @@ {disable, modules()} modules() -> [atom()]</code> <p>Here:</p> - <taglist> - <tag><c>{file, file()}</c></tag> - <item><p>If you use an old apace-like configuration file.</p></item> + <taglist> <tag><c>{proplist_file, file()}</c></tag> <item><p>File containing an Erlang property - list, followed by a full stop, describing the HTTP server - configuration.</p></item> + list, followed by a full stop, describing the HTTP server + configuration.</p></item> <tag><c>{debug, debug()}</c></tag> <item><p>Can enable trace on all functions or only exported functions on chosen modules.</p></item> @@ -171,162 +164,9 @@ </section> <section> - <title>Htaccess - User Configurable Authentication</title> - <marker id="htaccess"></marker> - <p>Web server users without server administrative privileges - that need to manage authentication of web pages that are local - to their user can use the per-directory runtime configurable - user-authentication scheme <c>htaccess</c>. - It works as follows:</p> - <list type="bulleted"> - <item>Each directory in the path to the requested asset is - searched for an access file (default is <c>.htaccess</c>), which - restricts the web servers rights to respond to a request. - If an access file is found, the rules in that file is applied to the - request.</item> - <item>The rules in an access file apply to files in the same - directory and in subdirectories. If there exists more than one - access file in the path to an asset, the rules in the - access file nearest the requested asset is applied.</item> - <item>To change the rules that restrict the use of - an asset, the user only needs write access - to the directory where the asset is.</item> - <item>All access files in the path to a requested asset are read - once per request. This means that the load on the server - increases when <c>htaccess</c> is used.</item> - <item>If a directory is limited both by authentication directives - in the HTTP server configuration file and by the <c>htaccess</c> - files, the user must be allowed to get access to the file by both - methods for the request to succeed.</item> - </list> - - <section> - <title>Access Files Directives</title> - <p>In every directory under <c>DocumentRoot</c> or under an - <c>Alias</c> a user can place an access file. An access file - is a plain text file that specifies the restrictions to - consider before the web server answers to a - request. If there are more than one access file in the path - to the requested asset, the directives in the access file in - the directory nearest the asset is used.</p> - <taglist> - <tag><em>"allow"</em></tag> - <item> - <p><em>Syntax:</em> <c>Allow</c> from subnet <c>subnet | from all</c></p> - <p><em>Default:</em> <c>from all</c></p> - <p>Same as directive <c>allow</c> for the server configuration file.</p> - </item> - <tag><em>"AllowOverRide"</em></tag> - <item> - <p><em>Syntax:</em> <c>AllowOverRide</c> <c>all | none | Directives</c></p> - <p><em>Default:</em> <c>none</c></p> - <p><c>AllowOverRide</c> specifies the parameters that - access files in subdirectories are not allowed to alter the value - for. If the parameter is set to <c>none</c>, no further - access files is parsed. - </p> - <p>If only one access file exists, setting this parameter to - <c>none</c> can ease the burden on the server as the server - then stops looking for access files.</p> - </item> - <tag><em>"AuthGroupfile"</em></tag> - <item> - <p><em>Syntax:</em> <c>AuthGroupFile</c> Filename</p> - <p><em>Default:</em> <c>none</c></p> - <p><c>AuthGroupFile</c> indicates which file that contains the list - of groups. The filename must contain the absolute path to the - file. The format of the file is one group per row and - every row contains the name of the group and the members - of the group, separated by a space, for example:</p> - <pre> -GroupName: Member1 Member2 .... MemberN</pre> - </item> - <tag><em>"AuthName"</em></tag> - <item> - <p><em>Syntax:</em> <c>AuthName</c> auth-domain</p> - <p><em>Default:</em> <c>none</c></p> - <p>Same as directive <c>AuthName</c> for the server - configuration file.</p> - </item> - <tag><em>"AuthType"</em></tag> - <item> - <p><em>Syntax:</em> <c>AuthType</c> <c>Basic</c></p> - <p><em>Default:</em> <c>Basic</c></p> - <p><c>AuthType</c> specifies which authentication scheme to - be used. Only Basic Authenticating using UUEncoding of - the password and user ID is implemented.</p> - </item> - <tag><em>"AuthUserFile"</em></tag> - <item> - <p><em>Syntax:</em> <c>AuthUserFile</c> Filename</p> - <p><em>Default:</em><c>none</c></p> - <p><c>AuthUserFile</c> indicates which file that contains the list - of users. The filename must contain the absolute path to the - file. The username and password are not encrypted so do not - place the file with users in a directory that is accessible - through the web server. The format of the file is one user per row. - Every row contains <c>UserName</c> and <c>Password</c> separated - by a colon, for example:</p> - <pre> -UserName:Password -UserName:Password</pre> - </item> - <tag><em>"deny"</em></tag> - <item> - <p><em>Syntax:</em> <c>deny</c> from subnet <c>subnet | from all</c></p> - <p><em>Context:</em> Limit</p> - <p>Same as directive <c>deny</c> for the server configuration file.</p> - </item> - <tag><em>"Limit"</em></tag> - <item> - <p><em>Syntax:</em> <c><![CDATA[<Limit]]></c> RequestMethods<c>></c></p> - <p><em>Default:</em> <c>none</c></p> - <p><c><![CDATA[<Limit>]]></c> and <c></Limit></c> are used to enclose - a group of directives applying only to requests using - the specified methods. If no request method is specified, - all request methods are verified against the restrictions.</p> - <p>Example:</p> - <pre> -<Limit POST GET HEAD> - order allow deny - require group group1 - allow from 123.145.244.5 -</Limit></pre> - </item> - <tag><em>"order"</em></tag> - <item> - <p><em>Syntax:</em> <c>order</c> <c>allow deny | deny allow</c></p> - <p><em>Default:</em> <c>allow deny</c></p> - <p><c>order</c> defines if the deny or allow control is to - be performed first.</p> - <p>If the order is set to <c>allow deny</c>, the users - network address is first controlled to be in the allow subset. - If the user network address is not in the allowed subset, the user - is denied to get the asset. If the network address is in the - allowed subset, a second control is performed. That is, - the user network address is not in the subset of network - addresses to be denied as specified by parameter <c>deny</c>.</p> - <p>If the order is set to <c>deny allow</c>, only users from networks - specified to be in the allowed subset succeeds to request - assets in the limited area.</p> - </item> - <tag><em>"require"</em></tag> - <item> - <p><em>Syntax:</em> <c>require</c> - <c>group group1 group2... | user user1 user2...</c></p> - <p><em>Default:</em> <c>none</c></p> - <p><em>Context:</em> Limit</p> - <p>For more information, see directive <c>require</c> in - <seealso marker="mod_auth">mod_auth(3)</seealso>.</p> - </item> - </taglist> - </section> - </section> - - <section> - <title>Dynamic Web Pages</title> - <marker id="dynamic_we_pages"></marker> - <p><c>Inets</c> HTTP server provides two ways of creating dynamic web + <title>Dynamic Web Pages</title> + <marker id="dynamic_we_pages"></marker> + <p><c>Inets</c> HTTP server provides two ways of creating dynamic web pages, each with its own advantages and disadvantages:</p> <taglist> <tag><em>CGI scripts</em></tag> @@ -393,36 +233,6 @@ http://your.server.org/***/Module[:/]Function(?QueryString|/PathInfo)</code> see <seealso marker="mod_esi">mod_esi(3)</seealso>.</p> </section> - <section> - <title>EVAL Scheme</title> - <p>The eval scheme is straight-forward and does not mimic the - behavior of plain CGI. An URL that calls an Erlang <c>eval</c> - function has the following syntax:</p> - <code type="none"> -http://your.server.org/***/Mod:Func(Arg1,...,ArgN)</code> - <p>*** depends on how the ErlScriptAlias config - directive has been used.</p> - <p>The module <c>Mod</c> referred to must be found in the code - path and data returned by the function <c>Func</c> is passed - back to the client. Data returned from the - function must take the form as specified in - the CGI specification. For implementation details of the ESI - callback function, - see <seealso marker="mod_esi">mod_esi(3)</seealso>.</p> - <note> - <p>The eval scheme can seriously threaten the - integrity of the Erlang node housing a web server, for - example:</p> - <code type="none"> -http://your.server.org/eval?httpd_example:print(atom_to_list(apply(erlang,halt,[])))</code> - <p>This effectively closes down the Erlang node. - Therefore, use the erl scheme instead, until this - security breach is fixed.</p> - <p>Today there are no good ways of solving this problem - and therefore the eval scheme can be removed in future - release of <c>Inets</c>.</p> - </note> - </section> </section> </section> @@ -718,23 +528,7 @@ start() -> <item><c>real_name</c> - from <seealso marker="mod_alias">mod_alias</seealso></item> </list> </section> - - <section> - <title>mod_htaccess - User Configurable Access</title> - <p>This module provides per-directory user configurable access - control.</p> - <p>Uses the following Erlang Web Server API interaction data: - </p> - <list type="bulleted"> - <item><c>real_name</c> - from <seealso marker="mod_alias">mod_alias</seealso></item> - </list> - <p>Exports the following Erlang Web Server API interaction data: - </p> - <taglist> - <tag><c>{remote_user_name, User}</c></tag> - <item>The username used for authentication.</item> - </taglist> - </section> + <section> <title>mod_log - Logging Using Text Files.</title> diff --git a/lib/inets/doc/src/http_uri.xml b/lib/inets/doc/src/http_uri.xml index 6d3547f4fe..7fc524ff7f 100644 --- a/lib/inets/doc/src/http_uri.xml +++ b/lib/inets/doc/src/http_uri.xml @@ -31,12 +31,13 @@ </header> <module since="OTP R15B01">http_uri</module> - <modulesummary>URI utility module</modulesummary> + <modulesummary>Old URI utility module, use uri_string instead</modulesummary> <description> - <p>This module provides utility functions for working with URIs, - according to - <url href="http://www.ietf.org/rfc/rfc3986.txt">RFC 3986</url>.</p> + <p>This module is deprecated since OTP 23. + Use the module <seealso marker="stdlib:uri_string">uri_string</seealso> to properly handle URIs, + this is the recommend module since OTP 21. + </p> </description> <section> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 987f0c3cf4..19dd0c0abf 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -68,15 +68,13 @@ <marker id="props_file"></marker> <p><em>File Properties</em></p> - <p>When the web server is started - at application start time, the properties are to be fetched from a - configuration file that can consist of a regular Erlang property - list, that is, <c>[{Option, Value}]</c>, where <c> Option = property() - </c> and <c>Value = term()</c>, followed by a full stop, or for - backwards compatibility, an Apache-like configuration file. If the - web server is started dynamically at runtime, - a file can still be specified but also the complete property - list.</p> + <p>When the web server is started at application start time, the + properties are to be fetched from a configuration file that can + consist of a regular Erlang property list, that is, <c>[{Option, + Value}]</c>, where <c> Option = property() </c> and <c>Value = + term()</c>, followed by a full stop. If the web server is started + dynamically at runtime, a file can still be specified but also the + complete property list.</p> <taglist> <tag><marker id="prop_proplist_file"></marker>{proplist_file, path()}</tag> @@ -87,34 +85,9 @@ properties.</p> </item> - <tag><marker id="prop_file"></marker>{file, path()}</tag> - <item> - <p>If this property is defined, <c>Inets</c> expects to find all - other properties defined in this file, which uses Apache-like - syntax. The file must include all properties listed - under mandatory properties. The Apache-like syntax is the property, - written as one word where each new word begins with a capital, - followed by a white-space, followed by the value, followed by a - new line.</p> - <p>Example:</p> - <code> -{server_root, "/urs/local/www"} -> ServerRoot /usr/local/www</code> - - <p>A few exceptions are documented - for each property that behaves differently, - and the special cases <c>{directory, {path(), PropertyList}}</c> - and <c>{security_directory, {Dir, PropertyList}}</c>, are represented - as:</p> - <pre> - <![CDATA[ -<Directory Dir> - <Properties handled as described above> -</Directory> - ]]></pre> - </item> </taglist> <note> - <p>The properties <c>proplist_file</c> and <c>file</c> are mutually exclusive. Also newer properties may not be supported as Apache-like options, this is a legacy feature.</p> + <p>Note support for legacy configuration file with Apache syntax is dropped in OTP-23.</p> </note> <marker id="props_mand"></marker> @@ -152,8 +125,7 @@ <taglist> <tag><marker id="prop_bind_address"></marker>{bind_address, ip_address() | hostname() | any}</tag> <item> - <p>Default is <c>any</c>. <c>any</c> is denoted <em>*</em> - in the Apache-like configuration file.</p> + <p>Default is <c>any</c></p> </item> <tag><marker id="profile"></marker>{profile, atom()}</tag> @@ -303,7 +275,7 @@ 1590. File suffixes are mapped to MIME types before file delivery. The mapping between file suffixes and MIME types can be specified as an Apache-like file or directly in the property list. Such - a file can look like the follwoing:</p> + a file can look like the follwoing:</p> <pre> # MIME type Extension text/html html htm @@ -519,19 +491,8 @@ Transport: TLS <code>{re_write, {"^/[~]([^/]+)(.*)$", "/home/\\1/public\\2"}}</code> <p>Access to http://your.server.org/~bob/foo.gif would refer to - the file /home/bob/public/foo.gif. - - In an Apache-like configuration file, <c>Re</c> is separated - from <c>Replacement</c> with one single space, and as expected - backslashes do not need to be backslash escaped, the - same example would become:</p> + the file /home/bob/public/foo.gif. </p> - <code>ReWrite ^/[~]([^/]+)(.*)$ /home/\1/public\2</code> - - <p>Beware of trailing space in <c>Replacement</c> to be used. - If you must have a space in <c>Re</c>, use, for example, the character - encoding <c>\040</c>, see - <seealso marker="stdlib:re">re(3)</seealso>.</p> </item> <tag><marker id="prop_dir_idx"></marker>{directory_index, [string()]}</tag> @@ -663,16 +624,8 @@ Transport: TLS <c>mod_esi:deliver/2</c>. Default is <c>15</c>. This is only relevant for scripts that use the erl scheme.</p> </item> - - <tag><marker id="prop_esi_timeout"></marker>{eval_script_alias, {URLPath, [AllowedModule]}}</tag> - <item> - <p><c>URLPath = string()</c> and <c>AllowedModule = atom()</c>. - Same as <c>erl_script_alias</c> but for scripts - using the eval scheme. This is only supported - for backwards compatibility. The eval scheme is deprecated.</p> - </item> </taglist> - + <marker id="props_log"></marker> <p><em>Log Properties - Requires mod_log</em></p> <taglist> @@ -799,9 +752,7 @@ Transport: TLS <p>Sets the type of authentication database that is used for the directory. The key difference between the different methods is that dynamic data can be saved when Mnesia and Dets - are used. - This property is called <c>AuthDbType</c> in the Apache-like - configuration files.</p> + are used.</p> </item> <tag><marker id="prop_auth_user_file"></marker>{auth_user_file, path()}</tag> @@ -881,20 +832,6 @@ Transport: TLS </taglist> - <marker id="props_htaccess"></marker> - <p><em>Htaccess Authentication Properties - Requires mod_htaccess</em></p> - <taglist> - <tag><marker id="prop_access_files"></marker>{access_files, [path()]}</tag> - <item> - <p>Specifies the filenames that are used for - access files. When a request comes, every directory in the path - to the requested asset are searched after files with the - names specified by this parameter. If such a file is found, the - file is parsed and the restrictions specified in it are - applied to the request.</p> - </item> - </taglist> - <marker id="props_sec"></marker> <p><em>Security Properties - Requires mod_security</em></p> @@ -1179,30 +1116,7 @@ Transport: TLS closing the connection.</p> </desc> </func> - - <func> - <name since="">Module:load(Line, AccIn)-> eof | ok | {ok, AccOut} | {ok, AccOut, {Option, Value}} | {ok, AccOut, [{Option, Value}]} | {error, Reason}</name> - <fsummary>Converts a line in an Apache-like config - file to an <c>{Option, Value}</c> tuple.</fsummary> - <type> - <v>Line = string()</v> - <v>AccIn = [{Option, Value}]</v> - <v>AccOut = [{Option, Value}]</v> - <v>Option = property()</v> - <v>Value = term() </v> - <v>Reason = term()</v> - </type> - <desc> - <p>Converts a line in an Apache-like - configuration file to an <c>{Option, Value}</c> tuple. Some - more complex configuration options, such as <c>directory</c> - and <c>security_directory</c>, create an - accumulator. This function only needs clauses for the - options implemented by this particular callback module. - </p> - </desc> - </func> - + <func> <name since="">Module:remove(ConfigDB) -> ok | {error, Reason} </name> <fsummary>Callback function that is called when the web server is closed.</fsummary> diff --git a/lib/inets/doc/src/httpd_util.xml b/lib/inets/doc/src/httpd_util.xml index e0f947f860..cd22b89314 100644 --- a/lib/inets/doc/src/httpd_util.xml +++ b/lib/inets/doc/src/httpd_util.xml @@ -171,9 +171,7 @@ <desc> <p><c>lookup_mime</c> returns the MIME type associated with a specific file suffix as specified in the file <c>mime.types</c> - (located in the - <path unix="$SERVER_ROOT/conf/mime.types" windows="%SERVER_ROOT%\conf\mime.types"> - config directory</path>).</p> + (located in the config directory).</p> </desc> </func> @@ -191,9 +189,7 @@ <desc> <p><c>lookup_mime_default</c> returns the MIME type associated with a specific file suffix as specified in the - <c>mime.types</c> file (located in the - <path unix="$SERVER_ROOT/conf/mime.types" windows="%SERVER_ROOT%\conf\mime.types"> - config directory</path>). + <c>mime.types</c> file (located in the config directory). If no appropriate association is found, the value of <c>DefaultType</c> is returned.</p> </desc> diff --git a/lib/inets/doc/src/introduction.xml b/lib/inets/doc/src/introduction.xml index faf911f188..a5037b02dd 100644 --- a/lib/inets/doc/src/introduction.xml +++ b/lib/inets/doc/src/introduction.xml @@ -37,7 +37,7 @@ <p><c>Inets</c> is a container for Internet clients and servers including the following:</p> <list type="bulleted"> - <item>An <term id="HTTP"></term> client and server</item> + <item>An HTTP client and server</item> </list> <p>The HTTP client and server are HTTP 1.1 compliant as defined in diff --git a/lib/inets/doc/src/part.xml b/lib/inets/doc/src/part.xml index b9c8ed674c..eca680cdb6 100644 --- a/lib/inets/doc/src/part.xml +++ b/lib/inets/doc/src/part.xml @@ -33,7 +33,7 @@ <p>The <c>Inets</c> application provides a set of Internet-related services as follows:</p> <list type="bulleted"> - <item>An <term id="HTTP"></term> client and server</item> + <item>An HTTP client and server</item> </list> <p>The HTTP client and server are HTTP 1.1 compliant as defined in diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index b1c5cf13bb..3f91ae062c 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1637,7 +1637,7 @@ host_header(#http_request_h{host = Host}, _) -> %% Handles headers_as_is host_header(_, URI) -> - {ok, {_, _, Host, _, _, _}} = http_uri:parse(URI), + #{host := Host} = uri_string:parse(URI), Host. tls_upgrade(#state{status = diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index 0dc0483fa9..ba561100a1 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -472,10 +472,10 @@ handle_call(which_cookies, _, #state{cookie_db = CookieDb} = State) -> handle_call({which_cookies, Url, Options}, _, #state{cookie_db = CookieDb} = State) -> ?hcrv("which cookies", [{url, Url}, {options, Options}]), - case uri_parse(Url, Options) of - {ok, {Scheme, _, Host, Port, Path, _}} -> + case uri_parse(Url) of + {ok, {Scheme, Host, Port, Path}} -> CookieHeaders = - httpc_cookie:header(CookieDb, Scheme, {Host, Port}, Path), + httpc_cookie:header(CookieDb, erlang:list_to_existing_atom(Scheme), {Host, Port}, Path), {reply, CookieHeaders, State}; {error, _} = ERROR -> {reply, ERROR, State} @@ -948,14 +948,31 @@ make_db_name(ProfileName, Post) -> %%-------------------------------------------------------------------------- %% These functions is just simple wrappers to parse specifically HTTP URIs %%-------------------------------------------------------------------------- +uri_parse(URI) -> + case uri_string:parse(uri_string:normalize(URI)) of + #{scheme := Scheme, + host := Host, + port := Port, + path := Path} -> + {ok, {Scheme, Host, Port, Path}}; + #{scheme := Scheme, + host := Host, + path := Path} -> + {ok, {Scheme, Host, scheme_default_port(Scheme), Path}}; + Other -> + {error, maybe_error(Other)} + end. -scheme_defaults() -> - [{http, 80}, {https, 443}]. - -uri_parse(URI, Opts) -> - http_uri:parse(URI, [{scheme_defaults, scheme_defaults()} | Opts]). - +maybe_error({error, Atom, Term}) -> + {Atom, Term}; +maybe_error(Other) -> + {unexpected, Other}. +scheme_default_port("http") -> + 80; +scheme_default_port("https") -> + 443. + %%-------------------------------------------------------------------------- diff --git a/lib/inets/src/http_lib/http_uri.erl b/lib/inets/src/http_lib/http_uri.erl index 6805b0293d..8b3eaf1930 100644 --- a/lib/inets/src/http_lib/http_uri.erl +++ b/lib/inets/src/http_lib/http_uri.erl @@ -61,6 +61,14 @@ scheme_defaults/0, encode/1, decode/1]). + +-deprecated({parse, 1, "use uri_string functions instead"}). +-deprecated({parse, 2, "use uri_string functions instead"}). +-deprecated({encode, 1, "use uri_string functions instead"}). +-deprecated({decode, 1, "use uri_string functions instead"}). +-deprecated({scheme_defaults, 0, "use uri_string functions instead"}). + + -export_type([uri/0, user_info/0, scheme/0, default_scheme_port_number/0, diff --git a/lib/inets/src/http_server/Makefile b/lib/inets/src/http_server/Makefile index 9848fd4b35..da9549406f 100644 --- a/lib/inets/src/http_server/Makefile +++ b/lib/inets/src/http_server/Makefile @@ -74,14 +74,12 @@ MODULES = \ mod_auth_dets \ mod_auth_mnesia \ mod_auth_server \ - mod_browser \ mod_cgi \ mod_dir \ mod_disk_log \ mod_esi \ mod_get \ mod_head \ - mod_htaccess \ mod_log \ mod_range \ mod_responsecontrol \ diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl index f4b53ce129..ae35f109ed 100644 --- a/lib/inets/src/http_server/httpd.erl +++ b/lib/inets/src/http_server/httpd.erl @@ -41,16 +41,19 @@ reload_config/2, info/1, info/2, - info/3 + info/3, + info/4 ]). +-deprecated({parse_query, 1, + "use uri_string:dissect_query/1 instead"}). + %%%======================================================================== %%% API %%%======================================================================== parse_query(String) -> - SplitString = re:split(String,"[&;]", [{return, list}]), - foreach(SplitString). + uri_string:dissect_query(String). reload_config(Config = [Value| _], Mode) when is_tuple(Value) -> do_reload_config(Config, Mode); @@ -58,15 +61,7 @@ reload_config(ConfigFile, Mode) -> try file:consult(ConfigFile) of {ok, [PropList]} -> %% Erlang terms format - do_reload_config(PropList, Mode); - {error, _ } -> - %% Apache format - case httpd_conf:load(ConfigFile) of - {ok, ConfigList} -> - do_reload_config(ConfigList, Mode); - Error -> - Error - end + do_reload_config(PropList, Mode) catch exit:_ -> throw({error, {could_not_consult_proplist_file, ConfigFile}}) @@ -260,18 +255,6 @@ unblock(Addr, Port, Profile) when is_integer(Port) -> {error,not_started} end. -foreach([]) -> - []; -foreach([KeyValue|Rest]) -> - Plus2Space = re:replace(KeyValue,"[\+]"," ", [{return,list}, global]), - case re:split(Plus2Space,"=", [{return, list}]) of - [Key|Value] -> - [{http_uri:decode(Key), - http_uri:decode(lists:flatten(Value))}|foreach(Rest)]; - _ -> - foreach(Rest) - end. - make_name(Addr, Port, Profile) -> httpd_util:make_name("httpd", Addr, Port, Profile). diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index d42fc7c607..e85455178a 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -21,321 +21,35 @@ -module(httpd_conf). %% Application internal API --export([load/1, load/2, load_mime_types/1, store/1, store/2, +-export([load_mime_types/1, store/1, store/2, remove/1, remove_all/1, get_config/3, get_config/4, lookup_socket_type/1, lookup/2, lookup/3, lookup/4, validate_properties/1, white_space_clean/1]). -%% Deprecated --export([is_directory/1, is_file/1, make_integer/1, clean/1, - custom_clean/3, check_enum/2]). - --deprecated({is_directory, 1, next_major_release}). --deprecated({is_file, 1, next_major_release}). --deprecated({make_integer, 1, next_major_release}). --deprecated({clean, 1, next_major_release}). --deprecated({custom_clean, 3, next_major_release}). --deprecated({check_enum, 2, next_major_release}). - -define(VMODULE,"CONF"). -include("httpd_internal.hrl"). -include("httpd.hrl"). -include_lib("inets/src/http_lib/http_internal.hrl"). +%% Removed functions + +-removed([{check_enum,2,"use lists:member/2 instead"}, + {clean,1,"use sting:strip/1 instead or possibly the re module"}, + {custom_clean,3,"use sting:strip/1 instead or possibly the re module"}, + {is_directory,1,"use filelib:is_dir/1 instead"}, + {is_file,1,"use filelib:is_file/1 instead"}, + {make_integer,1,"use erlang:list_to_integer/1 instead"}]). + %%%========================================================================= %%% Application internal API %%%========================================================================= -%% The configuration data is handled in three (3) phases: -%% 1. Parse the config file and put all directives into a key-vale -%% tuple list (load/1). -%% 2. Traverse the key-value tuple list store it into an ETS table. +%% The configuration data is handled in three (2) phases: +%% 1. Traverse the key-value tuple list store it into an ETS table. %% Directives depending on other directives are taken care of here %% (store/1). %% 3. Traverse the ETS table and do a complete clean-up (remove/1). -%% Phase 1: Load -load(ConfigFile) -> - case read_config_file(ConfigFile) of - {ok, Config} -> - case bootstrap(Config) of - {error, Reason} -> - {error, Reason}; - {ok, Modules} -> - load_config(Config, lists:append(Modules, [?MODULE])) - end; - {error, Reason} -> - {error, ?NICE("Error while reading config file: "++Reason)} - end. - -load(eof, []) -> - eof; - -load("MaxHeaderSize " ++ MaxHeaderSize, []) -> - case make_integer(MaxHeaderSize) of - {ok, Integer} -> - {ok, [], {max_header_size,Integer}}; - {error, _} -> - {error, ?NICE(string:strip(MaxHeaderSize)++ - " is an invalid number of MaxHeaderSize")} - end; - -load("MaxURISize " ++ MaxHeaderSize, []) -> - case make_integer(MaxHeaderSize) of - {ok, Integer} -> - {ok, [], {max_uri_size, Integer}}; - {error, _} -> - {error, ?NICE(string:strip(MaxHeaderSize)++ - " is an invalid number of MaxHeaderSize")} - end; - -load("MaxContentLength " ++ Max, []) -> - case make_integer(Max) of - {ok, Integer} -> - {ok, [], {max_content_length, Integer}}; - {error, _} -> - {error, ?NICE(string:strip(Max) ++ - " is an invalid number of MaxContentLength")} - end; - -load("ServerName " ++ ServerName, []) -> - {ok,[], {server_name, string:strip(ServerName)}}; - -load("ServerTokens " ++ ServerTokens, []) -> - %% These are the valid *plain* server tokens: - %% none, prod, major, minor, minimum, os, full - %% It can also be a "private" server token: private:<any string> - case string:tokens(ServerTokens, [$:]) of - ["private", Private] -> - {ok,[], {server_tokens, string:strip(Private)}}; - [TokStr] -> - Tok = list_to_atom(string:strip(TokStr)), - case lists:member(Tok, [none, prod, major, minor, minimum, os, full]) of - true -> - {ok,[], {server_tokens, Tok}}; - false -> - {error, ?NICE(string:strip(ServerTokens) ++ - " is an invalid ServerTokens")} - end; - _ -> - {error, ?NICE(string:strip(ServerTokens) ++ " is an invalid ServerTokens")} - end; - -load("SocketType " ++ SocketType, []) -> - %% ssl is the same as HTTP_DEFAULT_SSL_KIND - %% essl is the pure Erlang-based ssl (the "new" ssl) - case check_enum(string:strip(SocketType), ["ssl", "essl", "ip_comm"]) of - {ok, ValidSocketType} -> - {ok, [], {socket_type, ValidSocketType}}; - {error,_} -> - {error, ?NICE(string:strip(SocketType) ++ " is an invalid SocketType")} - end; - -load("Port " ++ Port, []) -> - case make_integer(Port) of - {ok, Integer} -> - {ok, [], {port, Integer}}; - {error, _} -> - {error, ?NICE(string:strip(Port)++" is an invalid Port")} - end; - -load("BindAddress " ++ Address0, []) -> - %% If an ipv6 address is provided in URL-syntax strip the - %% url specific part e.i. "[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]" - %% -> "FEDC:BA98:7654:3210:FEDC:BA98:7654:3210" - - try - begin - {Address, IpFamily} = - case string:tokens(Address0, [$|]) of - [Address1] -> - {clean_address(Address1), inet}; - [Address1, IpFamilyStr] -> - {clean_address(Address1), make_ipfamily(IpFamilyStr)}; - _Bad -> - throw({error, {bad_bind_address, Address0}}) - end, - - case Address of - "*" -> - {ok, [], [{bind_address, any}, {ipfamily, IpFamily}]}; - _ -> - case httpd_util:ip_address(Address, IpFamily) of - {ok, IPAddr} -> - Entries = [{bind_address, IPAddr}, - {ipfamily, IpFamily}], - {ok, [], Entries}; - {error, _} -> - {error, ?NICE(Address ++ " is an invalid address")} - end - end - end - catch - throw:{error, {bad_bind_address, _}} -> - {error, ?NICE(Address0 ++ " is an invalid address")}; - throw:{error, {bad_ipfamily, _}} -> - {error, ?NICE(Address0 ++ " has an invalid ipfamily")} - end; - -load("KeepAlive " ++ OnorOff, []) -> - case list_to_atom(string:strip(OnorOff)) of - off -> - {ok, [], {keep_alive, false}}; - _ -> - {ok, [], {keep_alive, true}} - end; - -load("MaxKeepAliveRequests " ++ MaxRequests, []) -> - case make_integer(MaxRequests) of - {ok, Integer} -> - {ok, [], {max_keep_alive_request, Integer}}; - {error, _} -> - {error, ?NICE(string:strip(MaxRequests) ++ - " is an invalid MaxKeepAliveRequests")} - end; - -%% This clause is kept for backwards compatibility -load("MaxKeepAliveRequest " ++ MaxRequests, []) -> - case make_integer(MaxRequests) of - {ok, Integer} -> - {ok, [], {max_keep_alive_request, Integer}}; - {error, _} -> - {error, ?NICE(string:strip(MaxRequests) ++ - " is an invalid MaxKeepAliveRequest")} - end; - -load("KeepAliveTimeout " ++ Timeout, []) -> - case make_integer(Timeout) of - {ok, Integer} -> - {ok, [], {keep_alive_timeout, Integer}}; - {error, _} -> - {error, ?NICE(string:strip(Timeout)++" is an invalid KeepAliveTimeout")} - end; - -load("Modules " ++ Modules, []) -> - ModuleList = re:split(Modules," ", [{return, list}]), - {ok, [], {modules,[list_to_atom(X) || X <- ModuleList]}}; - -load("ServerAdmin " ++ ServerAdmin, []) -> - {ok, [], {server_admin,string:strip(ServerAdmin)}}; - -load("ServerRoot " ++ ServerRoot, []) -> - case is_directory(string:strip(ServerRoot)) of - {ok, Directory} -> - {ok, [], [{server_root,string:strip(Directory,right,$/)}]}; - {error, _} -> - {error, ?NICE(string:strip(ServerRoot)++" is an invalid ServerRoot")} - end; - -load("MimeTypes " ++ MimeTypes, []) -> - case load_mime_types(white_space_clean(MimeTypes)) of - {ok, MimeTypesList} -> - {ok, [], [{mime_types, MimeTypesList}]}; - {error, Reason} -> - {error, Reason} - end; - -load("MaxClients " ++ MaxClients, []) -> - case make_integer(MaxClients) of - {ok, Integer} -> - {ok, [], {max_clients,Integer}}; - {error, _} -> - {error, ?NICE(string:strip(MaxClients) ++ - " is an invalid number of MaxClients")} - end; -load("DocumentRoot " ++ DocumentRoot,[]) -> - case is_directory(string:strip(DocumentRoot)) of - {ok, Directory} -> - {ok, [], {document_root,string:strip(Directory,right,$/)}}; - {error, _} -> - {error, ?NICE(string:strip(DocumentRoot)++" is an invalid DocumentRoot")} - end; -load("DefaultType " ++ DefaultType, []) -> - {ok, [], {default_type,string:strip(DefaultType)}}; -load("SSLCertificateFile " ++ SSLCertificateFile, []) -> - case is_file(string:strip(SSLCertificateFile)) of - {ok, File} -> - {ok, [], {ssl_certificate_file,File}}; - {error, _} -> - {error, ?NICE(string:strip(SSLCertificateFile)++ - " is an invalid SSLCertificateFile")} - end; -load("SSLLogLevel " ++ SSLLogAlert, []) -> - case SSLLogAlert of - "none" -> - {ok, [], {ssl_log_alert, false}}; - _ -> - {ok, [], {ssl_log_alert, true}} - end; -load("SSLCertificateKeyFile " ++ SSLCertificateKeyFile, []) -> - case is_file(string:strip(SSLCertificateKeyFile)) of - {ok, File} -> - {ok, [], {ssl_certificate_key_file,File}}; - {error, _} -> - {error, ?NICE(string:strip(SSLCertificateKeyFile)++ - " is an invalid SSLCertificateKeyFile")} - end; -load("SSLVerifyClient " ++ SSLVerifyClient, []) -> - case make_integer(string:strip(SSLVerifyClient)) of - {ok, Integer} when (Integer >=0) andalso (Integer =< 2) -> - {ok, [], {ssl_verify_client,Integer}}; - {ok, _Integer} -> - {error,?NICE(string:strip(SSLVerifyClient) ++ - " is an invalid SSLVerifyClient")}; - {error, nomatch} -> - {error,?NICE(string:strip(SSLVerifyClient) ++ - " is an invalid SSLVerifyClient")} - end; -load("SSLVerifyDepth " ++ SSLVerifyDepth, []) -> - case make_integer(string:strip(SSLVerifyDepth)) of - {ok, Integer} when Integer > 0 -> - {ok, [], {ssl_verify_client_depth,Integer}}; - {ok, _Integer} -> - {error,?NICE(string:strip(SSLVerifyDepth) ++ - " is an invalid SSLVerifyDepth")}; - {error, nomatch} -> - {error,?NICE(string:strip(SSLVerifyDepth) ++ - " is an invalid SSLVerifyDepth")} - end; -load("SSLCiphers " ++ SSLCiphers, []) -> - {ok, [], {ssl_ciphers, string:strip(SSLCiphers)}}; -load("SSLCACertificateFile " ++ SSLCACertificateFile, []) -> - case is_file(string:strip(SSLCACertificateFile)) of - {ok, File} -> - {ok, [], {ssl_ca_certificate_file,File}}; - {error, _} -> - {error, ?NICE(string:strip(SSLCACertificateFile)++ - " is an invalid SSLCACertificateFile")} - end; -load("SSLPasswordCallbackModule " ++ SSLPasswordCallbackModule, []) -> - {ok, [], {ssl_password_callback_module, - list_to_atom(string:strip(SSLPasswordCallbackModule))}}; -load("SSLPasswordCallbackFunction " ++ SSLPasswordCallbackFunction, []) -> - {ok, [], {ssl_password_callback_function, - list_to_atom(string:strip(SSLPasswordCallbackFunction))}}; -load("SSLPasswordCallbackArguments " ++ SSLPasswordCallbackArguments, []) -> - {ok, [], {ssl_password_callback_arguments, - SSLPasswordCallbackArguments}}; -load("DisableChunkedTransferEncodingSend " ++ TrueOrFalse, []) -> - case list_to_atom(string:strip(TrueOrFalse)) of - true -> - {ok, [], {disable_chunked_transfer_encoding_send, true}}; - _ -> - {ok, [], {disable_chunked_transfer_encoding_send, false}} - end; -load("LogFormat " ++ LogFormat, []) -> - {ok,[],{log_format, list_to_atom(string:strip(LogFormat))}}; -load("ErrorLogFormat " ++ LogFormat, []) -> - {ok,[],{error_log_format, list_to_atom(string:strip(LogFormat))}}. - - -clean_address(Addr) -> - string:strip(string:strip(string:strip(Addr), left, $[), right, $]). - - -make_ipfamily(IpFamilyStr) -> - validate_ipfamily(list_to_atom(IpFamilyStr)). - validate_ipfamily(inet) -> inet; validate_ipfamily(inet6) -> @@ -861,139 +575,9 @@ ssl_config(ConfigDB) -> ssl_ca_certificate_file(ConfigDB) ++ ssl_log_level(ConfigDB). - - %%%======================================================================== %%% Internal functions %%%======================================================================== -%%% Phase 1 Load: -bootstrap([]) -> - {ok, ?DEFAULT_MODS}; -bootstrap([Line|Config]) -> - case Line of - "Modules " ++ Modules -> - ModuleList = re:split(Modules," ", [{return, list}]), - TheMods = [list_to_atom(X) || X <- ModuleList], - case verify_modules(TheMods) of - ok -> - {ok, TheMods}; - {error, Reason} -> - {error, Reason} - end; - _ -> - bootstrap(Config) - end. - -load_config(Config, Modules) -> - %% Create default contexts for all modules - Contexts = lists:duplicate(length(Modules), []), - load_config(Config, Modules, Contexts, []). - -load_config([], _Modules, _Contexts, ConfigList) -> - {ok, ConfigList}; - -load_config([Line|Config], Modules, Contexts, ConfigList) -> - case load_traverse(Line, Contexts, Modules, [], ConfigList, no) of - {ok, NewContexts, NewConfigList} -> - load_config(Config, Modules, NewContexts, NewConfigList); - {error, Reason} -> - {error, Reason} - end. - - -%% This loads the config file into each module specified by Modules -%% Each module has its own context that is passed to and (optionally) -%% returned by the modules load function. The module can also return -%% a ConfigEntry, which will be added to the global configuration -%% list. -%% All configuration directives are guaranteed to be passed to all -%% modules. Each module only implements the function clauses of -%% the load function for the configuration directives it supports, -%% it's ok if an apply returns {'EXIT', {function_clause, ..}}. -load_traverse(Line, [], [], _NewContexts, _ConfigList, no) -> - {error, ?NICE("Configuration directive not recognized: "++Line)}; -load_traverse(_Line, [], [], NewContexts, ConfigList, yes) -> - {ok, lists:reverse(NewContexts), ConfigList}; -load_traverse(Line, [Context|Contexts], [Module|Modules], NewContexts, - ConfigList, State) -> - case catch apply(Module, load, [Line, Context]) of - {'EXIT', {function_clause, _FC}} -> - load_traverse(Line, Contexts, Modules, - [Context|NewContexts], ConfigList, State); - - {'EXIT', {undef, _}} -> - load_traverse(Line, Contexts, Modules, - [Context|NewContexts], ConfigList, yes); - - {'EXIT', Reason} -> - error_logger:error_report({'EXIT', Reason}), - load_traverse(Line, Contexts, Modules, - [Context|NewContexts], ConfigList, State); - - ok -> - load_traverse(Line, Contexts, Modules, - [Context|NewContexts], ConfigList, yes); - - {ok, NewContext} -> - load_traverse(Line, Contexts, Modules, - [NewContext|NewContexts], ConfigList, yes); - - {ok, NewContext, ConfigEntry} when is_tuple(ConfigEntry) -> - load_traverse(Line, Contexts, - Modules, [NewContext|NewContexts], - [ConfigEntry|ConfigList], yes); - - {ok, NewContext, ConfigEntry} when is_list(ConfigEntry) -> - load_traverse(Line, Contexts, Modules, [NewContext|NewContexts], - lists:append(ConfigEntry, ConfigList), yes); - - {error, Reason} -> - {error, Reason} - end. - -%% Verifies that all specified modules are available. -verify_modules([]) -> - ok; -verify_modules([Mod|Rest]) -> - case code:which(Mod) of - non_existing -> - {error, ?NICE(string:strip(atom_to_list(Mod), right, $\n) ++" does not exist")}; - _Path -> - verify_modules(Rest) - end. - -%% Reads the entire configuration file and returns list of strings or -%% and error. -read_config_file(FileName) -> - case file:open(FileName, [read]) of - {ok, Stream} -> - read_config_file(Stream, []); - {error, _Reason} -> - {error, ?NICE("Cannot open "++FileName)} - end. -read_config_file(Stream, SoFar) -> - case io:get_line(Stream, []) of - eof -> - file:close(Stream), - {ok, lists:reverse(SoFar)}; - {error, Reason} -> - file:close(Stream), - {error, Reason}; - [$#|_Rest] -> - %% Ignore commented lines for efficiency later .. - read_config_file(Stream, SoFar); - Line -> - NewLine = re:replace(white_space_clean(Line), - "[\t\r\f ]"," ", [{return,list}, global]), - case NewLine of - [] -> - %% Also ignore empty lines .. - read_config_file(Stream, SoFar); - _Other -> - read_config_file(Stream, [NewLine|SoFar]) - end - end. - parse_mime_types(Stream,MimeTypesList) -> Line= case io:get_line(Stream,'') of @@ -1191,63 +775,7 @@ validate_logger([{error, Domain}]) when is_atom(Domain) -> validate_logger(List) -> throw({logger, List}). -%%%========================================================================= -%%% Deprecated remove in 19 -%%%========================================================================= -is_directory(Directory) -> - case file:read_file_info(Directory) of - {ok,FileInfo} -> - #file_info{type = Type, access = Access} = FileInfo, - is_directory(Type,Access,FileInfo,Directory); - {error,Reason} -> - {error,Reason} - end. -is_directory(directory,read,_FileInfo,Directory) -> - {ok,Directory}; -is_directory(directory,read_write,_FileInfo,Directory) -> - {ok,Directory}; -is_directory(_Type,_Access,FileInfo,_Directory) -> - {error,FileInfo}. - -is_file(File) -> - case file:read_file_info(File) of - {ok,FileInfo} -> - #file_info{type = Type, access = Access} = FileInfo, - is_file(Type,Access,FileInfo,File); - {error,Reason} -> - {error,Reason} - end. -is_file(regular,read,_FileInfo,File) -> - {ok,File}; -is_file(regular,read_write,_FileInfo,File) -> - {ok,File}; -is_file(_Type,_Access,FileInfo,_File) -> - {error,FileInfo}. - -make_integer(String) -> - case re:run(string:strip(String),"[0-9]+", [{capture, none}]) of - match -> - {ok, list_to_integer(string:strip(String))}; - nomatch -> - {error, nomatch} - end. - -clean(String) -> - re:replace(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$","", - [{return,list}, global]). - -custom_clean(String,MoreBefore,MoreAfter) -> - re:replace(String, - "^[ \t\n\r\f"++MoreBefore++ - "]*|[ \t\n\r\f"++MoreAfter++"]*\$","", - [{return,list}, global]). -check_enum(_Enum,[]) -> - {error, not_valid}; -check_enum(Enum,[Enum|_Rest]) -> - {ok, list_to_atom(Enum)}; -check_enum(Enum, [_NotValid|Rest]) -> - check_enum(Enum, Rest). diff --git a/lib/inets/src/http_server/httpd_example.erl b/lib/inets/src/http_server/httpd_example.erl index 3c25ca336f..78b781aa96 100644 --- a/lib/inets/src/http_server/httpd_example.erl +++ b/lib/inets/src/http_server/httpd_example.erl @@ -19,13 +19,27 @@ %% %% -module(httpd_example). --export([print/1]). --export([get/2, put/2, post/2, yahoo/2, test1/2, get_bin/2, peer/2,new_status_and_location/2]). --export([newformat/3, post_chunked/3, post_204/3, ignore_invalid_header/3]). -%% These are used by the inets test-suite --export([delay/1, chunk_timeout/3, get_chunks/3]). +-export([print/3, + get/3, + put/3, + post/3, + yahoo/3, + test1/3, + get_bin/3, + peer/3, + new_status_and_location/3, + newformat/3, + post_chunked/3, + post_204/3, + ignore_invalid_header/3, + delay/3, + chunk_timeout/3, + get_chunks/3]). +%% ------------------------------------------------------ +print(SessionID, _Env, Input) -> + mod_esi:deliver(SessionID, print(Input)). print(String) -> [header(), @@ -33,7 +47,11 @@ print(String) -> String++"\n", footer()]. -test1(Env, []) -> +%% ------------------------------------------------------ +test1(SessionID, Env, _Input) -> + mod_esi:deliver(SessionID, test1(Env)). + +test1(Env) -> io:format("Env:~p~n",[Env]), ["<html>", "<head>", @@ -44,9 +62,10 @@ test1(Env, []) -> "<h2>Stuff</h2>", "</body>", "</html>"]. - - -get(_Env,[]) -> +%% ------------------------------------------------------ +get(SessionID, Env, Input) -> + mod_esi:deliver(SessionID, do_get(Env, Input)). +do_get(_Env,[]) -> [header(), top("GET Example"), "<FORM ACTION=\"/cgi-bin/erl/httpd_example:get\" METHOD=GET> @@ -55,24 +74,35 @@ get(_Env,[]) -> <INPUT TYPE=\"submit\"><BR> </FORM>" ++ "\n", footer()]; - -get(Env,Input) -> +do_get(Env,Input) -> default(Env,Input). +%% ------------------------------------------------------ +put(SessionID, Env, Input) -> + mod_esi:deliver(SessionID, do_put(Env, Input)). -put(Env,{Input,_Body}) -> +do_put(Env,{Input,_Body}) -> default(Env,Input); -put(Env,Input) -> +do_put(Env,Input) -> default(Env,Input). +%% ------------------------------------------------------ +get_bin(SessionID, Env, Input) -> + Header = header(), + IoData = get_bin(Env, Input), + Size = erlang:iolist_size(IoData), + mod_esi:deliver(SessionID, ["Content-Length:" ++ erlang:integer_to_list(Size) ++ "\r\n", + Header, IoData]). get_bin(_Env,_Input) -> - [list_to_binary(header()), - list_to_binary(top("GET Example")), + [list_to_binary(top("GET Example")), list_to_binary("<FORM ACTION=\"/cgi-bin/erl/httpd_example:get\" METHOD=GET> <B>Input:</B> <INPUT TYPE=\"text\" NAME=\"input1\"> <INPUT TYPE=\"text\" NAME=\"input2\"> <INPUT TYPE=\"submit\"><BR> </FORM>" ++ "\n"), list_to_binary(footer())]. +%% ------------------------------------------------------ +post(SessionID, Env, Input) -> + mod_esi:deliver(SessionID, post(Env, Input)). post(_Env,[]) -> [header(), @@ -86,21 +116,22 @@ post(_Env,[]) -> post(Env,Input) -> default(Env,Input). +%% ------------------------------------------------------ +yahoo(SessionID, Env, Input) -> + mod_esi:deliver(SessionID, yahoo(Env, Input)). yahoo(_Env,_Input) -> "Location: http://www.yahoo.com\r\n\r\n". +%% ------------------------------------------------------ +new_status_and_location(SessionID, Env, Input) -> + mod_esi:deliver(SessionID, new_status_and_location(Env, Input)). new_status_and_location(_Env,_Input) -> "status:201 Created\r\n Location: http://www.yahoo.com\r\n\r\n". +%% ------------------------------------------------------ -default(Env,Input) -> - [header(), - top("Default Example"), - "<B>Environment:</B> ",io_lib:format("~p",[Env]),"<BR>\n", - "<B>Input:</B> ",Input,"<BR>\n", - "<B>Parsed Input:</B> ", - io_lib:format("~p",[httpd:parse_query(Input)]),"\n", - footer()]. +peer(SessionID, Env, Input) -> + mod_esi:deliver(SessionID, peer(Env, Input)). peer(Env, _Input) -> Header = @@ -116,23 +147,7 @@ peer(Env, _Input) -> io_lib:format("~p",[proplists:get_value(peer_cert, Env)]),"\n", footer()]. -header() -> - header("text/html"). -header(MimeType) -> - "Content-type: " ++ MimeType ++ "\r\n\r\n". -header(MimeType, Other) -> - "Content-type: " ++ MimeType ++ "\r\n" ++ Other ++ "\r\n\r\n". - -top(Title) -> - "<HTML> -<HEAD> -<TITLE>" ++ Title ++ "</TITLE> -</HEAD> -<BODY>\n". - -footer() -> - "</BODY> -</HTML>\n". +%% ------------------------------------------------------ post_chunked(_SessionID, _Env, {first, _Body} = _Bodychunk) -> {continue, {state, 1}}; @@ -150,11 +165,13 @@ post_chunked(SessionID, _Env, {last, _Body, undefined} = _Bodychunk) -> mod_esi:deliver(SessionID, footer()); post_chunked(_, _, _Body) -> exit(body_not_chunked). +%% ------------------------------------------------------ post_204(SessionID, _Env, _Input) -> mod_esi:deliver(SessionID, ["Status: 204 No Content" ++ "\r\n\r\n"]), mod_esi:deliver(SessionID, []). +%% ------------------------------------------------------ ignore_invalid_header(SessionID, Env, _Input) -> case proplists:get_value(content_length, Env, undefined) of @@ -165,7 +182,8 @@ ignore_invalid_header(SessionID, Env, _Input) -> mod_esi:deliver(SessionID, ["Status: 500 Internal Server Error" ++ "\r\n\r\n"]) end. - +%% ------------------------------------------------------ + newformat(SessionID,_,_) -> mod_esi:deliver(SessionID, "Content-Type:text/html\r\n\r\n"), mod_esi:deliver(SessionID, top("new esi format test")), @@ -176,28 +194,16 @@ newformat(SessionID,_,_) -> %% ------------------------------------------------------ -delay(Time) when is_integer(Time) -> - i("httpd_example:delay(~p) -> do the delay",[Time]), - sleep(Time), - i("httpd_example:delay(~p) -> done, now reply",[Time]), - delay_reply("delay ok"); -delay(Time) when is_list(Time) -> - delay(list_to_integer(Time)); -delay({error,_Reason}) -> - i("delay -> called with invalid time"), - delay_reply("delay failed: invalid delay time"). +delay(SessionID,_, _) -> + sleep(10000), + Reply = delay_reply("delay ok"), + mod_esi:deliver(SessionID, Reply). delay_reply(Reply) -> [header(), top("delay"), Reply, footer()]. - -i(F) -> i(F,[]). -i(F,A) -> io:format(F ++ "~n",A). - -sleep(T) -> receive after T -> ok end. - %% ------------------------------------------------------ chunk_timeout(SessionID, _, _StrInt) -> @@ -224,3 +230,34 @@ get_chunks(Sid, _Env, In) -> mod_esi:deliver(Sid, io_lib:format("Chunk ~p ms\r\n", [ChunkDelay])), timer:sleep(ChunkDelay + BadChunkDelay), mod_esi:deliver(Sid, "BAD Chunk\r\n"). + +%% ------------------------------------------------------ +default(Env,Input) -> + [header(), + top("Default Example"), + "<B>Environment:</B> ",io_lib:format("~p",[Env]),"<BR>\n", + "<B>Input:</B> ",Input,"<BR>\n", + "<B>Parsed Input:</B> ", + io_lib:format("~p",[uri_string:dissect_query(Input)]),"\n", + footer()]. + +header() -> + header("text/html"). +header(MimeType) -> + "Content-type: " ++ MimeType ++ "\r\n\r\n". +header(MimeType, Other) -> + "Content-type: " ++ MimeType ++ "\r\n" ++ Other ++ "\r\n\r\n". + +top(Title) -> + "<HTML> +<HEAD> +<TITLE>" ++ Title ++ "</TITLE> +</HEAD> +<BODY>\n". + +footer() -> + "</BODY> +</HTML>\n". + +sleep(T) -> receive after T -> ok end. + diff --git a/lib/inets/src/http_server/httpd_instance_sup.erl b/lib/inets/src/http_server/httpd_instance_sup.erl index b77aa174ca..d5750f21ad 100644 --- a/lib/inets/src/http_server/httpd_instance_sup.erl +++ b/lib/inets/src/http_server/httpd_instance_sup.erl @@ -53,23 +53,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, Debug) -> {error, Reason} -> error_logger:error_report(Reason), {stop, Reason} - end; - -start_link(ConfigFile, AcceptTimeout, Debug) -> - case file_2_config(ConfigFile) of - {ok, ConfigList, Address, Port} -> - Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), - Name = make_name(Address, Port, Profile), - SupName = {local, Name}, - supervisor:start_link(SupName, ?MODULE, - [ConfigFile, ConfigList, AcceptTimeout, - Debug, Address, Port]); - {error, Reason} -> - error_logger:error_report(Reason), - {stop, Reason} end. - start_link([{_, _}| _] = Config, AcceptTimeout, ListenInfo, Debug) -> case (catch httpd_conf:validate_properties(Config)) of {ok, Config2} -> @@ -84,23 +69,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, ListenInfo, Debug) -> {error, Reason} -> error_logger:error_report(Reason), {stop, Reason} - end; - -start_link(ConfigFile, AcceptTimeout, ListenInfo, Debug) -> - case file_2_config(ConfigFile) of - {ok, ConfigList, Address, Port} -> - Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), - Name = make_name(Address, Port, Profile), - SupName = {local, Name}, - supervisor:start_link(SupName, ?MODULE, - [ConfigFile, ConfigList, AcceptTimeout, - Debug, Address, Port, ListenInfo]); - {error, Reason} -> - error_logger:error_report(Reason), - {stop, Reason} end. - %%%========================================================================= %%% Supervisor callback %%%========================================================================= @@ -183,18 +153,3 @@ worker_spec(WorkerModule, Address, Port, Profile, ListenInfo, ConfigFile, make_name(Address, Port, Profile) -> httpd_util:make_name("httpd_instance_sup", Address, Port, Profile). - -file_2_config(ConfigFile) -> - case httpd_conf:load(ConfigFile) of - {ok, ConfigList} -> - case (catch httpd_conf:validate_properties(ConfigList)) of - {ok, Config} -> - Address = proplists:get_value(bind_address, ConfigList), - Port = proplists:get_value(port, ConfigList), - {ok, Config, Address, Port}; - Error -> - Error - end; - Error -> - Error - end. diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl index 7cb39937e8..617e03a68f 100644 --- a/lib/inets/src/http_server/httpd_manager.erl +++ b/lib/inets/src/http_server/httpd_manager.erl @@ -364,25 +364,16 @@ handle_block(non_disturbing, Timeout, handle_reload(undefined, #state{config_file = undefined} = State) -> {continue, {error, undefined_config_file}, State}; -handle_reload(undefined, #state{config_file = ConfigFile} = State) -> - case load_config(ConfigFile) of - {ok, Config} -> - do_reload(Config, State); - {error, Reason} -> - error_logger:error_msg("Bad config file: ~p~n", [Reason]), - {continue, {error, Reason}, State} +handle_reload(undefined, #state{config_file = ConfigFile, admin_state = AdminState} = State) -> + try httpd:reload_config(ConfigFile, AdminState) of + Result -> + Result + catch throw:Err -> + {config_file, Err, State} end; handle_reload(Config, State) -> do_reload(Config, State). -load_config(ConfigFile) -> - case httpd_conf:load(ConfigFile) of - {ok, Config} -> - httpd_conf:validate_properties(Config); - Error -> - Error - end. - do_reload(Config, #state{config_db = Db} = State) -> case (catch check_constant_values(Db, Config)) of ok -> diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index 3df55c0f7a..958b122255 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -340,31 +340,13 @@ whole_body(Body, Length) -> %% Prevent people from trying to access directories/files %% relative to the ServerRoot. validate_uri(RequestURI) -> - UriNoQueryNoHex = - case string:str(RequestURI, "?") of - 0 -> - (catch http_uri:decode(RequestURI)); - Ndx -> - (catch http_uri:decode(string:left(RequestURI, Ndx))) - end, - case UriNoQueryNoHex of - {'EXIT', _Reason} -> - {error, {bad_request, {malformed_syntax, RequestURI}}}; - _ -> - Path = format_request_uri(UriNoQueryNoHex), - Path2 = [X||X<-string:tokens(Path, "/"),X=/="."], %% OTP-5938 - validate_path(Path2, 0, RequestURI) + case uri_string:normalize(RequestURI) of + {error, _, _} -> + {error, {bad_request, {malformed_syntax, RequestURI}}}; + URI -> + {ok, URI} end. - -validate_path([], _, _) -> - ok; -validate_path([".." | _], 0, RequestURI) -> - {error, {bad_request, {forbidden, RequestURI}}}; -validate_path([".." | Rest], N, RequestURI) -> - validate_path(Rest, N - 1, RequestURI); -validate_path([_ | Rest], N, RequestURI) -> - validate_path(Rest, N + 1, RequestURI). - + validate_version("HTTP/1.1") -> true; validate_version("HTTP/1.0") -> diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index e48555f4d7..e82b1c46e9 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -400,9 +400,9 @@ handle_http_msg({_, _, Version, {_, _}, _}, handle_http_msg({Method, Uri, Version, {RecordHeaders, Headers}, Body}, #state{status = accept, mod = ModData} = State) -> case httpd_request:validate(Method, Uri, Version) of - ok -> + {ok, NormalizedURI} -> {ok, NewModData} = - httpd_request:update_mod_data(ModData, Method, Uri, + httpd_request:update_mod_data(ModData, Method, NormalizedURI, Version, Headers), case is_host_specified_if_required(NewModData#mod.absolute_uri, @@ -421,10 +421,6 @@ handle_http_msg({Method, Uri, Version, {RecordHeaders, Headers}, Body}, httpd_response:send_status(ModData#mod{http_version = Version}, 501, {Method, Uri, Version}, {not_sup, What}), {stop, normal, State#state{response_sent = true}}; - {error, {bad_request, {forbidden, URI}}} -> - httpd_response:send_status(ModData#mod{http_version = Version}, - 403, URI), - {stop, normal, State#state{response_sent = true}}; {error, {bad_request, {malformed_syntax, URI}}} -> httpd_response:send_status(ModData#mod{http_version = Version}, 400, URI, {malformed_syntax, URI}), diff --git a/lib/inets/src/http_server/httpd_sup.erl b/lib/inets/src/http_server/httpd_sup.erl index d1216e01b0..76fa15f991 100644 --- a/lib/inets/src/http_server/httpd_sup.erl +++ b/lib/inets/src/http_server/httpd_sup.erl @@ -135,23 +135,18 @@ child_spec(HttpdService) -> httpd_child_spec(Config, AcceptTimeout, Debug). httpd_config([Value| _] = Config) when is_tuple(Value) -> - case proplists:get_value(file, Config) of - undefined -> - case proplists:get_value(proplist_file, Config) of - undefined -> - httpd_conf:validate_properties(Config); - File -> - try file:consult(File) of - {ok, [PropList]} -> - httpd_conf:validate_properties(PropList) - catch - exit:_ -> - throw({error, - {could_not_consult_proplist_file, File}}) - end - end; - File -> - {ok, File} + case proplists:get_value(proplist_file, Config) of + undefined -> + httpd_conf:validate_properties(Config); + File -> + try file:consult(File) of + {ok, [PropList]} -> + httpd_conf:validate_properties(PropList) + catch + exit:_ -> + throw({error, + {could_not_consult_proplist_file, File}}) + end end. httpd_child_spec([Value| _] = Config, AcceptTimeout, Debug) @@ -159,30 +154,8 @@ httpd_child_spec([Value| _] = Config, AcceptTimeout, Debug) Address = proplists:get_value(bind_address, Config, any), Port = proplists:get_value(port, Config, 80), Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE), - httpd_child_spec(Config, AcceptTimeout, Debug, Address, Port, Profile); - -%% In this case the AcceptTimeout and Debug will only have default values... -httpd_child_spec(ConfigFile, AcceptTimeoutDef, DebugDef) -> - case httpd_conf:load(ConfigFile) of - {ok, ConfigList} -> - case (catch httpd_conf:validate_properties(ConfigList)) of - {ok, Config} -> - Address = proplists:get_value(bind_address, Config, any), - Port = proplists:get_value(port, Config, 80), - Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE), - AcceptTimeout = - proplists:get_value(accept_timeout, Config, - AcceptTimeoutDef), - Debug = - proplists:get_value(debug, Config, DebugDef), - httpd_child_spec([{file, ConfigFile} | Config], - AcceptTimeout, Debug, Address, Port, Profile); - Error -> - Error - end; - Error -> - Error - end. + httpd_child_spec(Config, AcceptTimeout, Debug, Address, Port, Profile). + httpd_child_spec(Config, AcceptTimeout, Debug, Addr, Port, Profile) -> case get_fd(Port) of diff --git a/lib/inets/src/http_server/httpd_util.erl b/lib/inets/src/http_server/httpd_util.erl index 6b3b2c9660..05cff30243 100644 --- a/lib/inets/src/http_server/httpd_util.erl +++ b/lib/inets/src/http_server/httpd_util.erl @@ -167,7 +167,7 @@ reason_phrase(_) -> "Internal Server Error". %% message message(301,URL,_) -> - "The document has moved <A HREF=\""++ maybe_encode(URL) ++"\">here</A>."; + "The document has moved <A HREF=\""++ html_encode(uri_string:normalize(URL)) ++"\">here</A>."; message(304, _URL,_) -> "The document has not been changed."; message(400, none, _) -> @@ -184,11 +184,11 @@ browser doesn't understand how to supply the credentials required."; message(403,RequestURI,_) -> "You don't have permission to access " ++ - html_encode(RequestURI) ++ + html_encode(uri_string:normalize(RequestURI)) ++ " on this server."; message(404,RequestURI,_) -> "The requested URL " ++ - html_encode(RequestURI) ++ + html_encode(uri_string:normalize(RequestURI)) ++ " was not found on this server."; message(408, Timeout, _) -> Timeout; @@ -212,7 +212,7 @@ message(501,{Method, RequestURI, HTTPVersion}, _ConfigDB) -> is_atom(Method) -> atom_to_list(Method) ++ " to " ++ - html_encode(RequestURI) ++ + html_encode(uri_string:normalize(RequestURI)) ++ " (" ++ HTTPVersion ++ ") not supported."; is_list(Method) -> Method ++ @@ -225,23 +225,9 @@ message(503, String, _ConfigDB) -> "This service in unavailable due to: " ++ html_encode(String); message(_, ReasonPhrase, _) -> html_encode(ReasonPhrase). - -maybe_encode(URI) -> - Decoded = try http_uri:decode(URI) of - N -> N - catch - error:_ -> URI - end, - http_uri:encode(Decoded). - + html_encode(String) -> - try http_uri:decode(String) of - Decoded when is_list(Decoded) -> - http_util:html_encode(Decoded) - catch - _:_ -> - http_util:html_encode(String) - end. + http_util:html_encode(String). %%convert_rfc_date(Date)->{{YYYY,MM,DD},{HH,MIN,SEC}} @@ -422,21 +408,26 @@ flatlength([],L) -> %% split_path -split_path(Path) -> - case re:run(Path,"[\?].*\$", [{capture, first}]) of - %% A QUERY_STRING exists! - {match,[{Start,Length}]} -> - {http_uri:decode(string:substr(Path,1,Start)), - string:substr(Path,Start+1,Length)}; - %% A possible PATH_INFO exists! - nomatch -> - split_path(Path,[]) +split_path(URI) -> + case uri_string:normalize(URI, [return_map]) of + #{fragment := Fragment, + path := Path, + query := Query} -> + {Path, add_hashmark(Query, Fragment)}; + #{path := Path, + query := Query} -> + {Path, Query}; + #{path := Path} -> + split_path(Path, []) end. +add_hashmark(Query, Fragment) -> + Query ++ "#" ++ Fragment. + split_path([],SoFar) -> - {http_uri:decode(lists:reverse(SoFar)),[]}; + {lists:reverse(SoFar),[]}; split_path([$/|Rest],SoFar) -> - Path=http_uri:decode(lists:reverse(SoFar)), + Path=lists:reverse(SoFar), case file:read_file_info(Path) of {ok,FileInfo} when FileInfo#file_info.type =:= regular -> {Path,[$/|Rest]}; @@ -450,56 +441,20 @@ split_path([C|Rest],SoFar) -> %% split_script_path -split_script_path(Path) -> - case split_script_path(Path, []) of - {Script, AfterPath} -> - {PathInfo, QueryString} = pathinfo_querystring(AfterPath), - {Script, {PathInfo, QueryString}}; - not_a_script -> - not_a_script - end. -pathinfo_querystring(Str) -> - pathinfo_querystring(Str, []). -pathinfo_querystring([], SoFar) -> - {lists:reverse(SoFar), []}; -pathinfo_querystring([$?|Rest], SoFar) -> - {lists:reverse(SoFar), Rest}; -pathinfo_querystring([C|Rest], SoFar) -> - pathinfo_querystring(Rest, [C|SoFar]). - -split_script_path([$?|QueryString], SoFar) -> - Path = http_uri:decode(lists:reverse(SoFar)), - case file:read_file_info(Path) of - {ok,FileInfo} when FileInfo#file_info.type =:= regular -> - {Path, [$?|QueryString]}; - {ok, _FileInfo} -> - not_a_script; - {error, _Reason} -> - not_a_script - end; -split_script_path([], SoFar) -> - Path = http_uri:decode(lists:reverse(SoFar)), - case file:read_file_info(Path) of - {ok,FileInfo} when FileInfo#file_info.type =:= regular -> - {Path, []}; - {ok, _FileInfo} -> - not_a_script; - {error, _Reason} -> - not_a_script - end; -split_script_path([$/|Rest], SoFar) -> - Path = http_uri:decode(lists:reverse(SoFar)), - case file:read_file_info(Path) of - {ok, FileInfo} when FileInfo#file_info.type =:= regular -> - {Path, [$/|Rest]}; - {ok, _FileInfo} -> - split_script_path(Rest, [$/|SoFar]); - {error, _Reason} -> - split_script_path(Rest, [$/|SoFar]) - end; -split_script_path([C|Rest], SoFar) -> - split_script_path(Rest,[C|SoFar]). +split_script_path(URI) -> + case uri_string:normalize(URI, [return_map]) of + #{fragment := _Fragment, + path := _Path, + query := _Query} -> + not_a_script; + #{path := Path, + query := Query} -> + {Script, PathInfo} = split_path(Path, []), + {Script, {PathInfo, Query}}; + #{path := Path} -> + split_path(Path, []) + end. %% suffix diff --git a/lib/inets/src/http_server/mod_actions.erl b/lib/inets/src/http_server/mod_actions.erl index b5449f20ee..dcc2b87961 100644 --- a/lib/inets/src/http_server/mod_actions.erl +++ b/lib/inets/src/http_server/mod_actions.erl @@ -19,7 +19,7 @@ %% %% -module(mod_actions). --export([do/1,load/2, store/2]). +-export([do/1, store/2]). -include("httpd.hrl"). -include("httpd_internal.hrl"). @@ -78,23 +78,6 @@ script(RequestURI, Method, [_ | Rest]) -> %% Configuration %% -%% load - -load("Action "++ Action, []) -> - case re:split(Action, " ", [{return, list}]) of - [MimeType, CGIScript] -> - {ok,[],{action, {MimeType, CGIScript}}}; - _ -> - {error,?NICE(string:strip(Action)++" is an invalid Action")} - end; -load("Script " ++ Script,[]) -> - case re:split(Script, " ", [{return, list}]) of - [Method, CGIScript] -> - {ok,[],{script, {Method, CGIScript}}}; - _ -> - {error,?NICE(string:strip(Script)++" is an invalid Script")} - end. - store({action, {MimeType, CGIScript}} = Conf, _) when is_list(MimeType), is_list(CGIScript) -> {ok, Conf}; diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl index fac59ab93c..0d1681f6ed 100644 --- a/lib/inets/src/http_server/mod_alias.erl +++ b/lib/inets/src/http_server/mod_alias.erl @@ -24,7 +24,6 @@ real_name/3, real_script_name/3, default_index/2, - load/2, store/2, path/3]). @@ -99,13 +98,12 @@ get_protocol(_) -> %% real_name real_name(ConfigDB, RequestURI, []) -> - DocumentRoot = which_document_root(ConfigDB), + {Prefix, DocumentRoot} = which_document_root(ConfigDB), RealName = DocumentRoot ++ RequestURI, {ShortPath, _AfterPath} = httpd_util:split_path(RealName), {Path, AfterPath} = httpd_util:split_path(default_index(ConfigDB, RealName)), - {ShortPath, Path, AfterPath}; - + {Prefix ++ ShortPath, Prefix ++ Path, AfterPath}; real_name(ConfigDB, RequestURI, [{MP,Replacement}| _] = Aliases) when element(1, MP) =:= re_pattern -> case longest_match(Aliases, RequestURI) of @@ -200,10 +198,10 @@ append_index(RealName, [Index | Rest]) -> path(Data, ConfigDB, RequestURI) -> case proplists:get_value(real_name, Data) of undefined -> - DocumentRoot = which_document_root(ConfigDB), - {Path, _AfterPath} = - httpd_util:split_path(DocumentRoot ++ RequestURI), - Path; + {Prefix, DocumentRoot} = which_document_root(ConfigDB), + {Path, _AfterPath} = + httpd_util:split_path(DocumentRoot ++ RequestURI), + Prefix ++ Path; {Path, _AfterPath} -> Path end. @@ -211,50 +209,6 @@ path(Data, ConfigDB, RequestURI) -> %% %% Configuration %% - -%% load - -load("DirectoryIndex " ++ DirectoryIndex, []) -> - DirectoryIndexes = re:split(DirectoryIndex," ", [{return, list}]), - {ok,[], {directory_index, DirectoryIndexes}}; -load("Alias " ++ Alias, []) -> - case re:split(Alias," ", [{return, list}]) of - [FakeName, RealName] -> - {ok,[],{alias,{FakeName,RealName}}}; - _ -> - {error,?NICE(string:strip(Alias)++" is an invalid Alias")} - end; -load("ReWrite " ++ Rule, Acc) -> - load_re_write(Rule, Acc, "ReWrite", re_write); -load("ScriptAlias " ++ ScriptAlias, []) -> - case re:split(ScriptAlias, " ", [{return, list}]) of - [FakeName, RealName] -> - %% Make sure the path always has a trailing slash.. - RealName1 = filename:join(filename:split(RealName)), - {ok, [], {script_alias, {FakeName, RealName1++"/"}}}; - _ -> - {error, ?NICE(string:strip(ScriptAlias)++ - " is an invalid ScriptAlias")} - end; -load("ScriptReWrite " ++ Rule, Acc) -> - load_re_write(Rule, Acc, "ScriptReWrite", script_re_write). - -load_re_write(Rule0, Acc, Type, Tag) -> - case lists:dropwhile( - fun ($\s) -> true; ($\t) -> true; (_) -> false end, - Rule0) of - "" -> - {error, ?NICE(string:strip(Rule0)++" is an invalid "++Type)}; - Rule -> - case string:chr(Rule, $\s) of - 0 -> - {ok, Acc, {Tag, {Rule, ""}}}; - N -> - {Re, [_|Replacement]} = lists:split(N-1, Rule), - {ok, Acc, {Tag, {Re, Replacement}}} - end - end. - store({directory_index, Value} = Conf, _) when is_list(Value) -> case is_directory_index_list(Value) of true -> @@ -315,7 +269,13 @@ which_port(ConfigDB) -> httpd_util:lookup(ConfigDB, port, 80). which_document_root(ConfigDB) -> - httpd_util:lookup(ConfigDB, document_root, ""). + Root = httpd_util:lookup(ConfigDB, document_root, ""), + case string:tokens(Root, ":") of + [Prefix, Path] -> + {Prefix ++ ":", Path}; + [Path] -> + {"", Path} + end. which_directory_index(ConfigDB) -> httpd_util:lookup(ConfigDB, directory_index, []). diff --git a/lib/inets/src/http_server/mod_auth.erl b/lib/inets/src/http_server/mod_auth.erl index fba94df176..89d6e966cb 100644 --- a/lib/inets/src/http_server/mod_auth.erl +++ b/lib/inets/src/http_server/mod_auth.erl @@ -22,7 +22,7 @@ %% The functions that the webbserver call on startup stop %% and when the server traverse the modules. --export([do/1, load/2, store/2, remove/1]). +-export([do/1, store/2, remove/1]). %% User entries to the gen-server. -export([add_user/2, add_user/5, add_user/6, @@ -127,97 +127,6 @@ do(Info) -> %% will be returned as a ConfigList and the context will return to the %% state it was previously. -load("<Directory " ++ Directory,[]) -> - Dir = string:strip(string:strip(Directory),right, $>), - {ok,[{directory, {Dir, [{path, Dir}]}}]}; -load(eof,[{directory, {Directory, _DirData}}|_]) -> - {error, ?NICE("Premature end-of-file in "++ Directory)}; - -load("AuthName " ++ AuthName, [{directory, {Directory, DirData}}|Rest]) -> - {ok, [{directory, {Directory, - [{auth_name, string:strip(AuthName)} | DirData]}} - | Rest ]}; -load("AuthUserFile " ++ AuthUserFile0, - [{directory, {Directory, DirData}}|Rest]) -> - AuthUserFile = string:strip(AuthUserFile0), - {ok, [{directory, {Directory, - [{auth_user_file, AuthUserFile}|DirData]}} | Rest ]}; -load("AuthGroupFile " ++ AuthGroupFile0, - [{directory, {Directory, DirData}}|Rest]) -> - AuthGroupFile = string:strip(AuthGroupFile0), - {ok,[{directory, {Directory, - [{auth_group_file, AuthGroupFile}|DirData]}} | Rest]}; - -load("AuthAccessPassword " ++ AuthAccessPassword0, - [{directory, {Directory, DirData}}|Rest]) -> - AuthAccessPassword = string:strip(AuthAccessPassword0), - {ok,[{directory, {Directory, - [{auth_access_password, AuthAccessPassword}|DirData]}} | Rest]}; - -load("AuthDBType " ++ Type, - [{directory, {Dir, DirData}}|Rest]) -> - case string:strip(Type) of - "plain" -> - {ok, [{directory, {Dir, [{auth_type, plain}|DirData]}} | Rest ]}; - "mnesia" -> - {ok, [{directory, {Dir, [{auth_type, mnesia}|DirData]}} | Rest ]}; - "dets" -> - {ok, [{directory, {Dir, [{auth_type, dets}|DirData]}} | Rest ]}; - _ -> - {error, ?NICE(string:strip(Type)++" is an invalid AuthDBType")} - end; - -load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) -> - case re:split(Require," ", [{return, list}]) of - ["user" | Users] -> - {ok,[{directory, {Directory, - [{require_user,Users}|DirData]}} | Rest]}; - ["group"|Groups] -> - {ok,[{directory, {Directory, - [{require_group,Groups}|DirData]}} | Rest]}; - _ -> - {error,?NICE(string:strip(Require) ++" is an invalid require")} - end; - -load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) -> - case re:split(Allow," ", [{return, list}]) of - ["from","all"] -> - {ok,[{directory, {Directory, - [{allow_from,all}|DirData]}} | Rest]}; - ["from"|Hosts] -> - {ok,[{directory, {Directory, - [{allow_from,Hosts}|DirData]}} | Rest]}; - _ -> - {error,?NICE(string:strip(Allow) ++" is an invalid allow")} - end; - -load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) -> - case re:split(Deny," ", [{return, list}]) of - ["from", "all"] -> - {ok,[{{directory, Directory, - [{deny_from, all}|DirData]}} | Rest]}; - ["from"|Hosts] -> - {ok,[{{directory, Directory, - [{deny_from, Hosts}|DirData]}} | Rest]}; - _ -> - {error,?NICE(string:strip(Deny) ++" is an invalid deny")} - end; - -load("</Directory>",[{directory, {Directory, DirData}}|Rest]) -> - {ok, Rest, {directory, {Directory, DirData}}}; - -load("AuthMnesiaDB " ++ AuthMnesiaDB, - [{directory, {Dir, DirData}}|Rest]) -> - case string:strip(AuthMnesiaDB) of - "On" -> - {ok,[{directory, {Dir,[{auth_type,mnesia}|DirData]}}|Rest]}; - "Off" -> - {ok,[{directory, {Dir,[{auth_type,plain}|DirData]}}|Rest]}; - _ -> - {error, ?NICE(string:strip(AuthMnesiaDB) ++ - " is an invalid AuthMnesiaDB")} - end. - store({directory, {Directory, DirData}}, ConfigList) when is_list(Directory) andalso is_list(DirData) -> try directory_config_check(Directory, DirData) of diff --git a/lib/inets/src/http_server/mod_browser.erl b/lib/inets/src/http_server/mod_browser.erl deleted file mode 100644 index 1e8f860746..0000000000 --- a/lib/inets/src/http_server/mod_browser.erl +++ /dev/null @@ -1,251 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% -%% ---------------------------------------------------------------------- -%% -%% Browsers sends a string to the webbserver -%% to identify themsevles. They are a bit nasty -%% since the only thing that the specification really -%% is strict about is that they shall be short -%% some axamples: -%% -%% Netscape Mozilla/4.75 [en] (X11; U; SunOS 5.8 sun4u) -%% Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0 -%% Mozilla Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.1) Gecko/20020827 -%% Safari Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/85 (KHTML, like Gecko) Safari/85 -%% IE5 Mozilla/4.0 (compatible; MSIE 5.0; SP1B; SunOS 5.8 sun4u; X11) -%% Lynx Lynx/2.8.3rel.1 libwww-FM/2.142 -%% -%% ---------------------------------------------------------------------- - --module(mod_browser). - --export([do/1, test/0, getBrowser/1]). - -%% Remember that the order of the mozilla browsers are -%% important since some browsers include others to behave -%% as they were something else --define(MOZILLA_BROWSERS,[{netscape, "netscape"}, - {opera, "opera"}, - {msie, "msie"}, - {safari, "safari"}, - {mozilla, "rv:"}]). % fallback, must be last - - -%% If your operatingsystem is not recognized add it to this list. --define(OPERATIVE_SYSTEMS,[{win3x, ["win16", "windows 3", "windows 16-bit"]}, - {win95, ["win95", "windows 95"]}, - {win98, ["win98", "windows 98"]}, - {winnt, ["winnt", "windows nt"]}, - {win2k, ["nt 5"]}, - {sunos4, ["sunos 4"]}, - {sunos5, ["sunos 5"]}, - {sun, ["sunos"]}, - {aix, ["aix"]}, - {linux, ["linux"]}, - {sco, ["sco", "unix_sv"]}, - {freebsd,["freebsd"]}, - {bsd, ["bsd"]}, - {macosx, ["mac os x"]}]). - --define(LYNX, lynx). --define(MOZILLA, mozilla). --define(EMACS, emacs). --define(STAROFFICE, soffice). --define(MOSAIC, mosaic). --define(NETSCAPE, netscape). --define(SAFARU, safari). --define(UNKOWN, unknown). - --include("httpd.hrl"). - --define(VMODULE,"BROWSER"). - -do(Info) -> - case proplists:get_value(status, Info#mod.data) of - {_StatusCode, _PhraseArgs, _Reason} -> - {proceed,Info#mod.data}; - undefined -> - Browser = getBrowser1(Info), - {proceed,[{'user-agent', Browser}|Info#mod.data]} - end. - -getBrowser1(Info) -> - PHead = Info#mod.parsed_header, - case proplists:get_value("user-agent", PHead) of - undefined -> - undefined; - AgentString -> - getBrowser(AgentString) - end. - -getBrowser(AgentString) -> - LAgentString = http_util:to_lower(AgentString), - case re:run(LAgentString,"^[^ ]*", [{capture, first}]) of - {match,[{Start,Length}]} -> - Browser = lists:sublist(LAgentString,Start+1,Length), - case browserType(Browser) of - {mozilla,Vsn} -> - {getMozilla(LAgentString, - ?MOZILLA_BROWSERS,{?NETSCAPE,Vsn}), - operativeSystem(LAgentString)}; - AnyBrowser -> - {AnyBrowser,operativeSystem(LAgentString)} - end; - nomatch -> - browserType(LAgentString) - end. - -browserType([$l,$y,$n,$x|Version]) -> - {?LYNX,browserVersion(Version)}; -browserType([$m,$o,$z,$i,$l,$l,$a|Version]) -> - {?MOZILLA,browserVersion(Version)}; -browserType([$e,$m,$a,$c,$s|Version]) -> - {?EMACS,browserVersion(Version)}; -browserType([$s,$t,$a,$r,$o,$f,$f,$i,$c,$e|Version]) -> - {?STAROFFICE,browserVersion(Version)}; -browserType([$m,$o,$s,$a,$i,$c|Version]) -> - {?MOSAIC,browserVersion(Version)}; -browserType(_Unknown) -> - unknown. - - -browserVersion([$/|VsnString]) -> - case catch list_to_float(VsnString) of - Number when is_float(Number) -> - Number; - _Whatever -> - case string:span(VsnString,"1234567890.") of - 0 -> - unknown; - VLength -> - Vsn = string:substr(VsnString,1,VLength), - case string:tokens(Vsn,".") of - [Number] -> - list_to_float(Number++".0"); - [Major,Minor|_MinorMinor] -> - list_to_float(Major++"."++Minor) - end - end - end; -browserVersion(VsnString) -> - browserVersion([$/|VsnString]). - -operativeSystem(OpString) -> - operativeSystem(OpString, ?OPERATIVE_SYSTEMS). - -operativeSystem(_OpString,[]) -> - unknown; -operativeSystem(OpString,[{RetVal,RegExps}|Rest]) -> - case controlOperativeSystem(OpString,RegExps) of - true -> - RetVal; - _ -> - operativeSystem(OpString,Rest) - end. - -controlOperativeSystem(_OpString,[]) -> - false; -controlOperativeSystem(OpString,[Regexp|Regexps]) -> - case re:run(OpString,Regexp, [{capture, none}]) of - match -> - true; - nomatch -> - controlOperativeSystem(OpString,Regexps) - end. - - -%% OK this is ugly but thats the only way since -%% all browsers dont conform to the name/vsn standard -%% First we check if it is one of the browsers that -%% are not the default mozillaborwser against the regexp -%% for the different browsers. if no match, it is a mozilla -%% browser i.e opera, netscape, ie or safari - -getMozilla(_AgentString,[],Default) -> - Default; -getMozilla(AgentString,[{Agent,AgentRegExp}|Rest],Default) -> - case re:run(AgentString,AgentRegExp, [{capture, none}]) of - match -> - {Agent,getMozVersion(AgentString,AgentRegExp)}; - nomatch -> - getMozilla(AgentString,Rest,Default) - end. - -getMozVersion(AgentString, AgentRegExp) -> - case re:run(AgentString,AgentRegExp++"[0-9\.\ \/]*", - [{capture, first}]) of - {match, [{Start,Length}]} when length(AgentRegExp) < Length -> - %% Ok we got the number split it out - RealStart = Start+1+length(AgentRegExp), - RealLength = Length-length(AgentRegExp), - VsnString = string:substr(AgentString,RealStart,RealLength), - %% case string:strip(VsnString,both,$\ ) of - case strip(VsnString) of - [] -> - unknown; - [Y1,Y2,Y3,Y4,M1,M2,D1,D2] = DateVsn when - Y1 =< $9, Y1 >= $0, - Y2 =< $9, Y2 >= $0, - Y3 =< $9, Y3 >= $0, - Y4 =< $9, Y4 >= $0, - M1 =< $9, M1 >= $0, - M2 =< $9, M2 >= $0, - D1 =< $9, D1 >= $0, - D2 =< $9, D2 >= $0 -> - list_to_integer(DateVsn); - Vsn -> - case string:tokens(Vsn,".") of - [Number]-> - list_to_float(Number++".0"); - [Major,Minor|Rev] -> - V = lists:flatten([Major,".",Minor,Rev]), - list_to_float(V) - end - end; - nomatch -> - unknown - end. - -strip(VsnString) -> - strip2(strip1(VsnString)). - -strip1(VsnString) -> - string:strip(VsnString,both,$\ ). - -strip2(VsnString) -> - string:strip(VsnString,both,$/ ). - -test()-> - test("Mozilla/4.75 [en] (X11; U; SunOS 5.8 sun4u)"), - test("Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0"), - test("Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.1) Gecko/20020827"), - test("Mozilla/5.0 (Macintosh; U; PPC Mac OS X Mach-O; en-US; rv:1.4) Gecko/20020827"), - test("Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/85 (KHTML, like Gecko) Safari/85"), - test("Mozilla/4.0 (compatible; MSIE 5.0; SP1B; SunOS 5.8 sun4u; X11)"), - test("Lynx/2.8.3rel.1 libwww-FM/2.142"), - ok. - -test(Str) -> - Browser = getBrowser(Str), - io:format("~n--------------------------------------------------------~n"), - io:format("~p",[Browser]), - io:format("~n--------------------------------------------------------~n"). - diff --git a/lib/inets/src/http_server/mod_dir.erl b/lib/inets/src/http_server/mod_dir.erl index 2a90575e7d..ad2ee1d994 100644 --- a/lib/inets/src/http_server/mod_dir.erl +++ b/lib/inets/src/http_server/mod_dir.erl @@ -57,9 +57,7 @@ do_dir(Info) -> %% Is it a directory? case file:read_file_info(DefaultPath) of {ok,FileInfo} when FileInfo#file_info.type == directory -> - DecodedRequestURI = - http_uri:decode(Info#mod.request_uri), - case dir(DefaultPath,string:strip(DecodedRequestURI,right,$/), + case dir(DefaultPath,string:strip( Info#mod.request_uri,right,$/), Info#mod.config_db) of {ok, Dir} -> LastModified = diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index 112e74575d..00268aefec 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -27,7 +27,7 @@ -export([deliver/2]). %% Callback API --export([do/1, load/2, store/2]). +-export([do/1, store/2]). -include("httpd.hrl"). -include("httpd_internal.hrl"). @@ -83,61 +83,6 @@ do(ModData) -> %%-------------------------------------------------------------------------- -%% load(Line, Context) -> eof | ok | {ok, NewContext} | -%% {ok, NewContext, Directive} | -%% {ok, NewContext, DirectiveList} | {error, Reason} -%% Line = string() -%% Context = NewContext = DirectiveList = [Directive] -%% Directive = {DirectiveKey , DirectiveValue} -%% DirectiveKey = DirectiveValue = term() -%% Reason = term() -%% -%% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS -%%------------------------------------------------------------------------- -load("ErlScriptAlias " ++ ErlScriptAlias, []) -> - try re:split(ErlScriptAlias," ", [{return, list}]) of - [ErlName | StrModules] -> - Modules = lists:map(fun(Str) -> - list_to_atom(string:strip(Str)) - end, StrModules), - {ok, [], {erl_script_alias, {ErlName, Modules}}} - catch _:_ -> - {error, ?NICE(string:strip(ErlScriptAlias) ++ - " is an invalid ErlScriptAlias")} - end; -load("EvalScriptAlias " ++ EvalScriptAlias, []) -> - try re:split(EvalScriptAlias, " ", [{return, list}]) of - [EvalName | StrModules] -> - Modules = lists:map(fun(Str) -> - list_to_atom(string:strip(Str)) - end, StrModules), - {ok, [], {eval_script_alias, {EvalName, Modules}}} - catch - _:_ -> - {error, ?NICE(string:strip(EvalScriptAlias) ++ - " is an invalid EvalScriptAlias")} - end; -load("ErlScriptTimeout " ++ Timeout, [])-> - case catch list_to_integer(string:strip(Timeout)) of - TimeoutSec when is_integer(TimeoutSec) -> - {ok, [], {erl_script_timeout, TimeoutSec}}; - _ -> - {error, ?NICE(string:strip(Timeout) ++ - " is an invalid ErlScriptTimeout")} - end; -load("ErlScriptNoCache " ++ CacheArg, [])-> - case catch list_to_atom(string:strip(CacheArg)) of - true -> - {ok, [], {erl_script_nocache, true}}; - false -> - {ok, [], {erl_script_nocache, false}}; - _ -> - {error, ?NICE(string:strip(CacheArg)++ - " is an invalid ErlScriptNoCache directive")} - end. - - -%%-------------------------------------------------------------------------- %% store(Directive, DirectiveList) -> {ok, NewDirective} | %% {ok, [NewDirective]} | %% {error, Reason} @@ -161,16 +106,6 @@ store({erl_script_alias, {Name, Modules}} = Conf, _) {error, {wrong_type, {erl_script_alias, Error}}} end; -store({eval_script_alias, {Name, Modules}} = Conf, _) - when is_list(Name)-> - try httpd_util:modules_validate(Modules) of - ok -> - {ok, Conf} - catch - throw:Error -> - {error, {wrong_type, {eval_script_alias, Error}}} - end; - store({erl_script_alias, Value}, _) -> {error, {wrong_type, {erl_script_alias, Value}}}; store({erl_script_timeout, TimeoutSec}, _) @@ -190,8 +125,6 @@ store({erl_script_nocache, Value}, _) -> %%%======================================================================== generate_response(ModData) -> case scheme(ModData#mod.request_uri, ModData#mod.config_db) of - {eval, ESIBody, Modules} -> - eval(ModData, ESIBody, Modules); {erl, ESIBody, Modules} -> erl(ModData, ESIBody, Modules); no_scheme -> @@ -201,12 +134,7 @@ generate_response(ModData) -> scheme(RequestURI, ConfigDB) -> case match_script(RequestURI, ConfigDB, erl_script_alias) of no_match -> - case match_script(RequestURI, ConfigDB, eval_script_alias) of - no_match -> - no_scheme; - {EsiBody, ScriptModules} -> - {eval, EsiBody, ScriptModules} - end; + no_scheme; {EsiBody, ScriptModules} -> {erl, EsiBody, ScriptModules} end. @@ -231,10 +159,7 @@ match_esi_script(RequestURI, [{Alias,Modules} | Rest], AliasType) -> end. alias_match_str(Alias, erl_script_alias) -> - "^" ++ Alias ++ "/"; -alias_match_str(Alias, eval_script_alias) -> - "^" ++ Alias ++ "\\?". - + "^" ++ Alias ++ "/". %%------------------------ Erl mechanism -------------------------------- @@ -315,8 +240,8 @@ generate_webpage(ModData, ESIBody, Modules, Module, FunctionName, case erl_scheme_webpage_chunk(Module, Function, Env, Input, ModData) of {error, erl_scheme_webpage_chunk_undefined} -> - erl_scheme_webpage_whole(Module, Function, Env, Input, - ModData); + {proceed, [{status, {404, ModData#mod.request_uri, "Not found"}} + | ModData#mod.data]}; ResponseResult -> ResponseResult end; @@ -326,38 +251,7 @@ generate_webpage(ModData, ESIBody, Modules, Module, FunctionName, ++ ESIBody)}} | ModData#mod.data]} end. -%% Old API that waits for the dymnamic webpage to be totally generated -%% before anythig is sent back to the client. -erl_scheme_webpage_whole(Mod, Func, Env, Input, ModData) -> - case (catch Mod:Func(Env, Input)) of - {'EXIT',{undef, _}} -> - {proceed, [{status, {404, ModData#mod.request_uri, "Not found"}} - | ModData#mod.data]}; - {'EXIT',Reason} -> - {proceed, [{status, {500, none, Reason}} | - ModData#mod.data]}; - Response -> - {Headers, Body} = - httpd_esi:parse_headers(lists:flatten(Response)), - Length = httpd_util:flatlength(Body), - {ok, NewHeaders, StatusCode} = httpd_esi:handle_headers(Headers), - send_headers(ModData, StatusCode, - [{"content-length", - integer_to_list(Length)}| NewHeaders]), - case ModData#mod.method of - "HEAD" -> - {proceed, [{response, {already_sent, StatusCode, 0}} | - ModData#mod.data]}; - _ -> - httpd_response:send_body(ModData, - StatusCode, Body), - {proceed, [{response, {already_sent, StatusCode, - Length}} | - ModData#mod.data]} - end - end. - -%% New API that allows the dynamic wepage to be sent back to the client +%% API that allows the dynamic wepage to be sent back to the client %% in small chunks at the time during generation. erl_scheme_webpage_chunk(Mod, Func, Env, Input, ModData) -> process_flag(trap_exit, true), @@ -369,7 +263,6 @@ erl_scheme_webpage_chunk(Mod, Func, Env, Input, ModData) -> fun() -> case catch Mod:Func(Self, Env, Input) of {'EXIT', {undef,_}} -> - %% Will force fallback on the old API exit(erl_scheme_webpage_chunk_undefined); {continue, _} = Continue -> exit(Continue); @@ -523,64 +416,3 @@ input_type([$?|_Rest]) -> input_type([_First|Rest]) -> input_type(Rest). -%%------------------------ Eval mechanism -------------------------------- - -eval(#mod{request_uri = ReqUri, - method = "PUT", - http_version = Version, - data = Data}, _ESIBody, _Modules) -> - {proceed,[{status,{501,{"PUT", ReqUri, Version}, - ?NICE("Eval mechanism doesn't support method PUT")}}| - Data]}; - -eval(#mod{request_uri = ReqUri, - method = "DELETE", - http_version = Version, - data = Data}, _ESIBody, _Modules) -> - {proceed,[{status,{501,{"DELETE", ReqUri, Version}, - ?NICE("Eval mechanism doesn't support method DELETE")}}| - Data]}; - -eval(#mod{request_uri = ReqUri, - method = "POST", - http_version = Version, - data = Data}, _ESIBody, _Modules) -> - {proceed,[{status,{501,{"POST", ReqUri, Version}, - ?NICE("Eval mechanism doesn't support method POST")}}| - Data]}; - -eval(#mod{method = Method} = ModData, ESIBody, Modules) - when (Method =:= "GET") orelse (Method =:= "HEAD") -> - case is_authorized(ESIBody, Modules) of - true -> - case generate_webpage(ESIBody) of - {error, Reason} -> - {proceed, [{status, {500, none, Reason}} | - ModData#mod.data]}; - {ok, Response} -> - {Headers, _} = - httpd_esi:parse_headers(lists:flatten(Response)), - {ok, _, StatusCode} =httpd_esi:handle_headers(Headers), - {proceed,[{response, {StatusCode, Response}} | - ModData#mod.data]} - end; - false -> - {proceed,[{status, - {403, ModData#mod.request_uri, - ?NICE("Client not authorized to evaluate: " - ++ ESIBody)}} | ModData#mod.data]} - end. - -generate_webpage(ESIBody) -> - (catch erl_eval:eval_str(string:concat(ESIBody,". "))). - -is_authorized(_ESIBody, [all]) -> - true; -is_authorized(ESIBody, Modules) -> - case re:run(ESIBody, "^[^\:(%3A)]*", [{capture, first}]) of - {match, [{Start, Length}]} -> - lists:member(list_to_atom(string:substr(ESIBody, Start+1, Length)), - Modules); - nomatch -> - false - end. diff --git a/lib/inets/src/http_server/mod_htaccess.erl b/lib/inets/src/http_server/mod_htaccess.erl deleted file mode 100644 index 7b742bba24..0000000000 --- a/lib/inets/src/http_server/mod_htaccess.erl +++ /dev/null @@ -1,1071 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(mod_htaccess). - --export([do/1, load/2, store/2]). - --include("httpd.hrl"). --include("httpd_internal.hrl"). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Public methods that interface the eswapi %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% Public method called by the webbserver to insert the data about -% Names on accessfiles -%---------------------------------------------------------------------- -load("AccessFileName" ++ FileNames, _Context)-> - CleanFileNames=string:strip(FileNames), - {ok,[],{access_files,string:tokens(CleanFileNames," ")}}. - -store({access_files, Files} = Conf, _) when is_list(Files)-> - {ok, Conf}; -store({access_files, Value}, _) -> - {error, {wrong_type, {access_files, Value}}}. - -%---------------------------------------------------------------------- -% Public method that the webbserver calls to control the page -%---------------------------------------------------------------------- -do(Info)-> - case proplists:get_value(status, Info#mod.data) of - {_Status_code, _PhraseArgs, _Reason}-> - {proceed,Info#mod.data}; - undefined -> - control_path(Info) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The functions that start the control if there is a accessfile %% -%% and if so controls if the dir is allowed or not %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -%Info = record mod as specified in httpd.hrl -%returns either {proceed,Info#mod.data} -%{proceed,[{status,403....}|Info#mod.data]} -%{proceed,[{status,401....}|Info#mod.data]} -%{proceed,[{status,500....}|Info#mod.data]} -%---------------------------------------------------------------------- -control_path(Info) -> - Path = mod_alias:path(Info#mod.data, - Info#mod.config_db, - Info#mod.request_uri), - case isErlScriptOrNotAccessibleFile(Path,Info) of - true-> - {proceed,Info#mod.data}; - false-> - case getHtAccessData(Path,Info)of - {ok,public}-> - %%There was no restrictions on the page continue - {proceed,Info#mod.data}; - {error, _Reason} -> - %%Something got wrong continue or quit??????????????????/ - {proceed,Info#mod.data}; - {accessData,AccessData}-> - controlAllowedMethod(Info,AccessData) - end - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% These methods controls that the method the client used in the %% -%% request is one of the limited %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -%Control that if the accessmethod used is in the list of modes to challenge -% -%Info is the mod record as specified in httpd.hrl -%AccessData is an ets table whit the data in the .htaccessfiles -%---------------------------------------------------------------------- -controlAllowedMethod(Info,AccessData)-> - case allowedRequestMethod(Info,AccessData) of - allow-> - %%The request didnt use one of the limited methods - ets:delete(AccessData), - {proceed,Info#mod.data}; - challenge-> - authenticateUser(Info,AccessData) - end. - -%---------------------------------------------------------------------- -%Check the specified access method in the .htaccessfile -%---------------------------------------------------------------------- -allowedRequestMethod(Info,AccessData)-> - case ets:lookup(AccessData,limit) of - [{limit,all}]-> - challenge; - [{limit,Methods}]-> - isLimitedRequestMethod(Info,Methods) - end. - - -%---------------------------------------------------------------------- -%Check the specified accessmethods in the .htaccesfile against the users -%accessmethod -% -%Info is the record from the do call -%Methods is a list of the methods specified in the .htaccessfile -%---------------------------------------------------------------------- -isLimitedRequestMethod(Info,Methods)-> - case lists:member(Info#mod.method,Methods) of - true-> - challenge; - false -> - allow - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% These methods controls that the user comes from an allowwed net %% -%% and if so wheather its a valid user or a challenge shall be %% -%% generated %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -%The first thing to control is that the user is from a network -%that has access to the page -%---------------------------------------------------------------------- -authenticateUser(Info,AccessData)-> - case controlNet(Info,AccessData) of - allow-> - %the network is ok control that it is an allowed user - authenticateUser2(Info,AccessData); - deny-> - %The user isnt allowed to access the pages from that network - ets:delete(AccessData), - {proceed,[{status,{403,Info#mod.request_uri, - "Restricted area not allowed from your network"}}|Info#mod.data]} - end. - - -%---------------------------------------------------------------------- -%The network the user comes from is allowed to view the resources -%control whether the user needsto supply a password or not -%---------------------------------------------------------------------- -authenticateUser2(Info,AccessData)-> - case ets:lookup(AccessData,require) of - [{require,AllowedUsers}]-> - case ets:lookup(AccessData,auth_name) of - [{auth_name,Realm}]-> - authenticateUser2(Info,AccessData,Realm,AllowedUsers); - _NoAuthName-> - ets:delete(AccessData), - {break,[{status,{500,none, - ?NICE("mod_htaccess:AuthName directive " - "not specified")}}]} - end; - [] -> - %%No special user is required the network is ok so let - %%the user in - ets:delete(AccessData), - {proceed,Info#mod.data} - end. - - -%---------------------------------------------------------------------- -%The user must send a userId and a password to get the resource -%Control if its already in the http-request -%if the file with users is bad send an 500 response -%---------------------------------------------------------------------- -authenticateUser2(Info,AccessData,Realm,AllowedUsers)-> - case authenticateUser(Info,AccessData,AllowedUsers) of - allow -> - ets:delete(AccessData), - {user,Name, _Pwd} = getAuthenticatingDataFromHeader(Info), - {proceed, [{remote_user_name,Name}|Info#mod.data]}; - challenge-> - ets:delete(AccessData), - ReasonPhrase = httpd_util:reason_phrase(401), - Message = httpd_util:message(401,none,Info#mod.config_db), - {proceed, - [{response, - {401, - ["WWW-Authenticate: Basic realm=\"",Realm, - "\"\r\n\r\n","<HTML>\n<HEAD>\n<TITLE>", - ReasonPhrase,"</TITLE>\n", - "</HEAD>\n<BODY>\n<H1>",ReasonPhrase, - "</H1>\n",Message,"\n</BODY>\n</HTML>\n"]}}| - Info#mod.data]}; - deny-> - ets:delete(AccessData), - {break,[{status,{500,none, - ?NICE("mod_htaccess:Bad path to user " - "or group file")}}]} - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Methods that validate the netwqork the user comes from %% -%% according to the allowed networks %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%--------------------------------------------------------------------- -%Controls the users networkaddress agains the specifed networks to -%allow or deny -% -%returns either allow or deny -%---------------------------------------------------------------------- -controlNet(Info,AccessData)-> - UserNetwork=getUserNetworkAddress(Info), - case getAllowDenyOrder(AccessData) of - {_deny,[],_allow,[]}-> - allow; - {deny,[],allow,AllowedNetworks}-> - controlIfAllowed(AllowedNetworks,UserNetwork,allow,deny); - {allow,AllowedNetworks,deny,[]}-> - controlIfAllowed(AllowedNetworks,UserNetwork,allow,deny); - - {deny,DeniedNetworks,allow,[]}-> - controlIfAllowed(DeniedNetworks,UserNetwork,allow,deny); - {allow,[],deny,DeniedNetworks}-> - controlIfAllowed(DeniedNetworks,UserNetwork,allow,deny); - - {deny,DeniedNetworks,allow,AllowedNetworks}-> - controlDenyAllow(DeniedNetworks,AllowedNetworks,UserNetwork); - {allow,AllowedNetworks,deny,DeniedNetworks}-> - controlAllowDeny(AllowedNetworks,DeniedNetworks,UserNetwork) - end. - - -%---------------------------------------------------------------------- -%Returns the users IP-Number -%---------------------------------------------------------------------- -getUserNetworkAddress(Info)-> - {_Socket,Address}=(Info#mod.init_data)#init_data.peername, - Address. - - -%---------------------------------------------------------------------- -%Control the users Ip-number against the ip-numbers in the .htaccessfile -%---------------------------------------------------------------------- -controlIfAllowed(AllowedNetworks,UserNetwork,IfAllowed,IfDenied)-> - case AllowedNetworks of - [{allow,all}]-> - IfAllowed; - [{deny,all}]-> - IfDenied; - [{deny,Networks}]-> - memberNetwork(Networks,UserNetwork,IfDenied,IfAllowed); - [{allow,Networks}]-> - memberNetwork(Networks,UserNetwork,IfAllowed,IfDenied); - _Error-> - IfDenied - end. - - -%---------------------------------------------------------------------% -%The Denycontrol isn't neccessary to preform since the allow control % -%override the deny control % -%---------------------------------------------------------------------% -controlDenyAllow(_DeniedNetworks, AllowedNetworks, UserNetwork)-> - case AllowedNetworks of - [{allow, all}]-> - allow; - [{allow, Networks}]-> - case memberNetwork(Networks, UserNetwork) of - true-> - allow; - false-> - deny - end - end. - - -%----------------------------------------------------------------------% -%Control that the user is in the allowed list if so control that the % -%network is in the denied list -%----------------------------------------------------------------------% -controlAllowDeny(AllowedNetworks,DeniedNetworks,UserNetwork)-> - case controlIfAllowed(AllowedNetworks,UserNetwork,allow,deny) of - allow-> - controlIfAllowed(DeniedNetworks,UserNetwork,deny,allow); - deny -> - deny - end. - -%---------------------------------------------------------------------- -%Controls if the users Ipnumber is in the list of either denied or -%allowed networks -%---------------------------------------------------------------------- -memberNetwork(Networks,UserNetwork,IfTrue,IfFalse)-> - case memberNetwork(Networks,UserNetwork) of - true-> - IfTrue; - false-> - IfFalse - end. - - -%---------------------------------------------------------------------- -%regexp match the users ip-address against the networks in the list of -%ipadresses or subnet addresses. -memberNetwork(Networks,UserNetwork)-> - case lists:filter(fun(Net)-> - case re:run(UserNetwork, - formatRegexp(Net), [{capture, first}]) of - {match,[{0,_}]}-> - true; - _NotSubNet -> - false - end - end,Networks) of - []-> - false; - _MemberNetWork -> - true - end. - - -%---------------------------------------------------------------------- -%Creates a regexp from an ip-number i.e "127.0.0-> "^127[.]0[.]0.*" -%"127.0.0.-> "^127[.]0[.]0[.].*" -%---------------------------------------------------------------------- -formatRegexp(Net)-> - [SubNet1|SubNets]=string:tokens(Net,"."), - NetRegexp=lists:foldl(fun(SubNet,Newnet)-> - Newnet ++ "[.]" ++SubNet - end,"^"++SubNet1,SubNets), - case string:len(Net)-string:rchr(Net,$.) of - 0-> - NetRegexp++"[.].*"; - _-> - NetRegexp++".*" - end. - -%---------------------------------------------------------------------- -%If the user has specified if the allow or deny check shall be preformed -%first get that order if no order is specified take -%allow - deny since its harder that deny - allow -%---------------------------------------------------------------------- -getAllowDenyOrder(AccessData)-> - case ets:lookup(AccessData,order) of - [{order,{deny,allow}}]-> - {deny,ets:lookup(AccessData,deny), - allow,ets:lookup(AccessData,allow)}; - _DefaultOrder-> - {allow,ets:lookup(AccessData,allow), - deny,ets:lookup(AccessData,deny)} - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The methods that validates the user %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -%Control if there is anyu autheticating data in threquest header -%if so it controls it against the users in the list Allowed Users -%---------------------------------------------------------------------- -authenticateUser(Info,AccessData,AllowedUsers)-> - case getAuthenticatingDataFromHeader(Info) of - {user,User,PassWord}-> - authenticateUser(Info,AccessData,AllowedUsers, - {user,User,PassWord}); - {error,nouser}-> - challenge; - {error, _BadData}-> - challenge - end. - - -%---------------------------------------------------------------------- -%Returns the Autheticating data in the http-request -%---------------------------------------------------------------------- -getAuthenticatingDataFromHeader(Info)-> - PrsedHeader=Info#mod.parsed_header, - case proplists:get_value("authorization", PrsedHeader) of - undefined-> - {error,nouser}; - [$B,$a,$s,$i,$c,$\ |EncodedString] = Credentials -> - case (catch base64:decode_to_string(EncodedString)) of - {'EXIT',{function_clause, _}} -> - {error, Credentials}; - UnCodedString -> - case httpd_util:split(UnCodedString,":",2) of - {ok,[User,PassWord]}-> - {user,User,PassWord}; - Other -> - {error, Other} - end - end; - BadCredentials -> - {error,BadCredentials} - end. - -%---------------------------------------------------------------------- -%Returns a list of all members of the allowed groups -%---------------------------------------------------------------------- -getGroupMembers(Groups,AllowedGroups)-> - Allowed=lists:foldl(fun({group,Name,Members},AllowedMembers)-> - case lists:member(Name,AllowedGroups) of - true-> - AllowedMembers++Members; - false -> - AllowedMembers - end - end,[],Groups), - {ok,Allowed}. - -authenticateUser(Info,AccessData,{{users,[]},{groups,Groups}},User)-> - authenticateUser(Info,AccessData,{groups,Groups},User); -authenticateUser(Info,AccessData,{{users,Users},{groups,[]}},User)-> - authenticateUser(Info,AccessData,{users,Users},User); - -authenticateUser(Info,AccessData,{{users,Users},{groups,Groups}},User)-> - AllowUser=authenticateUser(Info,AccessData,{users,Users},User), - AllowGroup=authenticateUser(Info,AccessData,{groups,Groups},User), - case {AllowGroup,AllowUser} of - {_,allow}-> - allow; - {allow,_}-> - allow; - {challenge,_}-> - challenge; - {_,challenge}-> - challenge; - {_deny,_deny}-> - deny - end; - - -%---------------------------------------------------------------------- -%Controls that the user is a member in one of the allowed group -%---------------------------------------------------------------------- -authenticateUser(Info,AccessData,{groups,AllowedGroups},{user,User,PassWord})-> - case getUsers(AccessData,group_file) of - {group_data,Groups}-> - {ok, Members } = getGroupMembers(Groups,AllowedGroups), - authenticateUser(Info,AccessData,{users,Members}, - {user,User,PassWord}); - {error, _BadData}-> - deny - end; - - -%---------------------------------------------------------------------- -%Control that the user is one of the allowed users and that the passwd is ok -%---------------------------------------------------------------------- -authenticateUser(_Info,AccessData,{users,AllowedUsers},{user,User,PassWord})-> - case lists:member(User,AllowedUsers) of - true-> - %Get the usernames and passwords from the file - case getUsers(AccessData,user_file) of - {error, _BadData}-> - deny; - {user_data,Users}-> - %Users is a list of the users in - %the userfile [{user,User,Passwd}] - checkPassWord(Users,{user,User,PassWord}) - end; - false -> - challenge - end. - - -%---------------------------------------------------------------------- -%Control that the user User={user,"UserName","PassWd"} is -%member of the list of Users -%---------------------------------------------------------------------- -checkPassWord(Users,User)-> - case lists:member(User,Users) of - true-> - allow; - false-> - challenge - end. - - -%---------------------------------------------------------------------- -%Get the users in the specified file -%UserOrGroup is an atom that specify if its a group file or a user file -%i.e. group_file or user_file -%---------------------------------------------------------------------- -getUsers({file,FileName},UserOrGroup)-> - case file:open(FileName,[read]) of - {ok,AccessFileHandle} -> - getUsers({stream,AccessFileHandle},[],UserOrGroup); - {error,Reason} -> - {error,{Reason,FileName}} - end; - - -%---------------------------------------------------------------------- -%The method that starts the lokkong for user files -%---------------------------------------------------------------------- - -getUsers(AccessData,UserOrGroup)-> - case ets:lookup(AccessData,UserOrGroup) of - [{UserOrGroup,File}]-> - getUsers({file,File},UserOrGroup); - _ -> - {error,noUsers} - end. - - -%---------------------------------------------------------------------- -%Reads data from the filehandle File to the list FileData and when its -%reach the end it returns the list in a tuple {user_file|group_file,FileData} -%---------------------------------------------------------------------- -getUsers({stream,File},FileData,UserOrGroup)-> - case io:get_line(File,[]) of - eof when UserOrGroup =:= user_file -> - {user_data,FileData}; - eof when UserOrGroup =:= group_file -> - {group_data,FileData}; - Line -> - getUsers({stream,File}, - formatUser(Line,FileData,UserOrGroup),UserOrGroup) - end. - - -%---------------------------------------------------------------------- -%If the line is a comment remove it -%---------------------------------------------------------------------- -formatUser([$#|_UserDataComment],FileData,_UserOrgroup)-> - FileData; - - -%---------------------------------------------------------------------- -%The user name in the file is Username:Passwd\n -%Remove the newline sign and split the user name in -%UserName and Password -%---------------------------------------------------------------------- -formatUser(UserData,FileData,UserOrGroup)-> - case string:tokens(UserData," \r\n")of - [User| _Whitespace] when UserOrGroup =:= user_file -> - case string:tokens(User,":") of - [Name,PassWord]-> - [{user,Name,PassWord}|FileData]; - _Error-> - FileData - end; - GroupData when UserOrGroup =:= group_file -> - parseGroupData(GroupData,FileData); - _Error -> - FileData - end. - - -%---------------------------------------------------------------------- -%if everything is right GroupData is on the form -% ["groupName:", "Member1", "Member2", "Member2" -%---------------------------------------------------------------------- -parseGroupData([GroupName|GroupData],FileData)-> - [{group,formatGroupName(GroupName),GroupData}|FileData]. - - -%---------------------------------------------------------------------- -%the line in the file is GroupName: Member1 Member2 .....MemberN -%Remove the : from the group name -%---------------------------------------------------------------------- -formatGroupName(GroupName)-> - string:strip(GroupName,right,$:). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Functions that parses the accessfiles %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%---------------------------------------------------------------------- -%Control that the asset is a real file and not a request for an virtual -%asset -%---------------------------------------------------------------------- -isErlScriptOrNotAccessibleFile(Path, _Info)-> - case file:read_file_info(Path) of - {ok,_fileInfo}-> - false; - {error,_Reason} -> - true - end. - - -%---------------------------------------------------------------------- -%Path=PathToTheRequestedFile=String -%Innfo=record#mod -%---------------------------------------------------------------------- -getHtAccessData(Path,Info)-> - HtAccessFileNames=getHtAccessFileNames(Info), - case getData(Path,Info,HtAccessFileNames) of - {ok,public}-> - {ok,public}; - {accessData,AccessData}-> - {accessData,AccessData}; - {error,Reason} -> - {error,Reason} - end. - - -%---------------------------------------------------------------------- -%returns the names of the accessfiles -%---------------------------------------------------------------------- -getHtAccessFileNames(Info)-> - case httpd_util:lookup(Info#mod.config_db,access_files) of - undefined-> - [".htaccess"]; - Files-> - Files - end. -%---------------------------------------------------------------------- -%HtAccessFileNames=["accessfileName1",..."AccessFileName2"] -%---------------------------------------------------------------------- -getData(Path,Info,HtAccessFileNames)-> - SplittedPath = re:split(Path, "/", [{return, list}]), - getData2(HtAccessFileNames,SplittedPath,Info). - -%---------------------------------------------------------------------- -%Add to together the data in the Splittedpath up to the path -%that is the alias or the document root -%Since we do not need to control after any accessfiles before here -%---------------------------------------------------------------------- -getData2(HtAccessFileNames,SplittedPath,Info)-> - case getRootPath(SplittedPath,Info) of - {error,Path}-> - {error,Path}; - {ok,StartPath,RestOfSplittedPath} -> - getData2(HtAccessFileNames,StartPath,RestOfSplittedPath,Info) - end. - - -%---------------------------------------------------------------------- -%HtAccessFilenames is a list the names the accesssfiles can have -%Path is the shortest match agains all alias and documentroot -%rest of splitted path is a list of the parts of the path -%Info is the mod recod from the server -%---------------------------------------------------------------------- -getData2(HtAccessFileNames, StartPath, RestOfSplittedPath, _Info)-> - case getHtAccessFiles(HtAccessFileNames,StartPath,RestOfSplittedPath) of - []-> - %No accessfile qiut its a public directory - {ok,public}; - Files -> - loadAccessFilesData(Files) - end. - - -%---------------------------------------------------------------------- -%Loads the data in the accessFiles specifiied by -% AccessFiles=["/hoem/public/html/accefile", -% "/home/public/html/priv/accessfile"] -%---------------------------------------------------------------------- -loadAccessFilesData(AccessFiles)-> - loadAccessFilesData(AccessFiles,ets:new(accessData,[])). - - -%---------------------------------------------------------------------- -%Returns the found data -%---------------------------------------------------------------------- -contextToValues(AccessData)-> - case ets:lookup(AccessData,context) of - [{context,Values}]-> - ets:delete(AccessData,context), - insertContext(AccessData,Values), - {accessData,AccessData}; - _Error-> - {error,errorInAccessFile} - end. - - -insertContext(_AccessData, [])-> - ok; - -insertContext(AccessData,[{allow,From}|Values])-> - insertDenyAllowContext(AccessData,{allow,From}), - insertContext(AccessData,Values); - -insertContext(AccessData,[{deny,From}|Values])-> - insertDenyAllowContext(AccessData,{deny,From}), - insertContext(AccessData,Values); - -insertContext(AccessData,[{require,{GrpOrUsr,Members}}|Values])-> - case ets:lookup(AccessData,require) of - [] when GrpOrUsr =:= users -> - ets:insert(AccessData,{require,{{users,Members},{groups,[]}}}); - - [{require,{{users,Users},{groups,Groups}}}] when GrpOrUsr =:= users -> - ets:insert(AccessData,{require,{{users,Users++Members}, - {groups,Groups}}}); - [] when GrpOrUsr =:= groups -> - ets:insert(AccessData,{require,{{users,[]},{groups,Members}}}); - - [{require,{{users,Users},{groups,Groups}}}] when GrpOrUsr =:= groups -> - ets:insert(AccessData,{require,{{users,Users}, - {groups,Groups++Members}}}) - end, - insertContext(AccessData,Values); - - - -%%limit and order directive need no transforming they areis just to insert -insertContext(AccessData,[Elem|Values])-> - ets:insert(AccessData,Elem), - insertContext(AccessData,Values). - - -insertDenyAllowContext(AccessData,{AllowDeny,From})-> - case From of - all -> - ets:insert(AccessData,{AllowDeny,all}); - _AllowedSubnets -> - case ets:lookup(AccessData,AllowDeny) of - []-> - ets:insert(AccessData,{AllowDeny,From}); - [{AllowDeny,all}]-> - ok; - [{AllowDeny,Networks}]-> - ets:insert(AccessData,{allow,Networks++From}) - end - end. - -loadAccessFilesData([],AccessData)-> - %preform context to limits - contextToValues(AccessData), - {accessData,AccessData}; - -%---------------------------------------------------------------------- -%Takes each file in the list and load the data to the ets table -%AccessData -%---------------------------------------------------------------------- -loadAccessFilesData([FileName|FileNames],AccessData)-> - case loadAccessFileData({file,FileName},AccessData) of - overRide-> - loadAccessFilesData(FileNames,AccessData); - noOverRide -> - {accessData,AccessData}; - error-> - ets:delete(AccessData), - {error,errorInAccessFile} - end. - -%---------------------------------------------------------------------- -%opens the filehandle to the specified file -%---------------------------------------------------------------------- -loadAccessFileData({file,FileName},AccessData)-> - case file:open(FileName,[read]) of - {ok,AccessFileHandle}-> - loadAccessFileData({stream,AccessFileHandle},AccessData,[]); - {error, _Reason} -> - overRide - end. - -%---------------------------------------------------------------------- -%%look att each line in the file and add them to the database -%%When end of file is reached control i overrride is allowed -%% if so return -%---------------------------------------------------------------------- -loadAccessFileData({stream,File},AccessData,FileData)-> - case io:get_line(File,[]) of - eof-> - insertData(AccessData,FileData), - case ets:match_object(AccessData,{'_',error}) of - []-> - %Case we got no error control that we can override a - %at least some of the values - case ets:match_object(AccessData, - {allow_over_ride,none}) of - []-> - overRide; - _NoOverride-> - noOverRide - end; - _ -> - error - end; - Line -> - loadAccessFileData({stream,File},AccessData, - insertLine(string:strip(Line,left),FileData)) - end. - -%---------------------------------------------------------------------- -%AccessData is a ets table where the previous found data is inserted -%FileData is a list of the directives in the last parsed file -%before insertion a control is done that the directive is allowed to -%override -%---------------------------------------------------------------------- -insertData(AccessData,{{context,Values},FileData})-> - insertData(AccessData,[{context,Values}|FileData]); - -insertData(AccessData,FileData)-> - case ets:lookup(AccessData,allow_over_ride) of - [{allow_over_ride,all}]-> - lists:foreach(fun(Elem)-> - ets:insert(AccessData,Elem) - end,FileData); - []-> - lists:foreach(fun(Elem)-> - ets:insert(AccessData,Elem) - end,FileData); - [{allow_over_ride,Directives}] when is_list(Directives)-> - lists:foreach(fun({Key,Value}) -> - case lists:member(Key,Directives) of - true-> - ok; - false -> - ets:insert(AccessData,{Key,Value}) - end - end,FileData); - [{allow_over_ride,_}]-> - %Will never appear if the user - %aint doing very strang econfig files - ok - end. -%---------------------------------------------------------------------- -%Take a line in the accessfile and transform it into a tuple that -%later can be inserted in to the ets:table -%---------------------------------------------------------------------- -%%%Here is the alternatives that resides inside the limit context - -insertLine("order"++ Order, {{context, Values}, FileData})-> - {{context,[{order,getOrder(Order)}|Values]},FileData}; -%%Let the user place a tab in the beginning -insertLine([$\t,$o,$r,$d,$e,$r|Order],{{context,Values},FileData})-> - {{context,[{order,getOrder(Order)}|Values]},FileData}; - -insertLine("allow" ++ Allow, {{context, Values}, FileData})-> - {{context,[{allow,getAllowDenyData(Allow)}|Values]},FileData}; -insertLine([$\t,$a,$l,$l,$o,$w|Allow],{{context,Values},FileData})-> - {{context,[{allow,getAllowDenyData(Allow)}|Values]},FileData}; - -insertLine("deny" ++ Deny, {{context,Values}, FileData})-> - {{context,[{deny,getAllowDenyData(Deny)}|Values]},FileData}; -insertLine([$\t, $d,$e,$n,$y|Deny],{{context,Values},FileData})-> - {{context,[{deny,getAllowDenyData(Deny)}|Values]},FileData}; - -insertLine("require" ++ Require, {{context, Values}, FileData})-> - {{context,[{require,getRequireData(Require)}|Values]},FileData}; -insertLine([$\t,$r,$e,$q,$u,$i,$r,$e|Require],{{context,Values},FileData})-> - {{context,[{require,getRequireData(Require)}|Values]},FileData}; - -insertLine("</Limit" ++ _EndLimit, {Context,FileData})-> - [Context | FileData]; -insertLine("<Limit" ++ Limit, FileData)-> - {{context,[{limit,getLimits(Limit)}]}, FileData}; - -insertLine([$A,$u,$t,$h,$U,$s,$e,$r,$F,$i,$l,$e,$\ |AuthUserFile],FileData)-> - [{user_file,string:strip(AuthUserFile,right,$\n)}|FileData]; - -insertLine([$A,$u,$t,$h,$G,$r,$o,$u,$p,$F,$i,$l,$e,$\ |AuthGroupFile], - FileData)-> - [{group_file,string:strip(AuthGroupFile,right,$\n)}|FileData]; - -insertLine("AllowOverRide" ++ AllowOverRide, FileData)-> - [{allow_over_ride,getAllowOverRideData(AllowOverRide)} - | FileData]; - -insertLine([$A,$u,$t,$h,$N,$a,$m,$e,$\ |AuthName],FileData)-> - [{auth_name,string:strip(AuthName,right,$\n)}|FileData]; - -insertLine("AuthType" ++ AuthType,FileData)-> - [{auth_type,getAuthorizationType(AuthType)}|FileData]; - -insertLine(_BadDirectiveOrComment,FileData)-> - FileData. - -%---------------------------------------------------------------------- -%transform the Data specified about override to a form that is ieasier -%handled later -%Override data="all"|"md5"|"Directive1 .... DirectioveN" -%---------------------------------------------------------------------- - -getAllowOverRideData(OverRideData)-> - case string:tokens(OverRideData," \r\n") of - ["all" ++ _] -> - all; - ["none" ++ _]-> - none; - Directives -> - getOverRideDirectives(Directives) - end. - -getOverRideDirectives(Directives)-> - lists:map(fun(Directive)-> - transformDirective(Directive) - end,Directives). -transformDirective("AuthUserFile" ++ _)-> - user_file; -transformDirective("AuthGroupFile" ++ _) -> - group_file; -transformDirective("AuthName" ++ _)-> - auth_name; -transformDirective("AuthType" ++ _)-> - auth_type; -transformDirective(_UnAllowedOverRideDirective) -> - unallowed. -%---------------------------------------------------------------------- -%Replace the string that specify which method to use for authentication -%and replace it with the atom for easier mathing -%---------------------------------------------------------------------- -getAuthorizationType(AuthType)-> - [Arg | _Crap] = string:tokens(AuthType,"\n\r\ "), - case Arg of - "Basic"-> - basic; - "MD5" -> - md5; - _What -> - error - end. -%---------------------------------------------------------------------- -%Returns a list of the specified methods to limit or the atom all -%---------------------------------------------------------------------- -getLimits(Limits)-> - case re:split(Limits,">", [{return, list}])of - [_NoEndOnLimit]-> - error; - [Methods | _Crap]-> - case re:split(Methods," ", [{return, list}]) of - [[]]-> - all; - SplittedMethods -> - SplittedMethods - end - end. - - -%---------------------------------------------------------------------- -% Transform the order to prefrom deny allow control to a tuple of atoms -%---------------------------------------------------------------------- -getOrder(Order)-> - [First | _Rest]=lists:map(fun(Part)-> - list_to_atom(Part) - end,string:tokens(Order," \n\r")), - case First of - deny-> - {deny,allow}; - allow-> - {allow,deny}; - _Error-> - error - end. - -%---------------------------------------------------------------------- -% The string AllowDeny is "from all" or "from Subnet1 Subnet2...SubnetN" -%---------------------------------------------------------------------- -getAllowDenyData(AllowDeny)-> - case string:tokens(AllowDeny," \n\r") of - [_From|AllowDenyData] when length(AllowDenyData)>=1 -> - case lists:nth(1,AllowDenyData) of - "all" -> - all; - _Hosts-> - AllowDenyData - end; - _ -> - error - end. -%---------------------------------------------------------------------- -% Fix the string that describes who is allowed to se the page -%---------------------------------------------------------------------- -getRequireData(Require)-> - [UserOrGroup|UserData]=string:tokens(Require," \n\r"), - case UserOrGroup of - "user"-> - {users,UserData}; - "group" -> - {groups,UserData}; - _Whatever -> - error - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Methods that collects the searchways to the accessfiles %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%---------------------------------------------------------------------- -% Get the whole path to the different accessfiles -%---------------------------------------------------------------------- -getHtAccessFiles(HtAccessFileNames,Path,RestOfSplittedPath)-> - getHtAccessFiles(HtAccessFileNames,Path,RestOfSplittedPath,[]). - -getHtAccessFiles(HtAccessFileNames,Path,[[]],HtAccessFiles)-> - HtAccessFiles ++ accessFilesOfPath(HtAccessFileNames,Path++"/"); - -getHtAccessFiles(_HtAccessFileNames, _Path, [], HtAccessFiles)-> - HtAccessFiles; -getHtAccessFiles(HtAccessFileNames,Path,[NextDir|RestOfSplittedPath], - AccessFiles)-> - getHtAccessFiles(HtAccessFileNames,Path++"/"++NextDir,RestOfSplittedPath, - AccessFiles ++ - accessFilesOfPath(HtAccessFileNames,Path++"/")). - - -%---------------------------------------------------------------------- -%Control if therer are any accessfies in the path -%---------------------------------------------------------------------- -accessFilesOfPath(HtAccessFileNames,Path)-> - lists:foldl(fun(HtAccessFileName,Files)-> - case file:read_file_info(Path++HtAccessFileName) of - {ok, _}-> - [Path++HtAccessFileName|Files]; - {error,_Error} -> - Files - end - end,[],HtAccessFileNames). - - -%---------------------------------------------------------------------- -%Sake the splitted path and joins it up to the documentroot or the alias -%that match first -%---------------------------------------------------------------------- - -getRootPath(SplittedPath, Info)-> - DocRoot=httpd_util:lookup(Info#mod.config_db,document_root,"/"), - PresumtiveRootPath= - [DocRoot|lists:map(fun({_Alias,RealPath})-> - RealPath - end, - httpd_util:multi_lookup(Info#mod.config_db,alias))], - getRootPath(PresumtiveRootPath,SplittedPath,Info). - - -getRootPath(PresumtiveRootPath,[[],Splittedpath],Info)-> - getRootPath(PresumtiveRootPath,["/",Splittedpath],Info); - - -getRootPath(PresumtiveRootPath,[Part,NextPart|SplittedPath],Info)-> - case lists:member(Part,PresumtiveRootPath)of - true-> - {ok,Part,[NextPart|SplittedPath]}; - false -> - getRootPath(PresumtiveRootPath, - [Part++"/"++NextPart|SplittedPath],Info) - end; - -getRootPath(PresumtiveRootPath, [Part], _Info)-> - case lists:member(Part,PresumtiveRootPath)of - true-> - {ok,Part,[]}; - false -> - {error,Part} - end. diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index 41b2ab950f..54b60ee1f7 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -43,14 +43,14 @@ httpc_sup, httpc_cookie, - http_uri, %% Proably will by used by server also in the future - %% HTTP used by both client and server http_chunk, http_request, http_response, http_transport, http_util, + + http_uri, %% Deprecated %% HTTP server: httpd, @@ -83,14 +83,12 @@ mod_auth_mnesia, mod_auth_plain, mod_auth_server, - mod_browser, mod_cgi, mod_dir, mod_disk_log, mod_esi, mod_get, mod_head, - mod_htaccess, mod_log, mod_range, mod_responsecontrol, diff --git a/lib/inets/test/http_format_SUITE.erl b/lib/inets/test/http_format_SUITE.erl index 3ff3ed4e97..6492325701 100644 --- a/lib/inets/test/http_format_SUITE.erl +++ b/lib/inets/test/http_format_SUITE.erl @@ -454,7 +454,7 @@ validate_request_line() -> validate_request_line(Config) when is_list(Config) -> %% HTTP/0.9 only has GET requests - ok = + {ok, "http://www.erlang/org"} = httpd_request:validate("GET", "http://www.erlang/org", "HTTP/0.9"), {error, {not_supported, {"HEAD", "http://www.erlang/org", "HTTP/0.9"}}} = @@ -467,43 +467,37 @@ validate_request_line(Config) when is_list(Config) -> httpd_request:validate("POST", "http://www.erlang/org", "HTTP/0.9"), %% HTTP/1.* - ok = httpd_request:validate("HEAD", "http://www.erlang/org", + {ok, "http://www.erlang/org"} = httpd_request:validate("HEAD", "http://www.erlang/org", "HTTP/1.1"), - ok = httpd_request:validate("GET", "http://www.erlang/org", + {ok, "http://www.erlang/org"} = httpd_request:validate("GET", "http://www.erlang/org", "HTTP/1.1"), - ok = httpd_request:validate("POST","http://www.erlang/org", - "HTTP/1.1"), - ok = httpd_request:validate("TRACE","http://www.erlang/org", + {ok, "http://www.erlang/org"} = httpd_request:validate("POST","http://www.erlang/org", "HTTP/1.1"), + {ok, "http://www.erlang/org"} = httpd_request:validate("TRACE","http://www.erlang/org", + "HTTP/1.1"), {error, {not_supported, {"FOOBAR", "http://www.erlang/org", "HTTP/1.1"}}} = httpd_request:validate("FOOBAR", "http://www.erlang/org", "HTTP/1.1"), + %%% Will work after normalization + Uri = "http://127.0.0.1:8888/../../../../../etc/passwd", + {ok, "http://127.0.0.1:8888/etc/passwd"} = httpd_request:validate("GET", Uri, "HTTP/1.1"), - %% Attempts to get outside of server_root directory by relative links - ForbiddenUri = "http://127.0.0.1:8888/../../../../../etc/passwd", - {error, {bad_request, {forbidden, ForbiddenUri}}} = - httpd_request:validate("GET", ForbiddenUri, "HTTP/1.1"), - - ForbiddenUri2 = + Uri2 = "http://127.0.0.1:8888/././././././../../../../../etc/passwd", - {error, {bad_request, {forbidden, ForbiddenUri2}}} = - httpd_request:validate("GET", ForbiddenUri2, "HTTP/1.1"), - - HexForbiddenUri = "http://127.0.0.1:8888/%2e%2e/%2e%2e/%2e%2e/" - "home/ingela/test.html", - {error, {bad_request, {forbidden, HexForbiddenUri}}} = - httpd_request:validate("GET", HexForbiddenUri, "HTTP/1.1"), - - NewForbiddenUri = - "http://127.0.0.1:8888/foobar/../../../home/ingela/test.html", - {error, {bad_request, {forbidden, NewForbiddenUri}}} = - httpd_request:validate("GET", NewForbiddenUri, "HTTP/1.1"), - - NewForbiddenUri1 = - "http://127.0.0.1:8888/../home/ingela/test.html", - {error, {bad_request, {forbidden, NewForbiddenUri1}}} = - httpd_request:validate("GET", NewForbiddenUri1, "HTTP/1.1"). + {ok, "http://127.0.0.1:8888/etc/passwd"} = httpd_request:validate("GET", Uri2, "HTTP/1.1"), + + HexUri = "http://127.0.0.1:8888/%2e%2e/%2e%2e/%2e%2e/" + "home/foobar/test.html", + {ok, "http://127.0.0.1:8888/home/foobar/test.html"} = httpd_request:validate("GET", HexUri, "HTTP/1.1"), + + NewUri = + "http://127.0.0.1:8888/foobar/../../../home/foobar/test.html", + {ok,"http://127.0.0.1:8888/home/foobar/test.html"} = httpd_request:validate("GET", NewUri, "HTTP/1.1"), + + Uri1 = + "http://127.0.0.1:8888/../home/foobar/test.html", + {ok,"http://127.0.0.1:8888/home/foobar/test.html"} = httpd_request:validate("GET", Uri1, "HTTP/1.1"). %%------------------------------------------------------------------------- check_content_length_encoding() -> diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 1289432f0d..da60a9a9c2 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -68,8 +68,6 @@ all() -> {group, https_auth_api_dets}, {group, http_auth_api_mnesia}, {group, https_auth_api_mnesia}, - {group, http_htaccess}, - {group, https_htaccess}, {group, http_security}, {group, https_security}, {group, http_reload}, @@ -84,8 +82,7 @@ all() -> mime_types_format, erl_script_timeout_default, erl_script_timeout_option, - erl_script_timeout_proplist, - erl_script_timeout_apache + erl_script_timeout_proplist ]. groups() -> @@ -104,8 +101,6 @@ groups() -> {https_auth_api_dets, [], [{group, auth_api_dets}]}, {http_auth_api_mnesia, [], [{group, auth_api_mnesia}]}, {https_auth_api_mnesia, [], [{group, auth_api_mnesia}]}, - {http_htaccess, [], [{group, htaccess}]}, - {https_htaccess, [], [{group, htaccess}]}, {http_security, [], [{group, security}]}, {https_security, [], [{group, security}]}, {http_logging, [], [{group, logging}]}, @@ -116,16 +111,16 @@ groups() -> {https_not_sup, [], [{group, not_sup}]}, {https_alert, [], [tls_alert]}, {http_mime_types, [], [alias_1_1, alias_1_0, alias_0_9]}, - {limit, [], [max_clients_1_1, max_clients_1_0, max_clients_0_9]}, + {limit, [], [content_length, max_clients_1_1]}, {custom, [], [customize, add_default]}, {reload, [], [non_disturbing_reconfiger_dies, disturbing_reconfiger_dies, non_disturbing_1_1, non_disturbing_1_0, non_disturbing_0_9, - disturbing_1_1, - disturbing_1_0, - disturbing_0_9, + disturbing_1_1, + disturbing_1_0, + disturbing_0_9, reload_config_file ]}, {post, [], [chunked_post, chunked_chunked_encoded_post, post_204]}, @@ -136,7 +131,6 @@ groups() -> ]}, {auth_api_mnesia, [], [auth_api_1_1, auth_api_1_0, auth_api_0_9 ]}, - {htaccess, [], [htaccess_1_1, htaccess_1_0, htaccess_0_9]}, {security, [], [security_1_1, security_1_0]}, %% Skip 0.9 as causes timing issus in test code {logging, [], [disk_log_internal, disk_log_exists, disk_log_bad_size, disk_log_bad_file]}, @@ -163,7 +157,6 @@ http_get() -> get, %%actions, Add configuration so that this test mod_action esi, - content_length, bad_hex, missing_CR, max_header, @@ -231,7 +224,7 @@ init_per_group(Group, Config0) when Group == https_basic; catch crypto:stop(), try crypto:start() of ok -> - init_ssl(Group, Config0) + init_ssl(Group, [{http_version, "HTTP/1.0"} | Config0]) catch _:_ -> {skip, "Crypto did not start"} @@ -250,7 +243,7 @@ init_per_group(Group, Config0) when Group == http_basic; Group == http_mime_types -> ok = start_apps(Group), - init_httpd(Group, [{type, ip_comm} | Config0]); + init_httpd(Group, [{http_version, "HTTP/1.0"}, {type, ip_comm} | Config0]); init_per_group(http_1_1, Config) -> [{http_version, "HTTP/1.1"} | Config]; init_per_group(http_1_0, Config) -> @@ -262,24 +255,6 @@ init_per_group(http_0_9, Config) -> _ -> [{http_version, "HTTP/0.9"} | Config] end; -init_per_group(http_htaccess = Group, Config) -> - Path = proplists:get_value(doc_root, Config), - catch remove_htaccess(Path), - create_htaccess_data(Path, proplists:get_value(address, Config)), - ok = start_apps(Group), - init_httpd(Group, [{type, ip_comm} | Config]); -init_per_group(https_htaccess = Group, Config) -> - Path = proplists:get_value(doc_root, Config), - catch remove_htaccess(Path), - create_htaccess_data(Path, proplists:get_value(address, Config)), - catch crypto:stop(), - try crypto:start() of - ok -> - init_ssl(Group, Config) - catch - _:_ -> - {skip, "Crypto did not start"} - end; init_per_group(auth_api, Config) -> [{auth_prefix, ""} | Config]; init_per_group(auth_api_dets, Config) -> @@ -306,7 +281,6 @@ end_per_group(Group, _Config) when Group == http_basic; Group == http_auth_api; Group == http_auth_api_dets; Group == http_auth_api_mnesia; - Group == http_htaccess; Group == http_security; Group == http_reload; Group == http_post; @@ -319,7 +293,6 @@ end_per_group(Group, _Config) when Group == https_basic; Group == https_auth_api; Group == https_auth_api_dets; Group == https_auth_api_mnesia; - Group == https_htaccess; Group == https_security; Group == https_reload -> @@ -453,7 +426,8 @@ head(Config) when is_list(Config) -> Version = proplists:get_value(http_version, Config), Host = proplists:get_value(host, Config), ok = httpd_test_lib:verify_request(proplists:get_value(type, Config), Host, - proplists:get_value(port, Config), proplists:get_value(node, Config), + proplists:get_value(port, Config), + proplists:get_value(node, Config), http_request("HEAD /index.html ", Version, Host), [{statuscode, head_status(Version)}, {version, Version}]). @@ -799,139 +773,15 @@ post_204(Config) -> ct:fail({connect_error, ConnectError, [SockType, Host, Port, TranspOpts]}) catch - T:E -> + T:E:Stk -> ct:fail({connect_failure, [{type, T}, {error, E}, - {stacktrace, erlang:get_stacktrace()}, + {stacktrace, Stk}, {args, [SockType, Host, Port, TranspOpts]}]}) end. %%------------------------------------------------------------------------- -htaccess_1_1(Config) when is_list(Config) -> - htaccess([{http_version, "HTTP/1.1"} | Config]). - -htaccess_1_0(Config) when is_list(Config) -> - htaccess([{http_version, "HTTP/1.0"} | Config]). - -htaccess_0_9(Config) when is_list(Config) -> - htaccess([{http_version, "HTTP/0.9"} | Config]). - -htaccess() -> - [{doc, "Test mod_auth API"}]. - -htaccess(Config) when is_list(Config) -> - Version = proplists:get_value(http_version, Config), - Host = proplists:get_value(host, Config), - Type = proplists:get_value(type, Config), - Port = proplists:get_value(port, Config), - Node = proplists:get_value(node, Config), - %% Control that authentication required! - %% Control that the pages that shall be - %% authenticated really need authenticatin - ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - http_request("GET /ht/open/ ", Version, Host), - [{statuscode, 401}, - {version, Version}, - {header, "WWW-Authenticate"}]), - ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - http_request("GET /ht/secret/ ", Version, Host), - [{statuscode, 401}, - {version, Version}, - {header, "WWW-Authenticate"}]), - ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - http_request("GET /ht/secret/top_secret/ ", - Version, Host), - [{statuscode, 401}, - {version, Version}, - {header, "WWW-Authenticate"}]), - - %% Make sure Authenticate header is received even the second time - %% we try a incorrect password! Otherwise a browser client will hang! - ok = auth_status(auth_request("/ht/open/", - "dummy", "WrongPassword", Version, Host), Config, - [{statuscode, 401}, - {header, "WWW-Authenticate"}]), - ok = auth_status(auth_request("/ht/open/", - "dummy", "WrongPassword", Version, Host), Config, - [{statuscode, 401}, - {header, "WWW-Authenticate"}]), - - %% Control that not just the first user in the list is valid - %% Control the first user - %% Authennticating ["one:OnePassword" user first in user list] - ok = auth_status(auth_request("/ht/open/dummy.html", "one", "OnePassword", - Version, Host), Config, - [{statuscode, 200}]), - - %% Control the second user - %% Authentication OK and a directory listing is supplied! - %% ["Aladdin:open sesame" user second in user list] - ok = auth_status(auth_request("/ht/open/","Aladdin", - "AladdinPassword", Version, Host), Config, - [{statuscode, 200}]), - - %% Contro that bad passwords and userids get a good denial - %% User correct but wrong password! ["one:one" user first in user list] - ok = auth_status(auth_request("/ht/open/", "one", "one", Version, Host), Config, - [{statuscode, 401}]), - %% Neither user or password correct! ["dummy:dummy"] - ok = auth_status(auth_request("/ht/open/", "dummy", "dummy", Version, Host), Config, - [{statuscode, 401}]), - - %% Control that authetication still works, even if its a member in a group - %% Authentication OK! ["two:TwoPassword" user in first group] - ok = auth_status(auth_request("/ht/secret/dummy.html", "two", - "TwoPassword", Version, Host), Config, - [{statuscode, 200}]), - - %% Authentication OK and a directory listing is supplied! - %% ["three:ThreePassword" user in second group] - ok = auth_status(auth_request("/ht/secret/", "three", - "ThreePassword", Version, Host), Config, - [{statuscode, 200}]), - - %% Deny users with bad passwords even if the user is a group member - %% User correct but wrong password! ["two:two" user in first group] - ok = auth_status(auth_request("/ht/secret/", "two", "two", Version, Host), Config, - [{statuscode, 401}]), - %% Neither user or password correct! ["dummy:dummy"] - ok = auth_status(auth_request("/ht/secret/", "dummy", "dummy", Version, Host), Config, - [{statuscode, 401}]), - - %% control that we deny the users that are in subnet above the allowed - ok = auth_status(auth_request("/ht/blocknet/dummy.html", "four", - "FourPassword", Version, Host), Config, - [{statuscode, 403}]), - %% Control that we only applies the rules to the right methods - ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - http_request("HEAD /ht/blocknet/dummy.html ", Version, Host), - [{statuscode, head_status(Version)}, - {version, Version}]), - - %% Control that the rerquire directive can be overrideen - ok = auth_status(auth_request("/ht/secret/top_secret/ ", "Aladdin", "AladdinPassword", - Version, Host), Config, - [{statuscode, 401}]), - - %% Authentication still required! - ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - http_request("GET /ht/open/ ", Version, Host), - [{statuscode, 401}, - {version, Version}, - {header, "WWW-Authenticate"}]), - ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - http_request("GET /ht/secret/ ", Version, Host), - [{statuscode, 401}, - {version, Version}, - {header, "WWW-Authenticate"}]), - ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - http_request("GET /ht/secret/top_secret/ ", Version, Host), - [{statuscode, 401}, - {version, Version}, - {header, "WWW-Authenticate"}]). - -%%------------------------------------------------------------------------- host() -> [{doc, "Test host header"}]. @@ -960,19 +810,6 @@ max_clients_1_1() -> max_clients_1_1(Config) when is_list(Config) -> do_max_clients([{http_version, "HTTP/1.1"} | Config]). -max_clients_1_0() -> - [{doc, "Test max clients limit"}]. - -max_clients_1_0(Config) when is_list(Config) -> - do_max_clients([{http_version, "HTTP/1.0"} | Config]). - -max_clients_0_9() -> - [{doc, "Test max clients limit"}]. - -max_clients_0_9(Config) when is_list(Config) -> - do_max_clients([{http_version, "HTTP/0.9"} | Config]). - - %%------------------------------------------------------------------------- put_not_sup() -> [{doc, "Test unhandled request"}]. @@ -1003,12 +840,6 @@ esi() -> [{doc, "Test mod_esi"}]. esi(Config) when is_list(Config) -> - ok = http_status("GET /eval?httpd_example:print(\"Hi!\") ", - Config, [{statuscode, 200}]), - ok = http_status("GET /eval?not_allowed:print(\"Hi!\") ", - Config, [{statuscode, 403}]), - ok = http_status("GET /eval?httpd_example:undef(\"Hi!\") ", - Config, [{statuscode, 500}]), ok = http_status("GET /cgi-bin/erl/httpd_example ", Config, [{statuscode, 400}]), ok = http_status("GET /cgi-bin/erl/httpd_example:get ", @@ -1590,20 +1421,20 @@ do_reconfiger_dies(Config, DisturbingType) -> Type = proplists:get_value(type, Config), HttpdConfig = httpd:info(Server), - BlockRequest = http_request("GET /eval?httpd_example:delay(2000) ", Version, Host), + BlockRequest = http_request("GET /cgi-bin/erl/httpd_example:delay ", Version, Host), {ok, Socket} = inets_test_lib:connect_bin(Type, Host, Port, transport_opts(Type, Config)), inets_test_lib:send(Type, Socket, BlockRequest), ct:sleep(100), %% Avoid possible timing issues Pid = spawn(fun() -> httpd:reload_config([{server_name, "httpd_kill_" ++ Version}, - {port, Port}| - proplists:delete(server_name, HttpdConfig)], DisturbingType) - end), + {port, Port}| + proplists:delete(server_name, HttpdConfig)], DisturbingType) + end), monitor(process, Pid), exit(Pid, kill), receive - {'DOWN', _, _, _, _} -> - ok + {'DOWN', _, _, _, _} -> + ok end, inets_test_lib:close(Type, Socket), [{server_name, "httpd_test"}] = httpd:info(Server, [server_name]). @@ -1624,7 +1455,8 @@ disturbing(Config) when is_list(Config)-> Port = proplists:get_value(port, Config), Type = proplists:get_value(type, Config), HttpdConfig = httpd:info(Server), - BlockRequest = http_request("GET /eval?httpd_example:delay(2000) ", Version, Host), + + BlockRequest = http_request("GET /cgi-bin/erl/httpd_example:delay ", Version, Host), {ok, Socket} = inets_test_lib:connect_bin(Type, Host, Port, transport_opts(Type, Config)), inets_test_lib:send(Type, Socket, BlockRequest), ct:sleep(100), %% Avoid possible timing issues @@ -1657,7 +1489,7 @@ non_disturbing(Config) when is_list(Config)-> Type = proplists:get_value(type, Config), HttpdConfig = httpd:info(Server), - BlockRequest = http_request("GET /eval?httpd_example:delay(2000) ", Version, Host), + BlockRequest = http_request("GET /cgi-bin/erl/httpd_example:delay ", Version, Host), {ok, Socket} = inets_test_lib:connect_bin(Type, Host, Port, transport_opts(Type, Config)), inets_test_lib:send(Type, Socket, BlockRequest), ct:sleep(100), %% Avoid possible timing issues @@ -1696,22 +1528,11 @@ reload_config_file(Config) when is_list(Config) -> "{server_root,\"" ++ ServerRoot ++ "\"}," ++ "{document_root,\"" ++ proplists:get_value(doc_root, Config) ++ "\"}" ++ "].", - NewConfigApache = - "BindAddress localhost\n" ++ - "Port " ++ integer_to_list(Port) ++ "\n" ++ - "ServerName httpd_test_new_apache\n" ++ - "ServerRoot " ++ ServerRoot ++ "\n" ++ - "DocumentRoot " ++ proplists:get_value(doc_root, Config) ++ "\n", - + %% Test Erlang term format ok = file:write_file(HttpdConf, NewConfig), ok = httpd:reload_config(HttpdConf, non_disturbing), - "httpd_test_new" = proplists:get_value(server_name, httpd:info(Server)), - - %% Test Apache format - ok = file:write_file(HttpdConf, NewConfigApache), - ok = httpd:reload_config(HttpdConf, non_disturbing), - "httpd_test_new_apache" = proplists:get_value(server_name, httpd:info(Server)). + "httpd_test_new" = proplists:get_value(server_name, httpd:info(Server)). %%------------------------------------------------------------------------- mime_types_format(Config) when is_list(Config) -> @@ -1906,47 +1727,6 @@ erl_script_timeout_proplist(Config) when is_list(Config) -> verify_body(Body, 3000), inets:stop(). -erl_script_timeout_apache(Config) when is_list(Config) -> - HttpdConf = filename:join(get_tmp_dir(Config), - "httpd_erl_script_timeout.conf"), - MimeTypes = filename:join(get_tmp_dir(Config), - "erl_script_timeout_mime_types.conf"), - - MimeTypesConf = - "html\n" ++ - "text/html\n", - - ok = file:write_file(MimeTypes, MimeTypesConf), - - ServerConfig = - "Port 0\n" ++ - "ServerName localhost\n" ++ - "ServerRoot ./\n" ++ - "DocumentRoot ./\n" ++ - "BindAddress 0.0.0.0\n" ++ - "MimeTypes " ++ MimeTypes ++ "\n" ++ - "Modules mod_esi\n" ++ - "ErlScriptTimeout 8\n" ++ - "ErlScriptAlias /erl httpd_example\n", - - ok = file:write_file(HttpdConf, ServerConfig), - - inets:start(), - {ok, Pid} = inets:start(httpd, - [{file, HttpdConf}]), - Info = httpd:info(Pid), - verify_timeout(Info, 8), - - Port = proplists:get_value(port, Info), - - %% Verify: 6 =< erl_script_timeout =< 10 - Url = http_get_url(Port, 500, 6000, 4000), - - {ok, {_, _, Body}} = httpc:request(Url), - ct:log("Response: ~p~n", [Body]), - verify_body(Body, 6000), - inets:stop(). - tls_alert(Config) when is_list(Config) -> SSLOpts = proplists:get_value(client_alert_conf, Config), Port = proplists:get_value(port, Config), @@ -1999,10 +1779,9 @@ do_max_clients(Config) -> Type = proplists:get_value(type, Config), Request = http_request("GET /index.html ", Version, Host), - BlockRequest = http_request("GET /eval?httpd_example:delay(2000) ", Version, Host), + BlockRequest = http_request("GET /cgi_bin/erl/httpd_example:delay ", Version, Host), {ok, Socket} = inets_test_lib:connect_bin(Type, Host, Port, transport_opts(Type, Config)), inets_test_lib:send(Type, Socket, BlockRequest), - ct:sleep(100), %% Avoid possible timing issues ok = httpd_test_lib:verify_request(Type, Host, Port, transport_opts(Type, Config), @@ -2081,7 +1860,6 @@ start_apps(Group) when Group == https_basic; Group == https_auth_api; Group == https_auth_api_dets; Group == https_auth_api_mnesia; - Group == https_htaccess; Group == https_security; Group == https_reload; Group == https_not_sup; @@ -2095,7 +1873,6 @@ start_apps(Group) when Group == http_basic; Group == http_auth_api; Group == http_auth_api_dets; Group == http_auth_api_mnesia; - Group == http_htaccess; Group == http_security; Group == http_logging; Group == http_reload; @@ -2151,6 +1928,7 @@ server_config(https_reload, Config) -> [{keep_alive_timeout, 2}] ++ server_config(https, Config); server_config(http_limit, Config) -> Conf = [{max_clients, 1}, + {disable_chunked_transfer_encoding_send, true}, %% Make sure option checking code is run {max_content_length, 100000002}] ++ server_config(http, Config), ct:pal("Received message ~p~n", [Conf]), @@ -2160,7 +1938,9 @@ server_config(http_custom, Config) -> server_config(https_custom, Config) -> [{customize, ?MODULE}] ++ server_config(https, Config); server_config(https_limit, Config) -> - [{max_clients, 1}] ++ server_config(https, Config); + [{max_clients, 1}, + {disable_chunked_transfer_encoding_send, true} + ] ++ server_config(https, Config); server_config(http_basic_auth, Config) -> ServerRoot = proplists:get_value(server_root, Config), auth_conf(ServerRoot) ++ server_config(http, Config); @@ -2185,10 +1965,6 @@ server_config(http_auth_api_mnesia, Config) -> server_config(https_auth_api_mnesia, Config) -> ServerRoot = proplists:get_value(server_root, Config), auth_api_conf(ServerRoot, mnesia) ++ server_config(https, Config); -server_config(http_htaccess, Config) -> - auth_access_conf() ++ server_config(http, Config); -server_config(https_htaccess, Config) -> - auth_access_conf() ++ server_config(https, Config); server_config(http_security, Config) -> ServerRoot = proplists:get_value(server_root, Config), tl(auth_conf(ServerRoot)) ++ security_conf(ServerRoot) ++ server_config(http, Config); @@ -2222,8 +1998,7 @@ server_config(http, Config) -> {alias, {"/pics/", filename:join(ServerRoot,"icons") ++ "/"}}, {script_alias, {"/cgi-bin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}}, {script_alias, {"/htbin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}}, - {erl_script_alias, {"/cgi-bin/erl", [httpd_example, io]}}, - {eval_script_alias, {"/eval", [httpd_example, io]}} + {erl_script_alias, {"/cgi-bin/erl", [httpd_example, io]}} ]; server_config(http_rel_path_script_alias, Config) -> ServerRoot = proplists:get_value(server_root, Config), @@ -2243,8 +2018,7 @@ server_config(http_rel_path_script_alias, Config) -> {alias, {"/pics/", filename:join(ServerRoot,"icons") ++ "/"}}, {script_alias, {"/cgi-bin/", "./cgi-bin/"}}, {script_alias, {"/htbin/", "./cgi-bin/"}}, - {erl_script_alias, {"/cgi-bin/erl", [httpd_example, io]}}, - {eval_script_alias, {"/eval", [httpd_example, io]}} + {erl_script_alias, {"/cgi-bin/erl", [httpd_example, io]}} ]; server_config(https, Config) -> SSLConf = proplists:get_value(ssl_conf, Config), @@ -2309,8 +2083,7 @@ not_sup_conf() -> [{modules, [mod_get]}]. auth_access_conf() -> - [{modules, [mod_alias, mod_htaccess, mod_dir, mod_get, mod_head]}, - {access_files, [".htaccess"]}]. + [{modules, [mod_alias, mod_dir, mod_get, mod_head]}]. auth_conf(Root) -> [{modules, [mod_alias, mod_auth, mod_dir, mod_get, mod_head]}, @@ -2541,103 +2314,6 @@ create_range_data(Path) -> ok end. -%%% mod_htaccess -create_htaccess_data(Path, IpAddress)-> - create_htaccess_dirs(Path), - - create_html_file(filename:join([Path,"ht/open/dummy.html"])), - create_html_file(filename:join([Path,"ht/blocknet/dummy.html"])), - create_html_file(filename:join([Path,"ht/secret/dummy.html"])), - create_html_file(filename:join([Path,"ht/secret/top_secret/dummy.html"])), - - create_htaccess_file(filename:join([Path,"ht/open/.htaccess"]), - Path, "user one Aladdin"), - create_htaccess_file(filename:join([Path,"ht/secret/.htaccess"]), - Path, "group group1 group2"), - create_htaccess_file(filename:join([Path, - "ht/secret/top_secret/.htaccess"]), - Path, "user four"), - create_htaccess_file(filename:join([Path,"ht/blocknet/.htaccess"]), - Path, nouser, IpAddress), - - create_user_group_file(filename:join([Path,"ht","users.file"]), - "one:OnePassword\ntwo:TwoPassword\nthree:" - "ThreePassword\nfour:FourPassword\nAladdin:" - "AladdinPassword"), - create_user_group_file(filename:join([Path,"ht","groups.file"]), - "group1: two one\ngroup2: two three"). - -create_html_file(PathAndFileName)-> - file:write_file(PathAndFileName,list_to_binary( - "<html><head><title>test</title></head> - <body>testar</body></html>")). - -create_htaccess_file(PathAndFileName, BaseDir, RequireData)-> - file:write_file(PathAndFileName, - list_to_binary( - "AuthUserFile "++ BaseDir ++ - "/ht/users.file\nAuthGroupFile "++ BaseDir - ++ "/ht/groups.file\nAuthName Test\nAuthType" - " Basic\n<Limit>\nrequire " ++ RequireData ++ - "\n</Limit>")). - -create_htaccess_file(PathAndFileName, BaseDir, nouser, IpAddress)-> - file:write_file(PathAndFileName,list_to_binary( - "AuthUserFile "++ BaseDir ++ - "/ht/users.file\nAuthGroupFile " ++ - BaseDir ++ "/ht/groups.file\nAuthName" - " Test\nAuthType" - " Basic\n<Limit GET>\n\tallow from " ++ - format_ip(IpAddress, - string:rchr(IpAddress,$.)) ++ - "\n</Limit>")). - -create_user_group_file(PathAndFileName, Data)-> - file:write_file(PathAndFileName, list_to_binary(Data)). - -create_htaccess_dirs(Path)-> - ok = file:make_dir(filename:join([Path,"ht"])), - ok = file:make_dir(filename:join([Path,"ht/open"])), - ok = file:make_dir(filename:join([Path,"ht/blocknet"])), - ok = file:make_dir(filename:join([Path,"ht/secret"])), - ok = file:make_dir(filename:join([Path,"ht/secret/top_secret"])). - -remove_htaccess_dirs(Path)-> - file:del_dir(filename:join([Path,"ht/secret/top_secret"])), - file:del_dir(filename:join([Path,"ht/secret"])), - file:del_dir(filename:join([Path,"ht/blocknet"])), - file:del_dir(filename:join([Path,"ht/open"])), - file:del_dir(filename:join([Path,"ht"])). - -format_ip(IpAddress,Pos)when Pos > 0-> - case lists:nth(Pos,IpAddress) of - $.-> - case lists:nth(Pos-2,IpAddress) of - $.-> - format_ip(IpAddress,Pos-3); - _-> - lists:sublist(IpAddress,Pos-2) ++ "." - end; - _ -> - format_ip(IpAddress,Pos-1) - end; - -format_ip(IpAddress, _Pos)-> - "1" ++ IpAddress. - -remove_htaccess(Path)-> - file:delete(filename:join([Path,"ht/open/dummy.html"])), - file:delete(filename:join([Path,"ht/secret/dummy.html"])), - file:delete(filename:join([Path,"ht/secret/top_secret/dummy.html"])), - file:delete(filename:join([Path,"ht/blocknet/dummy.html"])), - file:delete(filename:join([Path,"ht/blocknet/.htaccess"])), - file:delete(filename:join([Path,"ht/open/.htaccess"])), - file:delete(filename:join([Path,"ht/secret/.htaccess"])), - file:delete(filename:join([Path,"ht/secret/top_secret/.htaccess"])), - file:delete(filename:join([Path,"ht","users.file"])), - file:delete(filename:join([Path,"ht","groups.file"])), - remove_htaccess_dirs(Path). - dos_hostname(Type, Port, Host, Node, Version, Max) -> TooLongHeader = lists:append(lists:duplicate(Max + 1, "a")), diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl index 94d22ea76c..1d3be6de57 100644 --- a/lib/inets/test/httpd_basic_SUITE.erl +++ b/lib/inets/test/httpd_basic_SUITE.erl @@ -302,11 +302,13 @@ escaped_url_in_error_body(Config) when is_list(Config) -> %% Ask for a non-existing page(1) Path = "/<b>this_is_bold<b>", - HTMLEncodedPath = http_util:html_encode(Path), URL2 = uri_string:recompose(#{scheme => "http", host => "localhost", port => Port, path => Path}), + + #{path := EncodedPath} = uri_string:parse(URL2), + HTMLEncodedPath = http_util:html_encode(EncodedPath), {ok, {404, Body3}} = httpc:request(get, {URL2, []}, [{url_encode, true}, {version, "HTTP/1.0"}], diff --git a/lib/inets/test/httpd_bench_SUITE.erl b/lib/inets/test/httpd_bench_SUITE.erl index 087516f56c..1cba527687 100644 --- a/lib/inets/test/httpd_bench_SUITE.erl +++ b/lib/inets/test/httpd_bench_SUITE.erl @@ -87,7 +87,8 @@ init_per_suite(Config) -> {Node, Host} = setup(Config, node()), init_ssl(Config), [{iter, 10}, {server_node, Node}, {server_host, Host} | Config] - catch _:_ -> + catch E:R:ST -> + ct:pal("~p:~p:~p",[E,R,ST]), {skipped, "Benchmark machines only"} end. diff --git a/lib/inets/test/httpd_mod_SUITE.erl b/lib/inets/test/httpd_mod_SUITE.erl index 5ec4e0856d..ebef7eea6c 100644 --- a/lib/inets/test/httpd_mod_SUITE.erl +++ b/lib/inets/test/httpd_mod_SUITE.erl @@ -53,7 +53,6 @@ groups() -> {mod_actions, [], []}, {mod_security, [], []}, {mod_auth, [], []}, - {mod_htaccess, [], []}, {mod_cgi, [], []}, {mod_esi, [], []}, {mod_head, [], []}, @@ -66,7 +65,6 @@ all_version_groups ()-> {group, mod_actions}, {group, mod_security}, {group, mod_auth}, - {group, mod_htaccess}, {group, mod_cgi}, {group, mod_esi}, {group, mod_head} diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index b6525037b2..31a9c72e9c 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -119,11 +119,11 @@ verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, Ti ct:fail({connect_error, ConnectError, [SocketType, Host, Port, TranspOpts]}) catch - T:E -> + T:E:Stk -> ct:fail({connect_failure, [{type, T}, {error, E}, - {stacktrace, erlang:get_stacktrace()}, + {stacktrace, Stk}, {args, [SocketType, Host, Port, TranspOpts]}]}) end. @@ -136,11 +136,11 @@ verify_request_N(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, ct:fail({connect_error, ConnectError, [SocketType, Host, Port, TranspOpts]}) catch - T:E -> + T:E:Stk -> ct:fail({connect_failure, [{type, T}, {error, E}, - {stacktrace, erlang:get_stacktrace()}, + {stacktrace, Stk}, {args, [SocketType, Host, Port, TranspOpts]}]}) end. @@ -388,8 +388,8 @@ is_expect(RequestStr) -> end. %% OTP-5775, content-length -check_body("GET /cgi-bin/erl/httpd_example:get_bin HTTP/1.0\r\n\r\n", 200, "text/html", Length, _Body) when (Length =/= 274) -> - ct:fail(content_length_error); +check_body("GET /cgi-bin/erl/httpd_example:get_bin HTTP/1.1\r\n\r\n", 200, "text/html", Length, _Body) when (Length =/= 274) -> + ct:fail({content_length_error, Length}); check_body("GET /cgi-bin/cgi_echo HTTP/1.0\r\n\r\n", 200, "text/plain", _, Body) -> case size(Body) of diff --git a/lib/inets/test/inets_SUITE.erl b/lib/inets/test/inets_SUITE.erl index e7964ff7f1..0ec3ce86ad 100644 --- a/lib/inets/test/inets_SUITE.erl +++ b/lib/inets/test/inets_SUITE.erl @@ -246,52 +246,6 @@ start_httpd(Config) when is_list(Config) -> ok = inets:start(), (?NUM_DEFAULT_SERVICES + 1) = length(inets:services()), application:unset_env(inets, services), - ok = inets:stop(), - - File1 = filename:join(PrivDir, "httpd_apache.conf"), - - {ok, Fd1} = file:open(File1, [write]), - file:write(Fd1, "ServerName httpd_test\r\n"), - file:write(Fd1, "ServerRoot " ++ PrivDir ++ "\r\n"), - file:write(Fd1, "DocumentRoot " ++ PrivDir ++" \r\n"), - file:write(Fd1, "BindAddress *|inet\r\n"), - file:write(Fd1, "Port 0\r\n"), - file:close(Fd1), - - application:load(inets), - application:set_env(inets, - services, [{httpd, [{file, File1}]}]), - ok = inets:start(), - (?NUM_DEFAULT_SERVICES + 1) = length(inets:services()), - application:unset_env(inets, services), - ok = inets:stop(), - - %% OLD format - application:load(inets), - application:set_env(inets, - services, [{httpd, File1}]), - ok = inets:start(), - (?NUM_DEFAULT_SERVICES + 1) = length(inets:services()), - application:unset_env(inets, services), - ok = inets:stop(), - ok = inets:start(), - {error, {missing_property, server_name}} = - inets:start(httpd, [{port, 0}, - {server_root, PrivDir}, - {document_root, PrivDir}, - {bind_address, "localhost"}]), - {error, {missing_property, document_root}} = - inets:start(httpd, [{port, 0}, - {server_name, "httpd_test"}, - {server_root, PrivDir}, - {bind_address, "localhost"}]), - {error, {missing_property, server_root}} = - inets:start(httpd, [{port, 0}, - {server_name, "httpd_test"}, - {document_root, PrivDir}, - {bind_address, "localhost"}]), - {error, {missing_property, port}} = - inets:start(httpd, HttpdConf), ok = inets:stop(). %%------------------------------------------------------------------------- @@ -337,48 +291,4 @@ httpd_reload(Config) when is_list(Config) -> [{document_root, PrivDir}] = httpd:info(Pid0, [document_root]), ok = inets:stop(httpd, Pid0), - ok = inets:stop(), - - File = filename:join(PrivDir, "httpd_apache.conf"), - - {ok, Fd0} = file:open(File, [write]), - file:write(Fd0, "ServerName httpd_test\r\n"), - file:write(Fd0, "ServerRoot " ++ PrivDir ++ "\r\n"), - file:write(Fd0, "DocumentRoot " ++ PrivDir ++" \r\n"), - file:write(Fd0, "BindAddress *\r\n"), - file:write(Fd0, "Port 0\r\n"), - file:close(Fd0), - - application:load(inets), - application:set_env(inets, - services, [{httpd, [{file, File}]}]), - - ok = inets:start(), - [Pid1] = [HttpdPid || {httpd, HttpdPid} <- inets:services()], - [{server_name, "httpd_test"}] = httpd:info(Pid1, [server_name]), - [{port, Port1}] = httpd:info(Pid1, [port]), - {ok, Fd1} = file:open(File, [write]), - file:write(Fd1, "ServerName httpd_test2\r\n"), - file:write(Fd1, "ServerRoot " ++ PrivDir ++ "\r\n"), - file:write(Fd1, "DocumentRoot " ++ PrivDir ++" \r\n"), - file:write(Fd1, "BindAddress *\r\n"), - file:write(Fd1, "Port " ++ integer_to_list(Port1) ++ "\r\n"), - file:close(Fd1), - - ok = httpd:reload_config(File, non_disturbing), - [{server_name, "httpd_test2"}] = httpd:info(Pid1, [server_name]), - - {ok, Fd2} = file:open(File, [write]), - file:write(Fd2, "ServerName httpd_test\r\n"), - file:write(Fd2, "ServerRoot " ++ PrivDir ++ "\r\n"), - file:write(Fd2, "DocumentRoot " ++ PrivDir ++" \r\n"), - file:write(Fd2, "BindAddress *\r\n"), - file:write(Fd2, "Port " ++ integer_to_list(Port1) ++ "\r\n"), - file:close(Fd2), - ok = httpd:reload_config(File, disturbing), - [{server_name, "httpd_test"}] = httpd:info(Pid1, [server_name]), - - ok = inets:stop(httpd, Pid1), - application:unset_env(inets, services), ok = inets:stop(). - diff --git a/lib/jinterface/Makefile b/lib/jinterface/Makefile index 9cf5f3e94c..dd22d743a5 100644 --- a/lib/jinterface/Makefile +++ b/lib/jinterface/Makefile @@ -39,3 +39,4 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/jinterface/doc/src/Makefile b/lib/jinterface/doc/src/Makefile index f5cba9d074..348cf0e429 100644 --- a/lib/jinterface/doc/src/Makefile +++ b/lib/jinterface/doc/src/Makefile @@ -53,14 +53,9 @@ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APP_FILES) $(XML_REF3_FILES) \ $(XML_PART_FILES) $(XML_CHAPTER_FILES) -GIF_FILES = -#------------------------------------------------------ - - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +NO_CHUNKS=$(XML_REF3_FILES) +#------------------------------------------------------ JAVADOC = javadoc JAVADOC_PKGS = com.ericsson.otp.erlang @@ -86,75 +81,20 @@ JAVA_DOC_FILES = \ stylesheet.css \ help-doc.html -INFO_FILE = ../../info -JAVA_EXTRA_FILES = $(JAVA_DOC_FILES:%=$(HTMLDIR)/java/%) - JAVA_GEN_FILES = \ $(JAVA_FILES:%=$(JAVADOC_DEST)/$(JAVA_PKG_PATH)/%.html) \ $(JAVADOC_DEST)/$(JAVA_PKG_PATH)/package-summary.html \ $(JAVADOC_DEST)/$(JAVA_PKG_PATH)/package-tree.html \ $(JAVADOC_DEST)/$(JAVA_PKG_PATH)/package-frame.html - -# ---------------------------------------------------- - - -HTML_FILES = \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -TOP_HTML_FILES = $(INDEX_TARGET) - -INDEX_FILE = index.html -INDEX_TARGET = $(DOCDIR)/$(INDEX_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - # ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html jdoc man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ jdoc:$(JAVA_SRC_FILES) (cd ../../java_src;$(JAVADOC) -sourcepath . -d $(JAVADOC_DEST) \ -windowtitle $(JAVADOC_TITLE) $(JAVADOC_PKGS)) touch jdoc -man: - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR_DATA) $(HTMLDIR) "$(RELSYSDIR)/doc/html" - +docs: jdoc -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java index 0bf3ca2a67..26f6ffcd97 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java @@ -147,21 +147,6 @@ public abstract class AbstractConnection extends Thread { if (traceLevel >= handshakeThreshold) { System.out.println("<- ACCEPT FROM " + s); } - - // get his info - recvName(peer); - - // now find highest common dist value - if (peer.proto != self.proto || self.distHigh < peer.distLow - || self.distLow > peer.distHigh) { - close(); - throw new IOException( - "No common protocol found - cannot accept connection"); - } - // highest common version: min(peer.distHigh, self.distHigh) - peer.distChoose = peer.distHigh > self.distHigh ? self.distHigh - : peer.distHigh; - doAccept(); name = peer.node(); } @@ -953,10 +938,12 @@ public abstract class AbstractConnection extends Thread { } protected void doAccept() throws IOException, OtpAuthException { + final int send_name_tag = recvName(peer); try { sendStatus("ok"); final int our_challenge = genChallenge(); - sendChallenge(peer.distChoose, localNode.flags, our_challenge); + sendChallenge(peer.flags, localNode.flags, our_challenge); + recvComplement(send_name_tag); final int her_challenge = recvChallengeReply(our_challenge); final byte[] our_digest = genDigest(her_challenge, localNode.cookie()); @@ -992,12 +979,14 @@ public abstract class AbstractConnection extends Thread { System.out.println("-> MD5 CONNECT TO " + peer.host() + ":" + port); } - sendName(peer.distChoose, localNode.flags); + final int send_name_tag = sendName(peer.distChoose, localNode.flags, + localNode.creation); recvStatus(); final int her_challenge = recvChallenge(); final byte[] our_digest = genDigest(her_challenge, localNode.cookie()); final int our_challenge = genChallenge(); + sendComplement(send_name_tag); sendChallengeReply(our_challenge, our_digest); recvChallengeAck(our_challenge); cookieOk = true; @@ -1070,17 +1059,31 @@ public abstract class AbstractConnection extends Thread { return res; } - protected void sendName(final int dist, final int aflags) + protected int sendName(final int dist, final long aflags, + final int creation) throws IOException { @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); final String str = localNode.node(); - obuf.write2BE(str.length() + 7); // 7 bytes + nodename - obuf.write1(AbstractNode.NTYPE_R6); - obuf.write2BE(dist); - obuf.write4BE(aflags); - obuf.write(str.getBytes()); + int send_name_tag; + if (dist == 5) { + obuf.write2BE(1+2+4 + str.length()); + send_name_tag = 'n'; + obuf.write1(send_name_tag); + obuf.write2BE(dist); + obuf.write4BE(aflags); + obuf.write(str.getBytes()); + } + else { + obuf.write2BE(1+8+4+2 + str.length()); + send_name_tag = 'N'; + obuf.write1(send_name_tag); + obuf.write8BE(aflags); + obuf.write4BE(creation); + obuf.write2BE(str.length()); + obuf.write(str.getBytes()); + } obuf.writeToAndFlush(socket.getOutputStream()); @@ -1088,26 +1091,61 @@ public abstract class AbstractConnection extends Thread { System.out.println("-> " + "HANDSHAKE sendName" + " flags=" + aflags + " dist=" + dist + " local=" + localNode); } + return send_name_tag; } - protected void sendChallenge(final int dist, final int aflags, - final int challenge) throws IOException { + protected void sendComplement(final int send_name_tag) + throws IOException { + + if (send_name_tag == 'n' && + (peer.flags & AbstractNode.dFlagHandshake23) != 0) { + @SuppressWarnings("resource") + final OtpOutputStream obuf = new OtpOutputStream(); + obuf.write2BE(1+4+4); + obuf.write1('c'); + final int flagsHigh = (int)(localNode.flags >> 32); + obuf.write4BE(flagsHigh); + obuf.write4BE(localNode.creation); + + obuf.writeToAndFlush(socket.getOutputStream()); + + if (traceLevel >= handshakeThreshold) { + System.out.println("-> " + "HANDSHAKE sendComplement" + + " flagsHigh=" + flagsHigh + + " creation=" + localNode.creation); + } + } + } + + protected void sendChallenge(final long her_flags, final long our_flags, + final int challenge) throws IOException { @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); final String str = localNode.node(); - obuf.write2BE(str.length() + 11); // 11 bytes + nodename - obuf.write1(AbstractNode.NTYPE_R6); - obuf.write2BE(dist); - obuf.write4BE(aflags); - obuf.write4BE(challenge); - obuf.write(str.getBytes()); + if ((her_flags & AbstractNode.dFlagHandshake23) == 0) { + obuf.write2BE(1+2+4+4 + str.length()); + obuf.write1('n'); + obuf.write2BE(5); + obuf.write4BE(our_flags & 0xffffffff); + obuf.write4BE(challenge); + obuf.write(str.getBytes()); + } + else { + obuf.write2BE(1+8+4+4+2 + str.length()); + obuf.write1('N'); + obuf.write8BE(our_flags); + obuf.write4BE(challenge); + obuf.write4BE(localNode.creation); + obuf.write2BE(str.length()); + obuf.write(str.getBytes()); + } obuf.writeToAndFlush(socket.getOutputStream()); if (traceLevel >= handshakeThreshold) { System.out.println("-> " + "HANDSHAKE sendChallenge" + " flags=" - + aflags + " dist=" + dist + " challenge=" + challenge + + our_flags + " challenge=" + challenge + " local=" + localNode); } } @@ -1127,8 +1165,8 @@ public abstract class AbstractConnection extends Thread { return tmpbuf; } - protected void recvName(final OtpPeer apeer) throws IOException { - + protected int recvName(final OtpPeer apeer) throws IOException { + int send_name_tag; String hisname = ""; try { @@ -1137,25 +1175,31 @@ public abstract class AbstractConnection extends Thread { final OtpInputStream ibuf = new OtpInputStream(tmpbuf, 0); byte[] tmpname; final int len = tmpbuf.length; - apeer.ntype = ibuf.read1(); - if (apeer.ntype != AbstractNode.NTYPE_R6) { + send_name_tag = ibuf.read1(); + switch (send_name_tag) { + case 'n': + apeer.distLow = apeer.distHigh = ibuf.read2BE(); + if (apeer.distLow != 5) + throw new IOException("Invalid handshake version"); + apeer.flags = ibuf.read4BE(); + tmpname = new byte[len - 7]; + ibuf.readN(tmpname); + hisname = OtpErlangString.newString(tmpname); + break; + case 'N': + apeer.distLow = apeer.distHigh = 6; + apeer.flags = ibuf.read8BE(); + if ((apeer.flags & AbstractNode.dFlagHandshake23) == 0) + throw new IOException("Missing DFLAG_HANDSHAKE_23"); + apeer.creation = ibuf.read4BE(); + int namelen = ibuf.read2BE(); + tmpname = new byte[namelen]; + ibuf.readN(tmpname); + hisname = OtpErlangString.newString(tmpname); + break; + default: throw new IOException("Unknown remote node type"); } - apeer.distLow = apeer.distHigh = ibuf.read2BE(); - if (apeer.distLow < 5) { - throw new IOException("Unknown remote node type"); - } - apeer.flags = ibuf.read4BE(); - tmpname = new byte[len - 7]; - ibuf.readN(tmpname); - hisname = OtpErlangString.newString(tmpname); - // Set the old nodetype parameter to indicate hidden/normal status - // When the old handshake is removed, the ntype should also be. - if ((apeer.flags & AbstractNode.dFlagPublished) != 0) { - apeer.ntype = AbstractNode.NTYPE_R4_ERLANG; - } else { - apeer.ntype = AbstractNode.NTYPE_R4_HIDDEN; - } if ((apeer.flags & AbstractNode.dFlagExtendedReferences) == 0) { throw new IOException( @@ -1180,6 +1224,7 @@ public abstract class AbstractConnection extends Thread { System.out.println("<- " + "HANDSHAKE" + " ntype=" + apeer.ntype + " dist=" + apeer.distHigh + " remote=" + apeer); } + return send_name_tag; } protected int recvChallenge() throws IOException { @@ -1190,14 +1235,31 @@ public abstract class AbstractConnection extends Thread { final byte[] buf = read2BytePackage(); @SuppressWarnings("resource") final OtpInputStream ibuf = new OtpInputStream(buf, 0); - peer.ntype = ibuf.read1(); - if (peer.ntype != AbstractNode.NTYPE_R6) { + int namelen; + switch (ibuf.read1()) { + case 'n': + if (peer.distChoose != 5) + throw new IOException("Old challenge wrong version"); + peer.distLow = peer.distHigh = ibuf.read2BE(); + peer.flags = ibuf.read4BE(); + if ((peer.flags & AbstractNode.dFlagHandshake23) != 0) + throw new IOException("Old challenge unexpected DFLAG_HANDHAKE_23"); + challenge = ibuf.read4BE(); + namelen = buf.length - (1+2+4+4); + break; + case 'N': + peer.distLow = peer.distHigh = peer.distChoose = 6; + peer.flags = ibuf.read8BE(); + if ((peer.flags & AbstractNode.dFlagHandshake23) == 0) + throw new IOException("New challenge missing DFLAG_HANDHAKE_23"); + challenge = ibuf.read4BE(); + peer.creation = ibuf.read4BE(); + namelen = ibuf.read2BE(); + break; + default: throw new IOException("Unexpected peer type"); } - peer.distLow = peer.distHigh = ibuf.read2BE(); - peer.flags = ibuf.read4BE(); - challenge = ibuf.read4BE(); - final byte[] tmpname = new byte[buf.length - 11]; + final byte[] tmpname = new byte[namelen]; ibuf.readN(tmpname); final String hisname = OtpErlangString.newString(tmpname); if (!hisname.equals(peer.node)) { @@ -1228,6 +1290,27 @@ public abstract class AbstractConnection extends Thread { return challenge; } + protected void recvComplement(int send_name_tag) throws IOException { + + if (send_name_tag == 'n' && + (peer.flags & AbstractNode.dFlagHandshake23) != 0) { + try { + final byte[] tmpbuf = read2BytePackage(); + @SuppressWarnings("resource") + final OtpInputStream ibuf = new OtpInputStream(tmpbuf, 0); + if (ibuf.read1() != 'c') + throw new IOException("Not a complement tag"); + + final long flagsHigh = ibuf.read4BE(); + peer.flags |= flagsHigh << 32; + peer.creation = ibuf.read4BE(); + + } catch (final OtpErlangDecodeException e) { + throw new IOException("Handshake failed - not enough data"); + } + } + } + protected void sendChallengeReply(final int challenge, final byte[] digest) throws IOException { diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java index c3f71a84f0..fa6db9a046 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java @@ -74,10 +74,7 @@ public class AbstractNode implements OtpTransportFactory { static String defaultCookie = null; final OtpTransportFactory transportFactory; - // Node types static final int NTYPE_R6 = 110; // 'n' post-r5, all nodes - static final int NTYPE_R4_ERLANG = 109; // 'm' Only for source compatibility - static final int NTYPE_R4_HIDDEN = 104; // 'h' Only for source compatibility // Node capability flags static final int dFlagPublished = 1; @@ -96,17 +93,19 @@ public class AbstractNode implements OtpTransportFactory { static final int dFlagUtf8Atoms = 0x10000; static final int dFlagMapTag = 0x20000; static final int dFlagBigCreation = 0x40000; + static final int dFlagHandshake23 = 0x1000000; int ntype = NTYPE_R6; int proto = 0; // tcp/ip - int distHigh = 5; // Cannot talk to nodes before R6 + int distHigh = 6; int distLow = 5; // Cannot talk to nodes before R6 int creation = 0; - int flags = dFlagExtendedReferences | dFlagExtendedPidsPorts + long flags = dFlagExtendedReferences | dFlagExtendedPidsPorts | dFlagBitBinaries | dFlagNewFloats | dFlagFunTags | dflagNewFunTags | dFlagUtf8Atoms | dFlagMapTag | dFlagExportPtrTag - | dFlagBigCreation; + | dFlagBigCreation + | dFlagHandshake23; /* initialize hostname and default cookie */ static { diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile b/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile index ee616f3d7e..bcbb206db6 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile @@ -67,8 +67,11 @@ JARFILE= OtpErlang.jar # ---------------------------------------------------- # Programs and Flags # ---------------------------------------------------- - -JAR= jar +ifeq ($(TARGET),win32) + JAR=jar.exe +else + JAR=jar +endif CLASSPATH = $(JAVA_SRC_ROOT) diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java index fffb8475d3..008ee9727e 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java @@ -74,8 +74,9 @@ public class OtpEpmd { private static final byte port4req = (byte) 122; private static final byte port4resp = (byte) 119; - private static final byte publish4req = (byte) 120; - private static final byte publish4resp = (byte) 121; + private static final byte ALIVE2_REQ = (byte) 120; + private static final byte ALIVE2_RESP = (byte) 121; + private static final byte ALIVE2_X_RESP = (byte) 118; private static final byte names4req = (byte) 110; private static int traceLevel = 0; @@ -287,7 +288,7 @@ public class OtpEpmd { obuf.write2BE(node.alive().length() + 13); - obuf.write1(publish4req); + obuf.write1(ALIVE2_REQ); obuf.write2BE(node.port()); obuf.write1(node.type()); @@ -322,10 +323,11 @@ public class OtpEpmd { final OtpInputStream ibuf = new OtpInputStream(tmpbuf, 0); final int response = ibuf.read1(); - if (response == publish4resp) { + if (response == ALIVE2_RESP || response == ALIVE2_X_RESP) { final int result = ibuf.read1(); if (result == 0) { - node.creation = ibuf.read2BE(); + node.creation = (response == ALIVE2_RESP + ? ibuf.read2BE() : ibuf.read4BE()); if (traceLevel >= traceThreshold) { System.out.println("<- OK"); } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java index 9cbd735751..3abdf9535f 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java @@ -27,7 +27,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object> // don't change this! private static final long serialVersionUID = 1664394142301803659L; - private final int tag; private final String node; private final int id; private final int serial; @@ -45,7 +44,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object> public OtpErlangPid(final OtpLocalNode self) { final OtpErlangPid p = self.createPid(); - tag = p.tag; id = p.id; serial = p.serial; creation = p.creation; @@ -67,7 +65,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object> throws OtpErlangDecodeException { final OtpErlangPid p = buf.read_pid(); - tag = p.tag; node = p.node(); id = p.id(); serial = p.serial(); @@ -118,7 +115,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object> */ protected OtpErlangPid(final int tag, final String node, final int id, final int serial, final int creation) { - this.tag = tag; this.node = node; if (tag == OtpExternal.pidTag) { this.id = id & 0x7fff; // 15 bits @@ -133,7 +129,7 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object> } protected int tag() { - return tag; + return OtpExternal.newPidTag; } /** diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java index 79b5d2736c..c8648d7aa3 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java @@ -26,7 +26,6 @@ public class OtpErlangPort extends OtpErlangObject { // don't change this! private static final long serialVersionUID = 4037115468007644704L; - private final int tag; private final String node; private final int id; private final int creation; @@ -43,7 +42,6 @@ public class OtpErlangPort extends OtpErlangObject { private OtpErlangPort(final OtpSelf self) { final OtpErlangPort p = self.createPort(); - tag = p.tag; id = p.id; creation = p.creation; node = p.node; @@ -64,7 +62,6 @@ public class OtpErlangPort extends OtpErlangObject { throws OtpErlangDecodeException { final OtpErlangPort p = buf.read_port(); - tag = p.tag; node = p.node(); id = p.id(); creation = p.creation(); @@ -105,7 +102,6 @@ public class OtpErlangPort extends OtpErlangObject { */ public OtpErlangPort(final int tag, final String node, final int id, final int creation) { - this.tag = tag; this.node = node; if (tag == OtpExternal.portTag) { this.id = id & 0xfffffff; // 28 bits @@ -118,7 +114,7 @@ public class OtpErlangPort extends OtpErlangObject { } protected int tag() { - return tag; + return OtpExternal.newPortTag; } /** diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java index 2165397013..2bf8d9a56b 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java @@ -28,7 +28,6 @@ public class OtpErlangRef extends OtpErlangObject { // don't change this! private static final long serialVersionUID = -7022666480768586521L; - private final int tag; private final String node; private final int creation; @@ -49,7 +48,6 @@ public class OtpErlangRef extends OtpErlangObject { public OtpErlangRef(final OtpLocalNode self) { final OtpErlangRef r = self.createRef(); - tag = r.tag; ids = r.ids; creation = r.creation; node = r.node; @@ -70,7 +68,6 @@ public class OtpErlangRef extends OtpErlangObject { throws OtpErlangDecodeException { final OtpErlangRef r = buf.read_ref(); - tag = r.tag; node = r.node(); creation = r.creation(); @@ -90,7 +87,6 @@ public class OtpErlangRef extends OtpErlangObject { * another arbitrary number. */ public OtpErlangRef(final String node, final int id, final int creation) { - this.tag = OtpExternal.newRefTag; this.node = node; ids = new int[1]; ids[0] = id & 0x3ffff; // 18 bits @@ -138,7 +134,6 @@ public class OtpErlangRef extends OtpErlangObject { */ public OtpErlangRef(final int tag, final String node, final int[] ids, final int creation) { - this.tag = tag; this.node = node; // use at most 3 words @@ -162,7 +157,7 @@ public class OtpErlangRef extends OtpErlangObject { } protected int tag() { - return tag; + return OtpExternal.newerRefTag; } /** diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java index 6d81ce630b..8cc5b3c21d 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java @@ -239,6 +239,20 @@ public class OtpInputStream extends ByteArrayInputStream { } /** + * Read a eight byte big endian integer from the stream. + * + * @return the bytes read, converted from big endian to a long integer. + * + * @exception OtpErlangDecodeException + * if the next byte cannot be read. + */ + public long read8BE() throws OtpErlangDecodeException { + long high = read4BE(); + long low = read4BE(); + return (high << 32) | (low & 0xffffffff); + } + + /** * Read a two byte little endian integer from the stream. * * @return the bytes read, converted from little endian to an integer. diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java index 5e777c1164..917e5baf3a 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java @@ -713,7 +713,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { */ public void write_pid(final String node, final int id, final int serial, final int creation) { - write1(OtpExternal.pidTag); + write1(OtpExternal.newPidTag); write_atom(node); write4BE(id & 0x7fff); // 15 bits write4BE(serial & 0x1fff); // 13 bits @@ -727,20 +727,11 @@ public class OtpOutputStream extends ByteArrayOutputStream { * the pid */ public void write_pid(OtpErlangPid pid) { - write1(pid.tag()); + write1(OtpExternal.newPidTag); write_atom(pid.node()); write4BE(pid.id()); write4BE(pid.serial()); - switch (pid.tag()) { - case OtpExternal.pidTag: - write1(pid.creation()); - break; - case OtpExternal.newPidTag: - write4BE(pid.creation()); - break; - default: - throw new AssertionError("Invalid pid tag " + pid.tag()); - } + write4BE(pid.creation()); } @@ -758,7 +749,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { * be used. */ public void write_port(final String node, final int id, final int creation) { - write1(OtpExternal.portTag); + write1(OtpExternal.newPortTag); write_atom(node); write4BE(id & 0xfffffff); // 28 bits write1(creation & 0x3); // 2 bits @@ -771,19 +762,10 @@ public class OtpOutputStream extends ByteArrayOutputStream { * the port. */ public void write_port(OtpErlangPort port) { - write1(port.tag()); + write1(OtpExternal.newPortTag); write_atom(port.node()); write4BE(port.id()); - switch (port.tag()) { - case OtpExternal.portTag: - write1(port.creation()); - break; - case OtpExternal.newPortTag: - write4BE(port.creation()); - break; - default: - throw new AssertionError("Invalid port tag " + port.tag()); - } + write4BE(port.creation()); } /** @@ -829,7 +811,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { arity = 3; // max 3 words in ref } - write1(OtpExternal.newRefTag); + write1(OtpExternal.newerRefTag); // how many id values write2BE(arity); @@ -857,24 +839,12 @@ public class OtpOutputStream extends ByteArrayOutputStream { int[] ids = ref.ids(); int arity = ids.length; - write1(ref.tag()); + write1(OtpExternal.newerRefTag); write2BE(arity); write_atom(ref.node()); + write4BE(ref.creation()); - switch (ref.tag()) { - case OtpExternal.newRefTag: - write1(ref.creation()); - write4BE(ids[0] & 0x3ffff); // first word gets truncated to 18 bits - break; - case OtpExternal.newerRefTag: - write4BE(ref.creation()); - write4BE(ids[0]); // full first word - break; - default: - throw new AssertionError("Invalid ref tag " + ref.tag()); - } - - for (int i = 1; i < arity; i++) { + for (int i = 0; i < arity; i++) { write4BE(ids[i]); } } diff --git a/lib/kernel/Makefile b/lib/kernel/Makefile index b956f5eaf5..5ab8ac63b9 100644 --- a/lib/kernel/Makefile +++ b/lib/kernel/Makefile @@ -34,3 +34,5 @@ SPECIAL_TARGETS = # Default Subdir Targets # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/kernel/doc/src/Makefile b/lib/kernel/doc/src/Makefile index fe3dc9dab5..9b004b3781 100644 --- a/lib/kernel/doc/src/Makefile +++ b/lib/kernel/doc/src/Makefile @@ -28,11 +28,6 @@ VSN=$(KERNEL_VSN) APPLICATION=kernel # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -46,6 +41,7 @@ XML_REF3_FILES = application.xml \ erl_epmd.xml \ erl_prim_loader_stub.xml \ erlang_stub.xml \ + erpc.xml \ error_handler.xml \ error_logger.xml \ file.xml \ @@ -67,6 +63,7 @@ XML_REF3_FILES = application.xml \ net_adm.xml \ net_kernel.xml \ os.xml \ + pg.xml \ pg2.xml \ rpc.xml \ seq_trace.xml \ @@ -96,86 +93,8 @@ XML_FILES = \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF4_FILES)\ $(XML_REF6_FILES) $(XML_APPLICATION_FILES) -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN4_FILES = $(XML_REF4_FILES:%.xml=$(MAN4DIR)/%.4) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) - TOP_SPECS_FILE = specs.xml - -# ---------------------------------------------------- -# FIGURES -# ---------------------------------------------------- -# In order to update the figures you have to have both dia -# and imagemagick installed. -# The generated .png file must be committed. - -update_png: - dia --export=logger_arch.eps logger_arch.dia - convert logger_arch.eps -resize 65% logger_arch.png - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -SPECS_ESRC = ../../src - -SPECS_FLAGS = -I../../include - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%: % - $(INSTALL_DATA) $< $@ - -docs: man pdf html - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: images $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) $(MAN4_FILES) $(MAN6_FILES) - -images: $(IMAGE_FILES:%=$(HTMLDIR)/%) - -info: - @echo "XML_APPLICATION_FILES: $(XML_APPLICATION_FILES)" - @echo "XML_REF3_ESOCK_FILES: $(XML_REF3_ESOCK_FILES)" - @echo "XML_REF3_FILES: $(XML_REF3_FILES)" - @echo "XML_REF4_FILES: $(XML_REF4_FILES)" - @echo "XML_REF6_FILES: $(XML_REF6_FILES)" - @echo "XML_PART_FILES: $(XML_PART_FILES)" - @echo "XML_CHAPTER_FILES: $(XML_CHAPTER_FILES)" - @echo "BOOK_FILES: $(BOOK_FILES)" - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(MAN4DIR)/* - rm -f $(MAN6DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f $(SPECDIR)/* - rm -f errs core *~ *.eps - $(SPECDIR)/specs_erl_prim_loader_stub.xml: $(gen_verbose)escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ -o$(dir $@) -module erl_prim_loader_stub @@ -189,24 +108,17 @@ $(SPECDIR)/specs_zlib_stub.xml: $(gen_verbose)escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ -o$(dir $@) -module zlib_stub +NO_CHUNKS = erl_prim_loader_stub.xml erlang_stub.xml init_stub.xml zlib_stub.xml # ---------------------------------------------------- -# Release Target +# FIGURES # ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk +# In order to update the figures you have to have both dia +# and imagemagick installed. +# The generated .png file must be committed. -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man4" - $(INSTALL_DATA) $(MAN4_FILES) "$(RELEASE_PATH)/man/man4" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" +update_png: + dia --export=logger_arch.eps logger_arch.dia + convert logger_arch.eps -resize 65% logger_arch.png -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml index 4aa9e8b9d2..45538d3239 100644 --- a/lib/kernel/doc/src/code.xml +++ b/lib/kernel/doc/src/code.xml @@ -315,6 +315,9 @@ zip:create("mnesia-4.4.7.ez", <name name="load_error_rsn"/> </datatype> <datatype> + <name name="module_status"/> + </datatype> + <datatype> <name name="prepared_code"/> <desc><p>An opaque term holding prepared code.</p></desc> </datatype> @@ -702,6 +705,21 @@ ok = code:finish_loading(Prepared), </desc> </func> <func> + <name name="all_available" arity="0" since="OTP @OTP-16494@"/> + <fsummary>Get all available modules.</fsummary> + <type name="loaded_filename"/> + <type name="loaded_ret_atoms"/> + <type_desc name="loaded_filename"><c><anno>Filename</anno></c> is an absolute + filename.</type_desc> + <desc> + <p>Returns a list of tuples <c>{<anno>Module</anno>, <anno>Filename</anno>, + <anno>Loaded</anno>}</c> for all available modules. A module is considered + to be available if it either is loaded or would be loaded if called. + <c><anno>Filename</anno></c> is normally the absolute filename, as described for + <seealso marker="#is_loaded/1"><c>is_loaded/1</c></seealso>.</p> + </desc> + </func> + <func> <name name="all_loaded" arity="0" since=""/> <fsummary>Get all loaded modules.</fsummary> <type name="loaded_filename"/> @@ -718,6 +736,7 @@ ok = code:finish_loading(Prepared), <func> <name name="which" arity="1" since=""/> <fsummary>The object code file of a module.</fsummary> + <type name="loaded_filename"/> <type name="loaded_ret_atoms"/> <desc> <p>If the module is not loaded, this function searches the code @@ -750,6 +769,22 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), </desc> </func> <func> + <name name="get_doc" arity="1" since="OTP @OTP-16406@"/> + <fsummary>Gets the documentation for a module.</fsummary> + <desc> + <p>Searches the code path for a documentation chunk + and returns ut if available. If no documentation chunk + can be found the function tries to generate documentation + from the debug information in the module. If no debug + information is available, this function will return + <c>{error,missing}</c>. + </p> + <p>For more information about the documentation chunk see + <seealso marker="erl_docgen:doc_storage">Documentation Storage</seealso> + in Erl_Docgen's User's Guide.</p> + </desc> + </func> + <func> <name name="root_dir" arity="0" since=""/> <fsummary>Root directory of Erlang/OTP.</fsummary> <desc> @@ -901,10 +936,20 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), </desc> </func> <func> + <name name="module_status" arity="0" since="OTP 23.0"/> + <fsummary>Return the statuses of all loaded modules.</fsummary> + <type name="module_status"/> + <desc> + <p>See <seealso marker="#module_status/1"><c>module_status/1</c></seealso> and <seealso marker="#all_loaded/0"><c>all_loaded/0</c></seealso> for details.</p> + </desc> + </func> + <func> <name name="module_status" arity="1" since="OTP 20.0"/> - <fsummary>Return the status of the module in relation to object file on disk.</fsummary> + <fsummary>Return the status of a module or modules in relation to the + object files on disk.</fsummary> + <type name="module_status"/> <desc> - <p>Returns:</p> + <p>The status of a module can be one of:</p> <taglist> <tag><c>not_loaded</c></tag> <item><p>If <c><anno>Module</anno></c> is not currently loaded.</p></item> diff --git a/lib/kernel/doc/src/disk_log.xml b/lib/kernel/doc/src/disk_log.xml index e308b06f3c..4bfe9cb0db 100644 --- a/lib/kernel/doc/src/disk_log.xml +++ b/lib/kernel/doc/src/disk_log.xml @@ -127,6 +127,10 @@ functions fail. The corresponding terms (not the binaries) are returned when <c>chunk/2,3</c> is called. </p> + <note><p> + The distributed disk log feature has been deprecated. This + feature has also been scheduled for removal in OTP 24. + </p></note> <p>A collection of open disk logs with the same name running on different nodes is said to be a <em>distributed disk log</em> if requests made to any of the logs are automatically made to @@ -609,6 +613,10 @@ the current node, <c><anno>Dist</anno></c> has the value <c>local</c>, otherwise all nodes where the log is distributed are returned as a list.</p> + <warning><p> + The distributed disk log feature has been deprecated. This + feature has also been scheduled for removal in OTP 24. + </p></warning> </item> </taglist> <p>The following pairs are returned for all logs opened in @@ -871,7 +879,11 @@ adding members to a distributed disk log. Defaults to <c>[]</c>, which means that the log is local on the current node. - </p> + </p> + <warning><p> + The distributed disk log feature has been deprecated. This + feature has also been scheduled for removal in OTP 24. + </p></warning> </item> <tag><c>{notify, boolean()}</c><marker id="notify"></marker></tag> <item> diff --git a/lib/kernel/doc/src/erpc.xml b/lib/kernel/doc/src/erpc.xml new file mode 100644 index 0000000000..43e25b016b --- /dev/null +++ b/lib/kernel/doc/src/erpc.xml @@ -0,0 +1,513 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2020</year><year>2020</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>erpc</title> + <prepared>Rickard Green</prepared> + <docno>1</docno> + <date>2020-02-20</date> + <rev>A</rev> + </header> + <module since="OTP @OTP-13450@">erpc</module> + <modulesummary>Enhanced Remote Procedure Call</modulesummary> + <description> + <p> + This module provide services similar to Remote Procedure Calls. + A remote procedure call is a method to call a function on a remote + node and collect the answer. It is used for collecting information + on a remote node, or for running a function with some specific side + effects on the remote node. + </p> + <p> + This is an enhanced subset of the operations provided by the + <seealso marker="rpc"><c>rpc</c></seealso> module. Enhanced in the + sense that it makes it possible to distinguish between returned + value, raised exceptions, and other errors. <c>erpc</c> also has + better performance and scalability than the original <c>rpc</c> + implementation. However, current <c>rpc</c> module will utilize + <c>erpc</c> in order to also provide these properties when + possible. + </p> + <p> + In order for an <c>erpc</c> operation to succeed, the remote + node also needs to support <c>erpc</c>. Typically only ordinary + Erlang nodes as of OTP 23 have <c>erpc</c> support. + </p> + </description> + + <datatypes> + <datatype> + <name name="request_id"/> + <desc> + <p> + An opaque type of call request identifiers. For more + information see + <seealso marker="#send_request/4"><c>send_request/4</c></seealso>. + </p> + </desc> + </datatype> + </datatypes> + + <funcs> + + <func> + <name name="call" arity="4" since="OTP @OTP-13450@"/> + <name name="call" arity="5" since="OTP @OTP-13450@"/> + <fsummary>Evaluate a function call on a node.</fsummary> + <desc> + <p> + Evaluates <c>apply(<anno>Module</anno>, <anno>Function</anno>, + <anno>Args</anno>)</c> on node <c><anno>Node</anno></c> and returns + the corresponding value <c><anno>Result</anno></c>. + <c><anno>Timeout</anno></c> is an integer representing + the timeout in milliseconds or the atom <c>infinity</c>. + </p> + <p>The call <c>erpc:call(<anno>Node</anno>, <anno>Module</anno>, + <anno>Function</anno>, <anno>Args</anno>)</c> is equivalent + to the call <c>erpc:call(<anno>Node</anno>, <anno>Module</anno>, + <anno>Function</anno>, <anno>Args</anno>, infinity)</c></p> + <p> + The <c>call()</c> function only returns if the applied + function successfully returned without raising any uncaught + exceptions, the operation did not time out, and no failures + occurred. In all other cases an exception is raised. The + following exceptions, listed by exception class, can + currently be raised by <c>erpc:call()</c>: + </p> + <taglist> + <tag><c>throw</c></tag> + <item><p> + The applied function called <c>throw(Value)</c> + and did not catch this exception. The exception + reason <c>Value</c> equals the argument passed to + <c>throw/1</c>. + </p></item> + + <tag><c>exit</c></tag> + <item><p> + Exception reason: + </p> + <taglist> + <tag><c>{exception, ExitReason}</c></tag> + <item><p> + The applied function called <c>exit(ExitReason)</c> + and did not catch this exception. The exit + reason <c>ExitReason</c> equals the argument passed + to <c>exit/1</c>. + </p></item> + <tag><c>{signal, ExitReason}</c></tag> + <item><p> + The process that applied the function received an + exit signal and terminated due to this signal. The + process terminated with exit reason <c>ExitReason</c>. + </p></item> + </taglist> + </item> + + <tag><c>error</c></tag> + <item><p> + Exception reason: + </p> + <taglist> + + <tag><c>{exception, ErrorReason, StackTrace}</c></tag> + <item><p> + A runtime error occurred which raised and error + exception while applying the function, + and the applied function did not catch the + exception. The error reason <c>ErrorReason</c> + indicates the type of error that occurred. + <c>StackTrace</c> is formatted as when caught in a + <c>try/catch</c> construct. The <c>StackTrace</c> + is limited to the applied function and functions + called by it. + </p></item> + + <tag><c>{erpc, ERpcErrorReason}</c></tag> + <item><p> + The <c>erpc</c> operation failed. The following + <c>ERpcErrorReason</c>s are the most common ones: + </p> + + <taglist> + <tag><c>badarg</c></tag> + <item> + <p>If any one of these are true:</p> + <list> + <item><p><c><anno>Node</anno></c> is not a valid + node name atom.</p></item> + <item><p><c><anno>Module</anno></c> is not an atom.</p></item> + <item><p><c><anno>Function</anno></c> is not an atom.</p></item> + <item><p><c><anno>Args</anno></c> is not a proper list + of terms.</p></item> + <item><p><c><anno>Timeout</anno></c> is not the + atom <c>infinity</c> or an integer in valid + range.</p></item> + </list> + </item> + + <tag><c>noconnection</c></tag> + <item><p> + The connection to <c>Node</c> was lost or could + not be established. The function may or may not + be applied. + </p></item> + + <tag><c>system_limit</c></tag> + <item><p> + The <c>erpc</c> operation failed due to some system + limit being reached. This typically due to failure + to create a process on the remote node <c>Node</c>, + but can be other things as well. + </p></item> + + <tag><c>timeout</c></tag> + <item><p> + The <c>erpc</c> operation timed out. The function may + or may not be applied. + </p></item> + + <tag><c>notsup</c></tag> + <item><p> + The remote node <c>Node</c> does not support + this <c>erpc</c> operation. + </p> + </item> + + </taglist> + </item> + + </taglist> + </item> + </taglist> + + <p> + If the <c>erpc</c> operation fails, but it is unknown if + the function is/will be applied (that is, a timeout or + a connection loss), the caller will not receive any + further information about the result if/when the applied + function completes. If the applied function explicitly + communicates with the calling process, such communication + may, of course, reach the calling process. + </p> + + <note> + <p> + You cannot make <em>any</em> assumptions about the + process that will perform the <c>apply()</c>. It may + be the calling process itself, a server, or a freshly + spawned process. + </p> + </note> + </desc> + </func> + + <func> + <name name="cast" arity="4" since="OTP @OTP-13450@"/> + <fsummary>Evaluate a function call on a node ignoring the result.</fsummary> + <desc> + <p> + Evaluates <c>apply(<anno>Module</anno>, <anno>Function</anno>, + <anno>Args</anno>)</c> on node + <c><anno>Node</anno></c>. No response is delivered to the + calling process. <c>erpc:cast()</c> returns immediately + after the cast request has been sent. Any failures beside + bad arguments are silently ignored. + </p> + <p><c>erpc:cast/4</c> fails with an <c>{erpc, badarg}</c> + <c>error</c> exception if:</p> + <list> + <item><p><c><anno>Node</anno></c> is not a valid + node name atom.</p></item> + <item><p><c><anno>Module</anno></c> is not an atom.</p></item> + <item><p><c><anno>Function</anno></c> is not an atom.</p></item> + <item><p><c><anno>Args</anno></c> is not a proper list + of terms.</p></item> + </list> + <note> + <p> + You cannot make <em>any</em> assumptions about the + process that will perform the <c>apply()</c>. It may + be a server, or a freshly spawned process. + </p> + </note> + </desc> + </func> + + <func> + <name name="check_response" arity="2" since="OTP @OTP-13450@"/> + <fsummary>Check if a message is a response corresponding to a + previously sent call request.</fsummary> + <desc> + <p> + Check if a message is a response to a <c>call</c> request + previously made by the calling process using + <seealso marker="#send_request/4"><c>erpc:send_request/4</c></seealso>. + <c><anno>RequestId</anno></c> should be the value returned + from the previously made <c>erpc:send_request()</c> call, + and the corresponding response should not already have been + received and handled to completion by <c>erpc:check_response()</c>, + <seealso marker="#receive_response/2"><c>erpc:receive_response()</c></seealso>, or + <seealso marker="#wait_response/2"><c>erpc:wait_response()</c></seealso>. + <c><anno>Message</anno></c> is the message to check. + </p> + <p> + If <c><anno>Message</anno></c> does not correspond to the + response, the atom <c>no_response</c> is returned. If + <c><anno>Message</anno></c> corresponds to the response, the + <c>call</c> operation is completed and either the result is + returned as <c>{response, Result}</c> where <c>Result</c> + corresponds to the value returned from the applied function + or an exception is raised. The exceptions that can be raised + corresponds to the same exceptions as can be raised by + <seealso marker="#call/4"><c>erpc:call/4</c></seealso>. + That is, no <c>{erpc, timeout}</c> <c>error</c> exception + can be raised. + </p> + <p> + If the <c>erpc</c> operation fails, but it is unknown if + the function is/will be applied (that is, a connection loss), + the caller will not receive any further information about the + result if/when the applied function completes. If the applied + function explicitly communicates with the calling process, + such communication may, of course, reach the calling process. + </p> + </desc> + </func> + + <func> + <name name="multicall" arity="4" since="OTP @OTP-13450@"/> + <name name="multicall" arity="5" since="OTP @OTP-13450@"/> + <fsummary>Evaluate a function call on a number of nodes.</fsummary> + <type name="caught_call_exception"/> + <type name="stack_item"/> + <desc> + <p> + Performs multiple <c>call</c> operations in parallel + on multiple nodes. The result is returned as a list where + the result from each node is placed at the same position + as the node name is placed in <c><anno>Nodes</anno></c>. + Each item in the resulting list is formatted as either: + </p> + <taglist> + <tag><c>{ok, Result}</c></tag> + <item><p> + The <c>call</c> operation for this specific node + returned <c>Result</c>. + </p></item> + <tag><c>{Class, ExceptionReason}</c></tag> + <item><p> + The <c>call</c> operation for this specific node + raised an exception of class <c>Class</c> with + exception reason <c>ExceptionReason</c>. These + corresponds the the exceptions that + <seealso marker="#call/5"><c>erpc:call/5</c></seealso> + can raise. + </p></item> + </taglist> + <p> + The call <c>erpc:multicall(<anno>Nodes</anno>, <anno>Module</anno>, + <anno>Function</anno>, <anno>Args</anno>)</c> is equivalent + to the call <c>erpc:multicall(<anno>Nodes</anno>, <anno>Module</anno>, + <anno>Function</anno>, <anno>Args</anno>, infinity)</c>. These + calls are also equivalent to calling <c>my_multicall(Nodes, Module, + Function, Args)</c> if one disregards performance: + </p> + <pre> +my_multicall(Nodes, Module, Function, Args) -> + ReqIds = lists:map(fun (Node) -> + <seealso marker="#send_request/4">erpc:send_request(Node, Module, Function, Args)</seealso> + end, + Nodes), + lists:map(fun (ReqId) -> + try + {ok, <seealso marker="#receive_response/2">erpc:receive_response(ReqId, infinity)</seealso>} + catch + Class:Reason -> + {Class, Reason} + end + end, + ReqIds). +</pre> + + <p> + The <c><anno>Timeout</anno></c> value in milliseconds + sets an upper time limit for all <c>call</c> operations + to complete. + </p> + + <p> + If an <c>erpc</c> operation fails, but it is unknown if + the function is/will be applied (that is, a timeout or + connection loss), the caller will not receive any + further information about the result if/when the applied + function completes. If the applied function communicates + with the calling process, such communication may, of + course, reach the calling process. + </p> + </desc> + + </func> + + <func> + <name name="receive_response" arity="1" since="OTP @OTP-13450@"/> + <name name="receive_response" arity="2" since="OTP @OTP-13450@"/> + <fsummary>Receive a call response corresponding to a + previously sent call request.</fsummary> + <desc> + <p> + Receive a response to a <c>call</c> request previously + made by the calling process using + <seealso marker="#send_request/4"><c>erpc:send_request/4</c></seealso>. + <c><anno>RequestId</anno></c> should be the value returned from + the previously made <c>erpc:send_request()</c> call, and + the corresponding response should not already have been received + and handled to completion by + <seealso marker="#check_response/2"><c>erpc:check_response()</c></seealso>, + <c>erpc:receive_response()</c>, or + <seealso marker="#wait_response/2"><c>erpc:wait_response()</c></seealso>. + <c><anno>Timeout</anno></c> equals the timeout time in milliseconds + or the atom <c>infinity</c>. The <c>call</c> operation is completed + once the <c>erpc:receive_response()</c> call returns or raise an + exception. + </p> + <p> + The call <c>erpc:receive_response(<anno>RequestId</anno>)</c> is + equivalent to the call + <c>erpc:receive_response(<anno>RequestId</anno>, infinity)</c>. + </p> + <p> + A call to the function + <c>my_call(Node, Module, Function, Args, Timeout)</c> + below is equivalent to the call + <seealso marker="#call/5"><c>erpc:call(Node, Module, Function, Args, + Timeout)</c></seealso> if one disregards performance. <c>erpc:call()</c> + can utilize a message queue optimization which removes the need to scan + the whole message queue which the combination + <c>erpc:send_request()/erpc:receive_response()</c> cannot. + </p> + <pre> +my_call(Node, Module, Function, Args, Timeout) -> + RequestId = <seealso marker="#send_request/4">erpc:send_request(Node, Module, Function, Args)</seealso>, + erpc:receive_response(RequestId, Timeout). +</pre> + <p> + If the <c>erpc</c> operation fails, but it is unknown if + the function is/will be applied (that is, a timeout, or + a connection loss), the caller will not receive any + further information about the result if/when the applied + function completes. If the applied function explicitly + communicates with the calling process, such communication + may, of course, reach the calling process. + </p> + + <p> + <c>erpc:receive_response()</c> will return or raise exceptions the + same way as <seealso marker="#call/5"><c>erpc:call/5</c></seealso> + does. + </p> + </desc> + </func> + + <func> + <name name="send_request" arity="4" since="OTP @OTP-13450@"/> + <fsummary>Send a request to evaluate a function call on a node.</fsummary> + <desc> + <p> + Send an asynchronous <c>call</c> request to the node + <c><anno>Node</anno></c>. <c>erpc:send_request()</c> + returns a request identifier that later is to be passed + as argument to either + <seealso marker="#receive_response/1"><c>erpc:receive_response()</c></seealso>, + <seealso marker="#wait_response/1"><c>erpc:wait_response()</c></seealso>, + or, + <seealso marker="#check_response/2"><c>erpc:check_response()</c></seealso> + in order to get the response of the call request. + </p> + <p><c>erpc:send_request()</c> fails with an <c>{erpc, badarg}</c> + <c>error</c> exception if:</p> + <list> + <item><p><c><anno>Node</anno></c> is not a valid + node name atom.</p></item> + <item><p><c><anno>Module</anno></c> is not an atom.</p></item> + <item><p><c><anno>Function</anno></c> is not an atom.</p></item> + <item><p><c><anno>Args</anno></c> is not a proper list + of terms.</p></item> + </list> + </desc> + </func> + + <func> + <name name="wait_response" arity="1" since="OTP @OTP-13450@"/> + <name name="wait_response" arity="2" since="OTP @OTP-13450@"/> + <fsummary>Wait or poll for a call response corresponding to a previously + sent call request.</fsummary> + <desc> + <p> + Wait or poll for a response message to a <c>call</c> request + previously made by the calling process using + <seealso marker="#send_request/4"><c>erpc:send_request/4</c></seealso>. + <c><anno>RequestId</anno></c> should be the value returned from + the previously made <c>erpc:send_request()</c> call, and the + corresponding response should not already have been received and handled + to completion by + <seealso marker="#check_response/2"><c>erpc:check_response()</c></seealso>, + <seealso marker="#receive_response/2"><c>erpc:receive_response()</c></seealso>, + or <c>erpc:wait_response()</c>. <c><anno>WaitTime</anno></c> equals the + time to wait in milliseconds (or the atom <c>infinity</c>) during the wait. + </p> + <p> + The call <c>erpc:wait_response(<anno>RequestId</anno>)</c> is equivalent + to the call <c>erpc:wait_response(<anno>RequestId</anno>, 0)</c>. That is, + poll for a response message to a <c>call</c> request previously made by + the calling process. + </p> + <p> + If no response is received before <c><anno>WaitTime</anno></c> milliseconds, + the atom <c>no_response</c> is returned. It is valid to continue waiting + for a response as many times as needed up until a response has + been received and completed by <c>erpc:check_response()</c>, + <c>erpc:receive_response()</c>, or <c>erpc:wait_response()</c>. If a + response is received, the <c>call</c> operation is completed and either + the result is returned as <c>{response, Result}</c> where <c>Result</c> + corresponds to the value returned from the applied function or an + exception is raised. The exceptions that can be raised corresponds to the + same exceptions as can be raised by + <seealso marker="#call/4"><c>erpc:call/4</c></seealso>. + That is, no <c>{erpc, timeout}</c> <c>error</c> exception can be raised. + </p> + <p> + If the <c>erpc</c> operation fails, but it is unknown if + the function is/will be applied (that is, a too large wait time + value, or a connection loss), the caller will not receive any + further information about the result if/when the applied function + completes. If the applied function explicitly communicates with the + calling process, such communication may, of course, reach the + calling process. + </p> + </desc> + </func> + + </funcs> +</erlref> + diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index fc25e83d40..c4073f13a2 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -202,10 +202,7 @@ <desc> <p><c>allocate/3</c> can be used to preallocate space for a file.</p> <p>This function only succeeds in platforms that provide this - feature. When it succeeds, space is preallocated for the file but - the file size might not be updated. This behaviour depends on the - preallocation implementation. To guarantee that the file size is updated, - truncate the file to the new size.</p> + feature.</p> </desc> </func> <func> @@ -939,6 +936,10 @@ f.txt: {person, "kalle", 25}. support for POSIX <c>O_SYNC</c> or equivalent, use of the <c>sync</c> flag causes <c>open</c> to return <c>{error, enotsup}</c>.</p> </item> + <tag><c>directory</c></tag> + <item> + <p>Allows <c>open</c> to work on directories.</p> + </item> </taglist> <p>Returns:</p> <taglist> @@ -953,10 +954,9 @@ f.txt: {person, "kalle", 25}. </item> </taglist> <p><c><anno>IoDevice</anno></c> is really the pid of the process that - handles the file. This process is linked to the process - that originally opened the file. If any process to which - the <c><anno>IoDevice</anno></c> is linked terminates, the file is - closed and the process itself is terminated. + handles the file. This process monitors the process that originally + opened the file (the owner process). If the owner process terminates, + the file is closed and the process itself terminates too. An <c><anno>IoDevice</anno></c> returned from this call can be used as an argument to the I/O functions (see <seealso marker="stdlib:io"><c>io(3)</c></seealso>).</p> @@ -985,8 +985,10 @@ f.txt: {person, "kalle", 25}. </item> <tag><c>enotdir</c></tag> <item> - <p>A component of the filename is not a directory. On some - platforms, <c>enoent</c> is returned instead.</p> + <p>A component of the filename is not a directory, or the + filename itself is not a directory if <c>directory</c> + mode was specified. On some platforms, <c>enoent</c> is + returned instead.</p> </item> <tag><c>enospc</c></tag> <item> @@ -1438,7 +1440,11 @@ f.txt: {person, "kalle", 25}. break this module's atomicity guarantees as it can race with a concurrent call to <seealso marker="#write_file_info/2"><c>write_file_info/1,2</c> - </seealso></p> + </seealso>.</p> + <p>This option has no effect when the function is + given an I/O device instead of a file name. Use + <seealso marker="#open/2"><c>open/2</c></seealso> with the + <c>raw</c> mode to obtain a file descriptor first.</p> <note> <p>As file times are stored in POSIX time on most OS, it is faster to query file information with option <c>posix</c>.</p> diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml index 61ac1485c1..d9194da4f2 100644 --- a/lib/kernel/doc/src/gen_sctp.xml +++ b/lib/kernel/doc/src/gen_sctp.xml @@ -165,7 +165,7 @@ <pre> #sctp_assoc_change{ state = atom(), - error = atom(), + error = integer(), outbound_streams = integer(), inbound_streams = integer(), assoc_id = assoc_id() @@ -208,7 +208,9 @@ connect(Socket, Ip, Port>, <tag><c>shutdown_comp</c></tag> <item></item> </taglist> - <p>Field <c>error</c> can provide more detailed diagnostics.</p> + <p>Field <c>error</c> can provide more detailed diagnostics. + The <c>error</c> field value can be converted into a string using + <seealso marker="#error_string/1"><c>error_string/1</c></seealso>.</p> </desc> </func> diff --git a/lib/kernel/doc/src/gen_udp.xml b/lib/kernel/doc/src/gen_udp.xml index 14819aa938..9ecadc5498 100644 --- a/lib/kernel/doc/src/gen_udp.xml +++ b/lib/kernel/doc/src/gen_udp.xml @@ -305,4 +305,3 @@ </func> </funcs> </erlref> - diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index 7f9609d5c1..7ad3d15cd6 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -414,6 +414,15 @@ MaxT = TickTime + TickTime / 4</code> using this service.</p> <p>Defaults to <c>false</c>.</p> </item> + <tag><c>start_pg = true | false</c></tag> + <item> + <marker id="start_pg"></marker> + <p>Starts the default <c>pg</c> scope server (see + <seealso marker="pg"><c>pg(3)</c></seealso>) if + the parameter is <c>true</c>. This parameter is to be set to + <c>true</c> in an embedded system that uses this service.</p> + <p>Defaults to <c>false</c>.</p> + </item> <tag><c>start_pg2 = true | false</c></tag> <item> <marker id="start_pg2"></marker> @@ -556,6 +565,7 @@ erl -kernel logger '[{handler,default,logger_std_h,#{formatter=>{logger_formatte <seealso marker="logger"><c>logger(3)</c></seealso>, <seealso marker="net_kernel"><c>net_kernel(3)</c></seealso>, <seealso marker="os"><c>os(3)</c></seealso>, + <seealso marker="pg"><c>pg(3)</c></seealso>, <seealso marker="pg2"><c>pg2(3)</c></seealso>, <seealso marker="rpc"><c>rpc(3)</c></seealso>, <seealso marker="seq_trace"><c>seq_trace(3)</c></seealso>, diff --git a/lib/kernel/doc/src/net.xml b/lib/kernel/doc/src/net.xml index d60e1af311..d7732e714a 100644 --- a/lib/kernel/doc/src/net.xml +++ b/lib/kernel/doc/src/net.xml @@ -122,7 +122,7 @@ <funcs> <func> - <name name="gethostname" arity="0"/> + <name name="gethostname" arity="0" since="OTP 22.0"/> <fsummary>Get hostname.</fsummary> <desc> <p>Returns the name of the current host.</p> diff --git a/lib/kernel/doc/src/pg.xml b/lib/kernel/doc/src/pg.xml new file mode 100644 index 0000000000..f04d9561e9 --- /dev/null +++ b/lib/kernel/doc/src/pg.xml @@ -0,0 +1,195 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<!-- %ExternalCopyright% --> + +<erlref> + <header> + <copyright> + <year>2020</year><year>2020</year> + <holder>Maxim Fedorov, WhatsApp Inc.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>pg</title> + <prepared>maximfca@gmail.com</prepared> + <responsible></responsible> + <docno></docno> + <approved></approved> + <checked></checked> + <date></date> + <rev>A</rev> + <file>pg.xml</file> + </header> + <module since="OTP 23.0">pg</module> + <modulesummary>Distributed named process groups.</modulesummary> + <description> + <p>This module implements process groups. A message can be sent + to one, some, or all group members.</p> + + <p>Up until OTP 17 there used to exist an experimental <c>pg</c> + module in <c>stdlib</c>. This <c>pg</c> module is not the same + module as that experimental <c>pg</c> module, and only share + the same module name.</p> + + <p>A group of processes can be accessed by a common name. For + example, if there is a group named <c>foobar</c>, there can be a + set of processes (which can be located on different nodes) that + are all members of the group <c>foobar</c>. There are no special + functions for sending a message to the group. Instead, client + functions are to be written with the functions + <seealso marker="#get_members/1"><c>get_members/1</c></seealso> and + <seealso marker="#get_local_members/1"><c>get_local_members/1</c></seealso> + to determine which processes are members of the group. + Then the message can be sent to one or more group members.</p> + <p>If a member terminates, it is automatically removed from the group.</p> + + <p>A process may join multiple groups. It may join the same group multiple times. + It is only allowed to join processes running on local node. + </p> + + <p>Process Groups implement strong eventual consistency. + Unlike <seealso marker="pg2"><c>pg2</c></seealso>, that provides + strong ordering guarantees, Process Groups membership view may temporarily + diverge. For example, when processes on <c>node1</c> and <c>node2</c> + join concurrently, <c>node3</c> and <c>node4</c> may receive updates in + a different order.</p> + + <p> Membership view is not transitive. If <c>node1</c> is not directly + connected to <c>node2</c>, they will not see each other groups. But if + both are connected to <c>node3</c>, <c>node3</c> will have the full view. </p> + + <p>Groups are automatically created when any process joins, + and are removed when all processes leave the group. Non-existing group is + considered empty (containing no processes).</p> + + <p>Process groups can be organised into multiple scopes. Scopes are + completely independent of each other. A process may join any + number of groups in any number of scopes. Scopes are designed to + decouple single mesh into a set of overlay networks, reducing + amount of traffic required to propagate group membership + information. Default scope <c>pg</c> is started automatically + when <seealso marker="kernel_app#start_pg"><c>kernel(6)</c></seealso> + is configured to do so. + </p> + + <note><p> + Scope name is used to register process locally, and to name an ETS table. + If there is another process registered under this name, or another ETS table + exists, scope fails to start.</p> + <p>Local membership is not preserved if scope process exits and + restarts. This behaviour is different from + <seealso marker="pg2"><c>pg2</c></seealso>, that recovers + local membership from remote nodes. + </p></note> + + </description> + + <datatypes> + <datatype> + <name name="group"/> + <desc><p>The identifier of a process group.</p></desc> + </datatype> + </datatypes> + + <funcs> + + <func> + <name name="start_link" arity="0" since="OTP 23.0"/> + <fsummary>Start the default <c>pg</c> scope.</fsummary> + <desc> + <p>Starts the default <c>pg</c> scope within supervision tree. + Kernel may be configured to do it automatically, see + <seealso marker="kernel_app#start_pg"><c>kernel(6)</c></seealso> + configuration manual.</p> + </desc> + </func> + + <func> + <name name="start" arity="1" since="OTP 23.0"/> + <name name="start_link" arity="1" since="OTP 23.0"/> + <fsummary>Start additional scope.</fsummary> + <desc> + <p>Starts additional scope.</p> + </desc> + </func> + + <func> + <name name="join" arity="2" since="OTP 23.0"/> + <name name="join" arity="3" since="OTP 23.0"/> + <fsummary>Join a process or a list of processes to a group.</fsummary> + <desc> + <p>Joins single process or multiple processes to the + group <c>Name</c>. A process can join a group many times and + must then leave the group the same number of times.</p> + <p><c>PidOrPids</c> may contain the same process multiple times.</p> + </desc> + </func> + + <func> + <name name="leave" arity="2" since="OTP 23.0"/> + <name name="leave" arity="3" since="OTP 23.0"/> + <fsummary>Make a process leave a group.</fsummary> + <desc> + <p>Makes the process <c>PidOrPids</c> leave the group <c>Name</c>. + If the process is not a member of the group, <c>not_joined</c> is + returned.</p> + <p>When list of processes is passed as <c>PidOrPids</c>, function + returns <c>not_joined</c> only when all processes of the list + are not joined.</p> + </desc> + </func> + + <func> + <name name="get_local_members" arity="1" since="OTP 23.0"/> + <name name="get_local_members" arity="2" since="OTP 23.0"/> + <fsummary>Return all local processes in a group.</fsummary> + <desc> + <p>Returns all processes running on the local node in the + group <c>Name</c>. Processes are returned in no specific order. + This function is optimised for speed. + </p> + </desc> + </func> + + <func> + <name name="get_members" arity="1" since="OTP 23.0"/> + <name name="get_members" arity="2" since="OTP 23.0"/> + <fsummary>Return all processes in a group.</fsummary> + <desc> + <p>Returns all processes in the group <c>Name</c>. + Processes are returned in no specific order. + This function is optimised for speed.</p> + </desc> + </func> + + <func> + <name name="which_groups" arity="0" since="OTP 23.0"/> + <name name="which_groups" arity="1" since="OTP 23.0"/> + <fsummary>Return a list of all known groups.</fsummary> + <desc> + <p>Returns a list of all known groups.</p> + </desc> + </func> + + </funcs> + + <section> + <title>See Also</title> + <p><seealso marker="kernel_app"><c>kernel(6)</c></seealso></p> + </section> +</erlref> + diff --git a/lib/kernel/doc/src/pg2.xml b/lib/kernel/doc/src/pg2.xml index 058d711756..510dea0b92 100644 --- a/lib/kernel/doc/src/pg2.xml +++ b/lib/kernel/doc/src/pg2.xml @@ -35,6 +35,16 @@ <module since="">pg2</module> <modulesummary>Distributed named process groups.</modulesummary> <description> + <warning> + <p> + The <c>pg2</c> module is deprecated as of OTP 23 and scheduled + for removal in OTP 24. You are advised to replace the usage of + <c>pg2</c> with <seealso marker="kernel:pg">pg</seealso>. + <c>pg</c> has a similar API, but with an implementation that + is more scalable. See the documentation of <c>pg</c> for more + information about differences. + </p> + </warning> <p>This module implements process groups. Each message can be sent to one, some, or all group members.</p> <p>A group of processes can be accessed by a common name. For diff --git a/lib/kernel/doc/src/ref_man.xml b/lib/kernel/doc/src/ref_man.xml index 9df51dee22..9127157eb5 100644 --- a/lib/kernel/doc/src/ref_man.xml +++ b/lib/kernel/doc/src/ref_man.xml @@ -43,6 +43,7 @@ <xi:include href="erl_epmd.xml"/> <xi:include href="erl_prim_loader_stub.xml"/> <xi:include href="erlang_stub.xml"/> + <xi:include href="erpc.xml"/> <xi:include href="error_handler.xml"/> <xi:include href="error_logger.xml"/> <xi:include href="file.xml"/> @@ -64,6 +65,7 @@ <xi:include href="net_adm.xml"/> <xi:include href="net_kernel.xml"/> <xi:include href="os.xml"/> + <xi:include href="pg.xml"/> <xi:include href="pg2.xml"/> <xi:include href="rpc.xml"/> <xi:include href="seq_trace.xml"/> diff --git a/lib/kernel/doc/src/rpc.xml b/lib/kernel/doc/src/rpc.xml index 0e07d334d8..03bfc97c5b 100644 --- a/lib/kernel/doc/src/rpc.xml +++ b/lib/kernel/doc/src/rpc.xml @@ -37,13 +37,29 @@ a function on a remote node and collect the answer. It is used for collecting information on a remote node, or for running a function with some specific side effects on the remote node.</p> + <note><p> + <c>rpc:call()</c> and friends makes it quite hard to distinguish + between successful results, raised exceptions, and other errors. + This cannot be changed due to compatibility reasons. As of OTP 23, + a new module <seealso marker="erpc"><c>erpc</c></seealso> was + introduced in order to provide an API that makes it possible + to distingush between the different results. The <c>erpc</c> + module provides a subset (however, the central subset) of the + functionality available in the <c>rpc</c> module. The <c>erpc</c> + implementation also provides a more scalable implementation with + better performance than the original <c>rpc</c> implementation. + However, since the introduction of <c>erpc</c>, the <c>rpc</c> + module implements large parts of its central functionality using + <c>erpc</c>, so the <c>rpc</c> module wont not suffer scalability + wise and performance wise compared to <c>erpc</c>. + </p></note> </description> <datatypes> <datatype> <name name="key"/> <desc> - <p>As returned by + <p>Opaque value returned by <seealso marker="#async_call/4"><c>async_call/4</c></seealso>.</p> </desc> </datatype> @@ -87,7 +103,17 @@ <seealso marker="#nb_yield/1"><c>nb_yield/1,2</c></seealso> to retrieve the value of evaluating <c>apply(<anno>Module</anno>, <anno>Function</anno>, <anno>Args</anno>)</c> on node - <c><anno>Node</anno></c>.</p> + <c><anno>Node</anno></c>.</p> + <note> + <p> + If you want the ability to distinguish between results, + you may want to consider using the + <seealso marker="erpc#send_request/4"><c>erpc:send_request()</c></seealso> + function from the <c>erpc</c> module instead. This also + gives you the ability retrieve the results in other useful + ways. + </p> + </note> <note> <p><seealso marker="#yield/1"><c>yield/1</c></seealso> and <seealso marker="#nb_yield/1"><c>nb_yield/1,2</c></seealso> @@ -99,34 +125,34 @@ <func> <name name="block_call" arity="4" since=""/> - <fsummary>Evaluate a function call on a node in the RPC server's - context.</fsummary> - <desc> - <p>Same as <seealso marker="#call/4"><c>call/4</c></seealso>, - but the RPC server at <c><anno>Node</anno></c> does - not create a separate process to handle the call. Thus, - this function can be used if the intention of the call is to - block the RPC server from any other incoming requests until - the request has been handled. The function can also be used - for efficiency reasons when very small fast functions are - evaluated, for example, BIFs that are guaranteed not to - suspend.</p> - <p>See the note in <seealso marker="#call/4"><c>call/4</c></seealso> - for more details of the return value.</p> + <fsummary>Evaluate a function call on a node.</fsummary> + <desc> + <p> + The same as calling + <seealso marker="#block_call/5"><c>rpc:block_call(<anno>Node</anno>, + <anno>Module</anno>, <anno>Function</anno>, + <anno>Args</anno>, infinity)</c></seealso>. + </p> </desc> </func> <func> <name name="block_call" arity="5" since=""/> - <fsummary>Evaluate a function call on a node in the RPC server's - context.</fsummary> + <fsummary>Evaluate a function call on a node.</fsummary> <desc> - <p>Same as - <seealso marker="#block_call/4"><c>block_call/4</c></seealso>, - but with a time-out value in the same manner as - <seealso marker="#call/5"><c>call/5</c></seealso>.</p> - <p>See the note in <seealso marker="#call/4"><c>call/4</c></seealso> - for more details of the return value.</p> + <p> + The same as calling + <seealso marker="#call/5"><c>rpc:call(<anno>Node</anno>, + <anno>Module</anno>, <anno>Function</anno>, + <anno>Args</anno>, <anno>Timeout</anno>)</c></seealso> with + the exception that it also blocks other <c>rpc:block_call()</c> + operations from executing concurrently on the node + <c><anno>Node</anno></c>. + </p> + <warning><p> + Note that it also blocks other operations than just + <c>rpc:block_call()</c> operations, so use it with care. + </p></warning> </desc> </func> @@ -135,9 +161,38 @@ <fsummary>Evaluate a function call on a node.</fsummary> <desc> <p>Evaluates <c>apply(<anno>Module</anno>, <anno>Function</anno>, + <anno>Args</anno>)</c> on node <c><anno>Node</anno></c> and returns + the corresponding value <c><anno>Res</anno></c>, or + <c>{badrpc, <anno>Reason</anno>}</c> if the call fails. + The same as calling + <seealso marker="#call/5"><c>rpc:call(<anno>Node</anno>, + <anno>Module</anno>, <anno>Function</anno>, + <anno>Args</anno>, infinity)</c></seealso>. + </p> + </desc> + </func> + + <func> + <name name="call" arity="5" since=""/> + <fsummary>Evaluate a function call on a node.</fsummary> + <desc> + <p>Evaluates <c>apply(<anno>Module</anno>, <anno>Function</anno>, <anno>Args</anno>)</c> on node <c><anno>Node</anno></c> and returns the corresponding value <c><anno>Res</anno></c>, or - <c>{badrpc, <anno>Reason</anno>}</c> if the call fails.</p> + <c>{badrpc, <anno>Reason</anno>}</c> if the call fails. + <c><anno>Timeout</anno></c> is + a time-out value in milliseconds. If the call times out, + <c><anno>Reason</anno></c> is <c>timeout</c>.</p> + <p>If the reply arrives after the call times out, no message + contaminates the caller's message queue.</p> + <note> + <p> + If you want the ability to distinguish between results, + you may want to consider using the + <seealso marker="erpc#call/4"><c>erpc:call()</c></seealso> + function from the <c>erpc</c> module instead. + </p> + </note> <note> <p>Here follows the details of what exactly is returned.</p> <p><c>{badrpc, <anno>Reason</anno>}</c> will be returned in the @@ -159,28 +214,14 @@ <strong>not</strong> match <c>{'EXIT',_}</c>.</item> </list> </note> - </desc> - </func> - - <func> - <name name="call" arity="5" since=""/> - <fsummary>Evaluate a function call on a node.</fsummary> - <desc> - <p>Evaluates <c>apply(<anno>Module</anno>, <anno>Function</anno>, - <anno>Args</anno>)</c> on node <c><anno>Node</anno></c> and returns - the corresponding value <c><anno>Res</anno></c>, or - <c>{badrpc, <anno>Reason</anno>}</c> if the call fails. - <c><anno>Timeout</anno></c> is - a time-out value in milliseconds. If the call times out, - <c><anno>Reason</anno></c> is <c>timeout</c>. - See the note in <seealso marker="#call/4"><c>call/4</c></seealso> - for more details of the return value.</p> - <p>If the reply arrives after the call times out, no message - contaminates the caller's message queue, as this - function spawns off a middleman process to act as (a void) - destination for such an orphan reply. This feature also makes - this function more expensive than <c>call/4</c> at - the caller's end.</p> + <note> + <p> + You cannot make <em>any</em> assumptions about the + process that will perform the <c>apply()</c>. It may + be the calling process itself, an <c>rpc</c> server, + another server, or a freshly spawned process. + </p> + </note> </desc> </func> @@ -194,6 +235,14 @@ process is not suspended until the evaluation is complete, as is the case with <seealso marker="#call/4"><c>call/4,5</c></seealso>.</p> + <note> + <p> + You cannot make <em>any</em> assumptions about the + process that will perform the <c>apply()</c>. It may + be an <c>rpc</c> server, another server, or a + freshly spawned process. + </p> + </note> </desc> </func> @@ -226,7 +275,7 @@ <anno>Name</anno>, <anno>Msg</anno>)</c>.</p> </desc> </func> - + <func> <name name="multi_server_call" arity="3" since=""/> <fsummary>Interact with the servers on a number of nodes.</fsummary> @@ -311,6 +360,14 @@ {ResL, _} = rpc:multicall(code, load_binary, [Mod, File, Bin]), %% and then maybe check the ResL list.</code> + <note> + <p> + If you want the ability to distinguish between results, + you may want to consider using the + <seealso marker="erpc#multicall/4"><c>erpc:multicall()</c></seealso> + function from the <c>erpc</c> module instead. + </p> + </note> </desc> </func> diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml index 9aef748594..059f03593f 100644 --- a/lib/kernel/doc/src/seq_trace.xml +++ b/lib/kernel/doc/src/seq_trace.xml @@ -29,10 +29,11 @@ <rev>A</rev> </header> <module since="">seq_trace</module> - <modulesummary>Sequential tracing of messages.</modulesummary> + <modulesummary>Sequential tracing of information transfers.</modulesummary> <description> - <p>Sequential tracing makes it possible to trace all messages - resulting from one initial message. Sequential tracing is + <p>Sequential tracing makes it possible to trace information + flows between processes resulting from one initial transfer + of information. Sequential tracing is independent of the ordinary tracing in Erlang, which is controlled by the <c>erlang:trace/3</c> BIF. For more information about what sequential tracing is and how it can be used, see section @@ -104,13 +105,13 @@ seq_trace:set_token(OldToken), % activate the trace token again <tag><c>set_token(send, <anno>Bool</anno>)</c></tag> <item> <p>A trace token flag (<c>true | false</c>) which - enables/disables tracing on message sending. Default is + enables/disables tracing on information sending. Default is <c>false</c>.</p> </item> <tag><c>set_token('receive', <anno>Bool</anno>)</c></tag> <item> <p>A trace token flag (<c>true | false</c>) which - enables/disables tracing on message reception. Default is + enables/disables tracing on information reception. Default is <c>false</c>.</p> </item> <tag><c>set_token(print, <anno>Bool</anno>)</c></tag> @@ -257,12 +258,26 @@ TimeStamp = {Seconds, Milliseconds, Microseconds} <tag><c>{send, Serial, From, To, Message}</c></tag> <item> <p>Used when a process <c>From</c> with its trace token flag - <c>send</c> set to <c>true</c> has sent a message.</p> + <c>send</c> set to <c>true</c> has sent information. <c>To</c> + may be a process identifier, a registered name on a node + represented as <c>{NameAtom, NodeAtom}</c>, or a node name + represented as an atom. <c>From</c> may be a process identifier + or a node name represented as an atom. <c>Message</c> contains + the information passed along in this information transfer. If + the transfer is done via message passing, it is the actual + message. + </p> </item> <tag><c>{'receive', Serial, From, To, Message}</c></tag> <item> - <p>Used when a process <c>To</c> receives a message with a - trace token that has flag <c>'receive'</c> set to <c>true</c>.</p> + <p>Used when a process <c>To</c> receives information with a + trace token that has flag <c>'receive'</c> set to <c>true</c>. + <c>To</c> may be a process identifier, or a node name + represented as an atom. <c>From</c> may be a process identifier + or a node name represented as an atom. <c>Message</c> contains + the information passed along in this information transfer. If + the transfer is done via message passing, it is the actual + message.</p> </item> <tag><c>{print, Serial, From, _, Info}</c></tag> <item> @@ -276,7 +291,7 @@ TimeStamp = {Seconds, Milliseconds, Microseconds} where:</p> <list type="bulleted"> <item><p>Integer <c>PreviousSerial</c> denotes the serial - counter passed in the last received message that carried a trace + counter passed in the last received information that carried a trace token. If the process is the first in a new sequential trace, <c>PreviousSerial</c> is set to the value of the process internal "trace clock".</p></item> @@ -290,22 +305,32 @@ TimeStamp = {Seconds, Milliseconds, Microseconds} <section> <marker id="whatis"></marker> <title>Sequential Tracing</title> - <p>Sequential tracing is a way to trace a sequence of messages sent - between different local or remote processes, where the sequence - is initiated by a single message. In short, it works as follows:</p> + <p>Sequential tracing is a way to trace a sequence of information + transfers between different local or remote processes, where the + sequence is initiated by a single transfer. The typical information + transfer is an ordinary Erlang message passed between two processes, + but information is transferred also in other ways. In short, it works + as follows:</p> <p>Each process has a <em>trace token</em>, which can be empty or not empty. When not empty, the trace token can be seen as the tuple <c>{Label, Flags, Serial, From}</c>. The trace token is - passed invisibly with each message.</p> + passed invisibly when information is passed between processes. + In most cases the information is passed in ordinary messages + between processes, but information is also passed between processes + by other means. For example, by spawning a new process. An information + transfer between two processes is represented by a send event and a + receive event regardless of how it is passed. + </p> <p>To start a sequential trace, the user must explicitly set - the trace token in the process that will send the first message + the trace token in the process that will send the first information in a sequence.</p> <p>The trace token of a process is set each time the process + receives information. This is typically when the process matches a message in a receive statement, according to the trace token carried by the received message, empty or not.</p> <p>On each Erlang node, a process can be set as the <em>system tracer</em>. This process will receive trace messages each time - a message with a trace token is sent or received (if the trace + information with a trace token is sent or received (if the trace token flag <c>send</c> or <c>'receive'</c> is set). The system tracer can then print each trace event, write it to a file, or whatever suitable.</p> @@ -321,11 +346,58 @@ TimeStamp = {Seconds, Milliseconds, Microseconds} </section> <section> + <title>Different Information Transfers</title> + <p> + Information flows between processes in a lot of different + ways. Not all flows of information will be covered by + sequential tracing. One example is information passed via + ETS tables. Below is a list of information paths that are + covered by sequential tracing:</p> + <taglist> + <tag>Message Passing</tag> + <item><p> + All ordinary messages passed between Erlang processes. + </p></item> + <tag>Exit signals</tag> + <item><p> + An exit signal is represented as an <c>{'EXIT', Pid, Reason}</c> + tuple. + </p></item> + <tag>Process Spawn</tag> + <item><p> + A process spawn is represented as multiple information + transfers. At least one spawn request and one spawn reply. The + actual amount of information transfers depends on what type + of spawn it is and may also change in future implementations. + Note that this is more or less an internal protocol that you + are peeking at. The spawn request will be represented as a + tuple with the first element containing the atom + <c>spawn_request</c>, but this is more or less all that you + can depend on. + </p></item> + </taglist> + <note> + <p> + If you do ordinary <c>send</c> or <c>receive</c> + trace on the system, you will only see ordinary message + passing, not the other information transfers listed above. + </p> + </note> + <note> + <p> + When a send event and corresponding receive event do not + both correspond to ordinary Erlang messages, the <c>Message</c> + part of the trace messages may not be identical. This since + all information not necessarily are available when generating + the trace messages. + </p> + </note> + </section> + + <section> <title>Trace Token</title> - <p>Each process has a current trace token. Initially, the token is - empty. When the process sends a message to another process, a - copy of the current token is sent "invisibly" along with - the message.</p> + <p>Each process has a current trace token which is "invisibly" passed + from the parent process on creation of the process.</p> <p>The current token of a process is set in one of the following two ways:</p> <list type="bulleted"> @@ -334,7 +406,9 @@ TimeStamp = {Seconds, Milliseconds, Microseconds} <c>seq_trace:set_token/1,2</c></p> </item> <item> - <p>When a message is received</p> + <p>When information is received. This is typically when + a received message is matched out in a receive expression, + but also when information is received in other ways.</p> </item> </list> <p>In both cases, the current token is set. In particular, if @@ -354,12 +428,16 @@ TimeStamp = {Seconds, Milliseconds, Microseconds} <p>The algorithm for updating <c>Serial</c> can be described as follows:</p> <p>Let each process have two counters, <c>prev_cnt</c> and - <c>curr_cnt</c>, both are set to <c>0</c> when a process is created. - The counters are updated at the following occasions:</p> + <c>curr_cnt</c>, both are set to <c>0</c> when a process is created + outside of a trace sequence. The counters are updated at the following + occasions:</p> <list type="bulleted"> <item> - <p><em>When the process is about to send a message and the trace token - is not empty.</em></p> + <p><em>When the process is about to pass along information to + another process and the trace token is not empty.</em> This + typically occurs when sending a message, but also, for example, + when spawning another process. + </p> <p>Let the serial of the trace token be <c>tprev</c> and <c>tcurr</c>.</p> <pre> @@ -367,7 +445,7 @@ curr_cnt := curr_cnt + 1 tprev := prev_cnt tcurr := curr_cnt</pre> <p>The trace token with <c>tprev</c> and <c>tcurr</c> is then - passed along with the message.</p> + passed along with the information passed to the other process.</p> </item> <item> <p><em>When the process calls</em> <c>seq_trace:print(Label, Info)</c>, @@ -376,8 +454,9 @@ tcurr := curr_cnt</pre> <p>The algorithm is the same as for send above.</p> </item> <item> - <p><em>When a message is received and contains a non-empty trace - token.</em></p> + <p><em>When information is received that also contains a non-empty + trace token. For example, when a message is matched out in a + receive expression, or when a new process is spawned.</em></p> <p>The process trace token is set to the trace token from the message.</p> <p>Let the serial of the trace token be <c>tprev</c> and @@ -487,9 +566,9 @@ tracer() -> print_trace(Label,TraceInfo,false); {seq_trace,Label,TraceInfo,Ts} -> print_trace(Label,TraceInfo,Ts); - Other -> ignore + _Other -> ignore end, - tracer(). + tracer(). print_trace(Label,TraceInfo,false) -> io:format("~p:",[Label]), @@ -504,7 +583,7 @@ print_trace({'receive',Serial,From,To,Message}) -> io:format("~p Received ~p FROM ~p WITH~n~p~n", [To,Serial,From,Message]); print_trace({send,Serial,From,To,Message}) -> - io:format("~p Sent ~p TO ~p WITH~n~p~n", + io:format("~p Sent ~p TO ~p WITH~n~p~n", [From,Serial,To,Message]).</code> <p>The code that creates a process that runs this tracer function and sets that process as the system tracer can look like this:</p> diff --git a/lib/kernel/doc/src/specs.xml b/lib/kernel/doc/src/specs.xml index 9e258910db..00f6f04218 100644 --- a/lib/kernel/doc/src/specs.xml +++ b/lib/kernel/doc/src/specs.xml @@ -9,6 +9,7 @@ <xi:include href="../specs/specs_erl_epmd.xml"/> <xi:include href="../specs/specs_erl_prim_loader_stub.xml"/> <xi:include href="../specs/specs_erlang_stub.xml"/> + <xi:include href="../specs/specs_erpc.xml"/> <xi:include href="../specs/specs_error_handler.xml"/> <xi:include href="../specs/specs_error_logger.xml"/> <xi:include href="../specs/specs_file.xml"/> @@ -30,6 +31,7 @@ <xi:include href="../specs/specs_net_adm.xml"/> <xi:include href="../specs/specs_net_kernel.xml"/> <xi:include href="../specs/specs_os.xml"/> + <xi:include href="../specs/specs_pg.xml"/> <xi:include href="../specs/specs_pg2.xml"/> <xi:include href="../specs/specs_rpc.xml"/> <xi:include href="../specs/specs_seq_trace.xml"/> diff --git a/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl b/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl index bc2e07ddf5..f4eb12818d 100644 --- a/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl +++ b/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl @@ -400,6 +400,10 @@ is_node_name(_Node) -> hs_data_common(DistCtrl) -> TickHandler = call_ctrlr(DistCtrl, tick_handler), Socket = call_ctrlr(DistCtrl, socket), + RejectFlags = case init:get_argument(gen_tcp_dist_reject_flags) of + {ok,[[Flags]]} -> list_to_integer(Flags); + _ -> #hs_data{}#hs_data.reject_flags + end, #hs_data{f_send = send_fun(), f_recv = recv_fun(), f_setopts_pre_nodeup = setopts_pre_nodeup_fun(), @@ -410,7 +414,8 @@ hs_data_common(DistCtrl) -> mf_setopts = setopts_fun(DistCtrl, Socket), mf_getopts = getopts_fun(DistCtrl, Socket), mf_getstat = getstat_fun(DistCtrl, Socket), - mf_tick = tick_fun(DistCtrl, TickHandler)}. + mf_tick = tick_fun(DistCtrl, TickHandler), + reject_flags = RejectFlags}. %%% ------------------------------------------------------------ %%% Distribution controller processes diff --git a/lib/kernel/include/dist.hrl b/lib/kernel/include/dist.hrl index f06fc328d7..3cc825fca6 100644 --- a/lib/kernel/include/dist.hrl +++ b/lib/kernel/include/dist.hrl @@ -44,7 +44,18 @@ -define(DFLAG_BIG_SEQTRACE_LABELS, 16#100000). %% -define(DFLAG_NO_MAGIC, 16#200000). %% Used internally only -define(DFLAG_EXIT_PAYLOAD, 16#400000). --define(DFLAG_FRAGMENTS, 16#800000). +-define(DFLAG_FRAGMENTS, 16#00800000). +-define(DFLAG_HANDSHAKE_23, 16#01000000). +-define(DFLAG_RESERVED, 16#fe000000). +-define(DFLAG_SPAWN, 16#100000000). %% Also update dflag2str() in ../src/dist_util.erl %% when adding flags... + + +-define(ERL_DIST_VER_5, 5). % OTP-22 or (much) older +-define(ERL_DIST_VER_6, 6). % OTP-23 (or maybe newer?) + +-define(ERL_DIST_VER_LOW, ?ERL_DIST_VER_5). +-define(ERL_DIST_VER_HIGH, ?ERL_DIST_VER_6). + diff --git a/lib/kernel/include/dist_util.hrl b/lib/kernel/include/dist_util.hrl index 56f775f060..05c7eee795 100644 --- a/lib/kernel/include/dist_util.hrl +++ b/lib/kernel/include/dist_util.hrl @@ -84,7 +84,10 @@ f_handshake_complete, %% Notify handshake complete add_flags, %% dflags to add reject_flags, %% dflags not to use (not all can be rejected) - require_flags %% dflags that are required + require_flags, %% dflags that are required + + %% New in kernel-@master@ (OTP-23.0) + other_creation }). diff --git a/lib/kernel/include/eep48.hrl b/lib/kernel/include/eep48.hrl new file mode 100644 index 0000000000..2ce9a1430a --- /dev/null +++ b/lib/kernel/include/eep48.hrl @@ -0,0 +1,14 @@ +-define(NATIVE_FORMAT,<<"application/erlang+html">>). +-define(CURR_DOC_VERSION, {1,0,0}). +-record(docs_v1, {anno, + beam_language = erlang, + format = ?NATIVE_FORMAT, + module_doc, + metadata = #{ otp_doc_vsn => ?CURR_DOC_VERSION }, + docs}). + +-record(docs_v1_entry, {kind_name_arity, + anno, + signature, + doc, + metadata}). diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 2d2b84c206..a5e24c9d67 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -73,6 +73,7 @@ MODULES = \ erl_epmd \ erl_reply \ erl_signal_handler \ + erpc \ erts_debug \ error_handler \ error_logger \ @@ -128,6 +129,7 @@ MODULES = \ net_adm \ net_kernel \ os \ + pg \ pg2 \ ram_file \ rpc \ @@ -147,7 +149,8 @@ MODULES = \ HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl \ ../include/dist.hrl ../include/dist_util.hrl \ - ../include/net_address.hrl ../include/logger.hrl + ../include/net_address.hrl ../include/logger.hrl ../include/eep48.hrl + INTERNAL_HRL_FILES= application_master.hrl disk_log.hrl \ erl_epmd.hrl file_int.hrl hipe_ext_format.hrl \ diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index 7715dca7c6..3e1a49733a 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -37,6 +37,9 @@ -export([handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, init_starter/4, get_loaded/1]). +%% logger callback +-export([format_log/1, format_log/2]). + %% Test exports, only to be used from the test suites -export([test_change_apps/2]). @@ -1804,7 +1807,7 @@ check_conf() -> case init:get_argument(config) of {ok, Files} -> {ok, lists:foldl( - fun([File], Env) -> + fun(File, Env) -> BFName = filename:basename(File,".config"), FName = filename:join(filename:dirname(File), BFName ++ ".config"), @@ -1836,7 +1839,7 @@ check_conf() -> {error, {Line, _Mod, Str}} -> throw({error, {FName, Line, Str}}) end - end, [], Files)}; + end, [], lists:append(Files))}; _ -> {ok, []} end. @@ -1930,9 +1933,12 @@ info_started(Name, Node) -> report=>[{application, Name}, {started_at, Node}]}, #{domain=>[otp,sasl], - report_cb=>fun logger:format_otp_report/1, + report_cb=>fun application_controller:format_log/2, logger_formatter=>#{title=>"PROGRESS REPORT"}, - error_logger=>#{tag=>info_report,type=>progress}}). + error_logger=>#{tag=>info_report, + type=>progress, + report_cb=> + fun application_controller:format_log/1}}). info_exited(Name, Reason, Type) -> ?LOG_NOTICE(#{label=>{application_controller,exit}, @@ -1940,8 +1946,140 @@ info_exited(Name, Reason, Type) -> {exited, Reason}, {type, Type}]}, #{domain=>[otp], - report_cb=>fun logger:format_otp_report/1, - error_logger=>#{tag=>info_report,type=>std_info}}). + report_cb=>fun application_controller:format_log/2, + error_logger=>#{tag=>info_report, + type=>std_info, + report_cb=> + fun application_controller:format_log/1}}). + +%% format_log/1 is the report callback used by Logger handler +%% error_logger only. It is kept for backwards compatibility with +%% legacy error_logger event handlers. This function must always +%% return {Format,Args} compatible with the arguments in this module's +%% calls to error_logger prior to OTP-21.0. +format_log(LogReport) -> + Depth = error_logger:get_format_depth(), + FormatOpts = #{chars_limit => unlimited, + depth => Depth, + single_line => false, + encoding => utf8}, + format_log_multi(limit_report(LogReport, Depth), FormatOpts). + +limit_report(LogReport, unlimited) -> + LogReport; +limit_report(#{label:={application_controller,progress}, + report:=[{application,_}=Application, + {started_at,Node}]}=LogReport, + Depth) -> + LogReport#{report=>[Application, + {started_at,io_lib:limit_term(Node, Depth)}]}; +limit_report(#{label:={application_controller,exit}, + report:=[{application,_}=Application, + {exited,Reason},{type,Type}]}=LogReport, + Depth) -> + LogReport#{report=>[Application, + {exited,io_lib:limit_term(Reason, Depth)}, + {type,io_lib:limit_term(Type, Depth)}]}. + +%% format_log/2 is the report callback for any Logger handler, except +%% error_logger. +format_log(Report, FormatOpts0) -> + Default = #{chars_limit => unlimited, + depth => unlimited, + single_line => false, + encoding => utf8}, + FormatOpts = maps:merge(Default, FormatOpts0), + IoOpts = + case FormatOpts of + #{chars_limit:=unlimited} -> + []; + #{chars_limit:=Limit} -> + [{chars_limit,Limit}] + end, + {Format,Args} = format_log_single(Report, FormatOpts), + io_lib:format(Format, Args, IoOpts). + +format_log_single(#{label:={application_controller,progress}, + report:=[{application,Name},{started_at,Node}]}, + #{single_line:=true,depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = "Application: "++P++". Started at: "++P++".", + Args = + case Depth of + unlimited -> + [Name,Node]; + _ -> + [Name,Depth,Node,Depth] + end, + {Format,Args}; +format_log_single(#{label:={application_controller,exit}, + report:=[{application,Name}, + {exited,Reason}, + {type,Type}]}, + #{single_line:=true,depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = lists:append(["Application: ",P,". Exited: ",P, + ". Type: ",P,"."]), + Args = + case Depth of + unlimited -> + [Name,Reason,Type]; + _ -> + [Name,Depth,Reason,Depth,Type,Depth] + end, + {Format,Args}; +format_log_single(Report,FormatOpts) -> + format_log_multi(Report,FormatOpts). + +format_log_multi(#{label:={application_controller,progress}, + report:=[{application,Name}, + {started_at,Node}]}, + #{depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = + lists:append( + [" application: ",P,"~n", + " started_at: ",P,"~n"]), + Args = + case Depth of + unlimited -> + [Name,Node]; + _ -> + [Name,Depth,Node,Depth] + end, + {Format,Args}; +format_log_multi(#{label:={application_controller,exit}, + report:=[{application,Name}, + {exited,Reason}, + {type,Type}]}, + #{depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = + lists:append( + [" application: ",P,"~n", + " exited: ",P,"~n", + " type: ",P,"~n"]), + Args = + case Depth of + unlimited -> + [Name,Reason,Type]; + _ -> + [Name,Depth,Reason,Depth,Type,Depth] + end, + {Format,Args}. + +p(#{single_line:=Single,depth:=Depth,encoding:=Enc}) -> + "~"++single(Single)++mod(Enc)++p(Depth); +p(unlimited) -> + "p"; +p(_Depth) -> + "P". + +single(true) -> "0"; +single(false) -> "". + +mod(latin1) -> ""; +mod(_) -> "t". %%----------------------------------------------------------------- %% Reply to all processes waiting this application to be started. diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl index 4d18daf9e4..1f4a507766 100644 --- a/lib/kernel/src/auth.erl +++ b/lib/kernel/src/auth.erl @@ -24,7 +24,11 @@ %% Old documented interface - deprecated -export([is_auth/1, cookie/0, cookie/1, node_cookie/1, node_cookie/2]). --deprecated([{is_auth,1}, {cookie,'_'}, {node_cookie, '_'}]). +-deprecated([{is_auth,1,"use net_adm:ping/1 instead"}, + {cookie,0,"use erlang:get_cookie/0 instead"}, + {cookie,1,"use erlang:set_cookie/2 instead"}, + {node_cookie, '_', + "use erlang:set_cookie/2 and net_adm:ping/1 instead"}]). %% New interface - meant for internal use within kernel only -export([get_cookie/0, get_cookie/1, diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 964ede9bc9..71a20231d4 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -20,6 +20,7 @@ -module(code). -include_lib("kernel/include/logger.hrl"). +-include("eep48.hrl"). %% This is the interface module to the code server. It also contains %% some implementation details. See also related modules: code_*.erl @@ -44,6 +45,7 @@ soft_purge/1, is_loaded/1, all_loaded/0, + all_available/0, stop/0, root_dir/0, lib_dir/0, @@ -68,18 +70,21 @@ rehash/0, start_link/0, which/1, + get_doc/1, where_is_file/1, where_is_file/2, set_primary_archive/4, clash/0, + module_status/0, module_status/1, modified_modules/0, get_mode/0]). --deprecated({rehash,0,next_major_release}). +-deprecated({rehash,0,"the code path cache feature has been removed"}). -export_type([load_error_rsn/0, load_ret/0]). -export_type([prepared_code/0]). +-export_type([module_status/0]). -include_lib("kernel/include/file.hrl"). @@ -218,6 +223,53 @@ get_object_code(Mod) when is_atom(Mod) -> call({get_object_code, Mod}). Loaded :: loaded_filename(). all_loaded() -> call(all_loaded). +-spec all_available() -> [{Module, Filename, Loaded}] when + Module :: string(), + Filename :: loaded_filename(), + Loaded :: boolean(). +all_available() -> + case code:get_mode() of + interactive -> + all_available(get_path(), #{}); + embedded -> + all_available([], #{}) + end. +all_available([Path|Tail], Acc) -> + case erl_prim_loader:list_dir(Path) of + {ok, Files} -> + all_available(Tail, all_available(Path, Files, Acc)); + _Error -> + all_available(Tail, Acc) + end; +all_available([], AllModules) -> + AllLoaded = [{atom_to_list(M),Path,true} || {M,Path} <- all_loaded()], + AllAvailable = + maps:fold( + fun(File, Path, Acc) -> + [{filename:rootname(File), filename:append(Path, File), false} | Acc] + end, [], AllModules), + OrderFun = fun F({A,_,_},{B,_,_}) -> + F(A,B); + F(A,B) -> + A =< B + end, + lists:umerge(OrderFun, lists:sort(OrderFun, AllLoaded), lists:sort(OrderFun, AllAvailable)). + +all_available(Path, [File | T], Acc) -> + case filename:extension(File) of + ".beam" -> + case maps:is_key(File, Acc) of + false -> + all_available(Path, T, Acc#{ File => Path }); + true -> + all_available(Path, T, Acc) + end; + _Else -> + all_available(Path, T, Acc) + end; +all_available(_Path, [], Acc) -> + Acc. + -spec stop() -> no_return(). stop() -> call(stop). @@ -734,7 +786,7 @@ start_get_mode() -> -spec which(Module) -> Which when Module :: module(), - Which :: file:filename() | loaded_ret_atoms() | non_existing. + Which :: loaded_filename() | non_existing. which(Module) when is_atom(Module) -> case is_loaded(Module) of false -> @@ -783,6 +835,94 @@ where_is_file(Tail, File, Path, Files) -> where_is_file(Tail, File) end. +-spec get_doc(Mod) -> {ok, Res} | {error, Reason} when + Mod :: module(), + Res :: #docs_v1{}, + Reason :: non_existing | missing | file:posix(). +get_doc(Mod) when is_atom(Mod) -> + case which(Mod) of + preloaded -> + Fn = filename:join([code:lib_dir(erts),"ebin",atom_to_list(Mod) ++ ".beam"]), + get_doc_chunk(Fn, Mod); + Error when is_atom(Error) -> + {error, Error}; + Fn -> + get_doc_chunk(Fn, Mod) + end. + +get_doc_chunk(Filename, Mod) when is_atom(Mod) -> + case beam_lib:chunks(Filename, ["Docs"]) of + {error,beam_lib,{missing_chunk,_,_}} -> + case get_doc_chunk(Filename, atom_to_list(Mod)) of + {error,missing} -> + get_doc_chunk_from_ast(Filename); + Error -> + Error + end; + {error,beam_lib,{file_error,_Filename,enoent}} -> + get_doc_chunk(Filename, atom_to_list(Mod)); + {ok, {Mod, [{"Docs",Bin}]}} -> + binary_to_term(Bin) + end; +get_doc_chunk(Filename, Mod) -> + case filename:dirname(Filename) of + Filename -> + {error,missing}; + Dir -> + ChunkFile = filename:join([Dir,"doc","chunks",Mod ++ ".chunk"]), + case file:read_file(ChunkFile) of + {ok, Bin} -> + {ok, binary_to_term(Bin)}; + {error,enoent} -> + get_doc_chunk(Dir, Mod); + {error,Reason} -> + {error,Reason} + end + end. + +get_doc_chunk_from_ast(Filename) -> + case beam_lib:chunks(Filename, [abstract_code]) of + {error,beam_lib,{missing_chunk,_,_}} -> + {error,missing}; + {ok, {_Mod, [{abstract_code, + {raw_abstract_v1, AST}}]}} -> + Docs = get_function_docs_from_ast(AST), + {ok, #docs_v1{ anno = 0, beam_language = erlang, + module_doc = none, + metadata = #{ generated => true, otp_doc_vsn => ?CURR_DOC_VERSION }, + docs = Docs }}; + {ok, {_Mod, [{abstract_code,no_abstract_code}]}} -> + {error,missing}; + Error -> + Error + end. + +get_function_docs_from_ast(AST) -> + lists:flatmap(fun(E) -> get_function_docs_from_ast(E, AST) end, AST). +get_function_docs_from_ast({function,Ln,Name,Arity,_Code}, AST) -> + Signature = io_lib:format("~p/~p",[Name,Arity]), + Anno = erl_anno:new(Ln), + Specs = lists:filter(fun({attribute,_Ln,spec,{FA,_}}) -> + case FA of + {F,A} -> + F =:= Name andalso A =:= Arity; + {_, F, A} -> + F =:= Name andalso A =:= Arity + end; + (_) -> false + end, AST), + SpecMd = case Specs of + [S] -> #{ spec => [S] }; + [] -> #{} + end, + FnDocs = [], + Md = SpecMd#{}, + [{{function, Name, Arity}, Anno, [unicode:characters_to_binary(Signature)], + #{ <<"en">> => FnDocs }, + Md#{}}]; +get_function_docs_from_ast(_, _) -> + []. + -spec set_primary_archive(ArchiveFile :: file:filename(), ArchiveBin :: binary(), FileInfo :: file:file_info(), @@ -804,7 +944,7 @@ set_primary_archive(ArchiveFile0, ArchiveBin, #file_info{} = FileInfo, {error, _Reason} = Error -> Error end. - + %% Search the entire path system looking for name clashes -spec clash() -> 'ok'. @@ -915,8 +1055,19 @@ load_all_native_1([{Mod,BeamFilename}|T], ChunkTag) -> load_all_native_1([], _) -> ok. +-type module_status() :: not_loaded | loaded | modified | removed. + +%% Returns the list of all loaded modules and their current status +-spec module_status() -> [{module(), module_status()}]. +module_status() -> + module_status([M || {M, _} <- all_loaded()]). + %% Returns the status of the module in relation to object file on disk. --spec module_status(Module :: module()) -> not_loaded | loaded | modified | removed. +-spec module_status (Module :: module() | [module()]) -> + module_status() | [{module(), module_status()}]. +module_status(Modules) when is_list(Modules) -> + PathFiles = path_files(), + [{M, module_status(M, PathFiles)} || M <- Modules]; module_status(Module) -> module_status(Module, code:get_path()). @@ -991,9 +1142,7 @@ get_beam_chunk(Path, Chunk) -> %% Returns a list of all modules modified on disk. -spec modified_modules() -> [module()]. modified_modules() -> - PathFiles = path_files(), - [M || {M, _} <- code:all_loaded(), - module_status(M, PathFiles) =:= modified]. + [M || {M, modified} <- module_status()]. %% prefetch the directory contents of code path directories path_files() -> diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 5469d8694c..8ef54dd0e1 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -93,7 +93,7 @@ init(Ref, Parent, [Root,Mode]) -> root = Root, path = Path, moddb = Db, - namedb = init_namedb(Path), + namedb = create_namedb(Path, Root), mode = Mode}, Parent ! {Ref,{ok,self()}}, @@ -265,8 +265,8 @@ handle_call({add_paths,Where,Dirs0}, _From, {reply,Resp,S#state{path=Path}}; handle_call({set_path,PathList}, _From, - #state{path=Path0,namedb=Namedb}=S) -> - {Resp,Path,NewDb} = set_path(PathList, Path0, Namedb), + #state{root=Root,path=Path0,namedb=Namedb}=S) -> + {Resp,Path,NewDb} = set_path(PathList, Path0, Namedb, Root), {reply,Resp,S#state{path=Path,namedb=NewDb}}; handle_call({del_path,Name}, _From, @@ -755,12 +755,12 @@ update(Dir, NameDb) -> %% %% Set a completely new path. %% -set_path(NewPath0, OldPath, NameDb) -> +set_path(NewPath0, OldPath, NameDb, Root) -> NewPath = normalize(NewPath0), case check_path(NewPath) of {ok, NewPath2} -> ets:delete(NameDb), - NewDb = init_namedb(NewPath2), + NewDb = create_namedb(NewPath2, Root), {true, NewPath2, NewDb}; Error -> {Error, OldPath, NameDb} @@ -788,11 +788,27 @@ normalize(Other) -> %% Handle a table of name-directory pairs. %% The priv_dir/1 and lib_dir/1 functions will have %% an O(1) lookup. -init_namedb(Path) -> - Db = ets:new(code_names,[private]), +create_namedb(Path, Root) -> + Db = ets:new(code_names,[named_table, public]), init_namedb(lists:reverse(Path), Db), + + case lookup_name("erts", Db) of + {ok, _, _, _} -> + %% erts is part of code path + ok; + false -> + %% No erts in code path, check if this is a source + %% repo and if so use that. + ErtsDir = filename:join(Root, "erts"), + case erl_prim_loader:read_file_info(ErtsDir) of + error -> + ok; + _ -> + do_insert_name("erts", ErtsDir, Db) + end + end, Db. - + init_namedb([P|Path], Db) -> insert_dir(P, Db), init_namedb(Path, Db); @@ -997,7 +1013,6 @@ lookup_name(Name, Db) -> _ -> false end. - %% %% Fetch a directory. %% diff --git a/lib/kernel/src/disk_log_server.erl b/lib/kernel/src/disk_log_server.erl index 78c15d0ad8..2e22f28b14 100644 --- a/lib/kernel/src/disk_log_server.erl +++ b/lib/kernel/src/disk_log_server.erl @@ -38,6 +38,12 @@ -record(state, {pending = [] :: [#pending{}]}). +-compile({nowarn_deprecated_function, [{pg2, create, 1}]}). +-compile({nowarn_deprecated_function, [{pg2, join, 2}]}). +-compile({nowarn_deprecated_function, [{pg2, leave, 2}]}). +-compile({nowarn_deprecated_function, [{pg2, which_groups, 0}]}). +-compile({nowarn_deprecated_function, [{pg2, get_members, 1}]}). + %%%----------------------------------------------------------------- %%% This module implements the disk_log server. Its primary purpose %%% is to keep the ets table 'disk_log_names' updated and to handle diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index d8571c01be..3b9d88da6a 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -27,7 +27,7 @@ %%-compile(export_all). -export([handshake_we_started/1, handshake_other_started/1, - strict_order_flags/0, + strict_order_flags/0, rejectable_flags/0, start_timer/1, setup_timer/2, reset_timer/1, cancel_timer/1, is_node_name/1, split_node/1, is_allowed/2, @@ -70,6 +70,8 @@ -define(u32(X3,X2,X1,X0), (((X3) bsl 24) bor ((X2) bsl 16) bor ((X1) bsl 8) bor (X0))). +-define(CREATION_UNKNOWN,0). + -record(tick, {read = 0, write = 0, tick = 0, @@ -120,6 +122,10 @@ dflag2str(?DFLAG_EXIT_PAYLOAD) -> "EXIT_PAYLOAD"; dflag2str(?DFLAG_FRAGMENTS) -> "FRAGMENTS"; +dflag2str(?DFLAG_HANDSHAKE_23) -> + "HANDSHAKE_23"; +dflag2str(?DFLAG_SPAWN) -> + "SPAWN"; dflag2str(_) -> "UNKNOWN". @@ -152,6 +158,11 @@ strict_order_flags() -> EDF = erts_internal:get_dflags(), EDF#erts_dflags.strict_order. +-spec rejectable_flags() -> integer(). +rejectable_flags() -> + EDF = erts_internal:get_dflags(), + EDF#erts_dflags.rejectable. + make_this_flags(RequestType, AddFlags, RejectFlags, OtherNode, #erts_dflags{}=EDF) -> case RejectFlags band (bnot EDF#erts_dflags.rejectable) of @@ -174,30 +185,35 @@ handshake_other_started(#hs_data{request_type=ReqType, AddFlgs = convert_flags(AddFlgs0), RejFlgs = convert_flags(RejFlgs0), ReqFlgs = convert_flags(ReqFlgs0), - {PreOtherFlags,Node,Version} = recv_name(HSData0), + {PreOtherFlags,Node,Creation,SendNameVersion} = recv_name(HSData0), EDF = erts_internal:get_dflags(), PreThisFlags = make_this_flags(ReqType, AddFlgs, RejFlgs, Node, EDF), - ChosenFlags = adjust_flags(PreThisFlags, PreOtherFlags), - HSData = HSData0#hs_data{this_flags=ChosenFlags, - other_flags=ChosenFlags, - other_version=Version, - other_node=Node, - other_started=true, - add_flags=AddFlgs, - reject_flags=RejFlgs, - require_flags=ReqFlgs}, - check_dflags(HSData, EDF), - ?debug({"MD5 connection from ~p (V~p)~n", - [Node, HSData#hs_data.other_version]}), - mark_pending(HSData), + HSData1 = HSData0#hs_data{this_flags=PreThisFlags, + other_flags=PreOtherFlags, + other_version=flags_to_version(PreOtherFlags), + other_node=Node, + other_started=true, + other_creation=Creation, + add_flags=AddFlgs, + reject_flags=RejFlgs, + require_flags=ReqFlgs}, + check_dflags(HSData1, EDF), + ?debug({"MD5 connection from ~p~n", [Node]}), + mark_pending(HSData1), {MyCookie,HisCookie} = get_cookies(Node), ChallengeA = gen_challenge(), - send_challenge(HSData, ChallengeA), - reset_timer(HSData#hs_data.timer), - ChallengeB = recv_challenge_reply(HSData, ChallengeA, MyCookie), - send_challenge_ack(HSData, gen_digest(ChallengeB, HisCookie)), + send_challenge(HSData1, ChallengeA), + reset_timer(HSData1#hs_data.timer), + HSData2 = recv_complement(HSData1, SendNameVersion), + check_dflags(HSData2, EDF), + ChosenFlags = adjust_flags(HSData2#hs_data.this_flags, + HSData2#hs_data.other_flags), + HSData3 = HSData2#hs_data{this_flags = ChosenFlags, + other_flags = ChosenFlags}, + ChallengeB = recv_challenge_reply(HSData3, ChallengeA, MyCookie), + send_challenge_ack(HSData3, gen_digest(ChallengeB, HisCookie)), ?debug({dist_util, self(), accept_connection, Node}), - connection(HSData); + connection(HSData3); handshake_other_started(OldHsData) when element(1,OldHsData) =:= hs_data -> handshake_other_started(convert_old_hsdata(OldHsData)). @@ -363,16 +379,19 @@ handshake_we_started(#hs_data{request_type=ReqType, add_flags = AddFlgs, reject_flags = RejFlgs, require_flags = ReqFlgs}, - send_name(HSData), + SendNameVersion = send_name(HSData), recv_status(HSData), - {PreOtherFlags,ChallengeA} = recv_challenge(HSData), + {PreOtherFlags, ChallengeA, Creation} = recv_challenge(HSData), ChosenFlags = adjust_flags(PreThisFlags, PreOtherFlags), NewHSData = HSData#hs_data{this_flags = ChosenFlags, other_flags = ChosenFlags, - other_started = false}, + other_started = false, + other_version = flags_to_version(PreOtherFlags), + other_creation = Creation}, check_dflags(NewHSData, EDF), MyChallenge = gen_challenge(), {MyCookie,HisCookie} = get_cookies(Node), + send_complement(NewHSData, SendNameVersion), send_challenge_reply(NewHSData,MyChallenge, gen_digest(ChallengeA,HisCookie)), reset_timer(NewHSData#hs_data.timer), @@ -393,6 +412,16 @@ convert_flags(Flags) when is_integer(Flags) -> convert_flags(_Undefined) -> 0. +flags_to_version(Flags) -> + case Flags band ?DFLAG_HANDSHAKE_23 of + 0 -> + ?ERL_DIST_VER_5; + ?DFLAG_HANDSHAKE_23 -> + ?ERL_DIST_VER_6 + end. + + + %% -------------------------------------------------------------- %% The connection has been established. %% -------------------------------------------------------------- @@ -470,15 +499,14 @@ get_cookies(Node) -> %% No error return; either succeeds or terminates the process. do_setnode(#hs_data{other_node = Node, socket = Socket, other_flags = Flags, other_version = Version, - f_getll = GetLL}) -> + f_getll = GetLL, + other_creation = Creation}) -> case GetLL(Socket) of {ok,Port} -> - ?trace("setnode(md5,~p ~p ~p)~n", - [Node, Port, {publish_type(Flags), - '(', Flags, ')', - Version}]), + ?trace("setnode: node=~p port=~p flags=~p(~p) ver=~p creation=~p~n", + [Node, Port, Flags, publish_type(Flags), Version, Creation]), try - erlang:setnode(Node, Port, {Flags, Version, '', ''}) + erlang:setnode(Node, Port, {Flags, Version, Creation}) catch error:system_limit -> error_msg("** Distribution system limit reached, " @@ -585,21 +613,77 @@ send_name(#hs_data{socket = Socket, this_node = Node, f_send = FSend, this_flags = Flags, other_version = Version}) -> - ?trace("send_name: node=~w, version=~w\n", - [Node,Version]), - ?to_port(FSend, Socket, - [$n, ?int16(Version), ?int32(Flags), atom_to_list(Node)]). + NameBin = atom_to_binary(Node, latin1), + if Version =:= undefined; + Version =:= ?ERL_DIST_VER_5 -> + %% We treat "5" the same as 'undefined' as there are + %% custom made epmd modules out there with a hardcoded "5". + %% + %% Send old 'n' message but with DFLAG_HANDSHAKE_23 + %% Old nodes will ignore DFLAG_HANDSHAKE_23 and reply old 'n' challenge. + %% New nodes will see DFLAG_HANDSHAKE_23 and reply new 'N' challenge. + ?trace("send_name: 'n' node=~p, version=~w\n", + [Node, ?ERL_DIST_VER_5]), + _ = ?to_port(FSend, Socket, + [<<$n, ?ERL_DIST_VER_5:16, Flags:32>>, NameBin]), + ?ERL_DIST_VER_5; + + is_integer(Version), Version >= ?ERL_DIST_VER_6 -> + Creation = erts_internal:get_creation(), + NameLen = byte_size(NameBin), + ?trace("send_name: 'N' node=~p creation=~w\n", + [Node, Creation]), + _ = ?to_port(FSend, Socket, + [<<$N, Flags:64, Creation:32, NameLen:16>>, NameBin]), + ?ERL_DIST_VER_6 + end. send_challenge(#hs_data{socket = Socket, this_node = Node, - other_version = Version, - this_flags = Flags, + this_flags = ThisFlags, + other_flags = OtherFlags, f_send = FSend}, Challenge ) -> - ?trace("send: challenge=~w version=~w\n", - [Challenge,Version]), - ?to_port(FSend, Socket, [$n,?int16(Version), ?int32(Flags), - ?int32(Challenge), - atom_to_list(Node)]). + case OtherFlags band ?DFLAG_HANDSHAKE_23 of + 0 -> + %% Reply with old 'n' message + ?trace("send: 'n' challenge=~w\n", [Challenge]), + + ?to_port(FSend, Socket, [<<$n, + ?ERL_DIST_VER_5:16, % echo same Version back + ThisFlags:32, + Challenge:32>>, + atom_to_list(Node)]); + + ?DFLAG_HANDSHAKE_23 -> + %% Reply with new 'N' message + Creation = erts_internal:get_creation(), + NodeName = atom_to_binary(Node, latin1), + NameLen = byte_size(NodeName), + ?trace("send: 'N' challenge=~w creation=~w\n", + [Challenge,Creation]), + ?to_port(FSend, Socket, [<<$N, + ThisFlags:64, + Challenge:32, + Creation:32, + NameLen:16>>, NodeName]) + end. + +send_complement(#hs_data{socket = Socket, + f_send = FSend, + this_flags = Flags, + other_flags = Flags}, + SendNameVersion) -> + if SendNameVersion =:= ?ERL_DIST_VER_5, + (Flags band ?DFLAG_HANDSHAKE_23) =/= 0 -> + %% We sent an old 'n' name message and need to complement + %% with creation value. + Creation = erts_internal:get_creation(), + FlagsHigh = Flags bsr 32, + ?trace("send_complement: 'c' flags_high=~w creation=~w\n", [FlagsHigh,Creation]), + ?to_port(FSend, Socket, [<<$c, FlagsHigh:32, Creation:32>>]); + true-> + ok % no complement msg needed + end. send_challenge_reply(#hs_data{socket = Socket, f_send = FSend}, Challenge, Digest) -> @@ -614,31 +698,50 @@ send_challenge_ack(#hs_data{socket = Socket, f_send = FSend}, %% -%% Get the name of the other side. +%% Receive first handshake message sent from connecting side. %% Close the connection if invalid data. -%% The IP address sent is not interesting (as in the old -%% tcp_drv.c which used it to detect simultaneous connection -%% attempts). %% recv_name(#hs_data{socket = Socket, f_recv = Recv} = HSData) -> case Recv(Socket, 0, infinity) of - {ok, - [$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4 - | OtherNode] = Data} -> - case is_node_name(OtherNode) of - true -> - Flags = ?u32(Flag1, Flag2, Flag3, Flag4), - Version = ?u16(VersionA,VersionB), - is_allowed(HSData, Flags, OtherNode, Version); - false -> - ?shutdown(Data) - end; + {ok, [$n | _] = Data} -> + recv_name_old(HSData, Data); + {ok, [$N | _] = Data} -> + recv_name_new(HSData, Data); _ -> ?shutdown(no_node) end. -is_node_name(OtherNodeName) -> - case string:split(OtherNodeName, "@", all) of +recv_name_old(HSData, + [$n, V1, V0, F3, F2, F1, F0 | Node] = Data) -> + <<_Version:16>> = <<V1,V0>>, + <<Flags:32>> = <<F3,F2,F1,F0>>, + ?trace("recv_name: 'n' node=~p version=~w\n", [Node, _Version]), + case is_node_name(Node) of + true -> + check_allowed(HSData, Node), + {Flags, list_to_atom(Node), ?CREATION_UNKNOWN, ?ERL_DIST_VER_5}; + false -> + ?shutdown(Data) + end. + +recv_name_new(HSData, + [$N, F7,F6,F5,F4,F3,F2,F1,F0, Cr3,Cr2,Cr1,Cr0, + NL1, NL0 | Rest] = Data) -> + <<Flags:64>> = <<F7,F6,F5,F4,F3,F2,F1,F0>>, + <<Creation:32>> = <<Cr3,Cr2,Cr1,Cr0>>, + <<NameLen:16>> = <<NL1,NL0>>, + {Node, _Residue} = lists:split(NameLen, Rest), + ?trace("recv_name: 'N' node=~p creation=~w\n", [Node, Creation]), + case is_node_name(Node) of + true -> + check_allowed(HSData, Node), + {Flags, list_to_atom(Node), Creation, ?ERL_DIST_VER_6}; + false -> + ?shutdown(Data) + end. + +is_node_name(NodeName) -> + case string:split(NodeName, "@", all) of [Name,Host] -> (not string:is_empty(Name)) andalso (not string:is_empty(Host)); @@ -674,12 +777,12 @@ split_node(Node) -> %% with allow-node-scheme. An empty allowed list %% allows all nodes. %% -is_allowed(#hs_data{allowed = []}, Flags, Node, Version) -> - {Flags,list_to_atom(Node),Version}; -is_allowed(#hs_data{allowed = Allowed} = HSData, Flags, Node, Version) -> +check_allowed(#hs_data{allowed = []}, _Node) -> + ok; +check_allowed(#hs_data{allowed = Allowed} = HSData, Node) -> case is_allowed(Node, Allowed) of true -> - {Flags,list_to_atom(Node),Version}; + ok; false -> send_status(HSData#hs_data{other_node = Node}, not_allowed), error_msg("** Connection attempt from " @@ -753,25 +856,91 @@ publish_type(Flags) -> end. %% wait for challenge after connect -recv_challenge(#hs_data{socket=Socket,other_node=Node, - other_version=Version,f_recv=Recv}) -> +recv_challenge(#hs_data{socket=Socket, f_recv=Recv}=HSData) -> case Recv(Socket, 0, infinity) of - {ok,[$n,V1,V0,Fl1,Fl2,Fl3,Fl4,CA3,CA2,CA1,CA0 | Ns]} -> - Flags = ?u32(Fl1,Fl2,Fl3,Fl4), - try {list_to_existing_atom(Ns),?u16(V1,V0)} of - {Node,Version} -> - Challenge = ?u32(CA3,CA2,CA1,CA0), - ?trace("recv: node=~w, challenge=~w version=~w\n", - [Node, Challenge,Version]), - {Flags,Challenge}; - _ -> - ?shutdown2(no_node, {recv_challenge_failed, no_node, Ns}) - catch - error:badarg -> - ?shutdown2(no_node, {recv_challenge_failed, no_node, Ns}) - end; + {ok, [$n | _]=Msg} -> + recv_challenge_old(HSData, Msg); + {ok,[$N | _]=Msg} -> + recv_challenge_new(HSData, Msg); Other -> - ?shutdown2(no_node, {recv_challenge_failed, Other}) + ?shutdown2(no_node, {recv_challenge_failed, Other}) + end. + +recv_challenge_old(#hs_data{other_node=Node}, + [$n, V1,V0, F3,F2,F1,F0, C3,C2,C1,C0 | Ns]=Msg) -> + <<_Version:16>> = <<V1,V0>>, + <<Flags:32>> = <<F3,F2,F1,F0>>, + <<Challenge:32>> = <<C3,C2,C1,C0>>, + ?trace("recv: 'n' node=~p, challenge=~w version=~w\n", + [Ns, Challenge, _Version]), + try {list_to_existing_atom(Ns), Flags band ?DFLAG_HANDSHAKE_23} of + {Node, 0} -> + {Flags, Challenge, ?CREATION_UNKNOWN}; + _ -> + ?shutdown2(no_node, {recv_challenge_failed, version, Msg}) + catch + error:badarg -> + ?shutdown2(no_node, {recv_challenge_failed, no_node, Ns}) + end; +recv_challenge_old(_, Other) -> + ?shutdown2(no_node, {recv_challenge_failed, Other}). + +recv_challenge_new(#hs_data{other_node=Node}, + [$N, + F7,F6,F5,F4,F3,F2,F1,F0, + Ch3,Ch2,Ch1,Ch0, + Cr3,Cr2,Cr1,Cr0, + NL1,NL0 | Rest] = Msg) -> + <<Flags:64>> = <<F7,F6,F5,F4,F3,F2,F1,F0>>, + <<Challenge:32>> = <<Ch3,Ch2,Ch1,Ch0>>, + <<Creation:32>> = <<Cr3,Cr2,Cr1,Cr0>>, + <<NameLen:16>> = <<NL1,NL0>>, + {Ns, _Residue} = + try + lists:split(NameLen, Rest) + catch + error:badarg -> + ?shutdown2(no_node, {recv_challenge_failed, no_node, Msg}) + end, + ?trace("recv: 'N' node=~p, challenge=~w creation=~w\n", + [Ns, Challenge, Creation]), + + case Flags band ?DFLAG_HANDSHAKE_23 of + ?DFLAG_HANDSHAKE_23 -> + try list_to_existing_atom(Ns) of + Node -> + {Flags, Challenge, Creation}; + _ -> + ?shutdown2(no_node, {recv_challenge_failed, no_node, Ns}) + catch + error:badarg -> + ?shutdown2(no_node, {recv_challenge_failed, no_node, Ns}) + end; + 0 -> + ?shutdown2(no_node, {recv_challenge_failed, version, Msg}) + end; +recv_challenge_new(_, Other) -> + ?shutdown2(no_node, {recv_challenge_failed, Other}). + + +recv_complement(#hs_data{socket = Socket, + f_recv = Recv, + other_flags = Flags} = HSData, + SendNameVersion) -> + if SendNameVersion =:= ?ERL_DIST_VER_5, + (Flags band ?DFLAG_HANDSHAKE_23) =/= 0 -> + case Recv(Socket, 0, infinity) of + {ok, [$c, F7,F6,F5,F4, Cr3,Cr2,Cr1,Cr0]} -> + <<FlagsHigh:32>> = <<F7,F6,F5,F4>>, + <<Creation:32>> = <<Cr3,Cr2,Cr1,Cr0>>, + ?trace("recv_complement: creation=~w\n", [Creation]), + HSData#hs_data{other_creation = Creation, + other_flags = Flags bor (FlagsHigh bsl 32)}; + Other -> + ?shutdown2(no_node, {recv_complement_failed, Other}) + end; + true -> + HSData end. diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl index ac4fe2b78b..fecb1cd3e0 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -29,14 +29,16 @@ -define(port_please_failure2(Term), noop). -endif. +-include("dist.hrl"). + -ifndef(erlang_daemon_port). -define(erlang_daemon_port, 4369). -endif. -ifndef(epmd_dist_high). --define(epmd_dist_high, 4370). +-define(epmd_dist_high, ?ERL_DIST_VER_HIGH). -endif. -ifndef(epmd_dist_low). --define(epmd_dist_low, 4370). +-define(epmd_dist_low, ?ERL_DIST_VER_LOW). -endif. %% External exports @@ -347,6 +349,13 @@ wait_for_reg_reply(Socket, SoFar) -> receive {tcp, Socket, Data0} -> case SoFar ++ Data0 of + [$v, Result, A, B, C, D] -> + case Result of + 0 -> + {alive, Socket, ?u32(A, B, C, D)}; + _ -> + {error, duplicate_name} + end; [$y, Result, A, B] -> case Result of 0 -> diff --git a/lib/kernel/src/erpc.erl b/lib/kernel/src/erpc.erl new file mode 100644 index 0000000000..a73598c019 --- /dev/null +++ b/lib/kernel/src/erpc.erl @@ -0,0 +1,473 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2020. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% Author: Rickard Green +%% + +-module(erpc). + +%% Exported API + +-export([call/4, + call/5, + cast/4, + send_request/4, + receive_response/1, + receive_response/2, + wait_response/1, + wait_response/2, + check_response/2, + multicall/4, + multicall/5]). + +-export_type([request_id/0]). + +%% Internal exports (also used by the 'rpc' module) + +-export([execute_call/4, + execute_call/3, + is_arg_error/4, + trim_stack/4, + call_result/4]). + +%%------------------------------------------------------------------------ + +-compile({inline,[{result,4}]}). %% Nicer error stack trace... + +-define(MAX_INT_TIMEOUT, 4294967295). +-define(TIMEOUT_TYPE, 0..?MAX_INT_TIMEOUT | 'infinity'). +-define(IS_VALID_TMO_INT(TI_), (is_integer(TI_) + andalso (0 =< TI_) + andalso (TI_ =< ?MAX_INT_TIMEOUT))). +-define(IS_VALID_TMO(T_), ((T_ == infinity) orelse ?IS_VALID_TMO_INT(T_))). + +%%------------------------------------------------------------------------ +%% Exported API +%%------------------------------------------------------------------------ + +-spec call(Node, Module, Function, Args) -> Result when + Node :: node(), + Module :: atom(), + Function :: atom(), + Args :: [term()], + Result :: term(). + +call(N, M, F, A) -> + call(N, M, F, A, infinity). + +-dialyzer([{nowarn_function, call/5}, no_return]). + +-spec call(Node, Module, Function, Args, Timeout) -> Result when + Node :: node(), + Module :: atom(), + Function :: atom(), + Args :: [term()], + Timeout :: ?TIMEOUT_TYPE, + Result :: term(). + +call(N, M, F, A, infinity) when node() =:= N, %% Optimize local call + is_atom(M), + is_atom(F), + is_list(A) -> + try + {return, Return} = execute_call(M,F,A), + Return + catch + exit:Reason -> + exit({exception, Reason}); + error:Reason:Stack -> + case is_arg_error(Reason, M, F, A) of + true -> + error({?MODULE, Reason}); + false -> + ErpcStack = trim_stack(Stack, M, F, A), + error({exception, Reason, ErpcStack}) + end + end; +call(N, _M, _F, _A, infinity) when node() =:= N -> + error({?MODULE, badarg}); +call(N, M, F, A, T) when ?IS_VALID_TMO(T) -> + try + Res = make_ref(), + ReqId = erlang:spawn_request(N, ?MODULE, execute_call, + [Res, M, F, A], + [{reply, error_only}, + monitor]), + receive + {spawn_reply, ReqId, error, Reason} -> + result(spawn_reply, ReqId, Res, Reason); + {'DOWN', ReqId, process, _Pid, Reason} -> + result(down, ReqId, Res, Reason) + after T -> + result(timeout, ReqId, Res, undefined) + end + catch + error:badarg -> + error({?MODULE, badarg}) + end; +call(_N, _M, _F, _A, _T) -> + error({?MODULE, badarg}). + +%% Asynchronous call + +-opaque request_id() :: {reference(), reference()}. + +-spec send_request(Node, Module, Function, Args) -> RequestId when + Node :: node(), + Module :: module(), + Function :: atom(), + Args :: [term()], + RequestId :: request_id(). + +send_request(N, M, F, A) -> + try + Res = make_ref(), + ReqId = erlang:spawn_request(N, ?MODULE, execute_call, + [Res, M, F, A], + [{reply, error_only}, + monitor]), + {Res, ReqId} + catch + error:badarg -> + error({?MODULE, badarg}) + end. + +-spec receive_response(RequestId) -> Result when + RequestId :: request_id(), + Result :: term(). + +receive_response({Res, ReqId} = RId) when is_reference(Res), + is_reference(ReqId) -> + receive_response(RId, infinity); +receive_response(_) -> + error({?MODULE, badarg}). + +-dialyzer([{nowarn_function, receive_response/2}, no_return]). + +-spec receive_response(RequestId, Timeout) -> Result when + RequestId :: request_id(), + Timeout :: ?TIMEOUT_TYPE, + Result :: term(). + +receive_response({Res, ReqId}, Tmo) when is_reference(Res), + is_reference(ReqId), + ?IS_VALID_TMO(Tmo) -> + receive + {spawn_reply, ReqId, error, Reason} -> + result(spawn_reply, ReqId, Res, Reason); + {'DOWN', ReqId, process, _Pid, Reason} -> + result(down, ReqId, Res, Reason) + after Tmo -> + result(timeout, ReqId, Res, undefined) + end; +receive_response(_, _) -> + error({?MODULE, badarg}). + +-spec wait_response(RequestId) -> {'response', Result} | 'no_response' when + RequestId :: request_id(), + Result :: term(). + +wait_response({Res, ReqId} = RId) when is_reference(Res), + is_reference(ReqId) -> + wait_response(RId, 0). + +-dialyzer([{nowarn_function, wait_response/2}, no_return]). + +-spec wait_response(RequestId, WaitTime) -> + {'response', Result} | 'no_response' when + RequestId :: request_id(), + WaitTime :: ?TIMEOUT_TYPE, + Result :: term(). + +wait_response({Res, ReqId}, WT) when is_reference(Res), + is_reference(ReqId), + ?IS_VALID_TMO(WT) -> + receive + {spawn_reply, ReqId, error, Reason} -> + result(spawn_reply, ReqId, Res, Reason); + {'DOWN', ReqId, process, _Pid, Reason} -> + {response, result(down, ReqId, Res, Reason)} + after WT -> + no_response + end; +wait_response(_, _) -> + error({?MODULE, badarg}). + +-dialyzer([{nowarn_function, check_response/2}, no_return]). + +-spec check_response(Message, RequestId) -> + {'response', Result} | 'no_response' when + Message :: term(), + RequestId :: request_id(), + Result :: term(). + +check_response({spawn_reply, ReqId, error, Reason}, + {Res, ReqId}) when is_reference(Res), + is_reference(ReqId) -> + result(spawn_reply, ReqId, Res, Reason); +check_response({'DOWN', ReqId, process, _Pid, Reason}, + {Res, ReqId}) when is_reference(Res), + is_reference(ReqId) -> + {response, result(down, ReqId, Res, Reason)}; +check_response(_Msg, {Res, ReqId}) when is_reference(Res), + is_reference(ReqId) -> + no_response; +check_response(_, _) -> + error({?MODULE, badarg}). + +-type stack_item() :: + {Module :: atom(), + Function :: atom(), + Arity :: arity() | (Args :: [term()]), + Location :: [{file, Filename :: string()} | + {line, Line :: pos_integer()}]}. + +-type caught_call_exception() :: + {throw, Throw :: term()} + | {exit, {exception, Reason :: term()}} + | {error, {exception, Reason :: term(), StackTrace :: [stack_item()]}} + | {exit, {signal, Reason :: term()}} + | {error, {?MODULE, Reason :: term()}}. + + +-spec multicall(Nodes, Module, Function, Args) -> Result when + Nodes :: [atom()], + Module :: atom(), + Function :: atom(), + Args :: [term()], + Result :: [{ok, ReturnValue :: term()} | caught_call_exception()]. + +multicall(Ns, M, F, A) -> + multicall(Ns, M, F, A, infinity). + +-spec multicall(Nodes, Module, Function, Args, Timeout) -> Result when + Nodes :: [atom()], + Module :: atom(), + Function :: atom(), + Args :: [term()], + Timeout :: ?TIMEOUT_TYPE, + Result :: [{ok, ReturnValue :: term()} | caught_call_exception()]. + +multicall(Ns, M, F, A, T) when ?IS_VALID_TMO(T) -> + EndTime = if T == infinity -> + infinity; + T == 0 -> + erlang:monotonic_time(millisecond); + T == ?MAX_INT_TIMEOUT -> + erlang:monotonic_time(millisecond) + + ?MAX_INT_TIMEOUT; + true -> + Start = erlang:monotonic_time(), + NTmo = erlang:convert_time_unit(T, + millisecond, + native), + erlang:convert_time_unit(Start + NTmo - 1, + native, + millisecond) + 1 + end, + try + ReqIds = mcall_send_requests(Ns, M, F, A, []), + mcall_wait_replies(ReqIds, [], EndTime) + catch + error:{?MODULE, badarg} = Reason -> + error(Reason) + end; +multicall(_Ns, _M, _F, _A, _T) -> + error({?MODULE, badarg}). + +-spec cast(Node, Module, Function, Args) -> ok when + Node :: node(), + Module :: module(), + Function :: atom(), + Args :: [term()]. + +cast(Node, Mod, Fun, Args) -> + %% Fire and forget... + try + _ = erlang:spawn_request(Node, Mod, Fun, Args, [{reply, no}]), + ok + catch + error:badarg -> + error({?MODULE, badarg}) + end. + +%%------------------------------------------------------------------------ +%% Exported internals +%%------------------------------------------------------------------------ + +%% Note that most of these are used by 'rpc' as well... + +execute_call(Ref, M, F, A) -> + Reply = try + {Ref, return, apply(M, F, A)} + catch + throw:Reason -> + {Ref, throw, Reason}; + exit:Reason -> + {Ref, exit, Reason}; + error:Reason:Stack -> + case is_arg_error(Reason, M, F, A) of + true -> + {Ref, error, {?MODULE, Reason}}; + false -> + ErpcStack = trim_stack(Stack, M, F, A), + {Ref, error, Reason, ErpcStack} + end + end, + exit(Reply). + +execute_call(M,F,A) -> + {return, apply(M, F, A)}. + +call_result(Type, ReqId, Res, Reason) -> + result(Type, ReqId, Res, Reason). + +is_arg_error(badarg, M, F, A) -> + try + true = is_atom(M), + true = is_atom(F), + true = is_integer(length(A)), + false + catch + error:badarg -> + true + end; +is_arg_error(system_limit, _M, _F, A) -> + try + apply(?MODULE, nonexisting, A), + false + catch + error:system_limit -> true; + _:_ -> false + end; +is_arg_error(_R, _M, _F, _A) -> + false. + +trim_stack([{?MODULE, execute_call, _, _} | _], M, F, A) -> + [{M, F, A, []}]; +trim_stack([{M, F, A, _} = SF, {?MODULE, execute_call, _, _} | _], M, F, A) -> + [SF]; +trim_stack(S, M, F, A) -> + try + trim_stack_aux(S, M, F, A) + catch + throw:use_all -> S + end. + +%%------------------------------------------------------------------------ +%% Internals +%%------------------------------------------------------------------------ + +trim_stack_aux([], _M, _F, _A) -> + throw(use_all); +trim_stack_aux([{M, F, AL, _} = SF, {?MODULE, execute_call, _, _} | _], + M, F, A) when AL == length(A) -> + [SF]; +trim_stack_aux([{?MODULE, execute_call, _, _} | _], M, F, A) -> + [{M, F, length(A), []}]; +trim_stack_aux([SF|SFs], M, F, A) -> + [SF|trim_stack_aux(SFs, M, F, A)]. + +call_abandon(ReqId) -> + case erlang:spawn_request_abandon(ReqId) of + true -> true; + false -> erlang:demonitor(ReqId, [info]) + end. + +-dialyzer([{nowarn_function, result/4}, no_return]). + +-spec result('down', ReqId, Res, Reason) -> term() when + ReqId :: reference(), + Res :: reference(), + Reason :: term(); + ('spawn_reply', ReqId, Res, Reason) -> no_return() when + ReqId :: reference(), + Res :: reference(), + Reason :: term(); + ('timeout', ReqId, Res, Reason) -> term() when + ReqId :: reference(), + Res :: reference(), + Reason :: term(). + +result(down, _ReqId, Res, {Res, return, Return}) -> + Return; +result(down, _ReqId, Res, {Res, throw, Throw}) -> + throw(Throw); +result(down, _ReqId, Res, {Res, exit, Exit}) -> + exit({exception, Exit}); +result(down, _ReqId, Res, {Res, error, Error, Stack}) -> + error({exception, Error, Stack}); +result(down, _ReqId, Res, {Res, error, {?MODULE, _} = ErpcErr}) -> + error(ErpcErr); +result(down, _ReqId, _Res, noconnection) -> + error({?MODULE, noconnection}); +result(down, _ReqId, _Res, Reason) -> + exit({signal, Reason}); +result(spawn_reply, _ReqId, _Res, Reason) -> + error({?MODULE, Reason}); +result(timeout, ReqId, Res, _Reason) -> + case call_abandon(ReqId) of + true -> + error({?MODULE, timeout}); + false -> + %% Spawn error or DOWN has arrived. Return + %% a result instead of a timeout since we + %% just got the result... + receive + {spawn_reply, ReqId, error, Reason} -> + result(spawn_reply, ReqId, Res, Reason); + {'DOWN', ReqId, process, _Pid, Reason} -> + result(down, ReqId, Res, Reason) + after + 0 -> + %% Invalid request id... + error({?MODULE, badarg}) + end + end. + +mcall_send_requests([], _M, _F, _A, RIDs) -> + RIDs; +mcall_send_requests([N|Ns], M, F, A, RIDs) -> + RID = send_request(N, M, F, A), + mcall_send_requests(Ns, M, F, A, [RID|RIDs]); +mcall_send_requests(_, _M, _F, _A, _RIDs) -> + error({?MODULE, badarg}). + +mcall_wait_replies([], Replies, _Tmo) -> + Replies; +mcall_wait_replies([RID|RIDs], Replies, infinity) -> + Reply = mcall_wait_reply(RID, infinity), + mcall_wait_replies(RIDs, [Reply|Replies], infinity); +mcall_wait_replies([RID|RIDs], Replies, EndTime) -> + Now = erlang:monotonic_time(millisecond), + Tmo = case EndTime - Now of + T when T =< 0 -> 0; + T -> T + end, + Reply = mcall_wait_reply(RID, Tmo), + mcall_wait_replies(RIDs, [Reply|Replies], EndTime). + +mcall_wait_reply(RID, Tmo) -> + try + {ok, receive_response(RID, Tmo)} + catch + Class:Reason -> + {Class, Reason} + end. + diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl index e324be5290..37771f4e60 100644 --- a/lib/kernel/src/error_logger.erl +++ b/lib/kernel/src/error_logger.erl @@ -147,15 +147,15 @@ do_log(Level,{report,Msg},#{?MODULE:=#{tag:=Tag}}=Meta) -> _ -> %% From logger call which added error_logger data to %% obtain backwards compatibility with error_logger:*_msg/1,2 - case maps:get(report_cb,Meta,fun logger:format_report/1) of + case get_report_cb(Meta) of RCBFun when is_function(RCBFun,1) -> try RCBFun(Msg) of {F,A} when is_list(F), is_list(A) -> {F,A}; Other -> {"REPORT_CB ERROR: ~tp; Returned: ~tp",[Msg,Other]} - catch C:R -> - {"REPORT_CB CRASH: ~tp; Reason: ~tp",[Msg,{C,R}]} + catch C:R:S -> + {"REPORT_CB CRASH: ~tp; Reason: ~tp",[Msg,{C,R,S}]} end; RCBFun when is_function(RCBFun,2) -> try RCBFun(Msg,#{depth=>get_format_depth(), @@ -216,6 +216,13 @@ fix_warning_type(error,std_warning) -> std_error; fix_warning_type(info,std_warning) -> std_info; fix_warning_type(_,Type) -> Type. +get_report_cb(#{?MODULE:=#{report_cb:=RBFun}}) -> + RBFun; +get_report_cb(#{report_cb:=RBFun}) -> + RBFun; +get_report_cb(_) -> + fun logger:format_report/1. + %%----------------------------------------------------------------- %% These two simple old functions generate events tagged 'error' %% Used for simple messages; error or information. diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index e6a30d0b92..da86679532 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -40,6 +40,15 @@ lc_graph/0, lc_graph_to_dot/2, lc_graph_merge/2, alloc_blocks_size/1]). +%% Reroutes calls to the given MFA to error_handler:breakpoint/3 +%% +%% Note that this is potentially unsafe as compiled code may assume that the +%% targeted function returns a specific type, triggering undefined behavior if +%% this function were to return something else. +%% +%% For reference, the debugger avoids the issue by purging the affected module +%% and interpreting all functions in the module, ensuring that no assumptions +%% are made with regard to return or argument types. -spec breakpoint(MFA, Flag) -> non_neg_integer() when MFA :: {Module :: module(), Function :: atom(), @@ -92,7 +101,7 @@ copy_shared(_) -> -spec get_internal_state(W) -> term() when W :: reds_left | node_and_dist_references | monitoring_nodes - | next_pid | 'DbTable_words' | check_io_debug + | next_pid | 'DbTable_words' | check_io_debug | lc_graph | process_info_args | processes | processes_bif_info | max_atom_out_cache_index | nbalance | available_internal_state | force_heap_frags | memory @@ -517,43 +526,38 @@ alloc_blocks_size_1([], _Type, 0) -> undefined; alloc_blocks_size_1([{_Type, false} | Rest], Type, Acc) -> alloc_blocks_size_1(Rest, Type, Acc); -alloc_blocks_size_1([{Type, Instances} | Rest], Type, Acc0) -> - F = fun ({instance, _, L}, Acc) -> +alloc_blocks_size_1([{_Type, Instances} | Rest], Type, Acc) -> + F = fun ({instance, _, L}, Acc0) -> MBCSPool = case lists:keyfind(mbcs_pool, 1, L) of {_, Pool} -> Pool; false -> [] end, {_,MBCS} = lists:keyfind(mbcs, 1, L), {_,SBCS} = lists:keyfind(sbcs, 1, L), - Acc + - sum_block_sizes(MBCSPool) + - sum_block_sizes(MBCS) + - sum_block_sizes(SBCS) + Acc1 = sum_block_sizes(MBCSPool, Type, Acc0), + Acc2 = sum_block_sizes(MBCS, Type, Acc1), + sum_block_sizes(SBCS, Type, Acc2) end, - alloc_blocks_size_1(Rest, Type, lists:foldl(F, Acc0, Instances)); -alloc_blocks_size_1([{_Type, Instances} | Rest], Type, Acc0) -> - F = fun ({instance, _, L}, Acc) -> - Acc + sum_foreign_sizes(Type, L) - end, - alloc_blocks_size_1(Rest, Type, lists:foldl(F, Acc0, Instances)); + alloc_blocks_size_1(Rest, Type, lists:foldl(F, Acc, Instances)); alloc_blocks_size_1([], _Type, Acc) -> Acc. -sum_foreign_sizes(Type, L) -> - case lists:keyfind(mbcs_pool, 1, L) of - {_,Pool} -> - {_,ForeignBlocks} = lists:keyfind(foreign_blocks, 1, Pool), - case lists:keyfind(Type, 1, ForeignBlocks) of - {_,TypeSizes} -> sum_block_sizes(TypeSizes); - false -> 0 - end; - _ -> - 0 - end. +sum_block_sizes([{blocks, List} | Rest], Type, Acc) -> + sum_block_sizes(Rest, Type, sum_block_sizes_1(List, Type, Acc)); +sum_block_sizes([_ | Rest], Type, Acc) -> + sum_block_sizes(Rest, Type, Acc); +sum_block_sizes([], _Type, Acc) -> + Acc. + +sum_block_sizes_1([{Type, L} | Rest], Type, Acc0) -> + Acc = lists:foldl(fun({size, Sz,_,_}, Sz0) -> Sz0+Sz; + ({size, Sz}, Sz0) -> Sz0+Sz; + (_, Sz) -> Sz + end, Acc0, L), + sum_block_sizes_1(Rest, Type, Acc); +sum_block_sizes_1([_ | Rest], Type, Acc) -> + sum_block_sizes_1(Rest, Type, Acc); +sum_block_sizes_1([], _Type, Acc) -> + Acc. + -sum_block_sizes(Blocks) -> - lists:foldl( - fun({blocks_size, Sz,_,_}, Sz0) -> Sz0+Sz; - ({blocks_size, Sz}, Sz0) -> Sz0+Sz; - (_, Sz) -> Sz - end, 0, Blocks). diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 1d4e37196c..cde03ce1c4 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -239,20 +239,30 @@ make_dir(Name) -> del_dir(Name) -> check_and_call(del_dir, [file_name(Name)]). --spec read_file_info(Filename) -> {ok, FileInfo} | {error, Reason} when - Filename :: name_all(), +-spec read_file_info(File) -> {ok, FileInfo} | {error, Reason} when + File :: name_all() | io_device(), FileInfo :: file_info(), Reason :: posix() | badarg. +read_file_info(IoDevice) + when is_pid(IoDevice); is_record(IoDevice, file_descriptor) -> + read_file_info(IoDevice, []); + read_file_info(Name) -> check_and_call(read_file_info, [file_name(Name)]). --spec read_file_info(Filename, Opts) -> {ok, FileInfo} | {error, Reason} when - Filename :: name_all(), +-spec read_file_info(File, Opts) -> {ok, FileInfo} | {error, Reason} when + File :: name_all() | io_device(), Opts :: [file_info_option()], FileInfo :: file_info(), Reason :: posix() | badarg. +read_file_info(IoDevice, Opts) when is_pid(IoDevice), is_list(Opts) -> + file_request(IoDevice, {read_handle_info, Opts}); + +read_file_info(#file_descriptor{module = Module} = Handle, Opts) when is_list(Opts) -> + Module:read_handle_info(Handle, Opts); + read_file_info(Name, Opts) when is_list(Opts) -> Args = [file_name(Name), Opts], case check_args(Args) of @@ -460,7 +470,7 @@ raw_write_file_info(Name, #file_info{} = Info) -> -spec open(File, Modes) -> {ok, IoDevice} | {error, Reason} when File :: Filename | iodata(), Filename :: name_all(), - Modes :: [mode() | ram], + Modes :: [mode() | ram | directory], IoDevice :: io_device(), Reason :: posix() | badarg | system_limit. @@ -545,7 +555,7 @@ allocate(#file_descriptor{module = Module} = Handle, Offset, Length) -> | {no_translation, unicode, latin1}. read(File, Sz) when (is_pid(File) orelse is_atom(File)), is_integer(Sz), Sz >= 0 -> - case io:request(File, {get_chars, '', Sz}) of + case io:request(File, {get_chars, latin1, '', Sz}) of Data when is_list(Data); is_binary(Data) -> {ok, Data}; Other -> @@ -566,7 +576,7 @@ read(_, _) -> | {no_translation, unicode, latin1}. read_line(File) when (is_pid(File) orelse is_atom(File)) -> - case io:request(File, {get_line, ''}) of + case io:request(File, {get_line, latin1, ''}) of Data when is_list(Data); is_binary(Data) -> {ok, Data}; Other -> @@ -1143,7 +1153,7 @@ path_script(Path, File, Bs) -> {ok, IoDevice, FullName} | {error, Reason} when Path :: [Dir :: name_all()], Filename :: name_all(), - Modes :: [mode()], + Modes :: [mode() | directory], IoDevice :: io_device(), FullName :: filename_all(), Reason :: posix() | badarg | system_limit. diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl index 34d5497a4a..c03fbb548a 100644 --- a/lib/kernel/src/file_io_server.erl +++ b/lib/kernel/src/file_io_server.erl @@ -314,6 +314,14 @@ file_request(truncate, Reply -> std_reply(Reply, State) end; +file_request({read_handle_info, Opts}, + #state{handle=Handle}=State) -> + case ?CALL_FD(Handle, read_handle_info, [Opts]) of + {error,Reason}=Reply -> + {stop,Reason,Reply,State}; + Reply -> + {reply,Reply,State} + end; file_request(Unknown, #state{}=State) -> Reason = {request, Unknown}, diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index 3875074d74..ff6674cd08 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -909,7 +909,7 @@ handle_info({nodeup, Node}, S0) when S0#state.connect_all -> end; handle_info({whereis, Name, From}, S) -> - do_whereis(Name, From), + _ = do_whereis(Name, From), {noreply, S}; handle_info(known, S) -> diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index 5625ae6eb7..8410c1a4b5 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -73,7 +73,7 @@ get_pids([], _Found, false) -> start_shell({Mod,Func,Args}) -> start_shell1(Mod, Func, Args); start_shell({Node,Mod,Func,Args}) -> - start_shell1(net, call, [Node,Mod,Func,Args]); + start_shell1(rpc, call, [Node,Mod,Func,Args]); start_shell(Shell) when is_atom(Shell) -> start_shell1(Shell, start, []); start_shell(Shell) when is_function(Shell) -> @@ -795,12 +795,6 @@ save_line({stack, U, _L, D}, Line) -> {stack, U, Line, D}. get_lines(Ls) -> get_all_lines(Ls). -%get_lines({stack, U, {}, []}) -> -% U; -%get_lines({stack, U, {}, D}) -> -% tl(lists:reverse(D, U)); -%get_lines({stack, U, L, D}) -> -% get_lines({stack, U, {}, [L|D]}). %% There's a funny behaviour whenever the line stack doesn't have a "\n" %% at its end -- get_lines() seemed to work on the assumption it *will* be diff --git a/lib/kernel/src/group_history.erl b/lib/kernel/src/group_history.erl index 9745848992..1fab2ba14e 100644 --- a/lib/kernel/src/group_history.erl +++ b/lib/kernel/src/group_history.erl @@ -44,7 +44,7 @@ load() -> wait_for_kernel_safe_sup(), case history_status() of enabled -> - case open_log() of + try open_log() of {ok, ?LOG_NAME} -> read_full_log(?LOG_NAME); {repaired, ?LOG_NAME, {recovered, Good}, {badbytes, Bad}} -> @@ -68,6 +68,10 @@ load() -> handle_open_error(Reason), disable_history(), [] + catch + % disk_log shut down abruptly, possibly because + % the node is shutting down. Ignore it. + exit:_ -> [] end; _ -> [] @@ -127,11 +131,15 @@ repair_log(Name) -> %% Return whether the shell history is enabled or not -spec history_status() -> enabled | disabled. history_status() -> - case is_user() orelse application:get_env(kernel, shell_history) of - true -> disabled; % don't run for user proc - {ok, enabled} -> enabled; - undefined -> ?DEFAULT_STATUS; - _ -> disabled + %% Don't run for user proc or if the emulator's tearing down + Skip = is_user() orelse not init_running(), + case application:get_env(kernel, shell_history) of + {ok, enabled} when not Skip -> + enabled; + undefined when not Skip -> + ?DEFAULT_STATUS; + _ -> + disabled end. %% Return whether the user process is running this @@ -142,6 +150,14 @@ is_user() -> _ -> false end. +%% Return if the system is running (not stopping) +-spec init_running() -> boolean(). +init_running() -> + case init:get_status() of + {stopping, _} -> false; + _ -> true + end. + %% Open a disk_log file while ensuring the required path is there. open_log() -> Opts = log_options(), @@ -322,7 +338,7 @@ show_unexpected_warning({M,F,A}, Term) -> show_unexpected_close_warning() -> show('$#erlang-history-unexpected-close', - "The shell log file has mysteriousy closed. Ignoring " + "The shell log file has mysteriously closed. Ignoring " "currently unread history.~n", []). show_size_warning(_Current, _New) -> diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index 630ef5d2f7..fbccc787a2 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2019. All Rights Reserved. +%% Copyright Ericsson AB 1997-2020. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -229,12 +229,14 @@ set_edns(Version) -> res_option(edns, Version). set_udp_payload_size(Size) -> res_option(udp_payload_size, Size). -set_resolv_conf(Fname) -> res_option(resolv_conf, Fname). +set_resolv_conf(Fname) when is_list(Fname) -> + res_option(resolv_conf, Fname). -set_hosts_file(Fname) -> res_option(hosts_file, Fname). +set_hosts_file(Fname) when is_list(Fname) -> + res_option(hosts_file, Fname). get_hosts_file() -> - get_rc_hosts([], [], inet_hosts_file_byname). + get_rc_hosts([], [], inet_hosts_file_byaddr). %% set socks options set_socks_server(Server) -> call({set_socks_server, Server}). @@ -318,7 +320,7 @@ get_rc() -> get_rc([K | Ks], Ls) -> case K of - hosts -> get_rc_hosts(Ks, Ls, inet_hosts_byname); + hosts -> get_rc_hosts(Ks, Ls, inet_hosts_byaddr); domain -> get_rc(domain, res_domain, "", Ks, Ls); nameservers -> get_rc_ns(db_get(res_ns),nameservers,Ks,Ls); alt_nameservers -> get_rc_ns(db_get(res_alt_ns),alt_nameservers,Ks,Ls); @@ -371,18 +373,11 @@ get_rc_ns([], _Tag, Ks, Ls) -> get_rc(Ks, Ls). get_rc_hosts(Ks, Ls, Tab) -> - case lists:keysort(3, ets:tab2list(Tab)) of + case ets:tab2list(Tab) of [] -> get_rc(Ks, Ls); - [{N,_,IP}|Hosts] -> get_rc_hosts(Ks, Ls, IP, Hosts, [N]) + Hosts -> get_rc(Ks, [ [{host, IP, Names} || {{_Fam, IP}, Names} <- Hosts] | Ls]) end. -get_rc_hosts(Ks, Ls, IP, [], Ns) -> - get_rc(Ks, [{host,IP,lists:reverse(Ns)}|Ls]); -get_rc_hosts(Ks, Ls, IP, [{N,_,IP}|Hosts], Ns) -> - get_rc_hosts(Ks, Ls, IP, Hosts, [N|Ns]); -get_rc_hosts(Ks, Ls, IP, [{N,_,NewIP}|Hosts], Ns) -> - [{host,IP,lists:reverse(Ns)}|get_rc_hosts(Ks, Ls, NewIP, Hosts, [N])]. - %% %% Resolver options %% @@ -502,49 +497,26 @@ socks_option(noproxy) -> db_get(socks5_noproxy). gethostname() -> db_get(hostname). res_update_conf() -> - res_update(res_resolv_conf, res_resolv_conf_tm, res_resolv_conf_info, - set_resolv_conf_tm, fun set_resolv_conf/1). + res_update(resolv_conf, res_resolv_conf_tm). res_update_hosts() -> - res_update(res_hosts_file, res_hosts_file_tm, res_hosts_file_info, - set_hosts_file_tm, fun set_hosts_file/1). + res_update(hosts_file, res_hosts_file_tm). -res_update(Tag, TagTm, TagInfo, TagSetTm, SetFun) -> +res_update(Option, TagTm) -> case db_get(TagTm) of undefined -> ok; - TM -> + Tm -> case times() of - Now when Now >= TM + ?RES_FILE_UPDATE_TM -> - case db_get(Tag) of - undefined -> - SetFun(""); - "" -> - SetFun(""); - File -> - case erl_prim_loader:read_file_info(File) of - {ok, Finfo0} -> - Finfo = - Finfo0#file_info{access = undefined, - atime = undefined}, - case db_get(TagInfo) of - Finfo -> - call({TagSetTm, Now}); - _ -> - SetFun(File) - end; - _ -> - call({TagSetTm, Now}), - error - end - end; + Now when Now >= Tm + ?RES_FILE_UPDATE_TM -> + %% Enough time has passed - request server to update + res_option(Option, Tm); _ -> ok end end. db_get(Name) -> - case ets:lookup(inet_db, Name) of - [] -> undefined; - [{_,Val}] -> Val + try ets:lookup_element(inet_db, Name, 2) + catch error:badarg -> undefined end. add_rr(RR) -> @@ -853,12 +825,10 @@ init([]) -> reset_db(Db), CacheOpts = [public, bag, {keypos,#dns_rr.domain}, named_table], Cache = ets:new(inet_cache, CacheOpts), - BynameOpts = [protected, bag, named_table, {keypos,1}], - ByaddrOpts = [protected, bag, named_table, {keypos,3}], - HostsByname = ets:new(inet_hosts_byname, BynameOpts), - HostsByaddr = ets:new(inet_hosts_byaddr, ByaddrOpts), - HostsFileByname = ets:new(inet_hosts_file_byname, BynameOpts), - HostsFileByaddr = ets:new(inet_hosts_file_byaddr, ByaddrOpts), + HostsByname = ets:new(inet_hosts_byname, [named_table]), + HostsByaddr = ets:new(inet_hosts_byaddr, [named_table]), + HostsFileByname = ets:new(inet_hosts_file_byname, [named_table]), + HostsFileByaddr = ets:new(inet_hosts_file_byaddr, [named_table]), {ok, #state{db = Db, cache = Cache, hosts_byname = HostsByname, @@ -868,29 +838,31 @@ init([]) -> cache_timer = init_timer() }}. reset_db(Db) -> - ets:insert(Db, {hostname, []}), - ets:insert(Db, {res_ns, []}), - ets:insert(Db, {res_alt_ns, []}), - ets:insert(Db, {res_search, []}), - ets:insert(Db, {res_domain, ""}), - ets:insert(Db, {res_lookup, []}), - ets:insert(Db, {res_recurse, true}), - ets:insert(Db, {res_usevc, false}), - ets:insert(Db, {res_id, 0}), - ets:insert(Db, {res_retry, ?RES_RETRY}), - ets:insert(Db, {res_timeout, ?RES_TIMEOUT}), - ets:insert(Db, {res_inet6, false}), - ets:insert(Db, {res_edns, false}), - ets:insert(Db, {res_udp_payload_size, ?DNS_UDP_PAYLOAD_SIZE}), - ets:insert(Db, {cache_size, ?CACHE_LIMIT}), - ets:insert(Db, {cache_refresh_interval,?CACHE_REFRESH}), - ets:insert(Db, {socks5_server, ""}), - ets:insert(Db, {socks5_port, ?IPPORT_SOCKS}), - ets:insert(Db, {socks5_methods, [none]}), - ets:insert(Db, {socks5_noproxy, []}), - ets:insert(Db, {tcp_module, ?DEFAULT_TCP_MODULE}), - ets:insert(Db, {udp_module, ?DEFAULT_UDP_MODULE}), - ets:insert(Db, {sctp_module, ?DEFAULT_SCTP_MODULE}). + ets:insert( + Db, + [{hostname, []}, + {res_ns, []}, + {res_alt_ns, []}, + {res_search, []}, + {res_domain, ""}, + {res_lookup, []}, + {res_recurse, true}, + {res_usevc, false}, + {res_id, 0}, + {res_retry, ?RES_RETRY}, + {res_timeout, ?RES_TIMEOUT}, + {res_inet6, false}, + {res_edns, false}, + {res_udp_payload_size, ?DNS_UDP_PAYLOAD_SIZE}, + {cache_size, ?CACHE_LIMIT}, + {cache_refresh_interval,?CACHE_REFRESH}, + {socks5_server, ""}, + {socks5_port, ?IPPORT_SOCKS}, + {socks5_methods, [none]}, + {socks5_noproxy, []}, + {tcp_module, ?DEFAULT_TCP_MODULE}, + {udp_module, ?DEFAULT_UDP_MODULE}, + {sctp_module, ?DEFAULT_SCTP_MODULE}]). %%---------------------------------------------------------------------- %% Func: handle_call/3 @@ -908,22 +880,7 @@ reset_db(Db) -> handle_call(Request, From, #state{db=Db}=State) -> case Request of {load_hosts_file,IPNmAs} when is_list(IPNmAs) -> - NIPs = - lists:flatten( - [ [{N, - if tuple_size(IP) =:= 4 -> inet; - tuple_size(IP) =:= 8 -> inet6 - end,IP} || N <- [Nm|As]] - || {IP,Nm,As} <- IPNmAs]), - Byname = State#state.hosts_file_byname, - Byaddr = State#state.hosts_file_byaddr, - ets:delete_all_objects(Byname), - ets:delete_all_objects(Byaddr), - %% Byname has lowercased names while Byaddr keep the name casing. - %% This is to be able to reconstruct the original - %% /etc/hosts entry. - ets:insert(Byname, [{tolower(N),Type,IP} || {N,Type,IP} <- NIPs]), - ets:insert(Byaddr, NIPs), + load_hosts_list(IPNmAs, State#state.hosts_file_byname, State#state.hosts_file_byaddr), {reply, ok, State}; {add_host,{A,B,C,D}=IP,[N|As]=Names} @@ -969,7 +926,7 @@ handle_call(Request, From, #state{db=Db}=State) -> case res_check_option(Opt, El) of true -> Optname = res_optname(Opt), - [{_,Es}] = ets:lookup(Db, Optname), + Es = ets:lookup_element(Db, Optname, 2), NewEs = case Op of ins -> [E | lists_delete(E, Es)]; add -> lists_delete(E, Es) ++ El; @@ -1003,12 +960,12 @@ handle_call(Request, From, #state{db=Db}=State) -> Option, Fname, res_resolv_conf_tm, res_resolv_conf_info, undefined, From, State); - {res_set, hosts_file=Option, Fname} -> + {res_set, hosts_file=Option, Fname_or_Tm} -> handle_set_file( - Option, Fname, res_hosts_file_tm, res_hosts_file_info, - fun (Bin) -> + Option, Fname_or_Tm, res_hosts_file_tm, res_hosts_file_info, + fun (File, Bin) -> case inet_parse:hosts( - Fname, {chars,Bin}) of + File, {chars,Bin}) of {ok,Opts} -> [{load_hosts_file,Opts}]; _ -> error @@ -1016,12 +973,12 @@ handle_call(Request, From, #state{db=Db}=State) -> end, From, State); %% - {res_set, resolv_conf=Option, Fname} -> + {res_set, resolv_conf=Option, Fname_or_Tm} -> handle_set_file( - Option, Fname, res_resolv_conf_tm, res_resolv_conf_info, - fun (Bin) -> + Option, Fname_or_Tm, res_resolv_conf_tm, res_resolv_conf_info, + fun (File, Bin) -> case inet_parse:resolv( - Fname, {chars,Bin}) of + File, {chars,Bin}) of {ok,Opts} -> Search = lists:foldl( @@ -1075,13 +1032,13 @@ handle_call(Request, From, #state{db=Db}=State) -> {reply, ok, State}; {add_socks_methods, Ls} -> - [{_,As}] = ets:lookup(Db, socks5_methods), + As = ets:lookup_element(Db, socks5_methods, 2), As1 = lists_subtract(As, Ls), ets:insert(Db, {socks5_methods, As1 ++ Ls}), {reply, ok, State}; {del_socks_methods, Ls} -> - [{_,As}] = ets:lookup(Db, socks5_methods), + As = ets:lookup_element(Db, socks5_methods, 2), As1 = lists_subtract(As, Ls), case lists:member(none, As1) of false -> ets:insert(Db, {socks5_methods, As1 ++ [none]}); @@ -1095,12 +1052,12 @@ handle_call(Request, From, #state{db=Db}=State) -> {add_socks_noproxy, {{A,B,C,D},{MA,MB,MC,MD}}} when ?ip(A,B,C,D), ?ip(MA,MB,MC,MD) -> - [{_,As}] = ets:lookup(Db, socks5_noproxy), + As = ets:lookup_element(Db, socks5_noproxy, 2), ets:insert(Db, {socks5_noproxy, As++[{{A,B,C,D},{MA,MB,MC,MD}}]}), {reply, ok, State}; {del_socks_noproxy, {A,B,C,D}=IP} when ?ip(A,B,C,D) -> - [{_,As}] = ets:lookup(Db, socks5_noproxy), + As = ets:lookup_element(Db, socks5_noproxy, 2), ets:insert(Db, {socks5_noproxy, lists_keydelete(IP, 1, As)}), {reply, ok, State}; @@ -1194,68 +1151,283 @@ terminate(_Reason, State) -> %%% Internal functions %%%---------------------------------------------------------------------- -handle_set_file(Option, Fname, TagTm, TagInfo, ParseFun, From, - #state{db=Db}=State) -> +handle_set_file( + Option, Tm, TagTm, TagInfo, ParseFun, From, #state{db=Db}=State) + when is_integer(Tm) -> + %% + %% Maybe update file content + %% + try ets:lookup_element(Db, TagTm, 2) of + Tm -> + %% Current update request + File = ets:lookup_element(Db, res_optname(Option), 2), + Finfo = ets:lookup_element(Db, TagInfo, 2), + handle_update_file( + Finfo, File, TagTm, TagInfo, ParseFun, From, State); + _ -> + %% Late request - ignore update + {reply, ok, State} + catch error:badarg -> + %% Option no longer set - ignore update + {reply, ok, State} + end; +handle_set_file( + Option, Fname, TagTm, TagInfo, ParseFun, From, #state{db=Db}=State) -> case res_check_option(Option, Fname) of true when Fname =:= "" -> + %% Delete file content and monitor ets:insert(Db, {res_optname(Option), Fname}), ets:delete(Db, TagInfo), ets:delete(Db, TagTm), - handle_set_file(ParseFun, <<>>, From, State); + handle_set_file(ParseFun, Fname, <<>>, From, State); true when ParseFun =:= undefined -> + %% Set file name and monitor File = filename:flatten(Fname), ets:insert(Db, {res_optname(Option), File}), ets:insert(Db, {TagInfo, undefined}), - TimeZero = - (?RES_FILE_UPDATE_TM + 1), % Early enough + TimeZero = times() - (?RES_FILE_UPDATE_TM + 1), % Early enough ets:insert(Db, {TagTm, TimeZero}), {reply,ok,State}; true -> + %% Set file name and monitor, read content File = filename:flatten(Fname), ets:insert(Db, {res_optname(Option), File}), - Bin = - case erl_prim_loader:read_file_info(File) of - {ok, Finfo0} -> - Finfo = Finfo0#file_info{access = undefined, - atime = undefined}, - ets:insert(Db, {TagInfo, Finfo}), - ets:insert(Db, {TagTm, times()}), - case erl_prim_loader:get_file(File) of - {ok, B, _} -> B; - _ -> <<>> - end; - _ -> - ets:insert(Db, {TagInfo, undefined}), - TimeZero = - (?RES_FILE_UPDATE_TM + 1), % Early enough - ets:insert(Db, {TagTm, TimeZero}), - <<>> - end, - handle_set_file(ParseFun, Bin, From, State); + handle_update_file( + undefined, File, TagTm, TagInfo, ParseFun, From, State); false -> {reply,error,State} end. -handle_set_file(ParseFun, Bin, From, State) -> - case ParseFun(Bin) of +handle_set_file(ParseFun, File, Bin, From, State) -> + case ParseFun(File, Bin) of error -> {reply,error,State}; Opts -> handle_rc_list(Opts, From, State) end. +handle_update_file( + Finfo, File, TagTm, TagInfo, ParseFun, From, #state{db = Db} = State) -> + %% + %% Update file content if file has been updated + %% + case erl_prim_loader:read_file_info(File) of + {ok, Finfo} -> + %% No file update - we are done + {reply, ok, State}; + {ok, Finfo_1} -> + %% File updated - read content + ets:insert(Db, {TagInfo, Finfo_1}), + ets:insert(Db, {TagTm, times()}), + Bin = + case erl_prim_loader:get_file(File) of + {ok, B, _} -> B; + _ -> <<>> + end, + handle_set_file(ParseFun, File, Bin, From, State); + _ -> + %% No file - clear content and reset monitor + ets:insert(Db, {TagInfo, undefined}), + ets:insert(Db, {TagTm, times()}), + handle_set_file(ParseFun, File, <<>>, From, State) + end. + %% Byname has lowercased names while Byaddr keep the name casing. %% This is to be able to reconstruct the original /etc/hosts entry. do_add_host(Byname, Byaddr, Names, Type, IP) -> - do_del_host(Byname, Byaddr, IP), - ets:insert(Byname, [{tolower(N),Type,IP} || N <- Names]), - ets:insert(Byaddr, [{N,Type,IP} || N <- Names]), + Nms = [tolower(Nm) || Nm <- Names], + add_ip_bynms(Byname, Type, IP, Nms, Names), + Key = {Type, IP}, + try ets:lookup_element(Byaddr, Key, 2) of + Names_0 -> + %% Delete IP address from byname entries + NmsSet = % Set of new tolower(Name)s + lists:foldl( + fun (Nm, Set) -> + maps:put(Nm, [], Set) + end, #{}, Nms), + del_ip_bynms( + Byname, Type, IP, + [Nm || Nm <- [tolower(Name) || Name <- Names_0], + not maps:is_key(Nm, NmsSet)]) + catch error:badarg -> + ok + end, + %% Replace the entry in the byaddr table + ets:insert(Byaddr, {Key, Names}), ok. do_del_host(Byname, Byaddr, IP) -> - _ = - [ets:delete_object(Byname, {tolower(Name),Type,Addr}) || - {Name,Type,Addr} <- ets:lookup(Byaddr, IP)], - ets:delete(Byaddr, IP), + Fam = inet_family(IP), + Key = {Fam, IP}, + try ets:lookup_element(Byaddr, Key, 2) of + Names -> + %% Delete IP address from byname entries + del_ip_bynms( + Byname, Fam, IP, + [tolower(Name) || Name <- Names]), + %% Delete from byaddr table + true = ets:delete(Byaddr, Key), + ok + catch error:badarg -> + ok + end. + + +add_ip_bynms(Byname, Fam, IP, Nms, Names) -> + lists:foreach( + fun (Nm) -> + Key = {Fam, Nm}, + case ets:lookup(Byname, Key) of + [{_Key, [IP | _] = IPs, _Names_1}] -> + %% Replace names in the byname entry + true = + ets:insert( + Byname, + {Key, IPs, Names}); + [{_Key, IPs, Names_0}] -> + case lists:member(IP, IPs) of + true -> + ok; + false -> + %% Add the IP address + true = + ets:insert( + Byname, + {Key, IPs ++ [IP], Names_0}) + end; + [] -> + %% Create a new byname entry + true = + ets:insert(Byname, {Key, [IP], Names}) + end + end, Nms). + +del_ip_bynms(Byname, Fam, IP, Nms) -> + lists:foreach( + fun (Nm) -> + Key = {Fam, Nm}, + case ets:lookup(Byname, Key) of + [{_Key, [IP], _Names}] -> + %% Delete whole entry + true = ets:delete(Byname, Key); + [{_Key, IPs_0, Names_0}] -> + case lists:member(IP, IPs_0) of + true -> + %% Delete the IP address from list + IPs = lists:delete(IP, IPs_0), + true = + ets:insert( + Byname, {Key, IPs, Names_0}); + false -> + ok + end; + [] -> + ok + end + end, Nms). + + +inet_family(T) when tuple_size(T) =:= 4 -> inet; +inet_family(T) when tuple_size(T) =:= 8 -> inet6. + + +%% Hosts = [ {IP, Name, Aliases}, ... ] +%% ByaddrMap = #{ {Fam, IP} := rev(Names) } +%% BynameMap = #{ {Fam, tolower(Name)} := {rev([IP, ...]), Names}} + +%% Synchronises internal tables with .hosts/aliases file +load_hosts_list(Hosts, Byname, Byaddr) -> + %% Create byaddr and byname maps + {ByaddrMap, BynameMap} = load_hosts_list(Hosts), + %% Insert or overwrite existing keys + ets:insert( + Byaddr, + [{Addr, lists:reverse(NamesR)} + || {Addr, NamesR} <- maps:to_list(ByaddrMap)]), + ets:insert( + Byname, + [{Fam_Nm, lists:reverse(IPsR), Names} + || {Fam_Nm, {IPsR, Names}} <- maps:to_list(BynameMap)]), + %% Delete no longer existing keys + ets_clean_map_keys(Byaddr, ByaddrMap), + ets_clean_map_keys(Byname, BynameMap). + +load_hosts_list(Hosts) -> + load_hosts_list_byaddr(Hosts, #{}, []). + +load_hosts_list_byaddr( + [], ByaddrMap, Addrs) -> + %% Now for the byname table... + load_hosts_list_byname(lists:reverse(Addrs), ByaddrMap, #{}); +%% Traverse hosts list, create byaddr map and insertion order list +load_hosts_list_byaddr( + [{IP, Name, Aliases} | Hosts], ByaddrMap, Addrs) -> + Addr = {inet_family(IP), IP}, + case ByaddrMap of + #{Addr := NamesR} -> + %% Concatenate names to existing IP address entry + load_hosts_list_byaddr( + Hosts, + ByaddrMap#{Addr := lists:reverse(Aliases, [Name | NamesR])}, + Addrs); + #{} -> + %% First entry for an IP address + load_hosts_list_byaddr( + Hosts, + ByaddrMap#{Addr => lists:reverse(Aliases, [Name])}, + [Addr | Addrs]) + end. + +%% Traverse in insertion order from byaddr pass +load_hosts_list_byname( + [], ByaddrMap, BynameMap) -> + {ByaddrMap, BynameMap}; +load_hosts_list_byname( + [{Fam, IP} = Addr | Addrs], ByaddrMap, BynameMap) -> + Names = lists:reverse(maps:get(Addr, ByaddrMap)), + %% Traverse all names for this IP address + load_hosts_list_byname( + Addrs, ByaddrMap, + load_hosts_list_byname(Fam, IP, BynameMap, Names, Names)). + +load_hosts_list_byname(_Fam, _IP, BynameMap, _Names_0, []) -> + BynameMap; +load_hosts_list_byname( + Fam, IP, BynameMap, Names_0, [Name | Names]) -> + Key = {Fam, tolower(Name)}, + case BynameMap of + #{Key := {IPsR, Names_1}} -> + %% Add IP address to existing name entry + load_hosts_list_byname( + Fam, IP, + BynameMap#{Key := {[IP | IPsR], Names_1}}, + Names_0, Names); + #{} -> + %% First entry for a name + load_hosts_list_byname( + Fam, IP, + BynameMap#{Key => {[IP], Names_0}}, + Names_0, Names) + end. + +ets_clean_map_keys(Tab, Map) -> + true = ets:safe_fixtable(Tab, true), + ets_clean_map_keys(Tab, Map, ets:first(Tab)), + true = ets:safe_fixtable(Tab, false), ok. +%% +ets_clean_map_keys(_Tab, _Map, '$end_of_table') -> + ok; +ets_clean_map_keys(Tab, Map, Key) -> + case maps:is_key(Key, Map) of + true -> + ets_clean_map_keys(Tab, Map, ets:next(Tab, Key)); + false -> + true = ets:delete(Tab, Key), + ets_clean_map_keys(Tab, Map, ets:next(Tab, Key)) + end. + %% Loop over .inetrc option list and call handle_call/3 for each %% @@ -1383,8 +1555,9 @@ cache_rr(_Db, Cache, RR) -> ets:insert(Cache, RR). times() -> - erlang:convert_time_unit(erlang:monotonic_time() - erlang:system_info(start_time), - native, second). + erlang:monotonic_time(second). + %% erlang:convert_time_unit(erlang:monotonic_time() - erlang:system_info(start_time), + %% native, second). %% lookup and remove old entries @@ -1518,12 +1691,12 @@ do_refresh_cache(Key, CacheDb, Now, OldestT) -> %% ------------------------------------------------------------------- alloc_entry(Db, CacheDb, TM) -> CurSize = ets:info(CacheDb, size), - case ets:lookup(Db, cache_size) of - [{cache_size, Size}] when Size =< CurSize, Size > 0 -> + case ets:lookup_element(Db, cache_size, 2) of + Size when Size =< CurSize, Size > 0 -> alloc_entry(CacheDb, CurSize, TM, trunc(Size * 0.1) + 1); - [{cache_size, Size}] when Size =< 0 -> + Size when Size =< 0 -> false; - _ -> + _Size -> true end. diff --git a/lib/kernel/src/inet_hosts.erl b/lib/kernel/src/inet_hosts.erl index fc653bf0d3..6dce48cf42 100644 --- a/lib/kernel/src/inet_hosts.erl +++ b/lib/kernel/src/inet_hosts.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2018. All Rights Reserved. +%% Copyright Ericsson AB 1997-2020. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -41,12 +41,10 @@ gethostbyname(_) -> {error, formerr}. gethostbyname(Name, Type) when is_list(Name), is_atom(Type) -> %% Byname has lowercased names while Byaddr keep the name casing. %% This is to be able to reconstruct the original /etc/hosts entry. - N = inet_db:tolower(Name), - case gethostbyname(N, Type, inet_hosts_byname, inet_hosts_byaddr) of + Nm = inet_db:tolower(Name), + case gethostbyname(Nm, Type, inet_hosts_byname) of false -> - case gethostbyname(N, Type, - inet_hosts_file_byname, - inet_hosts_file_byaddr) of + case gethostbyname(Nm, Type, inet_hosts_file_byname) of false -> {error,nxdomain}; Hostent -> {ok,Hostent} end; @@ -56,15 +54,12 @@ gethostbyname(Name, Type) when is_atom(Name), is_atom(Type) -> gethostbyname(atom_to_list(Name), Type); gethostbyname(_, _) -> {error, formerr}. -gethostbyname(Name, Type, Byname, Byaddr) -> +gethostbyname(Nm, Type, Byname) -> inet_db:res_update_hosts(), - case [I || [I] <- ets:match(Byname, {Name,Type,'$1'})] of + case ets:lookup(Byname, {Type, Nm}) of [] -> false; - [IP|_]=IPs -> - %% Use the primary IP address to generate aliases - [Nm|As] = [N || [N] <- ets:match(Byaddr, - {'$1',Type,IP})], - make_hostent(Nm, IPs, As, Type) + [{_, IPs, [Primary | Aliases]}] -> + make_hostent(Primary, IPs, Aliases, Type) end. @@ -97,13 +92,12 @@ gethostbyaddr(IP, Type) -> gethostbyaddr(IP, Type, Byaddr) -> inet_db:res_update_hosts(), - case [N || [N] <- ets:match(Byaddr, {'$1',Type,IP})] of + case ets:lookup(Byaddr, {Type, IP}) of [] -> false; - [Nm|As] -> make_hostent(Nm, [IP], As, Type) + [{_, [Primary | Aliases]}] -> make_hostent(Primary, [IP], Aliases, Type) end. - make_hostent(Name, Addrs, Aliases, inet) -> #hostent { h_name = Name, diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 35c0c3f88e..f7f6a3b497 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -36,6 +36,7 @@ erl_distribution, erl_reply, erl_signal_handler, + erpc, error_handler, error_logger, file, @@ -103,6 +104,7 @@ inet_tcp, inet_udp, inet_sctp, + pg, pg2, raw_file_io, raw_file_io_compressed, @@ -143,12 +145,14 @@ ddll_server, erl_epmd, inet_db, + pg, pg2]}, {applications, []}, {env, [{logger_level, notice}, - {logger_sasl_compatible, false} + {logger_sasl_compatible, false}, + {shell_docs_ansi,auto} ]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-10.6", "stdlib-3.5", "sasl-3.0"]} + {runtime_dependencies, ["erts-@OTP-15251@", "stdlib-@OTP-15251@", "sasl-3.0"]} ] }. diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl index 8877ceea8e..83f3fbecd5 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -64,7 +64,7 @@ config_change(Changed, New, Removed) -> %%% (file,code, | erl_dist (A)| | safe_sup (1)| %%% rpc, ...) ------------- ------------- %%% | | -%%% (net_kernel, (disk_log, pg2, +%%% (net_kernel, (disk_log, pg, %%% auth, ...) ...) %%% %%% The rectangular boxes are supervisors. All supervisors except @@ -180,7 +180,7 @@ init(safe) -> Boot = start_boot_server(), DiskLog = start_disk_log(), - Pg2 = start_pg2(), + Pg = start_pg2() ++ start_pg(), %% Run the on_load handlers for all modules that have been %% loaded so far. Running them at this point means that @@ -188,7 +188,7 @@ init(safe) -> %% (and in particular call code:priv_dir/1 or code:lib_dir/1). init:run_on_load_handlers(), - {ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}. + {ok, {SupFlags, Boot ++ DiskLog ++ Pg}}. start_distribution() -> Rpc = #{id => rex, @@ -279,6 +279,19 @@ start_disk_log() -> [] end. +start_pg() -> + case application:get_env(kernel, start_pg) of + {ok, true} -> + [#{id => pg, + start => {pg, start_link, []}, + restart => permanent, + shutdown => 1000, + type => worker, + modules => [pg]}]; + _ -> + [] + end. + start_pg2() -> case application:get_env(kernel, start_pg2) of {ok, true} -> diff --git a/lib/kernel/src/logger.erl b/lib/kernel/src/logger.erl index fd02cf67bf..e51407f482 100644 --- a/lib/kernel/src/logger.erl +++ b/lib/kernel/src/logger.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2017-2018. All Rights Reserved. +%% Copyright Ericsson AB 2017-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -256,9 +256,8 @@ log(Level, FunOrFormat, Args, Metadata) -> -spec allow(Level,Module) -> boolean() when Level :: level(), Module :: module(). -allow(Level,Module) when ?IS_LEVEL(Level), is_atom(Module) -> - logger_config:allow(?LOGGER_TABLE,Level,Module). - +allow(Level,Module) when is_atom(Module) -> + logger_config:allow(Level,Module). -spec macro_log(Location,Level,StringOrReport) -> ok when Location :: location(), @@ -571,8 +570,8 @@ set_application_level(App,Level) -> {error, {not_loaded, App}} end. --spec unset_application_level(Application) -> ok | {error, not_loaded} when - Application :: atom(). +-spec unset_application_level(Application) -> + ok | {error, {not_loaded, Application}} when Application :: atom(). unset_application_level(App) -> case application:get_key(App, modules) of {ok, Modules} -> @@ -595,7 +594,7 @@ get_module_level(Modules) when is_list(Modules) -> Module :: module(), Level :: level() | all | none. get_module_level() -> - logger_config:get_module_level(?LOGGER_TABLE). + logger_config:get_module_level(). %%%----------------------------------------------------------------- %%% Misc @@ -1027,14 +1026,14 @@ get_logger_env(App) -> %%%----------------------------------------------------------------- %%% Internal do_log(Level,Msg,#{mfa:={Module,_,_}}=Meta) -> - case logger_config:allow(?LOGGER_TABLE,Level,Module) of + case logger_config:allow(Level,Module) of true -> log_allowed(#{},Level,Msg,Meta); false -> ok end; do_log(Level,Msg,Meta) -> - case logger_config:allow(?LOGGER_TABLE,Level) of + case logger_config:allow(Level) of true -> log_allowed(#{},Level,Msg,Meta); false -> @@ -1051,7 +1050,7 @@ do_log(Level,Msg,Meta) -> Meta :: metadata(). log_allowed(Location,Level,{Fun,FunArgs},Meta) when is_function(Fun,1) -> try Fun(FunArgs) of - Msg={Format,Args} when is_list(Format), is_list(Args) -> + Msg={Format,Args} when ?IS_FORMAT(Format), is_list(Args) -> log_allowed(Location,Level,Msg,Meta); Report when ?IS_REPORT(Report) -> log_allowed(Location,Level,Report,Meta); @@ -1086,7 +1085,7 @@ log_allowed(Location,Level,Msg,Meta0) when is_map(Meta0) -> do_log_allowed(Level,{Format,Args}=Msg,Meta,Tid) when ?IS_LEVEL(Level), - is_list(Format), + ?IS_FORMAT(Format), is_list(Args), is_map(Meta) -> logger_backend:log_allowed(#{level=>Level,msg=>Msg,meta=>Meta},Tid); diff --git a/lib/kernel/src/logger_backend.erl b/lib/kernel/src/logger_backend.erl index 432c671afd..7003d2268e 100644 --- a/lib/kernel/src/logger_backend.erl +++ b/lib/kernel/src/logger_backend.erl @@ -56,6 +56,7 @@ call_handlers(#{level:=Level}=Log,[Id|Handlers],Tid) -> error,{removed_failing_handler,Id}), ?LOG_INTERNAL( debug, + Log1, [{logger,removed_failing_handler}, {handler,{Id,Module}}, {log_event,Log1}, @@ -68,6 +69,7 @@ call_handlers(#{level:=Level}=Log,[Id|Handlers],Tid) -> {error,Reason} -> ?LOG_INTERNAL( debug, + Log1, [{logger,remove_handler_failed}, {reason,Reason}]) end @@ -119,6 +121,7 @@ handle_filter_failed({Id,_}=Filter,Owner,Log,Reason) -> ok -> logger:internal_log(error,{removed_failing_filter,Id}), ?LOG_INTERNAL(debug, + Log, [{logger,removed_failing_filter}, {filter,Filter}, {owner,Owner}, diff --git a/lib/kernel/src/logger_config.erl b/lib/kernel/src/logger_config.erl index af8ebfd4e9..4495790c30 100644 --- a/lib/kernel/src/logger_config.erl +++ b/lib/kernel/src/logger_config.erl @@ -21,120 +21,142 @@ -export([new/1,delete/2, exist/2, - allow/2,allow/3, + allow/1,allow/2, get/2, get/3, create/3, set/3, - set_module_level/3,unset_module_level/2, - get_module_level/1,cache_module_level/2, + set_module_level/2,unset_module_level/1, + get_module_level/0, level_to_int/1]). -include("logger_internal.hrl"). +-compile({inline,[get_primary_level/0,level_to_int/1]}). + +-define(LEVEL_TO_CACHE(Level),Level + 16#10). +-define(PRIMARY_TO_CACHE(Level),Level). +-define(IS_CACHED(Level),(Level =< ?LOG_ALL)). +-define(CACHE_TO_LEVEL(Level),if ?IS_CACHED(Level) -> Level; true -> Level - 16#10 end). + +-define(IS_MODULE(Module),is_atom(Module) andalso Module =/= ?PRIMARY_KEY). + new(Name) -> _ = ets:new(Name,[set,protected,named_table, {read_concurrency,true}, {write_concurrency,true}]), ets:whereis(Name). -delete(Tid,Id) -> - ets:delete(Tid,table_key(Id)). - -allow(Tid,Level,Module) -> - LevelInt = level_to_int(Level), - try ets:lookup(Tid,Module) of - [{Module,{ModLevel,cached}}] when is_integer(ModLevel), - LevelInt =< ModLevel -> - true; - [{Module,ModLevel}] when is_integer(ModLevel), - LevelInt =< ModLevel -> - true; - [] -> - logger_server:cache_module_level(Module), - allow(Tid,Level); - _ -> - false - catch error:badarg -> - true - end. - -allow(Tid,Level) -> - try ets:lookup_element(Tid,?PRIMARY_KEY,2) of - GlobalLevelInt -> - level_to_int(Level) =< GlobalLevelInt - catch error:badarg -> - true - end. +delete(Tid,What) -> + persistent_term:put({?MODULE,table_key(What)},undefined), + ets:delete(Tid,table_key(What)). + +%% Optimized for speed. +allow(Level,Module) -> + ModLevel = + case persistent_term:get({?MODULE,Module},undefined) of + undefined -> + %% This is where the module cache takes place. We insert the module level + %% plus 16 into the pt and then when looking it up we need to do a check + %% and subtraction. + %% The reason why we do this dance and not just wrap it all in a tuple + %% is because updates of immediates (i.e. small ints in this case) + %% is cheap even in pt, so we cannot put any complex terms in there. + IntLevel = get_primary_level(), + persistent_term:put({?MODULE,Module},?PRIMARY_TO_CACHE(IntLevel)), + IntLevel; + IntLevel -> + ?CACHE_TO_LEVEL(IntLevel) + end, + less_or_equal_level(Level,ModLevel). + +allow(Level) -> + PrimaryLevelInt = get_primary_level(), + less_or_equal_level(Level,PrimaryLevelInt). + +less_or_equal_level(emergency,ModLevel) -> ?EMERGENCY =< ModLevel; +less_or_equal_level(alert,ModLevel) -> ?ALERT =< ModLevel; +less_or_equal_level(critical,ModLevel) -> ?CRITICAL =< ModLevel; +less_or_equal_level(error,ModLevel) -> ?ERROR =< ModLevel; +less_or_equal_level(warning,ModLevel) -> ?WARNING =< ModLevel; +less_or_equal_level(notice,ModLevel) -> ?NOTICE =< ModLevel; +less_or_equal_level(info,ModLevel) -> ?INFO =< ModLevel; +less_or_equal_level(debug,ModLevel) -> ?DEBUG =< ModLevel. exist(Tid,What) -> ets:member(Tid,table_key(What)). +get_primary_level() -> + persistent_term:get({?MODULE,?PRIMARY_KEY},?NOTICE). + get(Tid,What) -> case ets:lookup(Tid,table_key(What)) of - [{_,_,Config}] -> - {ok,Config}; - [{_,Config}] when What=:=proxy -> + [{_,Config}] -> {ok,Config}; [] -> {error,{not_found,What}} end. get(Tid,What,Level) -> - MS = [{{table_key(What),'$1','$2'}, - [{'>=','$1',level_to_int(Level)}], - ['$2']}], - case ets:select(Tid,MS) of - [] -> error; - [Data] -> {ok,Data} + TableKey = table_key(What), + case persistent_term:get({?MODULE,TableKey},undefined) of + undefined -> + %% The handler is not installed at the moment + {error,{not_found,What}}; + ConfLevel -> + case less_or_equal_level(Level,ConfLevel) of + true -> + get(Tid, What); + false -> + error + end end. create(Tid,proxy,Config) -> ets:insert(Tid,{table_key(proxy),Config}); create(Tid,What,Config) -> LevelInt = level_to_int(maps:get(level,Config)), - ets:insert(Tid,{table_key(What),LevelInt,Config}). + ok = persistent_term:put({?MODULE,table_key(What)}, LevelInt), + ets:insert(Tid,{table_key(What),Config}). set(Tid,proxy,Config) -> ets:insert(Tid,{table_key(proxy),Config}), ok; set(Tid,What,Config) -> LevelInt = level_to_int(maps:get(level,Config)), - %% Should do this only if the level has actually changed. Possibly - %% overwrite instead of delete? + ok = persistent_term:put({?MODULE,table_key(What)}, LevelInt), case What of primary -> - _ = ets:select_delete(Tid,[{{'_',{'$1',cached}}, - [{'=/=','$1',LevelInt}], - [true]}]), + [persistent_term:put(Key,?PRIMARY_TO_CACHE(LevelInt)) + || {{?MODULE,Module} = Key,Level} <- persistent_term:get(), + ?IS_MODULE(Module), ?IS_CACHED(Level)], ok; _ -> ok end, - ets:update_element(Tid,table_key(What),[{2,LevelInt},{3,Config}]), + ets:insert(Tid,{table_key(What),Config}), ok. -set_module_level(Tid,Modules,Level) -> +set_module_level(Modules,Level) -> LevelInt = level_to_int(Level), - [ets:insert(Tid,{Module,LevelInt}) || Module <- Modules], + [persistent_term:put({?MODULE,Module},?LEVEL_TO_CACHE(LevelInt)) || Module <- Modules], ok. -%% should possibly overwrite instead of delete? -unset_module_level(Tid,all) -> - MS = [{{'$1','$2'},[{is_atom,'$1'},{is_integer,'$2'}],[true]}], - _ = ets:select_delete(Tid,MS), +%% We overwrite instead of delete because that is more efficient +%% when using persistent_term +unset_module_level(all) -> + PrimaryLevel = get_primary_level(), + [persistent_term:put(Key, ?PRIMARY_TO_CACHE(PrimaryLevel)) + || {{?MODULE, Module} = Key,_} <- persistent_term:get(), ?IS_MODULE(Module)], ok; -unset_module_level(Tid,Modules) -> - [ets:delete(Tid,Module) || Module <- Modules], +unset_module_level(Modules) -> + PrimaryLevel = get_primary_level(), + [persistent_term:put({?MODULE,Module}, ?PRIMARY_TO_CACHE(PrimaryLevel)) || Module <- Modules], ok. -get_module_level(Tid) -> - MS = [{{'$1','$2'},[{is_atom,'$1'},{is_integer,'$2'}],[{{'$1','$2'}}]}], - Modules = ets:select(Tid,MS), - lists:sort([{M,int_to_level(L)} || {M,L} <- Modules]). - -cache_module_level(Tid,Module) -> - GlobalLevelInt = ets:lookup_element(Tid,?PRIMARY_KEY,2), - ets:insert_new(Tid,{Module,{GlobalLevelInt,cached}}), - ok. +get_module_level() -> + lists:sort( + [{Module,int_to_level(?CACHE_TO_LEVEL(Level))} + || {{?MODULE, Module},Level} <- persistent_term:get(), + ?IS_MODULE(Module), not ?IS_CACHED(Level)]). level_to_int(none) -> ?LOG_NONE; level_to_int(emergency) -> ?EMERGENCY; diff --git a/lib/kernel/src/logger_formatter.erl b/lib/kernel/src/logger_formatter.erl index 8696adbd72..0a145b16d5 100644 --- a/lib/kernel/src/logger_formatter.erl +++ b/lib/kernel/src/logger_formatter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2017-2018. All Rights Reserved. +%% Copyright Ericsson AB 2017-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -323,7 +323,7 @@ timestamp_to_datetimemicro(SysTime,Config) when is_integer(SysTime) -> {Date,Time,Micro,UtcStr}. format_mfa({M,F,A},_) when is_atom(M), is_atom(F), is_integer(A) -> - atom_to_list(M)++":"++atom_to_list(F)++"/"++integer_to_list(A); + io_lib:fwrite("~tw:~tw/~w", [M, F, A]); format_mfa({M,F,A},Config) when is_atom(M), is_atom(F), is_list(A) -> format_mfa({M,F,length(A)},Config); format_mfa(MFA,Config) -> diff --git a/lib/kernel/src/logger_h_common.erl b/lib/kernel/src/logger_h_common.erl index 16946ff97c..fb150d181b 100644 --- a/lib/kernel/src/logger_h_common.erl +++ b/lib/kernel/src/logger_h_common.erl @@ -392,26 +392,26 @@ do_log_to_binary(Log,Config) -> String = try_format(Log,Formatter,FormatterConfig), try string_to_binary(String) catch C2:R2:S2 -> - ?LOG_INTERNAL(debug,[{formatter_error,Formatter}, - {config,FormatterConfig}, - {log_event,Log}, - {bad_return_value,String}, - {catched,{C2,R2,S2}}]), - <<"FORMATTER ERROR: bad return value">> + ?LOG_INTERNAL(debug,Log,[{formatter_error,Formatter}, + {config,FormatterConfig}, + {log_event,Log}, + {bad_return_value,String}, + {catched,{C2,R2,S2}}]), + <<"FORMATTER ERROR: bad return value\n">> end. try_format(Log,Formatter,FormatterConfig) -> try Formatter:format(Log,FormatterConfig) catch C:R:S -> - ?LOG_INTERNAL(debug,[{formatter_crashed,Formatter}, - {config,FormatterConfig}, - {log_event,Log}, - {reason, - {C,R,logger:filter_stacktrace(?MODULE,S)}}]), + ?LOG_INTERNAL(debug,Log,[{formatter_crashed,Formatter}, + {config,FormatterConfig}, + {log_event,Log}, + {reason, + {C,R,logger:filter_stacktrace(?MODULE,S)}}]), case {?DEFAULT_FORMATTER,#{}} of {Formatter,FormatterConfig} -> - "DEFAULT FORMATTER CRASHED"; + "DEFAULT FORMATTER CRASHED\n"; {DefaultFormatter,DefaultConfig} -> try_format(Log#{msg=>{"FORMATTER CRASH: ~tp", [maps:get(msg,Log)]}}, diff --git a/lib/kernel/src/logger_handler_watcher.erl b/lib/kernel/src/logger_handler_watcher.erl index b75c74c643..6f622b169c 100644 --- a/lib/kernel/src/logger_handler_watcher.erl +++ b/lib/kernel/src/logger_handler_watcher.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018. All Rights Reserved. +%% Copyright Ericsson AB 2018-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -51,42 +51,25 @@ register_handler(Id,Pid) -> %%% gen_server callbacks %%%=================================================================== --spec init(Args :: term()) -> {ok, State :: term()} | - {ok, State :: term(), Timeout :: timeout()} | - {ok, State :: term(), hibernate} | - {stop, Reason :: term()} | - ignore. +-spec init(Args :: term()) -> {ok, State :: term()}. init([]) -> process_flag(trap_exit, true), {ok, #state{handlers=[]}}. -spec handle_call(Request :: term(), From :: {pid(), term()}, State :: term()) -> - {reply, Reply :: term(), NewState :: term()} | - {reply, Reply :: term(), NewState :: term(), Timeout :: timeout()} | - {reply, Reply :: term(), NewState :: term(), hibernate} | - {noreply, NewState :: term()} | - {noreply, NewState :: term(), Timeout :: timeout()} | - {noreply, NewState :: term(), hibernate} | - {stop, Reason :: term(), Reply :: term(), NewState :: term()} | - {stop, Reason :: term(), NewState :: term()}. + {reply, ok, NewState :: term()}. handle_call({register,Id,Pid}, _From, #state{handlers=Hs}=State) -> Ref = erlang:monitor(process,Pid), Hs1 = lists:keystore(Id,1,Hs,{Id,Ref}), {reply, ok, State#state{handlers=Hs1}}. -spec handle_cast(Request :: term(), State :: term()) -> - {noreply, NewState :: term()} | - {noreply, NewState :: term(), Timeout :: timeout()} | - {noreply, NewState :: term(), hibernate} | - {stop, Reason :: term(), NewState :: term()}. + {noreply, NewState :: term()}. handle_cast(_Request, State) -> {noreply, State}. -spec handle_info(Info :: timeout() | term(), State :: term()) -> - {noreply, NewState :: term()} | - {noreply, NewState :: term(), Timeout :: timeout()} | - {noreply, NewState :: term(), hibernate} | - {stop, Reason :: normal | term(), NewState :: term()}. + {noreply, NewState :: term()}. handle_info({'DOWN',Ref,process,_,shutdown}, #state{handlers=Hs}=State) -> case lists:keytake(Ref,2,Hs) of {value,{Id,Ref},Hs1} -> @@ -108,6 +91,6 @@ handle_info(_Other,State) -> {noreply,State}. -spec terminate(Reason :: normal | shutdown | {shutdown, term()} | term(), - State :: term()) -> any(). + State :: term()) -> ok. terminate(_Reason, _State) -> ok. diff --git a/lib/kernel/src/logger_internal.hrl b/lib/kernel/src/logger_internal.hrl index c2b2d419e7..0a5c4c944f 100644 --- a/lib/kernel/src/logger_internal.hrl +++ b/lib/kernel/src/logger_internal.hrl @@ -41,14 +41,14 @@ -define(DEFAULT_LOGGER_CALL_TIMEOUT, infinity). --define(LOG_INTERNAL(Level,Report),?DO_LOG_INTERNAL(Level,[Report])). --define(LOG_INTERNAL(Level,Format,Args),?DO_LOG_INTERNAL(Level,[Format,Args])). --define(DO_LOG_INTERNAL(Level,Data), +-define(LOG_INTERNAL(Level,Log,Report), + ?DO_LOG_INTERNAL(Level,Log,[Report])). +-define(LOG_INTERNAL(Level,Log,Format,Args), + ?DO_LOG_INTERNAL(Level,Log,[Format,Args])). +-define(DO_LOG_INTERNAL(Level,Log,Data), case logger:allow(Level,?MODULE) of true -> - %% Spawn this to avoid deadlocks - _ = spawn(logger,macro_log,[?LOCATION,Level|Data]++ - [logger:add_default_metadata(#{})]), + _ = logger_server:do_internal_log(Level,?LOCATION,Log,Data), ok; false -> ok @@ -91,7 +91,7 @@ -define(IS_LEVEL_ALL(L), ?IS_LEVEL(L) orelse L=:=all orelse - L=:=none ). + L=:=none ). -define(IS_MSG(Msg), ((is_tuple(Msg) andalso tuple_size(Msg)==2) @@ -107,3 +107,6 @@ -define(IS_STRING(String), (is_list(String) orelse is_binary(String))). + +-define(IS_FORMAT(Format), + (?IS_STRING(Format) orelse is_atom(Format))). diff --git a/lib/kernel/src/logger_olp.erl b/lib/kernel/src/logger_olp.erl index 8365383fe2..cf9b480341 100644 --- a/lib/kernel/src/logger_olp.erl +++ b/lib/kernel/src/logger_olp.erl @@ -77,7 +77,7 @@ load({_Name,Pid,ModeRef},Msg) -> %% synchronous instead of asynchronous (slows down the tempo of a %% process causing much load). If the process is choked, drop mode %% is set and no message is sent. - try ?get_mode(ModeRef) of + case get_mode(ModeRef) of async -> gen_server:cast(Pid, {'$olp_load',Msg}); sync -> @@ -86,17 +86,11 @@ load({_Name,Pid,ModeRef},Msg) -> ok; _Other -> %% dropped or {error,busy} - ?observe(_Name,{dropped,1}), - ok + ?observe(_Name,{dropped,1}) end; drop -> ?observe(_Name,{dropped,1}) - catch - %% if the ETS table doesn't exist (maybe because of a - %% process restart), we can only drop the event - _:_ -> ?observe(_Name,{dropped,1}) - end, - ok. + end. -spec info(Olp) -> map() | {error, busy} when Olp :: atom() | pid() | olp_ref(). @@ -147,8 +141,8 @@ restart(Fun) -> catch C:R:S -> {error,{restart_failed,Fun,C,R,S}} end, - ?LOG_INTERNAL(debug,[{logger_olp,restart}, - {result,Result}]), + ?LOG_INTERNAL(debug,#{},[{logger_olp,restart}, + {result,Result}]), ok. -spec get_ref() -> olp_ref(). @@ -174,40 +168,32 @@ init([Name,Module,Args,Options]) -> ?start_observation(Name), - try ets:new(Name, [public]) of - ModeRef -> - OlpRef = {Name,self(),ModeRef}, - put(olp_ref,OlpRef), - try Module:init(Args) of - {ok,CBState} -> - ?set_mode(ModeRef, async), - T0 = ?timestamp(), - proc_lib:init_ack({ok,self(),OlpRef}), - %% Storing options in state to avoid copying - %% (sending) the option data with each message - State0 = ?merge_with_stats( - Options#{id => Name, - idle=> true, - module => Module, - mode_ref => ModeRef, - mode => async, - last_qlen => 0, - last_load_ts => T0, - burst_win_ts => T0, - burst_msg_count => 0, - cb_state => CBState}), - State = reset_restart_flag(State0), - gen_server:enter_loop(?MODULE, [], State); - Error -> - _ = ets:delete(ModeRef), - unregister(Name), - proc_lib:init_ack(Error) - catch - _:Error -> - _ = ets:delete(ModeRef), - unregister(Name), - proc_lib:init_ack(Error) - end + ModeRef = {?MODULE, Name}, + OlpRef = {Name,self(),ModeRef}, + put(olp_ref,OlpRef), + try Module:init(Args) of + {ok,CBState} -> + set_mode(ModeRef, async), + T0 = ?timestamp(), + proc_lib:init_ack({ok,self(),OlpRef}), + %% Storing options in state to avoid copying + %% (sending) the option data with each message + State0 = ?merge_with_stats( + Options#{id => Name, + idle=> true, + module => Module, + mode_ref => ModeRef, + mode => async, + last_qlen => 0, + last_load_ts => T0, + burst_win_ts => T0, + burst_msg_count => 0, + cb_state => CBState}), + State = reset_restart_flag(State0), + gen_server:enter_loop(?MODULE, [], State); + Error -> + unregister(Name), + proc_lib:init_ack(Error) catch _:Error -> unregister(Name), @@ -274,11 +260,11 @@ handle_cast(Msg, #{module:=Module, cb_state:=CBState} = State) -> {stop, Reason, State#{cb_state=>CBState1}} end. -handle_info(timeout, #{mode_ref:=_ModeRef, mode:=Mode} = State) -> +handle_info(timeout, #{mode_ref:=ModeRef} = State) -> State1 = notify(idle,State), State2 = maybe_notify_mode_change(async,State1), {noreply, State2#{idle => true, - mode => ?change_mode(_ModeRef, Mode, async), + mode => set_mode(ModeRef, async), burst_msg_count => 0}}; handle_info(Msg, #{module := Module, cb_state := CBState} = State) -> case try_callback_call(Module,handle_info,[Msg, CBState]) of @@ -357,7 +343,7 @@ do_load(Msg, CallOrCast, State) -> %% this function is called by do_load/3 after an overload check %% has been performed, where QLen > FlushQLen -flush(T1, State=#{id := _Name, mode := Mode, last_load_ts := _T0, mode_ref := ModeRef}) -> +flush(T1, State=#{id := _Name, last_load_ts := _T0, mode_ref := ModeRef}) -> %% flush load messages in the mailbox (a limited number in order %% to not cause long delays) NewFlushed = flush_load(?FLUSH_MAX_N), @@ -378,7 +364,7 @@ flush(T1, State=#{id := _Name, mode := Mode, last_load_ts := _T0, mode_ref := Mo State3 = ?update_max_qlen(QLen1,State2), State4 = maybe_notify_mode_change(async,State3), {dropped,?update_other(flushed,FLUSHED,NewFlushed, - State4#{mode => ?change_mode(ModeRef,Mode,async), + State4#{mode => set_mode(ModeRef,async), last_qlen => QLen1, last_load_ts => T1})}. @@ -507,11 +493,11 @@ check_load(State = #{id:=_Name, mode_ref := ModeRef, mode := Mode, %% be dropped on the client side (never sent to %% the olp process). IncDrops = if Mode == drop -> 0; true -> 1 end, - {?change_mode(ModeRef, Mode, drop), IncDrops,0}; + {set_mode(ModeRef, drop), IncDrops,0}; QLen >= SyncModeQLen -> - {?change_mode(ModeRef, Mode, sync), 0,0}; + {set_mode(ModeRef, sync), 0,0}; true -> - {?change_mode(ModeRef, Mode, async), 0,0} + {set_mode(ModeRef, async), 0,0} end, State1 = ?update_other(drops,DROPS,_NewDrops,State), State2 = ?update_max_qlen(QLen,State1), @@ -576,7 +562,7 @@ flush_load(N, Limit) -> {log,_,_,_,_} -> flush_load(N+1, Limit); {log,_,_,_} -> - flush_load(N+1, Limit) + flush_load(N+1, Limit) after 0 -> N end. @@ -587,6 +573,11 @@ overload_levels_ok(Options) -> FQL = maps:get(flush_qlen, Options, ?FLUSH_QLEN), (DMQL > 1) andalso (SMQL =< DMQL) andalso (DMQL =< FQL). +get_mode(Ref) -> persistent_term:get(Ref, async). + +set_mode(Ref, M) -> + true = is_atom(M), persistent_term:put(Ref, M), M. + maybe_notify_mode_change(drop,#{mode:=Mode0}=State) when Mode0=/=drop -> notify({mode_change,Mode0,drop},State); diff --git a/lib/kernel/src/logger_olp.hrl b/lib/kernel/src/logger_olp.hrl index d68b5c048d..5ee3f4dd1c 100644 --- a/lib/kernel/src/logger_olp.hrl +++ b/lib/kernel/src/logger_olp.hrl @@ -72,25 +72,8 @@ -define(timestamp(), erlang:monotonic_time(microsecond)). --define(get_mode(Tid), - case ets:lookup(Tid, mode) of - [{mode,M}] -> M; - _ -> async - end). - --define(set_mode(Tid, M), - begin ets:insert(Tid, {mode,M}), M end). - --define(change_mode(Tid, M0, M1), - if M0 == M1 -> - M0; - true -> - ets:insert(Tid, {mode,M1}), - M1 - end). - -define(max(X1, X2), - if + if X2 == undefined -> X1; X2 > X1 -> X2; true -> X1 diff --git a/lib/kernel/src/logger_proxy.erl b/lib/kernel/src/logger_proxy.erl index 6ab8e3e4c5..ead2d74f37 100644 --- a/lib/kernel/src/logger_proxy.erl +++ b/lib/kernel/src/logger_proxy.erl @@ -151,13 +151,13 @@ notify({mode_change,Mode0,Mode1},State) -> true -> ok end, - ?LOG_INTERNAL(notice,"~w switched from ~w to ~w mode",[?MODULE,Mode0,Mode1]), + ?LOG_INTERNAL(notice,#{},"~w switched from ~w to ~w mode",[?MODULE,Mode0,Mode1]), State; notify({flushed,Flushed},State) -> - ?LOG_INTERNAL(notice, "~w flushed ~w log events",[?MODULE,Flushed]), + ?LOG_INTERNAL(notice,#{},"~w flushed ~w log events",[?MODULE,Flushed]), State; notify(restart,State) -> - ?LOG_INTERNAL(notice, "~w restarted", [?MODULE]), + ?LOG_INTERNAL(notice,#{},"~w restarted", [?MODULE]), State; notify(_Note,State) -> State. @@ -167,7 +167,7 @@ notify(_Note,State) -> try_log(Args) -> try apply(logger,log,Args) catch C:R:S -> - ?LOG_INTERNAL(debug,[{?MODULE,log_failed}, - {log,Args}, - {reason,{C,R,S}}]) + ?LOG_INTERNAL(debug,#{},[{?MODULE,log_failed}, + {log,Args}, + {reason,{C,R,S}}]) end. diff --git a/lib/kernel/src/logger_server.erl b/lib/kernel/src/logger_server.erl index 722246e82c..fbf3b48d9b 100644 --- a/lib/kernel/src/logger_server.erl +++ b/lib/kernel/src/logger_server.erl @@ -25,13 +25,13 @@ -export([start_link/0, add_handler/3, remove_handler/1, add_filter/2, remove_filter/2, set_module_level/2, unset_module_level/0, - unset_module_level/1, cache_module_level/1, + unset_module_level/1, set_config/2, set_config/3, update_config/2, update_config/3, update_formatter_config/2]). %% Helper --export([diff_maps/2]). +-export([diff_maps/2,do_internal_log/4]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, @@ -104,9 +104,6 @@ unset_module_level(Modules) when is_list(Modules) -> unset_module_level(Modules) -> {error,{not_a_list_of_modules,Modules}}. -cache_module_level(Module) -> - gen_server:cast(?SERVER,{cache_module_level,Module}). - set_config(Owner,Key,Value) -> case sanity_check(Owner,Key,Value) of ok -> @@ -325,18 +322,15 @@ handle_call({update_formatter_config,HandlerId,NewFConfig},_From, {error,{not_found,HandlerId}} end, {reply,Reply,State}; -handle_call({set_module_level,Modules,Level}, _From, #state{tid=Tid}=State) -> - Reply = logger_config:set_module_level(Tid,Modules,Level), +handle_call({set_module_level,Modules,Level}, _From, State) -> + Reply = logger_config:set_module_level(Modules,Level), {reply,Reply,State}; -handle_call({unset_module_level,Modules}, _From, #state{tid=Tid}=State) -> - Reply = logger_config:unset_module_level(Tid,Modules), +handle_call({unset_module_level,Modules}, _From, State) -> + Reply = logger_config:unset_module_level(Modules), {reply,Reply,State}. handle_cast({async_req_reply,_Ref,_Reply} = Reply,State) -> - call_h_reply(Reply,State); -handle_cast({cache_module_level,Module}, #state{tid=Tid}=State) -> - logger_config:cache_module_level(Tid,Module), - {noreply, State}. + call_h_reply(Reply,State). %% Interface for those who can't call the API - e.g. the emulator, or %% places related to code loading. @@ -359,12 +353,14 @@ handle_info(Unexpected,State) when element(1,Unexpected) == 'EXIT' -> %% The simple handler will send an 'EXIT' message when it is replaced %% We may as well ignore all 'EXIT' messages that we get ?LOG_INTERNAL(debug, + #{}, [{logger,got_unexpected_message}, {process,?SERVER}, {message,Unexpected}]), {noreply,State}; handle_info(Unexpected,State) -> ?LOG_INTERNAL(info, + #{}, [{logger,got_unexpected_message}, {process,?SERVER}, {message,Unexpected}]), @@ -550,6 +546,7 @@ call_h(Module, Function, Args, DefRet) -> _ -> ST = logger:filter_stacktrace(?MODULE,S), ?LOG_INTERNAL(error, + #{}, [{logger,callback_crashed}, {process,?SERVER}, {reason,{C,R,ST}}]), @@ -592,6 +589,7 @@ call_h_reply({'DOWN',Ref,_Proc,Pid,Reason}, #state{ async_req = {Ref,_PostFun,_F %% to the spawned process. It is only here to make sure that the logger_server does %% not deadlock if that happens. ?LOG_INTERNAL(error, + #{}, [{logger,process_exited}, {process,Pid}, {reason,Reason}]), @@ -600,6 +598,7 @@ call_h_reply({'DOWN',Ref,_Proc,Pid,Reason}, #state{ async_req = {Ref,_PostFun,_F State); call_h_reply(Unexpected,State) -> ?LOG_INTERNAL(info, + #{}, [{logger,got_unexpected_message}, {process,?SERVER}, {message,Unexpected}]), @@ -615,3 +614,18 @@ diffs([{K,V1}|T1],[{K,V2}|T2],D1,D2) -> diffs(T1,T2,D1#{K=>V1},D2#{K=>V2}); diffs([],[],D1,D2) -> {D1,D2}. + +do_internal_log(Level,Location,Log,[Report] = Data) -> + do_internal_log(Level,Location,Log,Data,{report,Report}); +do_internal_log(Level,Location,Log,[Fmt,Args] = Data) -> + do_internal_log(Level,Location,Log,Data,{Fmt,Args}). +do_internal_log(Level,Location,Log,Data,Msg) -> + Meta = logger:add_default_metadata(maps:merge(Location,maps:get(meta,Log,#{}))), + %% Spawn these to avoid deadlocks + case Log of + #{ meta := #{ internal_log_event := true } } -> + _ = spawn(logger_simple_h,log,[#{level=>Level,msg=>Msg,meta=>Meta},#{}]); + _ -> + _ = spawn(logger,macro_log,[Location,Level|Data]++ + [Meta#{internal_log_event=>true}]) + end. diff --git a/lib/kernel/src/logger_simple_h.erl b/lib/kernel/src/logger_simple_h.erl index a0d51dba25..72dfe8a899 100644 --- a/lib/kernel/src/logger_simple_h.erl +++ b/lib/kernel/src/logger_simple_h.erl @@ -61,15 +61,20 @@ log(#{meta:=#{error_logger:=#{tag:=info_report,type:=Type}}},_Config) %% Skip info reports that are not 'std_info' (ref simple logger in %% error_logger) ok; -log(#{msg:=_,meta:=#{time:=_}}=Log,_Config) -> +log(#{msg:=_,meta:=#{time:=_}=M}=Log,_Config) -> _ = case whereis(?MODULE) of undefined -> %% Is the node on the way down? Real emergency? %% Log directly from client just to get it out - do_log( - #{level=>error, - msg=>{report,{error,simple_handler_process_dead}}, - meta=>#{time=>logger:timestamp()}}), + case maps:get(internal_log_event, M, false) of + false -> + do_log( + #{level=>error, + msg=>{report,{error,simple_handler_process_dead}}, + meta=>#{time=>logger:timestamp()}}); + true -> + ok + end, do_log(Log); _ -> ?MODULE ! {log,Log} diff --git a/lib/kernel/src/logger_std_h.erl b/lib/kernel/src/logger_std_h.erl index 6641d99776..dbbd6fbc1f 100644 --- a/lib/kernel/src/logger_std_h.erl +++ b/lib/kernel/src/logger_std_h.erl @@ -330,13 +330,22 @@ open_log_file(HandlerName,#{type:=file, end. close_log_file(#{fd:=Fd}) -> - _ = file:datasync(Fd), + _ = file:datasync(Fd), %% file:datasync may return error as it will flush the delayed_write buffer _ = file:close(Fd), ok; close_log_file(_) -> ok. - +%% A special close that closes the FD properly when the delayed write close failed +delayed_write_close(#{fd:=Fd}) -> + case file:close(Fd) of + %% We got an error while closing, could be a delayed write failing + %% So we close again in order to make sure the file is closed. + {error, _} -> + file:close(Fd); + Res -> + Res + end. %%%----------------------------------------------------------------- %%% File control process @@ -556,10 +565,9 @@ maybe_rotate_file(AddSize,#{rotation:=#{size:=RotSize, maybe_rotate_file(_Bin,State) -> State. -rotate_file(#{fd:=Fd0,file_name:=FileName,modes:=Modes,rotation:=Rotation}=State) -> +rotate_file(#{file_name:=FileName,modes:=Modes,rotation:=Rotation}=State) -> State1 = sync_dev(State), - _ = file:close(Fd0), - _ = file:close(Fd0), + _ = delayed_write_close(State), rotate_files(FileName,maps:get(count,Rotation),maps:get(compress,Rotation)), case file:open(FileName,Modes) of {ok,Fd} -> diff --git a/lib/kernel/src/net.erl b/lib/kernel/src/net.erl index fcc78d6971..aceb903bb6 100644 --- a/lib/kernel/src/net.erl +++ b/lib/kernel/src/net.erl @@ -69,12 +69,12 @@ ]). --deprecated({call, 4, eventually}). --deprecated({cast, 4, eventually}). --deprecated({broadcast, 3, eventually}). --deprecated({ping, 1, eventually}). --deprecated({relay, 1, eventually}). --deprecated({sleep, 1, eventually}). +-deprecated({call, 4, "use rpc:call/4 instead"}). +-deprecated({cast, 4, "use rpc:cast/4 instead"}). +-deprecated({broadcast, 3, "use rpc:eval_everywhere/3 instead"}). +-deprecated({ping, 1, "use net_adm:ping/1 instead"}). +-deprecated({relay, 1, "use slave:relay/1 instead"}). +-deprecated({sleep, 1, "use 'receive after T -> ok end' instead"}). -type ifaddrs_flag() :: up | broadcast | debug | loopback | pointopoint | diff --git a/lib/kernel/src/pg.erl b/lib/kernel/src/pg.erl new file mode 100644 index 0000000000..0668dd1f79 --- /dev/null +++ b/lib/kernel/src/pg.erl @@ -0,0 +1,507 @@ +%% +%% +%% Copyright WhatsApp Inc. and its affiliates. All rights reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% +%%------------------------------------------------------------------- +%% +%% @author Maxim Fedorov <maximfca@gmail.com> +%% Process Groups with eventually consistent membership. +%% +%% Differences (compared to pg2): +%% * non-existent and empty group treated the same (empty list of pids), +%% thus create/1 and delete/1 have no effect (and not implemented). +%% which_groups() return only non-empty groups +%% * no cluster lock required, and no dependency on global +%% * all join/leave operations require local process (it's not possible to join +%% a process from a different node) +%% * multi-join: join/leave several processes with a single call +%% +%% Why empty groups are not supported: +%% Unlike a process, group does not have originating node. So it's possible +%% that during net split one node deletes the group, that still exists for +%% another partition. pg2 will recover the group, as soon as net +%% split converges, which is quite unexpected. +%% +%% Exchange protocol: +%% * when pg process starts, it broadcasts +%% 'discover' message to all nodes in the cluster +%% * when pg server receives 'discover', it responds with 'sync' message +%% containing list of groups with all local processes, and starts to +%% monitor process that sent 'discover' message (assuming it is a part +%% of an overlay network) +%% * every pg process monitors 'nodeup' messages to attempt discovery for +%% nodes that are (re)joining the cluster +%% +%% Leave/join operations: +%% * processes joining the group are monitored on the local node +%% * when process exits (without leaving groups prior to exit), local +%% instance of pg scoped process detects this and sends 'leave' to +%% all nodes in an overlay network (no remote monitoring done) +%% * all leave/join operations are serialised through pg server process +%% +-module(pg). + +%% API: default scope +-export([ + start_link/0, + + join/2, + leave/2, + get_members/1, + get_local_members/1, + which_groups/0, + which_local_groups/0 +]). + +%% Scoped API: overlay networks +-export([ + start/1, + start_link/1, + + join/3, + leave/3, + get_members/2, + get_local_members/2, + which_groups/1, + which_local_groups/1 +]). + +%% gen_server callbacks +-export([ + init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2 +]). + +%% Types +-type group() :: any(). + +%% Default scope started by kernel app +-define(DEFAULT_SCOPE, ?MODULE). + +%%-------------------------------------------------------------------- +%% @doc +%% Starts the server and links it to calling process. +%% Uses default scope, which is the same as as the module name. +-spec start_link() -> {ok, pid()} | {error, any()}. +start_link() -> + start_link(?DEFAULT_SCOPE). + +%% @doc +%% Starts the server outside of supervision hierarchy. +-spec start(Scope :: atom()) -> {ok, pid()} | {error, any()}. +start(Scope) when is_atom(Scope) -> + gen_server:start({local, Scope}, ?MODULE, [Scope], []). + +%% @doc +%% Starts the server and links it to calling process. +%% Scope name is supplied. +-spec start_link(Scope :: atom()) -> {ok, pid()} | {error, any()}. +start_link(Scope) when is_atom(Scope) -> + gen_server:start_link({local, Scope}, ?MODULE, [Scope], []). + +%%-------------------------------------------------------------------- +%% @doc +%% Joins a single process +%% Group is created automatically. +%% Process must be local to this node. +-spec join(Group :: group(), PidOrPids :: pid() | [pid()]) -> ok. +join(Group, PidOrPids) -> + join(?DEFAULT_SCOPE, Group, PidOrPids). + +-spec join(Scope :: atom(), Group :: group(), PidOrPids :: pid() | [pid()]) -> ok. +join(Scope, Group, PidOrPids) -> + Node = node(), + is_list(PidOrPids) andalso [error({nolocal, Pid}) || Pid <- PidOrPids, node(Pid) =/= Node orelse not is_pid(Pid)], + gen_server:call(Scope, {join_local, Group, PidOrPids}, infinity). + +%%-------------------------------------------------------------------- +%% @doc +%% Single process leaving the group. +%% Process must be local to this node. +-spec leave(Group :: group(), PidOrPids :: pid() | [pid()]) -> ok. +leave(Group, PidOrPids) -> + leave(?DEFAULT_SCOPE, Group, PidOrPids). + +-spec leave(Scope :: atom(), Group :: group(), Pid :: pid() | [pid()]) -> ok | not_joined. +leave(Scope, Group, PidOrPids) -> + Node = node(), + is_list(PidOrPids) andalso [error({nolocal, Pid}) || Pid <- PidOrPids, node(Pid) =/= Node orelse not is_pid(Pid)], + gen_server:call(Scope, {leave_local, Group, PidOrPids}, infinity). + +%%-------------------------------------------------------------------- +%% @doc +%% Returns all processes in a group +-spec get_members(Group :: group()) -> [pid()]. +get_members(Group) -> + get_members(?DEFAULT_SCOPE, Group). + +-spec get_members(Scope :: atom(), Group :: group()) -> [pid()]. +get_members(Scope, Group) -> + try + ets:lookup_element(Scope, Group, 2) + catch + error:badarg -> + [] + end. + +%%-------------------------------------------------------------------- +%% @doc +%% Returns processes in a group, running on local node. +-spec get_local_members(Group :: group()) -> [pid()]. +get_local_members(Group) -> + get_local_members(?DEFAULT_SCOPE, Group). + +-spec get_local_members(Scope :: atom(), Group :: group()) -> [pid()]. +get_local_members(Scope, Group) -> + try + ets:lookup_element(Scope, Group, 3) + catch + error:badarg -> + [] + end. + +%%-------------------------------------------------------------------- +%% @doc +%% Returns a list of all known groups. +-spec which_groups() -> [Group :: group()]. +which_groups() -> + which_groups(?DEFAULT_SCOPE). + +-spec which_groups(Scope :: atom()) -> [Group :: group()]. +which_groups(Scope) when is_atom(Scope) -> + [G || [G] <- ets:match(Scope, {'$1', '_', '_'})]. + +%%-------------------------------------------------------------------- +%% @private +%% Returns a list of groups that have any local processes joined. +-spec which_local_groups() -> [Group :: group()]. +which_local_groups() -> + which_local_groups(?DEFAULT_SCOPE). + +-spec which_local_groups(Scope :: atom()) -> [Group :: group()]. +which_local_groups(Scope) when is_atom(Scope) -> + ets:select(Scope, [{{'$1', '_', '$2'}, [{'=/=', '$2', []}], ['$1']}]). + +%%-------------------------------------------------------------------- +%% Internal implementation + +%% gen_server implementation +-record(state, { + %% ETS table name, and also the registered process name (self()) + scope :: atom(), + %% monitored local processes and groups they joined + monitors = #{} :: #{pid() => {MRef :: reference(), Groups :: [group()]}}, + %% remote node: scope process monitor and map of groups to pids for fast sync routine + nodes = #{} :: #{pid() => {reference(), #{group() => [pid()]}}} +}). + +-type state() :: #state{}. + +-spec init([Scope :: atom()]) -> {ok, state()}. +init([Scope]) -> + ok = net_kernel:monitor_nodes(true), + %% discover all nodes in the cluster + broadcast([{Scope, Node} || Node <- nodes()], {discover, self()}), + Scope = ets:new(Scope, [set, protected, named_table, {read_concurrency, true}]), + {ok, #state{scope = Scope}}. + +-spec handle_call(Call :: {join_local, Group :: group(), Pid :: pid()} + | {leave_local, Group :: group(), Pid :: pid()}, + From :: {pid(),Tag :: any()}, + State :: state()) -> {reply, ok | not_joined, state()}. + +handle_call({join_local, Group, PidOrPids}, _From, #state{scope = Scope, monitors = Monitors, nodes = Nodes} = State) -> + NewMons = join_monitors(PidOrPids, Group, Monitors), + join_local_group(Scope, Group, PidOrPids), + broadcast(maps:keys(Nodes), {join, self(), Group, PidOrPids}), + {reply, ok, State#state{monitors = NewMons}}; + +handle_call({leave_local, Group, PidOrPids}, _From, #state{scope = Scope, monitors = Monitors, nodes = Nodes} = State) -> + case leave_monitors(PidOrPids, Group, Monitors) of + Monitors -> + {reply, not_joined, State}; + NewMons -> + leave_local_group(Scope, Group, PidOrPids), + broadcast(maps:keys(Nodes), {leave, self(), PidOrPids, [Group]}), + {reply, ok, State#state{monitors = NewMons}} + end; + +handle_call(_Request, _From, _S) -> + error(badarg). + +-spec handle_cast( + {sync, Peer :: pid(), Groups :: [{group(), [pid()]}]}, + State :: state()) -> {noreply, state()}. + +handle_cast({sync, Peer, Groups}, #state{scope = Scope, nodes = Nodes} = State) -> + {noreply, State#state{nodes = handle_sync(Scope, Peer, Nodes, Groups)}}; + +handle_cast(_, _State) -> + error(badarg). + +-spec handle_info( + {discover, Peer :: pid()} | + {join, Peer :: pid(), group(), pid() | [pid()]} | + {leave, Peer :: pid(), pid() | [pid()], [group()]} | + {'DOWN', reference(), process, pid(), term()} | + {nodedown, node()} | {nodeup, node()}, State :: state()) -> {noreply, state()}. + +%% remote pid or several pids joining the group +handle_info({join, Peer, Group, PidOrPids}, #state{scope = Scope, nodes = Nodes} = State) -> + join_remote(Scope, Group, PidOrPids), + % store remote group => pids map for fast sync operation + {MRef, RemoteGroups} = maps:get(Peer, Nodes), + NewRemoteGroups = join_remote_map(Group, PidOrPids, RemoteGroups), + {noreply, State#state{nodes = Nodes#{Peer => {MRef, NewRemoteGroups}}}}; + +%% remote pid leaving (multiple groups at once) +handle_info({leave, Peer, PidOrPids, Groups}, #state{scope = Scope, nodes = Nodes} = State) -> + _ = leave_remote(Scope, PidOrPids, Groups), + {MRef, RemoteMap} = maps:get(Peer, Nodes), + NewRemoteMap = lists:foldl( + fun (Group, Acc) -> + case maps:get(Group, Acc) of + PidOrPids -> + Acc; + [PidOrPids] -> + Acc; + Existing when is_pid(PidOrPids) -> + Acc#{Group => lists:delete(PidOrPids, Existing)}; + Existing -> + Acc#{Group => Existing-- PidOrPids} + end + end, RemoteMap, Groups), + {noreply, State#state{nodes = Nodes#{Peer => {MRef, NewRemoteMap}}}}; + +%% we're being discovered, let's exchange! +handle_info({discover, Peer}, #state{scope = Scope, nodes = Nodes} = State) -> + gen_server:cast(Peer, {sync, self(), all_local_pids(Scope)}), + %% do we know who is looking for us? + case maps:is_key(Peer, Nodes) of + true -> + {noreply, State}; + false -> + MRef = monitor(process, Peer), + erlang:send(Peer, {discover, self()}, [noconnect]), + {noreply, State#state{nodes = Nodes#{Peer => {MRef, #{}}}}} + end; + +%% handle local process exit +handle_info({'DOWN', MRef, process, Pid, _Info}, #state{scope = Scope, monitors = Monitors, nodes = Nodes} = State) when node(Pid) =:= node() -> + case maps:take(Pid, Monitors) of + error -> + %% this can only happen when leave request and 'DOWN' are in pg queue + {noreply, State}; + {{MRef, Groups}, NewMons} -> + [leave_local_group(Scope, Group, Pid) || Group <- Groups], + %% send update to all nodes + broadcast(maps:keys(Nodes), {leave, self(), Pid, Groups}), + {noreply, State#state{monitors = NewMons}} + end; + +%% handle remote node down or leaving overlay network +handle_info({'DOWN', MRef, process, Pid, _Info}, #state{scope = Scope, nodes = Nodes} = State) -> + {{MRef, RemoteMap}, NewNodes} = maps:take(Pid, Nodes), + _ = maps:map(fun (Group, Pids) -> leave_remote(Scope, Pids, [Group]) end, RemoteMap), + {noreply, State#state{nodes = NewNodes}}; + +%% nodedown: ignore, and wait for 'DOWN' signal for monitored process +handle_info({nodedown, _Node}, State) -> + {noreply, State}; + +%% nodeup: discover if remote node participates in the overlay network +handle_info({nodeup, Node}, #state{scope = Scope} = State) -> + {Scope, Node} ! {discover, self()}, + {noreply, State}; + +handle_info(_Info, _State) -> + error(badarg). + +-spec terminate(Reason :: any(), State :: state()) -> true. +terminate(_Reason, #state{scope = Scope}) -> + true = ets:delete(Scope). + +%%-------------------------------------------------------------------- +%% Internal implementation + +%% Override all knowledge of the remote node with information it sends +%% to local node. Current implementation must do the full table scan +%% to remove stale pids (just as for 'nodedown'). +handle_sync(Scope, Peer, Nodes, Groups) -> + %% can't use maps:get() because it evaluates 'default' value first, + %% and in this case monitor() call has side effect. + {MRef, RemoteGroups} = + case maps:find(Peer, Nodes) of + error -> + {monitor(process, Peer), #{}}; + {ok, MRef0} -> + MRef0 + end, + %% sync RemoteMap and transform ETS table + _ = sync_groups(Scope, RemoteGroups, Groups), + Nodes#{Peer => {MRef, maps:from_list(Groups)}}. + +sync_groups(Scope, RemoteGroups, []) -> + %% leave all missing groups + [leave_remote(Scope, Pids, [Group]) || {Group, Pids} <- maps:to_list(RemoteGroups)]; +sync_groups(Scope, RemoteGroups, [{Group, Pids} | Tail]) -> + case maps:take(Group, RemoteGroups) of + {Pids, NewRemoteGroups} -> + sync_groups(Scope, NewRemoteGroups, Tail); + {OldPids, NewRemoteGroups} -> + [{Group, AllOldPids, LocalPids}] = ets:lookup(Scope, Group), + %% should be really rare... + AllNewPids = Pids ++ AllOldPids -- OldPids, + true = ets:insert(Scope, {Group, AllNewPids, LocalPids}), + sync_groups(Scope, NewRemoteGroups, Tail); + error -> + join_remote(Scope, Group, Pids), + sync_groups(Scope, RemoteGroups, Tail) + end. + +join_monitors(Pid, Group, Monitors) when is_pid(Pid) -> + case maps:find(Pid, Monitors) of + {ok, {MRef, Groups}} -> + maps:put(Pid, {MRef, [Group | Groups]}, Monitors); + error -> + MRef = erlang:monitor(process, Pid), + Monitors#{Pid => {MRef, [Group]}} + end; +join_monitors([], _Group, Monitors) -> + Monitors; +join_monitors([Pid | Tail], Group, Monitors) -> + join_monitors(Tail, Group, join_monitors(Pid, Group, Monitors)). + +join_local_group(Scope, Group, Pid) when is_pid(Pid) -> + case ets:lookup(Scope, Group) of + [{Group, All, Local}] -> + ets:insert(Scope, {Group, [Pid | All], [Pid | Local]}); + [] -> + ets:insert(Scope, {Group, [Pid], [Pid]}) + end; +join_local_group(Scope, Group, Pids) -> + case ets:lookup(Scope, Group) of + [{Group, All, Local}] -> + ets:insert(Scope, {Group, Pids ++ All, Pids ++ Local}); + [] -> + ets:insert(Scope, {Group, Pids, Pids}) + end. + +join_remote(Scope, Group, Pid) when is_pid(Pid) -> + case ets:lookup(Scope, Group) of + [{Group, All, Local}] -> + ets:insert(Scope, {Group, [Pid | All], Local}); + [] -> + ets:insert(Scope, {Group, [Pid], []}) + end; +join_remote(Scope, Group, Pids) -> + case ets:lookup(Scope, Group) of + [{Group, All, Local}] -> + ets:insert(Scope, {Group, Pids ++ All, Local}); + [] -> + ets:insert(Scope, {Group, Pids, []}) + end. + +join_remote_map(Group, Pid, RemoteGroups) when is_pid(Pid) -> + maps:update_with(Group, fun (List) -> [Pid | List] end, [Pid], RemoteGroups); +join_remote_map(Group, Pids, RemoteGroups) -> + maps:update_with(Group, fun (List) -> Pids ++ List end, Pids, RemoteGroups). + +leave_monitors(Pid, Group, Monitors) when is_pid(Pid) -> + case maps:find(Pid, Monitors) of + {ok, {MRef, [Group]}} -> + erlang:demonitor(MRef), + maps:remove(Pid, Monitors); + {ok, {MRef, Groups}} -> + case lists:member(Group, Groups) of + true -> + maps:put(Pid, {MRef, lists:delete(Group, Groups)}, Monitors); + false -> + Monitors + end; + _ -> + Monitors + end; +leave_monitors([], _Group, Monitors) -> + Monitors; +leave_monitors([Pid | Tail], Group, Monitors) -> + leave_monitors(Tail, Group, leave_monitors(Pid, Group, Monitors)). + +leave_local_group(Scope, Group, Pid) when is_pid(Pid) -> + case ets:lookup(Scope, Group) of + [{Group, [Pid], [Pid]}] -> + ets:delete(Scope, Group); + [{Group, All, Local}] -> + ets:insert(Scope, {Group, lists:delete(Pid, All), lists:delete(Pid, Local)}); + [] -> + %% rare race condition when 'DOWN' from monitor stays in msg queue while process is leave-ing. + true + end; +leave_local_group(Scope, Group, Pids) -> + case ets:lookup(Scope, Group) of + [{Group, All, Local}] -> + case All -- Pids of + [] -> + ets:delete(Scope, Group); + NewAll -> + ets:insert(Scope, {Group, NewAll, Local -- Pids}) + end; + [] -> + true + end. + +leave_remote(Scope, Pid, Groups) when is_pid(Pid) -> + _ = [ + case ets:lookup(Scope, Group) of + [{Group, [Pid], []}] -> + ets:delete(Scope, Group); + [{Group, All, Local}] -> + ets:insert(Scope, {Group, lists:delete(Pid, All), Local}); + [] -> + true + end || + Group <- Groups]; +leave_remote(Scope, Pids, Groups) -> + _ = [ + case ets:lookup(Scope, Group) of + [{Group, All, Local}] -> + case All -- Pids of + [] when Local =:= [] -> + ets:delete(Scope, Group); + NewAll -> + ets:insert(Scope, {Group, NewAll, Local}) + end; + [] -> + true + end || + Group <- Groups]. + +all_local_pids(Scope) -> + %% selector: ets:fun2ms(fun({N,_,L}) when L =/=[] -> {N,L}end). + ets:select(Scope, [{{'$1','_','$2'},[{'=/=','$2',[]}],[{{'$1','$2'}}]}]). + +%% Works as gen_server:abcast(), but accepts a list of processes +%% instead of nodes list. +broadcast([], _Msg) -> + ok; +broadcast([Dest | Tail], Msg) -> + %% do not use 'nosuspend', as it will lead to missing + %% join/leave messages when dist buffer is full + erlang:send(Dest, Msg, [noconnect]), + broadcast(Tail, Msg). diff --git a/lib/kernel/src/pg2.erl b/lib/kernel/src/pg2.erl index c4732f37ee..d02bbeccdf 100644 --- a/lib/kernel/src/pg2.erl +++ b/lib/kernel/src/pg2.erl @@ -25,6 +25,10 @@ -export([start/0,start_link/0,init/1,handle_call/3,handle_cast/2,handle_info/2, terminate/2]). +-deprecated([{'_','_', + "the 'pg2' module is deprecated and scheduled for removal " + "in OTP 24; use 'pg' instead."}]). + %%% As of R13B03 monitors are used instead of links. %%% diff --git a/lib/kernel/src/raw_file_io_compressed.erl b/lib/kernel/src/raw_file_io_compressed.erl index f6ac6eaffc..1a6de3a4eb 100644 --- a/lib/kernel/src/raw_file_io_compressed.erl +++ b/lib/kernel/src/raw_file_io_compressed.erl @@ -21,7 +21,8 @@ -export([close/1, sync/1, datasync/1, truncate/1, advise/4, allocate/3, position/2, write/2, pwrite/2, pwrite/3, - read_line/1, read/2, pread/2, pread/3]). + read_line/1, read/2, pread/2, pread/3, + read_handle_info/2]). %% OTP internal. -export([ipread_s32bu_p32bu/3, sendfile/8]). @@ -118,6 +119,9 @@ ipread_s32bu_p32bu(Fd, Offset, MaxSize) -> sendfile(_,_,_,_,_,_,_,_) -> {error, enotsup}. +read_handle_info(Fd, Opts) -> + wrap_call(Fd, [Opts]). + wrap_call(Fd, Command) -> {_Owner, Pid} = get_fd_data(Fd), try gen_statem:call(Pid, Command, infinity) of diff --git a/lib/kernel/src/raw_file_io_delayed.erl b/lib/kernel/src/raw_file_io_delayed.erl index 5644717aaa..f9b89270f1 100644 --- a/lib/kernel/src/raw_file_io_delayed.erl +++ b/lib/kernel/src/raw_file_io_delayed.erl @@ -23,7 +23,8 @@ -export([close/1, sync/1, datasync/1, truncate/1, advise/4, allocate/3, position/2, write/2, pwrite/2, pwrite/3, - read_line/1, read/2, pread/2, pread/3]). + read_line/1, read/2, pread/2, pread/3, + read_handle_info/2]). %% OTP internal. -export([ipread_s32bu_p32bu/3, sendfile/8]). @@ -304,6 +305,9 @@ ipread_s32bu_p32bu(Fd, Offset, MaxSize) -> sendfile(_,_,_,_,_,_,_,_) -> {error, enotsup}. +read_handle_info(Fd, Opts) -> + wrap_call(Fd, [Opts]). + wrap_call(Fd, Command) -> #{ pid := Pid } = get_fd_data(Fd), try gen_statem:call(Pid, Command, infinity) of diff --git a/lib/kernel/src/raw_file_io_list.erl b/lib/kernel/src/raw_file_io_list.erl index 2e16e63f0e..e4fe434e13 100644 --- a/lib/kernel/src/raw_file_io_list.erl +++ b/lib/kernel/src/raw_file_io_list.erl @@ -21,7 +21,8 @@ -export([close/1, sync/1, datasync/1, truncate/1, advise/4, allocate/3, position/2, write/2, pwrite/2, pwrite/3, - read_line/1, read/2, pread/2, pread/3]). + read_line/1, read/2, pread/2, pread/3, + read_handle_info/2]). %% OTP internal. -export([ipread_s32bu_p32bu/3, sendfile/8]). @@ -126,3 +127,7 @@ sendfile(Fd, Dest, Offset, Bytes, ChunkSize, Headers, Trailers, Flags) -> Args = [Dest, Offset, Bytes, ChunkSize, Headers, Trailers, Flags], PrivateFd = Fd#file_descriptor.data, ?CALL_FD(PrivateFd, sendfile, Args). + +read_handle_info(Fd, Opts) -> + PrivateFd = Fd#file_descriptor.data, + ?CALL_FD(PrivateFd, read_handle_info, [Opts]). diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl index d197de942f..22893b3468 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.erl @@ -19,6 +19,8 @@ %% -module(rpc). +%% -define(SERVER_SIDE_ERPC_IS_MANDATORY, yes). + %% General rpc, broadcast,multicall, promise and parallel evaluator %% facility @@ -26,6 +28,7 @@ %% a separate module. -define(NAME, rex). +-define(TAB_NAME, rex_nodes_observer). -behaviour(gen_server). @@ -61,12 +64,23 @@ -export_type([key/0]). +%% Removed functions + +-removed([{safe_multi_server_call,2,"use rpc:multi_server_call/2 instead"}, + {safe_multi_server_call,3,"use rpc:multi_server_call/3 instead"}]). + %%------------------------------------------------------------------------ -type state() :: map(). %%------------------------------------------------------------------------ +-define(MAX_INT_TIMEOUT, 4294967295). +-define(TIMEOUT_TYPE, 0..?MAX_INT_TIMEOUT | 'infinity'). +-define(IS_VALID_TMO_INT(TI_), (is_integer(TI_) + andalso (0 =< TI_) + andalso (TI_ =< ?MAX_INT_TIMEOUT))). +-define(IS_VALID_TMO(T_), ((T_ == infinity) orelse ?IS_VALID_TMO_INT(T_))). %% The rex server may receive a huge amount of %% messages. Make sure that they are stored off heap to @@ -101,7 +115,7 @@ stop(Rpc) -> init([]) -> process_flag(trap_exit, true), - {ok, maps:new()}. + {ok, #{nodes_observer => start_nodes_observer()}}. -spec handle_call(term(), term(), state()) -> {'noreply', state()} | @@ -113,13 +127,23 @@ handle_call({call, Mod, Fun, Args, Gleader}, To, S) -> handle_call({block_call, Mod, Fun, Args, Gleader}, _To, S) -> MyGL = group_leader(), set_group_leader(Gleader), - Reply = - case catch apply(Mod,Fun,Args) of - {'EXIT', _} = Exit -> - {badrpc, Exit}; - Other -> - Other - end, + Reply = try + {return, Return} = erpc:execute_call(Mod, Fun, Args), + Return + catch + throw:Result -> + Result; + exit:Reason -> + {'EXIT', Reason}; + error:Reason:Stack -> + case erpc:is_arg_error(Reason, Mod, Fun, Args) of + true -> + {'EXIT', Reason}; + false -> + RpcStack = erpc:trim_stack(Stack, Mod, Fun, Args), + {'EXIT', {Reason, RpcStack}} + end + end, group_leader(MyGL, self()), % restore {reply, Reply, S}; handle_call(stop, _To, S) -> @@ -140,6 +164,8 @@ handle_cast(_, S) -> -spec handle_info(term(), state()) -> {'noreply', state()}. +handle_info({'DOWN', M, process, P, _}, #{nodes_observer := {P,M}} = S) -> + {noreply, S#{nodes_observer => start_nodes_observer()}}; handle_info({'DOWN', _, process, Caller, normal}, S) -> {noreply, maps:remove(Caller, S)}; handle_info({'DOWN', _, process, Caller, Reason}, S) -> @@ -169,6 +195,9 @@ handle_info({From, {send, Name, Msg}}, S) -> handle_info({From, {call,Mod,Fun,Args,Gleader}}, S) -> %% Special for hidden C node's, uugh ... handle_call_call(Mod, Fun, Args, Gleader, {From,?NAME}, S); +handle_info({From, features_request}, S) -> + From ! {features_reply, node(), [erpc]}, + {noreply, S}; handle_info(_, S) -> {noreply, S}. @@ -254,9 +283,72 @@ proxy_user_flush() -> end, proxy_user_flush(). +start_nodes_observer() -> + Init = fun () -> + process_flag(priority, high), + process_flag(trap_exit, true), + Tab = ets:new(?TAB_NAME, + [{read_concurrency, true}, + protected]), + persistent_term:put(?TAB_NAME, Tab), + ok = net_kernel:monitor_nodes(true), + lists:foreach(fun (N) -> + self() ! {nodeup, N} + end, + [node()|nodes()]), + nodes_observer_loop(Tab) + end, + spawn_monitor(Init). + +nodes_observer_loop(Tab) -> + receive + {nodeup, N} -> + {?NAME, N} ! {self(), features_request}; + {nodedown, N} -> + ets:delete(Tab, N); + {features_reply, N, FeatureList} -> + try + SpawnRpc = lists:member(erpc, FeatureList), + ets:insert(Tab, {N, SpawnRpc}) + catch + _:_ -> ets:insert(Tab, {N, false}) + end; + _ -> + ignore + end, + nodes_observer_loop(Tab). + +-dialyzer([{nowarn_function, node_has_feature/2}, no_match]). + +-spec node_has_feature(Node :: atom(), Feature :: term()) -> boolean(). + +node_has_feature(N, erpc) when N == node() -> + true; +node_has_feature(N, erpc) -> + try + Tab = persistent_term:get(?TAB_NAME), + ets:lookup_element(Tab, N, 2) + catch + _:_ -> false + end; +node_has_feature(_N, _Feature) -> + false. %% THE rpc client interface +%% Call + +-define(RPCIFY(ERPC_), + try ERPC_ of + {'EXIT', _} = BadRpc_ -> + {badrpc, BadRpc_}; + Result_ -> + Result_ + catch + Class_:Reason_ -> + callify_exception(Class_, Reason_) + end). + -spec call(Node, Module, Function, Args) -> Res | {badrpc, Reason} when Node :: node(), Module :: module(), @@ -265,10 +357,8 @@ proxy_user_flush() -> Res :: term(), Reason :: term(). -call(N,M,F,A) when node() =:= N -> %% Optimize local call - local_call(M, F, A); call(N,M,F,A) -> - do_call(N, {call,M,F,A,group_leader()}, infinity). + call(N,M,F,A,infinity). -spec call(Node, Module, Function, Args, Timeout) -> Res | {badrpc, Reason} when @@ -278,14 +368,23 @@ call(N,M,F,A) -> Args :: [term()], Res :: term(), Reason :: term(), - Timeout :: timeout(). + Timeout :: ?TIMEOUT_TYPE. -call(N,M,F,A,infinity) when node() =:= N -> %% Optimize local call - local_call(M,F,A); call(N,M,F,A,infinity) -> - do_call(N, {call,M,F,A,group_leader()}, infinity); -call(N,M,F,A,Timeout) when is_integer(Timeout), Timeout >= 0 -> - do_call(N, {call,M,F,A,group_leader()}, Timeout). + case ?RPCIFY(erpc:call(N, M, F, A, infinity)) of + {badrpc, notsup} -> + call_fallback(N, M, F, A, infinity, undefined); + Res -> + Res + end; +call(N,M,F,A,T) when ?IS_VALID_TMO_INT(T) -> + Start = erlang:monotonic_time(), + case ?RPCIFY(erpc:call(N, M, F, A, T)) of + {badrpc, notsup} -> + call_fallback(N, M, F, A, T, Start); + Res -> + Res + end. -spec block_call(Node, Module, Function, Args) -> Res | {badrpc, Reason} when Node :: node(), @@ -295,10 +394,8 @@ call(N,M,F,A,Timeout) when is_integer(Timeout), Timeout >= 0 -> Res :: term(), Reason :: term(). -block_call(N,M,F,A) when node() =:= N -> %% Optimize local call - local_call(M,F,A); block_call(N,M,F,A) -> - do_call(N, {block_call,M,F,A,group_leader()}, infinity). + do_srv_call(N, {block_call,M,F,A,group_leader()}, infinity). -spec block_call(Node, Module, Function, Args, Timeout) -> Res | {badrpc, Reason} when @@ -308,24 +405,58 @@ block_call(N,M,F,A) -> Args :: [term()], Res :: term(), Reason :: term(), - Timeout :: timeout(). - -block_call(N,M,F,A,_Timeout) when node() =:= N -> %% Optimize local call - local_call(M, F, A); -block_call(N,M,F,A,infinity) -> - do_call(N, {block_call,M,F,A,group_leader()}, infinity); -block_call(N,M,F,A,Timeout) when is_integer(Timeout), Timeout >= 0 -> - do_call(N, {block_call,M,F,A,group_leader()}, Timeout). - -local_call(M, F, A) when is_atom(M), is_atom(F), is_list(A) -> - case catch apply(M, F, A) of - {'EXIT',_}=V -> {badrpc, V}; - Other -> Other + Timeout :: ?TIMEOUT_TYPE. + +block_call(N,M,F,A,Timeout) when is_atom(N), + is_atom(M), + is_list(A), + ?IS_VALID_TMO(Timeout) -> + do_srv_call(N, {block_call,M,F,A,group_leader()}, Timeout). + + +%% call() implementation utilizing erpc:call()... + +callify_exception(throw, {'EXIT', _} = BadRpc) -> + {badrpc, BadRpc}; +callify_exception(throw, Return) -> + Return; +callify_exception(exit, {exception, Exit}) -> + {badrpc, {'EXIT', Exit}}; +callify_exception(exit, {signal, Reason}) -> + {badrpc, {'EXIT', Reason}}; +callify_exception(exit, Reason) -> + exit(Reason); +callify_exception(error, {exception, Error, Stack}) -> + {badrpc, {'EXIT', {Error, Stack}}}; +callify_exception(error, {erpc, noconnection}) -> + {badrpc, nodedown}; +callify_exception(error, {erpc, timeout}) -> + {badrpc, timeout}; +callify_exception(error, {erpc, notsup}) -> + {badrpc, notsup}; +callify_exception(error, {erpc, Error}) -> + {badrpc, {'EXIT', Error}}; +callify_exception(error, Reason) -> + error(Reason). + +call_result(Type, ReqId, Res, Reason) -> + ?RPCIFY(erpc:call_result(Type, ReqId, Res, Reason)). + +call_fallback(N, M, F, A, infinity, _S) -> + do_srv_call(N, {call,M,F,A,group_leader()}, infinity); +call_fallback(N, M, F, A, T, S) -> + Now = erlang:monotonic_time(), + Used = erlang:convert_time_unit(Now-S, native, millisecond), + case T - Used of + Timeout when Timeout =< 0 -> + {badrpc, timeout}; + Timeout -> + do_srv_call(N, {call,M,F,A,group_leader()}, Timeout) end. -do_call(Node, Request, infinity) -> +do_srv_call(Node, Request, infinity) -> rpc_check(catch gen_server:call({?NAME,Node}, Request, infinity)); -do_call(Node, Request, Timeout) -> +do_srv_call(Node, Request, Timeout) -> Tag = make_ref(), {Receiver,Mref} = erlang:spawn_monitor( @@ -346,6 +477,7 @@ do_call(Node, Request, Timeout) -> end. rpc_check_t({'EXIT', {timeout,_}}) -> {badrpc, timeout}; +rpc_check_t({'EXIT', {timeout_value,_}}) -> {badrpc, badarg}; rpc_check_t(X) -> rpc_check(X). rpc_check({'EXIT', {{nodedown,_},_}}) -> @@ -395,11 +527,14 @@ server_call(Node, Name, ReplyWrapper, Msg) Function :: atom(), Args :: [term()]. -cast(Node, Mod, Fun, Args) when Node =:= node() -> - catch spawn(Mod, Fun, Args), - true; cast(Node, Mod, Fun, Args) -> - gen_server:cast({?NAME,Node}, {cast,Mod,Fun,Args,group_leader()}), + _ = case node_has_feature(Node, erpc) of + false -> + gen_server:cast({?NAME,Node}, + {cast,Mod,Fun,Args,group_leader()}); + true -> + erpc:cast(Node, Mod, Fun, Args) + end, true. @@ -464,8 +599,11 @@ eval_everywhere(Mod, Fun, Args) -> Args :: [term()]. eval_everywhere(Nodes, Mod, Fun, Args) -> - gen_server:abcast(Nodes, ?NAME, {cast,Mod,Fun,Args,group_leader()}). - + lists:foreach(fun (Node) -> + cast(Node, Mod, Fun, Args) + end, + Nodes), + abcast. send_nodes([Node|Tail], Name, Msg, Monitors) when is_atom(Node) -> Monitor = start_monitor(Node, Name), @@ -489,7 +627,6 @@ start_monitor(Node, Name) -> {Node,erlang:monitor(process, {Name, Node})} end. - %% Call apply(M,F,A) on all nodes in parallel -spec multicall(Module, Function, Args) -> {ResL, BadNodes} when Module :: module(), @@ -512,7 +649,7 @@ multicall(M, F, A) -> Module :: module(), Function :: atom(), Args :: [term()], - Timeout :: timeout(), + Timeout :: ?TIMEOUT_TYPE, ResL :: [Res :: term() | {'badrpc', Reason :: term()}], BadNodes :: [node()]. @@ -527,23 +664,187 @@ multicall(M, F, A, Timeout) -> Module :: module(), Function :: atom(), Args :: [term()], - Timeout :: timeout(), + Timeout :: ?TIMEOUT_TYPE, ResL :: [Res :: term() | {'badrpc', Reason :: term()}], BadNodes :: [node()]. -multicall(Nodes, M, F, A, infinity) - when is_list(Nodes), is_atom(M), is_atom(F), is_list(A) -> - do_multicall(Nodes, M, F, A, infinity); -multicall(Nodes, M, F, A, Timeout) - when is_list(Nodes), is_atom(M), is_atom(F), is_list(A), is_integer(Timeout), - Timeout >= 0 -> +multicall(Nodes, M, F, A, Timeout) when is_list(Nodes), is_atom(M), + is_atom(F), is_list(A), + ?IS_VALID_TMO(Timeout) -> do_multicall(Nodes, M, F, A, Timeout). +mc_requests(_Res, [], _M, _F, _A, ReqMap) -> + ReqMap; +mc_requests(Res, [N|Ns], M, F, A, ReqMap) -> + ReqId = erlang:spawn_request(N, erpc, execute_call, + [Res, M, F, A], + [{reply_tag, {spawn_reply, Res, N}}, + monitor]), + mc_requests(Res, Ns, M, F, A, ReqMap#{N => {spawn_request, ReqId}}). + +mc_spawn_replies(_Res, 0, ReqMap, _MFA, _EndTime) -> + ReqMap; +mc_spawn_replies(Res, Outstanding, ReqMap, MFA, EndTime) -> + Timeout = mc_timeout(EndTime), + receive + {{spawn_reply, Res, _}, _, _, _} = Reply -> + NewReqMap = mc_handle_spawn_reply(Reply, ReqMap, MFA, EndTime), + mc_spawn_replies(Res, Outstanding-1, NewReqMap, MFA, EndTime) + after + Timeout -> + ReqMap + end. + +mc_handle_spawn_reply({{spawn_reply, _Res, Node}, ReqId, ok, Pid}, + ReqMap, _MFA, _EndTime) -> + ReqMap#{Node => {spawn, ReqId, Pid}}; +mc_handle_spawn_reply({{spawn_reply, _Res, Node}, _ReqId, error, notsup}, + ReqMap, MFA, infinity) -> + {M, F, A} = MFA, + SrvReqId = gen_server:send_request({?NAME, Node}, + {call, M,F,A, + group_leader()}), + ReqMap#{Node => {server, SrvReqId}}; +mc_handle_spawn_reply({{spawn_reply, Res, Node}, _ReqId, error, notsup}, + ReqMap, MFA, EndTime) -> + {M, F, A} = MFA, + {Pid, Mon} = spawn_monitor(fun () -> + process_flag(trap_exit, true), + Request = {call, M,F,A, + group_leader()}, + Timeout = mc_timeout(EndTime), + Result = gen_server:call({?NAME, Node}, + Request, + Timeout), + exit({Res, Result}) + end), + ReqMap#{Node => {spawn_server, Mon, Pid}}; +mc_handle_spawn_reply({{spawn_reply, _Res, Node}, _ReqId, error, noconnection}, + ReqMap, _MFA, _EndTime) -> + ReqMap#{Node => {error, badnode}}; +mc_handle_spawn_reply({{spawn_reply, _Res, Node}, _ReqId, error, Reason}, + ReqMap, _MFA, _EndTime) -> + ReqMap#{Node => {error, {badrpc, {'EXIT', Reason}}}}. + +mc_timeout(infinity) -> + infinity; +mc_timeout(EndTime) when is_integer(EndTime) -> + Now = erlang:monotonic_time(), + case erlang:convert_time_unit(EndTime - Now, + native, + millisecond) + 1 of + Ms when Ms >= 0 -> + Ms; + _ -> + 0 + end. + +mc_results(_Res, [], OkAcc, ErrAcc, _ReqMap, _MFA, _EndTime) -> + {lists:reverse(OkAcc), lists:reverse(ErrAcc)}; +mc_results(Res, [N|Ns] = Nodes, OkAcc, ErrAcc, ReqMap, MFA, EndTime) -> + case maps:get(N, ReqMap) of + {error, badnode} -> + mc_results(Res, Ns, OkAcc, [N|ErrAcc], ReqMap, MFA, EndTime); + {error, BadRpc} -> + mc_results(Res, Ns, [BadRpc|OkAcc], ErrAcc, ReqMap, MFA, EndTime); + {spawn_request, ReqId} -> + %% We timed out waiting for spawn replies... + case erlang:spawn_request_abandon(ReqId) of + true -> + %% Timed out request... + mc_results(Res, Ns, OkAcc, [N|ErrAcc], ReqMap, MFA, EndTime); + false -> + %% Reply has been delivered now; handle it... + receive + {{spawn_reply, Res, _}, _, _, _} = Reply -> + NewReqMap = mc_handle_spawn_reply(Reply, ReqMap, MFA, + EndTime), + mc_results(Res, Nodes, OkAcc, ErrAcc, NewReqMap, + MFA, EndTime) + after 0 -> + error(internal_error) + end + end; + {spawn, ReqId, Pid} -> + Timeout = mc_timeout(EndTime), + receive + {'DOWN', ReqId, process, Pid, Reason} -> + case call_result(down, ReqId, Res, Reason) of + {badrpc, nodedown} -> + mc_results(Res, Ns, OkAcc, [N|ErrAcc], ReqMap, + MFA, EndTime); + CallRes -> + mc_results(Res, Ns, [CallRes|OkAcc], ErrAcc, + ReqMap, MFA, EndTime) + end + after + Timeout -> + case erlang:demonitor(ReqId, [info]) of + true -> + mc_results(Res, Ns, OkAcc, [N|ErrAcc], ReqMap, + MFA, EndTime); + false -> + receive + {'DOWN', ReqId, process, Pid, Reason} -> + case call_result(down, ReqId, Res, Reason) of + {badrpc, nodedown} -> + mc_results(Res, Ns, OkAcc, [N|ErrAcc], + ReqMap, MFA, EndTime); + CallRes -> + mc_results(Res, Ns, [CallRes|OkAcc], + ErrAcc, ReqMap, MFA, + EndTime) + end + after 0 -> + error(internal_error) + end + end + end; + {spawn_server, Mon, Pid} -> + %% Old node with timeout on the call... + Result = receive + {'DOWN', Mon, process, Pid, {Res, CallRes}} -> + rpc_check(CallRes); + {'DOWN', Mon, process, Pid, Reason} -> + rpc_check_t({'EXIT',Reason}) + end, + case Result of + {badrpc, BadRpcReason} when BadRpcReason == timeout; + BadRpcReason == nodedown -> + mc_results(Res, Ns, OkAcc, [N|ErrAcc], ReqMap, MFA, EndTime); + _ -> + mc_results(Res, Ns, [Result|OkAcc], ErrAcc, ReqMap, MFA, EndTime) + end; + {server, ReqId} -> + %% Old node without timeout on the call... + case gen_server:wait_response(ReqId, infinity) of + {reply, Reply} -> + Result = rpc_check(Reply), + mc_results(Res, Ns, [Result|OkAcc], ErrAcc, ReqMap, MFA, EndTime); + {error, {noconnection, _}} -> + mc_results(Res, Ns, OkAcc, [N|ErrAcc], ReqMap, MFA, EndTime); + {error, {Reason, _}} -> + BadRpc = {badrpc, {'EXIT', Reason}}, + mc_results(Res, Ns, [BadRpc|OkAcc], ErrAcc, ReqMap, MFA, EndTime) + end + end. + do_multicall(Nodes, M, F, A, Timeout) -> - {Rep,Bad} = gen_server:multi_call(Nodes, ?NAME, - {call, M,F,A, group_leader()}, - Timeout), - {lists:map(fun({_,R}) -> R end, Rep), Bad}. + Res = make_ref(), + EndTime = if Timeout == infinity -> + infinity; + true -> + Now = erlang:monotonic_time(), + Tmo = erlang:convert_time_unit(Timeout, + millisecond, + native), + Now + Tmo + end, + MFA = {M, F, A}, + ReqMap0 = mc_requests(Res, Nodes, M, F, A, #{}), + ReqMap1 = mc_spawn_replies(Res, maps:size(ReqMap0), ReqMap0, + MFA, EndTime), + mc_results(Res, Nodes, [], [], ReqMap1, MFA, EndTime). %% Send Msg to Name on all nodes, and collect the answers. @@ -603,7 +904,75 @@ rec_nodes(Name, [{N,R} | Tail], Badnodes, Replies) -> %% rpc's towards the same node. I.e. it returns immediately and %% it returns a Key that can be used in a subsequent yield(Key). --opaque key() :: pid(). +-ifdef(SERVER_SIDE_ERPC_IS_MANDATORY). + +%% +%% Use this more efficient implementation of async_call() +%% when 'erpc' support can be made mandatory for server +%% side. It should be possible to make it mandatory in +%% OTP 25. +%% + +-opaque key() :: erpc:request_id(). + +-spec async_call(Node, Module, Function, Args) -> Key when + Node :: node(), + Module :: module(), + Function :: atom(), + Args :: [term()], + Key :: key(). + +async_call(Node, Mod, Fun, Args) -> + try + erpc:send_request(Node, Mod, Fun, Args) + catch + error:{erpc, badarg} -> + error(badarg) + end. + +-spec yield(Key) -> Res | {badrpc, Reason} when + Key :: key(), + Res :: term(), + Reason :: term(). + +yield(Key) -> + ?RPCIFY(erpc:receive_response(Key)). + +-spec nb_yield(Key, Timeout) -> {value, Val} | timeout when + Key :: key(), + Timeout :: ?TIMEOUT_TYPE, + Val :: (Res :: term()) | {badrpc, Reason :: term()}. + +nb_yield(Key, Tmo) -> + case ?RPCIFY(erpc:wait_response(Key, Tmo)) of + no_response -> + timeout; + {response, {'EXIT', _} = BadRpc} -> + %% RPCIFY() cannot handle this case... + {value, BadRpc}; + {response, R} -> + {value, R}; + BadRpc -> + %% An exception converted by RPCIFY()... + {value, BadRpc} + end. + +-spec nb_yield(Key) -> {value, Val} | timeout when + Key :: key(), + Val :: (Res :: term()) | {badrpc, Reason :: term()}. + +nb_yield(Key) -> + nb_yield(Key, 0). + +-else. + +%% +%% Currently used implementation for async_call(). When +%% 'erpc' support can be required for async_call() +%% replace with the implementation above... +%% + +-opaque key() :: {pid(), reference()}. -spec async_call(Node, Module, Function, Args) -> Key when Node :: node(), @@ -613,49 +982,59 @@ rec_nodes(Name, [{N,R} | Tail], Badnodes, Replies) -> Key :: key(). async_call(Node, Mod, Fun, Args) -> - ReplyTo = self(), - spawn( - fun() -> - R = call(Node, Mod, Fun, Args), %% proper rpc - ReplyTo ! {self(), {promise_reply, R}} %% self() is key - end). + Caller = self(), + spawn_monitor(fun() -> + process_flag(trap_exit, true), + R = call(Node, Mod, Fun, Args), + exit({call_result, Caller, R}) + end). -spec yield(Key) -> Res | {badrpc, Reason} when Key :: key(), Res :: term(), Reason :: term(). -yield(Key) when is_pid(Key) -> +yield({Pid, Ref} = Key) when is_pid(Pid), + is_reference(Ref) -> {value,R} = do_yield(Key, infinity), R. -spec nb_yield(Key, Timeout) -> {value, Val} | timeout when Key :: key(), - Timeout :: timeout(), + Timeout :: ?TIMEOUT_TYPE, Val :: (Res :: term()) | {badrpc, Reason :: term()}. -nb_yield(Key, infinity=Inf) when is_pid(Key) -> +nb_yield({Pid, Ref} = Key, infinity=Inf) when is_pid(Pid), + is_reference(Ref) -> do_yield(Key, Inf); -nb_yield(Key, Timeout) when is_pid(Key), is_integer(Timeout), Timeout >= 0 -> - do_yield(Key, Timeout). +nb_yield({Pid, Ref} = Key, Tmo) when is_pid(Pid), + is_reference(Ref), + is_integer(Tmo), + Tmo >= 0 -> + do_yield(Key, Tmo). -spec nb_yield(Key) -> {value, Val} | timeout when Key :: key(), Val :: (Res :: term()) | {badrpc, Reason :: term()}. -nb_yield(Key) when is_pid(Key) -> +nb_yield({Pid, Ref} = Key) when is_pid(Pid), + is_reference(Ref) -> do_yield(Key, 0). --spec do_yield(pid(), timeout()) -> {'value', _} | 'timeout'. +-spec do_yield({pid(), reference()}, ?TIMEOUT_TYPE) -> {'value', _} | 'timeout'. -do_yield(Key, Timeout) -> +do_yield({Proxy, Mon}, Tmo) -> + Me = self(), receive - {Key,{promise_reply,R}} -> - {value,R} - after Timeout -> + {'DOWN', Mon, process, Proxy, {call_result, Me, R}} -> + {value,R}; + {'DOWN', Mon, process, Proxy, Reason} -> + {value, {badrpc, {'EXIT', Reason}}} + after Tmo -> timeout end. +-endif. %% A parallel network evaluator %% ArgL === [{M,F,Args},........] diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl index f0bd1fabe9..a9f46126ef 100644 --- a/lib/kernel/src/seq_trace.erl +++ b/lib/kernel/src/seq_trace.erl @@ -20,12 +20,13 @@ -module(seq_trace). --define(SEQ_TRACE_SEND, 1). %(1 << 0) --define(SEQ_TRACE_RECEIVE, 2). %(1 << 1) --define(SEQ_TRACE_PRINT, 4). %(1 << 2) --define(SEQ_TRACE_NOW_TIMESTAMP, 8). %(1 << 3) --define(SEQ_TRACE_STRICT_MON_TIMESTAMP, 16). %(1 << 4) --define(SEQ_TRACE_MON_TIMESTAMP, 32). %(1 << 5) +%% Don't forget to update seq_trace_SUITE after changing these. +-define(SEQ_TRACE_SEND, 1). %(1 << 0) +-define(SEQ_TRACE_RECEIVE, 2). %(1 << 1) +-define(SEQ_TRACE_PRINT, 4). %(1 << 2) +-define(SEQ_TRACE_NOW_TIMESTAMP, 8). %(1 << 3) +-define(SEQ_TRACE_STRICT_MON_TIMESTAMP, 16). %(1 << 4) +-define(SEQ_TRACE_MON_TIMESTAMP, 32). %(1 << 5) -export([set_token/1, set_token/2, @@ -39,7 +40,8 @@ %%--------------------------------------------------------------------------- --type flag() :: 'send' | 'receive' | 'print' | 'timestamp' | 'monotonic_timestamp' | 'strict_monotonic_timestamp'. +-type flag() :: 'send' | 'receive' | 'print' | 'timestamp' | + 'monotonic_timestamp' | 'strict_monotonic_timestamp'. -type component() :: 'label' | 'serial' | flag(). -type value() :: (Label :: term()) | {Previous :: non_neg_integer(), diff --git a/lib/kernel/src/user.erl b/lib/kernel/src/user.erl index 5a3487a9ba..81520dd841 100644 --- a/lib/kernel/src/user.erl +++ b/lib/kernel/src/user.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -537,54 +537,6 @@ get_line_doit(Prompt, Port, Q, Accu, Enc) -> binrev(L, T) -> list_to_binary(lists:reverse(L, T)). -%% is_cr_at(Pos,Bin) -> -%% case Bin of -%% <<_:Pos/binary,$\r,_/binary>> -> -%% true; -%% _ -> -%% false -%% end. - -%% collect_line_bin_re(Bin,_Data,Stack,_) -> -%% case re:run(Bin,<<"\n">>) of -%% nomatch -> -%% X = byte_size(Bin)-1, -%% case is_cr_at(X,Bin) of -%% true -> -%% <<D:X/binary,_/binary>> = Bin, -%% [<<$\r>>,D|Stack]; -%% false -> -%% [Bin|Stack] -%% end; -%% {match,[{Pos,1}]} -> -%% PosPlus = Pos + 1, -%% case Stack of -%% [] -> -%% case is_cr_at(Pos - 1,Bin) of -%% false -> -%% <<Head:PosPlus/binary,Tail/binary>> = Bin, -%% {stop, Head, Tail}; -%% true -> -%% PosMinus = Pos - 1, -%% <<Head:PosMinus/binary,_,_,Tail/binary>> = Bin, -%% {stop, binrev([],[Head,$\n]),Tail} -%% end; -%% [<<$\r>>|Stack1] when Pos =:= 0 -> - -%% <<_:PosPlus/binary,Tail/binary>> = Bin, -%% {stop,binrev(Stack1, [$\n]),Tail}; -%% _ -> -%% case is_cr_at(Pos - 1,Bin) of -%% false -> -%% <<Head:PosPlus/binary,Tail/binary>> = Bin, -%% {stop,binrev(Stack, [Head]),Tail}; -%% true -> -%% PosMinus = Pos - 1, -%% <<Head:PosMinus/binary,_,_,Tail/binary>> = Bin, -%% {stop, binrev(Stack,[Head,$\n]),Tail} -%% end -%% end -%% end. %% get_chars(Prompt, Module, Function, XtraArg, Port, Queue, Encoding) %% Gets characters from the input port until the applied function %% returns {stop,Result,RestBuf}. Does not block output until input @@ -618,9 +570,6 @@ get_chars(Prompt, M, F, Xa, Port, Q, State, Enc) -> {Port, eof} -> put(eof, true), {ok, eof, queue:new()}; - %%{io_request,From,ReplyAs,Request} when is_pid(From) -> - %% get_chars_req(Prompt, M, F, Xa, Port, queue:new(), State, - %% Request, From, ReplyAs); {io_request,From,ReplyAs,{get_geometry,_}=Req} when is_pid(From) -> do_io_request(Req, From, ReplyAs, Port, queue:new()), %Keep Q over this call diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index bd1590ee8f..57fcc74729 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -25,6 +25,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # ---------------------------------------------------- MODULES= \ + erpc_SUITE \ rpc_SUITE \ pdict_SUITE \ bif_SUITE \ @@ -85,6 +86,7 @@ MODULES= \ logger_test_lib \ net_SUITE \ os_SUITE \ + pg_SUITE \ pg2_SUITE \ seq_trace_SUITE \ wrap_log_reader_SUITE \ diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index 1ab554db7c..aebbd7735d 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -39,7 +39,8 @@ distr_changed_tc1/1, distr_changed_tc2/1, ensure_started/1, ensure_all_started/1, shutdown_func/1, do_shutdown/1, shutdown_timeout/1, shutdown_deadlock/1, - config_relative_paths/1]). + config_relative_paths/1, handle_many_config_files/1, + format_log_1/1, format_log_2/1]). -define(TESTCASE, testcase_name). -define(testcase, proplists:get_value(?TESTCASE, Config)). @@ -59,7 +60,7 @@ all() -> set_env, set_env_persistent, set_env_errors, {group, distr_changed}, config_change, shutdown_func, shutdown_timeout, shutdown_deadlock, config_relative_paths, - persistent_env]. + persistent_env, handle_many_config_files, format_log_1, format_log_2]. groups() -> [{reported_bugs, [], @@ -2076,6 +2077,31 @@ persistent_env(Conf) when is_list(Conf) -> %% Clean up ok = application:unload(appinc). + +%% Test more than one config file defined by one -config parameter: +handle_many_config_files(Conf) when is_list(Conf) -> + + %% Write a config file + Dir = proplists:get_value(priv_dir, Conf), + {ok, Fd} = file:open(filename:join(Dir, "sys.config"), [write]), + io:format(Fd, "[].~n", []), + file:close(Fd), + NodeName = node_name(n1, Conf), + Config = filename:join(Dir, "sys"), + + %% Node will be started with two -config + %% First one has one argument and second one has two arguments. + {ok, Node} = start_node( + NodeName, + Config, + " -config " ++ Config ++ " " ++ Config + ), + case rpc:call(Node, init, get_argument, [config]) of + {ok, [[Config], [Config, Config]]} -> ok; + {ok, [[Config], [Config], [Config]]} -> ok %% This happens on windows + end, + stop_node_nice(Node). + %%%----------------------------------------------------------------- %%% Tests the 'shutdown_func' kernel config parameter %%%----------------------------------------------------------------- @@ -3008,6 +3034,188 @@ distr_changed_prep(Conf) when is_list(Conf) -> {value, {kernel, OldKernel}} = lists:keysearch(kernel, 1, OldEnv), {OldKernel, OldEnv, {Cp1, Cp2, Cp3}, {Ncp1, Ncp2, Ncp3}, Config2}. +%% Test report callback for Logger handler error_logger +format_log_1(_Config) -> + FD = application:get_env(kernel, error_logger_format_depth), + application:unset_env(kernel, error_logger_format_depth), + Term = lists:seq(1, 15), + Application = my_application, + Error = exit, + Node = Term, + Report = #{label=>{application_controller,Error}, + report=>[{application,Application}, + {exited,Term}, + {type,Term}]}, + {F1, A1} = application_controller:format_log(Report), + FExpected1 = " application: ~tp~n" + " exited: ~tp~n" + " type: ~tp~n", + ct:log("F1: ~ts~nA1: ~tp", [F1,A1]), + FExpected1 = F1, + [Application,Term,Term] = A1, + + Progress = #{label=>{application_controller,progress}, + report=>[{application,Application},{started_at,Node}]}, + {PF1,PA1} = application_controller:format_log(Progress), + PFExpected1 = " application: ~tp~n started_at: ~tp~n", + ct:log("PF1: ~ts~nPA1: ~tp", [PF1,PA1]), + PFExpected1 = PF1, + [Application,Node] = PA1, + + Depth = 10, + ok = application:set_env(kernel, error_logger_format_depth, Depth), + Limited = [1,2,3,4,5,6,7,8,9,'...'], + {F2,A2} = application_controller:format_log(Report), + FExpected2 = " application: ~tP~n" + " exited: ~tP~n" + " type: ~tP~n", + ct:log("F2: ~ts~nA2: ~tp", [F2,A2]), + FExpected2 = F2, + Limited = [1,2,3,4,5,6,7,8,9,'...'], + [Application,Depth,Limited,Depth,Limited,Depth] = A2, + + {PF2,PA2} = application_controller:format_log(Progress), + PFExpected2 = " application: ~tP~n started_at: ~tP~n", + ct:log("PF2: ~ts~nPA2: ~tp", [PF2,PA2]), + PFExpected2 = PF2, + [Application,Depth,Limited,Depth] = PA2, + + case FD of + undefined -> + application:unset_env(kernel, error_logger_format_depth); + _ -> + application:set_env(kernel, error_logger_format_depth, FD) + end, + ok. + +%% Test report callback for any Logger handler +format_log_2(_Config) -> + Term = lists:seq(1, 15), + Application = my_application, + Error = exit, + Node = Term, + Report = #{label=>{application_controller,Error}, + report=>[{application,Application}, + {exited,Term}, + {type,Term}]}, + FormatOpts1 = #{}, + Str1 = flatten_format_log(Report, FormatOpts1), + L1 = length(Str1), + Expected1 = " application: my_application\n" + " exited: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n" + " type: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n", + ct:log("Str1: ~ts", [Str1]), + ct:log("length(Str1): ~p", [L1]), + true = Expected1 =:= Str1, + + Progress = #{label=>{application_controller,progress}, + report=>[{application,Application},{started_at,Node}]}, + PStr1 = flatten_format_log(Progress, FormatOpts1), + PL1 = length(PStr1), + PExpected1 = " application: my_application\n" + " started_at: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n", + ct:log("PStr1: ~ts", [PStr1]), + ct:log("length(PStr1): ~p", [PL1]), + true = PExpected1 =:= PStr1, + + Depth = 10, + FormatOpts2 = #{depth=>Depth}, + Str2 = flatten_format_log(Report, FormatOpts2), + L2 = length(Str2), + Expected2 = " application: my_application\n" + " exited: [1,2,3,4,5,6,7,8,9|...]\n" + " type: [1,2,3,4,5,6,7,8,9|...]\n", + ct:log("Str2: ~ts", [Str2]), + ct:log("length(Str2): ~p", [L2]), + true = Expected2 =:= Str2, + + PStr2 = flatten_format_log(Progress, FormatOpts2), + PL2 = length(PStr2), + PExpected2 = " application: my_application\n" + " started_at: [1,2,3,4,5,6,7,8,9|...]\n", + ct:log("PStr2: ~ts", [PStr2]), + ct:log("length(PStr2): ~p", [PL2]), + true = PExpected2 =:= PStr2, + + FormatOpts3 = #{chars_limit=>200}, + Str3 = flatten_format_log(Report, FormatOpts3), + L3 = length(Str3), + Expected3 = " application: my_application\n" + " exited: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n" + " type: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n", + ct:log("Str3: ~ts", [Str3]), + ct:log("length(Str3): ~p", [L3]), + true = Expected3 =:= Str3, + + PFormatOpts3 = #{chars_limit=>80}, + PStr3 = flatten_format_log(Progress, PFormatOpts3), + PL3 = length(PStr3), + PExpected3 = " application: my_application\n" + " started_at:", + ct:log("PStr3: ~ts", [PStr3]), + ct:log("length(PStr3): ~p", [PL3]), + true = lists:prefix(PExpected3, PStr3), + true = PL3 < PL1, + + FormatOpts4 = #{single_line=>true}, + Str4 = flatten_format_log(Report, FormatOpts4), + L4 = length(Str4), + + Expected4 = "Application: my_application. " + "Exited: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]. " + "Type: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15].", + ct:log("Str4: ~ts", [Str4]), + ct:log("length(Str4): ~p", [L4]), + true = Expected4 =:= Str4, + + PStr4 = flatten_format_log(Progress, FormatOpts4), + PL4 = length(PStr4), + PExpected4 = "Application: my_application. " + "Started at: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15].", + ct:log("PStr4: ~ts", [PStr4]), + ct:log("length(PStr4): ~p", [PL4]), + true = PExpected4 =:= PStr4, + + FormatOpts5 = #{single_line=>true, depth=>Depth}, + Str5 = flatten_format_log(Report, FormatOpts5), + L5 = length(Str5), + Expected5 = "Application: my_application. " + "Exited: [1,2,3,4,5,6,7,8,9|...]. " + "Type: [1,2,3,4,5,6,7,8,9|...].", + ct:log("Str5: ~ts", [Str5]), + ct:log("length(Str5): ~p", [L5]), + true = Expected5 =:= Str5, + + PStr5 = flatten_format_log(Progress, FormatOpts5), + PL5 = length(PStr5), + PExpected5 = "Application: my_application. " + "Started at: [1,2,3,4,5,6,7,8,9|...].", + ct:log("PStr5: ~ts", [PStr5]), + ct:log("length(PStr5): ~p", [PL5]), + true = PExpected5 =:= PStr5, + + FormatOpts6 = #{single_line=>true, chars_limit=>100}, + Str6 = flatten_format_log(Report, FormatOpts6), + L6 = length(Str6), + Expected6 = "Application: my_application. Exited:", + ct:log("Str6: ~ts", [Str6]), + ct:log("length(Str6): ~p", [L6]), + true = lists:prefix(Expected6, Str6), + true = L6 < L4, + + PFormatOpts6 = #{single_line=>true, chars_limit=>60}, + PStr6 = flatten_format_log(Progress, PFormatOpts6), + PL6 = length(PStr6), + PExpected6 = "Application: my_application. Started at:", + ct:log("PStr6: ~ts", [PStr6]), + ct:log("length(PStr6): ~p", [PL6]), + true = lists:prefix(PExpected6, PStr6), + true = PL6 < PL4, + + ok. + +flatten_format_log(Report, Format) -> + lists:flatten(application_controller:format_log(Report, Format)). %%% Copied from init_SUITE.erl. is_real_system(KernelVsn, StdlibVsn) -> diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 131e3fed34..ed1976d912 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -26,7 +26,7 @@ -export([set_path/1, get_path/1, add_path/1, add_paths/1, del_path/1, replace_path/1, load_file/1, load_abs/1, ensure_loaded/1, delete/1, purge/1, purge_many_exits/0, purge_many_exits/1, - soft_purge/1, is_loaded/1, all_loaded/1, + soft_purge/1, is_loaded/1, all_loaded/1, all_available/1, load_binary/1, dir_req/1, object_code/1, set_path_file/1, upgrade/0, upgrade/1, sticky_dir/1, pa_pz_option/1, add_del_path/1, @@ -61,7 +61,7 @@ all() -> [set_path, get_path, add_path, add_paths, del_path, replace_path, load_file, load_abs, ensure_loaded, delete, purge, purge_many_exits, soft_purge, is_loaded, all_loaded, - load_binary, dir_req, object_code, set_path_file, + all_available, load_binary, dir_req, object_code, set_path_file, upgrade, sticky_dir, pa_pz_option, add_del_path, dir_disappeared, ext_mod_dep, clash, where_is_file, @@ -507,6 +507,47 @@ all_unique([]) -> ok; all_unique([_]) -> ok; all_unique([{X,_}|[{Y,_}|_]=T]) when X < Y -> all_unique(T). +all_available(Config) when is_list(Config) -> + case test_server:is_cover() of + true -> {skip,"Cover is running"}; + false -> all_available_1(Config) + end. + +all_available_1(Config) -> + + %% Add an ez dir to make sure the modules in there are found + DDir = proplists:get_value(data_dir,Config)++"clash/", + true = code:add_path(DDir++"foobar-0.1.ez/foobar-0.1/ebin"), + + Available = code:all_available(), + + %% Test that baz and blarg that are part of the .ez archive are found + {value, _} = + lists:search(fun({Name,_,Loaded}) -> not Loaded andalso Name =:= "baz" end, Available), + {value, _} = + lists:search(fun({Name,_,Loaded}) -> not Loaded andalso Name =:= "blarg" end, Available), + + %% Test that all loaded are part of all available + Loaded = [{atom_to_list(M),P,true} || {M,P} <- code:all_loaded()], + [] = Loaded -- Available, + + {value, {ModStr,_Path,false} = NotLoaded} = + lists:search(fun({Name,_,Loaded}) -> not is_atom(Name) end, Available), + ct:log("Testing with ~p",[NotLoaded]), + + Mod = list_to_atom(ModStr), + + %% Test that the module is actually not loaded + false = code:is_loaded(Mod), + + %% Load it + Mod:module_info(), + + {value, {ModStr,_Path,true}} = + lists:search(fun({Name,_,_}) -> Name =:= ModStr end, code:all_available()), + + ok. + load_binary(Config) when is_list(Config) -> TestDir = test_dir(), File = TestDir ++ "/code_b_test" ++ code:objfile_extension(), @@ -1883,6 +1924,11 @@ module_status() -> loaded = code:module_status(erlang), % preloaded loaded = code:module_status(?MODULE), % normal known loaded + %% module_status/0 returns status for each loaded module + true = (lists:sort([{M, code:module_status(M)} + || {M, _} <- code:all_loaded()]) + =:= lists:sort(code:module_status())), + non_existing = code:which(?TESTMOD), % verify dummy name not in path code:purge(?TESTMOD), % ensure no previous version in memory code:delete(?TESTMOD), @@ -1895,6 +1941,11 @@ module_status() -> "" = code:which(?TESTMOD), % verify empty string for source file loaded = code:module_status(?TESTMOD), + %% module_status/1 also accepts a list of modules + [] = code:module_status([]), + [{erlang, loaded},{?MODULE,loaded},{?TESTMOD,loaded}] = + code:module_status([erlang, ?MODULE, ?TESTMOD]), + %% deleting generated code true = code:delete(?TESTMOD), non_existing = code:which(?TESTMOD), % verify still not in path diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index c3a022df0a..70661637cc 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -20,6 +20,7 @@ -module(erl_distribution_SUITE). -include_lib("common_test/include/ct.hrl"). +-include_lib("kernel/include/dist.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). @@ -41,7 +42,9 @@ monitor_nodes_combinations/1, monitor_nodes_cleanup/1, monitor_nodes_many/1, - dist_ctrl_proc_smoke/1]). + monitor_nodes_down_up/1, + dist_ctrl_proc_smoke/1, + dist_ctrl_proc_reject/1]). %% Performs the test at another node. -export([get_socket_priorities/0, @@ -53,7 +56,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). --export([dist_cntrlr_output_test/2]). +-export([dist_cntrlr_output_test_size/2]). -export([pinger/1]). @@ -72,6 +75,7 @@ suite() -> all() -> [dist_ctrl_proc_smoke, + dist_ctrl_proc_reject, tick, tick_change, nodenames, hostnames, illegal_nodenames, connect_node, hidden_node, setopts, @@ -85,13 +89,16 @@ groups() -> monitor_nodes_node_type, monitor_nodes_misc, monitor_nodes_otp_6481, monitor_nodes_errors, monitor_nodes_combinations, monitor_nodes_cleanup, - monitor_nodes_many]}]. + monitor_nodes_many, + monitor_nodes_down_up]}]. init_per_suite(Config) -> + start_gen_tcp_dist_test_type_server(), Config. end_per_suite(_Config) -> [slave:stop(N) || N <- nodes()], + kill_gen_tcp_dist_test_type_server(), ok. init_per_group(_GroupName, Config) -> @@ -275,7 +282,7 @@ test_node(Name, Illigal, ExtraArgs) -> end, net_kernel:monitor_nodes(true), BinCommand = unicode:characters_to_binary(Command, utf8), - Prt = open_port({spawn, BinCommand}, [stream,{cd,"hostnames_nodedir"}]), + _Prt = open_port({spawn, BinCommand}, [stream,{cd,"hostnames_nodedir"}]), Node = list_to_atom(Name), receive {nodeup, Node} -> @@ -1456,89 +1463,268 @@ monitor_nodes_many(DCfg, _Config) -> MonNodeState = monitor_node_state(), ok. +%% Test order of messages nodedown and nodeup. +monitor_nodes_down_up(Config) when is_list(Config) -> + [An] = get_nodenames(1, monitor_nodeup), + {ok, A} = ct_slave:start(An), + + try + monitor_nodes_yoyo(A) + after + catch ct_slave:stop(A) + end. + +monitor_nodes_yoyo(A) -> + net_kernel:monitor_nodes(true), + Papa = self(), + + %% Spawn lots of processes doing one erlang:monitor_node(A,true) each + %% just to get lots of other monitors to fire when connection goes down + %% and thereby give time for {nodeup,A} to race before {nodedown,A}. + NodeMonCnt = 10000, + NodeMons = [my_spawn_opt(fun F() -> + monitor_node = receive_any(), + monitor_node(A, true), + Papa ! ready, + {nodedown, A} = receive_any(), + F() + end, + [link, monitor, {priority, low}]) + || + _ <- lists:seq(1, NodeMonCnt)], + + %% Spawn message spamming process to trigger new connection setups + %% as quick as possible. + Spammer = my_spawn_opt(fun F() -> + {dummy, A} ! trigger_auto_connect, + F() + end, + [link, monitor]), + + %% Now bring connection down and verify we get {nodedown,A} before {nodeup,A}. + Yoyos = 20, + [begin + [P ! monitor_node || P <- NodeMons], + [receive ready -> ok end || _ <- NodeMons], + + Owner = get_conn_owner(A), + exit(Owner, kill), + + {nodedown, A} = receive_any(), + {nodeup, A} = receive_any() + end + || _ <- lists:seq(1,Yoyos)], + + unlink(Spammer), + exit(Spammer, die), + receive {'DOWN',_,process,Spammer,_} -> ok end, + + [begin unlink(P), exit(P, die) end || P <- NodeMons], + [receive {'DOWN',_,process,P,_} -> ok end || P <- NodeMons], + + net_kernel:monitor_nodes(false), + ok. + +receive_any() -> + receive_any(infinity). + +receive_any(Timeout) -> + receive + M -> M + after + Timeout -> timeout + end. + +my_spawn_opt(Fun, Opts) -> + case spawn_opt(Fun, Opts) of + {Pid, _Mref} -> Pid; + Pid -> Pid + end. + +get_conn_owner(Node) -> + {ok, NodeInfo} = net_kernel:node_info(Node), + {value,{owner, Owner}} = lists:keysearch(owner, 1, NodeInfo), + Owner. + dist_ctrl_proc_smoke(Config) when is_list(Config) -> + dist_ctrl_proc_test(get_nodenames(2, ?FUNCTION_NAME)). + +dist_ctrl_proc_reject(Config) when is_list(Config) -> + ToReject = combinations(dist_util:rejectable_flags()), + lists:map(fun(Flags) -> + ct:log("Try to reject ~p",[Flags]), + dist_ctrl_proc_test(get_nodenames(2, ?FUNCTION_NAME), + "-gen_tcp_dist_reject_flags " ++ integer_to_list(Flags)) + end, ToReject). + +combinations([H | T]) -> + lists:flatten([[(1 bsl H) bor C || C <- combinations(T)] | combinations(T)]); +combinations([]) -> + [0]; +combinations(BitField) -> + lists:sort(combinations(bits(BitField, 0))). + +bits(0, _) -> + []; +bits(BitField, Cnt) when BitField band 1 == 1 -> + [Cnt | bits(BitField bsr 1, Cnt + 1)]; +bits(BitField, Cnt) -> + bits(BitField bsr 1, Cnt + 1). + +dist_ctrl_proc_test(Nodes) -> + dist_ctrl_proc_test(Nodes,""). + +dist_ctrl_proc_test([Name1,Name2], Extra) -> ThisNode = node(), - [Name1, Name2] = get_nodenames(2, dist_ctrl_proc_example_smoke), - GetSizeArg = " -gen_tcp_dist_output_loop " - ++ atom_to_list(?MODULE) ++ " " - ++ "dist_cntrlr_output_test", + GenTcpOptProlog = "-proto_dist gen_tcp " + "-gen_tcp_dist_output_loop " ++ atom_to_list(?MODULE) ++ " " ++ + "dist_cntrlr_output_test_size " ++ Extra, {ok, Node1} = start_node("", Name1, "-proto_dist gen_tcp"), - {ok, Node2} = start_node("", Name2, "-proto_dist gen_tcp" ++ GetSizeArg), - pong = rpc:call(Node1, net_adm, ping, [Node2]), - NL1 = lists:sort([ThisNode, Node2]), - NL2 = lists:sort([ThisNode, Node1]), - NL1 = lists:sort(rpc:call(Node1, erlang, nodes, [])), - NL2 = lists:sort(rpc:call(Node2, erlang, nodes, [])), + {ok, Node2} = start_node("", Name2, GenTcpOptProlog), + NL = lists:sort([ThisNode, Node1, Node2]), + wait_until(fun () -> + NL == lists:sort([node()|nodes()]) + end), + wait_until(fun () -> + NL == lists:sort([rpc:call(Node1,erlang, node, []) + | rpc:call(Node1, erlang, nodes, [])]) + end), + wait_until(fun () -> + NL == lists:sort([rpc:call(Node2,erlang, node, []) + | rpc:call(Node2, erlang, nodes, [])]) + end), + + smoke_communicate(Node1, gen_tcp_dist, dist_cntrlr_output_loop), + smoke_communicate(Node2, erl_distribution_SUITE, dist_cntrlr_output_loop_size), + stop_node(Node1), + stop_node(Node2), + ok. + +smoke_communicate(Node, OLoopMod, OLoopFun) -> %% Verify that we actually are executing the distribution %% module we expect and also massage message passing over - %% it a bit... - Ps1 = rpc:call(Node1, erlang, processes, []), - try - lists:foreach( - fun (P) -> - case rpc:call(Node1, erlang, process_info, [P, current_stacktrace]) of - undefined -> - ok; - {current_stacktrace, StkTrace} -> - lists:foreach(fun ({gen_tcp_dist, - dist_cntrlr_output_loop, - 2, _}) -> - io:format("~p ~p~n", [P, StkTrace]), - throw(found_it); - (_) -> - ok - end, StkTrace) - end - end, Ps1), - exit({missing, dist_cntrlr_output_loop}) - catch - throw:found_it -> ok - end, - - Ps2 = rpc:call(Node2, erlang, processes, []), + %% the connection a bit... + Ps = rpc:call(Node, erlang, processes, []), try lists:foreach( fun (P) -> - case rpc:call(Node2, erlang, process_info, [P, current_stacktrace]) of + case rpc:call(Node, erlang, process_info, [P, current_stacktrace]) of undefined -> ok; {current_stacktrace, StkTrace} -> - lists:foreach(fun ({erl_distribution_SUITE, - dist_cntrlr_output_loop, - 2, _}) -> + lists:foreach(fun ({Mod, Fun, 2, _}) when Mod == OLoopMod, + Fun == OLoopFun -> io:format("~p ~p~n", [P, StkTrace]), throw(found_it); (_) -> ok end, StkTrace) end - end, Ps2), - exit({missing, dist_cntrlr_output_loop}) + end, Ps), + exit({missing, {OLoopMod, OLoopFun}}) catch throw:found_it -> ok end, - - stop_node(Node1), - stop_node(Node2), + Bin = list_to_binary(lists:duplicate(1000,100)), + BitStr = <<0:7999>>, + List = [[Bin], atom, [BitStr|Bin], make_ref(), [[[BitStr|"hopp"]]], + 4711, 111122222211111111111111,"hej", fun () -> ok end, BitStr, + self(), fun erlang:node/1], + Pid = spawn_link(Node, fun () -> receive {From1, Msg1} -> From1 ! Msg1 end, + receive {From2, Msg2} -> From2 ! Msg2 end + end), + R = make_ref(), + Pid ! {self(), [R, List]}, + receive [R, L1] -> List = L1 end, + + %% Send a huge message in order to trigger message fragmentation if enabled + FragBin = <<0:(2*(1024*64*8))>>, + Pid ! {self(), [R, List, FragBin]}, + receive [R, L2, B] -> List = L2, FragBin = B end, + + unlink(Pid), + exit(Pid, kill), ok. %% Misc. functions run_dist_configs(Func, Config) -> - GetSizeArg = " -gen_tcp_dist_output_loop " - ++ atom_to_list(?MODULE) ++ " " - ++ "dist_cntrlr_output_test", + GetOptProlog = "-proto_dist gen_tcp -gen_tcp_dist_output_loop " + ++ atom_to_list(?MODULE) ++ " ", + GenTcpDistTest = case get_gen_tcp_dist_test_type() of + default -> + {"gen_tcp_dist", "-proto_dist gen_tcp"}; + size -> + {"gen_tcp_dist (get_size)", + GetOptProlog ++ "dist_cntrlr_output_test_size"} + end, lists:map(fun ({DCfgName, DCfg}) -> io:format("~n~n=== Running ~s configuration ===~n~n", [DCfgName]), Func(DCfg, Config) end, - [{"default", ""}, - {"gen_tcp_dist", "-proto_dist gen_tcp"}, - {"gen_tcp_dist (get_size)", "-proto_dist gen_tcp" ++ GetSizeArg}]). + [{"default", ""}, GenTcpDistTest]). + +start_gen_tcp_dist_test_type_server() -> + Me = self(), + Go = make_ref(), + io:format("STARTING: gen_tcp_dist_test_type_server~n",[]), + {P, M} = spawn_monitor(fun () -> + register(gen_tcp_dist_test_type_server, self()), + Me ! Go, + gen_tcp_dist_test_type_server() + end), + receive + Go -> + ok; + {'DOWN', M, process, P, _} -> + start_gen_tcp_dist_test_type_server() + end. + +kill_gen_tcp_dist_test_type_server() -> + case whereis(gen_tcp_dist_test_type_server) of + undefined -> + ok; + Pid -> + exit(Pid,kill), + %% Sync death, before continuing... + false = erlang:is_process_alive(Pid) + end. + +gen_tcp_dist_test_type_server() -> + Type = case abs(erlang:monotonic_time(second)) rem 2 of + 0 -> default; + 1 -> size + end, + gen_tcp_dist_test_type_server(Type). + +gen_tcp_dist_test_type_server(Type) -> + receive + {From, Ref} -> + From ! {Ref, Type}, + NewType = case Type of + default -> size; + size -> default + end, + gen_tcp_dist_test_type_server(NewType) + end. + +get_gen_tcp_dist_test_type() -> + Ref = make_ref(), + try + gen_tcp_dist_test_type_server ! {self(), Ref}, + receive + {Ref, Type} -> + Type + end + catch + error:badarg -> + start_gen_tcp_dist_test_type_server(), + get_gen_tcp_dist_test_type() + end. -dist_cntrlr_output_test(DHandle, Socket) -> +dist_cntrlr_output_test_size(DHandle, Socket) -> false = erlang:dist_ctrl_get_opt(DHandle, get_size), false = erlang:dist_ctrl_set_opt(DHandle, get_size, true), true = erlang:dist_ctrl_get_opt(DHandle, get_size), @@ -1546,27 +1732,33 @@ dist_cntrlr_output_test(DHandle, Socket) -> false = erlang:dist_ctrl_get_opt(DHandle, get_size), false = erlang:dist_ctrl_set_opt(DHandle, get_size, true), true = erlang:dist_ctrl_get_opt(DHandle, get_size), - dist_cntrlr_output_loop(DHandle, Socket). - -dist_cntrlr_send_data(DHandle, Socket) -> + dist_cntrlr_output_loop_size(DHandle, Socket). + +dist_cntrlr_output_loop_size(DHandle, Socket) -> + receive + dist_data -> + %% Outgoing data from this node... + dist_cntrlr_send_data_size(DHandle, Socket); + _ -> + ok %% Drop garbage message... + end, + dist_cntrlr_output_loop_size(DHandle, Socket). + +dist_cntrlr_send_data_size(DHandle, Socket) -> case erlang:dist_ctrl_get_data(DHandle) of none -> erlang:dist_ctrl_get_data_notification(DHandle); {Size, Data} -> + ok = ensure_iovec(Data), Size = erlang:iolist_size(Data), ok = gen_tcp:send(Socket, Data), - dist_cntrlr_send_data(DHandle, Socket) + dist_cntrlr_send_data_size(DHandle, Socket) end. -dist_cntrlr_output_loop(DHandle, Socket) -> - receive - dist_data -> - %% Outgoing data from this node... - dist_cntrlr_send_data(DHandle, Socket); - _ -> - ok %% Drop garbage message... - end, - dist_cntrlr_output_loop(DHandle, Socket). +ensure_iovec([]) -> + ok; +ensure_iovec([X|Y]) when is_binary(X) -> + ensure_iovec(Y). monitor_node_state() -> erts_debug:set_internal_state(available_internal_state, true), @@ -1593,7 +1785,7 @@ print_my_messages() -> sleep(T) -> receive after T * 1000 -> ok end. -start_node(DCfg, Name, Param, this) -> +start_node(_DCfg, Name, Param, this) -> NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)), test_server:start_node(Name, peer, [{args, NewParam}, {erl, [this]}]); start_node(DCfg, Name, Param, "this") -> @@ -1671,3 +1863,5 @@ block_emu(Ms) -> Res = erts_debug:set_internal_state(block, Ms), erts_debug:set_internal_state(available_internal_state, false), Res. + + diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl index 8256444bdc..ca4511a19b 100644 --- a/lib/kernel/test/erl_distribution_wb_SUITE.erl +++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl @@ -28,15 +28,6 @@ -export([init_per_testcase/2, end_per_testcase/2, whitebox/1, switch_options/1, missing_compulsory_dflags/1]). -%% 1) -%% -%% Connections are now always set up symmetrically with respect to -%% publication. If connecting node doesn't send DFLAG_PUBLISHED -%% the other node wont send DFLAG_PUBLISHED. If the connecting -%% node send DFLAG_PUBLISHED but the other node doesn't send -%% DFLAG_PUBLISHED, the connecting node should consider its -%% DFLAG_PUBLISHED as dropped, i.e the connecting node wont be -%% published on the other node. -define(to_port(Socket, Data), case inet_tcp:send(Socket, Data) of @@ -47,6 +38,9 @@ R end). +-define(DIST_VER_HIGH, 6). +-define(DIST_VER_LOW, 5). + -define(DFLAG_PUBLISHED,1). -define(DFLAG_ATOM_CACHE,2). -define(DFLAG_EXTENDED_REFERENCES,4). @@ -57,15 +51,19 @@ -define(DFLAG_NEW_FUN_TAGS,16#80). -define(DFLAG_EXTENDED_PIDS_PORTS,16#100). -define(DFLAG_UTF8_ATOMS, 16#10000). +-define(DFLAG_BIG_CREATION, 16#40000). +-define(DFLAG_HANDSHAKE_23, 16#01000000). %% From R9 and forward extended references is compulsory %% From R10 and forward extended pids and ports are compulsory %% From R20 and forward UTF8 atoms are compulsory %% From R21 and forward NEW_FUN_TAGS is compulsory (no more tuple fallback {fun, ...}) +%% From R23 and forward BIG_CREATION is compulsory -define(COMPULSORY_DFLAGS, (?DFLAG_EXTENDED_REFERENCES bor ?DFLAG_EXTENDED_PIDS_PORTS bor ?DFLAG_UTF8_ATOMS bor - ?DFLAG_NEW_FUN_TAGS)). + ?DFLAG_NEW_FUN_TAGS bor + ?DFLAG_BIG_CREATION)). -define(PASS_THROUGH, $p). @@ -131,9 +129,18 @@ whitebox(Config) when is_list(Config) -> {ok, Node} = start_node(?MODULE,""), Cookie = erlang:get_cookie(), {_,Host} = split(node()), - ok = pending_up_md5(Node, join(ccc,Host), Cookie), - ok = simultaneous_md5(Node, join('A',Host), Cookie), - ok = simultaneous_md5(Node, join(zzzzzzzzzzzzzz,Host), Cookie), + [begin + io:format("Test OurVersion=~p and TrustEpmd=~p\n", + [OurVersion, TrustEpmd]), + ok = pending_up_md5(Node, join(ccc,Host), OurVersion, + TrustEpmd, Cookie), + ok = simultaneous_md5(Node, join('A',Host), OurVersion, + TrustEpmd, Cookie), + ok = simultaneous_md5(Node, join(zzzzzzzzzzzzzz,Host), + OurVersion, TrustEpmd, Cookie) + end + || OurVersion <- lists:seq(?DIST_VER_LOW, ?DIST_VER_HIGH), + TrustEpmd <- [true, false]], stop_node(Node), ok. @@ -202,17 +209,22 @@ test_switch_active_and_packet() -> %% %% Handshake tests %% -pending_up_md5(Node,OurName,Cookie) -> +pending_up_md5(Node,OurName,OurVersion,TrustEpmd,Cookie) -> {NA,NB} = split(Node), - {port,PortNo,_} = erl_epmd:port_please(NA,NB), + {port,PortNo,EpmdSaysVersion} = erl_epmd:port_please(NA,NB), {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, [{active,false}, {packet,2}]), - send_name(SocketA,OurName,5), + AssumedVersion = case TrustEpmd of + true -> EpmdSaysVersion; + false -> ?DIST_VER_LOW + end, + SentNameMsg = send_name(SocketA,OurName, OurVersion, AssumedVersion), ok = recv_status(SocketA), - {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1) + {Node,ChallengeMsg,HisChallengeA} = recv_challenge(SocketA,OurVersion), OurChallengeA = gen_challenge(), OurDigestA = gen_digest(HisChallengeA, Cookie), + send_complement(SocketA, SentNameMsg, ChallengeMsg, OurVersion), send_challenge_reply(SocketA, OurChallengeA, OurDigestA), ok = recv_challenge_ack(SocketA, OurChallengeA, Cookie), %%% @@ -224,13 +236,14 @@ pending_up_md5(Node,OurName,Cookie) -> {ok, SocketB} = gen_tcp:connect(atom_to_list(NB),PortNo, [{active,false}, {packet,2}]), - send_name(SocketB,OurName,5), + SentNameMsg = send_name(SocketB,OurName, OurVersion, AssumedVersion), alive = recv_status(SocketB), send_status(SocketB, true), gen_tcp:close(SocketA), - {hidden,Node,5,HisChallengeB} = recv_challenge(SocketB), % See 1) + {Node,ChallengeMsg,HisChallengeB} = recv_challenge(SocketB,OurVersion), OurChallengeB = gen_challenge(), OurDigestB = gen_digest(HisChallengeB, Cookie), + send_complement(SocketB, SentNameMsg, ChallengeMsg, OurVersion), send_challenge_reply(SocketB, OurChallengeB, OurDigestB), ok = recv_challenge_ack(SocketB, OurChallengeB, Cookie), %%% @@ -246,7 +259,7 @@ pending_up_md5(Node,OurName,Cookie) -> gen_tcp:close(SocketB), ok. -simultaneous_md5(Node, OurName, Cookie) when OurName < Node -> +simultaneous_md5(Node, OurName, OurVersion, TrustEpmd, Cookie) when OurName < Node -> pong = net_adm:ping(Node), LSocket = case gen_tcp:listen(0, [{active, false}, {packet,2}]) of {ok, Socket} -> @@ -254,15 +267,19 @@ simultaneous_md5(Node, OurName, Cookie) when OurName < Node -> Else -> exit(Else) end, - EpmdSocket = register(OurName, LSocket, 1, 5), + EpmdSocket = register_node(OurName, LSocket, ?DIST_VER_LOW, ?DIST_VER_LOW), {NA, NB} = split(Node), rpc:cast(Node, net_adm, ping, [OurName]), receive after 1000 -> ok end, - {port, PortNo, _} = erl_epmd:port_please(NA,NB), + {port, PortNo, EpmdSaysVersion} = erl_epmd:port_please(NA,NB), {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, [{active,false}, {packet,2}]), - send_name(SocketA,OurName,5), + AssumedVersion = case TrustEpmd of + true -> EpmdSaysVersion; + false -> ?DIST_VER_LOW + end, + send_name(SocketA,OurName, OurVersion, AssumedVersion), %% We are still not marked up on the other side, as our first message %% is not sent. SocketB = case gen_tcp:accept(LSocket) of @@ -275,11 +292,13 @@ simultaneous_md5(Node, OurName, Cookie) when OurName < Node -> %% Now we are expected to close A gen_tcp:close(SocketA), %% But still Socket B will continue - {normal,Node,5} = recv_name(SocketB), % See 1) + {Node,GotNameMsg,GotFlags} = recv_name(SocketB), + true = (GotFlags band ?DFLAG_HANDSHAKE_23) =/= 0, send_status(SocketB, ok_simultaneous), MyChallengeB = gen_challenge(), - send_challenge(SocketB, OurName, MyChallengeB,5), - HisChallengeB = recv_challenge_reply(SocketB, MyChallengeB, Cookie), + send_challenge(SocketB, OurName, MyChallengeB, OurVersion, GotFlags), + recv_complement(SocketB, GotNameMsg, OurVersion), + {ok,HisChallengeB} = recv_challenge_reply(SocketB, MyChallengeB, Cookie), DigestB = gen_digest(HisChallengeB,Cookie), send_challenge_ack(SocketB, DigestB), inet:setopts(SocketB, [{active, false}, @@ -293,7 +312,7 @@ simultaneous_md5(Node, OurName, Cookie) when OurName < Node -> gen_tcp:close(EpmdSocket), ok; -simultaneous_md5(Node, OurName, Cookie) when OurName > Node -> +simultaneous_md5(Node, OurName, OurVersion, TrustEpmd, Cookie) when OurName > Node -> pong = net_adm:ping(Node), LSocket = case gen_tcp:listen(0, [{active, false}, {packet,2}]) of {ok, Socket} -> @@ -301,11 +320,12 @@ simultaneous_md5(Node, OurName, Cookie) when OurName > Node -> Else -> exit(Else) end, - EpmdSocket = register(OurName, LSocket, 1, 5), + EpmdSocket = register_node(OurName, LSocket, + ?DIST_VER_LOW, ?DIST_VER_LOW), {NA, NB} = split(Node), rpc:cast(Node, net_adm, ping, [OurName]), receive after 1000 -> ok end, - {port, PortNo, _} = erl_epmd:port_please(NA,NB), + {port, PortNo, EpmdSaysVersion} = erl_epmd:port_please(NA,NB), {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, [{active,false}, {packet,2}]), @@ -315,16 +335,22 @@ simultaneous_md5(Node, OurName, Cookie) when OurName > Node -> Else2 -> exit(Else2) end, - send_name(SocketA,OurName,5), + AssumedVersion = case TrustEpmd of + true -> EpmdSaysVersion; + false -> ?DIST_VER_LOW + end, + SentNameMsg = send_name(SocketA,OurName, OurVersion, AssumedVersion), ok_simultaneous = recv_status(SocketA), %% Socket B should die during this case catch begin - {normal,Node,5} = recv_name(SocketB), % See 1) + {Node,GotNameMsg,GotFlagsB} = recv_name(SocketB), + true = (GotFlagsB band ?DFLAG_HANDSHAKE_23) =/= 0, send_status(SocketB, ok_simultaneous), MyChallengeB = gen_challenge(), send_challenge(SocketB, OurName, MyChallengeB, - 5), - HisChallengeB = recv_challenge_reply( + OurVersion, GotFlagsB), + recv_complement(SocketB, GotNameMsg, OurVersion), + {ok,HisChallengeB} = recv_challenge_reply( SocketB, MyChallengeB, Cookie), @@ -346,9 +372,10 @@ simultaneous_md5(Node, OurName, Cookie) when OurName > Node -> end, gen_tcp:close(SocketB), %% But still Socket A will continue - {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1) + {Node,ChallengeMsg,HisChallengeA} = recv_challenge(SocketA,OurVersion), OurChallengeA = gen_challenge(), OurDigestA = gen_digest(HisChallengeA, Cookie), + send_complement(SocketA, SentNameMsg, ChallengeMsg, OurVersion), send_challenge_reply(SocketA, OurChallengeA, OurDigestA), ok = recv_challenge_ack(SocketA, OurChallengeA, Cookie), @@ -368,13 +395,16 @@ missing_compulsory_dflags(Config) when is_list(Config) -> {ok, Node} = start_node(Name1,""), {NA,NB} = split(Node), {port,PortNo,_} = erl_epmd:port_please(NA,NB), - {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, - [{active,false}, - {packet,2}]), - BadNode = list_to_atom(atom_to_list(Name2)++"@"++atom_to_list(NB)), - send_name(SocketA,BadNode,5,0), - not_allowed = recv_status(SocketA), - gen_tcp:close(SocketA), + [begin + {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, + [{active,false}, + {packet,2}]), + BadNode = list_to_atom(atom_to_list(Name2)++"@"++atom_to_list(NB)), + send_name(SocketA,BadNode, Version, Version, 0), + not_allowed = recv_status(SocketA), + gen_tcp:close(SocketA) + end + || Version <- lists:seq(?DIST_VER_LOW, ?DIST_VER_HIGH)], stop_node(Node), ok. @@ -486,46 +516,91 @@ recv_status(Socket) -> exit(Bad) end. -send_challenge(Socket, Node, Challenge, Version) -> - send_challenge(Socket, Node, Challenge, Version, ?COMPULSORY_DFLAGS). -send_challenge(Socket, Node, Challenge, Version, Flags) -> - {ok, {{_Ip1,_Ip2,_Ip3,_Ip4}, _}} = inet:sockname(Socket), - ?to_port(Socket, [$n,?int16(Version),?int32(Flags), - ?int32(Challenge), atom_to_list(Node)]). +send_challenge(Socket, Node, Challenge, Version, GotFlags) -> + send_challenge(Socket, Node, Challenge, Version, GotFlags, ?COMPULSORY_DFLAGS). -recv_challenge(Socket) -> - case gen_tcp:recv(Socket, 0) of - {ok,[$n,V1,V0,Fl1,Fl2,Fl3,Fl4,CA3,CA2,CA1,CA0 | Ns]} -> +send_challenge(Socket, Node, Challenge, ?DIST_VER_LOW, _GotFlags, Flags) -> + {ok, {{_Ip1,_Ip2,_Ip3,_Ip4}, _}} = inet:sockname(Socket), + ?to_port(Socket, [$n,<<?DIST_VER_LOW:16>>,<<Flags:32>>, + <<Challenge:32>>, atom_to_list(Node)]); +send_challenge(Socket, Node, Challenge, ?DIST_VER_HIGH, GotFlags, Flags) -> + true = (GotFlags band ?DFLAG_HANDSHAKE_23) =/= 0, + {ok, {{_Ip1,_Ip2,_Ip3,_Ip4}, _}} = inet:sockname(Socket), + NodeName = atom_to_list(Node), + Nlen = length(NodeName), + Creation = erts_internal:get_creation(), + ?to_port(Socket, [$N, <<(Flags bor ?DFLAG_HANDSHAKE_23):64>>, + <<Challenge:32>>, <<Creation:32>>, + <<Nlen:16>>, NodeName + ]). + +recv_challenge(Socket, OurVersion) -> + {ok, Msg} = gen_tcp:recv(Socket, 0), + %%io:format("recv_challenge Msg=~p\n", [Msg]), + case {OurVersion, Msg} of + {?DIST_VER_LOW, + [$n,V1,V0,Fl1,Fl2,Fl3,Fl4,CA3,CA2,CA1,CA0 | Ns]} -> Flags = ?u32(Fl1,Fl2,Fl3,Fl4), - Type = case Flags band ?DFLAG_PUBLISHED of - 0 -> - hidden; - _ -> - normal - end, + true = (Flags band ?COMPULSORY_DFLAGS) =:= ?COMPULSORY_DFLAGS, Node =list_to_atom(Ns), - Version = ?u16(V1,V0), + ?DIST_VER_LOW = ?u16(V1,V0), + Challenge = ?u32(CA3,CA2,CA1,CA0), + {Node,$n,Challenge}; + + {?DIST_VER_HIGH, + [$N, F7,F6,F5,F4,F3,F2,F1,F0, CA3,CA2,CA1,CA0, + Cr3,Cr2,Cr1,Cr0, NL1,NL0 | Ns]} -> + <<Flags:64>> = <<F7,F6,F5,F4,F3,F2,F1,F0>>, + true = (Flags band ?COMPULSORY_DFLAGS) =:= ?COMPULSORY_DFLAGS, + <<Creation:32>> = <<Cr3,Cr2,Cr1,Cr0>>, + true = (Creation =/= 0), + <<NameLen:16>> = <<NL1,NL0>>, + NameLen = length(Ns), + Node = list_to_atom(Ns), Challenge = ?u32(CA3,CA2,CA1,CA0), - {Type,Node,Version,Challenge}; + {Node,$N,Challenge}; + _ -> ?shutdown(no_node) end. +send_complement(Socket, SentNameMsg, ChallengeMsg, OurVersion) -> + case {SentNameMsg,ChallengeMsg} of + {$n,$N} -> + FlagsHigh = our_flags(?COMPULSORY_DFLAGS, OurVersion) bsr 32, + ?to_port(Socket, [$c, + <<FlagsHigh:32>>, + ?int32(erts_internal:get_creation())]); + {Same,Same} -> + ok + end. + +recv_complement(Socket, $n, OurVersion) when OurVersion > ?DIST_VER_LOW -> + case gen_tcp:recv(Socket, 0) of + {ok,[$c,Cr3,Cr2,Cr1,Cr0]} -> + Creation = ?u32(Cr3,Cr2,Cr1,Cr0), + true = (Creation =/= 0); + Err -> + {error,Err} + end; +recv_complement(_, _ , _) -> + ok. + send_challenge_reply(Socket, Challenge, Digest) -> ?to_port(Socket, [$r,?int32(Challenge),Digest]). recv_challenge_reply(Socket, ChallengeA, Cookie) -> case gen_tcp:recv(Socket, 0) of - {ok,[$r,CB3,CB2,CB1,CB0 | SumB]} when length(SumB) == 16 -> + {ok,[$r,CB3,CB2,CB1,CB0 | SumB]=Data} when length(SumB) == 16 -> SumA = gen_digest(ChallengeA, Cookie), ChallengeB = ?u32(CB3,CB2,CB1,CB0), if SumB == SumA -> - ChallengeB; + {ok,ChallengeB}; true -> - ?shutdown(bad_challenge_reply) + {error,Data} end; - _ -> - ?shutdown(no_node) + Err -> + {error,Err} end. send_challenge_ack(Socket, Digest) -> @@ -539,20 +614,34 @@ recv_challenge_ack(Socket, ChallengeB, CookieA) -> ok; true -> ?shutdown(bad_challenge_ack) - end; - _ -> - ?shutdown(bad_challenge_ack) + end end. -send_name(Socket, MyNode0, Version) -> - send_name(Socket, MyNode0, Version, ?COMPULSORY_DFLAGS). -send_name(Socket, MyNode0, Version, Flags) -> +send_name(Socket, MyNode0, OurVersion, AssumedVersion) -> + send_name(Socket, MyNode0, OurVersion, AssumedVersion, ?COMPULSORY_DFLAGS). + +send_name(Socket, MyNode0, OurVersion, AssumedVersion, Flags) -> MyNode = atom_to_list(MyNode0), - ok = ?to_port(Socket, [<<$n,Version:16,Flags:32>>|MyNode]). + if (OurVersion =:= ?DIST_VER_LOW) or + (AssumedVersion =:= ?DIST_VER_LOW) -> + OurFlags = our_flags(Flags,OurVersion), + ok = ?to_port(Socket, [<<$n,OurVersion:16,OurFlags:32>>|MyNode]), + $n; + + (OurVersion > ?DIST_VER_LOW) and + (AssumedVersion > ?DIST_VER_LOW) -> + Creation = erts_internal:get_creation(), + NameLen = length(MyNode), + ok = ?to_port(Socket, [<<$N, (Flags bor ?DFLAG_HANDSHAKE_23):64, + Creation:32,NameLen:16>>|MyNode]), + $N + end. + +our_flags(Flags, ?DIST_VER_LOW) -> + Flags; +our_flags(Flags, OurVersion) when OurVersion > ?DIST_VER_LOW -> + Flags bor ?DFLAG_HANDSHAKE_23. -%% -%% recv_name is common for both old and new handshake. -%% recv_name(Socket) -> case gen_tcp:recv(Socket, 0) of {ok,Data} -> @@ -561,19 +650,18 @@ recv_name(Socket) -> ?shutdown({no_node,Res}) end. -get_name([$m,VersionA,VersionB,_Ip1,_Ip2,_Ip3,_Ip4|OtherNode]) -> - {normal, list_to_atom(OtherNode), ?u16(VersionA,VersionB)}; -get_name([$h,VersionA,VersionB,_Ip1,_Ip2,_Ip3,_Ip4|OtherNode]) -> - {hidden, list_to_atom(OtherNode), ?u16(VersionA,VersionB)}; -get_name([$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4 | OtherNode]) -> - Type = case ?u32(Flag1, Flag2, Flag3, Flag4) band ?DFLAG_PUBLISHED of - 0 -> - hidden; - _ -> - normal - end, - {Type, list_to_atom(OtherNode), - ?u16(VersionA,VersionB)}; +get_name([$n, V1,V0, F3,F2,F1,F0 | OtherNode]) -> + <<Version:16>> = <<V1,V0>>, + 5 = Version, + <<Flags:32>> = <<F3,F2,F1,F0>>, + {list_to_atom(OtherNode), $n, Flags}; +get_name([$N, F7,F6,F5,F4,F3,F2,F1,F0, + _C3,_C2,_C1,_C0, NLen1,NLen2 | OtherNode]) -> + <<Flags:64>> = <<F7,F6,F5,F4,F3,F2,F1,F0>>, + true = (Flags band ?DFLAG_HANDSHAKE_23) =/= 0, + <<NameLen:16>> = <<NLen1,NLen2>>, + NameLen = length(OtherNode), + {list_to_atom(OtherNode), $N, Flags}; get_name(Data) -> ?shutdown(Data). @@ -620,6 +708,13 @@ wait_for_reg_reply(Socket, SoFar) -> receive {tcp, Socket, Data0} -> case SoFar ++ Data0 of + [$v, Result, A, B, C, D] -> + case Result of + 0 -> + {alive, Socket, ?u32(A, B, C, D)}; + _ -> + {error, duplicate_name} + end; [$y, Result, A, B] -> case Result of 0 -> @@ -640,7 +735,7 @@ wait_for_reg_reply(Socket, SoFar) -> end. -register(NodeName, ListenSocket, VLow, VHigh) -> +register_node(NodeName, ListenSocket, VLow, VHigh) -> {ok,{_,TcpPort}} = inet:sockname(ListenSocket), case do_register_node(NodeName, TcpPort, VLow, VHigh) of {alive, Socket, _Creation} -> diff --git a/lib/kernel/test/erpc_SUITE.erl b/lib/kernel/test/erpc_SUITE.erl new file mode 100644 index 0000000000..3106bba879 --- /dev/null +++ b/lib/kernel/test/erpc_SUITE.erl @@ -0,0 +1,796 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2020. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(erpc_SUITE). + +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). +-export([call/1, call_reqtmo/1, call_against_old_node/1, cast/1, + send_request/1, send_request_receive_reqtmo/1, + send_request_wait_reqtmo/1, + send_request_check_reqtmo/1, + send_request_against_old_node/1, + multicall/1, multicall_reqtmo/1, + timeout_limit/1]). +-export([init_per_testcase/2, end_per_testcase/2]). + +-export([call_func1/1, call_func2/1, call_func4/4]). + +-export([f/0, f2/0]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,2}}]. + +all() -> + [call, call_reqtmo, call_against_old_node, cast, + send_request, send_request_receive_reqtmo, + send_request_wait_reqtmo, send_request_check_reqtmo, + send_request_against_old_node, + multicall, multicall_reqtmo, + timeout_limit]. + +groups() -> + []. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + [{testcase, Func}|Config]. + +end_per_testcase(_Func, _Config) -> + ok. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +call(Config) when is_list(Config) -> + call_test(Config). + +call_test(Config) -> + call_test(node(), 10000), + call_test(node(), infinity), + try + erpc:call(node(), erlang, node, [], 0), + ct:fail(unexpected) + catch + error:{erpc, timeout} -> + ok + end, + {ok, Node} = start_node(Config), + call_test(Node, 10000), + call_test(Node, infinity), + try + erpc:call(Node, erlang, node, [], 0), + ct:fail(unexpected) + catch + error:{erpc, timeout} -> + ok + end, + try + erpc:call(Node, erlang, halt, []), + ct:fail(unexpected) + catch + error:{erpc, noconnection} -> + ok + end, + try + erpc:call(Node, erlang, node, []), + ct:fail(unexpected) + catch + error:{erpc, noconnection} -> + ok + end. + +call_test(Node, Timeout) -> + io:format("call_test(~p, ~p)~n", [Node, Timeout]), + Node = erpc:call(Node, erlang, node, [], Timeout), + try + erpc:call(Node, erlang, error, [oops|invalid], Timeout), + ct:fail(unexpected) + catch + error:{erpc, badarg} -> + ok + end, + try + erpc:call(Node, erlang, error, [oops|invalid], Timeout), + ct:fail(unexpected) + catch + error:{erpc, badarg} -> + ok + end, + try + erpc:call(Node, erlang, error, [oops], Timeout), + ct:fail(unexpected) + catch + error:{exception, oops, [{erlang,error,[oops],_}]} -> + ok + end, + try + erpc:call(Node, erlang, exit, [oops], Timeout), + ct:fail(unexpected) + catch + exit:{exception, oops} -> + ok + end, + try + erpc:call(Node, erlang, throw, [oops], Timeout), + ct:fail(unexpected) + catch + throw:oops -> + ok + end, + case {node() == Node, Timeout == infinity} of + {true, true} -> + %% This would kill the test since local calls + %% without timeout is optimized to execute in + %% calling process itself... + ok; + _ -> + ExitSignal = fun () -> + exit(self(), oops), + receive after infinity -> ok end + end, + try + erpc:call(Node, erlang, apply, [ExitSignal, []], Timeout), + ct:fail(unexpected) + catch + exit:{signal, oops} -> + ok + end + end, + try + erpc:call(Node, ?MODULE, call_func1, [boom], Timeout), + ct:fail(unexpected) + catch + error:{exception, + {exception, + boom, + [{?MODULE, call_func3, A2, _}, + {?MODULE, call_func2, 1, _}]}, + [{erpc, call, A1, _}, + {?MODULE, call_func1, 1, _}]} + when ((A1 == 5) + orelse (A1 == [Node, ?MODULE, call_func2, [boom]])) + andalso ((A2 == 1) + orelse (A2 == [boom])) -> + ok + end, + try + call_func4(Node, node(), 10, Timeout), + ct:fail(unexpected) + catch + error:Error1 -> +%%% io:format("Error1=~p~n", [Error1]), + check_call_func4_error(Error1, 10) + end, + try + call_func4(node(), Node, 5, Timeout), + ct:fail(unexpected) + catch + error:Error2 -> +%%% io:format("Error2=~p~n", [Error2]), + check_call_func4_error(Error2, 5) + end, + ok. + +check_call_func4_error({exception, + badarg, + [{?MODULE, call_func5, _, _}, + {?MODULE, call_func4, _, _}]}, + 0) -> + ok; +check_call_func4_error({exception, + Exception, + [{erpc, call, _, _}, + {?MODULE, call_func5, _, _}, + {?MODULE, call_func4, _, _}]}, + N) -> + check_call_func4_error(Exception, N-1). + +call_func1(X) -> + erpc:call(node(), ?MODULE, call_func2, [X]), + ok. + +call_func2(X) -> + call_func3(X), + ok. + +call_func3(X) -> + erlang:error(X, [X]). + +call_func4(A, B, N, T) -> + call_func5(A, B, N, T), + ok. + +call_func5(A, B, N, T) when N >= 0 -> + erpc:call(A, ?MODULE, call_func4, [B, A, N-1, T], T), + ok; +call_func5(_A, _B, _N, _T) -> + erlang:error(badarg). + +call_against_old_node(Config) -> + case start_22_node(Config) of + {ok, Node22} -> + try + erpc:call(Node22, erlang, node, []), + ct:fail(unexpected) + catch + error:{erpc, notsup} -> + ok + end, + stop_node(Node22), + ok; + _ -> + {skipped, "No OTP 22 available"} + end. + +call_reqtmo(Config) when is_list(Config) -> + Fun = fun (Node, SendMe, Timeout) -> + try + erpc:call(Node, erlang, send, + [self(), SendMe], Timeout), + ct:fail(unexpected) + catch + error:{erpc, timeout} -> ok + end + end, + reqtmo_test(Config, Fun). + +reqtmo_test(Config, Test) -> + %% Tests that we time out in time also when the request itself + %% does not get through. A typical issue we have had + %% in the past, is that the timeout has not triggered until + %% the request has gotten through... + + Timeout = 500, + WaitBlock = 100, + BlockTime = 1000, + + {ok, Node} = start_node(Config), + + erpc:call(Node, erts_debug, set_internal_state, [available_internal_state, + true]), + + SendMe = make_ref(), + + erpc:cast(Node, erts_debug, set_internal_state, [block, BlockTime]), + receive after WaitBlock -> ok end, + + Start = erlang:monotonic_time(), + + Test(Node, SendMe, Timeout), + + Stop = erlang:monotonic_time(), + Time = erlang:convert_time_unit(Stop-Start, native, millisecond), + io:format("Actual time: ~p ms~n", [Time]), + true = Time >= Timeout, + true = Time =< Timeout + 200, + + receive SendMe -> ok end, + + receive UnexpectedMsg -> ct:fail({unexpected_message, UnexpectedMsg}) + after 0 -> ok + end, + + stop_node(Node), + + {comment, + "Timeout = " ++ integer_to_list(Timeout) + ++ " Actual = " ++ integer_to_list(Time)}. + +cast(Config) when is_list(Config) -> + try + erpc:cast(node, erlang, send, [hej]), + ct:fail(unexpected) + catch + error:{erpc, badarg} -> ok + end, + try + erpc:cast(node(), "erlang", send, [hej]), + ct:fail(unexpected) + catch + error:{erpc, badarg} -> ok + end, + try + erpc:cast(node(), erlang, make_ref(), [hej]), + ct:fail(unexpected) + catch + error:{erpc, badarg} -> ok + end, + try + erpc:cast(node(), erlang, send, [hej|hopp]), + ct:fail(unexpected) + catch + error:{erpc, badarg} -> ok + end, + Me = self(), + Ok1 = make_ref(), + ok = erpc:cast(node(), erlang, send, [Me, Ok1]), + receive + Ok1 -> ok + end, + {ok, Node} = start_node(Config), + Ok2 = make_ref(), + ok = erpc:cast(Node, erlang, send, [Me, Ok2]), + receive + Ok2 -> ok + end, + stop_node(Node), + case start_22_node(Config) of + {ok, Node22} -> + ok = erpc:cast(Node, erlang, send, [Me, wont_reach_me]), + receive + Msg -> ct:fail({unexpected_message, Msg}) + after + 2000 -> ok + end, + stop_node(Node22), + {comment, "Tested against OTP 22 as well"}; + _ -> + {comment, "No tested against OTP 22"} + end. + +send_request(Config) when is_list(Config) -> + %% Note: First part of nodename sets response delay in seconds. + PA = filename:dirname(code:which(?MODULE)), + NodeArgs = [{args,"-pa "++ PA}], + {ok,Node1} = test_server:start_node('1_erpc_SUITE_call', slave, NodeArgs), + {ok,Node2} = test_server:start_node('10_erpc_SUITE_call', slave, NodeArgs), + {ok,Node3} = test_server:start_node('20_erpc_SUITE_call', slave, NodeArgs), + ReqId1 = erpc:send_request(Node1, ?MODULE, f, []), + ReqId2 = erpc:send_request(Node2, ?MODULE, f, []), + ReqId3 = erpc:send_request(Node3, ?MODULE, f, []), + ReqId4 = erpc:send_request(Node1, erlang, error, [bang]), + ReqId5 = erpc:send_request(Node1, ?MODULE, f, []), + + try + erpc:receive_response(ReqId4, 10) + catch + error:{exception, bang, [{erlang,error,[bang],_}]} -> + ok + end, + try + erpc:receive_response(ReqId5, 10) + catch + error:{erpc, timeout} -> + ok + end, + + %% Test fast timeouts. + no_response = erpc:wait_response(ReqId2), + no_response = erpc:wait_response(ReqId2, 10), + + %% Let Node1 finish its work before yielding. + ct:sleep({seconds,2}), + {hej,_,Node1} = erpc:receive_response(ReqId1), + + %% Wait for the Node2 and Node3. + {response,{hej,_,Node2}} = erpc:wait_response(ReqId2, infinity), + {hej,_,Node3} = erpc:receive_response(ReqId3), + + try + erpc:receive_response(ReqId5, 10), + ct:fail(unexpected) + catch + error:{erpc, badarg} -> + ok + end, + + receive + Msg0 -> ct:fail(Msg0) + after 0 -> ok + end, + + {ok, Node4} = start_node(Config), + + ReqId6 = erpc:send_request(Node4, erlang, node, []), + + no_response = erpc:check_response({response, Node1}, ReqId6), + no_response = erpc:check_response(ReqId6, ReqId6), + receive + Msg1 -> + {response, Node4} = erpc:check_response(Msg1, ReqId6) + end, + + ReqId7 = erpc:send_request(Node4, erlang, halt, []), + try + erpc:receive_response(ReqId7), + ct:fail(unexpected) + catch + error:{erpc, noconnection} -> ok + end, + + ReqId8 = erpc:send_request(Node4, erlang, node, []), + receive + Msg2 -> + try + erpc:check_response(Msg2, ReqId8), + ct:fail(unexpected) + catch + error:{erpc, noconnection} -> + ok + end + end, + + case start_22_node(Config) of + {ok, Node5} -> + ReqId9 = erpc:send_request(Node5, erlang, node, []), + try + erpc:receive_response(ReqId9), + ct:fail(unexpected) + catch + error:{erpc, notsup} -> ok + end, + + stop_node(Node5), + ok; + _ -> + {comment, "No test against OTP 22 node performed"} + end. + +send_request_receive_reqtmo(Config) when is_list(Config) -> + Fun = fun (Node, SendMe, Timeout) -> + RID = erpc:send_request(Node, erlang, send, + [self(), SendMe]), + try + erpc:receive_response(RID, Timeout), + ct:fail(unexpected) + catch + error:{erpc, timeout} -> ok + end + end, + reqtmo_test(Config, Fun). + +send_request_wait_reqtmo(Config) when is_list(Config) -> + Fun = fun (Node, SendMe, Timeout) -> + RID = erpc:send_request(Node, erlang, send, + [self(), SendMe]), + no_response = erpc:wait_response(RID, 0), + no_response = erpc:wait_response(RID, Timeout), + %% Cleanup... + try + erpc:receive_response(RID, 0), + ct:fail(unexpected) + catch + error:{erpc, timeout} -> ok + end + end, + reqtmo_test(Config, Fun). + +send_request_check_reqtmo(Config) when is_list(Config) -> + Fun = fun (Node, SendMe, Timeout) -> + RID = erpc:send_request(Node, erlang, send, + [self(), SendMe]), + receive Msg -> erpc:check_response(Msg, RID) + after Timeout -> ok + end, + %% Cleanup... + try + erpc:receive_response(RID, 0), + ct:fail(unexpected) + catch + error:{erpc, timeout} -> ok + end + end, + reqtmo_test(Config, Fun). + +send_request_against_old_node(Config) when is_list(Config) -> + case start_22_node(Config) of + {ok, Node22} -> + RID1 = erpc:send_request(Node22, erlang, node, []), + RID2 = erpc:send_request(Node22, erlang, node, []), + RID3 = erpc:send_request(Node22, erlang, node, []), + try + erpc:receive_response(RID1), + ct:fail(unexpected) + catch + error:{erpc, notsup} -> + ok + end, + try + erpc:wait_response(RID2, infinity), + ct:fail(unexpected) + catch + error:{erpc, notsup} -> + ok + end, + try + receive + Msg -> + erpc:check_response(Msg, RID3), + ct:fail(unexpected) + end + catch + error:{erpc, notsup} -> + ok + end, + stop_node(Node22), + ok; + _ -> + {skipped, "No OTP 22 available"} + end. + +multicall(Config) -> + {ok, Node1} = start_node(Config), + {ok, Node2} = start_node(Config), + {Node3, Node3Res} = case start_22_node(Config) of + {ok, N3} -> + {N3, {error, {erpc, notsup}}}; + _ -> + {ok, N3} = start_node(Config), + stop_node(N3), + {N3, {error, {erpc, noconnection}}} + end, + {ok, Node4} = start_node(Config), + {ok, Node5} = start_node(Config), + stop_node(Node2), + + ThisNode = node(), + Nodes = [ThisNode, Node1, Node2, Node3, Node4, Node5], + + [{ok, ThisNode}, + {ok, Node1}, + {error, {erpc, noconnection}}, + Node3Res, + {ok, Node4}, + {ok, Node5}] + = erpc:multicall(Nodes, erlang, node, []), + + [BlingError, + BlingError, + {error, {erpc, noconnection}}, + Node3Res, + BlingError, + BlingError] + = erpc:multicall(Nodes, ?MODULE, call_func2, [bling]), + + {error, {exception, + bling, + [{?MODULE, call_func3, A, _}, + {?MODULE, call_func2, 1, _}]}} = BlingError, + true = (A == 1) orelse (A == [bling]), + + [{error, {exception, blong, [{erlang, error, [blong], _}]}}, + {error, {exception, blong, [{erlang, error, [blong], _}]}}, + {error, {erpc, noconnection}}, + Node3Res, + {error, {exception, blong, [{erlang, error, [blong], _}]}}, + {error, {exception, blong, [{erlang, error, [blong], _}]}}] + = erpc:multicall(Nodes, erlang, error, [blong]), + + SlowNode4 = fun () -> + case node() of + Node4 -> + receive after 1000 -> ok end, + slow; + ThisNode -> + throw(fast); + _ -> + fast + end + end, + + Start1 = erlang:monotonic_time(), + [{throw, fast}, + {ok, fast}, + {error, {erpc, noconnection}}, + Node3Res, + {error, {erpc, timeout}}, + {ok, fast}] + = erpc:multicall(Nodes, erlang, apply, [SlowNode4, []], 500), + + End1 = erlang:monotonic_time(), + + Time1 = erlang:convert_time_unit(End1-Start1, native, millisecond), + io:format("Time1 = ~p~n",[Time1]), + true = Time1 >= 500, + true = Time1 =< 1000, + + SlowThisNode = fun () -> + case node() of + ThisNode -> + receive after 1000 -> ok end, + slow; + Node4 -> + throw(fast); + Node5 -> + exit(fast); + _ -> + fast + end + end, + + Start2 = erlang:monotonic_time(), + [{error, {erpc, timeout}}, + {ok, fast}, + {error, {erpc, noconnection}}, + Node3Res, + {throw, fast}, + {exit, {exception, fast}}] + = erpc:multicall(Nodes, erlang, apply, [SlowThisNode, []], 500), + + End2 = erlang:monotonic_time(), + + Time2 = erlang:convert_time_unit(End2-Start2, native, millisecond), + io:format("Time2 = ~p~n",[Time2]), + true = Time2 >= 500, + true = Time2 =< 1000, + + %% We should not get any stray messages due to timed out operations... + receive Msg -> ct:fail({unexpected, Msg}) + after 1000 -> ok + end, + + [{error, {erpc, noconnection}}, + Node3Res, + {error, {erpc, noconnection}}, + {error, {erpc, noconnection}}] + = erpc:multicall([Node2, Node3, Node4, Node5], erlang, halt, []), + + stop_node(Node3), + case Node3Res of + {error, {erpc, notsup}} -> + {comment, "Tested against an OTP 22 node as well"}; + _ -> + {comment, "No OTP 22 node available; i.e., only testing against current release"} + end. + +multicall_reqtmo(Config) when is_list(Config) -> + {ok, QuickNode1} = start_node(Config), + {ok, QuickNode2} = start_node(Config), + Fun = fun (Node, SendMe, Timeout) -> + Me = self(), + SlowSend = fun () -> + if node() == Node -> + Me ! SendMe, + done; + true -> + done + end + end, + [{ok, done},{error,{erpc,timeout}},{ok, done}] + = erpc:multicall([QuickNode1, Node, QuickNode2], + erlang, apply, [SlowSend, []], + Timeout) + end, + Res = reqtmo_test(Config, Fun), + stop_node(QuickNode1), + stop_node(QuickNode2), + Res. + +timeout_limit(Config) when is_list(Config) -> + Node = node(), + MaxTmo = (1 bsl 32) - 1, + erlang:send_after(100, self(), dummy_message), + try + receive + M -> + M + after MaxTmo + 1 -> + ok + end, + ct:fail("The ?MAX_INT_TIMEOUT define in erpc.erl needs " + "to be updated to reflect max timeout value " + "in a receive/after...") + catch + error:timeout_value -> + ok + end, + Node = erpc:call(Node, erlang, node, [], MaxTmo), + try + erpc:call(node(), erlang, node, [], MaxTmo+1), + ct:fail(unexpected) + catch + error:{erpc, badarg} -> + ok + end, + [{ok,Node}] = erpc:multicall([Node], erlang, node, [], MaxTmo), + try + erpc:multicall([Node], erlang, node, [], MaxTmo+1), + ct:fail(unexpected) + catch + error:{erpc, badarg} -> + ok + end, + ReqId1 = erpc:send_request(Node, erlang, node, []), + Node = erpc:receive_response(ReqId1, MaxTmo), + ReqId2 = erpc:send_request(Node, erlang, node, []), + try + erpc:receive_response(ReqId2, MaxTmo+1), + ct:fail(unexpected) + catch + error:{erpc, badarg} -> + ok + end, + ReqId3 = erpc:send_request(Node, erlang, node, []), + Node = erpc:receive_response(ReqId3, MaxTmo), + ReqId4 = erpc:send_request(Node, erlang, node, []), + try + erpc:receive_response(ReqId4, MaxTmo+1), + ct:fail(unexpected) + catch + error:{erpc, badarg} -> + ok + end, + ok. + + +%%% +%%% Utility functions. +%%% + +start_node(Config) -> + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" ++ integer_to_list(erlang:system_time(second)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), + Pa = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]). + +start_22_node(Config) -> + Rel = "22_latest", + case test_server:is_release_available(Rel) of + false -> + notsup; + true -> + Cookie = atom_to_list(erlang:get_cookie()), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" ++ integer_to_list(erlang:system_time(second)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), + Pa = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, + peer, + [{args, "-pa " ++ Pa ++ " -setcookie "++Cookie}, + {erl, [{release, Rel}]}]) + end. + +stop_node(Node) -> + test_server:stop_node(Node). + +flush(L) -> + receive + M -> + flush([M|L]) + after 0 -> + L + end. + +t() -> + [N | _] = string:tokens(atom_to_list(node()), "_"), + 1000*list_to_integer(N). + +f() -> + timer:sleep(T=t()), + spawn(?MODULE, f2, []), + {hej,T,node()}. + +f2() -> + timer:sleep(500), + halt(). diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 1c1b35abc1..f432eec708 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -58,6 +58,8 @@ -export([ file_info_basic_file/1, file_info_basic_directory/1, file_info_bad/1, file_info_times/1, file_write_file_info/1, file_wfi_helpers/1]). +-export([ file_handle_info_basic_file/1, file_handle_info_basic_directory/1, + file_handle_info_times/1]). -export([rename/1, access/1, truncate/1, datasync/1, sync/1, read_write/1, pread_write/1, append/1, exclusive/1]). -export([ e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). @@ -155,7 +157,10 @@ groups() -> {pos, [], [pos1, pos2, pos3]}, {file_info, [], [file_info_basic_file, file_info_basic_directory, - file_info_bad, file_info_times, file_write_file_info, + file_info_bad, file_info_times, + file_handle_info_basic_file, file_handle_info_basic_directory, + file_handle_info_times, + file_write_file_info, file_wfi_helpers]}, {consult, [], [consult1, path_consult]}, {eval, [], [eval1, path_eval]}, @@ -275,11 +280,11 @@ mini_server(Parent) -> Parent ! {io_request,From,To,{put_chars,Data}}, From ! {io_reply, To, ok}, mini_server(Parent); - {io_request,From,To,{get_chars,'',N}} -> + {io_request,From,To,{get_chars,_Encoding,'',N}} -> Parent ! {io_request,From,To,{get_chars,'',N}}, From ! {io_reply, To, {ok, lists:duplicate(N,$a)}}, mini_server(Parent); - {io_request,From,To,{get_line,''}} -> + {io_request,From,To,{get_line,_Encoding,''}} -> Parent ! {io_request,From,To,{get_line,''}}, From ! {io_reply, To, {ok, "hej\n"}}, mini_server(Parent) @@ -989,6 +994,14 @@ new_modes(Config) when is_list(Config) -> ok end, + % open directory + {ok, Fd9} = ?FILE_MODULE:open(NewDir, [directory]), + ok = ?FILE_MODULE:close(Fd9), + + % open raw directory + {ok, Fd10} = ?FILE_MODULE:open(NewDir, [raw, directory]), + ok = ?FILE_MODULE:close(Fd10), + [] = flush(), ok. @@ -1238,6 +1251,9 @@ open_errors(Config) when is_list(Config) -> {error, E4} = ?FILE_MODULE:open(DataDirSlash, [write]), {eisdir,eisdir,eisdir,eisdir} = {E1,E2,E3,E4}, + Real = filename:join(DataDir, "realmen.html"), + {error, enotdir} = ?FILE_MODULE:open(Real, [directory]), + [] = flush(), ok. @@ -1408,7 +1424,8 @@ file_info_basic_directory(Config) when is_list(Config) -> {win32, _} -> test_directory("/", read_write), test_directory("c:/", read_write), - test_directory("c:\\", read_write); + test_directory("c:\\", read_write), + test_directory("\\\\localhost\\c$", read_write); _ -> test_directory("/", read) end, @@ -1540,6 +1557,180 @@ filter_atime(Atime, Config) -> Atime end. +%% Test read_file_info on I/O devices. + +file_handle_info_basic_file(Config) when is_list(Config) -> + RootDir = proplists:get_value(priv_dir, Config), + + %% Create a short file. + Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_basic_test.fil"), + {ok,Fd1} = ?FILE_MODULE:open(Name, write), + io:put_chars(Fd1, "foo bar"), + ok = ?FILE_MODULE:close(Fd1), + + %% Test that the file has the expected attributes. + %% The times are tricky, so we will save them to a separate test case. + + {ok, Fd} = ?FILE_MODULE:open(Name, read), + {ok,FileInfo} = ?FILE_MODULE:read_file_info(Fd), + ok = ?FILE_MODULE:close(Fd), + + {ok, FdRaw} = ?FILE_MODULE:open(Name, [read, raw]), + {ok,FileInfoRaw} = ?FILE_MODULE:read_file_info(FdRaw), + ok = ?FILE_MODULE:close(FdRaw), + + #file_info{size=Size,type=Type,access=Access, + atime=AccessTime,mtime=ModifyTime} = FileInfo = FileInfoRaw, + io:format("Access ~p, Modify ~p", [AccessTime, ModifyTime]), + Size = 7, + Type = regular, + read_write = Access, + true = abs(time_dist(filter_atime(AccessTime, Config), + filter_atime(ModifyTime, + Config))) < 5, + all_integers(tuple_to_list(AccessTime) ++ tuple_to_list(ModifyTime)), + + [] = flush(), + ok. + +file_handle_info_basic_directory(Config) when is_list(Config) -> + %% Note: filename:join/1 removes any trailing slash, + %% which is essential for ?FILE_MODULE:file_info/1 to work on + %% platforms such as Windows95. + RootDir = filename:join([proplists:get_value(priv_dir, Config)]), + + %% Test that the RootDir directory has the expected attributes. + test_directory_handle(RootDir, read_write), + + %% Note that on Windows file systems, + %% "/" or "c:/" are *NOT* directories. + %% Therefore, test that ?FILE_MODULE:file_info/1 behaves as if they were + %% directories. + case os:type() of + {win32, _} -> + test_directory_handle("/", read_write), + test_directory_handle("c:/", read_write), + test_directory_handle("c:\\", read_write), + test_directory_handle("\\\\localhost\\c$", read_write); + _ -> + test_directory_handle("/", read) + end, + ok. + +test_directory_handle(Name, ExpectedAccess) -> + {ok, DirFd} = file:open(Name, [read, directory]), + try + {ok,FileInfo} = ?FILE_MODULE:read_file_info(DirFd), + {ok,FileInfo} = ?FILE_MODULE:read_file_info(DirFd, [raw]), + #file_info{size=Size,type=Type,access=Access, + atime=AccessTime,mtime=ModifyTime} = FileInfo, + io:format("Testing directory ~s", [Name]), + io:format("Directory size is ~p", [Size]), + io:format("Access ~p", [Access]), + io:format("Access time ~p; Modify time~p", + [AccessTime, ModifyTime]), + Type = directory, + Access = ExpectedAccess, + all_integers(tuple_to_list(AccessTime) ++ tuple_to_list(ModifyTime)), + [] = flush(), + ok + after + file:close(DirFd) + end. + +%% Test that the file times behave as they should. + +file_handle_info_times(Config) when is_list(Config) -> + %% We have to try this twice, since if the test runs across the change + %% of a month the time diff calculations will fail. But it won't happen + %% if you run it twice in succession. + test_server:m_out_of_n( + 1,2, + fun() -> file_handle_info_int(Config) end), + ok. + +file_handle_info_int(Config) -> + %% Note: filename:join/1 removes any trailing slash, + %% which is essential for ?FILE_MODULE:file_info/1 to work on + %% platforms such as Windows95. + + RootDir = filename:join([proplists:get_value(priv_dir, Config)]), + io:format("RootDir = ~p", [RootDir]), + + Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_file_info.fil"), + {ok,Fd1} = ?FILE_MODULE:open(Name, write), + io:put_chars(Fd1,"foo"), + {ok,FileInfo1} = ?FILE_MODULE:read_file_info(Fd1), + ok = ?FILE_MODULE:close(Fd1), + + {ok,Fd1Raw} = ?FILE_MODULE:open(Name, [read, raw]), + {ok,FileInfo1Raw} = ?FILE_MODULE:read_file_info(Fd1Raw), + ok = ?FILE_MODULE:close(Fd1Raw), + + %% We assert that everything but the size is the same, on some OSs the + %% size may not have been flushed to disc and we do not want to do a + %% sync to force it. + FileInfo1Raw = FileInfo1#file_info{ size = FileInfo1Raw#file_info.size }, + + #file_info{type=regular,atime=AccTime1,mtime=ModTime1} = FileInfo1, + + Now = erlang:localtime(), %??? + io:format("Now ~p",[Now]), + io:format("Open file Acc ~p Mod ~p",[AccTime1,ModTime1]), + true = abs(time_dist(filter_atime(Now, Config), + filter_atime(AccTime1, + Config))) < 8, + true = abs(time_dist(Now,ModTime1)) < 8, + + %% Sleep until we can be sure the seconds value has changed. + %% Note: FAT-based filesystem (like on Windows 95) have + %% a resolution of 2 seconds. + timer:sleep(2200), + + %% close the file, and watch the modify date change + + {ok,Fd2} = ?FILE_MODULE:open(Name, read), + {ok,FileInfo2} = ?FILE_MODULE:read_file_info(Fd2), + ok = ?FILE_MODULE:close(Fd2), + + {ok,Fd2Raw} = ?FILE_MODULE:open(Name, [read, raw]), + {ok,FileInfo2Raw} = ?FILE_MODULE:read_file_info(Fd2Raw), + ok = ?FILE_MODULE:close(Fd2Raw), + + #file_info{size=Size,type=regular,access=Access, + atime=AccTime2,mtime=ModTime2} = FileInfo2 = FileInfo2Raw, + io:format("Closed file Acc ~p Mod ~p",[AccTime2,ModTime2]), + true = time_dist(ModTime1,ModTime2) >= 0, + + %% this file is supposed to be binary, so it'd better keep it's size + Size = 3, + Access = read_write, + + %% Do some directory checking + + {ok,Fd3} = ?FILE_MODULE:open(RootDir, [read, directory]), + {ok,FileInfo3} = ?FILE_MODULE:read_file_info(Fd3), + ok = ?FILE_MODULE:close(Fd3), + + {ok,Fd3Raw} = ?FILE_MODULE:open(RootDir, [read, directory, raw]), + {ok,FileInfo3Raw} = ?FILE_MODULE:read_file_info(Fd3Raw), + ok = ?FILE_MODULE:close(Fd3Raw), + + #file_info{size=DSize,type=directory,access=DAccess, + atime=AccTime3,mtime=ModTime3} = FileInfo3 = FileInfo3Raw, + %% this dir was modified only a few secs ago + io:format("Dir Acc ~p; Mod ~p; Now ~p", [AccTime3, ModTime3, Now]), + true = abs(time_dist(Now,ModTime3)) < 5, + DAccess = read_write, + io:format("Dir size is ~p",[DSize]), + + [] = flush(), + ok. + %% Test the write_file_info/2 function. file_write_file_info(Config) when is_list(Config) -> @@ -2042,24 +2233,33 @@ allocate_and_assert(Fd, Offset, Length) -> allocate_file_size(Config) when is_list(Config) -> case os:type() of {unix, darwin} -> - PrivDir = proplists:get_value(priv_dir, Config), - Allocate = filename:join(PrivDir, atom_to_list(?MODULE)++"_allocate_file"), - - {ok, Fd} = ?FILE_MODULE:open(Allocate, [write]), - ok = ?FILE_MODULE:allocate(Fd, 0, 1024), - {ok, 1024} = ?FILE_MODULE:position(Fd, eof), - ok = ?FILE_MODULE:close(Fd), - - [] = flush(), - ok; + do_allocate_file_size(Config); {unix, linux} -> - {skip, "file:allocate/3 on Linux does not change file size"}; + do_allocate_file_size(Config); {win32, _} -> {skip, "Windows does not support file:allocate/3"}; _ -> {skip, "Support for allocate/3 is spotty in our test platform at the moment."} end. +do_allocate_file_size(Config) when is_list(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + Allocate = filename:join(PrivDir, atom_to_list(?MODULE)++"_allocate_file"), + + {ok, Fd} = ?FILE_MODULE:open(Allocate, [write]), + Result = + case ?FILE_MODULE:allocate(Fd, 0, 1024) of + ok -> + {ok, 1024} = ?FILE_MODULE:position(Fd, eof), + ok; + {error, enotsup} -> + {skip, "Filesystem does not support file:allocate/3"} + end, + ok = ?FILE_MODULE:close(Fd), + + [] = flush(), + Result. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% delete(Config) when is_list(Config) -> diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl index 1be016444f..00c9dc5ed5 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE.erl +++ b/lib/kernel/test/gen_tcp_api_SUITE.erl @@ -594,10 +594,13 @@ unused_ip() -> io:format("we = ~p, unused_ip = ~p~n", [Hent, IP]), IP. -unused_ip(_, _, _, 255) -> error; +unused_ip(255, 255, 255, 255) -> error; +unused_ip(255, B, C, D) -> unused_ip(1, B + 1, C, D); +unused_ip(A, 255, C, D) -> unused_ip(A, 1, C + 1, D); +unused_ip(A, B, 255, D) -> unused_ip(A, B, 1, D + 1); unused_ip(A, B, C, D) -> case inet:gethostbyaddr({A, B, C, D}) of - {ok, _} -> unused_ip(A, B, C, D+1); + {ok, _} -> unused_ip(A + 1, B, C, D); {error, _} -> {ok, {A, B, C, D}} end. diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl index 5bff9cc292..3c4654b44c 100644 --- a/lib/kernel/test/global_SUITE.erl +++ b/lib/kernel/test/global_SUITE.erl @@ -43,7 +43,7 @@ -export([global_load/3, lock_global/2, lock_global2/2]). -export([]). --export([mass_spawn/1]). +-export([init_mass_spawn/1]). -export([start_tracer/0, stop_tracer/0, get_trace/0]). @@ -3887,7 +3887,7 @@ mass_death(Config) when is_list(Config) -> io:format("Nodes: ~p~n", [Nodes]), Ns = lists:seq(1, 40), %% Start processes with globally registered names on the nodes - {Pids,[]} = rpc:multicall(Nodes, ?MODULE, mass_spawn, [Ns]), + {Pids,[]} = rpc:multicall(Nodes, ?MODULE, init_mass_spawn, [Ns]), io:format("Pids: ~p~n", [Pids]), %% Wait... ct:sleep(10000), @@ -3924,6 +3924,11 @@ wait_mass_death(Nodes, OrigNames, Then, Config) -> wait_mass_death(Nodes, OrigNames, Then, Config) end. +init_mass_spawn(N) -> + Pid = mass_spawn(N), + unlink(Pid), + Pid. + mass_spawn([]) -> ok; mass_spawn([N|T]) -> @@ -3937,7 +3942,10 @@ mass_spawn([N|T]) -> Parent ! self(), loop() end), - receive Pid -> Pid end. + receive + Pid -> + Pid + end. mass_names([], _) -> []; diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index 44ec7e7076..efe48e7e99 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2018. All Rights Reserved. +%% Copyright Ericsson AB 1997-2020. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -35,7 +35,8 @@ ipv4_to_ipv6/0, ipv4_to_ipv6/1, host_and_addr/0, host_and_addr/1, t_gethostnative/1, - gethostnative_parallell/1, cname_loop/1, missing_hosts_reload/1, + gethostnative_parallell/1, cname_loop/1, + missing_hosts_reload/1, hosts_file_quirks/1, gethostnative_soft_restart/0, gethostnative_soft_restart/1, gethostnative_debug_level/0, gethostnative_debug_level/1, lookup_bad_search_option/1, @@ -43,6 +44,7 @@ getif_ifr_name_overflow/1,getservbyname_overflow/1, getifaddrs/1, parse_strict_address/1, ipv4_mapped_ipv6_address/1, simple_netns/1, simple_netns_open/1, + add_del_host/1, add_del_host_v6/1, simple_bind_to_device/1, simple_bind_to_device_open/1]). -export([get_hosts/1, get_ipv6_hosts/1, parse_hosts/1, parse_address/1, @@ -57,11 +59,13 @@ all() -> [t_gethostbyaddr, t_gethostbyname, t_getaddr, t_gethostbyaddr_v6, t_gethostbyname_v6, t_getaddr_v6, ipv4_to_ipv6, host_and_addr, {group, parse}, - t_gethostnative, gethostnative_parallell, cname_loop, missing_hosts_reload, + t_gethostnative, gethostnative_parallell, cname_loop, + missing_hosts_reload, hosts_file_quirks, gethostnative_debug_level, gethostnative_soft_restart, lookup_bad_search_option, getif, getif_ifr_name_overflow, getservbyname_overflow, getifaddrs, parse_strict_address, simple_netns, simple_netns_open, + add_del_host, add_del_host_v6, simple_bind_to_device, simple_bind_to_device_open]. groups() -> @@ -698,6 +702,8 @@ t_gethostnative(Config) when is_list(Config) -> {error,notfound} -> ok; {error,no_data} -> + ok; + {error,try_again} -> ok end. @@ -868,6 +874,176 @@ missing_hosts_reload(Config) when is_list(Config) -> % cleanup true = test_server:stop_node(TestNode). + +%% The /etc/hosts file format and limitations is quite undocumented. +%% +%% Our implementation of the hosts file resolver tries to +%% do the right thing. Here is an attempt to define "the right thing", +%% and this test case tries to check most of these rules: +%% +%% * A hosts file consists of entries with one IP address, +%% and a list of host names. The IP address is IPv4 or IPv6. +%% The first host name is the primary host name +%% and the others are aliases. +%% +%% * A lookup for an IP address should return one #hostent{} record +%% with the one IP address from the query, and the host names +%% from all entries with the same IP address concatenated. +%% The first host name from the first hosts file entry +%% with the requested IP address will be the primary host name +%% and all others are aliases. All host names are returned +%% as in the hosts file entries i.e character case is preserved. +%% +%% * A lookup for a host name is character case insensitive. +%% +%% * A lookup for a host name should return one #hostent{} record +%% with the host name list from the first hosts file entry +%% with an IP address of the requested address family +%% that has a matching host name, as it is in the hosts file +%% i.e character case is preserved. The IP addresses in the +%% returned #hostent{} record should be the first from the +%% same matching hosts file entry, followed by all others +%% for which there is a matching host name and address family. +%% There should be no duplicates among the returned IP addresses. +%% +%% * These rules are of the opinion that if duplicate host names +%% with the same character casing occurs for the same IP +%% address, it is a configuration error, so it is not tested for +%% and there is no preferred behaviour. +hosts_file_quirks(Config) when is_list(Config) -> + Records = [R1, R2, R3, R4, R5] = + [#hostent{ + h_name = h_ex(Name), + h_aliases = [h_ex(Alias) || Alias <- Aliases], + h_addrtype = Fam, + h_length = + case Fam of + inet -> 4; + inet6 -> 16 + end, + h_addr_list = + [case Fam of + inet -> inet_ex(N); + inet6 -> inet6_ex(N) + end]} + || {{Fam,N}, Name, Aliases} <- + [{{inet,1}, "a", ["B"]}, + {{inet,2}, "D", []}, + {{inet6,3}, "A", ["c"]}, + {{inet,1}, "c", []}, + {{inet,5}, "A", []}]], + true = R1#hostent.h_addr_list =:= R4#hostent.h_addr_list, + R14 = + R1#hostent{ + h_aliases = + R1#hostent.h_aliases ++ + [R4#hostent.h_name | R4#hostent.h_aliases]}, + R145 = + R14#hostent{ + h_addr_list = + R1#hostent.h_addr_list ++ R5#hostent.h_addr_list}, + %% + RootDir = proplists:get_value(priv_dir,Config), + HostsFile = filename:join(RootDir, atom_to_list(?MODULE) ++ "-quirks.hosts"), + InetRc = filename:join(RootDir, "quirks.inetrc"), + ok = file:write_file(HostsFile, hostents_to_list(Records)), + ok = file:write_file(InetRc, "{hosts_file, \"" ++ HostsFile ++ "\"}.\n"), + %% + %% start a node + Pa = filename:dirname(code:which(?MODULE)), + {ok, TestNode} = test_server:start_node(?MODULE, slave, + [{args, "-pa " ++ Pa ++ " -kernel inetrc '\"" ++ InetRc ++ "\"'"}]), + %% ensure it has our RC + Rc = rpc:call(TestNode, inet_db, get_rc, []), + {hosts_file, HostsFile} = lists:keyfind(hosts_file, 1, Rc), + %% + %% check entries + io:format("Check hosts file contents~n", []), + V1 = + [{R14, inet_ex(1)}, + {R2, inet_ex(2)}, + {R3, inet6_ex(3)}, + {R5, inet_ex(5)}, + {R145, h_ex("a"), inet}, + {R14, h_ex("b"), inet}, + {R14, h_ex("c"), inet}, + {R2, h_ex("d"), inet}, + {R3, h_ex("a"), inet6}, + {R3, h_ex("c"), inet6} + ], + hosts_file_quirks_verify(TestNode, V1), + %% + %% test add and del + ok = + rpc:call( + TestNode, inet_db, add_host, + [inet_ex(1), [h_ex("a"), h_ex("B")]]), + io:format("Check after add host~n", []), + hosts_file_quirks_verify( + TestNode, + [{R1, inet_ex(1)}, + {R2, inet_ex(2)}, + {R3, inet6_ex(3)}, + {R5, inet_ex(5)}, + {R1, h_ex("a"), inet}, + {R1, h_ex("b"), inet}, + {R14, h_ex("c"), inet}, + {R2, h_ex("d"), inet}, + {R3, h_ex("a"), inet6}, + {R3, h_ex("c"), inet6} + ]), + ok = rpc:call(TestNode, inet_db, del_host, [inet_ex(1)]), + io:format("Check after del host~n", []), + hosts_file_quirks_verify(TestNode, V1), + %% + %% cleanup + true = test_server:stop_node(TestNode). + +hosts_file_quirks_verify(_TestNode, Vs) -> + hosts_file_quirks_verify(_TestNode, Vs, true). +%% +hosts_file_quirks_verify(_TestNode, [], Ok) -> + case Ok of + true -> ok; + false -> error(verify_failed) + end; +hosts_file_quirks_verify(TestNode, [V | Vs], Ok) -> + case + case V of + {R, Addr} -> + {R, rpc:call(TestNode, inet_hosts, gethostbyaddr, [Addr])}; + {R, Host, Fam} -> + {R, rpc:call(TestNode, inet_hosts, gethostbyname, [Host, Fam])} + end + of + {nxdomain, {error, nxdomain}} -> + hosts_file_quirks_verify(TestNode, Vs, Ok); + {_R_1, {error, nxdomain}} -> + io:format("Verify failed ~p: nxdomain~n", [V]), + hosts_file_quirks_verify(TestNode, Vs, false); + {R_1, {ok, R_1}} -> + hosts_file_quirks_verify(TestNode, Vs, Ok); + {_R_1, {ok, R_2}} -> + io:format("Verify failed ~p: ~p~n", [V, R_2]), + hosts_file_quirks_verify(TestNode, Vs, false) + end. + +%% Expand entry +h_ex(H) -> H ++ ".example.com". +inet_ex(N) -> {127,17,17,N}. +inet6_ex(N) -> {0,0,0,0,17,17,17,N}. + +hostents_to_list([]) -> []; +hostents_to_list([R | Rs]) -> + #hostent{ + h_name = Name, + h_aliases = Aliases, + h_addr_list = [IP]} = R, + [inet:ntoa(IP), $\t, + lists:join($\s, [Name | Aliases]), $\r, $\n + | hostents_to_list(Rs)]. + + %% These must be run in the whole suite since they need %% the host list and require inet_gethost_native to be started. %% @@ -1413,3 +1589,46 @@ jog_bind_to_device_opt(S) -> ok = inet:setopts(S, [{bind_to_device,<<"lo">>}]), {ok,[{bind_to_device,<<"lo">>}]} = inet:getopts(S, [bind_to_device]), ok. + +add_del_host(_Config) -> + Name = "foo.com", + Alias = "bar.org", + Ip = {69,89,31,226}, + HostEnt = #hostent{ + h_name = Name, + h_aliases = [Alias], + h_addrtype = inet, + h_length = 4, + h_addr_list = [Ip] + }, + {error, nxdomain} = inet_hosts:gethostbyname(Name, inet), + ok = inet_db:add_host(Ip, [Name, Alias]), + {ok, HostEnt} = inet_hosts:gethostbyname(Name, inet), + {ok, HostEnt} = inet_hosts:gethostbyname(Alias, inet), + ok = inet_db:del_host(Ip), + {error, nxdomain} = inet_hosts:gethostbyname(Name, inet), + {error, nxdomain} = inet_hosts:gethostbyname(Alias, inet), + ok = inet_db:add_host(Ip, [Name, Alias]), + {ok, HostEnt} = inet_hosts:gethostbyname(Name, inet). + +add_del_host_v6(_Config) -> + Name = "foo.com", + Alias = "bar.org", + Ip = {32,1,219,8,10,11,18,240}, + HostEnt = #hostent{ + h_name = Name, + h_aliases = [Alias], + h_addrtype = inet6, + h_length = 16, + h_addr_list = [Ip] + }, + {error, nxdomain} = inet_hosts:gethostbyname(Name, inet6), + ok = inet_db:add_host(Ip, [Name, Alias]), + {ok, HostEnt} = inet_hosts:gethostbyname(Name, inet6), + {ok, HostEnt} = inet_hosts:gethostbyname(Alias, inet6), + ok = inet_db:del_host(Ip), + {error, nxdomain} = inet_hosts:gethostbyname(Name, inet6), + {error, nxdomain} = inet_hosts:gethostbyname(Alias, inet6), + ok = inet_db:add_host(Ip, [Name, Alias]), + {ok, HostEnt} = inet_hosts:gethostbyname(Name, inet6). + diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl index 9d35611d93..ceee387289 100644 --- a/lib/kernel/test/init_SUITE.erl +++ b/lib/kernel/test/init_SUITE.erl @@ -25,7 +25,7 @@ init_per_group/2,end_per_group/2]). -export([get_arguments/1, get_argument/1, boot_var/1, restart/1, - many_restarts/0, many_restarts/1, + many_restarts/0, many_restarts/1, restart_with_mode/1, get_plain_arguments/1, reboot/1, stop_status/1, stop/1, get_status/1, script_id/1, find_system_processes/0]). @@ -48,7 +48,7 @@ suite() -> all() -> [get_arguments, get_argument, boot_var, - many_restarts, + many_restarts, restart_with_mode, get_plain_arguments, restart, stop_status, get_status, script_id, {group, boot}]. @@ -348,6 +348,22 @@ wait_for(N,Node,EHPid) -> wait_for(N-1,Node,EHPid) end. +restart_with_mode(Config) when is_list(Config) -> + %% We cannot use loose_node because it doesn't run in + %% embedded mode so we quickly start one that exits after restarting + {ok,[[Erl]]} = init:get_argument(progname), + ModPath = filename:dirname(code:which(?MODULE)), + + Eval1 = "'Mode=code:get_mode(), io:fwrite(Mode), case Mode of interactive -> init:restart([{mode,embedded}]); embedded -> erlang:halt() end'", + Cmd1 = Erl ++ " -mode interactive -noshell -eval " ++ Eval1, + "interactiveembedded" = os:cmd(Cmd1), + + Eval2 = "'Mode=code:get_mode(), io:fwrite(Mode), case Mode of embedded -> init:restart([{mode,interactive}]); interactive -> erlang:halt() end'", + Cmd2 = Erl ++ " -mode embedded -noshell -eval " ++ Eval2, + "embeddedinteractive" = os:cmd(Cmd2), + + ok. + %% ------------------------------------------------ %% Slave executes erlang:halt() on master nodedown. %% Therefore the slave process must be killed diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl index 173e25c520..883abda067 100644 --- a/lib/kernel/test/interactive_shell_SUITE.erl +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -22,7 +22,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, get_columns_and_rows/1, exit_initial/1, job_control_local/1, - job_control_remote/1, + job_control_remote/1,stop_during_init/1, job_control_remote_noshell/1,ctrl_keys/1, get_columns_and_rows_escript/1]). @@ -44,7 +44,7 @@ all() -> [get_columns_and_rows_escript,get_columns_and_rows, exit_initial, job_control_local, job_control_remote, job_control_remote_noshell, - ctrl_keys]. + ctrl_keys, stop_during_init]. groups() -> []. @@ -205,6 +205,22 @@ exit_initial(Config) when is_list(Config) -> {getline_re,"35"}],[]) end. +stop_during_init(Config) when is_list(Config) -> + case get_progs() of + {error,_Reason} -> + {skip,"No runerl present"}; + {RunErl,_ToErl,Erl} -> + case create_tempdir() of + {error, Reason2} -> + {skip, Reason2}; + Tempdir -> + XArg = " -kernel shell_history true -s init stop", + start_runerl_command(RunErl, Tempdir, "\\\""++Erl++"\\\""++XArg), + {ok, Binary} = file:read_file(filename:join(Tempdir, "erlang.log.1")), + nomatch = binary:match(Binary, <<"*** ERROR: Shell process terminated! ***">>) + end + end. + %% Tests that local shell can be started by means of job control. job_control_local(Config) when is_list(Config) -> case proplists:get_value(default_shell,Config) of @@ -656,10 +672,10 @@ start_runerl_node(RunErl,Erl,Tempdir,Nodename) -> end)++ " -setcookie "++atom_to_list(erlang:get_cookie()) end, - spawn(fun() -> - os:cmd("\""++RunErl++"\" "++Tempdir++"/ "++Tempdir++" \""++ - Erl++XArg++"\"") - end). + spawn(fun() -> start_runerl_command(RunErl, Tempdir, Erl++XArg) end). + +start_runerl_command(RunErl, Tempdir, Cmd) -> + os:cmd("\""++RunErl++"\" "++Tempdir++"/ "++Tempdir++" \""++Cmd++"\""). start_toerl_server(ToErl,Tempdir) -> Pid = spawn(?MODULE,toerl_server,[self(),ToErl,Tempdir]), diff --git a/lib/kernel/test/kernel_SUITE.erl b/lib/kernel/test/kernel_SUITE.erl index 3e5ed855b5..1a88c70963 100644 --- a/lib/kernel/test/kernel_SUITE.erl +++ b/lib/kernel/test/kernel_SUITE.erl @@ -23,6 +23,7 @@ -module(kernel_SUITE). -include_lib("common_test/include/ct.hrl"). +-compile(r21). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, @@ -106,7 +107,7 @@ appup_tests(App,{OkVsns0,NokVsns}) -> create_test_vsns(App) -> ThisMajor = erlang:system_info(otp_release), FirstMajor = previous_major(ThisMajor), - SecondMajor = previous_major(FirstMajor), + SecondMajor = previous_major(previous_major(FirstMajor)), Ok = app_vsn(App,[ThisMajor,FirstMajor]), Nok0 = app_vsn(App,[SecondMajor]), Nok = case Ok of diff --git a/lib/kernel/test/logger_SUITE.erl b/lib/kernel/test/logger_SUITE.erl index f8f3d27778..f9dce3b61e 100644 --- a/lib/kernel/test/logger_SUITE.erl +++ b/lib/kernel/test/logger_SUITE.erl @@ -276,7 +276,7 @@ change_config(_Config) -> logger:get_primary_config(), 3 = maps:size(PC1), %% Check that internal 'handlers' field has not been changed - MS = [{{{?HANDLER_KEY,'$1'},'_','_'},[],['$1']}], + MS = [{{{?HANDLER_KEY,'$1'},'_'},[],['$1']}], HIds1 = lists:sort(ets:select(?LOGGER_TABLE,MS)), % dirty, internal data HIds2 = lists:sort(logger:get_handler_ids()), HIds1 = HIds2, @@ -478,14 +478,15 @@ set_application_level(cleanup,_Config) -> ok. cache_module_level(_Config) -> - ok = logger:unset_module_level(?MODULE), - [] = ets:lookup(?LOGGER_TABLE,?MODULE), %dirty - add API in logger_config? + + %% This test does a lot of whitebox tests so be prepared for that + persistent_term:erase({logger_config,?MODULE}), + + primary = persistent_term:get({logger_config,?MODULE}, primary), ?LOG_NOTICE(?map_rep), - %% Caching is done asynchronously, so wait a bit for the update - timer:sleep(100), - [_] = ets:lookup(?LOGGER_TABLE,?MODULE), %dirty - add API in logger_config? - ok = logger:unset_module_level(?MODULE), - [] = ets:lookup(?LOGGER_TABLE,?MODULE), %dirty - add API in logger_config? + 5 = persistent_term:get({logger_config,?MODULE}, primary), + logger:set_primary_config(level, info), + 6 = persistent_term:get({logger_config,?MODULE}, primary), ok. cache_module_level(cleanup,_Config) -> @@ -569,6 +570,7 @@ filter_failed(cleanup,_Config) -> ok. handler_failed(_Config) -> + logger:set_primary_config(level,all), register(callback_receiver,self()), {error,{invalid_id,1}} = logger:add_handler(1,?MODULE,#{}), {error,{invalid_module,"nomodule"}} = logger:add_handler(h1,"nomodule",#{}), @@ -612,7 +614,7 @@ handler_failed(_Config) -> logger:add_handler(h1,?MODULE,#{add_call=>KillHandler}), check_no_log(), - ok = logger:add_handler(h1,?MODULE,#{}), + ok = logger:add_handler(h1,?MODULE,#{tc_proc=>self()}), {error,{attempting_syncronous_call_to_self,_}} = logger:set_handler_config(h1,#{conf_call=>CallAddHandler}), {error,{callback_crashed,_}} = @@ -628,7 +630,8 @@ handler_failed(_Config) -> logger:set_handler_config(h1,conf_call,KillHandler), ok = logger:remove_handler(h1), - [add,remove] = test_server:messages_get(), + [add,{#{level:=error},_},{#{level:=error},_}, + {#{level:=error},_},{#{level:=error},_},remove] = test_server:messages_get(), check_no_log(), ok = logger:add_handler(h1,?MODULE,#{rem_call=>CallAddHandler}), @@ -644,6 +647,7 @@ handler_failed(_Config) -> handler_failed(cleanup,_Config) -> logger:remove_handler(h1), logger:remove_handler(h2), + logger:set_primary_config(level,info), ok. config_sanity_check(_Config) -> @@ -1146,7 +1150,7 @@ kernel_config(Config) -> ok. -pretty_print(Config) -> +pretty_print(_Config) -> ok = logger:add_handler(?FUNCTION_NAME,logger_std_h,#{}), ok = logger:set_module_level([module1,module2],debug), @@ -1280,11 +1284,21 @@ test_api(Level) -> ok = check_logged(Level,#{Level=>rep},#{my=>meta}), logger:Level("~w: ~w",[Level,fa]), ok = check_logged(Level,"~w: ~w",[Level,fa],#{}), + logger:Level('~w: ~w',[Level,fa]), + ok = check_logged(Level,'~w: ~w',[Level,fa],#{}), + logger:Level(<<"~w: ~w">>,[Level,fa]), + ok = check_logged(Level,<<"~w: ~w">>,[Level,fa],#{}), logger:Level("~w: ~w ~w",[Level,fa,meta],#{my=>meta}), ok = check_logged(Level,"~w: ~w ~w",[Level,fa,meta],#{my=>meta}), logger:Level(fun(x) -> {"~w: ~w ~w",[Level,fun_to_fa,meta]} end,x, #{my=>meta}), ok = check_logged(Level,"~w: ~w ~w",[Level,fun_to_fa,meta],#{my=>meta}), + logger:Level(fun(x) -> {<<"~w: ~w ~w">>,[Level,fun_to_fa,meta]} end,x, + #{my=>meta}), + ok = check_logged(Level,<<"~w: ~w ~w">>,[Level,fun_to_fa,meta],#{my=>meta}), + logger:Level(fun(x) -> {'~w: ~w ~w',[Level,fun_to_fa,meta]} end,x, + #{my=>meta}), + ok = check_logged(Level,'~w: ~w ~w',[Level,fun_to_fa,meta],#{my=>meta}), logger:Level(fun(x) -> #{Level=>fun_to_r,meta=>true} end,x, #{my=>meta}), ok = check_logged(Level,#{Level=>fun_to_r,meta=>true},#{my=>meta}), @@ -1310,6 +1324,12 @@ test_log_function(Level) -> logger:log(Level,fun(x) -> {"~w: ~w ~w",[Level,fun_to_fa,meta]} end, x, #{my=>meta}), ok = check_logged(Level,"~w: ~w ~w",[Level,fun_to_fa,meta],#{my=>meta}), + logger:log(Level,fun(x) -> {<<"~w: ~w ~w">>,[Level,fun_to_fa,meta]} end, + x, #{my=>meta}), + ok = check_logged(Level,<<"~w: ~w ~w">>,[Level,fun_to_fa,meta],#{my=>meta}), + logger:log(Level,fun(x) -> {'~w: ~w ~w',[Level,fun_to_fa,meta]} end, + x, #{my=>meta}), + ok = check_logged(Level,'~w: ~w ~w',[Level,fun_to_fa,meta],#{my=>meta}), logger:log(Level,fun(x) -> #{Level=>fun_to_r,meta=>true} end, x, #{my=>meta}), ok = check_logged(Level,#{Level=>fun_to_r,meta=>true},#{my=>meta}), diff --git a/lib/kernel/test/logger_formatter_SUITE.erl b/lib/kernel/test/logger_formatter_SUITE.erl index 83e3e6c40a..5217f76cbc 100644 --- a/lib/kernel/test/logger_formatter_SUITE.erl +++ b/lib/kernel/test/logger_formatter_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018. All Rights Reserved. +%% Copyright Ericsson AB 2018-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -568,6 +568,11 @@ format_mfa(_Config) -> ct:log(String4), "othermfa" = String4, + Meta5 = #{mfa=>{'m o d','a\x{281}b',[' ']}}, + String5 = format(info,{"~p",[term]},Meta5,#{template=>Template}), + ct:log(String5), + "'m o d':'a\x{281}b'/1" = String5, + ok. format_time(_Config) -> diff --git a/lib/kernel/test/logger_legacy_SUITE.erl b/lib/kernel/test/logger_legacy_SUITE.erl index c3cab07d81..0e46ec3ee3 100644 --- a/lib/kernel/test/logger_legacy_SUITE.erl +++ b/lib/kernel/test/logger_legacy_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018. All Rights Reserved. +%% Copyright Ericsson AB 2018-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -137,9 +137,9 @@ gen_event(_Config) -> ok = gen_event:add_handler(Pid,?MODULE,gen_event), Msg = fun() -> erlang:error({badmatch,b}) end, Pid ! Msg, - ?check({warning_msg,"** Undefined handle_info in ~tp"++_,[?MODULE,Msg]}), + ?check({warning_msg,"** Undefined handle_info in ~p"++_,[?MODULE,Msg]}), gen_event:notify(Pid,Msg), - ?check({error,"** gen_event handler ~p crashed."++_, + ?check({error,"** gen_event handler ~tp crashed."++_, [?MODULE,Pid,Msg,gen_event,{{badmatch,b},_}]}). gen_fsm(_Config) -> diff --git a/lib/kernel/test/logger_std_h_SUITE.erl b/lib/kernel/test/logger_std_h_SUITE.erl index 602a79c78b..ec0e5122e8 100644 --- a/lib/kernel/test/logger_std_h_SUITE.erl +++ b/lib/kernel/test/logger_std_h_SUITE.erl @@ -305,6 +305,8 @@ formatter_fail(Config) -> Dir = ?config(priv_dir,Config), Log = filename:join(Dir,?FUNCTION_NAME), + logger:set_primary_config(level,all), + %% no formatter ok = logger:add_handler(?MODULE, logger_std_h, @@ -346,6 +348,7 @@ formatter_fail(Config) -> ok. formatter_fail(cleanup,_Config) -> + logger:set_primary_config(level,info), logger:remove_handler(?MODULE). config_fail(_Config) -> @@ -2200,10 +2203,14 @@ check_tracer(T,TimeoutFun) -> TimeoutFun() end. -escape([$+|Rest]) -> - [$\\,$+|escape(Rest)]; -escape([H|T]) -> - [H|escape(T)]; +escape([C|Rest]) -> + %% The characters that have to be escaped in a regex + case lists:member(C,"[-[\]{}()*+?.,\\^$|#\s]") of + true -> + [$\\,C|escape(Rest)]; + false -> + [C|escape(Rest)] + end; escape([]) -> []. diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index 710b9b115c..e952dec625 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -324,14 +324,18 @@ close_stdin(Config) -> "-1" = os:cmd(Fds). max_size_command(_Config) -> + WSL = case os:getenv("WSLENV") of + false -> ""; + _ -> "wsl " + end, - Res20 = os:cmd("cat /dev/zero", #{ max_size => 20 }), + Res20 = os:cmd(WSL ++ "cat /dev/zero", #{ max_size => 20 }), 20 = length(Res20), - Res0 = os:cmd("cat /dev/zero", #{ max_size => 0 }), + Res0 = os:cmd(WSL ++ "cat /dev/zero", #{ max_size => 0 }), 0 = length(Res0), - Res32768 = os:cmd("cat /dev/zero", #{ max_size => 32768 }), + Res32768 = os:cmd(WSL ++ "cat /dev/zero", #{ max_size => 32768 }), 32768 = length(Res32768), ResHello = string:trim(os:cmd("echo hello", #{ max_size => 20 })), diff --git a/lib/kernel/test/pg_SUITE.erl b/lib/kernel/test/pg_SUITE.erl new file mode 100644 index 0000000000..bdb7abe99d --- /dev/null +++ b/lib/kernel/test/pg_SUITE.erl @@ -0,0 +1,619 @@ +%% +%% +%% Copyright WhatsApp Inc. and its affiliates. All rights reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%%------------------------------------------------------------------- +%% @author Maxim Fedorov <maximfca@gmail.com> +%% Process Groups smoke test. +-module(pg_SUITE). +-author("maximfca@gmail.com"). + +%% Test server callbacks +-export([ + suite/0, + all/0, + groups/0, + init_per_suite/1, + end_per_suite/1, + init_per_testcase/2, + end_per_testcase/2, + stop_proc/1 +]). + +%% Test cases exports +-export([ + pg/0, pg/1, + errors/0, errors/1, + leave_exit_race/0, leave_exit_race/1, + single/0, single/1, + two/1, + thundering_herd/0, thundering_herd/1, + initial/1, + netsplit/1, + trisplit/1, + foursplit/1, + exchange/1, + nolocal/1, + double/1, + scope_restart/1, + missing_scope_join/1, + disconnected_start/1, + forced_sync/0, forced_sync/1, + group_leave/1 +]). + +-export([ + control/1, + controller/3 +]). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("stdlib/include/assert.hrl"). + +suite() -> + [{timetrap, {seconds, 10}}]. + +init_per_suite(Config) -> + case erlang:is_alive() of + false -> + %% verify epmd running (otherwise next call fails) + (erl_epmd:names("localhost") =:= {error, address}) andalso ([] = os:cmd("epmd -daemon")), + %% start a random node name + NodeName = list_to_atom(lists:concat([atom_to_list(?MODULE), "_", os:getpid()])), + {ok, Pid} = net_kernel:start([NodeName, shortnames]), + [{distribution, Pid} | Config]; + true -> + Config + end. + +end_per_suite(Config) -> + is_pid(proplists:get_value(distribution, Config)) andalso net_kernel:stop(). + +init_per_testcase(TestCase, Config) -> + {ok, _Pid} = pg:start_link(TestCase), + Config. + +end_per_testcase(TestCase, _Config) -> + gen_server:stop(TestCase), + ok. + +all() -> + [{group, basic}, {group, cluster}, {group, performance}]. + +groups() -> + [ + {basic, [parallel], [errors, pg, leave_exit_race, single]}, + {performance, [sequential], [thundering_herd]}, + {cluster, [parallel], [two, initial, netsplit, trisplit, foursplit, + exchange, nolocal, double, scope_restart, missing_scope_join, + disconnected_start, forced_sync, group_leave]} + ]. + +%%-------------------------------------------------------------------- +%% TEST CASES + +pg() -> + [{doc, "This test must be names pg, to stay inline with default scope"}]. + +pg(_Config) -> + ?assertNotEqual(undefined, whereis(?FUNCTION_NAME)), %% ensure scope was started + ?assertEqual(ok, pg:join(?FUNCTION_NAME, self())), + ?assertEqual([self()], pg:get_local_members(?FUNCTION_NAME)), + ?assertEqual([?FUNCTION_NAME], pg:which_groups()), + ?assertEqual([?FUNCTION_NAME], pg:which_local_groups()), + ?assertEqual(ok, pg:leave(?FUNCTION_NAME, self())), + ?assertEqual([], pg:get_members(?FUNCTION_NAME)), + ?assertEqual([], pg:which_groups(?FUNCTION_NAME)), + ?assertEqual([], pg:which_local_groups(?FUNCTION_NAME)). + +errors() -> + [{doc, "Tests that errors are handled as expected, for example pg server crashes when it needs to"}]. + +errors(_Config) -> + %% kill with 'info' and 'cast' + ?assertException(error, badarg, pg:handle_info(garbage, garbage)), + ?assertException(error, badarg, pg:handle_cast(garbage, garbage)), + %% kill with call + {ok, _Pid} = pg:start(second), + ?assertException(exit, {{badarg, _}, _}, gen_server:call(second, garbage, 100)). + +leave_exit_race() -> + [{doc, "Tests that pg correctly handles situation when leave and 'DOWN' messages are both in pg queue"}]. + +leave_exit_race(Config) when is_list(Config) -> + process_flag(priority, high), + [ + begin + Pid = spawn(fun () -> ok end), + pg:join(leave_exit_race, test, Pid), + pg:leave(leave_exit_race, test, Pid) + end + || _ <- lists:seq(1, 100)]. + +single() -> + [{doc, "Tests single node groups"}, {timetrap, {seconds, 5}}]. + +single(Config) when is_list(Config) -> + ?assertEqual(ok, pg:join(?FUNCTION_NAME, ?FUNCTION_NAME, self())), + ?assertEqual(ok, pg:join(?FUNCTION_NAME, ?FUNCTION_NAME, [self(), self()])), + ?assertEqual([self(), self(), self()], pg:get_local_members(?FUNCTION_NAME, ?FUNCTION_NAME)), + ?assertEqual([self(), self(), self()], pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME)), + ?assertEqual(not_joined, pg:leave(?FUNCTION_NAME, '$missing$', self())), + ?assertEqual(ok, pg:leave(?FUNCTION_NAME, ?FUNCTION_NAME, [self(), self()])), + ?assertEqual(ok, pg:leave(?FUNCTION_NAME, ?FUNCTION_NAME, self())), + ?assertEqual([], pg:which_groups(?FUNCTION_NAME)), + ?assertEqual([], pg:get_local_members(?FUNCTION_NAME, ?FUNCTION_NAME)), + ?assertEqual([], pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME)), + %% double + ?assertEqual(ok, pg:join(?FUNCTION_NAME, ?FUNCTION_NAME, self())), + Pid = erlang:spawn(forever()), + ?assertEqual(ok, pg:join(?FUNCTION_NAME, ?FUNCTION_NAME, Pid)), + Expected = lists:sort([Pid, self()]), + ?assertEqual(Expected, lists:sort(pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME))), + ?assertEqual(Expected, lists:sort(pg:get_local_members(?FUNCTION_NAME, ?FUNCTION_NAME))), + + stop_proc(Pid), + sync(?FUNCTION_NAME), + ?assertEqual([self()], pg:get_local_members(?FUNCTION_NAME, ?FUNCTION_NAME)), + ?assertEqual(ok, pg:leave(?FUNCTION_NAME, ?FUNCTION_NAME, self())), + ok. + +two(Config) when is_list(Config) -> + {TwoPeer, Socket} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + Pid = erlang:spawn(forever()), + ?assertEqual(ok, pg:join(?FUNCTION_NAME, ?FUNCTION_NAME, Pid)), + ?assertEqual([Pid], pg:get_local_members(?FUNCTION_NAME, ?FUNCTION_NAME)), + %% first RPC must be serialised + sync({?FUNCTION_NAME, TwoPeer}), + ?assertEqual([Pid], rpc:call(TwoPeer, pg, get_members, [?FUNCTION_NAME, ?FUNCTION_NAME])), + ?assertEqual([], rpc:call(TwoPeer, pg, get_local_members, [?FUNCTION_NAME, ?FUNCTION_NAME])), + stop_proc(Pid), + %% again, must be serialised + sync(?FUNCTION_NAME), + ?assertEqual([], pg:get_local_members(?FUNCTION_NAME, ?FUNCTION_NAME)), + ?assertEqual([], rpc:call(TwoPeer, pg, get_members, [?FUNCTION_NAME, ?FUNCTION_NAME])), + + Pid2 = erlang:spawn(TwoPeer, forever()), + Pid3 = erlang:spawn(TwoPeer, forever()), + ?assertEqual(ok, rpc:call(TwoPeer, pg, join, [?FUNCTION_NAME, ?FUNCTION_NAME, Pid2])), + ?assertEqual(ok, rpc:call(TwoPeer, pg, join, [?FUNCTION_NAME, ?FUNCTION_NAME, Pid3])), + %% serialise through the *other* node + sync({?FUNCTION_NAME, TwoPeer}), + ?assertEqual(lists:sort([Pid2, Pid3]), + lists:sort(pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME))), + %% stop the peer + stop_node(TwoPeer, Socket), + %% hope that 'nodedown' comes before we route our request + sync(?FUNCTION_NAME), + ?assertEqual([], pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME)), + ok. + +thundering_herd() -> + [{doc, "Thousands of overlay network nodes sending sync to us, and we time out!"}, {timetrap, {seconds, 5}}]. + +thundering_herd(Config) when is_list(Config) -> + GroupCount = 10000, + SyncCount = 2000, + %% make up a large amount of groups + [pg:join(?FUNCTION_NAME, {group, Seq}, self()) || Seq <- lists:seq(1, GroupCount)], + %% initiate a few syncs - and those are really slow... + {Peer, Socket} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + PeerPid = erlang:spawn(Peer, forever()), + PeerPg = rpc:call(Peer, erlang, whereis, [?FUNCTION_NAME], 1000), + %% WARNING: code below acts for white-box! %% WARNING + FakeSync = [{{group, 1}, [PeerPid, PeerPid]}], + [gen_server:cast(?FUNCTION_NAME, {sync, PeerPg, FakeSync}) || _ <- lists:seq(1, SyncCount)], + %% next call must not timetrap, otherwise test fails + pg:join(?FUNCTION_NAME, ?FUNCTION_NAME, self()), + stop_node(Peer, Socket). + +initial(Config) when is_list(Config) -> + Pid = erlang:spawn(forever()), + ?assertEqual(ok, pg:join(?FUNCTION_NAME, ?FUNCTION_NAME, Pid)), + ?assertEqual([Pid], pg:get_local_members(?FUNCTION_NAME, ?FUNCTION_NAME)), + {Peer, Socket} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + %% first RPC must be serialised + sync({?FUNCTION_NAME, Peer}), + ?assertEqual([Pid], rpc:call(Peer, pg, get_members, [?FUNCTION_NAME, ?FUNCTION_NAME])), + + ?assertEqual([], rpc:call(Peer, pg, get_local_members, [?FUNCTION_NAME, ?FUNCTION_NAME])), + stop_proc(Pid), + sync({?FUNCTION_NAME, Peer}), + ?assertEqual([], rpc:call(Peer, pg, get_members, [?FUNCTION_NAME, ?FUNCTION_NAME])), + stop_node(Peer, Socket), + ok. + +netsplit(Config) when is_list(Config) -> + {Peer, Socket} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + ?assertEqual(Peer, rpc(Socket, erlang, node, [])), %% just to test RPC + RemoteOldPid = erlang:spawn(Peer, forever()), + ?assertEqual(ok, rpc:call(Peer, pg, join, [?FUNCTION_NAME, '$invisible', RemoteOldPid])), + %% hohoho, partition! + net_kernel:disconnect(Peer), + ?assertEqual(Peer, rpc(Socket, erlang, node, [])), %% just to ensure RPC still works + RemotePid = rpc(Socket, erlang, spawn, [forever()]), + ?assertEqual([], rpc(Socket, erlang, nodes, [])), + ?assertEqual(ok, rpc(Socket, pg, join, [?FUNCTION_NAME, ?FUNCTION_NAME, RemotePid])), %% join - in a partition! + + ?assertEqual(ok, rpc(Socket, pg, leave, [?FUNCTION_NAME, '$invisible', RemoteOldPid])), + ?assertEqual(ok, rpc(Socket, pg, join, [?FUNCTION_NAME, '$visible', RemoteOldPid])), + ?assertEqual([RemoteOldPid], rpc(Socket, pg, get_local_members, [?FUNCTION_NAME, '$visible'])), + %% join locally too + LocalPid = erlang:spawn(forever()), + ?assertEqual(ok, pg:join(?FUNCTION_NAME, ?FUNCTION_NAME, LocalPid)), + + ?assertNot(lists:member(Peer, nodes())), %% should be no nodes in the cluster + + pong = net_adm:ping(Peer), + %% now ensure sync happened + Pids = lists:sort([RemotePid, LocalPid]), + sync({?FUNCTION_NAME, Peer}), + ?assertEqual(Pids, lists:sort(rpc:call(Peer, pg, get_members, [?FUNCTION_NAME, ?FUNCTION_NAME]))), + ?assertEqual([RemoteOldPid], pg:get_members(?FUNCTION_NAME, '$visible')), + stop_node(Peer, Socket), + ok. + +trisplit(Config) when is_list(Config) -> + {Peer, Socket1} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + _PeerPid1 = erlang:spawn(Peer, forever()), + PeerPid2 = erlang:spawn(Peer, forever()), + ?assertEqual(ok, rpc:call(Peer, pg, join, [?FUNCTION_NAME, three, PeerPid2])), + net_kernel:disconnect(Peer), + ?assertEqual(true, net_kernel:connect_node(Peer)), + ?assertEqual(ok, rpc:call(Peer, pg, join, [?FUNCTION_NAME, one, PeerPid2])), + %% now ensure sync happened + {Peer2, Socket2} = spawn_node(?FUNCTION_NAME, trisplit_second), + ?assertEqual(true, rpc:call(Peer2, net_kernel, connect_node, [Peer])), + ?assertEqual(lists:sort([node(), Peer]), lists:sort(rpc:call(Peer2, erlang, nodes, []))), + sync({?FUNCTION_NAME, Peer2}), + ?assertEqual([PeerPid2], rpc:call(Peer2, pg, get_members, [?FUNCTION_NAME, one])), + stop_node(Peer, Socket1), + stop_node(Peer2, Socket2), + ok. + +foursplit(Config) when is_list(Config) -> + Pid = erlang:spawn(forever()), + {Peer, Socket} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + ?assertEqual(ok, pg:join(?FUNCTION_NAME, one, Pid)), + ?assertEqual(ok, pg:join(?FUNCTION_NAME, two, Pid)), + PeerPid1 = spawn(Peer, forever()), + ?assertEqual(ok, pg:leave(?FUNCTION_NAME, one, Pid)), + ?assertEqual(not_joined, pg:leave(?FUNCTION_NAME, three, Pid)), + net_kernel:disconnect(Peer), + ?assertEqual(ok, rpc(Socket, ?MODULE, stop_proc, [PeerPid1])), + ?assertEqual(not_joined, pg:leave(?FUNCTION_NAME, three, Pid)), + ?assertEqual(true, net_kernel:connect_node(Peer)), + ?assertEqual([], pg:get_members(?FUNCTION_NAME, one)), + ?assertEqual([], rpc(Socket, pg, get_members, [?FUNCTION_NAME, one])), + stop_node(Peer, Socket), + ok. + +exchange(Config) when is_list(Config) -> + {Peer1, Socket1} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + {Peer2, Socket2} = spawn_node(?FUNCTION_NAME, exchange_second), + Pids10 = [rpc(Socket1, erlang, spawn, [forever()]) || _ <- lists:seq(1, 10)], + Pids2 = [rpc(Socket2, erlang, spawn, [forever()]) || _ <- lists:seq(1, 10)], + Pids11 = [rpc(Socket1, erlang, spawn, [forever()]) || _ <- lists:seq(1, 10)], + %% kill first 3 pids from node1 + {PidsToKill, Pids1} = lists:split(3, Pids10), + + ?assertEqual(ok, rpc(Socket1, pg, join, [?FUNCTION_NAME, ?FUNCTION_NAME, Pids10])), + sync({?FUNCTION_NAME, Peer1}), + ?assertEqual(lists:sort(Pids10), lists:sort(pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME))), + [rpc(Socket1, ?MODULE, stop_proc, [Pid]) || Pid <- PidsToKill], + sync(?FUNCTION_NAME), + sync({?FUNCTION_NAME, Peer1}), + + Pids = lists:sort(Pids1 ++ Pids2 ++ Pids11), + ?assert(lists:all(fun erlang:is_pid/1, Pids)), + + net_kernel:disconnect(Peer1), + net_kernel:disconnect(Peer2), + + sync(?FUNCTION_NAME), + ?assertEqual([], lists:sort(pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME))), + + [?assertEqual(ok, rpc(Socket2, pg, join, [?FUNCTION_NAME, ?FUNCTION_NAME, Pid])) || Pid <- Pids2], + [?assertEqual(ok, rpc(Socket1, pg, join, [?FUNCTION_NAME, second, Pid])) || Pid <- Pids11], + ?assertEqual(ok, rpc(Socket1, pg, join, [?FUNCTION_NAME, third, Pids11])), + %% rejoin + ?assertEqual(true, net_kernel:connect_node(Peer1)), + ?assertEqual(true, net_kernel:connect_node(Peer2)), + %% need to sleep longer to ensure both nodes made the exchange + sync(?FUNCTION_NAME), + sync({?FUNCTION_NAME, Peer1}), + sync({?FUNCTION_NAME, Peer2}), + ?assertEqual(Pids, lists:sort(pg:get_members(?FUNCTION_NAME, second) ++ pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME))), + ?assertEqual(lists:sort(Pids11), lists:sort(pg:get_members(?FUNCTION_NAME, third))), + + {Left, Stay} = lists:split(3, Pids11), + ?assertEqual(ok, rpc(Socket1, pg, leave, [?FUNCTION_NAME, third, Left])), + sync({?FUNCTION_NAME, Peer1}), + sync(?FUNCTION_NAME), + ?assertEqual(lists:sort(Stay), lists:sort(pg:get_members(?FUNCTION_NAME, third))), + ?assertEqual(not_joined, rpc(Socket1, pg, leave, [?FUNCTION_NAME, left, Stay])), + ?assertEqual(ok, rpc(Socket1, pg, leave, [?FUNCTION_NAME, third, Stay])), + sync({?FUNCTION_NAME, Peer1}), + sync(?FUNCTION_NAME), + ?assertEqual([], lists:sort(pg:get_members(?FUNCTION_NAME, third))), + sync({?FUNCTION_NAME, Peer1}), + sync(?FUNCTION_NAME), + + stop_node(Peer1, Socket1), + stop_node(Peer2, Socket2), + ok. + +nolocal(Config) when is_list(Config) -> + {Peer, Socket} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + RemotePid = spawn(Peer, forever()), + ?assertEqual(ok, rpc:call(Peer, pg, join, [?FUNCTION_NAME, ?FUNCTION_NAME, RemotePid])), + ?assertEqual(ok, rpc:call(Peer, pg, join, [?FUNCTION_NAME, ?FUNCTION_NAME, RemotePid])), + ?assertEqual([], pg:get_local_members(?FUNCTION_NAME, ?FUNCTION_NAME)), + stop_node(Peer, Socket), + ok. + +double(Config) when is_list(Config) -> + Pid = erlang:spawn(forever()), + ?assertEqual(ok, pg:join(?FUNCTION_NAME, ?FUNCTION_NAME, Pid)), + {Peer, Socket} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + ?assertEqual(ok, pg:join(?FUNCTION_NAME, ?FUNCTION_NAME, [Pid])), + ?assertEqual([Pid, Pid], pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME)), + sync(?FUNCTION_NAME), + sync({?FUNCTION_NAME, Peer}), + ?assertEqual([Pid, Pid], rpc:call(Peer, pg, get_members, [?FUNCTION_NAME, ?FUNCTION_NAME])), + stop_node(Peer, Socket), + ok. + +scope_restart(Config) when is_list(Config) -> + Pid = erlang:spawn(forever()), + ?assertEqual(ok, pg:join(?FUNCTION_NAME, ?FUNCTION_NAME, [Pid, Pid])), + {Peer, Socket} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + RemotePid = spawn(Peer, forever()), + ?assertEqual(ok, rpc:call(Peer, pg, join, [?FUNCTION_NAME, ?FUNCTION_NAME, RemotePid])), + sync({?FUNCTION_NAME, Peer}), + ?assertEqual(lists:sort([RemotePid, Pid, Pid]), lists:sort(pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME))), + %% stop scope locally, and restart + gen_server:stop(?FUNCTION_NAME), + pg:start(?FUNCTION_NAME), + %% ensure remote pids joined, local are missing + sync(?FUNCTION_NAME), + sync({?FUNCTION_NAME, Peer}), + sync(?FUNCTION_NAME), + ?assertEqual([RemotePid], pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME)), + stop_node(Peer, Socket), + ok. + +missing_scope_join(Config) when is_list(Config) -> + {Peer, Socket} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + ?assertEqual(ok, rpc:call(Peer, gen_server, stop, [?FUNCTION_NAME])), + RemotePid = spawn(Peer, forever()), + ?assertMatch({badrpc, {'EXIT', {noproc, _}}}, rpc:call(Peer, pg, join, [?FUNCTION_NAME, ?FUNCTION_NAME, RemotePid])), + ?assertMatch({badrpc, {'EXIT', {noproc, _}}}, rpc:call(Peer, pg, leave, [?FUNCTION_NAME, ?FUNCTION_NAME, RemotePid])), + stop_node(Peer, Socket), + ok. + +disconnected_start(Config) when is_list(Config) -> + {Peer, Socket} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + net_kernel:disconnect(Peer), + ?assertEqual(ok, rpc(Socket, gen_server, stop, [?FUNCTION_NAME])), + ?assertMatch({ok, _Pid}, rpc(Socket, pg, start,[?FUNCTION_NAME])), + ?assertEqual(ok, rpc(Socket, gen_server, stop, [?FUNCTION_NAME])), + RemotePid = rpc(Socket, erlang, spawn, [forever()]), + ?assert(is_pid(RemotePid)), + stop_node(Peer, Socket), + ok. + +forced_sync() -> + [{doc, "This test was added when lookup_element was erroneously used instead of lookup, crashing pg with badmatch, and it tests rare out-of-order sync operations"}]. + +forced_sync(Config) when is_list(Config) -> + {Peer, Socket} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + Pid = erlang:spawn(forever()), + RemotePid = spawn(Peer, forever()), + Expected = lists:sort([Pid, RemotePid]), + pg:join(?FUNCTION_NAME, one, Pid), + + ?assertEqual(ok, rpc:call(Peer, pg, join, [?FUNCTION_NAME, one, RemotePid])), + RemoteScopePid = rpc:call(Peer, erlang, whereis, [?FUNCTION_NAME]), + ?assert(is_pid(RemoteScopePid)), + %% hohoho, partition! + net_kernel:disconnect(Peer), + ?assertEqual(true, net_kernel:connect_node(Peer)), + %% now ensure sync happened + sync({?FUNCTION_NAME, Peer}), + sync(?FUNCTION_NAME), + ?assertEqual(Expected, lists:sort(pg:get_members(?FUNCTION_NAME, one))), + %% WARNING: this code uses pg as white-box, exploiting internals, + %% only to simulate broken 'sync' + %% Fake Groups: one should disappear, one should be replaced, one stays + %% This tests handle_sync function. + FakeGroups = [{one, [RemotePid, RemotePid]}, {?FUNCTION_NAME, [RemotePid, RemotePid]}], + gen_server:cast(?FUNCTION_NAME, {sync, RemoteScopePid, FakeGroups}), + %% ensure it is broken well enough + sync(?FUNCTION_NAME), + ?assertEqual(lists:sort([RemotePid, RemotePid]), lists:sort(pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME))), + ?assertEqual(lists:sort([RemotePid, RemotePid, Pid]), lists:sort(pg:get_members(?FUNCTION_NAME, one))), + %% simulate force-sync via 'discover' - ask peer to send sync to us + {?FUNCTION_NAME, Peer} ! {discover, whereis(?FUNCTION_NAME)}, + sync({?FUNCTION_NAME, Peer}), + sync(?FUNCTION_NAME), + ?assertEqual(Expected, lists:sort(pg:get_members(?FUNCTION_NAME, one))), + ?assertEqual([], lists:sort(pg:get_members(?FUNCTION_NAME, ?FUNCTION_NAME))), + %% and simulate extra sync + sync({?FUNCTION_NAME, Peer}), + sync(?FUNCTION_NAME), + ?assertEqual(Expected, lists:sort(pg:get_members(?FUNCTION_NAME, one))), + + stop_node(Peer, Socket), + ok. + +group_leave(Config) when is_list(Config) -> + {Peer, Socket} = spawn_node(?FUNCTION_NAME, ?FUNCTION_NAME), + RemotePid = erlang:spawn(Peer, forever()), + Total = lists:duplicate(16, RemotePid), + {Left, Remain} = lists:split(4, Total), + %% join 16 times! + ?assertEqual(ok, rpc:call(Peer, pg, join, [?FUNCTION_NAME, two, Total])), + ?assertEqual(ok, rpc:call(Peer, pg, leave, [?FUNCTION_NAME, two, Left])), + + sync({?FUNCTION_NAME, Peer}), + sync(?FUNCTION_NAME), + ?assertEqual(Remain, pg:get_members(?FUNCTION_NAME, two)), + stop_node(Peer, Socket), + sync(?FUNCTION_NAME), + ?assertEqual([], pg:get_members(?FUNCTION_NAME, two)), + ok. + +%%-------------------------------------------------------------------- +%% Test Helpers - start/stop additional Erlang nodes + +sync(GS) -> + _ = sys:log(GS, get). + +-define (LOCALHOST, {127, 0, 0, 1}). + +%% @doc Kills process Pid and waits for it to exit using monitor, +%% and yields after (for 1 ms). +-spec stop_proc(pid()) -> ok. +stop_proc(Pid) -> + monitor(process, Pid), + erlang:exit(Pid, kill), + receive + {'DOWN', _MRef, process, Pid, _Info} -> + timer:sleep(1) + end. + +%% @doc Executes remote call on the node via TCP socket +%% Used when dist connection is not available, or +%% when it's undesirable to use one. +-spec rpc(gen_tcp:socket(), module(), atom(), [term()]) -> term(). +rpc(Sock, M, F, A) -> + ok = gen_tcp:send(Sock, term_to_binary({call, M, F, A})), + inet:setopts(Sock, [{active, once}]), + receive + {tcp, Sock, Data} -> + case binary_to_term(Data) of + {ok, Val} -> + Val; + {error, Error} -> + {badrpc, Error} + end; + {tcp_closed, Sock} -> + error(closed) + end. + +%% @doc starts peer node on this host. +%% Returns spawned node name, and a gen_tcp socket to talk to it using ?MODULE:rpc. +-spec spawn_node(Scope :: atom(), Node :: atom()) -> {node(), gen_tcp:socket()}. +spawn_node(Scope, Name) -> + Self = self(), + Controller = erlang:spawn(?MODULE, controller, [Name, Scope, Self]), + receive + {'$node_started', Node, Port} -> + {ok, Socket} = gen_tcp:connect(?LOCALHOST, Port, [{active, false}, {mode, binary}, {packet, 4}]), + Controller ! {socket, Socket}, + {Node, Socket}; + Other -> + error({start_node, Name, Other}) + after 60000 -> + error({start_node, Name, timeout}) + end. + +%% @private +-spec controller(atom(), atom(), pid()) -> ok. +controller(Name, Scope, Self) -> + Pa = filename:dirname(code:which(?MODULE)), + Pa2 = filename:dirname(code:which(pg)), + Args = lists:concat(["-setcookie ", erlang:get_cookie(), + "-connect_all false -kernel dist_auto_connect never -noshell -pa ", Pa, " -pa ", Pa2]), + {ok, Node} = test_server:start_node(Name, peer, [{args, Args}]), + case rpc:call(Node, ?MODULE, control, [Scope], 5000) of + {badrpc, nodedown} -> + Self ! {badrpc, Node}, + ok; + {Port, _PgPid} -> + Self ! {'$node_started', Node, Port}, + controller_wait() + end. + +controller_wait() -> + Port = + receive + {socket, Port0} -> + Port0 + end, + MRef = monitor(port, Port), + receive + {'DOWN', MRef, port, Port, _Info} -> + ok + end. + +%% @doc Stops the node previously started with spawn_node, +%% and also closes the RPC socket. +-spec stop_node(node(), gen_tcp:socket()) -> true. +stop_node(Node, Socket) when Node =/= node() -> + true = test_server:stop_node(Node), + Socket =/= undefined andalso gen_tcp:close(Socket), + true. + +forever() -> + fun() -> receive after infinity -> ok end end. + + +-spec control(Scope :: atom()) -> {Port :: integer(), pid()}. +control(Scope) -> + Control = self(), + erlang:spawn(fun () -> server(Control, Scope) end), + receive + {port, Port, PgPid} -> + {Port, PgPid}; + Other -> + error({error, Other}) + end. + +server(Control, Scope) -> + try + {ok, Pid} = if Scope =:= undefined -> {ok, undefined}; true -> pg:start(Scope) end, + {ok, Listen} = gen_tcp:listen(0, [{mode, binary}, {packet, 4}, {ip, ?LOCALHOST}]), + {ok, Port} = inet:port(Listen), + Control ! {port, Port, Pid}, + {ok, Sock} = gen_tcp:accept(Listen), + server_loop(Sock) + catch + Class:Reason:Stack -> + Control ! {error, {Class, Reason, Stack}} + end. + +server_loop(Sock) -> + inet:setopts(Sock, [{active, once}]), + receive + {tcp, Sock, Data} -> + {call, M, F, A} = binary_to_term(Data), + Ret = + try + erlang:apply(M, F, A) of + Res -> + {ok, Res} + catch + exit:Reason -> + {error, {'EXIT', Reason}}; + error:Reason -> + {error, {'EXIT', Reason}} + end, + ok = gen_tcp:send(Sock, term_to_binary(Ret)), + server_loop(Sock); + {tcp_closed, Sock} -> + erlang:halt(1) + end. diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl index a89a7600a2..d05db46837 100644 --- a/lib/kernel/test/rpc_SUITE.erl +++ b/lib/kernel/test/rpc_SUITE.erl @@ -25,7 +25,13 @@ call/1, block_call/1, multicall/1, multicall_timeout/1, multicall_dies/1, multicall_node_dies/1, called_dies/1, called_node_dies/1, - called_throws/1, call_benchmark/1, async_call/1]). + called_throws/1, call_benchmark/1, async_call/1, + call_against_old_node/1, + multicall_mix/1, + timeout_limit/1]). +-export([init_per_testcase/2, end_per_testcase/2]). + +-export([call_func1/1]). -export([suicide/2, suicide/3, f/0, f2/0]). @@ -39,11 +45,17 @@ all() -> [off_heap, call, block_call, multicall, multicall_timeout, multicall_dies, multicall_node_dies, called_dies, called_node_dies, called_throws, call_benchmark, - async_call]. + async_call, call_against_old_node, multicall_mix, timeout_limit]. groups() -> []. +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + [{testcase, Func}|Config]. + +end_per_testcase(_Func, _Config) -> + ok. + init_per_suite(Config) -> Config. @@ -224,7 +236,6 @@ do_multicall_2_nodes_dies(Mod, Func, Args) -> ok. - %% OTP-3766. called_dies(Config) when is_list(Config) -> PA = filename:dirname(code:which(?MODULE)), @@ -254,20 +265,23 @@ called_dies(Config) when is_list(Config) -> %% TrapExit = process_flag(trap_exit, true), %% - rep(fun (Tag, Call, Args=[Node|_]) when Node == node() -> + rep(fun (Tag, call, Args=[Node|_]) when Node == node() -> {Tag,timeout} = - {Tag,apply(rpc, Call, Args)}, + {Tag,apply(rpc, call, Args)}, {Tag,flush,[{'EXIT',_,normal}]} = {Tag,flush,flush([])}; (Tag, Call, Args) -> {Tag,timeout} = {Tag,apply(rpc, Call, Args)} end, N, ?MODULE, suicide, [link,normal]), - rep(fun (Tag, Call, Args=[Node|_]) when Node == node() -> + rep(fun (Tag, call, Args=[Node|_]) when Node == node() -> {Tag,timeout} = - {Tag,apply(rpc, Call, Args)}, + {Tag,apply(rpc, call, Args)}, {Tag,flush,[{'EXIT',_,abnormal}]} = {Tag,flush,flush([])}; + (Tag, Call, Args=[Node|_]) when Node == node() -> + {Tag,timeout} = + {Tag,apply(rpc, Call, Args)}; (Tag, block_call, Args) -> {Tag,timeout} = {Tag,apply(rpc, block_call, Args)}; @@ -275,20 +289,23 @@ called_dies(Config) when is_list(Config) -> {Tag,{badrpc,{'EXIT',abnormal}}} = {Tag,apply(rpc, Call, Args)} end, N, ?MODULE, suicide, [link,abnormal]), - rep(fun (Tag, Call, Args=[Node|_]) when Node == node() -> + rep(fun (Tag, call, Args=[Node|_]) when Node == node() -> {Tag,timeout} = - {Tag,apply(rpc, Call, Args)}, + {Tag,apply(rpc, call, Args)}, {Tag,flush,[{'EXIT',_,normal}]} = {Tag,flush,flush([])}; (Tag, Call, Args) -> {Tag,timeout} = {Tag,apply(rpc, Call, Args)} end, N, ?MODULE, suicide, [exit,normal]), - rep(fun (Tag, Call, Args=[Node|_]) when Node == node() -> + rep(fun (Tag, call, Args=[Node|_]) when Node == node() -> {Tag,timeout} = - {Tag,apply(rpc, Call, Args)}, + {Tag,apply(rpc, call, Args)}, {Tag,flush,[{'EXIT',_,abnormal}]} = {Tag,flush,flush([])}; + (Tag, Call, Args=[Node|_]) when Node == node() -> + {Tag,timeout} = + {Tag,apply(rpc, Call, Args)}; (Tag, block_call, Args) -> {Tag,timeout} = {Tag,apply(rpc, block_call, Args)}; @@ -370,8 +387,10 @@ called_node_dies(Config) when is_list(Config) -> PA, ?MODULE, suicide, [init,stop,[]]), node_rep( - fun (Call, Args=[_|_]) -> - {badrpc,{'EXIT',{killed,_}}} = apply(rpc, Call, Args) + fun (block_call, Args=[_|_]) -> + {badrpc,{'EXIT',{killed,_}}} = apply(rpc, block_call, Args); + (call, Args=[_|_]) -> + {badrpc,nodedown} = apply(rpc, call, Args) end, "rpc_SUITE_called_node_dies_3", PA, ?MODULE, suicide, [erlang,exit,[rex,kill]]), @@ -380,7 +399,7 @@ called_node_dies(Config) when is_list(Config) -> %% Cannot block call rpc - will hang ok; (Call, Args=[_|_]) -> - {badrpc,{'EXIT',{normal,_}}} = apply(rpc, Call, Args) + {badrpc,nodedown} = apply(rpc, Call, Args) end, "rpc_SUITE_called_node_dies_4", PA, ?MODULE, suicide, [rpc,stop,[]]), @@ -474,10 +493,153 @@ async_call(Config) when is_list(Config) -> ok. +call_against_old_node(Config) -> + case start_22_node(Config) of + {ok, Node22} -> + Node22 = rpc:call(Node22, erlang, node, []), + stop_node(Node22), + ok; + _ -> + {skipped, "No OTP 22 available"} + end. + +multicall_mix(Config) -> + {ok, Node1} = start_node(Config), + {ok, Node2} = start_node(Config), + {Node3, OldNodeTest} = case start_22_node(Config) of + {ok, N3} -> + {N3, true}; + _ -> + {ok, N3} = start_node(Config), + {N3, false} + end, + {ok, Node4} = start_node(Config), + {ok, Node5} = start_node(Config), + stop_node(Node2), + + ThisNode = node(), + Nodes = [ThisNode, Node1, Node2, Node3, Node4, Node5], + + {[ThisNode, + Node1, + Node3, + Node4, + Node5], + [Node2]} + = rpc:multicall(Nodes, erlang, node, []), + + {[BlingError, + BlingError, + {badrpc, {'EXIT', _}}, + BlingError, + BlingError], + [Node2]} + = rpc:multicall(Nodes, ?MODULE, call_func1, [bling]), + + {badrpc, {'EXIT', + {bling, + [{?MODULE, call_func2, A, _}, + {?MODULE, call_func1, 1, _}]}}} = BlingError, + true = (A == 1) orelse (A == [bling]), + + {[], Nodes} + = rpc:multicall(Nodes, erlang, processes, [], 0), + + OtherNodes = Nodes -- [ThisNode], + + {[], OtherNodes} + = rpc:multicall(OtherNodes, erlang, halt, []), + + case OldNodeTest of + true -> {comment, "Test with OTP 22 node as well"}; + false -> {comment, "Test without OTP 22"} + end. + +call_func1(X) -> + call_func2(X), + ok. + +call_func2(X) -> + erlang:error(X, [X]). + +timeout_limit(Config) when is_list(Config) -> + Node = node(), + MaxTmo = (1 bsl 32) - 1, + erlang:send_after(100, self(), dummy_message), + try + receive + M -> + M + after MaxTmo + 1 -> + ok + end, + ct:fail("The ?MAX_INT_TIMEOUT define in rpc.erl needs " + "to be updated to reflect max timeout value " + "in a receive/after...") + catch + error:timeout_value -> + ok + end, + Node = rpc:call(Node, erlang, node, [], MaxTmo), + try + {badrpc, _} = rpc:call(Node, erlang, node, [], MaxTmo+1), + ct:fail(unexpected) + catch + error:_ -> + ok + end, + Node = rpc:block_call(Node, erlang, node, [], MaxTmo), + try + {badrpc, _} = rpc:block_call(Node, erlang, node, [], MaxTmo+1), + ct:fail(unexpected) + catch + error:_ -> + ok + end, + {[Node],[]} = rpc:multicall([Node], erlang, node, [], MaxTmo), + try + rpc:multicall([Node], erlang, node, [], MaxTmo+1), + ct:fail(unexpected) + catch + error:_ -> + ok + end, + ok. + + %%% %%% Utility functions. %%% +start_node(Config) -> + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" ++ integer_to_list(erlang:system_time(second)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), + Pa = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]). + +start_22_node(Config) -> + Rel = "22_latest", + case test_server:is_release_available(Rel) of + false -> + notsup; + true -> + Cookie = atom_to_list(erlang:get_cookie()), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" ++ integer_to_list(erlang:system_time(second)) + ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), + Pa = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, + peer, + [{args, "-pa " ++ Pa ++ " -setcookie "++Cookie}, + {erl, [{release, Rel}]}]) + end. + +stop_node(Node) -> + test_server:stop_node(Node). + flush(L) -> receive M -> diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl index 52342560b1..d984a071f6 100644 --- a/lib/kernel/test/seq_trace_SUITE.erl +++ b/lib/kernel/test/seq_trace_SUITE.erl @@ -31,7 +31,8 @@ trace_exit/1, distributed_exit/1, call/1, port/1, port_clean_token/1, match_set_seq_token/1, gc_seq_token/1, label_capability_mismatch/1, - send_literal/1]). + send_literal/1,inherit_on_spawn/1,inherit_on_dist_spawn/1, + dist_spawn_error/1]). %% internal exports -export([simple_tracer/2, one_time_receiver/0, one_time_receiver/1, @@ -56,7 +57,8 @@ all() -> old_heap_token, distributed_exit, call, port, match_set_seq_token, port_clean_token, - gc_seq_token, label_capability_mismatch]. + gc_seq_token, label_capability_mismatch, + inherit_on_spawn, inherit_on_dist_spawn, dist_spawn_error]. groups() -> []. @@ -86,14 +88,27 @@ token_set_get(Config) when is_list(Config) -> do_token_set_get(timestamp), do_token_set_get(monotonic_timestamp), do_token_set_get(strict_monotonic_timestamp). - + +-define(SEQ_TRACE_SEND, 1). %(1 << 0) +-define(SEQ_TRACE_RECEIVE, 2). %(1 << 1) +-define(SEQ_TRACE_PRINT, 4). %(1 << 2) +-define(SEQ_TRACE_NOW_TIMESTAMP, 8). %(1 << 3) +-define(SEQ_TRACE_STRICT_MON_TIMESTAMP, 16). %(1 << 4) +-define(SEQ_TRACE_MON_TIMESTAMP, 32). %(1 << 5) + do_token_set_get(TsType) -> - io:format("Testing ~p~n", [TsType]), + BaseOpts = ?SEQ_TRACE_SEND bor + ?SEQ_TRACE_RECEIVE bor + ?SEQ_TRACE_PRINT, Flags = case TsType of - timestamp -> 15; - strict_monotonic_timestamp -> 23; - monotonic_timestamp -> 39 - end, + timestamp -> + BaseOpts bor ?SEQ_TRACE_NOW_TIMESTAMP; + strict_monotonic_timestamp -> + BaseOpts bor ?SEQ_TRACE_STRICT_MON_TIMESTAMP; + monotonic_timestamp -> + BaseOpts bor ?SEQ_TRACE_MON_TIMESTAMP + end, + ct:pal("Type ~p, flags = ~p~n", [TsType, Flags]), Self = self(), seq_trace:reset_trace(), %% Test that initial seq_trace is disabled @@ -208,9 +223,9 @@ do_send_literal(Msg) -> seq_trace:reset_trace(), start_tracer(), Label = make_ref(), + Receiver = spawn_link(fun() -> receive ok -> ok end end), seq_trace:set_token(label,Label), set_token_flags([send, 'receive', no_timestamp]), - Receiver = spawn_link(fun() -> receive ok -> ok end end), [Receiver ! Msg || _ <- lists:seq(1, N)], erlang:garbage_collect(Receiver), [Receiver ! Msg || _ <- lists:seq(1, N)], @@ -482,8 +497,6 @@ call(Config) when is_list(Config) -> 1 = erlang:trace(Self, true, [call, set_on_spawn, {tracer, TrB(pid)}]), - Label = 17, - seq_trace:set_token(label, Label), % Token enters here!! RefB = make_ref(), Pid2B = spawn_link( fun() -> @@ -497,6 +510,12 @@ call(Config) when is_list(Config) -> RefB = call_tracee_1(RefB), Pid2B ! {self(), msg, RefB} end), + + %% The token is set *AFTER* spawning to make sure we're testing that the + %% token follows on send and not that it inherits on spawn. + Label = 17, + seq_trace:set_token(label, Label), + Pid1B ! {Self, msg, RefB}, %% The message is passed Self -> Pid1B -> Pid2B -> Self, and the %% seq_trace token follows invisibly. Traced functions are @@ -517,6 +536,357 @@ call(Config) when is_list(Config) -> seq_trace:reset_trace(), ok. +%% The token should follow spawn, just like it follows messages. +inherit_on_spawn(Config) when is_list(Config) -> + lists:foreach(fun (Test) -> + inherit_on_spawn_test(Test) + end, + [spawn, spawn_link, spawn_monitor, + spawn_opt, spawn_request]), + ok. + +inherit_on_spawn_test(Spawn) -> + io:format("Testing ~p()~n", [Spawn]), + + seq_trace:reset_trace(), + start_tracer(), + + Ref = make_ref(), + seq_trace:set_token(label,Ref), + set_token_flags([send,'receive',strict_monotonic_timestamp]), + + Self = self(), + GurkaMsg = {gurka,Ref}, + SpawnFun = fun() -> Self ! GurkaMsg, receive after infinity -> ok end end, + {Other, Tag, KnownReqId, KnownSpawnReply} + = case Spawn of + spawn -> + {spawn(SpawnFun), spawn_reply, undefined, undefined}; + spawn_link -> + {spawn_link(SpawnFun), spawn_reply, undefined, undefined}; + spawn_monitor -> + {P, _} = spawn_monitor(SpawnFun), + {P, spawn_reply, undefined, undefined}; + spawn_opt -> + {spawn_opt(SpawnFun, [link]), spawn_reply, undefined, undefined}; + spawn_request -> + SReply = make_ref(), + RID = spawn_request(SpawnFun, [link, {reply_tag, SReply}]), + receive + {SReply, RID, ok, P} = M -> + {P, SReply, RID, M} + end + end, + + receive {gurka,Ref} -> ok end, + seq_trace:reset_trace(), + + Sequence = lists:keysort(3, stop_tracer(6)), + io:format("Sequence: ~p~n", [Sequence]), + [SSpawnRequest, RSpawnRequest, SSpawnReply, RSpawnReply, + SGurkaMsg, RGurkaMsg] = Sequence, + + %% Spawn request... + {Ref, + {send, + {0,1}, + Self,Other, + ReqMessage}, + _} = SSpawnRequest, + + spawn_request = element(1, ReqMessage), + ReqId = element(2, ReqMessage), + case KnownReqId of + undefined -> ok; + ReqId -> ok + end, + + {Ref, + {'receive', + {0,1}, + Self,Other, + ReqMessage}, + _} = RSpawnRequest, + + %% Spawn reply... + SpawnReply = {Tag,ReqId,ok,Other}, + {Ref, + {send, + {1,2}, + Other,Self, + SpawnReply}, + _} = SSpawnReply, + + case KnownSpawnReply of + undefined -> ok; + SpawnReply -> ok + end, + + {Ref, + {'receive', + {1,2}, + Other,Self, + SpawnReply}, + _} = RSpawnReply, + + %% Gurka message... + {Ref, + {send, + {1,3}, + Other, Self, + GurkaMsg}, + _} = SGurkaMsg, + + {Ref, + {'receive', + {1,3}, + Other, Self, + GurkaMsg}, + _} = RGurkaMsg, + + unlink(Other), + exit(Other, kill), + + ok. + +inherit_on_dist_spawn(Config) when is_list(Config) -> + lists:foreach(fun (Test) -> + inherit_on_dist_spawn_test(Test) + end, + [spawn, spawn_link, spawn_monitor, + spawn_opt, spawn_request]), + ok. + +inherit_on_dist_spawn_test(Spawn) -> + io:format("Testing ~p()~n", [Spawn]), + Pa = "-pa "++filename:dirname(code:which(?MODULE)), + {ok, Node} = start_node(seq_trace_dist_spawn, Pa), + %% ensure module is loaded on remote node... + _ = rpc:call(Node, ?MODULE, module_info, []), + + io:format("Self=~p~n",[self()]), + + seq_trace:reset_trace(), + start_tracer(), + rpc:call(Node, seq_trace, reset_trace, []), + start_tracer(Node), + + Ref = make_ref(), + io:format("Ref=~p~n",[Ref]), + + seq_trace:set_token(label,Ref), + set_token_flags([send,'receive',strict_monotonic_timestamp]), + + Self = self(), + + GurkaMsg = {gurka,Ref}, + SpawnFun = fun() -> Self ! GurkaMsg, receive after infinity -> ok end end, + {Other, Tag, KnownReqId, KnownSpawnReply} + = case Spawn of + spawn -> + {spawn(Node, SpawnFun), spawn_reply, undefined, undefined}; + spawn_link -> + {spawn_link(Node, SpawnFun), spawn_reply, undefined, undefined}; + spawn_monitor -> + {P, _} = spawn_monitor(Node, SpawnFun), + {P, spawn_reply, undefined, undefined}; + spawn_opt -> + {spawn_opt(Node, SpawnFun, [link]), spawn_reply, undefined, undefined}; + spawn_request -> + SReply = make_ref(), + RID = spawn_request(Node, SpawnFun, [{reply_tag, SReply}, link]), + receive + {SReply, RID, ok, P} = M -> + {P, SReply, RID, M} + end + end, + + receive GurkaMsg -> ok end, + seq_trace:reset_trace(), + + Sequence = lists:keysort(3,stop_tracer(4)), + io:format("Sequence: ~p~n", [Sequence]), + [StSpawnRequest, StAList, StSpawnReply, StGurkaMsg] = Sequence, + + %% Spawn request... + {Ref, + {send, + {0,1}, + Self,Node, + ReqMessage}, + _} = StSpawnRequest, + + spawn_request = element(1, ReqMessage), + ReqId = element(2, ReqMessage), + case KnownReqId of + undefined -> ok; + ReqId -> ok + end, + + {Ref, + {send, + {0,2}, + Self,Node, + ArgList}, + _} = StAList, + + %% Spawn reply... + SpawnReply = {Tag,ReqId,ok,Other}, + case KnownSpawnReply of + undefined -> ok; + SpawnReply -> ok + end, + + {Ref, + {'receive', + {1,2}, + Other,Self, + SpawnReply}, + _} = StSpawnReply, + + %% Gurka message... + {Ref, + {'receive', + {2,3}, + Other, Self, + GurkaMsg}, + _} = StGurkaMsg, + + SequenceNode = lists:keysort(3,stop_tracer(Node, 4)), + io:format("SequenceNode: ~p~n", [SequenceNode]), + [StSpawnRequestNode, StSpawnReplyNode, StAListNode, StGurkaMsgNode] = SequenceNode, + + + %% Spawn request... + {Ref, + {'receive', + {0,1}, + Self,Other, + ReqMessage}, + _} = StSpawnRequestNode, + + %% Spawn reply... + {Ref, + {send, + {1,2}, + Other,Self, + {spawn_reply, ReqId, ok, Other}}, + _} = StSpawnReplyNode, + + {Ref, + {'receive', + {0,2}, + Self,Other, + ArgList}, + _} = StAListNode, + + %% Gurka message... + {Ref, + {send, + {2,3}, + Other, Self, + GurkaMsg}, + _} = StGurkaMsgNode, + + unlink(Other), + + stop_node(Node), + + ok. + +dist_spawn_error(Config) when is_list(Config) -> + Pa = "-pa "++filename:dirname(code:which(?MODULE)), + {ok, Node} = start_node(seq_trace_dist_spawn, Pa), + %% ensure module is loaded on remote node... + _ = rpc:call(Node, ?MODULE, module_info, []), + + io:format("Self=~p~n",[self()]), + + seq_trace:reset_trace(), + start_tracer(), + rpc:call(Node, seq_trace, reset_trace, []), + start_tracer(Node), + + Ref = make_ref(), + io:format("Ref=~p~n",[Ref]), + + seq_trace:set_token(label,Ref), + set_token_flags([send,'receive',strict_monotonic_timestamp]), + + Self = self(), + SpawnReplyTag = make_ref(), + GurkaMsg = {gurka,Ref}, + ReqId = spawn_request(Node, + fun () -> + Self ! GurkaMsg, + receive after infinity -> ok end + end, + [lunk, {reply_tag, SpawnReplyTag}, link]), + + receive + {SpawnReplyTag, ReqId, ResType, Err} -> + error = ResType, + badopt = Err + end, + + seq_trace:reset_trace(), + + Sequence = lists:keysort(3,stop_tracer(3)), + io:format("Sequence: ~p~n", [Sequence]), + [StSpawnRequest, StAList, StSpawnReply] = Sequence, + + %% Spawn request... + {Ref, + {send, + {0,1}, + Self,Node, + ReqMessage}, + _} = StSpawnRequest, + + spawn_request = element(1, ReqMessage), + ReqId = element(2, ReqMessage), + + {Ref, + {send, + {0,2}, + Self,Node, + _ArgList}, + _} = StAList, + + %% Spawn reply... + ReplyMessage = {SpawnReplyTag,ReqId,error,badopt}, + {Ref, + {'receive', + {1,2}, + Node,Self, + ReplyMessage}, + _} = StSpawnReply, + + SequenceNode = lists:keysort(3,stop_tracer(Node, 2)), + io:format("SequenceNode: ~p~n", [SequenceNode]), + [StSpawnRequestNode, StSpawnReplyNode] = SequenceNode, + + %% Spawn request... + {Ref, + {'receive', + {0,1}, + Self,Node, + ReqMessage}, + _} = StSpawnRequestNode, + + %% Spawn reply... + {Ref, + {send, + {1,2}, + Node,Self, + {spawn_reply, ReqId, error, badopt}}, + _} = StSpawnReplyNode, + + stop_node(Node), + + ok. + + %% Send trace messages to a port. port(Config) when is_list(Config) -> lists:foreach(fun (TsType) -> do_port(TsType, Config) end, @@ -951,24 +1321,52 @@ simple_tracer(Data, DN) -> end. stop_tracer(N) when is_integer(N) -> - case catch (seq_trace_SUITE_tracer ! {stop,N,self()}) of - {'EXIT', _} -> - {error, not_started}; - _ -> - receive - {tracerlog,Data} -> - Data - after 1000 -> - {error,timeout} - end + stop_tracer(node(), N). + +stop_tracer(Node, N) when is_integer(N) -> + case rpc:call(Node,erlang,whereis,[seq_trace_SUITE_tracer]) of + Pid when is_pid(Pid) -> + unlink(Pid), + Mon = erlang:monitor(process, Pid), + Pid ! {stop,N,self()}, + receive + {'DOWN', Mon, process, Pid, noproc} -> + {error, not_started}; + {'DOWN', Mon, process, Pid, Reason} -> + {error, Reason}; + {tracerlog,Data} -> + erlang:demonitor(Mon, [flush]), + Data + after 5000 -> + erlang:demonitor(Mon, [flush]), + {error,timeout} + end; + _ -> + {error, not_started} end. start_tracer() -> - stop_tracer(0), - Pid = spawn(?MODULE,simple_tracer,[[], 0]), - register(seq_trace_SUITE_tracer,Pid), - seq_trace:set_system_tracer(Pid), - Pid. + start_tracer(node()). + +start_tracer(Node) -> + Me = self(), + Ref = make_ref(), + Pid = spawn_link(Node, + fun () -> + Self = self(), + stop_tracer(0), + register(seq_trace_SUITE_tracer,Self), + seq_trace:set_system_tracer(Self), + Self = seq_trace:get_system_tracer(), + Me ! Ref, + simple_tracer([], 0) + end), + receive + Ref -> + unlink(Pid), + Pid + end. + set_token_flags([]) -> ok; @@ -1020,7 +1418,7 @@ check_ts(strict_monotonic_timestamp, Ts) -> ok. start_node(Name, Param) -> - test_server:start_node(Name, slave, [{args, Param}]). + test_server:start_node(Name, peer, [{args, Param}]). stop_node(Node) -> test_server:stop_node(Node). diff --git a/lib/megaco/Makefile b/lib/megaco/Makefile index 1099c2a634..624c4b0619 100644 --- a/lib/megaco/Makefile +++ b/lib/megaco/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2019. All Rights Reserved. +# Copyright Ericsson AB 1999-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -110,7 +110,7 @@ DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk -.PHONY: reconf conf dconf econf configure setup info version \ +.PHONY: reconf conf dconf econf configure setup info_megaco version \ app_install dialyzer reconf: @@ -136,16 +136,15 @@ configure: configure.in setup: (cd src && $(MAKE) $@) -info: +info_megaco: @echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)" @echo "APP_DIR: $(APP_DIR)" @echo "APP_TAR_FILE: $(APP_TAR_FILE)" @echo "OTP_INSTALL_DIR: $(OTP_INSTALL_DIR)" @echo "APP_INSTALL_DIR: $(APP_INSTALL_DIR)" @echo "" - @echo "DIA_PLT: $(DIA_PLT)" - @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)" - @echo "" + +info: info_megaco version: @echo "$(VSN)" @@ -204,31 +203,6 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd "$(APP_RELEASE_DIR)"; gtar zcf "$(subst $(space),\ ,$@)" $(DIR_NAME)) -dialyzer_plt: $(DIA_PLT) - -$(DIA_PLT): Makefile - @echo "Building $(APPLICATION) plt file" - @dialyzer --build_plt \ - --output_plt $@ \ - -r ../$(APPLICATION)/ebin \ - ../../lib/kernel/ebin \ - ../../lib/stdlib/ebin \ - ../../lib/runtime_tools/ebin \ - ../../lib/syntax_tools/ebin \ - ../../lib/asn1/ebin \ - ../../lib/debugger/ebin \ - ../../lib/et/ebin \ - ../../lib/mnesia/ebin \ - ../../lib/crypto/ebin \ - ../../lib/compiler/ebin \ - ../../lib/wx/ebin \ - ../../lib/hipe/ebin \ - ../../erts/preloaded/ebin \ - --output $(DIA_ANALYSIS) \ - --verbose - -dialyzer: $(DIA_PLT) - @echo "Running dialyzer on $(APPLICATION)" - @dialyzer --plt $< \ - ../$(APPLICATION)/ebin \ - --verbose +DIA_PLT_APPS=asn1 runtime_tools et debugger + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/megaco/doc/src/Makefile b/lib/megaco/doc/src/Makefile index 5e085b60b0..b8488b4a13 100644 --- a/lib/megaco/doc/src/Makefile +++ b/lib/megaco/doc/src/Makefile @@ -27,11 +27,6 @@ include ../../vsn.mk VSN=$(MEGACO_VSN) APPLICATION=megaco -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - # ---------------------------------------------------- # Target Specs @@ -39,130 +34,23 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) include files.mk - # ---------------------------------------------------- XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ $(XML_PART_FILES) $(XML_CHAPTER_FILES) -INTERNAL_HTML_FILES = $(TECHNICAL_DESCR_FILES:%.xml=$(HTMLDIR)/%.html) - -HTML_APP_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) -HTML_EXTRA_FILES = $(XML_EXTRA_FILES:%.xml=$(HTMLDIR)/%.html) -HTML_PART_FILES = $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -HTML_FILES = $(HTML_APP_FILES) $(HTML_EXTRA_FILES) $(HTML_PART_FILES) - -INFO_FILE = ../../info - -HTML_REF3_FILES = $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) -HTML_CHAPTER_FILES = $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - -EXTRA_FILES = \ - $(DEFAULT_GIF_FILES) \ - $(DEFAULT_HTML_FILES) \ - $(HTML_REF3_FILES) \ - $(HTML_CHAPTER_FILES) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - STANDARD_DIR = ../standard STANDARDS = $(STANDARD_DIR)/rfc3525.txt \ $(STANDARD_DIR)/rfc4234.txt \ $(STANDARD_DIR)/rfc4566.txt \ $(STANDARD_DIR)/implementors_guide_v10-13.pdf -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -$(HTMLDIR)/%.jpg: %.jpg - $(INSTALL_DATA) $< $@ - -$(HTMLDIR)/%.png: %.png - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -ldocs: local_docs - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: imgs $(HTML_REF_MAN_FILE) - -clean clean_docs: clean_html clean_man - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -clean_man: - rm -f $(MAN3DIR)/* - -clean_html: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - -imgs: $(IMG_FILES:%=$(HTMLDIR)/%) - -man: $(MAN3_FILES) - -debug opt: - -info: - @echo "->Makefile<-" - @echo "" - @echo "HTML_REF_MAN_FILE = $(HTML_REF_MAN_FILE)" - @echo "" - @echo "XML_APPLICATION_FILES = $(XML_APPLICATION_FILES)" - @echo "XML_PART_FILES = $(XML_PART_FILES)" - @echo "XML_REF3_FILES = $(XML_REF3_FILES)" - @echo "XML_CHAPTER_FILES = $(XML_CHAPTER_FILES)" - @echo "" - @echo "IMG_FILES = $(IMG_FILES)" - @echo "" - @echo "MAN3_FILES = $(MAN3_FILES)" - @echo "" - @echo "HTML_FILES = $(HTML_FILES)" - @echo "TOP_HTML_FILES = $(TOP_HTML_FILES)" - @echo "" - @echo "DEFAULT_HTML_FILES = $(DEFAULT_HTML_FILES)" - @echo "DEFAULT_GIF_FILES = $(DEFAULT_GIF_FILES)" - @echo "" - @echo "" - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/standard" - $(INSTALL_DATA) $(STANDARDS) "$(RELSYSDIR)/doc/standard" +NO_CHUNKS = megaco_edist_compress.xml megaco_user.xml megaco_encoder.xml \ + megaco_transport.xml megaco_tcp.xml megaco_udp.xml \ + megaco_codec_meas.xml megaco_codec_mstone1.xml \ + megaco_codec_mstone2.xml megaco_codec_transform.xml -release_spec: +include $(ERL_TOP)/make/doc.mk $(HTMLDIR)/megaco_architecture.html: megaco_architecture.xml $(HTMLDIR)/megaco_codec_meas.html: megaco_codec_meas.xml diff --git a/lib/megaco/doc/src/definitions/term.defs.xml b/lib/megaco/doc/src/definitions/term.defs.xml deleted file mode 100644 index 096720af84..0000000000 --- a/lib/megaco/doc/src/definitions/term.defs.xml +++ /dev/null @@ -1,1518 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE terms SYSTEM "terms.dtd"> - -<terms> - <term> - <id>agent</id> - <shortdef>agent</shortdef> - <def> -An entity that terminates a management protocol in the Network Element. </def> - <resp>mbj</resp> - </term> - <term> - <id>API</id> - <shortdef>API</shortdef> - <def> -Application Programming Interface. The interface towards an application. Usually this is a set of functions available, but can also be a set of messages sent to or from an application. </def> - <resp>mbj</resp> - </term> - <term> - <id>application</id> - <shortdef>application</shortdef> - <def> -A collection of resources which is required to offer a specific service. </def> - <resp>mbj</resp> - </term> - <term> - <id>appmon</id> - <shortdef>Application Monitor</shortdef> - <def> -A graphical node and application process tree viewer. See also appmon. </def> - <resp>mbj</resp> - </term> - <term> - <id>Appmon</id> - <shortdef>Appmon</shortdef> - <def> -Application name for the Application Monitor within Erlang/OTP. A graphical node and process viewer. </def> - <resp>mbj</resp> - </term> - <term> - <id>app callback</id> - <shortdef>application callback module</shortdef> - <def> -A module which is called when the application is started, and when it has stopped. Every application has one application callback module. </def> - <resp>mbj</resp> - </term> - <term> - <id>AC</id> - <shortdef>application controller</shortdef> - <def> -A process which coordinates all operations on applications. </def> - <resp>mbj</resp> - </term> - <term> - <id>app master</id> - <shortdef>application master</shortdef> - <def> -The application master is a process that monitors the application. It is provided by the Erlang run-time system. Every application has an application master process. </def> - <resp>mbj</resp> - </term> - <term> - <id>.app file</id> - <shortdef>application resource file</shortdef> - <def> -Specifies the resources required by the application and how the application should be started. Every application has one application resource file, called AppName.app. </def> - <resp>mbj</resp> - </term> - <term> - <id>arity</id> - <shortdef>arity</shortdef> - <def> -Denotes the number of arguments to a function. </def> - <resp>jocke</resp> - </term> - <term> - <id>ASN.1</id> - <shortdef>ASN.1</shortdef> - <def> -Abstract Syntax Notation One - an ITU-T and ISO standard notation for describing data formats used in communication protocols. </def> - <resp>kenneth</resp> - </term> - <term> - <id>ASN.1 Compiler</id> - <shortdef>ASN.1 Compiler</shortdef> - <def> -The Erlang/OTP ASN.1 Compiler translates an ASN.1 module into a corresponding Erlang module with encode and decode functions. </def> - <resp>kenneth</resp> - </term> - <term> - <id>atom</id> - <shortdef>atom</shortdef> - <def> -An atom is a constant. Atoms always starts with a lower case letter (a-z) and are terminated by a non-alphanumeric character - otherwise they must be quoted (enclosed in ' '). An atom is a data type in Erlang, used to enhance the legibility of programs. </def> - <resp>kenneth</resp> - </term> - <term> - <id>atomicity</id> - <shortdef>atomicity</shortdef> - <def> -Atomicity refers to the "all or nothing" property. If a transaction succeeds (i.e. commits), then all its effects on the data is captured in the database. If the transaction does not succeed (i.e. aborts), then none of its effect on the data is captured in the database. In other words, the transaction processing algorithm guarantees that the database will not reflect a partitial effect of a transaction. </def> - <resp>hakan</resp> - </term> - <term> - <id>attach</id> - <shortdef>attach</shortdef> - <def> -The debugger may attach to a process. When attached, the debugger may show process details, such as message queues and variable bindings. </def> - <resp>olin</resp> - </term> - <term> - <id>behaviour</id> - <shortdef>behaviour</shortdef> - <def> -A "pattern of design" which can be used to build applications and processes in an applications. </def> - <resp>mbj</resp> - </term> - <term> - <id>BIF</id> - <shortdef>BIF</shortdef> - <def> -Built-In Functions which perform operations that are impossible or inefficient to program in Erlang itself. Are defined in the module Erlang in the application kernel </def> - <resp>kenneth</resp> - </term> - <term> - <id>binary</id> - <shortdef>binary</shortdef> - <def> -A data type in Erlang which is used to store an area of untyped memory. Binaries are used for efficiently handling large quantities of untyped data. </def> - <resp>kenneth</resp> - </term> - <term> - <id>boolean</id> - <shortdef>boolean</shortdef> - <def> -A common data type in programming and specification languages. The value can be either true or false. </def> - <resp>kenneth</resp> - </term> - <term> - <id>boot file</id> - <shortdef>boot file</shortdef> - <def> -A binary file with extension .boot which is read during start of an Erlang node. See SASL User's Guide for more info. </def> - <resp>kenneth</resp> - </term> - <term> - <id>break point</id> - <shortdef>break point</shortdef> - <def> -By setting a break point using the debugger, the user specifies a position in the source code of a module where execution is to be suspended and control transferred to the debugger. </def> - <resp>olin</resp> - </term> - <term> - <id>CAshort</id> - <shortdef>CA</shortdef> - <def> -See Certification Authority. </def> - <resp>helen</resp> - </term> - <term> - <id>CA certificate</id> - <shortdef>CA certificate</shortdef> - <def> -A certificate containing a CA's public key. Network entities use this public key to verify certificates signed with the CA's private key. </def> - <resp>helen</resp> - </term> - <term> - <id>callback function</id> - <shortdef>callback function</shortdef> - <def> -A callback function is a function exported from a callback module, that a generic behaviour calls to perform a specific task. </def> - <resp>mbj</resp> - </term> - <term> - <id>callback module</id> - <shortdef>callback module</shortdef> - <def> -A callback module is a module that implements the specific parts of a generic behaviour. The generic behaviour specifies which callback functions must be exported from the module. </def> - <resp>mbj</resp> - </term> - <term> - <id>certificate</id> - <shortdef>certificate</shortdef> - <def> -A file used for authenticating network entities under the SSL protocol. A certificate contains information about its owner (called the subject) and issuer, plus the owner's public key and a signature made by a CA. Network entities verify these signatures using CA certificates. </def> - <resp>helen</resp> - </term> - <term> - <id>CAlong</id> - <shortdef>Certification Authority (CA)</shortdef> - <def> -A trusted third party whose purpose is to sign certificates for network entities it has authenticated using secure means. Other network entities can check the signature to verify that a CA has authenticated the bearer of a certificate. </def> - <resp>helen</resp> - </term> - <term> - <id>CSRlong</id> - <shortdef>Certificate Signing Request (CSR)</shortdef> - <def> -An unsigned certificate for submission to a Certification Authority, which signs it with its private key. Once the CSR is signed, it becomes a certificate. </def> - <resp>helen</resp> - </term> - <term> - <id>child</id> - <shortdef>child</shortdef> - <def> -A supervised process. See also permanent, transient, temporary child. </def> - <resp>mbj</resp> - </term> - <term> - <id>cipher</id> - <shortdef>cipher</shortdef> - <def> -A system of encryption. </def> - <resp>helen</resp> - </term> - <term> - <id>ClearCase</id> - <shortdef>ClearCase</shortdef> - <def> -A configuration management system from Rational Software Corporation. </def> - <resp>lars</resp> - </term> - <term> - <id>client-server model</id> - <shortdef>client-server model</shortdef> - <def> -A model where there is a server, which manages some resource, and a number of clients which send requests to the server to access the resource. The client-server model is one of the basic programming techniques for coordinating the activities of several parallel processes. </def> - <resp>mbj</resp> - </term> - <term> - <id>cover</id> - <shortdef>Coverage Analyser</shortdef> - <def> -Module name for the coverage analyser tool, located in the Tools application. </def> - <resp>gunilla</resp> - </term> - <term> - <id>CORBAlong</id> - <shortdef>Common Object Request Broker Architecture (CORBA)</shortdef> - <def> -A specification of an architecture for a distributed object system </def> - <resp>lars</resp> - </term> - <term> - <id>CORBA</id> - <shortdef>Common Object Request Broker Architecture (CORBA)</shortdef> - <def> -A specification of an architecture for a distributed object system </def> - <resp>lars</resp> - </term> - <term> - <id>compiler</id> - <shortdef>compiler</shortdef> - <def> -A compiler is a translator. A common type of compilers are those who takes source code for a programming language and translates it into code that is executable on a specific platform. E.g. the Erlang compiler translates Erlang source code to an intermediary code that is executable by the Erlang Run Time System. </def> - <resp>kenneth</resp> - </term> - <term> - <id>consistency</id> - <shortdef>consistency</shortdef> - <def> -Consistency refers to the requirement that, given a consistent initial database state, the state of the database after the successful execution of a transaction is also consistent; that is, a transaction transforms the database from a consistent state to another consistent state. Database consistency may be defined as a set of rules or constraints. If the execution of a transaction causes the consistency constraints to be violated, the transaction is not accepted (and thus aborted) by the system. </def> - <resp>hakan</resp> - </term> - <term> - <id>cookie</id> - <shortdef>cookie</shortdef> - <def> -A magic cookie is a secret atom assigned to each Erlang node. The Erlang nodes in a distributed system must know each others cookies in order to authorize each other for communication </def> - <resp>kenneth</resp> - </term> - <term> - <id>CORBAshort</id> - <shortdef>CORBA</shortdef> - <def> -See Common Object RequestBroker Architecture. </def> - <resp>lars</resp> - </term> - <term> - <id>Coverage Analyser</id> - <shortdef>Coverage Analyser</shortdef> - <def> -A tool which provides a set of functions for coverage analysis of Erlang programs, i.e observing how many times each line or function are executed. See also cover. </def> - <resp>olin</resp> - </term> - <term> - <id>coverage analysis</id> - <shortdef>coverage analysis</shortdef> - <def> -The task of determining which lines, or how many lines of code, has actually been executed. Useful for determining the completeness of test suites. </def> - <resp>olin</resp> - </term> - <term> - <id>cross reference tool</id> - <shortdef>cross reference tool</shortdef> - <def> -A tool that can be used for finding dependencies between functions, modules, applications and releases. The Erlang/OTP cross reference tool is called xref and is part of the Tools application. </def> - <resp>gunilla</resp> - </term> - <term> - <id>CSRshort</id> - <shortdef>CSR</shortdef> - <def> -See Certificate Signing Request. </def> - <resp>helen</resp> - </term> - <term> - <id>data type</id> - <shortdef>data type</shortdef> - <def> -The data types in Erlang are numbers, atoms, tuples, lists, pids, funs, records, ports, references and binaries. The values of Erlang data types can be stored in variables. </def> - <resp>kenneth</resp> - </term> - <term> - <id>DBMSlong</id> - <shortdef>Database Management System (DBMS)</shortdef> - <def> -A database is a collection of data and a DBMS is a system which manages the database. Applications accesses the database through the database management system. </def> - <resp>hakan</resp> - </term> - <term> - <id>DBMSshort</id> - <shortdef>DBMS</shortdef> - <def> -See Database Management System. </def> - <resp>hakan</resp> - </term> - <term> - <id>Debugger</id> - <shortdef>Debugger</shortdef> - <def> -An Erlang/OTP tool which provides mechanisms which makes it possible to see what happens during the execution of code in specified modules, or when processes crash. </def> - <resp>olin</resp> - </term> - <term> - <id>dets</id> - <shortdef>dets</shortdef> - <def> -A module within the stdlib application, which provides a term storage, and which is used as the underlying file storage mechanism by the Mnesia DBMS. </def> - <resp>hakan</resp> - </term> - <term> - <id>dirty operations</id> - <shortdef>dirty operations</shortdef> - <def> -Functions which manipulate data in a DBMS, without using transactions. </def> - <resp>hakan</resp> - </term> - <term> - <id>distributed application</id> - <shortdef>distributed application</shortdef> - <def> -An application which runs on one of several nodes. May be restarted on another node. (See local application.) </def> - <resp>mbj</resp> - </term> - <term> - <id>DNSshort</id> - <shortdef>DNS</shortdef> - <def> -See Domain Name System. </def> - <resp>lars</resp> - </term> - <term> - <id>Docbuilder</id> - <shortdef>Docbuilder</shortdef> - <def> -The documentation system used in Erlang/OTP. </def> - <resp>jocke</resp> - </term> - <term> - <id>DNSlong</id> - <shortdef>Domain Name System (DNS)</shortdef> - <def> -DNS is a service that map names to internet addresses </def> - <resp>lars</resp> - </term> - <term> - <id>DTD</id> - <shortdef>DTD</shortdef> - <def> -Document Type Definition as defined in SGML. </def> - <resp>jocke</resp> - </term> - <term> - <id>durability</id> - <shortdef>durability</shortdef> - <def> -If a transaction succeeds, then its effect on the data is persistently captured, and will survive subsequent system failures resulting in loss of data in volatile memory. Durability is usually enforced by first writing modified data to some non-volatile memory (usually disc), before a transaction is allowed to commit. If there is a system failure, the state of the non-volatile memory must be recovered to reflect the effect of all and only committed transactions. </def> - <resp>hakan</resp> - </term> - <term> - <id>Emacs</id> - <shortdef>Emacs</shortdef> - <def> -A widely used text editor which allows customization of its behaviour. An Erlang mode for Emacs is included in the Erlang deliverables. </def> - <resp>kenneth</resp> - </term> - <term> - <id>Emacs for Erlang</id> - <shortdef>Emacs for Erlang</shortdef> - <def> -A tool which provides a major mode for editing Erlang source files in Emacs. </def> - <resp>olin</resp> - </term> - <term> - <id>encaps</id> - <shortdef>encapsulation</shortdef> - <def> -Data can be encapsulated into another data element. </def> - <resp>kent</resp> - </term> - <term> - <id>eprof</id> - <shortdef>eprof</shortdef> - <def> -A module in the tools application. See Profiler. </def> - <resp>olin</resp> - </term> - <term> - <id>erl</id> - <shortdef>erl</shortdef> - <def> -The command which starts an Erlang run-time system. </def> - <resp>kenneth</resp> - </term> - <term> - <id>erl_interface</id> - <shortdef>erl_interface library</shortdef> - <def> -A thread safe library with C-functions which makes it possible to write a C-program which appears as one of the nodes in a system of distributed Erlang nodes. </def> - <resp>kenneth</resp> - </term> - <term> - <id>Erlang</id> - <shortdef>Erlang</shortdef> - <def> -Erlang is a functional programming language intended for designing large industrial soft real time systems. </def> - <resp>kenneth</resp> - </term> - <term> - <id>Erlang emulator</id> - <shortdef>Erlang emulator</shortdef> - <def> -Another word for Erlang Virtual Machine. </def> - <resp>kenneth</resp> - </term> - <term> - <id>ERTSlong</id> - <shortdef>Erlang Run Time System</shortdef> - <def> -A fundamental part of Erlang/OTP which contains the Erlang Virtual Machine, the kernel and stdlib applications. The Erlang Run Time System is a mandatory part which all other Erlang applications are dependent upon. </def> - <resp>kenneth</resp> - </term> - <term> - <id>Erlang VM</id> - <shortdef>Erlang Virtual Machine</shortdef> - <def> -The virtual machine, which makes Erlang/OTP work together with a specific OS/HW platform. The Erlang Virtual Machine is available on several different platforms. The Erlang Virtual Machine is the glue which makes it possible to run an Erlang application on any platform without change. </def> - <resp>kenneth</resp> - </term> - <term> - <id>ERTSshort</id> - <shortdef>ERTS</shortdef> - <def> -See Erlang Run Time System. </def> - <resp>kenneth</resp> - </term> - <term> - <id>ETS</id> - <shortdef>ETS</shortdef> - <def> -Erlang Term Storage tables. </def> - <resp>olin</resp> - </term> - <term> - <id>EVAshort</id> - <shortdef>EVA</shortdef> - <def> -See Event and Alarm handling application </def> - <resp>mbj</resp> - </term> - <term> - <id>EVAlong</id> - <shortdef>Event and Alarm handling application (EVA)</shortdef> - <def> -An application that consists of Fault Management functionality, such as sending and logging of events and alarms. </def> - <resp>mbj</resp> - </term> - <term> - <id>event handler</id> - <shortdef>event handler</shortdef> - <def> -A module exporting functions which can process events sent to an event manager process. The event handler is a behaviour of type gen_event. </def> - <resp>mbj</resp> - </term> - <term> - <id>event manager</id> - <shortdef>event manager</shortdef> - <def> -A process to which events of a certain category is sent. gen_event handler can be installed in the event manager. </def> - <resp>mbj</resp> - </term> - <term> - <id>exit signal</id> - <shortdef>exit signal</shortdef> - <def> -A signal which is sent from a terminating process to the processes and ports it is linked to. An EXIT signal has the following format: {'EXIT', Exiting_Process_Id, Reason}. </def> - <resp>kent</resp> - </term> - <term> - <id>foo</id> - <shortdef>foo</shortdef> - <def> -Algebraic place holder. </def> - <resp>kent</resp> - </term> - <term> - <id>FSM</id> - <shortdef>FSM</shortdef> - <def> -Finite State Machine. </def> - <resp>kenneth</resp> - </term> - <term> - <id>fun</id> - <shortdef>fun</shortdef> - <def> -A data type, introduced in Erlang 4.4, which represent functional objects. </def> - <resp>kenneth</resp> - </term> - <term> - <id>function</id> - <shortdef>function</shortdef> - <def> -Erlang programs are written entirely in terms of modules with functions. A function can have arguments and does always return a result. A function can be exported which makes it available for calls from other modules. Non exported functions can only be called internally within the module. </def> - <resp>kenneth</resp> - </term> - <term> - <id>Gateway</id> - <shortdef>gateway</shortdef> - <def> -A server which acts as an intermediary for some other server. Unlike a proxy, a gateway receives requests as if it were the origin server for the requested resource; the requesting client may not be aware that it is communicating with a gateway. </def> - <resp>jocke</resp> - </term> - <term> - <id>gen_event</id> - <shortdef>gen_event</shortdef> - <def> -A behaviour used for programming event handling mechanisms, such as alarm handlers, error loggers, and plug-and-play handlers. </def> - <resp>mbj</resp> - </term> - <term> - <id>gen_fsm</id> - <shortdef>gen_fsm</shortdef> - <def> -A behaviour used for programming finite state machines. </def> - <resp>mbj</resp> - </term> - <term> - <id>gen_server</id> - <shortdef>gen_server</shortdef> - <def> -A behaviour used for programming client-server processes. </def> - <resp>mbj</resp> - </term> - <term> - <id>gterm</id> - <shortdef>Global Glossary Database</shortdef> - <def> -A glossary database used to list common acronymns and defintions etc. </def> - <resp>jocke</resp> - </term> - <term> - <id>xref</id> - <shortdef>xref</shortdef> - <def> -A cross reference tool that can be used for finding dependencies between functions, modules, applications and releases. Part of the Tools application. </def> - <resp>gunilla</resp> - </term> - <term> - <id>GSlong</id> - <shortdef>Graphics System</shortdef> - <def> -A library module which provides a graphics interface for Erlang. </def> - <resp>mbj</resp> - </term> - <term> - <id>grid</id> - <shortdef>grid</shortdef> - <def> -A multi-column object which is used to display tables. (Graphics System.) </def> - <resp>mbj</resp> - </term> - <term> - <id>GSshort</id> - <shortdef>GS</shortdef> - <def> -See Graphics System. </def> - <resp>olin</resp> - </term> - <term> - <id>GS Contributions</id> - <shortdef>GS Contributions</shortdef> - <def> -Unsupported user supplied tools which are included with the Erlang/OTP software release. </def> - <resp>olin</resp> - </term> - <term> - <id>GUI</id> - <shortdef>GUI</shortdef> - <def> -Graphical User Interface </def> - <resp>mbj</resp> - </term> - <term> - <id>Home Directory</id> - <shortdef>Home Directory</shortdef> - <def> -The position of a user account in the file system. The Home Directory is automatically passed to the Erlang run-time system at startup. On Unix the contents of the environment variable "HOME" is passed. Om Win32 the concatenation of the environment variables "HOMEDRIVE" and "HOMEPATH" is passed, or if these variables are not set, the value returned by the Win32 API function "GetWindowsDirectory" is passed. </def> - <resp>kenneth</resp> - </term> - <term> - <id>host name</id> - <shortdef>host name</shortdef> - <def> -The name of a machine on a network, e.g. erlang.ericsson.se. </def> - <resp>kent</resp> - </term> - <term> - <id>HTML</id> - <shortdef>HTML</shortdef> - <def> -Hypertext Markup Language. </def> - <resp>jocke</resp> - </term> - <term> - <id>HTTP</id> - <shortdef>HTTP</shortdef> - <def> -Hypertext Transfer Protocol. </def> - <resp>jocke</resp> - </term> - <term> - <id>HTTPS</id> - <shortdef>HTTPS</shortdef> - <def> -The Hypertext Transport Protocol, Secure, the standard SSL communication mechanism of the World Wide Web. </def> - <resp>helen</resp> - </term> - <term> - <id>IDLshort</id> - <shortdef>IDL</shortdef> - <def> -See Interface Description Language. </def> - <resp>lars</resp> - </term> - <term> - <id>IDLlong</id> - <shortdef>Interface Description Language (IDL)</shortdef> - <def> -The interface specification language created by OMG. </def> - <resp>lars</resp> - </term> - <term> - <id>indexing</id> - <shortdef>indexing</shortdef> - <def> -Fast lookup using an (usually enumerated) key. </def> - <resp>kent</resp> - </term> - <term> - <id>I1</id> - <shortdef>INETS</shortdef> - <def> -The Internet Services application </def> - <resp>jocke</resp> - </term> - <term> - <id>initial call</id> - <shortdef>initial call</shortdef> - <def> -The first call to an interpreted function (when using the Interpreter). </def> - <resp>kent</resp> - </term> - <term> - <id>instrumentation function</id> - <shortdef>instrumentation function</shortdef> - <def> -A function used to implement a Managed Object, i.e. give access to the real resources behind an MO. </def> - <resp>mbj</resp> - </term> - <term> - <id>IDLlong</id> - <shortdef>Interface Description Language (IDL)</shortdef> - <def> -The interface specification language created by OMG. </def> - <resp>lars</resp> - </term> - <term> - <id>interpreter</id> - <shortdef>interpreter</shortdef> - <def> -An application which provides mechanisms which make it possible to see what happens during the execution of code in specified (interpreted) modules, or when processes crash. </def> - <resp>kent</resp> - </term> - <term> - <id>isolation</id> - <shortdef>isolation</shortdef> - <def> -A transaction executes as if no other concurrent transactions are executing, and thus its execution results are equivalent to those obtained by executing database transactions serially. A system which maintains transaction isolation is also said to be enforcing serializability. </def> - <resp>hakan</resp> - </term> - <term> - <id>kernel</id> - <shortdef>kernel</shortdef> - <def> -An application which contains file servers, code servers and other code necessary for the Erlang run-time system. </def> - <resp>kenneth</resp> - </term> - <term> - <id>key</id> - <shortdef>key</shortdef> - <def> -A file containing the value that must be fed into an algorithm in order to encrypt or decrypt a message. </def> - <resp>helen</resp> - </term> - <term> - <id>key pair</id> - <shortdef>key pair</shortdef> - <def> -A set of two keys used in public key cryptography. One is the public key used to encrypt data, and the other is the private key necessary to decrypt the same data. </def> - <resp>helen</resp> - </term> - <term> - <id>list</id> - <shortdef>list</shortdef> - <def> -Terms separated by commas and enclosed in square brackets [ ] are called lists. A list is a data type in Erlang, used for storing a variable number of terms. It is dynamically sized. The first element of the list is referred to as the head of the list, and the remainer of the list as the tail. </def> - <resp>kenneth</resp> - </term> - <term> - <id>list box</id> - <shortdef>list box </shortdef> - <def> -A list of labels with optional scroll bars attached. (Graphics System.) </def> - <resp>mbj</resp> - </term> - <term> - <id>lc</id> - <shortdef>list comprehension</shortdef> - <def> -A language construct in Erlang which are analogous to set comprehensions in Zermelo-Frankel set theory. Analogous to the 'setof' and 'findall' predicates in Prolog. </def> - <resp>kenneth</resp> - </term> - <term> - <id>local application</id> - <shortdef>local application</shortdef> - <def> -An application which runs on one node and which are always started at the local node only. (See distributed application.) </def> - <resp>mbj</resp> - </term> - <term> - <id>manager</id> - <shortdef>manager</shortdef> - <def> -An entity that terminates a management protocol in the Network Management Station. </def> - <resp>mbj</resp> - </term> - <term> - <id>Master Agent</id> - <shortdef>Master Agent</shortdef> - <def> -The SNMP agent system consists of one Master Agent which terminates the SNMP protocol </def> - <resp>mbj</resp> - </term> - <term> - <id>MIB</id> - <shortdef>Management Information Base (MIB)</shortdef> - <def> -An abstract definition of the management information available through a management interface in a system. </def> - <resp>mbj</resp> - </term> - <term> - <id>matching</id> - <shortdef>matching</shortdef> - <def> -See pattern matching. </def> - <resp>kenneth</resp> - </term> - <term> - <id>message queue</id> - <shortdef>message queue</shortdef> - <def> -The queue of not yet received messages that are in the mailbox of a process. </def> - <resp>olin</resp> - </term> - <term> - <id>Mnesia</id> - <shortdef>Mnesia</shortdef> - <def> -Mnesia is a distributed Database Management System, appropriate for telecommunications applications and other applications with need of continuous operation and soft real-time properties. </def> - <resp>hakan</resp> - </term> - <term> - <id>MIBshort</id> - <shortdef>MIB</shortdef> - <def> -See Management Information Base. </def> - <resp>mbj</resp> - </term> - <term> - <id>MIME</id> - <shortdef>MIME</shortdef> - <def> -Multi-purpose Internet Mail Extensions. </def> - <resp>jocke</resp> - </term> - <term> - <id>MOlong</id> - <shortdef>Managed Object (MO)</shortdef> - <def> -The abstract management information defined in a MIB. </def> - <resp>mbj</resp> - </term> - <term> - <id>MO</id> - <shortdef>MO</shortdef> - <def> -Managed Object; The abstract management information defined in a MIB. </def> - <resp>nibe</resp> - </term> - <term> - <id>MOshort</id> - <shortdef>MO</shortdef> - <def> -See Managed Object. </def> - <resp>mbj</resp> - </term> - <term> - <id>module</id> - <shortdef>module</shortdef> - <def> -Module is the unit for compilation and for loading in Erlang. A Module contains a module declaration, export declarations and code representing the functions in the module. </def> - <resp>kenneth</resp> - </term> - <term> - <id>NCSA</id> - <shortdef>NCSA</shortdef> - <def> -The National Center for Supercomputing Applications. </def> - <resp>jocke</resp> - </term> - <term> - <id>NEshort</id> - <shortdef>NE</shortdef> - <def> -See Network Element. </def> - <resp>mbj</resp> - </term> - <term> - <id>NElong</id> - <shortdef>Network Element</shortdef> - <def> -In OTP, the Network Element is the entire distributed OTP system, meaning that the distributed OTP system is managed as one entity. </def> - <resp>mbj</resp> - </term> - <term> - <id>NE</id> - <shortdef>NE</shortdef> - <def> -Network Element; In OTP, the Network Element is the entire distributed OTP system, meaning that the distributed OTP system is managed as one entity. </def> - <resp>mbj</resp> - </term> - <term> - <id>NMSlong</id> - <shortdef>Network Management Station (NMS)</shortdef> - <def> -The place where the operator manages the network. </def> - <resp>mbj</resp> - </term> - <term> - <id>NMS</id> - <shortdef>NMS</shortdef> - <def> -Network Management Station; The place where the operator manages the network. </def> - <resp>nibe</resp> - </term> - <term> - <id>NMSshort</id> - <shortdef>NMS</shortdef> - <def> -See Network Management Station. </def> - <resp>mbj</resp> - </term> - <term> - <id>node</id> - <shortdef>node</shortdef> - <def> -An executing Erlang run-time system which can communicate with other Erlang run-time systems. </def> - <resp>kenneth</resp> - </term> - <term> - <id>node name</id> - <shortdef>node name</shortdef> - <def> -A node name is an atom constructed as the concatenation of a name supplied by the user, an "@" character, and the name of the host where the node is executing. </def> - <resp>kenneth</resp> - </term> - <term> - <id>notation</id> - <shortdef>notation</shortdef> - <def> -How things are written. </def> - <resp>kent</resp> - </term> - <term> - <id>notification</id> - <shortdef>notification</shortdef> - <def> -Information of an event. </def> - <resp>kent</resp> - </term> - <term> - <id>NROFF</id> - <shortdef>NROFF</shortdef> - <def> -A text formatting language for line printer quality output devices that runs on the UNIX operating system. </def> - <resp>jocke</resp> - </term> - <term> - <id>number</id> - <shortdef>number</shortdef> - <def> -A data type in Erlang. Are subdivided into integers, for storing natural numbers, or floats, for storing real numbers. </def> - <resp>kenneth</resp> - </term> - <term> - <id>OMGlong</id> - <shortdef>Object Managment Group (OMG)</shortdef> - <def> -A standardisation group for all specifications in the area of CORBA. </def> - <resp>lars</resp> - </term> - <term> - <id>OMGshort</id> - <shortdef>OMG</shortdef> - <def> -Object Managment Group. </def> - <resp>lars</resp> - </term> - <term> - <id>OTP</id> - <shortdef>OTP</shortdef> - <def> -Open Telecom Platform </def> - <resp>mike</resp> - </term> - <term> - <id>os_mon</id> - <shortdef>os_mon</shortdef> - <def> -An application which monitors the behaviour of the underlying operating system </def> - <resp>mbj</resp> - </term> - <term> - <id>parser generator</id> - <shortdef>parser generator</shortdef> - <def> -A tool for making compilers which takes a grammar description as input and generates a complete program (a parser) which recognizes input which complies with the grammar. YECC is a parser generator included in the Erlang/OTP. </def> - <resp>kenneth</resp> - </term> - <term> - <id>pass phrase</id> - <shortdef>pass phrase</shortdef> - <def> -The word or phrase which authenticates the user who is authorized to use private key file. The pass phrase prevents unauthorized users from starting, restarting, or reconfiguring the server. </def> - <resp>helen</resp> - </term> - <term> - <id>pattern matching</id> - <shortdef>pattern matching</shortdef> - <def> -A basic mechanism in Erlang for assigning values to variables and for controlling the flow of a program. </def> - <resp>kenneth</resp> - </term> - <term> - <id>permanent child</id> - <shortdef>permanent child</shortdef> - <def> -A supervised process which always is restarted when it dies. </def> - <resp>mbj</resp> - </term> - <term> - <id>Pid</id> - <shortdef>Pid</shortdef> - <def> -Process Identifier. A data type in Erlang for storing process references. The process identity of the process displayed in the line. </def> - <resp>kenneth</resp> - </term> - <term> - <id>Pman</id> - <shortdef>Pman</shortdef> - <def> -Module and application name for the Process Trace Tool. </def> - <resp>olin</resp> - </term> - <term> - <id>point</id> - <shortdef>point</shortdef> - <def> -A unit used to indicate the size of a typeface. Equal to 1/72 inches. </def> - <resp>jocke</resp> - </term> - <term> - <id>pointer</id> - <shortdef>pointer</shortdef> - <def> -A pointer tells where data is stored. Memory pointers are not used in Erlang. </def> - <resp>kent</resp> - </term> - <term> - <id>port</id> - <shortdef>port</shortdef> - <def> -A data type in Erlang. Ports provide the basic mechanism for communication with the external world. </def> - <resp>peterl</resp> - </term> - <term> - <id>port controller</id> - <shortdef>port controller</shortdef> - <def> -An Erlang process which controls a port program. A port has exactly one port controller. </def> - <resp>peterl</resp> - </term> - <term> - <id>port program</id> - <shortdef>port program</shortdef> - <def> -A program that runs as an external program in the operating system and which the Erlang run-time system can start and communicate with by means of the Erlang port mechanism. </def> - <resp>kenneth</resp> - </term> - <term> - <id>PostScript</id> - <shortdef>PostScript</shortdef> - <def> -A language describing a fully laid-out page in terms of fonts, lines, grey scales, and so on, in a way that is interpretable by a printer. The language was developed by Adobe Systems. </def> - <resp>jocke</resp> - </term> - <term> - <id>pretty-printed</id> - <shortdef>pretty-printed</shortdef> - <def> -Nicely formatted code or data, e.g. C or Erlang, with indents and tabs etc. </def> - <resp>jocke</resp> - </term> - <term> - <id>primitive</id> - <shortdef>primitive</shortdef> - <def> -The basic elements in a programming language. </def> - <resp>kent</resp> - </term> - <term> - <id>private key</id> - <shortdef>private key</shortdef> - <def> -The secret key in a pair, used to decrypt incoming messages and sign outgoing ones. </def> - <resp>helen</resp> - </term> - <term> - <id>process</id> - <shortdef>process</shortdef> - <def> -A process is a self-contained separate unit of execution which exists concurrently with other processes in the system. The BIF "spawn/3" creates and starts the execution of a new process. </def> - <resp>kenneth</resp> - </term> - <term> - <id>process dictionary</id> - <shortdef>process dictionary</shortdef> - <def> -Each process has an associated dictionary which provides the process with simple destructive storage capabilities. </def> - <resp>kenneth</resp> - </term> - <term> - <id>Process Manager</id> - <shortdef>Process Manager</shortdef> - <def> -Obsolete name for the Process Trace Tool. </def> - <resp>olin</resp> - </term> - <term> - <id>Process Trace Tool</id> - <shortdef>Process Trace Tool</shortdef> - <def> -A tool which gives an overview of the processes in the Erlang run-time system. See also Pman. </def> - <resp>olin</resp> - </term> - <term> - <id>Profiler</id> - <shortdef>Profiler</shortdef> - <def> -Another name for eprof, a tool used to profile a system in order to find out how much time is spent in various segments of a program. </def> - <resp>olin</resp> - </term> - <term> - <id>program</id> - <shortdef>program</shortdef> - <def> -Routines which can be executed by a computer. </def> - <resp>kent</resp> - </term> - <term> - <id>Proxy</id> - <shortdef>proxy</shortdef> - <def> -An intermediary program which acts as both a server and a client for the purpose of making requests on behalf of other clients. </def> - <resp>jocke</resp> - </term> - <term> - <id>public key</id> - <shortdef>public key</shortdef> - <def> -The publicly available key in a key pair, used to encrypt messages bound for its owner and to decrypt signatures made by its owner. </def> - <resp>helen</resp> - </term> - <term> - <id>query</id> - <shortdef>query</shortdef> - <def> -Queries are used for accessing the data in a Database Management System. The query specify a maybe complicated relation that should hold for all of the selected data. This could involve several tables as well as conditions like for instance less then and greater then. </def> - <resp>hakan</resp> - </term> - <term> - <id>query language</id> - <shortdef>query language</shortdef> - <def> -A language which is specially designed to express database queries. Examples of query languages are QLC and SQL. </def> - <resp>hakan</resp> - </term> - <term> - <id>receive</id> - <shortdef>receive</shortdef> - <def> -A primitive for message processing in Erlang, receives a message from a process. </def> - <resp>kenneth</resp> - </term> - <term> - <id>record</id> - <shortdef>record</shortdef> - <def> -A data structure intended for storing a fixed number of related Erlang terms, it is similar to a "struct" in C or a "record" in Pascal. </def> - <resp>kenneth</resp> - </term> - <term> - <id>recursion</id> - <shortdef>recursion</shortdef> - <def> -A function is recursive if it calls itself until the result desired is attained. Recursion is the heart of functional programming. </def> - <resp>kenneth</resp> - </term> - <term> - <id>reference</id> - <shortdef>reference</shortdef> - <def> -A data type in Erlang for storing system unique references. </def> - <resp>kenneth</resp> - </term> - <term> - <id>release handler</id> - <shortdef>release handler</shortdef> - <def> -A SASL process which handles software upgrade. </def> - <resp>mbj</resp> - </term> - <term> - <id>relup</id> - <shortdef>release upgrade script</shortdef> - <def> -A script with instructions to the release handler of how the release should be installed in the system. </def> - <resp>mbj</resp> - </term> - <term> - <id>RPC</id> - <shortdef>Remote Proceedure Call</shortdef> - <def> -A technique for evaluating a function transparently on a remote node. </def> - <resp>kenneth</resp> - </term> - <term> - <id>resource</id> - <shortdef>resource</shortdef> - <def> -The actual resource to be managed. A resource is represented by a Managed Object. Each resource is mapped to one or several resources. </def> - <resp>mbj</resp> - </term> - <term> - <id>resources</id> - <shortdef>resources</shortdef> - <def> -The actual resources to be managed. A resource is represented by a Managed Object. Each resource is mapped to one or several resources. </def> - <resp>nibe</resp> - </term> - <term> - <id>RFC</id> - <shortdef>RFC</shortdef> - <def> -A "Request for Comments" used as a proposed standard by IETF. </def> - <resp>jocke</resp> - </term> - <term> - <id>SASLshort</id> - <shortdef>SASL</shortdef> - <def> -See System Architecture Support Libraries. </def> - <resp>mbj</resp> - </term> - <term> - <id>schema</id> - <shortdef>schema</shortdef> - <def> -The schema contains the definitions and whereabouts for all tables. In Mnesia it is realized as a special table named "schema". </def> - <resp>hakan</resp> - </term> - <term> - <id>schema functions</id> - <shortdef>schema functions</shortdef> - <def> -The functions which are available for managing schemas. </def> - <resp>hakan</resp> - </term> - <term> - <id>SDL</id> - <shortdef>SDL</shortdef> - <def> -Specification and Description Language. A ITU-T standard specification language which is used to specify the behaviour of switching systems. </def> - <resp>kenneth</resp> - </term> - <term> - <id>send</id> - <shortdef>send</shortdef> - <def> -A primitive for message processing in Erlang, sends a message to a process. </def> - <resp>kenneth</resp> - </term> - <term> - <id>shell</id> - <shortdef>shell</shortdef> - <def> -The shell is an interactive front-end to an Erlang node where Erlang expressions can be evaluated. </def> - <resp>kenneth</resp> - </term> - <term> - <id>shell prompt</id> - <shortdef>shell prompt</shortdef> - <def> -The text or symbol shown on the screen when the shell is ready to receive commands. </def> - <resp>kent</resp> - </term> - <term> - <id>SNMPEAlong</id> - <shortdef>Simple Network Management Protocol Extensible Agent (SNMPEA).</shortdef> - <def> -An Erlang/OTP application that includes a bilingual extensible SNMP agent. </def> - <resp>mbj</resp> - </term> - <term> - <id>single assignment</id> - <shortdef>single assignment</shortdef> - <def> -Means that once a variable has been assigned a value, the value can never be changed. Erlang is a single assignment language. </def> - <resp>kenneth</resp> - </term> - <term> - <id>single step</id> - <shortdef>single step</shortdef> - <def> -Single stepping is a function provided by the debugger. By single stepping the developer may use the debugger to follow the execution of a process and see what actually happens at each function call. </def> - <resp>olin</resp> - </term> - <term> - <id>slave</id> - <shortdef>slave</shortdef> - <def> -Not in control, can never take over by himself. </def> - <resp>kent</resp> - </term> - <term> - <id>SSLlong</id> - <shortdef>Secure Sockets Layer (SSL)</shortdef> - <def> -A protocol created by Netscape Communications Corporation for authentication and encryption over TCP/IP networks, including Web. </def> - <resp>helen</resp> - </term> - <term> - <id>signature</id> - <shortdef>signature</shortdef> - <def> -An encrypted text block that validates a certificate or other file. A Certification Authority (CA) creates a signature by generating a hash of the public key embedded in a certificate, then encrypting the hash with its own private key. Only the CA's public key can decrypt the signature, verifying that the CA has authenticated the network entity that owns the certificate. </def> - <resp>helen</resp> - </term> - <term> - <id>SNMPshort</id> - <shortdef>SNMP</shortdef> - <def> -Simple Network Management Protocol. </def> - <resp>mbj</resp> - </term> - <term> - <id>SNMPshort</id> - <shortdef>SNMPEA</shortdef> - <def> -See Simple Network Management Protocol Extensible Agent. </def> - <resp>mbj</resp> - </term> - <term> - <id>spawn</id> - <shortdef>spawn</shortdef> - <def> -A primitive for multiprocessing in Erlang, that starts a parallel computation (called a process). The creation of a new process </def> - <resp>kenneth</resp> - </term> - <term> - <id>SSLshort</id> - <shortdef>SSL</shortdef> - <def> -See Secure Sockets Layer. </def> - <resp>helen</resp> - </term> - <term> - <id>SSLeay</id> - <shortdef>SSLeay</shortdef> - <def> -An SSL library developed by Eric Yong (eay@mincom.oz.au). </def> - <resp>helen</resp> - </term> - <term> - <id>SSLTOP</id> - <shortdef>SSLTOP</shortdef> - <def> -The path to your SSL directory, a subdirectory of ServerRoot. </def> - <resp>helen</resp> - </term> - <term> - <id>start script</id> - <shortdef>start script</shortdef> - <def> -A start script is a file with .script extension which is the source when a boot file is created. See SASL User's Guide for more info. </def> - <resp>kenneth</resp> - </term> - <term> - <id>stdlib</id> - <shortdef>stdlib</shortdef> - <def> -An application within Erlang/OTP which contains modules for manipulating lists, strings, files, etc. </def> - <resp>kenneth</resp> - </term> - <term> - <id>sticky directory</id> - <shortdef>sticky directory</shortdef> - <def> -A directory containing Erlang object code that is part of the runtime system. </def> - <resp>kent</resp> - </term> - <term> - <id>sticky lock</id> - <shortdef>sticky lock</shortdef> - <def> -A lock which lingers at a node after the transaction which first acquired the lock has terminated. Once a process has obtained a sticky lock on a node, subsequent locks acquired by processes on the same node, can be set without need of involving remote nodes. </def> - <resp>hakan</resp> - </term> - <term> - <id>string</id> - <shortdef>string</shortdef> - <def> -The ASCII or ISO-8859-1 representation of the list of characters occurring within quotation marks in Erlang code. </def> - <resp>kent</resp> - </term> - <term> - <id>Subagent</id> - <shortdef>Subagent</shortdef> - <def> -The SNMP agent system consists of one Master Agent (See Master Agent) and zero or more Subagents which can be used to distribute the SNMP agent system on several nodes. </def> - <resp>mbj</resp> - </term> - <term> - <id>supervision tree</id> - <shortdef>supervision tree</shortdef> - <def> -A hierarcial tree of processes used to program fault tolerant systems. </def> - <resp>mbj</resp> - </term> - <term> - <id>supervisor</id> - <shortdef>supervisor</shortdef> - <def> -A behaviour to stucture fault tolerant computations, and program supervision trees with. </def> - <resp>mbj</resp> - </term> - <term> - <id>sup_bridge</id> - <shortdef>supervisor bridge</shortdef> - <def> -A behaviour used to connect a process, or subsystem, to a supervisor tree. </def> - <resp>mbj</resp> - </term> - <term> - <id>SASLlong</id> - <shortdef>System Architecture Support Libraries (SASL)</shortdef> - <def> -An Erlang/OTP application which contains services for error logging, release handling and report browsing. </def> - <resp>mbj</resp> - </term> - <term> - <id>.config</id> - <shortdef>system configuration file</shortdef> - <def> -A file which specifies configuration parameters for the applications in the system. </def> - <resp>mbj</resp> - </term> - <term> - <id>table lock</id> - <shortdef>table lock</shortdef> - <def> -Table locks are locks which are set on whole tables. They may either be read locks or write locks. </def> - <resp>hakan</resp> - </term> - <term> - <id>Table Visualizer</id> - <shortdef>Table Visualizer</shortdef> - <def> -A tool which enables the user to examine ETS and Mnesia tables. </def> - <resp>olin</resp> - </term> - <term> - <id>temporary child</id> - <shortdef>temporary child</shortdef> - <def> -A supervised process which is never restarted when it dies. </def> - <resp>mbj</resp> - </term> - <term> - <id>term</id> - <shortdef>term</shortdef> - <def> -The super type of all Erlang types. </def> - <resp>kenneth</resp> - </term> - <term> - <id>Toolbar</id> - <shortdef>Toolbar</shortdef> - <def> -A tool that provides an simplistic interface to the other various Erlang/OTP tools </def> - <resp>olin</resp> - </term> - <term> - <id>tools</id> - <shortdef>tools</shortdef> - <def> -An application within Erlang/OTP which contains the tools which are not applications themselves. </def> - <resp>olin</resp> - </term> - <term> - <id>transaction</id> - <shortdef>transaction</shortdef> - <def> -Transactions groups a set of database accesses into an atomic unit. All transactions has the ACID (atomicity, concistency, isolation and durability) properties. </def> - <resp>hakan</resp> - </term> - <term> - <id>transient child</id> - <shortdef>transient child</shortdef> - <def> -A supervised process which is restarted if it dies non-normally. </def> - <resp>mbj</resp> - </term> - <term> - <id>trigger</id> - <shortdef>trigger</shortdef> - <def> -The Interpreter. A break point that is reached by a process triggers if it is active, and the execution of the process is stopped. </def> - <resp>olin</resp> - </term> - <term> - <id>tty</id> - <shortdef>tty</shortdef> - <def> -tty is a simple command line interface program where keystrokes are collected and interpreted. Originally meant teletypewriter equipment. Now it usually means the user console/terminal/shell window. </def> - <resp>kent</resp> - </term> - <term> - <id>tuple</id> - <shortdef>tuple</shortdef> - <def> -A tuple is a data type in Erlang. Tuples are used as place holders for complex data structures. Tuples may contain anything of any size, and are written as sequences of terms separated by commas, and enclosed in curly brackets { }. </def> - <resp>kenneth</resp> - </term> - <term> - <id>variable</id> - <shortdef>variable</shortdef> - <def> -An alias for a memory position, in which a value can be put. Erlang variables always start with an upper case letter. </def> - <resp>kenneth</resp> - </term> - <term> - <id>workers</id> - <shortdef>workers</shortdef> - <def> -The lower nodes in a supervision tree. These are the processes that actually performs some real work, e.g. servers. </def> - <resp>mbj</resp> - </term> - <term> - <id>YECC</id> - <shortdef>YECC</shortdef> - <def> -A LALR-1 parser generator included in Erlang/OTP. It is written in Erlang and generates a parser as an Erlang module. </def> - <resp>kenneth</resp> - </term> -</terms> - diff --git a/lib/megaco/doc/src/files.mk b/lib/megaco/doc/src/files.mk index e40889c3fb..6b7eaab531 100644 --- a/lib/megaco/doc/src/files.mk +++ b/lib/megaco/doc/src/files.mk @@ -55,7 +55,7 @@ XML_CHAPTER_FILES = \ BOOK_FILES = book.xml -IMG_FILES = \ +IMAGE_FILES = \ single_node_config.gif \ distr_node_config.gif \ megaco_sys_arch.gif \ diff --git a/lib/megaco/doc/src/megaco.xml b/lib/megaco/doc/src/megaco.xml index c7bcdfcd6f..f5daa4dfce 100644 --- a/lib/megaco/doc/src/megaco.xml +++ b/lib/megaco/doc/src/megaco.xml @@ -1969,23 +1969,6 @@ megaco_incr_timer() = #megaco_incr_timer{} </func> <func> - <name since="">get_sdp_record_from_PropertGroup(Type, PG) -> [sdp()]</name> - <fsummary>Get all sdp records of a certain type from a property group</fsummary> - <type> - <v>Type = v | c | m | o | a | b | t | r | z | k | s | i | u | e | p</v> - <v>PG = sdp_property_group()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Retreive all the sdp records of type <c>Type</c> from the - property group <c>PG</c>.</p> - - <marker id="versions1"></marker> - <marker id="versions2"></marker> - </desc> - </func> - - <func> <name since="">versions1() -> {ok, VersionInfo} | {error, Reason}</name> <name since="">versions2() -> {ok, Info} | {error, Reason}</name> <fsummary>Retreive various system and application info</fsummary> diff --git a/lib/megaco/src/app/megaco.erl b/lib/megaco/src/app/megaco.erl index a876ff02f8..2c27043782 100644 --- a/lib/megaco/src/app/megaco.erl +++ b/lib/megaco/src/app/megaco.erl @@ -101,8 +101,7 @@ formated_long_timestamp/0 ]). -%% This is for XREF --deprecated([{format_versions, 1, eventually}]). +-deprecated([{format_versions,1,"use megaco:print_version_info/0,1 instead"}]). -export_type([ void/0 diff --git a/lib/megaco/test/megaco_mess_SUITE.erl b/lib/megaco/test/megaco_mess_SUITE.erl index f3dfc053c6..8fb5c4a982 100644 --- a/lib/megaco/test/megaco_mess_SUITE.erl +++ b/lib/megaco/test/megaco_mess_SUITE.erl @@ -13474,8 +13474,8 @@ otp_8183_r1_mgc_reply_msg(Mid, TransId, CR, Cid) -> {?MODULE, otp_8183_r1_mg_verify_handle_connect, []}). -define(otp_8183_r1_mg_verify_service_change_rep_fun(), {?MODULE, otp_8183_r1_mg_verify_service_change_rep, []}). --define(otp_8183_r1_mg_verify_notify_rep_fun(Nr - {?MODULE, otp_8183_r1_mg_verify_notify_rep, [Nr). +-define(otp_8183_r1_mg_verify_notify_rep_fun(Nr), + {?MODULE, otp_8183_r1_mg_verify_notify_rep, [Nr]}). -else. -define(otp_8183_r1_mg_verify_handle_connect_fun(), otp_8183_r1_mg_verify_handle_connect_fun()). diff --git a/lib/mnesia/Makefile b/lib/mnesia/Makefile index 810433c4d0..d0edd48af9 100644 --- a/lib/mnesia/Makefile +++ b/lib/mnesia/Makefile @@ -38,3 +38,4 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/mnesia/doc/misc/Makefile b/lib/mnesia/doc/misc/Makefile index 29e2682967..0622a0b809 100644 --- a/lib/mnesia/doc/misc/Makefile +++ b/lib/mnesia/doc/misc/Makefile @@ -39,7 +39,7 @@ TEX_FILES= $(SGML_FILES:.sgml=.tex) DVI_FILES= $(SGML_FILES:.sgml=.dvi) PSFIG_FILES= $(FIG_FILES:.fig=.ps) PS_FILES= $(SGML_FILES:.sgml=.ps) -GIF_FILES= min_head.gif +GIF_FILES= ERL_FILES= HRL_FILES= DATA_FILES= diff --git a/lib/mnesia/doc/src/Makefile b/lib/mnesia/doc/src/Makefile index d9647fc081..f14fd33c7a 100644 --- a/lib/mnesia/doc/src/Makefile +++ b/lib/mnesia/doc/src/Makefile @@ -30,11 +30,6 @@ VSN=$(MNESIA_VSN) APPLICATION=mnesia # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -70,81 +65,9 @@ XML_FILES = \ XML_GEN_FILES = $(XML_CHAPTER_GEN_FILES:%=$(XMLDIR)/%) -GIF_FILES = \ +IMAGE_FILES = \ company.gif -XML_HTML_FILES = \ - notes_history.xml - - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_HTML_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info -EXTRA_FILES = \ - $(DEFAULT_GIF_FILES) \ - $(DEFAULT_HTML_FILES) \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - # ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -$(INDEX_TARGET): $(INDEX_SRC) ../../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - -debug opt: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3_FILES) "$(RELEASE_PATH)/man/man3" -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/mnesia/doc/src/Mnesia_chap4.xmlsrc b/lib/mnesia/doc/src/Mnesia_chap4.xmlsrc index b8d86adbf1..b646393ce3 100644 --- a/lib/mnesia/doc/src/Mnesia_chap4.xmlsrc +++ b/lib/mnesia/doc/src/Mnesia_chap4.xmlsrc @@ -750,7 +750,7 @@ mnesia:all_keys/1</seealso>. that can overload <c>Mnesia</c> on other nodes.</item> </list> <p>By passing the same "fun" as argument to the function - <seealso marker="mnesia#async_dirty/2">mnesia:async_dirty(Fun [, Args])</seealso>, + <seealso marker="mnesia#async_dirty/1">mnesia:async_dirty(Fun [, Args])</seealso>, it is performed in dirty context. The function calls are mapped to the corresponding dirty functions. This still involves logging, replication, and subscriptions but no locking, @@ -761,9 +761,9 @@ mnesia:all_keys/1</seealso>. node but not the others. If the table resides locally, no waiting occurs.</p> <p>By passing the same "fun" as an argument to the function - <seealso marker="mnesia#sync_dirty/2">mnesia:sync_dirty(Fun [, Args])</seealso>, + <seealso marker="mnesia#sync_dirty/1">mnesia:sync_dirty(Fun [, Args])</seealso>, it is performed in almost the same context as the function - <seealso marker="mnesia#async_dirty/2">mnesia:async_dirty/1,2</seealso>. + <seealso marker="mnesia#async_dirty/1">mnesia:async_dirty/1,2</seealso>. The difference is that the operations are performed synchronously. The caller waits for the updates to be performed on all active replicas. Using <c>mnesia:sync_dirty/1,2</c> @@ -788,7 +788,7 @@ mnesia:all_keys/1</seealso>. recommended if all options have been weighed and the possible outcomes are understood. By passing the earlier mentioned "fun" to the function - <seealso marker="mnesia#ets/2">mnesia:ets(Fun [, Args])</seealso>, + <seealso marker="mnesia#ets/1">mnesia:ets(Fun [, Args])</seealso>, it is performed but in a raw context. The operations are performed directly on the local <c>ets</c> tables, assuming that the local storage type is diff --git a/lib/mnesia/doc/src/mnesia.xml b/lib/mnesia/doc/src/mnesia.xml index 11b0b8e987..d05693cf8d 100644 --- a/lib/mnesia/doc/src/mnesia.xml +++ b/lib/mnesia/doc/src/mnesia.xml @@ -453,7 +453,7 @@ mnesia:add_table_index(person, age)</code> </desc> </func> <func> - <name since="">async_dirty(Fun, [, Args]) -> ResultOfFun | exit(Reason)</name> + <name since="">async_dirty(Fun [, Args]) -> ResultOfFun | exit(Reason)</name> <fsummary>Calls the <c>Fun</c> in a context that is not protected by a transaction.</fsummary> <desc> <marker id="async_dirty"></marker> @@ -1259,7 +1259,7 @@ mnesia:create_table(person, </desc> </func> <func> - <name since="">ets(Fun, [, Args]) -> ResultOfFun | exit(Reason)</name> + <name since="">ets(Fun [, Args]) -> ResultOfFun | exit(Reason)</name> <fsummary>Calls the <c>Fun</c> in a raw context that is not protected by a transaction.</fsummary> <desc> <marker id="ets"></marker> @@ -2134,7 +2134,7 @@ mnesia:create_table(employee, </desc> </func> <func> - <name since="">sync_dirty(Fun, [, Args]) -> ResultOfFun | exit(Reason)</name> + <name since="">sync_dirty(Fun [, Args]) -> ResultOfFun | exit(Reason)</name> <fsummary>Calls the <c>Fun</c> in a context that is not protected by a transaction.</fsummary> <desc> <marker id="sync_dirty"></marker> @@ -2497,8 +2497,12 @@ mnesia:create_table(employee, table.</p> </item> <item> - <p><c>memory</c>. Returns the number of - words allocated to the table on this node.</p> + <p><c>memory</c>. Returns for <c>ram_copies</c> and + <c>disc_copies</c> tables the number of words allocated in + memory to the table on this node. + For <c>disc_only_copies</c> tables the number of bytes stored + on disc is returned. + </p> </item> <item> <p><c>ram_copies</c>. Returns the nodes where a diff --git a/lib/mnesia/src/Makefile b/lib/mnesia/src/Makefile index 7d316df263..90e8780754 100644 --- a/lib/mnesia/src/Makefile +++ b/lib/mnesia/src/Makefile @@ -65,6 +65,7 @@ MODULES= \ mnesia_monitor \ mnesia_recover \ mnesia_registry \ + mnesia_rpc \ mnesia_schema\ mnesia_snmp_hook \ mnesia_subscr \ diff --git a/lib/mnesia/src/mnesia.app.src b/lib/mnesia/src/mnesia.app.src index c755b4d4b9..77bd1a7816 100644 --- a/lib/mnesia/src/mnesia.app.src +++ b/lib/mnesia/src/mnesia.app.src @@ -2,36 +2,37 @@ [{description, "MNESIA CXC 138 12"}, {vsn, "%VSN%"}, {modules, [ - mnesia, + mnesia, mnesia_app, mnesia_backend_type, - mnesia_backup, - mnesia_bup, - mnesia_checkpoint, + mnesia_backup, + mnesia_bup, + mnesia_checkpoint, mnesia_checkpoint_sup, mnesia_controller, - mnesia_dumper, - mnesia_event, + mnesia_dumper, + mnesia_event, mnesia_ext_sup, - mnesia_frag, - mnesia_frag_hash, - mnesia_index, + mnesia_frag, + mnesia_frag_hash, + mnesia_index, mnesia_kernel_sup, mnesia_late_loader, - mnesia_lib, - mnesia_loader, - mnesia_locker, - mnesia_log, - mnesia_monitor, + mnesia_lib, + mnesia_loader, + mnesia_locker, + mnesia_log, + mnesia_monitor, mnesia_recover, mnesia_registry, - mnesia_schema, - mnesia_snmp_hook, - mnesia_subscr, - mnesia_sup, + mnesia_rpc, + mnesia_schema, + mnesia_snmp_hook, + mnesia_subscr, + mnesia_sup, mnesia_sp, mnesia_text, - mnesia_tm + mnesia_tm ]}, {registered, [ mnesia_dumper_load_regulator, @@ -39,12 +40,13 @@ mnesia_fallback, mnesia_controller, mnesia_kernel_sup, - mnesia_late_loader, - mnesia_locker, + mnesia_late_loader, + mnesia_locker, mnesia_monitor, mnesia_recover, - mnesia_substr, - mnesia_sup, + mnesia_rpc, + mnesia_substr, + mnesia_sup, mnesia_tm ]}, {applications, [kernel, stdlib]}, diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index 02bc884e36..560ebca824 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -2057,8 +2057,14 @@ dirty_rpc(Tab, M, F, Args) -> do_dirty_rpc(_Tab, nowhere, _, _, Args) -> mnesia:abort({no_exists, Args}); +do_dirty_rpc(_Tab, Local, M, F, Args) when Local =:= node() -> + try apply(M,F,Args) + catch + throw:Res -> Res; + _:_ -> mnesia:abort({badarg, Args}) + end; do_dirty_rpc(Tab, Node, M, F, Args) -> - case rpc:call(Node, M, F, Args) of + case mnesia_rpc:call(Node, M, F, Args) of {badrpc, Reason} -> timer:sleep(20), %% Do not be too eager, and can't use yield on SMP %% Sync with mnesia_monitor @@ -2166,7 +2172,7 @@ raw_table_info(Tab, Item) -> disc_only_copies -> info_reply(dets:info(Tab, Item), Tab, Item); {ext, Alias, Mod} -> - info_reply(catch Mod:info(Alias, Tab, Item), Tab, Item); + info_reply(Mod:info(Alias, Tab, Item), Tab, Item); unknown -> bad_info_reply(Tab, Item) end @@ -2731,7 +2737,7 @@ create_table(Arg) -> create_table(Name, Arg) when is_list(Arg) -> mnesia_schema:create_table([{name, Name}| Arg]); create_table(Name, Arg) -> - {aborted, badarg, Name, Arg}. + {aborted, {badarg, Name, Arg}}. -spec delete_table(Tab::table()) -> t_result('ok'). delete_table(Tab) -> diff --git a/lib/mnesia/src/mnesia.hrl b/lib/mnesia/src/mnesia.hrl index fe48a6fe3d..4ddfc17a06 100644 --- a/lib/mnesia/src/mnesia.hrl +++ b/lib/mnesia/src/mnesia.hrl @@ -44,6 +44,8 @@ -define(SAFE(OP), try (OP) catch error:_ -> ok end). -define(CATCH(OP), try (OP) catch _:_Reason -> {'EXIT', _Reason} end). +-define(CATCHU(OP), fun() -> try (OP) catch _:_Reason -> {'EXIT', _Reason} end end()). + -define(catch_val(Var), (try ?ets_lookup_element(mnesia_gvar, Var, 2) catch error:_ -> {'EXIT', {badarg, []}} end)). diff --git a/lib/mnesia/src/mnesia_event.erl b/lib/mnesia/src/mnesia_event.erl index 49b3990086..0e96d5c73f 100644 --- a/lib/mnesia/src/mnesia_event.erl +++ b/lib/mnesia/src/mnesia_event.erl @@ -36,6 +36,8 @@ dumped_core = false, %% only dump fatal core once args}). +-include("mnesia.hrl"). + %%%---------------------------------------------------------------- %%% Callback functions from gen_server %%%---------------------------------------------------------------- @@ -131,14 +133,14 @@ handle_system_event({mnesia_down, Node}, State) -> "must be restarted. Forcing shutdown " "after mnesia_down from ~p...~n", report_fatal(Msg, [Node], nocore, State#state.dumped_core), - catch exit(whereis(mnesia_monitor), fatal), + ?SAFE(exit(whereis(mnesia_monitor), fatal)), {ok, State}; {UserMod, UserFunc} -> Msg = "Warning: A fallback is installed and Mnesia got mnesia_down " "from ~p. ~n", report_info(Msg, [Node]), - case catch apply(UserMod, UserFunc, [Node]) of - {'EXIT', {undef, _Reason}} -> + case ?CATCH(apply(UserMod, UserFunc, [Node])) of + {'EXIT', {undef, _R}} -> %% Backward compatibility apply(UserMod, UserFunc, []); {'EXIT', Reason} -> diff --git a/lib/mnesia/src/mnesia_kernel_sup.erl b/lib/mnesia/src/mnesia_kernel_sup.erl index a761d5eed0..7f226d92c4 100644 --- a/lib/mnesia/src/mnesia_kernel_sup.erl +++ b/lib/mnesia/src/mnesia_kernel_sup.erl @@ -42,6 +42,7 @@ init([]) -> worker_spec(mnesia_locker, timer:seconds(3), ProcLib), worker_spec(mnesia_recover, timer:minutes(3), [gen_server]), worker_spec(mnesia_tm, timer:seconds(30), ProcLib), + worker_spec(mnesia_rpc, timer:seconds(3), [gen_server]), supervisor_spec(mnesia_checkpoint_sup), worker_spec(mnesia_controller, timer:seconds(3), [gen_server]), worker_spec(mnesia_late_loader, timer:seconds(3), ProcLib) diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index 6abc05fade..dd28686f78 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -675,41 +675,41 @@ mkcore(CrashInfo) -> % dbg_out("Making a Mnesia core dump...~p~n", [CrashInfo]), Nodes = [node() |nodes()], %%TidLocks = (catch ets:tab2list(mnesia_tid_locks)), - HeldLocks = (catch mnesia:system_info(held_locks)), + HeldLocks = ?CATCHU(mnesia:system_info(held_locks)), Core = [ CrashInfo, {time, {date(), time()}}, {self, proc_dbg_info(self())}, - {nodes, catch rpc:multicall(Nodes, ?MODULE, get_node_number, [])}, - {applications, catch lists:sort(application:loaded_applications())}, - {flags, catch init:get_arguments()}, - {code_path, catch code:get_path()}, - {code_loaded, catch lists:sort(code:all_loaded())}, - {etsinfo, catch ets_info(ets:all())}, - - {version, catch mnesia:system_info(version)}, - {schema, catch ets:tab2list(schema)}, - {gvar, catch ets:tab2list(mnesia_gvar)}, - {master_nodes, catch mnesia_recover:get_master_node_info()}, - - {processes, catch procs()}, - {relatives, catch relatives()}, - {workers, catch workers(mnesia_controller:get_workers(2000))}, - {locking_procs, catch locking_procs(HeldLocks)}, + {nodes, ?CATCHU(rpc:multicall(Nodes, ?MODULE, get_node_number, []))}, + {applications, ?CATCHU(lists:sort(application:loaded_applications()))}, + {flags, ?CATCHU(init:get_arguments())}, + {code_path, ?CATCHU(code:get_path())}, + {code_loaded, ?CATCHU(lists:sort(code:all_loaded()))}, + {etsinfo, ?CATCHU(ets_info(ets:all()))}, + + {version, ?CATCHU(mnesia:system_info(version))}, + {schema, ?CATCHU(ets:tab2list(schema))}, + {gvar, ?CATCHU(ets:tab2list(mnesia_gvar))}, + {master_nodes, ?CATCHU(mnesia_recover:get_master_node_info())}, + + {processes, ?CATCHU(procs())}, + {relatives, ?CATCHU(relatives())}, + {workers, ?CATCHU(workers(mnesia_controller:get_workers(2000)))}, + {locking_procs, ?CATCHU(locking_procs(HeldLocks))}, {held_locks, HeldLocks}, - {lock_queue, catch mnesia:system_info(lock_queue)}, - {load_info, catch mnesia_controller:get_info(2000)}, - {trans_info, catch mnesia_tm:get_info(2000)}, + {lock_queue, ?CATCHU(mnesia:system_info(lock_queue))}, + {load_info, ?CATCHU(mnesia_controller:get_info(2000))}, + {trans_info, ?CATCHU(mnesia_tm:get_info(2000))}, - {schema_file, catch file:read_file(tab2dat(schema))}, - {dir_info, catch dir_info()}, - {logfile, catch {ok, read_log_files()}} + {schema_file, ?CATCHU(file:read_file(tab2dat(schema)))}, + {dir_info, ?CATCHU(dir_info())}, + {logfile, ?CATCHU({ok, read_log_files()})} ], term_to_binary(Core). procs() -> - Fun = fun(P) -> {P, (catch lists:zf(fun proc_info/1, process_info(P)))} end, + Fun = fun(P) -> {P, (?CATCH(lists:zf(fun proc_info/1, process_info(P))))} end, lists:map(Fun, processes()). proc_info({registered_name, Val}) -> {true, Val}; @@ -730,7 +730,7 @@ have_majority(_Tab, AllNodes, HaveNodes) -> length(Present) > length(Missing). read_log_files() -> - [{F, catch file:read_file(F)} || F <- mnesia_log:log_files()]. + [{F, ?CATCH(file:read_file(F))} || F <- mnesia_log:log_files()]. dir_info() -> {ok, Cwd} = file:get_cwd(), @@ -739,7 +739,7 @@ dir_info() -> {mnesia_dir, Dir, file:read_file_info(Dir)}] ++ case file:list_dir(Dir) of {ok, Files} -> - [{mnesia_file, F, catch file:read_file_info(dir(F))} || F <- Files]; + [{mnesia_file, F, ?CATCH(file:read_file_info(dir(F)))} || F <- Files]; Other -> [Other] end. @@ -854,7 +854,7 @@ vcore(Bin) when is_binary(Bin) -> Core = binary_to_term(Bin), Fun = fun({Item, Info}) -> show("***** ~tp *****~n", [Item]), - case catch vcore_elem({Item, Info}) of + case ?CATCHU(vcore_elem({Item, Info})) of {'EXIT', Reason} -> show("{'EXIT', ~tp}~n", [Reason]); _ -> ok @@ -1446,7 +1446,7 @@ eval_debug_fun(FunId, EvalContext, EvalFile, EvalLine) -> ok end end - catch error -> + catch _:_ -> ok end. diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index 2cdae0c906..c34a83bb6c 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -654,8 +654,8 @@ down(Tab, Storage) -> mnesia_lib:dets_sync_close(Tab), file:delete(TmpFile); {ext, Alias, Mod} -> - catch Mod:close_table(Alias, Tab), - catch Mod:delete_table(Alias, Tab) + ?CATCHU(Mod:close_table(Alias, Tab)), + ?CATCHU(Mod:delete_table(Alias, Tab)) end, mnesia_checkpoint:tm_del_copy(Tab, node()), mnesia_controller:sync_del_table_copy_whereabouts(Tab, node()), diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl index 4e50b46da8..5ce1439298 100644 --- a/lib/mnesia/src/mnesia_monitor.erl +++ b/lib/mnesia/src/mnesia_monitor.erl @@ -83,9 +83,9 @@ going_down = [], tm_started = false, early_connects = [], connecting, mq = [], remote_node_status = []}). --define(current_protocol_version, {8,4}). +-define(current_protocol_version, {8,5}). --define(previous_protocol_version, {8,3}). +-define(previous_protocol_version, {8,4}). start() -> gen_server:start_link({local, ?MODULE}, ?MODULE, @@ -196,7 +196,7 @@ protocol_version() -> %% A sorted list of acceptable protocols the %% preferred protocols are first in the list acceptable_protocol_versions() -> - [protocol_version(), ?previous_protocol_version]. + [protocol_version(), ?previous_protocol_version, {8,3}]. needs_protocol_conversion(Node) -> case {?catch_val({protocol, Node}), protocol_version()} of @@ -409,7 +409,7 @@ handle_call({unsafe_close_log, Name}, _From, State) -> {reply, ok, State}; handle_call({unsafe_create_external, Tab, Alias, Mod, Cs}, _From, State) -> - case catch Mod:create_table(Alias, Tab, mnesia_schema:cs2list(Cs)) of + case ?CATCH(Mod:create_table(Alias, Tab, mnesia_schema:cs2list(Cs))) of {'EXIT', ExitReason} -> {reply, {error, ExitReason}, State}; Reply -> diff --git a/lib/mnesia/src/mnesia_rpc.erl b/lib/mnesia/src/mnesia_rpc.erl new file mode 100644 index 0000000000..bbeacce9db --- /dev/null +++ b/lib/mnesia/src/mnesia_rpc.erl @@ -0,0 +1,86 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% Don't use the system rpc server since it may overload other +%% applications when using a lot of dirty read operations. + +-module(mnesia_rpc). +-behaviour(gen_server). + +-export([start/0, + call/4 + ]). + + +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3 + ]). + +-include("mnesia.hrl"). + +start() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, [self()], + [{timeout, infinity} %%, {debug, [trace]} + ]). + +call(Node, M, F, Args) -> + case ?catch_val({protocol, Node}) of + {Ver, _} when Ver < {8,5} -> + rpc:call(Node, M, F, Args); + _ -> + try gen_server:call({?MODULE, Node}, {apply, M, F, Args}, infinity) + catch + _:Reason -> {badrpc, {'EXIT', Reason}} + end + end. + +init([_Parent]) -> + {ok, #{}}. + +handle_call({apply, Mod, Fun, Args}, _From, State) -> + %% rpc is just for ets:lookups so no need to spawn requests + Result = try apply(Mod, Fun, Args) + catch throw:Res -> Res; + _:Reason -> {badrpc, {'EXIT', Reason}} + end, + {reply, Result, State}; +handle_call(Msg, _From, State) -> + error("~p got unexpected call: ~tp~n", [?MODULE, Msg]), + {reply, badop, State}. + +handle_cast(Msg, State) -> + mnesia_lib:error("~p got unexpected cast: ~tp~n", [?MODULE, Msg]), + {noreply, State}. + +handle_info(Msg, State) -> + mnesia_lib:error("~p got unexpected info: ~tp~n", [?MODULE, Msg]), + {noreply, State}. + + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +terminate(_Reason, _State) -> + ok. diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index d0f5d0e07b..4a65f3996a 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -1271,7 +1271,7 @@ verify_nodes(Cs) -> lists:foreach(AtomCheck, Nodes). verify(Expected, Fun, Error) when is_function(Fun) -> - do_verify(Expected, catch Fun(), Error); + do_verify(Expected, ?CATCH(Fun()), Error); verify(Expected, Actual, Error) -> do_verify(Expected, Actual, Error). diff --git a/lib/mnesia/src/mnesia_sp.erl b/lib/mnesia/src/mnesia_sp.erl index d65c659690..0c56107c41 100644 --- a/lib/mnesia/src/mnesia_sp.erl +++ b/lib/mnesia/src/mnesia_sp.erl @@ -30,12 +30,15 @@ init_proc(Who, Mod, Fun, Args) -> mnesia_lib:verbose("~p starting: ~p~n", [Who, self()]), - case catch apply(Mod, Fun, Args) of - {'EXIT', Reason} -> - mnesia_monitor:terminate_proc(Who, Reason, Args), + try + apply(Mod, Fun, Args) + catch + exit:Reason when Reason =:= shutdown; Reason =:= kill; Reason =:= normal -> + mnesia_monitor:terminate_proc(Who, Reason, Args), exit(Reason); - Other -> - Other + _:Reason:ST -> + mnesia_monitor:terminate_proc(Who, {Reason,ST}, Args), + exit(Reason) end. diff --git a/lib/mnesia/src/mnesia_sup.erl b/lib/mnesia/src/mnesia_sup.erl index 3e5792900b..fd5156d2a4 100644 --- a/lib/mnesia/src/mnesia_sup.erl +++ b/lib/mnesia/src/mnesia_sup.erl @@ -88,7 +88,7 @@ add_event_handler() -> kill() -> Mnesia = [mnesia_fallback | mnesia:ms()], - Kill = fun(Name) -> catch exit(whereis(Name), kill) end, + Kill = fun(Name) -> try exit(whereis(Name), kill) catch _:_ -> ok end end, lists:foreach(Kill, Mnesia), lists:foreach(fun ensure_dead/1, Mnesia), timer:sleep(10), diff --git a/lib/mnesia/src/mnesia_text.erl b/lib/mnesia/src/mnesia_text.erl index cc21621ff4..ee31fdfd27 100644 --- a/lib/mnesia/src/mnesia_text.erl +++ b/lib/mnesia/src/mnesia_text.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -170,7 +170,7 @@ read_terms(Stream, File, Line, L) -> end. read_term_from_stream(Stream, File, Line) -> - R = io:request(Stream, {get_until,'',erl_scan,tokens,[Line]}), + R = io:request(Stream, {get_until,latin1,'',erl_scan,tokens,[Line]}), case R of {ok,Toks,EndLine} -> case erl_parse:parse_term(Toks) of diff --git a/lib/mnesia/src/mnesia_tm.erl b/lib/mnesia/src/mnesia_tm.erl index 18520423ba..41e7ddce87 100644 --- a/lib/mnesia/src/mnesia_tm.erl +++ b/lib/mnesia/src/mnesia_tm.erl @@ -2082,9 +2082,9 @@ ask_commit(_Protocol, _Tid, [], _DiscNs, _RamNs, WaitFor, Local) -> {WaitFor, Local}. convert_old(sync_asym_trans, Node) -> - case mnesia_monitor:needs_protocol_conversion(Node) of - true -> asym_trans; - false -> sync_asym_trans + case ?catch_val({protocol, Node}) of + {{8,3}, _} -> asym_trans; + _ -> sync_asym_trans end; convert_old(Protocol, _) -> Protocol. diff --git a/lib/observer/Makefile b/lib/observer/Makefile index 8483922f76..ffd73051b9 100644 --- a/lib/observer/Makefile +++ b/lib/observer/Makefile @@ -36,4 +36,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=runtime_tools et wx +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/observer/doc/src/Makefile b/lib/observer/doc/src/Makefile index e843772f0b..459aeeea0b 100644 --- a/lib/observer/doc/src/Makefile +++ b/lib/observer/doc/src/Makefile @@ -27,16 +27,11 @@ VSN=$(OBSERVER_VSN) APPLICATION=observer # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml XML_REF1_FILES = \ - cdv.xml + cdv_cmd.xml XML_REF3_FILES = \ crashdump.xml \ observer.xml \ @@ -57,91 +52,16 @@ XML_CHAPTER_FILES = \ BOOK_FILES = book.xml - XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF1_FILES) $(XML_REF3_FILES) \ $(XML_APPLICATION_FILES) $(XML_REF6_FILES) -ONLY_HTML_FILE = - -GIF_FILES = \ +IMAGE_FILES = \ et_processes.gif \ et_modsprocs.gif -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN1_FILES = $(XML_REF1_FILES:%.xml=$(MAN1DIR)/%.1) -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -# ---------------------------------------------------- -# Targets +NO_CHUNKS = crashdump.xml # ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) $(ONLY_HTML_FILE:%=$(HTMLDIR)/%) - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN1DIR)/* - rm -f $(MAN3DIR)/* - rm -f $(MAN6DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - - -$(HTMLDIR)/$(ONLY_HTML_FILE): - $(INSTALL_DATA) $(ONLY_HTML_FILE) $@ - -man: $(MAN1_FILES) $(MAN3_FILES) $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man1" - $(INSTALL_DATA) $(MAN1DIR)/* "$(RELEASE_PATH)/man/man1" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" - - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/observer/doc/src/cdv.xml b/lib/observer/doc/src/cdv_cmd.xml index df1032780a..32f8f392cd 100644 --- a/lib/observer/doc/src/cdv.xml +++ b/lib/observer/doc/src/cdv_cmd.xml @@ -11,7 +11,7 @@ Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at - + http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software diff --git a/lib/observer/doc/src/ref_man.xml b/lib/observer/doc/src/ref_man.xml index 73e7e0053a..8ba920ecfb 100644 --- a/lib/observer/doc/src/ref_man.xml +++ b/lib/observer/doc/src/ref_man.xml @@ -36,6 +36,6 @@ <xi:include href="ttb.xml"/> <xi:include href="etop.xml"/> <xi:include href="crashdump.xml"/> - <xi:include href="cdv.xml"/> + <xi:include href="cdv_cmd.xml"/> </application> diff --git a/lib/observer/doc/src/ttb.xml b/lib/observer/doc/src/ttb.xml index fee95e0b21..ae5cc10b6e 100644 --- a/lib/observer/doc/src/ttb.xml +++ b/lib/observer/doc/src/ttb.xml @@ -277,8 +277,21 @@ ttb:p(all, call).</input></pre> </func> <func> - <name since="">tp, tpl, ctp, ctpl, ctpg</name> - <name since="OTP 19.0">tpe, ctpe</name> + <name since="">tp(Module [, Function [, Arity]], MatchSpec)</name> + <name since="">tp({Module, Function , Arity}, MatchSpec)</name> + <name since="">tpl(Module [, Function [, Arity]], MatchSpec)</name> + <name since="">tpl({Module, Function , Arity}, MatchSpec)</name> + <name since="">ctp()</name> + <name since="">ctp(Module [, Function [, Arity]])</name> + <name since="">ctp({Module, Function, Arity})</name> + <name since="">ctpl()</name> + <name since="">ctpl(Module [, Function [, Arity]])</name> + <name since="">ctpl({Module, Function, Arity})</name> + <name since="">ctpg()</name> + <name since="">ctpg(Module [, Function [, Arity]])</name> + <name since="">ctpg({Module, Function, Arity})</name> + <name since="OTP 19.0">tpe(Event,MatchSpec)</name> + <name since="OTP 19.0">ctpe(Event)</name> <fsummary>Set and clear trace patterns.</fsummary> <desc> <p>These functions are to be used with trace diff --git a/lib/observer/doc/src/ttb_ug.xml b/lib/observer/doc/src/ttb_ug.xml index 34591ae8de..bc44b60bf4 100644 --- a/lib/observer/doc/src/ttb_ug.xml +++ b/lib/observer/doc/src/ttb_ug.xml @@ -88,8 +88,8 @@ <item><p>If you want to trace function calls (that is, if you have trace flag <c>call</c> set on any process), you must also set trace patterns on the required function(s) with - <seealso marker="ttb#/0"><c>ttb:tp/2,3,4</c></seealso> or - <seealso marker="ttb#/0"><c>ttb:tpl/2,3,4</c></seealso>. + <seealso marker="ttb#tp/2"><c>ttb:tp/2,3,4</c></seealso> or + <seealso marker="ttb#tpl/2"><c>ttb:tpl/2,3,4</c></seealso>. A function is only traced if it has a trace pattern. The trace pattern specifies how to trace the function by using match specifications. Match specifications are diff --git a/lib/observer/src/observer.app.src b/lib/observer/src/observer.app.src index d48b846ad2..55de6de0c6 100644 --- a/lib/observer/src/observer.app.src +++ b/lib/observer/src/observer.app.src @@ -66,7 +66,7 @@ {registered, []}, {applications, [kernel, stdlib]}, {env, []}, - {runtime_dependencies, ["wx-1.2","stdlib-3.5","runtime_tools-1.8.14", - "kernel-3.0","et-1.5","erts-7.0"]}]}. + {runtime_dependencies, ["wx-1.2","stdlib-@OTP-15251@","runtime_tools-1.8.14", + "kernel-@OTP-15251@","et-1.5","erts-@OTP-15251@"]}]}. diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl index da47a30fb1..1b144e05dc 100644 --- a/lib/observer/src/observer_alloc_wx.erl +++ b/lib/observer/src/observer_alloc_wx.erl @@ -261,20 +261,31 @@ sum_alloc_instances([{_,_,Data}|Instances],BS,CS,TotalBS,TotalCS) -> sum_alloc_instances([],BS,CS,TotalBS,TotalCS) -> {BS,CS,TotalBS,TotalCS,true}. -sum_alloc_one_instance([{sbmbcs,[{blocks_size,BS,_,_},{carriers_size,CS,_,_}]}| - Rest],OldBS,OldCS,TotalBS,TotalCS) -> - sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS,TotalCS); -sum_alloc_one_instance([{_,[{blocks_size,BS,_,_},{carriers_size,CS,_,_}]}| +sum_alloc_one_instance([{_,[{blocks,TypedBlocks},{carriers_size,CS,_,_}]}| Rest],OldBS,OldCS,TotalBS,TotalCS) -> + %% OTP 23 and later. + BS = sum_alloc_block_list(TypedBlocks, 0), sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS+BS,TotalCS+CS); -sum_alloc_one_instance([{_,[{blocks_size,BS},{carriers_size,CS}]}| +sum_alloc_one_instance([{_,[{blocks_size,BS,_,_},{carriers_size,CS,_,_}]}| Rest],OldBS,OldCS,TotalBS,TotalCS) -> + %% OTP 22 and earlier. sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS+BS,TotalCS+CS); sum_alloc_one_instance([_|Rest],BS,CS,TotalBS,TotalCS) -> sum_alloc_one_instance(Rest,BS,CS,TotalBS,TotalCS); sum_alloc_one_instance([],BS,CS,TotalBS,TotalCS) -> {BS,CS,TotalBS,TotalCS}. +sum_alloc_block_list([{_Type, [{size, Current, _, _}]} | Rest], Acc) -> + %% We ignore the type since we're returning a summary of all blocks in the + %% carriers employed by a certain instance. + sum_alloc_block_list(Rest, Current + Acc); +sum_alloc_block_list([{_Type, [{size, Current}]} | Rest], Acc) -> + sum_alloc_block_list(Rest, Current + Acc); +sum_alloc_block_list([_ | Rest], Acc) -> + sum_alloc_block_list(Rest, Acc); +sum_alloc_block_list([], Acc) -> + Acc. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% create_mem_info(Parent) -> diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index 10d88c994a..5c77330e49 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -152,6 +152,7 @@ dump_maps() -> Pid = spawn_link(F), receive {Pid,done} -> + unlink(Pid), {ok,Pid} end. @@ -198,6 +199,7 @@ dump_persistent_terms() -> Pid = spawn_link(F), receive {Pid,done} -> + unlink(Pid), {ok,Pid} end. diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl index 33133dd78d..5d1a5d8dc2 100644 --- a/lib/observer/test/ttb_SUITE.erl +++ b/lib/observer/test/ttb_SUITE.erl @@ -658,11 +658,29 @@ seq_trace(Config) when is_list(Config) -> ?line ok = ttb:format( [filename:join(Privdir,atom_to_list(Node)++"-seq_trace")]), ?line [{trace_ts,StartProc,call,{?MODULE,seq,[]},{_,_,_}}, - {seq_trace,0,{send,{0,1},StartProc,P1Proc,{Start,P2}}}, - {seq_trace,0,{send,{1,2},P1Proc,P2Proc,{P1,Start}}}, - {seq_trace,0,{send,{2,3},P2Proc,StartProc,{P2,P1}}}, + {seq_trace,0,{send,{First, Seq0},StartProc,P1Proc,SpawnRequest1}}, + {seq_trace,0,{send,{Seq0, Seq1},P1Proc,StartProc,SpawnReply1}}, + {seq_trace,0,{send,{Seq2, Seq3},StartProc,P2Proc,SpawnRequest2}}, + {seq_trace,0,{send,{Seq3, Seq4},P2Proc,StartProc,SpawnReply2}}, + {seq_trace,0,{send,{Seq5, Seq6},StartProc,P1Proc,{Start,P2}}}, + {seq_trace,0,{send,{Seq6, Seq7},P1Proc,P2Proc,{P1,Start}}}, + {seq_trace,0,{send,{Seq7, Last},P2Proc,StartProc,{P2,P1}}}, end_of_trace] = flush(), - + spawn_request = element(1, SpawnRequest1), + SReq1 = element(2, SpawnRequest1), + spawn_reply = element(1, SpawnReply1), + SReq1 = element(2, SpawnReply1), + spawn_request = element(1, SpawnRequest2), + SReq2 = element(2, SpawnRequest2), + spawn_reply = element(1, SpawnReply2), + SReq2 = element(2, SpawnReply2), + true = First < Seq0, + true = Seq0 < Seq1, + true = Seq1 < Seq2, + true = Seq2 < Seq3, + true = Seq4 < Seq5, + true = Seq6 < Seq7, + true = Seq7 < Last, %% Additional test for metatrace case StartProc of {Start,_,_} -> ok; diff --git a/lib/odbc/Makefile b/lib/odbc/Makefile index f7816c25fc..ee39992a84 100644 --- a/lib/odbc/Makefile +++ b/lib/odbc/Makefile @@ -69,12 +69,6 @@ do_configure: configure configure: configure.in autoconf -.PHONY: info - -info: - @echo "ODBC_VSN: $(ODBC_VSN)" - - # ---------------------------------------------------- # Application (source) release targets # ---------------------------------------------------- @@ -114,3 +108,5 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/odbc/c_src/Makefile.in b/lib/odbc/c_src/Makefile.in index 294d832797..3c16e7e294 100644 --- a/lib/odbc/c_src/Makefile.in +++ b/lib/odbc/c_src/Makefile.in @@ -54,14 +54,14 @@ RELSYSDIR = $(RELEASE_PATH)/lib/odbc-$(VSN) EI_ROOT = $(ERL_TOP)/lib/erl_interface EI_INCLUDE = -I$(EI_ROOT)/include -I$(EI_ROOT)/include/$(TARGET) ifeq ($(findstring win32,$(TARGET)),win32) -EI_LIB = -lerl_interface_md -lei_md +EI_LIB = -lei_md ENTRY_OBJ=$(ERL_TOP)/erts/obj/$(TARGET)/port_entry.o PORT_ENTRY_POINT=erl_port_entry ENTRY_LDFLAGS=-entry:$(PORT_ENTRY_POINT) WIN32_TARGET = $(WIN_BIN_DIR)/odbcserver.exe EXE_TARGET = $(WIN32_TARGET) else -EI_LIB = -lerl_interface -lei +EI_LIB = -lei UNIX_TARGET = $(BIN_DIR)/odbcserver EXE_TARGET = $(UNIX_TARGET) endif diff --git a/lib/odbc/doc/src/Makefile b/lib/odbc/doc/src/Makefile index a6311ceede..b66341f9eb 100644 --- a/lib/odbc/doc/src/Makefile +++ b/lib/odbc/doc/src/Makefile @@ -30,11 +30,6 @@ VSN=$(ODBC_VSN) APPLICATION=odbc # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -57,75 +52,8 @@ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ $(XML_PART_FILES) $(XML_CHAPTER_FILES) -GIF_FILES = \ +IMAGE_FILES = \ odbc_app_arc.gif # ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_HTML_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) \ - -INFO_FILE = ../../info -EXTRA_FILES = $(DEFAULT_GIF_FILES) \ - $(DEFAULT_HTML_FILES) \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -$(HTMLDIR)/%.gif: %.gif # Copy them to ../html - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) # We depend just to copy them to ../html - -debug opt: - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/os_mon/Makefile b/lib/os_mon/Makefile index 40ce94e0c7..f45065a79d 100644 --- a/lib/os_mon/Makefile +++ b/lib/os_mon/Makefile @@ -35,3 +35,4 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/os_mon/doc/src/Makefile b/lib/os_mon/doc/src/Makefile index 8e9a4c333c..d16f2b4831 100644 --- a/lib/os_mon/doc/src/Makefile +++ b/lib/os_mon/doc/src/Makefile @@ -28,11 +28,6 @@ VSN=$(OS_MON_VSN) APPLICATION=os_mon # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -49,7 +44,7 @@ XML_CHAPTER_FILES = notes.xml BOOK_FILES = book.xml -GIF_FILES = +IMAGE_FILES = XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ @@ -57,66 +52,4 @@ XML_FILES = \ # ---------------------------------------------------- -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6DIR)/* "$(RELEASE_PATH)/man/man6" - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/os_mon/src/Makefile b/lib/os_mon/src/Makefile index 923a31f290..98c5ced068 100644 --- a/lib/os_mon/src/Makefile +++ b/lib/os_mon/src/Makefile @@ -34,7 +34,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/os_mon-$(VSN) # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- -MODULES= disksup memsup cpu_sup os_mon os_sup os_mon_sysinfo nteventlog +MODULES= disksup memsup cpu_sup os_mon os_mon_mib os_sup os_mon_sysinfo nteventlog INCLUDE=../include CSRC=../c_src diff --git a/lib/os_mon/src/os_mon.app.src b/lib/os_mon/src/os_mon.app.src index 6c9b0d7576..894f63e227 100644 --- a/lib/os_mon/src/os_mon.app.src +++ b/lib/os_mon/src/os_mon.app.src @@ -21,7 +21,7 @@ {application, os_mon, [{description, "CPO CXC 138 46"}, {vsn, "%VSN%"}, - {modules, [os_mon, os_sup, + {modules, [os_mon, os_mon_mib, os_sup, disksup, memsup, cpu_sup, os_mon_sysinfo, nteventlog]}, {registered, [os_mon_sup, os_mon_sysinfo, disksup, memsup, cpu_sup, os_sup_server]}, diff --git a/lib/os_mon/src/os_mon_mib.erl b/lib/os_mon/src/os_mon_mib.erl new file mode 100644 index 0000000000..8a171b6071 --- /dev/null +++ b/lib/os_mon/src/os_mon_mib.erl @@ -0,0 +1,27 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2020. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% This module was removed entirely in OTP 22.0, it's only retained for its +%% removal warning attribute. +%% + +-module(os_mon_mib). +-removed([{'_','_', "this module was removed in OTP 22.0"}]). diff --git a/lib/os_mon/test/cpu_sup_SUITE.erl b/lib/os_mon/test/cpu_sup_SUITE.erl index ba28f31f26..7a8065c591 100644 --- a/lib/os_mon/test/cpu_sup_SUITE.erl +++ b/lib/os_mon/test/cpu_sup_SUITE.erl @@ -155,46 +155,72 @@ tiny_diff(A, B) -> -define(SPIN_TIME, 1000). +spinner(Parent) -> + receive + stop -> Parent ! stopped + after 0 -> spinner(Parent) + end. + %% Test utilization values util_values(Config) when is_list(Config) -> - + NrOfProcessors = + case erlang:system_info(logical_processors_available) of + unknown -> 2; + X -> X + end, Tester = self(), Ref = make_ref(), - Loop = fun (L) -> L(L) end, Spinner = fun () -> - Looper = spawn_link(fun () -> Loop(Loop) end), + Spinner = self(), + NrOfProcesses = NrOfProcessors, + Loopers = + [spawn_link(fun () -> spinner(Spinner) end) + || _ <- lists:seq(1,NrOfProcesses)], receive after ?SPIN_TIME -> ok end, - unlink(Looper), - exit(Looper, kill), + [begin + Looper ! stop, + receive stopped -> ok end + end + || Looper <- Loopers], Tester ! Ref end, - + Spin = fun () -> + spawn_link(Spinner), + receive Ref -> ok end + end, cpu_sup:util(), - - spawn_link(Spinner), - receive Ref -> ok end, - HighUtil1 = cpu_sup:util(), - receive after ?SPIN_TIME -> ok end, - LowUtil1 = cpu_sup:util(), + LowUtil0 = cpu_sup:util(), + case LowUtil0 of + U when U > ((100.0 / NrOfProcessors) * 0.33) -> + %% We cannot run this test if the system is doing other + %% work at the same time as the result will be unreliable + {skip, io_lib:format("CPU utilization was too high (~f%)", [LowUtil0])}; + _ -> + cpu_sup:util(), + Spin(), + HighUtil1 = cpu_sup:util(), - spawn_link(Spinner), - receive Ref -> ok end, - HighUtil2 = cpu_sup:util(), + receive after ?SPIN_TIME -> ok end, + LowUtil1 = cpu_sup:util(), - receive after ?SPIN_TIME -> ok end, - LowUtil2 = cpu_sup:util(), + Spin(), + HighUtil2 = cpu_sup:util(), - Utils = [{high1,HighUtil1}, {low1,LowUtil1}, - {high2,HighUtil2}, {low2,LowUtil2}], - io:format("Utils: ~p~n", [Utils]), + receive after ?SPIN_TIME -> ok end, + LowUtil2 = cpu_sup:util(), - false = LowUtil1 > HighUtil1, - false = LowUtil1 > HighUtil2, - false = LowUtil2 > HighUtil1, - false = LowUtil2 > HighUtil2, + Utils = [{high1,HighUtil1}, {low1,LowUtil1}, + {high2,HighUtil2}, {low2,LowUtil2}], + io:format("Utils: ~p~n", [Utils]), - ok. + false = LowUtil1 > HighUtil1, + false = LowUtil1 > HighUtil2, + false = LowUtil2 > HighUtil1, + false = LowUtil2 > HighUtil2, + + ok + end. % Outdated diff --git a/lib/parsetools/Makefile b/lib/parsetools/Makefile index e9de5c43cb..2ddb06feb1 100644 --- a/lib/parsetools/Makefile +++ b/lib/parsetools/Makefile @@ -37,3 +37,4 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/parsetools/doc/src/Makefile b/lib/parsetools/doc/src/Makefile index 2e8b232902..a4d7d4381b 100644 --- a/lib/parsetools/doc/src/Makefile +++ b/lib/parsetools/doc/src/Makefile @@ -29,11 +29,6 @@ VSN=$(PARSETOOLS_VSN) APPLICATION=parsetools # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -48,72 +43,10 @@ XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) -GIF_FILES = +IMAGE_FILES = XML_HTML_FILES = \ notes_history.xml # ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_HTML_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/parsetools/doc/src/leex.xml b/lib/parsetools/doc/src/leex.xml index 3b82f60201..59a6c87586 100644 --- a/lib/parsetools/doc/src/leex.xml +++ b/lib/parsetools/doc/src/leex.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2009</year><year>2017</year> + <year>2009</year><year>2019</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -146,8 +146,8 @@ Token = tuple()</code> <funcs> <func> - <name since="">string(String) -> StringRet</name> - <name since="">string(String, StartLine) -> StringRet</name> + <name since="">Module:string(String) -> StringRet</name> + <name since="">Module:string(String, StartLine) -> StringRet</name> <fsummary>Generated by Leex</fsummary> <type> <v>String = string()</v> @@ -164,9 +164,9 @@ Token = tuple()</code> </func> <func> - <name since="">token(Cont, Chars) -> {more,Cont1} | {done,TokenRet,RestChars} + <name since="">Module:token(Cont, Chars) -> {more,Cont1} | {done,TokenRet,RestChars} </name> - <name since="">token(Cont, Chars, StartLine) -> {more,Cont1} + <name since="">Module:token(Cont, Chars, StartLine) -> {more,Cont1} | {done,TokenRet,RestChars} </name> <fsummary>Generated by Leex</fsummary> @@ -193,15 +193,15 @@ Token = tuple()</code> but used through the i/o system where it can typically be called in an application by:</p> <code> -io:request(InFile, {get_until,Prompt,Module,token,[Line]}) +io:request(InFile, {get_until,unicode,Prompt,Module,token,[Line]}) -> TokenRet</code> </desc> </func> <func> - <name since="">tokens(Cont, Chars) -> {more,Cont1} | {done,TokensRet,RestChars} + <name since="">Module:tokens(Cont, Chars) -> {more,Cont1} | {done,TokensRet,RestChars} </name> - <name since="">tokens(Cont, Chars, StartLine) -> + <name since="">Module:tokens(Cont, Chars, StartLine) -> {more,Cont1} | {done,TokensRet,RestChars} </name> <fsummary>Generated by Leex</fsummary> @@ -240,7 +240,7 @@ io:request(InFile, {get_until,Prompt,Module,token,[Line]}) but used through the i/o system where it can typically be called in an application by:</p> <code> -io:request(InFile, {get_until,Prompt,Module,tokens,[Line]}) +io:request(InFile, {get_until,unicode,Prompt,Module,tokens,[Line]}) -> TokensRet</code> </desc> </func> diff --git a/lib/parsetools/doc/src/ref_man.xml b/lib/parsetools/doc/src/ref_man.xml index a06221250f..a2c82eb711 100644 --- a/lib/parsetools/doc/src/ref_man.xml +++ b/lib/parsetools/doc/src/ref_man.xml @@ -31,9 +31,9 @@ </header> <description> <p>The <em>Parsetools</em> application contains utilities for - parsing and scanning. Yecc is an <term id="LALR-1"></term>parser - generator for Erlang, similar to yacc. Yecc takes a <term - id="BNF"></term>grammar definition as input, and produces Erlang + parsing and scanning. Yecc is an LALR-1 parser + generator for Erlang, similar to yacc. Yecc takes a BNF grammar + definition as input, and produces Erlang code for a parser as output. Leex is a regular expression based lexical analyzer generator for Erlang, similar to lex or flex.</p> </description> diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index 3343a4282b..f44b1da861 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.erl @@ -1345,7 +1345,7 @@ make_rule_pointer_info(StC, RpRhs, RuleIndex) -> rp_info([], _SymbolTab, _LcTab, _RuleIndex) -> []; rp_info([Category | Followers], SymbolTab, LcTab, RuleIndex) -> - case dict:find(Category, RuleIndex) of + case maps:find(Category, RuleIndex) of error -> % terminal []; {ok, ExpandingRules} when Followers =:= [] -> @@ -1364,7 +1364,7 @@ rp_info([Category | Followers], SymbolTab, LcTab, RuleIndex) -> make_lookahead([], _, _, LA) -> {empty, LA}; make_lookahead([Symbol | Symbols], SymbolTab, LcTab, LA) -> - case dict:find(Symbol, LcTab) of + case maps:find(Symbol, LcTab) of {ok, LeftCorner} -> % nonterminal case empty_member(LeftCorner) of true -> @@ -1377,7 +1377,7 @@ make_lookahead([Symbol | Symbols], SymbolTab, LcTab, LA) -> set_add(Symbol, LA) end. -%% -> dict-of({Nonterminal, [Terminal]}). +%% -> map-of({Nonterminal, [Terminal]}). %% The algorithm FIRST/1 from the Dragon Book. %% Left corner table, all terminals (including '$empty') that can %% begin strings generated by Nonterminal. @@ -1386,15 +1386,15 @@ make_left_corner_table(#yecc{rules_list = RulesList} = St) -> Rules = map(fun(#rule{symbols = [Lhs | Rhs]}) -> {Lhs,{Lhs, Rhs}} end, RulesList), - LeftHandTab = dict:from_list(family(Rules)), + LeftHandTab = maps:from_list(family(Rules)), X0 = [{S,H} || {H,{H,Rhs}} <- Rules, S <- Rhs, not is_terminal(SymbolTab, S)], XL = family_with_domain(X0, St#yecc.nonterminals), - X = dict:from_list(XL), - Xref = fun(NT) -> dict:fetch(NT, X) end, + X = maps:from_list(XL), + Xref = fun(NT) -> maps:get(NT, X) end, E = set_empty(), - LC0 = dict:from_list([{H, E} || {H,_} <- XL]), + LC0 = maps:from_list([{H, E} || {H,_} <- XL]), %% Handle H -> a S, where a is a terminal ('$empty' inclusive). {Q, LC1} = foldl(fun({H,{H,[S | _]}}, {Q0, LC}) -> @@ -1413,7 +1413,7 @@ left_corners(Q0, LC0, LeftHandTab, SymbolTab, Xref) -> [] -> LC0; Q1 -> - Rs = flatmap(fun(NT) -> dict:fetch(NT, LeftHandTab) end, Q1), + Rs = flatmap(fun(NT) -> maps:get(NT, LeftHandTab) end, Q1), {LC, Q} = left_corners2(Rs, LC0, [], SymbolTab, Xref), left_corners(Q, LC, LeftHandTab, SymbolTab, Xref) end. @@ -1422,7 +1422,7 @@ left_corners2([], LC, Q, _SymbolTab, _Xref) -> {LC, Q}; left_corners2([{Head,Rhs} | Rs], LC, Q0, SymbolTab, Xref) -> Ts = left_corner_rhs(Rhs, Head, LC, set_empty(), SymbolTab), - First0 = dict:fetch(Head, LC), + First0 = maps:get(Head, LC), case set_is_subset(Ts, First0) of true -> left_corners2(Rs, LC, Q0, SymbolTab, Xref); @@ -1432,14 +1432,14 @@ left_corners2([{Head,Rhs} | Rs], LC, Q0, SymbolTab, Xref) -> end. upd_first(NT, Ts, LC) -> - dict:update(NT, fun(First) -> set_union(First, Ts) end, LC). + maps:update_with(NT, fun(First) -> set_union(First, Ts) end, LC). left_corner_rhs([S | Ss], Head, LC, Ts, SymbolTab) -> case ets:lookup(SymbolTab, S) of [{_,Num}=SymbolAndNum] when Num >= 0 -> set_add_terminal(SymbolAndNum, Ts); [_NonTerminalSymbol] -> - First = dict:fetch(S, LC), + First = maps:get(S, LC), case empty_member(First) of true -> NTs = set_union(empty_delete(First), Ts), @@ -1466,7 +1466,7 @@ make_rule_index(#yecc{nonterminals = Nonterminals, Symbol2Rule = [{Foo,R} || #rule{symbols = Symbols}=R <- RulesListNoCodes, Foo <- Symbols], Pointer2Rule = [{I, R} || {{_Foo,R},I} <- count(1, Symbol2Rule)], - {dict:from_list(IndexedTab), dict:from_list(Pointer2Rule)}. + {maps:from_list(IndexedTab), maps:from_list(Pointer2Rule)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Computing parse action table from list of states and goto table: @@ -2309,14 +2309,14 @@ function_name(St, Name, Suf) -> rule(RulePointer, St) -> #rule{n = N, anno = Anno, symbols = Symbols} = - dict:fetch(RulePointer, St#yecc.rule_pointer2rule), + maps:get(RulePointer, St#yecc.rule_pointer2rule), {Symbols, Anno, N}. get_rule(RuleNmbr, St) -> - dict:fetch(RuleNmbr, St#yecc.rule_pointer2rule). + maps:get(RuleNmbr, St#yecc.rule_pointer2rule). tokens(RuleNmbr, St) -> - Rule = dict:fetch(RuleNmbr, St#yecc.rule_pointer2rule), + Rule = maps:get(RuleNmbr, St#yecc.rule_pointer2rule), Rule#rule.tokens. goto(From, Symbol, St) -> diff --git a/lib/public_key/Makefile b/lib/public_key/Makefile index 7a5c1c1443..ed8901a8af 100644 --- a/lib/public_key/Makefile +++ b/lib/public_key/Makefile @@ -38,3 +38,6 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=asn crypto + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/public_key/doc/src/Makefile b/lib/public_key/doc/src/Makefile index c8647750af..6a694806bc 100644 --- a/lib/public_key/doc/src/Makefile +++ b/lib/public_key/doc/src/Makefile @@ -30,10 +30,6 @@ VSN=$(PUBLIC_KEY_VSN) APPLICATION=public_key # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -52,107 +48,8 @@ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ $(XML_REF6_FILES) $(XML_PART_FILES) $(XML_CHAPTER_FILES) -GIF_FILES = - -# ---------------------------------------------------- - -TOP_HTML_FILES = - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -EXTRA_FILES = \ - $(DEFAULT_GIF_FILES) \ - $(DEFAULT_HTML_FILES) \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) - TOP_SPECS_FILE = specs.xml # ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -SPECS_FLAGS = -I../../include -I../../src -I../../.. - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(MAN6DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f $(SPECS_FILES) - rm -f errs core *~ - -man: $(MAN3_FILES) $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6DIR)/* "$(RELEASE_PATH)/man/man6" -release_spec: -info: - @echo "GIF_FILES:\n$(GIF_FILES)" - @echo "" - @echo "EXTRA_FILES:\n$(EXTRA_FILES)" - @echo "" - @echo "HTML_FILES:\n$(HTML_FILES)" - @echo "" - @echo "TOP_HTML_FILES:\n$(TOP_HTML_FILES)" - @echo "" - @echo "DEFAULT_GIF_FILES:\n$(DEFAULT_GIF_FILES)" - @echo "" - @echo "DEFAULT_HTML_FILES:\n$(DEFAULT_HTML_FILES)" - @echo "" - @echo "XML_REF3_FILES:\n$(XML_REF3_FILES)" - @echo "" - @echo "XML_REF6_FILES:\n$(XML_REF6_FILES)" - @echo "" - @echo "XML_CHAPTER_FILES:\n$(XML_CHAPTER_FILES)" - @echo "" +include $(ERL_TOP)/make/doc.mk diff --git a/lib/public_key/src/pubkey_pbe.erl b/lib/public_key/src/pubkey_pbe.erl index 6003bf21d0..75c17025ab 100644 --- a/lib/public_key/src/pubkey_pbe.erl +++ b/lib/public_key/src/pubkey_pbe.erl @@ -39,23 +39,22 @@ %%-------------------------------------------------------------------- encode(Data, Password, "DES-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_encrypt(des_cbc, Key, IV, pbe_pad(Data, block_size(des_cbc))); + crypto:crypto_one_time(des_cbc, Key, IV, pbe_pad(Data, block_size(des_cbc)), true); encode(Data, Password, "DES-EDE3-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, - crypto:block_encrypt(des3_cbc, [Key1, Key2, Key3], IV, pbe_pad(Data, block_size(des_3ede))); + crypto:crypto_one_time(des_ede3_cbc, Key, IV, pbe_pad(Data, block_size(des_ede3_cbc)), true); encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_encrypt(rc2_cbc, Key, IV, pbe_pad(Data, block_size(rc2_cbc))); + crypto:crypto_one_time(rc2_cbc, Key, IV, pbe_pad(Data, block_size(rc2_cbc)), true); encode(Data, Password, "AES-128-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_encrypt(aes_128_cbc, Key, IV, pbe_pad(Data, block_size(aes_128_cbc))); + crypto:crypto_one_time(aes_128_cbc, Key, IV, pbe_pad(Data, block_size(aes_128_cbc)), true); encode(Data, Password, "AES-192-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_encrypt(aes_192_cbc, Key, IV, pbe_pad(Data, block_size(aes_192_cbc))); + crypto:crypto_one_time(aes_192_cbc, Key, IV, pbe_pad(Data, block_size(aes_192_cbc)), true); encode(Data, Password, "AES-256-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_encrypt(aes_256_cbc, Key, IV, pbe_pad(Data, block_size(aes_256_cbc))). + crypto:crypto_one_time(aes_256_cbc, Key, IV, pbe_pad(Data, block_size(aes_256_cbc)), true). %%-------------------------------------------------------------------- -spec decode(binary(), string(), string(), term()) -> binary(). @@ -64,23 +63,22 @@ encode(Data, Password, "AES-256-CBC"= Cipher, KeyDevParams) -> %%-------------------------------------------------------------------- decode(Data, Password,"DES-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_decrypt(des_cbc, Key, IV, Data); + crypto:crypto_one_time(des_cbc, Key, IV, Data, false); decode(Data, Password,"DES-EDE3-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, - crypto:block_decrypt(des3_cbc, [Key1, Key2, Key3], IV, Data); + crypto:crypto_one_time(des_ede3_cbc, Key, IV, Data, false); decode(Data, Password,"RC2-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_decrypt(rc2_cbc, Key, IV, Data); + crypto:crypto_one_time(rc2_cbc, Key, IV, Data, false); decode(Data, Password,"AES-128-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_decrypt(aes_128_cbc, Key, IV, Data); + crypto:crypto_one_time(aes_128_cbc, Key, IV, Data, false); decode(Data, Password,"AES-192-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_decrypt(aes_192_cbc, Key, IV, Data); + crypto:crypto_one_time(aes_192_cbc, Key, IV, Data, false); decode(Data, Password,"AES-256-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_decrypt(aes_256_cbc, Key, IV, Data). + crypto:crypto_one_time(aes_256_cbc, Key, IV, Data, false). %%-------------------------------------------------------------------- -spec pbdkdf1(iodata(), iodata(), integer(), atom()) -> binary(). @@ -247,17 +245,21 @@ key_derivation_params(#'PBES2-params'{keyDerivationFunc = KeyDerivationFunc, %% ?'id-hmacWithSHA1, but we need some kind of ASN1-fix for this. pseudo_random_function(#'PBKDF2-params_prf'{algorithm = {_,_, _,'id-hmacWithSHA1'}}) -> - {fun crypto:hmac/4, sha, pseudo_output_length(?'id-hmacWithSHA1')}; + {fun hmac4/4, sha, pseudo_output_length(?'id-hmacWithSHA1')}; pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA1' = Algo}) -> - {fun crypto:hmac/4, sha, pseudo_output_length(Algo)}; + {fun hmac4/4, sha, pseudo_output_length(Algo)}; pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA224'= Algo}) -> - {fun crypto:hmac/4, sha224, pseudo_output_length(Algo)}; + {fun hmac4/4, sha224, pseudo_output_length(Algo)}; pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA256' = Algo}) -> - {fun crypto:hmac/4, sha256, pseudo_output_length(Algo)}; + {fun hmac4/4, sha256, pseudo_output_length(Algo)}; pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA384' = Algo}) -> - {fun crypto:hmac/4, sha384, pseudo_output_length(Algo)}; + {fun hmac4/4, sha384, pseudo_output_length(Algo)}; pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA512' = Algo}) -> - {fun crypto:hmac/4, sha512, pseudo_output_length(Algo)}. + {fun hmac4/4, sha512, pseudo_output_length(Algo)}. + +hmac4(SubType, Key, Data, MacLength) -> + crypto:macN(hmac, SubType, Key, Data, MacLength). + pseudo_output_length(?'id-hmacWithSHA1') -> 20; %%160/8 @@ -295,7 +297,7 @@ derived_key_length(Cipher,_) when (Cipher == "AES-256-CBC"); block_size(Cipher) when Cipher == rc2_cbc; Cipher == des_cbc; - Cipher == des_3ede -> + Cipher == des_ede3_cbc -> 8; block_size(Cipher) when Cipher == aes_128_cbc; Cipher == aes_192_cbc; diff --git a/lib/public_key/test/pbe_SUITE.erl b/lib/public_key/test/pbe_SUITE.erl index 61db282dfa..75e067532c 100644 --- a/lib/public_key/test/pbe_SUITE.erl +++ b/lib/public_key/test/pbe_SUITE.erl @@ -114,7 +114,7 @@ pbdkdf2(Config) when is_list(Config) -> <<16#0c, 16#60, 16#c8, 16#0f, 16#96, 16#1f, 16#0e, 16#71, 16#f3, 16#a9, 16#b5, 16#24, 16#af, 16#60, 16#12, 16#06, - 16#2f, 16#e0, 16#37, 16#a6>> = pubkey_pbe:pbdkdf2("password", "salt", 1, 20, fun crypto:hmac/4, sha, 20), + 16#2f, 16#e0, 16#37, 16#a6>> = pubkey_pbe:pbdkdf2("password", "salt", 1, 20, fun hmac4/4, sha, 20), %% Input: %% P = "password" (8 octets) @@ -130,7 +130,7 @@ pbdkdf2(Config) when is_list(Config) -> <<16#ea, 16#6c, 16#01, 16#4d, 16#c7, 16#2d, 16#6f, 16#8c, 16#cd, 16#1e, 16#d9, 16#2a, 16#ce, 16#1d, 16#41, 16#f0, 16#d8, 16#de, 16#89, 16#57>> = - pubkey_pbe:pbdkdf2("password", "salt", 2, 20, fun crypto:hmac/4, sha, 20), + pubkey_pbe:pbdkdf2("password", "salt", 2, 20, fun hmac4/4, sha, 20), %% Input: %% P = "password" (8 octets) @@ -145,7 +145,7 @@ pbdkdf2(Config) when is_list(Config) -> <<16#4b, 16#00, 16#79, 16#01, 16#b7, 16#65, 16#48, 16#9a, 16#be, 16#ad, 16#49, 16#d9, 16#26, 16#f7, 16#21, 16#d0, - 16#65, 16#a4, 16#29, 16#c1>> = pubkey_pbe:pbdkdf2("password", "salt", 4096, 20, fun crypto:hmac/4, sha, 20), + 16#65, 16#a4, 16#29, 16#c1>> = pubkey_pbe:pbdkdf2("password", "salt", 4096, 20, fun hmac4/4, sha, 20), %% Input: %% P = "password" (8 octets) @@ -161,7 +161,7 @@ pbdkdf2(Config) when is_list(Config) -> <<16#ee, 16#fe, 16#3d, 16#61, 16#cd, 16#4d, 16#a4, 16#e4, 16#e9, 16#94, 16#5b, 16#3d, 16#6b, 16#a2, 16#15, 16#8c, - 16#26, 16#34, 16#e9, 16#84>> = pubkey_pbe:pbdkdf2("password", "salt", 16777216, 20, fun crypto:hmac/4, sha, 20), + 16#26, 16#34, 16#e9, 16#84>> = pubkey_pbe:pbdkdf2("password", "salt", 16777216, 20, fun hmac4/4, sha, 20), %% Input: %% P = "passwordPASSWORDpassword" (24 octets) @@ -180,7 +180,7 @@ pbdkdf2(Config) when is_list(Config) -> 16#8b, 16#29, 16#1a, 16#96, 16#4c, 16#f2, 16#f0, 16#70, 16#38>> = pubkey_pbe:pbdkdf2("passwordPASSWORDpassword", - "saltSALTsaltSALTsaltSALTsaltSALTsalt", 4096, 25, fun crypto:hmac/4, sha, 20), + "saltSALTsaltSALTsaltSALTsaltSALTsalt", 4096, 25, fun hmac4/4, sha, 20), %% Input: %% P = "pass\0word" (9 octets) @@ -195,7 +195,7 @@ pbdkdf2(Config) when is_list(Config) -> <<16#56, 16#fa, 16#6a, 16#a7, 16#55, 16#48, 16#09, 16#9d, 16#cc, 16#37, 16#d7, 16#f0, 16#34, 16#25, 16#e0, 16#c3>> = pubkey_pbe:pbdkdf2("pass\0word", - "sa\0lt", 4096, 16, fun crypto:hmac/4, sha, 20). + "sa\0lt", 4096, 16, fun hmac4/4, sha, 20). pbes1() -> [{doc,"Tests encode/decode EncryptedPrivateKeyInfo encrypted with different ciphers using PBES1"}]. @@ -250,3 +250,6 @@ decode_encode_key_file(File, Password, Cipher, Config) -> strip_ending_newlines(Bin) -> string:strip(binary_to_list(Bin), right, 10). + +hmac4(SubType, Key, Data, MacLength) -> + crypto:macN(hmac, SubType, Key, Data, MacLength). diff --git a/lib/public_key/test/pkits_SUITE.erl b/lib/public_key/test/pkits_SUITE.erl index 487b3dbe3f..9ddd642d45 100644 --- a/lib/public_key/test/pkits_SUITE.erl +++ b/lib/public_key/test/pkits_SUITE.erl @@ -691,8 +691,7 @@ run({Chap, Test, Result}, TA) -> {ok, _OK} when Result =/= ok -> ?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, ok]), fail - catch Type:Reason -> - Stack = erlang:get_stacktrace(), + catch Type:Reason:Stack -> io:format("Crash ~p:~p in ~p~n",[Type,Reason,Stack]), io:format(" ~p ~p Expected ~p ~n", [Chap, Test, Result]), exit(crash) diff --git a/lib/reltool/Makefile b/lib/reltool/Makefile index 4b6aad07b3..0a39d7daa8 100644 --- a/lib/reltool/Makefile +++ b/lib/reltool/Makefile @@ -36,3 +36,6 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=wx sasl + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/reltool/doc/src/Makefile b/lib/reltool/doc/src/Makefile index dce8059616..76cf8b82dd 100644 --- a/lib/reltool/doc/src/Makefile +++ b/lib/reltool/doc/src/Makefile @@ -28,84 +28,9 @@ VSN=$(RELTOOL_VSN) APPLICATION=reltool # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- include files.mk -# ---------------------------------------------------- - -XML_FILES = \ - $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html:images $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) - -images: $(IMAGE_FILES:%=$(HTMLDIR)/%) - -debug opt: - -clean clean_docs: - for file in $(XML_FILES); do \ - if [ -f $$file\src ]; then \ - rm -f $$file; \ - fi \ - done - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: - +include $(ERL_TOP)/make/doc.mk diff --git a/lib/reltool/doc/src/files.mk b/lib/reltool/doc/src/files.mk index efd7d8f09c..46288d0f50 100644 --- a/lib/reltool/doc/src/files.mk +++ b/lib/reltool/doc/src/files.mk @@ -37,3 +37,6 @@ BOOK_FILES = book.xml IMAGE_FILES = +XML_FILES = \ + $(BOOK_FILES) $(XML_CHAPTER_FILES) \ + $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) diff --git a/lib/runtime_tools/Makefile b/lib/runtime_tools/Makefile index eec1ff379b..4b0f1633ab 100644 --- a/lib/runtime_tools/Makefile +++ b/lib/runtime_tools/Makefile @@ -36,4 +36,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=mnesia +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/runtime_tools/doc/src/LTTng.xml b/lib/runtime_tools/doc/src/LTTng.xml index 89cbc805d8..e6fa8d484c 100644 --- a/lib/runtime_tools/doc/src/LTTng.xml +++ b/lib/runtime_tools/doc/src/LTTng.xml @@ -313,14 +313,6 @@ $ make </code> <p>All tracepoints are in the domain of <c>org_erlang_otp</c></p> <p>All Erlang types are the string equivalent in LTTng.</p> - <p><em>scheduler_poll</em></p> - <list type="bulleted"> - <item><c>scheduler : integer</c> :: Scheduler ID. Ex. <c>1</c></item> - <item><c>runnable : integer</c> :: Runnable. Ex. <c>1</c></item> - </list> - <p>Example:</p> - <code type="none">scheduler_poll: { cpu_id = 4 }, { scheduler = 1, runnable = 1 }</code> - <p><em>driver_init</em></p> <list type="bulleted"> <item><c>driver : string</c> :: Driver name. Ex. <c>"tcp_inet"</c></item> @@ -450,23 +442,6 @@ $ make </code> <p>Example:</p> <code type="none">driver_control: { cpu_id = 3 }, { pid = "<0.32767.8191>", port = "#Port<0.0>", driver = "forker", command = 83, bytes = 32 }</code> - <p><em>aio_pool_get</em></p> - <list type="bulleted"> - <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>length : integer</c> :: Async queue length. Ex. <c>0</c></item> - </list> - <p>Example:</p> - <code type="none">aio_pool_get: { cpu_id = 4 }, { port = "#Port<0.3614>", length = 0 }</code> - - <p><em>aio_pool_put</em></p> - <list type="bulleted"> - <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> - <item><c>length : integer</c> :: Async queue length. Ex. <c>-1</c></item> - </list> - <p>Async queue length is not defined for <c>put</c> operations.</p> - <p>Example:</p> - <code type="none">aio_pool_put: { cpu_id = 3 }, { port = "#Port<0.3614>", length = -1 }</code> - <p><em>carrier_create</em></p> <list type="bulleted"> <item><c>type : string</c> :: Carrier type. Ex. <c>"ets_alloc"</c></item> diff --git a/lib/runtime_tools/doc/src/Makefile b/lib/runtime_tools/doc/src/Makefile index 2399ed51e0..53c3cc9d26 100644 --- a/lib/runtime_tools/doc/src/Makefile +++ b/lib/runtime_tools/doc/src/Makefile @@ -33,11 +33,6 @@ VSN=$(RUNTIME_TOOLS_VSN) APPLICATION=runtime_tools # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -64,83 +59,17 @@ XML_FILES = \ XML_GEN_FILES = $(GENERATED_XML_FILES:%=$(XMLDIR)/%) -GIF_FILES = - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) +IMAGE_FILES = TOP_SPECS_FILE = specs.xml # ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -SPECS_ESRC = ../../src - -SPECS_FLAGS = -I../../include -I../../../kernel/src - -# ---------------------------------------------------- # Targets # ---------------------------------------------------- $(XMLDIR)/%.xml: $(ERL_TOP)/HOWTO/%.md $(ERL_TOP)/make/emd2exml $(ERL_TOP)/make/emd2exml $< $@ -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(MAN6DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -# ---------------------------------------------------- -# Release Target # ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" - -release_spec: + +include $(ERL_TOP)/make/doc.mk diff --git a/lib/runtime_tools/doc/src/dbg.xml b/lib/runtime_tools/doc/src/dbg.xml index e15fc3efe6..6589e514ed 100644 --- a/lib/runtime_tools/doc/src/dbg.xml +++ b/lib/runtime_tools/doc/src/dbg.xml @@ -295,7 +295,7 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ specifications of how many processes and ports that matched (in the case of a pure pid() exactly 1). The specification of matched processes is <c>{matched, Node, N}</c>. If the - remote processor call,<c>rpc</c>, to a remote node fails, + remote processor call, <c>rpc</c>, to a remote node fails, the <c>rpc</c> error message is delivered as a fourth argument and the number of matched processes are 0. Note that the result {ok, List} may contain a list where diff --git a/lib/runtime_tools/examples/function-calls.d b/lib/runtime_tools/examples/function-calls.d index f8ca388228..a51ff51253 100644 --- a/lib/runtime_tools/examples/function-calls.d +++ b/lib/runtime_tools/examples/function-calls.d @@ -19,39 +19,85 @@ * %CopyrightEnd% */ +/** + * Triggered on local function entry + * + * @param arg0 pid + * @param arg1 MFA of the function + * @param arg2 depth + */ erlang*:::local-function-entry { printf("pid %s enter (local) %s depth %d\n", copyinstr(arg0), copyinstr(arg1), arg2); } +/** + * Triggered on global function entry + * + * @param arg0 pid + * @param arg1 MFA of the function + * @param arg2 depth + */ erlang*:::global-function-entry { printf("pid %s enter (global) %s depth %d\n", copyinstr(arg0), copyinstr(arg1), arg2); } +/** + * Triggered upon function return, either global or + * local + * + * @param arg0 pid + * @param arg1 MFA of the returned from function + * @param arg2 depth + */ erlang*:::function-return { printf("pid %s return %s depth %d\n", copyinstr(arg0), copyinstr(arg1), arg2); } +/** + * Triggered on built-in function entry + * + * @param arg0 pid + * @param arg1 MFA of the function + */ erlang*:::bif-entry { printf("pid %s BIF entry mfa %s\n", copyinstr(arg0), copyinstr(arg1)); } +/** + * Triggered on built-in function return + * + * @param arg0 pid + * @param arg1 MFA of the returned from function + */ erlang*:::bif-return { printf("pid %s BIF return mfa %s\n", copyinstr(arg0), copyinstr(arg1)); } +/** + * Triggered on native function entry + * + * @param arg0 pid + * @param arg1 MFA of the function + */ erlang*:::nif-entry { printf("pid %s NIF entry mfa %s\n", copyinstr(arg0), copyinstr(arg1)); } +/** + * Triggered upon native function return + * + * @param arg0 pid + * @param arg1 MFA of the returned from function + */ erlang*:::nif-return { printf("pid %s NIF return mfa %s\n", copyinstr(arg0), copyinstr(arg1)); diff --git a/lib/runtime_tools/examples/function-calls.systemtap b/lib/runtime_tools/examples/function-calls.systemtap index 6bb173b3ec..8f748ce0d1 100644 --- a/lib/runtime_tools/examples/function-calls.systemtap +++ b/lib/runtime_tools/examples/function-calls.systemtap @@ -29,39 +29,85 @@ * to your environment. */ +/** + * Triggered on local function entry + * + * @param arg0 pid + * @param arg1 MFA of the function + * @param arg2 depth + */ probe process("beam.smp").mark("local-function-entry") { printf("pid %s enter (local) %s depth %d\n", user_string($arg1), user_string($arg2), $arg3); } +/** + * Triggered on global function entry + * + * @param arg0 pid + * @param arg1 MFA of the function + * @param arg2 depth + */ probe process("beam.smp").mark("global-function-entry") { printf("pid %s enter (global) %s depth %d\n", user_string($arg1), user_string($arg2), $arg3); } +/** + * Triggered upon function return, either global or + * local + * + * @param arg0 pid + * @param arg1 MFA of the returned from function + * @param arg2 depth + */ probe process("beam.smp").mark("function-return") { printf("pid %s return %s depth %d\n", user_string($arg1), user_string($arg2), $arg3); } +/** + * Triggered on built-in function entry + * + * @param arg0 pid + * @param arg1 MFA of the function + */ probe process("beam.smp").mark("bif-entry") { printf("pid %s BIF entry mfa %s\n", user_string($arg1), user_string($arg2)); } +/** + * Triggered on built-in function return + * + * @param arg0 pid + * @param arg1 MFA of the returned from function + */ probe process("beam.smp").mark("bif-return") { printf("pid %s BIF return mfa %s\n", user_string($arg1), user_string($arg2)); } +/** + * Triggered on native function entry + * + * @param arg0 pid + * @param arg1 MFA of the function + */ probe process("beam.smp").mark("nif-entry") { printf("pid %s NIF entry mfa %s\n", user_string($arg1), user_string($arg2)); } +/** + * Triggered upon native function return + * + * @param arg0 pid + * @param arg1 MFA of the returned from function + */ probe process("beam.smp").mark("nif-return") { printf("pid %s NIF return mfa %s\n", user_string($arg1), user_string($arg2)); diff --git a/lib/runtime_tools/src/erts_alloc_config.erl b/lib/runtime_tools/src/erts_alloc_config.erl index 845efaf9ef..d8133ee14f 100644 --- a/lib/runtime_tools/src/erts_alloc_config.erl +++ b/lib/runtime_tools/src/erts_alloc_config.erl @@ -356,14 +356,23 @@ save_scenario(AlcList) -> process_flag(priority, OP), Res. -save_ai2(Alc, AI) -> - Alc1 = chk_sbct(Alc, AI), - case ai_value(mbcs, blocks_size, AI) of - {blocks_size, MinBS, _, MaxBS} -> - set_alloc_util(chk_mbcs_blocks_size(Alc1, MinBS, MaxBS), true); - _ -> - set_alloc_util(Alc, false) - end. +save_ai2(#alloc{name=Name}=Alc0, AI) -> + Alc1 = chk_sbct(Alc0, AI), + + {Alc, IsAUtil} = + case ai_value(mbcs, blocks, AI) of + {blocks, Bs} -> + case ai_value(Name, size, Bs) of + {size, MinBS, _, MaxBS} -> + {chk_mbcs_blocks_size(Alc1, MinBS, MaxBS), true}; + _ -> + {Alc1, false} + end; + _ -> + {Alc1, false} + end, + + set_alloc_util(Alc, IsAUtil). save_ai(Alc, [{instance, 0, AI}]) -> save_ai2(Alc, AI); diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index 3a24986381..e38757b939 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -433,7 +433,9 @@ ttb_meta_tracer(MetaFile,PI,Parent,SessionData) -> ReturnMS = [{'_',[],[{return_trace}]}], erlang:trace_pattern({erlang,spawn,3},ReturnMS,[meta]), erlang:trace_pattern({erlang,spawn_link,3},ReturnMS,[meta]), - erlang:trace_pattern({erlang,spawn_opt,1},ReturnMS,[meta]), + erlang:trace_pattern({erlang,spawn_opt,4},ReturnMS,[meta]), + erlang:trace_pattern({erts_internal,spawn_init,1},[],[meta]), + erlang:trace_pattern({erts_internal,dist_spawn_init,1},[],[meta]), erlang:trace_pattern({erlang,register,2},[],[meta]), erlang:trace_pattern({global,register_name,2},[],[meta]), ok; @@ -459,7 +461,7 @@ ttb_meta_tracer_loop(MetaFile,PI,Acc,State) -> {trace_ts,_,call,{global,register_name,[Name,Pid]},_} -> ok = ttb_store_meta({pid,{Pid,{global,Name}}},MetaFile), ttb_meta_tracer_loop(MetaFile,PI,Acc,State); - {trace_ts,CallingPid,call,{erlang,spawn_opt,[{M,F,Args,_}]},_} -> + {trace_ts,CallingPid,call,{erlang,spawn_opt,[M,F,Args,_]},_} -> MFA = {M,F,length(Args)}, NewAcc = dict:update(CallingPid, fun(Old) -> [MFA|Old] end, [MFA], @@ -497,6 +499,16 @@ ttb_meta_tracer_loop(MetaFile,PI,Acc,State) -> Acc), ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); + {trace_ts,CallingPid,call,{erts_internal,spawn_init,[{M,F,Args}]},_} -> + %% Local spawn_request()... + ok = ttb_store_meta({pid,{CallingPid,{M,F,length(Args)}}},MetaFile), + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); + + {trace_ts,CallingPid,call,{erts_internal, dist_spawn_init, [MFnoA]},_} -> + %% Distributed spawn_request()... + ok = ttb_store_meta({pid,{CallingPid,MFnoA}},MetaFile), + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); + {metadata,Data} when is_list(Data) -> ok = ttb_store_meta(Data,MetaFile), ttb_meta_tracer_loop(MetaFile,PI,Acc,State); @@ -530,7 +542,9 @@ ttb_meta_tracer_loop(MetaFile,PI,Acc,State) -> try_stop_overload_check(State), erlang:trace_pattern({erlang,spawn,3},false,[meta]), erlang:trace_pattern({erlang,spawn_link,3},false,[meta]), - erlang:trace_pattern({erlang,spawn_opt,1},false,[meta]), + erlang:trace_pattern({erlang,spawn_opt,4},false,[meta]), + erlang:trace_pattern({erts_internal,spawn_init,1},false,[meta]), + erlang:trace_pattern({erts_internal,dist_spawn_init,1},false,[meta]), erlang:trace_pattern({erlang,register,2},false,[meta]), erlang:trace_pattern({global,register_name,2},false,[meta]); stop -> @@ -752,6 +766,7 @@ sys_tables() -> mnesia_gvar, mnesia_stats, % mnesia_transient_decision, pg2_table, + pg, queue, schema, shell_records, @@ -763,7 +778,7 @@ sys_tables() -> sys_processes() -> [auth, code_server, global_name_server, inet_db, - mnesia_recover, net_kernel, timer_server, wxe_master]. + mnesia_recover, net_kernel, pg, timer_server, wxe_master]. mnesia_tables() -> [ir_AliasDef, ir_ArrayDef, ir_AttributeDef, ir_ConstantDef, diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index b026048b94..b55d50d040 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -29,5 +29,5 @@ {applications, [kernel, stdlib]}, {env, []}, {mod, {runtime_tools, []}}, - {runtime_dependencies, ["stdlib-3.0","mnesia-4.12","kernel-5.0", - "erts-8.0"]}]}. + {runtime_dependencies, ["stdlib-@OTP-15251@","mnesia-4.12","kernel-@OTP-15251@", + "erts-@OTP-15251:OTP-16327@"]}]}. diff --git a/lib/sasl/Makefile b/lib/sasl/Makefile index 065eb45fbb..06af80fd35 100644 --- a/lib/sasl/Makefile +++ b/lib/sasl/Makefile @@ -36,3 +36,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=tools + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/sasl/doc/src/Makefile b/lib/sasl/doc/src/Makefile index 8e1e8b502c..684fd2b5e4 100644 --- a/lib/sasl/doc/src/Makefile +++ b/lib/sasl/doc/src/Makefile @@ -27,11 +27,6 @@ VSN=$(SASL_VSN) APPLICATION=sasl # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -51,80 +46,13 @@ XML_CHAPTER_FILES = sasl_intro.xml \ BOOK_FILES = book.xml -GIF_FILES = +IMAGE_FILES = XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF4_FILES) \ $(XML_REF6_FILES) $(XML_APPLICATION_FILES) - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN4_FILES = $(XML_REF4_FILES:%.xml=$(MAN4DIR)/%.4) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - # ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) $(MAN4_FILES) $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) # We depend just to copy them to ../html - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(MAN4DIR)/* - rm -f $(MAN6DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man4" - $(INSTALL_DATA) $(MAN4_FILES) "$(RELEASE_PATH)/man/man4" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/sasl/src/systools_lib.erl b/lib/sasl/src/systools_lib.erl index dd97aeff08..f5489e7900 100644 --- a/lib/sasl/src/systools_lib.erl +++ b/lib/sasl/src/systools_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -63,8 +63,8 @@ read_term(File) -> end. read_term_from_stream(Stream, File) -> - _ = epp:set_encoding(Stream), - R = io:request(Stream, {get_until,'',erl_scan,tokens,[1]}), + Encoding = epp:set_encoding(Stream), + R = io:request(Stream, {get_until,Encoding,'',erl_scan,tokens,[1]}), case R of {ok,Toks,_EndLine} -> case erl_parse:parse_term(Toks) of diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m.erl index 418102bebb..e0ff480703 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m.erl +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/src/m.erl @@ -8,4 +8,5 @@ start(NProcs) -> receive stop -> Cs end end) || _ <- lists:seq(1,NProcs)], + [unlink(Pid) || Pid <- Pids], {Modules,Pids}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m.erl index 418102bebb..e0ff480703 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m.erl +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/src/m.erl @@ -8,4 +8,5 @@ start(NProcs) -> receive stop -> Cs end end) || _ <- lists:seq(1,NProcs)], + [unlink(Pid) || Pid <- Pids], {Modules,Pids}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/src/m.erl b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/src/m.erl index 2edc1e6be4..8ec3629e78 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/src/m.erl +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/src/m.erl @@ -8,4 +8,5 @@ start(NProcs) -> receive stop -> Cs end end) || _ <- lists:seq(1,NProcs)], + [unlink(Pid) || Pid <- Pids], {Modules,Pids}. diff --git a/lib/sasl/test/sasl_SUITE.erl b/lib/sasl/test/sasl_SUITE.erl index fc80e37210..beb129c1a6 100644 --- a/lib/sasl/test/sasl_SUITE.erl +++ b/lib/sasl/test/sasl_SUITE.erl @@ -32,6 +32,8 @@ log_file/1, utc_log/1]). +-compile(r21). + all() -> [log_mf_h_env, log_file, app_test, appup_test, utc_log]. @@ -104,7 +106,7 @@ appup_tests(App,{OkVsns0,NokVsns}) -> create_test_vsns(App) -> ThisMajor = erlang:system_info(otp_release), FirstMajor = previous_major(ThisMajor), - SecondMajor = previous_major(FirstMajor), + SecondMajor = previous_major(previous_major(FirstMajor)), Ok = app_vsn(App,[ThisMajor,FirstMajor]), Nok0 = app_vsn(App,[SecondMajor]), Nok = case Ok of diff --git a/lib/sasl/test/sasl_report_SUITE.erl b/lib/sasl/test/sasl_report_SUITE.erl index e639b55cee..bc984754cc 100644 --- a/lib/sasl/test/sasl_report_SUITE.erl +++ b/lib/sasl/test/sasl_report_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015-2018. All Rights Reserved. +%% Copyright Ericsson AB 2015-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,6 +21,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). -export([gen_server_crash/1, gen_server_crash_unicode/1]). +-export([gen_server_crash_chars_limit/1, + gen_server_crash_chars_limit_unicode/1]). -export([legacy_gen_server_crash/1, legacy_gen_server_crash_unicode/1]). -export([crash_me/0,start_link/0,init/1,handle_cast/2,terminate/2]). @@ -32,6 +34,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [gen_server_crash, gen_server_crash_unicode, + gen_server_crash_chars_limit, + gen_server_crash_chars_limit_unicode, legacy_gen_server_crash, legacy_gen_server_crash_unicode]. @@ -51,18 +55,31 @@ end_per_group(_GroupName, Config) -> Config. gen_server_crash(Config) -> - gen_server_crash(Config, latin1). + gen_server_crash(Config, latin1, depth). gen_server_crash_unicode(Config) -> - gen_server_crash(Config, unicode). + gen_server_crash(Config, unicode, depth). + +gen_server_crash_chars_limit(Config) -> + gen_server_crash(Config, latin1, chars_limit). + +gen_server_crash_chars_limit_unicode(Config) -> + gen_server_crash(Config, unicode, chars_limit). legacy_gen_server_crash(Config) -> - legacy_gen_server_crash(Config,latin1). + legacy_gen_server_crash(Config, latin1). legacy_gen_server_crash_unicode(Config) -> - legacy_gen_server_crash(Config,unicode). + legacy_gen_server_crash(Config, unicode). + +gen_server_crash(Config, Encoding, depth) -> + FormatterOpts = #{depth=>30}, + gen_server_crash(Config, Encoding, FormatterOpts, 70000, 150000); +gen_server_crash(Config, Encoding, chars_limit) -> + FormatterOpts = #{chars_limit=>50000, single_line=>true}, + gen_server_crash(Config, Encoding, FormatterOpts, 50000, 100000). -gen_server_crash(Config, Encoding) -> +gen_server_crash(Config, Encoding, FormatterOpts, Min, Max) -> TC = list_to_atom(lists:concat([?FUNCTION_NAME,"_",Encoding])), PrivDir = filename:join(?config(priv_dir,Config),?MODULE), ConfigFileName = filename:join(PrivDir,TC), @@ -85,9 +102,9 @@ gen_server_crash(Config, Encoding) -> " -boot start_sasl -kernel start_timer true " "-config ",ConfigFileName]}]), - %% Set depth - ok = rpc:call(Node,logger,update_formatter_config,[default,depth,30]), - ok = rpc:call(Node,logger,update_formatter_config,[sasl,depth,30]), + %% Set depth or chars_limit. + ok = rpc:call(Node,logger,update_formatter_config,[default,FormatterOpts]), + ok = rpc:call(Node,logger,update_formatter_config,[sasl,FormatterOpts]), %% Make sure remote node logs it's own logs, and current node does %% not log them. @@ -98,7 +115,7 @@ gen_server_crash(Config, Encoding) -> (_,_) -> ignore end,[]}), ct:log("Local node Logger config:~n~p", - [rpc:call(Node,logger,get_config,[])]), + [logger:get_config()]), ct:log("Remote node Logger config:~n~p", [rpc:call(Node,logger,get_config,[])]), ct:log("Remote node error_logger handlers: ~p", @@ -112,8 +129,8 @@ gen_server_crash(Config, Encoding) -> test_server:stop_node(Node), ok = logger:remove_primary_filter(no_remote), - check_file(KernelLog, utf8, 70000, 150000), - check_file(SaslLog, Encoding, 70000, 150000), + check_file(KernelLog, utf8, Min, Max), + check_file(SaslLog, Encoding, Min, Max), ok = file:delete(KernelLog), ok = file:delete(SaslLog), @@ -169,6 +186,7 @@ check_file(File, Encoding, Min, Max) -> _ -> io:format("~ts\n", [Bin]) end, Sz = byte_size(Bin), + %% Sz = string:length(string:replace(Bin, " ", "", all)), io:format("Size: ~p (allowed range is ~p..~p)\n", [Sz,Min,Max]), if diff --git a/lib/snmp/Makefile b/lib/snmp/Makefile index 1a5bed50a5..52debf1670 100644 --- a/lib/snmp/Makefile +++ b/lib/snmp/Makefile @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2019. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -71,24 +71,6 @@ do_configure: configure configure: configure.in autoconf -.PHONY: info gclean - -info: - @echo "OS: $(OS)" - @echo "DOCB: $(DOCB)" - @echo "" - @echo "SNMP_VSN: $(SNMP_VSN)" - @echo "APP_VSN: $(APP_VSN)" - @echo "" - @echo "DIA_PLT: $(DIA_PLT)" - @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)" - @echo "" - - -gclean: - git clean -fXd - - # ---------------------------------------------------- # Application (source) release targets # ---------------------------------------------------- @@ -130,30 +112,6 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) -dclean: - rm -f $(DIA_PLT) - rm -f $(DIA_ANALYSIS) - -dialyzer_plt: $(DIA_PLT) - -$(DIA_PLT): Makefile - @echo "Building $(APPLICATION) plt file" - @dialyzer --build_plt \ - --output_plt $@ \ - -r ../$(APPLICATION)/ebin \ - ../../lib/kernel/ebin \ - ../../lib/stdlib/ebin \ - ../../lib/compiler/ebin \ - ../../lib/hipe/ebin \ - ../../lib/runtime_tools/ebin \ - ../../lib/crypto/ebin \ - ../../lib/mnesia/ebin \ - ../../erts/preloaded/ebin \ - --output $(DIA_ANALYSIS) \ - --verbose - -dialyzer: $(DIA_PLT) - @echo "Running dialyzer on $(APPLICATION)" - @dialyzer --plt $< \ - ../$(APPLICATION)/ebin \ - --verbose +DIA_PLT_APPS=runtime_tools crypto mnesia + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/snmp/doc/src/Makefile b/lib/snmp/doc/src/Makefile index e7ab491eef..cfc41156cf 100644 --- a/lib/snmp/doc/src/Makefile +++ b/lib/snmp/doc/src/Makefile @@ -29,11 +29,6 @@ VSN = $(SNMP_VSN) APPLICATION=snmp # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- @@ -58,89 +53,21 @@ XML_ERRS = $(XML_FILES:%.xml=%.latex.xmls_errs) \ XML_OUTPUT = $(XML_FILES:%.xml=%.latex.xmls_output) \ $(XML_FILES:%.xml=%.html.xmls_output) -INFO_FILE = ../../info - -#HTML_REF1_FILES = $(XML_REF1_FILES:%.xml=$(HTMLDIR)/%.html) -HTML_REF3_FILES = $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) -HTML_REF6_FILES = $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) -HTML_CHAP_FILES = $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - -EXTRA_FILES = \ - $(DEFAULT_HTML_FILES) \ - $(HTML_REF1_FILES) \ - $(HTML_REF3_FILES) \ - $(HTML_REF6_FILES) \ - $(HTML_CHAP_FILES) - - -MAN7DIR = $(DOCDIR)/man7 - -MAN1_FILES = $(MAN1DIR)/snmpc.1 -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) -MAN7_FILES = $(MIB_FILES:$(MIBSDIR)/%.mib=$(MAN7DIR)/%.7) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -GIF_TARGETS = $(GIF_FILES:%=$(HTMLDIR)/%) - - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += +NO_CHUNKS = snmpa_discovery_handler.xml \ + snmpa_error_report.xml \ + snmpa_mib_data.xml \ + snmpa_mib_storage.xml \ + snmpa_network_interface.xml \ + snmpa_network_interface_filter.xml \ + snmpa_notification_delivery_info_receiver.xml \ + snmpa_notification_filter.xml \ + snmpm_network_interface.xml \ + snmpm_network_interface_filter.xml \ + snmpm_user.xml # ---------------------------------------------------- # Targets # ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif # Copy them to ../html - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -ldocs: local_docs - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -clean clean_docs: clean_html clean_man clean_pdf - rm -f errs core *~ - -man: man1 man3 man6 man7 - -man1: $(MAN1_FILES) - -man3: $(MAN3_FILES) - -man6: $(MAN6_FILES) - -man7: $(MAN7_FILES) - -gifs: $(GIF_TARGETS) - -debug opt: - -clean_pdf: - @echo "cleaning pdf:" - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - -clean_man: - @echo "cleaning man:" - rm -f $(MAN1DIR)/* - rm -f $(MAN3DIR)/* - rm -f $(MAN6DIR)/* - rm -f $(MAN7DIR)/* - -clean_html: - @echo "cleaning html:" - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) $(MAN7DIR)/%.7: $(MIBSDIR)/%.mib @echo "processing $*" @@ -150,40 +77,15 @@ $(MAN7DIR)/%.7: $(MIBSDIR)/%.mib @echo ".fi" >> $@ @echo "" >> $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- - $(MAN1DIR)/snmpc.1: snmpc_cmd.xml date=`date +"%B %e %Y"`; \ xsltproc --output "$@" --stringparam company "Ericsson AB" --stringparam docgen "$(DOCGEN)" --stringparam gendate "$$date" --stringparam appname "$(APPLICATION)" --stringparam appver "$(VSN)" --xinclude -path $(DOCGEN)/priv/dtd -path $(DOCGEN)/priv/dtd_man_entities $(DOCGEN)/priv/xsl/db_man.xsl $< -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man1" - $(INSTALL_DATA) $(MAN1DIR)/* "$(RELEASE_PATH)/man/man1" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6DIR)/* "$(RELEASE_PATH)/man/man6" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man7" - $(INSTALL_DATA) $(MAN7DIR)/* "$(RELEASE_PATH)/man/man7" - -release_spec: +# ---------------------------------------------------- + +include $(ERL_TOP)/make/doc.mk info: info_xml info_man info_html - @echo "MAN1DIR: $(MAN1DIR)" - @echo "MAN3DIR: $(MAN3DIR)" - @echo "MAN6DIR: $(MAN6DIR)" - @echo "MAN7DIR: $(MAN7DIR)" info_man: @echo "man files:" diff --git a/lib/snmp/doc/src/files.mk b/lib/snmp/doc/src/files.mk index f364cb6fa5..ea4143d121 100644 --- a/lib/snmp/doc/src/files.mk +++ b/lib/snmp/doc/src/files.mk @@ -113,7 +113,7 @@ XML_FILES = $(BOOK_FILES) \ $(XML_REF6_FILES) \ $(XML_APPLICATION_FILES) -GIF_FILES = \ +IMAGE_FILES = \ getnext1.gif \ getnext2.gif \ getnext3.gif \ @@ -125,19 +125,7 @@ GIF_FILES = \ snmp-um-1-image-3.gif \ MIB_mechanism.gif -PS_FILES = getnext1.ps \ - getnext2.ps \ - getnext3.ps \ - getnext4.ps \ - snmp_agent_netif.ps \ - snmp-um-1-image-1.ps \ - snmp-um-1-image-2.ps \ - snmp-um-1-image-3.ps \ - snmp-um-1-image-8.ps \ - MIB_mechanism.ps - - -MIB_FILES = \ +MIB_REF7_FILES = \ $(MIBSDIR)/RFC1213-MIB.mib \ $(MIBSDIR)/STANDARD-MIB.mib \ $(MIBSDIR)/SNMPv2-TM.mib \ diff --git a/lib/snmp/doc/src/snmp_app.xml b/lib/snmp/doc/src/snmp_app.xml index 54a7eafe76..9d29787ba2 100644 --- a/lib/snmp/doc/src/snmp_app.xml +++ b/lib/snmp/doc/src/snmp_app.xml @@ -52,7 +52,7 @@ <!-- -There are achors (marker id) in this file, but do **NOT** link to anything +There are anchors (marker id) in this file, but do **NOT** link to anything in this file!! Because of the title is in capital letters, the generated html file will also be in capital letters. This should not be a problem since almost everything here is duplicated diff --git a/lib/snmp/doc/src/snmp_pdus.xml b/lib/snmp/doc/src/snmp_pdus.xml index 4b00dcb7f0..0377a1c050 100644 --- a/lib/snmp/doc/src/snmp_pdus.xml +++ b/lib/snmp/doc/src/snmp_pdus.xml @@ -125,7 +125,6 @@ <p>Decodes a list of bytes into an SNMP UsmSecurityParameters</p> </desc> </func> - <func> <name since="">enc_message(Message) -> [byte()]</name> <fsummary>Encode an SNMP Message</fsummary> diff --git a/lib/snmp/src/agent/snmpa.erl b/lib/snmp/src/agent/snmpa.erl index ff7be54283..9e428466fa 100644 --- a/lib/snmp/src/agent/snmpa.erl +++ b/lib/snmp/src/agent/snmpa.erl @@ -123,7 +123,7 @@ mib_storage_options/0 ]). --deprecated([{old_info_format, 1, next_major_release}]). +-deprecated([{old_info_format, 1, "use \"new\" format instead"}]). -include("snmpa_atl.hrl"). diff --git a/lib/snmp/src/app/snmp.erl b/lib/snmp/src/app/snmp.erl index 1e6a93deff..b6cfe34047 100644 --- a/lib/snmp/src/app/snmp.erl +++ b/lib/snmp/src/app/snmp.erl @@ -129,53 +129,53 @@ %% This is for XREF --deprecated([{c, 1, eventually}, - {c, 2, eventually}, - {compile, 3, eventually}, - {is_consistent, 1, eventually}, - {mib_to_hrl, 1, eventually}, - - {change_log_size, 1, eventually}, - {log_to_txt, 2, eventually}, - {log_to_txt, 3, eventually}, - {log_to_txt, 4, eventually}, - - {current_request_id, 0, eventually}, - {current_community, 0, eventually}, - {current_address, 0, eventually}, - {current_context, 0, eventually}, - {current_net_if_data, 0, eventually}, - - {get_symbolic_store_db, 0, eventually}, - {name_to_oid, 1, eventually}, - {name_to_oid, 2, eventually}, - {oid_to_name, 1, eventually}, - {oid_to_name, 2, eventually}, - {int_to_enum, 2, eventually}, - {int_to_enum, 3, eventually}, - {enum_to_int, 2, eventually}, - {enum_to_int, 3, eventually}, - - {get, 2, eventually}, - {info, 1, eventually}, - {load_mibs, 2, eventually}, - {unload_mibs, 2, eventually}, - {dump_mibs, 0, eventually}, - {dump_mibs, 1, eventually}, - - {register_subagent, 3, eventually}, - {unregister_subagent, 2, eventually}, - - {send_notification, 3, eventually}, - {send_notification, 4, eventually}, - {send_notification, 5, eventually}, - {send_notification, 6, eventually}, - {send_trap, 3, eventually}, - {send_trap, 4, eventually}, - - {add_agent_caps, 2, eventually}, - {del_agent_caps, 1, eventually}, - {get_agent_caps, 0, eventually}]). +-deprecated([{c, 1, "use snmpa:c/1 instead"}, + {c, 2, "use snmpa:c/2 instead"}, + {compile, 3, "use snmpa:compile/3 instead"}, + {is_consistent, 1, "use snmpa:is_consistent/1 instead"}, + {mib_to_hrl, 1, "use snmpa:mib_to_hrl/1 instead"}, + + {change_log_size, 1, "use snmpa:change_log_size/1 instead"}, + {log_to_txt, 2, "use snmpa:log_to_txt/2 instead"}, + {log_to_txt, 3, "use snmpa:log_to_txt/3 instead"}, + {log_to_txt, 4, "use snmpa:log_to_txt/4 instead"}, + + {current_request_id, 0, "use snmpa:current_request_id/0 instead"}, + {current_community, 0, "use snmpa:current_community/0 instead"}, + {current_address, 0, "use snmpa:current_address/0 instead"}, + {current_context, 0, "use snmpa:current_context/0 instead"}, + {current_net_if_data, 0, "use snmpa:current_net_if_data/0 instead"}, + + {get_symbolic_store_db, 0, "use snmpa:get_symbolic_store_db/0 instead"}, + {name_to_oid, 1, "use snmpa:name_to_oid/1 instead"}, + {name_to_oid, 2, "use snmpa:name_to_oid/2 instead"}, + {oid_to_name, 1, "use snmpa:oid_to_name/1 instead"}, + {oid_to_name, 2, "use snmpa:oid_to_name/2 instead"}, + {int_to_enum, 2, "use snmpa:int_to_enum/2 instead"}, + {int_to_enum, 3, "use snmpa:int_to_enum/3 instead"}, + {enum_to_int, 2, "use snmpa:enum_to_int/2 instead"}, + {enum_to_int, 3, "use snmpa:enum_to_int/3 instead"}, + + {get, 2, "use snmpa:get/2 instead"}, + {info, 1, "use snmpa:info/1 instead"}, + {load_mibs, 2, "use snmpa:load_mibs/2 instead"}, + {unload_mibs, 2, "use snmpa:unload_mibs/2 instead"}, + {dump_mibs, 0, "use snmpa:dump_mibs/0 instead"}, + {dump_mibs, 1, "use snmpa:dump_mibs/1 instead"}, + + {register_subagent, 3, "use snmpa:register_subagent/3 instead"}, + {unregister_subagent, 2, "use snmpa:unregister_subagent/2 instead"}, + + {send_notification, 3, "use snmpa:send_notification/3 instead"}, + {send_notification, 4, "use snmpa:send_notification/4 instead"}, + {send_notification, 5, "use snmpa:send_notification/5 instead"}, + {send_notification, 6, "use snmpa:send_notification/6 instead"}, + {send_trap, 3, "use snmpa:send_trap/3 instead"}, + {send_trap, 4, "use snmpa:send_trap/4 instead"}, + + {add_agent_caps, 2, "use snmpa:add_agent_caps/2 instead"}, + {del_agent_caps, 1, "use snmpa:del_agent_caps/1 instead"}, + {get_agent_caps, 0, "use snmpa:get_agent_caps/0 instead"}]). -define(APPLICATION, snmp). diff --git a/lib/snmp/src/compile/snmpc_misc.erl b/lib/snmp/src/compile/snmpc_misc.erl index 312074f2e7..d0fee418e1 100644 --- a/lib/snmp/src/compile/snmpc_misc.erl +++ b/lib/snmp/src/compile/snmpc_misc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. +%% Copyright Ericsson AB 2003-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -156,7 +156,8 @@ loop(Fd, Res, Func, StartLine, File) -> %% io:read modified to give us line numbers. %%----------------------------------------------------------------- read(Io, Prompt, StartLine) -> - case io:request(Io, {get_until, Prompt, erl_scan, tokens, [StartLine]}) of + Enc = latin1, + case io:request(Io, {get_until, Enc, Prompt, erl_scan, tokens, [StartLine]}) of {ok, Toks, EndLine} -> case erl_parse:parse_term(Toks) of {ok, Term} -> diff --git a/lib/snmp/src/misc/snmp_conf.erl b/lib/snmp/src/misc/snmp_conf.erl index 20b7af0373..bec9d4d9d9 100644 --- a/lib/snmp/src/misc/snmp_conf.erl +++ b/lib/snmp/src/misc/snmp_conf.erl @@ -265,7 +265,8 @@ open_file(File) -> end. do_read(Io, Prompt, StartLine) -> - case io:request(Io, {get_until,Prompt,erl_scan,tokens,[StartLine]}) of + Enc = latin1, + case io:request(Io, {get_until,Enc,Prompt,erl_scan,tokens,[StartLine]}) of {ok, Toks, EndLine} -> case erl_parse:parse_term(Toks) of {ok, Term} -> diff --git a/lib/snmp/src/misc/snmp_config.erl b/lib/snmp/src/misc/snmp_config.erl index 3104f2a096..5aab9a74e0 100644 --- a/lib/snmp/src/misc/snmp_config.erl +++ b/lib/snmp/src/misc/snmp_config.erl @@ -2737,7 +2737,8 @@ read_lines(Fd, Acc, StartLine) -> end. read_and_parse_term(Fd, StartLine) -> - case io:request(Fd, {get_until, "", erl_scan, tokens, [StartLine]}) of + Enc = latin1, + case io:request(Fd, {get_until, Enc, "", erl_scan, tokens, [StartLine]}) of {ok, Tokens, EndLine} -> case erl_parse:parse_term(Tokens) of {ok, Term} -> diff --git a/lib/snmp/src/misc/snmp_usm.erl b/lib/snmp/src/misc/snmp_usm.erl index bae6bdec72..39172c9c1a 100644 --- a/lib/snmp/src/misc/snmp_usm.erl +++ b/lib/snmp/src/misc/snmp_usm.erl @@ -45,7 +45,12 @@ -define(i32(Int), (Int bsr 24) band 255, (Int bsr 16) band 255, (Int bsr 8) band 255, Int band 255). --define(BLOCK_CIPHER_AES, aes_cfb128). +-define(BLOCK_CIPHER_AES(Key), case size(iolist_to_binary(Key)) of + 128 -> aes_128_cfb128; + 192 -> aes_192_cfb128; + 256 -> aes_256_cfb128 + end). + -define(BLOCK_CIPHER_DES, des_cbc). @@ -157,7 +162,7 @@ md5_auth_out(AuthKey, Message, UsmSecParams) -> Packet = snmp_pdus:enc_message_only(Message2), %% 6.3.1.2-4 is done by the crypto function %% 6.3.1.4 - MAC = binary_to_list(crypto:hmac(md5, AuthKey, Packet, 12)), + MAC = binary_to_list(crypto:macN(hmac, md5, AuthKey, Packet, 12)), %% ?vtrace("md5_auth_out -> crypto (md5) encoded" %% "~n MAC: ~w", [MAC]), %% 6.3.1.5 @@ -171,7 +176,7 @@ md5_auth_in(AuthKey, AuthParams, Packet) when length(AuthParams) == 12 -> %% 6.3.2.3 Packet2 = patch_packet(binary_to_list(Packet)), %% 6.3.2.5 - MAC = binary_to_list(crypto:hmac(md5, AuthKey, Packet2, 12)), + MAC = binary_to_list(crypto:macN(hmac, md5, AuthKey, Packet2, 12)), %% 6.3.2.6 %% ?vtrace("md5_auth_in -> crypto (md5) encoded" %% "~n MAC: ~w", [MAC]), @@ -190,7 +195,7 @@ sha_auth_out(AuthKey, Message, UsmSecParams) -> Packet = snmp_pdus:enc_message_only(Message2), %% 7.3.1.2-4 is done by the crypto function %% 7.3.1.4 - MAC = binary_to_list(crypto:hmac(sha, AuthKey, Packet, 12)), + MAC = binary_to_list(crypto:macN(hmac, sha, AuthKey, Packet, 12)), %% 7.3.1.5 set_msg_auth_params(Message, UsmSecParams, MAC). @@ -198,7 +203,7 @@ sha_auth_in(AuthKey, AuthParams, Packet) when length(AuthParams) =:= 12 -> %% 7.3.2.3 Packet2 = patch_packet(binary_to_list(Packet)), %% 7.3.2.5 - MAC = binary_to_list(crypto:hmac(sha, AuthKey, Packet2, 12)), + MAC = binary_to_list(crypto:macN(hmac, sha, AuthKey, Packet2, 12)), %% 7.3.2.6 MAC == AuthParams; sha_auth_in(_AuthKey, _AuthParams, _Packet) -> @@ -216,8 +221,8 @@ des_encrypt(PrivKey, Data, SaltFun) -> IV = list_to_binary(snmp_misc:str_xor(PreIV, Salt)), TailLen = (8 - (length(Data) rem 8)) rem 8, Tail = mk_tail(TailLen), - EncData = crypto:block_encrypt(?BLOCK_CIPHER_DES, - DesKey, IV, [Data,Tail]), + EncData = crypto:crypto_one_time(?BLOCK_CIPHER_DES, + DesKey, IV, [Data,Tail], true), {ok, binary_to_list(EncData), Salt}. des_decrypt(PrivKey, MsgPrivParams, EncData) @@ -231,8 +236,8 @@ des_decrypt(PrivKey, MsgPrivParams, EncData) Salt = MsgPrivParams, IV = list_to_binary(snmp_misc:str_xor(PreIV, Salt)), %% Whatabout errors here??? E.g. not a mulitple of 8! - Data = binary_to_list(crypto:block_decrypt(?BLOCK_CIPHER_DES, - DesKey, IV, EncData)), + Data = binary_to_list(crypto:crypto_one_time(?BLOCK_CIPHER_DES, + DesKey, IV, EncData, false)), Data2 = snmp_pdus:strip_encrypted_scoped_pdu_data(Data), {ok, Data2}; des_decrypt(PrivKey, BadMsgPrivParams, EncData) -> @@ -248,8 +253,8 @@ aes_encrypt(PrivKey, Data, SaltFun, EngineBoots, EngineTime) -> AesKey = PrivKey, Salt = SaltFun(), IV = list_to_binary([?i32(EngineBoots), ?i32(EngineTime) | Salt]), - EncData = crypto:block_encrypt(?BLOCK_CIPHER_AES, - AesKey, IV, Data), + EncData = crypto:crypto_one_time(?BLOCK_CIPHER_AES(AesKey), + AesKey, IV, Data, true), {ok, binary_to_list(EncData), Salt}. aes_decrypt(PrivKey, MsgPrivParams, EncData, EngineBoots, EngineTime) @@ -258,8 +263,8 @@ aes_decrypt(PrivKey, MsgPrivParams, EncData, EngineBoots, EngineTime) Salt = MsgPrivParams, IV = list_to_binary([?i32(EngineBoots), ?i32(EngineTime) | Salt]), %% Whatabout errors here??? E.g. not a mulitple of 8! - Data = binary_to_list(crypto:block_decrypt(?BLOCK_CIPHER_AES, - AesKey, IV, EncData)), + Data = binary_to_list(crypto:crypto_one_time(?BLOCK_CIPHER_AES(AesKey), + AesKey, IV, EncData, false)), Data2 = snmp_pdus:strip_encrypted_scoped_pdu_data(Data), {ok, Data2}. diff --git a/lib/ssh/Makefile b/lib/ssh/Makefile index dedc7ac3a6..da0e3e6cd1 100644 --- a/lib/ssh/Makefile +++ b/lib/ssh/Makefile @@ -17,6 +17,7 @@ # # %CopyrightEnd% # +# include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk @@ -37,4 +38,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=crypto runtime_tools public_key +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/ssh/doc/src/Makefile b/lib/ssh/doc/src/Makefile index 4e32dd9976..4e6af79a1a 100644 --- a/lib/ssh/doc/src/Makefile +++ b/lib/ssh/doc/src/Makefile @@ -30,11 +30,6 @@ VSN=$(SSH_VSN) APPLICATION=ssh # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -67,87 +62,9 @@ XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) $(XML_REF6 IMAGE_FILES = SSH_protocols.png -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info -EXTRA_FILES = \ - $(DEFAULT_GIF_FILES) \ - $(DEFAULT_HTML_FILES) \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) - TOP_SPECS_FILE = specs.xml -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -#SPECS_FLAGS = -I../../include -I../../../kernel/include -SPECS_FLAGS = -I../../../public_key/include -I../../../public_key/src -I../../.. +NO_CHUNKS = ssh_client_key_api.xml ssh_server_key_api.xml ssh_server_channel.xml # ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.png: %.png - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -images: $(IMAGE_FILES:%=$(HTMLDIR)/%) - -pdf: $(TOP_PDF_FILE) - -html: images $(HTML_REF_MAN_FILE) - - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f $(SPECS_FILES) - rm -f errs core *~ - -man: $(MAN3_FILES) $(MAN6_FILES) - - -debug opt: - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" - - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 862f79ac56..913b162fe9 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -91,7 +91,7 @@ <section> <title>Keys and files</title> <p>A number of objects must be present for the SSH application to work. - Thoose objects are per default stored in files. + Those objects are per default stored in files. The default names, paths and file formats are the same as for <url href="http://www.openssh.com">OpenSSH</url>. Keys could be generated with the <c>ssh-keygen</c> program from OpenSSH. See the @@ -746,6 +746,25 @@ </desc> </datatype> + <datatype> + <name name="tcpip_tunnel_in_daemon_option"/> + <desc> + <p>Enables (<c>true</c>) or disables (<c>false</c>) the possibility to tunnel a TCP/IP connection in to a + <seealso marker="ssh:ssh#daemon-2">server</seealso>. + Disabled per default. + </p> + </desc> + </datatype> + + <datatype> + <name name="tcpip_tunnel_out_daemon_option"/> + <desc> + <p>Enables (<c>true</c>) or disables (<c>false</c>) the possibility to tunnel a TCP/IP connection out of a + <seealso marker="ssh:ssh#daemon-2">server</seealso>. + Disabled per default. + </p> + </desc> + </datatype> <!--................................................................--> <datatype_title>Options common to clients and daemons</datatype_title> @@ -1124,9 +1143,9 @@ </datatype> <datatype> - <name>opaque_client_options</name> - <name>opaque_daemon_options</name> - <name>opaque_common_options</name> + <name>opaque_client_options()</name> + <name>opaque_daemon_options()</name> + <name>opaque_common_options()</name> <desc> <marker id="type-opaque_client_options"/> <marker id="type-opaque_daemon_options"/> @@ -1376,6 +1395,49 @@ </desc> </func> + <func> + <name name="tcpip_tunnel_from_server" arity="5" since=""/> + <name name="tcpip_tunnel_from_server" arity="6" since=""/> + <fsummary>TCP/IP tunneling from a server to a client ("tcpip-forward")</fsummary> + <desc> + <p>Asks the remote server of <c>ConnectionRef</c> to listen to <c>ListenHost:ListenPort</c>. + When someone connects that address, the connection is forwarded in an encrypted channel from + the server to the client. The client (that is, at the node that calls this function) then + connects to <c>ConnectToHost:ConnectToPort</c>. + </p> + <p>The returned <c>TrueListenPort</c> is the port that is listened to. It is the same as + <c>ListenPort</c>, except when <c>ListenPort = 0</c>. In that case a free port is selected + by the underlying OS. + </p> + <p>Note that in case of an Erlang/OTP SSH server (daemon) as peer, that server must have been + started with the option + <seealso marker="#type-tcpip_tunnel_out_daemon_option">tcpip_tunnel_out</seealso> + to allow the connection. + </p> + </desc> + </func> + + <func> + <name name="tcpip_tunnel_to_server" arity="5" since=""/> + <name name="tcpip_tunnel_to_server" arity="6" since=""/> + <fsummary>TCP/IP tunneling from a client to a server ("direct-tcpip")</fsummary> + <desc> + <p>Tells the local client to listen to <c>ListenHost:ListenPort</c>. When someone + connects to that address, the connection is forwarded in an encrypted channel to the peer server + of <c>ConnectionRef</c>. That server then connects to <c>ConnectToHost:ConnectToPort</c>. + </p> + <p>The returned <c>TrueListenPort</c> is the port that is listened to. It is the same as + <c>ListenPort</c>, except when <c>ListenPort = 0</c>. In that case a free port is selected + by the underlying OS. + </p> + <p>Note that in case of an Erlang/OTP SSH server (daemon) as peer, that server must have been + started with the option + <seealso marker="#type-tcpip_tunnel_in_daemon_option">tcpip_tunnel_in</seealso> + to allow the connection. + </p> + </desc> + </func> + </funcs> </erlref> diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index f5c520f2f0..68d7fd13e7 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -61,6 +61,7 @@ MODULES= \ ssh_app \ ssh_auth\ ssh_bits \ + ssh_channel_sup \ ssh_cli \ ssh_connection \ ssh_connection_handler \ @@ -71,7 +72,6 @@ MODULES= \ ssh_message \ ssh_no_io \ ssh_options \ - ssh_server_channel_sup \ ssh_sftp \ ssh_sftpd \ ssh_sftpd_file\ @@ -79,6 +79,10 @@ MODULES= \ ssh_subsystem_sup \ ssh_sup \ ssh_system_sup \ + ssh_tcpip_forward_srv \ + ssh_tcpip_forward_client \ + ssh_tcpip_forward_acceptor_sup \ + ssh_tcpip_forward_acceptor \ ssh_transport \ ssh_xfer \ sshc_sup \ @@ -180,7 +184,7 @@ $(EBIN)/ssh_connection_handler.$(EMULATOR): ssh_connection_handler.erl ssh.hrl \ $(EBIN)/ssh_shell.$(EMULATOR): ssh_shell.erl ssh_connect.hrl $(EBIN)/ssh_system_sup.$(EMULATOR): ssh_system_sup.erl ssh.hrl $(EBIN)/ssh_subsystem_sup.$(EMULATOR): ssh_subsystem_sup.erl -$(EBIN)/ssh_server_channel_sup.$(EMULATOR): ssh_server_channel_sup.erl +$(EBIN)/ssh_channel_sup.$(EMULATOR): ssh_channel_sup.erl ssh.hrl $(EBIN)/ssh_acceptor_sup.$(EMULATOR): ssh_acceptor_sup.erl ssh.hrl $(EBIN)/ssh_acceptor.$(EMULATOR): ssh_acceptor.erl ssh.hrl $(EBIN)/ssh_app.$(EMULATOR): ssh_app.erl diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index 21e3604400..fda507727a 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -11,6 +11,7 @@ ssh_auth, ssh_message, ssh_bits, + ssh_channel_sup, ssh_cli, ssh_client_channel, ssh_client_key_api, @@ -28,7 +29,6 @@ ssh_info, ssh_no_io, ssh_server_channel, - ssh_server_channel_sup, ssh_server_key_api, ssh_sftp, ssh_sftpd, @@ -36,6 +36,10 @@ ssh_sftpd_file_api, ssh_subsystem_sup, ssh_sup, + ssh_tcpip_forward_client, + ssh_tcpip_forward_srv, + ssh_tcpip_forward_acceptor_sup, + ssh_tcpip_forward_acceptor, ssh_system_sup, ssh_transport, ssh_xfer]}, diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 355b40eea8..2673f30774 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -40,7 +40,9 @@ chk_algos_opts/1, stop_listener/1, stop_listener/2, stop_listener/3, stop_daemon/1, stop_daemon/2, stop_daemon/3, - shell/1, shell/2, shell/3 + shell/1, shell/2, shell/3, + tcpip_tunnel_from_server/5, tcpip_tunnel_from_server/6, + tcpip_tunnel_to_server/5, tcpip_tunnel_to_server/6 ]). %%% "Deprecated" types export: @@ -129,15 +131,13 @@ connect(Socket, UserOptions, NegotiationTimeout) when is_port(Socket), {error, Error} -> {error, Error}; Options -> - case valid_socket_to_use(Socket, ?GET_OPT(transport,Options)) of - ok -> - {ok, {Host,_Port}} = inet:peername(Socket), - Opts = ?PUT_INTERNAL_OPT([{user_pid,self()}, {host,Host}], Options), - ssh_connection_handler:start_connection(client, Socket, Opts, NegotiationTimeout); - {error,SockError} -> - {error,SockError} - end - end; + case valid_socket_to_use(Socket, ?GET_OPT(transport,Options)) of + ok -> + connect_socket(Socket, Options, NegotiationTimeout); + {error,SockError} -> + {error,SockError} + end + end; connect(Host, Port, Options) when is_integer(Port), Port>0, @@ -151,9 +151,9 @@ connect(Host, Port, Options) when is_integer(Port), Options :: client_options(), NegotiationTimeout :: timeout(). -connect(Host0, Port, UserOptions, Timeout) when is_integer(Port), - Port>0, - is_list(UserOptions) -> +connect(Host0, Port, UserOptions, NegotiationTimeout) when is_integer(Port), + Port>0, + is_list(UserOptions) -> case ssh_options:handle_options(client, UserOptions) of {error, _Reason} = Error -> Error; @@ -164,8 +164,7 @@ connect(Host0, Port, UserOptions, Timeout) when is_integer(Port), Host = mangle_connect_address(Host0, SocketOpts), try Transport:connect(Host, Port, SocketOpts, ConnectionTimeout) of {ok, Socket} -> - Opts = ?PUT_INTERNAL_OPT([{user_pid,self()}, {host,Host}], Options), - ssh_connection_handler:start_connection(client, Socket, Opts, Timeout); + connect_socket(Socket, Options, NegotiationTimeout); {error, Reason} -> {error, Reason} catch @@ -176,6 +175,22 @@ connect(Host0, Port, UserOptions, Timeout) when is_integer(Port), end end. + +connect_socket(Socket, Options0, NegotiationTimeout) -> + {ok, {Host,Port}} = inet:sockname(Socket), + Profile = ?GET_OPT(profile, Options0), + {ok, SystemSup} = sshc_sup:start_child(Host, Port, Profile, Options0), + {ok, SubSysSup} = ssh_system_sup:start_subsystem(SystemSup, client, Host, Port, Profile, Options0), + ConnectionSup = ssh_system_sup:connection_supervisor(SystemSup), + Opts = ?PUT_INTERNAL_OPT([{user_pid,self()}, + {host,Host}, + {supervisors, [{system_sup, SystemSup}, + {subsystem_sup, SubSysSup}, + {connection_sup, ConnectionSup}]} + ], Options0), + ssh_connection_handler:start_connection(client, Socket, Opts, NegotiationTimeout). + + %%-------------------------------------------------------------------- -spec close(ConnectionRef) -> ok | {error,term()} when ConnectionRef :: connection_ref() . @@ -452,7 +467,7 @@ stop_listener(Address, Port, Profile) -> -spec stop_daemon(DaemonRef::daemon_ref()) -> ok. stop_daemon(SysSup) -> - ssh_system_sup:stop_system(SysSup). + ssh_system_sup:stop_system(server, SysSup). -spec stop_daemon(inet:ip_address(), inet:port_number()) -> ok. @@ -465,11 +480,11 @@ stop_daemon(Address, Port) -> stop_daemon(any, Port, Profile) -> map_ip(fun(IP) -> - ssh_system_sup:stop_system(IP, Port, Profile) + ssh_system_sup:stop_system(server, IP, Port, Profile) end, [{0,0,0,0},{0,0,0,0,0,0,0,0}]); stop_daemon(Address, Port, Profile) -> map_ip(fun(IP) -> - ssh_system_sup:stop_system(IP, Port, Profile) + ssh_system_sup:stop_system(server, IP, Port, Profile) end, {address,Address}). %%-------------------------------------------------------------------- @@ -581,6 +596,113 @@ get_sock_opts(ConnectionRef, SocketGetOptions) -> ssh_connection_handler:get_sock_opts(ConnectionRef, SocketGetOptions). %%-------------------------------------------------------------------- +%% Ask local client to listen to ListenHost:ListenPort. When someone +%% connects that address, connect to ConnectToHost:ConnectToPort from +%% the server. +%%-------------------------------------------------------------------- +-spec tcpip_tunnel_to_server(ConnectionRef, + ListenHost, ListenPort, + ConnectToHost, ConnectToPort + ) -> + {ok,TrueListenPort} | {error, term()} when + ConnectionRef :: connection_ref(), + ListenHost :: host(), + ListenPort :: inet:port_number(), + ConnectToHost :: host(), + ConnectToPort :: inet:port_number(), + TrueListenPort :: inet:port_number(). + +tcpip_tunnel_to_server(ConnectionHandler, ListenHost, ListenPort, ConnectToHost, ConnectToPort) -> + tcpip_tunnel_to_server(ConnectionHandler, ListenHost, ListenPort, ConnectToHost, ConnectToPort, infinity). + + +-spec tcpip_tunnel_to_server(ConnectionRef, + ListenHost, ListenPort, + ConnectToHost, ConnectToPort, + Timeout) -> + {ok,TrueListenPort} | {error, term()} when + ConnectionRef :: connection_ref(), + ListenHost :: host(), + ListenPort :: inet:port_number(), + ConnectToHost :: host(), + ConnectToPort :: inet:port_number(), + Timeout :: timeout(), + TrueListenPort :: inet:port_number(). + +tcpip_tunnel_to_server(ConnectionHandler, ListenHost, ListenPort, ConnectToHost0, ConnectToPort, Timeout) -> + SockOpts = [], + try + list_to_binary( + case mangle_connect_address(ConnectToHost0,SockOpts) of + IP when is_tuple(IP) -> inet_parse:ntoa(IP); + _ when is_list(ConnectToHost0) -> ConnectToHost0 + end) + of + ConnectToHost -> + ssh_connection_handler:handle_direct_tcpip(ConnectionHandler, + mangle_tunnel_address(ListenHost), ListenPort, + ConnectToHost, ConnectToPort, + Timeout) + catch + _:_ -> + {error, bad_connect_to_address} + end. + +%%-------------------------------------------------------------------- +%% Ask remote server to listen to ListenHost:ListenPort. When someone +%% connects that address, connect to ConnectToHost:ConnectToPort from +%% the client. +%%-------------------------------------------------------------------- +-spec tcpip_tunnel_from_server(ConnectionRef, + ListenHost, ListenPort, + ConnectToHost, ConnectToPort + ) -> + {ok,TrueListenPort} | {error, term()} when + ConnectionRef :: connection_ref(), + ListenHost :: host(), + ListenPort :: inet:port_number(), + ConnectToHost :: host(), + ConnectToPort :: inet:port_number(), + TrueListenPort :: inet:port_number(). + +tcpip_tunnel_from_server(ConnectionRef, ListenHost, ListenPort, ConnectToHost, ConnectToPort) -> + tcpip_tunnel_from_server(ConnectionRef, ListenHost, ListenPort, ConnectToHost, ConnectToPort, infinity). + +-spec tcpip_tunnel_from_server(ConnectionRef, + ListenHost, ListenPort, + ConnectToHost, ConnectToPort, + Timeout) -> + {ok,TrueListenPort} | {error, term()} when + ConnectionRef :: connection_ref(), + ListenHost :: host(), + ListenPort :: inet:port_number(), + ConnectToHost :: host(), + ConnectToPort :: inet:port_number(), + Timeout :: timeout(), + TrueListenPort :: inet:port_number(). + +tcpip_tunnel_from_server(ConnectionRef, ListenHost0, ListenPort, ConnectToHost0, ConnectToPort, Timeout) -> + SockOpts = [], + ListenHost = mangle_tunnel_address(ListenHost0), + ConnectToHost = mangle_connect_address(ConnectToHost0, SockOpts), + case ssh_connection_handler:global_request(ConnectionRef, "tcpip-forward", true, + {ListenHost,ListenPort,ConnectToHost,ConnectToPort}, + Timeout) of + {success,<<>>} -> + {ok, ListenPort}; + {success,<<TruePort:32/unsigned-integer>>} when ListenPort==0 -> + {ok, TruePort}; + {success,_} = Res -> + {error, {bad_result,Res}}; + {failure,<<>>} -> + {error,not_accepted}; + {failure,Error} -> + {error,Error}; + Other -> + Other + end. + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- %% The handle_daemon_args/2 function basically only sets the ip-option in Opts @@ -697,3 +819,16 @@ mangle_connect_address1(A, _) -> {ok, {0,0,0,0,0,0,0,0}} -> loopback(true); _ -> A end. + +%%%---------------------------------------------------------------- +mangle_tunnel_address(any) -> <<"">>; +mangle_tunnel_address(loopback) -> <<"localhost">>; +mangle_tunnel_address({0,0,0,0}) -> <<"">>; +mangle_tunnel_address({0,0,0,0,0,0,0,0}) -> <<"">>; +mangle_tunnel_address(IP) when is_tuple(IP) -> list_to_binary(inet_parse:ntoa(IP)); +mangle_tunnel_address(A) when is_atom(A) -> mangle_tunnel_address(atom_to_list(A)); +mangle_tunnel_address(X) when is_list(X) -> case catch inet:parse_address(X) of + {ok, {0,0,0,0}} -> <<"">>; + {ok, {0,0,0,0,0,0,0,0}} -> <<"">>; + _ -> list_to_binary(X) + end. diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index a9d81f7252..e754b9ebc6 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -51,6 +51,7 @@ -define(STRING(X), ?UINT32((size(X))), (X)/binary). -define(DEC_BIN(X,Len), ?UINT32(Len), X:Len/binary ). +-define(DEC_INT(I,Len), ?UINT32(Len), I:Len/big-signed-integer-unit:8 ). -define(DEC_MPINT(I,Len), ?UINT32(Len), I:Len/big-signed-integer-unit:8 ). %% building macros @@ -308,6 +309,8 @@ | shell_daemon_option() | exec_daemon_option() | ssh_cli_daemon_option() + | tcpip_tunnel_out_daemon_option() + | tcpip_tunnel_in_daemon_option() | authentication_daemon_options() | diffie_hellman_group_exchange_daemon_option() | negotiation_timeout_daemon_option() @@ -338,6 +341,9 @@ -type ssh_cli_daemon_option() :: {ssh_cli, mod_args() | no_cli }. +-type tcpip_tunnel_out_daemon_option() :: {tcpip_tunnel_out, boolean()} . +-type tcpip_tunnel_in_daemon_option() :: {tcpip_tunnel_in, boolean()} . + -type send_ext_info_daemon_option() :: {send_ext_info, boolean()} . -type authentication_daemon_options() :: diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index b9813b6b5c..bb3bec9c7c 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -143,9 +143,9 @@ get_public_key(SigAlg, #ssh{opts = Opts}) -> {ok, PrivKey} -> try %% Check the key - the KeyCb may be a buggy plugin - true = ssh_transport:valid_key_sha_alg(PrivKey, KeyAlg), + true = ssh_transport:valid_key_sha_alg(private, PrivKey, KeyAlg), Key = ssh_transport:extract_public_key(PrivKey), - public_key:ssh_encode(Key, ssh2_pubkey) + ssh_message:ssh2_pubkey_encode(Key) of PubKeyBlob -> {ok,{PrivKey,PubKeyBlob}} catch @@ -495,7 +495,7 @@ get_password_option(Opts, User) -> pre_verify_sig(User, KeyBlob, Opts) -> try - Key = public_key:ssh_decode(KeyBlob, ssh2_pubkey), % or exception + Key = ssh_message:ssh2_pubkey_decode(KeyBlob), % or exception ssh_transport:call_KeyCb(is_auth_key, [Key, User], Opts) catch _:_ -> @@ -505,7 +505,7 @@ pre_verify_sig(User, KeyBlob, Opts) -> verify_sig(SessionId, User, Service, AlgBin, KeyBlob, SigWLen, #ssh{opts = Opts} = Ssh) -> try Alg = binary_to_list(AlgBin), - Key = public_key:ssh_decode(KeyBlob, ssh2_pubkey), % or exception + Key = ssh_message:ssh2_pubkey_decode(KeyBlob), % or exception true = ssh_transport:call_KeyCb(is_auth_key, [Key, User], Opts), PlainText = build_sig_data(SessionId, User, Service, KeyBlob, Alg), <<?UINT32(AlgSigLen), AlgSig:AlgSigLen/binary>> = SigWLen, diff --git a/lib/ssh/src/ssh_channel_sup.erl b/lib/ssh/src/ssh_channel_sup.erl new file mode 100644 index 0000000000..4b36c8a5a0 --- /dev/null +++ b/lib/ssh/src/ssh_channel_sup.erl @@ -0,0 +1,90 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%%---------------------------------------------------------------------- +%% Purpose: Ssh channel supervisor. +%%---------------------------------------------------------------------- +-module(ssh_channel_sup). + +-behaviour(supervisor). +-include("ssh.hrl"). + +-export([start_link/1, start_child/8]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% Internal API +%%%========================================================================= +start_link(Args) -> + supervisor:start_link(?MODULE, [Args]). + + +start_child(client, ChannelSup, ConnRef, Callback, Id, Args, Exec, _Opts) when is_pid(ConnRef) -> + start_the_child(ssh_client_channel, ChannelSup, ConnRef, Callback, Id, Args, Exec); +start_child(server, ChannelSup, ConnRef, Callback, Id, Args, Exec, Opts) when is_pid(ConnRef) -> + case max_num_channels_not_exceeded(ChannelSup, Opts) of + true -> + start_the_child(ssh_server_channel, ChannelSup, ConnRef, Callback, Id, Args, Exec); + false -> + {error, max_num_channels_exceeded} + end. + + +start_the_child(ChanMod, ChannelSup, ConnRef, Callback, Id, Args, Exec) -> + ChildSpec = + #{id => make_ref(), + start => {ChanMod, start_link, [ConnRef, Id, Callback, Args, Exec]}, + restart => temporary, + type => worker, + modules => [ChanMod] + }, + case supervisor:start_child(ChannelSup, ChildSpec) of + {ok, Pid} -> + {ok, Pid}; + {ok, Pid, _Info} -> + {ok,Pid}; + {error, {Error,_Info}} -> + {error, Error}; + {error, Error} -> + {error, Error} + end. + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +init(_Args) -> + RestartStrategy = one_for_one, + MaxR = 10, + MaxT = 3600, + Children = [], + {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. + +%%%========================================================================= +%%% Internal functions +%%%========================================================================= +max_num_channels_not_exceeded(ChannelSup, Opts) -> + MaxNumChannels = ?GET_OPT(max_channels, Opts), + NumChannels = length([x || {_,_,worker,[ssh_server_channel]} <- + supervisor:which_children(ChannelSup)]), + %% Note that NumChannels is BEFORE starting a new one + NumChannels < MaxNumChannels. diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index 380faeb11e..0d5ffaa509 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -45,6 +45,8 @@ handle_msg/3, handle_stop/1, + open_channel/4, + channel_adjust_window_msg/2, channel_close_msg/1, channel_open_failure_msg/4, @@ -57,6 +59,7 @@ channel_request_msg/4, channel_success_msg/1, + request_global_msg/3, request_failure_msg/0, request_success_msg/1, @@ -202,10 +205,22 @@ session_channel(ConnectionHandler, Timeout) -> Result :: {ok, ssh:channel_id()} | {error, reason()} . session_channel(ConnectionHandler, InitialWindowSize, MaxPacketSize, Timeout) -> - case ssh_connection_handler:open_channel(ConnectionHandler, "session", <<>>, - InitialWindowSize, - MaxPacketSize, Timeout) of - {open, Channel} -> + open_channel(ConnectionHandler, "session", <<>>, + InitialWindowSize, + MaxPacketSize, + Timeout). + +%%-------------------------------------------------------------------- +%% Description: Opens a channel for the given type. +%% -------------------------------------------------------------------- +open_channel(ConnectionHandler, Type, ChanData, Timeout) -> + open_channel(ConnectionHandler, Type, ChanData, ?DEFAULT_WINDOW_SIZE, ?DEFAULT_PACKET_SIZE, Timeout). + +open_channel(ConnectionHandler, Type, ChanData, InitialWindowSize, MaxPacketSize, Timeout) -> + case ssh_connection_handler:open_channel(ConnectionHandler, Type, ChanData, + InitialWindowSize, MaxPacketSize, + Timeout) of + {open, Channel} -> {ok, Channel}; Error -> Error @@ -376,6 +391,7 @@ ptty_alloc(ConnectionHandler, Channel, Options0, TimeOut) -> proplists:get_value(pixel_height, TermData, PixHeight), proplists:get_value(pty_opts, TermData, []), TimeOut ). + %%-------------------------------------------------------------------- %% Not yet officialy supported! The following functions are part of the %% initial contributed ssh application. They are untested. Do we want them? @@ -566,6 +582,124 @@ handle_msg(#ssh_msg_channel_open{channel_type = "session" = Type, {[{connection_reply, FailMsg}], Connection0} end; +handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip", + sender_channel = RemoteId, + initial_window_size = WindowSize, + maximum_packet_size = PacketSize, + data = <<?DEC_BIN(ConnectedHost,_L1), ?UINT32(ConnectedPort), + ?DEC_BIN(_OriginHost,_L2), ?UINT32(_OriginPort) + >> + }, + #connection{channel_cache = Cache, + channel_id_seed = ChId, + options = Options, + sub_system_supervisor = SubSysSup + } = C, + client) -> + {ReplyMsg, NextChId} = + case ssh_connection_handler:retrieve(C, {tcpip_forward,ConnectedHost,ConnectedPort}) of + {ok, {ConnectToHost,ConnectToPort}} -> + case gen_tcp:connect(ConnectToHost, ConnectToPort, [{active,false}, binary]) of + {ok,Sock} -> + {ok,Pid} = ssh_subsystem_sup:start_channel(client, SubSysSup, self(), + ssh_tcpip_forward_client, ChId, + [Sock], undefined, Options), + ssh_client_channel:cache_update(Cache, + #channel{type = "forwarded-tcpip", + sys = "none", + local_id = ChId, + remote_id = RemoteId, + user = Pid, + recv_window_size = ?DEFAULT_WINDOW_SIZE, + recv_packet_size = ?DEFAULT_PACKET_SIZE, + send_window_size = WindowSize, + send_packet_size = PacketSize, + send_buf = queue:new() + }), + gen_tcp:controlling_process(Sock, Pid), + inet:setopts(Sock, [{active,once}]), + {channel_open_confirmation_msg(RemoteId, ChId, + ?DEFAULT_WINDOW_SIZE, + ?DEFAULT_PACKET_SIZE), + ChId + 1}; + + {error,Error} -> + {channel_open_failure_msg(RemoteId, + ?SSH_OPEN_CONNECT_FAILED, + io_lib:format("Forwarded connection refused: ~p",[Error]), + "en"), + ChId} + end; + + undefined -> + {channel_open_failure_msg(RemoteId, + ?SSH_OPEN_CONNECT_FAILED, + io_lib:format("No forwarding ordered",[]), + "en"), + ChId} + end, + {[{connection_reply, ReplyMsg}], C#connection{channel_id_seed = NextChId}}; + +handle_msg(#ssh_msg_channel_open{channel_type = "direct-tcpip", + sender_channel = RemoteId, + initial_window_size = WindowSize, + maximum_packet_size = PacketSize, + data = <<?DEC_BIN(HostToConnect,_L1), ?UINT32(PortToConnect), + ?DEC_BIN(_OriginatorIPaddress,_L2), ?UINT32(_OrignatorPort) + >> + }, + #connection{channel_cache = Cache, + channel_id_seed = ChId, + options = Options, + sub_system_supervisor = SubSysSup + } = C, + server) -> + {ReplyMsg, NextChId} = + case ?GET_OPT(tcpip_tunnel_in, Options) of + %% May add more to the option, like allowed ip/port pairs to connect to + false -> + {channel_open_failure_msg(RemoteId, + ?SSH_OPEN_CONNECT_FAILED, + "Forwarding disabled", "en"), + ChId}; + + true -> + case gen_tcp:connect(binary_to_list(HostToConnect), PortToConnect, + [{active,false}, binary]) of + {ok,Sock} -> + {ok,Pid} = ssh_subsystem_sup:start_channel(server, SubSysSup, self(), + ssh_tcpip_forward_srv, ChId, + [Sock], undefined, Options), + ssh_client_channel:cache_update(Cache, + #channel{type = "direct-tcpip", + sys = "none", + local_id = ChId, + remote_id = RemoteId, + user = Pid, + recv_window_size = ?DEFAULT_WINDOW_SIZE, + recv_packet_size = ?DEFAULT_PACKET_SIZE, + send_window_size = WindowSize, + send_packet_size = PacketSize, + send_buf = queue:new() + }), + gen_tcp:controlling_process(Sock, Pid), + inet:setopts(Sock, [{active,once}]), + + {channel_open_confirmation_msg(RemoteId, ChId, + ?DEFAULT_WINDOW_SIZE, + ?DEFAULT_PACKET_SIZE), + ChId + 1}; + + {error,Error} -> + {channel_open_failure_msg(RemoteId, + ?SSH_OPEN_CONNECT_FAILED, + io_lib:format("Forwarded connection refused: ~p",[Error]), + "en"), + ChId} + end + end, + {[{connection_reply, ReplyMsg}], C#connection{channel_id_seed = NextChId}}; + handle_msg(#ssh_msg_channel_open{channel_type = "session", sender_channel = RemoteId}, Connection, @@ -646,19 +780,14 @@ handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId, #channel{remote_id=RemoteId} = Channel = ssh_client_channel:cache_lookup(Cache, ChannelId), Reply = - try - start_subsystem(SsName, Connection, Channel, - {subsystem, ChannelId, WantReply, binary_to_list(SsName)}) - of + case start_subsystem(SsName, Connection, Channel, + {subsystem, ChannelId, WantReply, binary_to_list(SsName)}) of {ok, Pid} -> erlang:monitor(process, Pid), ssh_client_channel:cache_update(Cache, Channel#channel{user=Pid}), channel_success_msg(RemoteId); {error,_Error} -> channel_failure_msg(RemoteId) - catch - _:_ -> - channel_failure_msg(RemoteId) end, {[{connection_reply,Reply}], Connection}; @@ -743,9 +872,45 @@ handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId, {[], Connection} end; +handle_msg(#ssh_msg_global_request{name = <<"tcpip-forward">>, + want_reply = WantReply, + data = <<?DEC_BIN(ListenAddrStr,_Len),?UINT32(ListenPort)>>}, + #connection{options = Opts} = Connection, server) -> + case ?GET_OPT(tcpip_tunnel_out, Opts) of + false -> + %% This daemon instance has not enabled tcpip_forwarding + {[{connection_reply, request_failure_msg()}], Connection}; + + true -> + Sups = ?GET_INTERNAL_OPT(supervisors, Opts), + SubSysSup = proplists:get_value(subsystem_sup, Sups), + FwdSup = ssh_subsystem_sup:tcpip_fwd_supervisor(SubSysSup), + ConnPid = self(), + case ssh_tcpip_forward_acceptor:supervised_start(FwdSup, + {ListenAddrStr, ListenPort}, + undefined, + "forwarded-tcpip", ssh_tcpip_forward_srv, + ConnPid) of + {ok,ListenPort} when WantReply==true -> + {[{connection_reply, request_success_msg(<<>>)}], Connection}; + + {ok,LPort} when WantReply==true -> + {[{connection_reply, request_success_msg(<<?UINT32(LPort)>>)}], Connection}; + + {error,_} when WantReply==true -> + {[{connection_reply, request_failure_msg()}], Connection}; + + _ when WantReply==true -> + {[{connection_reply, request_failure_msg()}], Connection}; + + _ -> + {[], Connection} + end + end; + handle_msg(#ssh_msg_global_request{name = _Type, want_reply = WantReply, - data = _Data}, Connection, _) -> + data = _Data}, Connection, _Role) -> if WantReply == true -> FailMsg = request_failure_msg(), {[{connection_reply, FailMsg}], Connection}; @@ -758,11 +923,22 @@ handle_msg(#ssh_msg_request_failure{}, {[{channel_request_reply, From, {failure, <<>>}}], Connection#connection{requests = Rest}}; +handle_msg(#ssh_msg_request_failure{}, + #connection{requests = [{_, From,_} | Rest]} = Connection, _) -> + {[{channel_request_reply, From, {failure, <<>>}}], + Connection#connection{requests = Rest}}; + handle_msg(#ssh_msg_request_success{data = Data}, #connection{requests = [{_, From} | Rest]} = Connection, _) -> {[{channel_request_reply, From, {success, Data}}], Connection#connection{requests = Rest}}; +handle_msg(#ssh_msg_request_success{data = Data}, + #connection{requests = [{_, From, Fun} | Rest]} = Connection0, _) -> + Connection = Fun({success,Data}, Connection0), + {[{channel_request_reply, From, {success, Data}}], + Connection#connection{requests = Rest}}; + handle_msg(#ssh_msg_disconnect{code = Code, description = Description}, Connection, _) -> @@ -847,8 +1023,13 @@ channel_success_msg(ChannelId) -> %%%---------------------------------------------------------------- %%% request_*_msg(...) -%%% Returns a #ssh_msg_....{} for request responses. +%%% Returns a #ssh_msg_....{} %%% +request_global_msg(Name, WantReply, Data) -> + #ssh_msg_global_request{name = Name, + want_reply = WantReply, + data = Data}. + request_failure_msg() -> #ssh_msg_request_failure{}. @@ -919,7 +1100,7 @@ start_cli(#connection{options = Options, no_cli -> {error, cli_disabled}; {CbModule, Args} -> - start_channel(CbModule, ChannelId, Args, SubSysSup, Exec, Options) + ssh_subsystem_sup:start_channel(server, SubSysSup, self(), CbModule, ChannelId, Args, Exec, Options) end. @@ -929,37 +1110,15 @@ start_subsystem(BinName, #connection{options = Options, Name = binary_to_list(BinName), case check_subsystem(Name, Options) of {Callback, Opts} when is_atom(Callback), Callback =/= none -> - start_channel(Callback, ChannelId, Opts, SubSysSup, Options); - {Other, _} when Other =/= none -> + ssh_subsystem_sup:start_channel(server, SubSysSup, self(), Callback, ChannelId, Opts, undefined, Options); + {none, _} -> + {error, bad_subsystem}; + {_, _} -> {error, legacy_option_not_supported} end. %%% Helpers for starting cli/subsystems -start_channel(Cb, Id, Args, SubSysSup, Opts) -> - start_channel(Cb, Id, Args, SubSysSup, undefined, Opts). - -start_channel(Cb, Id, Args, SubSysSup, Exec, Opts) -> - ChannelSup = ssh_subsystem_sup:channel_supervisor(SubSysSup), - case max_num_channels_not_exceeded(ChannelSup, Opts) of - true -> - case ssh_server_channel_sup:start_child(ChannelSup, Cb, Id, Args, Exec) of - {error,{Error,_Info}} -> - throw(Error); - Others -> - Others - end; - false -> - throw(max_num_channels_exceeded) - end. - -max_num_channels_not_exceeded(ChannelSup, Opts) -> - MaxNumChannels = ?GET_OPT(max_channels, Opts), - NumChannels = length([x || {_,_,worker,[ssh_server_channel]} <- - supervisor:which_children(ChannelSup)]), - %% Note that NumChannels is BEFORE starting a new one - NumChannels < MaxNumChannels. - check_subsystem("sftp"= SsName, Options) -> case ?GET_OPT(subsystems, Options) of no_subsys -> % FIXME: Can 'no_subsys' ever be matched? @@ -1298,13 +1457,13 @@ handle_cli_msg(C0, ChId, Reply0) -> Ch0 = ssh_client_channel:cache_lookup(Cache, ChId), case Ch0#channel.user of undefined -> - case (catch start_cli(C0, ChId)) of + case start_cli(C0, ChId) of {ok, Pid} -> erlang:monitor(process, Pid), Ch = Ch0#channel{user = Pid}, ssh_client_channel:cache_update(Cache, Ch), reply_msg(Ch, C0, Reply0); - _Other -> + {error, _Error} -> Reply = {connection_reply, channel_failure_msg(Ch0#channel.remote_id)}, {[Reply], C0} end; @@ -1315,6 +1474,10 @@ handle_cli_msg(C0, ChId, Reply0) -> %%%---------------------------------------------------------------- %%% +%%% TCP/IP forwarding + +%%%---------------------------------------------------------------- +%%% %%% Request response handling on return to the calling ssh_connection_handler %%% state machine. %%% diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index e8c0d88e59..d34537950e 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -48,10 +48,15 @@ -export([start_connection/4, available_hkey_algorithms/2, open_channel/6, + start_channel/5, + handle_direct_tcpip/6, request/6, request/7, reply_request/3, + global_request/5, send/5, send_eof/2, + store/3, + retrieve/2, info/1, info/2, connection_info/2, channel_info/3, @@ -128,35 +133,29 @@ stop(ConnectionHandler)-> timeout() ) -> {ok, connection_ref()} | {error, term()}. %% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . -start_connection(client = Role, Socket, Options, Timeout) -> +start_connection(Role, Socket, Options, Timeout) -> try - {ok, Pid} = sshc_sup:start_child([Role, Socket, Options]), - ok = socket_control(Socket, Pid, Options), - handshake(Pid, erlang:monitor(process,Pid), Timeout) - catch - exit:{noproc, _} -> - {error, ssh_not_started}; - _:Error -> - {error, Error} - end; - -start_connection(server = Role, Socket, Options, Timeout) -> - try - case ?GET_OPT(parallel_login, Options) of - true -> - HandshakerPid = - spawn_link(fun() -> - receive - {do_handshake, Pid} -> - handshake(Pid, erlang:monitor(process,Pid), Timeout) - end - end), - ChildPid = start_the_connection_child(HandshakerPid, Role, Socket, Options), - HandshakerPid ! {do_handshake, ChildPid}; - false -> - ChildPid = start_the_connection_child(self(), Role, Socket, Options), - handshake(ChildPid, erlang:monitor(process,ChildPid), Timeout) - end + case Role of + client -> + ChildPid = start_the_connection_child(self(), Role, Socket, Options), + handshake(ChildPid, erlang:monitor(process,ChildPid), Timeout); + server -> + case ?GET_OPT(parallel_login, Options) of + true -> + HandshakerPid = + spawn_link(fun() -> + receive + {do_handshake, Pid} -> + handshake(Pid, erlang:monitor(process,Pid), Timeout) + end + end), + ChildPid = start_the_connection_child(HandshakerPid, Role, Socket, Options), + HandshakerPid ! {do_handshake, ChildPid}; + false -> + ChildPid = start_the_connection_child(self(), Role, Socket, Options), + handshake(ChildPid, erlang:monitor(process,ChildPid), Timeout) + end + end catch exit:{noproc, _} -> {error, ssh_not_started}; @@ -178,6 +177,8 @@ disconnect(Code, DetailedText, Module, Line) -> [{next_event, internal, {send_disconnect, Code, DetailedText, Module, Line}}]}). %%-------------------------------------------------------------------- +%%% Open a channel in the connection to the peer, that is, do the ssh +%%% signalling with the peer. -spec open_channel(connection_ref(), string(), iodata(), @@ -197,6 +198,22 @@ open_channel(ConnectionHandler, Timeout}). %%-------------------------------------------------------------------- +%%% Start a channel handling process in the superviser tree +-spec start_channel(connection_ref(), atom(), channel_id(), list(), term()) -> + {ok, pid()} | {error, term()}. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +start_channel(ConnectionHandler, CallbackModule, ChannelId, Args, Exec) -> + {ok, {SubSysSup,Role,Opts}} = call(ConnectionHandler, get_misc), + ssh_subsystem_sup:start_channel(Role, SubSysSup, + ConnectionHandler, CallbackModule, ChannelId, + Args, Exec, Opts). + +%%-------------------------------------------------------------------- +handle_direct_tcpip(ConnectionHandler, ListenHost, ListenPort, ConnectToHost, ConnectToPort, Timeout) -> + call(ConnectionHandler, {handle_direct_tcpip, ListenHost, ListenPort, ConnectToHost, ConnectToPort, Timeout}). + +%%-------------------------------------------------------------------- -spec request(connection_ref(), pid(), channel_id(), @@ -235,6 +252,12 @@ reply_request(ConnectionHandler, Status, ChannelId) -> cast(ConnectionHandler, {reply_request, Status, ChannelId}). %%-------------------------------------------------------------------- +global_request(ConnectionHandler, Type, true, Data, Timeout) -> + call(ConnectionHandler, {global_request, Type, Data, Timeout}); +global_request(ConnectionHandler, Type, false, Data, _) -> + cast(ConnectionHandler, {global_request, Type, Data}). + +%%-------------------------------------------------------------------- -spec send(connection_ref(), channel_id(), non_neg_integer(), @@ -324,6 +347,21 @@ close(ConnectionHandler, ChannelId) -> %%-------------------------------------------------------------------- +store(ConnectionHandler, Key, Value) -> + cast(ConnectionHandler, {store,Key,Value}). + +retrieve(#connection{options=Opts}, Key) -> + try ?GET_INTERNAL_OPT(Key, Opts) of + Value -> + {ok,Value} + catch + error:{badkey,Key} -> + undefined + end; +retrieve(ConnectionHandler, Key) -> + call(ConnectionHandler, {retrieve,Key}). + +%%-------------------------------------------------------------------- %% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . set_sock_opts(ConnectionRef, SocketOptions) -> try lists:foldr(fun({Name,_Val}, Acc) -> @@ -408,13 +446,26 @@ alg(ConnectionHandler) -> %% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . init_connection_handler(Role, Socket, Opts) -> case init([Role, Socket, Opts]) of - {ok, StartState, D} -> + {ok, StartState, D} when Role == server -> process_flag(trap_exit, true), gen_statem:enter_loop(?MODULE, [], %%[{debug,[trace,log,statistics,debug]} ], %% [] StartState, D); + {ok, StartState, D0=#data{connection_state=C}} when Role == client -> + process_flag(trap_exit, true), + Sups = ?GET_INTERNAL_OPT(supervisors, Opts), + D = D0#data{connection_state = + C#connection{system_supervisor = proplists:get_value(system_sup, Sups), + sub_system_supervisor = proplists:get_value(subsystem_sup, Sups), + connection_supervisor = proplists:get_value(connection_sup, Sups) + }}, + gen_statem:enter_loop(?MODULE, + [], %%[{debug,[trace,log,statistics,debug]} ], %% [] + StartState, + D); + {stop, Error} -> D = try %% Only servers have supervisorts defined in Opts @@ -1183,6 +1234,10 @@ handle_event(cast, {unknown,Data}, StateName, D) when ?CONNECTED(StateName) -> Msg = #ssh_msg_unimplemented{sequence = Data}, {keep_state, send_msg(Msg,D)}; +handle_event(cast, {global_request, Type, Data}, StateName, D) when ?CONNECTED(StateName) -> + {keep_state, send_msg(ssh_connection:request_global_msg(Type,false,Data), D)}; + + %%% Previously handle_sync_event began here handle_event({call,From}, get_print_info, StateName, D) -> Reply = @@ -1274,6 +1329,34 @@ handle_event({call,From}, {request, ChannelId, Type, Data, Timeout}, StateName, {keep_state, D, cond_set_idle_timer(D)} end; +handle_event({call,From}, {global_request, "tcpip-forward" = Type, + {ListenHost,ListenPort,ConnectToHost,ConnectToPort}, + Timeout}, StateName, D0) when ?CONNECTED(StateName) -> + Id = make_ref(), + Data = <<?STRING(ListenHost), ?Euint32(ListenPort)>>, + Fun = fun({success, <<Port:32/unsigned-integer>>}, C) -> + Key = {tcpip_forward,ListenHost,Port}, + Value = {ConnectToHost,ConnectToPort}, + C#connection{options = ?PUT_INTERNAL_OPT({Key,Value}, C#connection.options)}; + ({success, <<>>}, C) -> + Key = {tcpip_forward,ListenHost,ListenPort}, + Value = {ConnectToHost,ConnectToPort}, + C#connection{options = ?PUT_INTERNAL_OPT({Key,Value}, C#connection.options)}; + (_, C) -> + C + end, + D = send_msg(ssh_connection:request_global_msg(Type, true, Data), + add_request(Fun, Id, From, D0)), + start_channel_request_timer(Id, From, Timeout), + {keep_state, D, cond_set_idle_timer(D)}; + +handle_event({call,From}, {global_request, Type, Data, Timeout}, StateName, D0) when ?CONNECTED(StateName) -> + Id = make_ref(), + D = send_msg(ssh_connection:request_global_msg(Type, true, Data), + add_request(true, Id, From, D0)), + start_channel_request_timer(Id, From, Timeout), + {keep_state, D, cond_set_idle_timer(D)}; + handle_event({call,From}, {data, ChannelId, Type, Data, Timeout}, StateName, D0) when ?CONNECTED(StateName) -> {Repls,D} = send_replies(ssh_connection:channel_data(ChannelId, Type, Data, D0#data.connection_state, From), @@ -1291,6 +1374,13 @@ handle_event({call,From}, {eof, ChannelId}, StateName, D0) {keep_state, D0, [{reply,From,{error,closed}}]} end; +handle_event({call,From}, get_misc, StateName, + #data{connection_state = #connection{options = Opts}} = D) when ?CONNECTED(StateName) -> + Sups = ?GET_INTERNAL_OPT(supervisors, Opts), + SubSysSup = proplists:get_value(subsystem_sup, Sups), + Reply = {ok, {SubSysSup, role(StateName), Opts}}, + {keep_state, D, [{reply,From,Reply}]}; + handle_event({call,From}, {open, ChannelPid, Type, InitialWindowSize, MaxPacketSize, Data, Timeout}, StateName, @@ -1347,6 +1437,17 @@ handle_event({call,From}, {close, ChannelId}, StateName, D0) {keep_state_and_data, [{reply,From,ok}]} end; +handle_event(cast, {store,Key,Value}, _StateName, #data{connection_state=C0} = D) -> + C = C0#connection{options = ?PUT_INTERNAL_OPT({Key,Value}, C0#connection.options)}, + {keep_state, D#data{connection_state = C}}; + +handle_event({call,From}, {retrieve,Key}, _StateName, #data{connection_state=C}) -> + case retrieve(C, Key) of + {ok,Value} -> + {keep_state_and_data, [{reply,From,{ok,Value}}]}; + _ -> + {keep_state_and_data, [{reply,From,undefined}]} + end; %%===== Reception of encrypted bytes, decryption and framing handle_event(info, {Proto, Sock, Info}, {hello,_}, #data{socket = Sock, @@ -1515,6 +1616,32 @@ handle_event(info, {'EXIT', _Sup, Reason}, StateName, _) -> handle_event(info, check_cache, _, D) -> {keep_state, D, cond_set_idle_timer(D)}; +handle_event(info, {fwd_connect_received, Sock, ChId, ChanCB}, StateName, #data{connection_state = Connection}) -> + #connection{options = Options, + channel_cache = Cache, + sub_system_supervisor = SubSysSup} = Connection, + Channel = ssh_client_channel:cache_lookup(Cache, ChId), + {ok,Pid} = ssh_subsystem_sup:start_channel(role(StateName), SubSysSup, self(), ChanCB, ChId, [Sock], undefined, Options), + ssh_client_channel:cache_update(Cache, Channel#channel{user=Pid}), + gen_tcp:controlling_process(Sock, Pid), + inet:setopts(Sock, [{active,once}]), + keep_state_and_data; + +handle_event({call,From}, + {handle_direct_tcpip, ListenHost, ListenPort, ConnectToHost, ConnectToPort, _Timeout}, + _StateName, + #data{connection_state = #connection{sub_system_supervisor=SubSysSup}}) -> + case ssh_tcpip_forward_acceptor:supervised_start(ssh_subsystem_sup:tcpip_fwd_supervisor(SubSysSup), + {ListenHost, ListenPort}, + {ConnectToHost, ConnectToPort}, + "direct-tcpip", ssh_tcpip_forward_client, + self()) of + {ok,LPort} -> + {keep_state_and_data, [{reply,From,{ok,LPort}}]}; + {error,Error} -> + {keep_state_and_data, [{reply,From,{error,Error}}]} + end; + handle_event(info, UnexpectedMessage, StateName, D = #data{ssh_params = Ssh}) -> case unexpected_fun(UnexpectedMessage, D) of report -> @@ -1705,17 +1832,36 @@ start_the_connection_child(UserPid, Role, Socket, Options0) -> Sups = ?GET_INTERNAL_OPT(supervisors, Options0), ConnectionSup = proplists:get_value(connection_sup, Sups), Options = ?PUT_INTERNAL_OPT({user_pid,UserPid}, Options0), - {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Options]), - ok = socket_control(Socket, Pid, Options), + InitArgs = [Role, Socket, Options], + {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, InitArgs), + ok = socket_control(Socket, Pid, Options), % transfer the Socket ownership in a controlled way. Pid. %%-------------------------------------------------------------------- %% Stopping -stop_subsystem(#data{connection_state = +stop_subsystem(#data{ssh_params = + #ssh{role = Role}, + connection_state = #connection{system_supervisor = SysSup, - sub_system_supervisor = SubSysSup}}) when is_pid(SubSysSup) -> - ssh_system_sup:stop_subsystem(SysSup, SubSysSup); + sub_system_supervisor = SubSysSup} + }) when is_pid(SysSup) andalso is_pid(SubSysSup) -> + process_flag(trap_exit, false), + C = self(), + spawn(fun() -> + Mref = erlang:monitor(process, C), + receive + {'DOWN', Mref, process, C, _Info} -> ok + after + 10000 -> ok + end, + case Role of + client -> + ssh_system_sup:stop_system(Role, SysSup); + _ -> + ssh_system_sup:stop_subsystem(SysSup, SubSysSup) + end + end); stop_subsystem(_) -> ok. @@ -1807,6 +1953,8 @@ call(FsmPid, Event, Timeout) -> exit:{normal, _R} -> {error, closed}; exit:{{shutdown, _R},_} -> + {error, closed}; + exit:{shutdown, _R} -> {error, closed} end. @@ -1941,6 +2089,11 @@ add_request(true, ChannelId, From, #data{connection_state = #connection{requests = Requests0} = Connection} = State) -> Requests = [{ChannelId, From} | Requests0], + State#data{connection_state = Connection#connection{requests = Requests}}; +add_request(Fun, ChannelId, From, #data{connection_state = + #connection{requests = Requests0} = + Connection} = State) when is_function(Fun) -> + Requests = [{ChannelId, From, Fun} | Requests0], State#data{connection_state = Connection#connection{requests = Requests}}. new_channel_id(#data{connection_state = #connection{channel_id_seed = Id} = diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index 510269bbb1..a9034d2085 100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl @@ -24,218 +24,140 @@ -module(ssh_file). --behaviour(ssh_server_key_api). --behaviour(ssh_client_key_api). - -include_lib("public_key/include/public_key.hrl"). -include_lib("kernel/include/file.hrl"). -include("ssh.hrl"). --export([host_key/2, - user_key/2, - is_host_key/4, - add_host_key/3, - is_auth_key/3]). - - --export_type([system_dir_daemon_option/0, - user_dir_common_option/0, - user_dir_fun_common_option/0, - pubkey_passphrase_client_options/0 - ]). - +%%%--------------------- server exports --------------------------- +-behaviour(ssh_server_key_api). +-export([host_key/2, is_auth_key/3]). +-export_type([system_dir_daemon_option/0]). -type system_dir_daemon_option() :: {system_dir, string()}. --type user_dir_common_option() :: {user_dir, string()}. --type user_dir_fun_common_option() :: {user_dir_fun, user2dir()}. --type user2dir() :: fun((RemoteUserName::string()) -> UserDir :: string()) . +%%%--------------------- client exports --------------------------- +-behaviour(ssh_client_key_api). +-export([is_host_key/4, user_key/2, add_host_key/3]). +-export_type([pubkey_passphrase_client_options/0]). -type pubkey_passphrase_client_options() :: {dsa_pass_phrase, string()} | {rsa_pass_phrase, string()} %% Not yet implemented: | {ed25519_pass_phrase, string()} %% Not yet implemented: | {ed448_pass_phrase, string()} | {ecdsa_pass_phrase, string()} . +%%%--------------------- common exports --------------------------- +-export_type([user_dir_common_option/0, + user_dir_fun_common_option/0 + ]). --define(PERM_700, 8#700). --define(PERM_644, 8#644). - +-type user_dir_common_option() :: {user_dir, string()}. +-type user_dir_fun_common_option() :: {user_dir_fun, user2dir()}. +-type user2dir() :: fun((RemoteUserName::string()) -> UserDir :: string()) . +%%%================================================================ +%%% %%% API +%%% -%% Used by server +%%%---------------- SERVER API ------------------------------------ host_key(Algorithm, Opts) -> - File = file_name(system, file_base_name(Algorithm), Opts), - %% We do not expect host keys to have pass phrases - %% so probably we could hardcod Password = ignore, but - %% we keep it as an undocumented option for now. - Password = proplists:get_value(identity_pass_phrase(Algorithm), Opts, ignore), - case decode(File, Password) of - {ok,Key} -> - check_key_type(Key, Algorithm); - {error,DecodeError} -> - {error,DecodeError} - end. - -is_auth_key(Key, User,Opts) -> - case lookup_user_key(Key, User, Opts) of - {ok, Key} -> - true; - _ -> - false - end. + read_ssh_key_file(system, private, Algorithm, Opts). +is_auth_key(Key, User ,Opts) -> + KeyType = erlang:atom_to_binary(ssh_transport:public_algo(Key), latin1), + Dir = ssh_dir({remoteuser,User}, Opts), + lookup_auth_keys(KeyType, Key, filename:join(Dir,"authorized_keys")) + orelse + lookup_auth_keys(KeyType, Key, filename:join(Dir,"authorized_keys2")). -%% Used by client -is_host_key(Key, PeerName, Algorithm, Opts) -> - case lookup_host_key(Key, PeerName, Algorithm, Opts) of - {ok, Key} -> - true; - _ -> - false - end. - +%%%---------------- CLIENT API ------------------------------------ user_key(Algorithm, Opts) -> - File = file_name(user, identity_key_filename(Algorithm), Opts), - Password = proplists:get_value(identity_pass_phrase(Algorithm), Opts, ignore), - case decode(File, Password) of - {ok, Key} -> - check_key_type(Key, Algorithm); - Error -> - Error - end. + read_ssh_key_file(user, private, Algorithm, Opts). - -%% Internal functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -check_key_type(Key, Algorithm) -> - case ssh_transport:valid_key_sha_alg(Key,Algorithm) of - true -> {ok,Key}; - false -> {error,bad_keytype_in_file} - end. - -file_base_name('ssh-rsa' ) -> "ssh_host_rsa_key"; -file_base_name('rsa-sha2-256' ) -> "ssh_host_rsa_key"; -file_base_name('rsa-sha2-384' ) -> "ssh_host_rsa_key"; -file_base_name('rsa-sha2-512' ) -> "ssh_host_rsa_key"; -file_base_name('ssh-dss' ) -> "ssh_host_dsa_key"; -file_base_name('ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key"; -file_base_name('ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key"; -file_base_name('ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key"; -file_base_name('ssh-ed25519' ) -> "ssh_host_ed25519_key"; -file_base_name('ssh-ed448' ) -> "ssh_host_ed448_key"; -file_base_name(_ ) -> "ssh_host_key". - -decode(File, Password) -> - try {ok, decode_ssh_file(read_ssh_file(File), Password)} - catch - throw:Reason -> - {error, Reason}; - error:Reason -> - {error, Reason} - end. - -read_ssh_file(File) -> - {ok, Bin} = file:read_file(File), - Bin. - -%% Public key -decode_ssh_file(SshBin, public_key) -> - public_key:ssh_decode(SshBin, public_key); - -%% Private Key -decode_ssh_file(Pem, Password) -> - case public_key:pem_decode(Pem) of - [{_, _, not_encrypted} = Entry] -> - public_key:pem_entry_decode(Entry); - [Entry] when Password =/= ignore -> - public_key:pem_entry_decode(Entry, Password); - _ -> - throw("No pass phrase provided for private key file") - end. - - -%% lookup_host_key -%% return {ok, Key(s)} or {error, not_found} -%% - -lookup_host_key(KeyToMatch, Host, Alg, Opts) -> - Host1 = replace_localhost(Host), - do_lookup_host_key(KeyToMatch, Host1, Alg, Opts). - +is_host_key(Key, PeerName, Algorithm, Opts) -> + KeyType = erlang:atom_to_binary(Algorithm, latin1), + Hosts = binary:split(list_to_binary(replace_localhost(PeerName)), + <<",">>, [global]), % make a list of hosts + Dir = ssh_dir(user, Opts), + lookup_host_keys(Hosts, KeyType, Key, filename:join(Dir,"known_hosts")). add_host_key(Host, Key, Opts) -> Host1 = add_ip(replace_localhost(Host)), KnownHosts = file_name(user, "known_hosts", Opts), case file:open(KnownHosts, [write,append]) of - {ok, Fd} -> - ok = file:change_mode(KnownHosts, ?PERM_644), - Res = add_key_fd(Fd, Host1, Key), - file:close(Fd), - Res; - Error -> - Error - end. - -lookup_user_key(Key, User, Opts) -> - SshDir = ssh_dir({remoteuser,User}, Opts), - case lookup_user_key_f(Key, User, SshDir, "authorized_keys", Opts) of - {ok, Key} -> - {ok, Key}; - _ -> - lookup_user_key_f(Key, User, SshDir, "authorized_keys2", Opts) + {ok, Fd} -> + ok = file:change_mode(KnownHosts, 8#644), + KeyType = erlang:atom_to_binary(ssh_transport:public_algo(Key), latin1), + EncKey = ssh_message:ssh2_pubkey_encode(Key), + SshBin = + iolist_to_binary([Host1, " ", + KeyType," ",base64:encode(iolist_to_binary(EncKey)), + "\n"]), + Res = file:write(Fd, SshBin), + file:close(Fd), + Res; + Error -> + Error end. +%%%================================================================ +%%% +%%% Local functions +%%% -%% -%% Utils -%% +%%%---------------- SERVER FUNCTIONS ------------------------------ -%% server use this to find individual keys for -%% an individual user when user tries to login -%% with publickey -ssh_dir({remoteuser, User}, Opts) -> - case proplists:get_value(user_dir_fun, Opts) of - undefined -> - case proplists:get_value(user_dir, Opts, false) of - false -> - default_user_dir(); - Dir -> - Dir - end; - FUN -> - FUN(User) - end; +lookup_auth_keys(KeyType, Key, File) -> + case file:read_file(File) of + {ok,Bin} -> + Lines = binary:split(Bin, <<"\n">>, [global,trim_all]), + find_key(KeyType, Key, Lines); + _ -> + false + end. -%% client use this to find client ssh keys -ssh_dir(user, Opts) -> - case proplists:get_value(user_dir, Opts, false) of - false -> default_user_dir(); - D -> D +find_key(KeyType, Key, [Line|Lines]) -> + case find_key_in_line(KeyType, Key, binary:split(Line, <<" ">>, [global,trim_all])) of + true -> + true; + false -> + find_key(KeyType, Key, Lines) end; +find_key(_, _, _) -> + false. -%% server use this to find server host keys -ssh_dir(system, Opts) -> - proplists:get_value(system_dir, Opts, "/etc/ssh"). - - -file_name(Type, Name, Opts) -> - FN = filename:join(ssh_dir(Type, Opts), Name), - FN. + +find_key_in_line(_KeyType, _Key, [<<"#",_/binary>> |_]) -> + false; +find_key_in_line(KeyType, Key, [KeyType, Base64EncodedKey, _Comment]) -> + %% Right KeyType. Try to decode to see if it matches + Key == decode_key(Base64EncodedKey); +find_key_in_line(KeyType, Key, [_Option | [_,_,_|_]=Rest]) -> + %% Dont care for options + find_key_in_line(KeyType, Key, Rest); +find_key_in_line(_, _, _) -> + false. +decode_key(Base64EncodedKey) -> + ssh_message:ssh2_pubkey_decode( + base64:mime_decode(Base64EncodedKey)). +%%%---------------- CLIENT FUNCTIONS ------------------------------ +%%%-------------------------------- %% in: "host" out: "host,1.2.3.4. add_ip(IP) when is_tuple(IP) -> ssh_connection:encode_ip(IP); -add_ip(Host) -> +add_ip(Host) -> case inet:getaddr(Host, inet) of {ok, Addr} -> case ssh_connection:encode_ip(Addr) of false -> Host; + Host -> Host; IPString -> Host ++ "," ++ IPString end; _ -> Host - end. + end. replace_localhost("localhost") -> {ok, Hostname} = inet:gethostname(), @@ -243,142 +165,203 @@ replace_localhost("localhost") -> replace_localhost(Host) -> Host. -do_lookup_host_key(KeyToMatch, Host, Alg, Opts) -> - case file:open(file_name(user, "known_hosts", Opts), [read, binary]) of - {ok, Fd} -> - Res = lookup_host_key_fd(Fd, KeyToMatch, Host, Alg), - file:close(Fd), - Res; - {error, enoent} -> - {error, not_found}; - Error -> - Error - end. - -identity_key_filename('ssh-dss' ) -> "id_dsa"; -identity_key_filename('ssh-rsa' ) -> "id_rsa"; -identity_key_filename('rsa-sha2-256' ) -> "id_rsa"; -identity_key_filename('rsa-sha2-384' ) -> "id_rsa"; -identity_key_filename('rsa-sha2-512' ) -> "id_rsa"; -identity_key_filename('ssh-ed25519' ) -> "id_ed25519"; -identity_key_filename('ssh-ed448' ) -> "id_ed448"; -identity_key_filename('ecdsa-sha2-nistp256') -> "id_ecdsa"; -identity_key_filename('ecdsa-sha2-nistp384') -> "id_ecdsa"; -identity_key_filename('ecdsa-sha2-nistp521') -> "id_ecdsa". - -identity_pass_phrase("ssh-dss" ) -> dsa_pass_phrase; -identity_pass_phrase("ssh-rsa" ) -> rsa_pass_phrase; -identity_pass_phrase("rsa-sha2-256" ) -> rsa_pass_phrase; -identity_pass_phrase("rsa-sha2-384" ) -> rsa_pass_phrase; -identity_pass_phrase("rsa-sha2-512" ) -> rsa_pass_phrase; -%% Not yet implemented: identity_pass_phrase("ssh-ed25519" ) -> ed25519_pass_phrase; -%% Not yet implemented: identity_pass_phrase("ssh-ed448" ) -> ed448_pass_phrase; -identity_pass_phrase("ecdsa-sha2-"++_) -> ecdsa_pass_phrase; -identity_pass_phrase(P) when is_atom(P) -> - identity_pass_phrase(atom_to_list(P)); -identity_pass_phrase(_) -> undefined. - -lookup_host_key_fd(Fd, KeyToMatch, Host, KeyType) -> - case io:get_line(Fd, '') of - eof -> - {error, not_found}; - {error,Error} -> - %% Rare... For example NFS errors - {error,Error}; - Line -> - case ssh_decode_line(Line, known_hosts) of - [{Key, Attributes}] -> - handle_host(Fd, KeyToMatch, Host, proplists:get_value(hostnames, Attributes), Key, KeyType); - [] -> - lookup_host_key_fd(Fd, KeyToMatch, Host, KeyType) - end +%%%-------------------------------- +lookup_host_keys(Hosts, KeyType, Key, File) -> + case file:read_file(File) of + {ok,Bin} -> + Lines = binary:split(Bin, <<"\n">>, [global,trim_all]), + find_key(Hosts, KeyType, Key, Lines); + _ -> + false end. -ssh_decode_line(Line, Type) -> - try - public_key:ssh_decode(Line, Type) - catch _:_ -> - [] - end. +find_key(Hosts, KeyType, Key, [Line|Lines]) -> + case find_key_in_line(Hosts, KeyType, Key, binary:split(Line, <<" ">>, [global,trim_all])) of + true -> + true; + false -> + find_key(Hosts, KeyType, Key, Lines) + end; +find_key(_, _, _, _) -> + false. -handle_host(Fd, KeyToMatch, Host, HostList, Key, KeyType) -> - Host1 = host_name(Host), - case lists:member(Host1, HostList) andalso key_match(Key, KeyType) of - true when KeyToMatch == Key -> - {ok,Key}; - _ -> - lookup_host_key_fd(Fd, KeyToMatch, Host, KeyType) - end. -host_name(Atom) when is_atom(Atom) -> - atom_to_list(Atom); -host_name(List) -> - List. - -key_match(#'RSAPublicKey'{}, 'ssh-rsa') -> - true; -key_match({_, #'Dss-Parms'{}}, 'ssh-dss') -> - true; -key_match({#'ECPoint'{},{namedCurve,Curve}}, Alg) -> - case atom_to_list(Alg) of - "ecdsa-sha2-"++IdS -> - Curve == public_key:ssh_curvename2oid(list_to_binary(IdS)); - _ -> - false - end; -key_match({ed_pub,ed25519,_}, 'ssh-ed25519') -> - true; -key_match({ed_pub,ed448,_}, 'ssh-ed448') -> - true; -key_match(_, _) -> +find_key_in_line(_Hosts, _KeyType, _Key, [<<"#",_/binary>> |_]) -> + false; +find_key_in_line(Hosts, KeyType, Key, [Patterns, KeyType, Base64EncodedKey, _Comment]) -> + host_match(Hosts, Patterns) andalso + Key == decode_key(Base64EncodedKey); +find_key_in_line(Hosts, KeyType, Key, [Patterns, KeyType, Base64EncodedKey]) -> + host_match(Hosts, Patterns) andalso + Key == decode_key(Base64EncodedKey); +find_key_in_line(Hosts, KeyType, Key, [_Option | [_,_,_|_]=Rest]) -> + %% Dont care for options + find_key_in_line(Hosts, KeyType, Key, Rest); +find_key_in_line(_, _, _, _) -> false. -add_key_fd(Fd, Host,Key) -> - SshBin = public_key:ssh_encode([{Key, [{hostnames, [Host]}]}], known_hosts), - file:write(Fd, SshBin). - -lookup_user_key_f(_, _User, [], _F, _Opts) -> - {error, nouserdir}; -lookup_user_key_f(_, _User, nouserdir, _F, _Opts) -> - {error, nouserdir}; -lookup_user_key_f(Key, _User, Dir, F, _Opts) -> - FileName = filename:join(Dir, F), - case file:open(FileName, [read, binary]) of - {ok, Fd} -> - Res = lookup_user_key_fd(Fd, Key), - file:close(Fd), - Res; - {error, Reason} -> - {error, {{openerr, Reason}, {file, FileName}}} + +host_match(Hosts, PatternsBin) -> + Patterns = binary:split(PatternsBin, <<",">>, [global]), + lists:any(fun(Pat) -> + lists:any(fun(Hst) -> + Pat == Hst + end, Hosts) + end, Patterns). + +%%%---------------- COMMON FUNCTIONS ------------------------------ + +read_ssh_key_file(Role, PrivPub, Algorithm, Opts) -> + File = file_name(Role, file_base_name(Role,Algorithm), Opts), + Password = %% Pwd for Host Keys is an undocumented option and should not be used + proplists:get_value(identity_pass_phrase(Algorithm), Opts, ignore), + + case file:read_file(File) of + {ok, Pem} -> + try + decode_ssh_file(PrivPub, Algorithm, Pem, Password) + catch + throw:Reason -> + {error, Reason}; + error:Reason -> + {error, Reason} + end; + + {error, Reason} -> + {error, Reason} end. -lookup_user_key_fd(Fd, Key) -> - case io:get_line(Fd, '') of - eof -> - {error, not_found}; - {error,Error} -> - %% Rare... For example NFS errors - {error,Error}; - Line -> - case ssh_decode_line(Line, auth_keys) of - [{AuthKey, _}] -> - case is_auth_key(Key, AuthKey) of - true -> - {ok, Key}; - false -> - lookup_user_key_fd(Fd, Key) - end; - [] -> - lookup_user_key_fd(Fd, Key) - end + +decode_ssh_file(PrivPub, Algorithm, Pem, Password) -> + %% Private Key + try get_key_part(Pem) of + {'openssh-key-v1', Bin, _KeyValues} -> + %% Holds both public and private keys + KeyPairs = new_openssh_decode(Bin, Password), + ValidKeys = + [Key || {Pub,Priv} <- KeyPairs, + Key <- [Pub,Priv], + ssh_transport:valid_key_sha_alg(PrivPub, Key, Algorithm)], + %% Select one (for now, just pick the first found): + case ValidKeys of + [Key|_] -> {ok,Key}; + [] -> {error,bad_keytype_in_file} + end; + + {rfc4716, Bin, _KeyValues} -> + %% rfc4716 only defines public keys + Key = ssh_message:ssh2_pubkey_decode(Bin), + case ssh_transport:valid_key_sha_alg(PrivPub, Key, Algorithm) of + true -> {ok,Key}; + false -> {error,bad_keytype_in_file} + end; + + {Type, Bin, KeyValues} -> + Key = + case get_encrypt_hdrs(KeyValues) of + not_encrypted -> + public_key:pem_entry_decode({Type,Bin,not_encrypted}); + [Cipher,Salt] when is_binary(Cipher), + is_binary(Salt), + Password =/= ignore -> + CryptInfo = + {binary_to_list(Cipher), unhex(binary_to_list(Salt))}, + public_key:pem_entry_decode({Type,Bin,CryptInfo}, Password); + _X -> + throw("No pass phrase provided for private key file") + end, + case ssh_transport:valid_key_sha_alg(PrivPub, Key, Algorithm) of + true -> {ok,Key}; + false -> {error,bad_keytype_in_file} + end + catch + _:_ -> error(bad_or_unsupported_key_format) end. -is_auth_key(Key, Key) -> - true; -is_auth_key(_,_) -> - false. +get_encrypt_hdrs(KVs) -> + lists:foldl(fun({<<"Proc-Type">>, <<"4,ENCRYPTED", _/binary>>}, _Acc) -> + {proc_type, <<"4,ENCRYPTED">>}; + ({<<"DEK-Info">>, DEKinfo}, {proc_type,_}) -> + binary:split(DEKinfo, <<",">>); + (_, Acc) -> + Acc + end, not_encrypted, KVs). + +unhex(S) -> + %% I would like to do erlang:list_to_integer(S,16), but that does not fit + %% the public_key:pem_entry_decode API + list_to_binary( + lists:foldr(fun(D2, {D1,Acc}) -> + [erlang:list_to_integer([D2,D1], 16) | Acc]; % sic! + (D1, Acc) when is_list(Acc) -> + {D1,Acc} + end, [], S)). + +file_base_name(user, 'ecdsa-sha2-nistp256') -> "id_ecdsa"; +file_base_name(user, 'ecdsa-sha2-nistp384') -> "id_ecdsa"; +file_base_name(user, 'ecdsa-sha2-nistp521') -> "id_ecdsa"; +file_base_name(user, 'rsa-sha2-256' ) -> "id_rsa"; +file_base_name(user, 'rsa-sha2-384' ) -> "id_rsa"; +file_base_name(user, 'rsa-sha2-512' ) -> "id_rsa"; +file_base_name(user, 'ssh-dss' ) -> "id_dsa"; +file_base_name(user, 'ssh-ed25519' ) -> "id_ed25519"; +file_base_name(user, 'ssh-ed448' ) -> "id_ed448"; +file_base_name(user, 'ssh-rsa' ) -> "id_rsa"; +file_base_name(system, 'ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key"; +file_base_name(system, 'ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key"; +file_base_name(system, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key"; +file_base_name(system, 'rsa-sha2-256' ) -> "ssh_host_rsa_key"; +file_base_name(system, 'rsa-sha2-384' ) -> "ssh_host_rsa_key"; +file_base_name(system, 'rsa-sha2-512' ) -> "ssh_host_rsa_key"; +file_base_name(system, 'ssh-dss' ) -> "ssh_host_dsa_key"; +file_base_name(system, 'ssh-ed25519' ) -> "ssh_host_ed25519_key"; +file_base_name(system, 'ssh-ed448' ) -> "ssh_host_ed448_key"; +file_base_name(system, 'ssh-rsa' ) -> "ssh_host_rsa_key"; +file_base_name(system, _ ) -> "ssh_host_key". + + +identity_pass_phrase('ssh-dss' ) -> dsa_pass_phrase; +identity_pass_phrase('ssh-rsa' ) -> rsa_pass_phrase; +identity_pass_phrase('rsa-sha2-256' ) -> rsa_pass_phrase; +identity_pass_phrase('rsa-sha2-384' ) -> rsa_pass_phrase; +identity_pass_phrase('rsa-sha2-512' ) -> rsa_pass_phrase; +identity_pass_phrase('ecdsa-sha2-nistp256') -> ecdsa_pass_phrase; +identity_pass_phrase('ecdsa-sha2-nistp384') -> ecdsa_pass_phrase; +identity_pass_phrase('ecdsa-sha2-nistp521') -> ecdsa_pass_phrase; +%% Not yet implemented: identity_pass_phrase('ssh-ed25519' ) -> ed25519_pass_phrase; +%% Not yet implemented: identity_pass_phrase('ssh-ed448' ) -> ed448_pass_phrase; +identity_pass_phrase(_) -> undefined. + +%%%---------------------------------------------------------------- +file_name(Type, Name, Opts) -> + filename:join(ssh_dir(Type, Opts), Name). + + +%%%-------------------------------- +ssh_dir({remoteuser, User}, Opts) -> + %% server use this to find individual keys for an individual + %% user when user tries to login with publickey + case proplists:get_value(user_dir_fun, Opts) of + undefined -> + %% Try the local user instead + ssh_dir(user, Opts); + FUN -> + FUN(User) + end; +ssh_dir(user, Opts) -> + %% client use this to find client ssh keys + case proplists:get_value(user_dir, Opts, false) of + false -> default_user_dir(); + D -> D + end; + +ssh_dir(system, Opts) -> + %% server use this to find server host keys + proplists:get_value(system_dir, Opts, "/etc/ssh"). + +%%%-------------------------------- default_user_dir() -> try default_user_dir(os:getenv("HOME")) @@ -395,9 +378,138 @@ default_user_dir(Home) when is_list(Home) -> {ok,Info} = file:read_file_info(UserDir), #file_info{mode=Mode} = Info, case (Mode band 8#777) of - ?PERM_700 -> + 8#700 -> ok; _Other -> - ok = file:change_mode(UserDir, ?PERM_700) + ok = file:change_mode(UserDir, 8#700) end, UserDir. + +%%%################################################################ +get_key_part(RawBin) when is_binary(RawBin) -> + case binary:split( + binary:replace(RawBin, <<"\\\n">>, <<"">>, [global]), + <<"\n">>, [global,trim_all]) + of + [<<"---- BEGIN SSH2 PUBLIC KEY ----">> | Lines0] -> + %% RFC 4716 format + {KeyValues,Lines} = get_hdr_lines(Lines0, []), + ExpectedEndLine = <<"---- END SSH2 PUBLIC KEY ----">>, + {rfc4716, get_body(Lines,ExpectedEndLine), KeyValues}; + + [<<"-----BEGIN ", Rest/binary>> | Lines0] -> + %% PEM format + ExpectedEndLine = <<"-----END ",Rest/binary>>, + [MiddlePart, <<>>] = binary:split(Rest, <<" KEY-----">>), + {KeyValues,Lines} = get_hdr_lines(Lines0, []), + {asn1_type(MiddlePart), get_body(Lines,ExpectedEndLine), KeyValues} + end. + + +get_hdr_lines(Lines, Acc) -> + Line1 = hd(Lines), + case binary:split(Line1, <<":">>) of + [Line1] -> + {lists:reverse(Acc), Lines}; + [Key,Value] -> + get_hdr_lines(tl(Lines), [{trim(Key),trim(Value)}|Acc]) + end. + + +get_body(Lines, ExpectedEndLine) -> + {KeyPart, [ExpectedEndLine]} = lists:split(length(Lines)-1, Lines), + base64:mime_decode(iolist_to_binary(KeyPart)). + +trim(<<" ",B/binary>>) -> trim(B); +trim(B) -> B. + +asn1_type(<<"RSA PRIVATE">>) -> 'RSAPrivateKey'; +asn1_type(<<"RSA PUBLIC">>) -> 'RSAPublicKey'; +asn1_type(<<"DSA PRIVATE">>) -> 'DSAPrivateKey'; +asn1_type(<<"EC PRIVATE">>) -> 'ECPrivateKey'; +asn1_type(<<"OPENSSH PRIVATE">>) -> 'openssh-key-v1'; +asn1_type(_) -> undefined. + +%%%================================================================ +%%% From https://github.com/openssh/openssh-portable/blob/master/PROTOCOL.key +%%% + +-define(NON_CRYPT_BLOCKSIZE, 8). + +new_openssh_decode(<<"openssh-key-v1",0, + ?DEC_BIN(CipherName, _L1), + ?DEC_BIN(KdfName, _L2), + ?DEC_BIN(KdfOptions, _L3), + ?UINT32(N), % number of keys + Rest/binary + >>, Pwd) -> + new_openssh_decode(Rest, N, Pwd, CipherName, KdfName, KdfOptions, N, []). + + +new_openssh_decode(<<?DEC_BIN(BinKey,_L1), Rest/binary>>, I, Pwd, CipherName, KdfName, KdfOptions, N, PubKeyAcc) when I>0 -> + PublicKey = ssh_message:ssh2_pubkey_decode(BinKey), + new_openssh_decode(Rest, I-1, Pwd, CipherName, KdfName, KdfOptions, N, [PublicKey|PubKeyAcc]); + +new_openssh_decode(<<?DEC_BIN(Encrypted,_L)>>, + 0, Pwd, CipherName, KdfName, KdfOptions, N, PubKeyAccRev) -> + PubKeys = lists:reverse(PubKeyAccRev), + try + Plain = decrypt_new_openssh(Encrypted, KdfName, KdfOptions, CipherName, Pwd), + new_openssh_decode_priv_keys(Plain, N, N, [], []) + of + {PrivKeys, _Comments} -> + lists:map(fun({ {ed_pub,A,Pub}, {ed_pri,A,Pub,Pri0} }) -> + Pri = binary:part(Pri0, {0,size(Pri0)-size(Pub)}), + {{ed_pub,A,Pub}, {ed_pri,A,Pub,Pri}}; + (Pair) -> + Pair + end, lists:zip(PubKeys, PrivKeys)) + catch + error:{decryption, DecryptError} -> + error({decryption, DecryptError}) + end. + + +new_openssh_decode_priv_keys(Bin, I, N, KeyAcc, CmntAcc) when I>0 -> + {PrivKey, <<?DEC_BIN(Comment,_Lc),Rest/binary>>} = ssh_message:ssh2_privkey_decode2(Bin), + new_openssh_decode_priv_keys(Rest, I-1, N, [PrivKey|KeyAcc], [Comment|CmntAcc]); +new_openssh_decode_priv_keys(_Padding, 0, _N, PrivKeyAccRev, CommentAccRev) -> + {lists:reverse(PrivKeyAccRev), + lists:reverse(CommentAccRev)}. + + +decrypt_new_openssh(Encrypted, <<"none">>, <<>>, _CipherName, _Pwd) -> + check_valid_decryption(Encrypted, ?NON_CRYPT_BLOCKSIZE); +decrypt_new_openssh(Encrypted, <<>>, <<>>, _CipherName, _Pwd) -> + check_valid_decryption(Encrypted, ?NON_CRYPT_BLOCKSIZE); +decrypt_new_openssh(_Encrypted, <<"bcrypt">>, <<?DEC_BIN(_Salt,_L),?UINT32(_Rounds)>>, _CipherName, _Pwd) -> + error({decryption, {not_supported,bcrypt}}); +decrypt_new_openssh(_Encrypted, KdfName, _KdfOpts, _CipherName, _Pwd) -> + error({decryption, {not_supported,KdfName}}). + + +check_valid_decryption(<<?UINT32(Checkint1),?UINT32(Checkint2),Plain/binary>>, BlockSize) when Checkint2==Checkint1 -> + case check_padding(Plain, BlockSize) of + true -> + Plain; + false -> + error({decryption,bad_padding}) + end; +check_valid_decryption(_, _) -> + error({decryption,bad_result}). + + +check_padding(Bin, BlockSize) -> + N = binary:last(Bin), + if + N < BlockSize -> + %% Check that Bin is <<...,1,2,...,N>> + Padding = binary:part(Bin, {byte_size(Bin),-N}), + ExpectedPadding = list_to_binary(lists:seq(1,N)), % <<1,2,...,N>> + Padding == ExpectedPadding; + true -> + true + end. + +%%%================================================================ +%%% diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl index 79cd95e422..91365205aa 100644 --- a/lib/ssh/src/ssh_info.erl +++ b/lib/ssh/src/ssh_info.erl @@ -79,8 +79,8 @@ print_clients() -> lists:map(fun print_client/1, supervisor:which_children(sshc_sup)) catch - C:E -> - io_lib:format('***print_clients FAILED: ~p:~p~n',[C,E]) + C:E:S -> + io_lib:format('***print_clients FAILED: ~p:~p,~n ~p~n',[C,E,S]) end. print_client({undefined,Pid,supervisor,[ssh_connection_handler]}) -> @@ -94,9 +94,9 @@ print_client({undefined,Pid,supervisor,[ssh_connection_handler]}) -> io_lib:format(?INDENT?INDENT?INDENT"No channels~n",[]) end]; -print_client(Other) -> - io_lib:format(" [[Other 1: ~p]]~n",[Other]). - +print_client({{client,ssh_system_sup,_,_,_},Pid,supervisor,[ssh_system_sup]}) when is_pid(Pid) -> + lists:map(fun print_system_sup/1, + supervisor:which_children(Pid)). %%%================================================================ print_servers() -> @@ -104,8 +104,8 @@ print_servers() -> lists:map(fun print_server/1, supervisor:which_children(sshd_sup)) catch - C:E -> - io_lib:format('***print_servers FAILED: ~p:~p~n',[C,E]) + C:E:S -> + io_lib:format('***print_servers FAILED: ~p:~p,~n ~p~n',[C,E,S]) end. @@ -140,22 +140,33 @@ print_system_sup({{ssh_acceptor_sup,_LocalHost,_LocalPort,_Profile}, Pid, superv -print_channels({{server,ssh_server_channel_sup,_,_},Pid,supervisor,[ssh_server_channel_sup]}) when is_pid(Pid) -> +print_channels({{Role,ssh_channel_sup,_,_},Pid,supervisor,[ssh_channel_sup]}) when is_pid(Pid) -> + ChanBehaviour = + case Role of + server -> ssh_server_channel; + client -> ssh_client_channel + end, Children = supervisor:which_children(Pid), - ChannelPids = [P || {R,P,worker,[ssh_server_channel]} <- Children, + ChannelPids = [P || {R,P,worker,[Mod]} <- Children, + ChanBehaviour == Mod, is_pid(P), is_reference(R)], case ChannelPids of [] -> io_lib:format(?INDENT?INDENT"No channels~n",[]); [Ch1Pid|_] -> - {{ConnManager,_}, _Str} = ssh_server_channel:get_print_info(Ch1Pid), + {{ConnManager,_}, _Str} = ChanBehaviour:get_print_info(Ch1Pid), {{_,Remote},_} = ssh_connection_handler:get_print_info(ConnManager), [io_lib:format(?INDENT?INDENT"Remote: ~s ConnectionRef = ~p~n",[fmt_host_port(Remote),ConnManager]), lists:map(fun print_ch/1, ChannelPids) ] end; -print_channels({{server,ssh_connection_sup,_,_},Pid,supervisor,[ssh_connection_sup]}) when is_pid(Pid) -> - []. % The supervisor of the connections socket owning process +print_channels({{_Role,ssh_connection_sup,_,_},Pid,supervisor,[ssh_connection_sup]}) when is_pid(Pid) -> + []; % The supervisor of the connections socket owning process + +print_channels({Ref,Pid,supervisor,[ssh_tcpip_forward_acceptor_sup]}) when is_pid(Pid), + is_reference(Ref) -> + []. % The supervisor of the forward_acceptor process + print_ch(Pid) -> try diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index 47cbec1513..81c2e00018 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -31,6 +31,9 @@ -include("ssh_transport.hrl"). -export([encode/1, decode/1, decode_keyboard_interactive_prompts/2]). +-export([ssh2_pubkey_decode/1, + ssh2_pubkey_encode/1, + ssh2_privkey_decode2/1]). -behaviour(ssh_dbg). -export([ssh_dbg_trace_points/0, ssh_dbg_flags/1, ssh_dbg_on/1, ssh_dbg_off/1, ssh_dbg_format/2]). @@ -46,6 +49,11 @@ ucl(B) -> -define(unicode_list(B), ucl(B)). +%%%================================================================ +%%% +%%% Encode/decode messages +%%% + encode(#ssh_msg_global_request{ name = Name, want_reply = Bool, @@ -242,7 +250,7 @@ encode(#ssh_msg_kexdh_reply{ f = F, h_sig = Signature }) -> - EncKey = public_key:ssh_encode(Key, ssh2_pubkey), + EncKey = ssh2_pubkey_encode(Key), EncSign = encode_signature(Key, SigAlg, Signature), <<?Ebyte(?SSH_MSG_KEXDH_REPLY), ?Ebinary(EncKey), ?Empint(F), ?Ebinary(EncSign)>>; @@ -268,7 +276,7 @@ encode(#ssh_msg_kex_dh_gex_reply{ f = F, h_sig = Signature }) -> - EncKey = public_key:ssh_encode(Key, ssh2_pubkey), + EncKey = ssh2_pubkey_encode(Key), EncSign = encode_signature(Key, SigAlg, Signature), <<?Ebyte(?SSH_MSG_KEX_DH_GEX_REPLY), ?Ebinary(EncKey), ?Empint(F), ?Ebinary(EncSign)>>; @@ -276,7 +284,7 @@ encode(#ssh_msg_kex_ecdh_init{q_c = Q_c}) -> <<?Ebyte(?SSH_MSG_KEX_ECDH_INIT), ?Ebinary(Q_c)>>; encode(#ssh_msg_kex_ecdh_reply{public_host_key = {Key,SigAlg}, q_s = Q_s, h_sig = Sign}) -> - EncKey = public_key:ssh_encode(Key, ssh2_pubkey), + EncKey = ssh2_pubkey_encode(Key), EncSign = encode_signature(Key, SigAlg, Sign), <<?Ebyte(?SSH_MSG_KEX_ECDH_REPLY), ?Ebinary(EncKey), ?Ebinary(Q_s), ?Ebinary(EncSign)>>; @@ -453,7 +461,7 @@ decode(<<"dh",?BYTE(?SSH_MSG_KEXDH_INIT), ?DEC_MPINT(E,__0)>>) -> decode(<<"dh", ?BYTE(?SSH_MSG_KEXDH_REPLY), ?DEC_BIN(Key,__0), ?DEC_MPINT(F,__1), ?DEC_BIN(Hashsign,__2)>>) -> #ssh_msg_kexdh_reply{ - public_host_key = public_key:ssh_decode(Key, ssh2_pubkey), + public_host_key = ssh2_pubkey_decode(Key), f = F, h_sig = decode_signature(Hashsign) }; @@ -483,7 +491,7 @@ decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_INIT), ?DEC_MPINT(E,__0)>>) -> decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_REPLY), ?DEC_BIN(Key,__0), ?DEC_MPINT(F,__1), ?DEC_BIN(Hashsign,__2)>>) -> #ssh_msg_kex_dh_gex_reply{ - public_host_key = public_key:ssh_decode(Key, ssh2_pubkey), + public_host_key = ssh2_pubkey_decode(Key), f = F, h_sig = decode_signature(Hashsign) }; @@ -496,7 +504,7 @@ decode(<<"ecdh",?BYTE(?SSH_MSG_KEX_ECDH_INIT), ?DEC_BIN(Q_c,__0)>>) -> decode(<<"ecdh",?BYTE(?SSH_MSG_KEX_ECDH_REPLY), ?DEC_BIN(Key,__1), ?DEC_BIN(Q_s,__2), ?DEC_BIN(Sig,__3)>>) -> #ssh_msg_kex_ecdh_reply{ - public_host_key = public_key:ssh_decode(Key, ssh2_pubkey), + public_host_key = ssh2_pubkey_decode(Key), q_s = Q_s, h_sig = decode_signature(Sig) }; @@ -540,6 +548,132 @@ decode(<<?BYTE(?SSH_MSG_DEBUG), ?BYTE(Bool), ?DEC_BIN(Msg,__0), ?DEC_BIN(Lang,__ message = Msg, language = Lang}. + +%%%================================================================ +%%% +%%% Encode/decode ssh public/private keys +%%% + +%%%-------- public key -------- +ssh2_pubkey_encode(#'RSAPublicKey'{modulus = N, publicExponent = E}) -> + <<?STRING(<<"ssh-rsa">>), ?Empint(E), ?Empint(N)>>; +ssh2_pubkey_encode({Y, #'Dss-Parms'{p = P, q = Q, g = G}}) -> + <<?STRING(<<"ssh-dss">>), ?Empint(P), ?Empint(Q), ?Empint(G), ?Empint(Y)>>; +ssh2_pubkey_encode({#'ECPoint'{point = Q}, {namedCurve,OID}}) -> + Curve = public_key:oid2ssh_curvename(OID), + KeyType = <<"ecdsa-sha2-", Curve/binary>>, + <<?STRING(KeyType), ?STRING(Curve), ?Estring(Q)>>; +ssh2_pubkey_encode({ed_pub, ed25519, Key}) -> + <<?STRING(<<"ssh-ed25519">>), ?Estring(Key)>>; +ssh2_pubkey_encode({ed_pub, ed448, Key}) -> + <<?STRING(<<"ssh-ed448">>), ?Estring(Key)>>. + +%%%-------- +ssh2_pubkey_decode(KeyBlob) -> + {Key,_RestBlob} = ssh2_pubkey_decode2(KeyBlob), + Key. + +ssh2_pubkey_decode2(<<?UINT32(7), "ssh-rsa", + ?DEC_INT(E, _EL), + ?DEC_INT(N, _NL), + Rest/binary>>) -> + {#'RSAPublicKey'{modulus = N, + publicExponent = E + }, Rest}; +ssh2_pubkey_decode2(<<?UINT32(7), "ssh-dss", + ?DEC_INT(P, _PL), + ?DEC_INT(Q, _QL), + ?DEC_INT(G, _GL), + ?DEC_INT(Y, _YL), + Rest/binary>>) -> + {{Y, #'Dss-Parms'{p = P, + q = Q, + g = G} + }, Rest}; +ssh2_pubkey_decode2(<<?UINT32(TL), "ecdsa-sha2-",KeyRest/binary>>) -> + Sz = TL-11, + <<_Curve:Sz/binary, + ?DEC_BIN(SshName, _IL), + ?DEC_BIN(Q, _QL), + Rest/binary>> = KeyRest, + OID = public_key:ssh_curvename2oid(SshName), + {{#'ECPoint'{point = Q}, {namedCurve,OID} + }, Rest}; +ssh2_pubkey_decode2(<<?UINT32(11), "ssh-ed25519", + ?DEC_BIN(Key, _L), + Rest/binary>>) -> + {{ed_pub, ed25519, Key}, + Rest}; +ssh2_pubkey_decode2(<<?UINT32(9), "ssh-ed448", + ?DEC_BIN(Key, _L), + Rest/binary>>) -> + {{ed_pub, ed448, Key}, + Rest}. + +%%%-------- private key -------- + +%% dialyser... ssh2_privkey_decode(KeyBlob) -> +%% dialyser... {Key,_RestBlob} = ssh2_privkey_decode2(KeyBlob), +%% dialyser... Key. + +%% See sshkey_private_serialize_opt in sshkey.c +ssh2_privkey_decode2(<<?UINT32(7), "ssh-rsa", + ?DEC_INT(N, _NL), % Yes, N and E is reversed relative pubkey format + ?DEC_INT(E, _EL), % --"-- + ?DEC_INT(D, _DL), + ?DEC_INT(IQMP, _IQMPL), + ?DEC_INT(P, _PL), + ?DEC_INT(Q, _QL), + Rest/binary>>) -> + {#'RSAPrivateKey'{version = 'two-prime', % Found this in public_key:generate_key/1 .. + modulus = N, + publicExponent = E, + privateExponent = D, + prime1 = P, + prime2 = Q, + %exponent1, % D_mod_P_1 + %exponent2, % D_mod_Q_1 + coefficient = IQMP + }, Rest}; +ssh2_privkey_decode2(<<?UINT32(7), "ssh-dss", + ?DEC_INT(P, _PL), + ?DEC_INT(Q, _QL), + ?DEC_INT(G, _GL), + ?DEC_INT(Y, _YL), % Publ key + ?DEC_INT(X, _XL), % Priv key + Rest/binary>>) -> + {#'DSAPrivateKey'{version = 0, + p = P, + q = Q, + g = G, + y = Y, + x = X + }, Rest}; +ssh2_privkey_decode2(<<?UINT32(TL), "ecdsa-sha2-",KeyRest/binary>>) -> + Sz = TL-11, + <<_Curve:Sz/binary, + ?DEC_BIN(CurveName, _SNN), + ?DEC_BIN(Q, _QL), + ?DEC_BIN(Priv, _PrivL), + Rest/binary>> = KeyRest, + OID = public_key:ssh_curvename2oid(CurveName), + {#'ECPrivateKey'{version = 1, + parameters = {namedCurve,OID}, + privateKey = Priv, + publicKey = Q + }, Rest}; +ssh2_privkey_decode2(<<?UINT32(11), "ssh-ed25519", + ?DEC_BIN(Pub,_Lpub), + ?DEC_BIN(Priv,_Lpriv), + Rest/binary>>) -> + {{ed_pri, ed25519, Pub, Priv}, Rest}; +ssh2_privkey_decode2(<<?UINT32(9), "ssh-ed448", + ?DEC_BIN(Pub,_Lpub), + ?DEC_BIN(Priv,_Lpriv), + Rest/binary>>) -> + {{ed_pri, ed448, Pub, Priv}, Rest}. + + %%%================================================================ %%% %%% Helper functions @@ -594,8 +728,8 @@ encode_signature(#'RSAPublicKey'{}, SigAlg, Signature) -> encode_signature({_, #'Dss-Parms'{}}, _SigAlg, Signature) -> <<?Ebinary(<<"ssh-dss">>), ?Ebinary(Signature)>>; encode_signature({#'ECPoint'{}, {namedCurve,OID}}, _SigAlg, Signature) -> - CurveName = public_key:oid2ssh_curvename(OID), - <<?Ebinary(<<"ecdsa-sha2-",CurveName/binary>>), ?Ebinary(Signature)>>; + Curve = public_key:oid2ssh_curvename(OID), + <<?Ebinary(<<"ecdsa-sha2-",Curve/binary>>), ?Ebinary(Signature)>>; encode_signature({ed_pub, ed25519,_}, _SigAlg, Signature) -> <<?Ebinary(<<"ssh-ed25519">>), ?Ebinary(Signature)>>; encode_signature({ed_pub, ed448,_}, _SigAlg, Signature) -> diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl index e2a18edc0d..b165c77341 100644 --- a/lib/ssh/src/ssh_options.erl +++ b/lib/ssh/src/ssh_options.erl @@ -331,6 +331,18 @@ default(server) -> class => user_option }, + tcpip_tunnel_out => + #{default => false, + chk => fun erlang:is_boolean/1, + class => user_option + }, + + tcpip_tunnel_in => + #{default => false, + chk => fun erlang:is_boolean/1, + class => user_option + }, + system_dir => #{default => "/etc/ssh", chk => fun(V) -> check_string(V) andalso check_dir(V) end, diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index 11d48bb1e5..007f912e5f 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -165,8 +165,8 @@ start_channel(Cm, UserOptions) when is_pid(Cm) -> PacketSize = proplists:get_value(packet_size, ChanOpts, ?XFER_PACKET_SIZE), case ssh_connection:session_channel(Cm, WindowSize, PacketSize, Timeout) of {ok, ChannelId} -> - case ssh_client_channel:start(Cm, ChannelId, - ?MODULE, [Cm, ChannelId, SftpOpts]) of + case ssh_connection_handler:start_channel(Cm, ?MODULE, ChannelId, + [Cm,ChannelId,SftpOpts], undefined) of {ok, Pid} -> case wait_for_version_negotiation(Pid, Timeout) of ok -> @@ -175,9 +175,7 @@ start_channel(Cm, UserOptions) when is_pid(Cm) -> TimeOut end; {error, Reason} -> - {error, format_channel_start_error(Reason)}; - ignore -> - {error, ignore} + {error, format_channel_start_error(Reason)} end; Error -> Error diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index b8dc905d4d..d478d939ff 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -62,14 +62,15 @@ %%==================================================================== -spec subsystem_spec(Options) -> Spec when Options :: [ {cwd, string()} | - {file_handler, CallbackModule::string()} | + {file_handler, CbMod | {CbMod, FileState}} | {max_files, integer()} | {root, string()} | {sftpd_vsn, integer()} ], Spec :: {Name, {CbMod,Options}}, Name :: string(), - CbMod :: atom() . + CbMod :: atom(), + FileState :: term(). subsystem_spec(Options) -> diff --git a/lib/ssh/src/ssh_subsystem_sup.erl b/lib/ssh/src/ssh_subsystem_sup.erl index 5fc8f7e764..140b219b32 100644 --- a/lib/ssh/src/ssh_subsystem_sup.erl +++ b/lib/ssh/src/ssh_subsystem_sup.erl @@ -30,7 +30,9 @@ -export([start_link/5, connection_supervisor/1, - channel_supervisor/1 + channel_supervisor/1, + tcpip_fwd_supervisor/1, + start_channel/8 ]). %% Supervisor callback @@ -46,9 +48,17 @@ connection_supervisor(SupPid) -> Children = supervisor:which_children(SupPid), ssh_connection_sup(Children). -channel_supervisor(SupPid) -> +channel_supervisor(SupPid) when is_pid(SupPid) -> Children = supervisor:which_children(SupPid), - ssh_server_channel_sup(Children). + ssh_channel_sup(Children). + +tcpip_fwd_supervisor(SupPid) when is_pid(SupPid) -> + Children = supervisor:which_children(SupPid), + tcpip_fwd_sup(Children). + +start_channel(Role, SupPid, ConnRef, Callback, Id, Args, Exec, Opts) -> + ChannelSup = channel_supervisor(SupPid), + ssh_channel_sup:start_child(Role, ChannelSup, ConnRef, Callback, Id, Args, Exec, Opts). %%%========================================================================= %%% Supervisor callback @@ -64,11 +74,10 @@ init([Role, Address, Port, Profile, Options]) -> %%%========================================================================= %%% Internal functions %%%========================================================================= -child_specs(client, _Address, _Port, _Profile, _Options) -> - []; -child_specs(server, Address, Port, Profile, Options) -> - [ssh_channel_child_spec(server, Address, Port, Profile, Options), - ssh_connection_child_spec(server, Address, Port, Profile, Options)]. +child_specs(Role, Address, Port, Profile, Options) -> + [ssh_channel_child_spec(Role, Address, Port, Profile, Options), + ssh_connection_child_spec(Role, Address, Port, Profile, Options), + ssh_tcpip_forward_acceptor_child_spec()]. ssh_connection_child_spec(Role, Address, Port, _Profile, Options) -> #{id => id(Role, ssh_connection_sup, Address, Port), @@ -78,12 +87,20 @@ ssh_connection_child_spec(Role, Address, Port, _Profile, Options) -> }. ssh_channel_child_spec(Role, Address, Port, _Profile, Options) -> - #{id => id(Role, ssh_server_channel_sup, Address, Port), - start => {ssh_server_channel_sup, start_link, [Options]}, + #{id => id(Role, ssh_channel_sup, Address, Port), + start => {ssh_channel_sup, start_link, [Options]}, + restart => temporary, + type => supervisor + }. + +ssh_tcpip_forward_acceptor_child_spec() -> + #{id => make_ref(), + start => {ssh_tcpip_forward_acceptor_sup, start_link, []}, restart => temporary, type => supervisor }. + id(Role, Sup, Address, Port) -> {Role, Sup, Address, Port}. @@ -92,10 +109,13 @@ ssh_connection_sup([{_, Child, _, [ssh_connection_sup]} | _]) -> ssh_connection_sup([_ | Rest]) -> ssh_connection_sup(Rest). -ssh_server_channel_sup([{_, Child, _, [ssh_server_channel_sup]} | _]) -> +ssh_channel_sup([{_, Child, _, [ssh_channel_sup]} | _]) -> Child; -ssh_server_channel_sup([_ | Rest]) -> - ssh_server_channel_sup(Rest). - +ssh_channel_sup([_ | Rest]) -> + ssh_channel_sup(Rest). +tcpip_fwd_sup([{_, Child, _, [ssh_tcpip_forward_acceptor_sup]} | _]) -> + Child; +tcpip_fwd_sup([_ | Rest]) -> + tcpip_fwd_sup(Rest). diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index 80406a6c47..704c17c4e7 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -31,9 +31,9 @@ -include("ssh.hrl"). --export([start_link/4, stop_listener/1, - stop_listener/3, stop_system/1, - stop_system/3, system_supervisor/3, +-export([start_link/5, stop_listener/1, + stop_listener/3, stop_system/2, + stop_system/4, system_supervisor/3, subsystem_supervisor/1, channel_supervisor/1, connection_supervisor/1, acceptor_supervisor/1, start_subsystem/6, @@ -50,14 +50,14 @@ %%%========================================================================= %%% API %%%========================================================================= -start_link(Address, Port, Profile, Options) -> +start_link(Role, Address, Port, Profile, Options) -> Name = make_name(Address, Port, Profile), - supervisor:start_link({local, Name}, ?MODULE, [Address, Port, Profile, Options]). + supervisor:start_link({local, Name}, ?MODULE, [Role, Address, Port, Profile, Options]). %%%========================================================================= %%% Supervisor callback %%%========================================================================= -init([Address, Port, Profile, Options]) -> +init([server, Address, Port, Profile, Options]) -> SupFlags = #{strategy => one_for_one, intensity => 0, period => 3600 @@ -73,6 +73,14 @@ init([Address, Port, Profile, Options]) -> _ -> [] end, + {ok, {SupFlags,ChildSpecs}}; + +init([client, _Address, _Port, _Profile, _Options]) -> + SupFlags = #{strategy => one_for_one, + intensity => 0, + period => 3600 + }, + ChildSpecs = [], {ok, {SupFlags,ChildSpecs}}. %%%========================================================================= @@ -92,11 +100,10 @@ stop_listener(Address, Port, Profile) -> system_supervisor(Address, Port, Profile)). -stop_system(SysSup) -> - catch sshd_sup:stop_child(SysSup), - ok. +stop_system(server, SysSup) -> catch sshd_sup:stop_child(SysSup), ok; +stop_system(client, SysSup) -> catch sshc_sup:stop_child(SysSup), ok. -stop_system(Address, Port, Profile) -> +stop_system(server, Address, Port, Profile) -> catch sshd_sup:stop_child(Address, Port, Profile), ok. diff --git a/lib/ssh/src/ssh_tcpip_forward_acceptor.erl b/lib/ssh/src/ssh_tcpip_forward_acceptor.erl new file mode 100644 index 0000000000..6f2fda2bf9 --- /dev/null +++ b/lib/ssh/src/ssh_tcpip_forward_acceptor.erl @@ -0,0 +1,116 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%%---------------------------------------------------------------------- +%% Purpose: The supervisor for tcpip-forwarding acceptor +%%---------------------------------------------------------------------- + +-module(ssh_tcpip_forward_acceptor). + +-export([supervised_start/6, + start_link/6]). + +-include("ssh.hrl"). + +%%%---------------------------------------------------------------- +supervised_start(FwdSup, {ListenAddrStr, ListenPort}, ConnectToAddr, ChanType, ChanCB, ConnPid) -> + case get_fwd_listen_opts(ListenAddrStr) of + {ok,Opts} -> + %% start listening on Addr:BoundPort + case gen_tcp:listen(ListenPort, [binary, + {reuseaddr,true}, + {active,false} | Opts]) of + {ok,LSock} -> + {ok,{_, TrueListenPort}} = inet:sockname(LSock), + ssh_tcpip_forward_acceptor_sup:start_child(FwdSup, + LSock, + {ListenAddrStr,TrueListenPort}, + ConnectToAddr, + ChanType, + ChanCB, + ConnPid), + {ok, TrueListenPort}; + + {error,Error} -> + {error,Error} + end; + + {error,Error} -> + {error,Error} + end. + + +%%%---------------------------------------------------------------- +start_link(LSock, {ListenAddrStr,ListenPort}, ConnectToAddr, ChanType, ChanCB, ConnPid) -> + Pid = proc_lib:spawn_link( + fun() -> + acceptor_loop(LSock, ListenAddrStr, ListenPort, ConnectToAddr, ChanType, ChanCB, ConnPid) + end), + {ok, Pid}. + +%%%================================================================ +%%% +%%% Internal +%%% +acceptor_loop(LSock, ListenAddrStr, ListenPort, ConnectToAddr, ChanType, ChanCB, ConnPid) -> + case gen_tcp:accept(LSock) of + {ok, Sock} -> + {ok, {RemHost,RemPort}} = inet:peername(Sock), + RemHostBin = list_to_binary(encode_ip(RemHost)), + Data = + case ConnectToAddr of + undefined -> + <<?STRING(ListenAddrStr), ?UINT32(ListenPort), + ?STRING(RemHostBin), ?UINT32(RemPort)>>; + {ConnectToHost, ConnectToPort} -> + <<?STRING(ConnectToHost), ?UINT32(ConnectToPort), + ?STRING(RemHostBin), ?UINT32(RemPort)>> + end, + case ssh_connection:open_channel(ConnPid, ChanType, Data, infinity) of + {ok,ChId} -> + gen_tcp:controlling_process(Sock, ConnPid), + ConnPid ! {fwd_connect_received, Sock, ChId, ChanCB}; + _ -> + gen_tcp:close(Sock) + end, + acceptor_loop(LSock, ListenAddrStr, ListenPort, ConnectToAddr, ChanType, ChanCB, ConnPid); + + {error,closed} -> + ok + end. + +%%%---------------------------------------------------------------- +get_fwd_listen_opts(<<"">> ) -> {ok, []}; +get_fwd_listen_opts(<<"0.0.0.0">> ) -> {ok, [inet]}; +get_fwd_listen_opts(<<"::">> ) -> {ok, [inet6]}; +get_fwd_listen_opts(<<"localhost">>) -> {ok, [{ip,loopback}]}; +get_fwd_listen_opts(AddrStr) -> + case inet:getaddr(binary_to_list(AddrStr), inet) of + {ok, Addr} -> {ok, [{ip,Addr}]}; + {error,Error} -> {error,Error} + end. + +%%%---------------------------------------------------------------- +encode_ip(Addr) when is_tuple(Addr) -> + case catch inet_parse:ntoa(Addr) of + {'EXIT',_} -> false; + A -> A + end. diff --git a/lib/ssh/src/ssh_server_channel_sup.erl b/lib/ssh/src/ssh_tcpip_forward_acceptor_sup.erl index ff74061bb3..522ce650ff 100644 --- a/lib/ssh/src/ssh_server_channel_sup.erl +++ b/lib/ssh/src/ssh_tcpip_forward_acceptor_sup.erl @@ -20,42 +20,42 @@ %% %%---------------------------------------------------------------------- -%% Purpose: Ssh channel supervisor. +%% Purpose: The supervisor for tcpip-forwarding acceptor %%---------------------------------------------------------------------- --module(ssh_server_channel_sup). +-module(ssh_tcpip_forward_acceptor_sup). -behaviour(supervisor). --export([start_link/1, start_child/5]). +-include("ssh.hrl"). + +-export([start_link/0, start_child/7]). %% Supervisor callback -export([init/1]). %%%========================================================================= -%%% Internal API +%%% API %%%========================================================================= -start_link(Args) -> - supervisor:start_link(?MODULE, [Args]). - -start_child(Sup, Callback, Id, Args, Exec) -> - ChildSpec = - #{id => make_ref(), - start => {ssh_server_channel, start_link, [self(), Id, Callback, Args, Exec]}, - restart => temporary, - type => worker, - modules => [ssh_server_channel] - }, - supervisor:start_child(Sup, ChildSpec). +start_link() -> + supervisor:start_link(?MODULE, []). + +start_child(Sup, LSock, ListenAddr, ConnectToAddr, ChanType, ChanCB, ConnPid) -> + Args = [LSock, ListenAddr, ConnectToAddr, ChanType, ChanCB, ConnPid], + supervisor:start_child(Sup, Args). %%%========================================================================= %%% Supervisor callback %%%========================================================================= -init(_Args) -> - RestartStrategy = one_for_one, - MaxR = 10, - MaxT = 3600, - Children = [], - {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. +init([]) -> + SupFlags = #{strategy => simple_one_for_one, + intensity => 10, + period => 3600 + }, + ChildSpecs = [#{id => undefined, % As simple_one_for_one is used. + start => {ssh_tcpip_forward_acceptor, start_link, []} + } + ], + {ok, {SupFlags,ChildSpecs}}. %%%========================================================================= %%% Internal functions diff --git a/lib/ssh/src/ssh_tcpip_forward_client.erl b/lib/ssh/src/ssh_tcpip_forward_client.erl new file mode 100644 index 0000000000..490d283461 --- /dev/null +++ b/lib/ssh/src/ssh_tcpip_forward_client.erl @@ -0,0 +1,84 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssh_tcpip_forward_client). + +-behaviour(ssh_client_channel). + +-record(state, { + id, cm, + fwd_socket + }). + +-export([init/1, handle_call/3, handle_cast/2, handle_msg/2, handle_ssh_msg/2, terminate/2, code_change/3]). + +init([FwdSocket]) -> + {ok, #state{fwd_socket=FwdSocket}}. + + +handle_msg({ssh_channel_up, ChannelId, ConnectionManager}, State) -> + {ok, State#state{id = ChannelId, + cm = ConnectionManager}}; + +handle_msg({tcp,Sock,Data}, #state{fwd_socket = Sock, + cm = CM, + id = ChId} = State) -> + ssh_connection:send(CM, ChId, Data), + inet:setopts(Sock, [{active,once}]), + {ok, State}; + +handle_msg({tcp_closed,Sock}, #state{fwd_socket = Sock, + cm = CM, + id = ChId} = State) -> + ssh_connection:send_eof(CM, ChId), + {stop, ChId, State#state{fwd_socket=undefined}}. + + + +handle_ssh_msg({ssh_cm, _CM, {data, _ChannelId, _Type, Data}}, #state{fwd_socket=Sock} = State) -> + gen_tcp:send(Sock, Data), + {ok, State}; + +handle_ssh_msg({ssh_cm, _CM, {eof, ChId}}, State) -> + {stop, ChId, State}; + +handle_ssh_msg({ssh_cm, _CM, {signal, _, _}}, State) -> + %% Ignore signals according to RFC 4254 section 6.9. + {ok, State}; + +handle_ssh_msg({ssh_cm, _CM, {exit_signal, ChId, _, _Error, _}}, State) -> + {stop, ChId, State}; + +handle_ssh_msg({ssh_cm, _, {exit_status, ChId, _Status}}, State) -> + {stop, ChId, State}. + + +terminate(_Reason, #state{fwd_socket=Sock}) -> + gen_tcp:close(Sock), + ok. + + +handle_call(Req, _, S) -> {reply, {unknown,Req}, S}. + +handle_cast(_, S) -> {noreply, S}. + +code_change(_, S, _) -> {ok, S}. + + diff --git a/lib/ssh/src/ssh_tcpip_forward_srv.erl b/lib/ssh/src/ssh_tcpip_forward_srv.erl new file mode 100644 index 0000000000..a29f70cf48 --- /dev/null +++ b/lib/ssh/src/ssh_tcpip_forward_srv.erl @@ -0,0 +1,75 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssh_tcpip_forward_srv). + +-behaviour(ssh_server_channel). + +-record(state, { + id, cm, + fwd_socket + }). + +-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]). + +init([FwdSocket]) -> + {ok, #state{fwd_socket=FwdSocket}}. + + +handle_msg({ssh_channel_up, ChannelId, ConnectionManager}, State) -> + {ok, State#state{id = ChannelId, + cm = ConnectionManager}}; + +handle_msg({tcp,Sock,Data}, #state{fwd_socket = Sock, + cm = CM, + id = ChId} = State) -> + ssh_connection:send(CM, ChId, Data), + inet:setopts(Sock, [{active,once}]), + {ok, State}; + +handle_msg({tcp_closed,Sock}, #state{fwd_socket = Sock, + cm = CM, + id = ChId} = State) -> + ssh_connection:send_eof(CM, ChId), + {stop, ChId, State#state{fwd_socket=undefined}}. + + + +handle_ssh_msg({ssh_cm, _CM, {data, _ChannelId, _Type, Data}}, #state{fwd_socket=Sock} = State) -> + gen_tcp:send(Sock, Data), + {ok, State}; + +handle_ssh_msg({ssh_cm, _CM, {eof, ChId}}, State) -> + {stop, ChId, State}; + +handle_ssh_msg({ssh_cm, _CM, {signal, _, _}}, State) -> + %% Ignore signals according to RFC 4254 section 6.9. + {ok, State}; + +handle_ssh_msg({ssh_cm, _CM, {exit_signal, ChId, _, _Error, _}}, State) -> + {stop, ChId, State}; + +handle_ssh_msg({ssh_cm, _, {exit_status, ChId, _Status}}, State) -> + {stop, ChId, State}. + + +terminate(_Reason, #state{fwd_socket=Sock}) -> + gen_tcp:close(Sock), + ok. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 9a4ae5bbc6..e1a7ecf66f 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -50,10 +50,11 @@ parallell_gen_key/1, extract_public_key/1, ssh_packet/2, pack/2, - valid_key_sha_alg/2, + valid_key_sha_alg/3, sha/1, sign/3, verify/5, get_host_key/2, - call_KeyCb/3]). + call_KeyCb/3, + public_algo/1]). -behaviour(ssh_dbg). -export([ssh_dbg_trace_points/0, ssh_dbg_flags/1, ssh_dbg_on/1, ssh_dbg_off/1, ssh_dbg_format/2]). @@ -786,7 +787,7 @@ get_host_key(SignAlg, Opts) -> case call_KeyCb(host_key, [SignAlg], Opts) of {ok, PrivHostKey} -> %% Check the key - the KeyCb may be a buggy plugin - case valid_key_sha_alg(PrivHostKey, SignAlg) of + case valid_key_sha_alg(private, PrivHostKey, SignAlg) of true -> PrivHostKey; false -> exit({error, bad_hostkey}) end; @@ -804,7 +805,7 @@ extract_public_key(#'RSAPrivateKey'{modulus = N, publicExponent = E}) -> extract_public_key(#'DSAPrivateKey'{y = Y, p = P, q = Q, g = G}) -> {Y, #'Dss-Parms'{p=P, q=Q, g=G}}; extract_public_key(#'ECPrivateKey'{parameters = {namedCurve,OID}, - publicKey = Q}) -> + publicKey = Q}) when is_tuple(OID) -> {#'ECPoint'{point=Q}, {namedCurve,OID}}; extract_public_key({ed_pri, Alg, Pub, _Priv}) -> {ed_pub, Alg, Pub}; @@ -1480,7 +1481,7 @@ encrypt(#ssh{encrypt = 'chacha20-poly1305@openssh.com', %% MAC tag PolyKey = crypto:crypto_one_time(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, true), EncBytes = <<EncLen/binary,EncPayloadData/binary>>, - Ctag = crypto:poly1305(PolyKey, EncBytes), + Ctag = crypto:mac(poly1305, PolyKey, EncBytes), %% Result {Ssh, {EncBytes,Ctag}}; @@ -1561,7 +1562,7 @@ decrypt(#ssh{decrypt = 'chacha20-poly1305@openssh.com', %% The length is already decrypted and used to divide the input %% Check the mac (important that it is timing-safe): PolyKey = crypto:crypto_one_time(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, false), - case crypto:equal_const_time(Ctag, crypto:poly1305(PolyKey, <<AAD/binary,Ctext/binary>>)) of + case crypto:equal_const_time(Ctag, crypto:mac(poly1305, PolyKey, <<AAD/binary,Ctext/binary>>)) of true -> %% MAC is ok, decode IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, @@ -1722,17 +1723,17 @@ recv_mac_final(SSH) -> mac(none, _ , _, _) -> <<>>; mac('hmac-sha1', Key, SeqNum, Data) -> - crypto:hmac(sha, Key, [<<?UINT32(SeqNum)>>, Data]); + crypto:mac(hmac, sha, Key, [<<?UINT32(SeqNum)>>, Data]); mac('hmac-sha1-96', Key, SeqNum, Data) -> - crypto:hmac(sha, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-sha1-96')); + crypto:macN(hmac, sha, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-sha1-96')); mac('hmac-md5', Key, SeqNum, Data) -> - crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data]); + crypto:mac(hmac, md5, Key, [<<?UINT32(SeqNum)>>, Data]); mac('hmac-md5-96', Key, SeqNum, Data) -> - crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-md5-96')); + crypto:macN(hmac, md5, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-md5-96')); mac('hmac-sha2-256', Key, SeqNum, Data) -> - crypto:hmac(sha256, Key, [<<?UINT32(SeqNum)>>, Data]); + crypto:mac(hmac, sha256, Key, [<<?UINT32(SeqNum)>>, Data]); mac('hmac-sha2-512', Key, SeqNum, Data) -> - crypto:hmac(sha512, Key, [<<?UINT32(SeqNum)>>, Data]). + crypto:mac(hmac, sha512, Key, [<<?UINT32(SeqNum)>>, Data]). %%%---------------------------------------------------------------- @@ -1760,7 +1761,7 @@ kex_hash(SSH, Key, HashAlg, Args) -> kex_plaintext(SSH, Key, Args) -> - EncodedKey = public_key:ssh_encode(Key, ssh2_pubkey), + EncodedKey = ssh_message:ssh2_pubkey_encode(Key), <<?Estring(SSH#ssh.c_version), ?Estring(SSH#ssh.s_version), ?Ebinary(SSH#ssh.c_keyinit), ?Ebinary(SSH#ssh.s_keyinit), ?Ebinary(EncodedKey), @@ -1787,33 +1788,36 @@ kex_alg_dependent({Min, NBits, Max, Prime, Gen, E, F, K}) -> %%%---------------------------------------------------------------- -valid_key_sha_alg(#{engine:=_, key_id:=_}, _Alg) -> true; % Engine key +valid_key_sha_alg(_, #{engine:=_, key_id:=_}, _Alg) -> true; % Engine key -valid_key_sha_alg(#'RSAPublicKey'{}, 'rsa-sha2-512') -> true; -valid_key_sha_alg(#'RSAPublicKey'{}, 'rsa-sha2-384') -> true; -valid_key_sha_alg(#'RSAPublicKey'{}, 'rsa-sha2-256') -> true; -valid_key_sha_alg(#'RSAPublicKey'{}, 'ssh-rsa' ) -> true; +valid_key_sha_alg(public, #'RSAPublicKey'{}, 'rsa-sha2-512') -> true; +valid_key_sha_alg(public, #'RSAPublicKey'{}, 'rsa-sha2-384') -> true; +valid_key_sha_alg(public, #'RSAPublicKey'{}, 'rsa-sha2-256') -> true; +valid_key_sha_alg(public, #'RSAPublicKey'{}, 'ssh-rsa' ) -> true; -valid_key_sha_alg(#'RSAPrivateKey'{}, 'rsa-sha2-512') -> true; -valid_key_sha_alg(#'RSAPrivateKey'{}, 'rsa-sha2-384') -> true; -valid_key_sha_alg(#'RSAPrivateKey'{}, 'rsa-sha2-256') -> true; -valid_key_sha_alg(#'RSAPrivateKey'{}, 'ssh-rsa' ) -> true; +valid_key_sha_alg(private, #'RSAPrivateKey'{}, 'rsa-sha2-512') -> true; +valid_key_sha_alg(private, #'RSAPrivateKey'{}, 'rsa-sha2-384') -> true; +valid_key_sha_alg(private, #'RSAPrivateKey'{}, 'rsa-sha2-256') -> true; +valid_key_sha_alg(private, #'RSAPrivateKey'{}, 'ssh-rsa' ) -> true; -valid_key_sha_alg({_, #'Dss-Parms'{}}, 'ssh-dss') -> true; -valid_key_sha_alg(#'DSAPrivateKey'{}, 'ssh-dss') -> true; +valid_key_sha_alg(public, {_, #'Dss-Parms'{}}, 'ssh-dss') -> true; +valid_key_sha_alg(private, #'DSAPrivateKey'{}, 'ssh-dss') -> true; -valid_key_sha_alg({ed_pub, ed25519,_}, 'ssh-ed25519') -> true; -valid_key_sha_alg({ed_pri, ed25519,_,_},'ssh-ed25519') -> true; -valid_key_sha_alg({ed_pub, ed448,_}, 'ssh-ed448') -> true; -valid_key_sha_alg({ed_pri, ed448,_,_}, 'ssh-ed448') -> true; +valid_key_sha_alg(public, {ed_pub, ed25519,_}, 'ssh-ed25519') -> true; +valid_key_sha_alg(private, {ed_pri, ed25519,_,_},'ssh-ed25519') -> true; +valid_key_sha_alg(public, {ed_pub, ed448,_}, 'ssh-ed448') -> true; +valid_key_sha_alg(private, {ed_pri, ed448,_,_}, 'ssh-ed448') -> true; -valid_key_sha_alg({#'ECPoint'{},{namedCurve,OID}}, Alg) -> valid_key_sha_alg_ec(OID, Alg); -valid_key_sha_alg(#'ECPrivateKey'{parameters = {namedCurve,OID}}, Alg) -> valid_key_sha_alg_ec(OID, Alg); -valid_key_sha_alg(_, _) -> false. +valid_key_sha_alg(public, {#'ECPoint'{},{namedCurve,OID}}, Alg) when is_tuple(OID) -> + valid_key_sha_alg_ec(OID, Alg); +valid_key_sha_alg(private, #'ECPrivateKey'{parameters = {namedCurve,OID}}, Alg) when is_tuple(OID) -> + valid_key_sha_alg_ec(OID, Alg); +valid_key_sha_alg(_, _, _) -> false. -valid_key_sha_alg_ec(OID, Alg) -> - Curve = public_key:oid2ssh_curvename(OID), - try Alg == list_to_existing_atom("ecdsa-sha2-" ++ binary_to_list(Curve)) +valid_key_sha_alg_ec(OID, Alg) -> + try + Curve = public_key:oid2ssh_curvename(OID), + Alg == list_to_existing_atom("ecdsa-sha2-" ++ binary_to_list(Curve)) catch _:_ -> false end. @@ -1825,9 +1829,9 @@ public_algo(#'RSAPublicKey'{}) -> 'ssh-rsa'; % FIXME: Not right with draft-cu public_algo({_, #'Dss-Parms'{}}) -> 'ssh-dss'; public_algo({ed_pub, ed25519,_}) -> 'ssh-ed25519'; public_algo({ed_pub, ed448,_}) -> 'ssh-ed448'; -public_algo({#'ECPoint'{},{namedCurve,OID}}) -> - Curve = public_key:oid2ssh_curvename(OID), - try list_to_existing_atom("ecdsa-sha2-" ++ binary_to_list(Curve)) +public_algo({#'ECPoint'{},{namedCurve,OID}}) when is_tuple(OID) -> + SshName = public_key:oid2ssh_curvename(OID), + try list_to_existing_atom("ecdsa-sha2-" ++ binary_to_list(SshName)) catch _:_ -> undefined end. diff --git a/lib/ssh/src/ssh_xfer.erl b/lib/ssh/src/ssh_xfer.erl index 2292beaf68..d89b59100f 100644 --- a/lib/ssh/src/ssh_xfer.erl +++ b/lib/ssh/src/ssh_xfer.erl @@ -117,13 +117,20 @@ rename(XF, ReqID, OldPath, NewPath, Flags) -> true -> (<<>>) end, - xf_request(XF, ?SSH_FXP_RENAME, - [?uint32(ReqID), - ?string_utf8(OldPath), - ?string_utf8(NewPath), - FlagBits]). - - + Ext = XF#ssh_xfer.ext, + ExtRename = "posix-rename@openssh.com", + case lists:member({ExtRename, "1"}, Ext) of + true -> + extended(XF, ReqID, ExtRename, + [?string_utf8(OldPath), + ?string_utf8(NewPath)]); + false -> + xf_request(XF, ?SSH_FXP_RENAME, + [?uint32(ReqID), + ?string_utf8(OldPath), + ?string_utf8(NewPath), + FlagBits]) + end. %% Create directory mkdir(XF, ReqID, Path, Attrs) -> @@ -222,7 +229,7 @@ extended(XF, ReqID, Request, Data) -> xf_request(XF, ?SSH_FXP_EXTENDED, [?uint32(ReqID), ?string(Request), - ?binary(Data)]). + Data]). %% Send xfer request to connection manager diff --git a/lib/ssh/src/sshc_sup.erl b/lib/ssh/src/sshc_sup.erl index 869de244ac..0c9f8be5a9 100644 --- a/lib/ssh/src/sshc_sup.erl +++ b/lib/ssh/src/sshc_sup.erl @@ -27,7 +27,10 @@ -behaviour(supervisor). --export([start_link/0, start_child/1]). +-export([start_link/0, + start_child/4, + stop_child/1 + ]). %% Supervisor callback -export([init/1]). @@ -38,22 +41,45 @@ %%% API %%%========================================================================= start_link() -> - supervisor:start_link({local,?SSHC_SUP}, ?MODULE, []). + supervisor:start_link({local,?MODULE}, ?MODULE, []). -start_child(Args) -> - supervisor:start_child(?MODULE, Args). +start_child(Address, Port, Profile, Options) -> + %% Here we a new connction on a new Host/EFERMERAL Port/Profile + Spec = child_spec(Address, Port, Profile, Options), + supervisor:start_child(?MODULE, Spec). + +stop_child(ChildId) when is_tuple(ChildId) -> + supervisor:terminate_child(?SSHC_SUP, ChildId); +stop_child(ChildPid) when is_pid(ChildPid)-> + stop_child(system_name(ChildPid)). %%%========================================================================= %%% Supervisor callback %%%========================================================================= init(_) -> - SupFlags = #{strategy => simple_one_for_one, + SupFlags = #{strategy => one_for_one, intensity => 0, period => 3600 }, - ChildSpecs = [#{id => undefined, % As simple_one_for_one is used. - start => {ssh_connection_handler, start_link, []}, - restart => temporary % because there is no way to restart a crashed connection - } - ], + ChildSpecs = [], {ok, {SupFlags,ChildSpecs}}. + +%%%========================================================================= +%%% Internal functions +%%%========================================================================= +child_spec(Address, Port, Profile, Options) -> + #{id => id(Address, Port, Profile), + start => {ssh_system_sup, start_link, [client, Address, Port, Profile, Options]}, + restart => temporary, + type => supervisor + }. + +id(Address, Port, Profile) -> + {client, ssh_system_sup, Address, Port, Profile}. + +system_name(SysSup) -> + case lists:keyfind(SysSup, 2, supervisor:which_children(?SSHC_SUP)) of + {Name, SysSup, _, _} -> Name; + false -> undefind + end. + diff --git a/lib/ssh/src/sshd_sup.erl b/lib/ssh/src/sshd_sup.erl index b5361abba5..b716b66ec7 100644 --- a/lib/ssh/src/sshd_sup.erl +++ b/lib/ssh/src/sshd_sup.erl @@ -89,7 +89,7 @@ init(_) -> %%%========================================================================= child_spec(Address, Port, Profile, Options) -> #{id => id(Address, Port, Profile), - start => {ssh_system_sup, start_link, [Address, Port, Profile, Options]}, + start => {ssh_system_sup, start_link, [server, Address, Port, Profile, Options]}, restart => temporary, type => supervisor }. diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index e221e94075..ee8480dfdb 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -43,6 +43,7 @@ MODULES= \ ssh_engine_SUITE \ ssh_protocol_SUITE \ ssh_property_test_SUITE \ + ssh_pubkey_SUITE \ ssh_sftp_SUITE \ ssh_sftpd_SUITE \ ssh_sftpd_erlclient_SUITE \ diff --git a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl index 6470fa5f3d..cfcc56d1a4 100644 --- a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl +++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl @@ -186,7 +186,7 @@ gen_pubkey_string(Type) -> ecdsa -> {#'ECPoint'{point=[1,2,3,4,5]}, {namedCurve,{1,2,840,10045,3,1,7}}} % 'secp256r1' nistp256 end, - gen_string(public_key:ssh_encode(PubKey, ssh2_pubkey)). + gen_string(ssh_message:ssh2_pubkey_encode(PubKey)). gen_signature_string(Type) -> diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 2ed3a248d5..3a90b4d0fe 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -52,7 +52,8 @@ all() -> groups() -> [{all_tests, [?PARALLEL], [{group, ssh_renegotiate_SUITE}, - {group, ssh_basic_SUITE} + {group, ssh_basic_SUITE}, + ssh_file_is_host_key4 ]}, {ssh_basic_SUITE, [], [app_test, appup_test, @@ -900,13 +901,87 @@ known_hosts(Config) when is_list(Config) -> {ok, _Channel} = ssh_connection:session_channel(ConnectionRef, infinity), ok = ssh:close(ConnectionRef), {ok, Binary} = file:read_file(KnownHosts), + ct:log("known_hosts:~n~p",[Binary]), Lines = string:tokens(binary_to_list(Binary), "\n"), [Line] = Lines, [HostAndIp, Alg, _KeyData] = string:tokens(Line, " "), - [StoredHost, _Ip] = string:tokens(HostAndIp, ","), + [StoredHost|_] = string:tokens(HostAndIp, ","), true = ssh_test_lib:match_ip(StoredHost, Host), "ssh-" ++ _ = Alg, + NLines = length(binary:split(Binary, <<"\n">>, [global,trim_all])), + ct:log("NLines = ~p~n~p", [NLines,Binary]), + if + NLines>1 -> ct:fail("wrong num lines", []); + NLines<1 -> ct:fail("wrong num lines", []); + true -> ok + end, + + _ConnectionRef2 = + ssh_test_lib:connect(Host, Port, [{user_dir, PrivDir}, + {user_interaction, false}, + silently_accept_hosts]), + {ok, Binary2} = file:read_file(KnownHosts), + case Binary of + Binary2 -> ok; + _ -> ct:log("2nd differ~n~p", [Binary2]), + ct:fail("wrong num lines", []) + end, + + Binary3 = <<"localhost,",Binary/binary>>, + ok = file:write_file(KnownHosts, Binary3), + _ConnectionRef3 = + ssh_test_lib:connect(Host, Port, [{user_dir, PrivDir}, + {user_interaction, false}, + silently_accept_hosts]), + ct:log("New known_hosts:~n~p",[Binary3]), + {ok, Binary4} = file:read_file(KnownHosts), + case Binary3 of + Binary4 -> ok; + _ -> ct:log("2nd differ~n~p", [Binary4]), + ct:fail("wrong num lines", []) + end, + + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- +ssh_file_is_host_key4(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + + Key1 = {ed_pub,ed25519,<<73,72,235,162,96,101,154,59,217,114,123,192,96,105,250,29, + 214,76,60,63,167,21,221,118,246,168,152,2,7,172,137,125>>}, + Key2 = {ed_pub,ed448,<<95,215,68,155,89,180,97,253,44,231,135,236,97,106,212,106,29, + 161,52,36,133,167,14,31,138,14,167,93,128,233,103,120,237,241, + 36,118,155,70,199,6,27,214,120,61,241,229,15,108,209,250,26, + 190,175,232,37,97,128>>}, + + FileContents = <<"h11,h12,h13,h14 ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIElI66JgZZo72XJ7wGBp+h3WTDw/pxXddvaomAIHrIl9\n", + "h21,[h22]:2345,h23 ssh-ed448 AAAACXNzaC1lZDQ0OAAAADlf10SbWbRh/Sznh+xhatRqHaE0JIWnDh" + "+KDqddgOlneO3xJHabRscGG9Z4PfHlD2zR+hq+r+glYYA=\n" + >>, + ok = file:write_file(KnownHosts, FileContents), + + true = ssh_file:is_host_key(Key1, "h11", 'ssh-ed25519', [{user_dir,PrivDir}]), + true = ssh_file:is_host_key(Key1, "h12", 'ssh-ed25519', [{user_dir,PrivDir}]), + true = ssh_file:is_host_key(Key1, "h13", 'ssh-ed25519', [{user_dir,PrivDir}]), + true = ssh_file:is_host_key(Key1, "h14", 'ssh-ed25519', [{user_dir,PrivDir}]), + + true = ssh_file:is_host_key(Key1, "h11,noh1", 'ssh-ed25519', [{user_dir,PrivDir}]), + true = ssh_file:is_host_key(Key1, "noh1,h11", 'ssh-ed25519', [{user_dir,PrivDir}]), + true = ssh_file:is_host_key(Key1, "noh1,h12,noh2", 'ssh-ed25519', [{user_dir,PrivDir}]), + + true = ssh_file:is_host_key(Key2, "h21", 'ssh-ed448', [{user_dir,PrivDir}]), + false = ssh_file:is_host_key(Key2, "h22", 'ssh-ed448', [{user_dir,PrivDir}]), + false = ssh_file:is_host_key(Key2, "[h22]",'ssh-ed448', [{user_dir,PrivDir}]), + true = ssh_file:is_host_key(Key2 , "[h22]:2345",'ssh-ed448', [{user_dir,PrivDir}]), + true = ssh_file:is_host_key(Key2, "h23", 'ssh-ed448', [{user_dir,PrivDir}]), + + false = ssh_file:is_host_key(Key2, "h11", 'ssh-ed448', [{user_dir,PrivDir}]), + false = ssh_file:is_host_key(Key1, "h21", 'ssh-ed25519', [{user_dir,PrivDir}]), + + ok. + %%-------------------------------------------------------------------- %%% Test that we can use keyes protected by pass phrases diff --git a/lib/ssh/test/ssh_pubkey_SUITE.erl b/lib/ssh/test/ssh_pubkey_SUITE.erl new file mode 100644 index 0000000000..160a78beb2 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE.erl @@ -0,0 +1,269 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2020. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +-module(ssh_pubkey_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include("ssh_test_lib.hrl"). + +%%%---------------------------------------------------------------- +%%% Common Test interface functions ------------------------------- +%%%---------------------------------------------------------------- + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{seconds,40}}]. + +all() -> + [{group, old_format}, + {group, new_format} + ]. + + +-define(tests_old, [connect_rsa_to_rsa, + connect_rsa_to_dsa, + connect_rsa_to_ecdsa, + connect_dsa_to_rsa, + connect_dsa_to_dsa, + connect_dsa_to_ecdsa, + connect_ecdsa_to_rsa, + connect_ecdsa_to_dsa, + connect_ecdsa_to_ecdsa + ]). + +-define(tests_new, [connect_ecdsa_to_ed25519, + connect_rsa_to_ed25519, + connect_dsa_to_ed25519, + connect_ed25519_to_rsa, + connect_ed25519_to_dsa, + connect_ed25519_to_ecdsa, + connect_ed25519_to_ed25519 + | ?tests_old]). + +groups() -> + [{new_format, [], ?tests_new}, + {old_format, [], ?tests_old++[{group,passphrase}]}, + {passphrase, [], ?tests_old} + ]. + +%%%---------------------------------------------------------------- +init_per_suite(Config) -> + ?CHECK_CRYPTO( + begin + ssh:start(), + [{client_opts,[]} + | Config] + end). + +end_per_suite(_onfig) -> + ssh:stop(). + +%%%---------------------------------------------------------------- +init_per_group(new_format, Config) -> + Dir = filename:join(proplists:get_value(data_dir,Config), "new_format"), + [{fmt,new_format}, + {key_src_dir,Dir} | Config]; + +init_per_group(old_format, Config) -> + Dir = filename:join(proplists:get_value(data_dir,Config), "old_format"), + [{fmt,old_format}, + {key_src_dir,Dir} | Config]; + +init_per_group(passphrase, Config0) -> + case supported(hashs, md5) of + true -> + Dir = filename:join(proplists:get_value(data_dir,Config0), "old_format_passphrase"), + PassPhrases = [{K,"somepwd"} || K <- [dsa_pass_phrase, + rsa_pass_phrase, + ecdsa_pass_phrase]], + Config1 = extend_optsL(client_opts, PassPhrases, Config0), + replace_opt(key_src_dir, Dir, Config1); + false -> + {skip, "Unsupported hash"} + end; + +init_per_group(_, Config) -> + Config. + + +extend_opts(OptName, Value, Config) -> + Opts = proplists:get_value(OptName, Config), + replace_opt(OptName, [Value|Opts], Config). + +extend_optsL(OptName, Values, Config) -> + Opts = proplists:get_value(OptName, Config), + replace_opt(OptName, Values ++ Opts, Config). + +replace_opt(OptName, Value, Config) -> + lists:keyreplace(OptName, 1, Config, {OptName,Value}). + + + +end_per_group(_, Config) -> + Config. + +%%%---------------------------------------------------------------- +init_per_testcase(_, Config) -> + Config. + +end_per_testcase(_, Config) -> + Config. + +%%%---------------------------------------------------------------- +%%% Test Cases ---------------------------------------------------- +%%%---------------------------------------------------------------- +connect_rsa_to_rsa(Config0) -> + Config = setup_user_system_dir(rsa, rsa, Config0), + try_connect(Config). + +connect_rsa_to_dsa(Config0) -> + Config = setup_user_system_dir(rsa, dsa, Config0), + try_connect(Config). + +connect_rsa_to_ecdsa(Config0) -> + Config = setup_user_system_dir(rsa, ecdsa, Config0), + try_connect(Config). + +connect_rsa_to_ed25519(Config0) -> + Config = setup_user_system_dir(rsa, ed25519, Config0), + try_connect(Config). + +connect_dsa_to_rsa(Config0) -> + Config = setup_user_system_dir(dsa, rsa, Config0), + try_connect(Config). + +connect_dsa_to_dsa(Config0) -> + Config = setup_user_system_dir(dsa, dsa, Config0), + try_connect(Config). + +connect_dsa_to_ecdsa(Config0) -> + Config = setup_user_system_dir(dsa, ecdsa, Config0), + try_connect(Config). + +connect_dsa_to_ed25519(Config0) -> + Config = setup_user_system_dir(dsa, ed25519, Config0), + try_connect(Config). + +connect_ecdsa_to_rsa(Config0) -> + Config = setup_user_system_dir(ecdsa, rsa, Config0), + try_connect(Config). + +connect_ecdsa_to_dsa(Config0) -> + Config = setup_user_system_dir(ecdsa, dsa, Config0), + try_connect(Config). + +connect_ecdsa_to_ecdsa(Config0) -> + Config = setup_user_system_dir(ecdsa, ecdsa, Config0), + try_connect(Config). + +connect_ecdsa_to_ed25519(Config0) -> + Config = setup_user_system_dir(ecdsa, ed25519, Config0), + try_connect(Config). + +connect_ed25519_to_rsa(Config0) -> + Config = setup_user_system_dir(ed25519, rsa, Config0), + try_connect(Config). + +connect_ed25519_to_dsa(Config0) -> + Config = setup_user_system_dir(ed25519, dsa, Config0), + try_connect(Config). + +connect_ed25519_to_ecdsa(Config0) -> + Config = setup_user_system_dir(ed25519, ecdsa, Config0), + try_connect(Config). + +connect_ed25519_to_ed25519(Config0) -> + Config = setup_user_system_dir(ed25519, ed25519, Config0), + try_connect(Config). + + +%%%---------------------------------------------------------------- +try_connect({skip,Reson}) -> + {skip,Reson}; +try_connect(Config) -> + SystemDir = proplists:get_value(system_dir, Config), + UserDir = proplists:get_value(user_dir, Config), + ClientOpts = proplists:get_value(client_opts, Config, []), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}]), + C = ssh_test_lib:connect(Host, Port, [{user_dir, UserDir}, + {silently_accept_hosts, true}, + {user_interaction, false} + | ClientOpts]), + ssh:close(C), + ssh:stop_daemon(Pid). + +%%%---------------------------------------------------------------- +%%% Local --------------------------------------------------------- +%%%---------------------------------------------------------------- +setup_user_system_dir(ClientAlg, ServerAlg, Config) -> + case supported(public_keys, ClientAlg) andalso supported(public_keys, ServerAlg) of + true -> + PrivDir = proplists:get_value(priv_dir, Config), + KeySrcDir = proplists:get_value(key_src_dir, Config), + Fmt = proplists:get_value(fmt, Config), + + System = lists:concat(["system_", ClientAlg, "_", ServerAlg, "_", Fmt]), + SystemDir = filename:join(PrivDir, System), + file:make_dir(SystemDir), + + User = lists:concat(["user_", ClientAlg, "_", ServerAlg, "_", Fmt]), + UserDir = filename:join(PrivDir, User), + file:make_dir(UserDir), + + HostSrcFile = filename:join(KeySrcDir, file(host,ServerAlg)), + HostDstFile = filename:join(SystemDir, file(host,ServerAlg)), + {ok,_} = file:copy(HostSrcFile, HostDstFile), + + UserSrcFile = filename:join(KeySrcDir, file(user,ClientAlg)), + UserDstFile = filename:join(UserDir, file(user,ClientAlg)), + {ok,_} = file:copy(UserSrcFile, UserDstFile), + + UserPubSrcFile = filename:join(KeySrcDir, file(user,ClientAlg)++".pub"), + AuthorizedKeys = filename:join(UserDir, "authorized_keys"), + {ok,_} = file:copy(UserPubSrcFile, AuthorizedKeys), + + [{system_dir,SystemDir}, + {user_dir,UserDir} | Config]; + + false -> + {skip, unsupported_algorithm} + end. + +%%%---------------------------------------------------------------- +file(host, dsa) -> "ssh_host_dsa_key"; +file(host, ecdsa) -> "ssh_host_ecdsa_key"; +file(host, ed25519) -> "ssh_host_ed25519_key"; +file(host, rsa) -> "ssh_host_rsa_key"; +file(user, dsa) -> "id_dsa"; +file(user, ecdsa) -> "id_ecdsa"; +file(user, ed25519) -> "id_ed25519"; +file(user, rsa) -> "id_rsa". + + +supported(public_keys, dsa) -> supported(public_keys, dss); +supported(public_keys, ed448) -> supported(public_keys, eddsa); +supported(public_keys, ed25519) -> supported(public_keys, eddsa); +supported(Type, Alg) -> lists:member(Alg, crypto:supports(Type)). + diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_dsa b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_dsa new file mode 100644 index 0000000000..5167322957 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_dsa @@ -0,0 +1,21 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAABsgAAAAdzc2gtZH +NzAAAAgQDsCchYjb27VZTDJuPwnYQQYZBCnQlVROAfDHa1dmAIQswOm/xFu5RyVpYCQPOY +Y2OBdEibM7/FzaAJUs9gRLfbcCHA9jYy8zjag5KijtPJe9BxoDPAM8bSEFfLDklebS8NDZ +tZvHsSz4UwagBQKNvoTPjljsf7fgjaQ9735S2jmwAAABUAiLuwAwdJr1qlGSmJSFqeM0Ao +18UAAACAMA+NIBNjhzYr4nIhWv1x0TYZ8OldFIEh5iUDRf53ZxcdCloxtfNpZjYJbwEwLK +UUW6xcPEp7/nCVOd50Yk4HgaDV5YvHwhS7g2yFXoK2gHKSa42BfWR4c8fPoMfapWSJ0aQU +xGqebjTDeavwJq5umZCbk9/MfIcSctT9Pn88BncAAACBANMOLq9WhZs3LtechqTpFmXgzQ +zjtoqFYbOd1ERDMXBffyS12aAlrJ1uUTKA1P/XVrIUMNuuXapWY6QwmqSOFVD58QQx9Z4l +itZUu4H+lOSVPHpJrMq45hqmr4Mu35ENtxzNkfQI544/QLlfqkXJ3SME2tUUXAHvTHEnUY +UvvteXAAAB8BiO51oYjudaAAAAB3NzaC1kc3MAAACBAOwJyFiNvbtVlMMm4/CdhBBhkEKd +CVVE4B8MdrV2YAhCzA6b/EW7lHJWlgJA85hjY4F0SJszv8XNoAlSz2BEt9twIcD2NjLzON +qDkqKO08l70HGgM8AzxtIQV8sOSV5tLw0Nm1m8exLPhTBqAFAo2+hM+OWOx/t+CNpD3vfl +LaObAAAAFQCIu7ADB0mvWqUZKYlIWp4zQCjXxQAAAIAwD40gE2OHNiviciFa/XHRNhnw6V +0UgSHmJQNF/ndnFx0KWjG182lmNglvATAspRRbrFw8Snv+cJU53nRiTgeBoNXli8fCFLuD +bIVegraAcpJrjYF9ZHhzx8+gx9qlZInRpBTEap5uNMN5q/Amrm6ZkJuT38x8hxJy1P0+fz +wGdwAAAIEA0w4ur1aFmzcu15yGpOkWZeDNDOO2ioVhs53UREMxcF9/JLXZoCWsnW5RMoDU +/9dWshQw265dqlZjpDCapI4VUPnxBDH1niWK1lS7gf6U5JU8ekmsyrjmGqavgy7fkQ23HM +2R9Ajnjj9AuV+qRcndIwTa1RRcAe9McSdRhS++15cAAAAUfRVtNnUPI+lhQgeu4d1i+H8x +Y9UAAAATdWFiaG5pbEBlbHhhZGxqM3EzMgECAwQFBgc= +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_dsa.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_dsa.pub new file mode 100644 index 0000000000..2f155b6ac9 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_dsa.pub @@ -0,0 +1 @@ +ssh-dss AAAAB3NzaC1kc3MAAACBAOwJyFiNvbtVlMMm4/CdhBBhkEKdCVVE4B8MdrV2YAhCzA6b/EW7lHJWlgJA85hjY4F0SJszv8XNoAlSz2BEt9twIcD2NjLzONqDkqKO08l70HGgM8AzxtIQV8sOSV5tLw0Nm1m8exLPhTBqAFAo2+hM+OWOx/t+CNpD3vflLaObAAAAFQCIu7ADB0mvWqUZKYlIWp4zQCjXxQAAAIAwD40gE2OHNiviciFa/XHRNhnw6V0UgSHmJQNF/ndnFx0KWjG182lmNglvATAspRRbrFw8Snv+cJU53nRiTgeBoNXli8fCFLuDbIVegraAcpJrjYF9ZHhzx8+gx9qlZInRpBTEap5uNMN5q/Amrm6ZkJuT38x8hxJy1P0+fzwGdwAAAIEA0w4ur1aFmzcu15yGpOkWZeDNDOO2ioVhs53UREMxcF9/JLXZoCWsnW5RMoDU/9dWshQw265dqlZjpDCapI4VUPnxBDH1niWK1lS7gf6U5JU8ekmsyrjmGqavgy7fkQ23HM2R9Ajnjj9AuV+qRcndIwTa1RRcAe9McSdRhS++15c= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_ecdsa b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_ecdsa new file mode 100644 index 0000000000..16f8d330e9 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_ecdsa @@ -0,0 +1,9 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAaAAAABNlY2RzYS +1zaGEyLW5pc3RwMjU2AAAACG5pc3RwMjU2AAAAQQQ6WBbp8A+ypG22sM4pqd+973IoBF9a +TcWU237H8NQRf4BbAKlA+NFfi5XHYrRtpW7XCTkdTQn1jdayyq8RtYaGAAAAsHHJLVBxyS +1QAAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBDpYFunwD7Kkbbaw +zimp373vcigEX1pNxZTbfsfw1BF/gFsAqUD40V+LlcditG2lbtcJOR1NCfWN1rLKrxG1ho +YAAAAhAIDK4KZm7jhx4e0gRH/DlLg8WYu+BUDNjmMAgcMLsDv9AAAAE3VhYmhuaWxAZWx4 +YWRsajNxMzIBAgME +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_ecdsa.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_ecdsa.pub new file mode 100644 index 0000000000..162ebd3fb0 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_ecdsa.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBDpYFunwD7Kkbbawzimp373vcigEX1pNxZTbfsfw1BF/gFsAqUD40V+LlcditG2lbtcJOR1NCfWN1rLKrxG1hoY= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_ed25519 b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_ed25519 new file mode 100644 index 0000000000..e2b83c0800 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_ed25519 @@ -0,0 +1,7 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAMwAAAAtzc2gtZW +QyNTUxOQAAACBo2p2XftaIjxYLqNQeIcDrdejVxhTX+db3O5UFV5XdLwAAAJhZQvGOWULx +jgAAAAtzc2gtZWQyNTUxOQAAACBo2p2XftaIjxYLqNQeIcDrdejVxhTX+db3O5UFV5XdLw +AAAECiqNZLTp3o73H+B1VseAJKhEiGXf4otOH461y+sAwBCmjanZd+1oiPFguo1B4hwOt1 +6NXGFNf51vc7lQVXld0vAAAAE3VhYmhuaWxAZWx4YWRsajNxMzIBAg== +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_ed25519.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_ed25519.pub new file mode 100644 index 0000000000..4d2f9f3677 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_ed25519.pub @@ -0,0 +1 @@ +ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIGjanZd+1oiPFguo1B4hwOt16NXGFNf51vc7lQVXld0v uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_rsa b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_rsa new file mode 100644 index 0000000000..243c17cfd2 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_rsa @@ -0,0 +1,27 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAABFwAAAAdzc2gtcn +NhAAAAAwEAAQAAAQEA6helL/aMwpp5cHOCZ5bB8tkpgiXykiV0U61t6K4h7fdud8zOyI9e +N/H9l787QkzOoLBJxzFvTOYcqsC1CMYKNiCvPEtFDZyfD6tZv03nEOc3VZhEO9+pKmnW3y +/7xjRekEW3bqyEk3GkMhnDFfm3JILtZmdRrooXCkVGZaVxELm8N+cEtAE8TCbOIOo1mjsv +x+R8bGktx057EZ8Ieg8tFWh/atFemHj75ZILjY795ji5YQHBHfDUBAwNNY5lCsue4COT6Z +Udv03JgwnCVTu+XsXqH6yemjefU7nvWktudnaKGbg5OS/H2pDrm6ivjRtGdz0gkMiD9miw +Q2n03cFThQAAA8h66iCmeuogpgAAAAdzc2gtcnNhAAABAQDqF6Uv9ozCmnlwc4JnlsHy2S +mCJfKSJXRTrW3oriHt9253zM7Ij1438f2XvztCTM6gsEnHMW9M5hyqwLUIxgo2IK88S0UN +nJ8Pq1m/TecQ5zdVmEQ736kqadbfL/vGNF6QRbdurISTcaQyGcMV+bckgu1mZ1GuihcKRU +ZlpXEQubw35wS0ATxMJs4g6jWaOy/H5HxsaS3HTnsRnwh6Dy0VaH9q0V6YePvlkguNjv3m +OLlhAcEd8NQEDA01jmUKy57gI5PplR2/TcmDCcJVO75exeofrJ6aN59Tue9aS252dooZuD +k5L8fakOubqK+NG0Z3PSCQyIP2aLBDafTdwVOFAAAAAwEAAQAAAQA0vFbuUzCqtnodJyh9 +hazztJBxTXM0EVP/ddaI0JG8Nj2gp3b+H64uFEn44Y/MA9mYwZ4dTbmxLTXQEdG2xEaQox +RXFO3dfycmNIfnXPltCWmh0sesZVqKv4U0im7B3BJhlhMYz6yeOr+uubcFQFhN1WD97NCt +7VX7blfJlle+WGsH6IB728MSlo+pU7desTPaWIamsDTftUkzrIVvgbppmk79XX/zhObIi/ +8xR3cCxygq3LM31LwTOcEnRvMufJOv3lR0ybUE5INtJVYYpqZ2hFaNON+hOTxaAFZ/pJJ1 +zm5XTb9HWSaouLlalzkQONCTucp7qU7PnBnIB/nQ5A0BAAAAgDO683uK2WICRSr2J7E1Q3 +jQ+GqU0c4SslORQ4mwjMbJVMyQwd4U00ctex4XIoQdB6dn17jmvEJa7UiH0+TMm9cJefoL +V8G4O4XThEDIBtF7Kp1oKV9roxVdJ/iS7psMop3g9X+/9L4nOUMxlI21j7YKf3C5KJwhD3 +RAqyE/YClnAAAAgQD6BacnxjxmcFJdCevQcfIhSCwzXp7fjYWK46U9fBF5k+H+GUicfaL6 +LGp0DDBhhpQ/lAzNO5IMn6pPAfl0ZSOsGie9OszSpMujxG1fSTDeUqyf0hL+t7yVrCRTEc +cyl5t0JBSUyoHy0w1B3pXF2vjRtrmqFvTmTrWYJAHxbPePsQAAAIEA77B9KyiCwX8AKubN +AA+nRRdmJfju7yM0xiHO6RfOgSnp9EAMKyoUdVFY1yddxgTQvpGSSigBogJHLB2ptGtmTE +6DtIEtP0SDQGso/Q51AhTtk4ScYlPvZJiXVfRmyibVdxmQqa8+aJcqS0j1cReSmAu5zRQm +zW0/752JsHk3qhUAAAATdWFiaG5pbEBlbHhhZGxqM3EzMg== +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_rsa.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_rsa.pub new file mode 100644 index 0000000000..3042323a71 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/id_rsa.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDqF6Uv9ozCmnlwc4JnlsHy2SmCJfKSJXRTrW3oriHt9253zM7Ij1438f2XvztCTM6gsEnHMW9M5hyqwLUIxgo2IK88S0UNnJ8Pq1m/TecQ5zdVmEQ736kqadbfL/vGNF6QRbdurISTcaQyGcMV+bckgu1mZ1GuihcKRUZlpXEQubw35wS0ATxMJs4g6jWaOy/H5HxsaS3HTnsRnwh6Dy0VaH9q0V6YePvlkguNjv3mOLlhAcEd8NQEDA01jmUKy57gI5PplR2/TcmDCcJVO75exeofrJ6aN59Tue9aS252dooZuDk5L8fakOubqK+NG0Z3PSCQyIP2aLBDafTdwVOF uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_dsa_key b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_dsa_key new file mode 100644 index 0000000000..071d761e46 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_dsa_key @@ -0,0 +1,21 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAABsQAAAAdzc2gtZH +NzAAAAgQDQp0Dp9ne0IXxq93hFwqQi+iOTNqw0GeJlCQvzSYsnLgPzWCj/4o1R6czLdx4/ +6nNWPJVmbManC0gcBwdcJbVXW7nTbW3xnD2LmzyB9dwjka8CgfC/A87MkslY8YCt0ZHz8f +/9L9eRqAv5udHlxgtaX1u81VDVPxAk4bOAAyz4AwAAABUA0pu1vOhk0mBbY9cz+uN+ELA2 +20MAAACAW1PJ1Rau3yNLwzldcoejYt4gOKmAoAUWL9F3fp+IKGhYf6Z6GX5OI/98BE2wWu +3/Kk12K7ZtVyTj2B1JheNjzivsZryNhZwJlCCbFQalkU9C2tApALix2j/PYQy++Hefk8yK +4qFwSG9DTC/TvMKPjaZA5w3TjIkWuC0tGoqvkkwAAACAIRynnqPLhvlyD0wg5F4v7iG+fr +d1JfusrjLobdgBz+d60wyu+0IUuaJdhB1z0TjPdxmkwwrbOzmkAhcRbHduV8HTAY/l0Trp +X8E4b7gzpJwcy/2T1lPx5pIwlcd3TwqwMBQPNOXV8FR2fZYhIARSZy0ccvePc+/XKFmKT6 +jjBCcAAAHwPSMhRT0jIUUAAAAHc3NoLWRzcwAAAIEA0KdA6fZ3tCF8avd4RcKkIvojkzas +NBniZQkL80mLJy4D81go/+KNUenMy3ceP+pzVjyVZmzGpwtIHAcHXCW1V1u5021t8Zw9i5 +s8gfXcI5GvAoHwvwPOzJLJWPGArdGR8/H//S/XkagL+bnR5cYLWl9bvNVQ1T8QJOGzgAMs ++AMAAAAVANKbtbzoZNJgW2PXM/rjfhCwNttDAAAAgFtTydUWrt8jS8M5XXKHo2LeIDipgK +AFFi/Rd36fiChoWH+mehl+TiP/fARNsFrt/ypNdiu2bVck49gdSYXjY84r7Ga8jYWcCZQg +mxUGpZFPQtrQKQC4sdo/z2EMvvh3n5PMiuKhcEhvQ0wv07zCj42mQOcN04yJFrgtLRqKr5 +JMAAAAgCEcp56jy4b5cg9MIOReL+4hvn63dSX7rK4y6G3YAc/netMMrvtCFLmiXYQdc9E4 +z3cZpMMK2zs5pAIXEWx3blfB0wGP5dE66V/BOG+4M6ScHMv9k9ZT8eaSMJXHd08KsDAUDz +Tl1fBUdn2WISAEUmctHHL3j3Pv1yhZik+o4wQnAAAAFQCWaj2vQN6mnxfVgP8YzlPakzQI +WAAAABN1YWJobmlsQGVseGFkbGozcTMyAQIDBAUGBw== +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..97193b1c58 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_dsa_key.pub @@ -0,0 +1 @@ +ssh-dss AAAAB3NzaC1kc3MAAACBANCnQOn2d7QhfGr3eEXCpCL6I5M2rDQZ4mUJC/NJiycuA/NYKP/ijVHpzMt3Hj/qc1Y8lWZsxqcLSBwHB1wltVdbudNtbfGcPYubPIH13CORrwKB8L8DzsySyVjxgK3RkfPx//0v15GoC/m50eXGC1pfW7zVUNU/ECThs4ADLPgDAAAAFQDSm7W86GTSYFtj1zP6434QsDbbQwAAAIBbU8nVFq7fI0vDOV1yh6Ni3iA4qYCgBRYv0Xd+n4goaFh/pnoZfk4j/3wETbBa7f8qTXYrtm1XJOPYHUmF42POK+xmvI2FnAmUIJsVBqWRT0La0CkAuLHaP89hDL74d5+TzIrioXBIb0NML9O8wo+NpkDnDdOMiRa4LS0aiq+STAAAAIAhHKeeo8uG+XIPTCDkXi/uIb5+t3Ul+6yuMuht2AHP53rTDK77QhS5ol2EHXPROM93GaTDCts7OaQCFxFsd25XwdMBj+XROulfwThvuDOknBzL/ZPWU/HmkjCVx3dPCrAwFA805dXwVHZ9liEgBFJnLRxy949z79coWYpPqOMEJw== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_ecdsa_key b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_ecdsa_key new file mode 100644 index 0000000000..3d01041bed --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_ecdsa_key @@ -0,0 +1,9 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAaAAAABNlY2RzYS +1zaGEyLW5pc3RwMjU2AAAACG5pc3RwMjU2AAAAQQT21rZj/MTJN9fK+jDZ6l0bYF1EndNL +N+3a4cAYl8jRhRk18s8QbCN3GP+CsFWtor5fRhragFo2X7yPVAVU75FoAAAAsEntb7pJ7W ++6AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBPbWtmP8xMk318r6 +MNnqXRtgXUSd00s37drhwBiXyNGFGTXyzxBsI3cY/4KwVa2ivl9GGtqAWjZfvI9UBVTvkW +gAAAAhAJVvBMRkEfuS8/YZ9PayecITNQ5CfZ5I49z3Ay17cxbbAAAAE3VhYmhuaWxAZWx4 +YWRsajNxMzIBAgME +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_ecdsa_key.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_ecdsa_key.pub new file mode 100644 index 0000000000..b125971661 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_ecdsa_key.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBPbWtmP8xMk318r6MNnqXRtgXUSd00s37drhwBiXyNGFGTXyzxBsI3cY/4KwVa2ivl9GGtqAWjZfvI9UBVTvkWg= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_ed25519_key b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_ed25519_key new file mode 100644 index 0000000000..0ebf1dc8b7 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_ed25519_key @@ -0,0 +1,7 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAMwAAAAtzc2gtZW +QyNTUxOQAAACBKsbrzown8TYrOXlZYV/D+LICEyw23bwjdXRGfm4FEAwAAAJheMIX9XjCF +/QAAAAtzc2gtZWQyNTUxOQAAACBKsbrzown8TYrOXlZYV/D+LICEyw23bwjdXRGfm4FEAw +AAAEBxNZQd4RXl1DDYt+bm7WeSXlVmncu/bQ/ubdj56T2xV0qxuvOjCfxNis5eVlhX8P4s +gITLDbdvCN1dEZ+bgUQDAAAAE3VhYmhuaWxAZWx4YWRsajNxMzIBAg== +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_ed25519_key.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_ed25519_key.pub new file mode 100644 index 0000000000..0108498194 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_ed25519_key.pub @@ -0,0 +1 @@ +ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIEqxuvOjCfxNis5eVlhX8P4sgITLDbdvCN1dEZ+bgUQD uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_rsa_key b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_rsa_key new file mode 100644 index 0000000000..6d51bf7672 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_rsa_key @@ -0,0 +1,27 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAABFwAAAAdzc2gtcn +NhAAAAAwEAAQAAAQEAt+8ElruXAw+OXtyGBUMxAkSfsw/A7BWqIzbtRn6hD3YlJPFYBo4O +0wNeW4g9z+k5u42Q4Sv3gZAPuVAVi/E4MEd3eg8ZRkkC674a5lUvEzIrDYPbkhzR5bLidG +0TK4wdqL/HRGE9gpTIaOcIDkK2RI2PeRhjvjscUHTsa/Kx6dwBiKOK5vjIXA2MlsTgVY7N +MSpjR/sH/TG6UZXxhlgmBGsrpVsVM/3kQomhVVoMn1yRG6Wz2Ed+b6ENYKNmuomeIoCZoU ++uE0RMqiE5qD32YVExt1B89CVAR3GbQKKTop+Pb1xkNMnYvCpDo8+68dZ7U7zJ1SZr00yd +G0M4pFntDwAAA9At3ILHLdyCxwAAAAdzc2gtcnNhAAABAQC37wSWu5cDD45e3IYFQzECRJ ++zD8DsFaojNu1GfqEPdiUk8VgGjg7TA15biD3P6Tm7jZDhK/eBkA+5UBWL8TgwR3d6DxlG +SQLrvhrmVS8TMisNg9uSHNHlsuJ0bRMrjB2ov8dEYT2ClMho5wgOQrZEjY95GGO+OxxQdO +xr8rHp3AGIo4rm+MhcDYyWxOBVjs0xKmNH+wf9MbpRlfGGWCYEayulWxUz/eRCiaFVWgyf +XJEbpbPYR35voQ1go2a6iZ4igJmhT64TREyqITmoPfZhUTG3UHz0JUBHcZtAopOin49vXG +Q0ydi8KkOjz7rx1ntTvMnVJmvTTJ0bQzikWe0PAAAAAwEAAQAAAQBjIt2rTIJxMOJAeMV3 +cqaonUoiHdySon6oKkOrGjc++SO+DKKwLcMJsqgZ143RUNhAIWY0Jxlo6LfA3swuOB5bzz +kzPY4W1uVPIJCpEsKjqwePakFfOE9daZQqwltxvjyCJpOFZI/doMl/2P37ibNpsY7h6uZf +ssZpCwwehpmj/HknoAlrGTrG2SlzLTMvk6vwYgNoeHKCQfM2wfr9fFlbwNFJE7L44o0PfK +8UX9u8mC7PR1Q1u2OopOsUXWu6f1Vc/nU5La6Z6W1voHxMfUMLhq7c/Jih7SfPVX2z6U22 +VKGXinhh1q5a71nv44BZPxTGw0TC/FrDntTWyDu3jkuhAAAAgQCNZx4JVV+yoFnbypRHh+ +n0hhYvPbtHEzmhK9WEyjQCWIhf7zMXau+00bhDaS+6nqiZOfXPecC9UbjH06KT8da6yqYK +3SwsXA+RALbKe0uqWO1KKufge+FxZWX3j07D/8+pL1fE0996f9yjR06kM8b0afxQBMDxnG +HzVnPJEmUpjAAAAIEA50BnLTKqHsQCiBHRYuzRAXomeW7EWO+lQSB7WUcx91QtuzspoXMK +NyiaabzsPfTqmqRH9fcL1ORSTy4Jk+0tZjK20P+gGtGthHCxQjQnOhgyjvSzp0P7F55Cme +LSr1lYtFtjrh4nLval05ddQ6cYmebzRzy0NveKUbeIgkR5zJEAAACBAMuePyCBm2RB6Hlw +cYqUTJ+zduNFhu83YJ2vQg0ojJ5If9jHNrTHyiRG/k81AJS0fZs9aF6//fvq+85Bf3bGd6 +4PSWbSwjlxLNvbcGqfQ8gOk75lni2hr5e5SQBimGavJM7bjqr3+nqBvAiPrDROWQpALdbh +hVWNOMdo8JBxcW+fAAAAE3VhYmhuaWxAZWx4YWRsajNxMzIBAgMEBQYH +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..0b12e79f63 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/new_format/ssh_host_rsa_key.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC37wSWu5cDD45e3IYFQzECRJ+zD8DsFaojNu1GfqEPdiUk8VgGjg7TA15biD3P6Tm7jZDhK/eBkA+5UBWL8TgwR3d6DxlGSQLrvhrmVS8TMisNg9uSHNHlsuJ0bRMrjB2ov8dEYT2ClMho5wgOQrZEjY95GGO+OxxQdOxr8rHp3AGIo4rm+MhcDYyWxOBVjs0xKmNH+wf9MbpRlfGGWCYEayulWxUz/eRCiaFVWgyfXJEbpbPYR35voQ1go2a6iZ4igJmhT64TREyqITmoPfZhUTG3UHz0JUBHcZtAopOin49vXGQ0ydi8KkOjz7rx1ntTvMnVJmvTTJ0bQzikWe0P uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_dsa b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_dsa new file mode 100644 index 0000000000..f76cc234b0 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_dsa @@ -0,0 +1,12 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvQIBAAKBgQD5eG+xea43Nas9xKOEPqkMaBmTZuKo+nz9S2mo3Qkuj5OV6Mqc +Jd6g9DUylc5XMtyYvq0AImgirc3ZTCOLyH3wXunNDkafUxwxrSO3w68mgdGbjJxZ +euS/dRx6pYmeb/ykWCQFd6D/t1OGK0QJT7gn9ke6pXAL1ARVafP2Yri8rQIVAORv +Zk6erYLd3aAvPNzVSLH6P6CRAoGBAImjtInOXhMXa+7ABuwrvdN78bJX5pSdlgUW +W1Nx1obUb65njR78CqB+fynwxevHDBPNEVE0T5xfAg3zWBTGH/mwQ/ivA3t350hT +usbRBbPs9kzzhfWdq7GKVKL76UmefYU1cwM58VdOFcuMbfUEujwIgw+KbJzI7c6y +DH8ll+s7AoGBAK8z5gZp4k43uEFRsLwhZj4edgb3vmZvOvEzo3awP+Pr2Et4ReL1 +48YYfb422FafzePzCkvkRNMdZF2iiPQXK1r4JIVCfi2Zyci8fMzHmBR3bmvz5cjP +9tVtKGR9z48dYe5R74Td+Vp//h6lCHyi06kSg8yoambE8sdAnp5DdgN6AhUAg8aR +exXtcrukzyrWLA/4jZSnrFY= +-----END DSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_dsa.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_dsa.pub new file mode 100644 index 0000000000..20c42561b0 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_dsa.pub @@ -0,0 +1 @@ +ssh-dss AAAAB3NzaC1kc3MAAACBAPl4b7F5rjc1qz3Eo4Q+qQxoGZNm4qj6fP1LaajdCS6Pk5Xoypwl3qD0NTKVzlcy3Ji+rQAiaCKtzdlMI4vIffBe6c0ORp9THDGtI7fDryaB0ZuMnFl65L91HHqliZ5v/KRYJAV3oP+3U4YrRAlPuCf2R7qlcAvUBFVp8/ZiuLytAAAAFQDkb2ZOnq2C3d2gLzzc1Uix+j+gkQAAAIEAiaO0ic5eExdr7sAG7Cu903vxslfmlJ2WBRZbU3HWhtRvrmeNHvwKoH5/KfDF68cME80RUTRPnF8CDfNYFMYf+bBD+K8De3fnSFO6xtEFs+z2TPOF9Z2rsYpUovvpSZ59hTVzAznxV04Vy4xt9QS6PAiDD4psnMjtzrIMfyWX6zsAAACBAK8z5gZp4k43uEFRsLwhZj4edgb3vmZvOvEzo3awP+Pr2Et4ReL148YYfb422FafzePzCkvkRNMdZF2iiPQXK1r4JIVCfi2Zyci8fMzHmBR3bmvz5cjP9tVtKGR9z48dYe5R74Td+Vp//h6lCHyi06kSg8yoambE8sdAnp5DdgN6 uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_ecdsa b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_ecdsa new file mode 100644 index 0000000000..e0ed11843a --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_ecdsa @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEINRRCrEPoBUJJueQ6IDc7UxpvYi+gzBJkn3pv+yp08tvoAoGCCqGSM49 +AwEHoUQDQgAEKAnppzgUZKpYf6qLbLL1LmTLWPLI7NDjY/+oWE1NqrUrMOM4NXKG +NCTNhLKWtICjfb8h0E3zbCh5PNubVw14WQ== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_ecdsa.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_ecdsa.pub new file mode 100644 index 0000000000..2793c68b70 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_ecdsa.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBCgJ6ac4FGSqWH+qi2yy9S5ky1jyyOzQ42P/qFhNTaq1KzDjODVyhjQkzYSylrSAo32/IdBN82woeTzbm1cNeFk= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_rsa b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_rsa new file mode 100644 index 0000000000..30871b6a67 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_rsa @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEowIBAAKCAQEAtnd1zCAPBkxEHFBQjpt9TOY7epRozetWWBp1wVQYxHMicpwe +2NwuN+3A6Y5r20lhdaElVQ08DBEcJ184sSxv/+8PCu4umiSyqRyrUvdap60InZq1 +Fg50OJMfAGcWjeOp4UrH/nGdJyqdN2Y40eVsXg4pogy7ElG3Q5hROmbC9vpOTkrb +3Krv7JFFXz3vhRkxiYCMNw8hK8TOye9o1JCyVzImZGGwdUA9OZN4Nizoj6ie90KC +VRoI+2GoE0gNy4Mt7P+lOyDBzFeJbGl0ob9S5P3gnyCVUmlV0EY1fSijN8IIOj5l +qsBpADt+sN3iYltZJmCn5wDP/iORn6P04jWU1wIDAQABAoIBAHlncHw5lGWXVvYT +xhWshSkmQsrjdfwUqmWCbXkNkFEdXf0tvSSDE0lpKqL7fO3xnCPc7W7ymFJbDAVy +SNExhO+fyr12DpHG+wykI6XXKH1KFuJuLjCXu2JtGQJ2lL4hjUV2MS0twOdvZh2X +KRUW9gx6ld7ZY5rjvfD+poUaHHygnN6f0+PiyBpUZaL+ZTj/6CpHiCxdZtOCf0o6 +bU7TaPNcZ3vf3Qhk4jk140vEDLJQnPF8stBqPWa9HfmM7CNjWBdmhQXHtHw8CtF6 +aba9BRC/FMYx43itE9hkg6p3JrSqAN/gZ6RCXLog6mQYttJV+y8oLTXvblT2Y3c9 +YjnigGkCgYEA2Y4+sjsGw3l5HnQ9CNuUQvJZgloVd/NTw8/UXXkV1QudI6tzmMJn +XAxCCtt2DVlPBqFJ74uwdWpY0nwFJslEp4sV6VPv2TpBmAOPDB6QtQ8SXhFWQ7vj +BVh5kwl3LUDVI+NIACoaMyZuS6N97Fp4a/mKtgj+ucOkfr15+IF7L/UCgYEA1rXd +ATBFQlLoPuv3VglU1LLgaLs/3qzoBH9DzwPPyEFdWYQUCuMHsL9eEfDZMsG/GeZb +Fch/CR0R2Qt+ZlcxcRichgMw3ydzIBqCvLe444lBzxdLWFqS5gCnSh5iage2QRs0 ++6QD9O16HJER6HmBwR6DtwpP3N4dHxLXJRjDrhsCgYEAl3/M/UTJkvpWc/SyRCbU ++kHWP0YIST2ziVqDIoydvXyW8y4EE87dN2Z53yGw9d7Jf252FFCMk1d5fypKVBY4 +rwvWOGPxVK6S2w8vYFswnkVenw8nqYd/sktIbjJbQbIyOwmdLDAlipUqnZW+rQbb +cSWXiOh+qlIpjPDZrUpNxLkCgYAMPjiI7dC1NHcLx3bGECgnLMABGNROhTuBriQW +tNfvSlLhXNeru0BgArmBemNYMpYMCwecmV8tDNxMrQwbF9O46DdcqOfrgZtd9EUK +L8u6JcR7448nTZrcxKLFZjAkbaYl1kBSLQsQt03kPR1xTSRp96x5Dnx5Uq0EbZWZ +Bu15iwKBgAlSiCUqCNir3fdd0wE2+MIczam3YshQmnS3/XEk+7Bmfmb7Rxdwk94l +P/SaQYZ3buCKoBTz5OveBl4aEdiyvEqBkeJoUbzwFILyo0RNncqULcrYAPIJtbKK +H0o0naCZUgUJGsX0/DdJsEE27KMljc1A1Fpd3qQ2qqVLFfDTrsuB +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_rsa.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_rsa.pub new file mode 100644 index 0000000000..f7b1180aad --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/id_rsa.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC2d3XMIA8GTEQcUFCOm31M5jt6lGjN61ZYGnXBVBjEcyJynB7Y3C437cDpjmvbSWF1oSVVDTwMERwnXzixLG//7w8K7i6aJLKpHKtS91qnrQidmrUWDnQ4kx8AZxaN46nhSsf+cZ0nKp03ZjjR5WxeDimiDLsSUbdDmFE6ZsL2+k5OStvcqu/skUVfPe+FGTGJgIw3DyErxM7J72jUkLJXMiZkYbB1QD05k3g2LOiPqJ73QoJVGgj7YagTSA3Lgy3s/6U7IMHMV4lsaXShv1Lk/eCfIJVSaVXQRjV9KKM3wgg6PmWqwGkAO36w3eJiW1kmYKfnAM/+I5Gfo/TiNZTX uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_dsa_key b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_dsa_key new file mode 100644 index 0000000000..99da9723ef --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_dsa_key @@ -0,0 +1,12 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQDLRBMHSgExTaMVjXrZwxdgmkpZgjQXGy/IUqBNw9MTq1AmndGH +6Pkj3LzPiNsZArTwg3k0strcx+VtbQcJ1TrH7nOABdO5vTGAd9arPIkhts0LgwHA +HcAHf+9iNr26uG8jtIc7+o7IpJyTzy2buVmfosYhKcwVbPHIhQp8KjAWfQIVAPd+ +7YzKkxRyBPZZ4K+G3QI3YJiPAoGBAKGRI74EwgLwRWMeVOJun7oWh0uVQFdi51sY +3e9JC4/0hx0D0JHO2+b3opGPw/wrVXmGWZdmgpslsPZbta/oVR0OgAK4V2tTgn8p +ijOIcEJmvpogtaJj40laTV+mpwRfQZWsfJPYTibZqtPVvvtu+6eVB1dTlNYngOAN +mDHh6wpzAoGATv2nRnv0l878aIchG99kKFq5hX1rfLOYqeDq5uKXHu+Zf9IDPEQB +Dmo73RA4pXWlD8Kf9mV3p5CSxg3tdSTelCt7h0cVoq3LmSU5fjA8eVNI7KsFi9QB +dBnxEdMIBW2S8x4FfuWzgBUrQBzLqLR0CEEPmr1N9Dw63OiTgh9drJcCFHmpYuRa +y/ynGrBb/mzt9QAGhNls +-----END DSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..485997cfb9 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_dsa_key.pub @@ -0,0 +1 @@ +ssh-dss AAAAB3NzaC1kc3MAAACBAMtEEwdKATFNoxWNetnDF2CaSlmCNBcbL8hSoE3D0xOrUCad0Yfo+SPcvM+I2xkCtPCDeTSy2tzH5W1tBwnVOsfuc4AF07m9MYB31qs8iSG2zQuDAcAdwAd/72I2vbq4byO0hzv6jsiknJPPLZu5WZ+ixiEpzBVs8ciFCnwqMBZ9AAAAFQD3fu2MypMUcgT2WeCvht0CN2CYjwAAAIEAoZEjvgTCAvBFYx5U4m6fuhaHS5VAV2LnWxjd70kLj/SHHQPQkc7b5veikY/D/CtVeYZZl2aCmyWw9lu1r+hVHQ6AArhXa1OCfymKM4hwQma+miC1omPjSVpNX6anBF9Blax8k9hOJtmq09W++277p5UHV1OU1ieA4A2YMeHrCnMAAACATv2nRnv0l878aIchG99kKFq5hX1rfLOYqeDq5uKXHu+Zf9IDPEQBDmo73RA4pXWlD8Kf9mV3p5CSxg3tdSTelCt7h0cVoq3LmSU5fjA8eVNI7KsFi9QBdBnxEdMIBW2S8x4FfuWzgBUrQBzLqLR0CEEPmr1N9Dw63OiTgh9drJc= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_ecdsa_key b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_ecdsa_key new file mode 100644 index 0000000000..75ba71da56 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_ecdsa_key @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIJeZs+jukpumHYLii4OXg5k9dN7u1aNLZovxbqFoEfgToAoGCCqGSM49 +AwEHoUQDQgAEBg0zAjfzxl0ccv2wnJHZvLXETa6bopctXD1V/FWcPoBL5dh42mOj +I6ZgtrUnnjbhdxJyeG3BjntqhP5rLMMpeA== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_ecdsa_key.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_ecdsa_key.pub new file mode 100644 index 0000000000..26e7285240 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_ecdsa_key.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBAYNMwI388ZdHHL9sJyR2by1xE2um6KXLVw9VfxVnD6AS+XYeNpjoyOmYLa1J5424XcScnhtwY57aoT+ayzDKXg= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_rsa_key b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_rsa_key new file mode 100644 index 0000000000..6044fc7725 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_rsa_key @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEogIBAAKCAQEArrzkBUAMYvAso4hR79vmNbxNbLYt7QocukbiCWOq29HQvqbS +zj/OSE1Qg6C/aTbghvdpvxbaFt3aqdWroF0PhVVoEsJY76bI7RsobIe9zI/Z3dkQ +RmW3IyjHvpVBwy84fKZ05A8Bd10kca1GfrQXi7LkFZ5FRjxarFzMojGVesWcZLag +ThPG0QAjSw2sG+oql4YoIeagSdf3tzOOF+04vcpgqCRugsscw17lI1Rwq0nM3thU +BgSWDRbjzmkWo9i5Wpc9ZKS1z4ANET+I2hGW7PEA6XAXJKC6nIWdVIie0GN02C/m +i45NyTPn52I/TJKFAtIoZ8fbrHEepX7V/Dt7DQIDAQABAoIBAA1yJY2t3wYh+x1e +WQe/ARjzc3XBEwmhdJJ07+HPFI+ztn9lMOWEDWiM4nwue2wqN97K3Q1CQefujGvz +MDC32IDnEIoZAGT4jY+JPnQTgexiyV4D3Pe9zfjbo3sr2xKc6JjW6jm+WduIhExn +C/yl+QXb7ycmtafw7v1CatC0Rg9bUtE8nMHKYVPazn30wlHdPl6TyTtEXoZCKMg2 +OTxrva80x5JboUqLZXX41VqVmqqoakEO3NOGlhrIzIOB866py8d+f6wilN/rUcGe +MJwB8aTrYPxLkCYl9PGeMDMLARvhjMm53f6UQFDpL2rY0XpnaqrZqS9KrbJoTQDW +lMj3OiECgYEA4FL3fba4FYGzf7T/m2xRSC5qrpr0gNn1mZJ5oUWGiHBwjAHC7EVW +apcjskac7WrznIBJiV2ozzxQOgIymuYO9LX95G6b3nrkWhVXqUiyCkpdMSE/YVfA +iMc3Z0QNz+I/cbEPUKZ7osKPZm4BRpUNvJwj4Vvt5jXwTZlPmVmpNHUCgYEAx2lx +q6HO+Grba0Azg7wobnnZ8uZZvdZ+QpxgGhH1Rx9862KM+uVYrJ7xEUlNTYfBtdpq +JXQnGlpzjGPeziZjJxv7AgWbJA80aXtTH/oE9E0KMmGRzE2bQNR8kUZHU5S2e0u+ +x1DUyvKqyKSRByxUp8wj5QZGPOH4MPvCHVZF+TkCgYAg52qQERYtaWn36Ie5t4iw +qsZROD93CwGAdkDLDBSwvLV1g+igmYcUeXjt9HeeR5rWMOcYdBmH1FP8PkhH+kjl +UjCcqjDI0IPgRtMl7JjY85F53GOclq+SII6a4huYi5o8xfj2HoVyGVHJd4dOYBy0 +tr54lvBtXSoTZ9KKLuGn5QKBgBUy4XGkfvMrsO3C4ncTrpyn+YJ3+HxU7BE6vICo +/hE0iLwhOumFLhsTvn7e8wfV8cLaWERpB6smiHgZOdtie1HyCIobfHWl5CV+hcS1 +eIdcFURr2OsGKQYIUMHE3dpFyexrjfl0X1q/12YDEKPZk5pO+lXjh937C75xVR53 +SHMJAoGAS57QNKLFaWZunoMNuvvNAj7Z0q1JrFuLEwfnkG28g5+ov3wIBinPtlrr +3HaK6sny0hHLPoRP+fa6BVRaQhDzeeKDu6PqNEkNnocWPi79lxfk531EJQHOgQgX +yt7Ruq0TlBYs5wGrmtYXLKAGvcfyx9EoFs2Km1iNKqu6b/dbQXc= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..8e62458395 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format/ssh_host_rsa_key.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCuvOQFQAxi8CyjiFHv2+Y1vE1sti3tChy6RuIJY6rb0dC+ptLOP85ITVCDoL9pNuCG92m/FtoW3dqp1augXQ+FVWgSwljvpsjtGyhsh73Mj9nd2RBGZbcjKMe+lUHDLzh8pnTkDwF3XSRxrUZ+tBeLsuQVnkVGPFqsXMyiMZV6xZxktqBOE8bRACNLDawb6iqXhigh5qBJ1/e3M44X7Ti9ymCoJG6CyxzDXuUjVHCrScze2FQGBJYNFuPOaRaj2Llalz1kpLXPgA0RP4jaEZbs8QDpcBckoLqchZ1UiJ7QY3TYL+aLjk3JM+fnYj9MkoUC0ihnx9uscR6lftX8O3sN uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_dsa b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_dsa new file mode 100644 index 0000000000..5420f40352 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_dsa @@ -0,0 +1,15 @@ +-----BEGIN DSA PRIVATE KEY----- +Proc-Type: 4,ENCRYPTED +DEK-Info: AES-128-CBC,C5C1380D397337A7425EF5FE7B2A01B5 + +/xZ9L6iKTvN6AbZu3Uper6DzMxLdhGMix9UB9pq3JXJAElZRfP5LkAYBX+3mYYXu +VGYsMsHrPLtItgDQQ7DNhbo+IOoC3Id7gIssxitXaNbuDs91ahMANzYPeypV71+U +fgNnznaTIL2yl6pr342IFksCw1lt9L6Z3nnslUO/4mwbESL7nIe2WDpxdAxIYQSw +QetL8FoP0ohyMvNdrmooJ48oJylR3Uctir1Szb6Rg65LEuvasY0SbJhDaS+weN9c ++dRgPTrZmIhohEy5FT52JqsSaONxM0NVV8wmkw0uX642cYpPU1WkVDK5RwXExiR0 +5hORAu1lqdCGG8M1KNutn/8ASN+ger79Jccp9Ity9TP3I2RbSFJCR8byysIJoFdF +Pb6ju+SRmtMBmrIMaAQdO10zAeBdVq78ALiK78Jw8D2ciA1zRnzvzBCoQhKw4dxU +XmD4V2qBVUuYFKms6Z/LRnjvShooQgmCm4CtX7RehQFTlbrJJcrfEaJdrb84d9QK +uY/lY/47tSsyC8YIK9ta9uyLgvxOmPvfKSA5lJpTPk0oEeRJEmtrMzDhfB4tXR7p ++d1F5kWJlTVdsYOpd1li28LpAu/YJrop85QP75TV/F8= +-----END DSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_dsa.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_dsa.pub new file mode 100644 index 0000000000..2ce1d597f4 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_dsa.pub @@ -0,0 +1 @@ +ssh-dss AAAAB3NzaC1kc3MAAACBALpx1AMh2SgvU5KTZLYlMMADqt46X/7KrXNiM/JbCG2vsUg+Pf1k24J5DThLH7Ex0o5ghmd4xrCi9hMrkcNe+RI1KU2B68mIrddGYmL9nLCwWf4loKmzVnTY+RCjBT7YRKOT4H9B1gF33kpRellmd+x7zVFSM1DbEdKjuPA9wseFAAAAFQD1R2qkuiiy67GoE6nErIaFH7cOIwAAAIEAqcswmM+/NrpXfaEF+mCUN1ylnO/YF2arqJp+CvAzSB9VhGnk7+hAX6vbQ+iQg6pDL8OOtky5fYqwlGdLJ4rTMiZuOOYx8grxgUxjMCmLCq3exH5VpXQnbcffZ+Zrqv6HtpqenLZgJxxcNG27oH/n4CLSoQOw0+AeJ8/NzIU8A68AAACBAJnnmAXlF9QW408bw9t0hNZDtacPDdiRENJaSVsb37+gTQvJPMfr6YpvDh2PO0ODg9Omwqddm/YpLAQAJ2tWzRMuxoI18ikcFWPveetaDZS/1eEPrTY3SMitmevrdCXGSpdEuvidbXNdW874MtmP5E4hW4vVe7wJkCEZ0hCL8AcN uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_ecdsa b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_ecdsa new file mode 100644 index 0000000000..3108bf688f --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_ecdsa @@ -0,0 +1,8 @@ +-----BEGIN EC PRIVATE KEY----- +Proc-Type: 4,ENCRYPTED +DEK-Info: AES-128-CBC,E2E108EACB898D6E55241106B2CDEC45 + +hAmOR9aVIF2RNJet/vFVGgsx9Jh1/r02FJEPMWcdfSMgxJMfjKfCpKDqY72+Idzs ++WVk/Nr6s/TzNZwOH4WJV2ObZ1EG9yClHPPnAYsgoog88JhW5RRwEaa5X7oHFmVc +zK1cixK5qc39SUiAGGn0PWcnx6qVVWd1KIWbqFzV5Hs= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_ecdsa.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_ecdsa.pub new file mode 100644 index 0000000000..8854f3be20 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_ecdsa.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBGcNr/NDr9ueJUzkYyy/MdhK5CFFJKcTIYMod81dlhvhtynWgE7B/eW5hdKwuUm07FLu6lOw14s39VCQ/WVPox4= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_rsa b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_rsa new file mode 100644 index 0000000000..a74e47862c --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_rsa @@ -0,0 +1,30 @@ +-----BEGIN RSA PRIVATE KEY----- +Proc-Type: 4,ENCRYPTED +DEK-Info: AES-128-CBC,B965F2149914DA8A54DD98275B94EC1C + +QRDCx1Taj7lBQRhLiPs8WLLsSSd8AKK/mzRUOwuf3E0VdrP20LLtcjn5xm9+zj91 +BQgPZshoB4eP2j2exJfTOOIkBdzjF3gYz/QyrSJ8fjdIA/MDzHcrv+HDpMes6gCP +UTb4daKtBmae/fnRoUJtOJeyfQsJT4HqSRuGitvp+/47TdiD8N4GeBO/buMGEch0 +zw89/9w5bGrn7cPYo6mB5WWjxBcGM0ertCJ4x+uU+QRaohXnatgVpaydCYIzbhdS +/thmlNEFizDtfSAoZQlGv30DXQWsvoYdDVZLtRPvYnNifTrcPBkfy/Etl9cgwmFT ++3aF8pQKppdGSeR5vaT5ardjyWEhoM1hVlucWzBjbhlWLeozjzMyT74lxw3hSiJW +KJsoFHrFsfMB1G4cfI/gANbaFOc834w5GHxrz6PCHnWwDLulnhMTPDv1Pu6tg+8Z ++Dxu8pVIehnNUifj9OfPfY+ZNIbdroRavYr/YXB+16lyP1u4r1/rbIbBWTorebLw +8Z6Yc1q4svnhiytWoyfzF3UQotCucZ13tHN3OaQ/u0SQnckYU1SdlGJqSvLW8N7S +Yx5jW5mFbuOAQbvzs2CgeO/ooXq0KNVTYOkr3neN6PMk4WYcEsagmaqhMfIFVCBJ +Fc4GFXbkSO4KKqRysGnnEt4sI9TJX9uIBVTtg38Q4rGisGMejD4f7eTjwqSMy4Xy +ETF2+JQW5rJTnMstAqA1RvGxqpsZXNxx4+pLSeHTe0xIC+LuB92THXiD1a5xcQa3 +RS2s8CT4trOqKLLr22eRkV2XfEG+v1LEcp2uVyjBVM8CPKRP6w5KNnut19CA7AnQ +WVVeNRGdVEtvId/kq2J91ZGTUWkmjgapTY+xhFNX67Sx0kwuosb2N1SvR6FidWIH +d7xCHf/WO2aKuQgLv5fVvPqN4vPM/VMd8Vsx4y5IxUne0dkSYtk5iAeHwS+b3sti +sMQAEauF8clt+jUXSGX4vSLIAc8JYSLxDRr2yy6q8dzdQ77pqqcFgg7Fa6tLKNQ6 +Op1eknVzPRDUDyaDr0mlE9pnSde1g++mEwEca4VORLljEQpf6vYDD/bDnyEfTXoA +d1zt06X8OHAubtG8GcLilw9rMglWLthX+ymHqC1UWMOzgBpua6mffDb2I4qYWR29 +NPdEF1u0PKlzT7fqBE4tpiL4OY5lT/vcNDmf6cq59KKgSVYTzADTH/nQ6eLTkTgt +pU4L60NtCIsn5r2xqwMI8R2f9gjqIwjn45BkqqJBq2vdTlyW6m0vdUdYnGHRkA0c +fU1XOYUHUPi7Wa9MfcwyKYe55zMo7zspa0kIVOgkwfMVSnFr1eDM4jTNfaWFjIf0 +xEqnF6sOGO+KefL7nscJHfX7UipASXO3cWl26YvT5sJPCbwOZSNS3S+6+YCfimLn +kNxWOUBDuHMWOsUDc26lh7YtBaImsLrM8eqdz8vRP2V9WH5RoHu0WT43HMZkWYZd +FQeE5fNUPTAJb/PLOyh9LZQ4BibDE4ZbikEJfj1ut9+4C5aWt2NKmwSnDnJTCu3J +qUeSlk0zIZXLbRsnK6TBQLVXc4cnZrVeb/Dfb2fropioh0f/WFusO5TKuP88XcSG +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_rsa.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_rsa.pub new file mode 100644 index 0000000000..469a6ceb7c --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/id_rsa.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDRAvJCrHYBhf5riHOyqBFfBCBZpKXf2zIc3iwbwY2xl/CHkEwZujBHe2KX1O1h8m7TpUNKMcdGNinsloZsDVKW2VEN7yT6oe3M2fyHLXDfd1KTyINF7LXqgtVq9+A8iLYdOBat7JBkY6c18pMvVU6yCWyr3m8+lnGskCW7swthANbwuW42PvyFdZf9/CkzNIVY6SsAF8wdXdf830wDIimZpN+ER8sLDGcu7dIaoypvs2KlCqwS6DE9kN7X2zXrxZA4thFsoJafgPDCaMOLRkCD2L8NBlRjXBE/U/sOb46oOfZTUy2wjo7pPwp9zekEO8l7OPZ9VgZ5bxXU+WTWox+z uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_dsa_key b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_dsa_key new file mode 100644 index 0000000000..99da9723ef --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_dsa_key @@ -0,0 +1,12 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQDLRBMHSgExTaMVjXrZwxdgmkpZgjQXGy/IUqBNw9MTq1AmndGH +6Pkj3LzPiNsZArTwg3k0strcx+VtbQcJ1TrH7nOABdO5vTGAd9arPIkhts0LgwHA +HcAHf+9iNr26uG8jtIc7+o7IpJyTzy2buVmfosYhKcwVbPHIhQp8KjAWfQIVAPd+ +7YzKkxRyBPZZ4K+G3QI3YJiPAoGBAKGRI74EwgLwRWMeVOJun7oWh0uVQFdi51sY +3e9JC4/0hx0D0JHO2+b3opGPw/wrVXmGWZdmgpslsPZbta/oVR0OgAK4V2tTgn8p +ijOIcEJmvpogtaJj40laTV+mpwRfQZWsfJPYTibZqtPVvvtu+6eVB1dTlNYngOAN +mDHh6wpzAoGATv2nRnv0l878aIchG99kKFq5hX1rfLOYqeDq5uKXHu+Zf9IDPEQB +Dmo73RA4pXWlD8Kf9mV3p5CSxg3tdSTelCt7h0cVoq3LmSU5fjA8eVNI7KsFi9QB +dBnxEdMIBW2S8x4FfuWzgBUrQBzLqLR0CEEPmr1N9Dw63OiTgh9drJcCFHmpYuRa +y/ynGrBb/mzt9QAGhNls +-----END DSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..485997cfb9 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_dsa_key.pub @@ -0,0 +1 @@ +ssh-dss AAAAB3NzaC1kc3MAAACBAMtEEwdKATFNoxWNetnDF2CaSlmCNBcbL8hSoE3D0xOrUCad0Yfo+SPcvM+I2xkCtPCDeTSy2tzH5W1tBwnVOsfuc4AF07m9MYB31qs8iSG2zQuDAcAdwAd/72I2vbq4byO0hzv6jsiknJPPLZu5WZ+ixiEpzBVs8ciFCnwqMBZ9AAAAFQD3fu2MypMUcgT2WeCvht0CN2CYjwAAAIEAoZEjvgTCAvBFYx5U4m6fuhaHS5VAV2LnWxjd70kLj/SHHQPQkc7b5veikY/D/CtVeYZZl2aCmyWw9lu1r+hVHQ6AArhXa1OCfymKM4hwQma+miC1omPjSVpNX6anBF9Blax8k9hOJtmq09W++277p5UHV1OU1ieA4A2YMeHrCnMAAACATv2nRnv0l878aIchG99kKFq5hX1rfLOYqeDq5uKXHu+Zf9IDPEQBDmo73RA4pXWlD8Kf9mV3p5CSxg3tdSTelCt7h0cVoq3LmSU5fjA8eVNI7KsFi9QBdBnxEdMIBW2S8x4FfuWzgBUrQBzLqLR0CEEPmr1N9Dw63OiTgh9drJc= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_ecdsa_key b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_ecdsa_key new file mode 100644 index 0000000000..75ba71da56 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_ecdsa_key @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIJeZs+jukpumHYLii4OXg5k9dN7u1aNLZovxbqFoEfgToAoGCCqGSM49 +AwEHoUQDQgAEBg0zAjfzxl0ccv2wnJHZvLXETa6bopctXD1V/FWcPoBL5dh42mOj +I6ZgtrUnnjbhdxJyeG3BjntqhP5rLMMpeA== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_ecdsa_key.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_ecdsa_key.pub new file mode 100644 index 0000000000..26e7285240 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_ecdsa_key.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBAYNMwI388ZdHHL9sJyR2by1xE2um6KXLVw9VfxVnD6AS+XYeNpjoyOmYLa1J5424XcScnhtwY57aoT+ayzDKXg= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_rsa_key b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_rsa_key new file mode 100644 index 0000000000..6044fc7725 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_rsa_key @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEogIBAAKCAQEArrzkBUAMYvAso4hR79vmNbxNbLYt7QocukbiCWOq29HQvqbS +zj/OSE1Qg6C/aTbghvdpvxbaFt3aqdWroF0PhVVoEsJY76bI7RsobIe9zI/Z3dkQ +RmW3IyjHvpVBwy84fKZ05A8Bd10kca1GfrQXi7LkFZ5FRjxarFzMojGVesWcZLag +ThPG0QAjSw2sG+oql4YoIeagSdf3tzOOF+04vcpgqCRugsscw17lI1Rwq0nM3thU +BgSWDRbjzmkWo9i5Wpc9ZKS1z4ANET+I2hGW7PEA6XAXJKC6nIWdVIie0GN02C/m +i45NyTPn52I/TJKFAtIoZ8fbrHEepX7V/Dt7DQIDAQABAoIBAA1yJY2t3wYh+x1e +WQe/ARjzc3XBEwmhdJJ07+HPFI+ztn9lMOWEDWiM4nwue2wqN97K3Q1CQefujGvz +MDC32IDnEIoZAGT4jY+JPnQTgexiyV4D3Pe9zfjbo3sr2xKc6JjW6jm+WduIhExn +C/yl+QXb7ycmtafw7v1CatC0Rg9bUtE8nMHKYVPazn30wlHdPl6TyTtEXoZCKMg2 +OTxrva80x5JboUqLZXX41VqVmqqoakEO3NOGlhrIzIOB866py8d+f6wilN/rUcGe +MJwB8aTrYPxLkCYl9PGeMDMLARvhjMm53f6UQFDpL2rY0XpnaqrZqS9KrbJoTQDW +lMj3OiECgYEA4FL3fba4FYGzf7T/m2xRSC5qrpr0gNn1mZJ5oUWGiHBwjAHC7EVW +apcjskac7WrznIBJiV2ozzxQOgIymuYO9LX95G6b3nrkWhVXqUiyCkpdMSE/YVfA +iMc3Z0QNz+I/cbEPUKZ7osKPZm4BRpUNvJwj4Vvt5jXwTZlPmVmpNHUCgYEAx2lx +q6HO+Grba0Azg7wobnnZ8uZZvdZ+QpxgGhH1Rx9862KM+uVYrJ7xEUlNTYfBtdpq +JXQnGlpzjGPeziZjJxv7AgWbJA80aXtTH/oE9E0KMmGRzE2bQNR8kUZHU5S2e0u+ +x1DUyvKqyKSRByxUp8wj5QZGPOH4MPvCHVZF+TkCgYAg52qQERYtaWn36Ie5t4iw +qsZROD93CwGAdkDLDBSwvLV1g+igmYcUeXjt9HeeR5rWMOcYdBmH1FP8PkhH+kjl +UjCcqjDI0IPgRtMl7JjY85F53GOclq+SII6a4huYi5o8xfj2HoVyGVHJd4dOYBy0 +tr54lvBtXSoTZ9KKLuGn5QKBgBUy4XGkfvMrsO3C4ncTrpyn+YJ3+HxU7BE6vICo +/hE0iLwhOumFLhsTvn7e8wfV8cLaWERpB6smiHgZOdtie1HyCIobfHWl5CV+hcS1 +eIdcFURr2OsGKQYIUMHE3dpFyexrjfl0X1q/12YDEKPZk5pO+lXjh937C75xVR53 +SHMJAoGAS57QNKLFaWZunoMNuvvNAj7Z0q1JrFuLEwfnkG28g5+ov3wIBinPtlrr +3HaK6sny0hHLPoRP+fa6BVRaQhDzeeKDu6PqNEkNnocWPi79lxfk531EJQHOgQgX +yt7Ruq0TlBYs5wGrmtYXLKAGvcfyx9EoFs2Km1iNKqu6b/dbQXc= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..8e62458395 --- /dev/null +++ b/lib/ssh/test/ssh_pubkey_SUITE_data/old_format_passphrase/ssh_host_rsa_key.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCuvOQFQAxi8CyjiFHv2+Y1vE1sti3tChy6RuIJY6rb0dC+ptLOP85ITVCDoL9pNuCG92m/FtoW3dqp1augXQ+FVWgSwljvpsjtGyhsh73Mj9nd2RBGZbcjKMe+lUHDLzh8pnTkDwF3XSRxrUZ+tBeLsuQVnkVGPFqsXMyiMZV6xZxktqBOE8bRACNLDawb6iqXhigh5qBJ1/e3M44X7Ti9ymCoJG6CyxzDXuUjVHCrScze2FQGBJYNFuPOaRaj2Llalz1kpLXPgA0RP4jaEZbs8QDpcBckoLqchZ1UiJ7QY3TYL+aLjk3JM+fnYj9MkoUC0ihnx9uscR6lftX8O3sN uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index 4ecec4e79d..a8436ab53b 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -86,7 +86,7 @@ groups() -> directory_to_tar, binaries_to_tar, null_crypto_tar, simple_crypto_tar_small, simple_crypto_tar_big, read_tar, read_null_crypto_tar, read_crypto_tar, - aes_cbc256_crypto_tar, aes_ctr_stream_crypto_tar + block_size_1_crypto_tar, block_size_16_crypto_tar ]}, {write_read_tests, [], [open_close_file, open_close_dir, read_file, read_dir, @@ -1017,54 +1017,10 @@ read_crypto_tar(Config) -> chk_tar(NameBins, Config, [{crypto,Cr}]). %%-------------------------------------------------------------------- -aes_cbc256_crypto_tar(Config) -> - ChPid2 = proplists:get_value(channel_pid2, Config), - NameBins = lists:sort( - [{"b1",<<"A binary">>}, - {"b2",list_to_binary(lists:duplicate(750000,"a"))}, - {"d1",fn("d1",Config)} % Dir - ]), - Key = <<"This is a 256 bit key. Boring...">>, - Ivec0 = crypto:strong_rand_bytes(16), - DataSize = 1024, % data_size rem 16 = 0 for aes_cbc - - Cinitw = fun() -> {ok, Ivec0, DataSize} end, - Cinitr = fun() -> {ok, Ivec0, DataSize} end, - - Cenc = fun(PlainBin,Ivec) -> - CipherBin = crypto:block_encrypt(aes_cbc256, Key, Ivec, PlainBin), - {ok, CipherBin, crypto:next_iv(aes_cbc,CipherBin), DataSize} - end, - Cdec = fun(CipherBin,Ivec) -> - PlainBin = crypto:block_decrypt(aes_cbc256, Key, Ivec, CipherBin), - {ok, PlainBin, crypto:next_iv(aes_cbc,CipherBin), DataSize} - end, - - Cendw = fun(PlainBin, _) when PlainBin == <<>> -> {ok, <<>>}; - (PlainBin, Ivec) -> - CipherBin = crypto:block_encrypt(aes_cbc256, Key, Ivec, - pad(16,PlainBin)), %% Last chunk - {ok, CipherBin} - end, +block_size_16_crypto_tar(Config) -> cipher_crypto_tar(aes_256_cbc, Config). +block_size_1_crypto_tar(Config) -> cipher_crypto_tar(aes_256_ctr, Config). - Cw = {Cinitw,Cenc,Cendw}, - TarFileName = proplists:get_value(tar_filename, Config), - SftpTarFileName = w2l(Config, TarFileName), - - {ok,HandleWrite} = ssh_sftp:open_tar(ChPid2, SftpTarFileName, [write,{crypto,Cw}]), - [ok = erl_tar:add(HandleWrite, Bin, Name, [verbose]) || {Name,Bin} <- NameBins], - ok = erl_tar:close(HandleWrite), - - Cr = {Cinitr,Cdec}, - chk_tar(NameBins, Config, [{crypto,Cr}]). - - -pad(BlockSize, Bin) -> - PadSize = (BlockSize - (size(Bin) rem BlockSize)) rem BlockSize, - list_to_binary( lists:duplicate(PadSize,0) ). - -%%-------------------------------------------------------------------- -aes_ctr_stream_crypto_tar(Config) -> +cipher_crypto_tar(Cipher, Config) -> ChPid2 = proplists:get_value(channel_pid2, Config), NameBins = lists:sort( [{"b1",<<"A binary">>}, @@ -1074,22 +1030,25 @@ aes_ctr_stream_crypto_tar(Config) -> Key = <<"This is a 256 bit key. Boring...">>, Ivec0 = crypto:strong_rand_bytes(16), - Cinitw = Cinitr = fun() -> {ok, crypto:stream_init(aes_ctr,Key,Ivec0)} end, + Cinitw = fun() -> {ok, crypto:crypto_init(Cipher,Key,Ivec0,[{encrypt,true}, + {padding,zero}])} end, + Cinitr = fun() -> {ok, crypto:crypto_init(Cipher,Key,Ivec0,false)} end, Cenc = fun(PlainBin,State) -> - {NewState,CipherBin} = crypto:stream_encrypt(State, PlainBin), - {ok, CipherBin, NewState} + CipherBin = crypto:crypto_update(State, PlainBin), + {ok, CipherBin, State} end, Cdec = fun(CipherBin,State) -> - {NewState,PlainBin} = crypto:stream_decrypt(State, CipherBin), - {ok, PlainBin, NewState} + PlainBin = crypto:crypto_update(State, CipherBin), + {ok, PlainBin, State} end, - Cendw = fun(PlainBin, _) when PlainBin == <<>> -> {ok, <<>>}; - (PlainBin, Ivec) -> - CipherBin = crypto:block_encrypt(aes_cbc256, Key, Ivec, - pad(16,PlainBin)), %% Last chunk - {ok, CipherBin} + Cendw = fun(PlainBin, State) -> + CipherBin1 = crypto:crypto_update(State, PlainBin), + Sz1 = size(CipherBin1), + CipherBin2 = crypto:crypto_final(State), + Sz2 = size(CipherBin2), + {ok, <<CipherBin1:Sz1/binary, CipherBin2:Sz2/binary>>} end, Cw = {Cinitw,Cenc,Cendw}, diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl index 73bfc13eef..ba4f420b1f 100644 --- a/lib/ssh/test/ssh_sup_SUITE.erl +++ b/lib/ssh/test/ssh_sup_SUITE.erl @@ -115,18 +115,21 @@ sshc_subtree(Config) when is_list(Config) -> {user_interaction, false}, {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), - ?wait_match([{_, _,worker,[ssh_connection_handler]}], - supervisor:which_children(sshc_sup)), + ?wait_match([{{client,ssh_system_sup, LocalIP, LocalPort, ?DEFAULT_PROFILE}, + SysSup, supervisor,[ssh_system_sup]}], + supervisor:which_children(sshc_sup), + [SysSup, LocalIP, LocalPort]), + check_sshc_system_tree(SysSup, Pid1, LocalIP, LocalPort, Config), {ok, Pid2} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, {user_interaction, false}, {user, ?USER}, {password, ?PASSWD}, {user_dir, UserDir}]), - ?wait_match([{_,_,worker,[ssh_connection_handler]}, - {_,_,worker,[ssh_connection_handler]}], + ?wait_match([{_, _,supervisor,[ssh_system_sup]}, + {_, _,supervisor,[ssh_system_sup]}], supervisor:which_children(sshc_sup)), ssh:close(Pid1), - ?wait_match([{_,_,worker,[ssh_connection_handler]}], + ?wait_match([{_, _,supervisor,[ssh_system_sup]}], supervisor:which_children(sshc_sup)), ssh:close(Pid2), ?wait_match([], supervisor:which_children(sshc_sup)). @@ -212,6 +215,7 @@ killed_acceptor_restarts(Config) -> ct:log("~s",[lists:flatten(ssh_info:string())]), %% Make acceptor restart: + ct:pal("Expect a SUPERVISOR REPORT with offender {pid,~p}....~n", [AccPid]), exit(AccPid, kill), ?wait_match(undefined, process_info(AccPid)), @@ -221,6 +225,8 @@ killed_acceptor_restarts(Config) -> AccPid1, 500, 30), + ct:pal("... now there should not be any SUPERVISOR REPORT.~n", []), + true = (AccPid1 =/= AccPid2), %% Connect second client and check it is alive: @@ -331,12 +337,14 @@ chk_empty_con_daemon(Daemon) -> {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}], supervisor:which_children(Daemon), [SubSysSup,AccSup]), - ?wait_match([{{server,ssh_connection_sup, _,_}, + ?wait_match([{_,_, supervisor, + [ssh_tcpip_forward_acceptor_sup]}, + {{server,ssh_connection_sup, _,_}, ConnectionSup, supervisor, [ssh_connection_sup]}, - {{server,ssh_server_channel_sup,_ ,_}, + {{server,ssh_channel_sup,_ ,_}, ChannelSup,supervisor, - [ssh_server_channel_sup]}], + [ssh_channel_sup]}], supervisor:which_children(SubSysSup), [ConnectionSup,ChannelSup]), ?wait_match([{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}], @@ -362,12 +370,15 @@ check_sshd_system_tree(Daemon, Host, Port, Config) -> supervisor:which_children(Daemon), [SubSysSup,AccSup]), - ?wait_match([{{server,ssh_connection_sup, _,_}, + ?wait_match([{_, + _AcceptorSup, supervisor, + [ssh_tcpip_forward_acceptor_sup]}, + {{server,ssh_connection_sup, _,_}, ConnectionSup, supervisor, [ssh_connection_sup]}, - {{server,ssh_server_channel_sup,_ ,_}, + {{server,ssh_channel_sup,_ ,_}, ChannelSup,supervisor, - [ssh_server_channel_sup]}], + [ssh_channel_sup]}], supervisor:which_children(SubSysSup), [ConnectionSup,ChannelSup]), @@ -379,12 +390,58 @@ check_sshd_system_tree(Daemon, Host, Port, Config) -> ?wait_match([], supervisor:which_children(ChannelSup)), - ssh_sftp:start_channel(Client), + {ok,PidC} = ssh_sftp:start_channel(Client), + + ?wait_match([{_, PidS,worker,[ssh_server_channel]}], + supervisor:which_children(ChannelSup), + [PidS]), + true = (PidS =/= PidC), - ?wait_match([{_, _,worker,[ssh_server_channel]}], - supervisor:which_children(ChannelSup)), ssh:close(Client). + +check_sshc_system_tree(SysSup, Connection, LocalIP, LocalPort, _Config) -> + ?wait_match([{_,SubSysSup,supervisor,[ssh_subsystem_sup]}], + supervisor:which_children(SysSup), + [SubSysSup]), + ?wait_match([{_,FwdAccSup, supervisor, + [ssh_tcpip_forward_acceptor_sup]}, + {{client,ssh_connection_sup, LocalIP, LocalPort}, + ConnectionSup, supervisor, + [ssh_connection_sup]}, + {{client,ssh_channel_sup, LocalIP, LocalPort}, + ChannelSup,supervisor, + [ssh_channel_sup]}], + supervisor:which_children(SubSysSup), + [ConnectionSup,ChannelSup,FwdAccSup]), + ?wait_match([{_, Connection, worker,[ssh_connection_handler]}], + supervisor:which_children(ConnectionSup)), + ?wait_match([], supervisor:which_children(ChannelSup)), + ?wait_match([], supervisor:which_children(FwdAccSup)), + + {ok,ChPid1} = ssh_sftp:start_channel(Connection), + ?wait_match([{_,ChPid1,worker,[ssh_client_channel]}], + supervisor:which_children(ChannelSup)), + + {ok,ChPid2} = ssh_sftp:start_channel(Connection), + ?wait_match([{_,ChPidA,worker,[ssh_client_channel]}, + {_,ChPidB,worker,[ssh_client_channel]}], + supervisor:which_children(ChannelSup), + [ChPidA, ChPidB]), + true = (lists:sort([ChPidA, ChPidB]) == lists:sort([ChPid1, ChPid2])), + + ct:pal("Expect a SUPERVISOR REPORT with offender {pid,~p}....~n", [ChPid1]), + exit(ChPid1, kill), + ?wait_match([{_,ChPid2,worker,[ssh_client_channel]}], + supervisor:which_children(ChannelSup)), + + ct:pal("Expect a SUPERVISOR REPORT with offender {pid,~p}....~n", [ChPid2]), + exit(ChPid2, kill), + ?wait_match([], supervisor:which_children(ChannelSup)), + ct:pal("... now there should not be any SUPERVISOR REPORT.~n", []). + + + acceptor_pid(DaemonPid) -> Parent = self(), Pid = spawn(fun() -> diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 83481e6c33..50f63c4096 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -432,7 +432,7 @@ setup_eddsa(Alg, DataDir, UserDir) -> file:copy(filename:join(DataDir, HostPub), filename:join(System, HostPub)), ct:log("DataDir ~p:~n ~p~n~nSystDir ~p:~n ~p~n~nUserDir ~p:~n ~p",[DataDir, file:list_dir(DataDir), System, file:list_dir(System), UserDir, file:list_dir(UserDir)]), setup_eddsa_known_host(HostPub, DataDir, UserDir), - setup_eddsa_auth_keys(IdPriv, DataDir, UserDir). + setup_eddsa_auth_keys(Alg, DataDir, UserDir). clean_dsa(UserDir) -> del_dirs(filename:join(UserDir, "system")), @@ -572,9 +572,12 @@ setup_ecdsa_auth_keys(Size, Dir, UserDir) -> PKey = #'ECPoint'{point = Q}, setup_auth_keys([{ {PKey,Param}, [{comment, "Test"}]}], UserDir). -setup_eddsa_auth_keys(IdPriv, Dir, UserDir) -> - {ok, Pem} = file:read_file(filename:join(Dir, IdPriv)), - {ed_pri, Alg, Pub, _} = public_key:pem_entry_decode(hd(public_key:pem_decode(Pem))), +setup_eddsa_auth_keys(Alg, Dir, UserDir) -> + SshAlg = case Alg of + ed25519 -> 'ssh-ed25519'; + ed448 -> 'ssh-ed448' + end, + {ok, {ed_pri,Alg,Pub,_}} = ssh_file:user_key(SshAlg, [{user_dir,Dir}]), setup_auth_keys([{{ed_pub,Alg,Pub}, [{comment, "Test"}]}], UserDir). setup_auth_keys(Keys, Dir) -> diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 4f06bd3d65..dc03445b41 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -48,12 +48,20 @@ all() -> end. groups() -> - [{erlang_client, [], [erlang_shell_client_openssh_server + [{erlang_client, [], [tunnel_in_erlclient_erlserver, + tunnel_out_erlclient_erlserver, + {group, tunnel_distro_server}, + erlang_shell_client_openssh_server ]}, - {erlang_server, [], [erlang_server_openssh_client_renegotiate, + {tunnel_distro_server, [], [tunnel_in_erlclient_openssh_server, + tunnel_out_erlclient_openssh_server]}, + {erlang_server, [], [{group, tunnel_distro_client}, + erlang_server_openssh_client_renegotiate, exec_with_io_in_sshc, exec_direct_with_io_in_sshc - ]} + ]}, + {tunnel_distro_client, [], [tunnel_in_non_erlclient_erlserver, + tunnel_out_non_erlclient_erlserver]} ]. init_per_suite(Config) -> @@ -78,6 +86,14 @@ init_per_group(erlang_server, Config) -> ssh_test_lib:setup_dsa_known_host(DataDir, UserDir), ssh_test_lib:setup_rsa_known_host(DataDir, UserDir), Config; +init_per_group(G, Config) when G==tunnel_distro_server ; + G==tunnel_distro_client -> + case no_forwarding() of + true -> + {skip, "port forwarding disabled in external ssh"}; + false -> + Config + end; init_per_group(erlang_client, Config) -> CommonAlgs = ssh_test_lib:algo_intersection( ssh:default_algorithms(), @@ -247,8 +263,184 @@ erlang_server_openssh_client_renegotiate(Config) -> end. %%-------------------------------------------------------------------- +tunnel_out_non_erlclient_erlserver(Config) -> + SystemDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + + {_Pid, Host, Port} = ssh_test_lib:daemon([{tcpip_tunnel_out, true}, + {system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}]), + {ToSock, _ToHost, ToPort} = tunneling_listner(), + + ListenHost = {127,0,0,1}, + ListenPort = 2345, + + Cmd = ssh_test_lib:open_sshc_cmd(Host, Port, + [" -o UserKnownHostsFile=", KnownHosts, + " -o StrictHostKeyChecking=no", + " -R ",integer_to_list(ListenPort),":127.0.0.1:",integer_to_list(ToPort)]), + spawn(fun() -> + ct:log(["ssh command:\r\n ",Cmd],[]), + R = os:cmd(Cmd), + ct:log(["ssh returned:\r\n",R],[]) + end), + + ct:sleep(1000), + test_tunneling(ToSock, ListenHost, ListenPort). + +%%-------------------------------------------------------------------- +tunnel_in_non_erlclient_erlserver(Config) -> + SystemDir = proplists:get_value(data_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), + KnownHosts = filename:join(UserDir, "known_hosts"), + {_Pid, Host, Port} = ssh_test_lib:daemon([{tcpip_tunnel_in, true}, + {system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}]), + {ToSock, _ToHost, ToPort} = tunneling_listner(), + + ListenHost = {127,0,0,1}, + ListenPort = 2345, + + Cmd = + ssh_test_lib:open_sshc_cmd(Host, Port, + [" -o UserKnownHostsFile=", KnownHosts, + " -o StrictHostKeyChecking=no", + " -L ",integer_to_list(ListenPort),":127.0.0.1:",integer_to_list(ToPort)]), + spawn(fun() -> + ct:log(["ssh command:\r\n ",Cmd],[]), + R = os:cmd(Cmd), + ct:log(["ssh returned:\r\n",R],[]) + end), + ct:sleep(1000), + test_tunneling(ToSock, ListenHost, ListenPort). + +%%-------------------------------------------------------------------- +tunnel_in_erlclient_erlserver(Config) -> + SystemDir = proplists:get_value(data_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), + {_Pid, Host, Port} = ssh_test_lib:daemon([{tcpip_tunnel_in, true}, + {system_dir, SystemDir}, + {user_dir, UserDir}, + {user_passwords, [{"foo", "bar"}]}, + {failfun, fun ssh_test_lib:failfun/2}]), + C = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user,"foo"},{password,"bar"}, + {user_interaction, false}]), + {ToSock, ToHost, ToPort} = tunneling_listner(), + + ListenHost = {127,0,0,1}, + {ok,ListenPort} = ssh:tcpip_tunnel_to_server(C, ListenHost,0, ToHost,ToPort, 2000), + + test_tunneling(ToSock, ListenHost, ListenPort). + +%%-------------------------------------------------------------------- +tunnel_in_erlclient_openssh_server(_Config) -> + C = ssh_test_lib:connect(loopback, 22, [{silently_accept_hosts, true}, + {user_interaction, false}]), + {ToSock, ToHost, ToPort} = tunneling_listner(), + + ListenHost = {127,0,0,1}, + {ok,ListenPort} = ssh:tcpip_tunnel_to_server(C, ListenHost,0, ToHost,ToPort, 5000), + + test_tunneling(ToSock, ListenHost, ListenPort). + +%%-------------------------------------------------------------------- +tunnel_out_erlclient_erlserver(Config) -> + SystemDir = proplists:get_value(data_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), + {_Pid, Host, Port} = ssh_test_lib:daemon([{tcpip_tunnel_out, true}, + {system_dir, SystemDir}, + {user_dir, UserDir}, + {user_passwords, [{"foo", "bar"}]}, + {failfun, fun ssh_test_lib:failfun/2}]), + C = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user,"foo"},{password,"bar"}, + {user_interaction, false}]), + {ToSock, ToHost, ToPort} = tunneling_listner(), + + ListenHost = {127,0,0,1}, + {ok,ListenPort} = ssh:tcpip_tunnel_from_server(C, ListenHost,0, ToHost,ToPort, 5000), + + test_tunneling(ToSock, ListenHost, ListenPort). + +%%-------------------------------------------------------------------- +tunnel_out_erlclient_openssh_server(_Config) -> + C = ssh_test_lib:connect(loopback, 22, [{silently_accept_hosts, true}, + {user_interaction, false}]), + {ToSock, ToHost, ToPort} = tunneling_listner(), + + ListenHost = {127,0,0,1}, + {ok,ListenPort} = ssh:tcpip_tunnel_from_server(C, ListenHost,0, ToHost,ToPort, 5000), + + test_tunneling(ToSock, ListenHost, ListenPort). + +%%-------------------------------------------------------------------- %%% Internal functions ----------------------------------------------- %%-------------------------------------------------------------------- +tunneling_listner() -> + {ok,LSock} = gen_tcp:listen(0, [{active,false}]), + {ok, {LHost,LPort}} = inet:sockname(LSock), + {LSock, LHost, LPort}. + +test_tunneling(ListenSocket, Host, Port) -> + {ok,Client1} = gen_tcp:connect(Host, Port, [{active,false}]), + {ok,Server1} = gen_tcp:accept(ListenSocket), + {ok,Client2} = gen_tcp:connect(Host, Port, [{active,false}]), + {ok,Server2} = gen_tcp:accept(ListenSocket), + send_rcv("Hi!", Client1, Server1), + send_rcv("Happy to see you!", Server1, Client1), + send_rcv("Hi, you to!", Client2, Server2), + send_rcv("Happy to see you also!", Server2, Client2), + close_and_check(Client1, Server1), + send_rcv("Still there?", Client2, Server2), + send_rcv("Yes!", Server2, Client2), + close_and_check(Server2, Client2). + + +tcp_connect(Host, Port, Options) -> + tcp_connect(Host, Port, Options, 0). +tcp_connect(Host, Port, Options, Timeout) -> + ct:log("Try connect to ~p:~p ~p Timeout=~p", [Host, Port, Options, Timeout]), + case gen_tcp:connect(Host, Port, Options, Timeout) of + {error,econnrefused} -> + timer:sleep( 2*max(Timeout,250)), + tcp_connect(Host, Port, Options, 2*max(Timeout,250)); + {error,timeout} -> + timer:sleep( 2*max(Timeout,250)), + tcp_connect(Host, Port, Options, 2*max(Timeout,250)); + {ok,S} -> + ct:log("connect to ~p:~p ~p Timeout=~p -> ~p", [Host, Port, Options, Timeout, S]), + {ok,S} + end. + +close_and_check(OneSide, OtherSide) -> + ok = gen_tcp:close(OneSide), + ok = chk_closed(OtherSide). + + +chk_closed(Sock) -> + chk_closed(Sock, 0). +chk_closed(Sock, Timeout) -> + case gen_tcp:recv(Sock, 0, Timeout) of + {error,closed} -> + ok; + {error,timeout} -> + chk_closed(Sock, 2*max(Timeout,250)); + Other -> + Other + end. + +send_rcv(Txt, From, To) -> + ct:log("Send ~p from ~p to ~p", [Txt, From, To]), + ok = gen_tcp:send(From, Txt), + ct:log("Recv ~p on ~p", [Txt, To]), + {ok,Txt} = gen_tcp:recv(To, 0, 5000), + ok. + +%%-------------------------------------------------------------------- receive_data(Data, Conn) -> receive Info when is_binary(Info) -> @@ -340,3 +532,41 @@ comment(AtomList) -> ct:comment( string:join(lists:map(fun erlang:atom_to_list/1, AtomList), ", ")). + +%%%---------------------------------------------------------------- +no_forwarding() -> + %%% Check if the ssh of the OS has tunneling enabled + Cmnd = "ssh -R 0:localhost:4567 localhost exit", + FailRegExp = + "Port forwarding is disabled" + "|remote port forwarding failed" + "|Bad.*specification" + "|Bad forwarding port", + {Result,TheText} = + try + Parent = self(), + Pid = spawn(fun() -> + Parent ! {self(), os:cmd(Cmnd)} + end), + receive + {Pid, Txt} -> + case re:run(Txt, FailRegExp) of + {match,_} -> {true,Txt}; + _ -> {false,Txt} + end + after 10000 -> + ct:log("*** TIMEOUT ***",[]), + {true,""} + end + catch C:E:S -> + ct:log("Exception in no_forwarding():~n~p:~p~n~p~n", [C,E,S]), + {true, ""} + end, + ct:log("---- os:cmd(~p) returned:~n~s~n" + "~n" + "---- Checking with regexp~n" + "~p~n" + "~n" + "---- The function no_forwarding() returns ~p", + [Cmnd,TheText, FailRegExp, Result]), + Result. diff --git a/lib/ssl/Makefile b/lib/ssl/Makefile index bd43794a36..526560288f 100644 --- a/lib/ssl/Makefile +++ b/lib/ssl/Makefile @@ -38,4 +38,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=crypto runtime_tools inets public_key +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/ssl/doc/src/Makefile b/lib/ssl/doc/src/Makefile index 064131944c..cb9ff02aa0 100644 --- a/lib/ssl/doc/src/Makefile +++ b/lib/ssl/doc/src/Makefile @@ -30,11 +30,6 @@ VSN=$(SSL_VSN) APPLICATION=ssl # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = refman.xml @@ -55,86 +50,9 @@ BOOK_FILES = book.xml XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES) \ $(XML_PART_FILES) $(XML_CHAPTER_FILES) -GIF_FILES = - -PS_FILES = - -XML_FLAGS += -defs cite cite.defs -booksty otpA4 - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info -EXTRA_FILES = \ - $(DEFAULT_GIF_FILES) \ - $(DEFAULT_HTML_FILES) \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) - TOP_SPECS_FILE = specs.xml -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += -SPECS_FLAGS = -I../../../public_key/include -I../../../public_key/src -I../../.. - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: html pdf man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f $(SPECS_FILES) - rm -f errs core *~ - -man: $(MAN3_FILES) $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: +NO_CHUNKS = ssl_crl_cache_api.xml ssl_session_cache_api.xml # ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 27b8a3f457..0126177c76 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -647,7 +647,7 @@ fun(Chain::[public_key:der_encoded()]) -> <desc><p>TLS protocol versions supported by started clients and servers. This option overrides the application environment option <c>protocol_version</c> and <c>dtls_protocol_version</c>. If the environment option is not set, it defaults - to all versions, except SSL-3.0, supported by the SSL application. + to all versions, supported by the SSL application. See also <seealso marker="ssl:ssl_app">ssl(6).</seealso></p> </desc> </datatype> @@ -736,7 +736,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <datatype> <name name="beast_mitigation"/> - <desc><p>Affects SSL-3.0 and TLS-1.0 connections only. Used to change the BEAST + <desc><p>Affects TLS-1.0 connections only. Used to change the BEAST mitigation strategy to interoperate with legacy software. Defaults to <c>one_n_minus_one</c>.</p> @@ -746,7 +746,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <p><c>disabled</c> - Disable BEAST mitigation.</p> - <warning><p>Using <c>{beast_mitigation, disabled}</c> makes SSL-3.0 or TLS-1.0 + <warning><p>Using <c>{beast_mitigation, disabled}</c> makes TLS-1.0 vulnerable to the BEAST attack.</p></warning> </desc> </datatype> @@ -916,10 +916,9 @@ fun(srp, Username :: string(), UserState :: term()) -> <warning><p>Note this option is not needed in normal TLS usage and should not be used to implement new clients. But legacy clients that retries connections in the following manner</p> - <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv2', 'tlsv1.1', 'tlsv1', 'sslv3']}])</c></p> - <p><c> ssl:connect(Host, Port, [...{versions, [tlsv1.1', 'tlsv1', 'sslv3']}, {fallback, true}])</c></p> - <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv1', 'sslv3']}, {fallback, true}]) </c></p> - <p><c> ssl:connect(Host, Port, [...{versions, ['sslv3']}, {fallback, true}]) </c></p> + <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv2', 'tlsv1.1', 'tlsv1']}])</c></p> + <p><c> ssl:connect(Host, Port, [...{versions, [tlsv1.1', 'tlsv1']}, {fallback, true}])</c></p> + <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv1']}, {fallback, true}]) </c></p> <p>may use it to avoid undesired TLS version downgrade. Note that TLS_FALLBACK_SCSV must also be supported by the server for the prevention to work. @@ -1633,8 +1632,6 @@ fun(srp, Username :: string(), UserState :: term()) -> extra key material. It either takes user-generated values for <c>Secret</c> and <c>Seed</c> or atoms directing it to use a specific value from the session security parameters.</p> - <p>Can only be used with TLS/DTLS connections; <c>{error, undefined}</c> - is returned for SSLv3 connections.</p> </desc> </func> @@ -1749,7 +1746,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name since="OTP R14B" name="start" arity="0" /> - <name since="OTP R14B">start(Type) -> ok | {error, Reason}</name> + <name since="OTP R14B" name="start" arity="1" /> <fsummary>Starts the SSL application.</fsummary> <desc> <p>Starts the SSL application. Default type @@ -1859,7 +1856,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <tag><c>available</c></tag> <item>All SSL/TLS versions supported by the SSL application. - TLS 1.2 requires sufficient support from the Crypto + TLS 1.2 and TLS 1.3 requires sufficient support from the Crypto application.</item> <tag><c>available_dtls</c></tag> diff --git a/lib/ssl/doc/src/standards_compliance.xml b/lib/ssl/doc/src/standards_compliance.xml index 553ee79a39..05c571a632 100644 --- a/lib/ssl/doc/src/standards_compliance.xml +++ b/lib/ssl/doc/src/standards_compliance.xml @@ -91,6 +91,7 @@ <section> <title>SSL 3.0</title> + <p>For security reasons SSL-3.0 is no longer supported at all. (OTP 23) </p> <p>For security reasons SSL-3.0 is no longer supported by default, but can be configured. (OTP 19)</p> </section> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index e961f05b37..6a8de38a1e 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -83,7 +83,6 @@ MODULES= \ ssl_session_cache \ ssl_srp_primes \ ssl_sup \ - ssl_v3 \ tls_bloom_filter \ tls_connection \ tls_connection_sup \ @@ -142,6 +141,13 @@ DEPDIR=$(ERL_TOP)/lib/ssl/src/deps DEP_FILE=$(DEPDIR)/ssl.d $(shell mkdir -p $(dir $(DEP_FILE)) >/dev/null) +ifeq ($(TARGET), win32) + # Native path without C: ignore driveletter case + ERL_TOP_NATIVE = $(shell w32_path.sh -m $(ERL_TOP) | sed "s@[a-zA-Z]:@:@") +else + ERL_TOP_NATIVE = $(ERL_TOP) +endif + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -151,7 +157,6 @@ ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/kernel/src \ -pz $(ERL_TOP)/lib/public_key/ebin \ $(EXTRA_ERLC_FLAGS) - # ---------------------------------------------------- # Targets # ---------------------------------------------------- @@ -159,8 +164,9 @@ ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/kernel/src \ $(TARGET_FILES): $(BEHAVIOUR_TARGET_FILES) $(DEP_FILE): $(ERL_FILES) + @echo SED $(TARGET) $(ERL_TOP_NATIVE) $(gen_verbose)erlc -M $(ERL_FILES) \ - | sed "s@$(ERL_TOP)@../../..@g" \ + | sed "s@[a-zA-Z]\?$(ERL_TOP_NATIVE)@../../..@g" \ | sed "s/\.$(EMULATOR)/\.$$\(EMULATOR\)/" \ | sed 's@^dtls_@$$(EBIN)/dtls_@' \ | sed 's@^inet_@$$(EBIN)/inet_@' \ diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index cad31b23ee..6649c4c341 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -120,7 +120,7 @@ cookie(Key, Address, Port, #client_hello{client_version = {Major, Minor}, CookieData = [address_to_bin(Address, Port), <<?BYTE(Major), ?BYTE(Minor)>>, Random, SessionId, CipherSuites, CompressionMethods], - crypto:hmac(sha, Key, CookieData). + crypto:mac(hmac, sha, Key, CookieData). %%-------------------------------------------------------------------- -spec hello_verify_request(binary(), ssl_record:ssl_version()) -> #hello_verify_request{}. %% diff --git a/lib/ssl/src/dtls_packet_demux.erl b/lib/ssl/src/dtls_packet_demux.erl index 11ad659ff5..13960a19d8 100644 --- a/lib/ssl/src/dtls_packet_demux.erl +++ b/lib/ssl/src/dtls_packet_demux.erl @@ -101,9 +101,9 @@ getstat(PacketSocket, Opts) -> %%% gen_server callbacks %%%=================================================================== -init([Port, {TransportModule, _,_,_,_} = TransportInfo, EmOpts, InetOptions, DTLSOptions]) -> +init([Port0, {TransportModule, _,_,_,_} = TransportInfo, EmOpts, InetOptions, DTLSOptions]) -> try - {ok, Socket} = TransportModule:open(Port, InetOptions), + {ok, Socket} = TransportModule:open(Port0, InetOptions), InternalActiveN = case application:get_env(ssl, internal_active_n) of {ok, N} when is_integer(N) -> N; @@ -111,6 +111,14 @@ init([Port, {TransportModule, _,_,_,_} = TransportInfo, EmOpts, InetOptions, DTL ?INTERNAL_ACTIVE_N end, + Port = case Port0 of + 0 -> + {ok, P} = inet:port(Socket), + P; + _ -> + Port0 + end, + {ok, #state{active_n = InternalActiveN, port = Port, first = true, diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index 8d9b92361b..bc51dd63fe 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -759,7 +759,7 @@ nodelay() -> get_ssl_options(Type) -> try ets:lookup(ssl_dist_opts, Type) of [{Type, Opts}] -> - [{erl_dist, true} | Opts]; + [{erl_dist, true}, {versions, ['tlsv1.2']} | Opts]; _ -> get_ssl_dist_arguments(Type) catch @@ -770,9 +770,9 @@ get_ssl_options(Type) -> get_ssl_dist_arguments(Type) -> case init:get_argument(ssl_dist_opt) of {ok, Args} -> - [{erl_dist, true} | ssl_options(Type, lists:append(Args))]; + [{erl_dist, true}, {versions, ['tlsv1.2']} | ssl_options(Type, lists:append(Args))]; _ -> - [{erl_dist, true}] + [{erl_dist, true}, {versions, ['tlsv1.2']}] end. diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index c45e6bcf9a..e35da9206e 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -11,7 +11,6 @@ tls_record_1_3, tls_socket, tls_v1, - ssl_v3, tls_connection_sup, tls_sender, tls_server_sup, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index ee1664a82f..d842eafa62 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -100,9 +100,12 @@ suite_to_openssl_str/1, str_to_suite/1]). --deprecated({ssl_accept, 1, eventually}). --deprecated({ssl_accept, 2, eventually}). --deprecated({ssl_accept, 3, eventually}). +-deprecated({ssl_accept, '_', "use ssl_handshake/1,2,3 instead"}). + +-removed([{negotiated_next_protocol,1, + "use ssl:negotiated_protocol/1 instead"}]). +-removed([{connection_info,1, + "use ssl:connection_information/[1,2] instead"}]). -export_type([socket/0, sslsocket/0, @@ -153,7 +156,7 @@ -type protocol_version() :: tls_version() | dtls_version(). % exported -type tls_version() :: 'tlsv1.2' | 'tlsv1.3' | tls_legacy_version(). -type dtls_version() :: 'dtlsv1.2' | dtls_legacy_version(). --type tls_legacy_version() :: tlsv1 | 'tlsv1.1' | sslv3. +-type tls_legacy_version() :: tlsv1 | 'tlsv1.1' . -type dtls_legacy_version() :: 'dtlsv1'. -type verify_type() :: verify_none | verify_peer. -type cipher() :: aes_128_cbc | @@ -1015,8 +1018,7 @@ cipher_suites(all) -> cipher_suites(Base, Version) when Version == 'tlsv1.3'; Version == 'tlsv1.2'; Version == 'tlsv1.1'; - Version == tlsv1; - Version == sslv3 -> + Version == tlsv1 -> cipher_suites(Base, tls_record:protocol_version(Version)); cipher_suites(Base, Version) when Version == 'dtlsv1.2'; Version == 'dtlsv1'-> @@ -1034,8 +1036,7 @@ cipher_suites(Base, Version) -> %%-------------------------------------------------------------------- cipher_suites(Base, Version, StringType) when Version == 'tlsv1.2'; Version == 'tlsv1.1'; - Version == tlsv1; - Version == sslv3 -> + Version == tlsv1 -> cipher_suites(Base, tls_record:protocol_version(Version), StringType); cipher_suites(Base, Version, StringType) when Version == 'dtlsv1.2'; Version == 'dtlsv1'-> @@ -1121,8 +1122,6 @@ eccs() -> %% Description: returns the curves supported for a given version of %% ssl/tls. %%-------------------------------------------------------------------- -eccs(sslv3) -> - []; eccs('dtlsv1') -> eccs('tlsv1.1'); eccs('dtlsv1.2') -> @@ -1532,21 +1531,13 @@ handle_options(Opts0, Role, Host) -> %% Ensure all options are evaluated at startup SslOpts1 = add_missing_options(SslOpts0, ?RULES), - SslOpts = #{protocol := Protocol, - versions := Versions} + SslOpts = #{protocol := Protocol} = process_options(SslOpts1, #{}, #{role => Role, host => Host, rules => ?RULES}), - - case Versions of - [{3, 0}] -> - reject_alpn_next_prot_options(SslOpts0); - _ -> - ok - end, - + %% Handle special options {Sock, Emulated} = emulated_options(Protocol, SockOpts), ConnetionCb = connection_cb(Protocol), @@ -2290,8 +2281,7 @@ validate_versions([], Versions) -> validate_versions([Version | Rest], Versions) when Version == 'tlsv1.3'; Version == 'tlsv1.2'; Version == 'tlsv1.1'; - Version == tlsv1; - Version == sslv3 -> + Version == tlsv1 -> tls_validate_versions(Rest, Versions); validate_versions([Version | Rest], Versions) when Version == 'dtlsv1'; Version == 'dtlsv1.2'-> @@ -2304,8 +2294,7 @@ tls_validate_versions([], Versions) -> tls_validate_versions([Version | Rest], Versions) when Version == 'tlsv1.3'; Version == 'tlsv1.2'; Version == 'tlsv1.1'; - Version == tlsv1; - Version == sslv3 -> + Version == tlsv1 -> tls_validate_versions(Rest, Versions); tls_validate_versions([Ver| _], Versions) -> throw({error, {options, {Ver, {versions, Versions}}}}). @@ -2580,25 +2569,6 @@ server_name_indication_default(Host) when is_list(Host) -> server_name_indication_default(_) -> undefined. - -reject_alpn_next_prot_options({Opts,_,_}) -> - AlpnNextOpts = [alpn_advertised_protocols, - alpn_preferred_protocols, - next_protocols_advertised, - next_protocol_selector, - client_preferred_next_protocols], - reject_alpn_next_prot_options(AlpnNextOpts, Opts). - -reject_alpn_next_prot_options([], _) -> - ok; -reject_alpn_next_prot_options([Opt| AlpnNextOpts], Opts) -> - case lists:keyfind(Opt, 1, Opts) of - {Opt, Value} -> - throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); - false -> - reject_alpn_next_prot_options(AlpnNextOpts, Opts) - end. - add_filter(undefined, Filters) -> Filters; add_filter(Filter, Filters) -> diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index c97884ec08..e9eb78203c 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -108,7 +108,7 @@ security_parameters_1_3(SecParams, CipherSuite) -> %% Description: Initializes the #cipher_state according to BCA %%------------------------------------------------------------------- cipher_init(?RC4, IV, Key) -> - State = crypto:stream_init(rc4, Key), + State = {stream_init,rc4,Key,IV}, #cipher_state{iv = IV, key = Key, state = State}; cipher_init(Type, IV, Key) when Type == ?AES_GCM; Type == ?AES_CCM -> @@ -137,38 +137,53 @@ nonce_seed(Seed, CipherState) -> %%------------------------------------------------------------------- cipher(?NULL, CipherState, <<>>, Fragment, _Version) -> {iolist_to_binary(Fragment), CipherState}; -cipher(?RC4, CipherState = #cipher_state{state = State0}, Mac, Fragment, _Version) -> +cipher(CipherEnum, CipherState = #cipher_state{state = {stream_init,rc4,Key,_IV}}, Mac, Fragment, Version) -> + State = crypto:crypto_init(rc4, Key, true), + cipher(CipherEnum, CipherState#cipher_state{state = State}, Mac, Fragment, Version); +cipher(?RC4, CipherState = #cipher_state{state = State}, Mac, Fragment, _Version) -> GenStreamCipherList = [Fragment, Mac], - {State1, T} = crypto:stream_encrypt(State0, GenStreamCipherList), - {iolist_to_binary(T), CipherState#cipher_state{state = State1}}; + T = crypto:crypto_update(State, GenStreamCipherList), + {iolist_to_binary(T), CipherState}; cipher(?DES, CipherState, Mac, Fragment, Version) -> block_cipher(fun(Key, IV, T) -> - crypto:block_encrypt(des_cbc, Key, IV, T) + crypto:crypto_one_time(des_cbc, Key, IV, T, true) end, block_size(des_cbc), CipherState, Mac, Fragment, Version); cipher(?'3DES', CipherState, Mac, Fragment, Version) -> - block_cipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> - crypto:block_encrypt(des3_cbc, [K1, K2, K3], IV, T) - end, block_size(des_cbc), CipherState, Mac, Fragment, Version); + block_cipher(fun(Key, IV, T) -> + crypto:crypto_one_time(des_ede3_cbc, Key, IV, T, true) + end, block_size(des_ede3_cbc), CipherState, Mac, Fragment, Version); cipher(?AES_CBC, CipherState, Mac, Fragment, Version) -> block_cipher(fun(Key, IV, T) when byte_size(Key) =:= 16 -> - crypto:block_encrypt(aes_cbc128, Key, IV, T); + crypto:crypto_one_time(aes_128_cbc, Key, IV, T, true); (Key, IV, T) when byte_size(Key) =:= 32 -> - crypto:block_encrypt(aes_cbc256, Key, IV, T) + crypto:crypto_one_time(aes_256_cbc, Key, IV, T, true) end, block_size(aes_128_cbc), CipherState, Mac, Fragment, Version). aead_encrypt(Type, Key, Nonce, Fragment, AdditionalData, TagLen) -> - crypto:block_encrypt(aead_type(Type), Key, Nonce, {AdditionalData, Fragment, TagLen}). + crypto:crypto_one_time_aead(aead_type(Type,size(Key)), Key, Nonce, Fragment, AdditionalData, TagLen, true). aead_decrypt(Type, Key, Nonce, CipherText, CipherTag, AdditionalData) -> - crypto:block_decrypt(aead_type(Type), Key, Nonce, {AdditionalData, CipherText, CipherTag}). - -aead_type(?AES_GCM) -> - aes_gcm; -aead_type(?AES_CCM) -> - aes_ccm; -aead_type(?AES_CCM_8) -> - aes_ccm; -aead_type(?CHACHA20_POLY1305) -> + crypto:crypto_one_time_aead(aead_type(Type,size(Key)), Key, Nonce, CipherText, AdditionalData, CipherTag, false). + +aead_type(?AES_GCM, 16) -> + aes_128_gcm; +aead_type(?AES_GCM, 24) -> + aes_192_gcm; +aead_type(?AES_GCM, 32) -> + aes_256_gcm; +aead_type(?AES_CCM, 16) -> + aes_128_ccm; +aead_type(?AES_CCM, 24) -> + aes_192_ccm; +aead_type(?AES_CCM, 32) -> + aes_256_ccm; +aead_type(?AES_CCM_8, 16) -> + aes_128_ccm; +aead_type(?AES_CCM_8, 24) -> + aes_192_ccm; +aead_type(?AES_CCM_8, 32) -> + aes_256_ccm; +aead_type(?CHACHA20_POLY1305, _) -> chacha20_poly1305. build_cipher_block(BlockSz, Mac, Fragment) -> @@ -211,12 +226,16 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV, state = IV_Cache0} = CS %%------------------------------------------------------------------- decipher(?NULL, _HashSz, CipherState, Fragment, _, _) -> {Fragment, <<>>, CipherState}; -decipher(?RC4, HashSz, CipherState = #cipher_state{state = State0}, Fragment, _, _) -> - try crypto:stream_decrypt(State0, Fragment) of - {State, Text} -> +decipher(CipherEnum, HashSz, CipherState = #cipher_state{state = {stream_init,rc4,Key,_IV}}, + Fragment, Version, PaddingCheck) -> + State = crypto:crypto_init(rc4, Key, false), + decipher(CipherEnum, HashSz, CipherState#cipher_state{state = State}, Fragment, Version, PaddingCheck); +decipher(?RC4, HashSz, CipherState = #cipher_state{state = State}, Fragment, _, _) -> + try crypto:crypto_update(State, Fragment) of + Text -> GSC = generic_stream_cipher_from_bin(Text, HashSz), #generic_stream_cipher{content = Content, mac = Mac} = GSC, - {Content, Mac, CipherState#cipher_state{state = State}} + {Content, Mac, CipherState} catch _:_ -> %% This is a DECRYPTION_FAILED but @@ -229,17 +248,17 @@ decipher(?RC4, HashSz, CipherState = #cipher_state{state = State0}, Fragment, _, decipher(?DES, HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(Key, IV, T) -> - crypto:block_decrypt(des_cbc, Key, IV, T) + crypto:crypto_one_time(des_cbc, Key, IV, T, false) end, CipherState, HashSz, Fragment, Version, PaddingCheck); decipher(?'3DES', HashSz, CipherState, Fragment, Version, PaddingCheck) -> - block_decipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> - crypto:block_decrypt(des3_cbc, [K1, K2, K3], IV, T) + block_decipher(fun(Key, IV, T) -> + crypto:crypto_one_time(des_ede3_cbc, Key, IV, T, false) end, CipherState, HashSz, Fragment, Version, PaddingCheck); decipher(?AES_CBC, HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(Key, IV, T) when byte_size(Key) =:= 16 -> - crypto:block_decrypt(aes_cbc128, Key, IV, T); + crypto:crypto_one_time(aes_128_cbc, Key, IV, T, false); (Key, IV, T) when byte_size(Key) =:= 32 -> - crypto:block_decrypt(aes_cbc256, Key, IV, T) + crypto:crypto_one_time(aes_256_cbc, Key, IV, T, false) end, CipherState, HashSz, Fragment, Version, PaddingCheck). block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, @@ -277,8 +296,6 @@ block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, %% %% Description: Returns a list of supported cipher suites. %%-------------------------------------------------------------------- -suites({3, 0}) -> - ssl_v3:suites(); suites({3, Minor}) -> tls_v1:suites(Minor); suites({_, Minor}) -> @@ -289,9 +306,9 @@ all_suites({3, _} = Version) -> ++ chacha_suites(Version) ++ psk_suites(Version) ++ srp_suites(Version) - ++ rc4_suites(Version) + ++ rsa_suites(Version) ++ des_suites(Version) - ++ rsa_suites(Version); + ++ rc4_suites(Version); all_suites(Version) -> dtls_v1:all_suites(Version). @@ -426,8 +443,6 @@ psk_suites_anon(0) -> %% Description: Returns a list of the SRP cipher suites, only supported %% if explicitly set by user. %%-------------------------------------------------------------------- -srp_suites({3,0}) -> - []; srp_suites(_) -> [?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA, @@ -442,8 +457,6 @@ srp_suites(_) -> %% Description: Returns a list of the SRP anonymous cipher suites, only supported %% if explicitly set by user. %%-------------------------------------------------------------------- -srp_suites_anon({3,0}) -> - []; srp_suites_anon(_) -> [?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA, ?TLS_SRP_SHA_WITH_AES_128_CBC_SHA, @@ -645,24 +658,12 @@ is_acceptable_cipher(null, _Algos) -> true; is_acceptable_cipher(rc4_128, Algos) -> proplists:get_bool(rc4, Algos); -is_acceptable_cipher(des_cbc, Algos) -> - proplists:get_bool(des_cbc, Algos); is_acceptable_cipher('3des_ede_cbc', Algos) -> - proplists:get_bool(des_ede3, Algos); -is_acceptable_cipher(aes_128_cbc, Algos) -> - proplists:get_bool(aes_cbc128, Algos); -is_acceptable_cipher(aes_256_cbc, Algos) -> - proplists:get_bool(aes_cbc256, Algos); -is_acceptable_cipher(Cipher, Algos) - when Cipher == aes_128_gcm; - Cipher == aes_256_gcm -> - proplists:get_bool(aes_gcm, Algos); -is_acceptable_cipher(Cipher, Algos) - when Cipher == aes_128_ccm; - Cipher == aes_256_ccm; - Cipher == aes_128_ccm_8; - Cipher == aes_256_ccm_8 -> - proplists:get_bool(aes_ccm, Algos); + proplists:get_bool(des_ede3_cbc, Algos); +is_acceptable_cipher(aes_128_ccm_8, Algos) -> + proplists:get_bool(aes_128_ccm, Algos); +is_acceptable_cipher(aes_256_ccm_8, Algos) -> + proplists:get_bool(aes_256_ccm, Algos); is_acceptable_cipher(Cipher, Algos) -> proplists:get_bool(Cipher, Algos). @@ -734,8 +735,6 @@ hash_size(sha512) -> mac_hash({_,_}, ?NULL, _MacSecret, _SeqNo, _Type, _Length, _Fragment) -> <<>>; -mac_hash({3, 0}, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> - ssl_v3:mac_hash(MacAlg, MacSecret, SeqNo, Type, Length, Fragment); mac_hash({3, N} = Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) when N =:= 1; N =:= 2; N =:= 3; N =:= 4 -> tls_v1:mac_hash(MacAlg, MacSecret, SeqNo, Type, Version, @@ -863,6 +862,7 @@ iv_size(Cipher) -> block_size(Cipher). block_size(Cipher) when Cipher == des_cbc; + Cipher == des_ede3_cbc; Cipher == '3des_ede_cbc' -> 8; block_size(Cipher) when Cipher == aes_128_cbc; diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 8e53be72ed..5f5505c02c 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -725,7 +725,7 @@ encode_extensions([#psk_key_exchange_modes{ke_modes = KEModes0} | Rest], Acc) -> encode_extensions([#pre_shared_key_client_hello{ offered_psks = #offered_psks{ identities = Identities0, - binders = Binders0} = _PSKs} | Rest], Acc) -> + binders = Binders0}} | Rest], Acc) -> Identities = encode_psk_identities(Identities0), Binders = encode_psk_binders(Binders0), Len = byte_size(Identities) + byte_size(Binders), @@ -948,8 +948,6 @@ cipher_suites(Suites, true) -> %% %% Description: use the TLS PRF to generate key material %%-------------------------------------------------------------------- -prf({3,0}, _, _, _, _, _) -> - {error, undefined}; prf({3,_N}, PRFAlgo, Secret, Label, Seed, WantedLength) -> {ok, tls_v1:prf(PRFAlgo, Secret, Label, Seed, WantedLength)}. @@ -1797,6 +1795,10 @@ bad_key(#'DSAPrivateKey'{}) -> bad_key(#'RSAPrivateKey'{}) -> unacceptable_rsa_key; bad_key(#'ECPrivateKey'{}) -> + unacceptable_ecdsa_key; +bad_key(#{algorithm := rsa}) -> + unacceptable_rsa_key; +bad_key(#{algorithm := ecdsa}) -> unacceptable_ecdsa_key. crl_check(_, false, _,_,_, _, _, _) -> @@ -1910,13 +1912,8 @@ encrypted_premaster_secret(Secret, RSAPublicKey) -> throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, premaster_encryption_failed)) end. -calc_certificate_verify({3, 0}, HashAlgo, MasterSecret, Handshake) -> - ssl_v3:certificate_verify(HashAlgo, MasterSecret, lists:reverse(Handshake)); calc_certificate_verify({3, N}, HashAlgo, _MasterSecret, Handshake) -> tls_v1:certificate_verify(HashAlgo, N, lists:reverse(Handshake)). - -calc_finished({3, 0}, Role, _PrfAlgo, MasterSecret, Handshake) -> - ssl_v3:finished(Role, MasterSecret, lists:reverse(Handshake)); calc_finished({3, N}, Role, PrfAlgo, MasterSecret, Handshake) -> tls_v1:finished(Role, N, PrfAlgo, MasterSecret, lists:reverse(Handshake)). @@ -1946,20 +1943,10 @@ master_secret(Version, MasterSecret, {MasterSecret, ssl_record:set_pending_cipher_state(ConnStates2, ClientCipherState, ServerCipherState, Role)}. - -setup_keys({3,0}, _PrfAlgo, MasterSecret, - ServerRandom, ClientRandom, HashSize, KML, EKML, IVS) -> - ssl_v3:setup_keys(MasterSecret, ServerRandom, - ClientRandom, HashSize, KML, EKML, IVS); - setup_keys({3,N}, PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, KML, _EKML, IVS) -> tls_v1:setup_keys(N, PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, KML, IVS). - -calc_master_secret({3,0}, _PrfAlgo, PremasterSecret, ClientRandom, ServerRandom) -> - ssl_v3:master_secret(PremasterSecret, ClientRandom, ServerRandom); - calc_master_secret({3,_}, PrfAlgo, PremasterSecret, ClientRandom, ServerRandom) -> tls_v1:master_secret(PrfAlgo, PremasterSecret, ClientRandom, ServerRandom). @@ -3210,9 +3197,6 @@ handle_renegotiation_info(_, _RecordCB, server, #renegotiation_info{renegotiated throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, server_renegotiation)) end end; -handle_renegotiation_info({3,0}, _RecordCB, client, undefined, ConnectionStates, true, _SecureRenegotation, _) -> - {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)}; - handle_renegotiation_info(_, RecordCB, client, undefined, ConnectionStates, true, SecureRenegotation, _) -> handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation); @@ -3299,8 +3283,6 @@ empty_extensions({3,4}, hello_retry_request) -> key_share => undefined, pre_shared_key => undefined }; -empty_extensions({3,0}, _) -> - empty_extensions(); empty_extensions(_, server_hello) -> #{renegotiation_info => undefined, alpn => undefined, diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index d661de323c..565db9b1a9 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -75,10 +75,10 @@ %% Keep as interop with legacy software but do not support as default %% tlsv1.0 and tlsv1.1 is now also considered legacy %% tlsv1.3 is under development (experimental). --define(ALL_AVAILABLE_VERSIONS, ['tlsv1.3', 'tlsv1.2', 'tlsv1.1', tlsv1, sslv3]). +-define(ALL_AVAILABLE_VERSIONS, ['tlsv1.3', 'tlsv1.2', 'tlsv1.1', tlsv1]). -define(ALL_AVAILABLE_DATAGRAM_VERSIONS, ['dtlsv1.2', dtlsv1]). %% Defines the default versions when not specified by an ssl option. --define(ALL_SUPPORTED_VERSIONS, ['tlsv1.2']). +-define(ALL_SUPPORTED_VERSIONS, ['tlsv1.3', 'tlsv1.2']). -define(MIN_SUPPORTED_VERSIONS, ['tlsv1.1']). %% Versions allowed in TLSCiphertext.version (TLS 1.2 and prior) and @@ -86,7 +86,7 @@ %% TLS 1.3 sets TLSCiphertext.legacy_record_version to 0x0303 for all records %% generated other than an than an initial ClientHello, where it MAY also be 0x0301. %% Thus, the allowed range is limited to 0x0300 - 0x0303. --define(ALL_TLS_RECORD_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1, sslv3]). +-define(ALL_TLS_RECORD_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1]). -define(ALL_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2']). -define(MIN_DATAGRAM_SUPPORTED_VERSIONS, [dtlsv1]). diff --git a/lib/ssl/src/ssl_v3.erl b/lib/ssl/src/ssl_v3.erl deleted file mode 100644 index 4eab60b440..0000000000 --- a/lib/ssl/src/ssl_v3.erl +++ /dev/null @@ -1,200 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Handles sslv3 encryption. -%%---------------------------------------------------------------------- - --module(ssl_v3). - --include("ssl_cipher.hrl"). --include("ssl_internal.hrl"). --include("ssl_record.hrl"). % MD5 and SHA - --export([master_secret/3, finished/3, certificate_verify/3, - mac_hash/6, setup_keys/7, - suites/0]). --compile(inline). - -%%==================================================================== -%% Internal application API -%%==================================================================== - --spec master_secret(binary(), binary(), binary()) -> binary(). - -master_secret(PremasterSecret, ClientRandom, ServerRandom) -> - %% draft-ietf-tls-ssl-version3-00 - 6.2.2 - %% key_block = - %% MD5(master_secret + SHA(`A' + master_secret + - %% ServerHello.random + - %% ClientHello.random)) + - %% MD5(master_secret + SHA(`BB' + master_secret + - %% ServerHello.random + - %% ClientHello.random)) + - %% MD5(master_secret + SHA(`CCC' + master_secret + - %% ServerHello.random + - %% ClientHello.random)) + [...]; - Block = generate_keyblock(PremasterSecret, ClientRandom, ServerRandom, 48), - Block. - --spec finished(client | server, binary(), [binary()]) -> binary(). - -finished(Role, MasterSecret, Handshake) -> - %% draft-ietf-tls-ssl-version3-00 - 5.6.9 Finished - %% struct { - %% opaque md5_hash[16]; - %% opaque sha_hash[20]; - %% } Finished; - %% - %% md5_hash MD5(master_secret + pad2 + - %% MD5(handshake_messages + Sender + - %% master_secret + pad1)); - %% sha_hash SHA(master_secret + pad2 + - %% SHA(handshake_messages + Sender + - %% master_secret + pad1)); - Sender = get_sender(Role), - MD5 = handshake_hash(?MD5, MasterSecret, Sender, Handshake), - SHA = handshake_hash(?SHA, MasterSecret, Sender, Handshake), - <<MD5/binary, SHA/binary>>. - --spec certificate_verify(md5sha | sha, binary(), [binary()]) -> binary(). - -certificate_verify(md5sha, MasterSecret, Handshake) -> - %% md5_hash - %% MD5(master_secret + pad_2 + - %% MD5(handshake_messages + master_secret + pad_1)); - %% sha_hash - %% SHA(master_secret + pad_2 + - %% SHA(handshake_messages + master_secret + pad_1)); - - MD5 = handshake_hash(?MD5, MasterSecret, undefined, Handshake), - SHA = handshake_hash(?SHA, MasterSecret, undefined, Handshake), - <<MD5/binary, SHA/binary>>; - -certificate_verify(sha, MasterSecret, Handshake) -> - %% sha_hash - %% SHA(master_secret + pad_2 + - %% SHA(handshake_messages + master_secret + pad_1)); - - handshake_hash(?SHA, MasterSecret, undefined, Handshake). - --spec mac_hash(integer(), binary(), integer(), integer(), integer(), binary()) -> binary(). - -mac_hash(Method, Mac_write_secret, Seq_num, Type, Length, Fragment) -> - %% draft-ietf-tls-ssl-version3-00 - 5.2.3.1 - %% hash(MAC_write_secret + pad_2 + - %% hash(MAC_write_secret + pad_1 + seq_num + - %% SSLCompressed.type + SSLCompressed.length + - %% SSLCompressed.fragment)); - Mac = mac_hash(Method, Mac_write_secret, - [<<?UINT64(Seq_num), ?BYTE(Type), - ?UINT16(Length)>>, Fragment]), - Mac. - --spec setup_keys(binary(), binary(), binary(), - integer(), integer(), term(), integer()) -> - {binary(), binary(), binary(), - binary(), binary(), binary()}. - -setup_keys(MasterSecret, ServerRandom, ClientRandom, HS, KML, _EKML, IVS) -> - KeyBlock = generate_keyblock(MasterSecret, ServerRandom, ClientRandom, - 2*(HS+KML+IVS)), - %% draft-ietf-tls-ssl-version3-00 - 6.2.2 - %% The key_block is partitioned as follows. - %% client_write_MAC_secret[CipherSpec.hash_size] - %% server_write_MAC_secret[CipherSpec.hash_size] - %% client_write_key[CipherSpec.key_material] - %% server_write_key[CipherSpec.key_material] - %% client_write_IV[CipherSpec.IV_size] /* non-export ciphers */ - %% server_write_IV[CipherSpec.IV_size] /* non-export ciphers */ - <<ClientWriteMacSecret:HS/binary, ServerWriteMacSecret:HS/binary, - ClientWriteKey:KML/binary, ServerWriteKey:KML/binary, - ClientIV:IVS/binary, ServerIV:IVS/binary>> = KeyBlock, - {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, - ServerWriteKey, ClientIV, ServerIV}. - --spec suites() -> [ssl_cipher_format:cipher_suite()]. - -suites() -> - [ - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA, - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, - ?TLS_RSA_WITH_AES_256_CBC_SHA, - ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, - ?TLS_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, - ?TLS_RSA_WITH_AES_128_CBC_SHA - ]. - -%%-------------------------------------------------------------------- -%%% Internal functions -%%-------------------------------------------------------------------- - -hash(?MD5, Data) -> - crypto:hash(md5, Data); -hash(?SHA, Data) -> - crypto:hash(sha, Data). - -%%pad_1(?NULL) -> -%% ""; -pad_1(?MD5) -> - <<"666666666666666666666666666666666666666666666666">>; -pad_1(?SHA) -> - <<"6666666666666666666666666666666666666666">>. -%%pad_2(?NULL) -> -%% ""; -pad_2(?MD5) -> - <<"\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" - "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\">>; -pad_2(?SHA) -> - <<"\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" - "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\">>. - -mac_hash(?NULL, _Secret, _Data) -> - <<>>; -mac_hash(Method, Secret, Data) -> - InnerHash = hash(Method, [Secret, pad_1(Method), Data]), - hash(Method, [Secret, pad_2(Method), InnerHash]). - -handshake_hash(Method, MasterSecret, undefined, Handshake) -> - InnerHash = hash(Method, [Handshake, MasterSecret, pad_1(Method)]), - hash(Method, [MasterSecret, pad_2(Method), InnerHash]); -handshake_hash(Method, MasterSecret, Sender, Handshake) -> - InnerHash = hash(Method, [Handshake, Sender, MasterSecret, pad_1(Method)]), - hash(Method, [MasterSecret, pad_2(Method), InnerHash]). - -get_sender(client) -> "CLNT"; -get_sender(server) -> "SRVR". - -generate_keyblock(MasterSecret, ServerRandom, ClientRandom, WantedLength) -> - gen(MasterSecret, [MasterSecret, ServerRandom, ClientRandom], - WantedLength, 0, $A, 1, []). - -gen(_Secret, _All, Wanted, Len, _C, _N, Acc) when Wanted =< Len -> - <<Block:Wanted/binary, _/binary>> = list_to_binary(lists:reverse(Acc)), - Block; -gen(Secret, All, Wanted, Len, C, N, Acc) -> - Prefix = lists:duplicate(N, C), - SHA = crypto:hash(sha, [Prefix, All]), - MD5 = crypto:hash(md5, [Secret, SHA]), - gen(Secret, All, Wanted, Len + 16, C+1, N+1, [MD5 | Acc]). diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index 8c5d652035..e1244aa5b7 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -488,7 +488,7 @@ certificate_entry(DER) -> %% 0101010101010101010101010101010101010101010101010101010101010101 sign(THash, Context, HashAlgo, #'ECPrivateKey'{} = PrivateKey) -> Content = build_content(Context, THash), - try public_key:sign(Content, HashAlgo, PrivateKey) of + try digitally_signed(Content, HashAlgo, PrivateKey) of Signature -> {ok, Signature} catch @@ -500,10 +500,10 @@ sign(THash, Context, HashAlgo, PrivateKey) -> %% The length of the Salt MUST be equal to the length of the output %% of the digest algorithm: rsa_pss_saltlen = -1 - try public_key:sign(Content, HashAlgo, PrivateKey, - [{rsa_padding, rsa_pkcs1_pss_padding}, - {rsa_pss_saltlen, -1}, - {rsa_mgf1_md, HashAlgo}]) of + try digitally_signed(Content, HashAlgo, PrivateKey, + [{rsa_padding, rsa_pkcs1_pss_padding}, + {rsa_pss_saltlen, -1}, + {rsa_mgf1_md, HashAlgo}]) of Signature -> {ok, Signature} catch @@ -2320,3 +2320,30 @@ process_user_tickets([H|T], Acc, N) -> %% (see Section 4.6.1), modulo 2^32. obfuscate_ticket_age(TicketAge, AgeAdd) -> (TicketAge + AgeAdd) rem round(math:pow(2,32)). + + +digitally_signed(Msg, HashAlgo, PrivateKey) -> + digitally_signed(Msg, HashAlgo, PrivateKey, []). + +digitally_signed(Msg, HashAlgo, PrivateKey, Options) -> + try do_digitally_signed(Msg, HashAlgo, PrivateKey, Options) of + Signature -> + Signature + catch + error:_ -> + {error, ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, bad_key(PrivateKey))} + end. + +do_digitally_signed(Msg, HashAlgo, #{algorithm := Alg} = Engine, Options) -> + crypto:sign(Alg, HashAlgo, Msg, maps:remove(algorithm, Engine), Options); +do_digitally_signed(Msg, HashAlgo, Key, Options) -> + public_key:sign(Msg, HashAlgo, Key, Options). + +bad_key(#'RSAPrivateKey'{}) -> + unacceptable_rsa_key; +bad_key(#'ECPrivateKey'{}) -> + unacceptable_ecdsa_key; +bad_key(#{algorithm := rsa}) -> + unacceptable_rsa_key; +bad_key(#{algorithm := ecdsa}) -> + unacceptable_ecdsa_key. diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 538c3e44fb..9d0349806a 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -353,28 +353,13 @@ supported_protocol_versions() -> end. supported_protocol_versions([]) -> - Vsns = case sufficient_tlsv1_2_crypto_support() of - true -> - ?ALL_SUPPORTED_VERSIONS; - false -> - ?MIN_SUPPORTED_VERSIONS - end, + Vsns = sufficient_support(?ALL_SUPPORTED_VERSIONS), application:set_env(ssl, protocol_version, Vsns), Vsns; supported_protocol_versions([_|_] = Vsns) -> - case sufficient_tlsv1_2_crypto_support() of - true -> - Vsns; - false -> - case Vsns -- ['tlsv1.2'] of - [] -> - ?MIN_SUPPORTED_VERSIONS; - NewVsns -> - NewVsns - end - end. - + sufficient_support(Vsns). + -spec is_acceptable_version(tls_version()) -> boolean(). is_acceptable_version({N,_}) when N >= ?LOWEST_MAJOR_SUPPORTED_VERSION -> @@ -474,7 +459,7 @@ validate_tls_records_type(Versions, Q, SslOpts, Acc, Type, Version, Length) -> validate_tls_record_version(Versions, Q, SslOpts, Acc, Type, Version, Length); true -> %% Not ?KNOWN_RECORD_TYPE(Type) - ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE) + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, {unsupported_record_type, Type}) end. validate_tls_record_version(_Versions, Q, _SslOpts, Acc, Type, undefined, _Length) -> @@ -487,7 +472,7 @@ validate_tls_record_version(Versions, Q, SslOpts, Acc, Type, Version, Length) -> true -> validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length); false -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, {unsupported_version, Version}) end; {3, 4} when Version =:= {3, 3} -> validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length); @@ -495,7 +480,7 @@ validate_tls_record_version(Versions, Q, SslOpts, Acc, Type, Version, Length) -> %% Exact version match validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length); _ -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, {unsupported_version, Version}) end. validate_tls_record_length(_Versions, Q, _SslOpts, Acc, Type, Version, undefined) -> @@ -668,11 +653,23 @@ highest_protocol_version() -> lowest_protocol_version() -> lowest_protocol_version(supported_protocol_versions()). -sufficient_tlsv1_2_crypto_support() -> - CryptoSupport = crypto:supports(), - proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)). - max_len([{3,4}|_])-> ?TLS13_MAX_CIPHER_TEXT_LENGTH; max_len(_) -> ?MAX_CIPHER_TEXT_LENGTH. + +sufficient_support(Versions) -> + CryptoSupport = crypto:supports(), + case proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)) of + false -> + Versions -- ['tlsv1.3', 'tlsv1.2']; + true -> + case proplists:get_bool(aes_gcm, proplists:get_value(ciphers, CryptoSupport)) of + false -> + Versions -- ['tlsv1.3']; + true -> + Versions + end + end. + + diff --git a/lib/ssl/src/tls_sender.erl b/lib/ssl/src/tls_sender.erl index 951d4302e9..5e7ef9d6a9 100644 --- a/lib/ssl/src/tls_sender.erl +++ b/lib/ssl/src/tls_sender.erl @@ -276,6 +276,7 @@ connection({call, From}, dist_get_tls_socket, {next_state, ?FUNCTION_NAME, StateData, [{reply, From, {ok, TLSSocket}}]}; connection({call, From}, {dist_handshake_complete, _Node, DHandle}, #data{static = #static{connection_pid = Pid} = Static} = StateData) -> + false = erlang:dist_ctrl_set_opt(DHandle, get_size, true), ok = erlang:dist_ctrl_input_handler(DHandle, Pid), ok = ssl_connection:dist_handshake_complete(Pid, DHandle), %% From now on we execute on normal priority @@ -287,7 +288,7 @@ connection({call, From}, {dist_handshake_complete, _Node, DHandle}, []; Data -> [{next_event, internal, - {application_packets,{self(),undefined},erlang:iolist_to_iovec(Data)}}] + {application_packets,{self(),undefined},Data}}] end]}; connection(internal, {application_packets, From, Data}, StateData) -> send_application_data(Data, From, ?FUNCTION_NAME, StateData); @@ -310,7 +311,7 @@ connection(info, dist_data, #data{static = #static{dist_handle = DHandle}}) -> []; Data -> [{next_event, internal, - {application_packets,{self(),undefined},erlang:iolist_to_iovec(Data)}}] + {application_packets,{self(),undefined},Data}}] end}; connection(info, tick, StateData) -> consume_ticks(), @@ -623,15 +624,14 @@ dist_data(DHandle) -> %% since the emulator will always deliver a Data %% smaller than 4 GB, and the distribution will %% therefore always have to use {packet,4} - Data when is_binary(Data) -> - Len = byte_size(Data), - [[<<Len:32>>,Data]|dist_data(DHandle)]; - [BA,BB] = Data -> - Len = byte_size(BA) + byte_size(BB), - [[<<Len:32>>|Data]|dist_data(DHandle)]; - Data when is_list(Data) -> - Len = iolist_size(Data), - [[<<Len:32>>|Data]|dist_data(DHandle)] + {Len, Data} -> + %% Data is of type iovec(); lets keep it + %% as an iovec()... + Packet = [<<Len:32>> | Data], + case dist_data(DHandle) of + [] -> Packet; + More -> Packet ++ More + end end. diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 381793c65d..1371ac7637 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -684,7 +684,7 @@ hkdf_expand(Algo, PseudoRandKey, ContextInfo, Length, M, N, Prev, Acc) -> hmac_hash(?NULL, _, _) -> <<>>; hmac_hash(Alg, Key, Value) -> - crypto:hmac(mac_algo(Alg), Key, Value). + crypto:mac(hmac, mac_algo(Alg), Key, Value). mac_algo(Alg) when is_atom(Alg) -> Alg; diff --git a/lib/ssl/test/inet_crypto_dist.erl b/lib/ssl/test/inet_crypto_dist.erl index 63c19d9438..608ebcbe89 100644 --- a/lib/ssl/test/inet_crypto_dist.erl +++ b/lib/ssl/test/inet_crypto_dist.erl @@ -60,7 +60,9 @@ iv = 12, key = 16, tag_len = 16, - rekey_interval = 262144 + rekey_count = 262144, + rekey_time = 7200000, % 2 hours + rekey_msg }). params(Socket) -> @@ -78,10 +80,10 @@ params(Socket) -> %%% params = brainpoolP384t1, params = brainpoolP256t1, public, - private}). - --define(KEY_PAIR_LIFE_TIME, 3600000). % 1 hour --define(KEY_PAIR_LIFE_COUNT, 256). % Number of connection setups + private, + life_time = 3600000, % 1 hour + life_count = 256 % Number of connection setups + }). %% ------------------------------------------------------------------------- @@ -102,12 +104,18 @@ start_key_pair_server() -> key_pair_server() -> key_pair_server(undefined, undefined, undefined). %% -key_pair_server(KeyPair) -> - key_pair_server( - KeyPair, - erlang:start_timer(?KEY_PAIR_LIFE_TIME, self(), discard), - ?KEY_PAIR_LIFE_COUNT). -%% +key_pair_server( + #key_pair{life_time = LifeTime, life_count = LifeCount} = KeyPair) -> + %% Presuming: 1 < LifeCount + Timer = + case LifeCount of + 1 -> + undefined; + _ -> + erlang:start_timer(LifeTime, self(), discard) + end, + key_pair_server(KeyPair, Timer, LifeCount - 1). +%% key_pair_server(_KeyPair, Timer, 0) -> cancel_timer(Timer), key_pair_server(); @@ -138,9 +146,20 @@ generate_key_pair() -> crypto:generate_key(Type, Params), #key_pair{public = Public, private = Private}. + cancel_timer(undefined) -> ok; cancel_timer(Timer) -> + erlang_cancel_timer(Timer). + +start_rekey_timer(Time) -> + Timer = erlang:start_timer(Time, self(), rekey_time), + {timeout, Timer, rekey_time}. + +cancel_rekey_timer({timeout, Timer, rekey_time}) -> + erlang_cancel_timer(Timer). + +erlang_cancel_timer(Timer) -> case erlang:cancel_timer(Timer) of false -> receive @@ -862,11 +881,12 @@ reply({Ref, Pid}, Msg) -> %% %% The start message contains the two encrypted random numbers %% this time encrypted with the session keys for verification -%% by the other side, plus the rekey interval. The rekey interval +%% by the other side, plus the rekey count. The rekey count %% is just there to get an early check for if the other side's -%% maximum rekey interal is acceptable, it is just an embryo +%% maximum rekey count is acceptable, it is just an embryo %% of some better check. Any side may rekey earlier but if the -%% rekey interval is exceeded the connection fails. +%% rekey count is exceeded the connection fails. Rekey is also +%% triggered by a timer. %% %% Subsequent encrypted messages has the sequence number and the length %% of the message as AAD data, and an incrementing IV. These messages @@ -950,7 +970,7 @@ init_msg( key = KeyLen, iv = IVLen, tag_len = TagLen, - rekey_interval = RekeyInterval} = Params, + rekey_count = RekeyCount} = Params, Secret, KeyPair, R2A, R3A, Msg) -> %% RLen = KeyLen + IVLen, @@ -974,7 +994,7 @@ init_msg( rekey_key = PubKeyB, key = Key2A, iv = IV2A}, %% - StartCleartext = [R2B, R3B, <<RekeyInterval:32>>], + StartCleartext = [R2B, R3B, <<RekeyCount:32>>], StartMsgLen = TagLen + iolist_size(StartCleartext), StartAAD = <<StartMsgLen:32>>, {StartCiphertext, StartTag} = @@ -1001,7 +1021,7 @@ start_msg( key = Key2B, iv = IV2B, tag_len = TagLen, - rekey_interval = RekeyIntervalA} = RecvParams, R2A, R3A, Msg) -> + rekey_count = RekeyCountA} = RecvParams, R2A, R3A, Msg) -> %% case Msg of <<Tag:TagLen/binary, Ciphertext/binary>> -> @@ -1014,10 +1034,10 @@ start_msg( crypto:block_decrypt( AeadCipher, Key2B, IV2B, {AAD, Ciphertext, Tag}) of - <<R2A:RLen/binary, R3A:RLen/binary, RekeyIntervalB:32>> - when RekeyIntervalA =< (RekeyIntervalB bsl 2), - RekeyIntervalB =< (RekeyIntervalA bsl 2) -> - RecvParams#params{rekey_interval = RekeyIntervalB} + <<R2A:RLen/binary, R3A:RLen/binary, RekeyCountB:32>> + when RekeyCountA =< (RekeyCountB bsl 2), + RekeyCountB =< (RekeyCountA bsl 2) -> + RecvParams#params{rekey_count = RekeyCountB} end end. @@ -1071,7 +1091,10 @@ handshake( process_flag(priority, normal), erlang:dist_ctrl_get_data_notification(DistHandle), output_handler( - SendParams#params{dist_handle = DistHandle}, SendSeq); + SendParams#params{ + dist_handle = DistHandle, + rekey_msg = start_rekey_timer(SendParams#params.rekey_time)}, + SendSeq); %% {?MODULE, From, {send, Data}} -> case @@ -1137,9 +1160,12 @@ output_handler(Params, Seq) -> output_handler_data(Params, Seq); dist_tick -> output_handler_tick(Params, Seq); - Other -> + _ when Msg =:= Params#params.rekey_msg -> + Params_1 = output_handler_rekey(Params, Seq), + output_handler(Params_1, 0); + _ -> %% Ignore - _ = trace(Other), + _ = trace(Msg), output_handler(Params, Seq) end end. @@ -1152,9 +1178,12 @@ output_handler_data(Params, Seq) -> output_handler_data(Params, Seq); dist_tick -> output_handler_data(Params, Seq); - Other -> + _ when Msg =:= Params#params.rekey_msg -> + Params_1 = output_handler_rekey(Params, Seq), + output_handler_data(Params_1, 0); + _ -> %% Ignore - _ = trace(Other), + _ = trace(Msg), output_handler_data(Params, Seq) end after 0 -> @@ -1173,9 +1202,12 @@ output_handler_tick(Params, Seq) -> output_handler_data(Params, Seq); dist_tick -> output_handler_tick(Params, Seq); - Other -> + _ when Msg =:= Params#params.rekey_msg -> + Params_1 = output_handler_rekey(Params, Seq), + output_handler(Params_1, 0); + _ -> %% Ignore - _ = trace(Other), + _ = trace(Msg), output_handler_tick(Params, Seq) end after 0 -> @@ -1192,22 +1224,31 @@ output_handler_tick(Params, Seq) -> end end. +output_handler_rekey(Params, Seq) -> + case encrypt_and_send_rekey_chunk(Params, Seq) of + #params{} = Params_1 -> + Params_1; + SendError -> + _ = trace(SendError), + death_row() + end. + output_handler_send(Params, Seq, {_, Size, _} = Q) -> if ?CHUNK_SIZE < Size -> - output_handler_send(Params, Seq, Q, ?CHUNK_SIZE); + output_handler_deq_send(Params, Seq, Q, ?CHUNK_SIZE); true -> case get_data(Params#params.dist_handle, Q) of {_, 0, _} -> {Params, Seq}; {_, Size, _} = Q_1 -> % Got no more - output_handler_send(Params, Seq, Q_1, Size); + output_handler_deq_send(Params, Seq, Q_1, Size); Q_1 -> output_handler_send(Params, Seq, Q_1) end end. -output_handler_send(Params, Seq, Q, Size) -> +output_handler_deq_send(Params, Seq, Q, Size) -> {Cleartext, Q_1} = deq_iovec(Size, Q), case encrypt_and_send_chunk(Params, Seq, [?DATA_CHUNK, Cleartext]) @@ -1358,13 +1399,30 @@ deliver_data(DistHandle, Front, Size, Rear, Bin) -> encrypt_and_send_chunk( #params{ + socket = Socket, rekey_count = Seq, rekey_msg = RekeyMsg} = Params, + Seq, Cleartext) -> + %% + cancel_rekey_timer(RekeyMsg), + case encrypt_and_send_rekey_chunk(Params, Seq) of + #params{} = Params_1 -> + Result = + gen_tcp:send(Socket, encrypt_chunk(Params, 0, Cleartext)), + {Params_1, 1, Result}; + SendError -> + {Params, Seq + 1, SendError} + end; +encrypt_and_send_chunk(#params{socket = Socket} = Params, Seq, Cleartext) -> + Result = gen_tcp:send(Socket, encrypt_chunk(Params, Seq, Cleartext)), + {Params, Seq + 1, Result}. + +encrypt_and_send_rekey_chunk( + #params{ socket = Socket, - rekey_interval = Seq, rekey_key = PubKeyB, key = Key, iv = {IVSalt, IVNo}, hmac_algorithm = HmacAlgo} = Params, - Seq, Cleartext) -> + Seq) -> %% KeyLen = byte_size(Key), IVSaltLen = byte_size(IVSalt), @@ -1380,17 +1438,13 @@ encrypt_and_send_chunk( hmac_key_iv( HmacAlgo, SharedSecret, [Key, IVSalt, IV], KeyLen, IVSaltLen + 6), - Params_1 = Params#params{key = Key_1, iv = {IVSalt_1, IVNo_1}}, - Result = - gen_tcp:send(Socket, encrypt_chunk(Params_1, 0, Cleartext)), - {Params_1, 1, Result}; + Params#params{ + key = Key_1, iv = {IVSalt_1, IVNo_1}, + rekey_msg = start_rekey_timer(Params#params.rekey_time)}; SendError -> - {Params, Seq + 1, SendError} - end; -encrypt_and_send_chunk(#params{socket = Socket} = Params, Seq, Cleartext) -> - Result = gen_tcp:send(Socket, encrypt_chunk(Params, Seq, Cleartext)), - {Params, Seq + 1, Result}. - + SendError + end. + encrypt_chunk( #params{ aead_cipher = AeadCipher, @@ -1431,7 +1485,7 @@ decrypt_chunk( block_decrypt( #params{ rekey_key = #key_pair{public = PubKeyA} = KeyPair, - rekey_interval = RekeyInterval} = Params, + rekey_count = RekeyCount} = Params, Seq, AeadCipher, Key, IV, Data) -> %% case crypto:block_decrypt(AeadCipher, Key, IV, Data) of @@ -1453,7 +1507,7 @@ block_decrypt( end; Chunk when is_binary(Chunk) -> case Seq of - RekeyInterval -> + RekeyCount -> %% This was one chunk too many without rekeying error; _ -> diff --git a/lib/ssl/test/openssl_alpn_SUITE.erl b/lib/ssl/test/openssl_alpn_SUITE.erl index 0e3e3daee3..299a97b76d 100644 --- a/lib/ssl/test/openssl_alpn_SUITE.erl +++ b/lib/ssl/test/openssl_alpn_SUITE.erl @@ -35,7 +35,6 @@ %%-------------------------------------------------------------------- all() -> - %% Note: ALPN not supported in sslv3 case ssl_test_lib:openssl_sane_dtls_alpn() of true -> [ diff --git a/lib/ssl/test/openssl_cipher_suite_SUITE.erl b/lib/ssl/test/openssl_cipher_suite_SUITE.erl index 5c10defd2f..6daf1a56b4 100644 --- a/lib/ssl/test/openssl_cipher_suite_SUITE.erl +++ b/lib/ssl/test/openssl_cipher_suite_SUITE.erl @@ -42,7 +42,6 @@ all_protocol_groups() -> [{group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'} ]. @@ -56,7 +55,6 @@ groups() -> {'tlsv1.2', [], kex()}, {'tlsv1.1', [], kex()}, {'tlsv1', [], kex()}, - {'sslv3', [], kex()}, {'dtlsv1.2', [], dtls_kex()}, {'dtlsv1', [], dtls_kex()}, {dhe_rsa, [],[dhe_rsa_3des_ede_cbc, diff --git a/lib/ssl/test/openssl_client_cert_SUITE.erl b/lib/ssl/test/openssl_client_cert_SUITE.erl index dce40b5638..a094b8ab39 100644 --- a/lib/ssl/test/openssl_client_cert_SUITE.erl +++ b/lib/ssl/test/openssl_client_cert_SUITE.erl @@ -41,7 +41,6 @@ groups() -> {'tlsv1.2', [], pre_tls_1_3_protocol_groups()}, {'tlsv1.1', [], pre_tls_1_3_protocol_groups()}, {'tlsv1', [], pre_tls_1_3_protocol_groups()}, - {'sslv3', [], ssl_protocol_groups()}, {'dtlsv1.2', [], pre_tls_1_3_protocol_groups()}, {'dtlsv1', [], pre_tls_1_3_protocol_groups()}, {rsa, [], all_version_tests()}, @@ -57,7 +56,6 @@ protocol_groups() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'} ]. diff --git a/lib/ssl/test/openssl_reject_SUITE.erl b/lib/ssl/test/openssl_reject_SUITE.erl index deefd11823..a637035f3c 100644 --- a/lib/ssl/test/openssl_reject_SUITE.erl +++ b/lib/ssl/test/openssl_reject_SUITE.erl @@ -36,20 +36,20 @@ all() -> [{group, 'tlsv1.2'}, {group, 'tlsv1.1'}, - {group, 'tlsv1'}, - {group, 'sslv3'}]. + {group, 'tlsv1'} + ]. groups() -> [{'tlsv1.2', [], all_versions_tests()}, {'tlsv1.1', [], all_versions_tests()}, - {'tlsv1', [], all_versions_tests()}, - {'sslv3', [], all_versions_tests()} + {'tlsv1', [], all_versions_tests()} ]. - + all_versions_tests() -> - [ + [ erlang_client_bad_openssl_server, - ssl2_erlang_server_openssl_client + ssl2_erlang_server_openssl_client, + ssl3_erlang_server_openssl_client ]. init_per_suite(Config0) -> @@ -110,6 +110,14 @@ special_init(ssl2_erlang_server_openssl_client, Config) -> false -> {skip, "sslv2 not supported by openssl"} end; +special_init(ssl3_erlang_server_openssl_client, Config) -> + case ssl_test_lib:supports_ssl_tls_version(sslv3) of + true -> + Config; + false -> + {skip, "sslv3 not supported by openssl"} + end; + special_init(_, Config) -> Config. @@ -193,9 +201,34 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> ct:log("Ports ~p~n", [[erlang:port_info(P) || P <- erlang:ports()]]), ssl_test_lib:consume_port_exit(OpenSslPort), - ssl_test_lib:check_server_alert(Server, unexpected_message), + ssl_test_lib:check_server_alert(Server, bad_record_mac), process_flag(trap_exit, false). +%%-------------------------------------------------------------------- +ssl3_erlang_server_openssl_client() -> + [{doc,"Test that ssl v3 clients are rejected"}]. + +ssl3_erlang_server_openssl_client(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + + {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Exe = "openssl", + Args = ["s_client", "-connect", ssl_test_lib:hostname_format(Hostname) ++ ":" ++ integer_to_list(Port), + "-ssl3", "-msg"], + + OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), + + ct:log("Ports ~p~n", [[erlang:port_info(P) || P <- erlang:ports()]]), + ssl_test_lib:consume_port_exit(OpenSslPort), + ssl_test_lib:check_server_alert(Server, bad_record_mac), + process_flag(trap_exit, false). %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ diff --git a/lib/ssl/test/openssl_renegotiate_SUITE.erl b/lib/ssl/test/openssl_renegotiate_SUITE.erl index f40d0b1575..f548b75abe 100644 --- a/lib/ssl/test/openssl_renegotiate_SUITE.erl +++ b/lib/ssl/test/openssl_renegotiate_SUITE.erl @@ -40,14 +40,13 @@ all() -> [{group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'}]; false -> [{group, 'tlsv1.2'}, {group, 'tlsv1.1'}, - {group, 'tlsv1'}, - {group, 'sslv3'}] + {group, 'tlsv1'} + ] end. groups() -> @@ -56,15 +55,13 @@ groups() -> [{'tlsv1.2', [], all_versions_tests()}, {'tlsv1.1', [], all_versions_tests()}, {'tlsv1', [], all_versions_tests()}, - {'sslv3', [], all_versions_tests()}, {'dtlsv1.2', [], all_versions_tests()}, {'dtlsv1', [], all_versions_tests()} ]; false -> [{'tlsv1.2', [], all_versions_tests()}, {'tlsv1.1', [], all_versions_tests()}, - {'tlsv1', [], all_versions_tests()}, - {'sslv3', [], all_versions_tests()} + {'tlsv1', [], all_versions_tests()} ] end. diff --git a/lib/ssl/test/openssl_server_cert_SUITE.erl b/lib/ssl/test/openssl_server_cert_SUITE.erl index 8e97f70064..b0713ab37d 100644 --- a/lib/ssl/test/openssl_server_cert_SUITE.erl +++ b/lib/ssl/test/openssl_server_cert_SUITE.erl @@ -40,7 +40,6 @@ groups() -> {'tlsv1.2', [], pre_tls_1_3_protocol_groups()}, {'tlsv1.1', [], pre_tls_1_3_protocol_groups()}, {'tlsv1', [], pre_tls_1_3_protocol_groups()}, - {'sslv3', [], ssl_protocol_groups()}, {'dtlsv1.2', [], pre_tls_1_3_protocol_groups()}, {'dtlsv1', [], pre_tls_1_3_protocol_groups()}, {rsa, [], all_version_tests()}, @@ -58,7 +57,6 @@ protocol_groups() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'} ]. diff --git a/lib/ssl/test/openssl_session_SUITE.erl b/lib/ssl/test/openssl_session_SUITE.erl index 6f74408cb4..d524e6c039 100644 --- a/lib/ssl/test/openssl_session_SUITE.erl +++ b/lib/ssl/test/openssl_session_SUITE.erl @@ -39,14 +39,13 @@ all() -> [{group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'}]; false -> [{group, 'tlsv1.2'}, {group, 'tlsv1.1'}, - {group, 'tlsv1'}, - {group, 'sslv3'}] + {group, 'tlsv1'} + ] end. groups() -> @@ -55,15 +54,13 @@ groups() -> [{'tlsv1.2', [], tests()}, {'tlsv1.1', [], tests()}, {'tlsv1', [], tests()}, - {'sslv3', [], tests()}, {'dtlsv1.2', [], tests()}, {'dtlsv1', [], tests()} ]; false -> [{'tlsv1.2', [], tests()}, {'tlsv1.1', [], tests()}, - {'tlsv1', [], tests()}, - {'sslv3', [], tests()} + {'tlsv1', [], tests()} ] end. diff --git a/lib/ssl/test/property_test/ssl_eqc_cipher_format.erl b/lib/ssl/test/property_test/ssl_eqc_cipher_format.erl index f225065ba6..b661ec8806 100644 --- a/lib/ssl/test/property_test/ssl_eqc_cipher_format.erl +++ b/lib/ssl/test/property_test/ssl_eqc_cipher_format.erl @@ -55,14 +55,13 @@ -define('TLS_v1.2', 'tlsv1.2'). -define('TLS_v1.1', 'tlsv1.1'). -define('TLS_v1', 'tlsv1'). --define('SSL_v3', 'sslv3'). %%-------------------------------------------------------------------- %% Properties -------------------------------------------------------- %%-------------------------------------------------------------------- prop_tls_cipher_suite_rfc_name() -> - ?FORALL({CipherSuite, TLSVersion}, ?LET(Version, tls_version(), {cipher_suite(Version), Version}), + ?FORALL({CipherSuite, _TLSVersion}, ?LET(Version, tls_version(), {cipher_suite(Version), Version}), case ssl:str_to_suite(ssl:suite_to_str(CipherSuite)) of CipherSuite -> true; @@ -72,7 +71,7 @@ prop_tls_cipher_suite_rfc_name() -> ). prop_tls_cipher_suite_openssl_name() -> - ?FORALL({CipherSuite, TLSVersion}, ?LET(Version, tls_version(), {cipher_suite(Version), Version}), + ?FORALL({CipherSuite, _TLSVersion}, ?LET(Version, tls_version(), {cipher_suite(Version), Version}), case ssl:str_to_suite(ssl:suite_to_openssl_str(CipherSuite)) of CipherSuite -> true; @@ -86,7 +85,7 @@ prop_tls_cipher_suite_openssl_name() -> %% Generators ----------------------------------------------- %%-------------------------------------------------------------------- tls_version() -> - oneof([?'TLS_v1.2', ?'TLS_v1.1', ?'TLS_v1', ?'SSL_v3']). + oneof([?'TLS_v1.3', ?'TLS_v1.2', ?'TLS_v1.1', ?'TLS_v1']). cipher_suite(Version) -> oneof(cipher_suites(Version)). diff --git a/lib/ssl/test/property_test/ssl_eqc_handshake.erl b/lib/ssl/test/property_test/ssl_eqc_handshake.erl index f19a74898d..ea1b078892 100644 --- a/lib/ssl/test/property_test/ssl_eqc_handshake.erl +++ b/lib/ssl/test/property_test/ssl_eqc_handshake.erl @@ -62,7 +62,6 @@ -define('TLS_v1.2', {3,3}). -define('TLS_v1.1', {3,2}). -define('TLS_v1', {3,1}). --define('SSL_v3', {3,0}). %%-------------------------------------------------------------------- %% Properties -------------------------------------------------------- @@ -132,14 +131,6 @@ client_hello(Version) -> compression_methods = compressions(Version), random = client_random(Version), extensions = client_hello_extensions(Version) - }; -client_hello(?'SSL_v3' = Version) -> - #client_hello{session_id = session_id(), - client_version = Version, - cipher_suites = cipher_suites(Version), - compression_methods = compressions(Version), - random = client_random(Version), - extensions = ssl_handshake:empty_extensions(Version, client_hello) }. server_hello(?'TLS_v1.3' = Version) -> @@ -150,14 +141,6 @@ server_hello(?'TLS_v1.3' = Version) -> compression_method = compression(Version), extensions = server_hello_extensions(Version) }; -server_hello(?'SSL_v3' = Version) -> - #server_hello{server_version = Version, - session_id = session_id(), - random = server_random(Version), - cipher_suite = cipher_suite(Version), - compression_method = compression(Version), - extensions = ssl_handshake:empty_extensions(Version, server_hello) - }; server_hello(Version) -> #server_hello{server_version = Version, session_id = session_id(), @@ -214,7 +197,7 @@ key_update() -> %%-------------------------------------------------------------------- tls_version() -> - oneof([?'TLS_v1.3', ?'TLS_v1.2', ?'TLS_v1.1', ?'TLS_v1', ?'SSL_v3']). + oneof([?'TLS_v1.3', ?'TLS_v1.2', ?'TLS_v1.1', ?'TLS_v1']). cipher_suite(Version) -> oneof(cipher_suites(Version)). @@ -382,8 +365,6 @@ extensions(?'TLS_v1.3' = Version, MsgType = client_hello) -> %% post_handshake_auth => PostHandshakeAuth, signature_algs_cert => SignatureAlgorithmsCert })); -extensions(?'SSL_v3', client_hello) -> - #{}; extensions(Version, client_hello) -> ?LET({ SNI, diff --git a/lib/ssl/test/ssl_alpn_SUITE.erl b/lib/ssl/test/ssl_alpn_SUITE.erl index 82a49e1469..f81a853bd1 100644 --- a/lib/ssl/test/ssl_alpn_SUITE.erl +++ b/lib/ssl/test/ssl_alpn_SUITE.erl @@ -37,7 +37,6 @@ all() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'} ]. @@ -48,7 +47,6 @@ groups() -> {'tlsv1.2', [], alpn_tests() ++ alpn_npn_coexist()}, {'tlsv1.1', [], alpn_tests() ++ alpn_npn_coexist()}, {'tlsv1', [], alpn_tests() ++ alpn_npn_coexist()}, - {'sslv3', [], alpn_not_supported()}, {'dtlsv1.2', [], alpn_tests() ++ alpn_npn_coexist()}, {'dtlsv1', [], alpn_tests() ++ alpn_npn_coexist()} ]. @@ -74,10 +72,6 @@ alpn_npn_coexist() -> client_alpn_and_server_alpn_npn ]. -alpn_not_supported() -> - [alpn_not_supported_client, - alpn_not_supported_server - ]. init_per_suite(Config0) -> catch crypto:stop(), @@ -274,30 +268,6 @@ session_reused(Config) when is_list(Config)-> ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0, ssl_test_lib:reuse_session(ClientOpts, ServerOpts, Config). -%-------------------------------------------------------------------------------- - -alpn_not_supported_client(Config) when is_list(Config) -> - ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config), - PrefProtocols = {client_preferred_next_protocols, - {client, [<<"http/1.0">>], <<"http/1.1">>}}, - ClientOpts = [PrefProtocols] ++ ClientOpts0, - {ClientNode, _ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Client = ssl_test_lib:start_client_error([{node, ClientNode}, - {port, 8888}, {host, Hostname}, - {from, self()}, {options, ClientOpts}]), - - ssl_test_lib:check_result(Client, {error, - {options, - {not_supported_in_sslv3, PrefProtocols}}}). - -%-------------------------------------------------------------------------------- - -alpn_not_supported_server(Config) when is_list(Config)-> - ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), - AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, - ServerOpts = [AdvProtocols] ++ ServerOpts0, - - {error, {options, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts). %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ diff --git a/lib/ssl/test/ssl_api_SUITE.erl b/lib/ssl/test/ssl_api_SUITE.erl index b393ba2f9b..00f59d3cce 100644 --- a/lib/ssl/test/ssl_api_SUITE.erl +++ b/lib/ssl/test/ssl_api_SUITE.erl @@ -37,7 +37,6 @@ all() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'} ]. @@ -51,7 +50,6 @@ groups() -> {'tlsv1.2', [], gen_api_tests() ++ since_1_2() ++ handshake_paus_tests() ++ pre_1_3()}, {'tlsv1.1', [], gen_api_tests() ++ handshake_paus_tests() ++ pre_1_3()}, {'tlsv1', [], gen_api_tests() ++ handshake_paus_tests() ++ pre_1_3() ++ beast_mitigation_test()}, - {'sslv3', [], (gen_api_tests() -- [new_options_in_handshake]) ++ beast_mitigation_test() ++ pre_1_3()}, {'dtlsv1.2', [], (gen_api_tests() -- [invalid_keyfile, invalid_certfile, invalid_cacertfile, invalid_options, new_options_in_handshake]) ++ diff --git a/lib/ssl/test/ssl_app_env_SUITE.erl b/lib/ssl/test/ssl_app_env_SUITE.erl index 27fbcb8e47..233985c729 100644 --- a/lib/ssl/test/ssl_app_env_SUITE.erl +++ b/lib/ssl/test/ssl_app_env_SUITE.erl @@ -37,7 +37,6 @@ all() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'} ]. @@ -48,7 +47,6 @@ groups() -> {'tlsv1.2', [], tests()}, {'tlsv1.1', [], tests()}, {'tlsv1', [], tests()}, - {'sslv3', [], tests()}, {'dtlsv1.2', [], tests()}, {'dtlsv1', [], tests()} ]. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index fbe2d4f6b0..2ca6c7de3d 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -173,7 +173,7 @@ connect_twice(Config) when is_list(Config) -> ssl_test_lib:close(Client1). defaults(Config) when is_list(Config)-> Versions = ssl:versions(), - true = lists:member(sslv3, proplists:get_value(available, Versions)), + false = lists:member(sslv3, proplists:get_value(available, Versions)), false = lists:member(sslv3, proplists:get_value(supported, Versions)), true = lists:member('tlsv1', proplists:get_value(available, Versions)), false = lists:member('tlsv1', proplists:get_value(supported, Versions)), @@ -321,7 +321,7 @@ cipher_suites_mix(Config) when is_list(Config) -> {host, Hostname}, {from, self()}, {mfa, {ssl_test_lib, send_recv_result_active, []}}, - {options, [{ciphers, CipherSuites} | ClientOpts]}]), + {options, [{versions, ['tlsv1.2']},{ciphers, CipherSuites} | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), @@ -406,7 +406,6 @@ eccs() -> eccs(Config) when is_list(Config) -> [_|_] = All = ssl:eccs(), - [] = ssl:eccs(sslv3), [_|_] = Tls = ssl:eccs(tlsv1), [_|_] = Tls1 = ssl:eccs('tlsv1.1'), [_|_] = Tls2 = ssl:eccs('tlsv1.2'), diff --git a/lib/ssl/test/ssl_bench_test_lib.erl b/lib/ssl/test/ssl_bench_test_lib.erl index 47bcd41608..7000683819 100644 --- a/lib/ssl/test/ssl_bench_test_lib.erl +++ b/lib/ssl/test/ssl_bench_test_lib.erl @@ -41,13 +41,13 @@ setup(Name) -> lists:append([" -pa " ++ P || [P] <- PaPaths]); _ -> [] end, - %% io:format("Slave args: ~p~n",[SlaveArgs]), + %% ct:pal("Slave args: ~p~n",[SlaveArgs]), Prog = case os:find_executable("erl") of false -> "erl"; P -> P end, - io:format("Prog = ~p~n", [Prog]), + ct:pal("Prog = ~p~n", [Prog]), case net_adm:ping(Node) of pong -> ok; @@ -58,13 +58,13 @@ setup(Name) -> Path = code:get_path(), true = rpc:call(Node, code, set_path, [Path]), ok = rpc:call(Node, ?MODULE, setup_server, [node()]), - io:format("Client (~p) using ~ts~n",[node(), code:which(ssl)]), + ct:pal("Client (~p) using ~ts~n",[node(), code:which(ssl)]), (Node =:= node()) andalso restrict_schedulers(client), Node. setup_server(ClientNode) -> (ClientNode =:= node()) andalso restrict_schedulers(server), - io:format("Server (~p) using ~ts~n",[node(), code:which(ssl)]), + ct:pal("Server (~p) using ~ts~n",[node(), code:which(ssl)]), ok. restrict_schedulers(Type) -> diff --git a/lib/ssl/test/ssl_cert_SUITE.erl b/lib/ssl/test/ssl_cert_SUITE.erl index d5ca9bcf02..bcf2086cca 100644 --- a/lib/ssl/test/ssl_cert_SUITE.erl +++ b/lib/ssl/test/ssl_cert_SUITE.erl @@ -36,7 +36,6 @@ all() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'} ]. @@ -47,7 +46,6 @@ groups() -> {'tlsv1.2', [], tls_1_2_protocol_groups()}, {'tlsv1.1', [], ssl_protocol_groups()}, {'tlsv1', [], ssl_protocol_groups()}, - {'sslv3', [], ssl_protocol_groups()}, {'dtlsv1.2', [], tls_1_2_protocol_groups()}, {'dtlsv1', [], ssl_protocol_groups()}, {rsa, [], all_version_tests() ++ rsa_tests() ++ pre_tls_1_3_rsa_tests()}, diff --git a/lib/ssl/test/ssl_cipher_suite_SUITE.erl b/lib/ssl/test/ssl_cipher_suite_SUITE.erl index e598d662e9..afb11660e7 100644 --- a/lib/ssl/test/ssl_cipher_suite_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_suite_SUITE.erl @@ -35,7 +35,6 @@ all() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'} ]. @@ -45,7 +44,6 @@ groups() -> {'tlsv1.2', [], kex()}, {'tlsv1.1', [], kex()}, {'tlsv1', [], kex()}, - {'sslv3', [], ssl3_kex()}, {'dtlsv1.2', [], kex()}, {'dtlsv1', [], kex()}, {dhe_rsa, [],[dhe_rsa_3des_ede_cbc, @@ -130,11 +128,6 @@ groups() -> kex() -> rsa() ++ ecdsa() ++ dss() ++ anonymous(). - -ssl3_kex() -> - ssl3_rsa() ++ ssl3_dss() ++ ssl3_anonymous(). - - rsa() -> [{group, dhe_rsa}, {group, ecdhe_rsa}, @@ -143,11 +136,6 @@ rsa() -> {group, rsa_psk} ]. -ssl3_rsa() -> - [{group, dhe_rsa}, - {group, rsa} - ]. - ecdsa() -> [{group, ecdhe_ecdsa}]. @@ -155,10 +143,6 @@ dss() -> [{group, dhe_dss}, {group, srp_dss}]. -ssl3_dss() -> - [{group, dhe_dss} - ]. - anonymous() -> [{group, dh_anon}, {group, ecdh_anon}, @@ -168,10 +152,6 @@ anonymous() -> {group, srp_anon} ]. -ssl3_anonymous() -> - [{group, dh_anon}]. - - init_per_suite(Config) -> catch crypto:stop(), try crypto:start() of diff --git a/lib/ssl/test/ssl_engine_SUITE.erl b/lib/ssl/test/ssl_engine_SUITE.erl index a39a62e550..ac54a2637e 100644 --- a/lib/ssl/test/ssl_engine_SUITE.erl +++ b/lib/ssl/test/ssl_engine_SUITE.erl @@ -101,15 +101,18 @@ private_key(Config) when is_list(Config) -> #{server_config := ServerConf, client_config := ClientConf} = GenCertData = public_key:pkix_test_data(#{server_chain => - #{root => [{key, ssl_test_lib:hardcode_rsa_key(1)}], - intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(2)}]], - peer => [{extensions, Ext}, + #{root => [{digest, sha256}, + {key, ssl_test_lib:hardcode_rsa_key(1)}], + intermediates => [[{digest, sha256}, + {key, ssl_test_lib:hardcode_rsa_key(2)}]], + peer => [{extensions, Ext}, {digest, sha256}, {key, ssl_test_lib:hardcode_rsa_key(3)} ]}, client_chain => - #{root => [{key, ssl_test_lib:hardcode_rsa_key(4)}], - intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(5)}]], - peer => [{key, ssl_test_lib:hardcode_rsa_key(6)}]}}), + #{root => [{key, ssl_test_lib:hardcode_rsa_key(4)}, {digest, sha256}], + intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(5)}, + {digest, sha256}]], + peer => [{key, ssl_test_lib:hardcode_rsa_key(6)},{digest, sha256}]}}), [{server_config, FileServerConf}, {client_config, FileClientConf}] = x509_test:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase), diff --git a/lib/ssl/test/ssl_npn_SUITE.erl b/lib/ssl/test/ssl_npn_SUITE.erl index 1f794075c1..94448b5721 100644 --- a/lib/ssl/test/ssl_npn_SUITE.erl +++ b/lib/ssl/test/ssl_npn_SUITE.erl @@ -33,15 +33,14 @@ all() -> [{group, 'tlsv1.2'}, {group, 'tlsv1.1'}, - {group, 'tlsv1'}, - {group, 'sslv3'}]. + {group, 'tlsv1'} + ]. groups() -> [ {'tlsv1.2', [], next_protocol_tests()}, {'tlsv1.1', [], next_protocol_tests()}, - {'tlsv1', [], next_protocol_tests()}, - {'sslv3', [], next_protocol_not_supported()} + {'tlsv1', [], next_protocol_tests()} ]. next_protocol_tests() -> @@ -59,11 +58,6 @@ next_protocol_tests() -> npn_handshake_session_reused ]. -next_protocol_not_supported() -> - [npn_not_supported_client, - npn_not_supported_server - ]. - init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of @@ -220,29 +214,6 @@ renegotiate_from_client_after_npn_handshake(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client, ok). %-------------------------------------------------------------------------------- -npn_not_supported_client(Config) when is_list(Config) -> - ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), - PrefProtocols = {client_preferred_next_protocols, - {client, [<<"http/1.0">>], <<"http/1.1">>}}, - ClientOpts = [PrefProtocols] ++ ClientOpts0, - {ClientNode, _ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Client = ssl_test_lib:start_client_error([{node, ClientNode}, - {port, 8888}, {host, Hostname}, - {from, self()}, {options, ClientOpts}]), - - ssl_test_lib:check_result(Client, {error, - {options, - {not_supported_in_sslv3, PrefProtocols}}}). - -%-------------------------------------------------------------------------------- -npn_not_supported_server(Config) when is_list(Config)-> - ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config), - AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, - ServerOpts = [AdvProtocols] ++ ServerOpts0, - - {error, {options, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts). - -%-------------------------------------------------------------------------------- npn_handshake_session_reused(Config) when is_list(Config)-> ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), ClientOpts = [{client_preferred_next_protocols, diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 99cf19f3ef..7cd84781d3 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -54,7 +54,6 @@ all() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'} ]. @@ -64,7 +63,6 @@ groups() -> {'tlsv1.2', [], socket_packet_tests() ++ protocol_packet_tests()}, {'tlsv1.1', [], socket_packet_tests() ++ protocol_packet_tests()}, {'tlsv1', [], socket_packet_tests() ++ protocol_packet_tests()}, - {'sslv3', [], socket_packet_tests() ++ protocol_packet_tests()}, %% We will not support any packet types if the transport is %% not reliable. We might support it for DTLS over SCTP in the future {'dtlsv1.2', [], [reject_packet_opt]}, @@ -1132,7 +1130,7 @@ server_send_trailer(Socket, Trailer)-> client_http_decode_trailer_active(Socket) -> receive {ssl, Socket, - {http_header,36,'Content-Encoding',undefined,"gzip"}} -> + {http_header,36,'Content-Encoding',"Content-Encoding","gzip"}} -> ok; Other1 -> exit({?LINE, Other1}) @@ -1182,7 +1180,7 @@ packet_httph_bin_active(Config) when is_list(Config) -> client_http_decode_trailer_bin_active(Socket) -> receive {ssl, Socket, - {http_header,36,'Content-Encoding',undefined, <<"gzip">>}} -> + {http_header,36,'Content-Encoding',<<"Content-Encoding">>, <<"gzip">>}} -> ok; Other1 -> exit({?LINE, Other1}) @@ -1234,7 +1232,7 @@ client_http_decode_trailer_active_once(Socket) -> ssl:setopts(Socket, [{active, once}]), receive {ssl, Socket, - {http_header,36,'Content-Encoding',undefined,"gzip"}} -> + {http_header,36,'Content-Encoding',"Content-Encoding","gzip"}} -> ok; Other1 -> exit({?LINE, Other1}) @@ -1286,7 +1284,7 @@ client_http_decode_trailer_bin_active_once(Socket) -> ssl:setopts(Socket, [{active, once}]), receive {ssl, Socket, - {http_header,36,'Content-Encoding',undefined, <<"gzip">>}} -> + {http_header,36,'Content-Encoding',<<"Content-Encoding">>, <<"gzip">>}} -> ok; Other1 -> exit({?LINE, Other1}) @@ -1337,7 +1335,7 @@ packet_httph_passive(Config) when is_list(Config) -> ssl_test_lib:close(Client). client_http_decode_trailer_passive(Socket) -> - {ok,{http_header,36,'Content-Encoding',undefined,"gzip"}} = ssl:recv(Socket, 0), + {ok,{http_header,36,'Content-Encoding',"Content-Encoding","gzip"}} = ssl:recv(Socket, 0), {ok, http_eoh} = ssl:recv(Socket, 0), ok. @@ -1377,7 +1375,7 @@ packet_httph_bin_passive(Config) when is_list(Config) -> ssl_test_lib:close(Client). client_http_decode_trailer_bin_passive(Socket) -> - {ok,{http_header,36,'Content-Encoding',undefined,<<"gzip">>}} = ssl:recv(Socket, 0), + {ok,{http_header,36,'Content-Encoding',<<"Content-Encoding">>,<<"gzip">>}} = ssl:recv(Socket, 0), {ok, http_eoh} = ssl:recv(Socket, 0), ok. diff --git a/lib/ssl/test/ssl_payload_SUITE.erl b/lib/ssl/test/ssl_payload_SUITE.erl index 4374d9ff47..a133159c8b 100644 --- a/lib/ssl/test/ssl_payload_SUITE.erl +++ b/lib/ssl/test/ssl_payload_SUITE.erl @@ -36,8 +36,7 @@ all() -> {group, 'tlsv1.3'}, {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, - {group, 'tlsv1'}, - {group, 'sslv3'} + {group, 'tlsv1'} ]. groups() -> @@ -45,8 +44,7 @@ groups() -> {'tlsv1.3', [], payload_tests()}, {'tlsv1.2', [], payload_tests()}, {'tlsv1.1', [], payload_tests()}, - {'tlsv1', [], payload_tests()}, - {'sslv3', [], payload_tests()} + {'tlsv1', [], payload_tests()} ]. payload_tests() -> diff --git a/lib/ssl/test/ssl_renegotiate_SUITE.erl b/lib/ssl/test/ssl_renegotiate_SUITE.erl index 921604458a..f4d57076eb 100644 --- a/lib/ssl/test/ssl_renegotiate_SUITE.erl +++ b/lib/ssl/test/ssl_renegotiate_SUITE.erl @@ -39,7 +39,6 @@ all() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'} ]. @@ -50,8 +49,7 @@ groups() -> {'tlsv1.3', [], renegotiate_tests()}, {'tlsv1.2', [], renegotiate_tests()}, {'tlsv1.1', [], renegotiate_tests()}, - {'tlsv1', [], renegotiate_tests()}, - {'sslv3', [], ssl3_renegotiate_tests()} + {'tlsv1', [], renegotiate_tests()} ]. renegotiate_tests() -> diff --git a/lib/ssl/test/ssl_session_SUITE.erl b/lib/ssl/test/ssl_session_SUITE.erl index aa79698a72..fc31db1a83 100644 --- a/lib/ssl/test/ssl_session_SUITE.erl +++ b/lib/ssl/test/ssl_session_SUITE.erl @@ -40,7 +40,6 @@ all() -> {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, - {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'} ]. @@ -51,8 +50,7 @@ groups() -> {'tlsv1.3', [], session_tests()}, {'tlsv1.2', [], session_tests()}, {'tlsv1.1', [], session_tests()}, - {'tlsv1', [], session_tests()}, - {'sslv3', [], session_tests()} + {'tlsv1', [], session_tests()} ]. session_tests() -> @@ -102,25 +100,30 @@ end_per_group(GroupName, Config) -> end. init_per_testcase(reuse_session_expired, Config) -> + Versions = ssl_test_lib:protocol_version(Config), ssl:stop(), - application:load(ssl), + application:load(ssl), ssl_test_lib:clean_env(), + ssl_test_lib:set_protocol_versions(Versions), application:set_env(ssl, session_lifetime, ?EXPIRE), - application:set_env(ssl, session_delay_cleanup_time, 500), ssl:start(), + ssl_test_lib:ct_log_supported_protocol_versions(Config), ct:timetrap({seconds, 30}), Config; init_per_testcase(_, Config) -> + ssl_test_lib:ct_log_supported_protocol_versions(Config), ct:timetrap({seconds, 15}), Config. -end_per_testcase(_TestCase, Config) -> +end_per_testcase(reuse_session_expired, Config) -> + application:unset_env(ssl, session_lifetime), + Config; +end_per_testcase(_, Config) -> Config. %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- - reuse_session() -> [{doc,"Test reuse of sessions (short handshake)"}]. reuse_session(Config) when is_list(Config) -> @@ -181,6 +184,7 @@ reuse_session_expired(Config) when is_list(Config) -> {from, self()}, {options, ClientOpts}]), receive {Client2, SID} -> + end_per_testcase(?FUNCTION_NAME, Config), ct:fail(session_reused_when_session_expired); {Client2, _} -> ok diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index f3b1c38d2e..e25244750e 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -27,7 +27,6 @@ -include_lib("common_test/include/ct.hrl"). --define(DELAY, 500). -define(SLEEP, 1000). -define(TIMEOUT, 60000). -define(LONG_TIMEOUT, 600000). @@ -43,7 +42,26 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- -all() -> + +all() -> + [ + {group, 'tlsv1.2'}, + {group, 'tlsv1.1'}, + {group, 'tlsv1'}, + {group, 'dtlsv1.2'}, + {group, 'dtlsv1'} + ]. + +groups() -> + [{'dtlsv1.2', [], session_tests()}, + {'dtlsv1', [], session_tests()}, + {'tlsv1.2', [], session_tests()}, + {'tlsv1.1', [], session_tests()}, + {'tlsv1', [], session_tests()} + ]. + + +session_tests() -> [session_cleanup, session_cache_process_list, session_cache_process_mnesia, @@ -52,9 +70,6 @@ all() -> save_specific_session ]. -groups() -> - []. - init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of @@ -70,11 +85,28 @@ end_per_suite(_Config) -> ssl:stop(), application:stop(crypto). -init_per_group(_GroupName, Config) -> - Config. +init_per_group(GroupName, Config) -> + ssl_test_lib:clean_tls_version(Config), + case ssl_test_lib:is_tls_version(GroupName) andalso ssl_test_lib:sufficient_crypto_support(GroupName) of + true -> + ssl_test_lib:init_tls_version(GroupName, Config); + _ -> + case ssl_test_lib:sufficient_crypto_support(GroupName) of + true -> + ssl:start(), + Config; + false -> + {skip, "Missing crypto support"} + end + end. -end_per_group(_GroupName, Config) -> - Config. +end_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:clean_tls_version(Config); + false -> + Config + end. init_per_testcase(session_cache_process_list, Config) -> init_customized_session_cache(list, Config); @@ -84,37 +116,47 @@ init_per_testcase(session_cache_process_mnesia, Config) -> init_customized_session_cache(mnesia, Config); init_per_testcase(session_cleanup, Config) -> + Versions = ssl_test_lib:protocol_version(Config), ssl:stop(), application:load(ssl), + ssl_test_lib:set_protocol_versions(Versions), application:set_env(ssl, session_lifetime, 5), - application:set_env(ssl, session_delay_cleanup_time, ?DELAY), ssl:start(), + ssl_test_lib:ct_log_supported_protocol_versions(Config), ct:timetrap({seconds, 20}), Config; init_per_testcase(client_unique_session, Config) -> ct:timetrap({seconds, 40}), + ssl_test_lib:ct_log_supported_protocol_versions(Config), Config; init_per_testcase(save_specific_session, Config) -> + Versions = ssl_test_lib:protocol_version(Config), ssl_test_lib:clean_start(), + ssl_test_lib:set_protocol_versions(Versions), ct:timetrap({seconds, 5}), Config; init_per_testcase(max_table_size, Config) -> + Versions = ssl_test_lib:protocol_version(Config), ssl:stop(), application:load(ssl), + ssl_test_lib:set_protocol_versions(Versions), application:set_env(ssl, session_cache_server_max, ?MAX_TABLE_SIZE), application:set_env(ssl, session_cache_client_max, ?MAX_TABLE_SIZE), - application:set_env(ssl, session_delay_cleanup_time, ?DELAY), - ssl:start(), + ssl:start(), + ssl_test_lib:ct_log_supported_protocol_versions(Config), ct:timetrap({seconds, 40}), Config. init_customized_session_cache(Type, Config) -> + Versions = ssl_test_lib:protocol_version(Config), ssl:stop(), application:load(ssl), + ssl_test_lib:set_protocol_versions(Versions), application:set_env(ssl, session_cb, ?MODULE), application:set_env(ssl, session_cb_init_args, [{type, Type}]), ssl:start(), + ssl_test_lib:ct_log_supported_protocol_versions(Config), catch (end_per_testcase(list_to_atom("session_cache_process" ++ atom_to_list(Type)), Config)), ets:new(ssl_test, [named_table, public, set]), @@ -133,7 +175,6 @@ end_per_testcase(session_cache_process_mnesia, Config) -> ssl:start(), end_per_testcase(default_action, Config); end_per_testcase(session_cleanup, Config) -> - application:unset_env(ssl, session_delay_cleanup_time), application:unset_env(ssl, session_lifetime), end_per_testcase(default_action, Config); end_per_testcase(max_table_size, Config) -> @@ -155,8 +196,8 @@ client_unique_session() -> "sets up many connections"}]. client_unique_session(Config) when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), - ServerOpts = proplists:get_value(server_rsa_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -253,8 +294,8 @@ save_specific_session() -> }]. save_specific_session(Config) when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), - ServerOpts = proplists:get_value(server_rsa_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -511,7 +552,7 @@ check_timer(Timer) -> case erlang:read_timer(Timer) of false -> {status, _, _, _} = sys:get_status(whereis(ssl_manager)), - timer:sleep(?SLEEP), + ct:sleep(?SLEEP), {status, _, _, _} = sys:get_status(whereis(ssl_manager)), ok; Int -> diff --git a/lib/ssl/test/ssl_sni_SUITE.erl b/lib/ssl/test/ssl_sni_SUITE.erl index e58a4642fb..9cd6a7a1a5 100644 --- a/lib/ssl/test/ssl_sni_SUITE.erl +++ b/lib/ssl/test/ssl_sni_SUITE.erl @@ -84,6 +84,27 @@ init_per_suite(Config0) -> catch _:_ -> {skip, "Crypto did not start"} end. +init_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + case ssl_test_lib:sufficient_crypto_support(GroupName) of + true -> + ssl_test_lib:init_tls_version(GroupName, Config); + false -> + {skip, "Missing crypto support"} + end; + _ -> + ssl:start(), + Config + end. + +end_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:clean_tls_version(Config); + false -> + Config + end. end_per_suite(_) -> ssl:stop(), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 206c4c8b32..1c8ec9a313 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -2251,8 +2251,6 @@ is_tls_version('tlsv1.1') -> true; is_tls_version('tlsv1') -> true; -is_tls_version('sslv3') -> - true; is_tls_version(_) -> false. @@ -2713,13 +2711,6 @@ check_sane_openssl_renegotaite(Config, Version) when Version == 'tlsv1'; _ -> check_sane_openssl_renegotaite(Config) end; -check_sane_openssl_renegotaite(Config, 'sslv3') -> - case os:cmd("openssl version") of - "OpenSSL 1" ++ _ -> - {skip, "Known renegotiation bug with sslv3 in OpenSSL"}; - _ -> - check_sane_openssl_renegotaite(Config) - end; check_sane_openssl_renegotaite(Config, _) -> check_sane_openssl_renegotaite(Config). @@ -2855,6 +2846,31 @@ close_loop(Port, Time, SentClose) -> end end. +portable_open_port("openssl" = Exe, Args0) -> + case os:getenv("WSLENV") of + false -> + AbsPath = os:find_executable(Exe), + ct:pal("open_port({spawn_executable, ~p}, [{args, ~p}, stderr_to_stdout]).", + [AbsPath, Args0]), + open_port({spawn_executable, AbsPath}, + [{args, Args0}, stderr_to_stdout]); + _ -> + %% I can't get the new windows version of openssl.exe to be stable + %% certain server tests are failing for no reason. + %% This is using "linux" openssl via wslenv + + Translate = fun("c:/" ++ _ = Path) -> + string:trim(os:cmd("wsl wslpath -u " ++ Path)); + (Arg) -> + Arg + end, + Args1 = [Translate(Arg) || Arg <- Args0], + Args = ["/C","wsl","openssl"| Args1] ++ ["2>&1"], + Cmd = os:find_executable("cmd"), + ct:pal("open_port({spawn_executable, ~p}, [{args, ~p}, stderr_to_stdout]).", [Cmd,Args]), + open_port({spawn_executable, Cmd}, + [{args, Args}, stderr_to_stdout, hide]) + end; portable_open_port(Exe, Args) -> AbsPath = os:find_executable(Exe), ct:pal("open_port({spawn_executable, ~p}, [{args, ~p}, stderr_to_stdout]).", [AbsPath, Args]), @@ -3295,10 +3311,13 @@ digest() -> kill_openssl() -> case os:type() of - {unix, _} -> - os:cmd("pkill openssl"); {win32, _} -> - os:cmd("cmd.exe /C \"taskkill /IM openssl.exe /F\"") + case os:getenv("WSLENV") of + false -> os:cmd("cmd.exe /C \"taskkill /IM openssl.exe /F\""); + _ -> os:cmd("wsl pkill openssl") + end; + _ -> + os:cmd("pkill openssl") end. hostname_format(Hostname) -> @@ -3380,3 +3399,16 @@ bigger_buffers() -> _ -> [] end. + +set_protocol_versions(Version) when Version == 'tlsv1'; + Version == 'tlsv1.1'; + Version == 'tlsv1.2' -> + set_protocol_versions(protocol_version, [Version]); +set_protocol_versions(Version) when Version == 'dtlsv1'; + Version == 'dtlsv1.2' -> + set_protocol_versions(dtls_protocol_version, [Version]). + +set_protocol_versions(_, undefined) -> + ok; +set_protocol_versions(AppVar, Value) -> + application:set_env(ssl, AppVar, Value). diff --git a/lib/ssl/test/tls_api_SUITE.erl b/lib/ssl/test/tls_api_SUITE.erl index fc0e9cf3fc..01de312a81 100644 --- a/lib/ssl/test/tls_api_SUITE.erl +++ b/lib/ssl/test/tls_api_SUITE.erl @@ -40,8 +40,7 @@ all() -> {group, 'tlsv1.3'}, {group, 'tlsv1.2'}, {group, 'tlsv1.1'}, - {group, 'tlsv1'}, - {group, 'sslv3'} + {group, 'tlsv1'} ]. groups() -> @@ -49,8 +48,7 @@ groups() -> {'tlsv1.3', [], api_tests() -- [sockname]}, {'tlsv1.2', [], api_tests()}, {'tlsv1.1', [], api_tests()}, - {'tlsv1', [], api_tests()}, - {'sslv3', [], api_tests() ++ [ssl3_cipher_suite_limitation]} + {'tlsv1', [], api_tests()} ]. api_tests() -> @@ -605,39 +603,6 @@ transport_close(Config) when is_list(Config) -> {error, _} = ssl:send(SslS, "Hello world"). %%-------------------------------------------------------------------- -ssl3_cipher_suite_limitation() -> - [{doc,"Test a SSLv3 client cannot negotiate a TLSv* cipher suite."}]. -ssl3_cipher_suite_limitation(Config) when is_list(Config) -> - - {_ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - - Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, - {from, self()}, - {options, ServerOpts}]), - Port = ssl_test_lib:inet_port(Server), - - {ok, Socket} = gen_tcp:connect(Hostname, Port, [binary, {active, false}]), - ok = gen_tcp:send(Socket, - <<22, 3,0, 49:16, % handshake, SSL 3.0, length - 1, 45:24, % client_hello, length - 3,0, % SSL 3.0 - 16#deadbeef:256, % 32 'random' bytes = 256 bits - 0, % no session ID - %% three cipher suites -- null, one with sha256 hash and one with sha hash - 6:16, 0,255, 0,61, 0,57, - 1, 0 % no compression - >>), - {ok, <<22, RecMajor:8, RecMinor:8, _RecLen:16, 2, HelloLen:24>>} = gen_tcp:recv(Socket, 9, 10000), - {ok, <<HelloBin:HelloLen/binary>>} = gen_tcp:recv(Socket, HelloLen, 5000), - ServerHello = tls_handshake:decode_handshake({RecMajor, RecMinor}, 2, HelloBin), - case ServerHello of - #server_hello{server_version = {3,0}, cipher_suite = <<0,57>>} -> - ok; - _ -> - ct:fail({unexpected_server_hello, ServerHello}) - end. -%%-------------------------------------------------------------------- emulated_options() -> [{doc,"Test API function getopts/2 and setopts/2"}]. diff --git a/lib/stdlib/Makefile b/lib/stdlib/Makefile index 3086d85445..cae3844126 100644 --- a/lib/stdlib/Makefile +++ b/lib/stdlib/Makefile @@ -35,3 +35,7 @@ SPECIAL_TARGETS = # Default Subdir Targets # include $(ERL_TOP)/make/otp_subdir.mk + +DIA_PLT_APPS=compiler crypto + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index 4541b4a463..1092ce3ffa 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -28,11 +28,6 @@ VSN=$(STDLIB_VSN) APPLICATION=stdlib # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -89,6 +84,7 @@ XML_REF3_FILES = \ sets.xml \ shell.xml \ shell_default.xml \ + shell_docs.xml \ slave.xml \ sofs.xml \ string.xml \ @@ -113,74 +109,12 @@ XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES) $(XML_APPLICATION_FILES) -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) - TOP_SPECS_FILE = specs.xml -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -SPECS_FLAGS = -I../../include -I../../../kernel/include - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -docs: man pdf html - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) $(MAN6_FILES) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(MAN6DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f $(SPECDIR)/* - rm -f errs core *~ - $(SPECDIR)/specs_erl_id_trans.xml: $(gen_verbose)escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ -o$(dir $@) -module erl_id_trans -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" - $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" +NO_CHUNKS = erl_id_trans.xml -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/stdlib/doc/src/c.xml b/lib/stdlib/doc/src/c.xml index 29edc373c7..04dad1a472 100644 --- a/lib/stdlib/doc/src/c.xml +++ b/lib/stdlib/doc/src/c.xml @@ -120,6 +120,64 @@ </func> <func> + <name name="h" arity="1" since="OTP @OTP-16222@"/> + <fsummary>Module help information</fsummary> + <type name="h_return"/> + <desc> + <p>Print the documentation for <c>Module</c></p> + </desc> + </func> + + <func> + <name name="h" arity="2" since="OTP @OTP-16222@"/> + <fsummary>Function help information</fsummary> + <type name="h_return"/> + <type name="hf_return"/> + <desc> + <p>Print the documentation for all <c>Module:Function</c>s (regardless of arity).</p> + </desc> + </func> + + <func> + <name name="h" arity="3" since="OTP @OTP-16222@"/> + <fsummary>Function help information</fsummary> + <type name="h_return"/> + <type name="hf_return"/> + <desc> + <p>Print the documentation for <c>Module:Function/Arity</c>.</p> + </desc> + </func> + + <func> + <name name="ht" arity="1" since="OTP @OTP-16222@"/> + <fsummary>Type help information</fsummary> + <type name="h_return"/> + <desc> + <p>Print the type documentation for <c>Module</c></p> + </desc> + </func> + + <func> + <name name="ht" arity="2" since="OTP @OTP-16222@"/> + <fsummary>Type help information</fsummary> + <type name="h_return"/> + <type name="ht_return"/> + <desc> + <p>Print the type documentation for <c>Type</c> in <c>Module</c> regardless of arity.</p> + </desc> + </func> + + <func> + <name name="ht" arity="3" since="OTP @OTP-16222@"/> + <fsummary>Type help information</fsummary> + <type name="h_return"/> + <type name="ht_return"/> + <desc> + <p>Print the type documentation for <c>Type/Arity</c> in <c>Module</c>.</p> + </desc> + </func> + + <func> <name name="i" arity="0" since=""/> <name name="ni" arity="0" since=""/> <fsummary>System information.</fsummary> diff --git a/lib/stdlib/doc/src/erl_parse.xml b/lib/stdlib/doc/src/erl_parse.xml index 8142e5c0aa..d487cccdfc 100644 --- a/lib/stdlib/doc/src/erl_parse.xml +++ b/lib/stdlib/doc/src/erl_parse.xml @@ -69,6 +69,25 @@ <name name="erl_parse_tree"></name> </datatype> <datatype> + <name>af_binelement(_)</name> + <desc> + <p>Abstract representation of an element of a bitstring.</p> + </desc> + </datatype> + <datatype> + <name>af_generator()</name> + <desc> + <p>Abstract representation of a generator + or a bitstring generator.</p> + </desc> + </datatype> + <datatype> + <name>af_remote_function()></name> + <desc> + <p>Abstract representation of a remote function call.</p> + </desc> + </datatype> + <datatype> <name name="error_description"></name> </datatype> <datatype> diff --git a/lib/stdlib/doc/src/erl_pp.xml b/lib/stdlib/doc/src/erl_pp.xml index 0a46139db6..70922b5825 100644 --- a/lib/stdlib/doc/src/erl_pp.xml +++ b/lib/stdlib/doc/src/erl_pp.xml @@ -68,6 +68,10 @@ <desc> <p>The option <c>quote_singleton_atom_types</c> is used to add quotes to all singleton atom types.</p> + <p>The option <c>linewidth</c> controls the maximum line + width for formatted lines (defaults to 72 characters).</p> + <p>The option <c>indent</c> controls the + indention for formatted lines (defaults to 4 spaces).</p> </desc> </datatype> <datatype> diff --git a/lib/stdlib/doc/src/erl_tar.xml b/lib/stdlib/doc/src/erl_tar.xml index b062c5cef3..ee66b581f8 100644 --- a/lib/stdlib/doc/src/erl_tar.xml +++ b/lib/stdlib/doc/src/erl_tar.xml @@ -288,6 +288,11 @@ writing the file. That is, absolute paths will be turned into relative paths. There will be an info message written to the error logger when paths are changed in this way.</p></note> + <warning> + <p>The <c>compressed</c> and <c>cooked</c> flags are invalid when + passing a file descriptor with <c>{file,Fd}</c>. The file is + assumed to have been opened with the appropriate flags.</p> + </warning> </desc> </func> @@ -349,6 +354,11 @@ <p>Prints an informational message for each extracted file.</p> </item> </taglist> + <warning> + <p>The <c>compressed</c> and <c>cooked</c> flags are invalid when + passing a file descriptor with <c>{file,Fd}</c>. The file is + assumed to have been opened with the appropriate flags.</p> + </warning> </desc> </func> @@ -474,10 +484,15 @@ erl_tar:close(TarDesc)</code> finished adding files, use function <seealso marker="#close/1"> <c>close/1</c></seealso> to close the tar file.</p> <warning> + <p>The <c>compressed</c> and <c>cooked</c> flags are invalid when + passing a file descriptor with <c>{file,Fd}</c>. The file must + already be opened with the appropriate flags.</p> + </warning> + <warning> <p>The <c>TarDescriptor</c> term is not a file descriptor. You are advised not to rely on the specific contents of this term, as it can change in future Erlang/OTP releases when more features are - added to this module..</p> + added to this module.</p> </warning> </desc> </func> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 2d0a88fc6e..c4d39142e3 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -557,6 +557,10 @@ Error: fun containing local Erlang function calls <item> <p>Indicates if the table is compressed.</p> </item> + <tag><c>{decentralized_counters, boolean()}</c></tag> + <item> + <p>Indicates whether the table uses <c>decentralized_counters</c>.</p> + </item> <tag><c>{heir, pid() | none}</c></tag> <item> <p>The pid of the heir of the table, or <c>none</c> if no heir @@ -616,6 +620,13 @@ Error: fun containing local Erlang function calls <p>Indicates whether the table uses <c>write_concurrency</c>.</p> </item> </taglist> + <note><p>The execution time of this function is affected by + the <seealso marker="#new_2_decentralized_counters"> + <c>decentralized_counters</c></seealso> table option. + The execution time is much longer when the <c>decentralized_counters</c> + option is set to <c>true</c> than when the <c>decentralized_counters</c> + option is set to <c>false</c>.</p> + </note> </desc> </func> @@ -701,6 +712,15 @@ Error: fun containing local Erlang function calls <p>Returns internal statistics about tables on an internal format used by OTP test suites. Not for production use.</p></item> </list> + <note> + <p>The execution time of this function is affected by + the <seealso marker="#new_2_decentralized_counters"> + <c>decentralized_counters</c></seealso> table option when the second + argument of the function is <c>size</c> or <c>memory</c>. + The execution time is much longer when the <c>decentralized_counters</c> + option is set to <c>true</c> than when the <c>decentralized_counters</c> + option is set to <c>false</c>.</p> + </note> </desc> </func> @@ -1113,7 +1133,8 @@ ets:select(Table, MatchSpec),</code> table is named. Default values are used for omitted options. This means that not specifying any options (<c>[]</c>) is the same as specifying <c>[set, protected, {keypos,1}, {heir,none}, - {write_concurrency,false}, {read_concurrency,false}]</c>.</p> + {write_concurrency,false}, {read_concurrency,false}, + {decentralized_counters,false}]</c>.</p> <taglist> <tag><c>set</c></tag> <item> @@ -1208,13 +1229,23 @@ ets:select(Table, MatchSpec),</code> (and read) by concurrent processes. This is achieved to some degree at the expense of memory consumption and the performance of sequential access and concurrent reading.</p> - <p>Option <c>write_concurrency</c> can be combined with option + <p>The <c>write_concurrency</c> option can be combined with the options <seealso marker="#new_2_read_concurrency"> - <c>read_concurrency</c></seealso>. You typically want to combine - these when large concurrent read bursts and large concurrent + <c>read_concurrency</c></seealso> and + <seealso marker="#new_2_decentralized_counters"> + <c>decentralized_counters</c></seealso>. You typically want to combine + <c>write_concurrency</c> with <c>read_concurrency</c> when large + concurrent read bursts and large concurrent write bursts are common; for more information, see option <seealso marker="#new_2_read_concurrency"> - <c>read_concurrency</c></seealso>.</p> + <c>read_concurrency</c></seealso>. The <c>decentralized_counters</c> + option is turned on by default for tables of type <c>ordered_set</c> + with the <c>write_concurrency</c> option enabled, and the + <c>decentralized_counters</c> option is turned off by default for + all other table types. + For more information, see the documentation for the + <seealso marker="#new_2_decentralized_counters"> + <c>decentralized_counters</c></seealso> option.</p> <p>Notice that this option does not change any guarantees about <seealso marker="#concurrency">atomicity and isolation</seealso>. Functions that makes such promises over many objects (like @@ -1256,7 +1287,39 @@ ets:select(Table, MatchSpec),</code> <c>write_concurrency</c></seealso>. You typically want to combine these when large concurrent read bursts and large concurrent write bursts are common.</p> - <marker id="new_2_compressed"></marker> + <marker id="new_2_decentralized_counters"></marker> + </item> + <tag><c>{decentralized_counters,boolean()}</c></tag> + <item> + <p> + Performance tuning. Defaults to <c>true</c> for tables + of type <c>ordered_set</c> with the + <seealso marker="#new_2_write_concurrency"> + <c>write_concurrency</c></seealso> option enabled, and defaults to + false for all other table types. This option has no effect if + the <c>write_concurrency</c> option is set to <c>false</c>.</p> + <p> + When this option is set to <c>true</c>, the table is optimized for + frequent concurrent calls to operations that modify the tables + size and/or its memory consumption (e.g., <seealso + marker="#insert/2"><c>insert/2</c></seealso> and <seealso + marker="#delete/2"><c>delete/2</c></seealso>). + The drawback is that calls to + <seealso marker="#info/1"><c>info/1</c></seealso> and + <seealso marker="#info/2"><c>info/2</c></seealso> with <c>size</c> or + <c>memory</c> as the second argument can get much slower when the + <c>decentralized_counters</c> option is turned on.</p> + <p> + When this option is enabled the counters for the + table size and memory consumption are distributed over + several cache lines and the scheduling threads are + mapped to one of those cache lines. The <c>erl</c> + option <seealso + marker="erts:erl#+dcg"><c>+dcg</c></seealso> can be used + to control the number of cache lines that the counters + are distributed over. + </p> + <marker id="new_2_compressed"></marker> </item> <tag><c>compressed</c></tag> <item> diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml index 5df415834f..cb867f8541 100644 --- a/lib/stdlib/doc/src/filelib.xml +++ b/lib/stdlib/doc/src/filelib.xml @@ -307,5 +307,35 @@ filelib:wildcard("lib/**/*.{erl,hrl}")</code> marker="kernel:kernel_app#source_search_rules"><c>source_search_rules</c></seealso>.</p> </desc> </func> + <func> + <name name="safe_relative_path" arity="2" since="OTP 23.0"/> + <fsummary>Sanitize a relative path to avoid directory traversal attacks.</fsummary> + <desc> + <p>Sanitizes the relative path by eliminating ".." and "." + components to protect against directory traversal attacks. + Either returns the sanitized path name, or the atom + <c>unsafe</c> if the path is unsafe. + The path is considered unsafe in the following circumstances:</p> + <list type="bulleted"> + <item><p>The path is not relative.</p></item> + <item><p>A ".." component would climb up above the root of + the relative path.</p></item> + <item><p>A symbolic link in the path points above the root + of the relative path.</p></item> + </list> + <p><em>Examples:</em></p> + <pre> +1> <input>{ok, Cwd} = file:get_cwd().</input> +... +2> <input>filelib:safe_relative_path("dir/sub_dir/..", Cwd).</input> +"dir" +3> <input>filelib:safe_relative_path("dir/..", Cwd).</input> +[] +4> <input>filelib:safe_relative_path("dir/../..", Cwd).</input> +unsafe +5> <input>filelib:safe_relative_path("/abs/path", Cwd).</input> +unsafe</pre> + </desc> + </func> </funcs> </erlref> diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml index 60b7eb3436..3dca60c2f0 100644 --- a/lib/stdlib/doc/src/filename.xml +++ b/lib/stdlib/doc/src/filename.xml @@ -570,6 +570,10 @@ true <item><p>A ".." component would climb up above the root of the relative path.</p></item> </list> + <warning> + <p>This function is deprecated. Use <seealso marker="filelib#safe_relative_path/2"> + <c>filelib:safe_relative_path/2</c></seealso> instead for sanitizing paths.</p> + </warning> <p><em>Examples:</em></p> <pre> 1> <input>filename:safe_relative_path("dir/sub_dir/..").</input> diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml index 2915c4f507..f9db5ba2a8 100644 --- a/lib/stdlib/doc/src/gen_event.xml +++ b/lib/stdlib/doc/src/gen_event.xml @@ -50,6 +50,7 @@ gen_event module Callback module ---------------- --------------- gen_event:start +gen_event:start_monitor gen_event:start_link -----> - gen_event:add_handler @@ -58,6 +59,7 @@ gen_event:add_sup_handler -----> Module:init/1 gen_event:notify gen_event:sync_notify -----> Module:handle_event/2 +gen_event:send_request gen_event:call -----> Module:handle_call/2 - -----> Module:handle_info/2 @@ -126,6 +128,15 @@ gen_event:stop -----> Module:terminate/2 <datatype> <name name="del_handler_ret"/> </datatype> + <datatype> + <name name="request_id"/> + <desc> + <p> + A request handle, see <seealso marker="#send_request/3"> <c>send_request/3</c> </seealso> + for details. + </p> + </desc> + </datatype> </datatypes> <funcs> @@ -284,6 +295,40 @@ gen_event:stop -----> Module:terminate/2 </desc> </func> + + <func> + <name since="OTP-23">check_response(Msg, RequestId) -> Result</name> + <fsummary>Check if a message is a reply from a server.</fsummary> + <type> + <v>Msg = term()</v> + <v>RequestId = request_id()</v> + <v>Result = {reply, Reply} | no_reply | {error, Error}</v> + <v>Reply = Error = term()</v> + </type> + <desc> + <p> + This function is used to check if a previously received + message, for example by <c>receive</c> or + <c>handle_info/2</c>, is a result of a request made with + <seealso marker="#send_request/3"><c>send_request/3</c></seealso>. + If <c>Msg</c> is a reply to the handle <c>RequestId</c> + the result of the request is returned in <c>Reply</c>. + Otherwise returns <c>no_reply</c> and no cleanup is done, and + thus the function shall be invoked repeatedly until a reply + is returned. + </p> + <p> + If the specified event handler is not + installed, the function returns <c>{error,bad_module}</c>. If + the callback function fails with <c>Reason</c> or returns an + unexpected value <c>Term</c>, this function returns + <c>{error,{'EXIT',Reason}}</c> or <c>{error,Term}</c>, + respectively. If the event manager dies before or during the + request this function returns <c>{error,{Reason, EventMgrRef}}</c>. + </p> + </desc> + </func> + <func> <name since="">delete_handler(EventMgrRef, Handler, Args) -> Result</name> <fsummary>Delete an event handler from a generic event manager.</fsummary> @@ -348,6 +393,49 @@ gen_event:stop -----> Module:terminate/2 </desc> </func> + + <func> + <name since="OTP-23">send_request(EventMgrRef, Handler, Request) -> RequestId</name> + <fsummary>Send a request to a generic event manager.</fsummary> + <type> + <v>EventMgrRef = Name | {Name,Node} | {global,GlobalName}</v> + <v> | {via,Module,ViaName} | pid()</v> + <v> Node = atom()</v> + <v> GlobalName = ViaName = term()</v> + <v>Handler = Module | {Module,Id}</v> + <v> Module = atom()</v> + <v> Id = term()</v> + <v>Request = term()</v> + <v>RequestId = request_id()</v> + </type> + <desc> + <p> + Sends a request to event handler <c>Handler</c> installed in + event manager <c>EventMgrRef</c> and returns a handle + <c>RequestId</c>. The return value <c>RequestId</c> shall + later be used with <seealso marker="#wait_response/2"> + <c>wait_response/2</c></seealso> or <seealso + marker="#check_response/2"> + <c>check_response/2</c></seealso> in the same process to + fetch the actual result of the request. + </p> + <p> + The call <c>gen_event:wait_response(gen_event:send_request(EventMgrRef,Handler,Request), Timeout)</c> + can be seen as equivalent to + <seealso marker="#call/3"><c>gen_event:call(EventMgrRef,Handler,Request,Timeout)</c></seealso>, + ignoring the error handling. + </p> + <p> + The event manager calls <seealso marker="#Module:handle_call/2"> + <c>Module:handle_call/2</c></seealso> to handle the request. + </p> + <p> + <c>Request</c> is any term that is passed as one of + the arguments to <c>Module:handle_call/3</c>. + </p> + </desc> + </func> + <func> <name since="">start() -> Result</name> <name since="">start(EventMgrName | Options) -> Result</name> @@ -436,6 +524,40 @@ gen_event:stop -----> Module:terminate/2 </func> <func> + <name since="OTP @OTP-16120@">start_monitor() -> Result</name> + <name since="OTP @OTP-16120@">start_monitor(EventMgrName | Options) -> Result</name> + <name since="OTP @OTP-16120@">start_monitor(EventMgrName, Options) -> Result</name> + <fsummary>Create a stand-alone event manager process.</fsummary> + <type> + <v>EventMgrName = {local,Name} | {global,GlobalName} | {via,Module,ViaName}</v> + <v> Name = atom()</v> + <v> GlobalName = ViaName = term()</v> + <v>Options = [Option]</v> + <v> Option = {debug,Dbgs} | {timeout,Time} | {hibernate_after,HibernateAfterTimeout} | {spawn_opt,SOpts}</v> + <v> Dbgs = [Dbg]</v> + <v> Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v> + <v> SOpts = [term()]</v> + <v>Result = {ok,{Pid,Mon}} | {error,{already_started,Pid}}</v> + <v> Pid = pid()</v> + </type> + <desc> + <p>Creates a stand-alone event manager process, that is, an event + manager that is not part of a supervision tree (and thus has + no supervisor) and atomically sets up a monitor to + the newly created process.</p> + <p>For a description of the arguments and return values, see + <seealso marker="#start_link/0"><c>start_link/0,1</c></seealso>. + Note that the return value on successful start differs from + <c>start_link/3,4</c>. <c>start_monitor/3,4</c> will return + <c>{ok,{Pid,Mon}}</c> where <c>Pid</c> is the process identifier + of the process, and <c>Mon</c> is a reference to the monitor + set up to monitor the process. If the start is not successful, + the caller will be blocked until the <c>DOWN</c> message has + been received and removed from the message queue.</p> + </desc> + </func> + + <func> <name since="">stop(EventMgrRef) -> ok</name> <name since="OTP 18.0">stop(EventMgrRef, Reason, Timeout) -> ok</name> <fsummary>Terminate a generic event manager.</fsummary> @@ -546,6 +668,49 @@ gen_event:stop -----> Module:terminate/2 </func> <func> + <name since="OTP-23">wait_response(RequestId, Timeout) -> Result</name> + <fsummary>Wait for a reply from a server.</fsummary> + <type> + <v>RequestId = request_id()</v> + <v>Reply = term()</v> + <v>Timeout = timeout()</v> + <v>Result = {reply, Reply} | timeout | {error, Error}</v> + <v>Reply = Error = term()</v> + </type> + <desc> + <p> + This function is used to wait for a reply of a request made with + <seealso marker="#send_request/3"><c>send_request/3</c></seealso> + from the event manager. This function must be called from the same + process from which <seealso marker="#send_request/3"><c>send_request/3</c></seealso> + was made. + </p> + <p> + <c>Timeout</c> is an integer greater then or equal to zero + that specifies how many milliseconds to wait for an reply, or + the atom <c>infinity</c> to wait indefinitely. + If no reply is received within the specified + time, the function returns <c>timeout</c> and no cleanup is + done, and thus the function must be invoked repeatedly until a + reply is returned. + </p> + <p> + The return value <c>Reply</c> is defined in the return value + of <c>Module:handle_call/3</c>. + </p> + <p> + If the specified event handler is not + installed, the function returns <c>{error,bad_module}</c>. If + the callback function fails with <c>Reason</c> or returns an + unexpected value <c>Term</c>, this function returns + <c>{error,{'EXIT',Reason}}</c> or <c>{error,Term}</c>, + respectively. If the event manager dies before or during the + request this function returns <c>{error,{Reason, EventMgrRef}}</c>. + </p> + </desc> + </func> + + <func> <name since="">which_handlers(EventMgrRef) -> [Handler]</name> <fsummary>Return all event handlers installed in a generic event manager. </fsummary> diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index a4554d7657..0221319dcc 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -48,11 +48,13 @@ gen_server module Callback module ----------------- --------------- gen_server:start +gen_server:start_monitor gen_server:start_link -----> Module:init/1 gen_server:stop -----> Module:terminate/2 gen_server:call +gen_server:send_request gen_server:multi_call -----> Module:handle_call/3 gen_server:cast @@ -155,8 +157,8 @@ gen_server:abcast -----> Module:handle_cast/2 <item><c>{via,Module,ViaName}</c>, if the <c>gen_server</c> process is registered through an alternative process registry</item> </list> - <p><c>Request</c> is any term that is passed as one of - the arguments to <c>Module:handle_call/3</c>.</p> + <p><c>Request</c> is any term that is passed as the + first argument to <c>Module:handle_call/3</c>.</p> <p><c>Timeout</c> is an integer greater than zero that specifies how many milliseconds to wait for a reply, or the atom <c>infinity</c> to wait indefinitely. Defaults to @@ -200,6 +202,43 @@ gen_server:abcast -----> Module:handle_cast/2 </func> <func> + <name since="OTP-23">check_response(Msg, RequestId) -> Result</name> + <fsummary>Check if a message is a reply from a server.</fsummary> + <type> + <v>RequestId = term()</v> + <v>Result = {reply, Reply} | no_reply | {error, {Reason, ServerRef}}</v> + <v>Msg = Reply = term()</v> + <v>Timeout = timeout()</v> + <v>Reason = term()</v> + <v>ServerRef = Name | {Name,Node} | {global,GlobalName}</v> + <v> | {via,Module,ViaName} | pid()</v> + <v> Node = atom()</v> + <v> GlobalName = ViaName = term()</v> + </type> + <desc> + <p> + This function is used to check if a previously received + message, for example by <c>receive</c> or + <c>handle_info/2</c>, is a result of a request made with + <seealso marker="#send_request/2"><c>send_request/2</c></seealso>. + If <c>Msg</c> is a reply to the handle <c>RequestId</c> + the result of the request is returned in <c>Reply</c>. + Otherwise returns <c>no_reply</c> and no cleanup is done, and + thus the function must be invoked repeatedly until a reply + is returned. + </p> + <p> + The return value <c>Reply</c> is defined in the return value + of <c>Module:handle_call/3</c>. + </p> + <p> + The function returns an error if the <c>gen_server</c> + dies before or during this request. + </p> + </desc> + </func> + + <func> <name since="">enter_loop(Module, Options, State)</name> <name since="">enter_loop(Module, Options, State, ServerName)</name> <name since="">enter_loop(Module, Options, State, Timeout)</name> @@ -232,7 +271,7 @@ gen_server:abcast -----> Module:handle_cast/2 is needed than the <c>gen_server</c> process behavior provides.</p> <p><c>Module</c>, <c>Options</c>, and <c>ServerName</c> have the same meanings as when calling - <seealso marker="#start_link/3"><c>start[_link]/3,4</c></seealso>. + <seealso marker="#start_link/3"><c>start[_link|_monitor]/3,4</c></seealso>. However, if <c>ServerName</c> is specified, the process must have been registered accordingly <em>before</em> this function is called.</p> @@ -280,8 +319,8 @@ gen_server:abcast -----> Module:handle_cast/2 <c>[node()|nodes()]</c>.</p> <p><c>Name</c> is the locally registered name of each <c>gen_server</c> process.</p> - <p><c>Request</c> is any term that is passed as one of - the arguments to <c>Module:handle_call/3</c>.</p> + <p><c>Request</c> is any term that is passed as the first + argument to <c>Module:handle_call/3</c>.</p> <p><c>Timeout</c> is an integer greater than zero that specifies how many milliseconds to wait for each reply, or the atom <c>infinity</c> to wait indefinitely. Defaults @@ -307,12 +346,11 @@ gen_server:abcast -----> Module:handle_cast/2 </func> <func> - <name since="">reply(Client, Reply) -> Result</name> + <name since="">reply(Client, Reply) -> ok</name> <fsummary>Send a reply to a client.</fsummary> <type> <v>Client - see below</v> <v>Reply = term()</v> - <v>Result = term()</v> </type> <desc> <p>This function can be used by a <c>gen_server</c> process to @@ -326,8 +364,55 @@ gen_server:abcast -----> Module:handle_cast/2 the callback function. <c>Reply</c> is any term given back to the client as the return value of <c>call/2,3</c> or <c>multi_call/2,3,4</c>.</p> - <p>The return value <c>Result</c> is not further defined, and - is always to be ignored.</p> + </desc> + </func> + + <func> + <name since="OTP-23">send_request(ServerRef, Request) -> RequestId</name> + <fsummary>Sends a request to a generic server.</fsummary> + <type> + <v>ServerRef = Name | {Name,Node} | {global,GlobalName}</v> + <v> | {via,Module,ViaName} | pid()</v> + <v> Node = atom()</v> + <v> GlobalName = ViaName = term()</v> + <v>RequestId = term()</v> + <v>Timeout = int()>0 | infinity</v> + <v>Request = term()</v> + </type> + <desc> + <p> + Sends a request to the <c>ServerRef</c> of the + <c>gen_server</c> process and returns a handle <c>RequestId</c>. + The return value <c>RequestId</c> shall later be used with + <seealso marker="#wait_response/2"> <c>wait_response/2</c></seealso> or + <seealso marker="#check_response/2"> <c>check_response/2</c></seealso> + to fetch the actual result of the request. + </p> + <p> + The call <c>gen_server:wait_response(gen_server:send_request(ServerRef,Request), Timeout)</c> + can be seen as equivalent to + <seealso marker="#call/3"><c>gen_server:call(Server,Request,Timeout)</c></seealso>, + ignoring the error handling. + </p> + <p> + The <c>gen_server</c> process calls + <seealso marker="#Module:handle_call/3"> <c>Module:handle_call/3</c></seealso> + to handle the request. + </p> + <p><c>ServerRef</c> can be any of the following:</p> + <list type="bulleted"> + <item>The pid</item> + <item><c>Name</c>, if the <c>gen_server</c> process is locally + registered</item> + <item><c>{Name,Node}</c>, if the <c>gen_server</c> process is locally + registered at another node</item> + <item><c>{global,GlobalName}</c>, if the <c>gen_server</c> process is + globally registered</item> + <item><c>{via,Module,ViaName}</c>, if the <c>gen_server</c> process is + registered through an alternative process registry</item> + </list> + <p><c>Request</c> is any term that is passed as the first + argument to <c>Module:handle_call/3</c>.</p> </desc> </func> @@ -466,6 +551,43 @@ gen_server:abcast -----> Module:handle_cast/2 </func> <func> + <name since="OTP @OTP-16120@">start_monitor(Module, Args, Options) -> Result</name> + <name since="OTP @OTP-16120@">start_monitor(ServerName, Module, Args, Options) -> Result</name> + <fsummary>Create a standalone <c>gen_server</c> process.</fsummary> + <type> + <v>ServerName = {local,Name} | {global,GlobalName}</v> + <v> | {via,Module,ViaName}</v> + <v> Name = atom()</v> + <v> GlobalName = ViaName = term()</v> + <v>Module = atom()</v> + <v>Args = term()</v> + <v>Options = [Option]</v> + <v> Option = {debug,Dbgs} | {timeout,Time} | {hibernate_after,HibernateAfterTimeout} | {spawn_opt,SOpts}</v> + <v> Dbgs = [Dbg]</v> + <v> Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v> + <v> SOpts = [term()]</v> + <v>Result = {ok,{Pid,Mon}} | ignore | {error,Error}</v> + <v> Pid = pid()</v> + <v> Error = {already_started,Pid} | term()</v> + </type> + <desc> + <p>Creates a standalone <c>gen_server</c> process, that is, a + <c>gen_server</c> process that is not part of a supervision tree + (and thus has no supervisor) and atomically sets up a monitor to + the newly created server.</p> + <p>For a description of arguments and return values, see + <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>. + Note that the return value on successful start differs from + <c>start_link/3,4</c>. <c>start_monitor/3,4</c> will return + <c>{ok,{Pid,Mon}}</c> where <c>Pid</c> is the process identifier + of the server, and <c>Mon</c> is a reference to the monitor + set up to monitor the server. If the start is not successful, + the caller will be blocked until the <c>DOWN</c> message has + been received and removed from the message queue.</p> + </desc> + </func> + + <func> <name since="OTP 18.0">stop(ServerRef) -> ok</name> <name since="OTP 18.0">stop(ServerRef, Reason, Timeout) -> ok</name> <fsummary>Synchronously stop a generic server.</fsummary> @@ -498,6 +620,49 @@ gen_server:abcast -----> Module:handle_cast/2 is raised.</p> </desc> </func> + + <func> + <name since="OTP-23">wait_response(RequestId, Timeout) -> Result</name> + <fsummary>Wait for a reply from a server.</fsummary> + <type> + <v>RequestId = term()</v> + <v>Result = {reply, Reply} | timeout | {error, {Reason, ServerRef}}</v> + <v>Reply = term()</v> + <v>Timeout = timeout()</v> + <v>Reason = term()</v> + <v>ServerRef = Name | {Name,Node} | {global,GlobalName}</v> + <v> | {via,Module,ViaName} | pid()</v> + <v> Node = atom()</v> + <v> GlobalName = ViaName = term()</v> + </type> + <desc> + <p> + This function is used to wait for a reply of a request made with + <seealso marker="#send_request/2"><c>send_request/2</c></seealso> + from the <c>gen_server</c> process. This function must be called + from the same process from which + <seealso marker="#send_request/2"><c>send_request/2</c></seealso> + was made. + </p> + <p> + <c>Timeout</c> is an integer greater then or equal to zero + that specifies how many milliseconds to wait for an reply, or + the atom <c>infinity</c> to wait indefinitely. + If no reply is received within the specified + time, the function returns <c>timeout</c> and no cleanup is + done, and thus the function can be invoked repeatedly until a + reply is returned. + </p> + <p> + The return value <c>Reply</c> is defined in the return value + of <c>Module:handle_call/3</c>. + </p> + <p> + The function returns an error if the <c>gen_server</c> + dies before or during this request. + </p> + </desc> + </func> </funcs> <section> @@ -782,8 +947,9 @@ gen_server:abcast -----> Module:handle_cast/2 </type> <desc> <p>Whenever a <c>gen_server</c> process is started using - <seealso marker="#start/3"><c>start/3,4</c></seealso> or - <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>, + <seealso marker="#start/3"><c>start/3,4</c></seealso>, + <seealso marker="#start_monitor/3"><c>start_monitor/3,4</c></seealso>, + or <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>, this function is called by the new process to initialize.</p> <p><c>Args</c> is the <c>Args</c> argument provided to the start function.</p> diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index 39fc565ff8..466eea6964 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -176,6 +176,7 @@ gen_statem module Callback module ----------------- --------------- gen_statem:start +gen_statem:start_monitor gen_statem:start_link -----> Module:init/1 Server start or code change @@ -185,6 +186,7 @@ gen_statem:stop -----> Module:terminate/3 gen_statem:call gen_statem:cast +gen_statem:send_request erlang:send erlang:'!' -----> Module:StateName/3 Module:handle_event/4 @@ -366,6 +368,7 @@ erlang:'!' -----> Module:StateName/3 </seealso> for <seealso marker="#start/3"><c>start/3,4</c></seealso>, + <seealso marker="#start_monitor/3"><c>start_monitor/3,4</c></seealso>, <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso> or <seealso marker="#enter_loop/4"><c>enter_loop/4,5,6</c></seealso>, that may be used to automatically hibernate the server. @@ -569,8 +572,18 @@ handle_event(_, _, State, Data) -> <name name="start_ret"/> <desc> <p> - Return value from the start functions, for example, - <seealso marker="#start_link/3"><c>start_link/3</c></seealso>. + Return value from the <c>start()</c> and <c>start_link()</c> functions, + for example, <seealso marker="#start_link/3"><c>start_link/3</c></seealso>. + </p> + </desc> + </datatype> + <datatype> + <name name="start_mon_ret"/> + <desc> + <p> + Return value from the + <seealso marker="#start_monitor/3"><c>start_monitor()</c></seealso> + functions. </p> </desc> </datatype> @@ -683,11 +696,12 @@ handle_event(_, _, State, Data) -> <p> External events are of 3 types: <c>{call,<anno>From</anno>}</c>, <c>cast</c>, or <c>info</c>. - <seealso marker="#call/2">Calls</seealso> - (synchronous) and - <seealso marker="#cast/2">casts</seealso> - originate from the corresponding API functions. + Type <c>call</c> originates from the API functions + <seealso marker="#call/2"><c>call/2</c></seealso> + and <seealso marker="#send_request/2"><c>send_request/2</c></seealso>. For calls, the event contains whom to reply to. + Type <c>cast</c> originates from the API function + <seealso marker="#cast/2"><c>cast/2</c></seealso>. Type <c>info</c> originates from regular process messages sent to the <c>gen_statem</c>. </p> @@ -1550,6 +1564,16 @@ handle_event(_, _, State, Data) -> </p> </desc> </datatype> + + <datatype> + <name name="request_id"/> + <desc> + <p> + A request handle, see <seealso marker="#send_request/2"> <c>send_request/2</c> </seealso> + for details. + </p> + </desc> + </datatype> </datatypes> <funcs> @@ -1651,6 +1675,37 @@ handle_event(_, _, State, Data) -> </func> <func> + <name name="check_response" arity="2" since="OTP-23"/> + <fsummary>Check if a message is a reply from a server.</fsummary> + <desc> + <p> + This function is used to check if a previously received + message, for example by <c>receive</c> or + <c>handle_info/2</c>, is a result of a request made with + <seealso marker="#send_request/2"><c>send_request/2</c></seealso>. + If <c>Msg</c> is a reply to the handle <c>RequestId</c> + the result of the request is returned in <c>Reply</c>. + Otherwise returns <c>no_reply</c> and no cleanup is done, and + thus the function shall be invoked repeatedly until a reply + is returned. + </p> + <p> + The return value <c><anno>Reply</anno></c> is generated when a + <seealso marker="#state callback"><em>state callback</em></seealso> + returns with + <c>{reply,From,<anno>Reply</anno>}</c> as one + <seealso marker="#type-action"><c>action()</c></seealso>, + and that <c><anno>Reply</anno></c> becomes the return value + of this function. + </p> + <p> + The function returns an error if the <c>gen_statem</c> + dies before or during this request. + </p> + </desc> + </func> + + <func> <name name="enter_loop" arity="4" since="OTP 19.1"/> <fsummary>Enter the <c>gen_statem</c> receive loop.</fsummary> <desc> @@ -1711,16 +1766,16 @@ handle_event(_, _, State, Data) -> <p> <c><anno>Module</anno></c>, <c><anno>Opts</anno></c> have the same meaning as when calling - <seealso marker="#start_link/3"><c>start[_link]/3,4</c></seealso>. + <seealso marker="#start_link/3"><c>start[_link|_monitor]/3,4</c></seealso>. </p> <p> If <c><anno>Server</anno></c> is <c>self()</c> an anonymous server is created just as when using - <seealso marker="#start_link/3"><c>start[_link]/3</c></seealso>. + <seealso marker="#start_link/3"><c>start[_link|_monitor]/3</c></seealso>. If <c><anno>Server</anno></c> is a <seealso marker="#type-server_name"><c>server_name()</c></seealso> a named server is created just as when using - <seealso marker="#start_link/4"><c>start[_link]/4</c></seealso>. + <seealso marker="#start_link/4"><c>start[_link|_monitor]/4</c></seealso>. However, the <seealso marker="#type-server_name"><c>server_name()</c></seealso> name must have been registered accordingly @@ -1779,6 +1834,48 @@ handle_event(_, _, State, Data) -> </func> <func> + <name name="send_request" arity="2" since="OTP-23"/> + <fsummary>Send a request to a <c>gen_statem</c>.</fsummary> + <desc> + <p> + Sends a request to the <c>gen_statem</c> + <seealso marker="#type-server_ref"><c><anno>ServerRef</anno></c></seealso> + and returns a handle <c><anno>RequestId</anno></c>. + </p> + <p> + The return value <c><anno>RequestId</anno></c> shall later be used with + <seealso marker="#wait_response/2"> <c>wait_response/1,2</c></seealso> or + <seealso marker="#check_response/2"> <c>check_response/2</c></seealso> + to fetch the actual result of the request. + </p> + <p> + The call <c>gen_statem:wait_response(gen_statem:send_request(ServerRef,Request), Timeout)</c> + can be seen as equivalent to + <seealso marker="#call/3"><c>gen_statem:call(Server,Request,Timeout)</c></seealso>, + ignoring the error handling. + </p> + <p> + The <c>gen_statem</c> calls the + <seealso marker="#state callback"><em>state callback</em></seealso> + with + <seealso marker="#type-event_type"><c>event_type()</c></seealso> + <c>{call,From}</c> and event content + <c><anno>Request</anno></c>. + </p> + <p> + A <c>Reply</c> is generated when a + <seealso marker="#state callback"><em>state callback</em></seealso> + returns with + <c>{reply,From,Reply}</c> as one + <seealso marker="#type-action"><c>action()</c></seealso>, + and that <c>Reply</c> becomes the return value + of <seealso marker="#wait_response/2"> <c>wait_response/1,2</c></seealso> or + <seealso marker="#check_response/2"> <c>check_response/2</c></seealso> function. + </p> + </desc> + </func> + + <func> <name name="start" arity="3" since="OTP 19.0"/> <name name="start" arity="4" since="OTP 19.0"/> <fsummary>Create a standalone <c>gen_statem</c> process.</fsummary> @@ -1922,6 +2019,35 @@ handle_event(_, _, State, Data) -> </func> <func> + <name name="start_monitor" arity="3" since="OTP @OTP-16120@"/> + <name name="start_monitor" arity="4" since="OTP @OTP-16120@"/> + <fsummary>Create a standalone <c>gen_statem</c> process.</fsummary> + <desc> + <p> + Creates a standalone <c>gen_statem</c> process according to + OTP design principles (using + <seealso marker="proc_lib"><c>proc_lib</c></seealso> + primitives) and atomically sets up a monitor to + the newly created process. + As it does not get linked to the calling process, + this start function cannot be used by a supervisor + to start a child. + </p> + <p> + For a description of arguments and return values, see + <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>. + Note that the return value on successful start differs from + <c>start_link/3,4</c>. <c>start_monitor/3,4</c> will return + <c>{ok,{Pid,Mon}}</c> where <c>Pid</c> is the process identifier + of the process, and <c>Mon</c> is a reference to the monitor + set up to monitor the process. If the start is not successful, + the caller will be blocked until the <c>DOWN</c> message has + been received and removed from the message queue. + </p> + </desc> + </func> + + <func> <name name="stop" arity="1" since="OTP 19.0"/> <fsummary>Synchronously stop a generic server.</fsummary> <desc> @@ -1967,6 +2093,45 @@ handle_event(_, _, State, Data) -> </p> </desc> </func> + + <func> + <name name="wait_response" arity="1" since="OTP-23"/> + <name name="wait_response" arity="2" since="OTP-23"/> + <fsummary>Wait for a reply from a server.</fsummary> + <desc> + <p> + This function is used to wait for a reply of a request made with + <seealso marker="#send_request/2"><c>send_request/2</c></seealso> + from the <c>gen_statem</c> process. This function must be called + from the same process from which + <seealso marker="#send_request/2"><c>send_request/2</c></seealso> + was made. + </p> + <p> + <c>Timeout</c> is an integer greater then or equal to zero + that specifies how many milliseconds to wait for an reply, or + the atom <c>infinity</c> to wait indefinitely. Defaults to + <c>infinity</c>. + If no reply is received within the specified + time, the function returns <c>timeout</c> and no cleanup is + done, and thus the function can be invoked repeatedly until a + reply is returned. + </p> + <p> + The return value <c><anno>Reply</anno></c> is generated when a + <seealso marker="#state callback"><em>state callback</em></seealso> + returns with + <c>{reply,From,<anno>Reply</anno>}</c> as one + <seealso marker="#type-action"><c>action()</c></seealso>, + and that <c><anno>Reply</anno></c> becomes the return value + of this function. + </p> + <p> + The function returns an error if the <c>gen_statem</c> + dies before or during this function call. + </p> + </desc> + </func> </funcs> <section> @@ -2144,7 +2309,8 @@ handle_event(_, _, State, Data) -> <marker id="Module:init-1"/> <p> Whenever a <c>gen_statem</c> is started using - <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso> + <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>, + <seealso marker="#start_monitor/3"><c>start_monitor/3,4</c></seealso>, or <seealso marker="#start/3"><c>start/3,4</c></seealso>, this function is called by the new process to initialize diff --git a/lib/stdlib/doc/src/io_protocol.xml b/lib/stdlib/doc/src/io_protocol.xml index 84b5f62c7f..f05c358866 100644 --- a/lib/stdlib/doc/src/io_protocol.xml +++ b/lib/stdlib/doc/src/io_protocol.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>1999</year> - <year>2016</year> + <year>2019</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -168,16 +168,6 @@ ok returns it "as is".</item> </list> - <p>For backward compatibility, the following <c>Request</c>s are also to be - handled by an I/O server (they are not to be present after - Erlang/OTP R15B):</p> - - <pre> -{put_chars, Characters} -{put_chars, Module, Function, Args}</pre> - - <p>These are to behave as <c>{put_chars, latin1, Characters}</c> and - <c>{put_chars, latin1, Module, Function, Args}</c>, respectively.</p> </section> <section> @@ -332,19 +322,6 @@ eof </item> </list> - <p>For backward compatibility, the following <c>Request</c>s are also to be - handled by an I/O server (they are not to be present after - Erlang/OTP R15B):</p> - - <pre> -{get_until, Prompt, Module, Function, ExtraArgs} -{get_chars, Prompt, N} -{get_line, Prompt}</pre> - - <p>These are to behave as - <c>{get_until, latin1, Prompt, Module, Function, ExtraArgs}</c>, - <c>{get_chars, latin1, Prompt, N}</c>, and - <c>{get_line, latin1, Prompt}</c>, respectively.</p> </section> <section> @@ -637,24 +614,6 @@ request({requests, Reqs}, State) -> function applying the requests in the list one after another, returning the last result.</p> - <p>We need to handle backward compatibility and the - <seealso marker="kernel:file"><c>file</c></seealso> module (which - uses the old requests until backward compatibility with pre-R13 nodes is - no longer needed). Notice that the I/O server does not work with a simple - <c>file:write/2</c> if these are not added:</p> - - <code> -request({put_chars,Chars}, State) -> - request({put_chars,latin1,Chars}, State); -request({put_chars,M,F,As}, State) -> - request({put_chars,latin1,M,F,As}, State); -request({get_chars,Prompt,N}, State) -> - request({get_chars,latin1,Prompt,N}, State); -request({get_line,Prompt}, State) -> - request({get_line,latin1,Prompt}, State); -request({get_until, Prompt,M,F,As}, State) -> - request({get_until,latin1,Prompt,M,F,As}, State);</code> - <p><c>{error, request}</c> must be returned if the request is not recognized:</p> diff --git a/lib/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml index bb983903a9..b5a78ae9f1 100644 --- a/lib/stdlib/doc/src/proc_lib.xml +++ b/lib/stdlib/doc/src/proc_lib.xml @@ -86,13 +86,11 @@ </desc> </datatype> <datatype> - <name name="priority_level"/> - </datatype> - <datatype> - <name name="max_heap_size"/> + <name name="start_spawn_option"/> <desc> - <p>See <seealso marker="erts:erlang#process_flag_max_heap_size"> - erlang:process_flag(max_heap_size, MaxHeapSize)</seealso>.</p> + <p>A restricted set of <seealso marker="#type-spawn_option">spawn + options</seealso>. Most notably <c>monitor</c> is <em>not</em> part + of these options.</p> </desc> </datatype> <datatype> @@ -295,8 +293,31 @@ init(Parent) -> <desc> <p>Spawns a new process and initializes it as described in the beginning of this manual page. The process is spawned using the - <seealso marker="erts:erlang#spawn_opt/2"><c>spawn_opt</c></seealso> + <seealso marker="erts:erlang#spawn_opt/2"><c>erlang:spawn_opt</c></seealso> BIFs.</p> + </desc> + </func> + + <func> + <name name="start" arity="3" since=""/> + <name name="start" arity="4" since=""/> + <name name="start" arity="5" since=""/> + <fsummary>Start a new process synchronously.</fsummary> + <desc> + <p>Starts a new process synchronously. Spawns the process and + waits for it to start. When the process has started, it + <em>must</em> call + <seealso marker="#init_ack/2"><c>init_ack(Parent, Ret)</c></seealso> + or <seealso marker="#init_ack/1"><c>init_ack(Ret)</c></seealso>, + where <c>Parent</c> is the process that evaluates this + function. At this time, <c>Ret</c> is returned.</p> + <p>If <c><anno>Time</anno></c> is specified as an integer, this + function waits for <c><anno>Time</anno></c> milliseconds for the + new process to call <c>init_ack</c>, or <c>Ret = {error, timeout}</c> + will be returned, and the process is killed.</p> + <p>Argument <c><anno>SpawnOpts</anno></c>, if specified, is passed + as the last argument to the <seealso marker="erts:erlang#spawn_opt/2"> + <c>spawn_opt/2,3,4,5</c></seealso> BIF.</p> <note> <p>Using spawn option <c>monitor</c> is not allowed. It causes the function to fail with reason @@ -306,29 +327,68 @@ init(Parent) -> </func> <func> - <name name="start" arity="3" since=""/> - <name name="start" arity="4" since=""/> - <name name="start" arity="5" since=""/> <name name="start_link" arity="3" since=""/> <name name="start_link" arity="4" since=""/> <name name="start_link" arity="5" since=""/> <fsummary>Start a new process synchronously.</fsummary> <desc> - <p>Starts a new process synchronously. Spawns the process and - waits for it to start. When the process has started, it + <p> + Starts a new process synchronously. Spawns the process and + waits for it to start. A link is atomically set on the + newly spawned process. When the process has started, it + <em>must</em> call + <seealso marker="#init_ack/2"><c>init_ack(Parent, Ret)</c></seealso> + or <seealso marker="#init_ack/1"><c>init_ack(Ret)</c></seealso>, + where <c>Parent</c> is the process that evaluates this + function. At this time, <c>Ret</c> is returned.</p> + <p>If <c><anno>Time</anno></c> is specified as an integer, this + function waits for <c><anno>Time</anno></c> milliseconds for the + new process to call <c>init_ack</c>, or <c>Ret = {error, timeout}</c> + will be returned, and the process is killed.</p> + <p>If the process crashes before it has called <c>init_ack/1,2</c>, + <c>Ret = {error, <anno>Reason</anno>}</c> will be returned if + the calling process traps exits.</p> + <p>Argument <c><anno>SpawnOpts</anno></c>, if specified, is passed + as the last argument to the <seealso marker="erts:erlang#spawn_opt/2"> + <c>spawn_opt/2,3,4,5</c></seealso> BIF.</p> + <note> + <p>Using spawn option <c>monitor</c> is not + allowed. It causes the function to fail with reason + <c>badarg</c>.</p> + </note> + </desc> + </func> + + <func> + <name name="start_monitor" arity="3" since="OTP @OTP-16120@"/> + <name name="start_monitor" arity="4" since="OTP @OTP-16120@"/> + <name name="start_monitor" arity="5" since="OTP @OTP-16120@"/> + <fsummary>Start a new process synchronously.</fsummary> + <desc> + <p> + Starts a new process synchronously. Spawns the process and + waits for it to start. A monitor is atomically set on the + newly spawned process. When the process has started, it <em>must</em> call <seealso marker="#init_ack/2"><c>init_ack(Parent, Ret)</c></seealso> or <seealso marker="#init_ack/1"><c>init_ack(Ret)</c></seealso>, where <c>Parent</c> is the process that evaluates this function. At this time, <c>Ret</c> is returned.</p> - <p>If function <c>start_link/3,4,5</c> is used and - the process crashes before it has called <c>init_ack/1,2</c>, - <c>{error, <anno>Reason</anno>}</c> is returned if the calling - process traps exits.</p> <p>If <c><anno>Time</anno></c> is specified as an integer, this function waits for <c><anno>Time</anno></c> milliseconds for the - new process to call <c>init_ack</c>, or <c>{error, timeout}</c> is - returned, and the process is killed.</p> + new process to call <c>init_ack</c>, or <c>Ret = {error, timeout}</c> + will be returned, and the process is killed.</p> + <p> + The return value is <c>{Ret, Mon}</c> where <c>Ret</c> corresponds + to the <c>Ret</c> argument in the call to <c>init_ack()</c>, and + <c>Mon</c> is the monitor reference of the monitor that has been + set up. + </p> + <p> + A <c>'DOWN'</c> message will be delivered to the caller if + this function returns, and the spawned process terminates. This is + true also in the case when the operation times out. + </p> <p>Argument <c><anno>SpawnOpts</anno></c>, if specified, is passed as the last argument to the <seealso marker="erts:erlang#spawn_opt/2"> <c>spawn_opt/2,3,4,5</c></seealso> BIF.</p> diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index 8d61833d1f..d12f537b07 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -84,6 +84,7 @@ <xi:include href="sets.xml"/> <xi:include href="shell.xml"/> <xi:include href="shell_default.xml"/> + <xi:include href="shell_docs.xml"/> <xi:include href="slave.xml"/> <xi:include href="sofs.xml"/> <xi:include href="string.xml"/> diff --git a/lib/stdlib/doc/src/shell_docs.xml b/lib/stdlib/doc/src/shell_docs.xml new file mode 100644 index 0000000000..a3b6f128c3 --- /dev/null +++ b/lib/stdlib/doc/src/shell_docs.xml @@ -0,0 +1,120 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2020</year><year>2020</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>shell_docs</title> + <prepared>Lukas Larsson</prepared> + <responsible></responsible> + <docno>1</docno> + <approved></approved> + <checked></checked> + <date>2020-02-19</date> + <rev>A</rev> + <file>shell_docs.xml</file> + </header> + <module since="OTP @OTP-16222@">shell_docs</module> + <modulesummary>Functions used to render documentation for a shell.</modulesummary> + <description> + <p>This module can be used to render function and type documentation + to be printed in a shell. It can only render documentation of the format + <c>application/erlang+html</c>. For more information about this format see + <seealso marker="erl_docgen:doc_storage">Documentation Storage</seealso> + in Erl_Docgen's User's Guide. + </p> + </description> + + <datatypes> + <datatype> + <name name="docs_v1"/> + </datatype> + <datatype> + <name name="chunk_element_type"/> + <desc> + <p> + The HTML tags allowed in <c>application/erlang+html</c>. + </p> + </desc> + </datatype> + <datatype> + <name name="chunk_element_attr"/> + <name name="chunk_element_attrs"/> + <name name="chunk_element"/> + <name name="chunk_elements"/> + <desc> + </desc> + </datatype> + </datatypes> + + <funcs> + + <func> + <name name="render" arity="2" since="OTP @OTP-16222@"/> + <fsummary>Render the documentation for a module.</fsummary> + <desc> + <p>Render the documentation for a module.</p> + </desc> + </func> + <func> + <name name="render" arity="3" since="OTP @OTP-16222@"/> + <name name="render" arity="4" since="OTP @OTP-16222@"/> + <fsummary>Render the documentation for a function.</fsummary> + <desc> + <p>Render the documentation for a function.</p> + </desc> + </func> + <func> + <name name="render_type" arity="2" since="OTP @OTP-16222@"/> + <fsummary>Render a list of all available types in a module.</fsummary> + <desc> + <p>Render a list of all available types in a module.</p> + </desc> + </func> + <func> + <name name="render_type" arity="3" since="OTP @OTP-16222@"/> + <name name="render_type" arity="4" since="OTP @OTP-16222@"/> + <fsummary>Render the documentation of a type in a module.</fsummary> + <desc> + <p>Render the documentation of a type in a module.</p> + </desc> + </func> + + <func> + <name name="validate" arity="1" since="OTP @OTP-16222@"/> + <fsummary>Validate the documentation</fsummary> + <desc> + <p>This function can be used to do a basic validation of + the doc content of <c>application/erlang+html</c> format.</p> + </desc> + </func> + + <func> + <name name="normalize" arity="1" since="OTP @OTP-16222@"/> + <fsummary>Normalize the documentation</fsummary> + <desc> + <p>This function can be used to do whitespace normalization + of <c>application/erlang+html</c> documentation.</p> + </desc> + </func> + + </funcs> +</erlref> diff --git a/lib/stdlib/doc/src/specs.xml b/lib/stdlib/doc/src/specs.xml index fd2d625685..9b11a6941c 100644 --- a/lib/stdlib/doc/src/specs.xml +++ b/lib/stdlib/doc/src/specs.xml @@ -51,6 +51,7 @@ <xi:include href="../specs/specs_sets.xml"/> <xi:include href="../specs/specs_shell.xml"/> <xi:include href="../specs/specs_shell_default.xml"/> + <xi:include href="../specs/specs_shell_docs.xml"/> <xi:include href="../specs/specs_slave.xml"/> <xi:include href="../specs/specs_sofs.xml"/> <xi:include href="../specs/specs_string.xml"/> diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index f15b1a2dd3..1f319c97b7 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2018</year> + <year>1996</year><year>2019</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -300,6 +300,18 @@ child_spec() = #{id => child_id(), % mandatory <name name="shutdown"/> </datatype> <datatype> + <name name="startchild_err"/> + </datatype> + <datatype> + <name name="startchild_ret"/> + </datatype> + <datatype> + <name name="startlink_err"/> + </datatype> + <datatype> + <name name="startlink_ret"/> + </datatype> + <datatype> <name name="strategy"/> </datatype> <datatype> diff --git a/lib/stdlib/doc/src/uri_string.xml b/lib/stdlib/doc/src/uri_string.xml index 54ea647f03..cc4186e5ef 100644 --- a/lib/stdlib/doc/src/uri_string.xml +++ b/lib/stdlib/doc/src/uri_string.xml @@ -322,9 +322,9 @@ <pre> 1> <input>URIMap = #{fragment => "nose", host => "example.com", path => "/over/there",</input> 1> port => 8042, query => "name=ferret", scheme => "foo", userinfo => "user"}. -#{fragment => "top",host => "example.com", - path => "/over/there",port => 8042,query => "?name=ferret", - scheme => foo,userinfo => "user"} +#{fragment => "nose",host => "example.com", + path => "/over/there",port => 8042,query => "name=ferret", + scheme => "foo",userinfo => "user"} 2> <input>uri_string:recompose(URIMap).</input> "foo://example.com:8042/over/there?name=ferret#nose"</pre> diff --git a/lib/stdlib/doc/src/zip.xml b/lib/stdlib/doc/src/zip.xml index bb2ed7727a..0d36478b05 100644 --- a/lib/stdlib/doc/src/zip.xml +++ b/lib/stdlib/doc/src/zip.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2006</year><year>2016</year> + <year>2006</year><year>2019</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -358,6 +358,8 @@ <name name="create" arity="2" since=""/> <name name="create" arity="3" since=""/> <fsummary>Create a zip archive with options.</fsummary> + <type name="create_option"/> + <type name="extension_spec"/> <desc> <p>Creates a zip archive containing the files specified in <c><anno>FileList</anno></c>.</p> diff --git a/lib/stdlib/scripts/update_deprecations b/lib/stdlib/scripts/update_deprecations new file mode 100755 index 0000000000..810a186b53 --- /dev/null +++ b/lib/stdlib/scripts/update_deprecations @@ -0,0 +1,149 @@ +#!/usr/bin/env escript +%% -*- erlang -*- + +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2020. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-mode(compile). + +-import(lists, [foldl/3,sort/1]). + +-record(st, { functions = [], types = [] }). + +main([_|_]=Directories) -> + emit(summarize(Directories)), + halt(0). + +summarize(Directories) -> + foldl(fun summarize_directory/2, #st{}, Directories). + +summarize_directory(Dir, Acc) -> + Files = [filename:join(Dir, F) || F <- filelib:wildcard("*.beam", Dir)], + foldl(fun summarize_file/2, Acc, Files). + +summarize_file(File, Acc) -> + {ok, {Module, [Chunk]}} = beam_lib:chunks(File, [attributes]), + {attributes, Attributes} = Chunk, + summarize_attributes(Attributes, Module, Acc). + +summarize_attributes([{deprecated, Ds} | As], Module, Acc0) -> + Fs = sa_1(Ds, deprecated, Module, Acc0#st.functions), + Acc = Acc0#st{ functions = Fs }, + summarize_attributes(As, Module, Acc); +summarize_attributes([{removed, Rs} | As], Module, Acc0) -> + Fs = sa_1(Rs, removed, Module, Acc0#st.functions), + Acc = Acc0#st{ functions = Fs }, + summarize_attributes(As, Module, Acc); +summarize_attributes([{deprecated_type, Ds} | As], Module, Acc0) -> + Ts = sa_1(Ds, deprecated, Module, Acc0#st.types), + Acc = Acc0#st{ types = Ts }, + summarize_attributes(As, Module, Acc); +summarize_attributes([{removed_type, Rs} | As], Module, Acc0) -> + Ts = sa_1(Rs, removed, Module, Acc0#st.types), + Acc = Acc0#st{ types = Ts }, + summarize_attributes(As, Module, Acc); +summarize_attributes([_ | As], Module, Acc) -> + summarize_attributes(As, Module, Acc); +summarize_attributes([], _Module, Acc) -> + Acc. + +sa_1([{F, A, Info} | As], Tag, Module, Acc0) -> + sa_1(As, Tag, Module, [{Tag, Module, F, A, Info} | Acc0]); +sa_1([{F, A} | As], Tag, Module, Acc0) -> + sa_1(As, Tag, Module, [{Tag, Module, F, A, undefined} | Acc0]); +sa_1([module | As], Tag, Module, Acc0) -> + sa_1(As, Tag, Module, [{Tag, Module, '_', '_', undefined} | Acc0]); +sa_1([], _Tag, _Module, Acc) -> + Acc. + +%% + +emit(#st{ functions = Fs, types = Ts }) -> + io:format("%%\n" + "%% WARNING: DO NOT EDIT THIS FILE.\n" + "%%\n" + "%% This file was auto-generated from attributes in the source\n" + "%% code.\n" + "%%\n" + "%% To add a description to a deprecation or removal attribute,\n" + "%% write a string after the arity:\n" + "%%\n" + "%% -deprecated([{foo,1,\"use bar/1 instead\"}]).\n" + "%% -deprecated_type([{gadget,1,\"use widget/1 instead\"}]).\n" + "%% -removed([{hello,2,\"use there/2 instead\"}]).\n" + "%% -removed_type([{frobnitz,1,\"use grunka/1 instead\"}]).\n" + "%%\n" + "%% Descriptions cannot be given with the `f/1` shorthand, and\n" + "%% it will fall back to a generic description referring the\n" + "%% user to the documentation.\n" + "%%\n" + "%% Use `./otp_build update_deprecations` to update this file\n" + "%% after adding an attribute.\n" + "%%\n" + "-module(otp_internal).\n" + "-include(\"otp_internal.hrl\").\n" + "%%\n"), + + emit_function("obsolete", Fs), + emit_function("obsolete_type", Ts), + + ok. + +emit_function(FuncName, Entries) -> + io:format("-dialyzer({no_match, ~ts/3}).\n", [FuncName]), + [emit_clause(FuncName, E) || E <- sort_clauses(Entries)], + + io:format("~ts(_,_,_) -> no.\n\n", [FuncName]). + +sort_clauses(Entries) -> + Tagged = [{clause_order(E), E} || E <- Entries], + [E || {_, E} <- sort(Tagged)]. + +%% Wildcard matches must be emitted *after* specific matches to avoid +%% losing descriptions. +clause_order({_Tag, _Module, F, A, _Info}) when F =/= '_', A =/= '_' -> 0; +clause_order({_Tag, _Module, F, '_', _Info}) when F =/= '_' -> 1; +clause_order({_Tag, _Module, '_', A, _Info}) when A =/= '_' -> 2; +clause_order({_Tag, _Module, '_', '_', _Info}) -> 3. + +emit_clause(FuncName, {Tag, M, F, A, Info}) -> + io:format("~ts(~ts, ~ts, ~ts) ->\n" + " {~p, ~p};\n", + [FuncName, match_string(M), match_string(F), match_string(A), + Tag, info_string(Info)]). + +%% + +info_string(undefined) -> + "see the documentation for details"; +info_string(next_version) -> + "will be removed in the next version. " + "See the documentation for details"; +info_string(next_major_release) -> + "will be removed in the next major release. " + "See the documentation for details"; +info_string(eventually) -> + "will be removed in a future release. " + "See the documentation for details"; +info_string(String) when is_list(String) -> + String. + +match_string('_') -> "_"; +match_string(Term) -> io_lib:format("~p", [Term]). diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 86003c953d..c410b36964 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -112,6 +112,7 @@ MODULES= \ sets \ shell \ shell_default \ + shell_docs \ slave \ sofs \ string \ @@ -133,7 +134,7 @@ HRL_FILES= \ ../include/qlc.hrl \ ../include/zip.hrl -INTERNAL_HRL_FILES= dets.hrl erl_tar.hrl +INTERNAL_HRL_FILES= dets.hrl erl_tar.hrl otp_internal.hrl ERL_FILES= $(MODULES:%=%.erl) @@ -149,6 +150,12 @@ APPUP_FILE= stdlib.appup APPUP_SRC= $(APPUP_FILE).src APPUP_TARGET= $(EBIN)/$(APPUP_FILE) +ifeq ($(TARGET),win32) + EXE_SUFFIX=.exe +else + EXE_SUFFIX= +endif + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -207,7 +214,7 @@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ unicode_util.erl: ../uc_spec/* - escript ../uc_spec/gen_unicode_mod.escript + escript$(EXE_SUFFIX) ../uc_spec/gen_unicode_mod.escript # ---------------------------------------------------- # Release Target diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index aa992f17ab..967ed33c61 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -19,6 +19,7 @@ %% -module(beam_lib). -behaviour(gen_server). +-compile({nowarn_deprecated_function,{crypto,block_decrypt,4}}). %% Avoid warning for local function error/1 clashing with autoimported BIF. -compile({no_auto_import,[error/1]}). diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index 0362b72536..6af3951604 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -19,6 +19,8 @@ %% -module(c). +-include_lib("kernel/include/eep48.hrl"). + %% Utilities to use from shell. %% Avoid warning for local function error/2 clashing with autoimported BIF. @@ -28,6 +30,7 @@ lc_batch/0, lc_batch/1, i/3,pid/3,m/0,m/1,mm/0,lm/0, bt/1, q/0, + h/1,h/2,h/3,ht/1,ht/2,ht/3, erlangrc/0,erlangrc/1,bi/1, flush/0, regs/0, uptime/0, nregs/0,pwd/0,ls/0,ls/1,cd/1,memory/1,memory/0, xm/1]). @@ -48,6 +51,9 @@ help() -> "cd(Dir) -- change working directory\n" "flush() -- flush any messages sent to the shell\n" "help() -- help info\n" + "h(M) -- module documentation\n" + "h(M,F) -- module function documentation\n" + "h(M,F,A) -- module function arity documentation\n" "i() -- information about the system\n" "ni() -- information about the networked system\n" "i(X,Y,Z) -- information about pid <X,Y,Z>\n" @@ -147,6 +153,82 @@ c(SrcFile, NewOpts, Filter, BeamFile, Info) -> format("Recompiling ~ts\n", [SrcFile]), safe_recompile(SrcFile, Options, BeamFile). +-type h_return() :: ok | {error, missing | {unknown_format, unicode:chardata()}}. +-type ht_return() :: h_return() | {error, type_missing}. +-type hf_return() :: h_return() | {error, function_missing}. + +-spec h(module()) -> h_return(). +h(Module) -> + case code:get_doc(Module) of + {ok, #docs_v1{ format = ?NATIVE_FORMAT } = Docs} -> + format_docs(shell_docs:render(Module, Docs)); + {ok, #docs_v1{ format = Enc }} -> + {error, {unknown_format, Enc}}; + Error -> + Error + end. + +-spec h(module(),function()) -> hf_return(). +h(Module,Function) -> + case code:get_doc(Module) of + {ok, #docs_v1{ format = ?NATIVE_FORMAT } = Docs} -> + format_docs(shell_docs:render(Module, Function, Docs)); + {ok, #docs_v1{ format = Enc }} -> + {error, {unknown_format, Enc}}; + Error -> + Error + end. + +-spec h(module(),function(),arity()) -> hf_return(). +h(Module,Function,Arity) -> + case code:get_doc(Module) of + {ok, #docs_v1{ format = ?NATIVE_FORMAT } = Docs} -> + format_docs(shell_docs:render(Module, Function, Arity, Docs)); + {ok, #docs_v1{ format = Enc }} -> + {error, {unknown_format, Enc}}; + Error -> + Error + end. + +-spec ht(module()) -> h_return(). +ht(Module) -> + case code:get_doc(Module) of + {ok, #docs_v1{ format = ?NATIVE_FORMAT } = Docs} -> + format_docs(shell_docs:render_type(Module, Docs)); + {ok, #docs_v1{ format = Enc }} -> + {error, {unknown_format, Enc}}; + Error -> + Error + end. + +-spec ht(module(),Type :: atom()) -> ht_return(). +ht(Module,Type) -> + case code:get_doc(Module) of + {ok, #docs_v1{ format = ?NATIVE_FORMAT } = Docs} -> + format_docs(shell_docs:render_type(Module, Type, Docs)); + {ok, #docs_v1{ format = Enc }} -> + {error, {unknown_format, Enc}}; + Error -> + Error + end. + +-spec ht(module(),Type :: atom(),arity()) -> + ht_return(). +ht(Module,Type,Arity) -> + case code:get_doc(Module) of + {ok, #docs_v1{ format = ?NATIVE_FORMAT } = Docs} -> + format_docs(shell_docs:render_type(Module, Type, Arity, Docs)); + {ok, #docs_v1{ format = Enc }} -> + {error, {unknown_format, Enc}}; + Error -> + Error + end. + +format_docs({error,_} = E) -> + E; +format_docs(Docs) -> + format("~ts",[Docs]). + old_options(Info) -> case lists:keyfind(options, 1, Info) of {options, Opts} -> Opts; diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl index ef6d1882e6..2f95f54312 100644 --- a/lib/stdlib/src/calendar.erl +++ b/lib/stdlib/src/calendar.erl @@ -54,7 +54,8 @@ valid_date/1, valid_date/3]). --deprecated([{local_time_to_universal_time,1}]). +-deprecated([{local_time_to_universal_time,1, + "use calendar:local_time_to_universal_time_dst/1 instead"}]). -define(SECONDS_PER_MINUTE, 60). -define(SECONDS_PER_HOUR, 3600). diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index f027d05f55..6078c5e67b 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -352,9 +352,6 @@ do_op({blink,C,M}, Bef=[$$,$$|_], Aft, Rs) -> %% don't blink after a $ do_op({blink,C,_}, Bef=[$$|_], Aft, Rs) -> do_op({insert,C}, Bef, Aft, Rs); -%do_op({blink,C,M}, Bef, [], Rs) -> -% N = over_paren(Bef, C, M), -% {blink,N+1,{[C|Bef],[]},[{move_rel,-(N+1)},{put_chars,[C]}|Rs]}; do_op({blink,C,M}, Bef, Aft, Rs) -> case over_paren(Bef, C, M) of beep -> diff --git a/lib/stdlib/src/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl index bdcefda6e5..bb6ad26d8f 100644 --- a/lib/stdlib/src/edlin_expand.erl +++ b/lib/stdlib/src/edlin_expand.erl @@ -32,35 +32,71 @@ %% function name must be on the same line. CurrentBefore is reversed %% and over_word/3 reverses the characters it finds. In certain cases %% possible expansions are printed. +%% +%% The function also handles expansion with "h(" for module and functions. expand(Bef0) -> {Bef1,Word,_} = edlin:over_word(Bef0, [], 0), case over_white(Bef1, [], 0) of - {[$:|Bef2],_White,_Nwh} -> + {[$,|Bef2],_White,_Nwh} -> + {Bef3,_White1,_Nwh1} = over_white(Bef2, [], 0), + {Bef4,Mod,_Nm} = edlin:over_word(Bef3, [], 0), + case expand_function(Bef4) of + help -> + expand_function_name(Mod, Word, ","); + _ -> + expand_module_name(Word, ",") + end; + {[$:|Bef2],_White,_Nwh} -> {Bef3,_White1,_Nwh1} = over_white(Bef2, [], 0), {_,Mod,_Nm} = edlin:over_word(Bef3, [], 0), - expand_function_name(Mod, Word); + expand_function_name(Mod, Word, "("); {_,_,_} -> - expand_module_name(Word) + CompleteChar + = case expand_function(Bef1) of + help -> ","; + _ -> ":" + end, + expand_module_name(Word, CompleteChar) end. -expand_module_name(Prefix) -> - match(Prefix, code:all_loaded(), ":"). +expand_function("("++Str) -> + case edlin:over_word(Str, [], 0) of + {_,"h",_} -> + help; + {_,"ht",_} -> + help_type; + _ -> + module + end; +expand_function(_) -> + module. + +expand_module_name("",_) -> + {no, [], []}; +expand_module_name(Prefix,CompleteChar) -> + match(Prefix, [{list_to_atom(M),P} || {M,P,_} <- code:all_available()], CompleteChar). -expand_function_name(ModStr, FuncPrefix) -> +expand_function_name(ModStr, FuncPrefix, CompleteChar) -> case to_atom(ModStr) of {ok, Mod} -> - case erlang:module_loaded(Mod) of - true -> - L = Mod:module_info(), - case lists:keyfind(exports, 1, L) of - {_, Exports} -> - match(FuncPrefix, Exports, "("); - _ -> - {no, [], []} - end; - false -> - {no, [], []} - end; + Exports = + case erlang:module_loaded(Mod) of + true -> + Mod:module_info(exports); + false -> + case beam_lib:chunks(code:which(Mod), [exports]) of + {ok, {Mod, [{exports,E}]}} -> + E; + _ -> + {no, [], []} + end + end, + case Exports of + {no, [], []} -> + {no, [], []}; + Exports -> + match(FuncPrefix, Exports, CompleteChar) + end; error -> {no, [], []} end. @@ -99,8 +135,10 @@ match(Prefix, Alts, Extra0) -> {no, [], []} end. -flat_write(T) -> - lists:flatten(io_lib:fwrite("~tw",[T])). +flat_write(T) when is_atom(T) -> + lists:flatten(io_lib:fwrite("~tw",[T])); +flat_write(S) -> + S. %% Return the list of names L in multiple columns. format_matches(L) -> diff --git a/lib/stdlib/src/erl_error.erl b/lib/stdlib/src/erl_error.erl index fdcb9e824c..5fbf5a6282 100644 --- a/lib/stdlib/src/erl_error.erl +++ b/lib/stdlib/src/erl_error.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,7 +19,7 @@ %% -module(erl_error). --export([format_exception/6, format_exception/7, +-export([format_exception/6, format_exception/7, format_exception/8, format_stacktrace/4, format_stacktrace/5, format_call/4, format_call/5, format_fun/1, format_fun/2]). @@ -38,20 +38,34 @@ format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun) -> %% -> iolist() | unicode:charlist() (no \n at end) %% FormatFun = fun(Term, I) -> iolist() | unicode:charlist(). -format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun, Encoding) +format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun, Encoding) -> + FF = wrap_format_fun_2(FormatFun), + format_exception(I, Class, Reason, StackTrace, StackFun, FF, Encoding, -1). + +format_exception(I, Class, Reason, StackTrace, StackFun, FormatFun, Encoding, + CharsLimit) when is_integer(I), I >= 1, is_function(StackFun, 3), - is_function(FormatFun, 2) -> + is_function(FormatFun, 3), is_integer(CharsLimit) -> S = n_spaces(I-1), {Term,Trace1,Trace} = analyze_exception(Class, Reason, StackTrace), - Expl0 = explain_reason(Term, Class, Trace1, FormatFun, S, Encoding), + StLimit = if + CharsLimit < 0 -> + CharsLimit; + true -> + %% Reserve one third for the stacktrace. + CharsLimit div 3 + end, + St = format_stacktrace1(S, Trace, FormatFun, StackFun, Encoding, StLimit), + Lim = sub(sub(CharsLimit, exited(Class), latin1), St, Encoding), + Expl0 = explain_reason(Term, Class, Trace1, FormatFun, S, Encoding, Lim), FormatString = case Encoding of latin1 -> "~s~s"; _ -> "~s~ts" end, Expl = io_lib:fwrite(FormatString, [exited(Class), Expl0]), - case format_stacktrace1(S, Trace, FormatFun, StackFun, Encoding) of + case St of [] -> Expl; - Stack -> [Expl, $\n, Stack] + _ -> [Expl, $\n, St] end. %% -> iolist() (no \n at end) @@ -63,7 +77,8 @@ format_stacktrace(I, StackTrace, StackFun, FormatFun, Encoding) when is_integer(I), I >= 1, is_function(StackFun, 3), is_function(FormatFun, 2) -> S = n_spaces(I-1), - format_stacktrace1(S, StackTrace, FormatFun, StackFun, Encoding). + FF = wrap_format_fun_2(FormatFun), + format_stacktrace1(S, StackTrace, FF, StackFun, Encoding, -1). %% -> iolist() (no \n at end) format_call(I, ForMForFun, As, FormatFun) -> @@ -72,7 +87,8 @@ format_call(I, ForMForFun, As, FormatFun) -> %% -> iolist() | unicode:charlist() (no \n at end) format_call(I, ForMForFun, As, FormatFun, Enc) when is_integer(I), I >= 1, is_list(As), is_function(FormatFun, 2) -> - format_call("", n_spaces(I-1), ForMForFun, As, FormatFun, Enc). + FF = wrap_format_fun_2(FormatFun), + format_call("", n_spaces(I-1), ForMForFun, As, FF, Enc). %% -> iolist() (no \n at end) format_fun(Fun) -> @@ -94,6 +110,9 @@ format_fun(Fun, Enc) when is_function(Fun) -> mfa_to_string(M, F, A, Enc) end. +wrap_format_fun_2(FormatFun) -> + fun(T, I1, CL) -> {FormatFun(T, I1), CL} end. + analyze_exception(error, Term, Stack) -> case {is_stacktrace(Stack), Stack, Term} of {true, [{_,_,As,_}=MFAL|MFAs], function_clause} when is_list(As) -> @@ -127,82 +146,83 @@ is_stacktrace(_) -> false. %% ERTS exit codes (some of them are also returned by erl_eval): -explain_reason(badarg, error, [], _PF, _S, _Enc) -> +explain_reason(badarg, error, [], _PF, _S, _Enc, _CL) -> <<"bad argument">>; -explain_reason({badarg,V}, error=Cl, [], PF, S, _Enc) -> % orelse, andalso - format_value(V, <<"bad argument: ">>, Cl, PF, S); -explain_reason(badarith, error, [], _PF, _S, _Enc) -> +explain_reason({badarg,V}, error=Cl, [], PF, S, _Enc, CL) -> % orelse, andalso + format_value(V, <<"bad argument: ">>, Cl, PF, S, CL); +explain_reason(badarith, error, [], _PF, _S, _Enc, _CL) -> <<"an error occurred when evaluating an arithmetic expression">>; -explain_reason({badarity,{Fun,As}}, error, [], _PF, _S, Enc) +explain_reason({badarity,{Fun,As}}, error, [], _PF, _S, Enc, _CL) when is_function(Fun) -> %% Only the arity is displayed, not the arguments As. io_lib:fwrite(<<"~ts called with ~s">>, [format_fun(Fun, Enc), argss(length(As))]); -explain_reason({badfun,Term}, error=Cl, [], PF, S, _Enc) -> - format_value(Term, <<"bad function ">>, Cl, PF, S); -explain_reason({badmatch,Term}, error=Cl, [], PF, S, _Enc) -> +explain_reason({badfun,Term}, error=Cl, [], PF, S, _Enc, CL) -> + format_value(Term, <<"bad function ">>, Cl, PF, S, CL); +explain_reason({badmatch,Term}, error=Cl, [], PF, S, _Enc, CL) -> Str = <<"no match of right hand side value ">>, - format_value(Term, Str, Cl, PF, S); -explain_reason({case_clause,V}, error=Cl, [], PF, S, _Enc) -> + format_value(Term, Str, Cl, PF, S, CL); +explain_reason({case_clause,V}, error=Cl, [], PF, S, _Enc, CL) -> %% "there is no case clause with a true guard sequence and a %% pattern matching..." - format_value(V, <<"no case clause matching ">>, Cl, PF, S); -explain_reason(function_clause, error, [{F,A}], _PF, _S, _Enc) -> + format_value(V, <<"no case clause matching ">>, Cl, PF, S, CL); +explain_reason(function_clause, error, [{F,A}], _PF, _S, _Enc, _CL) -> %% Shell commands FAs = io_lib:fwrite(<<"~w/~w">>, [F, A]), [<<"no function clause matching call to ">> | FAs]; -explain_reason(function_clause, error=Cl, [{M,F,As,Loc}], PF, S, Enc) -> +explain_reason(function_clause, error=Cl, [{M,F,As,Loc}], PF, S, Enc, CL) -> Str = <<"no function clause matching ">>, - [format_errstr_call(Str, Cl, {M,F}, As, PF, S, Enc),$\s|location(Loc)]; -explain_reason(if_clause, error, [], _PF, _S, _Enc) -> + [format_errstr_call(Str, Cl, {M,F}, As, PF, S, Enc, CL),$\s|location(Loc)]; +explain_reason(if_clause, error, [], _PF, _S, _Enc, _CL) -> <<"no true branch found when evaluating an if expression">>; -explain_reason(noproc, error, [], _PF, _S, _Enc) -> +explain_reason(noproc, error, [], _PF, _S, _Enc, _CL) -> <<"no such process or port">>; -explain_reason(notalive, error, [], _PF, _S, _Enc) -> +explain_reason(notalive, error, [], _PF, _S, _Enc, _CL) -> <<"the node cannot be part of a distributed system">>; -explain_reason(system_limit, error, [], _PF, _S, _Enc) -> +explain_reason(system_limit, error, [], _PF, _S, _Enc, _CL) -> <<"a system limit has been reached">>; -explain_reason(timeout_value, error, [], _PF, _S, _Enc) -> +explain_reason(timeout_value, error, [], _PF, _S, _Enc, _CL) -> <<"bad receive timeout value">>; -explain_reason({try_clause,V}, error=Cl, [], PF, S, _Enc) -> +explain_reason({try_clause,V}, error=Cl, [], PF, S, _Enc, CL) -> %% "there is no try clause with a true guard sequence and a %% pattern matching..." - format_value(V, <<"no try clause matching ">>, Cl, PF, S); -explain_reason(undef, error, [{M,F,A,_}], _PF, _S, Enc) -> + format_value(V, <<"no try clause matching ">>, Cl, PF, S, CL); +explain_reason(undef, error, [{M,F,A,_}], _PF, _S, Enc, _CL) -> %% Only the arity is displayed, not the arguments, if there are any. io_lib:fwrite(<<"undefined function ~ts">>, [mfa_to_string(M, F, n_args(A), Enc)]); -explain_reason({shell_undef,F,A,_}, error, [], _PF, _S, Enc) -> +explain_reason({shell_undef,F,A,_}, error, [], _PF, _S, Enc, _CL) -> %% Give nicer reports for undefined shell functions %% (but not when the user actively calls shell_default:F(...)). FS = to_string(F, Enc), io_lib:fwrite(<<"undefined shell command ~ts/~w">>, [FS, n_args(A)]); %% Exit codes returned by erl_eval only: -explain_reason({argument_limit,_Fun}, error, [], _PF, _S, _Enc) -> +explain_reason({argument_limit,_Fun}, error, [], _PF, _S, _Enc, _CL) -> io_lib:fwrite(<<"limit of number of arguments to interpreted function" " exceeded">>, []); -explain_reason({bad_filter,V}, error=Cl, [], PF, S, _Enc) -> - format_value(V, <<"bad filter ">>, Cl, PF, S); -explain_reason({bad_generator,V}, error=Cl, [], PF, S, _Enc) -> - format_value(V, <<"bad generator ">>, Cl, PF, S); -explain_reason({unbound,V}, error, [], _PF, _S, _Enc) -> +explain_reason({bad_filter,V}, error=Cl, [], PF, S, _Enc, CL) -> + format_value(V, <<"bad filter ">>, Cl, PF, S, CL); +explain_reason({bad_generator,V}, error=Cl, [], PF, S, _Enc, CL) -> + format_value(V, <<"bad generator ">>, Cl, PF, S, CL); +explain_reason({unbound,V}, error, [], _PF, _S, _Enc, _CL) -> io_lib:fwrite(<<"variable ~w is unbound">>, [V]); %% Exit codes local to the shell module (restricted shell): -explain_reason({restricted_shell_bad_return, V}, exit=Cl, [], PF, S, _Enc) -> +explain_reason({restricted_shell_bad_return, V}, exit=Cl, [], PF, S, _Enc, CL) -> Str = <<"restricted shell module returned bad value ">>, - format_value(V, Str, Cl, PF, S); + format_value(V, Str, Cl, PF, S, CL); explain_reason({restricted_shell_disallowed,{ForMF,As}}, - exit=Cl, [], PF, S, Enc) -> + exit=Cl, [], PF, S, Enc, CL) -> %% ForMF can be a fun, but not a shell fun. Str = <<"restricted shell does not allow ">>, - format_errstr_call(Str, Cl, ForMF, As, PF, S, Enc); -explain_reason(restricted_shell_started, exit, [], _PF, _S, _Enc) -> + format_errstr_call(Str, Cl, ForMF, As, PF, S, Enc, CL); +explain_reason(restricted_shell_started, exit, [], _PF, _S, _Enc, _CL) -> <<"restricted shell starts now">>; -explain_reason(restricted_shell_stopped, exit, [], _PF, _S, _Enc) -> +explain_reason(restricted_shell_stopped, exit, [], _PF, _S, _Enc, _CL) -> <<"restricted shell stopped">>; %% Other exit code: -explain_reason(Reason, Class, [], PF, S, _Enc) -> - PF(Reason, (iolist_size(S)+1) + exited_size(Class)). +explain_reason(Reason, Class, [], PF, S, _Enc, CL) -> + {L, _} = PF(Reason, (iolist_size(S)+1) + exited_size(Class), CL), + L. n_args(A) when is_integer(A) -> A; @@ -218,29 +238,33 @@ argss(2) -> argss(I) -> io_lib:fwrite(<<"~w arguments">>, [I]). -format_stacktrace1(S0, Stack0, PF, SF, Enc) -> +format_stacktrace1(S0, Stack0, PF, SF, Enc, CL) -> Stack1 = lists:dropwhile(fun({M,F,A,_}) -> SF(M, F, A) end, lists:reverse(Stack0)), S = [" " | S0], Stack = lists:reverse(Stack1), - format_stacktrace2(S, Stack, 1, PF, Enc). - -format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF, Enc) when is_integer(A) -> - [io_lib:fwrite(<<"~s~s ~ts ~ts">>, - [sep(N, S), origin(N, M, F, A), - mfa_to_string(M, F, A, Enc), - location(L)]) - | format_stacktrace2(S, Fs, N + 1, PF, Enc)]; -format_stacktrace2(S, [{M,F,As,_}|Fs], N, PF, Enc) when is_list(As) -> + format_stacktrace2(S, Stack, 1, PF, Enc, CL). + +format_stacktrace2(_S, _Stack, _N, _PF, _Enc, _CL=0) -> + []; +format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF, Enc, CL) when is_integer(A) -> + Cs = io_lib:fwrite(<<"~s~s ~ts ~ts">>, + [sep(N, S), origin(N, M, F, A), + mfa_to_string(M, F, A, Enc), + location(L)]), + CL1 = sub(CL, Cs, Enc), + [Cs | format_stacktrace2(S, Fs, N + 1, PF, Enc, CL1)]; +format_stacktrace2(S, [{M,F,As,_}|Fs], N, PF, Enc, CL) when is_list(As) -> A = length(As), CalledAs = [S,<<" called as ">>], - C = format_call("", CalledAs, {M,F}, As, PF, Enc), - [io_lib:fwrite(<<"~s~s ~ts\n~s~ts">>, - [sep(N, S), origin(N, M, F, A), - mfa_to_string(M, F, A, Enc), - CalledAs, C]) - | format_stacktrace2(S, Fs, N + 1, PF, Enc)]; -format_stacktrace2(_S, [], _N, _PF, _Enc) -> + C = format_call("", CalledAs, {M,F}, As, PF, Enc, CL), + Cs = io_lib:fwrite(<<"~s~s ~ts\n~s~ts">>, + [sep(N, S), origin(N, M, F, A), + mfa_to_string(M, F, A, Enc), + CalledAs, C]), + CL1 = sub(CL, Enc, Cs), + [Cs | format_stacktrace2(S, Fs, N + 1, PF, Enc, CL1)]; +format_stacktrace2(_S, [], _N, _PF, _Enc, _CL) -> "". location(L) -> @@ -264,22 +288,26 @@ origin(1, M, F, A) -> origin(_N, _M, _F, _A) -> <<"in call from">>. -format_errstr_call(ErrStr, Class, ForMForFun, As, PF, Pre0, Enc) -> +format_errstr_call(ErrStr, Class, ForMForFun, As, PF, Pre0, Enc, CL) -> Pre1 = [Pre0 | n_spaces(exited_size(Class))], - format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc). + format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc, CL). format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc) -> + format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc, -1). + +format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc, CL) -> Arity = length(As), [ErrStr | case is_op(ForMForFun, Arity) of {yes,Op} -> - format_op(ErrStr, Pre1, Op, As, PF, Enc); + format_op(ErrStr, Pre1, Op, As, PF, Enc, CL); no -> MFs = mf_to_string(ForMForFun, Arity, Enc), I1 = string:length([Pre1,ErrStr|MFs]), - S1 = pp_arguments(PF, As, I1, Enc), - S2 = pp_arguments(PF, As, string:length([Pre1|MFs]), Enc), - Long = count_nl(pp_arguments(PF, [a2345,b2345], I1, Enc)) > 0, + S1 = pp_arguments(PF, As, I1, Enc, CL), + S2 = pp_arguments(PF, As, string:length([Pre1|MFs]), Enc, CL), + S3 = pp_arguments(PF, [a2345,b2345], I1, Enc, CL), + Long = count_nl(S3) > 0, case Long or (count_nl(S2) < count_nl(S1)) of true -> [$\n, Pre1, MFs, S2]; @@ -288,14 +316,15 @@ format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc) -> end end]. -format_op(ErrStr, Pre, Op, [A1], PF, _Enc) -> +format_op(ErrStr, Pre, Op, [A1], PF, _Enc, CL) -> OpS = io_lib:fwrite(<<"~s ">>, [Op]), I1 = iolist_size([ErrStr,Pre,OpS]), - [OpS | PF(A1, I1+1)]; -format_op(ErrStr, Pre, Op, [A1, A2], PF, Enc) -> + {S, _} = PF(A1, I1+1, CL), + [OpS | S]; +format_op(ErrStr, Pre, Op, [A1, A2], PF, Enc, CL) -> I1 = iolist_size([ErrStr,Pre]), - S1 = PF(A1, I1+1), - S2 = PF(A2, I1+1), + {S1, CL1} = PF(A1, I1+1, CL), + {S2, _} = PF(A2, I1+1, CL1), OpS = atom_to_list(Op), Pre1 = [$\n | n_spaces(I1)], case count_nl(S1) > 0 of @@ -304,26 +333,28 @@ format_op(ErrStr, Pre, Op, [A1, A2], PF, Enc) -> false -> OpS2 = io_lib:fwrite(<<" ~s ">>, [Op]), Size1 = iolist_size([ErrStr,Pre|OpS2]), - {Size2,S1_2} = size(Enc, S1), - S2_2 = PF(A2, Size1+Size2+1), + Size2 = size(Enc, S1), + {S2_2, _} = PF(A2, Size1+Size2+1, CL1), case count_nl(S2) < count_nl(S2_2) of true -> - [S1_2,Pre1,OpS,Pre1|S2]; + [S1,Pre1,OpS,Pre1|S2]; false -> - [S1_2,OpS2|S2_2] + [S1,OpS2|S2_2] end end. -pp_arguments(PF, As, I, Enc) -> +pp_arguments(PF, As, I, Enc, CL) -> case {As, printable_list(Enc, As)} of {[Int | T], true} -> L = integer_to_list(Int), Ll = length(L), A = list_to_atom(lists:duplicate(Ll, $a)), - S0 = unicode:characters_to_list(PF([A | T], I+1), Enc), - brackets_to_parens([$[,L,string:slice(S0, 1+Ll)], Enc); + {S0, _} = PF([A | T], I+1, CL), + S = unicode:characters_to_list(S0, Enc), + brackets_to_parens([$[,L,string:slice(S, 1+Ll)], Enc); _ -> - brackets_to_parens(PF(As, I+1), Enc) + {S, _CL1} = PF(As, I+1, CL), + brackets_to_parens(S, Enc) end. brackets_to_parens(S, Enc) -> @@ -361,12 +392,12 @@ mf_to_string(F, _A, Enc) -> FS = to_string(F, Enc), io_lib:fwrite(<<"~ts">>, [FS]). -format_value(V, ErrStr, Class, PF, S) -> +format_value(V, ErrStr, Class, PF, S, CL) -> Pre1Sz = exited_size(Class), - S1 = PF(V, Pre1Sz + iolist_size([S, ErrStr])+1), + {S1, _} = PF(V, Pre1Sz + iolist_size([S, ErrStr]) + 1, CL), [ErrStr | case count_nl(S1) of N1 when N1 > 1 -> - S2 = PF(V, iolist_size(S) + 1 + Pre1Sz), + {S2, _} = PF(V, iolist_size(S) + 1 + Pre1Sz, CL), case count_nl(S2) < N1 of true -> [$\n, S, n_spaces(Pre1Sz) | S2]; @@ -413,9 +444,17 @@ to_string(A, latin1) -> to_string(A, _) -> io_lib:write_atom(A). +%% Make sure T does change sign. +sub(T, _, _Enc) when T < 0 -> T; +sub(T, S, Enc) -> + sub(T, size(Enc, S)). + +sub(T, Sz) when T >= Sz -> + T - Sz; +sub(_T, _Sz) -> + 0. + size(latin1, S) -> - {iolist_size(S),S}; -size(_, S0) -> - S = unicode:characters_to_list(S0, unicode), - true = is_list(S), - {string:length(S),S}. + iolist_size(S); +size(_, S) -> + string:length(S). diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 2066b2f60f..aa809ab05c 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -501,13 +501,13 @@ find_maxline(LC) -> hide_calls(LC, MaxLine) -> LineId0 = MaxLine + 1, - {NLC, _, D} = hide(LC, LineId0, dict:new()), + {NLC, _, D} = hide(LC, LineId0, maps:new()), {NLC, D}. %% v/1 and local calls are hidden. hide({value,L,V}, Id, D) -> A = erl_anno:new(Id), - {{atom,A,ok}, Id+1, dict:store(Id, {value,L,V}, D)}; + {{atom,A,ok}, Id+1, maps:put(Id, {value,L,V}, D)}; hide({call,L,{atom,_,N}=Atom,Args}, Id0, D0) -> {NArgs, Id, D} = hide(Args, Id0, D0), C = case erl_internal:bif(N, length(Args)) of @@ -517,7 +517,7 @@ hide({call,L,{atom,_,N}=Atom,Args}, Id0, D0) -> A = erl_anno:new(Id), {call,A,{remote,L,{atom,L,m},{atom,L,f}},NArgs} end, - {C, Id+1, dict:store(Id, {call,Atom}, D)}; + {C, Id+1, maps:put(Id, {call,Atom}, D)}; hide(T0, Id0, D0) when is_tuple(T0) -> {L, Id, D} = hide(tuple_to_list(T0), Id0, D0), {list_to_tuple(L), Id, D}; @@ -532,7 +532,7 @@ unhide_calls({atom,A,ok}=E, MaxLine, D) -> L = erl_anno:line(A), if L > MaxLine -> - dict:fetch(L, D); + map_get(L, D); true -> E end; @@ -540,7 +540,7 @@ unhide_calls({call,A,{remote,L,{atom,L,m},{atom,L,f}}=F,Args}, MaxLine, D) -> Line = erl_anno:line(A), if Line > MaxLine -> - {call,Atom} = dict:fetch(Line, D), + {call,Atom} = map_get(Line, D), {call,L,Atom,unhide_calls(Args, MaxLine, D)}; true -> {call,A,F,unhide_calls(Args, MaxLine, D)} @@ -1163,9 +1163,19 @@ match1({map,_,Fs}, #{}=Map, Bs, BBs) -> match1({map,_,_}, _, _Bs, _BBs) -> throw(nomatch); match1({bin, _, Fs}, <<_/bitstring>>=B, Bs0, BBs) -> - eval_bits:match_bits(Fs, B, Bs0, BBs, - match_fun(BBs), - fun(E, Bs) -> expr(E, Bs, none, none, none) end); + EvalFun = fun(E, Bs) -> + case erl_lint:is_guard_expr(E) of + true -> ok; + false -> throw(invalid) + end, + try + expr(E, Bs, none, none, none) + catch + error:{unbound, _} -> + throw(invalid) + end + end, + eval_bits:match_bits(Fs, B, Bs0, BBs, match_fun(BBs), EvalFun); match1({bin,_,_}, _, _Bs, _BBs) -> throw(nomatch); match1({op,_,'++',{nil,_},R}, Term, Bs, BBs) -> diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index d7bd15d9db..5351490b1a 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -797,9 +797,13 @@ is_simple_val(Val) -> pattern_bin(Es0, St) -> foldr(fun (E, Acc) -> pattern_element(E, Acc) end, {[],St}, Es0). -pattern_element({bin_element,Line,Expr0,Size,Type}, {Es,St0}) -> +pattern_element({bin_element,Line,Expr0,Size0,Type}, {Es,St0}) -> {Expr,St1} = pattern(Expr0, St0), - {[{bin_element,Line,Expr,Size,Type} | Es],St1}. + {Size,St2} = case Size0 of + default -> {Size0,St1}; + _ -> expr(Size0, St1) + end, + {[{bin_element,Line,Expr,Size,Type} | Es],St2}. %% expr_bin([Element], State) -> {[Element],State}. diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 939abaff00..f5059ac710 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -245,11 +245,14 @@ bif(M, F, A) when is_atom(M), is_atom(F), is_integer(A) -> false. bif(abs, 1) -> true; bif(apply, 2) -> true; bif(apply, 3) -> true; +bif(atom_to_binary, 1) -> true; bif(atom_to_binary, 2) -> true; bif(atom_to_list, 1) -> true; bif(binary_part, 2) -> true; bif(binary_part, 3) -> true; +bif(binary_to_atom, 1) -> true; bif(binary_to_atom, 2) -> true; +bif(binary_to_existing_atom, 1) -> true; bif(binary_to_existing_atom, 2) -> true; bif(binary_to_integer, 1) -> true; bif(binary_to_integer, 2) -> true; @@ -383,8 +386,16 @@ bif(spawn_link, 1) -> true; bif(spawn_link, 2) -> true; bif(spawn_link, 3) -> true; bif(spawn_link, 4) -> true; +bif(spawn_request, 1) -> true; +bif(spawn_request, 2) -> true; +bif(spawn_request, 3) -> true; +bif(spawn_request, 4) -> true; +bif(spawn_request, 5) -> true; +bif(spawn_request_abandon, 1) -> true; bif(spawn_monitor, 1) -> true; +bif(spawn_monitor, 2) -> true; bif(spawn_monitor, 3) -> true; +bif(spawn_monitor, 4) -> true; bif(spawn_opt, 2) -> true; bif(spawn_opt, 3) -> true; bif(spawn_opt, 4) -> true; @@ -393,6 +404,8 @@ bif(split_binary, 2) -> true; bif(statistics, 1) -> true; bif(term_to_binary, 1) -> true; bif(term_to_binary, 2) -> true; +bif(term_to_iovec, 1) -> true; +bif(term_to_iovec, 2) -> true; bif(throw, 1) -> true; bif(time, 0) -> true; bif(tl, 1) -> true; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 54b0fbd999..5163b0df1d 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -1,4 +1,4 @@ -%% -*- erlang-indent-level: 4 -*- +%%% -*- erlang-indent-level: 4 -*- %% %% %CopyrightBegin% %% @@ -33,6 +33,10 @@ -import(lists, [member/2,map/2,foldl/3,foldr/3,mapfoldl/3,all/2,reverse/1]). +%% Removed functions + +-removed([{modify_line,2,"use erl_parse:map_anno/2 instead"}]). + %% bool_option(OnOpt, OffOpt, Default, Options) -> boolean(). %% value_option(Flag, Default, Options) -> Value. %% value_option(Flag, Default, OnOpt, OnVal, OffOpt, OffVal, Options) -> @@ -81,17 +85,19 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> -type module_or_mfa() :: module() | mfa(). +-type gexpr_context() :: 'guard' | 'bin_seg_size' | 'map_key'. + -record(typeinfo, {attr, line}). %% Usage of records, functions, and imports. The variable table, which %% is passed on as an argument, holds the usage of variables. -record(usage, { - calls = dict:new(), %Who calls who + calls = maps:new(), %Who calls who imported = [], %Actually imported functions - used_records = sets:new() %Used record definitions - :: sets:set(atom()), - used_types = dict:new() %Used type definitions - :: dict:dict(ta(), line()) + used_records = gb_sets:new() %Used record definitions + :: gb_sets:set(atom()), + used_types = maps:new() %Used type definitions + :: #{ta() := line()} }). @@ -104,8 +110,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> exports=gb_sets:empty() :: gb_sets:set(fa()),%Exports imports=[] :: orddict:orddict(fa(), module()),%Imports compile=[], %Compile flags - records=dict:new() %Record definitions - :: dict:dict(atom(), {line(),Fields :: term()}), + records=maps:new() %Record definitions + :: #{atom() => {line(),Fields :: term()}}, locals=gb_sets:empty() %All defined functions (prescanned) :: gb_sets:set(fa()), no_auto=gb_sets:empty() %Functions explicitly not autoimported @@ -131,17 +137,20 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> xqlc= false :: boolean(), %true if qlc.hrl included called= [] :: [{fa(),line()}], %Called functions usage = #usage{} :: #usage{}, - specs = dict:new() %Type specifications - :: dict:dict(mfa(), line()), - callbacks = dict:new() %Callback types - :: dict:dict(mfa(), line()), - optional_callbacks = dict:new() %Optional callbacks - :: dict:dict(mfa(), line()), - types = dict:new() %Type definitions - :: dict:dict(ta(), #typeinfo{}), + specs = maps:new() %Type specifications + :: #{mfa() => line()}, + callbacks = maps:new() %Callback types + :: #{mfa() => line()}, + optional_callbacks = maps:new() %Optional callbacks + :: #{mfa() => line()}, + types = maps:new() %Type definitions + :: #{ta() => #typeinfo{}}, exp_types=gb_sets:empty() %Exported types :: gb_sets:set(ta()), - in_try_head=false :: boolean() %In a try head. + in_try_head=false :: boolean(), %In a try head. + bvt = none :: 'none' | [any()], %Variables in binary pattern + gexpr_context = guard %Context of guard expression + :: gexpr_context() }). -type lint_state() :: #lint{}. @@ -183,6 +192,14 @@ format_error({invalid_deprecated,D}) -> format_error({bad_deprecated,{F,A}}) -> io_lib:format("deprecated function ~tw/~w undefined or not exported", [F,A]); +format_error({invalid_removed,D}) -> + io_lib:format("badly formed removed attribute ~tw", [D]); +format_error({bad_removed,{F,A}}) when F =:= '_'; A =:= '_' -> + io_lib:format("at least one function matching ~tw/~w is still exported", + [F,A]); +format_error({bad_removed,{F,A}}) -> + io_lib:format("removed function ~tw/~w is still exported", + [F,A]); format_error({bad_nowarn_unused_function,{F,A}}) -> io_lib:format("function ~tw/~w undefined", [F,A]); format_error({bad_nowarn_bif_clash,{F,A}}) -> @@ -231,18 +248,18 @@ format_error({redefine_bif_import,{F,A}}) -> format_error({deprecated, MFA, ReplacementMFA, Rel}) -> io_lib:format("~s is deprecated and will be removed in ~s; use ~s", [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); -format_error({deprecated, {M1, F1, A1}, String}) when is_list(String) -> - io_lib:format("~p:~p/~p: ~s", [M1, F1, A1, String]); +format_error({deprecated, MFA, String}) when is_list(String) -> + io_lib:format("~s is deprecated; ~s", [format_mfa(MFA), String]); format_error({deprecated_type, {M1, F1, A1}, String}) when is_list(String) -> - io_lib:format("~p:~p~s: ~s", [M1, F1, gen_type_paren(A1), String]); + io_lib:format("the type ~p:~p~s is deprecated; ~s", + [M1, F1, gen_type_paren(A1), String]); format_error({removed, MFA, ReplacementMFA, Rel}) -> io_lib:format("call to ~s will fail, since it was removed in ~s; " "use ~s", [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); format_error({removed, MFA, String}) when is_list(String) -> - io_lib:format("~s: ~s", [format_mfa(MFA), String]); -format_error({removed_type, MNA, ReplacementMNA, Rel}) -> - io_lib:format("the type ~s was removed in ~s; use ~s instead", - [format_mna(MNA), Rel, format_mna(ReplacementMNA)]); + io_lib:format("~s is removed; ~s", [format_mfa(MFA), String]); +format_error({removed_type, MNA, String}) -> + io_lib:format("the type ~s is removed; ~s", [format_mna(MNA), String]); format_error({obsolete_guard, {F, A}}) -> io_lib:format("~p/~p obsolete (use is_~p/~p)", [F, A, F, A]); format_error({obsolete_guard_overridden,Test}) -> @@ -313,6 +330,13 @@ format_error(bittype_unit) -> "a bit unit size must not be specified unless a size is specified too"; format_error(illegal_bitsize) -> "illegal bit size"; +format_error({illegal_bitsize_local_call, {F,A}}) -> + io_lib:format("call to local/imported function ~tw/~w is illegal in a size " + "expression for a binary segment", + [F,A]); +format_error(non_integer_bitsize) -> + "a size expression in a pattern evaluates to a non-integer value; " + "this pattern cannot possibly match"; format_error(unsized_binary_not_at_end) -> "a binary field without size is only allowed at the end of a binary pattern"; format_error(typed_literal_string) -> @@ -591,7 +615,7 @@ start(File, Opts) -> Enabled = ordsets:from_list(Enabled1), Calls = case ordsets:is_element(unused_function, Enabled) of true -> - dict:from_list([{{module_info,1},pseudolocals()}]); + maps:from_list([{{module_info,1},pseudolocals()}]); false -> undefined end, @@ -647,7 +671,14 @@ pack_warnings(Ws) -> add_error(E, St) -> add_lint_error(E, St#lint.file, St). -add_error(Anno, E, St) -> +add_error(Anno, E0, #lint{gexpr_context=Context}=St) -> + E = case {E0,Context} of + {illegal_guard_expr,bin_seg_size} -> + illegal_bitsize; + {{illegal_guard_local_call,FA},bin_seg_size} -> + {illegal_bitsize_local_call,FA}; + {_,_} -> E0 + end, {File,Location} = loc(Anno, St), add_lint_error({Location,erl_lint,E}, File, St). @@ -918,7 +949,8 @@ post_traversal_check(Forms, St0) -> StE = check_unused_records(Forms, StD), StF = check_local_opaque_types(StE), StG = check_dialyzer_attribute(Forms, StF), - check_callback_information(StG). + StH = check_callback_information(StG), + check_removed(Forms, StH). %% check_behaviour(State0) -> State %% Check that the behaviour attribute is valid. @@ -1030,7 +1062,7 @@ check_deprecated(Forms, St0) -> true -> St0#lint.defined; false -> St0#lint.exports end, - X = gb_sets:to_list(Exports), + X = ignore_predefined_funcs(gb_sets:to_list(Exports)), #lint{module = Mod} = St0, Bad = [{E,L} || {attribute, L, deprecated, Depr} <- Forms, D <- lists:flatten([Depr]), @@ -1074,7 +1106,80 @@ depr_fa(F, A, _X, _Mod) -> deprecated_flag(next_version) -> true; deprecated_flag(next_major_release) -> true; deprecated_flag(eventually) -> true; -deprecated_flag(_) -> false. +deprecated_flag(String) -> deprecated_desc(String). + +deprecated_desc([Char | Str]) when is_integer(Char) -> deprecated_desc(Str); +deprecated_desc([]) -> true; +deprecated_desc(_) -> false. + +%% check_removed(Forms, State0) -> State + +check_removed(Forms, St0) -> + %% Get the correct list of exported functions. + Exports = case member(export_all, St0#lint.compile) of + true -> St0#lint.defined; + false -> St0#lint.exports + end, + X = ignore_predefined_funcs(gb_sets:to_list(Exports)), + #lint{module = Mod} = St0, + Bad = [{E,L} || {attribute, L, removed, Removed} <- Forms, + R <- lists:flatten([Removed]), + E <- removed_cat(R, X, Mod)], + foldl(fun ({E,L}, St1) -> + add_error(L, E, St1) + end, St0, Bad). + +removed_cat({F, A, Desc}=R, X, Mod) -> + case removed_desc(Desc) of + false -> [{invalid_removed,R}]; + true -> removed_fa(F, A, X, Mod) + end; +removed_cat({F, A}, X, Mod) -> + removed_fa(F, A, X, Mod); +removed_cat(module, X, Mod) -> + removed_fa('_', '_', X, Mod); +removed_cat(R, _X, _Mod) -> + [{invalid_removed,R}]. + +removed_fa('_', '_', X, _Mod) -> + case X of + [_|_] -> [{bad_removed,{'_','_'}}]; + [] -> [] + end; +removed_fa(F, '_', X, _Mod) when is_atom(F) -> + %% Don't use this syntax for built-in functions. + case lists:filter(fun({F1,_}) -> F1 =:= F end, X) of + [_|_] -> [{bad_removed,{F,'_'}}]; + _ -> [] + end; +removed_fa(F, A, X, Mod) when is_atom(F), is_integer(A), A >= 0 -> + case lists:member({F,A}, X) of + true -> + [{bad_removed,{F,A}}]; + false -> + case erlang:is_builtin(Mod, F, A) of + true -> [{bad_removed,{F,A}}]; + false -> [] + end + end; +removed_fa(F, A, _X, _Mod) -> + [{invalid_removed,{F,A}}]. + +removed_desc([Char | Str]) when is_integer(Char) -> removed_desc(Str); +removed_desc([]) -> true; +removed_desc(_) -> false. + +%% Ignores functions added by erl_internal:add_predefined_functions/1 +ignore_predefined_funcs([{behaviour_info,1} | Fs]) -> + ignore_predefined_funcs(Fs); +ignore_predefined_funcs([{module_info,0} | Fs]) -> + ignore_predefined_funcs(Fs); +ignore_predefined_funcs([{module_info,1} | Fs]) -> + ignore_predefined_funcs(Fs); +ignore_predefined_funcs([Other | Fs]) -> + [Other | ignore_predefined_funcs(Fs)]; +ignore_predefined_funcs([]) -> + []. %% check_imports(Forms, State0) -> State @@ -1134,7 +1239,7 @@ reached_functions([R|Rs], More0, Ref, Reached0) -> true -> reached_functions(Rs, More0, Ref, Reached0); false -> Reached = gb_sets:add_element(R, Reached0), %It IS reached - case dict:find(R, Ref) of + case maps:find(R, Ref) of {ok,More} -> reached_functions(Rs, [More|More0], Ref, Reached); error -> reached_functions(Rs, More0, Ref, Reached) end @@ -1157,10 +1262,10 @@ check_undefined_functions(#lint{called=Called0,defined=Def0}=St0) -> check_undefined_types(#lint{usage=Usage,types=Def}=St0) -> Used = Usage#usage.used_types, - UTAs = dict:fetch_keys(Used), - Undef = [{TA,dict:fetch(TA, Used)} || + UTAs = maps:keys(Used), + Undef = [{TA,map_get(TA, Used)} || TA <- UTAs, - not dict:is_key(TA, Def), + not is_map_key(TA, Def), not is_default_type(TA)], foldl(fun ({TA,L}, St) -> add_error(L, {undefined_type,TA}, St) @@ -1199,7 +1304,7 @@ check_untyped_records(Forms, St0) -> case is_warn_enabled(untyped_record, St0) of true -> %% Use the names of all records *defined* in the module (not used) - RecNames = dict:fetch_keys(St0#lint.records), + RecNames = maps:keys(St0#lint.records), %% these are the records with field(s) containing type info TRecNames = [Name || {attribute,_,record,{Name,Fields}} <- Forms, @@ -1207,7 +1312,7 @@ check_untyped_records(Forms, St0) -> (_) -> false end, Fields)], foldl(fun (N, St) -> - {L, Fields} = dict:fetch(N, St0#lint.records), + {L, Fields} = map_get(N, St0#lint.records), case Fields of [] -> St; % exclude records with no fields [_|_] -> add_warning(L, {untyped_record, N}, St) @@ -1225,12 +1330,12 @@ check_unused_records(Forms, St0) -> %% The check is a bit imprecise in that uses from unused %% functions count. Usage = St0#lint.usage, - UsedRecords = sets:to_list(Usage#usage.used_records), - URecs = foldl(fun (Used, Recs) -> - dict:erase(Used, Recs) - end, St0#lint.records, UsedRecords), + UsedRecords = Usage#usage.used_records, + URecs = gb_sets:fold(fun (Used, Recs) -> + maps:remove(Used, Recs) + end, St0#lint.records, UsedRecords), Unused = [{Name,FileLine} || - {Name,{FileLine,_Fields}} <- dict:to_list(URecs), + {Name,{FileLine,_Fields}} <- maps:to_list(URecs), element(1, loc(FileLine, St0)) =:= FirstFile], foldl(fun ({N,L}, St) -> add_warning(L, {unused_record, N}, St) @@ -1242,27 +1347,26 @@ check_unused_records(Forms, St0) -> check_callback_information(#lint{callbacks = Callbacks, optional_callbacks = OptionalCbs, defined = Defined} = St0) -> - OptFun = fun({MFA, Line}, St) -> - case dict:is_key(MFA, Callbacks) of + OptFun = fun(MFA, Line, St) -> + case is_map_key(MFA, Callbacks) of true -> St; false -> add_error(Line, {undefined_callback, MFA}, St) end end, - St1 = lists:foldl(OptFun, St0, dict:to_list(OptionalCbs)), + St1 = maps:fold(OptFun, St0, OptionalCbs), case gb_sets:is_member({behaviour_info, 1}, Defined) of false -> St1; true -> - case dict:size(Callbacks) of + case map_size(Callbacks) of 0 -> St1; _ -> - CallbacksList = dict:to_list(Callbacks), - FoldL = - fun({Fa, Line}, St) -> + FoldFun = + fun(Fa, Line, St) -> add_error(Line, {behaviour_info, Fa}, St) end, - lists:foldl(FoldL, St1, CallbacksList) + maps:fold(FoldFun, St1, Callbacks) end end. @@ -1300,7 +1404,7 @@ export_type(Line, ETs, #lint{usage = Usage, exp_types = ETs0} = St0) -> false -> St2 end, - {gb_sets:add_element(TA, E), dict:store(TA, Line, U), St} + {gb_sets:add_element(TA, E), maps:put(TA, Line, U), St} end, {ETs0,UTs0,St0}, ETs) of {ETs1,UTs1,St1} -> @@ -1430,7 +1534,7 @@ call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func,file=File}=St) NA = {F,A}, Usage = case Cs of undefined -> Usage0; - _ -> Usage0#usage{calls=dict:append(Func, NA, Cs)} + _ -> Usage0#usage{calls=maps_prepend(Func, NA, Cs)} end, Anno = erl_anno:set_file(File, Line), St#lint{called=[{NA,Anno}|Cd], usage=Usage}. @@ -1541,7 +1645,7 @@ pattern({record_index,Line,Name,Field}, _Vt, _Old, _Bvt, St) -> end), {Vt1,[],St1}; pattern({record,Line,Name,Pfs}, Vt, Old, Bvt, St) -> - case dict:find(Name, St#lint.records) of + case maps:find(Name, St#lint.records) of {ok,{_Line,Fields}} -> St1 = used_record(Name, St), pattern_fields(Pfs, Name, Fields, Vt, Old, Bvt, St1); @@ -1625,10 +1729,10 @@ reject_invalid_alias({tuple,_,Es1}, {tuple,_,Es2}, Vt, St) -> reject_invalid_alias_list(Es1, Es2, Vt, St); reject_invalid_alias({record,_,Name1,Pfs1}, {record,_,Name2,Pfs2}, Vt, #lint{records=Recs}=St) -> - case {dict:find(Name1, Recs),dict:find(Name2, Recs)} of - {{ok,{_Line1,Fields1}},{ok,{_Line2,Fields2}}} -> + case Recs of + #{Name1 := {_Line1,Fields1}, Name2 := {_Line2,Fields2}} -> reject_invalid_alias_rec(Pfs1, Pfs2, Fields1, Fields2, Vt, St); - {_,_} -> + #{} -> %% One or more non-existing records. (An error messages has %% already been generated, so we are done here.) St @@ -1706,19 +1810,16 @@ is_pattern_expr_1({op,_Line,Op,A1,A2}) -> is_pattern_expr_1(_Other) -> false. pattern_map(Ps, Vt, Old, Bvt, St) -> - foldl(fun - ({map_field_assoc,L,_,_}, {Psvt,Bvt0,St0}) -> - {Psvt,Bvt0,add_error(L, illegal_pattern, St0)}; - ({map_field_exact,L,K,V}, {Psvt,Bvt0,St0}) -> - case is_valid_map_key(K) of - true -> - {Kvt,St1} = expr(K, Vt, St0), - {Vvt,Bvt2,St2} = pattern(V, Vt, Old, Bvt, St1), - {vtmerge_pat(vtmerge_pat(Kvt, Vvt), Psvt), vtmerge_pat(Bvt0, Bvt2), St2}; - false -> - {Psvt,Bvt0,add_error(L, illegal_map_key, St0)} - end - end, {[],[],St}, Ps). + foldl(fun({map_field_assoc,L,_,_}, {Psvt,Bvt0,St0}) -> + {Psvt,Bvt0,add_error(L, illegal_pattern, St0)}; + ({map_field_exact,_L,K,V}, {Psvt,Bvt0,St0}) -> + St1 = St0#lint{gexpr_context=map_key}, + {Kvt,St2} = gexpr(K, Vt, St1), + {Vvt,Bvt2,St3} = pattern(V, Vt, Old, Bvt, St2), + {vtmerge_pat(vtmerge_pat(Kvt, Vvt), Psvt), + vtmerge_pat(Bvt0, Bvt2), + St3} + end, {[],[],St}, Ps). %% pattern_bin([Element], VarTable, Old, BinVarTable, State) -> %% {UpdVarTable,UpdBinVarTable,State}. @@ -1787,21 +1888,41 @@ pat_bit_expr(P, _Old, _Bvt, St) -> %% Check pattern size expression, only allow really valid sizes! pat_bit_size(default, _Vt, _Bvt, St) -> {default,[],[],St}; -pat_bit_size({atom,_Line,all}, _Vt, _Bvt, St) -> {all,[],[],St}; pat_bit_size({var,Lv,V}, Vt0, Bvt0, St0) -> {Vt,Bvt,St1} = pat_binsize_var(V, Lv, Vt0, Bvt0, St0), {unknown,Vt,Bvt,St1}; -pat_bit_size(Size, _Vt, _Bvt, St) -> +pat_bit_size(Size, Vt0, Bvt0, St0) -> Line = element(2, Size), - case is_pattern_expr(Size) of - true -> - case erl_eval:partial_eval(Size) of - {integer,Line,I} -> {I,[],[],St}; - _Other -> {unknown,[],[],add_error(Line, illegal_bitsize, St)} - end; - false -> {unknown,[],[],add_error(Line, illegal_bitsize, St)} + case erl_eval:partial_eval(Size) of + {integer,Line,I} -> {I,[],[],St0}; + Expr -> + %% The size is an expression using operators + %% and/or guard BIFs calls. If the expression + %% happens to evaluate to a non-integer value, the + %% pattern will fail to match. + St1 = St0#lint{bvt=Bvt0,gexpr_context=bin_seg_size}, + {Vt,#lint{bvt=Bvt}=St2} = gexpr(Size, Vt0, St1), + St3 = St2#lint{bvt=none,gexpr_context=St0#lint.gexpr_context}, + St = case is_bit_size_illegal(Expr) of + true -> + %% The size is a non-integer literal or a simple + %% expression that does not evaluate to an + %% integer value. Issue a warning. + add_warning(Line, non_integer_bitsize, St3); + false -> St3 + end, + {unknown,Vt,Bvt,St} end. +is_bit_size_illegal({atom,_,_}) -> true; +is_bit_size_illegal({bin,_,_}) -> true; +is_bit_size_illegal({cons,_,_,_}) -> true; +is_bit_size_illegal({float,_,_}) -> true; +is_bit_size_illegal({map,_,_}) -> true; +is_bit_size_illegal({nil,_}) -> true; +is_bit_size_illegal({tuple,_,_}) -> true; +is_bit_size_illegal(_) -> false. + %% expr_bin(Line, [Element], VarTable, State, CheckFun) -> {UpdVarTable,State}. %% Check an expression group. @@ -2067,7 +2188,7 @@ gexpr_list(Es, Vt, St) -> Expr :: erl_parse:abstract_expr(). is_guard_test(E) -> - is_guard_test2(E, {dict:new(),fun(_) -> false end}). + is_guard_test2(E, {maps:new(),fun(_) -> false end}). %% is_guard_test(Expression, Forms) -> boolean(). is_guard_test(Expression, Forms) -> @@ -2115,7 +2236,7 @@ is_guard_test2(G, Info) -> %% is_guard_expr(Expression) -> boolean(). %% Test if an expression is a guard expression. -is_guard_expr(E) -> is_gexpr(E, []). +is_guard_expr(E) -> is_gexpr(E, {[],fun({_,_}) -> false end}). is_gexpr({var,_L,_V}, _Info) -> true; is_gexpr({char,_L,_C}, _Info) -> true; @@ -2183,7 +2304,7 @@ is_map_fields([], _Info) -> true; is_map_fields(_T, _Info) -> false. is_gexpr_fields(Fs, L, Name, {RDs,_}=Info) -> - IFs = case dict:find(Name, RDs) of + IFs = case maps:find(Name, RDs) of {ok,{_Line,Fields}} -> Fs ++ init_fields(Fs, L, Fields); error -> Fs end, @@ -2510,73 +2631,16 @@ is_valid_call(Call) -> _ -> true end. -%% is_valid_map_key(K) -> true | false -%% variables are allowed for patterns only at the top of the tree - -is_valid_map_key({var,_,_}) -> true; -is_valid_map_key(K) -> is_valid_map_key_value(K). -is_valid_map_key_value(K) -> - case K of - {var,_,_} -> false; - {char,_,_} -> true; - {integer,_,_} -> true; - {float,_,_} -> true; - {string,_,_} -> true; - {nil,_} -> true; - {atom,_,_} -> true; - {cons,_,H,T} -> - is_valid_map_key_value(H) andalso - is_valid_map_key_value(T); - {tuple,_,Es} -> - foldl(fun(E,B) -> - B andalso is_valid_map_key_value(E) - end,true,Es); - {map,_,Arg,Ps} -> - % only check for value expressions to be valid - % invalid map expressions are later checked in - % core and kernel - is_valid_map_key_value(Arg) andalso foldl(fun - ({Tag,_,Ke,Ve},B) when Tag =:= map_field_assoc; - Tag =:= map_field_exact -> - B andalso is_valid_map_key_value(Ke) - andalso is_valid_map_key_value(Ve); - (_,_) -> false - end,true,Ps); - {map,_,Ps} -> - foldl(fun - ({Tag,_,Ke,Ve},B) when Tag =:= map_field_assoc; - Tag =:= map_field_exact -> - B andalso is_valid_map_key_value(Ke) - andalso is_valid_map_key_value(Ve); - (_,_) -> false - end, true, Ps); - {record,_,_,Fs} -> - foldl(fun - ({record_field,_,Ke,Ve},B) -> - B andalso is_valid_map_key_value(Ke) - andalso is_valid_map_key_value(Ve) - end,true,Fs); - {bin,_,Es} -> - % only check for value expressions to be valid - % invalid binary expressions are later checked in - % core and kernel - foldl(fun - ({bin_element,_,E,_,_},B) -> - B andalso is_valid_map_key_value(E) - end,true,Es); - Val -> is_pattern_expr(Val) - end. - %% record_def(Line, RecordName, [RecField], State) -> State. %% Add a record definition if it does not already exist. Normalise %% so that all fields have explicit initial value. record_def(Line, Name, Fs0, St0) -> - case dict:is_key(Name, St0#lint.records) of + case is_map_key(Name, St0#lint.records) of true -> add_error(Line, {redefine_record,Name}, St0); false -> {Fs1,St1} = def_fields(normalise_fields(Fs0), Name, St0), - St2 = St1#lint{records=dict:store(Name, {Line,Fs1}, + St2 = St1#lint{records=maps:put(Name, {Line,Fs1}, St1#lint.records)}, Types = [T || {typed_record_field, _, T} <- Fs0], check_type({type, nowarn(), product, Types}, St2) @@ -2627,7 +2691,7 @@ normalise_fields(Fs) -> %% Check if a record exists. Set State. exist_record(Line, Name, St) -> - case dict:is_key(Name, St#lint.records) of + case is_map_key(Name, St#lint.records) of true -> used_record(Name, St); false -> add_error(Line, {undefined_record,Name}, St) end. @@ -2644,13 +2708,13 @@ exist_record(Line, Name, St) -> %% {UpdatedVarTable,State} check_record(Line, Name, St, CheckFun) -> - case dict:find(Name, St#lint.records) of + case maps:find(Name, St#lint.records) of {ok,{_Line,Fields}} -> CheckFun(Fields, used_record(Name, St)); error -> {[],add_error(Line, {undefined_record,Name}, St)} end. used_record(Name, #lint{usage=Usage}=St) -> - UsedRecs = sets:add_element(Name, Usage#usage.used_records), + UsedRecs = gb_sets:add_element(Name, Usage#usage.used_records), St#lint{usage = Usage#usage{used_records=UsedRecs}}. %%% Record check functions. @@ -2791,7 +2855,7 @@ type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> Info = #typeinfo{attr = Attr, line = Line}, StoreType = fun(St) -> - NewDefs = dict:store(TypePair, Info, TypeDefs), + NewDefs = maps:put(TypePair, Info, TypeDefs), CheckType = {type, nowarn(), product, [ProtoType|Args]}, check_type(CheckType, St#lint{types=NewDefs}) end, @@ -2811,7 +2875,7 @@ type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> end end; false -> - case dict:is_key(TypePair, TypeDefs) of + case is_map_key(TypePair, TypeDefs) of true -> add_error(Line, {redefine_type, TypePair}, St0); false -> @@ -2833,8 +2897,8 @@ is_underspecified({type,_,any,[]}, 0) -> true; is_underspecified(_ProtType, _Arity) -> false. check_type(Types, St) -> - {SeenVars, St1} = check_type(Types, dict:new(), St), - dict:fold(fun(Var, {seen_once, Line}, AccSt) -> + {SeenVars, St1} = check_type(Types, maps:new(), St), + maps:fold(fun(Var, {seen_once, Line}, AccSt) -> case atom_to_list(Var) of "_"++_ -> AccSt; _ -> add_error(Line, {singleton_typevar, Var}, AccSt) @@ -2862,10 +2926,10 @@ check_type({atom, _L, _}, SeenVars, St) -> {SeenVars, St}; check_type({var, _L, '_'}, SeenVars, St) -> {SeenVars, St}; check_type({var, L, Name}, SeenVars, St) -> NewSeenVars = - case dict:find(Name, SeenVars) of - {ok, {seen_once, _}} -> dict:store(Name, seen_multiple, SeenVars); + case maps:find(Name, SeenVars) of + {ok, {seen_once, _}} -> maps:put(Name, seen_multiple, SeenVars); {ok, seen_multiple} -> SeenVars; - error -> dict:store(Name, {seen_once, L}, SeenVars) + error -> maps:put(Name, {seen_once, L}, SeenVars) end, {NewSeenVars, St}; check_type({type, L, bool, []}, SeenVars, St) -> @@ -2924,7 +2988,7 @@ check_type({type, La, TypeName, Args}, SeenVars, St) -> andalso obsolete_builtin_type(TypePair)), St1 = case Obsolete of {deprecated, Repl, _} when element(1, Repl) =/= Module -> - case dict:find(TypePair, Types) of + case maps:find(TypePair, Types) of {ok, _} -> used_type(TypePair, La, St); error -> @@ -2953,7 +3017,7 @@ check_type(I, SeenVars, St) -> end. check_record_types(Line, Name, Fields, SeenVars, St) -> - case dict:find(Name, St#lint.records) of + case maps:find(Name, St#lint.records) of {ok,{_L,DefFields}} -> case lists:all(fun({type, _, field_type, _}) -> true; (_) -> false @@ -2988,7 +3052,7 @@ check_record_types([], _Name, _DefFields, SeenVars, St, _SeenFields) -> used_type(TypePair, L, #lint{usage = Usage, file = File} = St) -> OldUsed = Usage#usage.used_types, - UsedTypes = dict:store(TypePair, erl_anno:set_file(File, L), OldUsed), + UsedTypes = maps:put(TypePair, erl_anno:set_file(File, L), OldUsed), St#lint{usage=Usage#usage{used_types=UsedTypes}}. is_default_type({Name, NumberOfTypeVariables}) -> @@ -3012,8 +3076,8 @@ spec_decl(Line, MFA0, TypeSpecs, St00 = #lint{specs = Specs, module = Mod}) -> {_M, _F, Arity} -> MFA0 end, St0 = check_module_name(element(1, MFA), Line, St00), - St1 = St0#lint{specs = dict:store(MFA, Line, Specs)}, - case dict:is_key(MFA, Specs) of + St1 = St0#lint{specs = maps:put(MFA, Line, Specs)}, + case is_map_key(MFA, Specs) of true -> add_error(Line, {redefine_spec, MFA0}, St1); false -> case MFA of @@ -3034,8 +3098,8 @@ callback_decl(Line, MFA0, TypeSpecs, add_error(Line, {bad_callback, MFA0}, St1); {F, Arity} -> MFA = {Mod, F, Arity}, - St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, - case dict:is_key(MFA, Callbacks) of + St1 = St0#lint{callbacks = maps:put(MFA, Line, Callbacks)}, + case is_map_key(MFA, Callbacks) of true -> add_error(Line, {redefine_callback, MFA0}, St1); false -> check_specs(TypeSpecs, callback_wrong_arity, Arity, St1) @@ -3058,8 +3122,8 @@ optional_cbs(_Line, [], St) -> optional_cbs(Line, [{F,A}|FAs], St0) -> #lint{optional_callbacks = OptionalCbs, module = Mod} = St0, MFA = {Mod, F, A}, - St1 = St0#lint{optional_callbacks = dict:store(MFA, Line, OptionalCbs)}, - St2 = case dict:is_key(MFA, OptionalCbs) of + St1 = St0#lint{optional_callbacks = maps:put(MFA, Line, OptionalCbs)}, + St2 = case is_map_key(MFA, OptionalCbs) of true -> add_error(Line, {redefine_optional_callback, {F,A}}, St1); false -> @@ -3119,7 +3183,7 @@ check_specs_without_function(#lint{module=Mod,defined=Funcs,specs=Specs}=St) -> end; ({_M, _F, _A}, _Line, AccSt) -> AccSt end, - dict:fold(Fun, St, Specs). + maps:fold(Fun, St, Specs). %% This generates warnings for functions without specs; if the user has %% specified both options, we do not generate the same warnings twice. @@ -3137,7 +3201,7 @@ check_functions_without_spec(Forms, St0) -> end. add_missing_spec_warnings(Forms, St0, Type) -> - Specs = [{F,A} || {_M,F,A} <- dict:fetch_keys(St0#lint.specs)], + Specs = [{F,A} || {_M,F,A} <- maps:keys(St0#lint.specs)], Warns = %% functions + line numbers for which we should warn case Type of all -> @@ -3163,7 +3227,7 @@ check_unused_types_1(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> case [File || {attribute,_L,file,{File,_Line}} <- Forms] of [FirstFile|_] -> D = Usage#usage.used_types, - L = gb_sets:to_list(ExpTs) ++ dict:fetch_keys(D), + L = gb_sets:to_list(ExpTs) ++ maps:keys(D), UsedTypes = gb_sets:from_list(L), FoldFun = fun({{record, _}=_Type, 0}, _, AccSt) -> @@ -3182,7 +3246,7 @@ check_unused_types_1(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> AccSt end end, - dict:fold(FoldFun, St, Ts); + maps:fold(FoldFun, St, Ts); [] -> St end. @@ -3200,7 +3264,7 @@ check_local_opaque_types(St) -> add_warning(FileLine, Warn, AccSt) end end, - dict:fold(FoldFun, St, Ts). + maps:fold(FoldFun, St, Ts). check_dialyzer_attribute(Forms, St0) -> Vals = [{L,V} || @@ -3444,7 +3508,7 @@ handle_generator(P,E,Vt,Uvt,St0) -> handle_bitstring_gen_pat({bin,_,Segments=[_|_]},St) -> case lists:last(Segments) of - {bin_element,Line,{var,_,_},default,Flags} when is_list(Flags) -> + {bin_element,Line,_,default,Flags} when is_list(Flags) -> case member(binary, Flags) orelse member(bytes, Flags) orelse member(bits, Flags) orelse member(bitstring, Flags) of true -> @@ -3590,7 +3654,13 @@ pat_binsize_var(V, Line, Vt, Bvt, St) -> %% exported vars are probably safe, warn only if warn_export_vars is %% set. -expr_var(V, Line, Vt, St) -> +expr_var(V, Line, Vt, #lint{bvt=none}=St) -> + do_expr_var(V, Line, Vt, St); +expr_var(V, Line, Vt0, #lint{bvt=Bvt0}=St0) when is_list(Bvt0) -> + {Vt,Bvt,St} = pat_binsize_var(V, Line, Vt0, Bvt0, St0), + {Vt,St#lint{bvt=vtmerge(Bvt0, Bvt)}}. + +do_expr_var(V, Line, Vt, St) -> case orddict:find(V, Vt) of {ok,{bound,_Usage,Ls}} -> {[{V,{bound,used,Ls}}],St}; @@ -3846,8 +3916,8 @@ deprecated_type(L, M, N, As, St) -> false -> St end; - {removed, Replacement, Rel} -> - add_warning(L, {removed_type, {M,N,NAs}, Replacement, Rel}, St); + {removed, String} -> + add_warning(L, {removed_type, {M,N,NAs}, String}, St); no -> St end. @@ -4122,3 +4192,13 @@ no_guard_bif_clash(St,{F,A}) -> is_imported_from_erlang(St#lint.imports,{F,A}) ) ). + +%% maps_prepend(Key, Value, Map) -> Map. + +maps_prepend(Key, Value, Map) -> + case maps:find(Key, Map) of + {ok, Values} -> + maps:put(Key, [Value|Values], Map); + error -> + maps:put(Key, [Value], Map) + end. diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 739f786321..eab8da4ab7 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -608,6 +608,13 @@ Erlang code. -export_type([abstract_clause/0, abstract_expr/0, abstract_form/0, abstract_type/0, form_info/0, error_info/0]). +%% The following types are exported because they are used by syntax_tools +-export_type([af_binelement/1, af_generator/0, af_remote_function/0]). + +%% Removed functions +-removed([{set_line,2,"use erl_anno:set_line/2"}, + {get_attributes,1,"erl_anno:{column,line,location,text}/1 instead"}, + {get_attribute,2,"erl_anno:{column,line,location,text}/1 instead"}]). %% Start of Abstract Format @@ -637,7 +644,7 @@ Erlang code. -type af_export() :: {'attribute', anno(), 'export', af_fa_list()}. --type af_import() :: {'attribute', anno(), 'import', af_fa_list()}. +-type af_import() :: {'attribute', anno(), 'import', {module(), af_fa_list()}}. -type af_fa_list() :: [{function_name(), arity()}]. @@ -1455,7 +1462,19 @@ abstract(List, A, E) when is_list(List) -> abstract(Tuple, A, E) when is_tuple(Tuple) -> {tuple,A,abstract_tuple_list(tuple_to_list(Tuple), A, E)}; abstract(Map, A, E) when is_map(Map) -> - {map,A,abstract_map_fields(maps:to_list(Map),A,E)}. + {map,A,abstract_map_fields(maps:to_list(Map),A,E)}; +abstract(Fun, A, E) when is_function(Fun) -> + case erlang:fun_info(Fun, type) of + {type, external} -> + Info = erlang:fun_info(Fun), + {module, M} = lists:keyfind(module, 1, Info), + {name, F} = lists:keyfind(name, 1, Info), + {arity, Arity} = lists:keyfind(arity, 1, Info), + {'fun', A, {function, + abstract(M, A, E), + abstract(F, A, E), + abstract(Arity, A, E)}} + end. abstract_list([H|T], String, A, E) -> case is_integer(H) andalso H >= 0 andalso E(H) of diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index daa172af50..c706a5c945 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -31,7 +31,8 @@ -import(erl_parse, [inop_prec/1,preop_prec/1,func_prec/0,max_prec/0, type_inop_prec/1, type_preop_prec/1]). --define(MAXLINE, 72). +-define(DEFAULT_LINEWIDTH, 72). +-define(DEFAULT_INDENT, 4). -type(hook_function() :: none | fun((Expr :: erl_parse:abstract_expr(), @@ -42,10 +43,13 @@ -type(option() :: {hook, hook_function()} | {encoding, latin1 | unicode | utf8} - | {quote_singleton_atom_types, boolean()}). + | {quote_singleton_atom_types, boolean()} + | {linewidth, pos_integer()} + | {indent, pos_integer()}). -type(options() :: hook_function() | [option()]). --record(pp, {value_fun, singleton_atom_type_fun, string_fun, char_fun}). +-record(pp, {value_fun, singleton_atom_type_fun, string_fun, char_fun, + linewidth=?DEFAULT_LINEWIDTH, indent=?DEFAULT_INDENT}). -record(options, {hook, encoding, opts}). @@ -208,10 +212,14 @@ options(Hook) -> state(Options) when is_list(Options) -> Quote = proplists:get_bool(quote_singleton_atom_types, Options), - case encoding(Options) of - latin1 -> latin1_state(Quote); - unicode -> unicode_state(Quote) - end; + State = + case encoding(Options) of + latin1 -> latin1_state(Quote); + unicode -> unicode_state(Quote) + end, + Indent = proplists:get_value(indent, Options, ?DEFAULT_INDENT), + LineWidth = proplists:get_value(linewidth, Options, ?DEFAULT_LINEWIDTH), + State#pp{indent=Indent, linewidth=LineWidth}; state(_Hook) -> latin1_state(false). @@ -1020,7 +1028,7 @@ f({seq,Before,After,Sep,LItems}, I0, ST, WT, PP) -> true -> 0 end, - case same_line(I0, Sizes, NSepChars) of + case same_line(I0, Sizes, NSepChars, PP) of {yes,Size} -> Chars = if NSepChars > 0 -> insert_sep(CharsL, $\s); @@ -1028,9 +1036,9 @@ f({seq,Before,After,Sep,LItems}, I0, ST, WT, PP) -> end, {BCharsL++Chars,Size}; no -> - CharsList = handle_step(CharsSizeL, I, ST), + CharsList = handle_step(CharsSizeL, I, ST, PP), {LChars, LSize} = - maybe_newlines(CharsList, LItems, I, NSepChars, ST), + maybe_newlines(CharsList, LItems, I, NSepChars, ST, PP), {[BCharsL,LChars],nsz(LSize, I0)} end; f({force_nl,_ExtraInfoItem,Item}, I, ST, WT, PP) when I < 0 -> @@ -1047,7 +1055,7 @@ f({prefer_nl,Sep,LItems}, I0, ST, WT, PP) -> Sizes =:= [] -> {[], 0}; true -> - {insert_newlines(CharsSize2L, I0, ST), + {insert_newlines(CharsSize2L, I0, ST, PP), nsz(lists:last(Sizes), I0)} end; f({value,V}, I, ST, WT, PP) -> @@ -1071,8 +1079,6 @@ f({ehook,HookExpr,Precedence,{Mod,Func,Eas}=ModFuncEas}, I, _ST, _WT, _PP) -> f(WordName, _I, _ST, WT, _PP) when is_atom(WordName) -> word(WordName, WT). --define(IND, 4). - %% fl(ListItems, I0, ST, WT) -> [[CharsSize1,CharsSize2]] %% ListItems = [{Item,Items}|Item] fl([], _Sep, I0, After, ST, WT, PP) -> @@ -1080,15 +1086,15 @@ fl([], _Sep, I0, After, ST, WT, PP) -> fl(CItems, Sep0, I0, After, ST, WT, PP) -> F = fun({step,Item1,Item2}, S) -> [f(Item1, I0, ST, WT, PP), - f([Item2,S], incr(I0, ?IND), ST, WT, PP)]; + f([Item2,S], incr(I0, PP#pp.indent), ST, WT, PP)]; ({cstep,Item1,Item2}, S) -> {_,Sz1} = CharSize1 = f(Item1, I0, ST, WT, PP), if - is_integer(Sz1), Sz1 < ?IND -> + is_integer(Sz1), Sz1 < PP#pp.indent -> Item2p = [leaf("\s"),Item2,S], [consecutive(Item2p, CharSize1, I0, ST, WT, PP),{[],0}]; true -> - [CharSize1,f([Item2,S], incr(I0, ?IND), ST, WT, PP)] + [CharSize1,f([Item2,S], incr(I0, PP#pp.indent), ST, WT, PP)] end; ({reserved,Word}, S) -> [f([Word,S], I0, ST, WT, PP),{[],0}]; @@ -1127,58 +1133,58 @@ unz1(CharSizes) -> nonzero(CharSizes) -> lists:filter(fun({_,Sz}) -> Sz =/= 0 end, CharSizes). -maybe_newlines([{Chars,Size}], [], _I, _NSepChars, _ST) -> +maybe_newlines([{Chars,Size}], [], _I, _NSepChars, _ST, _PP) -> {Chars,Size}; -maybe_newlines(CharsSizeList, Items, I, NSepChars, ST) when I >= 0 -> - maybe_sep(CharsSizeList, Items, I, NSepChars, nl_indent(I, ST)). +maybe_newlines(CharsSizeList, Items, I, NSepChars, ST, PP) when I >= 0 -> + maybe_sep(CharsSizeList, Items, I, NSepChars, nl_indent(I, ST), PP). -maybe_sep([{Chars1,Size1}|CharsSizeL], [Item|Items], I0, NSepChars, Sep) -> +maybe_sep([{Chars1,Size1}|CharsSizeL], [Item|Items], I0, NSepChars, Sep, PP) -> I1 = case classify_item(Item) of atomic -> I0 + Size1; _ -> - ?MAXLINE+1 + PP#pp.linewidth+1 end, - maybe_sep1(CharsSizeL, Items, I0, I1, Sep, NSepChars, Size1, [Chars1]). + maybe_sep1(CharsSizeL, Items, I0, I1, Sep, NSepChars, Size1, [Chars1], PP). maybe_sep1([{Chars,Size}|CharsSizeL], [Item|Items], - I0, I, Sep, NSepChars, Sz0, A) -> + I0, I, Sep, NSepChars, Sz0, A, PP) -> case classify_item(Item) of atomic when is_integer(Size) -> Size1 = Size + 1, I1 = I + Size1, if - I1 =< ?MAXLINE -> + I1 =< PP#pp.linewidth -> A1 = if NSepChars > 0 -> [Chars,$\s|A]; true -> [Chars|A] end, maybe_sep1(CharsSizeL, Items, I0, I1, Sep, NSepChars, - Sz0 + Size1, A1); + Sz0 + Size1, A1, PP); true -> A1 = [Chars,Sep|A], maybe_sep1(CharsSizeL, Items, I0, I0 + Size, Sep, - NSepChars, Size1, A1) + NSepChars, Size1, A1, PP) end; _ -> A1 = [Chars,Sep|A], - maybe_sep1(CharsSizeL, Items, I0, ?MAXLINE+1, Sep, NSepChars, - 0, A1) + maybe_sep1(CharsSizeL, Items, I0, PP#pp.linewidth+1, Sep, NSepChars, + 0, A1, PP) end; -maybe_sep1(_CharsSizeL, _Items, _Io, _I, _Sep, _NSepChars, Sz, A) -> +maybe_sep1(_CharsSizeL, _Items, _Io, _I, _Sep, _NSepChars, Sz, A, _PP) -> {lists:reverse(A), Sz}. -insert_newlines(CharsSizesL, I, ST) when I >= 0 -> - {CharsL, _} = unz1(handle_step(CharsSizesL, I, ST)), +insert_newlines(CharsSizesL, I, ST, PP) when I >= 0 -> + {CharsL, _} = unz1(handle_step(CharsSizesL, I, ST, PP)), insert_nl(CharsL, I, ST). -handle_step(CharsSizesL, I, ST) -> +handle_step(CharsSizesL, I, ST, PP) -> map(fun([{_C1,0},{_C2,0}]) -> {[], 0}; ([{C1,Sz1},{_C2,0}]) -> {C1, Sz1}; ([{C1,Sz1},{C2,Sz2}]) when Sz2 > 0 -> - {insert_nl([C1,C2], I+?IND, ST),line_size([Sz1,Sz2])} + {insert_nl([C1,C2], I+PP#pp.indent, ST),line_size([Sz1,Sz2])} end, CharsSizesL). insert_nl(CharsL, I, ST) -> @@ -1198,10 +1204,10 @@ classify_item(Atom) when is_atom(Atom) -> atomic; classify_item({leaf, _, _}) -> atomic; classify_item(_) -> complex. -same_line(I0, SizeL, NSepChars) -> +same_line(I0, SizeL, NSepChars, PP) -> try Size = lists:sum(SizeL) + NSepChars, - true = incr(I0, Size) =< ?MAXLINE, + true = incr(I0, Size) =< PP#pp.linewidth, {yes,Size} catch _:_ -> no @@ -1269,7 +1275,7 @@ write_a_char(C, PP) -> write_a_string(S, I, PP) when I < 0; S =:= [] -> flat_leaf(write_string(S, PP)); write_a_string(S, I, PP) -> - Len = erlang:max(?MAXLINE-I, ?MIN_SUBSTRING), + Len = erlang:max(PP#pp.linewidth-I, ?MIN_SUBSTRING), {list,write_a_string(S, Len, Len, PP)}. write_a_string([], _N, _Len, _PP) -> diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 4774c4bf19..0854e15177 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -66,6 +66,17 @@ token/0, tokens_result/0]). +%% Removed functions and types +-removed([{set_attribute,3,"use erl_anno:set_line/2 instead"}, + {attributes_info,'_', + "erl_anno:{column,line,location,text}/1 instead"}, + {token_info,'_', + "erl_scan:{category,column,line,location,symbol,text}/1 instead"}]). + +-removed_type([{column,0,"use erl_anno:column() instead"}, + {line,0,"use erl_anno:line() instead"}, + {location,0,"use erl_anno:location() instead"}]). + %%% %%% Defines and type definitions %%% @@ -249,7 +260,7 @@ string_thing(_) -> "string". -define(WHITE_SPACE(C), is_integer(C) andalso (C >= $\000 andalso C =< $\s orelse C >= $\200 andalso C =< $\240)). --define(DIGIT(C), C >= $0, C =< $9). +-define(DIGIT(C), C >= $0 andalso C =< $9). -define(CHAR(C), is_integer(C), C >= 0). -define(UNICODE(C), is_integer(C) andalso @@ -379,7 +390,7 @@ scan1([$\%|Cs], St, Line, Col, Toks) when not St#erl_scan.comment -> scan1([$\%=C|Cs], St, Line, Col, Toks) -> scan_comment(Cs, St, Line, Col, Toks, [C]); scan1([C|Cs], St, Line, Col, Toks) when ?DIGIT(C) -> - scan_number(Cs, St, Line, Col, Toks, [C]); + scan_number(Cs, St, Line, Col, Toks, [C], no_underscore); scan1("..."++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "...", '...', 3); scan1(".."=Cs, _St, Line, Col, Toks) -> @@ -938,27 +949,35 @@ escape_char($s) -> $\s; % \s = SPC escape_char($d) -> $\d; % \d = DEL escape_char(C) -> C. -scan_number([C|Cs], St, Line, Col, Toks, Ncs) when ?DIGIT(C) -> - scan_number(Cs, St, Line, Col, Toks, [C|Ncs]); -scan_number([$.,C|Cs], St, Line, Col, Toks, Ncs) when ?DIGIT(C) -> - scan_fraction(Cs, St, Line, Col, Toks, [C,$.|Ncs]); -scan_number([$.]=Cs, _St, Line, Col, Toks, Ncs) -> - {more,{Cs,Col,Toks,Line,Ncs,fun scan_number/6}}; -scan_number([$#|Cs]=Cs0, St, Line, Col, Toks, Ncs0) -> +scan_number(Cs, St, Line, Col, Toks, {Ncs, Us}) -> + scan_number(Cs, St, Line, Col, Toks, Ncs, Us). + +scan_number([C|Cs], St, Line, Col, Toks, Ncs, Us) when ?DIGIT(C) -> + scan_number(Cs, St, Line, Col, Toks, [C|Ncs], Us); +scan_number([$_,Next|Cs], St, Line, Col, Toks, [Prev|_]=Ncs, _Us) when + ?DIGIT(Next) andalso ?DIGIT(Prev) -> + scan_number(Cs, St, Line, Col, Toks, [Next,$_|Ncs], with_underscore); +scan_number([$_]=Cs, _St, Line, Col, Toks, Ncs, Us) -> + {more,{Cs,Col,Toks,Line,{Ncs,Us},fun scan_number/6}}; +scan_number([$.,C|Cs], St, Line, Col, Toks, Ncs, Us) when ?DIGIT(C) -> + scan_fraction(Cs, St, Line, Col, Toks, [C,$.|Ncs], Us); +scan_number([$.]=Cs, _St, Line, Col, Toks, Ncs, Us) -> + {more,{Cs,Col,Toks,Line,{Ncs,Us},fun scan_number/6}}; +scan_number([$#|Cs]=Cs0, St, Line, Col, Toks, Ncs0, Us) -> Ncs = lists:reverse(Ncs0), - case catch list_to_integer(Ncs) of + case catch list_to_integer(remove_digit_separators(Ncs, Us)) of B when B >= 2, B =< 1+$Z-$A+10 -> Bcs = Ncs++[$#], - scan_based_int(Cs, St, Line, Col, Toks, {B,[],Bcs}); + scan_based_int(Cs, St, Line, Col, Toks, B, [], Bcs, no_underscore); B -> Len = length(Ncs), scan_error({base,B}, Line, Col, Line, incr_column(Col, Len), Cs0) end; -scan_number([]=Cs, _St, Line, Col, Toks, Ncs) -> - {more,{Cs,Col,Toks,Line,Ncs,fun scan_number/6}}; -scan_number(Cs, St, Line, Col, Toks, Ncs0) -> +scan_number([]=Cs, _St, Line, Col, Toks, Ncs, Us) -> + {more,{Cs,Col,Toks,Line,{Ncs,Us},fun scan_number/6}}; +scan_number(Cs, St, Line, Col, Toks, Ncs0, Us) -> Ncs = lists:reverse(Ncs0), - case catch list_to_integer(Ncs) of + case catch list_to_integer(remove_digit_separators(Ncs, Us)) of N when is_integer(N) -> tok3(Cs, St, Line, Col, Toks, integer, Ncs, N); _ -> @@ -966,20 +985,33 @@ scan_number(Cs, St, Line, Col, Toks, Ncs0) -> scan_error({illegal,integer}, Line, Col, Line, Ncol, Cs) end. -scan_based_int([C|Cs], St, Line, Col, Toks, {B,Ncs,Bcs}) - when ?DIGIT(C), C < $0+B -> - scan_based_int(Cs, St, Line, Col, Toks, {B,[C|Ncs],Bcs}); -scan_based_int([C|Cs], St, Line, Col, Toks, {B,Ncs,Bcs}) - when C >= $A, B > 10, C < $A+B-10 -> - scan_based_int(Cs, St, Line, Col, Toks, {B,[C|Ncs],Bcs}); -scan_based_int([C|Cs], St, Line, Col, Toks, {B,Ncs,Bcs}) - when C >= $a, B > 10, C < $a+B-10 -> - scan_based_int(Cs, St, Line, Col, Toks, {B,[C|Ncs],Bcs}); -scan_based_int([]=Cs, _St, Line, Col, Toks, State) -> - {more,{Cs,Col,Toks,Line,State,fun scan_based_int/6}}; -scan_based_int(Cs, St, Line, Col, Toks, {B,Ncs0,Bcs}) -> +remove_digit_separators(Number, no_underscore) -> + Number; +remove_digit_separators(Number, with_underscore) -> + [C || C <- Number, C =/= $_]. + +-define(BASED_DIGIT(C, B), + ((?DIGIT(C) andalso C < $0 + B) + orelse (C >= $A andalso B > 10 andalso C < $A + B - 10) + orelse (C >= $a andalso B > 10 andalso C < $a + B - 10))). + +scan_based_int(Cs, St, Line, Col, Toks, {B,NCs,BCs,Us}) -> + scan_based_int(Cs, St, Line, Col, Toks, B, NCs, BCs, Us). + +scan_based_int([C|Cs], St, Line, Col, Toks, B, Ncs, Bcs, Us) when + ?BASED_DIGIT(C, B) -> + scan_based_int(Cs, St, Line, Col, Toks, B, [C|Ncs], Bcs, Us); +scan_based_int([$_,Next|Cs], St, Line, Col, Toks, B, [Prev|_]=Ncs, Bcs, _Us) + when ?BASED_DIGIT(Next, B) andalso ?BASED_DIGIT(Prev, B) -> + scan_based_int(Cs, St, Line, Col, Toks, B, [Next,$_|Ncs], Bcs, + with_underscore); +scan_based_int([$_]=Cs, _St, Line, Col, Toks, B, NCs, BCs, Us) -> + {more,{Cs,Col,Toks,Line,{B,NCs,BCs,Us},fun scan_based_int/6}}; +scan_based_int([]=Cs, _St, Line, Col, Toks, B, NCs, BCs, Us) -> + {more,{Cs,Col,Toks,Line,{B,NCs,BCs,Us},fun scan_based_int/6}}; +scan_based_int(Cs, St, Line, Col, Toks, B, Ncs0, Bcs, Us) -> Ncs = lists:reverse(Ncs0), - case catch erlang:list_to_integer(Ncs, B) of + case catch erlang:list_to_integer(remove_digit_separators(Ncs, Us), B) of N when is_integer(N) -> tok3(Cs, St, Line, Col, Toks, integer, Bcs++Ncs, N); _ -> @@ -988,32 +1020,52 @@ scan_based_int(Cs, St, Line, Col, Toks, {B,Ncs0,Bcs}) -> scan_error({illegal,integer}, Line, Col, Line, Ncol, Cs) end. -scan_fraction([C|Cs], St, Line, Col, Toks, Ncs) when ?DIGIT(C) -> - scan_fraction(Cs, St, Line, Col, Toks, [C|Ncs]); -scan_fraction([E|Cs], St, Line, Col, Toks, Ncs) when E =:= $e; E =:= $E -> - scan_exponent_sign(Cs, St, Line, Col, Toks, [E|Ncs]); -scan_fraction([]=Cs, _St, Line, Col, Toks, Ncs) -> - {more,{Cs,Col,Toks,Line,Ncs,fun scan_fraction/6}}; -scan_fraction(Cs, St, Line, Col, Toks, Ncs) -> - float_end(Cs, St, Line, Col, Toks, Ncs). - -scan_exponent_sign([C|Cs], St, Line, Col, Toks, Ncs) when C =:= $+; C =:= $- -> - scan_exponent(Cs, St, Line, Col, Toks, [C|Ncs]); -scan_exponent_sign([]=Cs, _St, Line, Col, Toks, Ncs) -> - {more,{Cs,Col,Toks,Line,Ncs,fun scan_exponent_sign/6}}; -scan_exponent_sign(Cs, St, Line, Col, Toks, Ncs) -> - scan_exponent(Cs, St, Line, Col, Toks, Ncs). - -scan_exponent([C|Cs], St, Line, Col, Toks, Ncs) when ?DIGIT(C) -> - scan_exponent(Cs, St, Line, Col, Toks, [C|Ncs]); -scan_exponent([]=Cs, _St, Line, Col, Toks, Ncs) -> - {more,{Cs,Col,Toks,Line,Ncs,fun scan_exponent/6}}; -scan_exponent(Cs, St, Line, Col, Toks, Ncs) -> - float_end(Cs, St, Line, Col, Toks, Ncs). - -float_end(Cs, St, Line, Col, Toks, Ncs0) -> +scan_fraction(Cs, St, Line, Col, Toks, {Ncs,Us}) -> + scan_fraction(Cs, St, Line, Col, Toks, Ncs, Us). + +scan_fraction([C|Cs], St, Line, Col, Toks, Ncs, Us) when ?DIGIT(C) -> + scan_fraction(Cs, St, Line, Col, Toks, [C|Ncs], Us); +scan_fraction([$_,Next|Cs], St, Line, Col, Toks, [Prev|_]=Ncs, _Us) when + ?DIGIT(Next) andalso ?DIGIT(Prev) -> + scan_fraction(Cs, St, Line, Col, Toks, [Next,$_|Ncs], with_underscore); +scan_fraction([$_]=Cs, _St, Line, Col, Toks, Ncs, Us) -> + {more,{Cs,Col,Toks,Line,{Ncs,Us},fun scan_fraction/6}}; +scan_fraction([E|Cs], St, Line, Col, Toks, Ncs, Us) when E =:= $e; E =:= $E -> + scan_exponent_sign(Cs, St, Line, Col, Toks, [E|Ncs], Us); +scan_fraction([]=Cs, _St, Line, Col, Toks, Ncs, Us) -> + {more,{Cs,Col,Toks,Line,{Ncs,Us},fun scan_fraction/6}}; +scan_fraction(Cs, St, Line, Col, Toks, Ncs, Us) -> + float_end(Cs, St, Line, Col, Toks, Ncs, Us). + +scan_exponent_sign(Cs, St, Line, Col, Toks, {Ncs, Us}) -> + scan_exponent_sign(Cs, St, Line, Col, Toks, Ncs, Us). + +scan_exponent_sign([C|Cs], St, Line, Col, Toks, Ncs, Us) when + C =:= $+; C =:= $- -> + scan_exponent(Cs, St, Line, Col, Toks, [C|Ncs], Us); +scan_exponent_sign([]=Cs, _St, Line, Col, Toks, Ncs, Us) -> + {more,{Cs,Col,Toks,Line,{Ncs,Us},fun scan_exponent_sign/6}}; +scan_exponent_sign(Cs, St, Line, Col, Toks, Ncs, Us) -> + scan_exponent(Cs, St, Line, Col, Toks, Ncs, Us). + +scan_exponent(Cs, St, Line, Col, Toks, {Ncs, Us}) -> + scan_exponent(Cs, St, Line, Col, Toks, Ncs, Us). + +scan_exponent([C|Cs], St, Line, Col, Toks, Ncs, Us) when ?DIGIT(C) -> + scan_exponent(Cs, St, Line, Col, Toks, [C|Ncs], Us); +scan_exponent([$_,Next|Cs], St, Line, Col, Toks, [Prev|_]=Ncs, _) when + ?DIGIT(Next) andalso ?DIGIT(Prev) -> + scan_exponent(Cs, St, Line, Col, Toks, [Next,$_|Ncs], with_underscore); +scan_exponent([$_]=Cs, _St, Line, Col, Toks, Ncs, Us) -> + {more,{Cs,Col,Toks,Line,{Ncs,Us},fun scan_exponent/6}}; +scan_exponent([]=Cs, _St, Line, Col, Toks, Ncs, Us) -> + {more,{Cs,Col,Toks,Line,{Ncs,Us},fun scan_exponent/6}}; +scan_exponent(Cs, St, Line, Col, Toks, Ncs, Us) -> + float_end(Cs, St, Line, Col, Toks, Ncs, Us). + +float_end(Cs, St, Line, Col, Toks, Ncs0, Us) -> Ncs = lists:reverse(Ncs0), - case catch list_to_float(Ncs) of + case catch list_to_float(remove_digit_separators(Ncs, Us)) of F when is_float(F) -> tok3(Cs, St, Line, Col, Toks, float, Ncs, F); _ -> diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index 78cdd02307..cbfed30b13 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -321,22 +321,29 @@ do_open(Name, Mode) when is_list(Mode) -> {error, {Name, Reason}} end. -open1({binary,Bin}, read, _Raw, Opts) when is_binary(Bin) -> +open1({binary,Bin}=Handle, read, _Raw, Opts) when is_binary(Bin) -> case file:open(Bin, [ram,binary,read]) of {ok,File} -> _ = [ram_file:uncompress(File) || lists:member(compressed, Opts)], {ok, #reader{handle=File,access=read,func=fun file_op/2}}; - Error -> - Error + {error, Reason} -> + {error, {Handle, Reason}} end; -open1({file, Fd}, read, _Raw, _Opts) -> - Reader = #reader{handle=Fd,access=read,func=fun file_op/2}, - case do_position(Reader, {cur, 0}) of - {ok, Pos, Reader2} -> - {ok, Reader2#reader{pos=Pos}}; - {error, _} = Err -> - Err +open1({file, Fd}=Handle, read, [raw], Opts) -> + case not lists:member(compressed, Opts) of + true -> + Reader = #reader{handle=Fd,access=read,func=fun file_op/2}, + case do_position(Reader, {cur, 0}) of + {ok, Pos, Reader2} -> + {ok, Reader2#reader{pos=Pos}}; + {error, Reason} -> + {error, {Handle, Reason}} + end; + false -> + {error, {Handle, {incompatible_option, compressed}}} end; +open1({file, _Fd}=Handle, read, [], _Opts) -> + {error, {Handle, {incompatible_option, cooked}}}; open1(Name, Access, Raw, Opts) when is_list(Name) or is_binary(Name) -> case file:open(Name, Raw ++ [binary, Access|Opts]) of {ok, File} -> @@ -1637,60 +1644,18 @@ write_extracted_element(#tar_header{name=Name0}=Header, Bin, Opts) -> make_safe_path([$/|Path], Opts) -> make_safe_path(Path, Opts); -make_safe_path(Path, #read_opts{cwd=Cwd}) -> - case filename:safe_relative_path(Path) of - unsafe -> - throw({error,{Path,unsafe_path}}); - SafePath -> - filename:absname(SafePath, Cwd) +make_safe_path(Path0, #read_opts{cwd=Cwd}) -> + case filelib:safe_relative_path(Path0, Cwd) of + unsafe -> throw({error,{Path0,unsafe_path}}); + Path -> filename:absname(Path, Cwd) end. -safe_link_name(#tar_header{linkname=Path}, #read_opts{cwd=Cwd}) -> - case safe_relative_path_links(Path, Cwd) of - unsafe -> - throw({error,{Path,unsafe_symlink}}); - SafePath -> - SafePath +safe_link_name(#tar_header{linkname=Path0},#read_opts{cwd=Cwd} ) -> + case filelib:safe_relative_path(Path0, Cwd) of + unsafe -> throw({error,{Path0,unsafe_symlink}}); + Path -> Path end. -safe_relative_path_links(Path, Cwd) -> - case filename:pathtype(Path) of - relative -> safe_relative_path_links(filename:split(Path), Cwd, [], ""); - _ -> unsafe - end. - -safe_relative_path_links([Segment|Segments], Cwd, PrevSegments, Acc) -> - AccSegment = join(Acc, Segment), - case lists:member(AccSegment, PrevSegments) of - true -> - unsafe; - false -> - case file:read_link(join(Cwd, AccSegment)) of - {ok, LinkPath} -> - case filename:pathtype(LinkPath) of - relative -> - safe_relative_path_links(filename:split(LinkPath) ++ Segments, - Cwd, [AccSegment|PrevSegments], Acc); - _ -> - unsafe - end; - - {error, _} -> - case filename:safe_relative_path(join(Acc, Segment)) of - unsafe -> - unsafe; - NewAcc -> - safe_relative_path_links(Segments, Cwd, - [AccSegment|PrevSegments], NewAcc) - end - end - end; -safe_relative_path_links([], _Cwd, _PrevSegments, Acc) -> - Acc. - -join([], Path) -> Path; -join(Left, Right) -> filename:join(Left, Right). - create_regular(Name, NameInArchive, Bin, Opts) -> case write_extracted_file(Name, Bin, Opts) of not_written -> diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 4e9ba1cc16..0e120174fe 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -780,7 +780,7 @@ interpret(Forms, HasRecs, File, Args) -> false -> Forms; true -> erl_expand_records:module(Forms, []) end, - Dict = parse_to_dict(Forms2), + Dict = parse_to_map(Forms2), ArgsA = erl_parse:abstract(Args, 0), Anno = a0(), Call = {call,Anno,{atom,Anno,main},[ArgsA]}, @@ -824,29 +824,29 @@ format_message(F, [{Mod,E}|Es]) -> [M|format_message(F, Es)]; format_message(_, []) -> []. -parse_to_dict(L) -> parse_to_dict(L, dict:new()). - -parse_to_dict([{function,_,Name,Arity,Clauses}|T], Dict0) -> - Dict = dict:store({local, Name,Arity}, Clauses, Dict0), - parse_to_dict(T, Dict); -parse_to_dict([{attribute,_,import,{Mod,Funcs}}|T], Dict0) -> - Dict = lists:foldl(fun(I, D) -> - dict:store({remote,I}, Mod, D) - end, Dict0, Funcs), - parse_to_dict(T, Dict); -parse_to_dict([_|T], Dict) -> - parse_to_dict(T, Dict); -parse_to_dict([], Dict) -> - Dict. +parse_to_map(L) -> parse_to_map(L, maps:new()). + +parse_to_map([{function,_,Name,Arity,Clauses}|T], Map0) -> + Map = maps:put({local, Name,Arity}, Clauses, Map0), + parse_to_map(T, Map); +parse_to_map([{attribute,_,import,{Mod,Funcs}}|T], Map0) -> + Map = lists:foldl(fun(I, D) -> + maps:put({remote,I}, Mod, D) + end, Map0, Funcs), + parse_to_map(T, Map); +parse_to_map([_|T], Map) -> + parse_to_map(T, Map); +parse_to_map([], Map) -> + Map. code_handler(local, [file], _, File) -> File; -code_handler(Name, Args, Dict, File) -> +code_handler(Name, Args, Map, File) -> %%io:format("code handler=~p~n",[{Name, Args}]), Arity = length(Args), - case dict:find({local,Name,Arity}, Dict) of + case maps:find({local,Name,Arity}, Map) of {ok, Cs} -> - LF = {value,fun(I, J) -> code_handler(I, J, Dict, File) end}, + LF = {value,fun(I, J) -> code_handler(I, J, Map, File) end}, case erl_eval:match_clause(Cs, Args,erl_eval:new_bindings(),LF) of {Body, Bs} -> eval_exprs(Body, Bs, LF, none, none); @@ -854,7 +854,7 @@ code_handler(Name, Args, Dict, File) -> erlang:error({function_clause,[{local,Name,Args}]}) end; error -> - case dict:find({remote,{Name,Arity}}, Dict) of + case maps:find({remote,{Name,Arity}}, Map) of {ok, Mod} -> %% io:format("Calling:~p~n",[{Mod,Name,Args}]), apply(Mod, Name, Args); diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index e926e4fcaf..c8f8c9721f 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -155,6 +155,7 @@ give_away(_, _, _) -> Tab :: tab(), InfoList :: [InfoTuple], InfoTuple :: {compressed, boolean()} + | {decentralized_counters, boolean()} | {heir, pid() | none} | {id, tid()} | {keypos, pos_integer()} @@ -174,7 +175,7 @@ info(_) -> -spec info(Tab, Item) -> Value | undefined when Tab :: tab(), - Item :: binary | compressed | fixed | heir | id | keypos | memory + Item :: binary | compressed | decentralized_counters | fixed | heir | id | keypos | memory | name | named_table | node | owner | protection | safe_fixed | safe_fixed_monotonic_time | size | stats | type | write_concurrency | read_concurrency, @@ -311,6 +312,7 @@ member(_, _) -> Access :: access(), Tweaks :: {write_concurrency, boolean()} | {read_concurrency, boolean()} + | {decentralized_counters, boolean()} | compressed, Pos :: pos_integer(), HeirData :: term(). diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl index bb86a65c72..15abb6166b 100644 --- a/lib/stdlib/src/eval_bits.erl +++ b/lib/stdlib/src/eval_bits.erl @@ -187,7 +187,6 @@ bin_gen_field({bin_element,Line,{string,SLine,S},Size0,Options0}, Bin0, Bs0, BBs0, Mfun, Efun) -> {Size1, [Type,{unit,Unit},Sign,Endian]} = make_bit_type(Line, Size0, Options0), - match_check_size(Mfun, Size1, BBs0), {value, Size, _BBs} = Efun(Size1, BBs0), F = fun(C, Bin, Bs, BBs) -> bin_gen_field1(Bin, Type, Size, Unit, Sign, Endian, @@ -200,7 +199,6 @@ bin_gen_field({bin_element,Line,VE,Size0,Options0}, make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), NewV = coerce_to_float(V, Type), - match_check_size(Mfun, Size1, BBs0, false), {value, Size, _BBs} = Efun(Size1, BBs0), bin_gen_field1(Bin, Type, Size, Unit, Sign, Endian, NewV, Bs0, BBs0, Mfun). @@ -269,7 +267,6 @@ match_field_1({bin_element,Line,{string,SLine,S},Size0,Options0}, {Size1, [Type,{unit,Unit},Sign,Endian]} = make_bit_type(Line, Size0, Options0), Size2 = erl_eval:partial_eval(Size1), - match_check_size(Mfun, Size2, BBs0), {value, Size, _BBs} = Efun(Size2, BBs0), F = fun(C, Bin, Bs, BBs) -> match_field(Bin, Type, Size, Unit, Sign, Endian, @@ -283,7 +280,6 @@ match_field_1({bin_element,Line,VE,Size0,Options0}, V = erl_eval:partial_eval(VE), NewV = coerce_to_float(V, Type), Size2 = erl_eval:partial_eval(Size1), - match_check_size(Mfun, Size2, BBs0), {value, Size, _BBs} = Efun(Size2, BBs0), match_field(Bin, Type, Size, Unit, Sign, Endian, NewV, Bs0, BBs0, Mfun). @@ -387,24 +383,3 @@ make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all' {ok,Size,Bt} -> {Size,erl_bits:as_list(Bt)}; {error,Reason} -> erlang:raise(error, Reason, ?STACKTRACE) end. - -match_check_size(Mfun, Size, Bs) -> - match_check_size(Mfun, Size, Bs, true). - -match_check_size(Mfun, {var,_,V}, Bs, _AllowAll) -> - case Mfun(binding, {V,Bs}) of - {value,_} -> ok; - unbound -> throw(invalid) % or, rather, error({unbound,V}) - end; -match_check_size(_, {atom,_,all}, _Bs, true) -> - ok; -match_check_size(_, {atom,_,all}, _Bs, false) -> - throw(invalid); -match_check_size(_, {atom,_,undefined}, _Bs, _AllowAll) -> - ok; -match_check_size(_, {integer,_,_}, _Bs, _AllowAll) -> - ok; -match_check_size(_, {value,_,_}, _Bs, _AllowAll) -> - ok; %From the debugger. -match_check_size(_, _, _Bs, _AllowAll) -> - throw(invalid). diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index d1a5a4dc35..b4c9ffc1b9 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -25,6 +25,7 @@ -export([wildcard/3, is_dir/2, is_file/2, is_regular/2]). -export([fold_files/6, last_modified/2, file_size/2]). -export([find_file/2, find_file/3, find_source/1, find_source/2, find_source/3]). +-export([safe_relative_path/2]). %% For debugging/testing. -export([compile_wildcard/1]). @@ -333,6 +334,7 @@ match_part([_|_], []) -> false. will_always_match([accept]) -> true; +will_always_match([double_star]) -> true; will_always_match(_) -> false. prepare_base(Base0) -> @@ -340,22 +342,33 @@ prepare_base(Base0) -> "x"++Base2 = lists:reverse(Base1), lists:reverse(Base2). -do_double_star(Base, [H|T], Rest, Result, Mod, Root) -> +do_double_star(Base, [H|T], Patterns, Result0, Mod, Root) -> Full = case Root of - false -> filename:join(Base, H); - true -> H - end, + false -> filename:join(Base, H); + true -> H + end, Result1 = case do_list_dir(Full, Mod) of - {ok, Files} -> - do_double_star(Full, Files, Rest, Result, Mod, false); - _ -> Result - end, - Result2 = case Root andalso Rest == [] of - true -> Result1; - false -> do_wildcard_3(Full, Rest, Result1, Mod) - end, - do_double_star(Base, T, Rest, Result2, Mod, Root); -do_double_star(_Base, [], _Rest, Result, _Mod, _Root) -> + {ok, Files} -> + do_double_star(Full, Files, Patterns, Result0, Mod, false); + _ -> Result0 + end, + Result2 = case Patterns of + %% The root is never included in the result. + _ when Root -> Result1; + + %% An empty pattern includes all results (except the root). + [] -> [Full | Result1]; + + %% Otherwise we check if the current entry matches + %% and continue recursively. + [Pattern | Rest] -> + case match_part(Pattern, H) of + true -> do_wildcard_2([Full], Rest, Result1, Mod); + false -> Result1 + end + end, + do_double_star(Base, T, Patterns, Result2, Mod, Root); +do_double_star(_Base, [], _Patterns, Result, _Mod, _Root) -> Result. do_star(Pattern, [_|Rest]=File) -> @@ -706,3 +719,71 @@ find_regular_file([File|Files]) -> true -> {ok, File}; false -> find_regular_file(Files) end. + +-spec safe_relative_path(Filename, Cwd) -> unsafe | SafeFilename when + Filename :: filename_all(), + Cwd :: filename_all(), + SafeFilename :: filename_all(). + +safe_relative_path(Path, Cwd) -> + case filename:pathtype(Path) of + relative -> safe_relative_path(filename:split(Path), Cwd, [], ""); + _ -> unsafe + end. + +safe_relative_path([], _Cwd, _PrevLinks, Acc) -> + Acc; + +safe_relative_path([Segment | Segments], Cwd, PrevLinks, Acc) -> + AccSegment = join(Acc, Segment), + case safe_relative_path(AccSegment) of + unsafe -> + unsafe; + SafeAccSegment -> + case file:read_link(join(Cwd, SafeAccSegment)) of + {ok, LinkPath} -> + case lists:member(LinkPath, PrevLinks) of + true -> + unsafe; + false -> + case safe_relative_path(filename:split(LinkPath), Cwd, [LinkPath | PrevLinks], Acc) of + unsafe -> unsafe; + NewAcc -> safe_relative_path(Segments, Cwd, [], NewAcc) + end + end; + {error, _} -> + safe_relative_path(Segments, Cwd, PrevLinks, SafeAccSegment) + end + end. + +join([], Path) -> Path; +join(Left, Right) -> filename:join(Left, Right). + +safe_relative_path(Path) -> + case filename:pathtype(Path) of + relative -> + Cs0 = filename:split(Path), + safe_relative_path_1(Cs0, []); + _ -> + unsafe + end. + +safe_relative_path_1(["."|T], Acc) -> + safe_relative_path_1(T, Acc); +safe_relative_path_1([<<".">>|T], Acc) -> + safe_relative_path_1(T, Acc); +safe_relative_path_1([".."|T], Acc) -> + climb(T, Acc); +safe_relative_path_1([<<"..">>|T], Acc) -> + climb(T, Acc); +safe_relative_path_1([H|T], Acc) -> + safe_relative_path_1(T, [H|Acc]); +safe_relative_path_1([], []) -> + []; +safe_relative_path_1([], Acc) -> + filename:join(lists:reverse(Acc)). + +climb(_, []) -> + unsafe; +climb(T, [_|Acc]) -> + safe_relative_path_1(T, Acc).
\ No newline at end of file diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index b7b7b562ab..b6df99621f 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -19,8 +19,8 @@ %% -module(filename). --deprecated({find_src,1,next_major_release}). --deprecated({find_src,2,next_major_release}). +-deprecated([{find_src,'_',"use filelib:find_source/1,3 instead"}]). +-deprecated([{safe_relative_path,1,"use filelib:safe_relative_path/2 instead"}]). %% Purpose: Provides generic manipulation of filenames. %% diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index a7f743bd4c..be14665d80 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -28,7 +28,9 @@ %%%----------------------------------------------------------------- -export([start/5, start/6, debug_options/2, hibernate_after/1, name/1, unregister_name/1, get_proc_name/1, get_parent/0, - call/3, call/4, reply/2, stop/1, stop/3]). + call/3, call/4, reply/2, + send_request/3, wait_response/2, check_response/2, + stop/1, stop/3]). -export([init_it/6, init_it/7]). @@ -38,7 +40,7 @@ %%----------------------------------------------------------------- --type linkage() :: 'link' | 'nolink'. +-type linkage() :: 'monitor' | 'link' | 'nolink'. -type emgr_name() :: {'local', atom()} | {'global', term()} | {'via', Module :: module(), Name :: term()}. @@ -53,6 +55,11 @@ | {'spawn_opt', [proc_lib:spawn_option()]}. -type options() :: [option()]. +-type server_ref() :: pid() | atom() | {atom(), node()} + | {global, term()} | {via, module(), term()}. + +-type request_id() :: term(). + %%----------------------------------------------------------------- %% Starts a generic process. %% start(GenMod, LinkP, Mod, Args, Options) @@ -95,6 +102,13 @@ do_spawn(GenMod, link, Mod, Args, Options) -> [GenMod, self(), self(), Mod, Args, Options], Time, spawn_opts(Options)); +do_spawn(GenMod, monitor, Mod, Args, Options) -> + Time = timeout(Options), + Ret = proc_lib:start_monitor(?MODULE, init_it, + [GenMod, self(), self(), Mod, Args, Options], + Time, + spawn_opts(Options)), + monitor_return(Ret); do_spawn(GenMod, _, Mod, Args, Options) -> Time = timeout(Options), proc_lib:start(?MODULE, init_it, @@ -108,6 +122,13 @@ do_spawn(GenMod, link, Name, Mod, Args, Options) -> [GenMod, self(), self(), Name, Mod, Args, Options], Time, spawn_opts(Options)); +do_spawn(GenMod, monitor, Name, Mod, Args, Options) -> + Time = timeout(Options), + Ret = proc_lib:start_monitor(?MODULE, init_it, + [GenMod, self(), self(), Name, Mod, Args, Options], + Time, + spawn_opts(Options)), + monitor_return(Ret); do_spawn(GenMod, _, Name, Mod, Args, Options) -> Time = timeout(Options), proc_lib:start(?MODULE, init_it, @@ -115,6 +136,26 @@ do_spawn(GenMod, _, Name, Mod, Args, Options) -> Time, spawn_opts(Options)). + +%% +%% Adjust monitor returns for OTP gen behaviours... +%% +%% If an OTP behaviour is introduced that 'init_ack's +%% other results, this has code has to be moved out +%% into all behaviours as well as adjusted... +%% +monitor_return({{ok, Pid}, Mon}) when is_pid(Pid), is_reference(Mon) -> + %% Successful start_monitor()... + {ok, {Pid, Mon}}; +monitor_return({Error, Mon}) when is_reference(Mon) -> + %% Failure; wait for spawned process to terminate + %% and release resources, then return the error... + receive + {'DOWN', Mon, process, _Pid, _Reason} -> + ok + end, + Error. + %%----------------------------------------------------------------- %% Initiate the new process. %% Register the name using the Rfunc function @@ -139,7 +180,7 @@ init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) -> %%----------------------------------------------------------------- %% Makes a synchronous call to a generic process. %% Request is sent to the Pid, and the response must be -%% {Tag, _, Reply}. +%% {Tag, Reply}. %%----------------------------------------------------------------- %%% New call function which uses the new monitor BIF @@ -192,6 +233,56 @@ get_node(Process) -> node(Process) end. +-spec send_request(Name::server_ref(), Label::term(), Request::term()) -> request_id(). +send_request(Process, Label, Request) when is_pid(Process) -> + do_send_request(Process, Label, Request); +send_request(Process, Label, Request) -> + Fun = fun(Pid) -> do_send_request(Pid, Label, Request) end, + try do_for_proc(Process, Fun) + catch exit:Reason -> + %% Make send_request async and fake a down message + Mref = erlang:make_ref(), + self() ! {'DOWN', Mref, process, Process, Reason}, + Mref + end. + +do_send_request(Process, Label, Request) -> + Mref = erlang:monitor(process, Process), + erlang:send(Process, {Label, {self(), {'$gen_request_id', Mref}}, Request}, [noconnect]), + Mref. + +%% +%% Wait for a reply to the client. +%% Note: if timeout is returned monitors are kept. + +-spec wait_response(RequestId::request_id(), timeout()) -> + {reply, Reply::term()} | 'timeout' | {error, {term(), server_ref()}}. +wait_response(Mref, Timeout) + when is_reference(Mref) -> + receive + {{'$gen_request_id', Mref}, Reply} -> + erlang:demonitor(Mref, [flush]), + {reply, Reply}; + {'DOWN', Mref, _, Object, Reason} -> + {error, {Reason, Object}} + after Timeout -> + timeout + end. + +-spec check_response(RequestId::term(), Key::request_id()) -> + {reply, Reply::term()} | 'no_reply' | {error, {term(), server_ref()}}. +check_response(Msg, Mref) + when is_reference(Mref) -> + case Msg of + {{'$gen_request_id', Mref}, Reply} -> + erlang:demonitor(Mref, [flush]), + {reply, Reply}; + {'DOWN', Mref, _, Object, Reason} -> + {error, {Reason, Object}}; + _ -> + no_reply + end. + %% %% Send a reply to the client. %% diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 8213282867..8024221cab 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -31,13 +31,20 @@ %%% Re-written by Joe with new functional interface ! %%% Modified by Martin - uses proc_lib, sys and gen! +%%% +%%% NOTE: If init_ack() return values are modified, see comment +%%% above monitor_return() in gen.erl! +%%% -export([start/0, start/1, start/2, start_link/0, start_link/1, start_link/2, + start_monitor/0, start_monitor/1, start_monitor/2, stop/1, stop/3, notify/2, sync_notify/2, add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, - swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/5]). + swap_sup_handler/3, which_handlers/1, call/3, call/4, + send_request/3, wait_response/2, check_response/2, + wake_hib/5]). -export([init_it/6, system_continue/3, @@ -48,7 +55,7 @@ format_status/2]). %% logger callback --export([format_log/1]). +-export([format_log/1, format_log/2]). -export_type([handler/0, handler_args/0, add_handler_ret/0, del_handler_ret/0]). @@ -128,11 +135,13 @@ | {'logfile', string()}. -type option() :: {'timeout', timeout()} | {'debug', [debug_flag()]} - | {'spawn_opt', [proc_lib:spawn_option()]} + | {'spawn_opt', [proc_lib:start_spawn_option()]} | {'hibernate_after', timeout()}. -type emgr_ref() :: atom() | {atom(), atom()} | {'global', term()} | {'via', atom(), term()} | pid(). -type start_ret() :: {'ok', pid()} | {'error', term()}. +-type start_mon_ret() :: {'ok', {pid(),reference()}} | {'error', term()}. +-type request_id() :: term(). %%--------------------------------------------------------------------------- @@ -183,6 +192,20 @@ start_link(Options) when is_list(Options) -> start_link(Name, Options) -> gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], Options). +-spec start_monitor() -> start_mon_ret(). +start_monitor() -> + gen:start(?MODULE, monitor, ?NO_CALLBACK, [], []). + +-spec start_monitor(emgr_name() | [option()]) -> start_mon_ret(). +start_monitor(Name) when is_tuple(Name) -> + gen:start(?MODULE, monitor, Name, ?NO_CALLBACK, [], []); +start_monitor(Options) when is_list(Options) -> + gen:start(?MODULE, monitor, ?NO_CALLBACK, [], Options). + +-spec start_monitor(emgr_name(), [option()]) -> start_mon_ret(). +start_monitor(Name, Options) -> + gen:start(?MODULE, monitor, Name, ?NO_CALLBACK, [], Options). + %% -spec init_it(pid(), 'self' | pid(), emgr_name(), module(), [term()], [_]) -> init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); @@ -213,6 +236,26 @@ call(M, Handler, Query) -> call1(M, Handler, Query). -spec call(emgr_ref(), handler(), term(), timeout()) -> term(). call(M, Handler, Query, Timeout) -> call1(M, Handler, Query, Timeout). +-spec send_request(emgr_ref(), handler(), term()) -> request_id(). +send_request(M, Handler, Query) -> + gen:send_request(M, self(), {call, Handler, Query}). + +-spec wait_response(RequestId::request_id(), timeout()) -> + {reply, Reply::term()} | 'timeout' | {error, {Reason::term(), emgr_ref()}}. +wait_response(RequestId, Timeout) -> + case gen:wait_response(RequestId, Timeout) of + {reply, {error, _} = Err} -> Err; + Return -> Return + end. + +-spec check_response(Msg::term(), RequestId::request_id()) -> + {reply, Reply::term()} | 'no_reply' | {error, {Reason::term(), emgr_ref()}}. +check_response(Msg, RequestId) -> + case gen:check_response(Msg, RequestId) of + {reply, {error, _} = Err} -> Err; + Return -> Return + end. + -spec delete_handler(emgr_ref(), handler(), term()) -> term(). delete_handler(M, Handler, Args) -> rpc(M, {delete_handler, Handler, Args}). @@ -590,8 +633,10 @@ server_update(Handler1, Func, Event, SName) -> module=>Mod1, message=>Event}, #{domain=>[otp], - report_cb=>fun gen_event:format_log/1, - error_logger=>#{tag=>warning_msg}}), % warningmap?? + report_cb=>fun gen_event:format_log/2, + error_logger=> + #{tag=>warning_msg, % warningmap?? + report_cb=>fun gen_event:format_log/1}}), {ok, Handler1}; Other -> do_terminate(Mod1, Handler1, {error, Other}, State, @@ -752,46 +797,165 @@ report_error(Handler, Reason, State, LastIn, SName) -> get(),State), reason=>Reason}, #{domain=>[otp], - report_cb=>fun gen_event:format_log/1, - error_logger=>#{tag=>error}}). - -format_log(#{label:={gen_event,terminate}, - handler:=Handler, - name:=SName, - last_message:=LastIn, - state:=State, - reason:=Reason}) -> - Reason1 = - case Reason of - {'EXIT',{undef,[{M,F,A,L}|MFAs]}} -> - case code:is_loaded(M) of - false -> - {'module could not be loaded',[{M,F,A,L}|MFAs]}; - _ -> - case erlang:function_exported(M, F, length(A)) of - true -> - {undef,[{M,F,A,L}|MFAs]}; - false -> - {'function not exported',[{M,F,A,L}|MFAs]} - end - end; - {'EXIT',Why} -> - Why; - _ -> - Reason - end, - {"** gen_event handler ~p crashed.~n" - "** Was installed in ~tp~n" - "** Last event was: ~tp~n" - "** When handler state == ~tp~n" - "** Reason == ~tp~n", - [Handler,SName,LastIn,State,Reason1]}; -format_log(#{label:={gen_event,no_handle_info}, - module:=Mod, - message:=Msg}) -> - {"** Undefined handle_info in ~tp~n" - "** Unhandled message: ~tp~n", - [Mod, Msg]}. + report_cb=>fun gen_event:format_log/2, + error_logger=>#{tag=>error, + report_cb=>fun gen_event:format_log/1}}). + +%% format_log/1 is the report callback used by Logger handler +%% error_logger only. It is kept for backwards compatibility with +%% legacy error_logger event handlers. This function must always +%% return {Format,Args} compatible with the arguments in this module's +%% calls to error_logger prior to OTP-21.0. +format_log(Report) -> + Depth = error_logger:get_format_depth(), + FormatOpts = #{chars_limit => unlimited, + depth => Depth, + single_line => false, + encoding => utf8}, + format_log_multi(limit_report(Report, Depth), FormatOpts). + +limit_report(Report, unlimited) -> + Report; +limit_report(#{label:={gen_event,terminate}, + last_message:=LastIn, + state:=State, + reason:=Reason}=Report, + Depth) -> + Report#{last_message => io_lib:limit_term(LastIn, Depth), + state => io_lib:limit_term(State, Depth), + reason => io_lib:limit_term(Reason, Depth)}; +limit_report(#{label:={gen_event,no_handle_info}, + message:=Msg}=Report, + Depth) -> + Report#{message => io_lib:limit_term(Msg, Depth)}. + +%% format_log/2 is the report callback for any Logger handler, except +%% error_logger. +format_log(Report, FormatOpts0) -> + Default = #{chars_limit => unlimited, + depth => unlimited, + single_line => false, + encoding => utf8}, + FormatOpts = maps:merge(Default, FormatOpts0), + IoOpts = + case FormatOpts of + #{chars_limit:=unlimited} -> + []; + #{chars_limit:=Limit} -> + [{chars_limit,Limit}] + end, + {Format,Args} = format_log_single(Report, FormatOpts), + io_lib:format(Format, Args, IoOpts). + +format_log_single(#{label:={gen_event,terminate}, + handler:=Handler, + name:=SName, + last_message:=LastIn, + state:=State, + reason:=Reason}, + #{single_line:=true, depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Reason1 = fix_reason(Reason), + Format1 = lists:append(["Generic event handler ",P," crashed. " + "Installed: ",P,". Last event: ",P, + ". State: ",P,". Reason: ",P,"."]), + Args1 = + case Depth of + unlimited -> + [Handler,SName,Reason1,LastIn,State]; + _ -> + [Handler,Depth,SName,Depth,Reason1,Depth, + LastIn,Depth,State,Depth] + end, + {Format1, Args1}; +format_log_single(#{label:={gen_event,no_handle_info}, + module:=Mod, + message:=Msg}, + #{single_line:=true,depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = lists:append(["Undefined handle_info in ",P, + ". Unhandled message: ",P,"."]), + Args = + case Depth of + unlimited -> + [Mod,Msg]; + _ -> + [Mod,Depth,Msg,Depth] + end, + {Format,Args}; +format_log_single(Report,FormatOpts) -> + format_log_multi(Report,FormatOpts). + +format_log_multi(#{label:={gen_event,terminate}, + handler:=Handler, + name:=SName, + last_message:=LastIn, + state:=State, + reason:=Reason}, + #{depth:=Depth}=FormatOpts) -> + Reason1 = fix_reason(Reason), + P = p(FormatOpts), + Format = + lists:append(["** gen_event handler ",P," crashed.\n", + "** Was installed in ",P,"\n", + "** Last event was: ",P,"\n", + "** When handler state == ",P,"\n", + "** Reason == ",P,"\n"]), + Args = + case Depth of + unlimited -> + [Handler,SName,LastIn,State,Reason1]; + _ -> + [Handler,Depth,SName,Depth,LastIn,Depth,State,Depth, + Reason1,Depth] + end, + {Format,Args}; +format_log_multi(#{label:={gen_event,no_handle_info}, + module:=Mod, + message:=Msg}, + #{depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = + "** Undefined handle_info in ~p\n" + "** Unhandled message: "++P++"\n", + Args = + case Depth of + unlimited -> + [Mod,Msg]; + _ -> + [Mod,Msg,Depth] + end, + {Format,Args}. + +fix_reason({'EXIT',{undef,[{M,F,A,_L}|_]=MFAs}=Reason}) -> + case code:is_loaded(M) of + false -> + {'module could not be loaded',MFAs}; + _ -> + case erlang:function_exported(M, F, length(A)) of + true -> + Reason; + false -> + {'function not exported',MFAs} + end + end; +fix_reason({'EXIT',Reason}) -> + Reason; +fix_reason(Reason) -> + Reason. + +p(#{single_line:=Single,depth:=Depth,encoding:=Enc}) -> + "~"++single(Single)++mod(Enc)++p(Depth); +p(unlimited) -> + "p"; +p(_Depth) -> + "P". + +single(true) -> "0"; +single(false) -> "". + +mod(latin1) -> ""; +mod(_) -> "t". handler(Handler) when not Handler#handler.id -> Handler#handler.module; diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 1e18710738..f4752c37d4 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -127,27 +127,9 @@ format_status/2]). %% logger callback --export([format_log/1]). - --deprecated({start, 3, eventually}). --deprecated({start, 4, eventually}). --deprecated({start_link, 3, eventually}). --deprecated({start_link, 4, eventually}). --deprecated({stop, 1, eventually}). --deprecated({stop, 3, eventually}). --deprecated({send_event, 2, eventually}). --deprecated({sync_send_event, 2, eventually}). --deprecated({sync_send_event, 3, eventually}). --deprecated({send_all_state_event, 2, eventually}). --deprecated({sync_send_all_state_event, 2, eventually}). --deprecated({sync_send_all_state_event, 3, eventually}). --deprecated({reply, 2, eventually}). --deprecated({start_timer, 2, eventually}). --deprecated({send_event_after, 2, eventually}). --deprecated({cancel_timer, 1, eventually}). --deprecated({enter_loop, 4, eventually}). --deprecated({enter_loop, 5, eventually}). --deprecated({enter_loop, 6, eventually}). +-export([format_log/1, format_log/2]). + +-deprecated({'_','_', "use the 'gen_statem' module instead"}). %%% --------------------------------------------------- %%% Interface functions. @@ -517,8 +499,10 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, HibernateAfterTi module=>Mod, message=>Msg}, #{domain=>[otp], - report_cb=>fun gen_fsm:format_log/1, - error_logger=>#{tag=>warning_msg}}), + report_cb=>fun gen_fsm:format_log/2, + error_logger=> + #{tag=>warning_msg, + report_cb=>fun gen_fsm:format_log/1}}), loop(Parent, Name, StateName, StateData, Mod, infinity, HibernateAfterTimeout, []); {'EXIT', What} -> terminate(What, Name, From, Msg, Mod, StateName, StateData, []); @@ -634,8 +618,9 @@ error_info(Reason, Name, From, Msg, StateName, StateData, Debug) -> reason=>Reason, client_info=>client_stacktrace(From)}, #{domain=>[otp], - report_cb=>fun gen_fsm:format_log/1, - error_logger=>#{tag=>error}}), + report_cb=>fun gen_fsm:format_log/2, + error_logger=>#{tag=>error, + report_cb=>fun gen_fsm:format_log/1}}), ok. client_stacktrace(undefined) -> @@ -655,70 +640,197 @@ client_stacktrace(Pid) when is_pid(Pid) -> {Pid,remote}. -format_log(#{label:={gen_fsm,terminate}, - name:=Name, - last_message:=Msg, - state_name:=StateName, - state_data:=StateData, - log:=Log, - reason:=Reason, - client_info:=ClientInfo}) -> - Reason1 = - case Reason of - {undef,[{M,F,A,L}|MFAs]} -> - case code:is_loaded(M) of - false -> - {'module could not be loaded',[{M,F,A,L}|MFAs]}; - _ -> - case erlang:function_exported(M, F, length(A)) of - true -> - Reason; - false -> - {'function not exported',[{M,F,A,L}|MFAs]} - end - end; - _ -> - Reason - end, - {ClientFmt,ClientArgs} = format_client_log(ClientInfo), - {"** State machine ~tp terminating \n" ++ - get_msg_str(Msg) ++ - "** When State == ~tp~n" - "** Data == ~tp~n" - "** Reason for termination ==~n** ~tp~n" ++ +%% format_log/1 is the report callback used by Logger handler +%% error_logger only. It is kept for backwards compatibility with +%% legacy error_logger event handlers. This function must always +%% return {Format,Args} compatible with the arguments in this module's +%% calls to error_logger prior to OTP-21.0. +format_log(Report) -> + Depth = error_logger:get_format_depth(), + FormatOpts = #{chars_limit => unlimited, + depth => Depth, + single_line => false, + encoding => utf8}, + format_log_multi(limit_report(Report, Depth), FormatOpts). + +limit_report(Report, unlimited) -> + Report; +limit_report(#{label:={gen_fsm,terminate}, + last_message:=Msg, + state_data:=StateData, + log:=Log, + reason:=Reason, + client_info:=ClientInfo}=Report, + Depth) -> + Report#{last_message=>io_lib:limit_term(Msg, Depth), + state_data=>io_lib:limit_term(StateData, Depth), + log=>[io_lib:limit_term(L, Depth) || L <- Log], + reason=>io_lib:limit_term(Reason, Depth), + client_info=>limit_client_report(ClientInfo, Depth)}; +limit_report(#{label:={gen_fsm,no_handle_info}, + message:=Msg}=Report, Depth) -> + Report#{message=>io_lib:limit_term(Msg, Depth)}. + +limit_client_report({From,{Name,Stacktrace}}, Depth) -> + {From,{Name,io_lib:limit_term(Stacktrace, Depth)}}; +limit_client_report(Client, _) -> + Client. + +%% format_log/2 is the report callback for any Logger handler, except +%% error_logger. +format_log(Report, FormatOpts0) -> + Default = #{chars_limit => unlimited, + depth => unlimited, + single_line => false, + encoding => utf8}, + FormatOpts = maps:merge(Default, FormatOpts0), + IoOpts = + case FormatOpts of + #{chars_limit:=unlimited} -> + []; + #{chars_limit:=Limit} -> + [{chars_limit,Limit}] + end, + {Format,Args} = format_log_single(Report, FormatOpts), + io_lib:format(Format, Args, IoOpts). + +format_log_single(#{label:={gen_fsm,terminate}, + name:=Name, + last_message:=Msg, + state_name:=StateName, + state_data:=StateData, + log:=Log, + reason:=Reason, + client_info:=ClientInfo}, + #{single_line:=true,depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + FixedReason = fix_reason(Reason), + {ClientFmt,ClientArgs} = format_client_log_single(ClientInfo, P, Depth), + Format = + lists:append( + ["State machine ",P," terminating. Reason: ",P, + ". Last event: ",P, + ". State: ",P, + ". Data: ",P, + case Log of + [] -> ""; + _ -> ". Log: "++P + end, + "."]), + Args0 = + [Name,FixedReason,get_msg(Msg),StateName,StateData] ++ + case Log of + [] -> []; + _ -> [Log] + end, + Args = case Depth of + unlimited -> + Args0; + _ -> + lists:flatmap(fun(A) -> [A, Depth] end, Args0) + end, + {Format++ClientFmt, Args++ClientArgs}; +format_log_single(#{label:={gen_fsm,no_handle_info}, + module:=Mod, + message:=Msg}, + #{single_line:=true,depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = lists:append(["Undefined handle_info in ",P, + ". Unhandled message: ",P,"."]), + Args = + case Depth of + unlimited -> + [Mod,Msg]; + _ -> + [Mod,Depth,Msg,Depth] + end, + {Format,Args}; +format_log_single(Report, FormatOpts) -> + format_log_multi(Report, FormatOpts). + +format_log_multi(#{label:={gen_fsm,terminate}, + name:=Name, + last_message:=Msg, + state_name:=StateName, + state_data:=StateData, + log:=Log, + reason:=Reason, + client_info:=ClientInfo}, + #{depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + FixedReason = fix_reason(Reason), + {ClientFmt,ClientArgs} = format_client_log(ClientInfo, P, Depth), + Format = + lists:append( + ["** State machine ",P," terminating \n"++ + get_msg_str(Msg, P)++ + "** When State == ",P,"~n", + "** Data == ",P,"~n", + "** Reason for termination ==~n** ",P,"~n", + case Log of + [] -> []; + _ -> "** Log ==~n**"++P++"~n" + end]), + Args0 = + [Name|get_msg(Msg)] ++ + [StateName,StateData,FixedReason | case Log of [] -> []; - _ -> "** Log ==~n** ~tp~n" - end ++ ClientFmt, - [Name|error_logger:limit_term(get_msg(Msg))] ++ - [StateName, - error_logger:limit_term(StateData), - error_logger:limit_term(Reason1) | - case Log of - [] -> []; - _ -> [[error_logger:limit_term(D) || D <- Log]] - end] ++ ClientArgs}; -format_log(#{label:={gen_fsm,no_handle_info}, - module:=Mod, - message:=Msg}) -> - {"** Undefined handle_info in ~p~n" - "** Unhandled message: ~tp~n", - [Mod, error_logger:limit_term(Msg)]}. - -get_msg_str({'$gen_event', _Event}) -> - "** Last event in was ~tp~n"; -get_msg_str({'$gen_sync_event', _From, _Event}) -> - "** Last sync event in was ~tp from ~tw~n"; -get_msg_str({'$gen_all_state_event', _Event}) -> - "** Last event in was ~tp (for all states)~n"; -get_msg_str({'$gen_sync_all_state_event', _From, _Event}) -> - "** Last sync event in was ~tp (for all states) from ~tw~n"; -get_msg_str({timeout, _Ref, {'$gen_timer', _Msg}}) -> - "** Last timer event in was ~tp~n"; -get_msg_str({timeout, _Ref, {'$gen_event', _Msg}}) -> - "** Last timer event in was ~tp~n"; -get_msg_str(_Msg) -> - "** Last message in was ~tp~n". + _ -> [Log] + end], + Args = case Depth of + unlimited -> + Args0; + _ -> + lists:flatmap(fun(A) -> [A, Depth] end, Args0) + end, + {Format++ClientFmt,Args++ClientArgs}; +format_log_multi(#{label:={gen_fsm,no_handle_info}, + module:=Mod, + message:=Msg}, + #{depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = + "** Undefined handle_info in ~p~n" + "** Unhandled message: "++P++"~n", + Args = + case Depth of + unlimited -> + [Mod,Msg]; + _ -> + [Mod,Msg,Depth] + end, + {Format,Args}. + +fix_reason({undef,[{M,F,A,L}|MFAs]}=Reason) -> + case code:is_loaded(M) of + false -> + {'module could not be loaded',[{M,F,A,L}|MFAs]}; + _ -> + case erlang:function_exported(M, F, length(A)) of + true -> + Reason; + false -> + {'function not exported',[{M,F,A,L}|MFAs]} + end + end; +fix_reason(Reason) -> + Reason. + +get_msg_str({'$gen_event', _Event}, P) -> + "** Last event in was "++P++"~n"; +get_msg_str({'$gen_sync_event', _From, _Event}, P) -> + "** Last sync event in was "++P++" from ~tw~n"; +get_msg_str({'$gen_all_state_event', _Event}, P) -> + "** Last event in was "++P++" (for all states)~n"; +get_msg_str({'$gen_sync_all_state_event', _From, _Event}, P) -> + "** Last sync event in was "++P++" (for all states) from "++P++"~n"; +get_msg_str({timeout, _Ref, {'$gen_timer', _Msg}}, P) -> + "** Last timer event in was "++P++"~n"; +get_msg_str({timeout, _Ref, {'$gen_event', _Msg}}, P) -> + "** Last timer event in was "++P++"~n"; +get_msg_str(_Msg, P) -> + "** Last message in was "++P++"~n". get_msg({'$gen_event', Event}) -> [Event]; get_msg({'$gen_sync_event', {From,_Tag}, Event}) -> [Event,From]; @@ -728,16 +840,53 @@ get_msg({timeout, Ref, {'$gen_timer', Msg}}) -> [{timeout, Ref, Msg}]; get_msg({timeout, _Ref, {'$gen_event', Event}}) -> [Event]; get_msg(Msg) -> [Msg]. -format_client_log(undefined) -> +format_client_log_single(undefined, _, _) -> + {"", []}; +format_client_log_single({Pid,dead}, _, _) -> + {" Client ~0p is dead.", [Pid]}; +format_client_log_single({Pid,remote}, _, _) -> + {" Client ~0p is remote on node ~0p.", [Pid,node(Pid)]}; +format_client_log_single({_Pid,{Name,Stacktrace0}}, P, Depth) -> + %% Minimize the stacktrace a bit for single line reports. This is + %% hopefully enough to point out the position. + Stacktrace = lists:sublist(Stacktrace0, 4), + Format = lists:append([" Client ",P," stacktrace: ",P,"."]), + Args = case Depth of + unlimited -> + [Name, Stacktrace]; + _ -> + [Name, Depth, Stacktrace, Depth] + end, + {Format, Args}. + +format_client_log(undefined, _, _) -> {"", []}; -format_client_log({From,dead}) -> - {"** Client ~p is dead~n", [From]}; -format_client_log({From,remote}) -> - {"** Client ~p is remote on node ~p~n", [From, node(From)]}; -format_client_log({_From,{Name,Stacktrace}}) -> - {"** Client ~tp stacktrace~n" - "** ~tp~n", - [Name, error_logger:limit_term(Stacktrace)]}. +format_client_log({Pid,dead}, _, _) -> + {"** Client ~p is dead~n", [Pid]}; +format_client_log({Pid,remote}, _, _) -> + {"** Client ~p is remote on node ~p~n", [Pid,node(Pid)]}; +format_client_log({_Pid,{Name,Stacktrace}}, P, Depth) -> + Format = lists:append(["** Client ",P," stacktrace~n** ",P,"~n"]), + Args = case Depth of + unlimited -> + [Name, Stacktrace]; + _ -> + [Name, Depth, Stacktrace, Depth] + end, + {Format,Args}. + +p(#{single_line:=Single,depth:=Depth,encoding:=Enc}) -> + "~"++single(Single)++mod(Enc)++p(Depth); +p(unlimited) -> + "p"; +p(_Depth) -> + "P". + +single(true) -> "0"; +single(false) -> "". + +mod(latin1) -> ""; +mod(_) -> "t". %%----------------------------------------------------------------- %% Status information diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index c7b6406f54..e49961a5f0 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -19,6 +19,11 @@ %% -module(gen_server). +%%% +%%% NOTE: If init_ack() return values are modified, see comment +%%% above monitor_return() in gen.erl! +%%% + %%% --------------------------------------------------- %%% %%% The idea behind THIS server is that the user module @@ -89,8 +94,10 @@ %% API -export([start/3, start/4, start_link/3, start_link/4, + start_monitor/3, start_monitor/4, stop/1, stop/3, call/2, call/3, + send_request/2, wait_response/2, check_response/2, cast/2, reply/2, abcast/2, abcast/3, multi_call/2, multi_call/3, multi_call/4, @@ -105,7 +112,7 @@ format_status/2]). %% logger callback --export([format_log/1]). +-export([format_log/1, format_log/2]). %% Internal exports -export([init_it/6]). @@ -116,6 +123,16 @@ STACKTRACE(), element(2, erlang:process_info(self(), current_stacktrace))). + +-type server_ref() :: + pid() + | (LocalName :: atom()) + | {Name :: atom(), Node :: atom()} + | {'global', GlobalName :: term()} + | {'via', RegMod :: module(), ViaName :: term()}. + +-type request_id() :: term(). + %%%========================================================================= %%% API %%%========================================================================= @@ -188,6 +205,12 @@ start_link(Mod, Args, Options) -> start_link(Name, Mod, Args, Options) -> gen:start(?MODULE, link, Name, Mod, Args, Options). +start_monitor(Mod, Args, Options) -> + gen:start(?MODULE, monitor, Mod, Args, Options). + +start_monitor(Name, Mod, Args, Options) -> + gen:start(?MODULE, monitor, Name, Mod, Args, Options). + %% ----------------------------------------------------------------- %% Stop a generic server and wait for it to terminate. @@ -224,6 +247,25 @@ call(Name, Request, Timeout) -> end. %% ----------------------------------------------------------------- +%% Send a request to a generic server and return a Key which should be +%% used with wait_response/2 or check_response/2 to fetch the +%% result of the request. + +-spec send_request(Name::server_ref(), Request::term()) -> request_id(). +send_request(Name, Request) -> + gen:send_request(Name, '$gen_call', Request). + +-spec wait_response(RequestId::request_id(), timeout()) -> + {reply, Reply::term()} | 'timeout' | {error, {Reason::term(), server_ref()}}. +wait_response(RequestId, Timeout) -> + gen:wait_response(RequestId, Timeout). + +-spec check_response(Msg::term(), RequestId::request_id()) -> + {reply, Reply::term()} | 'no_reply' | {error, {Reason::term(), server_ref()}}. +check_response(Msg, RequestId) -> + gen:check_response(Msg, RequestId). + +%% ----------------------------------------------------------------- %% Make a cast to a generic server. %% ----------------------------------------------------------------- cast({global,Name}, Request) -> @@ -249,7 +291,8 @@ cast_msg(Request) -> {'$gen_cast',Request}. %% Send a reply to the client. %% ----------------------------------------------------------------- reply({To, Tag}, Reply) -> - catch To ! {Tag, Reply}. + catch To ! {Tag, Reply}, + ok. %% ----------------------------------------------------------------- %% Asynchronous broadcast, returns nothing, it's just send 'n' pray @@ -646,8 +689,10 @@ try_dispatch(Mod, Func, Msg, State) -> module=>Mod, message=>Msg}, #{domain=>[otp], - report_cb=>fun gen_server:format_log/1, - error_logger=>#{tag=>warning_msg}}), + report_cb=>fun gen_server:format_log/2, + error_logger=> + #{tag=>warning_msg, + report_cb=>fun gen_server:format_log/1}}), {ok, {noreply, State}}; true -> {'EXIT', error, R, Stacktrace} @@ -894,8 +939,9 @@ error_info(Reason, Name, From, Msg, Mod, State, Debug) -> reason=>Reason, client_info=>client_stacktrace(From)}, #{domain=>[otp], - report_cb=>fun gen_server:format_log/1, - error_logger=>#{tag=>error}}), + report_cb=>fun gen_server:format_log/2, + error_logger=>#{tag=>error, + report_cb=>fun gen_server:format_log/1}}), ok. client_stacktrace(undefined) -> @@ -914,63 +960,236 @@ client_stacktrace(From) when is_pid(From), node(From) =:= node() -> client_stacktrace(From) when is_pid(From) -> {From,remote}. -format_log(#{label:={gen_server,terminate}, - name:=Name, - last_message:=Msg, - state:=State, - log:=Log, - reason:=Reason, - client_info:=Client}) -> - Reason1 = - case Reason of - {undef,[{M,F,A,L}|MFAs]} -> - case code:is_loaded(M) of - false -> - {'module could not be loaded',[{M,F,A,L}|MFAs]}; - _ -> - case erlang:function_exported(M, F, length(A)) of - true -> - Reason; - false -> - {'function not exported',[{M,F,A,L}|MFAs]} - end - end; - _ -> - Reason - end, - {ClientFmt,ClientArgs} = format_client_log(Client), - [LimitedMsg,LimitedState,LimitedReason|LimitedLog] = - [error_logger:limit_term(D) || D <- [Msg,State,Reason1|Log]], - {"** Generic server ~tp terminating \n" - "** Last message in was ~tp~n" - "** When Server state == ~tp~n" - "** Reason for termination ==~n** ~tp~n" ++ - case LimitedLog of - [] -> []; - _ -> "** Log ==~n** ~tp~n" - end ++ ClientFmt, - [Name, LimitedMsg, LimitedState, LimitedReason] ++ - case LimitedLog of - [] -> []; - _ -> [LimitedLog] - end ++ ClientArgs}; -format_log(#{label:={gen_server,no_handle_info}, - module:=Mod, - message:=Msg}) -> - {"** Undefined handle_info in ~p~n" - "** Unhandled message: ~tp~n", - [Mod, error_logger:limit_term(Msg)]}. - -format_client_log(undefined) -> + +%% format_log/1 is the report callback used by Logger handler +%% error_logger only. It is kept for backwards compatibility with +%% legacy error_logger event handlers. This function must always +%% return {Format,Args} compatible with the arguments in this module's +%% calls to error_logger prior to OTP-21.0. +format_log(Report) -> + Depth = error_logger:get_format_depth(), + FormatOpts = #{chars_limit => unlimited, + depth => Depth, + single_line => false, + encoding => utf8}, + format_log_multi(limit_report(Report,Depth),FormatOpts). + +limit_report(Report,unlimited) -> + Report; +limit_report(#{label:={gen_server,terminate}, + last_message:=Msg, + state:=State, + log:=Log, + reason:=Reason, + client_info:=Client}=Report, + Depth) -> + Report#{last_message=>io_lib:limit_term(Msg,Depth), + state=>io_lib:limit_term(State,Depth), + log=>[io_lib:limit_term(L,Depth)||L<-Log], + reason=>io_lib:limit_term(Reason,Depth), + client_info=>limit_client_report(Client,Depth)}; +limit_report(#{label:={gen_server,no_handle_info}, + message:=Msg}=Report,Depth) -> + Report#{message=>io_lib:limit_term(Msg,Depth)}. + +limit_client_report({From,{Name,Stacktrace}},Depth) -> + {From,{Name,io_lib:limit_term(Stacktrace,Depth)}}; +limit_client_report(Client,_) -> + Client. + +%% format_log/2 is the report callback for any Logger handler, except +%% error_logger. +format_log(Report, FormatOpts0) -> + Default = #{chars_limit => unlimited, + depth => unlimited, + single_line => false, + encoding => utf8}, + FormatOpts = maps:merge(Default,FormatOpts0), + IoOpts = + case FormatOpts of + #{chars_limit:=unlimited} -> + []; + #{chars_limit:=Limit} -> + [{chars_limit,Limit}] + end, + {Format,Args} = format_log_single(Report, FormatOpts), + io_lib:format(Format, Args, IoOpts). + +format_log_single(#{label:={gen_server,terminate}, + name:=Name, + last_message:=Msg, + state:=State, + log:=Log, + reason:=Reason, + client_info:=Client}, + #{single_line:=true,depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format1 = lists:append(["Generic server ",P," terminating. Reason: ",P, + ". Last message: ", P, ". State: ",P,"."]), + {ServerLogFormat,ServerLogArgs} = format_server_log_single(Log,FormatOpts), + {ClientLogFormat,ClientLogArgs} = format_client_log_single(Client,FormatOpts), + + Args1 = + case Depth of + unlimited -> + [Name,fix_reason(Reason),Msg,State]; + _ -> + [Name,Depth,fix_reason(Reason),Depth,Msg,Depth,State,Depth] + end, + {Format1++ServerLogFormat++ClientLogFormat, + Args1++ServerLogArgs++ClientLogArgs}; +format_log_single(#{label:={gen_server,no_handle_info}, + module:=Mod, + message:=Msg}, + #{single_line:=true,depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = lists:append(["Undefined handle_info in ",P, + ". Unhandled message: ",P,"."]), + Args = + case Depth of + unlimited -> + [Mod,Msg]; + _ -> + [Mod,Depth,Msg,Depth] + end, + {Format,Args}; +format_log_single(Report,FormatOpts) -> + format_log_multi(Report,FormatOpts). + +format_log_multi(#{label:={gen_server,terminate}, + name:=Name, + last_message:=Msg, + state:=State, + log:=Log, + reason:=Reason, + client_info:=Client}, + #{depth:=Depth}=FormatOpts) -> + Reason1 = fix_reason(Reason), + {ClientFmt,ClientArgs} = format_client_log(Client,FormatOpts), + P = p(FormatOpts), + Format = + lists:append( + ["** Generic server ",P," terminating \n" + "** Last message in was ",P,"~n" + "** When Server state == ",P,"~n" + "** Reason for termination ==~n** ",P,"~n"] ++ + case Log of + [] -> []; + _ -> ["** Log ==~n** ["| + lists:join(",~n ",lists:duplicate(length(Log),P))]++ + ["]~n"] + end) ++ ClientFmt, + Args = + case Depth of + unlimited -> + [Name, Msg, State, Reason1] ++ + case Log of + [] -> []; + _ -> Log + end ++ ClientArgs; + _ -> + [Name, Depth, Msg, Depth, State, Depth, Reason1, Depth] ++ + case Log of + [] -> []; + _ -> lists:flatmap(fun(L) -> [L, Depth] end, Log) + end ++ ClientArgs + end, + {Format,Args}; +format_log_multi(#{label:={gen_server,no_handle_info}, + module:=Mod, + message:=Msg}, + #{depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = + "** Undefined handle_info in ~p~n" + "** Unhandled message: "++P++"~n", + Args = + case Depth of + unlimited -> + [Mod,Msg]; + _ -> + [Mod,Msg,Depth] + end, + {Format,Args}. + +fix_reason({undef,[{M,F,A,L}|MFAs]}=Reason) -> + case code:is_loaded(M) of + false -> + {'module could not be loaded',[{M,F,A,L}|MFAs]}; + _ -> + case erlang:function_exported(M, F, length(A)) of + true -> + Reason; + false -> + {'function not exported',[{M,F,A,L}|MFAs]} + end + end; +fix_reason(Reason) -> + Reason. + +format_server_log_single([],_) -> + {"",[]}; +format_server_log_single(Log,FormatOpts) -> + Args = + case maps:get(depth,FormatOpts) of + unlimited -> + [Log]; + Depth -> + [Log, Depth] + end, + {" Log: "++p(FormatOpts),Args}. + +format_client_log_single(undefined,_) -> + {"",[]}; +format_client_log_single({From,dead},_) -> + {" Client ~0p is dead.",[From]}; +format_client_log_single({From,remote},_) -> + {" Client ~0p is remote on node ~0p.", [From, node(From)]}; +format_client_log_single({_From,{Name,Stacktrace0}},FormatOpts) -> + P = p(FormatOpts), + %% Minimize the stacktrace a bit for single line reports. This is + %% hopefully enough to point out the position. + Stacktrace = lists:sublist(Stacktrace0,4), + Args = + case maps:get(depth,FormatOpts) of + unlimited -> + [Name, Stacktrace]; + Depth -> + [Name, Depth, Stacktrace, Depth] + end, + {" Client "++P++" stacktrace: "++P++".", Args}. + +format_client_log(undefined,_) -> {"", []}; -format_client_log({From,dead}) -> +format_client_log({From,dead},_) -> {"** Client ~p is dead~n", [From]}; -format_client_log({From,remote}) -> +format_client_log({From,remote},_) -> {"** Client ~p is remote on node ~p~n", [From, node(From)]}; -format_client_log({_From,{Name,Stacktrace}}) -> - {"** Client ~tp stacktrace~n" - "** ~tp~n", - [Name, error_logger:limit_term(Stacktrace)]}. +format_client_log({_From,{Name,Stacktrace}},FormatOpts) -> + P = p(FormatOpts), + Format = lists:append(["** Client ",P," stacktrace~n", + "** ",P,"~n"]), + Args = + case maps:get(depth,FormatOpts) of + unlimited -> + [Name, Stacktrace]; + Depth -> + [Name, Depth, Stacktrace, Depth] + end, + {Format,Args}. + +p(#{single_line:=Single,depth:=Depth,encoding:=Enc}) -> + "~"++single(Single)++mod(Enc)++p(Depth); +p(unlimited) -> + "p"; +p(_Depth) -> + "P". + +single(true) -> "0"; +single(false) -> "". + +mod(latin1) -> ""; +mod(_) -> "t". %%----------------------------------------------------------------- %% Status information diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 885c6ef031..acedd6daaa 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -21,11 +21,18 @@ -include("logger.hrl"). +%%% +%%% NOTE: If init_ack() return values are modified, see comment +%%% above monitor_return() in gen.erl! +%%% + %% API -export( [start/3,start/4,start_link/3,start_link/4, + start_monitor/3,start_monitor/4, stop/1,stop/3, cast/2,call/2,call/3, + send_request/2,wait_response/1,wait_response/2,check_response/2, enter_loop/4,enter_loop/5,enter_loop/6, reply/1,reply/2]). @@ -47,7 +54,7 @@ [wakeup_from_hibernate/3]). %% logger callback --export([format_log/1]). +-export([format_log/1, format_log/2]). %% Type exports for templates and callback modules -export_type( @@ -58,7 +65,8 @@ event_handler_result/1, reply_action/0, enter_action/0, - action/0]). + action/0 + ]). %% Old types, not advertised -export_type( [state_function_result/0, @@ -257,6 +265,7 @@ Replies :: [reply_action()] | reply_action(), NewData :: data()}. +-type request_id() :: term(). %% The state machine init function. It is called only once and %% the server is not running until this function has returned @@ -453,12 +462,16 @@ timeout_event_type(Type) -> | {'via', RegMod :: module(), ViaName :: term()}. -type start_opt() :: {'timeout', Time :: timeout()} - | {'spawn_opt', [proc_lib:spawn_option()]} + | {'spawn_opt', [proc_lib:start_spawn_option()]} | enter_loop_opt(). -type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. +-type start_mon_ret() :: + {'ok', {pid(),reference()}} + | 'ignore' + | {'error', term()}. -type enter_loop_opt() :: {'hibernate_after', HibernateAfterTimeout :: timeout()} | {'debug', Dbgs :: [sys:debug_option()]}. @@ -493,6 +506,20 @@ start_link(Module, Args, Opts) -> start_link(ServerName, Module, Args, Opts) -> gen:start(?MODULE, link, ServerName, Module, Args, Opts). +%% Start and monitor a state machine +-spec start_monitor( + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_mon_ret(). +start_monitor(Module, Args, Opts) -> + gen:start(?MODULE, monitor, Module, Args, Opts). +%% +-spec start_monitor( + ServerName :: server_name(), + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_mon_ret(). +start_monitor(ServerName, Module, Args, Opts) -> + gen:start(?MODULE, monitor, ServerName, Module, Args, Opts). + %% Stop a state machine -spec stop(ServerRef :: server_ref()) -> ok. stop(ServerRef) -> @@ -551,6 +578,26 @@ call(ServerRef, Request, {_, _} = Timeout) -> call(ServerRef, Request, Timeout) -> call_clean(ServerRef, Request, Timeout, Timeout). +-spec send_request(ServerRef::server_ref(), Request::term()) -> + RequestId::request_id(). +send_request(Name, Request) -> + gen:send_request(Name, '$gen_call', Request). + +-spec wait_response(RequestId::request_id()) -> + {reply, Reply::term()} | {error, {term(), server_ref()}}. +wait_response(RequestId) -> + gen:wait_response(RequestId, infinity). + +-spec wait_response(RequestId::request_id(), timeout()) -> + {reply, Reply::term()} | 'timeout' | {error, {term(), server_ref()}}. +wait_response(RequestId, Timeout) -> + gen:wait_response(RequestId, Timeout). + +-spec check_response(Msg::term(), RequestId::request_id()) -> + {reply, Reply::term()} | 'no_reply' | {error, {term(), server_ref()}}. +check_response(Msg, RequestId) -> + gen:check_response(Msg, RequestId). + %% Reply from a state machine callback to whom awaits in call/2 -spec reply([reply_action()] | reply_action()) -> ok. reply({reply,From,Reply}) -> @@ -2329,8 +2376,10 @@ error_info( reason=>{Class,Reason,Stacktrace}, client_info=>client_stacktrace(Q)}, #{domain=>[otp], - report_cb=>fun gen_statem:format_log/1, - error_logger=>#{tag=>error}}). + report_cb=>fun gen_statem:format_log/2, + error_logger=> + #{tag=>error, + report_cb=>fun gen_statem:format_log/1}}). client_stacktrace([]) -> undefined; @@ -2356,42 +2405,155 @@ client_stacktrace([_|_]) -> undefined. -format_log(#{label:={gen_statem,terminate}, - name:=Name, - queue:=Q, - postponed:=Postponed, - callback_mode:=CallbackMode, - state_enter:=StateEnter, - state:=FmtData, - timeouts:=Timeouts, - log:=Log, - reason:={Class,Reason,Stacktrace}, - client_info:=ClientInfo}) -> - {FixedReason,FixedStacktrace} = - case Stacktrace of - [{M,F,Args,_}|ST] - when Class =:= error, Reason =:= undef -> - case code:is_loaded(M) of - false -> - {{'module could not be loaded',M},ST}; - _ -> - Arity = - if - is_list(Args) -> - length(Args); - is_integer(Args) -> - Args - end, - case erlang:function_exported(M, F, Arity) of - true -> - {Reason,Stacktrace}; - false -> - {{'function not exported',{M,F,Arity}},ST} - end - end; - _ -> {Reason,Stacktrace} - end, - {ClientFmt,ClientArgs} = format_client_log(ClientInfo), +%% format_log/1 is the report callback used by Logger handler +%% error_logger only. It is kept for backwards compatibility with +%% legacy error_logger event handlers. This function must always +%% return {Format,Args} compatible with the arguments in this module's +%% calls to error_logger prior to OTP-21.0. +format_log(Report) -> + Depth = error_logger:get_format_depth(), + FormatOpts = #{chars_limit => unlimited, + depth => Depth, + single_line => false, + encoding => utf8}, + format_log_multi(limit_report(Report, Depth), FormatOpts). + +limit_report(Report, unlimited) -> + Report; +limit_report(#{label:={gen_statem,terminate}, + queue:=Q, + postponed:=Postponed, + state:=FmtData, + timeouts:=Timeouts, + log:=Log, + reason:={Class,Reason,Stacktrace}, + client_info:=ClientInfo}=Report, + Depth) -> + Report#{queue => + case Q of + [Event|Events] -> + [io_lib:limit_term(Event, Depth) + |io_lib:limit_term(Events, Depth)]; + _ -> [] + end, + postponed => + case Postponed of + [] -> []; + _ -> io_lib:limit_term(Postponed, Depth) + end, + state => io_lib:limit_term(FmtData, Depth), + timeouts => + case Timeouts of + {0,_} -> Timeouts; + _ -> io_lib:limit_term(Timeouts, Depth) + end, + log => + case Log of + [] -> []; + _ -> [io_lib:limit_term(T, Depth) || T <- Log] + end, + reason => + {Class, + io_lib:limit_term(Reason, Depth), + io_lib:limit_term(Stacktrace, Depth)}, + client_info => limit_client_info(ClientInfo, Depth)}. + + +limit_client_info({Pid,{Name,Stacktrace}}, Depth) -> + {Pid,{Name,io_lib:limit_term(Stacktrace, Depth)}}; +limit_client_info(Client, _Depth) -> + Client. + +%% format_log/2 is the report callback for any Logger handler, except +%% error_logger. +format_log(Report, FormatOpts0) -> + Default = #{chars_limit => unlimited, + depth => unlimited, + single_line => false, + encoding => utf8}, + FormatOpts = maps:merge(Default,FormatOpts0), + IoOpts = + case FormatOpts of + #{chars_limit:=unlimited} -> + []; + #{chars_limit:=Limit} -> + [{chars_limit,Limit}] + end, + {Format,Args} = format_log_single(Report, FormatOpts), + io_lib:format(Format, Args, IoOpts). + +format_log_single(#{label:={gen_statem,terminate}, + name:=Name, + queue:=Q, + %% postponed + %% callback_mode + %% state_enter + state:=FmtData, + %% timeouts + log:=Log, + reason:={Class,Reason,Stacktrace}, + client_info:=ClientInfo}, + #{single_line:=true,depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + {FixedReason,FixedStacktrace} = fix_reason(Class, Reason, Stacktrace), + {ClientFmt,ClientArgs} = format_client_log_single(ClientInfo, P, Depth), + Format = + lists:append( + ["State machine ",P," terminating. Reason: ",P, + case FixedStacktrace of + [] -> ""; + _ -> ". Stack: "++P + end, + case Q of + [] -> ""; + _ -> ". Last event: "++P + end, + ". State: ",P, + case Log of + [] -> ""; + _ -> ". Log: "++P + end, + "."]), + Args0 = + [Name,FixedReason] ++ + case FixedStacktrace of + [] -> []; + _ -> [FixedStacktrace] + end ++ + case Q of + [] -> []; + [Event|_] -> [Event] + end ++ + [FmtData] ++ + case Log of + [] -> []; + _ -> [Log] + end, + Args = case Depth of + unlimited -> + Args0; + _ -> + lists:flatmap(fun(A) -> [A, Depth] end, Args0) + end, + {Format++ClientFmt, Args++ClientArgs}; +format_log_single(Report, FormatOpts) -> + format_log_multi(Report, FormatOpts). + +format_log_multi(#{label:={gen_statem,terminate}, + name:=Name, + queue:=Q, + postponed:=Postponed, + callback_mode:=CallbackMode, + state_enter:=StateEnter, + state:=FmtData, + timeouts:=Timeouts, + log:=Log, + reason:={Class,Reason,Stacktrace}, + client_info:=ClientInfo}, + #{depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + {FixedReason,FixedStacktrace} = fix_reason(Class, Reason, Stacktrace), + {ClientFmt,ClientArgs} = format_client_log(ClientInfo, P, Depth), CBMode = case StateEnter of true -> @@ -2399,74 +2561,145 @@ format_log(#{label:={gen_statem,terminate}, false -> CallbackMode end, - {"** State machine ~tp terminating~n" ++ - case Q of - [] -> ""; - _ -> "** Last event = ~tp~n" - end ++ - "** When server state = ~tp~n" ++ - "** Reason for termination = ~w:~tp~n" ++ - "** Callback mode = ~p~n" ++ + Format = + lists:append( + ["** State machine ",P," terminating~n", + case Q of + [] -> ""; + _ -> "** Last event = "++P++"~n" + end, + "** When server state = ",P,"~n", + "** Reason for termination = ",P,":",P,"~n", + "** Callback mode = ",P,"~n", + case Q of + [_,_|_] -> "** Queued = "++P++"~n"; + _ -> "" + end, + case Postponed of + [] -> ""; + _ -> "** Postponed = "++P++"~n" + end, + case FixedStacktrace of + [] -> ""; + _ -> "** Stacktrace =~n** "++P++"~n" + end, + case Timeouts of + {0,_} -> ""; + _ -> "** Time-outs: "++P++"~n" + end, + case Log of + [] -> ""; + _ -> "** Log =~n** "++P++"~n" + end]), + Args0 = + [Name | case Q of - [_,_|_] -> "** Queued = ~tp~n"; - _ -> "" - end ++ - case Postponed of - [] -> ""; - _ -> "** Postponed = ~tp~n" - end ++ - case FixedStacktrace of - [] -> ""; - _ -> "** Stacktrace =~n** ~tp~n" - end ++ - case Timeouts of - {0,_} -> ""; - _ -> "** Time-outs: ~p~n" - end ++ - case Log of - [] -> ""; - _ -> "** Log =~n** ~tp~n" - end ++ ClientFmt, - [Name | - case Q of - [] -> []; - [Event|_] -> [error_logger:limit_term(Event)] - end] ++ - [error_logger:limit_term(FmtData), - Class,error_logger:limit_term(FixedReason), - CBMode] ++ - case Q of - [_|[_|_] = Events] -> [error_logger:limit_term(Events)]; - _ -> [] - end ++ - case Postponed of - [] -> []; - _ -> [error_logger:limit_term(Postponed)] - end ++ - case FixedStacktrace of [] -> []; - _ -> [error_logger:limit_term(FixedStacktrace)] - end ++ - case Timeouts of - {0,_} -> []; - _ -> [error_logger:limit_term(Timeouts)] - end ++ - case Log of - [] -> []; - _ -> [[error_logger:limit_term(T) || T <- Log]] - end ++ ClientArgs}. + [Event|_] -> [Event] + end] ++ + [FmtData, + Class,FixedReason, + CBMode] ++ + case Q of + [_|[_|_] = Events] -> [Events]; + _ -> [] + end ++ + case Postponed of + [] -> []; + _ -> [Postponed] + end ++ + case FixedStacktrace of + [] -> []; + _ -> [FixedStacktrace] + end ++ + case Timeouts of + {0,_} -> []; + _ -> [Timeouts] + end ++ + case Log of + [] -> []; + _ -> [Log] + end, + Args = case Depth of + unlimited -> + Args0; + _ -> + lists:flatmap(fun(A) -> [A, Depth] end, Args0) + end, + {Format++ClientFmt,Args++ClientArgs}. + +fix_reason(Class, Reason, Stacktrace) -> + case Stacktrace of + [{M,F,Args,_}|ST] + when Class =:= error, Reason =:= undef -> + case code:is_loaded(M) of + false -> + {{'module could not be loaded',M},ST}; + _ -> + Arity = + if + is_list(Args) -> + length(Args); + is_integer(Args) -> + Args + end, + case erlang:function_exported(M, F, Arity) of + true -> + {Reason,Stacktrace}; + false -> + {{'function not exported',{M,F,Arity}},ST} + end + end; + _ -> {Reason,Stacktrace} + end. -format_client_log(undefined) -> +format_client_log_single(undefined, _, _) -> {"", []}; -format_client_log({Pid,dead}) -> +format_client_log_single({Pid,dead}, _, _) -> + {" Client ~0p is dead.", [Pid]}; +format_client_log_single({Pid,remote}, _, _) -> + {" Client ~0p is remote on node ~0p.", [Pid,node(Pid)]}; +format_client_log_single({_Pid,{Name,Stacktrace0}}, P, Depth) -> + %% Minimize the stacktrace a bit for single line reports. This is + %% hopefully enough to point out the position. + Stacktrace = lists:sublist(Stacktrace0, 4), + Format = lists:append([" Client ",P," stacktrace: ",P,"."]), + Args = case Depth of + unlimited -> + [Name, Stacktrace]; + _ -> + [Name, Depth, Stacktrace, Depth] + end, + {Format, Args}. + +format_client_log(undefined, _, _) -> + {"", []}; +format_client_log({Pid,dead}, _, _) -> {"** Client ~p is dead~n", [Pid]}; -format_client_log({Pid,remote}) -> - {"** Client ~p is remote on node ~p~n", [Pid, node(Pid)]}; -format_client_log({_Pid,{Name,Stacktrace}}) -> - {"** Client ~tp stacktrace~n" - "** ~tp~n", - [Name, error_logger:limit_term(Stacktrace)]}. - +format_client_log({Pid,remote}, _, _) -> + {"** Client ~p is remote on node ~p~n", [Pid,node(Pid)]}; +format_client_log({_Pid,{Name,Stacktrace}}, P, Depth) -> + Format = lists:append(["** Client ",P," stacktrace~n** ",P,"~n"]), + Args = case Depth of + unlimited -> + [Name, Stacktrace]; + _ -> + [Name, Depth, Stacktrace, Depth] + end, + {Format,Args}. + +p(#{single_line:=Single,depth:=Depth,encoding:=Enc}) -> + "~"++single(Single)++mod(Enc)++p(Depth); +p(unlimited) -> + "p"; +p(_Depth) -> + "P". + +single(true) -> "0"; +single(false) -> "". + +mod(latin1) -> ""; +mod(_) -> "t". %% Call Module:format_status/2 or return a default value format_status( diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl index 63c9a6bddf..1848aa3628 100644 --- a/lib/stdlib/src/io.erl +++ b/lib/stdlib/src/io.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -106,7 +106,6 @@ nl() -> IoDevice :: device(). nl(Io) -> -% o_request(Io, {put_chars,io_lib:nl()}). o_request(Io, nl, nl). -spec columns() -> {'ok', pos_integer()} | {'error', 'enotsup'}. @@ -255,8 +254,6 @@ read(Io, Prompt) -> case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[1]}) of {ok,Toks,_EndLine} -> erl_parse:parse_term(Toks); -% {error, Reason} when atom(Reason) -> -% erlang:error(conv_reason(read, Reason), [Io, Prompt]); {error,E,_EndLine} -> {error,E}; {eof,_EndLine} -> @@ -352,12 +349,7 @@ fread(Prompt, Format) -> | server_no_data(). fread(Io, Prompt, Format) -> - case request(Io, {fread,Prompt,Format}) of -% {error, Reason} when atom(Reason) -> -% erlang:error(conv_reason(fread, Reason), [Io, Prompt, Format]); - Other -> - Other - end. + request(Io, {fread,Prompt,Format}). -spec format(Format) -> 'ok' when Format :: format(). diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 21d66c5529..e2823b70f2 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -78,7 +78,7 @@ %% Utilities for collecting characters. -export([collect_chars/3, collect_chars/4, - collect_line/2, collect_line/3, collect_line/4, + collect_line/3, collect_line/4, get_until/3, get_until/4]). %% The following functions were used by Yecc's include-file. @@ -851,6 +851,7 @@ collect_chars({binary,Stack,N}, Data,latin1, _) -> end; collect_chars({list,Stack,N}, Data, _,_) -> collect_chars_list(Stack, N, Data); + %% collect_chars(Continuation, MoreChars, Count) %% Returns: %% {done,Result,RestChars} @@ -881,32 +882,6 @@ collect_chars_list(Stack, N, []) -> collect_chars_list(Stack,N, [H|T]) -> collect_chars_list([H|Stack], N-1, T). -%% collect_line(Continuation, MoreChars) -%% Returns: -%% {done,Result,RestChars} -%% {more,Continuation} -%% -%% XXX Can be removed when compatibility with pre-R12B-5 nodes -%% is no longer required. -%% -collect_line([], Chars) -> - collect_line1(Chars, []); -collect_line({SoFar}, More) -> - collect_line1(More, SoFar). - -collect_line1([$\r, $\n|Rest], Stack) -> - collect_line1([$\n|Rest], Stack); -collect_line1([$\n|Rest], Stack) -> - {done,lists:reverse([$\n|Stack], []),Rest}; -collect_line1([C|Rest], Stack) -> - collect_line1(Rest, [C|Stack]); -collect_line1(eof, []) -> - {done,eof,[]}; -collect_line1(eof, Stack) -> - {done,lists:reverse(Stack, []),[]}; -collect_line1([], Stack) -> - {more,{Stack}}. - %% collect_line(State, Data, _). New in R9C. %% Returns: %% {stop,Result,RestData} diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index 77f02eafe0..838d412d0c 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -895,9 +895,6 @@ write_string(S, _Uni) -> io_lib:write_string(S, $"). %" expand({_, _, _Dots=0, no_more} = If, _T, _Dd) -> If; -%% expand({{list,L}, _Len, _, no_more}, T, Dd) -> -%% {NL, NLen, NDots} = expand_list(L, T, Dd, 2), -%% {{list,NL}, NLen, NDots, no_more}; expand({{tuple,IsTagged,L}, _Len, _, no_more}, T, Dd) -> {NL, NLen, NDots} = expand_list(L, T, Dd, 2), {{tuple,IsTagged,NL}, NLen, NDots, no_more}; diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index 51965ddb57..49d6a12eb2 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2018. All Rights Reserved. +%% Copyright Ericsson AB 2013-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -100,6 +100,7 @@ merge(_,_) -> erlang:nif_error(undef). put(_,_,_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:remove/2 -spec remove(Key,Map1) -> Map2 when Key :: term(), Map1 :: map(), diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index fa34f19637..57439c515e 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,574 +1,438 @@ %% -%% %CopyrightBegin% +%% WARNING: DO NOT EDIT THIS FILE. %% -%% Copyright Ericsson AB 1999-2018. All Rights Reserved. +%% This file was auto-generated from attributes in the source +%% code. %% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at +%% To add a description to a deprecation or removal attribute, +%% write a string after the arity: %% -%% http://www.apache.org/licenses/LICENSE-2.0 +%% -deprecated([{foo,1,"use bar/1 instead"}]). +%% -deprecated_type([{gadget,1,"use widget/1 instead"}]). +%% -removed([{hello,2,"use there/2 instead"}]). +%% -removed_type([{frobnitz,1,"use grunka/1 instead"}]). %% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. +%% Descriptions cannot be given with the `f/1` shorthand, and +%% it will fall back to a generic description referring the +%% user to the documentation. %% -%% %CopyrightEnd% +%% Use `./otp_build update_deprecations` to update this file +%% after adding an attribute. %% -module(otp_internal). - --export([obsolete/3, obsolete_type/3]). - -%%---------------------------------------------------------------------- - +-include("otp_internal.hrl"). +%% -dialyzer({no_match, obsolete/3}). - --type tag() :: 'deprecated' | 'removed'. %% | 'experimental'. --type mfas() :: mfa() | {atom(), atom(), [byte()]}. --type release() :: string(). - --spec obsolete(module(), atom(), arity()) -> - 'no' | {tag(), string()} | {tag(), mfas(), release()}. - -obsolete(Module, Name, Arity) -> - case obsolete_1(Module, Name, Arity) of - {deprecated=Tag,{_,_,_}=Replacement} -> - {Tag,Replacement,"a future release"}; - {_,String}=Ret when is_list(String) -> - Ret; - {_,_,_}=Ret -> - Ret; - no -> - no - end. - -obsolete_1(net, call, 4) -> - {deprecated, {rpc, call, 4}}; -obsolete_1(net, cast, 4) -> - {deprecated, {rpc, cast, 4}}; -obsolete_1(net, broadcast, 3) -> - {deprecated, {rpc, eval_everywhere, 3}}; -obsolete_1(net, ping, 1) -> - {deprecated, {net_adm, ping, 1}}; -obsolete_1(net, sleep, 1) -> - {deprecated, "Use 'receive after T -> ok end' instead"}; -obsolete_1(net, relay, 1) -> - {deprecated, {slave, relay, 1}}; - - -obsolete_1(erlang, now, 0) -> - {deprecated, - "Deprecated BIF. See the \"Time and Time Correction in Erlang\" " - "chapter of the ERTS User's Guide for more information."}; - -obsolete_1(calendar, local_time_to_universal_time, 1) -> - {deprecated, {calendar, local_time_to_universal_time_dst, 1}}; - -%% *** STDLIB added in OTP 22 *** - -obsolete_1(sys, get_debug, 3) -> - {deprecated, - "Deprecated function. " - "Incorrectly documented and in fact only for internal use. " - "Can often be replaced with sys:get_log/1."}; - -%% *** STDLIB added in OTP 20 *** - -obsolete_1(gen_fsm, start, 3) -> - {deprecated, {gen_statem, start, 3}}; -obsolete_1(gen_fsm, start, 4) -> - {deprecated, {gen_statem, start, 4}}; - -obsolete_1(gen_fsm, start_link, 3) -> - {deprecated, {gen_statem, start_link, 3}}; -obsolete_1(gen_fsm, start_link, 4) -> - {deprecated, {gen_statem, start_link, 4}}; - -obsolete_1(gen_fsm, stop, 1) -> - {deprecated, {gen_statem, stop, 1}}; -obsolete_1(gen_fsm, stop, 3) -> - {deprecated, {gen_statem, stop, 3}}; - -obsolete_1(gen_fsm, enter_loop, 4) -> - {deprecated, {gen_statem, enter_loop, 4}}; -obsolete_1(gen_fsm, enter_loop, 5) -> - {deprecated, {gen_statem, enter_loop, 5}}; -obsolete_1(gen_fsm, enter_loop, 6) -> - {deprecated, {gen_statem, enter_loop, 6}}; - -obsolete_1(gen_fsm, reply, 2) -> - {deprecated, {gen_statem, reply, 2}}; - -obsolete_1(gen_fsm, send_event, 2) -> - {deprecated, {gen_statem, cast, 2}}; -obsolete_1(gen_fsm, send_all_state_event, 2) -> - {deprecated, {gen_statem, cast, 2}}; - -obsolete_1(gen_fsm, sync_send_event, 2) -> - {deprecated, {gen_statem, call, 2}}; -obsolete_1(gen_fsm, sync_send_event, 3) -> - {deprecated, {gen_statem, call, 3}}; - -obsolete_1(gen_fsm, sync_send_all_state_event, 2) -> - {deprecated, {gen_statem, call, 2}}; -obsolete_1(gen_fsm, sync_send_all_state_event, 3) -> - {deprecated, {gen_statem, call, 3}}; - -obsolete_1(gen_fsm, start_timer, 2) -> - {deprecated, {erlang, start_timer, 3}}; -obsolete_1(gen_fsm, cancel_timer, 1) -> - {deprecated, {erlang, cancel_timer, 1}}; -obsolete_1(gen_fsm, send_event_after, 2) -> - {deprecated, {erlang, send_after, 3}}; - -%% *** CRYPTO added in OTP 20 *** - -obsolete_1(crypto, rand_uniform, 2) -> - {deprecated, {rand, uniform, 1}}; - -%% *** CRYPTO added in OTP 19 *** - -obsolete_1(crypto, rand_bytes, 1) -> - {removed, {crypto, strong_rand_bytes, 1}, "20.0"}; - -%% *** CRYPTO added in R16B01 *** - -obsolete_1(crypto, md4, 1) -> - {removed, {crypto, hash, 2}, "20.0"}; -obsolete_1(crypto, md5, 1) -> - {removed, {crypto, hash, 2}, "20.0"}; -obsolete_1(crypto, sha, 1) -> - {removed, {crypto, hash, 2}, "20.0"}; - -obsolete_1(crypto, md4_init, 0) -> - {removed, {crypto, hash_init, 1}, "20.0"}; -obsolete_1(crypto, md5_init, 0) -> - {removed, {crypto, hash_init, 1}, "20.0"}; -obsolete_1(crypto, sha_init, 0) -> - {removed, {crypto, hash_init, 1}, "20.0"}; - -obsolete_1(crypto, md4_update, 2) -> - {removed, {crypto, hash_update, 2}, "20.0"}; -obsolete_1(crypto, md5_update, 2) -> - {removed, {crypto, hash_update, 2}, "20.0"}; -obsolete_1(crypto, sha_update, 2) -> - {removed, {crypto, hash_update, 2}, "20.0"}; - -obsolete_1(crypto, md4_final, 1) -> - {removed, {crypto, hash_final, 1}, "20.0"}; -obsolete_1(crypto, md5_final, 1) -> - {removed, {crypto, hash_final, 1}, "20.0"}; -obsolete_1(crypto, sha_final, 1) -> - {removed, {crypto, hash_final, 1}, "20.0"}; - -obsolete_1(crypto, md5_mac, 2) -> - {removed, {crypto, hmac, 3}, "20.0"}; -obsolete_1(crypto, sha_mac, 2) -> - {removed, {crypto, hmac, 3}, "20.0"}; -obsolete_1(crypto, sha_mac, 3) -> - {removed, {crypto, hmac, 4}, "20.0"}; - -obsolete_1(crypto, sha_mac_96, 2) -> - {removed, {crypto, hmac, 4}, "20.0"}; -obsolete_1(crypto, md5_mac_96, 2) -> - {removed, {crypto, hmac, 4}, "20.0"}; - -obsolete_1(crypto, rsa_sign, 2) -> - {removed, {crypto, sign, 4}, "20.0"}; -obsolete_1(crypto, rsa_sign, 3) -> - {removed, {crypto, sign, 4}, "20.0"}; -obsolete_1(crypto, rsa_verify, 3) -> - {removed, {crypto, verify, 5}, "20.0"}; -obsolete_1(crypto, rsa_verify, 4) -> - {removed, {crypto, verify, 5}, "20.0"}; - -obsolete_1(crypto, dss_sign, 2) -> - {removed, {crypto, sign, 4}, "20.0"}; -obsolete_1(crypto, dss_sign, 3) -> - {removed, {crypto, sign, 4}, "20.0"}; - -obsolete_1(crypto, dss_verify, 3) -> - {removed, {crypto, verify, 5}, "20.0"}; -obsolete_1(crypto, dss_verify, 4) -> - {removed, {crypto, verify, 5}, "20.0"}; - -obsolete_1(crypto, mod_exp, 3) -> - {removed, {crypto, mod_pow, 3}, "20.0"}; - -obsolete_1(crypto, dh_compute_key, 3) -> - {removed, {crypto, compute_key, 4}, "20.0"}; -obsolete_1(crypto, dh_generate_key, 1) -> - {removed, {crypto, generate_key, 2}, "20.0"}; -obsolete_1(crypto, dh_generate_key, 2) -> - {removed, {crypto, generate_key, 3}, "20.0"}; - -obsolete_1(crypto, des_cbc_encrypt, 3) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; -obsolete_1(crypto, des3_cbc_encrypt, 5) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; -obsolete_1(crypto, des_ecb_encrypt, 2) -> - {removed, {crypto, block_encrypt, 3}, "20.0"}; -obsolete_1(crypto, des_ede3_cbc_encrypt, 5) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; -obsolete_1(crypto, des_cfb_encrypt, 3) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; -obsolete_1(crypto, des3_cfb_encrypt, 5) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; -obsolete_1(crypto, blowfish_ecb_encrypt, 2) -> - {removed, {crypto, block_encrypt, 3}, "20.0"}; -obsolete_1(crypto, blowfish_cbc_encrypt, 3) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; -obsolete_1(crypto, blowfish_cfb64_encrypt, 3) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; -obsolete_1(crypto, blowfish_ofb64_encrypt, 3) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; -obsolete_1(crypto, aes_cfb_128_encrypt, 3) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; -obsolete_1(crypto, aes_cbc_128_encrypt, 3) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; -obsolete_1(crypto, aes_cbc_256_encrypt, 3) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; -obsolete_1(crypto,rc2_cbc_encrypt, 3) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; -obsolete_1(crypto,rc2_40_cbc_encrypt, 3) -> - {removed, {crypto, block_encrypt, 4}, "20.0"}; - -obsolete_1(crypto, des_cbc_decrypt, 3) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; -obsolete_1(crypto, des3_cbc_decrypt, 5) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; -obsolete_1(crypto, des_ecb_decrypt, 2) -> - {removed, {crypto, block_decrypt, 3}, "20.0"}; -obsolete_1(crypto, des_ede3_cbc_decrypt, 5) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; -obsolete_1(crypto, des_cfb_decrypt, 3) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; -obsolete_1(crypto, des3_cfb_decrypt, 5) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; -obsolete_1(crypto, blowfish_ecb_decrypt, 2) -> - {removed, {crypto, block_decrypt, 3}, "20.0"}; -obsolete_1(crypto, blowfish_cbc_decrypt, 3) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; -obsolete_1(crypto, blowfish_cfb64_decrypt, 3) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; -obsolete_1(crypto, blowfish_ofb64_decrypt, 3) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; -obsolete_1(crypto, aes_cfb_128_decrypt, 3) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; -obsolete_1(crypto, aes_cbc_128_decrypt, 3) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; -obsolete_1(crypto, aes_cbc_256_decrypt, 3) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; -obsolete_1(crypto,rc2_cbc_decrypt, 3) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; -obsolete_1(crypto,rc2_40_cbc_decrypt, 3) -> - {removed, {crypto, block_decrypt, 4}, "20.0"}; - -obsolete_1(crypto, aes_ctr_stream_decrypt, 2) -> - {removed, {crypto, stream_decrypt, 2}, "20.0"}; -obsolete_1(crypto, aes_ctr_stream_encrypt, 2) -> - {removed, {crypto, stream_encrypt, 2}, "20.0"}; -obsolete_1(crypto, aes_ctr_decrypt, 3) -> - {removed, {crypto, stream_decrypt, 2}, "20.0"}; -obsolete_1(crypto, aes_ctr_encrypt, 3) -> - {removed, {crypto, stream_encrypt, 2}, "20.0"}; -obsolete_1(crypto, rc4_encrypt, 2) -> - {removed, {crypto, stream_encrypt, 2}, "20.0"}; -obsolete_1(crypto, rc4_encrypt_with_state, 2) -> - {removed, {crypto, stream_encrypt, 2}, "20.0"}; -obsolete_1(crypto, aes_ctr_stream_init, 2) -> - {removed, {crypto, stream_init, 3}, "20.0"}; -obsolete_1(crypto, rc4_set_key, 1) -> - {removed, {crypto, stream_init, 2}, "20.0"}; - -obsolete_1(crypto, rsa_private_decrypt, 3) -> - {removed, {crypto, private_decrypt, 4}, "20.0"}; -obsolete_1(crypto, rsa_public_decrypt, 3) -> - {removed, {crypto, public_decrypt, 4}, "20.0"}; -obsolete_1(crypto, rsa_private_encrypt, 3) -> - {removed, {crypto, private_encrypt, 4}, "20.0"}; -obsolete_1(crypto, rsa_public_encrypt, 3) -> - {removed, {crypto, public_encrypt, 4}, "20.0"}; - -obsolete_1(crypto, des_cfb_ivec, 2) -> - {removed, {crypto, next_iv, 3}, "20.0"}; -obsolete_1(crypto,des_cbc_ivec, 1) -> - {removed, {crypto, next_iv, 2}, "20.0"}; -obsolete_1(crypto, aes_cbc_ivec, 1) -> - {removed, {crypto, next_iv, 2}, "20.0"}; - -obsolete_1(crypto,info, 0) -> - {removed, {crypto, module_info, 0}, "20.0"}; - -obsolete_1(crypto, strong_rand_mpint, 3) -> - {removed, "removed in 20.0; only needed by removed functions"}; -obsolete_1(crypto, erlint, 1) -> - {removed, "removed in 20.0; only needed by removed functions"}; -obsolete_1(crypto, mpint, 1) -> - {removed, "removed in 20.0; only needed by removed functions"}; - - -%% *** SNMP *** - -obsolete_1(snmp, N, A) -> - case is_snmp_agent_function(N, A) of - false -> - no; - true -> - {deprecated, "Deprecated (will be removed in OTP 18); use snmpa:"++atom_to_list(N)++"/"++ - integer_to_list(A)++" instead"} - end; - -obsolete_1(snmpa, old_info_format, 1) -> - {deprecated, "Deprecated; (will be removed in OTP 18); use \"new\" format instead"}; - - -%% *** MEGACO *** - -obsolete_1(megaco, format_versions, 1) -> - {deprecated, "Deprecated; use megaco:print_version_info/0,1 instead"}; - - -%% *** OS-MON-MIB *** - -%% FIXME: Remove this warning in OTP 24. -obsolete_1(os_mon_mib, _, _) -> - {removed, "was removed in 22.0"}; - -obsolete_1(auth, is_auth, 1) -> - {deprecated, {net_adm, ping, 1}}; -obsolete_1(auth, cookie, 0) -> - {deprecated, {erlang, get_cookie, 0}}; -obsolete_1(auth, cookie, 1) -> - {deprecated, {erlang, set_cookie, 2}}; -obsolete_1(auth, node_cookie, 1) -> - {deprecated, "Deprecated; use erlang:set_cookie/2 and net_adm:ping/1 instead"}; -obsolete_1(auth, node_cookie, 2) -> - {deprecated, "Deprecated; use erlang:set_cookie/2 and net_adm:ping/1 instead"}; - -%% Added in R16 -obsolete_1(wxCalendarCtrl, enableYearChange, _) -> %% wx bug documented? - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxDC, computeScaleAndOrigin, 1) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxClientDC, new, 0) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxPaintDC, new, 0) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxWindowDC, new, 0) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxGraphicsRenderer, createLinearGradientBrush, 7) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxGraphicsRenderer, createRadialGradientBrush, 8) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxGridCellEditor, endEdit, 4) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxGridCellEditor, paintBackground, 3) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxIdleEvent, canSend, 1) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxMDIClientWindow, new, 1) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxMDIClientWindow, new, 2) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxPostScriptDC, getResolution, 0) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxPostScriptDC, setResolution, 1) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxCursor, new, 3) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; -obsolete_1(wxCursor, new, 4) -> - {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; - -%% Added in OTP 17. -obsolete_1(asn1ct, decode,3) -> - {removed,"removed; use Mod:decode/2 instead"}; -obsolete_1(asn1ct, encode, 2) -> - {removed,"removed; use Mod:encode/2 instead"}; -obsolete_1(asn1ct, encode, 3) -> - {removed,"removed; use Mod:encode/2 instead"}; -obsolete_1(asn1rt, decode,3) -> - {removed,"removed; use Mod:decode/2 instead"}; -obsolete_1(asn1rt, encode, 2) -> - {removed,"removed; use Mod:encode/2 instead"}; -obsolete_1(asn1rt, encode, 3) -> - {removed,"removed; use Mod:encode/2 instead"}; -obsolete_1(asn1rt, info, 1) -> - {removed,"removed; use Mod:info/0 instead"}; -obsolete_1(asn1rt, utf8_binary_to_list, 1) -> - {removed,{unicode,characters_to_list,1},"OTP 20"}; -obsolete_1(asn1rt, utf8_list_to_binary, 1) -> - {removed,{unicode,characters_to_binary,1},"OTP 20"}; - -%% Added in OTP 18. -obsolete_1(core_lib, get_anno, 1) -> - {removed,{cerl,get_ann,1},"19"}; -obsolete_1(core_lib, set_anno, 2) -> - {removed,{cerl,set_ann,2},"19"}; -obsolete_1(core_lib, is_literal, 1) -> - {removed,{cerl,is_literal,1},"19"}; -obsolete_1(core_lib, is_literal_list, 1) -> - {removed,"removed; use lists:all(fun cerl:is_literal/1, L)" - " instead"}; -obsolete_1(core_lib, literal_value, 1) -> - {removed,{core_lib,concrete,1},"19"}; -obsolete_1(erl_scan, set_attribute, 3) -> - {removed,{erl_anno,set_line,2},"19.0"}; -obsolete_1(erl_scan, attributes_info, 1) -> - {removed,"removed in 19.0; use " - "erl_anno:{column,line,location,text}/1 instead"}; -obsolete_1(erl_scan, attributes_info, 2) -> - {removed,"removed in 19.0; use " - "erl_anno:{column,line,location,text}/1 instead"}; -obsolete_1(erl_scan, token_info, 1) -> - {removed,"removed in 19.0; use " - "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; -obsolete_1(erl_scan, token_info, 2) -> - {removed,"removed in 19.0; use " - "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; -obsolete_1(erl_parse, set_line, 2) -> - {removed,{erl_anno,set_line,2},"19.0"}; -obsolete_1(erl_parse, get_attributes, 1) -> - {removed,"removed in 19.0; use " - "erl_anno:{column,line,location,text}/1 instead"}; -obsolete_1(erl_parse, get_attribute, 2) -> - {removed,"removed in 19.0; use " - "erl_anno:{column,line,location,text}/1 instead"}; -obsolete_1(erl_lint, modify_line, 2) -> - {removed,{erl_parse,map_anno,2},"19.0"}; -obsolete_1(ssl, negotiated_next_protocol, 1) -> - {removed,"removed in 20.0; use ssl:negotiated_protocol/1 instead"}; -obsolete_1(ssl, connection_info, 1) -> - {removed, "removed in 20.0; use ssl:connection_information/[1,2] instead"}; - -obsolete_1(httpd_conf, check_enum, 2) -> - {deprecated, "deprecated; use lists:member/2 instead"}; -obsolete_1(httpd_conf, clean, 1) -> - {deprecated, "deprecated; use sting:strip/1 instead or possible the re module"}; -obsolete_1(httpd_conf, custom_clean, 3) -> - {deprecated, "deprecated; use sting:strip/3 instead or possible the re module"}; -obsolete_1(httpd_conf, is_directory, 1) -> - {deprecated, "deprecated; use filelib:is_dir/1 instead"}; -obsolete_1(httpd_conf, is_file, 1) -> - {deprecated, "deprecated; use filelib:is_file/1 instead"}; -obsolete_1(httpd_conf, make_integer, 1) -> - {deprecated, "deprecated; use erlang:list_to_integer/1 instead"}; - -%% Added in OTP 19. - -obsolete_1(random, _, _) -> - {deprecated, "the 'random' module is deprecated; " - "use the 'rand' module instead"}; -obsolete_1(code, rehash, 0) -> - {deprecated, "deprecated because the code path cache feature has been removed"}; -obsolete_1(queue, lait, 1) -> - {deprecated, {queue,liat,1}}; - -%% Removed in OTP 19. - -obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 -> - {removed, {rpc, multi_server_call, A}, "19.0"}; - -%% Added in OTP 20. - -obsolete_1(filename, find_src, 1) -> - {deprecated, "deprecated; use filelib:find_source/1 instead"}; -obsolete_1(filename, find_src, 2) -> - {deprecated, "deprecated; use filelib:find_source/3 instead"}; - -obsolete_1(erlang, get_stacktrace, 0) -> - {deprecated, "deprecated; use the new try/catch syntax for retrieving the stack backtrace"}; - -%% Removed in OTP 20. - -obsolete_1(erlang, hash, 2) -> - {removed, {erlang, phash2, 2}, "20.0"}; - -%% Add in OTP 21. - -obsolete_1(ssl, ssl_accept, 1) -> - {deprecated, "deprecated; use ssl:handshake/1 instead"}; -obsolete_1(ssl, ssl_accept, 2) -> - {deprecated, "deprecated; use ssl:handshake/2 instead"}; -obsolete_1(ssl, ssl_accept, 3) -> - {deprecated, "deprecated; use ssl:handshake/3 instead"}; -obsolete_1(otp_mib, F, _) when F =:= load; F =:= unload -> - {deprecated, "deprecated; functionality will be removed in a future release"}; - -%% not obsolete - -obsolete_1(_, _, _) -> - no. - --spec is_snmp_agent_function(atom(), byte()) -> boolean(). - -is_snmp_agent_function(c, 1) -> true; -is_snmp_agent_function(c, 2) -> true; -is_snmp_agent_function(compile, 3) -> true; -is_snmp_agent_function(is_consistent, 1) -> true; -is_snmp_agent_function(mib_to_hrl, 1) -> true; -is_snmp_agent_function(change_log_size, 1) -> true; -is_snmp_agent_function(log_to_txt, 2) -> true; -is_snmp_agent_function(log_to_txt, 3) -> true; -is_snmp_agent_function(log_to_txt, 4) -> true; -is_snmp_agent_function(current_request_id, 0) -> true; -is_snmp_agent_function(current_community, 0) -> true; -is_snmp_agent_function(current_address, 0) -> true; -is_snmp_agent_function(current_context, 0) -> true; -is_snmp_agent_function(current_net_if_data, 0) -> true; -is_snmp_agent_function(get_symbolic_store_db, 0) -> true; -is_snmp_agent_function(name_to_oid, 1) -> true; -is_snmp_agent_function(name_to_oid, 2) -> true; -is_snmp_agent_function(oid_to_name, 1) -> true; -is_snmp_agent_function(oid_to_name, 2) -> true; -is_snmp_agent_function(int_to_enum, 2) -> true; -is_snmp_agent_function(int_to_enum, 3) -> true; -is_snmp_agent_function(enum_to_int, 2) -> true; -is_snmp_agent_function(enum_to_int, 3) -> true; -is_snmp_agent_function(get, 2) -> true; -is_snmp_agent_function(info, 1) -> true; -is_snmp_agent_function(load_mibs, 2) -> true; -is_snmp_agent_function(unload_mibs, 2) -> true; -is_snmp_agent_function(dump_mibs, 0) -> true; -is_snmp_agent_function(dump_mibs, 1) -> true; -is_snmp_agent_function(register_subagent, 3) -> true; -is_snmp_agent_function(unregister_subagent, 2) -> true; -is_snmp_agent_function(send_notification, 3) -> true; -is_snmp_agent_function(send_notification, 4) -> true; -is_snmp_agent_function(send_notification, 5) -> true; -is_snmp_agent_function(send_notification, 6) -> true; -is_snmp_agent_function(send_trap, 3) -> true; -is_snmp_agent_function(send_trap, 4) -> true; -is_snmp_agent_function(add_agent_caps, 2) -> true; -is_snmp_agent_function(del_agent_caps, 1) -> true; -is_snmp_agent_function(get_agent_caps, 0) -> true; -is_snmp_agent_function(_, _) -> false. - --dialyzer({no_match, obsolete_type/3}). - --spec obsolete_type(module(), atom(), arity()) -> - 'no' | {tag(), string()} | {tag(), mfas(), release()}. +obsolete(auth, cookie, 0) -> + {deprecated, "use erlang:get_cookie/0 instead"}; +obsolete(auth, cookie, 1) -> + {deprecated, "use erlang:set_cookie/2 instead"}; +obsolete(auth, is_auth, 1) -> + {deprecated, "use net_adm:ping/1 instead"}; +obsolete(calendar, local_time_to_universal_time, 1) -> + {deprecated, "use calendar:local_time_to_universal_time_dst/1 instead"}; +obsolete(code, rehash, 0) -> + {deprecated, "the code path cache feature has been removed"}; +obsolete(crypto, block_decrypt, 3) -> + {deprecated, "use crypto:crypto_one_time/4 or crypto:crypto_init/3 + crypto:crypto_update/2 + crypto:crypto_final/1 instead"}; +obsolete(crypto, block_decrypt, 4) -> + {deprecated, "use crypto:crypto_one_time/5, crypto:crypto_one_time_aead/6,7 or crypto:crypto_(dyn_iv)?_init + crypto:crypto_(dyn_iv)?_update + crypto:crypto_final instead"}; +obsolete(crypto, block_encrypt, 3) -> + {deprecated, "use crypto:crypto_one_time/4 or crypto:crypto_init/3 + crypto:crypto_update/2 + crypto:crypto_final/1 instead"}; +obsolete(crypto, block_encrypt, 4) -> + {deprecated, "use crypto:crypto_one_time/5, crypto:crypto_one_time_aead/6,7 or crypto:crypto_(dyn_iv)?_init + crypto:crypto_(dyn_iv)?_update + crypto:crypto_final instead"}; +obsolete(crypto, cmac, 3) -> + {deprecated, "use crypto:mac/4 instead"}; +obsolete(crypto, cmac, 4) -> + {deprecated, "use crypto:macN/5 instead"}; +obsolete(crypto, hmac, 3) -> + {deprecated, "use crypto:mac/4 instead"}; +obsolete(crypto, hmac, 4) -> + {deprecated, "use crypto:macN/5 instead"}; +obsolete(crypto, hmac_final, 1) -> + {deprecated, "use crypto:mac_final/1 instead"}; +obsolete(crypto, hmac_final_n, 2) -> + {deprecated, "use crypto:mac_finalN/2 instead"}; +obsolete(crypto, hmac_init, 2) -> + {deprecated, "use crypto:mac_init/3 instead"}; +obsolete(crypto, hmac_update, 2) -> + {deprecated, "use crypto:mac_update/2 instead"}; +obsolete(crypto, poly1305, 2) -> + {deprecated, "use crypto:mac/3 instead"}; +obsolete(crypto, rand_uniform, 2) -> + {deprecated, "use rand:rand_uniform/1 instead"}; +obsolete(crypto, stream_decrypt, 2) -> + {deprecated, "use crypto:crypto_update/2 instead"}; +obsolete(crypto, stream_encrypt, 2) -> + {deprecated, "use crypto:crypto_update/2 instead"}; +obsolete(erlang, get_stacktrace, 0) -> + {deprecated, "use the new try/catch syntax for retrieving the stack backtrace"}; +obsolete(erlang, now, 0) -> + {deprecated, "see the \"Time and Time Correction in Erlang\" chapter of the ERTS User's Guide for more information"}; +obsolete(filename, safe_relative_path, 1) -> + {deprecated, "use filelib:safe_relative_path/2 instead"}; +obsolete(http_uri, decode, 1) -> + {deprecated, "use uri_string functions instead"}; +obsolete(http_uri, encode, 1) -> + {deprecated, "use uri_string functions instead"}; +obsolete(http_uri, parse, 1) -> + {deprecated, "use uri_string functions instead"}; +obsolete(http_uri, parse, 2) -> + {deprecated, "use uri_string functions instead"}; +obsolete(http_uri, scheme_defaults, 0) -> + {deprecated, "use uri_string functions instead"}; +obsolete(httpd, parse_query, 1) -> + {deprecated, "use uri_string:dissect_query/1 instead"}; +obsolete(megaco, format_versions, 1) -> + {deprecated, "use megaco:print_version_info/0,1 instead"}; +obsolete(net, broadcast, 3) -> + {deprecated, "use rpc:eval_everywhere/3 instead"}; +obsolete(net, call, 4) -> + {deprecated, "use rpc:call/4 instead"}; +obsolete(net, cast, 4) -> + {deprecated, "use rpc:cast/4 instead"}; +obsolete(net, ping, 1) -> + {deprecated, "use net_adm:ping/1 instead"}; +obsolete(net, relay, 1) -> + {deprecated, "use slave:relay/1 instead"}; +obsolete(net, sleep, 1) -> + {deprecated, "use 'receive after T -> ok end' instead"}; +obsolete(queue, lait, 1) -> + {deprecated, "use queue:liat/1 instead"}; +obsolete(snmp, add_agent_caps, 2) -> + {deprecated, "use snmpa:add_agent_caps/2 instead"}; +obsolete(snmp, c, 1) -> + {deprecated, "use snmpa:c/1 instead"}; +obsolete(snmp, c, 2) -> + {deprecated, "use snmpa:c/2 instead"}; +obsolete(snmp, change_log_size, 1) -> + {deprecated, "use snmpa:change_log_size/1 instead"}; +obsolete(snmp, compile, 3) -> + {deprecated, "use snmpa:compile/3 instead"}; +obsolete(snmp, current_address, 0) -> + {deprecated, "use snmpa:current_address/0 instead"}; +obsolete(snmp, current_community, 0) -> + {deprecated, "use snmpa:current_community/0 instead"}; +obsolete(snmp, current_context, 0) -> + {deprecated, "use snmpa:current_context/0 instead"}; +obsolete(snmp, current_net_if_data, 0) -> + {deprecated, "use snmpa:current_net_if_data/0 instead"}; +obsolete(snmp, current_request_id, 0) -> + {deprecated, "use snmpa:current_request_id/0 instead"}; +obsolete(snmp, del_agent_caps, 1) -> + {deprecated, "use snmpa:del_agent_caps/1 instead"}; +obsolete(snmp, dump_mibs, 0) -> + {deprecated, "use snmpa:dump_mibs/0 instead"}; +obsolete(snmp, dump_mibs, 1) -> + {deprecated, "use snmpa:dump_mibs/1 instead"}; +obsolete(snmp, enum_to_int, 2) -> + {deprecated, "use snmpa:enum_to_int/2 instead"}; +obsolete(snmp, enum_to_int, 3) -> + {deprecated, "use snmpa:enum_to_int/3 instead"}; +obsolete(snmp, get, 2) -> + {deprecated, "use snmpa:get/2 instead"}; +obsolete(snmp, get_agent_caps, 0) -> + {deprecated, "use snmpa:get_agent_caps/0 instead"}; +obsolete(snmp, get_symbolic_store_db, 0) -> + {deprecated, "use snmpa:get_symbolic_store_db/0 instead"}; +obsolete(snmp, info, 1) -> + {deprecated, "use snmpa:info/1 instead"}; +obsolete(snmp, int_to_enum, 2) -> + {deprecated, "use snmpa:int_to_enum/2 instead"}; +obsolete(snmp, int_to_enum, 3) -> + {deprecated, "use snmpa:int_to_enum/3 instead"}; +obsolete(snmp, is_consistent, 1) -> + {deprecated, "use snmpa:is_consistent/1 instead"}; +obsolete(snmp, load_mibs, 2) -> + {deprecated, "use snmpa:load_mibs/2 instead"}; +obsolete(snmp, log_to_txt, 2) -> + {deprecated, "use snmpa:log_to_txt/2 instead"}; +obsolete(snmp, log_to_txt, 3) -> + {deprecated, "use snmpa:log_to_txt/3 instead"}; +obsolete(snmp, log_to_txt, 4) -> + {deprecated, "use snmpa:log_to_txt/4 instead"}; +obsolete(snmp, mib_to_hrl, 1) -> + {deprecated, "use snmpa:mib_to_hrl/1 instead"}; +obsolete(snmp, name_to_oid, 1) -> + {deprecated, "use snmpa:name_to_oid/1 instead"}; +obsolete(snmp, name_to_oid, 2) -> + {deprecated, "use snmpa:name_to_oid/2 instead"}; +obsolete(snmp, oid_to_name, 1) -> + {deprecated, "use snmpa:oid_to_name/1 instead"}; +obsolete(snmp, oid_to_name, 2) -> + {deprecated, "use snmpa:oid_to_name/2 instead"}; +obsolete(snmp, register_subagent, 3) -> + {deprecated, "use snmpa:register_subagent/3 instead"}; +obsolete(snmp, send_notification, 3) -> + {deprecated, "use snmpa:send_notification/3 instead"}; +obsolete(snmp, send_notification, 4) -> + {deprecated, "use snmpa:send_notification/4 instead"}; +obsolete(snmp, send_notification, 5) -> + {deprecated, "use snmpa:send_notification/5 instead"}; +obsolete(snmp, send_notification, 6) -> + {deprecated, "use snmpa:send_notification/6 instead"}; +obsolete(snmp, send_trap, 3) -> + {deprecated, "use snmpa:send_trap/3 instead"}; +obsolete(snmp, send_trap, 4) -> + {deprecated, "use snmpa:send_trap/4 instead"}; +obsolete(snmp, unload_mibs, 2) -> + {deprecated, "use snmpa:unload_mibs/2 instead"}; +obsolete(snmp, unregister_subagent, 2) -> + {deprecated, "use snmpa:unregister_subagent/2 instead"}; +obsolete(snmpa, old_info_format, 1) -> + {deprecated, "use \"new\" format instead"}; +obsolete(sys, get_debug, 3) -> + {deprecated, "incorrectly documented and only for internal use. Can often be replaced with sys:get_log/1"}; +obsolete(wxClientDC, new, 0) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxCursor, new, 3) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxCursor, new, 4) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxDC, computeScaleAndOrigin, 1) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxGraphicsRenderer, createLinearGradientBrush, 7) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxGraphicsRenderer, createRadialGradientBrush, 8) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxGridCellEditor, endEdit, 4) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxGridCellEditor, paintBackground, 3) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxIdleEvent, canSend, 1) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxMDIClientWindow, new, 1) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxMDIClientWindow, new, 2) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxPaintDC, new, 0) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxPostScriptDC, getResolution, 0) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxPostScriptDC, setResolution, 1) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(wxWindowDC, new, 0) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(core_lib, get_anno, 1) -> + {removed, "use cerl:get_ann/1 instead"}; +obsolete(core_lib, is_literal, 1) -> + {removed, "use cerl:is_literal/1 instead"}; +obsolete(core_lib, is_literal_list, 1) -> + {removed, "use cerl:is_literal_list/1 instead"}; +obsolete(core_lib, literal_value, 1) -> + {removed, "use cerl:concrete/1 instead"}; +obsolete(core_lib, set_anno, 2) -> + {removed, "use cerl:set_ann/2 instead"}; +obsolete(crypto, aes_cbc_128_decrypt, 3) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, aes_cbc_128_encrypt, 3) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, aes_cbc_256_decrypt, 3) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, aes_cbc_256_encrypt, 3) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, aes_cbc_ivec, 2) -> + {removed, "use crypto:next_iv/2 instead"}; +obsolete(crypto, aes_cfb_128_decrypt, 3) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, aes_cfb_128_encrypt, 3) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, aes_ctr_decrypt, 3) -> + {removed, "use crypto:stream_decrypt/2 instead"}; +obsolete(crypto, aes_ctr_encrypt, 3) -> + {removed, "use crypto:stream_encrypt/2 instead"}; +obsolete(crypto, aes_ctr_stream_decrypt, 2) -> + {removed, "use crypto:stream_decrypt/2 instead"}; +obsolete(crypto, aes_ctr_stream_encrypt, 2) -> + {removed, "use crypto:stream_encrypt/2 instead"}; +obsolete(crypto, aes_ctr_stream_init, 2) -> + {removed, "use crypto:stream_init/3 instead"}; +obsolete(crypto, blowfish_cbc_decrypt, 3) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, blowfish_cbc_encrypt, 3) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, blowfish_cfb64_decrypt, 3) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, blowfish_cfb64_encrypt, 3) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, blowfish_ecb_decrypt, 2) -> + {removed, "use crypto:block_decrypt/3 instead"}; +obsolete(crypto, blowfish_ecb_encrypt, 2) -> + {removed, "use crypto:block_encrypt/3 instead"}; +obsolete(crypto, blowfish_ofb64_decrypt, 3) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, blowfish_ofb64_encrypt, 3) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, des3_cbc_decrypt, 5) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, des3_cbc_encrypt, 5) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, des3_cfb_decrypt, 5) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, des3_cfb_encrypt, 5) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, des3_ede3_cbc_decrypt, 5) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, des_cbc_decrypt, 3) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, des_cbc_encrypt, 3) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, des_cbc_ivec, 2) -> + {removed, "use crypto:next_iv/2 instead"}; +obsolete(crypto, des_cfb_decrypt, 3) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, des_cfb_encrypt, 3) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, des_cfb_ivec, 2) -> + {removed, "use crypto:next_iv/3 instead"}; +obsolete(crypto, des_ecb_decrypt, 2) -> + {removed, "use crypto:block_decrypt/3 instead"}; +obsolete(crypto, des_ecb_encrypt, 2) -> + {removed, "use crypto:block_encrypt/3 instead"}; +obsolete(crypto, des_ede3_cbc_encrypt, 5) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, dh_compute_key, 3) -> + {removed, "use crypto:compute_key/4 instead"}; +obsolete(crypto, dh_generate_key, 1) -> + {removed, "use crypto:generate_key/2 instead"}; +obsolete(crypto, dh_generate_key, 2) -> + {removed, "use crypto:generate_key/3 instead"}; +obsolete(crypto, erlint, 1) -> + {removed, "only needed by other removed functions"}; +obsolete(crypto, info, 0) -> + {removed, "use crypto:module_info/0 instead"}; +obsolete(crypto, md4, 1) -> + {removed, "use crypto:hash/2 instead"}; +obsolete(crypto, md4_final, 1) -> + {removed, "use crypto:hash_final/1 instead"}; +obsolete(crypto, md4_init, 0) -> + {removed, "use crypto:hash_init/1 instead"}; +obsolete(crypto, md4_update, 2) -> + {removed, "use crypto:hash_update/2 instead"}; +obsolete(crypto, md5, 1) -> + {removed, "use crypto:hash/2 instead"}; +obsolete(crypto, md5_final, 1) -> + {removed, "use crypto:hash_final/1 instead"}; +obsolete(crypto, md5_init, 0) -> + {removed, "use crypto:hash_init/1 instead"}; +obsolete(crypto, md5_mac, 2) -> + {removed, "use crypto:hmac/3 instead"}; +obsolete(crypto, md5_mac_96, 2) -> + {removed, "use crypto:hmac/4 instead"}; +obsolete(crypto, md5_update, 2) -> + {removed, "use crypto:hash_update/2 instead"}; +obsolete(crypto, mod_exp, 3) -> + {removed, "use crypto:mod_pow/3 instead"}; +obsolete(crypto, mpint, 1) -> + {removed, "only needed by other removed functions"}; +obsolete(crypto, rand_bytes, 1) -> + {removed, "use crypto:strong_rand_bytes/1 instead"}; +obsolete(crypto, rc2_40_cbc_decrypt, 3) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, rc2_40_cbc_encrypt, 3) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, rc2_cbc_decrypt, 3) -> + {removed, "use crypto:block_decrypt/4 instead"}; +obsolete(crypto, rc2_cbc_encrypt, 3) -> + {removed, "use crypto:block_encrypt/4 instead"}; +obsolete(crypto, rc4_encrypt, 2) -> + {removed, "use crypto:stream_encrypt/2 instead"}; +obsolete(crypto, rc4_encrypt_with_state, 2) -> + {removed, "use crypto:stream_encrypt/2 instead"}; +obsolete(crypto, rc4_set_key, 2) -> + {removed, "use crypto:stream_init/2 instead"}; +obsolete(crypto, sha, 1) -> + {removed, "use crypto:hash/2 instead"}; +obsolete(crypto, sha_final, 1) -> + {removed, "use crypto:hash_final/1 instead"}; +obsolete(crypto, sha_init, 0) -> + {removed, "use crypto:hash_init/1 instead"}; +obsolete(crypto, sha_mac, 2) -> + {removed, "use crypto:hmac/3 instead"}; +obsolete(crypto, sha_mac, 3) -> + {removed, "use crypto:hmac/4 instead"}; +obsolete(crypto, sha_mac_96, 2) -> + {removed, "use crypto:hmac/4 instead"}; +obsolete(crypto, sha_update, 2) -> + {removed, "use crypto:hash_update/2 instead"}; +obsolete(crypto, strong_rand_mpint, 3) -> + {removed, "only needed by other removed functions"}; +obsolete(erl_lint, modify_line, 2) -> + {removed, "use erl_parse:map_anno/2 instead"}; +obsolete(erl_parse, get_attribute, 2) -> + {removed, "erl_anno:{column,line,location,text}/1 instead"}; +obsolete(erl_parse, get_attributes, 1) -> + {removed, "erl_anno:{column,line,location,text}/1 instead"}; +obsolete(erl_parse, set_line, 2) -> + {removed, "use erl_anno:set_line/2"}; +obsolete(erl_scan, set_attribute, 3) -> + {removed, "use erl_anno:set_line/2 instead"}; +obsolete(erlang, hash, 2) -> + {removed, "use erlang:phash2/2 instead"}; +obsolete(httpd_conf, check_enum, 2) -> + {removed, "use lists:member/2 instead"}; +obsolete(httpd_conf, clean, 1) -> + {removed, "use sting:strip/1 instead or possibly the re module"}; +obsolete(httpd_conf, custom_clean, 3) -> + {removed, "use sting:strip/1 instead or possibly the re module"}; +obsolete(httpd_conf, is_directory, 1) -> + {removed, "use filelib:is_dir/1 instead"}; +obsolete(httpd_conf, is_file, 1) -> + {removed, "use filelib:is_file/1 instead"}; +obsolete(httpd_conf, make_integer, 1) -> + {removed, "use erlang:list_to_integer/1 instead"}; +obsolete(rpc, safe_multi_server_call, 2) -> + {removed, "use rpc:multi_server_call/2 instead"}; +obsolete(rpc, safe_multi_server_call, 3) -> + {removed, "use rpc:multi_server_call/3 instead"}; +obsolete(ssl, connection_info, 1) -> + {removed, "use ssl:connection_information/[1,2] instead"}; +obsolete(ssl, negotiated_next_protocol, 1) -> + {removed, "use ssl:negotiated_protocol/1 instead"}; +obsolete(auth, node_cookie, _) -> + {deprecated, "use erlang:set_cookie/2 and net_adm:ping/1 instead"}; +obsolete(crypto, next_iv, _) -> + {deprecated, "see the 'New and Old API' chapter of the CRYPTO User's guide"}; +obsolete(crypto, stream_init, _) -> + {deprecated, "use crypto:crypto_init/3 + crypto:crypto_update/2 + crypto:crypto_final/1 or crypto:crypto_one_time/4 instead"}; +obsolete(filename, find_src, _) -> + {deprecated, "use filelib:find_source/1,3 instead"}; +obsolete(ssl, ssl_accept, _) -> + {deprecated, "use ssl_handshake/1,2,3 instead"}; +obsolete(wxCalendarCtrl, enableYearChange, _) -> + {deprecated, "not available in wxWidgets-2.9 and later"}; +obsolete(asn1ct, decode, _) -> + {removed, "use Mod:decode/2 instead"}; +obsolete(asn1ct, encode, _) -> + {removed, "use Mod:encode/2 instead"}; +obsolete(crypto, dss_sign, _) -> + {removed, "use crypto:sign/4 instead"}; +obsolete(crypto, dss_verify, _) -> + {removed, "use crypto:verify/5 instead"}; +obsolete(crypto, rsa_sign, _) -> + {removed, "use crypto:sign/4 instead"}; +obsolete(crypto, rsa_verify, _) -> + {removed, "use crypto:verify/5 instead"}; +obsolete(erl_scan, attributes_info, _) -> + {removed, "erl_anno:{column,line,location,text}/1 instead"}; +obsolete(erl_scan, token_info, _) -> + {removed, "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; +obsolete(gen_fsm, _, _) -> + {deprecated, "use the 'gen_statem' module instead"}; +obsolete(pg2, _, _) -> + {deprecated, "the 'pg2' module is deprecated and scheduled for removal in OTP 24; use 'pg' instead."}; +obsolete(random, _, _) -> + {deprecated, "use the 'rand' module instead"}; +obsolete(os_mon_mib, _, _) -> + {removed, "this module was removed in OTP 22.0"}; +obsolete(_,_,_) -> no. -dialyzer({no_match, obsolete_type/3}). -obsolete_type(Module, Name, NumberOfVariables) -> - case obsolete_type_1(Module, Name, NumberOfVariables) of - {deprecated=Tag,{_,_,_}=Replacement} -> - {Tag,Replacement,"in a future release"}; - {_,String}=Ret when is_list(String) -> - Ret; - {_,_,_}=Ret -> - Ret; - no -> - no - end. +obsolete_type(erl_scan, column, 0) -> + {removed, "use erl_anno:column() instead"}; +obsolete_type(erl_scan, line, 0) -> + {removed, "use erl_anno:line() instead"}; +obsolete_type(erl_scan, location, 0) -> + {removed, "use erl_anno:location() instead"}; +obsolete_type(_,_,_) -> no. -obsolete_type_1(erl_scan,column,0) -> - {removed,{erl_anno,column,0},"19.0"}; -obsolete_type_1(erl_scan,line,0) -> - {removed,{erl_anno,line,0},"19.0"}; -obsolete_type_1(erl_scan,location,0) -> - {removed,{erl_anno,location,0},"19.0"}; -obsolete_type_1(_,_,_) -> - no. diff --git a/lib/stdlib/src/otp_internal.hrl b/lib/stdlib/src/otp_internal.hrl new file mode 100644 index 0000000000..ace1fa5cc1 --- /dev/null +++ b/lib/stdlib/src/otp_internal.hrl @@ -0,0 +1,36 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2020. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% This file is included by the file "otp_internal.erl", which is +%% auto-generated by stdlib/scripts/update_deprecations +%% + +-export([obsolete/3, obsolete_type/3]). + +-type tag() :: 'deprecated' | 'removed'. %% | 'experimental'. +-type mfas() :: mfa() | {atom(), atom(), [byte()]}. +-type release() :: string(). + +-spec obsolete(module(), atom(), arity()) -> + 'no' | {tag(), string()} | {tag(), mfas(), release()}. + +-spec obsolete_type(module(), atom(), arity()) -> + 'no' | {tag(), string()} | {tag(), mfas(), release()}. diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index cfbaf8b242..58e6faf950 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,6 +28,7 @@ spawn/3, spawn_link/3, spawn/4, spawn_link/4, spawn_opt/2, spawn_opt/3, spawn_opt/4, spawn_opt/5, start/3, start/4, start/5, start_link/3, start_link/4, start_link/5, + start_monitor/3, start_monitor/4, start_monitor/5, hibernate/3, init_ack/1, init_ack/2, init_p/3,init_p/5,format/1,format/2,format/3,report_cb/2, @@ -39,25 +40,21 @@ -export([wake_up/3]). -export_type([spawn_option/0]). +-export_type([start_spawn_option/0]). -include("logger.hrl"). %%----------------------------------------------------------------------------- --type priority_level() :: 'high' | 'low' | 'max' | 'normal'. --type max_heap_size() :: non_neg_integer() | - #{ size => non_neg_integer(), - kill => true, - error_logger => true}. --type spawn_option() :: 'link' - | 'monitor' - | {'priority', priority_level()} - | {'max_heap_size', max_heap_size()} - | {'min_heap_size', non_neg_integer()} - | {'min_bin_vheap_size', non_neg_integer()} - | {'fullsweep_after', non_neg_integer()} - | {'message_queue_data', - 'off_heap' | 'on_heap' | 'mixed' }. +-type start_spawn_option() :: 'link' + | {'priority', erlang:priority_level()} + | {'max_heap_size', erlang:max_heap_size()} + | {'min_heap_size', non_neg_integer()} + | {'min_bin_vheap_size', non_neg_integer()} + | {'fullsweep_after', non_neg_integer()} + | {'message_queue_data', erlang:message_queue_data() }. + +-type spawn_option() :: erlang:spawn_opt_option(). -type dict_or_pid() :: pid() | (ProcInfo :: [_]) @@ -65,6 +62,14 @@ %%----------------------------------------------------------------------------- +-define(VERIFY_NO_MONITOR_OPT(M, F, A, T, Opts), + case lists:member(monitor, Opts) of + true -> erlang:error(badarg, [M,F,A,T,Opts]); + false -> ok + end). + +%%----------------------------------------------------------------------------- + -spec spawn(Fun) -> pid() when Fun :: function(). @@ -141,17 +146,16 @@ spawn_link(Node, M, F, A) when is_atom(M), is_atom(F), is_list(A) -> Ancestors = get_ancestors(), erlang:spawn_link(Node, ?MODULE, init_p, [Parent,Ancestors,M,F,A]). --spec spawn_opt(Fun, SpawnOpts) -> pid() when +-spec spawn_opt(Fun, SpawnOpts) -> pid() | {pid(), reference()} when Fun :: function(), SpawnOpts :: [spawn_option()]. spawn_opt(F, Opts) when is_function(F) -> Parent = get_my_name(), Ancestors = get_ancestors(), - check_for_monitor(Opts), erlang:spawn_opt(?MODULE, init_p, [Parent,Ancestors,F],Opts). --spec spawn_opt(Node, Function, SpawnOpts) -> pid() when +-spec spawn_opt(Node, Function, SpawnOpts) -> pid() | {pid(), reference()} when Node :: node(), Function :: function(), SpawnOpts :: [spawn_option()]. @@ -159,10 +163,9 @@ spawn_opt(F, Opts) when is_function(F) -> spawn_opt(Node, F, Opts) when is_function(F) -> Parent = get_my_name(), Ancestors = get_ancestors(), - check_for_monitor(Opts), erlang:spawn_opt(Node, ?MODULE, init_p, [Parent,Ancestors,F], Opts). --spec spawn_opt(Module, Function, Args, SpawnOpts) -> pid() when +-spec spawn_opt(Module, Function, Args, SpawnOpts) -> pid() | {pid(), reference()} when Module :: module(), Function :: atom(), Args :: [term()], @@ -171,10 +174,9 @@ spawn_opt(Node, F, Opts) when is_function(F) -> spawn_opt(M, F, A, Opts) when is_atom(M), is_atom(F), is_list(A) -> Parent = get_my_name(), Ancestors = get_ancestors(), - check_for_monitor(Opts), erlang:spawn_opt(?MODULE, init_p, [Parent,Ancestors,M,F,A], Opts). --spec spawn_opt(Node, Module, Function, Args, SpawnOpts) -> pid() when +-spec spawn_opt(Node, Module, Function, Args, SpawnOpts) -> pid() | {pid(), reference()} when Node :: node(), Module :: module(), Function :: atom(), @@ -184,30 +186,13 @@ spawn_opt(M, F, A, Opts) when is_atom(M), is_atom(F), is_list(A) -> spawn_opt(Node, M, F, A, Opts) when is_atom(M), is_atom(F), is_list(A) -> Parent = get_my_name(), Ancestors = get_ancestors(), - check_for_monitor(Opts), erlang:spawn_opt(Node, ?MODULE, init_p, [Parent,Ancestors,M,F,A], Opts). -%% OTP-6345 -%% monitor spawn_opt option is currently not possible to use -check_for_monitor(SpawnOpts) -> - case lists:member(monitor, SpawnOpts) of - true -> - erlang:error(badarg); - false -> - false - end. - spawn_mon(M,F,A) -> Parent = get_my_name(), Ancestors = get_ancestors(), erlang:spawn_monitor(?MODULE, init_p, [Parent,Ancestors,M,F,A]). -spawn_opt_mon(M, F, A, Opts) when is_atom(M), is_atom(F), is_list(A) -> - Parent = get_my_name(), - Ancestors = get_ancestors(), - check_for_monitor(Opts), - erlang:spawn_opt(?MODULE, init_p, [Parent,Ancestors,M,F,A], [monitor|Opts]). - -spec hibernate(Module, Function, Args) -> no_return() when Module :: module(), Function :: atom(), @@ -216,14 +201,6 @@ spawn_opt_mon(M, F, A, Opts) when is_atom(M), is_atom(F), is_list(A) -> hibernate(M, F, A) when is_atom(M), is_atom(F), is_list(A) -> erlang:hibernate(?MODULE, wake_up, [M, F, A]). -ensure_link(SpawnOpts) -> - case lists:member(link, SpawnOpts) of - true -> - SpawnOpts; - false -> - [link|SpawnOpts] - end. - -spec init_p(pid(), [pid()], function()) -> term(). init_p(Parent, Ancestors, Fun) when is_function(Fun) -> @@ -299,20 +276,32 @@ start(M, F, A) when is_atom(M), is_atom(F), is_list(A) -> Ret :: term() | {error, Reason :: term()}. start(M, F, A, Timeout) when is_atom(M), is_atom(F), is_list(A) -> - PidRef = spawn_mon(M, F, A), - sync_wait_mon(PidRef, Timeout). + sync_start(spawn_mon(M, F, A), Timeout). -spec start(Module, Function, Args, Time, SpawnOpts) -> Ret when Module :: module(), Function :: atom(), Args :: [term()], Time :: timeout(), - SpawnOpts :: [spawn_option()], + SpawnOpts :: [start_spawn_option()], Ret :: term() | {error, Reason :: term()}. start(M, F, A, Timeout, SpawnOpts) when is_atom(M), is_atom(F), is_list(A) -> - PidRef = spawn_opt_mon(M, F, A, SpawnOpts), - sync_wait_mon(PidRef, Timeout). + ?VERIFY_NO_MONITOR_OPT(M, F, A, Timeout, SpawnOpts), + sync_start(?MODULE:spawn_opt(M, F, A, [monitor|SpawnOpts]), Timeout). + +sync_start({Pid, Ref}, Timeout) -> + receive + {ack, Pid, Return} -> + erlang:demonitor(Ref, [flush]), + Return; + {'DOWN', Ref, process, Pid, Reason} -> + {error, Reason} + after Timeout -> + erlang:demonitor(Ref, [flush]), + kill_flush(Pid), + {error, timeout} + end. -spec start_link(Module, Function, Args) -> Ret when Module :: module(), @@ -331,60 +320,88 @@ start_link(M, F, A) when is_atom(M), is_atom(F), is_list(A) -> Ret :: term() | {error, Reason :: term()}. start_link(M, F, A, Timeout) when is_atom(M), is_atom(F), is_list(A) -> - Pid = ?MODULE:spawn_link(M, F, A), - sync_wait(Pid, Timeout). + sync_start_link(?MODULE:spawn_link(M, F, A), Timeout). -spec start_link(Module, Function, Args, Time, SpawnOpts) -> Ret when Module :: module(), Function :: atom(), Args :: [term()], Time :: timeout(), - SpawnOpts :: [spawn_option()], + SpawnOpts :: [start_spawn_option()], Ret :: term() | {error, Reason :: term()}. start_link(M,F,A,Timeout,SpawnOpts) when is_atom(M), is_atom(F), is_list(A) -> - Pid = ?MODULE:spawn_opt(M, F, A, ensure_link(SpawnOpts)), - sync_wait(Pid, Timeout). + ?VERIFY_NO_MONITOR_OPT(M, F, A, Timeout, SpawnOpts), + sync_start_link(?MODULE:spawn_opt(M, F, A, [link|SpawnOpts]), Timeout). -sync_wait(Pid, Timeout) -> +sync_start_link(Pid, Timeout) -> receive {ack, Pid, Return} -> - Return; + Return; {'EXIT', Pid, Reason} -> - {error, Reason} + {error, Reason} after Timeout -> - unlink(Pid), - exit(Pid, kill), - flush(Pid), - {error, timeout} + kill_flush(Pid), + {error, timeout} end. -sync_wait_mon({Pid, Ref}, Timeout) -> +-spec start_monitor(Module, Function, Args) -> {Ret, Mon} when + Module :: module(), + Function :: atom(), + Args :: [term()], + Mon :: reference(), + Ret :: term() | {error, Reason :: term()}. + +start_monitor(M, F, A) when is_atom(M), is_atom(F), is_list(A) -> + start_monitor(M, F, A, infinity). + +-spec start_monitor(Module, Function, Args, Time) -> {Ret, Mon} when + Module :: module(), + Function :: atom(), + Args :: [term()], + Time :: timeout(), + Mon :: reference(), + Ret :: term() | {error, Reason :: term()}. + +start_monitor(M, F, A, Timeout) when is_atom(M), is_atom(F), is_list(A) -> + sync_start_monitor(spawn_mon(M, F, A), Timeout). + +-spec start_monitor(Module, Function, Args, Time, SpawnOpts) -> {Ret, Mon} when + Module :: module(), + Function :: atom(), + Args :: [term()], + Time :: timeout(), + SpawnOpts :: [start_spawn_option()], + Mon :: reference(), + Ret :: term() | {error, Reason :: term()}. + +start_monitor(M,F,A,Timeout,SpawnOpts) when is_atom(M), + is_atom(F), + is_list(A) -> + ?VERIFY_NO_MONITOR_OPT(M, F, A, Timeout, SpawnOpts), + sync_start_monitor(?MODULE:spawn_opt(M, F, A, [monitor|SpawnOpts]), + Timeout). + +sync_start_monitor({Pid, Ref}, Timeout) -> receive {ack, Pid, Return} -> - erlang:demonitor(Ref, [flush]), - Return; - {'DOWN', Ref, _Type, Pid, Reason} -> - {error, Reason}; - {'EXIT', Pid, Reason} -> %% link as spawn_opt? - erlang:demonitor(Ref, [flush]), - {error, Reason} + {Return, Ref}; + {'DOWN', Ref, process, Pid, Reason} = Down -> + self() ! Down, + {{error, Reason}, Ref} after Timeout -> - erlang:demonitor(Ref, [flush]), - exit(Pid, kill), - flush(Pid), - {error, timeout} + kill_flush(Pid), + {{error, timeout}, Ref} end. --spec flush(pid()) -> 'true'. +-spec kill_flush(Pid) -> 'ok' when + Pid :: pid(). -flush(Pid) -> - receive - {'EXIT', Pid, _} -> - true - after 0 -> - true - end. +kill_flush(Pid) -> + unlink(Pid), + exit(Pid, kill), + receive {'EXIT', Pid, _} -> ok after 0 -> ok end, + ok. -spec init_ack(Parent, Ret) -> 'ok' when Parent :: pid(), @@ -784,20 +801,114 @@ format(CrashReport, Encoding, Depth) -> encoding => Encoding, single_line => false}). -do_format([OwnReport,LinkReport], #{single_line:=Single}=Extra) -> +do_format([OwnReport,LinkReport], Extra) -> + #{encoding:=Enc, single_line:=Single, chars_limit:=Limit0} = Extra, Indent = if Single -> ""; true -> " " end, - MyIndent = Indent ++ Indent, - Sep = nl(Single,"; "), - OwnFormat = format_report(OwnReport, MyIndent, Extra), - LinkFormat = lists:join(Sep,format_link_report(LinkReport, MyIndent, Extra)), Nl = nl(Single," "), - Str = io_lib:format("~scrasher:"++Nl++"~ts"++Sep++"~sneighbours:"++Nl++"~ts", - [Indent,OwnFormat,Indent,LinkFormat]), - lists:flatten(Str). + Sep = nl(Single, report_separator()), + {PartLimit, Limit} = + case Limit0 of + unlimited -> + {Limit0, Limit0}; + _ when is_integer(Limit0) -> + %% HardcodedSize is the length of the hardcoded heading + + %% separators in the final format string below, + %% including neighbours. Just make sure the limit + %% does not become negative. + Num = length(OwnReport), + HardcodedSize = (length(Indent) + length("crasher") + + length(Nl) + length(Sep) + + (length(Sep) * Num)), + Limit1 = max(Limit0-HardcodedSize, 1), + + %% Divide the available characters over all report + %% parts. Spend one third of the characters on the + %% crash reason, and let the rest of the elements + %% (including the neighbours) share the other two + %% thirds. This is to make sure we see a good part of + %% the crash reason. Most of the other elements in the + %% crasher's report are quite small, so we don't loose + %% a lot of info from these anyway. + EL = Limit1 div 3, + PL = (Limit1-EL) div (Num), + {PL, Limit1} + end, + LinkFormat = format_link_reports(LinkReport, Indent, Extra, PartLimit), + LinkFormatSize = size(Enc, LinkFormat), + + OwnFormat = format_own_report(OwnReport, Indent, Extra, + LinkFormatSize, PartLimit, Limit), + io_lib:format("~scrasher:"++Nl++"~ts"++Sep++"~ts", + [Indent,OwnFormat,LinkFormat]). + +format_own_report(OwnReport, Indent, Extra, LinkFormatSize, PartLimit, Limit0) -> + MyIndent = Indent ++ Indent, + case separate_error_info(OwnReport) of + {First,{Class,Reason,StackTrace},Rest} -> + F = format_report(First, MyIndent, Extra, PartLimit), + R = format_report(Rest, MyIndent, Extra, PartLimit), + #{encoding:=Enc, single_line:=Single} = Extra, + Sep = nl(Single, part_separator()), + Limit = case Limit0 of + unlimited -> + Limit0; + _ when is_integer(Limit0) -> + %% Some of the report parts are quite small, + %% and we can use the leftover chars to show + %% more of the error_info part. + SizeOfOther = (size(Enc, F) + +size(Enc, R) + -length(Sep)*(length(F)+length(R)) + +LinkFormatSize), + max(Limit0-SizeOfOther, 1) + end, + EI = format_exception(Class, Reason, StackTrace, Extra, Limit), + lists:join(Sep, [F, EI, R]); + no -> + Limit = case Limit0 of + unlimited -> + Limit0; + _ when is_integer(Limit0) -> + max(Limit0-LinkFormatSize, 1) + end, + format_report(OwnReport, MyIndent, Extra, Limit) + end. -format_link_report([Link|Reps], Indent0, #{single_line:=Single}=Extra) -> +separate_error_info(Report) -> + try + lists:splitwith(fun(A) -> element(1, A) =/= error_info end, Report) + of + {First, [{error_info,ErrorInfo}|Rest]} -> + {First,ErrorInfo,Rest}; + _ -> no + catch _:_ -> no + end. + +%% If the size of the total report is limited by chars_limit, then +%% print only the pids. +format_link_reports(LinkReports, Indent, Extra, PartLimit) + when is_integer(PartLimit) -> + #{encoding:=Enc, depth:=Depth, single_line:=Single} = Extra, + Pids = [P || {neighbour,[{pid,P}|_]} <- LinkReports], + {P,Tl} = p(Enc,Depth), + Width = if Single -> "0"; + true -> "" + end, + io_lib:format(Indent++"neighbours: ~"++Width++P, + [Pids|Tl], + [{chars_limit,PartLimit}]); +format_link_reports(LinkReports, Indent, Extra, PartLimit) -> + #{single_line:=Single} = Extra, + MyIndent = Indent ++ Indent, + LinkFormat = + lists:join(nl(Single, report_separator()), + format_link_report(LinkReports, MyIndent, Extra, PartLimit)), + [Indent,"neighbours:",nl(Single," "),LinkFormat]. + +format_link_report([Link|Reps], Indent0, Extra, PartLimit) -> + #{single_line:=Single} = Extra, Rep = case Link of {neighbour,Rep0} -> Rep0; _ -> Link @@ -806,63 +917,70 @@ format_link_report([Link|Reps], Indent0, #{single_line:=Single}=Extra) -> true -> Indent0 end, LinkIndent = [" ",Indent], - [[Indent,"neighbour:",nl(Single," "),format_report(Rep, LinkIndent, Extra)]| - format_link_report(Reps, Indent, Extra)]; -format_link_report(Rep, Indent, Extra) -> - format_report(Rep, Indent, Extra). - -format_report(Rep, Indent, #{single_line:=Single}=Extra) when is_list(Rep) -> - lists:join(nl(Single,", "),format_rep(Rep, Indent, Extra)); -format_report(Rep, Indent0, #{encoding:=Enc,depth:=Depth, - chars_limit:=Limit,single_line:=Single}) -> + [[Indent,"neighbour:",nl(Single," "), + format_report(Rep, LinkIndent, Extra, PartLimit)]| + format_link_report(Reps, Indent, Extra, PartLimit)]; +format_link_report(Rep, Indent, Extra, PartLimit) -> + format_report(Rep, Indent, Extra, PartLimit). + +format_report(Rep, Indent, Extra, Limit) when is_list(Rep) -> + #{single_line:=Single} = Extra, + lists:join(nl(Single, part_separator()), + format_rep(Rep, Indent, Extra, Limit)); +format_report(Rep, Indent0, Extra, Limit) -> + #{encoding:=Enc, depth:=Depth, single_line:=Single} = Extra, {P,Tl} = p(Enc,Depth), {Indent,Width} = if Single -> {"","0"}; true -> {Indent0,""} end, - Opts = if is_integer(Limit) -> [{chars_limit,Limit}]; - true -> [] - end, + Opts = chars_limit_opt(Limit), io_lib:format("~s~"++Width++P, [Indent, Rep | Tl], Opts). -format_rep([{initial_call,InitialCall}|Rep], Indent, Extra) -> - [format_mfa(Indent, InitialCall, Extra)|format_rep(Rep, Indent, Extra)]; -format_rep([{error_info,{Class,Reason,StackTrace}}|Rep], Indent, Extra) -> - [format_exception(Class, Reason, StackTrace, Extra)| - format_rep(Rep, Indent, Extra)]; -format_rep([{Tag,Data}|Rep], Indent, Extra) -> - [format_tag(Indent, Tag, Data, Extra)|format_rep(Rep, Indent, Extra)]; -format_rep(_, _, _Extra) -> +format_rep([{initial_call,InitialCall}|Rep], Indent, Extra, Limit) -> + [format_mfa(Indent, InitialCall, Extra, Limit)| + format_rep(Rep, Indent, Extra, Limit)]; +format_rep([{Tag,Data}|Rep], Indent, Extra, Limit) -> + [format_tag(Indent, Tag, Data, Extra, Limit)| + format_rep(Rep, Indent, Extra, Limit)]; +format_rep(_, _, _Extra, _Limit) -> []. -format_exception(Class, Reason, StackTrace, - #{encoding:=Enc,depth:=Depth,chars_limit:=Limit, - single_line:=Single}=Extra) -> - PF = pp_fun(Extra), +format_exception(Class, Reason, StackTrace, Extra, Limit) -> + #{encoding:=Enc,depth:=Depth, single_line:=Single} = Extra, StackFun = fun(M, _F, _A) -> (M =:= erl_eval) or (M =:= ?MODULE) end, if Single -> {P,Tl} = p(Enc,Depth), - Opts = if is_integer(Limit) -> [{chars_limit,Limit}]; - true -> [] - end, + Opts = chars_limit_opt(Limit), [atom_to_list(Class), ": ", io_lib:format("~0"++P,[{Reason,StackTrace}|Tl],Opts)]; true -> + %% Notice that each call to PF uses chars_limit, which + %% means that the total size of the formatted exception + %% can exceed the limit a lot. + PF = pp_fun(Extra, Enc), EI = " ", - [EI, erl_error:format_exception(1+length(EI), Class, Reason, - StackTrace, StackFun, PF, Enc)] + Lim = case Limit of + unlimited -> -1; + _ -> Limit + end, + FE = erl_error:format_exception(1+length(EI), Class, Reason, + StackTrace, StackFun, PF, Enc, + Lim), + [EI, FE] end. -format_mfa(Indent0, {M,F,Args}=StartF, #{encoding:=Enc,single_line:=Single}=Extra) -> +format_mfa(Indent0, {M,F,Args}=StartF, Extra, Limit) -> + #{encoding:=Enc,single_line:=Single} = Extra, Indent = if Single -> ""; true -> Indent0 end, try A = length(Args), - [Indent,"initial call: ",atom_to_list(M),$:,to_string(F, Enc),$/, + [Indent,"initial call: ",to_string(M, Enc),$:,to_string(F, Enc),$/, integer_to_list(A)] catch error:_ -> - format_tag(Indent, initial_call, StartF, Extra) + format_tag(Indent, initial_call, StartF, Extra, Limit) end. to_string(A, latin1) -> @@ -870,27 +988,25 @@ to_string(A, latin1) -> to_string(A, _) -> io_lib:write_atom(A). -pp_fun(#{encoding:=Enc,depth:=Depth,chars_limit:=Limit,single_line:=Single}) -> +pp_fun(Extra, Enc) -> + #{encoding:=Enc,depth:=Depth, single_line:=Single} = Extra, {P,Tl} = p(Enc, Depth), Width = if Single -> "0"; true -> "" end, - Opts = if is_integer(Limit) -> [{chars_limit,Limit}]; - true -> [] - end, - fun(Term, I) -> - io_lib:format("~" ++ Width ++ "." ++ integer_to_list(I) ++ P, - [Term|Tl], Opts) + fun(Term, I, Limit) -> + S = io_lib:format("~" ++ Width ++ "." ++ integer_to_list(I) ++ P, + [Term|Tl], [{chars_limit, Limit}]), + {S, sub(Limit, S, Enc)} end. -format_tag(Indent0, Tag, Data, #{encoding:=Enc,depth:=Depth,chars_limit:=Limit,single_line:=Single}) -> +format_tag(Indent0, Tag, Data, Extra, Limit) -> + #{encoding:=Enc,depth:=Depth,single_line:=Single} = Extra, {P,Tl} = p(Enc, Depth), {Indent,Width} = if Single -> {"","0"}; true -> {Indent0,""} end, - Opts = if is_integer(Limit) -> [{chars_limit,Limit}]; - true -> [] - end, + Opts = chars_limit_opt(Limit), io_lib:format("~s~" ++ Width ++ "p: ~" ++ Width ++ ".18" ++ P, [Indent, Tag, Data|Tl], Opts). @@ -902,12 +1018,35 @@ p(Encoding, Depth) -> P = modifier(Encoding) ++ Letter, {P, Tl}. +report_separator() -> "; ". + +part_separator() -> ", ". + +chars_limit_opt(CharsLimit) -> + [{chars_limit, CharsLimit} || is_integer(CharsLimit)]. + modifier(latin1) -> ""; modifier(_) -> "t". nl(true,Else) -> Else; nl(false,_) -> "\n". +%% Make sure T does change sign. +sub(T, _, _Enc) when T < 0 -> T; +sub(T, E, Enc) -> + Sz = size(Enc, E), + if + T >= Sz -> + T - Sz; + true -> + 0 + end. + +size(latin1, S) -> + iolist_size(S); +size(_, S) -> + string:length(S). + %%% ----------------------------------------------------------- %%% Stop a process and wait for it to terminate %%% ----------------------------------------------------------- diff --git a/lib/stdlib/src/proplists.erl b/lib/stdlib/src/proplists.erl index 3ce68887ae..9216c3bdb3 100644 --- a/lib/stdlib/src/proplists.erl +++ b/lib/stdlib/src/proplists.erl @@ -220,7 +220,7 @@ get_value(Key, [P | Ps], Default) -> {_, Value} -> Value; _ -> - %% Don</code>t continue the search! + %% Don't continue the search! Default end; true -> @@ -419,7 +419,7 @@ substitute_aliases_1([], P) -> %% <p>Example: <code>substitute_negations([{no_foo, foo}], L)</code> %% will replace any atom <code>no_foo</code> or tuple <code>{no_foo, %% true}</code> in <code>L</code> with <code>{foo, false}</code>, and -%% any other tuple <code>{no_foo, ...}</code> with <code>foo</code.</p> +%% any other tuple <code>{no_foo, ...}</code> with <code>foo</code>.</p> %% %% @see get_bool/2 %% @see substitute_aliases/2 @@ -639,24 +639,24 @@ normalize(L, []) -> Rest :: [term()]. split(List, Keys) -> - {Store, Rest} = split(List, dict:from_list([{K, []} || K <- Keys]), []), - {[lists:reverse(dict:fetch(K, Store)) || K <- Keys], + {Store, Rest} = split(List, maps:from_list([{K, []} || K <- Keys]), []), + {[lists:reverse(map_get(K, Store)) || K <- Keys], lists:reverse(Rest)}. split([P | Ps], Store, Rest) -> if is_atom(P) -> - case dict:is_key(P, Store) of + case is_map_key(P, Store) of true -> - split(Ps, dict_prepend(P, P, Store), Rest); + split(Ps, maps_prepend(P, P, Store), Rest); false -> split(Ps, Store, [P | Rest]) end; tuple_size(P) >= 1 -> %% Note that Key does not have to be an atom in this case. Key = element(1, P), - case dict:is_key(Key, Store) of + case is_map_key(Key, Store) of true -> - split(Ps, dict_prepend(Key, P, Store), Rest); + split(Ps, maps_prepend(Key, P, Store), Rest); false -> split(Ps, Store, [P | Rest]) end; @@ -666,5 +666,5 @@ split([P | Ps], Store, Rest) -> split([], Store, Rest) -> {Store, Rest}. -dict_prepend(Key, Val, Dict) -> - dict:store(Key, [Val | dict:fetch(Key, Dict)], Dict). +maps_prepend(Key, Val, Dict) -> + Dict#{Key := [Val | map_get(Key, Dict)]}. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index a1c1117e31..713ed1f896 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -785,7 +785,7 @@ merge_binding_structs(Bs1, Bs2) -> aux_name1(Name, N, AllNames) -> SN = name_suffix(Name, N), - case sets:is_element(SN, AllNames) of + case gb_sets:is_member(SN, AllNames) of true -> aux_name1(Name, N + 1, AllNames); false -> {SN, N} end. @@ -1357,7 +1357,7 @@ flatten_abstr(E, VN, _Vars, Body) -> {VN, Body, E}. abstract_vars(Abstract) -> - sets:from_list(ordsets:to_list(vars(Abstract))). + gb_sets:from_list(ordsets:to_list(vars(Abstract))). collect([]=L) -> L; diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index 4a39f8ae9d..7cf631d85d 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -511,7 +511,7 @@ used_genvar_check(FormsNoShadows, State) -> Acc0 = {State#state.intro_vars, [{atom, anno0(), true}]}, {_, {[], Exprs}} = qual_fold(F, Acc0, [], FormsNoShadows, State), FunctionNames = [Name || {function, _, Name, _, _} <- FormsNoShadows], - UniqueFName = qlc:aux_name(used_genvar, 1, sets:from_list(FunctionNames)), + UniqueFName = qlc:aux_name(used_genvar, 1, gb_sets:from_list(FunctionNames)), A = anno0(), {function,A,UniqueFName,0,[{clause,A,[],[],lists:reverse(Exprs)}]}. @@ -613,8 +613,8 @@ q_intro_vars(QId, [{QId, IVs} | QsIVs], IVsSoFar) -> {QsIVs, IVs ++ IVsSoFar}. transform(FormsNoShadows, State) -> _ = erlang:system_flag(backtrace_depth, 500), IntroVars = State#state.intro_vars, - AllVars = sets:from_list(ordsets:to_list(qlc:vars(FormsNoShadows))), - ?DEBUG("AllVars = ~p~n", [sets:to_list(AllVars)]), + AllVars = gb_sets:from_list(ordsets:to_list(qlc:vars(FormsNoShadows))), + ?DEBUG("AllVars = ~p~n", [gb_sets:to_list(AllVars)]), F1 = fun(QId, {generate,_,P,LE}, Foo, {GoI,SI}) -> {{QId,GoI,SI,{gen,P,LE}},Foo,{GoI + 3, SI + 2}}; (QId, F, Foo, {GoI,SI}) -> @@ -632,10 +632,10 @@ transform(FormsNoShadows, State) -> {_,Source0} = qual_fold(fun(_QId, {generate,_,_P,_E}=Q, Dict, Foo) -> {Q,Dict,Foo}; (QId, F, Dict, Foo) -> - {F,dict:store(QId, F, Dict),Foo} - end, dict:new(), [], FormsNoShadows, State), + {F,maps:put(QId, F, Dict),Foo} + end, maps:new(), [], FormsNoShadows, State), {_,Source} = qlc_mapfold(fun(Id, {lc,_L,E,_Qs}=LC, Dict) -> - {LC,dict:store(Id, E, Dict)} + {LC,maps:put(Id, E, Dict)} end, Source0, FormsNoShadows, State), @@ -685,7 +685,7 @@ transform(FormsNoShadows, State) -> FunW = {'fun',L,{clauses,[{clause,L,AsW,[], [{match,L,{var,L,Fun},FunC}, {call,L,{var,L,Fun},As0}]}]}}, - {ok, OrigE0} = dict:find(Id, Source), + OrigE0 = map_get(Id, Source), OrigE = undo_no_shadows(OrigE0, State), QCode = qcode(OrigE, XQCs, Source, L, State), Qdata = qdata(XQCs, L), @@ -2361,7 +2361,7 @@ qcode(E, QCs, Source, L, State) -> qcode([{_QId, {_QIvs, {{gen,P,_LE,_GV}, GoI, _SI}}} | QCs], Source, State) -> [{GoI,undo_no_shadows(P, State)} | qcode(QCs, Source, State)]; qcode([{QId, {_QIVs, {{fil,_F}, GoI, _SI}}} | QCs], Source, State) -> - {ok,OrigF} = dict:find(QId, Source), + OrigF = map_get(QId, Source), [{GoI,undo_no_shadows(OrigF, State)} | qcode(QCs, Source, State)]; qcode([], _Source, _State) -> []. @@ -2666,12 +2666,12 @@ no_shadows(Forms0, State) -> %% %% The original names of variables are kept in a table in State. %% undo_no_shadows/2 re-creates the original code. - AllVars = sets:from_list(ordsets:to_list(qlc:vars(Forms0))), - ?DEBUG("nos AllVars = ~p~n", [sets:to_list(AllVars)]), + AllVars = gb_sets:from_list(ordsets:to_list(qlc:vars(Forms0))), + ?DEBUG("nos AllVars = ~p~n", [gb_sets:to_list(AllVars)]), VFun = fun(_Id, LC, Vs) -> nos(LC, Vs) end, LI = ets:new(?APIMOD,[]), UV = ets:new(?APIMOD,[]), - D0 = dict:new(), + D0 = maps:new(), S1 = {LI, D0, UV, AllVars, [], State}, _ = qlc_mapfold(VFun, S1, Forms0, State), ?DEBUG("UsedIntroVars = ~p~n", [ets:match_object(UV, '_')]), @@ -2781,7 +2781,7 @@ nos_var(Anno, Name, State) -> end. used_var(V, Vs, UV) -> - case dict:find(V, Vs) of + case maps:find(V, Vs) of {ok,Value} -> VN = qlc:name_suffix(V, Value), _ = ets:update_counter(UV, VN, 1), @@ -2796,10 +2796,10 @@ next_var(V, Vs, AllVars, LI, UV) -> end, true = ets:insert(LI, {V, NValue}), VN = qlc:name_suffix(V, NValue), - case sets:is_element(VN, AllVars) of + case gb_sets:is_member(VN, AllVars) of true -> next_var(V, Vs, AllVars, LI, UV); false -> true = ets:insert(UV, {VN, 0}), - NVs = dict:store(V, NValue, Vs), + NVs = maps:put(V, NValue, Vs), {VN, NVs} end. diff --git a/lib/stdlib/src/queue.erl b/lib/stdlib/src/queue.erl index 11c0aa8d2b..9fe3782f92 100644 --- a/lib/stdlib/src/queue.erl +++ b/lib/stdlib/src/queue.erl @@ -37,7 +37,7 @@ %% Mis-spelled, deprecated. -export([lait/1]). --deprecated([lait/1]). +-deprecated([{lait,1,"use queue:liat/1 instead"}]). %%-------------------------------------------------------------------------- %% Efficient implementation of double ended fifo queues diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index 46dabb4323..8d6a35f031 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(random). --deprecated(module). +-deprecated({'_','_',"use the 'rand' module instead"}). %% Reasonable random number generator. %% The method is attributed to B. A. Wichmann and I. D. Hill diff --git a/lib/stdlib/src/shell_default.erl b/lib/stdlib/src/shell_default.erl index a0c1d98513..e65340e663 100644 --- a/lib/stdlib/src/shell_default.erl +++ b/lib/stdlib/src/shell_default.erl @@ -28,6 +28,7 @@ erlangrc/1,bi/1, regs/0, flush/0,pwd/0,ls/0,ls/1,cd/1, y/1, y/2, xm/1, bt/1, q/0, + h/1, h/2, h/3, ht/1, ht/2, ht/3, ni/0, nregs/0]). -export([ih/0,iv/0,im/0,ii/1,ii/2,iq/1,ini/1,ini/2,inq/1,ib/2,ib/3, @@ -43,7 +44,13 @@ help() -> format("e(N) -- repeat the expression in query <N>\n"), format("f() -- forget all variable bindings\n"), format("f(X) -- forget the binding of variable X\n"), - format("h() -- history\n"), + format("h() -- history\n"), + format("h(Mod) -- help about module\n"), + format("h(Mod,Func)-- help about function in module\n"), + format("h(Mod,Func,Arity) -- help about function with arity in module\n"), + format("ht(Mod) -- help about a module's types\n"), + format("ht(Mod,Func) -- help about type in module\n"), + format("ht(Mod,Func,Arity) -- help about type with arity in module\n"), format("history(N) -- set how many previous commands to keep\n"), format("results(N) -- set how many previous command results to keep\n"), format("catch_exception(B) -- how exceptions are handled\n"), @@ -76,6 +83,12 @@ c(File, Opt, Filter) -> c:c(File, Opt, Filter). cd(D) -> c:cd(D). erlangrc(X) -> c:erlangrc(X). flush() -> c:flush(). +h(M) -> c:h(M). +h(M,F) -> c:h(M,F). +h(M,F,A) -> c:h(M,F,A). +ht(M) -> c:ht(M). +ht(M,F) -> c:ht(M,F). +ht(M,F,A) -> c:ht(M,F,A). i() -> c:i(). i(X,Y,Z) -> c:i(X,Y,Z). l(Mod) -> c:l(Mod). diff --git a/lib/stdlib/src/shell_docs.erl b/lib/stdlib/src/shell_docs.erl new file mode 100644 index 0000000000..6e56030fca --- /dev/null +++ b/lib/stdlib/src/shell_docs.erl @@ -0,0 +1,684 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(shell_docs). + +-include("eep48.hrl"). + +-export([render/2, render/3, render/4]). +-export([render_type/2, render_type/3, render_type/4]). + +%% Used by chunks.escript in erl_docgen +-export([validate/1, normalize/1]). + +%% Convinience functions +-export([get_doc/1, get_doc/3, get_type_doc/3]). + +-record(config, { docs, + io_opts = io:getopts(), + io_columns = element(2,io:columns()) + }). + +-define(ALL_ELEMENTS,[a,p,h1,h2,h3,i,br,em,pre,code,ul,ol,li,dl,dt,dd]). +%% inline elements are: +-define(INLINE,[i,br,em,code,a]). +-define(IS_INLINE(ELEM),(((ELEM) =:= a) orelse ((ELEM) =:= code) + orelse ((ELEM) =:= i) orelse ((ELEM) =:= br) + orelse ((ELEM) =:= em))). +%% non-inline elements are: +-define(BLOCK,[p,pre,ul,ol,li,dl,dt,dd,h1,h2,h3]). +-define(IS_BLOCK(ELEM),not ?IS_INLINE(ELEM)). +-define(IS_PRE(ELEM),(((ELEM) =:= pre))). + +-type chunk_element_type() :: a | p | i | br | em | pre | code | ul | + ol | li | dl | dt | dd. +-type chunk_element_attr() :: {atom(),unicode:chardata()}. +-type chunk_element_attrs() :: [chunk_element_attr()]. +-type chunk_element() :: {chunk_element_type(),chunk_element_attrs(), + chunk_elements()} | binary(). +-type chunk_elements() :: [chunk_element()]. +-type docs_v1() :: #docs_v1{}. + + +-spec validate(Module) -> ok when + Module :: module() | docs_v1(). +%% Simple validation of erlang doc chunk. Check that all tags are supported and +%% that the signature is correct. +validate(Module) when is_atom(Module) -> + {ok, Doc} = code:get_doc(Module), + validate(Doc); +validate(#docs_v1{ module_doc = MDocs, docs = AllDocs }) -> + + %% Check some macro in-variants + AE = lists:sort(?ALL_ELEMENTS), + AE = lists:sort(?INLINE ++ ?BLOCK), + true = lists:all(fun(Elem) -> ?IS_INLINE(Elem) end, ?INLINE), + true = lists:all(fun(Elem) -> ?IS_BLOCK(Elem) end, ?BLOCK), + + _ = maps:map(fun(_Key,MDoc) -> validate(MDoc) end, MDocs), + lists:map(fun({_,_Anno, Sig, Docs, _Meta}) -> + case lists:all(fun erlang:is_binary/1, Sig) of + false -> throw({invalid_signature,Sig}); + true -> ok + end, + maps:map(fun(_Key,Doc) -> validate(Doc) end, Docs) + end, AllDocs); +validate([H|T]) when is_tuple(H) -> + _ = validate(H), + validate(T); +validate({Tag,Attr,Content}) -> + case lists:member(Tag,?ALL_ELEMENTS) of + false -> + throw({invalid_tag,Tag}); + true -> + ok + end, + true = is_list(Attr), + validate(Content); +validate([Chars | T]) when is_binary(Chars) -> + validate(T); +validate([]) -> + ok. + +%% Follows algorithm described here: +%% * https://medium.com/@patrickbrosset/when-does-white-space-matter-in-html-b90e8a7cdd33 +%% which in turn follows this: +%% * https://www.w3.org/TR/css-text-3/#white-space-processing +-spec normalize(Docs) -> NormalizedDocs when + Docs :: chunk_elements(), + NormalizedDocs :: chunk_elements(). +normalize(Docs) -> + Trimmed = normalize_trim(Docs,true), + normalize_space(Trimmed). + +normalize_trim(Bin,true) when is_binary(Bin) -> + %% Remove any whitespace (except \n) before or after a newline + NoSpace = re:replace(Bin,"[^\\S\n]*\n+[^\\S\n]*","\n",[global]), + %% Replace any tabs with space + NoTab = re:replace(NoSpace,"\t"," ",[global]), + %% Replace any newlines with space + NoNewLine = re:replace(NoTab,"\\v"," ",[global]), + %% Replace any sequences of \s with a single " " + re:replace(NoNewLine,"\\s+"," ",[global,{return,binary}]); +normalize_trim(Bin,false) when is_binary(Bin) -> + Bin; +normalize_trim([{pre,Attr,Content}|T],Trim) -> + [{pre,Attr,normalize_trim(Content,false)} | normalize_trim(T,Trim)]; +normalize_trim([{Tag,Attr,Content}|T],Trim) -> + [{Tag,Attr,normalize_trim(Content,Trim)} | normalize_trim(T,Trim)]; +normalize_trim([<<>>|T],Trim) -> + normalize_trim(T,Trim); +normalize_trim([B1,B2|T],Trim) when is_binary(B1),is_binary(B2) -> + normalize_trim([<<B1/binary,B2/binary>> | T],Trim); +normalize_trim([H|T],Trim) -> + [normalize_trim(H,Trim) | normalize_trim(T,Trim)]; +normalize_trim([],_Trim) -> + []. + +%% We want to remove any duplicate spaces, even if they +%% cross into other inline elements. +%% For non-inline elements we just need to make sure that any +%% leading or trailing spaces are stripped. +normalize_space([{Pre,Attr,Content}|T]) when ?IS_PRE(Pre) -> + [{Pre,Attr,trim_first_and_last(Content,$\n)} | normalize_space(T)]; +normalize_space([{Block,Attr,Content}|T]) when ?IS_BLOCK(Block) -> + [{Block,Attr,trim_first_and_last(trim_inline(Content),$ )} | normalize_space(T)]; +normalize_space([E|T]) -> + [E|normalize_space(T)]; +normalize_space([]) -> + []. + +trim_inline(Content) -> + {NewContent,_} = trim_inline(Content,false), + NewContent. +trim_inline([Bin|T],false) when is_binary(Bin) -> + LastElem = binary:at(Bin,byte_size(Bin)-1), + {NewT, NewState} = trim_inline(T,LastElem =:= $ ), + {[Bin | NewT],NewState}; +trim_inline([<<" ">>|T],true) -> + trim_inline(T,false); +trim_inline([<<" ",Bin/binary>>|T],true) when is_binary(Bin) -> + trim_inline([Bin | T],false); +trim_inline([Bin|T],true) when is_binary(Bin) -> + trim_inline([Bin|T],false); +trim_inline([{Elem,Attr,Content}|T],TrimSpace) when ?IS_INLINE(Elem) -> + {NewContent,ContentTrimSpace} = trim_inline(Content,TrimSpace), + {NewT,TTrimSpace} = trim_inline(T,ContentTrimSpace), + {[{Elem,Attr,NewContent} | NewT], TTrimSpace}; +trim_inline([{Elem1,_A1,_C1} = B1,<<" ">>,{Elem2,_A2,_C2} = B2|T],TrimSpace) + when ?IS_BLOCK(Elem1),?IS_BLOCK(Elem2) -> + trim_inline([B1,B2|T],TrimSpace); +trim_inline([{Elem,_Attr,_Content} = Block|T],_TrimSpace) when ?IS_BLOCK(Elem) -> + [NewBlock] = normalize_space([Block]), + {NewT,TTrimSpace} = trim_inline(T,false), + {[NewBlock | NewT], TTrimSpace}; +trim_inline([],TrimSpace) -> + {[],TrimSpace}. + + +%% This function removes the first and last What from the content. +%% This is complicated by the fact that the first or last element +%% may not have any binary, or have the binary deeply nested within. +trim_first_and_last(Content, What) when What < 256 -> + {NewContent,_State} = trim_last(trim_first(Content,What),What), + NewContent. + +trim_first(Content,What) -> + {NewContent,_State} = trim_first(Content,false,What), + NewContent. +trim_first([Bin|T],false,What) when is_binary(Bin) -> + case Bin of + <<What>> -> + {T,true}; + <<What,NewBin/binary>> -> + {[NewBin|T],true}; + Bin -> + {[Bin|T],true} + end; +trim_first([{Elem,Attr,Content} = Tag|T],false,What) -> + case trim_first(Content,false,What) of + {NewContent,true} -> + {[{Elem,Attr,NewContent}|T],true}; + {Content,false} -> + {NewT,NewState} = trim_first(T,false,What), + {[Tag | NewT],NewState} + end; +trim_first([],false,_What) -> + {[],false}. + +trim_last([Bin | T],What) when is_binary(Bin) -> + case trim_last(T,What) of + {NewT,true} -> + {[Bin | NewT],true}; + {T,false} -> + PreSz = byte_size(Bin)-1, + case Bin of + <<What>> -> {T,true}; + <<NewBin:PreSz/binary,What>> -> + {[NewBin|T],true}; + Bin -> + {[Bin|T],true} + end + end; +trim_last([{Elem,Attr,Content} = Tag|T],What) -> + case trim_last(T,What) of + {NewT,true} -> + {[Tag | NewT],true}; + {T,false} -> + {NewContent,NewState} = trim_last(Content,What), + {[{Elem,Attr,NewContent}|T],NewState} + end; +trim_last([],_What) -> + {[],false}. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% API function for dealing with the function documentation +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec get_doc(Module :: module()) -> chunk_elements(). +get_doc(Module) -> + {ok, #docs_v1{ module_doc = ModuleDoc } } = code:get_doc(Module), + get_local_doc(Module, ModuleDoc). + +-spec get_doc(Module :: module(), Function, Arity) -> + [{{Function,Arity}, Anno, Signature, chunk_elements(), Metadata}] when + Function :: function(), + Arity :: arity(), + Anno :: erl_anno:anno(), + Signature :: [binary()], + Metadata :: #{}. +get_doc(Module, Function, Arity) -> + {ok, #docs_v1{ docs = Docs } } = code:get_doc(Module), + FnFunctions = + lists:filter(fun({{function, F, A},_Anno,_Sig,_Doc,_Meta}) -> + F =:= Function andalso A =:= Arity; + (_) -> + false + end, Docs), + + [{F,A,S,get_local_doc({F,A},D),M} || {F,A,S,D,M} <- FnFunctions]. + +-spec render(Module :: module(), Docs :: docs_v1()) -> unicode:chardata(). +render(Module, #docs_v1{ module_doc = ModuleDoc, metadata = MD } = D) -> + render_docs([["\t",atom_to_binary(Module)]], + get_local_doc(Module, ModuleDoc), MD, D). + +-spec render(Module :: module(), Function :: function(), Docs :: docs_v1()) -> + unicode:chardata() | {error,function_missing}. +render(_Module, Function, #docs_v1{ docs = Docs } = D) -> + render_function( + lists:filter(fun({{function, F, _},_Anno,_Sig,_Doc,_Meta}) -> + F =:= Function; + (_) -> + false + end, Docs), D). +-spec render(Module :: module(), Function :: function(), Arity :: arity(), + Docs :: docs_v1()) -> unicode:chardata() | {error,function_missing}. +render(_Module, Function, Arity, #docs_v1{ docs = Docs } = D) -> + render_function( + lists:filter(fun({{function, F, A},_Anno,_Sig,_Doc,_Meta}) -> + F =:= Function andalso A =:= Arity; + (_) -> + false + end, Docs), D). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% API function for dealing with the type documentation +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec get_type_doc(Module :: module(), Type :: atom(), Arity :: arity()) -> + [{{Type,Arity}, Anno, Signature, chunk_elements(), Metadata}] when + Type :: atom(), + Arity :: arity(), + Anno :: erl_anno:anno(), + Signature :: [binary()], + Metadata :: #{}. +get_type_doc(Module, Type, Arity) -> + {ok, #docs_v1{ docs = Docs } } = code:get_doc(Module), + FnFunctions = + lists:filter(fun({{type, T, A},_Anno,_Sig,_Doc,_Meta}) -> + T =:= Type andalso A =:= Arity; + (_) -> + false + end, Docs), + [{F,A,S,get_local_doc(F, D),M} || {F,A,S,D,M} <- FnFunctions]. + +-spec render_type(Module :: module(), Docs :: docs_v1()) -> unicode:chardata(). +render_type(Module, #docs_v1{ docs = Docs } = D) -> + render_type_signatures(Module, + lists:filter(fun({{type, _, _},_Anno,_Sig,_Doc,_Meta}) -> + true; + (_) -> + false + end, Docs), D). + +-spec render_type(Module :: module(), Type :: atom(), Docs :: docs_v1()) -> + unicode:chardata() | {error,type_missing}. +render_type(_Module, Type, #docs_v1{ docs = Docs } = D) -> + render_type_docs( + lists:filter(fun({{type, T, _},_Anno,_Sig,_Doc,_Meta}) -> + T =:= Type; + (_) -> + false + end, Docs), D). + +-spec render_type(Module :: module(), Type :: atom(), Arity :: arity(), + Docs :: docs_v1()) -> unicode:chardata() | {error,type_missing}. +render_type(_Module, Type, Arity, #docs_v1{ docs = Docs } = D) -> + render_type_docs( + lists:filter(fun({{type, T, A},_Anno,_Sig,_Doc,_Meta}) -> + T =:= Type andalso A =:= Arity; + (_) -> + false + end, Docs), D). + + +%% Get the docs in the correct locale if it exists. +get_local_doc(MissingMod, Docs) when is_atom(MissingMod) -> + get_local_doc(atom_to_binary(MissingMod), Docs); +get_local_doc({F,A}, Docs) -> + get_local_doc(unicode:characters_to_binary(io_lib:format("~tp/~p",[F,A])), Docs); +get_local_doc(_Missing, #{ <<"en">> := Docs }) -> + %% English if it exists + normalize(Docs); +get_local_doc(_Missing, ModuleDoc) when map_size(ModuleDoc) > 0 -> + %% Otherwise take first alternative found + normalize(maps:get(hd(maps:keys(ModuleDoc)), ModuleDoc)); +get_local_doc(Missing, hidden) -> + [{p,[],[<<"The documentation for ">>,Missing, + <<" is hidden. This probably means that it is internal " + "and not to be used by other applications.">>]}]; +get_local_doc(Missing, None) when None =:= none; None =:= #{} -> + [{p,[],[<<"There is no documentation for ">>,Missing]}]. + +%%% Functions for rendering reference documentation +render_function([], _D) -> + {error,function_missing}; +render_function(FDocs, D) -> + [render_docs(render_signature(Func), get_local_doc({F,A},Doc), Meta, D) + || {{_,F,A},_Anno,_Sig,Doc,Meta} = Func <- lists:sort(FDocs)]. + +%% Render the signature of either function or a type, or anything else really. +render_signature({{_Type,_F,_A},_Anno,_Sig,_Docs,#{ signature := Specs }}) -> + [erl_pp:attribute(Spec,[{encoding,utf8}]) || Spec <- Specs]; +render_signature({{_Type,_F,_A},_Anno,Sigs,_Docs,_Meta}) -> + [Sig || Sig <- Sigs]. + +render_since(#{ since := Vsn }) -> + ["\n\nSince: ",Vsn]; +render_since(_) -> + []. + +render_docs(Headers, DocContents, MD, D = #config{}) -> + init_ansi(D), + try + {Doc,_} = render_docs(DocContents,[],0,2,D), + [sansi(bold), + [io_lib:format("~n~ts",[Header]) || Header <- Headers], + ransi(bold), + render_since(MD), + io_lib:format("~n~n~ts",[Doc])] + after + clean_ansi() + end; +render_docs(Headers, DocContents, MD, D) -> + render_docs(Headers, DocContents, MD, #config{ docs = D }). + +%%% Functions for rendering type documentation +render_type_signatures(Module, Types, D = #config{}) -> + init_ansi(D), + try + [sansi(bold),"\t",atom_to_list(Module),ransi(bold),"\n\n", + [render_signature(Type) || Type <- Types ]] + after + clean_ansi() + end; +render_type_signatures(Module, Types, D) -> + render_type_signatures(Module, Types, #config{ docs = D }). + +render_type_docs([], _D) -> + {error,type_missing}; +render_type_docs(Types, #config{} = D) when is_list(Types) -> + [render_type_docs(Type, D) || Type <- Types]; +render_type_docs({{_,F,A},_,_Sig,Docs,Meta} = Type, #config{} = D) -> + render_docs(render_signature(Type), get_local_doc({F,A},Docs), Meta, D); +render_type_docs(Docs, D) -> + render_type_docs(Docs, #config{ docs = D }). + +%%% General rendering functions +render_docs(Elems,State,Pos,Ind,D) when is_list(Elems) -> + lists:mapfoldl(fun(Elem,P) -> +% io:format("Elem: ~p (~p) (~p,~p)~n",[Elem,State,P,Ind]), + render_docs(Elem,State,P,Ind,D) + end,Pos,Elems); +render_docs(Elem,State,Pos,Ind,D) -> + render_element(Elem,State,Pos,Ind,D). + + +%%% The function is the main element rendering function +%%% +%%% Elem: The current element to process +%%% Stack: A stack of element names to see where we are in the dom +%%% Pos: The current print position on the current line +%%% Ind: How much the text should be indented after a newline +%%% Config: The renderer's configuration +%%% +%%% Each element is responsible for putting new lines AFTER itself +%%% The indents are done either by render_words when a newline happens +%%% or when a new element is to be rendered and Pos < Ind. +%%% +%%% Any block elements (i.e. p, ul, li etc) are responsible for trimming +%%% extra new lines. eg. <ul><li><p>content</p></li></ul> should only +%%% have two newlines at the end. +-spec render_element(Elem :: chunk_element(), + Stack :: [chunk_element_type()], + Pos :: non_neg_integer(), + Indent :: non_neg_integer(), + Config :: #config{}) -> + {unicode:chardata(), Pos :: non_neg_integer()}. + +render_element({IgnoreMe,_,Content}, State, Pos, Ind,D) + when IgnoreMe =:= a; IgnoreMe =:= anno -> + render_docs(Content, State, Pos, Ind,D); + +%% Catch h1, h2 and h3 before the padding is done as there reset padding +render_element({h1,_,Content},State,0 = Pos,_Ind,D) -> + trimnlnl(render_element({code,[],[{em,[],Content}]}, State, Pos, 0, D)); +render_element({h2,_,Content},State,0 = Pos,_Ind,D) -> + trimnlnl(render_element({em,[],Content}, State, Pos, 0, D)); +render_element({h3,_,Content},State,Pos,_Ind,D) when Pos =< 2 -> + trimnlnl(render_element({code,[],Content}, State, Pos, 2, D)); + +render_element({p,_Attr,_Content} = E,State,Pos,Ind,D) when Pos > Ind -> + {Docs,NewPos} = render_element(E,State,0,Ind,D), + {["\n",Docs],NewPos}; +render_element({p,[{class,What}],Content},State,Pos,Ind,D) -> + {Docs,_} = render_docs(Content, [p|State], 0, Ind+2, D), + trimnlnl([pad(Ind - Pos),string:titlecase(What),":\n",Docs]); +render_element({p,_,Content},State,Pos,Ind,D) -> + trimnlnl(render_docs(Content, [p|State], Pos, Ind,D)); + +render_element(Elem,State,Pos,Ind,D) when Pos < Ind -> +% io:format("Pad: ~p~n",[Ind - Pos]), + {Docs,NewPos} = render_element(Elem,State,Ind,Ind,D), + + {[pad(Ind - Pos), Docs],NewPos}; + +render_element({code,_,Content},[pre|_] = State,Pos,Ind,D) -> + %% When code is within a pre we don't emit any underline + render_docs(Content, [code|State], Pos, Ind,D); +render_element({code,_,Content},State,Pos,Ind,D) -> + Underline = sansi(underline), + {Docs, NewPos} = render_docs(Content, [code|State], Pos, Ind,D), + {[Underline,Docs,ransi(underline)], NewPos}; + +render_element({i,_,Content},State,Pos,Ind,D) -> + %% Just ignore i as ansi does not have cursive style + render_docs(Content, State, Pos, Ind,D); + +render_element({br,[],[]},_State,_Pos,_Ind,_D) -> + nl(""); + +render_element({em,_,Content},State,Pos,Ind,D) -> + Bold = sansi(bold), + {Docs, NewPos} = render_docs(Content, State, Pos, Ind,D), + {[Bold,Docs,ransi(bold)], NewPos}; + +render_element({pre,_,Content},State,Pos,Ind,D) -> + %% For pre we make sure to respect the newlines in pre + trimnlnl(render_docs(Content, [pre|State], Pos, Ind+2, D)); + +render_element({ul,[{class,"types"}],Content},State,_Pos,Ind,D) -> + {Docs, _} = render_docs(Content, [types|State], 0, Ind+2, D), + trimnlnl(["Types:\n", Docs]); +render_element({li,Attr,Content},[types|_] = State,Pos,Ind,C) -> + Doc = + case {proplists:get_value(name, Attr),proplists:get_value(class, Attr)} of + {undefined,Class} when Class =:= undefined; Class =:= "type" -> + %% Inline html for types + render_docs(Content,[type|State],Pos,Ind,C); + {_,"description"} -> + %% Inline html for type descriptions + render_docs(Content,[type|State],Pos,Ind+2,C); + {Name,_} -> + %% Try to render from type metadata + case render_type_signature(list_to_atom(Name),C) of + undefined when Content =:= [] -> + %% Failed and no content, emit place-holder + {["-type ",Name,"() :: term()."],0}; + undefined -> + %% Failed with metadata, render the content + render_docs(Content,[type|State],Pos,Ind,C); + Type -> + %% Emit the erl_pp typespec + {Type,0} + end + end, + trimnl(Doc); +render_element({ul,[],Content},State,Pos,Ind,D) -> + render_docs(Content, [l|State], Pos, Ind,D); +render_element({ol,[],Content},State,Pos,Ind,D) -> + %% For now ul and ol does the same thing + render_docs(Content, [l|State], Pos, Ind,D); +render_element({li,[],Content},[l | _] = State, Pos, Ind,D) -> + Bullet = get_bullet(State, proplists:get_value(encoding, D#config.io_opts)), + BulletLen = string:length(Bullet), + {Docs, _NewPos} = render_docs(Content, [li | State], Pos + BulletLen,Ind + BulletLen, D), + trimnlnl([Bullet,Docs]); + +render_element({dl,_,Content},State,Pos,Ind,D) -> + render_docs(Content, [dl|State], Pos, Ind,D); +render_element({dt,_,Content},[dl | _] = State,Pos,Ind,D) -> + Underline = sansi(underline), + {Docs, _NewPos} = render_docs(Content, [li | State], Pos, Ind, D), + {[Underline,Docs,ransi(underline),":","\n"], 0}; +render_element({dd,_,Content},[dl | _] = State,Pos,Ind,D) -> + trimnlnl(render_docs(Content, [li | State], Pos, Ind + 2, D)); + +render_element(B, State, Pos, Ind,#config{ io_columns = Cols }) when is_binary(B) -> + case lists:member(pre,State) of + true -> + Pre = string:replace(B,"\n",["\n",pad(Ind)],all), + {Pre, Pos + lastline(Pre)}; + _ -> + render_words(split_to_words(B),State,Pos,Ind,[[]],Cols) + end; + +render_element({Tag,Attr,Content}, State, Pos, Ind,D) -> + throw({unhandled,{Tag,Attr,Content,Pos,Ind}}), + render_docs(Content, State, Pos, Ind,D). + +render_words(Words,[_,types|State],Pos,Ind,Acc,Cols) -> + %% When we render words and are in the types->type state we indent + %% the extra lines two additional spaces to make it look nice + render_words(Words,State,Pos,Ind+2,Acc,Cols); +render_words([Word|T],State,Pos,Ind,Acc,Cols) when is_binary(Word) -> + WordLength = string:length(Word), + NewPos = WordLength + Pos, + if + NewPos > (Cols - 10 - Ind) -> + %% Word does not fit, time to add a newline and also pad to Indent level + render_words(T,State,WordLength+Ind+1,Ind,[[[pad(Ind), Word]]|Acc],Cols); + true -> + %% Word does fit on line + [Line | LineAcc] = Acc, + %% Add + 1 to length for space + NewPosSpc = NewPos+1, + render_words(T,State,NewPosSpc,Ind,[[Word|Line]|LineAcc],Cols) + end; +render_words([],_State,Pos,_Ind,Acc,_Cols) -> + Lines = lists:join( + $\n,lists:map(fun(RevLine) -> + Line = lists:reverse(RevLine), + lists:join($ ,Line) + end,lists:reverse(Acc))), + {iolist_to_binary(Lines), Pos}. + +render_type_signature(Name, #config{ docs = #docs_v1{ metadata = #{ types := AllTypes }}}) -> + case [Type || Type = {TName,_} <- maps:keys(AllTypes), TName =:= Name] of + [] -> + undefined; + Types -> + [erl_pp:attribute(maps:get(Type, AllTypes)) || Type <- Types] + end. + +%% Pad N spaces, disabling any ansi formatting while doing so +pad(N) -> + Pad = lists:duplicate(N," "), + case ansi() of + undefined -> + Pad; + Ansi -> + ["\033[0m",Pad,Ansi] + end. + +get_bullet(_State,latin1) -> + <<" * ">>; +get_bullet(State,unicode) -> + %% Fancy bullet point logic! + lists:nth(length([l || l <- State]), + [<<" • "/utf8>>,<<" ￮ "/utf8>>, + <<" ◼ "/utf8>>,<<" ◻ "/utf8>>]). + +% Look for the length of the last line of a string +lastline(Str) -> + LastStr = case string:find(Str,"\n",trailing) of + nomatch -> + Str; + Match -> + tl(string:next_codepoint(Match)) + end, + string:length(LastStr). + +split_to_words(B) -> + binary:split(B,[<<" ">>],[global]). + +%% These functions make sure that we trim extra newlines added +%% by the renderer. For example if we do <li><p></p></li> +%% that would add 4 \n at after the last </li>. This is trimmed +%% here to only be 2 \n +trimnlnl({Chars, _Pos}) -> + nl(nl(string:trim(Chars, trailing, "\n"))); +trimnlnl(Chars) -> + nl(nl(string:trim(Chars, trailing, "\n"))). +trimnl({Chars, _Pos}) -> + nl(string:trim(Chars, trailing, "\n")). +nl({Chars, _Pos}) -> + nl(Chars); +nl(Chars) -> + {[Chars,"\n"],0}. + +%% We keep the current ansi state in the pdict so that we know +%% what to disable and enable when doing padding +init_ansi(#config{ io_opts = Opts }) -> + %% We use this as our heuristic to see if we should print ansi or not + case {application:get_env(kernel, shell_docs_ansi), + proplists:is_defined(echo, Opts) andalso + proplists:is_defined(expand_fun, Opts), + os:type()} of + {{ok,false}, _, _} -> + put(ansi, noansi); + {{ok,true}, _, _} -> + put(ansi, []); + {_, _, {win32,_}} -> + put(ansi, noansi); + {_, true,_} -> + put(ansi, []); + {_, false,_} -> + put(ansi, noansi) + end. + +clean_ansi() -> + case get(ansi) of + [] -> erase(ansi); + noansi -> erase(ansi) + end, + ok. + +%% Set ansi +sansi(Type) -> sansi(Type, get(ansi)). +sansi(_Type, noansi) -> + []; +sansi(Type, Curr) -> + put(ansi,[Type | Curr]), + ansi(get(ansi)). + +%% Clear ansi +ransi(Type) -> ransi(Type, get(ansi)). +ransi(_Type, noansi) -> + []; +ransi(Type, Curr) -> + put(ansi,proplists:delete(Type,Curr)), + case ansi(get(ansi)) of + undefined -> + "\033[0m"; + Ansi -> + Ansi + end. + +ansi() -> ansi(get(ansi)). +ansi(noansi) -> undefined; +ansi(Curr) -> + case lists:usort(Curr) of + [] -> + undefined; + [bold] -> + "\033[;1m"; + [underline] -> + "\033[;;4m"; + [bold,underline] -> + "\033[;1;4m" + end. diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 6ade386159..9334a06ca2 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -92,6 +92,7 @@ sets, shell, shell_default, + shell_docs, slave, sofs, string, @@ -108,6 +109,6 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-10.6.2","crypto-3.3", + {runtime_dependencies, ["sasl-3.0","kernel-@OTP-15251@","erts-@OTP-15251@","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 1ac7334830..acb9dd1970 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -32,6 +32,9 @@ -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, format_status/2]). +%% logger callback +-export([format_log/1, format_log/2]). + %% For release_handler only -export([get_callback_module/1]). @@ -44,14 +47,17 @@ {reason,Reason}, {offender,extract_child(Child)}]}, #{domain=>[otp,sasl], - report_cb=>fun logger:format_otp_report/1, + report_cb=>fun supervisor:format_log/2, logger_formatter=>#{title=>"SUPERVISOR REPORT"}, error_logger=>#{tag=>error_report, - type=>supervisor_report}})). + type=>supervisor_report, + report_cb=>fun supervisor:format_log/1}})). %%-------------------------------------------------------------------------- --export_type([sup_flags/0, child_spec/0, startchild_ret/0, strategy/0]). +-export_type([sup_flags/0, child_spec/0, strategy/0, + startchild_ret/0, startchild_err/0, + startlink_ret/0, startlink_err/0]). %%-------------------------------------------------------------------------- @@ -122,7 +128,7 @@ strategy :: strategy() | 'undefined', children = {[],#{}} :: children(), % Ids in start order dynamics :: {'maps', #{pid() => list()}} - | {'sets', sets:set(pid())} + | {'mapsets', #{pid() => []}} | 'undefined', intensity :: non_neg_integer() | 'undefined', period :: pos_integer() | 'undefined', @@ -924,21 +930,21 @@ monitor_child(Pid) -> terminate_dynamic_children(State) -> Child = get_dynamic_child(State), {Pids, EStack0} = monitor_dynamic_children(Child,State), - Sz = sets:size(Pids), + Sz = maps:size(Pids), EStack = case Child#child.shutdown of brutal_kill -> - sets:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + maps:fold(fun(P, _, _) -> exit(P, kill) end, ok, Pids), wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); infinity -> - sets:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + maps:fold(fun(P, _, _) -> exit(P, shutdown) end, ok, Pids), wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); Time -> - sets:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + maps:fold(fun(P, _, _) -> exit(P, shutdown) end, ok, Pids), TRef = erlang:start_timer(Time, self(), kill), wait_dynamic_children(Child, Pids, Sz, TRef, EStack0) end, %% Unroll stacked errors and report them - dict:fold(fun(Reason, Ls, _) -> + maps:fold(fun(Reason, Ls, _) -> ?report_error(shutdown_error, Reason, Child#child{pid=Ls}, State#state.name) end, ok, EStack). @@ -947,15 +953,15 @@ monitor_dynamic_children(Child,State) -> dyn_fold(fun(P,{Pids, EStack}) when is_pid(P) -> case monitor_child(P) of ok -> - {sets:add_element(P, Pids), EStack}; + {maps:put(P, P, Pids), EStack}; {error, normal} when not (?is_permanent(Child)) -> {Pids, EStack}; {error, Reason} -> - {Pids, dict:append(Reason, P, EStack)} + {Pids, maps_prepend(Reason, P, EStack)} end; (?restarting(_), {Pids, EStack}) -> {Pids, EStack} - end, {sets:new(), dict:new()}, State). + end, {maps:new(), maps:new()}, State). wait_dynamic_children(_Child, _Pids, 0, undefined, EStack) -> EStack; @@ -973,36 +979,44 @@ wait_dynamic_children(#child{shutdown=brutal_kill} = Child, Pids, Sz, TRef, EStack) -> receive {'DOWN', _MRef, process, Pid, killed} -> - wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1, + wait_dynamic_children(Child, maps:remove(Pid, Pids), Sz-1, TRef, EStack); {'DOWN', _MRef, process, Pid, Reason} -> - wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1, - TRef, dict:append(Reason, Pid, EStack)) + wait_dynamic_children(Child, maps:remove(Pid, Pids), Sz-1, + TRef, maps_prepend(Reason, Pid, EStack)) end; wait_dynamic_children(Child, Pids, Sz, TRef, EStack) -> receive {'DOWN', _MRef, process, Pid, shutdown} -> - wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1, + wait_dynamic_children(Child, maps:remove(Pid, Pids), Sz-1, TRef, EStack); {'DOWN', _MRef, process, Pid, {shutdown, _}} -> - wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1, + wait_dynamic_children(Child, maps:remove(Pid, Pids), Sz-1, TRef, EStack); {'DOWN', _MRef, process, Pid, normal} when not (?is_permanent(Child)) -> - wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1, + wait_dynamic_children(Child, maps:remove(Pid, Pids), Sz-1, TRef, EStack); {'DOWN', _MRef, process, Pid, Reason} -> - wait_dynamic_children(Child, sets:del_element(Pid, Pids), Sz-1, - TRef, dict:append(Reason, Pid, EStack)); + wait_dynamic_children(Child, maps:remove(Pid, Pids), Sz-1, + TRef, maps_prepend(Reason, Pid, EStack)); {timeout, TRef, kill} -> - sets:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + maps:fold(fun(P, _, _) -> exit(P, kill) end, ok, Pids), wait_dynamic_children(Child, Pids, Sz, undefined, EStack) end. +maps_prepend(Key, Value, Map) -> + case maps:find(Key, Map) of + {ok, Values} -> + maps:put(Key, [Value|Values], Map); + error -> + maps:put(Key, [Value], Map) + end. + %%----------------------------------------------------------------- %% Access #state.children %%----------------------------------------------------------------- @@ -1420,9 +1434,159 @@ report_progress(Child, SupName) -> report=>[{supervisor,SupName}, {started,extract_child(Child)}]}, #{domain=>[otp,sasl], - report_cb=>fun logger:format_otp_report/1, + report_cb=>fun supervisor:format_log/2, logger_formatter=>#{title=>"PROGRESS REPORT"}, - error_logger=>#{tag=>info_report,type=>progress}}). + error_logger=>#{tag=>info_report, + type=>progress, + report_cb=>fun supervisor:format_log/1}}). + +%% format_log/1 is the report callback used by Logger handler +%% error_logger only. It is kept for backwards compatibility with +%% legacy error_logger event handlers. This function must always +%% return {Format,Args} compatible with the arguments in this module's +%% calls to error_logger prior to OTP-21.0. +format_log(LogReport) -> + Depth = error_logger:get_format_depth(), + FormatOpts = #{chars_limit => unlimited, + depth => Depth, + single_line => false, + encoding => utf8}, + format_log_multi(limit_report(LogReport, Depth), FormatOpts). + +limit_report(LogReport, unlimited) -> + LogReport; +limit_report(#{label:={supervisor,progress}, + report:=[{supervisor,_}=Supervisor,{started,Child}]}=LogReport, + Depth) -> + LogReport#{report=>[Supervisor, + {started,limit_child_report(Child, Depth)}]}; +limit_report(#{label:={supervisor,_Error}, + report:=[{supervisor,_}=Supervisor,{errorContext,Ctxt}, + {reason,Reason},{offender,Child}]}=LogReport, + Depth) -> + LogReport#{report=>[Supervisor, + {errorContext,io_lib:limit_term(Ctxt, Depth)}, + {reason,io_lib:limit_term(Reason, Depth)}, + {offender,limit_child_report(Child, Depth)}]}. + +limit_child_report(Report, Depth) -> + io_lib:limit_term(Report, Depth). + +%% format_log/2 is the report callback for any Logger handler, except +%% error_logger. +format_log(Report, FormatOpts0) -> + Default = #{chars_limit => unlimited, + depth => unlimited, + single_line => false, + encoding => utf8}, + FormatOpts = maps:merge(Default, FormatOpts0), + IoOpts = + case FormatOpts of + #{chars_limit:=unlimited} -> + []; + #{chars_limit:=Limit} -> + [{chars_limit,Limit}] + end, + {Format,Args} = format_log_single(Report, FormatOpts), + io_lib:format(Format, Args, IoOpts). + +format_log_single(#{label:={supervisor,progress}, + report:=[{supervisor,SupName},{started,Child}]}, + #{single_line:=true,depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + {ChildFormat,ChildArgs} = format_child_log_single(Child, "Started:"), + Format = "Supervisor: "++P++".", + Args = + case Depth of + unlimited -> + [SupName]; + _ -> + [SupName,Depth] + end, + {Format++ChildFormat,Args++ChildArgs}; +format_log_single(#{label:={supervisor,_Error}, + report:=[{supervisor,SupName}, + {errorContext,Ctxt}, + {reason,Reason}, + {offender,Child}]}, + #{single_line:=true,depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = lists:append(["Supervisor: ",P,". Context: ",P, + ". Reason: ",P,"."]), + {ChildFormat,ChildArgs} = format_child_log_single(Child, "Offender:"), + Args = + case Depth of + unlimited -> + [SupName,Ctxt,Reason]; + _ -> + [SupName,Depth,Ctxt,Depth,Reason,Depth] + end, + {Format++ChildFormat,Args++ChildArgs}; +format_log_single(Report,FormatOpts) -> + format_log_multi(Report,FormatOpts). + +format_log_multi(#{label:={supervisor,progress}, + report:=[{supervisor,SupName}, + {started,Child}]}, + #{depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = + lists:append( + [" supervisor: ",P,"~n", + " started: ",P,"~n"]), + Args = + case Depth of + unlimited -> + [SupName,Child]; + _ -> + [SupName,Depth,Child,Depth] + end, + {Format,Args}; +format_log_multi(#{label:={supervisor,_Error}, + report:=[{supervisor,SupName}, + {errorContext,Ctxt}, + {reason,Reason}, + {offender,Child}]}, + #{depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = + lists:append( + [" supervisor: ",P,"~n", + " errorContext: ",P,"~n", + " reason: ",P,"~n", + " offender: ",P,"~n"]), + Args = + case Depth of + unlimited -> + [SupName,Ctxt,Reason,Child]; + _ -> + [SupName,Depth,Ctxt,Depth,Reason,Depth,Child,Depth] + end, + {Format,Args}. + +format_child_log_single(Child, Tag) -> + {id,Id} = lists:keyfind(id, 1, Child), + case lists:keyfind(pid, 1, Child) of + false -> + {nb_children,NumCh} = lists:keyfind(nb_children, 1, Child), + {" ~s id=~w,nb_children=~w.", [Tag,Id,NumCh]}; + T when is_tuple(T) -> + {pid,Pid} = lists:keyfind(pid, 1, Child), + {" ~s id=~w,pid=~w.", [Tag,Id,Pid]} + end. + +p(#{single_line:=Single,depth:=Depth,encoding:=Enc}) -> + "~"++single(Single)++mod(Enc)++p(Depth); +p(unlimited) -> + "p"; +p(_Depth) -> + "P". + +single(true) -> "0"; +single(false) -> "". + +mod(latin1) -> ""; +mod(_) -> "t". format_status(terminate, [_PDict, State]) -> State; @@ -1431,36 +1595,41 @@ format_status(_, [_PDict, State]) -> {supervisor, [{"Callback", State#state.module}]}]. %%%----------------------------------------------------------------- -%%% Dynamics database access -dyn_size(#state{dynamics = {Mod,Db}}) -> - Mod:size(Db). +%%% Dynamics database access. +%%% +%%% Store all dynamic children in a map with the pid as the key. If +%%% the children are permanent, store the start arguments as the value, +%%% otherwise store [] as the value. +%%% -dyn_erase(Pid,#state{dynamics={sets,Db}}=State) -> - State#state{dynamics={sets,sets:del_element(Pid,Db)}}; -dyn_erase(Pid,#state{dynamics={maps,Db}}=State) -> +dyn_size(#state{dynamics = {_Kind,Db}}) -> + map_size(Db). + +dyn_erase(Pid,#state{dynamics={_Kind,Db}}=State) -> State#state{dynamics={maps,maps:remove(Pid,Db)}}. -dyn_store(Pid,_,#state{dynamics={sets,Db}}=State) -> - State#state{dynamics={sets,sets:add_element(Pid,Db)}}; -dyn_store(Pid,Args,#state{dynamics={maps,Db}}=State) -> - State#state{dynamics={maps,Db#{Pid => Args}}}. +dyn_store(Pid,Args,#state{dynamics={Kind,Db}}=State) -> + case Kind of + mapsets -> + %% Children are temporary. The start arguments + %% will not be needed again. Store []. + State#state{dynamics={mapsets,Db#{Pid => []}}}; + maps -> + %% Children are permanent and may be restarted. + %% Store the start arguments. + State#state{dynamics={maps,Db#{Pid => Args}}} + end. -dyn_fold(Fun,Init,#state{dynamics={sets,Db}}) -> - sets:fold(Fun,Init,Db); -dyn_fold(Fun,Init,#state{dynamics={maps,Db}}) -> +dyn_fold(Fun,Init,#state{dynamics={_Kind,Db}}) -> maps:fold(fun(Pid,_,Acc) -> Fun(Pid,Acc) end, Init, Db). -dyn_map(Fun, #state{dynamics={sets,Db}}) -> - lists:map(Fun, sets:to_list(Db)); -dyn_map(Fun, #state{dynamics={maps,Db}}) -> +dyn_map(Fun, #state{dynamics={_Kind,Db}}) -> lists:map(Fun, maps:keys(Db)). -dyn_exists(Pid, #state{dynamics={sets, Db}}) -> - sets:is_element(Pid, Db); -dyn_exists(Pid, #state{dynamics={maps, Db}}) -> - maps:is_key(Pid, Db). +dyn_exists(Pid, #state{dynamics={_Kind, Db}}) -> + is_map_key(Pid, Db). -dyn_args(_Pid, #state{dynamics={sets, _Db}}) -> +dyn_args(_Pid, #state{dynamics={mapsets, _Db}}) -> {ok,undefined}; dyn_args(Pid, #state{dynamics={maps, Db}}) -> maps:find(Pid, Db). @@ -1469,6 +1638,6 @@ dyn_init(State) -> dyn_init(get_dynamic_child(State),State). dyn_init(Child,State) when ?is_temporary(Child) -> - State#state{dynamics={sets,sets:new()}}; + State#state{dynamics={mapsets,maps:new()}}; dyn_init(_Child,State) -> State#state{dynamics={maps,maps:new()}}. diff --git a/lib/stdlib/src/supervisor_bridge.erl b/lib/stdlib/src/supervisor_bridge.erl index 21ba6f53af..abbfb404a5 100644 --- a/lib/stdlib/src/supervisor_bridge.erl +++ b/lib/stdlib/src/supervisor_bridge.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,6 +28,8 @@ %% Internal exports -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]). -export([code_change/3]). +%% logger callback +-export([format_log/1, format_log/2]). -callback init(Args :: term()) -> {ok, Pid :: pid(), State :: term()} | ignore | {error, Error :: term()}. @@ -136,9 +138,12 @@ report_progress(Pid, Mod, StartArgs, SupName) -> {started, [{pid, Pid}, {mfa, {Mod, init, [StartArgs]}}]}]}, #{domain=>[otp,sasl], - report_cb=>fun logger:format_otp_report/1, + report_cb=>fun supervisor_bridge:format_log/2, logger_formatter=>#{title=>"PROGRESS REPORT"}, - error_logger=>#{tag=>info_report,type=>progress}}). + error_logger=>#{tag=>info_report, + type=>progress, + report_cb=> + fun supervisor_bridge:format_log/1}}). report_error(Error, Reason, #state{name = Name, pid = Pid, mod = Mod}) -> ?LOG_ERROR(#{label=>{supervisor,error}, @@ -147,6 +152,167 @@ report_error(Error, Reason, #state{name = Name, pid = Pid, mod = Mod}) -> {reason, Reason}, {offender, [{pid, Pid}, {mod, Mod}]}]}, #{domain=>[otp,sasl], - report_cb=>fun logger:format_otp_report/1, + report_cb=>fun supervisor_bridge:format_log/2, logger_formatter=>#{title=>"SUPERVISOR REPORT"}, - error_logger=>#{tag=>error_report,type=>supervisor_report}}). + error_logger=>#{tag=>error_report, + type=>supervisor_report, + report_cb=> + fun supervisor_bridge:format_log/1}}). + +%% format_log/1 is the report callback used by Logger handler +%% error_logger only. It is kept for backwards compatibility with +%% legacy error_logger event handlers. This function must always +%% return {Format,Args} compatible with the arguments in this module's +%% calls to error_logger prior to OTP-21.0. +format_log(LogReport) -> + Depth = error_logger:get_format_depth(), + FormatOpts = #{chars_limit => unlimited, + depth => Depth, + single_line => false, + encoding => utf8}, + format_log_multi(limit_report(LogReport, Depth), FormatOpts). + +limit_report(LogReport, unlimited) -> + LogReport; +limit_report(#{label:={supervisor,progress}, + report:=[{supervisor,_}=Supervisor,{started,Child}]}=LogReport, + Depth) -> + LogReport#{report=>[Supervisor, + {started,limit_child_report(Child, Depth)}]}; +limit_report(#{label:={supervisor,error}, + report:=[{supervisor,_}=Supervisor,{errorContext,Ctxt}, + {reason,Reason},{offender,Child}]}=LogReport, + Depth) -> + LogReport#{report=>[Supervisor, + {errorContext,io_lib:limit_term(Ctxt, Depth)}, + {reason,io_lib:limit_term(Reason, Depth)}, + {offender,io_lib:limit_term(Child, Depth)}]}. + +limit_child_report(ChildReport, Depth) -> + {mfa,{M,F,[As]}} = lists:keyfind(mfa, 1, ChildReport), + NewMFAs = {M,F,[io_lib:limit_term(As, Depth)]}, + lists:keyreplace(mfa, 1, ChildReport, {mfa,NewMFAs}). + +%% format_log/2 is the report callback for any Logger handler, except +%% error_logger. +format_log(Report, FormatOpts0) -> + Default = #{chars_limit => unlimited, + depth => unlimited, + single_line => false, + encoding => utf8}, + FormatOpts = maps:merge(Default, FormatOpts0), + IoOpts = + case FormatOpts of + #{chars_limit:=unlimited} -> + []; + #{chars_limit:=Limit} -> + [{chars_limit,Limit}] + end, + {Format,Args} = format_log_single(Report, FormatOpts), + io_lib:format(Format, Args, IoOpts). + +format_log_single(#{label:={supervisor,progress}, + report:=[{supervisor,SupName},{started,Child}]}, + #{single_line:=true,depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + {ChildFormat,ChildArgs} = + format_child_log_progress_single(Child, "Started:", FormatOpts), + Format = "Supervisor: "++P++".", + Args = + case Depth of + unlimited -> + [SupName]; + _ -> + [SupName,Depth] + end, + {Format++ChildFormat,Args++ChildArgs}; +format_log_single(#{label:={supervisor,_Error}, + report:=[{supervisor,SupName}, + {errorContext,Ctxt}, + {reason,Reason}, + {offender,Child}]}, + #{single_line:=true,depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = lists:append(["Supervisor: ",P,". Context: ",P, + ". Reason: ",P,"."]), + {ChildFormat,ChildArgs} = + format_child_log_error_single(Child, "Offender:"), + Args = + case Depth of + unlimited -> + [SupName,Ctxt,Reason]; + _ -> + [SupName,Depth,Ctxt,Depth,Reason,Depth] + end, + {Format++ChildFormat,Args++ChildArgs}; +format_log_single(Report, FormatOpts) -> + format_log_multi(Report, FormatOpts). + +format_log_multi(#{label:={supervisor,progress}, + report:=[{supervisor,SupName}, + {started,Child}]}, + #{depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = + lists:append( + [" supervisor: ",P,"~n", + " started: ",P,"~n"]), + Args = + case Depth of + unlimited -> + [SupName,Child]; + _ -> + [SupName,Depth,Child,Depth] + end, + {Format,Args}; +format_log_multi(#{label:={supervisor,_Error}, + report:=[{supervisor,SupName}, + {errorContext,Ctxt}, + {reason,Reason}, + {offender,Child}]}, + #{depth:=Depth}=FormatOpts) -> + P = p(FormatOpts), + Format = + lists:append( + [" supervisor: ",P,"~n", + " errorContext: ",P,"~n", + " reason: ",P,"~n", + " offender: ",P,"~n"]), + Args = + case Depth of + unlimited -> + [SupName,Ctxt,Reason,Child]; + _ -> + [SupName,Depth,Ctxt,Depth,Reason,Depth,Child,Depth] + end, + {Format,Args}. + +format_child_log_progress_single(Child, Tag, FormatOpts) -> + {pid,Pid} = lists:keyfind(pid, 1, Child), + {mfa,MFAs} = lists:keyfind(mfa, 1, Child), + Args = + case maps:get(depth, FormatOpts) of + unlimited -> + [MFAs]; + Depth -> + [MFAs, Depth] + end, + {" ~s pid=~w,mfa="++p(FormatOpts)++".",[Tag,Pid]++Args}. + +format_child_log_error_single(Child, Tag) -> + {pid,Pid} = lists:keyfind(pid, 1, Child), + {mod,Mod} = lists:keyfind(mod, 1, Child), + {" ~s pid=~w,mod=~w.",[Tag,Pid,Mod]}. + +p(#{single_line:=Single,depth:=Depth,encoding:=Enc}) -> + "~"++single(Single)++mod(Enc)++p(Depth); +p(unlimited) -> + "p"; +p(_Depth) -> + "P". + +single(true) -> "0"; +single(false) -> "". + +mod(latin1) -> ""; +mod(_) -> "t". diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index 93bf4743d2..e803b749f7 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -31,7 +31,10 @@ install/2, install/3, remove/2, remove/3]). -export([handle_system_msg/6, handle_system_msg/7, handle_debug/4, print_log/1, get_log/1, get_debug/3, debug_options/1, suspend_loop_hib/6]). --deprecated([{get_debug,3,eventually}]). + +-deprecated([{get_debug,3, + "incorrectly documented and only for internal use. Can often " + "be replaced with sys:get_log/1"}]). %%----------------------------------------------------------------- %% Types diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index a922bf3fbe..8f703d9d1a 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2018. All Rights Reserved. +%% Copyright Ericsson AB 2006-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -53,6 +53,10 @@ %% for debugging, to turn off catch -define(CATCH, catch). +%% Debug. +-define(SHOW_GP_BIT_11(B, F), ok). +%%-define(SHOW_GP_BIT_11(B, F), io:format("F = ~.16#, B = ~lp\n", [F, B])). + %% option sets -record(unzip_opts, { output, % output object (fun) @@ -138,6 +142,10 @@ -define(PKWARE_RESERVED, 11). -define(BZIP2_COMPRESSED, 12). +%% Version 2.0, attribute compatibility type 3 (Unix) +-define(VERSION_MADE_BY, 20 bor (3 bsl 8)). +-define(GP_BIT_11, 16#800). % Filename and file comment UTF-8 encoded. + %% zip-file records -define(LOCAL_FILE_MAGIC,16#04034b50). -define(LOCAL_FILE_HEADER_SZ,(4+2+2+2+2+2+4+4+4+2+2)). @@ -160,6 +168,7 @@ -define(CENTRAL_DIR_DIGITAL_SIG_MAGIC, 16#05054b50). -define(CENTRAL_DIR_DIGITAL_SIG_SZ, (4+2)). +-define(CENTRAL_FILE_EXT_ATTRIBUTES, 8#644 bsl 16). -define(CENTRAL_FILE_MAGIC, 16#02014b50). -record(cd_file_header, {version_made_by, @@ -191,12 +200,16 @@ zip_comment_length}). --type create_option() :: memory | cooked | verbose | {comment, string()} - | {cwd, file:filename()} - | {compress, extension_spec()} - | {uncompress, extension_spec()}. +-type create_option() :: memory | cooked | verbose + | {comment, Comment ::string()} + | {cwd, CWD :: file:filename()} + | {compress, What :: extension_spec()} + | {uncompress, What :: extension_spec()}. -type extension() :: string(). --type extension_spec() :: all | [extension()] | {add, [extension()]} | {del, [extension()]}. +-type extension_spec() :: all + | [Extension :: extension()] + | {add, [Extension :: extension()]} + | {del, [Extension :: extension()]}. -type filename() :: file:filename(). -type zip_comment() :: #zip_comment{}. @@ -277,8 +290,11 @@ do_openzip_get(_, _) -> throw(einval). file_name_search(Name,Files) -> - case lists:dropwhile(fun({ZipFile,_}) -> ZipFile#zip_file.name =/= Name end, - Files) of + Fun = fun({ZipFile,_}) -> + not string:equal(ZipFile#zip_file.name, Name, + _IgnoreCase = false, _Norm = nfc) + end, + case lists:dropwhile(Fun, Files) of [ZFile|_] -> ZFile; [] -> false end. @@ -429,12 +445,7 @@ zip(F, Files) -> zip(F, Files, []). FileSpec :: file:name() | {file:name(), binary()} | {file:name(), binary(), file:file_info()}, Options :: [Option], - Option :: memory | cooked | verbose | {comment, Comment} - | {cwd, CWD} | {compress, What} | {uncompress, What}, - What :: all | [Extension] | {add, [Extension]} | {del, [Extension]}, - Extension :: string(), - Comment :: string(), - CWD :: file:filename(), + Option :: create_option(), RetValue :: {ok, FileName :: file:name()} | {ok, {FileName :: file:name(), binary()}} | {error, Reason :: term()}). @@ -622,9 +633,11 @@ get_zip_opt([Unknown | _Rest], _Opts) -> %% feedback funs silent(_) -> ok. -verbose_unzip(FN) -> io:format("extracting: ~tp\n", [FN]). +verbose_unzip(FN) -> + io:format("extracting: ~ts\n", [io_lib:write_string(FN)]). -verbose_zip(FN) -> io:format("adding: ~tp\n", [FN]). +verbose_zip(FN) -> + io:format("adding: ~ts\n", [io_lib:write_string(FN)]). %% file filter funs all(_) -> true. @@ -655,7 +668,10 @@ get_zip_options(Files, Options) -> compress = all, uncompress = Suffixes }, - get_zip_opt(Options, Opts). + Opts1 = #zip_opts{comment = Comment} = get_zip_opt(Options, Opts), + %% UTF-8 encode characters in the interval from 127 to 255. + {Comment1, _} = encode_string(Comment), + Opts1#zip_opts{comment = Comment1}. get_unzip_options(F, Options) -> Opts = #unzip_opts{file_filter = fun all/1, @@ -850,16 +866,18 @@ put_z_files([F | Rest], Z, Out0, Pos0, regular -> FileInfo#file_info.size; directory -> 0 end, - FileName = get_filename(F, Type), + FileName0 = get_filename(F, Type), + %% UTF-8 encode characters in the interval from 127 to 255. + {FileName, GPFlag} = encode_string(FileName0), CompMethod = get_comp_method(FileName, UncompSize, Opts, Type), - LH = local_file_header_from_info_method_name(FileInfo, UncompSize, CompMethod, FileName), + LH = local_file_header_from_info_method_name(FileInfo, UncompSize, CompMethod, FileName, GPFlag), BLH = local_file_header_to_bin(LH), B = [<<?LOCAL_FILE_MAGIC:32/little>>, BLH], Out1 = Output({write, B}, Out0), Out2 = Output({write, FileName}, Out1), {Out3, CompSize, CRC} = put_z_file(CompMethod, UncompSize, Out2, F1, 0, Input, Output, OpO, Z, Type), - FB(FileName), + FB(FileName0), Patch = <<CRC:32/little, CompSize:32/little>>, Out4 = Output({pwrite, Pos0 + ?LOCAL_FILE_HEADER_CRC32_OFFSET, Patch}, Out3), Out5 = Output({seek, eof, 0}, Out4), @@ -1012,7 +1030,7 @@ cd_file_header_from_lh_and_pos(LH, Pos) -> uncomp_size = UncompSize, file_name_length = FileNameLength, extra_field_length = ExtraFieldLength} = LH, - #cd_file_header{version_made_by = 20, + #cd_file_header{version_made_by = ?VERSION_MADE_BY, version_needed = VersionNeeded, gp_flag = GPFlag, comp_method = CompMethod, @@ -1026,7 +1044,7 @@ cd_file_header_from_lh_and_pos(LH, Pos) -> file_comment_length = 0, % FileCommentLength, disk_num_start = 0, % DiskNumStart, internal_attr = 0, % InternalAttr, - external_attr = 0, % ExternalAttr, + external_attr = ?CENTRAL_FILE_EXT_ATTRIBUTES, % ExternalAttr, local_header_offset = Pos}. cd_file_header_to_bin( @@ -1103,10 +1121,10 @@ eocd_to_bin(#eocd{disk_num = DiskNum, %% put together a local file header local_file_header_from_info_method_name(#file_info{mtime = MTime}, UncompSize, - CompMethod, Name) -> + CompMethod, Name, GPFlag) -> {ModDate, ModTime} = dos_date_time_from_datetime(MTime), #local_file_header{version_needed = 20, - gp_flag = 0, + gp_flag = GPFlag, comp_method = CompMethod, last_mod_time = ModTime, last_mod_date = ModDate, @@ -1270,7 +1288,9 @@ get_central_dir(In0, RawIterator, Input) -> In2 = Input({seek, bof, EOCD#eocd.offset}, In1), N = EOCD#eocd.entries, Acc0 = [], - Out0 = RawIterator(EOCD, "", binary_to_list(BComment), <<>>, Acc0), + %% There is no encoding flag for the archive comment. + Comment = heuristic_to_string(BComment), + Out0 = RawIterator(EOCD, "", Comment, <<>>, Acc0), get_cd_loop(N, In2, RawIterator, Input, Out0). get_cd_loop(0, In, _RawIterator, _Input, Acc) -> @@ -1286,20 +1306,32 @@ get_cd_loop(N, In0, RawIterator, Input, Acc0) -> ExtraLen = CD#cd_file_header.extra_field_length, CommentLen = CD#cd_file_header.file_comment_length, ToRead = FileNameLen + ExtraLen + CommentLen, + GPFlag = CD#cd_file_header.gp_flag, {B2, In2} = Input({read, ToRead}, In1), {FileName, Comment, BExtra} = - get_name_extra_comment(B2, FileNameLen, ExtraLen, CommentLen), + get_name_extra_comment(B2, FileNameLen, ExtraLen, CommentLen, GPFlag), Acc1 = RawIterator(CD, FileName, Comment, BExtra, Acc0), get_cd_loop(N-1, In2, RawIterator, Input, Acc1). -get_name_extra_comment(B, FileNameLen, ExtraLen, CommentLen) -> - case B of - <<BFileName:FileNameLen/binary, - BExtra:ExtraLen/binary, - BComment:CommentLen/binary>> -> - {binary_to_list(BFileName), binary_to_list(BComment), BExtra}; - _ -> - throw(bad_central_directory) +get_name_extra_comment(B, FileNameLen, ExtraLen, CommentLen, GPFlag) -> + try + <<BFileName:FileNameLen/binary, + BExtra:ExtraLen/binary, + BComment:CommentLen/binary>> = B, + {binary_to_chars(BFileName, GPFlag), + %% Appendix D says: "If general purpose bit 11 is unset, the + %% file name and comment should conform to the original ZIP + %% character encoding." However, it seems that at least Linux + %% zip(1) encodes the comment without setting bit 11 if the + %% filename is 7-bit ASCII. If bit 11 is set, + %% binary_to_chars/1 could (should?) be called (it can fail), + %% but the choice is to employ heuristics in this case too + %% (it does not fail). + heuristic_to_string(BComment), + BExtra} + catch + _:_ -> + throw(bad_central_directory) end. %% get end record, containing the offset to the central directory @@ -1428,7 +1460,8 @@ get_z_file(In0, Z, Input, Output, OpO, FB, LH#local_file_header.crc32} end, {BFileN, In3} = Input({read, FileNameLen + ExtraLen}, In1), - {FileName, _} = get_file_name_extra(FileNameLen, ExtraLen, BFileN), + {FileName, _} = + get_file_name_extra(FileNameLen, ExtraLen, BFileN, GPFlag), ReadAndWrite = case check_valid_location(CWD, FileName) of {true,FileName1} -> @@ -1488,12 +1521,13 @@ check_dir_level([".." | Parts], Level) -> check_dir_level([_Dir | Parts], Level) -> check_dir_level(Parts, Level+1). -get_file_name_extra(FileNameLen, ExtraLen, B) -> - case B of - <<BFileName:FileNameLen/binary, BExtra:ExtraLen/binary>> -> - {binary_to_list(BFileName), BExtra}; - _ -> - throw(bad_file_header) +get_file_name_extra(FileNameLen, ExtraLen, B, GPFlag) -> + try + <<BFileName:FileNameLen/binary, BExtra:ExtraLen/binary>> = B, + {binary_to_chars(BFileName, GPFlag), BExtra} + catch + _:_ -> + throw(bad_file_header) end. %% get compressed or stored data @@ -1597,6 +1631,38 @@ skip_bin(B, Pos) when is_binary(B) -> _ -> <<>> end. +binary_to_chars(B, GPFlag) -> + ?SHOW_GP_BIT_11(B, GPFlag band ?GP_BIT_11), + case GPFlag band ?GP_BIT_11 of + 0 -> + binary_to_list(B); + ?GP_BIT_11 -> + case unicode:characters_to_list(B) of + List when is_list(List) -> + List + end + end. + +heuristic_to_string(B) when is_binary(B) -> + case unicode:characters_to_binary(B) of + B -> + unicode:characters_to_list(B); + _ -> + binary_to_list(B) + end. + +encode_string(String) -> + case lists:any(fun(C) -> C > 127 end, String) of + true -> + case unicode:characters_to_binary(String) of + B when is_binary(B) -> + {binary_to_list(B), ?GP_BIT_11}; + _ -> + throw({bad_unicode, String}) + end; + false -> + {String, 0} + end. %% ZIP header manipulations eocd_and_comment_from_bin(<<DiskNum:16/little, diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 7f7a0834ba..4b923c5fe2 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -34,11 +34,6 @@ MODULES= \ escript_SUITE \ ets_SUITE \ ets_tough_SUITE \ - expand_test \ - expand_test1 \ - unicode_expand \ - ExpandTestCaps \ - ExpandTestCaps1 \ filelib_SUITE \ file_sorter_SUITE \ filename_SUITE \ @@ -79,6 +74,7 @@ MODULES= \ supervisor_deadlock \ naughty_child \ shell_SUITE \ + shell_docs_SUITE \ supervisor_SUITE \ supervisor_bridge_SUITE \ sys_SUITE \ diff --git a/lib/stdlib/test/dict_test_lib.erl b/lib/stdlib/test/dict_test_lib.erl index 8f999f7cad..a85fd86ab9 100644 --- a/lib/stdlib/test/dict_test_lib.erl +++ b/lib/stdlib/test/dict_test_lib.erl @@ -39,6 +39,9 @@ new(Mod, Eq) -> end. empty(Mod) -> + %% The dict module might not be loaded since it not used by + %% anything in the core parts of Erlang/OTP. + {module,Mod} = code:ensure_loaded(Mod), case erlang:function_exported(Mod, new, 0) of false -> Mod:empty(); true -> Mod:new() @@ -48,6 +51,7 @@ to_list(Mod, D) -> Mod:to_list(D). from_list(Mod, L) -> + {module,Mod} = code:ensure_loaded(Mod), case erlang:function_exported(Mod, from_orddict, 1) of false -> Mod:from_list(L); @@ -63,6 +67,7 @@ from_list(Mod, L) -> %% Store new value into dictionary or update previous value in dictionary. enter(Mod, Key, Val, Dict) -> + {module,Mod} = code:ensure_loaded(Mod), case erlang:function_exported(Mod, store, 3) of false -> Mod:enter(Key, Val, Dict); diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl index 5c2b1965ba..dd6b25a531 100644 --- a/lib/stdlib/test/edlin_expand_SUITE.erl +++ b/lib/stdlib/test/edlin_expand_SUITE.erl @@ -27,6 +27,7 @@ -include_lib("common_test/include/ct.hrl"). init_per_testcase(_Case, Config) -> + cleanup(), Config. end_per_testcase(_Case, _Config) -> @@ -44,10 +45,6 @@ groups() -> []. init_per_suite(Config) -> - (catch code:delete(expand_test)), - (catch code:delete(expand_test1)), - (catch code:delete('ExpandTestCaps')), - (catch code:delete('ExpandTestCaps1')), Config. end_per_suite(_Config) -> @@ -59,9 +56,15 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +cleanup() -> + [try + code:purge(M), + code:delete(M) + catch _:_ -> ok end || M <- [expand_test, expand_test1, + 'ExpandTestCaps', 'ExpandTestCaps2']]. normal(Config) when is_list(Config) -> - {module,expand_test} = c:l(expand_test), + {module,expand_test} = compile_and_load(Config,expand_test), %% These tests might fail if another module with the prefix %% "expand_" happens to also be loaded. {yes, "test:", []} = do_expand("expand_"), @@ -80,8 +83,8 @@ normal(Config) when is_list(Config) -> %% Normal module name, some function names using quoted atoms. quoted_fun(Config) when is_list(Config) -> - {module,expand_test} = c:l(expand_test), - {module,expand_test1} = c:l(expand_test1), + {module,expand_test} = compile_and_load(Config,expand_test), + {module,expand_test1} = compile_and_load(Config,expand_test1), %% should be no colon after test this time {yes, "test", []} = do_expand("expand_"), {no, [], []} = do_expand("expandXX_"), @@ -112,7 +115,7 @@ quoted_fun(Config) when is_list(Config) -> ok. quoted_module(Config) when is_list(Config) -> - {module,'ExpandTestCaps'} = c:l('ExpandTestCaps'), + {module,'ExpandTestCaps'} = compile_and_load(Config,'ExpandTestCaps'), {yes, "Caps':", []} = do_expand("'ExpandTest"), {no,[], [{"a_fun_name",1}, @@ -125,8 +128,8 @@ quoted_module(Config) when is_list(Config) -> ok. quoted_both(Config) when is_list(Config) -> - {module,'ExpandTestCaps'} = c:l('ExpandTestCaps'), - {module,'ExpandTestCaps1'} = c:l('ExpandTestCaps1'), + {module,'ExpandTestCaps'} = compile_and_load(Config,'ExpandTestCaps'), + {module,'ExpandTestCaps1'} = compile_and_load(Config,'ExpandTestCaps1'), %% should be no colon (or quote) after test this time {yes, "Caps", []} = do_expand("'ExpandTest"), {no,[],[{"'#weird-fun-name'",0}, @@ -229,7 +232,7 @@ check_trailing([I|Str], ArityStr, Suffix, Dots) -> end. unicode(Config) when is_list(Config) -> - {module,unicode_expand} = c:l('unicode_expand'), + {module,unicode_expand} = compile_and_load(Config,'unicode_expand'), {no,[],[{"'кlирилли́ческий атом'",0}, {"'кlирилли́ческий атом'",1}, {"'кlирилли́ческий атомB'",1}, @@ -253,3 +256,10 @@ do_expand(String) -> do_format(StringList) -> lists:flatten(edlin_expand:format_matches(StringList)). + +compile_and_load(Config,Module) -> + Filename = filename:join( + proplists:get_value(data_dir,Config), + atom_to_list(Module)), + {ok,Module,Bin} = compile:file(Filename, [binary]), + code:load_binary(Module, Filename, Bin). diff --git a/lib/stdlib/test/ExpandTestCaps.erl b/lib/stdlib/test/edlin_expand_SUITE_data/ExpandTestCaps.erl index 7fb1107ae0..7fb1107ae0 100644 --- a/lib/stdlib/test/ExpandTestCaps.erl +++ b/lib/stdlib/test/edlin_expand_SUITE_data/ExpandTestCaps.erl diff --git a/lib/stdlib/test/ExpandTestCaps1.erl b/lib/stdlib/test/edlin_expand_SUITE_data/ExpandTestCaps1.erl index 400a17b137..400a17b137 100644 --- a/lib/stdlib/test/ExpandTestCaps1.erl +++ b/lib/stdlib/test/edlin_expand_SUITE_data/ExpandTestCaps1.erl diff --git a/lib/stdlib/test/expand_test.erl b/lib/stdlib/test/edlin_expand_SUITE_data/expand_test.erl index 5544923a12..5544923a12 100644 --- a/lib/stdlib/test/expand_test.erl +++ b/lib/stdlib/test/edlin_expand_SUITE_data/expand_test.erl diff --git a/lib/stdlib/test/expand_test1.erl b/lib/stdlib/test/edlin_expand_SUITE_data/expand_test1.erl index abefaefcfd..abefaefcfd 100644 --- a/lib/stdlib/test/expand_test1.erl +++ b/lib/stdlib/test/edlin_expand_SUITE_data/expand_test1.erl diff --git a/lib/stdlib/test/unicode_expand.erl b/lib/stdlib/test/edlin_expand_SUITE_data/unicode_expand.erl index 41f741fa84..41f741fa84 100644 --- a/lib/stdlib/test/unicode_expand.erl +++ b/lib/stdlib/test/edlin_expand_SUITE_data/unicode_expand.erl diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index c7556f6f7e..88e09c3d21 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -49,7 +49,8 @@ eep37/1, eep43/1, otp_15035/1, - otp_16439/1]). + otp_16439/1, + otp_14708/1]). %% %% Define to run outside of test server @@ -89,7 +90,7 @@ all() -> otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, otp_8133, otp_10622, otp_13228, otp_14826, funs, try_catch, eval_expr_5, zero_width, - eep37, eep43, otp_15035, otp_16439]. + eep37, eep43, otp_15035, otp_16439, otp_14708]. groups() -> []. @@ -1678,6 +1679,53 @@ otp_16439(Config) when is_list(Config) -> ok. +%% Test guard expressions in keys for maps and in sizes in binary matching. + +otp_14708(Config) when is_list(Config) -> + check(fun() -> X = 42, #{{tag,X} := V} = #{{tag,X} => a}, V end, + "begin X = 42, #{{tag,X} := V} = #{{tag,X} => a}, V end.", + a), + check(fun() -> + T = {x,y,z}, + Map = #{x => 99, y => 100}, + #{element(1, T) := V1, element(2, T) := V2} = Map, + {V1, V2} + end, + "begin + T = {x,y,z}, + Map = #{x => 99, y => 100}, + #{element(1, T) := V1, element(2, T) := V2} = Map, + {V1, V2} + end.", + {99, 100}), + error_check("#{term_to_binary(42) := _} = #{}.", illegal_guard_expr), + + check(fun() -> + <<Sz:16,Body:(Sz-1)/binary>> = <<4:16,1,2,3>>, + Body + end, + "begin + <<Sz:16,Body:(Sz-1)/binary>> = <<4:16,1,2,3>>, + Body + end.", + <<1,2,3>>), + check(fun() -> + Sizes = #{0 => 3, 1 => 7}, + <<SzTag:1,Body:(map_get(SzTag, Sizes))/binary>> = + <<1:1,1,2,3,4,5,6,7>>, + Body + end, + "begin + Sizes = #{0 => 3, 1 => 7}, + <<SzTag:1,Body:(map_get(SzTag, Sizes))/binary>> = + <<1:1,1,2,3,4,5,6,7>>, + Body + end.", + <<1,2,3,4,5,6,7>>), + error_check("<<X:(process_info(self()))>> = <<>>.", illegal_bitsize), + + ok. + %% Check the string in different contexts: as is; in fun; from compiled code. check(F, String, Result) -> check1(F, String, Result), diff --git a/lib/stdlib/test/erl_expand_records_SUITE.erl b/lib/stdlib/test/erl_expand_records_SUITE.erl index 3885f6648d..257546d6a4 100644 --- a/lib/stdlib/test/erl_expand_records_SUITE.erl +++ b/lib/stdlib/test/erl_expand_records_SUITE.erl @@ -702,9 +702,13 @@ otp_7078(Config) when is_list(Config) -> -record(otp_7101, {a,b,c=[],d=[],e=[]}). +id(I) -> I. + %% OTP-7101. Record update: more than one call to setelement/3. otp_7101(Config) when is_list(Config) -> - Rec = #otp_7101{}, + %% Ensure the compiler won't do any funny constant propagation tricks. + id(#otp_7101{a=a,b=b,c=c,d=d,e=e}), + Rec = id(#otp_7101{}), %% Spawn a tracer process to count the number of setelement/3 calls. %% The tracer will forward all trace messages to us. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 38d07249fd..c27b928a5a 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -69,7 +69,7 @@ stacktrace_syntax/1, otp_14285/1, otp_14378/1, external_funs/1,otp_15456/1,otp_15563/1, - unused_type/1]). + unused_type/1,removed/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -91,7 +91,7 @@ all() -> otp_11851, otp_11879, otp_13230, record_errors, otp_11879_cont, non_latin1_module, otp_14323, stacktrace_syntax, otp_14285, otp_14378, external_funs, - otp_15456, otp_15563, unused_type]. + otp_15456, otp_15563, unused_type, removed]. groups() -> [{unused_vars_warn, [], @@ -469,7 +469,7 @@ unused_vars_warn_lc(Config) when is_list(Config) -> ">>, [warn_unused_vars], {warnings,[{6,erl_lint,{unused_var,'C1'}}, - {7,sys_core_fold,no_clause_match}, + {7,sys_core_fold,no_clause_match}, {9,erl_lint,{unused_var,'C3'}}]}}, {lc21, @@ -1298,6 +1298,10 @@ unsized_binary_in_bin_gen_pattern(Config) when is_list(Config) -> << <<X,Tail/bits>> || <<X,Tail/bits>> <= Bin >>; t({bc,bitstring,Bin}) -> << <<X,Tail/bits>> || <<X,Tail/bitstring>> <= Bin >>; + t({bc,binary_lit,Bin}) -> + << <<X>> || <<X,1/binary>> <= Bin >>; + t({bc,bytes_lit,Bin}) -> + << <<X>> || <<X,a/bytes>> <= Bin >>; t({lc,binary,Bin}) -> [ {X,Tail} || <<X,Tail/binary>> <= Bin ]; t({lc,bytes,Bin}) -> @@ -1305,17 +1309,25 @@ unsized_binary_in_bin_gen_pattern(Config) when is_list(Config) -> t({lc,bits,Bin}) -> [ {X,Tail} || <<X,Tail/bits>> <= Bin ]; t({lc,bitstring,Bin}) -> - [ {X,Tail} || <<X,Tail/bitstring>> <= Bin ].">>, + [ {X,Tail} || <<X,Tail/bitstring>> <= Bin ]; + t({lc,bits_lit,Bin}) -> + [ X || <<X,42/bits>> <= Bin ]; + t({lc,bitstring_lit,Bin}) -> + [ X || <<X,b/bitstring>> <= Bin ].">>, [], {errors, [{2,erl_lint,unsized_binary_in_bin_gen_pattern}, {4,erl_lint,unsized_binary_in_bin_gen_pattern}, {6,erl_lint,unsized_binary_in_bin_gen_pattern}, {8,erl_lint,unsized_binary_in_bin_gen_pattern}, - {10,erl_lint,unsized_binary_in_bin_gen_pattern}, - {12,erl_lint,unsized_binary_in_bin_gen_pattern}, - {14,erl_lint,unsized_binary_in_bin_gen_pattern}, - {16,erl_lint,unsized_binary_in_bin_gen_pattern}], + {10,erl_lint,unsized_binary_in_bin_gen_pattern}, + {12,erl_lint,unsized_binary_in_bin_gen_pattern}, + {14,erl_lint,unsized_binary_in_bin_gen_pattern}, + {16,erl_lint,unsized_binary_in_bin_gen_pattern}, + {18,erl_lint,unsized_binary_in_bin_gen_pattern}, + {20,erl_lint,unsized_binary_in_bin_gen_pattern}, + {22,erl_lint,unsized_binary_in_bin_gen_pattern}, + {24,erl_lint,unsized_binary_in_bin_gen_pattern}], []}}], [] = run(Config, Ts), ok. @@ -2061,8 +2073,9 @@ otp_5362(Config) when is_list(Config) -> {error, [{5,erl_lint,{call_to_redefined_old_bif,{spawn,1}}}], [{4,erl_lint,{deprecated,{erlang,now,0}, - "Deprecated BIF. See the \"Time and Time Correction in Erlang\" " - "chapter of the ERTS User's Guide for more information."}}]}}, + "see the \"Time and Time Correction in Erlang\" " + "chapter of the ERTS User's Guide for more " + "information"}}]}}, {otp_5362_5, <<"-compile(nowarn_deprecated_function). -compile(nowarn_bif_clash). @@ -2119,8 +2132,9 @@ otp_5362(Config) when is_list(Config) -> {nowarn_bif_clash,{spawn,1}}]}, % has no effect {warnings, [{5,erl_lint,{deprecated,{erlang,now,0}, - "Deprecated BIF. See the \"Time and Time Correction in Erlang\" " - "chapter of the ERTS User's Guide for more information."}}]}}, + "see the \"Time and Time Correction in Erlang\" " + "chapter of the ERTS User's Guide for more " + "information"}}]}}, {otp_5362_9, <<"-include_lib(\"stdlib/include/qlc.hrl\"). @@ -2150,13 +2164,15 @@ otp_5362(Config) when is_list(Config) -> [], {warnings, [{1,erl_lint,{deprecated,{calendar,local_time_to_universal_time,1}, - {calendar,local_time_to_universal_time_dst,1}, "a future release"}}]}}, + "use calendar:local_time_to_universal_time_dst/1 " + "instead"}}]}}, {call_removed_function, <<"t(X) -> erlang:hash(X, 10000).">>, [], {warnings, - [{1,erl_lint,{removed,{erlang,hash,2},{erlang,phash2,2},"20.0"}}]}}, + [{1,erl_lint,{removed,{erlang,hash,2}, + "use erlang:phash2/2 instead"}}]}}, {nowarn_call_removed_function_1, <<"t(X) -> erlang:hash(X, 10000).">>, @@ -2173,7 +2189,7 @@ otp_5362(Config) when is_list(Config) -> [], {warnings,[{1,erl_lint, {removed,{os_mon_mib,any_function_really,1}, - "was removed in 22.0"}}]}}, + "this module was removed in OTP 22.0"}}]}}, {nowarn_call_removed_module, <<"t(X) -> os_mon_mib:any_function_really(X).">>, @@ -2212,7 +2228,6 @@ otp_15456(Config) when is_list(Config) -> warn_deprecated_function]}, {warnings,[{5,erl_lint, {deprecated,{random,seed,3}, - "the 'random' module is deprecated; " "use the 'rand' module instead"}}]}}, %% {nowarn_unused_function,[{M,F,A}]} can be given @@ -3645,6 +3660,7 @@ bin_syntax_errors(Config) -> Ts = [{bin_syntax_errors, <<"t(<<X:bad_size>>) -> X; t(<<_:(x ! y)/integer>>) -> ok; + t(<<_:(l())/integer>>) -> ok; t(<<X:all/integer>>) -> X; t(<<X/bad_type>>) -> X; t(<<X/unit:8>>) -> X; @@ -3653,22 +3669,30 @@ bin_syntax_errors(Config) -> t(<<(x ! y):8/integer>>) -> ok; t(X) -> {<<X/binary-integer>>,<<X/signed-unsigned-integer>>, - <<X/little-big>>,<<X/unit:4-unit:8>>}. + <<X/little-big>>,<<X/unit:4-unit:8>>}; + t(<<_:{A,B}>>) -> ok. + + l() -> + foo. ">>, [], - {error,[{1,erl_lint,illegal_bitsize}, - {2,erl_lint,illegal_bitsize}, - {3,erl_lint,illegal_bitsize}, - {4,erl_lint,{undefined_bittype,bad_type}}, - {5,erl_lint,bittype_unit}, - {7,erl_lint,illegal_pattern}, + {error,[{2,erl_lint,illegal_bitsize}, + {3,erl_lint,{illegal_bitsize_local_call,{l,0}}}, + {5,erl_lint,{undefined_bittype,bad_type}}, + {6,erl_lint,bittype_unit}, {8,erl_lint,illegal_pattern}, - {10,erl_lint,{bittype_mismatch,integer,binary,"type"}}, - {10,erl_lint,{bittype_mismatch,unsigned,signed,"sign"}}, - {11,erl_lint,{bittype_mismatch,8,4,"unit"}}, - {11,erl_lint,{bittype_mismatch,big,little,"endianness"}} + {9,erl_lint,illegal_pattern}, + {11,erl_lint,{bittype_mismatch,integer,binary,"type"}}, + {11,erl_lint,{bittype_mismatch,unsigned,signed,"sign"}}, + {12,erl_lint,{bittype_mismatch,8,4,"unit"}}, + {12,erl_lint,{bittype_mismatch,big,little,"endianness"}}, + {13,erl_lint,{unbound_var,'A'}}, + {13,erl_lint,{unbound_var,'B'}} ], - [{6,erl_lint,{bad_bitsize,"float"}}]}} + [{1,erl_lint,non_integer_bitsize}, + {4,erl_lint,non_integer_bitsize}, + {7,erl_lint,{bad_bitsize,"float"}}, + {13,erl_lint,non_integer_bitsize}]}} ], [] = run(Config, Ts), ok. @@ -3779,7 +3803,7 @@ maps(Config) -> ">>, [], {errors,[{4,erl_lint,illegal_map_construction}, - {6,erl_lint,illegal_map_key}],[]}}, + {6,erl_lint,{unbound_var,'V'}}],[]}}, {unused_vars_with_empty_maps, <<"t(Foo, Bar, Baz) -> {#{},#{}}.">>, [warn_unused_variables], @@ -4128,9 +4152,9 @@ otp_14378(Config) -> [], {warnings,[{4,erl_lint, {deprecated,{erlang,now,0}, - "Deprecated BIF. See the \"Time and Time Correction" - " in Erlang\" chapter of the ERTS User's Guide" - " for more information."}}]}}], + "see the \"Time and Time Correction in Erlang\" " + "chapter of the ERTS User's Guide for more " + "information"}}]}}], [] = run(Config, Ts), ok. @@ -4291,6 +4315,30 @@ otp_15563(Config) when is_list(Config) -> [] = run(Config, Ts), ok. +removed(Config) when is_list(Config) -> + Ts = [{removed, + <<"-removed([{nonexistent,1,\"hi\"}]). %% okay since it doesn't exist + -removed([frutt/0]). %% okay since frutt/0 is not exported + -removed([t/0]). %% not okay since t/0 is exported + -removed([{t,'_'}]). %% not okay since t/0 is exported + -removed([{'_','_'}]). %% not okay since t/0 is exported + -removed([{{badly,formed},1}]). + -removed('badly formed'). + -export([t/0]). + frutt() -> ok. + t() -> ok. + ">>, + {[]}, + {error,[{3,erl_lint,{bad_removed,{t,0}}}, + {4,erl_lint,{bad_removed,{t,'_'}}}, + {5,erl_lint,{bad_removed,{'_','_'}}}, + {6,erl_lint,{invalid_removed,{{badly,formed},1}}}, + {7,erl_lint,{invalid_removed,'badly formed'}}], + [{9,erl_lint,{unused_function,{frutt,0}}}]}} + ], + [] = run(Config, Ts), + ok. + format_error(E) -> lists:flatten(erl_lint:format_error(E)). diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 48152243f8..61eccdd1b5 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -47,6 +47,7 @@ hook/1, neg_indent/1, maps_syntax/1, + format_options/1, quoted_atom_types/1, otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, @@ -76,7 +77,8 @@ groups() -> [{expr, [], [func, call, recs, try_catch, if_then, receive_after, bits, head_tail, cond1, block, case1, ops, - messages, maps_syntax, quoted_atom_types + messages, maps_syntax, quoted_atom_types, + format_options ]}, {attributes, [], [misc_attrs, import_export, dialyzer_attrs]}, {tickets, [], @@ -545,6 +547,36 @@ import_export(Config) when is_list(Config) -> compile(Config, Ts), ok. +format_options(Config) when is_list(Config) -> + "case 1 of\n" + " 2 ->\n" + " 3;\n" + " 4 ->\n" + " 5\n" + "end" = flat_parse_and_pp_expr("case 1 of 2 -> 3; 4 -> 5 end", 0, [{indent, 2}]), + + "-spec foo(bar(),\n" + " qux()) ->\n" + " T |\n" + " baz(T)\n" + " when\n" + " T ::\n" + " tuple().\n" = + lists:flatten( + parse_and_pp_forms( + "-spec foo(bar(), qux()) -> T | baz(T) when T :: tuple().", + [{indent, 2}, {linewidth, 20}] + ) + ), + + "-spec foo(bar(), qux()) -> T | baz(T) when T :: tuple().\n" = + lists:flatten( + parse_and_pp_forms( + "-spec foo(bar(), qux()) -> T | baz(T) when T :: tuple().", + [{indent, 2}, {linewidth, 1000}] + ) + ). + misc_attrs(Config) when is_list(Config) -> ok = pp_forms(<<"-module(m). ">>), ok = pp_forms(<<"-module(m, [Aafjlksfjdlsjflsdfjlsdjflkdsfjlk," diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index aca5b1e54f..162e2a0a3d 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2017. All Rights Reserved. +%% Copyright Ericsson AB 1998-2020. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,7 +23,7 @@ init_per_group/2,end_per_group/2]). -export([error_1/1, error_2/1, iso88591/1, otp_7810/1, otp_10302/1, - otp_10990/1, otp_10992/1, otp_11807/1]). + otp_10990/1, otp_10992/1, otp_11807/1, otp_16480/1]). -import(lists, [nth/2,flatten/1]). -import(io_lib, [print/1]). @@ -58,7 +58,7 @@ suite() -> all() -> [{group, error}, iso88591, otp_7810, otp_10302, otp_10990, otp_10992, - otp_11807]. + otp_11807, otp_16480]. groups() -> [{error, [], [error_1, error_2]}]. @@ -300,6 +300,32 @@ integers() -> Ts = [{integer,{1,1},I}], test_string(S, Ts) end || S <- [[N] || N <- lists:seq($0, $9)] ++ ["2323","000"] ], + UnderscoreSamples = + [{"123_456", 123456}, + {"123_456_789", 123456789}, + {"1_2", 12}], + lists:foreach( + fun({S, I}) -> + test_string(S, [{integer, {1, 1}, I}]) + end, UnderscoreSamples), + UnderscoreErrors = + ["123_", + "123__", + "123_456_", + "123__456", + "_123", + "__123"], + lists:foreach( + fun(S) -> + case erl_scan:string(S) of + {ok, [{integer, _, _}], _} -> + error({unexpected_integer, S}); + _ -> + ok + end + end, UnderscoreErrors), + test_string("_123", [{var,{1,1},'_123'}]), + test_string("123_", [{integer,{1,1},123},{var,{1,4},'_'}]), ok. base_integers() -> @@ -315,13 +341,19 @@ base_integers() -> {error,{{1,1},erl_scan,{base,1}},{1,2}} = erl_scan:string("1#000", {1,1}, []), + {error,{1,erl_scan,{base,1}},1} = erl_scan:string("1#000"), + {error,{{1,1},erl_scan,{base,1000}},{1,6}} = + erl_scan:string("1_000#000", {1,1}, []), + test_string("12#bc", [{integer,{1,1},11},{atom,{1,5},c}]), [begin Str = BS ++ "#" ++ S, - {error,{1,erl_scan,{illegal,integer}},1} = - erl_scan:string(Str) - end || {BS,S} <- [{"3","3"},{"15","f"}, {"12","c"}] ], + E = 2 + length(BS), + {error,{{1,1},erl_scan,{illegal,integer}},{1,E}} = + erl_scan:string(Str, {1,1}, []) + end || {BS,S} <- [{"3","3"},{"15","f"},{"12","c"}, + {"1_5","f"},{"1_2","c"}] ], {ok,[{integer,1,239},{'@',1}],1} = erl_scan_string("16#ef@"), {ok,[{integer,{1,1},239},{'@',{1,6}}],{1,7}} = @@ -329,6 +361,36 @@ base_integers() -> {ok,[{integer,{1,1},14},{atom,{1,5},g@}],{1,7}} = erl_scan_string("16#eg@", {1,1}, []), + UnderscoreSamples = + [{"16#1234_ABCD_EF56", 16#1234abcdef56}, + {"2#0011_0101_0011", 2#001101010011}, + {"1_6#123ABC", 16#123abc}, + {"1_6#123_ABC", 16#123abc}, + {"16#abcdef", 16#ABCDEF}], + lists:foreach( + fun({S, I}) -> + test_string(S, [{integer, {1, 1}, I}]) + end, UnderscoreSamples), + UnderscoreErrors = + ["16_#123ABC", + "16#123_", + "16#_123", + "16#ABC_", + "16#_ABC", + "2#_0101", + "1__6#ABC", + "16#AB__CD"], + lists:foreach( + fun(S) -> + case erl_scan:string(S) of + {ok, [{integer, _, _}], _} -> + error({unexpected_integer, S}); + _ -> + ok + end + end, UnderscoreErrors), + test_string("16#123_", [{integer,{1,1},291},{var,{1,7},'_'}]), + test_string("_16#ABC", [{var,{1,1},'_16'},{'#',{1,4}},{var,{1,5},'ABC'}]), ok. floats() -> @@ -344,12 +406,44 @@ floats() -> erl_scan:string("1.0e400"), {error,{{1,1},erl_scan,{illegal,float}},{1,8}} = erl_scan:string("1.0e400", {1,1}, []), + {error,{{1,1},erl_scan,{illegal,float}},{1,9}} = + erl_scan:string("1.0e4_00", {1,1}, []), [begin {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string(S), {error,{{1,1},erl_scan,{illegal,float}},{1,_}} = erl_scan:string(S, {1,1}, []) end || S <- ["1.14Ea"]], + UnderscoreSamples = + [{"123_456.789", 123456.789}, + {"123.456_789", 123.456789}, + {"1.2_345e10", 1.2345e10}, + {"1.234e1_06", 1.234e106}, + {"12_34.56_78e1_6", 1234.5678e16}, + {"12_34.56_78e-1_8", 1234.5678e-18}], + lists:foreach( + fun({S, I}) -> + test_string(S, [{float, {1, 1}, I}]) + end, UnderscoreSamples), + UnderscoreErrors = + ["123_.456", + "123._456", + "123.456_", + "123._", + "1._23e10", + "1.23e_10", + "1.23e10_"], + lists:foreach( + fun(S) -> + case erl_scan:string(S) of + {ok, [{float, _, _}], _} -> + error({unexpected_float, S}); + _ -> + ok + end + end, UnderscoreErrors), + test_string("123._", [{integer,{1,1},123},{'.',{1,4}},{var,{1,5},'_'}]), + test_string("1.23_e10", [{float,{1,1},1.23},{var,{1,5},'_e10'}]), ok. dots() -> @@ -1103,6 +1197,11 @@ otp_11807(Config) when is_list(Config) -> (catch erl_parse:abstract("string", [{encoding,bad}])), ok. +otp_16480(Config) when is_list(Config) -> + F = fun mod:func/19, + F = erl_parse:normalise(erl_parse_abstract(F)), + ok. + test_string(String, ExpectedWithCol) -> {ok, ExpectedWithCol, _EndWithCol} = erl_scan_string(String, {1, 1}, []), Expected = [ begin diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 7f349c1bb5..9912da0c6b 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -40,14 +40,19 @@ -export([lookup_element_mult/1]). -export([foldl_ordered/1, foldr_ordered/1, foldl/1, foldr/1, fold_empty/1]). -export([t_delete_object/1, t_init_table/1, t_whitebox/1, - select_bound_chunk/1, - t_delete_all_objects/1, t_insert_list/1, t_test_ms/1, + select_bound_chunk/1, t_delete_all_objects/1, t_test_ms/1, t_select_delete/1,t_select_replace/1,t_select_replace_next_bug/1,t_ets_dets/1]). +-export([t_insert_list/1, t_insert_list_bag/1, t_insert_list_duplicate_bag/1, + t_insert_list_set/1, t_insert_list_delete_set/1, + t_insert_list_parallel/1, t_insert_list_delete_parallel/1, + t_insert_list_kill_process/1]). -export([test_table_size_concurrency/1,test_table_memory_concurrency/1, - test_delete_table_while_size_snapshot/1, test_delete_table_while_size_snapshot_helper/0]). + test_delete_table_while_size_snapshot/1, test_delete_table_while_size_snapshot_helper/1, + test_decentralized_counters_setting/1]). -export([ordered/1, ordered_match/1, interface_equality/1, - fixtable_next/1, fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1, + fixtable_next/1, fixtable_iter_bag/1, + fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1, update_element/1, update_counter/1, evil_update_counter/1, partly_bound/1, match_heavy/1]). -export([update_counter_with_default/1]). -export([update_counter_with_default_bad_pos/1]). @@ -128,8 +133,8 @@ all() -> {group, delete}, firstnext, firstnext_concurrent, slot, {group, match}, t_match_spec_run, {group, lookup_element}, {group, misc}, {group, files}, - {group, heavy}, ordered, ordered_match, - interface_equality, fixtable_next, fixtable_insert, + {group, heavy}, {group, insert_list}, ordered, ordered_match, + interface_equality, fixtable_next, fixtable_iter_bag, fixtable_insert, rename, rename_unnamed, evil_rename, update_element, update_counter, evil_update_counter, update_counter_with_default, @@ -139,7 +144,7 @@ all() -> match_heavy, {group, fold}, member, t_delete_object, select_bound_chunk, t_init_table, t_whitebox, t_delete_all_objects, - t_insert_list, t_test_ms, t_select_delete, t_select_replace, + t_test_ms, t_select_delete, t_select_replace, t_select_replace_next_bug, t_ets_dets, memory, t_select_reverse, t_bucket_disappears, t_named_select, select_fixtab_owner_change, @@ -162,11 +167,12 @@ all() -> take, whereis_table, delete_unfix_race, - test_throughput_benchmark, - {group, benchmark}, + %test_throughput_benchmark, + %{group, benchmark}, test_table_size_concurrency, test_table_memory_concurrency, - test_delete_table_while_size_snapshot]. + test_delete_table_while_size_snapshot, + test_decentralized_counters_setting]. groups() -> @@ -197,7 +203,12 @@ groups() -> meta_lookup_named_read, meta_lookup_named_write, meta_newdel_unnamed, meta_newdel_named]}, {benchmark, [], - [long_throughput_benchmark]}]. + [long_throughput_benchmark]}, + {insert_list, [], + [t_insert_list, t_insert_list_set, t_insert_list_bag, + t_insert_list_duplicate_bag, t_insert_list_delete_set, + t_insert_list_parallel, t_insert_list_delete_parallel, + t_insert_list_kill_process]}]. init_per_suite(Config) -> erts_debug:set_internal_state(available_internal_state, true), @@ -1167,7 +1178,7 @@ t_insert_new(Config) when is_list(Config) -> L), verify_etsmem(EtsMem). -%% Test ets:insert/2 with list of objects. +%% Test ets:insert/2 with list of objects into duplicate bag table. t_insert_list(Config) when is_list(Config) -> EtsMem = etsmem(), repeat_for_opts(fun t_insert_list_do/1), @@ -1179,6 +1190,245 @@ t_insert_list_do(Opts) -> del_one_by_one_dbag_2(T,4000,0), ets:delete(T). +% Insert a long list twice in a bag +t_insert_list_bag(Config) when is_list(Config) -> + EtsMem = etsmem(), + T = ets:new(t, [bag]), + ListSize = 25000, + List = [ {N} || N <- lists:seq(1, ListSize)], + ets:insert(T, List), + ets:insert(T, List), + ListSize = ets:info(T, size), + ets:delete(T), + verify_etsmem(EtsMem). + +% Insert a long list twice in a duplicate_bag +t_insert_list_duplicate_bag(Config) when is_list(Config) -> + EtsMem = etsmem(), + T = ets:new(t, [duplicate_bag]), + ListSize = 25000, + List = [ {N} || N <- lists:seq(1, ListSize)], + ets:insert(T, List), + ets:insert(T, List), + DoubleListSize = ListSize * 2, + DoubleListSize = ets:info(T, size), + ets:delete(T), + verify_etsmem(EtsMem). + +%% Test ets:insert/2 with list of objects into set tables. +t_insert_list_set(Config) when is_list(Config) -> + EtsMem = etsmem(), + repeat_for_opts(fun t_insert_list_set_do/1, [set_types]), + verify_etsmem(EtsMem). + +t_insert_list_set_do(Opts) -> + Nr = 2, + t_insert_list_set_do(Opts, fun ets_insert_with_check/2, Nr, 1, Nr+1), + t_insert_list_set_do(Opts, fun ets_insert_with_check/2, Nr*2, 2, Nr*2), + InsertNewWithCheck = + fun(T,E) -> + Res = ets:insert_new(T,E), + Seq = element(1, lists:nth(1, E)), + case Seq rem 2 =:= 0 of + true -> Res = false; + false -> Res = true + end + end, + t_insert_list_set_do(Opts, InsertNewWithCheck, Nr, 1, Nr), + t_insert_list_set_do(Opts, fun ets:insert_new/2, Nr*2, 2, Nr*2), + ok. + +t_insert_list_set_do(Opts, InsertFun, Nr, Step, ExpectedSize) -> + T = ets_new(x,Opts), + [InsertFun(T,[{X,X}, {X+1,X}]) || X <- lists:seq(1,Nr,Step)], + ExpectedSize = ets:info(T,size), + ets:delete(T). + +%% Test ets:insert/2 with list of objects into set tables in parallel. +t_insert_list_parallel(Config) when is_list(Config) -> + EtsMem = etsmem(), + repeat_for_opts(fun t_insert_list_parallel_do/1, [[public], set_types]), + verify_etsmem(EtsMem). + +ets_insert_with_check(Table, ToInsert) -> + true = ets:insert(Table, ToInsert), + true. + +ets_insert_new_with_check(Table, ToInsert) -> + ExpectedRes = + case put(is_first_insert_for_list, true) of + undefined -> true; + true -> false + end, + ExpectedRes = ets:insert_new(Table, ToInsert), + ExpectedRes. + +t_insert_list_parallel_do(Opts) -> + [(fun(I) -> + t_insert_list_parallel_do(Opts, I, 2, 100, 5000), + t_insert_list_parallel_do(Opts, I, 10, 100, 500), + t_insert_list_parallel_do(Opts, I, 1000, 100, 50), + t_insert_list_parallel_do(Opts, I, 50000, 3, 1) + end)(InsertFun) || InsertFun <- [fun ets_insert_with_check/2, + fun ets_insert_new_with_check/2]]. + +t_insert_list_parallel_do(Opts, InsertFun, ListLength, NrOfProcesses, NrOfInsertsPerProcess) -> + T = ets_new(x,Opts), + t_insert_list_parallel_do_helper(self(), T, 0, InsertFun, ListLength, NrOfProcesses, NrOfInsertsPerProcess), + receive done -> ok end, + ExpectedSize = ListLength * NrOfProcesses, + ExpectedSize = length(ets:match_object(T, {'$0', '$1'})), + ExpectedSize = ets:info(T, size), + ets:delete(T), + ok. + +t_insert_list_delete_parallel(Config) when is_list(Config) -> + EtsMem = etsmem(), + repeat_for_opts(fun t_insert_list_delete_parallel_do/1, [[public], set_types]), + verify_etsmem(EtsMem). + +t_insert_list_delete_parallel_do(Opts) -> + [(fun(I) -> + t_insert_list_delete_parallel_do(Opts, I, 30, 32, 1000000), + t_insert_list_delete_parallel_do(Opts, I, 300, 8, 1000000), + t_insert_list_delete_parallel_do(Opts, I, 3000, 4, 1000000), + t_insert_list_delete_parallel_do(Opts, I, 9000, 4, 1000000) + end)(InsertFun) || InsertFun <- [fun ets_insert_with_check/2, + fun ets_insert_new_with_check/2]], + ok. + +t_insert_list_delete_parallel_do(Opts, InsertFun, ListLength, NrOfProcesses, NrOfInsertsPerProcess) -> + T = ets_new(x,Opts), + CompletedInsertsCtr = counters:new(1,[]), + NewInsertFun = + fun(Table, ToInsert) -> + try + InsertFun(Table, ToInsert), + counters:add(CompletedInsertsCtr, 1, 1) + catch + error:badarg -> put(stop,yes) + end + end, + Self = self(), + spawn(fun()-> + t_insert_list_parallel_do_helper(self(), T, 0, NewInsertFun, ListLength, NrOfProcesses, NrOfInsertsPerProcess), + receive done -> Self ! done_parallel_insert end + end), + receive after 3 -> ok end, + spawn(fun()-> + spawn(fun()-> + receive after 7 -> ok end, + ets:delete(T), + Self ! done_delete + end) + end), + receive done_delete -> ok end, + receive done_parallel_insert -> ok end, + io:format("~p/~p completed", + [counters:get(CompletedInsertsCtr, 1), + NrOfProcesses * NrOfInsertsPerProcess]). + + +t_insert_list_parallel_do_helper(Parent, T, StartKey, InsertFun, ListLength, 1, NrOfInsertsPerProcess) -> + try + repeat(fun()-> + case get(stop) of + yes -> throw(end_repeat); + _ -> ok + end, + InsertFun(T,[{X,X} || X <- lists:seq(StartKey,StartKey+ListLength-1,1)]) + end, NrOfInsertsPerProcess) + catch + throw:end_repeat -> ok + end, + Parent ! done; +t_insert_list_parallel_do_helper(Parent, T, StartKey, InsertFun, ListLength, NrOfProcesses, NrOfInsertsPerProcess) -> + Self = self(), + spawn(fun() -> + t_insert_list_parallel_do_helper(Self, + T, + StartKey, + InsertFun, + ListLength, + NrOfProcesses div 2, + NrOfInsertsPerProcess) end), + spawn(fun() -> + t_insert_list_parallel_do_helper(Self, + T, + StartKey + ListLength*(NrOfProcesses div 2), + InsertFun, + ListLength, + (NrOfProcesses div 2) + (NrOfProcesses rem 2), + NrOfInsertsPerProcess) + end), + receive done -> ok end, + receive done -> ok end, + Parent ! done. + +t_insert_list_delete_set(Config) when is_list(Config) -> + EtsMem = etsmem(), + repeat_for_opts(fun t_insert_list_delete_set_do/1, [[public],set_types]), + verify_etsmem(EtsMem). + +t_insert_list_delete_set_do(Opts) -> + [(fun(I) -> + t_insert_list_delete_set_do(Opts, I, 1000000, 1, 1), + t_insert_list_delete_set_do(Opts, I, 100000, 10, 5), + t_insert_list_delete_set_do(Opts, I, 10000, 100, 50), + t_insert_list_delete_set_do(Opts, I, 1000, 1000, 500) + end)(InsertFun) || InsertFun <- [fun ets_insert_with_check/2, + fun ets_insert_new_with_check/2]], + ok. + + +t_insert_list_delete_set_do(Opts, InsertFun, ListLength, NrOfTables, NrOfInserts) -> + CompletedInsertsCtr = counters:new(1,[]), + Parent = self(), + [(fun() -> + T = ets_new(x,Opts), + spawn( + fun() -> + try + repeat( + fun() -> + InsertFun(T,[{Z,Z} || + Z <- lists:seq(1,ListLength)]), + counters:add(CompletedInsertsCtr, 1, 1)%, + end, NrOfInserts) + catch + error:badarg -> ok + end, + Parent ! done + end), + receive after 1 -> ok end, + ets:delete(T) + end)() || _ <- lists:seq(1,NrOfTables)], + [receive done -> ok end || _ <- lists:seq(1,NrOfTables)], + io:format("~p/~p completed", + [counters:get(CompletedInsertsCtr, 1), + NrOfTables * NrOfInserts]). + + +t_insert_list_kill_process(Config) when is_list(Config) -> + EtsMem = etsmem(), + repeat_for_opts(fun t_insert_list_kill_process_do/1, [[public], set_types]), + verify_etsmem(EtsMem). + + +t_insert_list_kill_process_do(Opts) -> + [(fun(I) -> + [(fun(Time) -> + T = ets_new(x,Opts), + List = lists:seq(1,600000), + TupleList = [{E,E} || E <- List], + Pid = spawn(fun() -> I(T, TupleList) end), + receive after Time -> ok end, + exit(Pid, kill), + ets:delete(T) + end)(TheTime) || TheTime <- [1,3,5] ++ lists:seq(7,29,7)] + end)(InsertFun) || InsertFun <- [fun ets:insert/2, + fun ets:insert_new/2]], + ok. %% Test interface of ets:test_ms/2. t_test_ms(Config) when is_list(Config) -> @@ -2494,6 +2744,135 @@ do_fixtable_next(Tab) -> false = ets:info(Tab, fixed), ets:delete(Tab). +%% Check that iteration of bags find all live objects and nothing else. +fixtable_iter_bag(Config) when is_list(Config) -> + repeat_for_opts(fun fixtable_iter_do/1, + [write_concurrency,[bag,duplicate_bag]]). + +fixtable_iter_do(Opts) -> + EtsMem = etsmem(), + do_fixtable_iter_bag(ets_new(fixtable_iter_bag,Opts)), + verify_etsmem(EtsMem). + +do_fixtable_iter_bag(T) -> + MaxValues = 4, + %% Create 1 to MaxValues objects for each key + %% and then delete every possible combination of those objects + %% in every possible order. + %% Then test iteration returns all live objects and nothing else. + + CrDelOps = [begin + Values = lists:seq(1,N), + %% All ways of deleting any number of the Values in any order + Combos = combs(Values), + DeleteOps = concat_lists([perms(C) || C <- Combos]), + {N, DeleteOps} + end + || N <- lists:seq(1,MaxValues)], + + %%io:format("~p\n", [CrDelOps]), + + NKeys = lists:foldl(fun({_, DeleteOps}, Cnt) -> + Cnt + length(DeleteOps) + end, + 0, + CrDelOps), + + io:format("Create ~p keys\n", [NKeys]), + + %% Fixate even before inserts just to maintain small table size + %% and increase likelyhood of different keys in same bucket. + ets:safe_fixtable(T,true), + InsRes = [begin + [begin + Key = {NValues,ValueList}, + [begin + Tpl = {Key, V}, + %%io:format("Insert object ~p", [Tpl]), + ets:insert(T, Tpl), + Tpl + end + || V <- lists:seq(1,NValues)] + end + || ValueList <- DeleteOps] + end + || {NValues, DeleteOps} <- CrDelOps], + + Inserted = lists:flatten(InsRes), + InSorted = lists:sort(Inserted), + InSorted = lists:usort(Inserted), %% No duplicates + NObjs = length(Inserted), + + DelRes = [begin + [begin + Key = {NValues,ValueList}, + [begin + Tpl = {Key, V}, + %%io:format("Delete object ~p", [Tpl]), + ets:delete_object(T, Tpl), + Tpl + end + || V <- ValueList] + end + || ValueList <- DeleteOps] + end + || {NValues, DeleteOps} <- CrDelOps], + + Deleted = lists:flatten(DelRes), + DelSorted = lists:sort(Deleted), + DelSorted = lists:usort(Deleted), %% No duplicates + NDels = length(Deleted), + + %% Nr of keys where all values were deleted. + NDeletedKeys = lists:sum([factorial(N) || N <- lists:seq(1,MaxValues)]), + + CountKeysFun = fun Me(K1, Cnt) -> + case ets:next(T, K1) of + '$end_of_table' -> + Cnt; + K2 -> + Objs = ets:lookup(T, K2), + [{{NValues, ValueList}, _V} | _] = Objs, + ExpectedLive = NValues - length(ValueList), + ExpectedLive = length(Objs), + Me(K2, Cnt+1) + end + end, + + ExpectedKeys = NKeys - NDeletedKeys, + io:format("Expected keys: ~p\n", [ExpectedKeys]), + FoundKeys = CountKeysFun(ets:first(T), 1), + io:format("Found keys: ~p\n", [FoundKeys]), + ExpectedKeys = FoundKeys, + + ExpectedObjs = NObjs - NDels, + io:format("Expected objects: ~p\n", [ExpectedObjs]), + FoundObjs = ets:select_count(T, [{{'_','_'}, [], [true]}]), + io:format("Found objects: ~p\n", [FoundObjs]), + ExpectedObjs = FoundObjs, + + ets:delete(T). + +%% All permutations of list +perms([]) -> [[]]; +perms(L) -> [[H|T] || H <- L, T <- perms(L--[H])]. + +%% All combinations of picking the element (or not) from list +combs([]) -> [[]]; +combs([H|T]) -> + Tcombs = combs(T), + Tcombs ++ [[H | C] || C <- Tcombs]. + +factorial(0) -> 1; +factorial(N) when N > 0 -> + N * factorial(N - 1). + +concat_lists([]) -> + []; +concat_lists([H|T]) -> + H ++ concat_lists(T). + + %% Check inserts of deleted keys in fixed bags. fixtable_insert(Config) when is_list(Config) -> Combos = [[Type,{write_concurrency,WC}] || Type<- [bag,duplicate_bag], @@ -2558,15 +2937,17 @@ write_concurrency(Config) when is_list(Config) -> Yes6 = ets_new(foo,[duplicate_bag,protected,{write_concurrency,true}]), No3 = ets_new(foo,[duplicate_bag,private,{write_concurrency,true}]), - Yes7 = ets_new(foo,[ordered_set,public,{write_concurrency,true}]), - Yes8 = ets_new(foo,[ordered_set,protected,{write_concurrency,true}]), - Yes9 = ets_new(foo,[ordered_set,{write_concurrency,true}]), - Yes10 = ets_new(foo,[{write_concurrency,true},ordered_set,public]), - Yes11 = ets_new(foo,[{write_concurrency,true},ordered_set,protected]), + NoCentCtrs = {decentralized_counters,false}, + Yes7 = ets_new(foo,[ordered_set,public,{write_concurrency,true},NoCentCtrs]), + Yes8 = ets_new(foo,[ordered_set,protected,{write_concurrency,true},NoCentCtrs]), + Yes9 = ets_new(foo,[ordered_set,{write_concurrency,true},NoCentCtrs]), + Yes10 = ets_new(foo,[{write_concurrency,true},ordered_set,public,NoCentCtrs]), + Yes11 = ets_new(foo,[{write_concurrency,true},ordered_set,protected,NoCentCtrs]), Yes12 = ets_new(foo,[set,{write_concurrency,false}, - {write_concurrency,true},ordered_set,public]), + {write_concurrency,true},ordered_set,public,NoCentCtrs]), Yes13 = ets_new(foo,[private,public,set,{write_concurrency,false}, - {write_concurrency,true},ordered_set]), + {write_concurrency,true},ordered_set,NoCentCtrs]), + Yes14 = ets_new(foo,[ordered_set,public,{write_concurrency,true}]), No4 = ets_new(foo,[ordered_set,private,{write_concurrency,true}]), No5 = ets_new(foo,[ordered_set,public,{write_concurrency,false}]), No6 = ets_new(foo,[ordered_set,protected,{write_concurrency,false}]), @@ -2578,6 +2959,7 @@ write_concurrency(Config) when is_list(Config) -> YesMem = ets:info(Yes1,memory), NoHashMem = ets:info(No1,memory), YesTreeMem = ets:info(Yes7,memory), + YesYesTreeMem = ets:info(Yes14,memory), NoTreeMem = ets:info(No4,memory), io:format("YesMem=~p NoHashMem=~p NoTreeMem=~p YesTreeMem=~p\n",[YesMem,NoHashMem, NoTreeMem,YesTreeMem]), @@ -2603,10 +2985,17 @@ write_concurrency(Config) when is_list(Config) -> NoHashMem = ets:info(No8,memory), NoHashMem = ets:info(No9,memory), - true = YesMem > NoHashMem orelse erlang:system_info(schedulers) == 1, - true = YesMem > NoTreeMem orelse erlang:system_info(schedulers) == 1, true = YesMem > YesTreeMem, - true = YesTreeMem < NoTreeMem orelse erlang:system_info(schedulers) == 1, + + case erlang:system_info(schedulers) > 1 of + true -> + true = YesMem > NoHashMem, + true = YesMem > NoTreeMem, + true = YesTreeMem < NoTreeMem, + true = YesYesTreeMem > YesTreeMem; + _ -> + one_scheduler_only + end, {'EXIT',{badarg,_}} = (catch ets_new(foo,[public,{write_concurrency,foo}])), {'EXIT',{badarg,_}} = (catch ets_new(foo,[public,{write_concurrency}])), @@ -2614,7 +3003,7 @@ write_concurrency(Config) when is_list(Config) -> {'EXIT',{badarg,_}} = (catch ets_new(foo,[public,write_concurrency])), lists:foreach(fun(T) -> ets:delete(T) end, - [Yes1,Yes2,Yes3,Yes4,Yes5,Yes6,Yes7,Yes8,Yes9,Yes10,Yes11,Yes12,Yes13, + [Yes1,Yes2,Yes3,Yes4,Yes5,Yes6,Yes7,Yes8,Yes9,Yes10,Yes11,Yes12,Yes13,Yes14, No1,No2,No3,No4,No5,No6,No7,No8,No9]), verify_etsmem(EtsMem), ok. @@ -4497,6 +4886,8 @@ info_do(Opts) -> {value, {protection, Protection}} = lists:keysearch(protection, 1, Res), {value, {id, Tab}} = lists:keysearch(id, 1, Res), + {value, {decentralized_counters, _DecentralizedCtrs}} = + lists:keysearch(decentralized_counters, 1, Res), %% Test 'binary' [] = ?ets_info(Tab, binary, SlavePid), @@ -4610,7 +5001,10 @@ size_loop(_T, 0, _, _) -> size_loop(T, I, PrevSize, WhatToTest) -> Size = ets:info(T, WhatToTest), case Size < PrevSize of - true -> ct:fail("Bad ets:info/2"); + true -> + io:format("Bad ets:info/2 (got ~p expected >=~p)", + [Size, PrevSize]), + ct:fail("Bad ets:info/2)"); _ -> ok end, size_loop(T, I -1, Size, WhatToTest). @@ -4622,13 +5016,17 @@ add_loop(T, I) -> add_loop(T, I -1). -test_table_counter_concurrency(WhatToTest) -> +test_table_counter_concurrency(WhatToTest, TableOptions) -> IntStatePrevOn = erts_debug:set_internal_state(available_internal_state, true), ItemsToAdd = 1000000, SizeLoopSize = 1000, - T = ets:new(k, [public, ordered_set, {write_concurrency, true}]), - erts_debug:set_internal_state(ets_debug_random_split_join, {T, false}), + T = ets:new(k, TableOptions), + case lists:member(ordered_set, TableOptions) of + true -> + erts_debug:set_internal_state(ets_debug_random_split_join, {T, false}); + false -> ok + end, 0 = ets:info(T, size), P = self(), SpawnedSizeProcs = @@ -4659,14 +5057,18 @@ test_table_size_concurrency(Config) when is_list(Config) -> case erlang:system_info(schedulers) of 1 -> {skip,"Only valid on smp > 1 systems"}; _ -> - test_table_counter_concurrency(size) + BaseOptions = [public, {write_concurrency, true}], + test_table_counter_concurrency(size, [set | BaseOptions]), + test_table_counter_concurrency(size, [ordered_set | BaseOptions]) end. test_table_memory_concurrency(Config) when is_list(Config) -> case erlang:system_info(schedulers) of 1 -> {skip,"Only valid on smp > 1 systems"}; _ -> - test_table_counter_concurrency(memory) + BaseOptions = [public, {write_concurrency, true}], + test_table_counter_concurrency(memory, [set | BaseOptions]), + test_table_counter_concurrency(memory, [ordered_set | BaseOptions]) end. %% Tests that calling the ets:delete operation on a table T with @@ -4677,15 +5079,20 @@ test_delete_table_while_size_snapshot(Config) when is_list(Config) -> %% depend on that pids are ordered in creation order which is no %% longer the case when many processes have been started before Node = start_slave(), - ok = rpc:call(Node, ?MODULE, test_delete_table_while_size_snapshot_helper, []), + [ok = rpc:call(Node, + ?MODULE, + test_delete_table_while_size_snapshot_helper, + [TableType]) + || TableType <- [set, ordered_set]], test_server:stop_node(Node), ok. -test_delete_table_while_size_snapshot_helper()-> +test_delete_table_while_size_snapshot_helper(TableType) -> TopParent = self(), repeat_par( fun() -> - Table = ets:new(t, [public, ordered_set, + Table = ets:new(t, [public, TableType, + {decentralized_counters, true}, {write_concurrency, true}]), Parent = self(), NrOfSizeProcs = 100, @@ -4693,7 +5100,7 @@ test_delete_table_while_size_snapshot_helper()-> || _ <- lists:seq(1, NrOfSizeProcs)], timer:sleep(1), ets:delete(Table), - [receive + [receive table_gone -> ok; Problem -> TopParent ! Problem end || _ <- Pids] @@ -4738,6 +5145,64 @@ repeat_par_help(FunToRepeat, NrOfTimes, OrgNrOfTimes) -> end), repeat_par_help(FunToRepeat, NrOfTimes-1, OrgNrOfTimes). +test_decentralized_counters_setting(Config) when is_list(Config) -> + case erlang:system_info(schedulers) of + 1 -> {skip,"Only relevant when the number of shedulers > 1"}; + _ -> EtsMem = etsmem(), + do_test_decentralized_counters_setting(set), + do_test_decentralized_counters_setting(ordered_set), + do_test_decentralized_counters_default_setting(), + verify_etsmem(EtsMem) + end. + +do_test_decentralized_counters_setting(TableType) -> + wait_for_memory_deallocations(), + FlxCtrMemUsage = erts_debug:get_internal_state(flxctr_memory_usage), + lists:foreach( + fun(OptList) -> + T1 = ets:new(t1, [public, TableType] ++ OptList ++ [TableType]), + check_decentralized_counters(T1, false, FlxCtrMemUsage), + ets:delete(T1) + end, + [[{write_concurrency, false}], + [{write_concurrency, true}, {decentralized_counters, false}]]), + lists:foreach( + fun(OptList) -> + T1 = ets:new(t1, [public, + TableType, + {write_concurrency, true}] ++ OptList ++ [TableType]), + check_decentralized_counters(T1, true, FlxCtrMemUsage), + ets:delete(T1), + wait_for_memory_deallocations(), + FlxCtrMemUsage = erts_debug:get_internal_state(flxctr_memory_usage) + end, + [[{decentralized_counters, true}]]), + ok. + +do_test_decentralized_counters_default_setting() -> + wait_for_memory_deallocations(), + FlxCtrMemUsage = erts_debug:get_internal_state(flxctr_memory_usage), + Set = ets:new(t1, [public, {write_concurrency, true}]), + check_decentralized_counters(Set, false, FlxCtrMemUsage), + ets:delete(Set), + Set2 = ets:new(t1, [public, set, {write_concurrency, true}]), + check_decentralized_counters(Set2, false, FlxCtrMemUsage), + ets:delete(Set2), + OrdSet = ets:new(t1, [public, ordered_set, {write_concurrency, true}]), + check_decentralized_counters(OrdSet, true, FlxCtrMemUsage), + ets:delete(OrdSet), + ok. + +check_decentralized_counters(T, ExpectedState, InitMemUsage) -> + case {ExpectedState, erts_debug:get_internal_state(flxctr_memory_usage)} of + {false, notsup} -> ok; + {false, X} -> InitMemUsage = X; + {true, notsup} -> ok; + {true, X} when X > InitMemUsage -> ok; + {true, _} -> ct:fail("Decentralized counter not used.") + end, + ExpectedState = ets:info(T, decentralized_counters). + %% Test various duplicate_bags stuff. dups(Config) when is_list(Config) -> repeat_for_opts(fun dups_do/1). @@ -5023,7 +5488,7 @@ tabfile_ext4(Config) when is_list(Config) -> {error,Y} = ets:file2tab(FName,[{verify,true}]), ets:tab2file(TL,FName,[{extended_info,[md5sum]}]), {X,Y} - end || N <- lists:seq(500,600)], + end || N <- lists:seq(700,800)], io:format("~p~n",[Res]), file:delete(FName) end), @@ -5804,13 +6269,13 @@ otp_7665_act(Tab,Min,Max,DelNr) -> true = ets:insert(Tab, List1), true = ets:safe_fixtable(Tab, true), true = ets:delete_object(Tab, {key,DelNr}), - List2 = lists:delete({key,DelNr}, List1), + List2 = lists:sort(lists:delete({key,DelNr}, List1)), %% Now verify that we find all remaining objects - List2 = ets:lookup(Tab,key), - EList2 = lists:map(fun({key,N})-> N end, - List2), - EList2 = ets:lookup_element(Tab,key,2), + List2 = lists:sort(ets:lookup(Tab,key)), + EList2 = lists:sort(lists:map(fun({key,N})-> N end, + List2)), + EList2 = lists:sort(ets:lookup_element(Tab,key,2)), true = ets:delete(Tab, key), [] = ets:lookup(Tab, key), true = ets:safe_fixtable(Tab, false), @@ -6835,7 +7300,8 @@ take(Config) when is_list(Config) -> %% Same with bag. T3 = ets_new(c, [bag]), ets:insert(T3, [{1,1},{1,2},{3,3}]), - [{1,1},{1,2}] = ets:take(T3, 1), + R = lists:sort([{1,1},{1,2}]), + R = lists:sort(ets:take(T3, 1)), [{3,3}] = ets:take(T3, 3), [] = ets:tab2list(T3), ets:delete(T1), @@ -7598,31 +8064,70 @@ my_tab_to_list(Ts,Key, Acc) -> wait_for_memory_deallocations() -> try + erts_debug:set_internal_state(wait, thread_progress), erts_debug:set_internal_state(wait, deallocations) catch error:undef -> erts_debug:set_internal_state(available_internal_state, true), - wait_for_memory_deallocations() + wait_for_memory_deallocations(); + error:badarg -> + %% The emulator we run on does not have the wait internal state + %% so we just sleep some time instead... + timer:sleep(100) end. etsmem() -> % The following is done twice to avoid an inconsistent memory % "snapshot" (see verify_etsmem/2). lists:foldl( - fun(_,_) -> + fun(AttemptNr, PrevEtsMem) -> + AllTabsExceptions = [logger, code], + %% The logger table is excluded from the AllTabs list + %% below because it uses decentralized counters to keep + %% track of the size and the memory counters. This cause + %% ets:info(T,size) and ets:info(T,memory) to trigger + %% allocations and frees that may change the amount of + %% memory that is allocated for ETS. + %% + %% The code table is excluded from the list below + %% because the amount of memory allocated for it may + %% change if the tested code loads a new module. + AllTabs = + lists:sort( + [begin + try ets:info(T, decentralized_counters) of + true -> + ct:fail("Background ETS table (~p) that " + "uses decentralized counters (Add exception?)", + [ets:info(T,name)]); + _ -> ok + catch _:_ -> + ok + end, + {T, + ets:info(T,name), + ets:info(T,size), + ets:info(T,memory), + ets:info(T,type)} + end + || T <- ets:all(), + not lists:member(ets:info(T, name), AllTabsExceptions)]), wait_for_memory_deallocations(), - - AllTabs = lists:map(fun(T) -> {T,ets:info(T,name),ets:info(T,size), - ets:info(T,memory),ets:info(T,type)} - end, ets:all()), - EtsAllocSize = erts_debug:alloc_blocks_size(ets_alloc), ErlangMemoryEts = try erlang:memory(ets) catch error:notsup -> notsup end, - - Mem = {ErlangMemoryEts, EtsAllocSize}, - {Mem, AllTabs} + FlxCtrMemUsage = try erts_debug:get_internal_state(flxctr_memory_usage) catch error:badarg -> notsup end, + Mem = {ErlangMemoryEts, EtsAllocSize, FlxCtrMemUsage}, + EtsMem = {Mem, AllTabs}, + case PrevEtsMem of + first -> ok; + _ when PrevEtsMem =:= EtsMem -> ok; + _ -> + io:format("etsmem(): Change in attempt ~p~n~nbefore:~n~p~n~nafter:~n~p~n~n", + [AttemptNr, PrevEtsMem, EtsMem]) + end, + EtsMem end, - not_used, + first, lists:seq(1,2)). verify_etsmem(MI) -> diff --git a/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html b/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html index 27d6849c60..239877c257 100644 --- a/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html +++ b/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html @@ -4,7 +4,7 @@ <!-- %% --> <!-- %% %CopyrightBegin% --> <!-- %% --> -<!-- %% Copyright Ericsson AB and Kjell Winblad 1996-2018. All Rights Reserved. --> +<!-- %% Copyright Ericsson AB and Kjell Winblad 1996-2019. All Rights Reserved. --> <!-- %% --> <!-- %% Licensed under the Apache License, Version 2.0 (the "License"); --> <!-- %% you may not use this file except in compliance with the License. --> @@ -44,6 +44,12 @@ <br> <textarea id="dataField" rows="4" cols="50">#bench_data_placeholder</textarea> <br> + <input type="checkbox" id="throughputPlot" checked> Include Throughput Plot + <br> + <input type="checkbox" id="betterThanWorstPlot"> Include % More Throughput Than Worst Plot + <br> + <input type="checkbox" id="worseThanBestPlot"> Include % Less Throughput Than Best Plot + <br> <input type="checkbox" id="barPlot"> Bar Plot <br> <input type="checkbox" id="sameSpacing" checked> Same X Spacing Between Points @@ -148,10 +154,52 @@ } return data; } + function toCompareData(dataParam, compareWithWorst) { + var data = $.extend(true, [], dataParam); + var worstSoFarMap = {}; + var defaultSoFarValue = compareWithWorst ? Number.MAX_VALUE : Number.MIN_VALUE; + function getWorstBestSoFar(x){ + return worstSoFarMap[x] === undefined ? defaultSoFarValue : worstSoFarMap[x]; + } + function setWorstBestSoFar(x, y){ + return worstSoFarMap[x] = y; + } + function lessOrGreaterThan(n1, n2){ + return compareWithWorst ? n1 < n2 : n1 > n2; + } + $.each(data, function(i, allResConfig) { + $.each(allResConfig.y, function(index, res) { + var xName = allResConfig.x[index]; + if(lessOrGreaterThan(res, getWorstBestSoFar(xName))){ + setWorstBestSoFar(xName, res); + } + }); + }); + $.each(data, function(i, allResConfig) { + $.each(allResConfig.y, function(index, res) { + var xName = allResConfig.x[index]; + if(compareWithWorst){ + allResConfig.y[index] = ((res / getWorstBestSoFar(xName))-1.0) * 100; + }else{ + allResConfig.y[index] = (1.0 -(res / getWorstBestSoFar(xName))) * 100; + } + }); + }); + return data; + } + function toBetterThanWorstData(data){ + return toCompareData(data, true); + } + function toWorseThanBestData(data){ + return toCompareData(data, false); + } function plotGraphs(){ var insertPlaceholder = $("#insertPlaceholder"); var sameSpacing = $('#sameSpacing').is(":checked"); var barPlot = $('#barPlot').is(":checked"); + var throughputPlot = $('#throughputPlot').is(":checked"); + var betterThanWorstPlot = $('#betterThanWorstPlot').is(":checked"); + var worseThanBestPlot = $('#worseThanBestPlot').is(":checked"); var lines = $("#dataField").val(); $('.showCheck').each(function() { var item = $(this); @@ -188,42 +236,59 @@ plotGraph(lines, sameSpacing, barPlot, prefix)); } } + var nrOfGraphs = 0; + function plotScenario(name, plotType) { + var data = scenarioDataMap[name]; + var yAxisTitle = undefined; + nrOfGraphs = nrOfGraphs + 1; + $("<div class='added' id='graph" + nrOfGraphs + "'>") + .insertBefore(insertPlaceholder); + $("<button type='button' class='added' id='fullscreenButton" + nrOfGraphs + "'>Fill screen</button>") + .insertBefore(insertPlaceholder); + $("<span class='added'><br><hr><br></span>") + .insertBefore(insertPlaceholder); + if (plotType === 'throughput') { + yAxisTitle = 'Operations/Second'; + } else if (plotType === 'better_than_worst') { + yAxisTitle = '% More Throughput Than Worst'; + data = toBetterThanWorstData(data); + } else { + yAxisTitle = '% Less Throughput Than Best'; + data = toWorseThanBestData(data); + } + var layout = { + title: name, + xaxis: { + title: '# of Processes' + }, + yaxis: { + title: yAxisTitle + } + }; + $("#fullscreenButton" + nrOfGraphs).click( + function () { + $('#graph' + nrOfGraphs).replaceWith( + $("<div class='added' id='graph" + nrOfGraphs + "'>")); + layout = $.extend({}, layout, { + width: $(window).width() - 40, + height: $(window).height() - 40 + }); + Plotly.newPlot('graph' + nrOfGraphs, data, layout); + }); + Plotly.newPlot('graph' + nrOfGraphs, data, layout); + } $.each(scenarioList, - function( index, name ) { - var nrOfGraphs = index + 1; - var data = scenarioDataMap[name]; - $( "<div class='added' id='graph"+nrOfGraphs+"'>") - .insertBefore( insertPlaceholder ); - $( "<button type='button' class='added' id='fullscreenButton"+nrOfGraphs+"'>Fill screen</button>") - .insertBefore( insertPlaceholder ); - $( "<span class='added'><br><hr><br></span>") - .insertBefore( insertPlaceholder ); - var layout = { - title:name, - xaxis: { - title: '# of Processes' - }, - yaxis: { - title: 'Operations/Second' - } - - }; - - $("#fullscreenButton"+nrOfGraphs).click( - function(){ - $('#graph'+nrOfGraphs).replaceWith( - $("<div class='added' id='graph"+nrOfGraphs+"'>")); - layout = $.extend({}, layout, { - width:$(window).width()-40, - height:$(window).height()-40 - }); - Plotly.newPlot('graph'+nrOfGraphs, data, layout); - }); - Plotly.newPlot('graph'+nrOfGraphs, data, layout); - - }); - - + function (index, name) { + if (throughputPlot) { + plotScenario(name, 'throughput'); + } + if (betterThanWorstPlot) { + plotScenario(name, 'better_than_worst'); + } + if (worseThanBestPlot) { + plotScenario(name, 'worse_than_best'); + } + }); } $(document).ready(function(){ $('#renderButton').click( diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 527d083eaa..3a1ca9b28a 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -26,7 +26,8 @@ wildcard_one/1,wildcard_two/1,wildcard_errors/1, fold_files/1,otp_5960/1,ensure_dir_eexist/1,ensure_dir_symlink/1, wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1, - find_source/1, find_source_subdir/1]). + find_source/1, find_source_subdir/1, safe_relative_path/1, + safe_relative_path_links/1]). -import(lists, [foreach/2]). @@ -49,7 +50,8 @@ all() -> [wildcard_one, wildcard_two, wildcard_errors, fold_files, otp_5960, ensure_dir_eexist, ensure_dir_symlink, wildcard_symlink, is_file_symlink, file_props_symlink, - find_source, find_source_subdir]. + find_source, find_source_subdir, safe_relative_path, + safe_relative_path_links]. groups() -> []. @@ -647,3 +649,167 @@ find_source_subdir(Config) when is_list(Config) -> {ok, SrcFile} = filelib:find_file(SrcName, BeamDir), ok. + +safe_relative_path(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + Root = filename:join(PrivDir, "filelib_SUITE_safe_relative_path"), + ok = file:make_dir(Root), + ok = file:set_cwd(Root), + + ok = file:make_dir("a"), + ok = file:set_cwd("a"), + ok = file:make_dir("b"), + ok = file:set_cwd("b"), + ok = file:make_dir("c"), + + ok = file:set_cwd(Root), + + "a" = test_srp("a"), + "a/b" = test_srp("a/b"), + "a/b" = test_srp("a/./b"), + "a/b" = test_srp("a/./b/."), + + "" = test_srp("a/.."), + "" = test_srp("a/./.."), + "" = test_srp("a/../."), + "a" = test_srp("a/b/.."), + "a" = test_srp("a/../a"), + "a" = test_srp("a/../a/../a"), + "a/b/c" = test_srp("a/../a/b/c"), + + unsafe = test_srp("a/../.."), + unsafe = test_srp("a/../../.."), + unsafe = test_srp("a/./../.."), + unsafe = test_srp("a/././../../.."), + unsafe = test_srp("a/b/././../../.."), + + unsafe = test_srp(PrivDir), %Absolute path. + + ok. + +test_srp(RelPath) -> + Res = do_test_srp(RelPath), + Res = case do_test_srp(list_to_binary(RelPath)) of + Bin when is_binary(Bin) -> + binary_to_list(Bin); + Other -> + Other + end. + +do_test_srp(RelPath) -> + {ok,Root} = file:get_cwd(), + ok = file:set_cwd(RelPath), + {ok,Cwd} = file:get_cwd(), + ok = file:set_cwd(Root), + case filelib:safe_relative_path(RelPath, Cwd) of + unsafe -> + true = length(Cwd) < length(Root), + unsafe; + "" -> + ""; + SafeRelPath -> + ok = file:set_cwd(SafeRelPath), + {ok,Cwd} = file:get_cwd(), + true = length(Cwd) >= length(Root), + ok = file:set_cwd(Root), + SafeRelPath + end. + +safe_relative_path_links(Config) -> + PrivDir = ?config(priv_dir, Config), + BaseDir = filename:join(PrivDir, "filelib_SUITE_safe_relative_path_links"), + ok = file:make_dir(BaseDir), + try + case check_symlink_support(BaseDir) of + true -> + simple_test(BaseDir), + inside_directory_test(BaseDir), + nested_links_test(BaseDir), + loop_test(BaseDir), + loop_with_parent_test(BaseDir), + revist_links_test(BaseDir); + false -> + {skipped, "This platform/user can't create symlinks."} + end + after + %% This test leaves some rather nasty links that may screw with + %% z_SUITE's core file search, so we must make sure everything's + %% removed regardless of what happens. + rm_rf(BaseDir) + end. + +check_symlink_support(BaseDir) -> + Canary = filename:join(BaseDir, "symlink_canary"), + Link = filename:join(BaseDir, "symlink_canary_link"), + ok = file:write_file(Canary, <<"chirp">>), + ok =:= file:make_symlink(Canary, Link). + +simple_test(BaseDir) -> + file:make_dir(filename:join(BaseDir, "simple_test")), + file:make_symlink("..", filename:join(BaseDir, "simple_test/link")), + + unsafe = filelib:safe_relative_path("link/file", filename:join(BaseDir, "simple_test")), + "file" = filelib:safe_relative_path("file", filename:join(BaseDir, "simple_test/link")). + +inside_directory_test(BaseDir) -> + file:make_dir(filename:join(BaseDir, "inside_directory_test")), + file:make_symlink("..", filename:join(BaseDir, "inside_directory_test/link")), + + unsafe = filelib:safe_relative_path("link/file", filename:join(BaseDir, "inside_directory_test")), + "file" = filelib:safe_relative_path("file", filename:join(BaseDir, "inside_directory_test/link")). + +nested_links_test(BaseDir) -> + file:make_dir(filename:join(BaseDir, "nested_links_test")), + file:make_dir(filename:join(BaseDir, "nested_links_test/a")), + file:make_symlink("a/b/c", filename:join(BaseDir, "nested_links_test/link")), + file:make_symlink("..", filename:join(BaseDir, "nested_links_test/a/b")), + + "c/file" = filelib:safe_relative_path("link/file", filename:join(BaseDir, "nested_links_test")), + + file:delete(filename:join(BaseDir, "nested_links_test/a/b")), + file:make_symlink("../..", filename:join(BaseDir, "nested_links_test/a/b")), + unsafe = filelib:safe_relative_path("link/file", filename:join(BaseDir, "nested_links_test")). + +loop_test(BaseDir) -> + file:make_dir(filename:join(BaseDir, "loop_test")), + + file:make_symlink("b", filename:join(BaseDir, "loop_test/c")), + file:make_symlink("c", filename:join(BaseDir, "loop_test/b")), + + unsafe = filelib:safe_relative_path("c", filename:join(BaseDir, "loop_test")). + +loop_with_parent_test(BaseDir) -> + file:make_dir(filename:join(BaseDir, "loop_with_parent_test")), + file:make_dir(filename:join(BaseDir, "loop_with_parent_test/bar")), + + file:make_symlink("../bar/foo", filename:join(BaseDir, "loop_with_parent_test/bar/foo")), + + unsafe = filelib:safe_relative_path("bar/foo", filename:join(BaseDir, "loop_with_parent_test")). + +revist_links_test(BaseDir) -> + file:make_dir(filename:join(BaseDir, "revist_links_test")), + + file:make_symlink(".", filename:join(BaseDir, "revist_links_test/x")), + file:make_symlink("x", filename:join(BaseDir, "revist_links_test/y")), + file:make_symlink("y", filename:join(BaseDir, "revist_links_test/z")), + + "file" = filelib:safe_relative_path("x/file", filename:join(BaseDir, "revist_links_test")), + "file" = filelib:safe_relative_path("y/x/file", filename:join(BaseDir, "revist_links_test")), + "file" = filelib:safe_relative_path("x/x/file", filename:join(BaseDir, "revist_links_test")), + "file" = filelib:safe_relative_path("x/y/x/y/file", filename:join(BaseDir, "revist_links_test")), + "file" = filelib:safe_relative_path("x/y/z/x/y/z/file", filename:join(BaseDir, "revist_links_test")), + "file" = filelib:safe_relative_path("x/x/y/y/file", filename:join(BaseDir, "revist_links_test")), + "file" = filelib:safe_relative_path("x/z/y/x/./z/foo/../x/./y/file", filename:join(BaseDir, "revist_links_test")). + +rm_rf(Dir) -> + case file:read_link_info(Dir) of + {ok, #file_info{type = directory}} -> + {ok, Content} = file:list_dir_all(Dir), + [ rm_rf(filename:join(Dir,C)) || C <- Content ], + file:del_dir(Dir), + ok; + {ok, #file_info{}} -> + file:delete(Dir); + _ -> + ok + end. diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index f284eb1ed6..846394d366 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -886,7 +886,7 @@ t_nativename_bin(Config) when is_list(Config) -> safe_relative_path(Config) -> PrivDir = proplists:get_value(priv_dir, Config), - Root = filename:join(PrivDir, ?FUNCTION_NAME), + Root = filename:join(PrivDir, "filename_SUITE_safe_relative_path"), ok = file:make_dir(Root), ok = file:set_cwd(Root), @@ -1081,7 +1081,10 @@ check_basedir_xdg([Type|Types]) -> Opt = #{os=>linux}, Key = basedir_xdg_env(Type), io:format("type: ~p~n", [Type]), - Home = os:getenv("HOME"), + Home = case os:getenv("WSLENV") of + false -> os:getenv("HOME"); + _ -> os:getenv("USERPROFILE") + end, NDir = "/some/absolute/path", DefPath = basedir_xdg_def(Type,Home,Name), EnvPath = case Type of diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 880b10117c..cb292cf01f 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -32,7 +32,7 @@ start_opt/1, undef_init/1, undef_handle_call/1, undef_handle_event/1, undef_handle_info/1, undef_code_change/1, undef_terminate/1, - undef_in_terminate/1]). + undef_in_terminate/1, format_log_1/1, format_log_2/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -40,7 +40,8 @@ all() -> [start, {group, test_all}, hibernate, auto_hibernate, call_format_status, call_format_status_anon, error_format_status, get_state, replace_state, - start_opt, {group, undef_callbacks}, undef_in_terminate]. + start_opt, {group, undef_callbacks}, undef_in_terminate, + format_log_1, format_log_2]. groups() -> [{test_all, [], @@ -112,6 +113,11 @@ start(Config) when is_list(Config) -> [] = gen_event:which_handlers(Pid1), ok = gen_event:stop(Pid1), + {ok, {Pid1b,Mon1b}} = gen_event:start_monitor(), %anonymous + [] = gen_event:which_handlers(Pid1b), + ok = gen_event:stop(Pid1b), + receive {'DOWN',Mon1b,process,Pid1b,_} -> ok end, + {ok, Pid2} = gen_event:start(?LMGR), [] = gen_event:which_handlers(my_dummy_name), [] = gen_event:which_handlers(Pid2), @@ -122,21 +128,45 @@ start(Config) when is_list(Config) -> [] = gen_event:which_handlers(Pid3), ok = gen_event:stop(my_dummy_name), + {ok, {Pid3b,Mon3b}} = gen_event:start_monitor(?LMGR), + [] = gen_event:which_handlers(my_dummy_name), + [] = gen_event:which_handlers(Pid3b), + ok = gen_event:stop(my_dummy_name), + receive {'DOWN',Mon3b,process,Pid3b,_} -> ok end, + {ok, Pid4} = gen_event:start_link(?GMGR), [] = gen_event:which_handlers(?GMGR), [] = gen_event:which_handlers(Pid4), ok = gen_event:stop(?GMGR), + {ok, {Pid4b,Mon4b}} = gen_event:start_monitor(?GMGR), + [] = gen_event:which_handlers(?GMGR), + [] = gen_event:which_handlers(Pid4b), + ok = gen_event:stop(?GMGR), + receive {'DOWN',Mon4b,process,Pid4b,_} -> ok end, + {ok, Pid5} = gen_event:start_link({via, dummy_via, my_dummy_name}), [] = gen_event:which_handlers({via, dummy_via, my_dummy_name}), [] = gen_event:which_handlers(Pid5), ok = gen_event:stop({via, dummy_via, my_dummy_name}), + {ok, {Pid5b,Mon5b}} = gen_event:start_monitor({via, dummy_via, my_dummy_name}), + [] = gen_event:which_handlers({via, dummy_via, my_dummy_name}), + [] = gen_event:which_handlers(Pid5b), + ok = gen_event:stop({via, dummy_via, my_dummy_name}), + receive {'DOWN',Mon5b,process,Pid5b,_} -> ok end, + {ok, _} = gen_event:start_link(?LMGR), {error, {already_started, _}} = gen_event:start_link(?LMGR), {error, {already_started, _}} = gen_event:start(?LMGR), ok = gen_event:stop(my_dummy_name), + {ok, {Pid5c,Mon5c}} = gen_event:start_monitor(?LMGR), + {error, {already_started, Pid5c}} = gen_event:start_monitor(?LMGR), + {error, {already_started, Pid5c}} = gen_event:start(?LMGR), + ok = gen_event:stop(my_dummy_name), + receive {'DOWN',Mon5c,process,Pid5c,_} -> ok end, + {ok, Pid6} = gen_event:start_link(?GMGR), {error, {already_started, _}} = gen_event:start_link(?GMGR), {error, {already_started, _}} = gen_event:start(?GMGR), @@ -148,6 +178,17 @@ start(Config) when is_list(Config) -> ct:fail(exit_gen_event) end, + {ok, {Pid6b,Mon6b}} = gen_event:start_monitor(?GMGR), + {error, {already_started, _}} = gen_event:start_monitor(?GMGR), + {error, {already_started, _}} = gen_event:start(?GMGR), + + ok = gen_event:stop(?GMGR, shutdown, 10000), + receive + {'DOWN', Mon6b, process, Pid6b, shutdown} -> ok + after 10000 -> + ct:fail(exit_gen_event) + end, + {ok, Pid7} = gen_event:start_link({via, dummy_via, my_dummy_name}), {error, {already_started, _}} = gen_event:start_link({via, dummy_via, my_dummy_name}), {error, {already_started, _}} = gen_event:start({via, dummy_via, my_dummy_name}), @@ -159,6 +200,17 @@ start(Config) when is_list(Config) -> ct:fail(exit_gen_event) end, + {ok, {Pid7b,Mon7b}} = gen_event:start_monitor({via, dummy_via, my_dummy_name}), + {error, {already_started, _}} = gen_event:start_monitor({via, dummy_via, my_dummy_name}), + {error, {already_started, _}} = gen_event:start({via, dummy_via, my_dummy_name}), + + exit(Pid7b, shutdown), + receive + {'DOWN', Mon7b, process, Pid7b, shutdown} -> ok + after 10000 -> + ct:fail(exit_gen_event) + end, + process_flag(trap_exit, OldFl), ok. @@ -763,27 +815,49 @@ sync_notify(Config) when is_list(Config) -> ok. call(Config) when is_list(Config) -> + Async = fun(Mgr,H,Req) -> + try + Promise = gen_event:send_request(Mgr,H,Req), + gen_event:wait_response(Promise, infinity) + catch _:Reason -> + {'did_exit', Reason} + end + end, {ok,_} = gen_event:start({local, my_dummy_handler}), ok = gen_event:add_handler(my_dummy_handler, dummy_h, [self()]), ok = gen_event:add_handler(my_dummy_handler, {dummy_h, 1}, [self()]), [{dummy_h, 1}, dummy_h] = gen_event:which_handlers(my_dummy_handler), {'EXIT',_} = (catch gen_event:call(non_exist, dummy_h, hejsan)), - {error, bad_module} = - gen_event:call(my_dummy_handler, bad_h, hejsan), + {error, _} = Async(non_exist, dummy_h, hejsan), + {error, bad_module} = gen_event:call(my_dummy_handler, bad_h, hejsan), + {error, bad_module} = Async(my_dummy_handler, bad_h, hejsan), + {ok, hejhopp} = gen_event:call(my_dummy_handler, dummy_h, hejsan), - {ok, hejhopp} = gen_event:call(my_dummy_handler, {dummy_h, 1}, - hejsan), - {ok, hejhopp} = gen_event:call(my_dummy_handler, dummy_h, hejsan, - 10000), + {reply, {ok, hejhopp}} = Async(my_dummy_handler, dummy_h, hejsan), + {ok, hejhopp} = gen_event:call(my_dummy_handler, {dummy_h, 1}, hejsan), + {reply, {ok, hejhopp}} = Async(my_dummy_handler, {dummy_h, 1}, hejsan), + {ok, hejhopp} = gen_event:call(my_dummy_handler, {dummy_h, 1}, hejsan), + {reply, {ok, hejhopp}} = Async(my_dummy_handler, {dummy_h, 1}, hejsan), + {ok, hejhopp} = gen_event:call(my_dummy_handler, dummy_h, hejsan, 10000), {'EXIT', {timeout, _}} = (catch gen_event:call(my_dummy_handler, dummy_h, hejsan, 0)), flush(), + P1 = gen_event:send_request(my_dummy_handler, dummy_h, hejsan), + timeout = gen_event:wait_response(P1, 0), + {reply, {ok, hejhopp}} = gen_event:wait_response(P1, infinity), + + flush(), + P2 = gen_event:send_request(my_dummy_handler, dummy_h, hejsan), + no_reply = gen_event:check_response({other,msg}, P2), + {reply, {ok, hejhopp}} = receive Msg -> gen_event:check_response(Msg, P2) + after 1000 -> exit(tmo) end, + ok = gen_event:delete_handler(my_dummy_handler, {dummy_h, 1}, []), {ok, swapped} = gen_event:call(my_dummy_handler, dummy_h, {swap_call,dummy1_h,swap}), [dummy1_h] = gen_event:which_handlers(my_dummy_handler), - {error, bad_module} = - gen_event:call(my_dummy_handler, dummy_h, hejsan), + {error, bad_module} = gen_event:call(my_dummy_handler, dummy_h, hejsan), + {error, bad_module} = Async(my_dummy_handler, dummy_h, hejsan), ok = gen_event:call(my_dummy_handler, dummy1_h, delete_call), receive {dummy1_h, removed} -> @@ -1221,3 +1295,209 @@ fake_upgrade(Pid, Mod) -> Ret = sys:change_code(Pid, Mod, old_vsn, []), ok = sys:resume(Pid), Ret. + +%% Test report callback for Logger handler error_logger +format_log_1(_Config) -> + FD = application:get_env(kernel, error_logger_format_depth), + application:unset_env(kernel, error_logger_format_depth), + Term = lists:seq(1, 15), + Handler = my_handler, + Name = self(), + Report = #{label=>{gen_event,terminate}, + handler=>Handler, + name=>Name, + last_message=>Term, + state=>Term, + reason=>Term}, + {F1, A1} = gen_event:format_log(Report), + FExpected1 = "** gen_event handler ~tp crashed.\n" + "** Was installed in ~tp\n" + "** Last event was: ~tp\n" + "** When handler state == ~tp\n" + "** Reason == ~tp\n", + ct:log("F1: ~ts~nA1: ~tp", [F1,A1]), + FExpected1 = F1, + [Handler,Name,Term,Term,Term] = A1, + + Warning = #{label=>{gen_event,no_handle_info}, + module=>?MODULE, + message=>Term}, + {WF1,WA1} = gen_event:format_log(Warning), + WFExpected1 = "** Undefined handle_info in ~p\n" + "** Unhandled message: ~tp\n", + ct:log("WF1: ~ts~nWA1: ~tp", [WF1,WA1]), + WFExpected1 = WF1, + [?MODULE,Term] = WA1, + + Depth = 10, + ok = application:set_env(kernel, error_logger_format_depth, Depth), + Limited = [1,2,3,4,5,6,7,8,9,'...'], + {F2,A2} = gen_event:format_log(#{label=>{gen_event,terminate}, + handler=>Handler, + name=>Name, + last_message=>Term, + state=>Term, + reason=>Term}), + FExpected2 = "** gen_event handler ~tP crashed.\n" + "** Was installed in ~tP\n" + "** Last event was: ~tP\n" + "** When handler state == ~tP\n" + "** Reason == ~tP\n", + ct:log("F2: ~ts~nA2: ~tp", [F2,A2]), + FExpected2 = F2, + [Handler,Depth,Name,Depth,Limited,Depth,Limited,Depth,Limited,Depth] = A2, + + {WF2,WA2} = gen_event:format_log(Warning), + WFExpected2 = "** Undefined handle_info in ~p\n" + "** Unhandled message: ~tP\n", + ct:log("WF2: ~ts~nWA2: ~tp", [WF2,WA2]), + WFExpected2 = WF2, + [?MODULE,Limited,Depth] = WA2, + + case FD of + undefined -> + application:unset_env(kernel, error_logger_format_depth); + _ -> + application:set_env(kernel, error_logger_format_depth, FD) + end, + ok. + +%% Test report callback for any Logger handler +format_log_2(_Config) -> + Term = lists:seq(1, 15), + Handler = my_handler, + Name = self(), + NameStr = pid_to_list(Name), + Report = #{label=>{gen_event,terminate}, + handler=>Handler, + name=>Name, + last_message=>Term, + state=>Term, + reason=>Term}, + FormatOpts1 = #{}, + Str1 = flatten_format_log(Report, FormatOpts1), + L1 = length(Str1), + Expected1 = "** gen_event handler my_handler crashed.\n" + "** Was installed in "++NameStr++"\n" + "** Last event was: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n" + "** When handler state == [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n" + "** Reason == [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n", + ct:log("Str1: ~ts", [Str1]), + ct:log("length(Str1): ~p", [L1]), + true = Expected1 =:= Str1, + + Warning = #{label=>{gen_event,no_handle_info}, + module=>?MODULE, + message=>Term}, + WStr1 = flatten_format_log(Warning, FormatOpts1), + WL1 = length(WStr1), + WExpected1 = "** Undefined handle_info in gen_event_SUITE\n" + "** Unhandled message: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n", + ct:log("WStr1: ~ts", [WStr1]), + ct:log("length(WStr1): ~p", [WL1]), + true = WExpected1 =:= WStr1, + + Depth = 10, + FormatOpts2 = #{depth=>Depth}, + Str2 = flatten_format_log(Report, FormatOpts2), + L2 = length(Str2), + Expected2 = "** gen_event handler my_handler crashed.\n" + "** Was installed in " ++ NameStr ++ "\n" + "** Last event was: [1,2,3,4,5,6,7,8,9|...]\n" + "** When handler state == [1,2,3,4,5,6,7,8,9|...]\n" + "** Reason == [1,2,3,4,5,6,7,8,9|...]\n", + ct:log("Str2: ~ts", [Str2]), + ct:log("length(Str2): ~p", [L2]), + true = Expected2 =:= Str2, + + WStr2 = flatten_format_log(Warning, FormatOpts2), + WL2 = length(WStr2), + WExpected2 = "** Undefined handle_info in gen_event_SUITE\n" + "** Unhandled message: [1,2,3,4,5,6,7,8,9|...]\n", + ct:log("WStr2: ~ts", [WStr2]), + ct:log("length(WStr2): ~p", [WL2]), + true = WExpected2 =:= WStr2, + + FormatOpts3 = #{chars_limit=>200}, + Str3 = flatten_format_log(Report, FormatOpts3), + L3 = length(Str3), + Expected3 = "** gen_event handler my_handler crashed.\n" + "** Was installed", + ct:log("Str3: ~ts", [Str3]), + ct:log("length(Str3): ~p", [L3]), + true = lists:prefix(Expected3, Str3), + true = L3 < L1, + + WFormatOpts3 = #{chars_limit=>80}, + WStr3 = flatten_format_log(Warning, WFormatOpts3), + WL3 = length(WStr3), + WExpected3 = "** Undefined handle_info in gen_event_SUITE\n" + "** Unhandled message: ", + ct:log("WStr3: ~ts", [WStr3]), + ct:log("length(WStr3): ~p", [WL3]), + true = lists:prefix(WExpected3, WStr3), + true = WL3 < WL1, + + FormatOpts4 = #{single_line=>true}, + Str4 = flatten_format_log(Report, FormatOpts4), + L4 = length(Str4), + + Expected4 = "Generic event handler my_handler crashed. " + "Installed: "++NameStr++". " + "Last event: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]. " + "State: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]. " + "Reason: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15].", + ct:log("Str4: ~ts", [Str4]), + ct:log("length(Str4): ~p", [L4]), + true = Expected4 =:= Str4, + + WStr4 = flatten_format_log(Warning, FormatOpts4), + WL4 = length(WStr4), + WExpected4 = "Undefined handle_info in gen_event_SUITE. " + "Unhandled message: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15].", + ct:log("WStr4: ~ts", [WStr4]), + ct:log("length(WStr4): ~p", [WL4]), + true = WExpected4 =:= WStr4, + + FormatOpts5 = #{single_line=>true, depth=>Depth}, + Str5 = flatten_format_log(Report, FormatOpts5), + L5 = length(Str5), + Expected5 = "Generic event handler my_handler crashed. " + "Installed: "++NameStr++". " + "Last event: [1,2,3,4,5,6,7,8,9|...]. " + "State: [1,2,3,4,5,6,7,8,9|...]. " + "Reason: [1,2,3,4,5,6,7,8,9|...].", + ct:log("Str5: ~ts", [Str5]), + ct:log("length(Str5): ~p", [L5]), + true = Expected5 =:= Str5, + + WStr5 = flatten_format_log(Warning, FormatOpts5), + WL5 = length(WStr5), + WExpected5 = "Undefined handle_info in gen_event_SUITE. " + "Unhandled message: [1,2,3,4,5,6,7,8,9|...].", + ct:log("WStr5: ~ts", [WStr5]), + ct:log("length(WStr5): ~p", [WL5]), + true = WExpected5 =:= WStr5, + + FormatOpts6 = #{single_line=>true, chars_limit=>200}, + Str6 = flatten_format_log(Report, FormatOpts6), + L6 = length(Str6), + Expected6 = "Generic event handler my_handler crashed. Installed: ", + ct:log("Str6: ~ts", [Str6]), + ct:log("length(Str6): ~p", [L6]), + true = lists:prefix(Expected6, Str6), + true = L6 < L4, + + WFormatOpts6 = #{single_line=>true, chars_limit=>80}, + WStr6 = flatten_format_log(Warning, WFormatOpts6), + WL6 = length(WStr6), + WExpected6 = "Undefined handle_info in gen_event_SUITE. ", + ct:log("WStr6: ~ts", [WStr6]), + ct:log("length(WStr6): ~p", [WL6]), + true = lists:prefix(WExpected6, WStr6), + true = WL6 < WL4, + + ok. + +flatten_format_log(Report, Format) -> + lists:flatten(gen_event:format_log(Report, Format)). diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index 62d9d0e0ae..6840184c74 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -46,6 +46,8 @@ -export([hibernate/1,auto_hibernate/1,hiber_idle/3,hiber_wakeup/3,hiber_idle/2,hiber_wakeup/2]). +-export([format_log_1/1, format_log_2/1]). + -export([enter_loop/1]). %% Exports for apply @@ -69,7 +71,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [{group, start}, {group, abnormal}, shutdown, {group, sys}, hibernate, auto_hibernate, enter_loop, {group, undef_callbacks}, - undef_in_handle_info, undef_in_terminate]. + undef_in_handle_info, undef_in_terminate,{group,format_log}]. groups() -> [{start, [], @@ -83,7 +85,8 @@ groups() -> get_state, replace_state]}, {undef_callbacks, [], [undef_handle_event, undef_handle_sync_event, undef_handle_info, - undef_init, undef_code_change, undef_terminate1, undef_terminate2]}]. + undef_init, undef_code_change, undef_terminate1, undef_terminate2]}, + {format_log, [], [format_log_1, format_log_2]}]. init_per_suite(Config) -> Config. @@ -1018,6 +1021,236 @@ undef_in_terminate(Config) when is_list(Config) -> ok end. +%% Test report callback for Logger handler error_logger +format_log_1(_Config) -> + FD = application:get_env(kernel, error_logger_format_depth), + application:unset_env(kernel, error_logger_format_depth), + Term = lists:seq(1, 15), + Name = self(), + Report = #{label=>{gen_fsm,terminate}, + name=>Name, + last_message=>Term, + state_name=>Name, + state_data=>Term, + log=>[Term], + reason=>Term, + client_info=>{self(),{clientname,[]}}}, + {F1,A1} = gen_fsm:format_log(Report), + FExpected1 = "** State machine ~tp terminating \n" + "** Last message in was ~tp~n" + "** When State == ~tp~n" + "** Data == ~tp~n" + "** Reason for termination ==~n** ~tp~n" + "** Log ==~n**~tp~n" + "** Client ~tp stacktrace~n** ~tp~n", + ct:log("F1: ~ts~nA1: ~tp", [F1,A1]), + FExpected1=F1, + + [Name,Term,Name,Term,Term,[Term],clientname,[]] = A1, + + Warning = #{label=>{gen_fsm,no_handle_info}, + module=>?MODULE, + message=>Term}, + {WF1,WA1} = gen_fsm:format_log(Warning), + WFExpected1 = "** Undefined handle_info in ~p~n" + "** Unhandled message: ~tp~n", + ct:log("WF1: ~ts~nWA1: ~tp", [WF1,WA1]), + WFExpected1=WF1, + [?MODULE,Term] = WA1, + + Depth = 10, + ok = application:set_env(kernel, error_logger_format_depth, Depth), + Limited = [1,2,3,4,5,6,7,8,9,'...'], + {F2,A2} = gen_fsm:format_log(#{label=>{gen_fsm,terminate}, + name=>Name, + last_message=>Term, + state_name=>Name, + state_data=>Term, + log=>[Term], + reason=>Term, + client_info=>{self(),{clientname,[]}}}), + FExpected2 = "** State machine ~tP terminating \n" + "** Last message in was ~tP~n" + "** When State == ~tP~n" + "** Data == ~tP~n" + "** Reason for termination ==~n** ~tP~n" + "** Log ==~n**~tP~n" + "** Client ~tP stacktrace~n** ~tP~n", + ct:log("F2: ~ts~nA2: ~tp", [F2,A2]), + FExpected2=F2, + + [Name,Depth,Limited,Depth,Name,Depth,Limited,Depth,Limited, + Depth,[Limited],Depth,clientname,Depth,[],Depth] = A2, + + {WF2,WA2} = gen_fsm:format_log(Warning), + WFExpected2 = "** Undefined handle_info in ~p~n" + "** Unhandled message: ~tP~n", + ct:log("WF2: ~ts~nWA2: ~tp", [WF2,WA2]), + WFExpected2=WF2, + [?MODULE,Limited,Depth] = WA2, + + case FD of + undefined -> + application:unset_env(kernel, error_logger_format_depth); + _ -> + application:set_env(kernel, error_logger_format_depth, FD) + end, + ok. + +%% Test report callback for any Logger handler +format_log_2(_Config) -> + Term = lists:seq(1, 15), + Name = self(), + NameStr = pid_to_list(Name), + Report = #{label=>{gen_fsm,terminate}, + name=>Name, + last_message=>Term, + state_name=>Name, + state_data=>Term, + log=>[Term], + reason=>Term, + client_info=>{self(),{clientname,[]}}}, + FormatOpts1 = #{}, + Str1 = flatten_format_log(Report, FormatOpts1), + L1 = length(Str1), + Expected1 = "** State machine "++NameStr++" terminating \n" + "** Last message in was [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n" + "** When State == "++NameStr++"\n" + "** Data == [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n" + "** Reason for termination ==\n" + "** [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n" + "** Log ==\n" + "**[[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]\n" + "** Client clientname stacktrace\n" + "** []\n", + ct:log("Str1: ~ts", [Str1]), + ct:log("length(Str1): ~p", [L1]), + true = Expected1 =:= Str1, + + Warning = #{label=>{gen_fsm,no_handle_info}, + module=>?MODULE, + message=>Term}, + WStr1 = flatten_format_log(Warning, FormatOpts1), + WL1 = length(WStr1), + WExpected1 = "** Undefined handle_info in gen_fsm_SUITE\n" + "** Unhandled message: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n", + ct:log("WStr1: ~ts", [WStr1]), + ct:log("length(WStr1): ~p", [WL1]), + true = WExpected1 =:= WStr1, + + Depth = 10, + FormatOpts2 = #{depth=>Depth}, + Str2 = flatten_format_log(Report, FormatOpts2), + L2 = length(Str2), + Expected2 = "** State machine "++NameStr++" terminating \n" + "** Last message in was [1,2,3,4,5,6,7,8,9|...]\n" + "** When State == "++NameStr++"\n" + "** Data == [1,2,3,4,5,6,7,8,9|...]\n" + "** Reason for termination ==\n" + "** [1,2,3,4,5,6,7,8,9|...]\n" + "** Log ==\n" + "**[[1,2,3,4,5,6,7,8|...]]\n" + "** Client clientname stacktrace\n" + "** []\n", + ct:log("Str2: ~ts", [Str2]), + ct:log("length(Str2): ~p", [L2]), + true = Expected2 =:= Str2, + + WStr2 = flatten_format_log(Warning, FormatOpts2), + WL2 = length(WStr2), + WExpected2 = "** Undefined handle_info in gen_fsm_SUITE\n" + "** Unhandled message: [1,2,3,4,5,6,7,8,9|...]\n", + ct:log("WStr2: ~ts", [WStr2]), + ct:log("length(WStr2): ~p", [WL2]), + true = WExpected2 =:= WStr2, + + FormatOpts3 = #{chars_limit=>200}, + Str3 = flatten_format_log(Report, FormatOpts3), + L3 = length(Str3), + Expected3 = "** State machine "++NameStr++" terminating \n" + "** Last ", + ct:log("Str3: ~ts", [Str3]), + ct:log("length(Str3): ~p", [L3]), + true = lists:prefix(Expected3, Str3), + true = L3 < L1, + + WFormatOpts3 = #{chars_limit=>80}, + WStr3 = flatten_format_log(Warning, WFormatOpts3), + WL3 = length(WStr3), + WExpected3 = "** Undefined handle_info in gen_fsm_SUITE", + ct:log("WStr3: ~ts", [WStr3]), + ct:log("length(WStr3): ~p", [WL3]), + true = lists:prefix(WExpected3, WStr3), + true = WL3 < WL1, + + FormatOpts4 = #{single_line=>true}, + Str4 = flatten_format_log(Report, FormatOpts4), + L4 = length(Str4), + Expected4 = "State machine "++NameStr++" terminating. " + "Reason: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]. " + "Last event: [[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]. " + "State: "++NameStr++". " + "Data: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]. " + "Log: [[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]. " + "Client clientname stacktrace: [].", + ct:log("Str4: ~ts", [Str4]), + ct:log("length(Str4): ~p", [L4]), + true = Expected4 =:= Str4, + + WStr4 = flatten_format_log(Warning, FormatOpts4), + WL4 = length(WStr4), + WExpected4 = "Undefined handle_info in gen_fsm_SUITE. " + "Unhandled message: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15].", + ct:log("WStr4: ~ts", [WStr4]), + ct:log("length(WStr4): ~p", [WL4]), + true = WExpected4 =:= WStr4, + + FormatOpts5 = #{single_line=>true, depth=>Depth}, + Str5 = flatten_format_log(Report, FormatOpts5), + L5 = length(Str5), + Expected5 = "State machine "++NameStr++" terminating. " + "Reason: [1,2,3,4,5,6,7,8,9|...]. " + "Last event: [[1,2,3,4,5,6,7,8|...]]. " + "State: "++NameStr++". " + "Data: [1,2,3,4,5,6,7,8,9|...]. " + "Log: [[1,2,3,4,5,6,7,8|...]]. " + "Client clientname stacktrace: [].", + ct:log("Str5: ~ts", [Str5]), + ct:log("length(Str5): ~p", [L5]), + true = Expected5 =:= Str5, + + WStr5 = flatten_format_log(Warning, FormatOpts5), + WL5 = length(WStr5), + WExpected5 = "Undefined handle_info in gen_fsm_SUITE. " + "Unhandled message: [1,2,3,4,5,6,7,8,9|...].", + ct:log("WStr5: ~ts", [WStr5]), + ct:log("length(WStr5): ~p", [WL5]), + true = WExpected5 =:= WStr5, + + FormatOpts6 = #{single_line=>true, chars_limit=>200}, + Str6 = flatten_format_log(Report, FormatOpts6), + L6 = length(Str6), + Expected6 = "State machine "++NameStr++" terminating. Reason: ", + ct:log("Str6: ~ts", [Str6]), + ct:log("length(Str6): ~p", [L6]), + true = lists:prefix(Expected6, Str6), + true = L6 < L4, + + WFormatOpts6 = #{single_line=>true, chars_limit=>80}, + WStr6 = flatten_format_log(Warning, WFormatOpts6), + WL6 = length(WStr6), + WExpected6 = "Undefined handle_info in gen_fsm_SUITE. " + "Unhandled message: ", + ct:log("WStr6: ~ts", [WStr6]), + ct:log("length(WStr6): ~p", [WL6]), + true = lists:prefix(WExpected6, WStr6), + true = WL6 < WL4, + + ok. + +flatten_format_log(Report, Format) -> + lists:flatten(gen_fsm:format_log(Report, Format)). + %% %% Functionality check %% diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index e29195e895..8015126b0d 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -26,7 +26,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). --export([start/1, crash/1, call/1, cast/1, cast_fast/1, +-export([start/1, crash/1, call/1, send_request/1, cast/1, cast_fast/1, continue/1, info/1, abcast/1, multicall/1, multicall_down/1, call_remote1/1, call_remote2/1, call_remote3/1, call_remote_n1/1, call_remote_n2/1, call_remote_n3/1, spec_init/1, @@ -38,7 +38,9 @@ undef_handle_call/1, undef_handle_cast/1, undef_handle_info/1, undef_init/1, undef_code_change/1, undef_terminate1/1, undef_terminate2/1, undef_in_terminate/1, undef_in_handle_info/1, - undef_handle_continue/1 + undef_handle_continue/1, + + format_log_1/1, format_log_2/1 ]). -export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1, @@ -61,7 +63,7 @@ suite() -> {timetrap,{minutes,1}}]. all() -> - [start, {group,stop}, crash, call, cast, cast_fast, info, abcast, + [start, {group,stop}, crash, call, send_request, cast, cast_fast, info, abcast, continue, multicall, multicall_down, call_remote1, call_remote2, call_remote3, call_remote_n1, call_remote_n2, call_remote_n3, spec_init, @@ -71,7 +73,8 @@ all() -> call_format_status, error_format_status, terminate_crash_format, get_state, replace_state, call_with_huge_message_queue, {group, undef_callbacks}, - undef_in_terminate, undef_in_handle_info]. + undef_in_terminate, undef_in_handle_info, + format_log_1, format_log_2]. groups() -> [{stop, [], @@ -104,7 +107,8 @@ init_per_testcase(Case, Config) when Case == call_remote1; Case == call_remote3; Case == call_remote_n1; Case == call_remote_n2; - Case == call_remote_n3 -> + Case == call_remote_n3; + Case == send_request -> {ok,N} = start_node(hubba), [{node,N} | Config]; @@ -161,6 +165,18 @@ start(Config) when is_list(Config) -> ct:fail(not_stopped) end, + %% anonymous monitored + {ok, {Pid1b, Mon1b}} = + gen_server:start_monitor(gen_server_SUITE, [], []), + ok = gen_server:call(Pid1b, started_p), + ok = gen_server:call(Pid1b, stop), + receive + {'DOWN', Mon1b, process, Pid1b, stopped} -> + ok + after 5000 -> + ct:fail(not_stopped) + end, + %% local register {ok, Pid2} = gen_server:start({local, my_test_name}, @@ -191,6 +207,22 @@ start(Config) when is_list(Config) -> ct:fail(not_stopped) end, + %% local register monitored + {ok, {Pid3b, Mon3b}} = + gen_server:start_monitor({local, my_test_name}, + gen_server_SUITE, [], []), + ok = gen_server:call(my_test_name, started_p), + {error, {already_started, Pid3b}} = + gen_server:start_monitor({local, my_test_name}, + gen_server_SUITE, [], []), + ok = gen_server:call(my_test_name, stop), + receive + {'DOWN', Mon3b, process, Pid3b, stopped} -> + ok + after 5000 -> + ct:fail(not_stopped) + end, + %% global register {ok, Pid4} = gen_server:start({global, my_test_name}, @@ -219,6 +251,22 @@ start(Config) when is_list(Config) -> ct:fail(not_stopped) end, + %% global register monitored + {ok, {Pid5b, Mon5b}} = + gen_server:start_monitor({global, my_test_name}, + gen_server_SUITE, [], []), + ok = gen_server:call({global, my_test_name}, started_p), + {error, {already_started, Pid5b}} = + gen_server:start_monitor({global, my_test_name}, + gen_server_SUITE, [], []), + ok = gen_server:call({global, my_test_name}, stop), + receive + {'DOWN', Mon5b, process, Pid5b, stopped} -> + ok + after 5000 -> + ct:fail(not_stopped) + end, + %% via register dummy_via:reset(), {ok, Pid6} = @@ -459,6 +507,90 @@ call(Config) when is_list(Config) -> ok. %% -------------------------------------- +%% Test gen_server:send_request. +%% -------------------------------------- + +send_request(Config) when is_list(Config) -> + OldFl = process_flag(trap_exit, true), + + {ok, Pid} = gen_server:start_link({local, my_test_name}, + gen_server_SUITE, [], []), + + Async = fun(Process, Req) -> + try + Promise = gen_server:send_request(Process, Req), + gen_server:wait_response(Promise, infinity) + catch _:Reason:ST -> + {'did_exit', Reason, ST} + end + end, + {reply,ok} = Async(my_test_name, started_p), + + {reply,delayed} = Async(Pid, {delayed_answer,1}), + + %% two requests within a specified time. + Promise1 = gen_server:send_request(my_test_name, {call_within, 1000}), + Promise2 = gen_server:send_request(my_test_name, next_call), + {reply, ok} = gen_server:wait_response(Promise1, infinity), + {reply, ok} = gen_server:wait_response(Promise2, infinity), + + Promise3 = gen_server:send_request(my_test_name, {call_within, 1000}), + no_reply = gen_server:check_response({foo, bar}, Promise3), + receive {{'$gen_request_id',Ref},_} = Msg when is_reference(Ref) -> + {reply, ok} = gen_server:check_response(Msg, Promise3) + after 1000 -> + %% Format not yet doumented so it might be ok + %% This test is just to make you aware that you have changed it + exit(message_format_changed) + end, + timer:sleep(1500), + + {reply, false} = Async(my_test_name, next_call), + + %% timeout + Promise5 = gen_server:send_request(my_test_name, {delayed_answer,50}), + timeout = gen_server:wait_response(Promise5, 0), + {reply, delayed} = gen_server:wait_response(Promise5, infinity), + + %% bad return value in the gen_server loop from handle_call. + {error,{{bad_return_value, badreturn},_}} = Async(my_test_name, badreturn), + + %% Test other error cases + {error, {noproc,_}} = Async(Pid, started_p), + {error, {noproc,_}} = Async(my_test_name, started_p), + {error, {noconnection, _}} = Async({my_test_name, foo@node}, started_p), + + {error, {noproc,_}} = Async({global, non_existing}, started_p), + catch exit(whereis(dummy_via), foo), + {'EXIT', {badarg,_}} = + (catch gen_server:send_request({via, dummy_via, non_existing}, started_p)), + + %% Remote nodes + Via = dummy_via:reset(), + Remote = proplists:get_value(node,Config), + {ok, RPid} = rpc:call(Remote, gen_server, start, [{global, remote}, ?MODULE, [], []]), + dummy_via:register_name(remote, RPid), + {reply, ok} = Async(RPid, started_p), + {reply, ok} = Async({global, remote}, started_p), + {reply, ok} = Async({via, dummy_via, remote}, started_p), + {error, {shutdown, _}} = Async({global, remote}, stop_shutdown), + {error, {noproc, _}} = Async({global, remote}, started_p), + {error, {noproc, _}} = Async({via, dummy_via, remote}, started_p), + {error, {noproc, _}} = Async({via, dummy_via, non_existing}, started_p), + + {ok, _} = rpc:call(Remote, gen_server, start, [{local, remote}, ?MODULE, [], []]), + {reply, ok} = Async({remote, Remote}, started_p), + {error, {shutdown, _}} = Async({remote, Remote}, stop_shutdown), + {error, {noproc, _}} = Async({remote, Remote}, started_p), + + %% Cleanup + catch exit(Via, foo2), + receive {'EXIT', Via, foo2} -> ok end, + process_flag(trap_exit, OldFl), + ok. + + +%% -------------------------------------- %% Test handle_continue. %% -------------------------------------- @@ -1528,6 +1660,208 @@ wait_until_processed(Pid, Message, N) -> ok end. +%% Test report callback for Logger handler error_logger +format_log_1(_Config) -> + FD = application:get_env(kernel,error_logger_format_depth), + application:unset_env(kernel,error_logger_format_depth), + Term = lists:seq(1,15), + Name = self(), + Report = #{label=>{gen_server,terminate}, + name=>Name, + last_message=>Term, + state=>Term, + log=>[], + reason=>Term, + client_info=>{self(),{clientname,[]}}}, + {F1,A1} = gen_server:format_log(Report), + FExpected1 = "** Generic server ~tp terminating \n" + "** Last message in was ~tp~n" + "** When Server state == ~tp~n" + "** Reason for termination ==~n** ~tp~n" + "** Client ~tp stacktrace~n" + "** ~tp~n", + ct:log("F1: ~ts~nA1: ~tp",[F1,A1]), + FExpected1=F1, + [Name,Term,Term,Term,clientname,[]] = A1, + + Warning = #{label=>{gen_server,no_handle_info}, + module=>?MODULE, + message=>Term}, + {WF1,WA1} = gen_server:format_log(Warning), + WFExpected1 = "** Undefined handle_info in ~p~n" + "** Unhandled message: ~tp~n", + ct:log("WF1: ~ts~nWA1: ~tp",[WF1,WA1]), + WFExpected1=WF1, + [?MODULE,Term] = WA1, + + Depth = 10, + ok = application:set_env(kernel,error_logger_format_depth,Depth), + Limited = [1,2,3,4,5,6,7,8,9,'...'], + {F2,A2} = gen_server:format_log(#{label=>{gen_server,terminate}, + name=>Name, + last_message=>Term, + state=>Term, + log=>[], + reason=>Term, + client_info=>{self(),{clientname,[]}}}), + FExpected2 = "** Generic server ~tP terminating \n" + "** Last message in was ~tP~n" + "** When Server state == ~tP~n" + "** Reason for termination ==~n** ~tP~n" + "** Client ~tP stacktrace~n" + "** ~tP~n", + ct:log("F2: ~ts~nA2: ~tp",[F2,A2]), + FExpected2=F2, + [Name,Depth,Limited,Depth,Limited,Depth,Limited,Depth, + clientname,Depth,[],Depth] = A2, + + {WF2,WA2} = gen_server:format_log(Warning), + WFExpected2 = "** Undefined handle_info in ~p~n" + "** Unhandled message: ~tP~n", + ct:log("WF2: ~ts~nWA2: ~tp",[WF2,WA2]), + WFExpected2=WF2, + [?MODULE,Limited,Depth] = WA2, + + case FD of + undefined -> + application:unset_env(kernel,error_logger_format_depth); + _ -> + application:set_env(kernel,error_logger_format_depth,FD) + end, + ok. + +%% Test report callback for any Logger handler +format_log_2(_Config) -> + Term = lists:seq(1,15), + Name = self(), + NameStr = pid_to_list(Name), + Report = #{label=>{gen_server,terminate}, + name=>Name, + last_message=>Term, + state=>Term, + log=>[], + reason=>Term, + client_info=>{self(),{clientname,[]}}}, + FormatOpts1 = #{}, + Str1 = flatten_format_log(Report,FormatOpts1), + L1 = length(Str1), + Expected1 = "** Generic server "++NameStr++" terminating \n" + "** Last message in was ", + ct:log("Str1: ~ts",[Str1]), + ct:log("length(Str1): ~p",[L1]), + true = lists:prefix(Expected1,Str1), + + Warning = #{label=>{gen_server,no_handle_info}, + module=>?MODULE, + message=>Term}, + WStr1 = flatten_format_log(Warning,FormatOpts1), + WL1 = length(WStr1), + WExpected1 = "** Undefined handle_info in gen_server_SUITE\n" + "** Unhandled message: ", + ct:log("WStr1: ~ts",[WStr1]), + ct:log("length(WStr1): ~p",[WL1]), + true = lists:prefix(WExpected1,WStr1), + + Depth = 10, + FormatOpts2 = #{depth=>Depth}, + Str2 = flatten_format_log(Report,FormatOpts2), + L2 = length(Str2), + Expected2 = "** Generic server "++NameStr++" terminating \n" + "** Last message in was ", + ct:log("Str2: ~ts",[Str2]), + ct:log("length(Str2): ~p",[L2]), + true = lists:prefix(Expected2,Str2), + true = L2<L1, + + WStr2 = flatten_format_log(Warning,FormatOpts2), + WL2 = length(WStr2), + WExpected2 = "** Undefined handle_info in gen_server_SUITE\n" + "** Unhandled message: ", + ct:log("WStr2: ~ts",[WStr2]), + ct:log("length(WStr2): ~p",[WL2]), + true = lists:prefix(WExpected2,WStr2), + true = WL2<WL1, + + FormatOpts3 = #{chars_limit=>200}, + Str3 = flatten_format_log(Report,FormatOpts3), + L3 = length(Str3), + Expected3 = "** Generic server "++NameStr++" terminating \n" + "** Last message in was ", + ct:log("Str3: ~ts",[Str3]), + ct:log("length(Str3): ~p",[L3]), + true = lists:prefix(Expected3,Str3), + true = L3<L1, + + WFormatOpts3 = #{chars_limit=>80}, + WStr3 = flatten_format_log(Warning,WFormatOpts3), + WL3 = length(WStr3), + WExpected3 = "** Undefined handle_info in gen_server_SUITE\n" + "** Unhandled message: ", + ct:log("WStr3: ~ts",[WStr3]), + ct:log("length(WStr3): ~p",[WL3]), + true = lists:prefix(WExpected3,WStr3), + true = WL3<WL1, + + FormatOpts4 = #{single_line=>true}, + Str4 = flatten_format_log(Report,FormatOpts4), + L4 = length(Str4), + Expected4 = "Generic server "++NameStr++" terminating. Reason: ", + ct:log("Str4: ~ts",[Str4]), + ct:log("length(Str4): ~p",[L4]), + true = lists:prefix(Expected4,Str4), + true = L4<L1, + + WStr4 = flatten_format_log(Warning,FormatOpts4), + WL4 = length(WStr4), + WExpected4 = "Undefined handle_info in gen_server_SUITE. " + "Unhandled message: ", + ct:log("WStr4: ~ts",[WStr4]), + ct:log("length(WStr4): ~p",[WL4]), + true = lists:prefix(WExpected4,WStr4), + true = WL4<WL1, + + FormatOpts5 = #{single_line=>true, depth=>Depth}, + Str5 = flatten_format_log(Report,FormatOpts5), + L5 = length(Str5), + Expected5 = "Generic server "++NameStr++" terminating. Reason: ", + ct:log("Str5: ~ts",[Str5]), + ct:log("length(Str5): ~p",[L5]), + true = lists:prefix(Expected5,Str5), + true = L5<L4, + + WStr5 = flatten_format_log(Warning,FormatOpts5), + WL5 = length(WStr5), + WExpected5 = "Undefined handle_info in gen_server_SUITE. " + "Unhandled message: ", + ct:log("WStr5: ~ts",[WStr5]), + ct:log("length(WStr5): ~p",[WL5]), + true = lists:prefix(WExpected5,WStr5), + true = WL5<WL4, + + FormatOpts6 = #{single_line=>true, chars_limit=>200}, + Str6 = flatten_format_log(Report,FormatOpts6), + L6 = length(Str6), + Expected6 = "Generic server "++NameStr++" terminating. Reason: ", + ct:log("Str6: ~ts",[Str6]), + ct:log("length(Str6): ~p",[L6]), + true = lists:prefix(Expected6,Str6), + true = L6<L4, + + WFormatOpts6 = #{single_line=>true, chars_limit=>80}, + WStr6 = flatten_format_log(Warning,WFormatOpts6), + WL6 = length(WStr6), + WExpected6 = "Undefined handle_info in gen_server_SUITE. " + "Unhandled message: ", + ct:log("WStr6: ~ts",[WStr6]), + ct:log("length(WStr6): ~p",[WL6]), + true = lists:prefix(WExpected6,WStr6), + true = WL6<WL4, + + ok. + +flatten_format_log(Report, Format) -> + lists:flatten(gen_server:format_log(Report, Format)). + %%-------------------------------------------------------------- %% Help functions to spec_init_* start_link(Init, Options) -> diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 0586575736..741ce6211f 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -42,7 +42,7 @@ all() -> event_types, generic_timers, code_change, {group, sys}, hibernate, auto_hibernate, enter_loop, {group, undef_callbacks}, - undef_in_terminate]. + undef_in_terminate, {group, format_log}]. groups() -> [{start, [], tcs(start)}, @@ -53,7 +53,8 @@ groups() -> {abnormal_handle_event, [], tcs(abnormal)}, {sys, [], tcs(sys)}, {sys_handle_event, [], tcs(sys)}, - {undef_callbacks, [], tcs(undef_callbacks)}]. + {undef_callbacks, [], tcs(undef_callbacks)}, + {format_log, [], tcs(format_log)}]. tcs(start) -> [start1, start2, start3, start4, start5, start6, start7, @@ -69,7 +70,9 @@ tcs(sys) -> get_state, replace_state]; tcs(undef_callbacks) -> [undef_code_change, undef_terminate1, undef_terminate2, - function_clause_after_change_callback_module]. + function_clause_after_change_callback_module]; +tcs(format_log) -> + [format_log_1, format_log_2]. init_per_suite(Config) -> Config. @@ -140,8 +143,18 @@ start1(Config) -> %% ?EXPECT_FAILURE(gen_statem:call(Pid0, hej), Reason), %%process_flag(trap_exit, OldFl), - ok = verify_empty_msgq(). + ok = verify_empty_msgq(), + {ok,{Pid1,Mon1}} = gen_statem:start_monitor(?MODULE, start_arg(Config, []), []), + ok = do_func_test(Pid1), + ok = do_sync_func_test(Pid1), + stop_it(Pid1), + receive + {'DOWN', Mon1, process, Pid1, _Reason} -> + ok + end, + ok = verify_empty_msgq(). + %% anonymous w. shutdown start2(Config) -> %% Dont link when shutdown @@ -197,7 +210,7 @@ start6(Config) -> ok = verify_empty_msgq(). -%% global register linked +%% global register linked & monitored start7(Config) -> STM = {global,my_stm}, @@ -207,6 +220,8 @@ start7(Config) -> gen_statem:start_link(STM, ?MODULE, start_arg(Config, []), []), {error,{already_started,Pid}} = gen_statem:start(STM, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid}} = + gen_statem:start_monitor(STM, ?MODULE, start_arg(Config, []), []), ok = do_func_test(Pid), ok = do_sync_func_test(Pid), @@ -214,6 +229,28 @@ start7(Config) -> ok = do_sync_func_test(STM), stop_it(STM), + ok = verify_empty_msgq(), + + {ok,{Pid1,Mon1}} = + gen_statem:start_monitor(STM, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid1}} = + gen_statem:start_link(STM, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid1}} = + gen_statem:start(STM, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid1}} = + gen_statem:start_monitor(STM, ?MODULE, start_arg(Config, []), []), + + ok = do_func_test(Pid1), + ok = do_sync_func_test(Pid1), + ok = do_func_test(STM), + ok = do_sync_func_test(STM), + stop_it(STM), + + receive + {'DOWN', Mon1, process, Pid1, _Reason} -> + ok + end, + ok = verify_empty_msgq(). @@ -237,7 +274,7 @@ start8(Config) -> %%process_flag(trap_exit, OldFl), ok = verify_empty_msgq(). -%% local register linked +%% local register linked & monitored start9(Config) -> %%OldFl = process_flag(trap_exit, true), Name = my_stm, @@ -255,6 +292,24 @@ start9(Config) -> stop_it(Pid), %%process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(), + + {ok,{Pid1,Mon1}} = + gen_statem:start_monitor(STM, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid1}} = + gen_statem:start_monitor(STM, ?MODULE, start_arg(Config, []), []), + + ok = do_func_test(Pid1), + ok = do_sync_func_test(Pid1), + ok = do_func_test(Name), + ok = do_sync_func_test(Name), + stop_it(Pid1), + + receive + {'DOWN', Mon1, process, Pid1, _Reason} -> + ok + end, + ok = verify_empty_msgq(). %% global register @@ -1827,6 +1882,306 @@ next_events(Config) -> ?EXPECT_FAILURE(gen_statem:stop(Pid), Reason). +%% Test report callback for Logger handler error_logger +format_log_1(_Config) -> + FD = application:get_env(kernel, error_logger_format_depth), + application:unset_env(kernel, error_logger_format_depth), + Term = lists:seq(1,15), + Name = self(), + Reason = {bad_reply_action_from_state_function,[]}, + Report1 = simple_report(Name, Term, Reason), + Report2 = elaborate_report(Name, Term, Reason), + + {F1,A1} = gen_statem:format_log(Report1), + ct:log("F1: ~ts~nA1: ~tp",[F1,A1]), + FExpected1 = "** State machine ~tp terminating~n" + "** When server state = ~tp~n" + "** Reason for termination = ~tp:~tp~n" + "** Callback mode = ~tp~n", + FExpected1 = F1, + [Name,Term,error,Reason,state_functions] = A1, + + {F3,A3} = gen_statem:format_log(Report2), + ct:log("F3: ~ts~nA3: ~tp",[F3,A3]), + FExpected3 = "** State machine ~tp terminating~n" + "** Last event = ~tp~n" + "** When server state = ~tp~n" + "** Reason for termination = ~tp:~tp~n" + "** Callback mode = ~tp~n" + "** Queued = ~tp~n" + "** Postponed = ~tp~n" + "** Stacktrace =~n** ~tp~n" + "** Time-outs: ~tp~n" + "** Log =~n** ~tp~n" + "** Client ~tp stacktrace~n" + "** ~tp~n", + FExpected3 = F3, + Stacktrace = stacktrace(), + [Name,Term,Term,error,Reason,[state_functions,state_enter],[Term], + [{internal,Term}],Stacktrace,{1,[{timeout,message}]},[Term],Name,[]] = A3, + + Depth = 10, + ok = application:set_env(kernel, error_logger_format_depth, Depth), + Limited = [1,2,3,4,5,6,7,8,9,'...'], + {F2,A2} = gen_statem:format_log(Report1), + ct:log("F2: ~ts~nA2: ~tp",[F2,A2]), + FExpected2 = "** State machine ~tP terminating~n" + "** When server state = ~tP~n" + "** Reason for termination = ~tP:~tP~n" + "** Callback mode = ~tP~n", + FExpected2 = F2, + [Name,Depth,Limited,Depth,error,Depth,Reason, + Depth,state_functions,Depth] = A2, + + {F4,A4} = gen_statem:format_log(Report2), + ct:log("F4: ~ts~nA4: ~tp",[F4,A4]), + FExpected4 = "** State machine ~tP terminating~n" + "** Last event = ~tP~n" + "** When server state = ~tP~n" + "** Reason for termination = ~tP:~tP~n" + "** Callback mode = ~tP~n" + "** Queued = ~tP~n" + "** Postponed = ~tP~n" + "** Stacktrace =~n** ~tP~n" + "** Time-outs: ~tP~n" + "** Log =~n** ~tP~n" + "** Client ~tP stacktrace~n" + "** ~tP~n", + FExpected4 = F4, + LimitedPostponed = [{internal,[1,2,3,4,5,6,'...']}], + LimitedStacktrace = io_lib:limit_term(Stacktrace, Depth), + LimitedQueue = io_lib:limit_term([Term], Depth), + [Name,Depth,Limited,Depth,Limited,Depth,error,Depth,Reason,Depth, + [state_functions,state_enter],Depth,LimitedQueue,Depth, + LimitedPostponed,Depth,LimitedStacktrace,Depth,{1,[{timeout,message}]}, + Depth,[Limited],Depth,Name,Depth,[],Depth] = A4, + + case FD of + undefined -> + application:unset_env(kernel, error_logger_format_depth); + _ -> + application:set_env(kernel, error_logger_format_depth, FD) + end, + ok. + +%% Test report callback for any Logger handler +format_log_2(_Config) -> + format_log_2_simple(), + format_log_2_elaborate(), + ok. + +format_log_2_simple() -> + FD = application:get_env(kernel, error_logger_format_depth), + application:unset_env(kernel, error_logger_format_depth), + + Term = lists:seq(1,15), + Name = self(), + NameStr = pid_to_list(Name), + Reason = {bad_reply_action_from_state_function,[]}, + Report = simple_report(Name, Term, Reason), + + FormatOpts1 = #{}, + Str1 = flatten_format_log(Report, FormatOpts1), + L1 = length(Str1), + Expected1 = "** State machine " ++ NameStr ++ " terminating\n" + "** When server state = [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n" + "** Reason for termination = " + "error:{bad_reply_action_from_state_function,[]}\n" + "** Callback mode = state_functions\n", + ct:log("Str1: ~ts", [Str1]), + ct:log("length(Str1): ~p", [L1]), + Expected1 = Str1, + + Depth = 10, + FormatOpts2 = #{depth=>Depth}, + Str2 = flatten_format_log(Report, FormatOpts2), + L2 = length(Str2), + Expected2 = "** State machine " ++ NameStr ++ " terminating\n" + "** When server state = [1,2,3,4,5,6,7,8,9|...]\n" + "** Reason for termination = " + "error:{bad_reply_action_from_state_function,[]}\n" + "** Callback mode = state_functions\n", + ct:log("Str2: ~ts", [Str2]), + ct:log("length(Str2): ~p", [L2]), + true = Expected2 =:= Str2, + + FormatOpts3 = #{chars_limit=>200}, + Str3 = flatten_format_log(Report, FormatOpts3), + L3 = length(Str3), + Expected3 = "** State machine " ++ NameStr ++ " terminating\n" + "** When server state = [", + ct:log("Str3: ~ts", [Str3]), + ct:log("length(Str3): ~p", [L3]), + true = lists:prefix(Expected3, Str3), + true = L3 < L1, + + FormatOpts4 = #{single_line=>true}, + Str4 = flatten_format_log(Report, FormatOpts4), + L4 = length(Str4), + Expected4 = "State machine " ++ NameStr ++ " terminating. " + "Reason: {bad_reply_action_from_state_function,[]}. " + "State: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15].", + ct:log("Str4: ~ts", [Str4]), + ct:log("length(Str4): ~p", [L4]), + Expected4 = Str4, + + FormatOpts5 = #{single_line=>true, depth=>Depth}, + Str5 = flatten_format_log(Report, FormatOpts5), + L5 = length(Str5), + Expected5 = "State machine " ++ NameStr ++ " terminating. " + "Reason: {bad_reply_action_from_state_function,[]}. " + "State: [1,2,3,4,5,6,7,8,9|...].", + ct:log("Str5: ~ts", [Str5]), + ct:log("length(Str5): ~p", [L5]), + Expected5 = Str5, + + FormatOpts6 = #{single_line=>true, chars_limit=>100}, + Str6 = flatten_format_log(Report, FormatOpts6), + L6 = length(Str6), + Expected6 = "State machine " ++ NameStr ++ " terminating. " + "Reason: ", + ct:log("Str6: ~ts", [Str6]), + ct:log("length(Str6): ~p", [L6]), + true = lists:prefix(Expected6, Str6), + true = L6 < L4, + + case FD of + undefined -> + application:unset_env(kernel, error_logger_format_depth); + _ -> + application:set_env(kernel, error_logger_format_depth, FD) + end, + ok. + +format_log_2_elaborate() -> + FD = application:get_env(kernel, error_logger_format_depth), + application:unset_env(kernel, error_logger_format_depth), + + Term = lists:seq(1,15), + Name = self(), + NameStr = pid_to_list(Name), + Reason = {bad_reply_action_from_state_function,[]}, + Report = elaborate_report(Name, Term, Reason), + FormatOpts1 = #{}, + Str1 = flatten_format_log(Report, FormatOpts1), + L1 = length(Str1), + Expected1 = "** State machine " ++ NameStr ++ " terminating\n" + "** Last event = [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n", + ct:log("Str1: ~ts", [Str1]), + ct:log("length(Str1): ~p", [L1]), + true = lists:prefix(Expected1, Str1), + + Depth = 10, + FormatOpts2 = #{depth=>Depth}, + Str2 = flatten_format_log(Report, FormatOpts2), + L2 = length(Str2), + Expected2 = "** State machine " ++ NameStr ++ " terminating\n" + "** Last event = [1,2,3,4,5,6,7,8,9|...]\n" + "** When server state = [1,2,3,4,5,6,7,8,9|...]\n" + "** Reason for termination = " + "error:{bad_reply_action_from_state_function,[]}\n" + "** Callback mode = [state_functions,state_enter]\n" + "** Queued = [[1,2,3,4,5,6,7,8|...]]\n" + "** Postponed = [{internal,[1,2,3,4,5,6|...]}]\n" + "** Stacktrace =\n" + "** [{m,f,1,[1,2,3,4|...]}]\n" + "** Time-outs: {1,[{timeout,message}]}\n" + "** Log =\n" + "** [[1,2,3,4,5,6,7,8|...]]\n" + "** Client "++NameStr ++ " stacktrace\n" + "** []\n", + ct:log("Str2: ~ts", [Str2]), + ct:log("length(Str2): ~p", [L2]), + Expected2 = Str2, + + FormatOpts3 = #{chars_limit=>300}, + Str3 = flatten_format_log(Report, FormatOpts3), + L3 = length(Str3), + Expected3 = "** State machine " ++ NameStr ++ " terminating\n" + "** Last event = ", + ct:log("Str3: ~ts", [Str3]), + ct:log("length(Str3): ~p", [L3]), + true = lists:prefix(Expected3, Str3), + true = L3 < L1, + + FormatOpts4 = #{single_line=>true}, + Str4 = flatten_format_log(Report, FormatOpts4), + L4 = length(Str4), + Expected4 = "State machine " ++ NameStr ++ " terminating. " + "Reason: {bad_reply_action_from_state_function,[]}. " + "Stack: [{m,f,1,[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]}]. " + "Last event: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]. " + "State: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]. " + "Log: [[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]. " + "Client " ++ NameStr ++ " stacktrace: [].", + ct:log("Str4: ~ts", [Str4]), + ct:log("length(Str4): ~p", [L4]), + Expected4 = Str4, + + FormatOpts5 = #{single_line=>true, depth=>Depth}, + Str5 = flatten_format_log(Report, FormatOpts5), + L5 = length(Str5), + Expected5 = "State machine " ++ NameStr ++ " terminating. " + "Reason: {bad_reply_action_from_state_function,[]}. " + "Stack: [{m,f,1,[1,2,3,4|...]}]. " + "Last event: [1,2,3,4,5,6,7,8,9|...]. " + "State: [1,2,3,4,5,6,7,8,9|...]. " + "Log: [[1,2,3,4,5,6,7,8|...]]. " + "Client " ++ NameStr ++ " stacktrace: [].", + ct:log("Str5: ~ts", [Str5]), + ct:log("length(Str5): ~p", [L5]), + Expected5 = Str5, + + FormatOpts6 = #{single_line=>true, chars_limit=>300}, + Str6 = flatten_format_log(Report, FormatOpts6), + L6 = length(Str6), + Expected6 = "State machine " ++ NameStr ++ " terminating. " + "Reason:", + ct:log("Str6: ~ts", [Str6]), + ct:log("length(Str6): ~p", [L6]), + true = lists:prefix(Expected6, Str6), + true = L6 < L4, + + case FD of + undefined -> + application:unset_env(kernel, error_logger_format_depth); + _ -> + application:set_env(kernel, error_logger_format_depth, FD) + end, + ok. + +simple_report(Name, Term, Reason) -> + #{label=>{gen_statem,terminate}, + name=>Name, + queue=>[], + postponed=>[], + callback_mode=>state_functions, + state_enter=>false, + state=>Term, + timeouts=>{0,[]}, + log=>[], + reason=>{error,Reason,[]}, + client_info=>undefined}. + +elaborate_report(Name, Term, Reason) -> + #{label=>{gen_statem,terminate}, + name=>Name, + queue=>[Term,Term], + postponed=>[{internal,Term}], + callback_mode=>state_functions, + state_enter=>true, + state=>Term, + timeouts=>{1,[{timeout,message}]}, + log=>[Term], + reason=>{error,Reason,stacktrace()}, + client_info=>{self(),{self(),[]}}}. + +stacktrace() -> + [{m,f,1,lists:seq(1, 15)}]. + +flatten_format_log(Report, Format) -> + lists:flatten(gen_statem:format_log(Report, Format)). + %% %% Functionality check %% @@ -1862,7 +2217,17 @@ do_func_test(STM) -> wfor(yes), ok = do_disconnect(STM), ok = gen_statem:cast(STM, {'alive?',self()}), + P0 = gen_statem:send_request(STM, 'alive?'), + timeout = gen_statem:wait_response(P0, 0), wfor(yes), + {reply, yes} = gen_statem:wait_response(P0, infinity), + _ = flush(), + P1 = gen_statem:send_request(STM, 'alive?'), + receive Msg -> + no_reply = gen_statem:check_response(Msg, P0), + {reply, yes} = gen_statem:check_response(Msg, P1) + after 1000 -> exit(timeout) + end, ok. diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl index e497b2fb5d..df6958cfa9 100644 --- a/lib/stdlib/test/io_proto_SUITE.erl +++ b/lib/stdlib/test/io_proto_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2017. All Rights Reserved. +%% Copyright Ericsson AB 2009-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1568,10 +1568,6 @@ request({put_chars, Encoding, Chars}, State) -> request({put_chars, Encoding, Module, Function, Args}, State) -> {ok, ok, State#state{q=[{put_chars, Encoding, Module, Function, Args} | State#state.q ]}}; -request({put_chars,Chars}, State) -> - {ok, ok, State#state{q=[{put_chars, Chars} | State#state.q ]}}; -request({put_chars,M,F,As}, State) -> - {ok, ok, State#state{q=[{put_chars, M,F,As} | State#state.q ]}}; request({get_until, Encoding, Prompt, M, F, As}, State) -> {ok, convert(State#state.nxt, Encoding, State#state.mode), State#state{nxt = eof, q = [{get_until, Encoding, Prompt, M, F, As} | State#state.q]}}; request({get_chars, Encoding, Prompt, N}, State) -> @@ -1583,20 +1579,6 @@ request({get_line, Encoding, Prompt}, State) -> State#state{nxt = eof, q = [{get_line, Encoding, Prompt} | State#state.q]}}; -request({get_until, Prompt, M, F, As}, State) -> - {ok, convert(State#state.nxt, latin1, State#state.mode), - State#state{nxt = eof, - q = [{get_until, Prompt, M, F, As} | State#state.q]}}; -request({get_chars, Prompt, N}, State) -> - {ok, convert(State#state.nxt, latin1, State#state.mode), - State#state{nxt = eof, - q = [{get_chars, Prompt, N} | - State#state.q]}}; -request({get_line, Prompt}, State) -> - {ok, convert(State#state.nxt, latin1, State#state.mode), - State#state{nxt = eof, - q = [{get_line, Prompt} | - State#state.q]}}; request({get_geomentry,_}, State) -> {error, {error,enotsup}, State}; request({setopts, Opts}, State) when Opts =:= [{binary, false}]; Opts =:= [list] -> diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl index 6f3cd8bf1b..0ad6989cbb 100644 --- a/lib/stdlib/test/maps_SUITE.erl +++ b/lib/stdlib/test/maps_SUITE.erl @@ -30,7 +30,7 @@ -export([t_update_with_3/1, t_update_with_4/1, t_get_3/1, t_filter_2/1, t_fold_3/1,t_map_2/1,t_size_1/1, - t_iterator_1/1, + t_iterator_1/1, t_put_opt/1, t_merge_opt/1, t_with_2/1,t_without_2/1]). %%-define(badmap(V,F,Args), {'EXIT', {{badmap,V}, [{maps,F,Args,_}|_]}}). @@ -48,7 +48,7 @@ all() -> [t_update_with_3,t_update_with_4, t_get_3,t_filter_2, t_fold_3,t_map_2,t_size_1, - t_iterator_1, + t_iterator_1,t_put_opt,t_merge_opt, t_with_2,t_without_2]. t_update_with_3(Config) when is_list(Config) -> @@ -204,6 +204,28 @@ iter_kv(I) -> [{K,V} | iter_kv(NI)] end. +t_put_opt(Config) when is_list(Config) -> + Value = id(#{complex => map}), + Map = id(#{a => Value}), + true = erts_debug:same(maps:put(a, Value, Map), Map), + ok. + +t_merge_opt(Config) when is_list(Config) -> + Small = id(#{a => 1}), + true = erts_debug:same(maps:merge(#{}, Small), Small), + true = erts_debug:same(maps:merge(Small, #{}), Small), + true = erts_debug:same(maps:merge(Small, Small), Small), + + Large = maps:from_list([{I,I}||I<-lists:seq(1,200)]), + true = erts_debug:same(maps:merge(#{}, Large), Large), + true = erts_debug:same(maps:merge(Large, #{}), Large), + true = erts_debug:same(maps:merge(Large, Large), Large), + + List = id([a|b]), + ?badmap([a|b],merge,[[a|b],[a|b]]) = (catch maps:merge(List, List)), + + ok. + t_size_1(Config) when is_list(Config) -> 0 = maps:size(#{}), 10 = maps:size(maps:from_list([{{"k",I},I}||I<-lists:seq(1,10)])), @@ -215,8 +237,11 @@ t_size_1(Config) when is_list(Config) -> 600 = maps:size(maps:from_list([{{"k",I},I}||I<-lists:seq(1,600)])), %% error case - ?badmap(a,size,[a]) = (catch maps:size(id(a))), - ?badmap(<<>>,size,[<<>>]) = (catch maps:size(id(<<>>))), + %% + %% Note that the stack trace is ignored because the compiler may have + %% rewritten maps:size/2 to map_size. + {'EXIT', {{badmap,a}, _}} = (catch maps:size(id(a))), + {'EXIT', {{badmap,<<>>}, _}} = (catch maps:size(id(<<>>))), ok. id(I) -> I. diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl index 127b1317e4..b3673efb5a 100644 --- a/lib/stdlib/test/proc_lib_SUITE.erl +++ b/lib/stdlib/test/proc_lib_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -27,8 +27,12 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, crash/1, stacktrace/1, sync_start_nolink/1, sync_start_link/1, - spawn_opt/1, sp1/0, sp2/0, sp3/1, sp4/2, sp5/1, '\x{447}'/0, - hibernate/1, stop/1, t_format/1, t_format_arbitrary/1]). + sync_start_monitor/1, sync_start_monitor_link/1, + sync_start_timeout/1, sync_start_link_timeout/1, + sync_start_monitor_link_timeout/1, + spawn_opt/1, sp1/0, sp2/0, sp3/1, sp4/2, sp5/1, sp6/1, sp7/1, + sp8/1, sp9/1, sp10/1, + '\x{447}'/0, hibernate/1, stop/1, t_format/1, t_format_arbitrary/1]). -export([ otp_6345/1, init_dont_hang/1]). -export([hib_loop/1, awaken/1]). @@ -39,6 +43,8 @@ -export([otp_6345_init/1, init_dont_hang_init/1]). +-export([report_cb/1, report_cb_chars_limit/1, log/2, rcb_tester/0]). + -export([system_terminate/4]). -ifdef(STANDALONE). @@ -51,11 +57,14 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [crash, stacktrace, {group, sync_start}, spawn_opt, hibernate, - {group, tickets}, stop, t_format, t_format_arbitrary]. + {group, tickets}, stop, t_format, t_format_arbitrary, report_cb]. groups() -> [{tickets, [], [otp_6345, init_dont_hang]}, - {sync_start, [], [sync_start_nolink, sync_start_link]}]. + {sync_start, [], [sync_start_nolink, sync_start_link, + sync_start_monitor, sync_start_monitor_link, + sync_start_timeout, sync_start_link_timeout, + sync_start_monitor_link_timeout]}]. init_per_suite(Config) -> Config. @@ -275,6 +284,84 @@ sync_start_link(Config) when is_list(Config) -> end, ok. +sync_start_monitor(Config) when is_list(Config) -> + _Pid = spawn_link(?MODULE, sp6, [self()]), + receive + {sync_started, _} -> ct:fail(async_start) + after 1000 -> ok + end, + receive + {Pid2, init} -> + Pid2 ! go_on + end, + receive + {sync_started, _} -> ok + after 1000 -> ct:fail(no_sync_start) + end, + receive received_down -> ok + after 2000 -> ct:fail(no_down) + end, + ok. + +sync_start_monitor_link(Config) when is_list(Config) -> + _Pid = spawn_link(?MODULE, sp7, [self()]), + receive + {sync_started, _} -> ct:fail(async_start) + after 1000 -> ok + end, + receive + {Pid2, init} -> + Pid2 ! go_on + end, + receive + {sync_started, _} -> ok + after 1000 -> ct:fail(no_sync_start) + end, + receive received_down -> ok + after 1000 -> ct:fail(no_down) + end, + receive received_exit -> ok + after 1000 -> ct:fail(no_exit) + end, + ok. + +sync_start_timeout(Config) when is_list(Config) -> + _Pid = spawn_link(?MODULE, sp8, [self()]), + receive done -> ok end, + receive {received_exit, _} = M1 -> ct:fail(M1) + after 0 -> ok + end, + receive {received_down, _} = M2 -> ct:fail(M2) + after 0 -> ok + end, + ok. + +sync_start_link_timeout(Config) when is_list(Config) -> + _Pid = spawn_link(?MODULE, sp9, [self()]), + receive done -> ok end, + receive {received_exit, _} = M1 -> ct:fail(M1) + after 0 -> ok + end, + receive {received_down, _} = M2 -> ct:fail(M2) + after 0 -> ok + end, + ok. + +sync_start_monitor_link_timeout(Config) when is_list(Config) -> + _Pid = spawn_link(?MODULE, sp10, [self()]), + receive done -> ok end, + receive {received_exit, _} = M1 -> ct:fail(M1) + after 0 -> ok + end, + receive + {received_down, R} -> + killed = R, + ok + after 0 -> ct:fail(no_down) + end, + ok. + + spawn_opt(Config) when is_list(Config) -> F = fun sp1/0, {name,Fname} = erlang:fun_info(F, name), @@ -313,6 +400,89 @@ sp5(Tester) -> Pid = proc_lib:start(?MODULE, sp4, [self(), Tester]), Tester ! {sync_started, Pid}. +sp6(Tester) -> + process_flag(trap_exit, true), + {Pid, Mon} = proc_lib:start_monitor(?MODULE, sp4, [self(), Tester]), + Tester ! {sync_started, Pid}, + receive + {'EXIT', Pid, normal} -> + exit(received_exit) + after 1000 -> + ok + end, + receive + {'DOWN', Mon, process, Pid, normal} -> + Tester ! received_down + end. + +sp7(Tester) -> + process_flag(trap_exit, true), + {Pid, Mon} = proc_lib:start_monitor(?MODULE, sp4, [self(), Tester], infinity, [link]), + Tester ! {sync_started, Pid}, + receive + {'EXIT', Pid, normal} -> + Tester ! received_exit + end, + receive + {'DOWN', Mon, process, Pid, normal} -> + Tester ! received_down + end. + +sp8(Tester) -> + process_flag(trap_exit, true), + {error,timeout} = proc_lib:start(?MODULE, sp4, [self(), Tester], 500, [link]), + receive after 500 -> ok end, + receive + {'EXIT', _Pid1, Reason1} -> + Tester ! {received_exit, Reason1} + after 0 -> + ok + end, + receive + {'DOWN', _Mon2, process, _Pid2, Reason2} -> + Tester ! {received_down, Reason2} + after 0 -> + ok + end, + Tester ! done. + +sp9(Tester) -> + process_flag(trap_exit, true), + {error,timeout} = proc_lib:start_link(?MODULE, sp4, [self(), Tester], 500), + receive after 500 -> ok end, + receive + {'EXIT', _Pid1, Reason1} -> + Tester ! {received_exit, Reason1} + after 0 -> + ok + end, + receive + {'DOWN', _Mon, process, _Pid2, Reason2} -> + Tester ! {received_down, Reason2} + after 0 -> + ok + end, + Tester ! done. + + +sp10(Tester) -> + process_flag(trap_exit, true), + {{error,timeout}, Mon} = proc_lib:start_monitor(?MODULE, sp4, [self(), Tester], 500, [link]), + receive after 500 -> ok end, + receive + {'EXIT', _Pid1, Reason1} -> + Tester ! {received_exit, Reason1} + after 0 -> + ok + end, + receive + {'DOWN', Mon, process, _Pid2, Reason2} -> + Tester ! {received_down, Reason2} + after 0 -> + ok + end, + Tester ! done. + sp4(Parent, Tester) -> Tester ! {self(), init}, receive @@ -421,10 +591,12 @@ hib_receive_messages(N) -> %% 'monitor' spawn_opt option. otp_6345(Config) when is_list(Config) -> Opts = [link,monitor], - {'EXIT', {badarg,[{proc_lib,check_for_monitor,_,_}|_Stack]}} = - (catch proc_lib:start(?MODULE, otp_6345_init, [self()], - 1000, Opts)), - ok. + try + blupp = proc_lib:start(?MODULE, otp_6345_init, [self()], + 1000, Opts) + catch + error:badarg -> ok + end. otp_6345_init(Parent) -> proc_lib:init_ack(Parent, {ok, self()}), @@ -628,6 +800,180 @@ do_test_format(Report, Encoding, Depth) -> '\x{aaa}t_format_looper'() end. +%% Test report callback for any Logger handler +report_cb(_Config) -> + ok = logger:add_handler(?MODULE,?MODULE,#{config=>self()}), + Pid = proc_lib:spawn(?MODULE, sp2, []), + ct:sleep(100), + {links,[NPid]} = process_info(Pid,links), + NPidStr = pid_to_list(NPid), + Pid ! die, + Report = + receive + {report,R} -> + R + after 5000 -> + ct:fail(no_report_received) + end, + + Str1 = flatten_report_cb(Report,#{}), + L1 = length(Str1), + Expected1 = " crasher:\n initial call: proc_lib_SUITE:sp2/0\n", + ct:log("Str1: ~p",[Str1]), + ct:log("length(Str1): ~p",[L1]), + true = lists:prefix(Expected1,Str1), + + FormatOpts1 = #{}, + Str1 = flatten_report_cb(Report,FormatOpts1), + L1 = length(Str1), + Expected1 = " crasher:\n initial call: proc_lib_SUITE:sp2/0\n", + ct:log("Str1: ~p",[Str1]), + ct:log("length(Str1): ~p",[L1]), + true = lists:prefix(Expected1,Str1), + + Depth = 10, + FormatOpts2 = #{depth=>Depth}, + Str2 = flatten_report_cb(Report,FormatOpts2), + L2 = length(Str2), + Expected2 = " crasher:\n initial call: proc_lib_SUITE:sp2/0\n", + ct:log("Str2: ~p",[Str2]), + ct:log("length(Str2): ~p",[L2]), + true = lists:prefix(Expected2,Str2), + true = L2<L1, + + FormatOpts3 = #{chars_limit=>500}, + Str3 = flatten_report_cb(Report,FormatOpts3), + L3 = length(Str3), + Expected3 = " crasher:\n initial call: proc_lib_SUITE:sp2/0\n", + ct:log("Str3: ~p",[Str3]), + ct:log("length(Str3): ~p",[L3]), + true = lists:prefix(Expected3,Str3), + true = L3<L1, + + FormatOpts4 = #{single_line=>true}, + Str4 = flatten_report_cb(Report,FormatOpts4), + L4 = length(Str4), + Expected4 = "crasher: initial call: proc_lib_SUITE:sp2/0,", + ct:log("Str4: ~p",[Str4]), + ct:log("length(Str4): ~p",[L4]), + true = lists:prefix(Expected4,Str4), + true = L4<L1, + + FormatOpts5 = #{single_line=>true, depth=>Depth}, + Str5 = flatten_report_cb(Report,FormatOpts5), + L5 = length(Str5), + Expected5 = "crasher: initial call: proc_lib_SUITE:sp2/0,", + ct:log("Str5: ~p",[Str5]), + ct:log("length(Str5): ~p",[L5]), + true = lists:prefix(Expected5,Str5), + true = L5<L4, + %% Check that neighbour information is printed + SplitFun = fun($;) -> false; (_) -> true end, + ExpectedNeighbours5 = "; neighbours: neighbour: pid: "++NPidStr++ + ", registered_name: []", + true = lists:prefix(ExpectedNeighbours5,lists:dropwhile(SplitFun, Str5)), + + FormatOpts6 = #{single_line=>true, chars_limit=>500}, + Str6 = flatten_report_cb(Report,FormatOpts6), + L6 = length(Str6), + Expected6 = "crasher: initial call: proc_lib_SUITE:sp2/0,", + ct:log("Str6: ~p",[Str6]), + ct:log("length(Str6): ~p",[L6]), + true = lists:prefix(Expected6,Str6), + true = L6<L4, + %% Check that only pid is printed for neighbour, due to chars_limit + ExpectedNeighbours6 = "; neighbours: ["++NPidStr++"]", + ExpectedNeighbours6 = lists:dropwhile(SplitFun, Str6), + + ok = logger:remove_handler(?MODULE), + ok. + +report_cb_chars_limit(_Config) -> + %% This test does not really test anything, it just formats the + %% crash reports with different settings and prints the result. It + %% could be used as an example if report_cb was to be modified + %% for better utilization of the available number of characters + %% according to the chars_limit setting. + %% + %% Currently, multi-line formatting with chars_limit=1024 gives + %% a final report of 1696 character. The excess is due to the fact + %% that io_lib_pretty counts non-white characters--the indentation + %% of the formatted exception is not counted. + %% + %% Single-line formatting with chars_limit=1024 gives a final + %% report of 1104 characters. + %% + %% Single-line formatting a fake report with chars_limit=1024 gives + %% a final report of 1024 characters. + + ok = logger:add_handler(?MODULE,?MODULE,#{config=>self()}), + Pid = proc_lib:spawn(?MODULE, rcb_tester, []), + ct:sleep(500), + Pid ! die, + Report = + receive + {report,R} -> + R + after 5000 -> + ct:fail(no_report_received) + end, + + ct:sleep(500), % To separate debug calls to erlang:display(), if any. + Str1 = flatten_report_cb(Report,#{}), + L1 = length(Str1), + ct:log("Multi-line, no size limit:~n~s",[Str1]), + ct:log("Length, multi-line, no size limit: ~p",[L1]), + + ct:sleep(500), + FormatOpts2 = #{chars_limit=>1024}, + Str2 = flatten_report_cb(Report,FormatOpts2), + L2 = length(Str2), + ct:log("Multi-line, chars_limit=1024:~n~s",[Str2]), + ct:log("Length, multi-line, chars_limit=1024: ~p",[L2]), + + ct:sleep(500), + FormatOpts3 = #{single_line=>true, chars_limit=>1024}, + Str3 = flatten_report_cb(Report,FormatOpts3), + L3 = length(Str3), + ct:log("Single-line, chars_limit=1024:~n~s",[Str3]), + ct:log("Length, single-line, chars_limit=1024: ~p",[L3]), + + ct:sleep(500), + Seq = lists:seq(1, 1000), + FakeReport = [[{fake_tag,Seq}],Seq], + FReport = #{label=>{proc_lib,crash}, report=>FakeReport}, + Str4 = flatten_report_cb(FReport,FormatOpts3), + L4 = length(Str4), + ct:log("Fake: Single-line, chars_limit=1024:~n~s",[Str4]), + ct:log("Fake: Length, single-line, chars_limit=1024: ~p",[L4]), + + ok = logger:remove_handler(?MODULE), + ok. + +rcb_tester() -> + L = lists:seq(1,255), + Term = [{some_data,#{pids=>processes(), + info=>process_info(self())}}, + {tabs,lists:sort(ets:all())}, + {bin,list_to_binary(L)}, + {list,L}], + + %% Put something in process dictionary + [put(K,V) ||{K,V} <- Term], + + %% Add some messages + [self() ! {some_message,T} || T <- Term], + + %% Create some neighbours + [_ = proc_lib:spawn_link(?MODULE,sp1,[]) || _ <- lists:seq(1,5)], + + receive + die -> error({badmatch,Term}) + end. + +flatten_report_cb(Report, Format) -> + lists:flatten(proc_lib:report_cb(Report, Format)). + %%----------------------------------------------------------------- %% The error_logger handler used. %%----------------------------------------------------------------- @@ -648,3 +994,11 @@ handle_call(_Query, State) -> {ok, {error, bad_query}, State}. terminate(_Reason, State) -> State. + +%%----------------------------------------------------------------- +%% The Logger handler used. +%%----------------------------------------------------------------- +log(#{msg:={report,Report}},#{config:=Pid}) -> + Pid ! {report,Report}; +log(_,_) -> + ok. diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index cdb6031b07..0f42e4632f 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -601,7 +601,7 @@ otp_5327(Config) when is_list(Config) -> comm_err(<<"<<103133:64/binary>> = <<103133:64/float>>.">>), "exception error: interpreted function with arity 1 called with two arguments" = comm_err(<<"(fun(X) -> X end)(a,b).">>), - {'EXIT', {{illegal_pattern,_}, _}} = + {'EXIT', {{badmatch,<<17:32>>}, _}} = (catch evaluate("<<A:a>> = <<17:32>>.", [])), C = <<" <<A:4,B:4,C:4,D:4,E:4,F:4>> = <<\"hej\">>, @@ -614,6 +614,9 @@ otp_5327(Config) when is_list(Config) -> %% unbound_var would be nicer... {'EXIT',{{illegal_pattern,_},_}} = (catch evaluate(<<"<<A:B>> = <<17:32>>.">>, [])), + %% A badarith exception is turned into badmatch. + {'EXIT', {{badmatch,<<1777:32>>}, _}} = + (catch evaluate(<<"<<A:(1/0)>> = <<1777:32>>.">>, [])), %% undefined_bittype is turned into badmatch: {'EXIT',{{badmatch,<<17:32>>},_}} = (catch evaluate(<<"<<A/apa>> = <<17:32>>.">>, [])), @@ -2941,7 +2944,7 @@ otp_14296(Config) when is_list(Config) -> end(), fun() -> - Port = open_port({spawn, "ls"}, [{line,1}]), + Port = open_port({spawn, "erl"}, [{line,1}]), KnownPort = erlang:port_to_list(Port), S = KnownPort ++ ".", R = KnownPort ++ ".\n", @@ -3141,25 +3144,16 @@ io_request({get_geometry,columns}, S) -> {ok,80,S}; io_request({get_geometry,rows}, S) -> {ok,24,S}; -io_request({put_chars,Chars}, S) -> - {ok,ok,S#state{reply = [S#state.reply | Chars]}}; io_request({put_chars,latin1,Chars}, S) -> {ok,ok,S#state{reply = [S#state.reply | Chars]}}; io_request({put_chars,unicode,Chars0}, S) -> Chars = unicode:characters_to_list(Chars0), {ok,ok,S#state{reply = [S#state.reply | Chars]}}; -io_request({put_chars,Mod,Func,Args}, S) -> - case catch apply(Mod, Func, Args) of - Chars when is_list(Chars) -> - io_request({put_chars,Chars}, S) - end; io_request({put_chars,Enc,Mod,Func,Args}, S) -> case catch apply(Mod, Func, Args) of Chars when is_list(Chars) -> io_request({put_chars,Enc,Chars}, S) end; -io_request({get_until,_Prompt,Mod,Func,ExtraArgs}, S) -> - get_until(Mod, Func, ExtraArgs, S, latin1); io_request({get_until,Enc,_Prompt,Mod,Func,ExtraArgs}, S) -> get_until(Mod, Func, ExtraArgs, S, Enc). diff --git a/lib/stdlib/test/shell_docs_SUITE.erl b/lib/stdlib/test/shell_docs_SUITE.erl new file mode 100644 index 0000000000..69cca467d0 --- /dev/null +++ b/lib/stdlib/test/shell_docs_SUITE.erl @@ -0,0 +1,88 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(shell_docs_SUITE). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). +-export([init_per_testcase/2, end_per_testcase/2]). + +-export([render/1]). + +-include_lib("kernel/include/eep48.hrl"). + +init_per_testcase(_Case, Config) -> + Config. + +end_per_testcase(_Case, Config) -> + ok. + +suite() -> + [{timetrap,{minutes,10}}]. + +all() -> + [render]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +render(_Config) -> + Avail = code:all_available(), + [render_test(Mod) || {Mod,_,_} <- Avail], + ok. +render_test(Mod) when is_list(Mod) -> + render_test(list_to_atom(Mod)); +render_test(Mod) -> + try + case code:get_doc(Mod) of + {error,missing} -> + ok; + {ok, #docs_v1{ docs = Docs } = D} -> + shell_docs:render(Mod, D), + shell_docs:render_type(Mod, D), + [try + shell_docs:render(Mod, F, A, D) + catch _E:R:ST -> + io:format("Failed to render ~p:~p/~p~n~p:~p~n~p~n", + [Mod,F,A,R,ST,shell_docs:get_doc(Mod,F,A)]), + erlang:raise(error,R,ST) + end || {F,A} <- Mod:module_info(exports)], + [try + shell_docs:render_type(Mod, T, A, D) + catch _E:R:ST -> + io:format("Failed to render type ~p:~p/~p~n~p:~p~n~p~n", + [Mod,T,A,R,ST,shell_docs:get_type_doc(Mod,T,A)]), + erlang:raise(error,R,ST) + end || {{type,T,A},_,_,_,_} <- Docs] + end + catch throw:R:ST -> + io:format("Failed to render ~p~n~p:~p~n",[Mod,R,ST]), + exit(R) + end. diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl index 0b7510c305..5bbd16d1f4 100644 --- a/lib/stdlib/test/stdlib_SUITE.erl +++ b/lib/stdlib/test/stdlib_SUITE.erl @@ -27,6 +27,8 @@ init_per_testcase/2, end_per_testcase/2, app_test/1, appup_test/1, assert_test/1]). +-compile(r21). + suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> @@ -95,7 +97,7 @@ appup_tests(App,{OkVsns0,NokVsns}) -> create_test_vsns(App) -> ThisMajor = erlang:system_info(otp_release), FirstMajor = previous_major(ThisMajor), - SecondMajor = previous_major(FirstMajor), + SecondMajor = previous_major(previous_major(FirstMajor)), Ok = app_vsn(App,[ThisMajor,FirstMajor]), Nok0 = app_vsn(App,[SecondMajor]), Nok = case Ok of diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index c9aadd7f10..4475d7c06e 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -1111,12 +1111,22 @@ needs_check(_) -> true. %%%% Timer stuff time_func(Fun, Mode, Bin, Repeat) -> - timer:sleep(100), %% Let emulator catch up and clean things before test runs + %% Let emulator catch up and clean things before test runs + timer:sleep(100), + + %% We're spawning with a minimum heap size of 1k because certain benchmarks + %% (e.g. string_lexemes_binary) keep very little heap data alive, making + %% them very sensitive to changes in GC behavior. + %% + %% If we don't do this, something as benign as shrinking a stack frame can + %% make things run slower by making it stick to a smaller heap size, + %% causing it to GC more often. Self = self(), - Pid = spawn_link(fun() -> - Str = mode(Mode, Bin), - Self ! {self(),time_func(0,0,0, Fun, Str, undefined, Repeat)} - end), + Pid = spawn_opt(fun() -> + Str = mode(Mode, Bin), + Res = time_func(0,0,0, Fun, Str, undefined, Repeat), + Self ! {self(), Res} + end, [link, {min_heap_size, 1 bsl 10}]), receive {Pid,Msg} -> Msg end. time_func(N,Sum,SumSq, Fun, Str, _, Repeat) when N < Repeat -> diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 36751c641b..b21cc9c6e0 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -77,7 +77,8 @@ hanging_restart_loop_rest_for_one/1, hanging_restart_loop_simple/1, code_change/1, code_change_map/1, code_change_simple/1, code_change_simple_map/1, - order_of_children/1, scale_start_stop_many_children/1]). + order_of_children/1, scale_start_stop_many_children/1, + format_log_1/1, format_log_2/1]). %%------------------------------------------------------------------------- @@ -104,7 +105,8 @@ all() -> simple_global_supervisor, hanging_restart_loop, hanging_restart_loop_rest_for_one, hanging_restart_loop_simple, code_change, code_change_map, code_change_simple, code_change_simple_map, - order_of_children, scale_start_stop_many_children]. + order_of_children, scale_start_stop_many_children, + format_log_1, format_log_2]. groups() -> [{sup_start, [], @@ -2398,6 +2400,249 @@ scale_start_stop_many_children() -> ok. +%% Test report callback for Logger handler error_logger +format_log_1(_Config) -> + FD = application:get_env(kernel, error_logger_format_depth), + application:unset_env(kernel, error_logger_format_depth), + Term = lists:seq(1, 15), + Supervisor = my_supervisor, + Name = self(), + Error = shutdown_error, + Child = [{pid,Name},{id,any_id}, + {mfargs,{mod,func,[any,Term]}}, + {restart_type,temporary}, + {shutdown,brutal_kill}, + {child_type,worker}], + Report = #{label=>{supervisor,Error}, + report=>[{supervisor,Supervisor}, + {errorContext,Error}, + {reason,Term}, + {offender,Child}]}, + {F1, A1} = supervisor:format_log(Report), + FExpected1 = " supervisor: ~tp~n" + " errorContext: ~tp~n" + " reason: ~tp~n" + " offender: ~tp~n", + ct:log("F1: ~ts~nA1: ~tp", [F1,A1]), + FExpected1 = F1, + [Supervisor,Error,Term,Child] = A1, + + Progress = #{label=>{supervisor,progress}, + report=>[{supervisor,Supervisor},{started,Child}]}, + {PF1,PA1} = supervisor:format_log(Progress), + PFExpected1 = " supervisor: ~tp~n started: ~tp~n", + ct:log("PF1: ~ts~nPA1: ~tp", [PF1,PA1]), + PFExpected1 = PF1, + [Supervisor,Child] = PA1, + + Depth = 10, + ok = application:set_env(kernel, error_logger_format_depth, Depth), + Limited = [1,2,3,4,5,6,7,8,9,'...'], + {F2,A2} = supervisor:format_log(Report), + FExpected2 = " supervisor: ~tP~n" + " errorContext: ~tP~n" + " reason: ~tP~n" + " offender: ~tP~n", + ct:log("F2: ~ts~nA2: ~tp", [F2,A2]), + FExpected2 = F2, + Limited = [1,2,3,4,5,6,7,8,9,'...'], + LimitedChild = [{pid,Name},{id,any_id}, + {mfargs,{mod,func,[any,'...']}}, + {restart_type,temporary}, + {shutdown,brutal_kill}, + {child_type,worker}], + + [Supervisor,Depth,Error,Depth,Limited,Depth,LimitedChild,Depth] = A2, + + {PF2,PA2} = supervisor:format_log(Progress), + PFExpected2 = " supervisor: ~tP~n started: ~tP~n", + ct:log("PF2: ~ts~nPA2: ~tp", [PF2,PA2]), + PFExpected2 = PF2, + [Supervisor,Depth,LimitedChild,Depth] = PA2, + + case FD of + undefined -> + application:unset_env(kernel, error_logger_format_depth); + _ -> + application:set_env(kernel, error_logger_format_depth, FD) + end, + ok. + +%% Test report callback for any Logger handler +format_log_2(_Config) -> + Term = lists:seq(1, 15), + Supervisor = my_supervisor, + Name = self(), + NameStr = pid_to_list(Name), + Error = shutdown_error, + Child = [{pid,Name},{id,any_id}, + {mfargs,{mod,func,[Term]}}, + {restart_type,temporary}, + {shutdown,brutal_kill}, + {child_type,worker}], + Report = #{label=>{supervisor,Error}, + report=>[{supervisor,Supervisor}, + {errorContext,Error}, + {reason,Term}, + {offender,Child}]}, + FormatOpts1 = #{}, + Str1 = flatten_format_log(Report, FormatOpts1), + L1 = length(Str1), + Expected1 = " supervisor: my_supervisor\n" + " errorContext: shutdown_error\n" + " reason: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n" + " offender: [{pid,"++NameStr++"},\n" + " {id,any_id},\n" + " {mfargs,{mod,func," + "[[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]}},\n" + " {restart_type,temporary},\n" + " {shutdown,brutal_kill},\n" + " {child_type,worker}]\n", + ct:log("Str1: ~ts", [Str1]), + ct:log("length(Str1): ~p", [L1]), + true = Expected1 =:= Str1, + + Progress = #{label=>{supervisor,progress}, + report=>[{supervisor,Supervisor},{started,Child}]}, + PStr1 = flatten_format_log(Progress, FormatOpts1), + PL1 = length(PStr1), + PExpected1 = " supervisor: my_supervisor\n" + " started: [{pid,"++NameStr++"},\n" + " {id,any_id},\n" + " {mfargs,{mod,func," + "[[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]}},\n" + " {restart_type,temporary},\n" + " {shutdown,brutal_kill},\n" + " {child_type,worker}]\n", + ct:log("PStr1: ~ts", [PStr1]), + ct:log("length(PStr1): ~p", [PL1]), + true = PExpected1 =:= PStr1, + + Depth = 10, + FormatOpts2 = #{depth=>Depth}, + Str2 = flatten_format_log(Report, FormatOpts2), + L2 = length(Str2), + Expected2 = " supervisor: my_supervisor\n" + " errorContext: shutdown_error\n" + " reason: [1,2,3,4,5,6,7,8,9|...]\n" + " offender: [{pid,"++NameStr++"},\n" + " {id,any_id},\n" + " {mfargs,{mod,func,[[...]]}},\n" + " {restart_type,temporary},\n" + " {shutdown,brutal_kill},\n" + " {child_type,worker}]\n", + ct:log("Str2: ~ts", [Str2]), + ct:log("length(Str2): ~p", [L2]), + true = Expected2 =:= Str2, + + PStr2 = flatten_format_log(Progress, FormatOpts2), + PL2 = length(PStr2), + PExpected2 = " supervisor: my_supervisor\n" + " started: [{pid,"++NameStr++"},\n" + " {id,any_id},\n" + " {mfargs,{mod,func,[[...]]}},\n" + " {restart_type,temporary},\n" + " {shutdown,brutal_kill},\n" + " {child_type,worker}]\n", + ct:log("PStr2: ~ts", [PStr2]), + ct:log("length(PStr2): ~p", [PL2]), + true = PExpected2 =:= PStr2, + + FormatOpts3 = #{chars_limit=>200}, + Str3 = flatten_format_log(Report, FormatOpts3), + L3 = length(Str3), + Expected3 = " supervisor: my_supervisor\n" + " errorContext: ", + ct:log("Str3: ~ts", [Str3]), + ct:log("length(Str3): ~p", [L3]), + true = lists:prefix(Expected3, Str3), + true = L3 < L1, + + PFormatOpts3 = #{chars_limit=>80}, + PStr3 = flatten_format_log(Progress, PFormatOpts3), + PL3 = length(PStr3), + PExpected3 = " supervisor: my_supervisor\n started:", + ct:log("PStr3: ~ts", [PStr3]), + ct:log("length(PStr3): ~p", [PL3]), + true = lists:prefix(PExpected3, PStr3), + true = PL3 < PL1, + + FormatOpts4 = #{single_line=>true}, + Str4 = flatten_format_log(Report, FormatOpts4), + L4 = length(Str4), + + Expected4 = "Supervisor: my_supervisor. Context: shutdown_error. " + "Reason: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]. " + "Offender: id=any_id,pid="++NameStr++".", + ct:log("Str4: ~ts", [Str4]), + ct:log("length(Str4): ~p", [L4]), + true = Expected4 =:= Str4, + + PStr4 = flatten_format_log(Progress, FormatOpts4), + PL4 = length(PStr4), + PExpected4 = "Supervisor: my_supervisor. " + "Started: id=any_id,pid="++NameStr++".", + ct:log("PStr4: ~ts", [PStr4]), + ct:log("length(PStr4): ~p", [PL4]), + true = PExpected4 =:= PStr4, + + FormatOpts5 = #{single_line=>true, depth=>Depth}, + Str5 = flatten_format_log(Report, FormatOpts5), + L5 = length(Str5), + Expected5 = "Supervisor: my_supervisor. Context: shutdown_error. " + "Reason: [1,2,3,4,5,6,7,8,9|...]. " + "Offender: id=any_id,pid="++NameStr++".", + ct:log("Str5: ~ts", [Str5]), + ct:log("length(Str5): ~p", [L5]), + true = Expected5 =:= Str5, + + PStr5 = flatten_format_log(Progress, FormatOpts5), + PL5 = length(PStr5), + PExpected5 = "Supervisor: my_supervisor. " + "Started: id=any_id,pid="++NameStr++".", + ct:log("PStr5: ~ts", [PStr5]), + ct:log("length(PStr5): ~p", [PL5]), + true = PExpected5 =:= PStr5, + + FormatOpts6 = #{single_line=>true, chars_limit=>200}, + Str6 = flatten_format_log(Report, FormatOpts6), + L6 = length(Str6), + Expected6 = "Supervisor: my_supervisor. Context:", + ct:log("Str6: ~ts", [Str6]), + ct:log("length(Str6): ~p", [L6]), + true = lists:prefix(Expected6, Str6), + true = L6 < L4, + + PFormatOpts6 = #{single_line=>true, chars_limit=>60}, + PStr6 = flatten_format_log(Progress, PFormatOpts6), + PL6 = length(PStr6), + PExpected6 = "Supervisor: my_supervisor.", + ct:log("PStr6: ~ts", [PStr6]), + ct:log("length(PStr6): ~p", [PL6]), + true = lists:prefix(PExpected6, PStr6), + true = PL6 < PL4, + + Child2 = [{nb_children,7},{id,any_id}, + {mfargs,{mod,func,[Term]}}, + {restart_type,temporary}, + {shutdown,brutal_kill}, + {child_type,worker}], + Report2 = #{label=>{supervisor,Error}, + report=>[{supervisor,Supervisor}, + {errorContext,Error}, + {reason,Term}, + {offender,Child2}]}, + Str7 = flatten_format_log(Report2, FormatOpts6), + L7 = length(Str7), + ct:log("Str7: ~ts", [Str7]), + ct:log("length(Str7): ~p", [L7]), + true = string:find(Str7, "Offender: id=any_id,nb_children=7.") =/= nomatch, + + ok. + +flatten_format_log(Report, Format) -> + lists:flatten(supervisor:format_log(Report, Format)). + %%------------------------------------------------------------------------- terminate(Pid, Reason) when Reason =/= supervisor -> terminate(dummy, Pid, dummy, Reason). diff --git a/lib/stdlib/test/supervisor_bridge_SUITE.erl b/lib/stdlib/test/supervisor_bridge_SUITE.erl index 279ae91cdc..60af37dd9a 100644 --- a/lib/stdlib/test/supervisor_bridge_SUITE.erl +++ b/lib/stdlib/test/supervisor_bridge_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,7 +21,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2,starting/1, mini_terminate/1,mini_die/1,badstart/1, - simple_global_supervisor/1]). + simple_global_supervisor/1, format_log_1/1, format_log_2/1]). -export([client/1,init/1,internal_loop_init/1,terminate/2,server9212/0]). -include_lib("common_test/include/ct.hrl"). @@ -35,7 +35,8 @@ suite() -> {timetrap,{minutes,1}}]. all() -> - [starting, mini_terminate, mini_die, badstart, simple_global_supervisor]. + [starting, mini_terminate, mini_die, badstart, simple_global_supervisor, + format_log_1, format_log_2]. groups() -> []. @@ -227,3 +228,202 @@ simple_global_supervisor(Config) when is_list(Config) -> server9212() -> supervisor_bridge:start_link({global,?bridge_name}, ?MODULE, 3). + +%% Test report callback for Logger handler error_logger +format_log_1(_Config) -> + FD = application:get_env(kernel, error_logger_format_depth), + application:unset_env(kernel, error_logger_format_depth), + Term = lists:seq(1, 15), + Supervisor = my_supervisor, + Name = self(), + Error = error, + Offender = [{pid,Name},{mod,a_module}], + Report = #{label=>{supervisor,Error}, + report=>[{supervisor,Supervisor}, + {errorContext,Error}, + {reason,Term}, + {offender,Offender}]}, + {F1, A1} = supervisor_bridge:format_log(Report), + FExpected1 = " supervisor: ~tp~n" + " errorContext: ~tp~n" + " reason: ~tp~n" + " offender: ~tp~n", + ct:log("F1: ~ts~nA1: ~tp", [F1,A1]), + FExpected1 = F1, + [Supervisor,Error,Term,Offender] = A1, + + Started = [{pid,Name},{mfa,{a_module,init,[Term]}}], + Progress = #{label=>{supervisor,progress}, + report=>[{supervisor,Supervisor},{started,Started}]}, + {PF1,PA1} = supervisor_bridge:format_log(Progress), + PFExpected1 = " supervisor: ~tp~n started: ~tp~n", + ct:log("PF1: ~ts~nPA1: ~tp", [PF1,PA1]), + PFExpected1 = PF1, + [Supervisor,Started] = PA1, + + Depth = 10, + ok = application:set_env(kernel, error_logger_format_depth, Depth), + Limited = [1,2,3,4,5,6,7,8,9,'...'], + {F2,A2} = supervisor_bridge:format_log(Report), + FExpected2 = " supervisor: ~tP~n" + " errorContext: ~tP~n" + " reason: ~tP~n" + " offender: ~tP~n", + ct:log("F2: ~ts~nA2: ~tp", [F2,A2]), + FExpected2 = F2, + LimitedOffender = Offender, + [Supervisor,Depth,Error,Depth,Limited,Depth,LimitedOffender,Depth] = A2, + + LimitedStarted = + [{pid,Name},{mfa,{a_module,init,[[1,2,3,4,5,6,7,8,9,'...']]}}], + {PF2,PA2} = supervisor_bridge:format_log(Progress), + PFExpected2 = " supervisor: ~tP~n started: ~tP~n", + ct:log("PF2: ~ts~nPA2: ~tp", [PF2,PA2]), + PFExpected2 = PF2, + [Supervisor,Depth,LimitedStarted,Depth] = PA2, + + case FD of + undefined -> + application:unset_env(kernel, error_logger_format_depth); + _ -> + application:set_env(kernel, error_logger_format_depth, FD) + end, + ok. + +%% Test report callback for any Logger handler +format_log_2(_Config) -> + Term = lists:seq(1, 15), + Supervisor = my_supervisor, + Name = self(), + NameStr = pid_to_list(Name), + Error = shutdown_error, + Offender = [{pid,Name},{mod,a_module}], + Report = #{label=>{supervisor,Error}, + report=>[{supervisor,Supervisor}, + {errorContext,Error}, + {reason,Term}, + {offender,Offender}]}, + FormatOpts1 = #{}, + Str1 = flatten_format_log(Report, FormatOpts1), + L1 = length(Str1), + Expected1 = " supervisor: my_supervisor\n" + " errorContext: shutdown_error\n" + " reason: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n" + " offender: [{pid,"++NameStr++"},{mod,a_module}]\n", + ct:log("Str1: ~ts", [Str1]), + ct:log("length(Str1): ~p", [L1]), + true = Expected1 =:= Str1, + + Started = [{pid,Name},{mfa,{a_module,init,[Term]}}], + Progress = #{label=>{supervisor,progress}, + report=>[{supervisor,Supervisor},{started,Started}]}, + PStr1 = flatten_format_log(Progress, FormatOpts1), + PL1 = length(PStr1), + PExpected1 = " supervisor: my_supervisor\n" + " started: [{pid,"++NameStr++"},\n" + " {mfa,{a_module,init," + "[[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]}}]\n", + ct:log("PStr1: ~ts", [PStr1]), + ct:log("length(PStr1): ~p", [PL1]), + true = PExpected1 =:= PStr1, + + Depth = 10, + FormatOpts2 = #{depth=>Depth}, + Str2 = flatten_format_log(Report, FormatOpts2), + L2 = length(Str2), + Expected2 = " supervisor: my_supervisor\n" + " errorContext: shutdown_error\n" + " reason: [1,2,3,4,5,6,7,8,9|...]\n" + " offender: [{pid,"++NameStr++"},{mod,a_module}]\n", + ct:log("Str2: ~ts", [Str2]), + ct:log("length(Str2): ~p", [L2]), + true = Expected2 =:= Str2, + + PStr2 = flatten_format_log(Progress, FormatOpts2), + PL2 = length(PStr2), + PExpected2 = " supervisor: my_supervisor\n" + " started: [{pid,"++NameStr++"}," + "{mfa,{a_module,init,[[1|...]]}}]\n", + ct:log("PStr2: ~ts", [PStr2]), + ct:log("length(PStr2): ~p", [PL2]), + true = PExpected2 =:= PStr2, + + FormatOpts3 = #{chars_limit=>200}, + Str3 = flatten_format_log(Report, FormatOpts3), + L3 = length(Str3), + Expected3 = " supervisor: my_supervisor\n" + " errorContext: shutdown_error\n" + " reason: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]\n" + " offender: [{pid,"++NameStr++"},{mod,a_module}]\n", + ct:log("Str3: ~ts", [Str3]), + ct:log("length(Str3): ~p", [L3]), + true = Expected3 =:= Str3, + + PFormatOpts3 = #{chars_limit=>80}, + PStr3 = flatten_format_log(Progress, PFormatOpts3), + PL3 = length(PStr3), + PExpected3 = " supervisor: my_supervisor\n started:", + ct:log("PStr3: ~ts", [PStr3]), + ct:log("length(PStr3): ~p", [PL3]), + true = lists:prefix(PExpected3, PStr3), + true = PL3 < PL1, + + FormatOpts4 = #{single_line=>true}, + Str4 = flatten_format_log(Report, FormatOpts4), + L4 = length(Str4), + Expected4 = "Supervisor: my_supervisor. Context: shutdown_error. " + "Reason: [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]. " + "Offender: pid="++NameStr++",mod=a_module.", + ct:log("Str4: ~ts", [Str4]), + ct:log("length(Str4): ~p", [L4]), + true = Expected4 =:= Str4, + + PStr4 = flatten_format_log(Progress, FormatOpts4), + PL4 = length(PStr4), + PExpected4 = "Supervisor: my_supervisor. " + "Started: pid="++NameStr++",mfa={a_module,init," + "[[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]]}.", + ct:log("PStr4: ~ts", [PStr4]), + ct:log("length(PStr4): ~p", [PL4]), + true = PExpected4 =:= PStr4, + + FormatOpts5 = #{single_line=>true, depth=>Depth}, + Str5 = flatten_format_log(Report, FormatOpts5), + L5 = length(Str5), + Expected5 = "Supervisor: my_supervisor. Context: shutdown_error. " + "Reason: [1,2,3,4,5,6,7,8,9|...]. " + "Offender: pid="++NameStr++",mod=a_module.", + ct:log("Str5: ~ts", [Str5]), + ct:log("length(Str5): ~p", [L5]), + true = Expected5 =:= Str5, + + PStr5 = flatten_format_log(Progress, FormatOpts5), + PL5 = length(PStr5), + PExpected5 = "Supervisor: my_supervisor. " + "Started: pid="++NameStr++",mfa={a_module,init,[[1,2,3,4,5|...]]}.", + ct:log("PStr5: ~ts", [PStr5]), + ct:log("length(PStr5): ~p", [PL5]), + true = PExpected5 =:= PStr5, + + FormatOpts6 = #{single_line=>true, chars_limit=>100}, + Str6 = flatten_format_log(Report, FormatOpts6), + L6 = length(Str6), + Expected6 = "Supervisor: my_supervisor. Context:", + ct:log("Str6: ~ts", [Str6]), + ct:log("length(Str6): ~p", [L6]), + true = lists:prefix(Expected6, Str6), + true = L6 < L4, + + PFormatOpts6 = #{single_line=>true, chars_limit=>60}, + PStr6 = flatten_format_log(Progress, PFormatOpts6), + PL6 = length(PStr6), + PExpected6 = "Supervisor: my_supervisor.", + ct:log("PStr6: ~ts", [PStr6]), + ct:log("length(PStr6): ~p", [PL6]), + true = lists:prefix(PExpected6, PStr6), + true = PL6 < PL4, + + ok. + +flatten_format_log(Report, Format) -> + lists:flatten(supervisor_bridge:format_log(Report, Format)). diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl index fb2b7dc45d..120c689d7f 100644 --- a/lib/stdlib/test/tar_SUITE.erl +++ b/lib/stdlib/test/tar_SUITE.erl @@ -28,7 +28,8 @@ extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1, memory/1,unicode/1,read_other_implementations/1, sparse/1, init/1, leading_slash/1, dotdot/1, - roundtrip_metadata/1, apply_file_info_opts/1]). + roundtrip_metadata/1, apply_file_info_opts/1, + incompatible_options/1]). -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). @@ -43,7 +44,7 @@ all() -> symlinks, open_add_close, cooked_compressed, memory, unicode, read_other_implementations, sparse,init,leading_slash,dotdot,roundtrip_metadata, - apply_file_info_opts]. + apply_file_info_opts,incompatible_options]. groups() -> []. @@ -574,6 +575,29 @@ extract_from_open_file(Config) when is_list(Config) -> verify_ports(Config). +%% Make sure incompatible options are rejected when opening archives with file +%% descriptors. +incompatible_options(Config) when is_list(Config) -> + DataDir = proplists:get_value(data_dir, Config), + Long = filename:join(DataDir, "no_fancy_stuff.tar"), + + {ok, File} = file:open(Long, [read]), + Handle = {file, File}, + + {error, {Handle, {incompatible_option, compressed}}} + = erl_tar:open(Handle, [read, compressed]), + {error, {Handle, {incompatible_option, cooked}}} + = erl_tar:open(Handle, [read, cooked]), + + {error, {Handle, {incompatible_option, compressed}}} + = erl_tar:extract(Handle, [compressed]), + {error, {Handle, {incompatible_option, cooked}}} + = erl_tar:extract(Handle, [cooked]), + + ok = file:close(File), + + verify_ports(Config). + %% Test that archives containing symlinks can be created and extracted. symlinks(Config) when is_list(Config) -> PrivDir = proplists:get_value(priv_dir, Config), diff --git a/lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt b/lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt index 6847953c23..fb4fec9fff 100644 --- a/lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt +++ b/lib/stdlib/test/unicode_util_SUITE_data/GraphemeBreakTest.txt @@ -1,6 +1,6 @@ -# GraphemeBreakTest-11.0.0.txt -# Date: 2018-03-18, 13:30:33 GMT -# © 2018 Unicode®, Inc. +# GraphemeBreakTest-12.1.0.txt +# Date: 2019-03-10, 10:53:12 GMT +# © 2019 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # @@ -56,8 +56,6 @@ ÷ 0020 × 0308 × 200D ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 0020 ÷ 0378 ÷ # ÷ [0.2] SPACE (Other) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 0020 × 0308 ÷ 0378 ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 0020 ÷ D800 ÷ # ÷ [0.2] SPACE (Other) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 0020 × 0308 ÷ D800 ÷ # ÷ [0.2] SPACE (Other) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 000D ÷ 0020 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] SPACE (Other) ÷ [0.3] ÷ 000D ÷ 0308 ÷ 0020 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 000D ÷ 000D ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -92,8 +90,6 @@ ÷ 000D ÷ 0308 × 200D ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 000D ÷ 0378 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] <reserved-0378> (Other) ÷ [0.3] ÷ 000D ÷ 0308 ÷ 0378 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 000D ÷ D800 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 000D ÷ 0308 ÷ D800 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 000A ÷ 0020 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] SPACE (Other) ÷ [0.3] ÷ 000A ÷ 0308 ÷ 0020 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 000A ÷ 000D ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -128,8 +124,6 @@ ÷ 000A ÷ 0308 × 200D ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 000A ÷ 0378 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] <reserved-0378> (Other) ÷ [0.3] ÷ 000A ÷ 0308 ÷ 0378 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 000A ÷ D800 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 000A ÷ 0308 ÷ D800 ÷ # ÷ [0.2] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 0001 ÷ 0020 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] SPACE (Other) ÷ [0.3] ÷ 0001 ÷ 0308 ÷ 0020 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 0001 ÷ 000D ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -164,8 +158,6 @@ ÷ 0001 ÷ 0308 × 200D ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 0001 ÷ 0378 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] <reserved-0378> (Other) ÷ [0.3] ÷ 0001 ÷ 0308 ÷ 0378 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 0001 ÷ D800 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 0001 ÷ 0308 ÷ D800 ÷ # ÷ [0.2] <START OF HEADING> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 034F ÷ 0020 ÷ # ÷ [0.2] COMBINING GRAPHEME JOINER (Extend) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 034F × 0308 ÷ 0020 ÷ # ÷ [0.2] COMBINING GRAPHEME JOINER (Extend) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 034F ÷ 000D ÷ # ÷ [0.2] COMBINING GRAPHEME JOINER (Extend) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -200,8 +192,6 @@ ÷ 034F × 0308 × 200D ÷ # ÷ [0.2] COMBINING GRAPHEME JOINER (Extend) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 034F ÷ 0378 ÷ # ÷ [0.2] COMBINING GRAPHEME JOINER (Extend) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 034F × 0308 ÷ 0378 ÷ # ÷ [0.2] COMBINING GRAPHEME JOINER (Extend) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 034F ÷ D800 ÷ # ÷ [0.2] COMBINING GRAPHEME JOINER (Extend) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 034F × 0308 ÷ D800 ÷ # ÷ [0.2] COMBINING GRAPHEME JOINER (Extend) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 1F1E6 ÷ 0020 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 1F1E6 × 0308 ÷ 0020 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 1F1E6 ÷ 000D ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -236,8 +226,6 @@ ÷ 1F1E6 × 0308 × 200D ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 1F1E6 ÷ 0378 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 1F1E6 × 0308 ÷ 0378 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 1F1E6 ÷ D800 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 1F1E6 × 0308 ÷ D800 ÷ # ÷ [0.2] REGIONAL INDICATOR SYMBOL LETTER A (RI) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 0600 × 0020 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.2] SPACE (Other) ÷ [0.3] ÷ 0600 × 0308 ÷ 0020 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 0600 ÷ 000D ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -272,8 +260,6 @@ ÷ 0600 × 0308 × 200D ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 0600 × 0378 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.2] <reserved-0378> (Other) ÷ [0.3] ÷ 0600 × 0308 ÷ 0378 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 0600 ÷ D800 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 0600 × 0308 ÷ D800 ÷ # ÷ [0.2] ARABIC NUMBER SIGN (Prepend) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 0903 ÷ 0020 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 0903 × 0308 ÷ 0020 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 0903 ÷ 000D ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -308,8 +294,6 @@ ÷ 0903 × 0308 × 200D ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 0903 ÷ 0378 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 0903 × 0308 ÷ 0378 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 0903 ÷ D800 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 0903 × 0308 ÷ D800 ÷ # ÷ [0.2] DEVANAGARI SIGN VISARGA (SpacingMark) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 1100 ÷ 0020 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 1100 × 0308 ÷ 0020 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 1100 ÷ 000D ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -344,8 +328,6 @@ ÷ 1100 × 0308 × 200D ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 1100 ÷ 0378 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 1100 × 0308 ÷ 0378 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 1100 ÷ D800 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 1100 × 0308 ÷ D800 ÷ # ÷ [0.2] HANGUL CHOSEONG KIYEOK (L) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 1160 ÷ 0020 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 1160 × 0308 ÷ 0020 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 1160 ÷ 000D ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -380,8 +362,6 @@ ÷ 1160 × 0308 × 200D ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 1160 ÷ 0378 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 1160 × 0308 ÷ 0378 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 1160 ÷ D800 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 1160 × 0308 ÷ D800 ÷ # ÷ [0.2] HANGUL JUNGSEONG FILLER (V) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 11A8 ÷ 0020 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 11A8 × 0308 ÷ 0020 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 11A8 ÷ 000D ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -416,8 +396,6 @@ ÷ 11A8 × 0308 × 200D ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 11A8 ÷ 0378 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 11A8 × 0308 ÷ 0378 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 11A8 ÷ D800 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 11A8 × 0308 ÷ D800 ÷ # ÷ [0.2] HANGUL JONGSEONG KIYEOK (T) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ AC00 ÷ 0020 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ AC00 × 0308 ÷ 0020 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ AC00 ÷ 000D ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -452,8 +430,6 @@ ÷ AC00 × 0308 × 200D ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ AC00 ÷ 0378 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ AC00 × 0308 ÷ 0378 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ AC00 ÷ D800 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ AC00 × 0308 ÷ D800 ÷ # ÷ [0.2] HANGUL SYLLABLE GA (LV) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ AC01 ÷ 0020 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ AC01 × 0308 ÷ 0020 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ AC01 ÷ 000D ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -488,8 +464,6 @@ ÷ AC01 × 0308 × 200D ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ AC01 ÷ 0378 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ AC01 × 0308 ÷ 0378 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ AC01 ÷ D800 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ AC01 × 0308 ÷ D800 ÷ # ÷ [0.2] HANGUL SYLLABLE GAG (LVT) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 231A ÷ 0020 ÷ # ÷ [0.2] WATCH (ExtPict) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 231A × 0308 ÷ 0020 ÷ # ÷ [0.2] WATCH (ExtPict) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 231A ÷ 000D ÷ # ÷ [0.2] WATCH (ExtPict) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -524,8 +498,6 @@ ÷ 231A × 0308 × 200D ÷ # ÷ [0.2] WATCH (ExtPict) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 231A ÷ 0378 ÷ # ÷ [0.2] WATCH (ExtPict) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 231A × 0308 ÷ 0378 ÷ # ÷ [0.2] WATCH (ExtPict) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 231A ÷ D800 ÷ # ÷ [0.2] WATCH (ExtPict) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 231A × 0308 ÷ D800 ÷ # ÷ [0.2] WATCH (ExtPict) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 0300 ÷ 0020 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 0300 × 0308 ÷ 0020 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend_ExtCccZwj) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 0300 ÷ 000D ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend_ExtCccZwj) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -560,8 +532,6 @@ ÷ 0300 × 0308 × 200D ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend_ExtCccZwj) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 0300 ÷ 0378 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 0300 × 0308 ÷ 0378 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend_ExtCccZwj) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 0300 ÷ D800 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 0300 × 0308 ÷ D800 ÷ # ÷ [0.2] COMBINING GRAVE ACCENT (Extend_ExtCccZwj) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 200D ÷ 0020 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 200D × 0308 ÷ 0020 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 200D ÷ 000D ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -596,8 +566,6 @@ ÷ 200D × 0308 × 200D ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 200D ÷ 0378 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 200D × 0308 ÷ 0378 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 200D ÷ D800 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 200D × 0308 ÷ D800 ÷ # ÷ [0.2] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 0378 ÷ 0020 ÷ # ÷ [0.2] <reserved-0378> (Other) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 0378 × 0308 ÷ 0020 ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] ÷ 0378 ÷ 000D ÷ # ÷ [0.2] <reserved-0378> (Other) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] @@ -632,44 +600,6 @@ ÷ 0378 × 0308 × 200D ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] ÷ 0378 ÷ 0378 ÷ # ÷ [0.2] <reserved-0378> (Other) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] ÷ 0378 × 0308 ÷ 0378 ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ 0378 ÷ D800 ÷ # ÷ [0.2] <reserved-0378> (Other) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ 0378 × 0308 ÷ D800 ÷ # ÷ [0.2] <reserved-0378> (Other) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] -÷ D800 ÷ 0020 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] SPACE (Other) ÷ [0.3] -÷ D800 ÷ 0308 ÷ 0020 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] SPACE (Other) ÷ [0.3] -÷ D800 ÷ 000D ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] -÷ D800 ÷ 0308 ÷ 000D ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <CARRIAGE RETURN (CR)> (CR) ÷ [0.3] -÷ D800 ÷ 000A ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] <LINE FEED (LF)> (LF) ÷ [0.3] -÷ D800 ÷ 0308 ÷ 000A ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <LINE FEED (LF)> (LF) ÷ [0.3] -÷ D800 ÷ 0001 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] <START OF HEADING> (Control) ÷ [0.3] -÷ D800 ÷ 0308 ÷ 0001 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <START OF HEADING> (Control) ÷ [0.3] -÷ D800 ÷ 034F ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING GRAPHEME JOINER (Extend) ÷ [0.3] -÷ D800 ÷ 0308 × 034F ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] COMBINING GRAPHEME JOINER (Extend) ÷ [0.3] -÷ D800 ÷ 1F1E6 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [0.3] -÷ D800 ÷ 0308 ÷ 1F1E6 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] REGIONAL INDICATOR SYMBOL LETTER A (RI) ÷ [0.3] -÷ D800 ÷ 0600 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] ARABIC NUMBER SIGN (Prepend) ÷ [0.3] -÷ D800 ÷ 0308 ÷ 0600 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] ARABIC NUMBER SIGN (Prepend) ÷ [0.3] -÷ D800 ÷ 0903 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [0.3] -÷ D800 ÷ 0308 × 0903 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.1] DEVANAGARI SIGN VISARGA (SpacingMark) ÷ [0.3] -÷ D800 ÷ 1100 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] HANGUL CHOSEONG KIYEOK (L) ÷ [0.3] -÷ D800 ÷ 0308 ÷ 1100 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] HANGUL CHOSEONG KIYEOK (L) ÷ [0.3] -÷ D800 ÷ 1160 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] HANGUL JUNGSEONG FILLER (V) ÷ [0.3] -÷ D800 ÷ 0308 ÷ 1160 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] HANGUL JUNGSEONG FILLER (V) ÷ [0.3] -÷ D800 ÷ 11A8 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] HANGUL JONGSEONG KIYEOK (T) ÷ [0.3] -÷ D800 ÷ 0308 ÷ 11A8 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] HANGUL JONGSEONG KIYEOK (T) ÷ [0.3] -÷ D800 ÷ AC00 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] HANGUL SYLLABLE GA (LV) ÷ [0.3] -÷ D800 ÷ 0308 ÷ AC00 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] HANGUL SYLLABLE GA (LV) ÷ [0.3] -÷ D800 ÷ AC01 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] HANGUL SYLLABLE GAG (LVT) ÷ [0.3] -÷ D800 ÷ 0308 ÷ AC01 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] HANGUL SYLLABLE GAG (LVT) ÷ [0.3] -÷ D800 ÷ 231A ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] WATCH (ExtPict) ÷ [0.3] -÷ D800 ÷ 0308 ÷ 231A ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] WATCH (ExtPict) ÷ [0.3] -÷ D800 ÷ 0300 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING GRAVE ACCENT (Extend_ExtCccZwj) ÷ [0.3] -÷ D800 ÷ 0308 × 0300 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] COMBINING GRAVE ACCENT (Extend_ExtCccZwj) ÷ [0.3] -÷ D800 ÷ 200D ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] -÷ D800 ÷ 0308 × 200D ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [0.3] -÷ D800 ÷ 0378 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] <reserved-0378> (Other) ÷ [0.3] -÷ D800 ÷ 0308 ÷ 0378 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [999.0] <reserved-0378> (Other) ÷ [0.3] -÷ D800 ÷ D800 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] <surrogate-D800> (Control) ÷ [0.3] -÷ D800 ÷ 0308 ÷ D800 ÷ # ÷ [0.2] <surrogate-D800> (Control) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [5.0] <surrogate-D800> (Control) ÷ [0.3] ÷ 000D × 000A ÷ 0061 ÷ 000A ÷ 0308 ÷ # ÷ [0.2] <CARRIAGE RETURN (CR)> (CR) × [3.0] <LINE FEED (LF)> (LF) ÷ [4.0] LATIN SMALL LETTER A (Other) ÷ [5.0] <LINE FEED (LF)> (LF) ÷ [4.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [0.3] ÷ 0061 × 0308 ÷ # ÷ [0.2] LATIN SMALL LETTER A (Other) × [9.0] COMBINING DIAERESIS (Extend_ExtCccZwj) ÷ [0.3] ÷ 0020 × 200D ÷ 0646 ÷ # ÷ [0.2] SPACE (Other) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [999.0] ARABIC LETTER NOON (Other) ÷ [0.3] @@ -695,6 +625,6 @@ ÷ 2701 × 200D × 2701 ÷ # ÷ [0.2] UPPER BLADE SCISSORS (Other) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) × [11.0] UPPER BLADE SCISSORS (Other) ÷ [0.3] ÷ 0061 × 200D ÷ 2701 ÷ # ÷ [0.2] LATIN SMALL LETTER A (Other) × [9.0] ZERO WIDTH JOINER (ZWJ_ExtCccZwj) ÷ [999.0] UPPER BLADE SCISSORS (Other) ÷ [0.3] # -# Lines: 672 +# Lines: 602 # # EOF diff --git a/lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt b/lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt index 0e9e678a85..eb056990a0 100644 --- a/lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt +++ b/lib/stdlib/test/unicode_util_SUITE_data/LineBreakTest.txt @@ -1,6 +1,6 @@ -# LineBreakTest-11.0.0.txt -# Date: 2018-05-20, 09:03:09 GMT -# © 2018 Unicode®, Inc. +# LineBreakTest-12.1.0.txt +# Date: 2019-03-10, 10:53:14 GMT +# © 2019 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # diff --git a/lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt b/lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt index 72a31bcdf1..54f43bdf4d 100644 --- a/lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt +++ b/lib/stdlib/test/unicode_util_SUITE_data/NormalizationTest.txt @@ -1,6 +1,6 @@ -# NormalizationTest-11.0.0.txt -# Date: 2018-02-19, 18:33:08 GMT -# © 2018 Unicode®, Inc. +# NormalizationTest-12.1.0.txt +# Date: 2019-04-01, 09:10:28 GMT +# © 2019 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # @@ -2149,6 +2149,7 @@ 32FC;32FC;32FC;30F0;30F0; # (㋼; ㋼; ㋼; ヰ; ヰ; ) CIRCLED KATAKANA WI 32FD;32FD;32FD;30F1;30F1; # (㋽; ㋽; ㋽; ヱ; ヱ; ) CIRCLED KATAKANA WE 32FE;32FE;32FE;30F2;30F2; # (㋾; ㋾; ㋾; ヲ; ヲ; ) CIRCLED KATAKANA WO +32FF;32FF;32FF;4EE4 548C;4EE4 548C; # (㋿; ㋿; ㋿; 令和; 令和; ) SQUARE ERA NAME REIWA 3300;3300;3300;30A2 30D1 30FC 30C8;30A2 30CF 309A 30FC 30C8; # (㌀; ㌀; ㌀; アパート; アハ◌゚ート; ) SQUARE APAATO 3301;3301;3301;30A2 30EB 30D5 30A1;30A2 30EB 30D5 30A1; # (㌁; ㌁; ㌁; アルファ; アルファ; ) SQUARE ARUHUA 3302;3302;3302;30A2 30F3 30DA 30A2;30A2 30F3 30D8 309A 30A2; # (㌂; ㌂; ㌂; アンペア; アンヘ◌゚ア; ) SQUARE ANPEA @@ -16363,6 +16364,7 @@ FFEE;FFEE;FFEE;25CB;25CB; # (￮; ￮; ￮; ○; ○; ) HALFWIDTH WHITE CIRCLE 1F14F;1F14F;1F14F;0057 0043;0057 0043; # (🅏; 🅏; 🅏; WC; WC; ) SQUARED WC 1F16A;1F16A;1F16A;004D 0043;004D 0043; # (🅪; 🅪; 🅪; MC; MC; ) RAISED MC SIGN 1F16B;1F16B;1F16B;004D 0044;004D 0044; # (🅫; 🅫; 🅫; MD; MD; ) RAISED MD SIGN +1F16C;1F16C;1F16C;004D 0052;004D 0052; # (🅬; 🅬; 🅬; MR; MR; ) RAISED MR SIGN 1F190;1F190;1F190;0044 004A;0044 004A; # (🆐; 🆐; 🆐; DJ; DJ; ) SQUARE DJ 1F200;1F200;1F200;307B 304B;307B 304B; # (🈀; 🈀; 🈀; ほか; ほか; ) SQUARE HIRAGANA HOKA 1F201;1F201;1F201;30B3 30B3;30B3 30B3; # (🈁; 🈁; 🈁; ココ; ココ; ) SQUARED KATAKANA KOKO @@ -17685,6 +17687,8 @@ FFEE;FFEE;FFEE;25CB;25CB; # (￮; ￮; ￮; ○; ○; ) HALFWIDTH WHITE CIRCLE 0061 0EB8 0EC8 0EB8 0E48 0062;0061 0E48 0EB8 0EB8 0EC8 0062;0061 0E48 0EB8 0EB8 0EC8 0062;0061 0E48 0EB8 0EB8 0EC8 0062;0061 0E48 0EB8 0EB8 0EC8 0062; # (a◌ຸ◌່◌ຸ◌่b; a◌่◌ຸ◌ຸ◌່b; a◌่◌ຸ◌ຸ◌່b; a◌่◌ຸ◌ຸ◌່b; a◌่◌ຸ◌ຸ◌່b; ) LATIN SMALL LETTER A, LAO VOWEL SIGN U, LAO TONE MAI EK, LAO VOWEL SIGN U, THAI CHARACTER MAI EK, LATIN SMALL LETTER B 0061 0EC8 0EB8 0E48 0EB9 0062;0061 0E48 0EB8 0EB9 0EC8 0062;0061 0E48 0EB8 0EB9 0EC8 0062;0061 0E48 0EB8 0EB9 0EC8 0062;0061 0E48 0EB8 0EB9 0EC8 0062; # (a◌່◌ຸ◌่◌ູb; a◌่◌ຸ◌ູ◌່b; a◌่◌ຸ◌ູ◌່b; a◌่◌ຸ◌ູ◌່b; a◌่◌ຸ◌ູ◌່b; ) LATIN SMALL LETTER A, LAO TONE MAI EK, LAO VOWEL SIGN U, THAI CHARACTER MAI EK, LAO VOWEL SIGN UU, LATIN SMALL LETTER B 0061 0EB9 0EC8 0EB8 0E48 0062;0061 0E48 0EB9 0EB8 0EC8 0062;0061 0E48 0EB9 0EB8 0EC8 0062;0061 0E48 0EB9 0EB8 0EC8 0062;0061 0E48 0EB9 0EB8 0EC8 0062; # (a◌ູ◌່◌ຸ◌่b; a◌่◌ູ◌ຸ◌່b; a◌่◌ູ◌ຸ◌່b; a◌่◌ູ◌ຸ◌່b; a◌่◌ູ◌ຸ◌່b; ) LATIN SMALL LETTER A, LAO VOWEL SIGN UU, LAO TONE MAI EK, LAO VOWEL SIGN U, THAI CHARACTER MAI EK, LATIN SMALL LETTER B +0061 05B0 094D 3099 0EBA 0062;0061 3099 094D 0EBA 05B0 0062;0061 3099 094D 0EBA 05B0 0062;0061 3099 094D 0EBA 05B0 0062;0061 3099 094D 0EBA 05B0 0062; # (a◌ְ◌्◌゙◌຺b; a◌゙◌्◌຺◌ְb; a◌゙◌्◌຺◌ְb; a◌゙◌्◌຺◌ְb; a◌゙◌्◌຺◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LAO SIGN PALI VIRAMA, LATIN SMALL LETTER B +0061 0EBA 05B0 094D 3099 0062;0061 3099 0EBA 094D 05B0 0062;0061 3099 0EBA 094D 05B0 0062;0061 3099 0EBA 094D 05B0 0062;0061 3099 0EBA 094D 05B0 0062; # (a◌຺◌ְ◌्◌゙b; a◌゙◌຺◌्◌ְb; a◌゙◌຺◌्◌ְb; a◌゙◌຺◌्◌ְb; a◌゙◌຺◌्◌ְb; ) LATIN SMALL LETTER A, LAO SIGN PALI VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B 0061 0F71 0EC8 0EB8 0EC8 0062;0061 0EB8 0EC8 0EC8 0F71 0062;0061 0EB8 0EC8 0EC8 0F71 0062;0061 0EB8 0EC8 0EC8 0F71 0062;0061 0EB8 0EC8 0EC8 0F71 0062; # (a◌ཱ◌່◌ຸ◌່b; a◌ຸ◌່◌່◌ཱb; a◌ຸ◌່◌່◌ཱb; a◌ຸ◌່◌່◌ཱb; a◌ຸ◌່◌່◌ཱb; ) LATIN SMALL LETTER A, TIBETAN VOWEL SIGN AA, LAO TONE MAI EK, LAO VOWEL SIGN U, LAO TONE MAI EK, LATIN SMALL LETTER B 0061 0EC8 0F71 0EC8 0EB8 0062;0061 0EB8 0EC8 0EC8 0F71 0062;0061 0EB8 0EC8 0EC8 0F71 0062;0061 0EB8 0EC8 0EC8 0F71 0062;0061 0EB8 0EC8 0EC8 0F71 0062; # (a◌່◌ཱ◌່◌ຸb; a◌ຸ◌່◌່◌ཱb; a◌ຸ◌່◌່◌ཱb; a◌ຸ◌່◌່◌ཱb; a◌ຸ◌່◌່◌ཱb; ) LATIN SMALL LETTER A, LAO TONE MAI EK, TIBETAN VOWEL SIGN AA, LAO TONE MAI EK, LAO VOWEL SIGN U, LATIN SMALL LETTER B 0061 0F71 0EC8 0EB8 0EC9 0062;0061 0EB8 0EC8 0EC9 0F71 0062;0061 0EB8 0EC8 0EC9 0F71 0062;0061 0EB8 0EC8 0EC9 0F71 0062;0061 0EB8 0EC8 0EC9 0F71 0062; # (a◌ཱ◌່◌ຸ◌້b; a◌ຸ◌່◌້◌ཱb; a◌ຸ◌່◌້◌ཱb; a◌ຸ◌່◌້◌ཱb; a◌ຸ◌່◌້◌ཱb; ) LATIN SMALL LETTER A, TIBETAN VOWEL SIGN AA, LAO TONE MAI EK, LAO VOWEL SIGN U, LAO TONE MAI THO, LATIN SMALL LETTER B @@ -18453,6 +18457,8 @@ FFEE;FFEE;FFEE;25CB;25CB; # (￮; ￮; ￮; ○; ○; ) HALFWIDTH WHITE CIRCLE 0061 11839 05B0 094D 3099 0062;0061 3099 11839 094D 05B0 0062;0061 3099 11839 094D 05B0 0062;0061 3099 11839 094D 05B0 0062;0061 3099 11839 094D 05B0 0062; # (a◌𑠹◌ְ◌्◌゙b; a◌゙◌𑠹◌्◌ְb; a◌゙◌𑠹◌्◌ְb; a◌゙◌𑠹◌्◌ְb; a◌゙◌𑠹◌्◌ְb; ) LATIN SMALL LETTER A, DOGRA SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B 0061 3099 093C 0334 1183A 0062;0061 0334 093C 1183A 3099 0062;0061 0334 093C 1183A 3099 0062;0061 0334 093C 1183A 3099 0062;0061 0334 093C 1183A 3099 0062; # (a◌゙◌़◌̴◌𑠺b; a◌̴◌़◌𑠺◌゙b; a◌̴◌़◌𑠺◌゙b; a◌̴◌़◌𑠺◌゙b; a◌̴◌़◌𑠺◌゙b; ) LATIN SMALL LETTER A, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, DOGRA SIGN NUKTA, LATIN SMALL LETTER B 0061 1183A 3099 093C 0334 0062;0061 0334 1183A 093C 3099 0062;0061 0334 1183A 093C 3099 0062;0061 0334 1183A 093C 3099 0062;0061 0334 1183A 093C 3099 0062; # (a◌𑠺◌゙◌़◌̴b; a◌̴◌𑠺◌़◌゙b; a◌̴◌𑠺◌़◌゙b; a◌̴◌𑠺◌़◌゙b; a◌̴◌𑠺◌़◌゙b; ) LATIN SMALL LETTER A, DOGRA SIGN NUKTA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B +0061 05B0 094D 3099 119E0 0062;0061 3099 094D 119E0 05B0 0062;0061 3099 094D 119E0 05B0 0062;0061 3099 094D 119E0 05B0 0062;0061 3099 094D 119E0 05B0 0062; # (a◌ְ◌्◌゙◌𑧠b; a◌゙◌्◌𑧠◌ְb; a◌゙◌्◌𑧠◌ְb; a◌゙◌्◌𑧠◌ְb; a◌゙◌्◌𑧠◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, NANDINAGARI SIGN VIRAMA, LATIN SMALL LETTER B +0061 119E0 05B0 094D 3099 0062;0061 3099 119E0 094D 05B0 0062;0061 3099 119E0 094D 05B0 0062;0061 3099 119E0 094D 05B0 0062;0061 3099 119E0 094D 05B0 0062; # (a◌𑧠◌ְ◌्◌゙b; a◌゙◌𑧠◌्◌ְb; a◌゙◌𑧠◌्◌ְb; a◌゙◌𑧠◌्◌ְb; a◌゙◌𑧠◌्◌ְb; ) LATIN SMALL LETTER A, NANDINAGARI SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B 0061 05B0 094D 3099 11A34 0062;0061 3099 094D 11A34 05B0 0062;0061 3099 094D 11A34 05B0 0062;0061 3099 094D 11A34 05B0 0062;0061 3099 094D 11A34 05B0 0062; # (a◌ְ◌्◌゙◌𑨴b; a◌゙◌्◌𑨴◌ְb; a◌゙◌्◌𑨴◌ְb; a◌゙◌्◌𑨴◌ְb; a◌゙◌्◌𑨴◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, ZANABAZAR SQUARE SIGN VIRAMA, LATIN SMALL LETTER B 0061 11A34 05B0 094D 3099 0062;0061 3099 11A34 094D 05B0 0062;0061 3099 11A34 094D 05B0 0062;0061 3099 11A34 094D 05B0 0062;0061 3099 11A34 094D 05B0 0062; # (a◌𑨴◌ְ◌्◌゙b; a◌゙◌𑨴◌्◌ְb; a◌゙◌𑨴◌्◌ְb; a◌゙◌𑨴◌्◌ְb; a◌゙◌𑨴◌्◌ְb; ) LATIN SMALL LETTER A, ZANABAZAR SQUARE SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B 0061 05B0 094D 3099 11A47 0062;0061 3099 094D 11A47 05B0 0062;0061 3099 094D 11A47 05B0 0062;0061 3099 094D 11A47 05B0 0062;0061 3099 094D 11A47 05B0 0062; # (a◌ְ◌्◌゙◌𑩇b; a◌゙◌्◌𑩇◌ְb; a◌゙◌्◌𑩇◌ְb; a◌゙◌्◌𑩇◌ְb; a◌゙◌्◌𑩇◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, ZANABAZAR SQUARE SUBJOINER, LATIN SMALL LETTER B @@ -18637,6 +18643,28 @@ FFEE;FFEE;FFEE;25CB;25CB; # (￮; ￮; ￮; ○; ○; ) HALFWIDTH WHITE CIRCLE 0061 1E029 0315 0300 05AE 0062;0061 05AE 1E029 0300 0315 0062;0061 05AE 1E029 0300 0315 0062;0061 05AE 1E029 0300 0315 0062;0061 05AE 1E029 0300 0315 0062; # (a◌𞀩◌̕◌̀◌֮b; a◌֮◌𞀩◌̀◌̕b; a◌֮◌𞀩◌̀◌̕b; a◌֮◌𞀩◌̀◌̕b; a◌֮◌𞀩◌̀◌̕b; ) LATIN SMALL LETTER A, COMBINING GLAGOLITIC LETTER IOTATED BIG YUS, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B 0061 0315 0300 05AE 1E02A 0062;00E0 05AE 1E02A 0315 0062;0061 05AE 0300 1E02A 0315 0062;00E0 05AE 1E02A 0315 0062;0061 05AE 0300 1E02A 0315 0062; # (a◌̕◌̀◌֮◌𞀪b; à◌֮◌𞀪◌̕b; a◌֮◌̀◌𞀪◌̕b; à◌֮◌𞀪◌̕b; a◌֮◌̀◌𞀪◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, COMBINING GLAGOLITIC LETTER FITA, LATIN SMALL LETTER B 0061 1E02A 0315 0300 05AE 0062;0061 05AE 1E02A 0300 0315 0062;0061 05AE 1E02A 0300 0315 0062;0061 05AE 1E02A 0300 0315 0062;0061 05AE 1E02A 0300 0315 0062; # (a◌𞀪◌̕◌̀◌֮b; a◌֮◌𞀪◌̀◌̕b; a◌֮◌𞀪◌̀◌̕b; a◌֮◌𞀪◌̀◌̕b; a◌֮◌𞀪◌̀◌̕b; ) LATIN SMALL LETTER A, COMBINING GLAGOLITIC LETTER FITA, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B +0061 0315 0300 05AE 1E130 0062;00E0 05AE 1E130 0315 0062;0061 05AE 0300 1E130 0315 0062;00E0 05AE 1E130 0315 0062;0061 05AE 0300 1E130 0315 0062; # (a◌̕◌̀◌֮◌𞄰b; à◌֮◌𞄰◌̕b; a◌֮◌̀◌𞄰◌̕b; à◌֮◌𞄰◌̕b; a◌֮◌̀◌𞄰◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, NYIAKENG PUACHUE HMONG TONE-B, LATIN SMALL LETTER B +0061 1E130 0315 0300 05AE 0062;0061 05AE 1E130 0300 0315 0062;0061 05AE 1E130 0300 0315 0062;0061 05AE 1E130 0300 0315 0062;0061 05AE 1E130 0300 0315 0062; # (a◌𞄰◌̕◌̀◌֮b; a◌֮◌𞄰◌̀◌̕b; a◌֮◌𞄰◌̀◌̕b; a◌֮◌𞄰◌̀◌̕b; a◌֮◌𞄰◌̀◌̕b; ) LATIN SMALL LETTER A, NYIAKENG PUACHUE HMONG TONE-B, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B +0061 0315 0300 05AE 1E131 0062;00E0 05AE 1E131 0315 0062;0061 05AE 0300 1E131 0315 0062;00E0 05AE 1E131 0315 0062;0061 05AE 0300 1E131 0315 0062; # (a◌̕◌̀◌֮◌𞄱b; à◌֮◌𞄱◌̕b; a◌֮◌̀◌𞄱◌̕b; à◌֮◌𞄱◌̕b; a◌֮◌̀◌𞄱◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, NYIAKENG PUACHUE HMONG TONE-M, LATIN SMALL LETTER B +0061 1E131 0315 0300 05AE 0062;0061 05AE 1E131 0300 0315 0062;0061 05AE 1E131 0300 0315 0062;0061 05AE 1E131 0300 0315 0062;0061 05AE 1E131 0300 0315 0062; # (a◌𞄱◌̕◌̀◌֮b; a◌֮◌𞄱◌̀◌̕b; a◌֮◌𞄱◌̀◌̕b; a◌֮◌𞄱◌̀◌̕b; a◌֮◌𞄱◌̀◌̕b; ) LATIN SMALL LETTER A, NYIAKENG PUACHUE HMONG TONE-M, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B +0061 0315 0300 05AE 1E132 0062;00E0 05AE 1E132 0315 0062;0061 05AE 0300 1E132 0315 0062;00E0 05AE 1E132 0315 0062;0061 05AE 0300 1E132 0315 0062; # (a◌̕◌̀◌֮◌𞄲b; à◌֮◌𞄲◌̕b; a◌֮◌̀◌𞄲◌̕b; à◌֮◌𞄲◌̕b; a◌֮◌̀◌𞄲◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, NYIAKENG PUACHUE HMONG TONE-J, LATIN SMALL LETTER B +0061 1E132 0315 0300 05AE 0062;0061 05AE 1E132 0300 0315 0062;0061 05AE 1E132 0300 0315 0062;0061 05AE 1E132 0300 0315 0062;0061 05AE 1E132 0300 0315 0062; # (a◌𞄲◌̕◌̀◌֮b; a◌֮◌𞄲◌̀◌̕b; a◌֮◌𞄲◌̀◌̕b; a◌֮◌𞄲◌̀◌̕b; a◌֮◌𞄲◌̀◌̕b; ) LATIN SMALL LETTER A, NYIAKENG PUACHUE HMONG TONE-J, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B +0061 0315 0300 05AE 1E133 0062;00E0 05AE 1E133 0315 0062;0061 05AE 0300 1E133 0315 0062;00E0 05AE 1E133 0315 0062;0061 05AE 0300 1E133 0315 0062; # (a◌̕◌̀◌֮◌𞄳b; à◌֮◌𞄳◌̕b; a◌֮◌̀◌𞄳◌̕b; à◌֮◌𞄳◌̕b; a◌֮◌̀◌𞄳◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, NYIAKENG PUACHUE HMONG TONE-V, LATIN SMALL LETTER B +0061 1E133 0315 0300 05AE 0062;0061 05AE 1E133 0300 0315 0062;0061 05AE 1E133 0300 0315 0062;0061 05AE 1E133 0300 0315 0062;0061 05AE 1E133 0300 0315 0062; # (a◌𞄳◌̕◌̀◌֮b; a◌֮◌𞄳◌̀◌̕b; a◌֮◌𞄳◌̀◌̕b; a◌֮◌𞄳◌̀◌̕b; a◌֮◌𞄳◌̀◌̕b; ) LATIN SMALL LETTER A, NYIAKENG PUACHUE HMONG TONE-V, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B +0061 0315 0300 05AE 1E134 0062;00E0 05AE 1E134 0315 0062;0061 05AE 0300 1E134 0315 0062;00E0 05AE 1E134 0315 0062;0061 05AE 0300 1E134 0315 0062; # (a◌̕◌̀◌֮◌𞄴b; à◌֮◌𞄴◌̕b; a◌֮◌̀◌𞄴◌̕b; à◌֮◌𞄴◌̕b; a◌֮◌̀◌𞄴◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, NYIAKENG PUACHUE HMONG TONE-S, LATIN SMALL LETTER B +0061 1E134 0315 0300 05AE 0062;0061 05AE 1E134 0300 0315 0062;0061 05AE 1E134 0300 0315 0062;0061 05AE 1E134 0300 0315 0062;0061 05AE 1E134 0300 0315 0062; # (a◌𞄴◌̕◌̀◌֮b; a◌֮◌𞄴◌̀◌̕b; a◌֮◌𞄴◌̀◌̕b; a◌֮◌𞄴◌̀◌̕b; a◌֮◌𞄴◌̀◌̕b; ) LATIN SMALL LETTER A, NYIAKENG PUACHUE HMONG TONE-S, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B +0061 0315 0300 05AE 1E135 0062;00E0 05AE 1E135 0315 0062;0061 05AE 0300 1E135 0315 0062;00E0 05AE 1E135 0315 0062;0061 05AE 0300 1E135 0315 0062; # (a◌̕◌̀◌֮◌𞄵b; à◌֮◌𞄵◌̕b; a◌֮◌̀◌𞄵◌̕b; à◌֮◌𞄵◌̕b; a◌֮◌̀◌𞄵◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, NYIAKENG PUACHUE HMONG TONE-G, LATIN SMALL LETTER B +0061 1E135 0315 0300 05AE 0062;0061 05AE 1E135 0300 0315 0062;0061 05AE 1E135 0300 0315 0062;0061 05AE 1E135 0300 0315 0062;0061 05AE 1E135 0300 0315 0062; # (a◌𞄵◌̕◌̀◌֮b; a◌֮◌𞄵◌̀◌̕b; a◌֮◌𞄵◌̀◌̕b; a◌֮◌𞄵◌̀◌̕b; a◌֮◌𞄵◌̀◌̕b; ) LATIN SMALL LETTER A, NYIAKENG PUACHUE HMONG TONE-G, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B +0061 0315 0300 05AE 1E136 0062;00E0 05AE 1E136 0315 0062;0061 05AE 0300 1E136 0315 0062;00E0 05AE 1E136 0315 0062;0061 05AE 0300 1E136 0315 0062; # (a◌̕◌̀◌֮◌𞄶b; à◌֮◌𞄶◌̕b; a◌֮◌̀◌𞄶◌̕b; à◌֮◌𞄶◌̕b; a◌֮◌̀◌𞄶◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, NYIAKENG PUACHUE HMONG TONE-D, LATIN SMALL LETTER B +0061 1E136 0315 0300 05AE 0062;0061 05AE 1E136 0300 0315 0062;0061 05AE 1E136 0300 0315 0062;0061 05AE 1E136 0300 0315 0062;0061 05AE 1E136 0300 0315 0062; # (a◌𞄶◌̕◌̀◌֮b; a◌֮◌𞄶◌̀◌̕b; a◌֮◌𞄶◌̀◌̕b; a◌֮◌𞄶◌̀◌̕b; a◌֮◌𞄶◌̀◌̕b; ) LATIN SMALL LETTER A, NYIAKENG PUACHUE HMONG TONE-D, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B +0061 0315 0300 05AE 1E2EC 0062;00E0 05AE 1E2EC 0315 0062;0061 05AE 0300 1E2EC 0315 0062;00E0 05AE 1E2EC 0315 0062;0061 05AE 0300 1E2EC 0315 0062; # (a◌̕◌̀◌֮◌𞋬b; à◌֮◌𞋬◌̕b; a◌֮◌̀◌𞋬◌̕b; à◌֮◌𞋬◌̕b; a◌֮◌̀◌𞋬◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, WANCHO TONE TUP, LATIN SMALL LETTER B +0061 1E2EC 0315 0300 05AE 0062;0061 05AE 1E2EC 0300 0315 0062;0061 05AE 1E2EC 0300 0315 0062;0061 05AE 1E2EC 0300 0315 0062;0061 05AE 1E2EC 0300 0315 0062; # (a◌𞋬◌̕◌̀◌֮b; a◌֮◌𞋬◌̀◌̕b; a◌֮◌𞋬◌̀◌̕b; a◌֮◌𞋬◌̀◌̕b; a◌֮◌𞋬◌̀◌̕b; ) LATIN SMALL LETTER A, WANCHO TONE TUP, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B +0061 0315 0300 05AE 1E2ED 0062;00E0 05AE 1E2ED 0315 0062;0061 05AE 0300 1E2ED 0315 0062;00E0 05AE 1E2ED 0315 0062;0061 05AE 0300 1E2ED 0315 0062; # (a◌̕◌̀◌֮◌𞋭b; à◌֮◌𞋭◌̕b; a◌֮◌̀◌𞋭◌̕b; à◌֮◌𞋭◌̕b; a◌֮◌̀◌𞋭◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, WANCHO TONE TUPNI, LATIN SMALL LETTER B +0061 1E2ED 0315 0300 05AE 0062;0061 05AE 1E2ED 0300 0315 0062;0061 05AE 1E2ED 0300 0315 0062;0061 05AE 1E2ED 0300 0315 0062;0061 05AE 1E2ED 0300 0315 0062; # (a◌𞋭◌̕◌̀◌֮b; a◌֮◌𞋭◌̀◌̕b; a◌֮◌𞋭◌̀◌̕b; a◌֮◌𞋭◌̀◌̕b; a◌֮◌𞋭◌̀◌̕b; ) LATIN SMALL LETTER A, WANCHO TONE TUPNI, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B +0061 0315 0300 05AE 1E2EE 0062;00E0 05AE 1E2EE 0315 0062;0061 05AE 0300 1E2EE 0315 0062;00E0 05AE 1E2EE 0315 0062;0061 05AE 0300 1E2EE 0315 0062; # (a◌̕◌̀◌֮◌𞋮b; à◌֮◌𞋮◌̕b; a◌֮◌̀◌𞋮◌̕b; à◌֮◌𞋮◌̕b; a◌֮◌̀◌𞋮◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, WANCHO TONE KOI, LATIN SMALL LETTER B +0061 1E2EE 0315 0300 05AE 0062;0061 05AE 1E2EE 0300 0315 0062;0061 05AE 1E2EE 0300 0315 0062;0061 05AE 1E2EE 0300 0315 0062;0061 05AE 1E2EE 0300 0315 0062; # (a◌𞋮◌̕◌̀◌֮b; a◌֮◌𞋮◌̀◌̕b; a◌֮◌𞋮◌̀◌̕b; a◌֮◌𞋮◌̀◌̕b; a◌֮◌𞋮◌̀◌̕b; ) LATIN SMALL LETTER A, WANCHO TONE KOI, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B +0061 0315 0300 05AE 1E2EF 0062;00E0 05AE 1E2EF 0315 0062;0061 05AE 0300 1E2EF 0315 0062;00E0 05AE 1E2EF 0315 0062;0061 05AE 0300 1E2EF 0315 0062; # (a◌̕◌̀◌֮◌𞋯b; à◌֮◌𞋯◌̕b; a◌֮◌̀◌𞋯◌̕b; à◌֮◌𞋯◌̕b; a◌֮◌̀◌𞋯◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, WANCHO TONE KOINI, LATIN SMALL LETTER B +0061 1E2EF 0315 0300 05AE 0062;0061 05AE 1E2EF 0300 0315 0062;0061 05AE 1E2EF 0300 0315 0062;0061 05AE 1E2EF 0300 0315 0062;0061 05AE 1E2EF 0300 0315 0062; # (a◌𞋯◌̕◌̀◌֮b; a◌֮◌𞋯◌̀◌̕b; a◌֮◌𞋯◌̀◌̕b; a◌֮◌𞋯◌̀◌̕b; a◌֮◌𞋯◌̀◌̕b; ) LATIN SMALL LETTER A, WANCHO TONE KOINI, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B 0061 059A 0316 302A 1E8D0 0062;0061 302A 0316 1E8D0 059A 0062;0061 302A 0316 1E8D0 059A 0062;0061 302A 0316 1E8D0 059A 0062;0061 302A 0316 1E8D0 059A 0062; # (a◌֚◌̖◌〪◌𞣐b; a◌〪◌̖◌𞣐◌֚b; a◌〪◌̖◌𞣐◌֚b; a◌〪◌̖◌𞣐◌֚b; a◌〪◌̖◌𞣐◌֚b; ) LATIN SMALL LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, IDEOGRAPHIC LEVEL TONE MARK, MENDE KIKAKUI COMBINING NUMBER TEENS, LATIN SMALL LETTER B 0061 1E8D0 059A 0316 302A 0062;0061 302A 1E8D0 0316 059A 0062;0061 302A 1E8D0 0316 059A 0062;0061 302A 1E8D0 0316 059A 0062;0061 302A 1E8D0 0316 059A 0062; # (a◌𞣐◌֚◌̖◌〪b; a◌〪◌𞣐◌̖◌֚b; a◌〪◌𞣐◌̖◌֚b; a◌〪◌𞣐◌̖◌֚b; a◌〪◌𞣐◌̖◌֚b; ) LATIN SMALL LETTER A, MENDE KIKAKUI COMBINING NUMBER TEENS, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, IDEOGRAPHIC LEVEL TONE MARK, LATIN SMALL LETTER B 0061 059A 0316 302A 1E8D1 0062;0061 302A 0316 1E8D1 059A 0062;0061 302A 0316 1E8D1 059A 0062;0061 302A 0316 1E8D1 059A 0062;0061 302A 0316 1E8D1 059A 0062; # (a◌֚◌̖◌〪◌𞣑b; a◌〪◌̖◌𞣑◌֚b; a◌〪◌̖◌𞣑◌֚b; a◌〪◌̖◌𞣑◌֚b; a◌〪◌̖◌𞣑◌֚b; ) LATIN SMALL LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, IDEOGRAPHIC LEVEL TONE MARK, MENDE KIKAKUI COMBINING NUMBER TENS, LATIN SMALL LETTER B diff --git a/lib/stdlib/test/win32reg_SUITE.erl b/lib/stdlib/test/win32reg_SUITE.erl index 5e44e16ddc..f7d3d8da97 100644 --- a/lib/stdlib/test/win32reg_SUITE.erl +++ b/lib/stdlib/test/win32reg_SUITE.erl @@ -59,23 +59,27 @@ long(Config) when is_list(Config) -> {ok,Read} = win32reg:open([read]), ok = win32reg:change_key(Read, "\\hklm"), - ok = win32reg:change_key(Read, LongKey), - {ok,ErlangKey} = win32reg:current_key(Read), - io:format("Erlang key: ~s~n", [ErlangKey]), - ok = win32reg:close(Read), - - {ok,Reg} = win32reg:open([read, write]), - %% Write a long value and read it back. - TestKey = "test_key", - LongValue = lists:concat(["This is a long value generated by the test case ",?MODULE,":long/1. "|lists:duplicate(128, "a")]), - ok = win32reg:set_value(Reg, TestKey, LongValue), - {ok,LongValue} = win32reg:value(Reg, TestKey), - - io:format("Where ~p Key ~s Value ~s ~n", [win32reg:current_key(Reg), TestKey, LongValue]), - %% Done. - - ok = win32reg:close(Reg), - ok. + case os:getenv("WSLENV") of + false -> + ok = win32reg:change_key(Read, LongKey), + {ok,ErlangKey} = win32reg:current_key(Read), + io:format("Erlang key: ~s~n", [ErlangKey]), + ok = win32reg:close(Read), + + {ok,Reg} = win32reg:open([read, write]), + %% Write a long value and read it back. + TestKey = "test_key", + LongValue = lists:concat(["This is a long value generated by the test case ",?MODULE,":long/1. "|lists:duplicate(128, "a")]), + ok = win32reg:set_value(Reg, TestKey, LongValue), + {ok,LongValue} = win32reg:value(Reg, TestKey), + + io:format("Where ~p Key ~s Value ~s ~n", [win32reg:current_key(Reg), TestKey, LongValue]), + %% Done. + ok = win32reg:close(Reg); + _ -> + %% We have installed erlang when testing on win10 and newer + ok + end. evil_write(Config) when is_list(Config) -> Key = "Software\\Ericsson\\Erlang", diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index 081bffa7cb..c1be2786da 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2018. All Rights Reserved. +%% Copyright Ericsson AB 2006-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -27,7 +27,7 @@ openzip_api/1, zip_api/1, open_leak/1, unzip_jar/1, unzip_traversal_exploit/1, compress_control/1, - foldl/1,fd_leak/1]). + foldl/1,fd_leak/1,unicode/1]). -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). @@ -40,7 +40,7 @@ all() -> unzip_to_binary, zip_to_binary, unzip_options, zip_options, list_dir_options, aliases, openzip_api, zip_api, open_leak, unzip_jar, compress_control, foldl, - unzip_traversal_exploit,fd_leak]. + unzip_traversal_exploit,fd_leak,unicode]. groups() -> []. @@ -105,49 +105,32 @@ borderline_test(Size, TempDir) -> %% Verify that Unix zip can read it. (if we have a unix zip that is!) - unzip_list(Archive, Name), + zipinfo_match(Archive, Name), ok. -unzip_list(Archive, Name) -> - case unix_unzip_exists() of - true -> - unzip_list1(Archive, Name); +zipinfo_match(Archive, Name) -> + case check_zipinfo_exists() of + true -> + Encoding = file:native_name_encoding(), + Expect = unicode:characters_to_binary(Name ++ "\n", + Encoding, Encoding), + cmd_expect("zipinfo -1 " ++ Archive, Expect); _ -> ok end. -%% Used to do os:find_executable() to check if unzip exists, but on -%% some hosts that would give an unzip program which did not take the -%% "-Z" option. -%% Here we check that "unzip -Z" (which should display usage) and -%% check that it exists with status 0. -unix_unzip_exists() -> - case os:type() of - {unix,_} -> - Port = open_port({spawn,"unzip -Z > /dev/null"}, [exit_status]), - receive - {Port,{exit_status,0}} -> - true; - {Port,{exit_status,_Fail}} -> - false - end; - _ -> - false - end. - -unzip_list1(Archive, Name) -> - Expect = Name ++ "\n", - cmd_expect("unzip -Z -1 " ++ Archive, Expect). +check_zipinfo_exists() -> + is_list(os:find_executable("zipinfo")). cmd_expect(Cmd, Expect) -> - Port = open_port({spawn, make_cmd(Cmd)}, [stream, in, eof]), - get_data(Port, Expect). + Port = open_port({spawn, make_cmd(Cmd)}, [stream, in, binary, eof]), + get_data(Port, Expect, <<>>). -get_data(Port, Expect) -> +get_data(Port, Expect, Acc) -> receive {Port, {data, Bytes}} -> - get_data(Port, match_output(Bytes, Expect, Port)); + get_data(Port, Expect, <<Acc/binary, Bytes/binary>>); {Port, eof} -> Port ! {self(), close}, receive @@ -160,21 +143,17 @@ get_data(Port, Expect) -> after 1 -> % force context switch ok end, - match_output(eof, Expect, Port) + match_output(Acc, Expect, Port) end. -match_output([C|Output], [C|Expect], Port) -> +match_output(<<C, Output/bits>>, <<C,Expect/bits>>, Port) -> match_output(Output, Expect, Port); -match_output([_|_], [_|_], Port) -> +match_output(<<_, _/bits>>, <<_, _/bits>>, Port) -> kill_port_and_fail(Port, badmatch); -match_output([X|Output], [], Port) -> - kill_port_and_fail(Port, {too_much_data, [X|Output]}); -match_output([], Expect, _Port) -> - Expect; -match_output(eof, [], _Port) -> - []; -match_output(eof, Expect, Port) -> - kill_port_and_fail(Port, {unexpected_end_of_input, Expect}). +match_output(<<_, _/bits>>=Rest, <<>>, Port) -> + kill_port_and_fail(Port, {too_much_data, Rest}); +match_output(<<>>, <<>>, _Port) -> + ok. kill_port_and_fail(Port, Reason) -> unlink(Port), @@ -913,3 +892,137 @@ do_fd_leak(Bad, N) -> io:format("Bad error after ~p attempts\n", [N]), erlang:raise(C, R, Stk) end. + +unicode(Config) -> + case file:native_name_encoding() of + latin1 -> + {comment, "Native name encoding is Latin-1; skipping all tests"}; + utf8 -> + DataDir = proplists:get_value(data_dir, Config), + ok = file:set_cwd(proplists:get_value(priv_dir, Config)), + test_file_comment(DataDir), + test_archive_comment(DataDir), + test_bad_comment(DataDir), + test_latin1_archive(DataDir), + case has_zip() of + false -> + {comment, "No zip program found; skipping some tests"}; + true -> + case zip_is_unicode_aware() of + true -> + test_filename_compatibility(), + ok; + false -> + {comment, "Old zip program; skipping some tests"} + end + end + end. + +test_filename_compatibility() -> + FancyName = "üñíĉòdë한", + Archive = "test.zip", + + {ok, Archive} = zip:zip(Archive, [{FancyName, <<"test">>}]), + zipinfo_match(Archive, FancyName). + +test_file_comment(DataDir) -> + Archive = filename:join(DataDir, "zip_file_comment.zip"), + Comments = ["a", [246], [1024]], + FileNames = [[C] ++ ".txt" || C <- [$a, 246, 1024]], + [begin + test_zip_file(FileName, Comment, Archive), + test_file_comment(FileName, Comment, Archive) + end || + Comment <- Comments, FileName <- FileNames], + ok. + +test_zip_file(FileName, Comment, Archive) -> + _ = file:delete(Archive), + io:format("*** zip:zip(). Testing FileName ~ts, Comment ~ts\n", + [FileName, Comment]), + ok = file:write_file(FileName, ["anything"]), + {ok, Archive} = + zip:zip(Archive, [FileName], [verbose, {comment, Comment}]), + zip_check(Archive, Comment, FileName, ""). + +test_file_comment(FileName, Comment, Archive) -> + case test_zip1() of + false -> + ok; + true -> + _ = file:delete(Archive), + io:format("*** zip(1). Testing FileName ~ts, Comment ~ts\n", + [FileName, Comment]), + ok = file:write_file(FileName, ["anything"]), + R = os:cmd("echo " ++ Comment ++ "| zip -c " ++ + Archive ++ " " ++ FileName), + io:format("os:cmd/1 returns ~lp\n", [R]), + zip_check(Archive, "", FileName, Comment) + end. + +test_archive_comment(DataDir) -> + Archive = filename:join(DataDir, "zip_archive_comment.zip"), + Chars = [$a, 246, 1024], + [test_archive_comment(Char, Archive) || Char <- Chars], + ok. + +test_archive_comment(Char, Archive) -> + case test_zip1() of + false -> + ok; + true -> + _ = file:delete(Archive), + FileName = "a.txt", + Comment = [Char], + io:format("*** Testing archive Comment ~ts\n", [Comment]), + ok = file:write_file(FileName, ["anything"]), + + {ok, _} = + zip:zip(Archive, [FileName], [verbose, {comment, Comment}]), + Res = os:cmd("zip -z " ++ Archive), + io:format("os:cmd/1 returns ~lp\n", [Res]), + true = lists:member(Char, Res), + + os:cmd("echo " ++ Comment ++ "| zip -z "++ + Archive ++ " " ++ FileName), + zip_check(Archive, Comment, FileName, "") + end. + +test_zip1() -> + has_zip() andalso zip_is_unicode_aware(). + +has_zip() -> + os:find_executable("zip") =/= false. + +zip_is_unicode_aware() -> + S = os:cmd("zip -v | grep 'UNICODE_SUPPORT'"), + string:find(S, "UNICODE_SUPPORT") =/= nomatch. + +zip_check(Archive, ArchiveComment, FileName, FileNameComment) -> + {ok, CommentAndFiles} = zip:table(Archive), + io:format("zip:table/1 returns\n ~lp\n", [CommentAndFiles]), + io:format("checking archive comment ~lp\n", [ArchiveComment]), + [_] = [C || #zip_comment{comment = C} <- CommentAndFiles, + C =:= ArchiveComment], + io:format("checking filename ~lp\n", [FileName]), + io:format("and filename comment ~lp\n", [FileNameComment]), + [_] = [F || #zip_file{name = F, comment = C} <- CommentAndFiles, + F =:= FileName, C =:= FileNameComment], + {ok, FileList} = zip:unzip(Archive, [verbose]), + io:format("zip:unzip/2 returns\n ~lp\n", [FileList]), + true = lists:member(FileName, FileList), + ok. + +test_bad_comment(DataDir) -> + Archive = filename:join(DataDir, "zip_bad_comment.zip"), + FileName = "a.txt", + file:write_file(FileName, ["something"]), + Comment = [9999999], + {error,{bad_unicode,Comment}} = + zip:zip(Archive, [FileName], [verbose, {comment, Comment}]). + +test_latin1_archive(DataDir) -> + Archive = filename:join(DataDir, "zip-latin1.zip"), + FileName = [246] ++ ".txt", + ArchiveComment = [246], + zip_check(Archive, ArchiveComment, FileName, ""). diff --git a/lib/stdlib/test/zip_SUITE_data/zip-latin1.zip b/lib/stdlib/test/zip_SUITE_data/zip-latin1.zip Binary files differnew file mode 100644 index 0000000000..d54c783653 --- /dev/null +++ b/lib/stdlib/test/zip_SUITE_data/zip-latin1.zip diff --git a/lib/stdlib/uc_spec/CaseFolding.txt b/lib/stdlib/uc_spec/CaseFolding.txt index cce350f49c..7eeb915abf 100644 --- a/lib/stdlib/uc_spec/CaseFolding.txt +++ b/lib/stdlib/uc_spec/CaseFolding.txt @@ -1,6 +1,6 @@ -# CaseFolding-11.0.0.txt -# Date: 2018-01-31, 08:20:09 GMT -# © 2018 Unicode®, Inc. +# CaseFolding-12.1.0.txt +# Date: 2019-03-10, 10:53:00 GMT +# © 2019 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # @@ -1227,6 +1227,13 @@ A7B3; C; AB53; # LATIN CAPITAL LETTER CHI A7B4; C; A7B5; # LATIN CAPITAL LETTER BETA A7B6; C; A7B7; # LATIN CAPITAL LETTER OMEGA A7B8; C; A7B9; # LATIN CAPITAL LETTER U WITH STROKE +A7BA; C; A7BB; # LATIN CAPITAL LETTER GLOTTAL A +A7BC; C; A7BD; # LATIN CAPITAL LETTER GLOTTAL I +A7BE; C; A7BF; # LATIN CAPITAL LETTER GLOTTAL U +A7C2; C; A7C3; # LATIN CAPITAL LETTER ANGLICANA W +A7C4; C; A794; # LATIN CAPITAL LETTER C WITH PALATAL HOOK +A7C5; C; 0282; # LATIN CAPITAL LETTER S WITH HOOK +A7C6; C; 1D8E; # LATIN CAPITAL LETTER Z WITH PALATAL HOOK AB70; C; 13A0; # CHEROKEE SMALL LETTER A AB71; C; 13A1; # CHEROKEE SMALL LETTER E AB72; C; 13A2; # CHEROKEE SMALL LETTER I diff --git a/lib/stdlib/uc_spec/CompositionExclusions.txt b/lib/stdlib/uc_spec/CompositionExclusions.txt index ea63595bd3..aa654974be 100644 --- a/lib/stdlib/uc_spec/CompositionExclusions.txt +++ b/lib/stdlib/uc_spec/CompositionExclusions.txt @@ -1,6 +1,6 @@ -# CompositionExclusions-11.0.0.txt -# Date: 2017-12-06, 00:00:00 GMT [KW, LI] -# © 2017 Unicode®, Inc. +# CompositionExclusions-12.1.0.txt +# Date: 2019-03-08, 23:59:00 GMT [KW, LI] +# © 2019 Unicode®, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Unicode Character Database diff --git a/lib/stdlib/uc_spec/GraphemeBreakProperty.txt b/lib/stdlib/uc_spec/GraphemeBreakProperty.txt index 52052e6e33..b75b201f97 100644 --- a/lib/stdlib/uc_spec/GraphemeBreakProperty.txt +++ b/lib/stdlib/uc_spec/GraphemeBreakProperty.txt @@ -1,6 +1,6 @@ -# GraphemeBreakProperty-11.0.0.txt -# Date: 2018-03-16, 20:34:02 GMT -# © 2018 Unicode®, Inc. +# GraphemeBreakProperty-12.1.0.txt +# Date: 2019-03-10, 10:53:12 GMT +# © 2019 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # @@ -27,10 +27,10 @@ 110CD ; Prepend # Cf KAITHI NUMBER SIGN ABOVE 111C2..111C3 ; Prepend # Lo [2] SHARADA SIGN JIHVAMULIYA..SHARADA SIGN UPADHMANIYA 11A3A ; Prepend # Lo ZANABAZAR SQUARE CLUSTER-INITIAL LETTER RA -11A86..11A89 ; Prepend # Lo [4] SOYOMBO CLUSTER-INITIAL LETTER RA..SOYOMBO CLUSTER-INITIAL LETTER SA +11A84..11A89 ; Prepend # Lo [6] SOYOMBO SIGN JIHVAMULIYA..SOYOMBO CLUSTER-INITIAL LETTER SA 11D46 ; Prepend # Lo MASARAM GONDI REPHA -# Total code points: 20 +# Total code points: 22 # ================================================ @@ -61,10 +61,10 @@ 2060..2064 ; Control # Cf [5] WORD JOINER..INVISIBLE PLUS 2065 ; Control # Cn <reserved-2065> 2066..206F ; Control # Cf [10] LEFT-TO-RIGHT ISOLATE..NOMINAL DIGIT SHAPES -D800..DFFF ; Control # Cs [2048] <surrogate-D800>..<surrogate-DFFF> FEFF ; Control # Cf ZERO WIDTH NO-BREAK SPACE FFF0..FFF8 ; Control # Cn [9] <reserved-FFF0>..<reserved-FFF8> FFF9..FFFB ; Control # Cf [3] INTERLINEAR ANNOTATION ANCHOR..INTERLINEAR ANNOTATION TERMINATOR +13430..13438 ; Control # Cf [9] EGYPTIAN HIEROGLYPH VERTICAL JOINER..EGYPTIAN HIEROGLYPH END SEGMENT 1BCA0..1BCA3 ; Control # Cf [4] SHORTHAND FORMAT LETTER OVERLAP..SHORTHAND FORMAT UP STEP 1D173..1D17A ; Control # Cf [8] MUSICAL SYMBOL BEGIN BEAM..MUSICAL SYMBOL END PHRASE E0000 ; Control # Cn <reserved-E0000> @@ -73,7 +73,7 @@ E0002..E001F ; Control # Cn [30] <reserved-E0002>..<reserved-E001F> E0080..E00FF ; Control # Cn [128] <reserved-E0080>..<reserved-E00FF> E01F0..E0FFF ; Control # Cn [3600] <reserved-E01F0>..<reserved-E0FFF> -# Total code points: 5925 +# Total code points: 3886 # ================================================ @@ -178,8 +178,7 @@ E01F0..E0FFF ; Control # Cn [3600] <reserved-E01F0>..<reserved-E0FFF> 0E34..0E3A ; Extend # Mn [7] THAI CHARACTER SARA I..THAI CHARACTER PHINTHU 0E47..0E4E ; Extend # Mn [8] THAI CHARACTER MAITAIKHU..THAI CHARACTER YAMAKKAN 0EB1 ; Extend # Mn LAO VOWEL SIGN MAI KAN -0EB4..0EB9 ; Extend # Mn [6] LAO VOWEL SIGN I..LAO VOWEL SIGN UU -0EBB..0EBC ; Extend # Mn [2] LAO VOWEL SIGN MAI KON..LAO SEMIVOWEL SIGN LO +0EB4..0EBC ; Extend # Mn [9] LAO VOWEL SIGN I..LAO SEMIVOWEL SIGN LO 0EC8..0ECD ; Extend # Mn [6] LAO TONE MAI EK..LAO NIGGAHITA 0F18..0F19 ; Extend # Mn [2] TIBETAN ASTROLOGICAL SIGN -KHYUD PA..TIBETAN ASTROLOGICAL SIGN SDONG TSHUGS 0F35 ; Extend # Mn TIBETAN MARK NGAS BZUNG NYI ZLA @@ -232,6 +231,7 @@ E01F0..E0FFF ; Control # Cn [3600] <reserved-E01F0>..<reserved-E0FFF> 1ABE ; Extend # Me COMBINING PARENTHESES OVERLAY 1B00..1B03 ; Extend # Mn [4] BALINESE SIGN ULU RICEM..BALINESE SIGN SURANG 1B34 ; Extend # Mn BALINESE SIGN REREKAN +1B35 ; Extend # Mc BALINESE VOWEL SIGN TEDUNG 1B36..1B3A ; Extend # Mn [5] BALINESE VOWEL SIGN ULU..BALINESE VOWEL SIGN RA REPA 1B3C ; Extend # Mn BALINESE VOWEL SIGN LA LENGA 1B42 ; Extend # Mn BALINESE VOWEL SIGN PEPET @@ -283,7 +283,7 @@ A947..A951 ; Extend # Mn [11] REJANG VOWEL SIGN I..REJANG CONSONANT SIGN R A980..A982 ; Extend # Mn [3] JAVANESE SIGN PANYANGGA..JAVANESE SIGN LAYAR A9B3 ; Extend # Mn JAVANESE SIGN CECAK TELU A9B6..A9B9 ; Extend # Mn [4] JAVANESE VOWEL SIGN WULU..JAVANESE VOWEL SIGN SUKU MENDUT -A9BC ; Extend # Mn JAVANESE VOWEL SIGN PEPET +A9BC..A9BD ; Extend # Mn [2] JAVANESE VOWEL SIGN PEPET..JAVANESE CONSONANT SIGN KERET A9E5 ; Extend # Mn MYANMAR SIGN SHAN SAW AA29..AA2E ; Extend # Mn [6] CHAM VOWEL SIGN AA..CHAM VOWEL SIGN OE AA31..AA32 ; Extend # Mn [2] CHAM VOWEL SIGN AU..CHAM VOWEL SIGN UE @@ -368,6 +368,9 @@ FF9E..FF9F ; Extend # Lm [2] HALFWIDTH KATAKANA VOICED SOUND MARK..HALFWIDT 11727..1172B ; Extend # Mn [5] AHOM VOWEL SIGN AW..AHOM SIGN KILLER 1182F..11837 ; Extend # Mn [9] DOGRA VOWEL SIGN U..DOGRA SIGN ANUSVARA 11839..1183A ; Extend # Mn [2] DOGRA SIGN VIRAMA..DOGRA SIGN NUKTA +119D4..119D7 ; Extend # Mn [4] NANDINAGARI VOWEL SIGN U..NANDINAGARI VOWEL SIGN VOCALIC RR +119DA..119DB ; Extend # Mn [2] NANDINAGARI VOWEL SIGN E..NANDINAGARI VOWEL SIGN AI +119E0 ; Extend # Mn NANDINAGARI SIGN VIRAMA 11A01..11A0A ; Extend # Mn [10] ZANABAZAR SQUARE VOWEL SIGN I..ZANABAZAR SQUARE VOWEL LENGTH MARK 11A33..11A38 ; Extend # Mn [6] ZANABAZAR SQUARE FINAL CONSONANT MARK..ZANABAZAR SQUARE SIGN ANUSVARA 11A3B..11A3E ; Extend # Mn [4] ZANABAZAR SQUARE CLUSTER-FINAL LETTER YA..ZANABAZAR SQUARE CLUSTER-FINAL LETTER VA @@ -394,6 +397,7 @@ FF9E..FF9F ; Extend # Lm [2] HALFWIDTH KATAKANA VOICED SOUND MARK..HALFWIDT 11EF3..11EF4 ; Extend # Mn [2] MAKASAR VOWEL SIGN I..MAKASAR VOWEL SIGN U 16AF0..16AF4 ; Extend # Mn [5] BASSA VAH COMBINING HIGH TONE..BASSA VAH COMBINING HIGH-LOW TONE 16B30..16B36 ; Extend # Mn [7] PAHAWH HMONG MARK CIM TUB..PAHAWH HMONG MARK CIM TAUM +16F4F ; Extend # Mn MIAO SIGN CONSONANT MODIFIER BAR 16F8F..16F92 ; Extend # Mn [4] MIAO TONE RIGHT..MIAO TONE BELOW 1BC9D..1BC9E ; Extend # Mn [2] DUPLOYAN THICK LETTER SELECTOR..DUPLOYAN DOUBLE MARK 1D165 ; Extend # Mc MUSICAL SYMBOL COMBINING STEM @@ -414,13 +418,15 @@ FF9E..FF9F ; Extend # Lm [2] HALFWIDTH KATAKANA VOICED SOUND MARK..HALFWIDT 1E01B..1E021 ; Extend # Mn [7] COMBINING GLAGOLITIC LETTER SHTA..COMBINING GLAGOLITIC LETTER YATI 1E023..1E024 ; Extend # Mn [2] COMBINING GLAGOLITIC LETTER YU..COMBINING GLAGOLITIC LETTER SMALL YUS 1E026..1E02A ; Extend # Mn [5] COMBINING GLAGOLITIC LETTER YO..COMBINING GLAGOLITIC LETTER FITA +1E130..1E136 ; Extend # Mn [7] NYIAKENG PUACHUE HMONG TONE-B..NYIAKENG PUACHUE HMONG TONE-D +1E2EC..1E2EF ; Extend # Mn [4] WANCHO TONE TUP..WANCHO TONE KOINI 1E8D0..1E8D6 ; Extend # Mn [7] MENDE KIKAKUI COMBINING NUMBER TEENS..MENDE KIKAKUI COMBINING NUMBER MILLIONS 1E944..1E94A ; Extend # Mn [7] ADLAM ALIF LENGTHENER..ADLAM NUKTA 1F3FB..1F3FF ; Extend # Sk [5] EMOJI MODIFIER FITZPATRICK TYPE-1-2..EMOJI MODIFIER FITZPATRICK TYPE-6 E0020..E007F ; Extend # Cf [96] TAG SPACE..CANCEL TAG E0100..E01EF ; Extend # Mn [240] VARIATION SELECTOR-17..VARIATION SELECTOR-256 -# Total code points: 1948 +# Total code points: 1970 # ================================================ @@ -489,7 +495,6 @@ E0100..E01EF ; Extend # Mn [240] VARIATION SELECTOR-17..VARIATION SELECTOR-256 1A57 ; SpacingMark # Mc TAI THAM CONSONANT SIGN LA TANG LAI 1A6D..1A72 ; SpacingMark # Mc [6] TAI THAM VOWEL SIGN OY..TAI THAM VOWEL SIGN THAM AI 1B04 ; SpacingMark # Mc BALINESE SIGN BISAH -1B35 ; SpacingMark # Mc BALINESE VOWEL SIGN TEDUNG 1B3B ; SpacingMark # Mc BALINESE VOWEL SIGN RA REPA TEDUNG 1B3D..1B41 ; SpacingMark # Mc [5] BALINESE VOWEL SIGN LA LENGA TEDUNG..BALINESE VOWEL SIGN TALING REPA TEDUNG 1B43..1B44 ; SpacingMark # Mc [2] BALINESE VOWEL SIGN PEPET TEDUNG..BALINESE ADEG ADEG @@ -504,7 +509,6 @@ E0100..E01EF ; Extend # Mn [240] VARIATION SELECTOR-17..VARIATION SELECTOR-256 1C24..1C2B ; SpacingMark # Mc [8] LEPCHA SUBJOINED LETTER YA..LEPCHA VOWEL SIGN UU 1C34..1C35 ; SpacingMark # Mc [2] LEPCHA CONSONANT SIGN NYIN-DO..LEPCHA CONSONANT SIGN KANG 1CE1 ; SpacingMark # Mc VEDIC TONE ATHARVAVEDIC INDEPENDENT SVARITA -1CF2..1CF3 ; SpacingMark # Mc [2] VEDIC SIGN ARDHAVISARGA..VEDIC SIGN ROTATED ARDHAVISARGA 1CF7 ; SpacingMark # Mc VEDIC SIGN ATIKRAMA A823..A824 ; SpacingMark # Mc [2] SYLOTI NAGRI VOWEL SIGN A..SYLOTI NAGRI VOWEL SIGN I A827 ; SpacingMark # Mc SYLOTI NAGRI VOWEL SIGN OO @@ -514,7 +518,7 @@ A952..A953 ; SpacingMark # Mc [2] REJANG CONSONANT SIGN H..REJANG VIRAMA A983 ; SpacingMark # Mc JAVANESE SIGN WIGNYAN A9B4..A9B5 ; SpacingMark # Mc [2] JAVANESE VOWEL SIGN TARUNG..JAVANESE VOWEL SIGN TOLONG A9BA..A9BB ; SpacingMark # Mc [2] JAVANESE VOWEL SIGN TALING..JAVANESE VOWEL SIGN DIRGA MURE -A9BD..A9C0 ; SpacingMark # Mc [4] JAVANESE CONSONANT SIGN KERET..JAVANESE PANGKON +A9BE..A9C0 ; SpacingMark # Mc [3] JAVANESE CONSONANT SIGN PENGKAL..JAVANESE PANGKON AA2F..AA30 ; SpacingMark # Mc [2] CHAM VOWEL SIGN O..CHAM VOWEL SIGN AI AA33..AA34 ; SpacingMark # Mc [2] CHAM CONSONANT SIGN YA..CHAM CONSONANT SIGN RA AA4D ; SpacingMark # Mc CHAM CONSONANT SIGN FINAL H @@ -566,6 +570,9 @@ ABEC ; SpacingMark # Mc MEETEI MAYEK LUM IYEK 11726 ; SpacingMark # Mc AHOM VOWEL SIGN E 1182C..1182E ; SpacingMark # Mc [3] DOGRA VOWEL SIGN AA..DOGRA VOWEL SIGN II 11838 ; SpacingMark # Mc DOGRA SIGN VISARGA +119D1..119D3 ; SpacingMark # Mc [3] NANDINAGARI VOWEL SIGN AA..NANDINAGARI VOWEL SIGN II +119DC..119DF ; SpacingMark # Mc [4] NANDINAGARI VOWEL SIGN O..NANDINAGARI SIGN VISARGA +119E4 ; SpacingMark # Mc NANDINAGARI VOWEL SIGN PRISHTHAMATRA E 11A39 ; SpacingMark # Mc ZANABAZAR SQUARE SIGN VISARGA 11A57..11A58 ; SpacingMark # Mc [2] SOYOMBO VOWEL SIGN AI..SOYOMBO VOWEL SIGN AU 11A97 ; SpacingMark # Mc SOYOMBO SIGN VISARGA @@ -578,11 +585,11 @@ ABEC ; SpacingMark # Mc MEETEI MAYEK LUM IYEK 11D93..11D94 ; SpacingMark # Mc [2] GUNJALA GONDI VOWEL SIGN OO..GUNJALA GONDI VOWEL SIGN AU 11D96 ; SpacingMark # Mc GUNJALA GONDI SIGN VISARGA 11EF5..11EF6 ; SpacingMark # Mc [2] MAKASAR VOWEL SIGN E..MAKASAR VOWEL SIGN O -16F51..16F7E ; SpacingMark # Mc [46] MIAO SIGN ASPIRATION..MIAO VOWEL SIGN NG +16F51..16F87 ; SpacingMark # Mc [55] MIAO SIGN ASPIRATION..MIAO VOWEL SIGN UI 1D166 ; SpacingMark # Mc MUSICAL SYMBOL COMBINING SPRECHGESANG STEM 1D16D ; SpacingMark # Mc MUSICAL SYMBOL COMBINING AUGMENTATION DOT -# Total code points: 362 +# Total code points: 375 # ================================================ diff --git a/lib/stdlib/uc_spec/PropList.txt b/lib/stdlib/uc_spec/PropList.txt index ef86795abe..4394602fea 100644 --- a/lib/stdlib/uc_spec/PropList.txt +++ b/lib/stdlib/uc_spec/PropList.txt @@ -1,6 +1,6 @@ -# PropList-11.0.0.txt -# Date: 2018-03-15, 04:28:35 GMT -# © 2018 Unicode®, Inc. +# PropList-12.1.0.txt +# Date: 2019-03-10, 10:53:16 GMT +# © 2019 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # @@ -138,7 +138,7 @@ FF63 ; Quotation_Mark # Pe HALFWIDTH RIGHT CORNER BRACKET 0F0D..0F12 ; Terminal_Punctuation # Po [6] TIBETAN MARK SHAD..TIBETAN MARK RGYA GRAM SHAD 104A..104B ; Terminal_Punctuation # Po [2] MYANMAR SIGN LITTLE SECTION..MYANMAR SIGN SECTION 1361..1368 ; Terminal_Punctuation # Po [8] ETHIOPIC WORDSPACE..ETHIOPIC PARAGRAPH SEPARATOR -166D..166E ; Terminal_Punctuation # Po [2] CANADIAN SYLLABICS CHI SIGN..CANADIAN SYLLABICS FULL STOP +166E ; Terminal_Punctuation # Po CANADIAN SYLLABICS FULL STOP 16EB..16ED ; Terminal_Punctuation # Po [3] RUNIC SINGLE PUNCTUATION..RUNIC CROSS PUNCTUATION 1735..1736 ; Terminal_Punctuation # Po [2] PHILIPPINE SINGLE PUNCTUATION..PHILIPPINE DOUBLE PUNCTUATION 17D4..17D6 ; Terminal_Punctuation # Po [3] KHMER SIGN KHAN..KHMER SIGN CAMNUC PII KUUH @@ -157,7 +157,7 @@ FF63 ; Quotation_Mark # Pe HALFWIDTH RIGHT CORNER BRACKET 2E3C ; Terminal_Punctuation # Po STENOGRAPHIC FULL STOP 2E41 ; Terminal_Punctuation # Po REVERSED COMMA 2E4C ; Terminal_Punctuation # Po MEDIEVAL COMMA -2E4E ; Terminal_Punctuation # Po PUNCTUS ELEVATUS MARK +2E4E..2E4F ; Terminal_Punctuation # Po [2] PUNCTUS ELEVATUS MARK..CORNISH VERSE DIVIDER 3001..3002 ; Terminal_Punctuation # Po [2] IDEOGRAPHIC COMMA..IDEOGRAPHIC FULL STOP A4FE..A4FF ; Terminal_Punctuation # Po [2] LISU PUNCTUATION COMMA..LISU PUNCTUATION FULL STOP A60D..A60F ; Terminal_Punctuation # Po [3] VAI COMMA..VAI QUESTION MARK @@ -553,15 +553,17 @@ FF41..FF46 ; Hex_Digit # L& [6] FULLWIDTH LATIN SMALL LETTER A..FULLWIDTH L 1056..1057 ; Other_Alphabetic # Mc [2] MYANMAR VOWEL SIGN VOCALIC R..MYANMAR VOWEL SIGN VOCALIC RR 1058..1059 ; Other_Alphabetic # Mn [2] MYANMAR VOWEL SIGN VOCALIC L..MYANMAR VOWEL SIGN VOCALIC LL 105E..1060 ; Other_Alphabetic # Mn [3] MYANMAR CONSONANT SIGN MON MEDIAL NA..MYANMAR CONSONANT SIGN MON MEDIAL LA -1062 ; Other_Alphabetic # Mc MYANMAR VOWEL SIGN SGAW KAREN EU -1067..1068 ; Other_Alphabetic # Mc [2] MYANMAR VOWEL SIGN WESTERN PWO KAREN EU..MYANMAR VOWEL SIGN WESTERN PWO KAREN UE +1062..1064 ; Other_Alphabetic # Mc [3] MYANMAR VOWEL SIGN SGAW KAREN EU..MYANMAR TONE MARK SGAW KAREN KE PHO +1067..106D ; Other_Alphabetic # Mc [7] MYANMAR VOWEL SIGN WESTERN PWO KAREN EU..MYANMAR SIGN WESTERN PWO KAREN TONE-5 1071..1074 ; Other_Alphabetic # Mn [4] MYANMAR VOWEL SIGN GEBA KAREN I..MYANMAR VOWEL SIGN KAYAH EE 1082 ; Other_Alphabetic # Mn MYANMAR CONSONANT SIGN SHAN MEDIAL WA 1083..1084 ; Other_Alphabetic # Mc [2] MYANMAR VOWEL SIGN SHAN AA..MYANMAR VOWEL SIGN SHAN E 1085..1086 ; Other_Alphabetic # Mn [2] MYANMAR VOWEL SIGN SHAN E ABOVE..MYANMAR VOWEL SIGN SHAN FINAL Y -109C ; Other_Alphabetic # Mc MYANMAR VOWEL SIGN AITON A +1087..108C ; Other_Alphabetic # Mc [6] MYANMAR SIGN SHAN TONE-2..MYANMAR SIGN SHAN COUNCIL TONE-3 +108D ; Other_Alphabetic # Mn MYANMAR SIGN SHAN COUNCIL EMPHATIC TONE +108F ; Other_Alphabetic # Mc MYANMAR SIGN RUMAI PALAUNG TONE-5 +109A..109C ; Other_Alphabetic # Mc [3] MYANMAR SIGN KHAMTI TONE-1..MYANMAR VOWEL SIGN AITON A 109D ; Other_Alphabetic # Mn MYANMAR VOWEL SIGN AITON AI -135F ; Other_Alphabetic # Mn ETHIOPIC COMBINING GEMINATION MARK 1712..1713 ; Other_Alphabetic # Mn [2] TAGALOG VOWEL SIGN I..TAGALOG VOWEL SIGN U 1732..1733 ; Other_Alphabetic # Mn [2] HANUNOO VOWEL SIGN I..HANUNOO VOWEL SIGN U 1752..1753 ; Other_Alphabetic # Mn [2] BUHID VOWEL SIGN I..BUHID VOWEL SIGN U @@ -618,18 +620,21 @@ FF41..FF46 ; Hex_Digit # L& [6] FULLWIDTH LATIN SMALL LETTER A..FULLWIDTH L 1C24..1C2B ; Other_Alphabetic # Mc [8] LEPCHA SUBJOINED LETTER YA..LEPCHA VOWEL SIGN UU 1C2C..1C33 ; Other_Alphabetic # Mn [8] LEPCHA VOWEL SIGN E..LEPCHA CONSONANT SIGN T 1C34..1C35 ; Other_Alphabetic # Mc [2] LEPCHA CONSONANT SIGN NYIN-DO..LEPCHA CONSONANT SIGN KANG -1CF2..1CF3 ; Other_Alphabetic # Mc [2] VEDIC SIGN ARDHAVISARGA..VEDIC SIGN ROTATED ARDHAVISARGA +1C36 ; Other_Alphabetic # Mn LEPCHA SIGN RAN 1DE7..1DF4 ; Other_Alphabetic # Mn [14] COMBINING LATIN SMALL LETTER ALPHA..COMBINING LATIN SMALL LETTER U WITH DIAERESIS 24B6..24E9 ; Other_Alphabetic # So [52] CIRCLED LATIN CAPITAL LETTER A..CIRCLED LATIN SMALL LETTER Z 2DE0..2DFF ; Other_Alphabetic # Mn [32] COMBINING CYRILLIC LETTER BE..COMBINING CYRILLIC LETTER IOTIFIED BIG YUS A674..A67B ; Other_Alphabetic # Mn [8] COMBINING CYRILLIC LETTER UKRAINIAN IE..COMBINING CYRILLIC LETTER OMEGA A69E..A69F ; Other_Alphabetic # Mn [2] COMBINING CYRILLIC LETTER EF..COMBINING CYRILLIC LETTER IOTIFIED E +A802 ; Other_Alphabetic # Mn SYLOTI NAGRI SIGN DVISVARA +A80B ; Other_Alphabetic # Mn SYLOTI NAGRI SIGN ANUSVARA A823..A824 ; Other_Alphabetic # Mc [2] SYLOTI NAGRI VOWEL SIGN A..SYLOTI NAGRI VOWEL SIGN I A825..A826 ; Other_Alphabetic # Mn [2] SYLOTI NAGRI VOWEL SIGN U..SYLOTI NAGRI VOWEL SIGN E A827 ; Other_Alphabetic # Mc SYLOTI NAGRI VOWEL SIGN OO A880..A881 ; Other_Alphabetic # Mc [2] SAURASHTRA SIGN ANUSVARA..SAURASHTRA SIGN VISARGA A8B4..A8C3 ; Other_Alphabetic # Mc [16] SAURASHTRA CONSONANT SIGN HAARU..SAURASHTRA VOWEL SIGN AU A8C5 ; Other_Alphabetic # Mn SAURASHTRA SIGN CANDRABINDU +A8FF ; Other_Alphabetic # Mn DEVANAGARI VOWEL SIGN AY A926..A92A ; Other_Alphabetic # Mn [5] KAYAH LI VOWEL UE..KAYAH LI VOWEL O A947..A951 ; Other_Alphabetic # Mn [11] REJANG VOWEL SIGN I..REJANG CONSONANT SIGN R A952 ; Other_Alphabetic # Mc REJANG CONSONANT SIGN H @@ -638,8 +643,9 @@ A983 ; Other_Alphabetic # Mc JAVANESE SIGN WIGNYAN A9B4..A9B5 ; Other_Alphabetic # Mc [2] JAVANESE VOWEL SIGN TARUNG..JAVANESE VOWEL SIGN TOLONG A9B6..A9B9 ; Other_Alphabetic # Mn [4] JAVANESE VOWEL SIGN WULU..JAVANESE VOWEL SIGN SUKU MENDUT A9BA..A9BB ; Other_Alphabetic # Mc [2] JAVANESE VOWEL SIGN TALING..JAVANESE VOWEL SIGN DIRGA MURE -A9BC ; Other_Alphabetic # Mn JAVANESE VOWEL SIGN PEPET -A9BD..A9BF ; Other_Alphabetic # Mc [3] JAVANESE CONSONANT SIGN KERET..JAVANESE CONSONANT SIGN CAKRA +A9BC..A9BD ; Other_Alphabetic # Mn [2] JAVANESE VOWEL SIGN PEPET..JAVANESE CONSONANT SIGN KERET +A9BE..A9BF ; Other_Alphabetic # Mc [2] JAVANESE CONSONANT SIGN PENGKAL..JAVANESE CONSONANT SIGN CAKRA +A9E5 ; Other_Alphabetic # Mn MYANMAR SIGN SHAN SAW AA29..AA2E ; Other_Alphabetic # Mn [6] CHAM VOWEL SIGN AA..CHAM VOWEL SIGN OE AA2F..AA30 ; Other_Alphabetic # Mc [2] CHAM VOWEL SIGN O..CHAM VOWEL SIGN AI AA31..AA32 ; Other_Alphabetic # Mn [2] CHAM VOWEL SIGN AU..CHAM VOWEL SIGN UE @@ -648,6 +654,9 @@ AA35..AA36 ; Other_Alphabetic # Mn [2] CHAM CONSONANT SIGN LA..CHAM CONSONA AA43 ; Other_Alphabetic # Mn CHAM CONSONANT SIGN FINAL NG AA4C ; Other_Alphabetic # Mn CHAM CONSONANT SIGN FINAL M AA4D ; Other_Alphabetic # Mc CHAM CONSONANT SIGN FINAL H +AA7B ; Other_Alphabetic # Mc MYANMAR SIGN PAO KAREN TONE +AA7C ; Other_Alphabetic # Mn MYANMAR SIGN TAI LAING TONE-2 +AA7D ; Other_Alphabetic # Mc MYANMAR SIGN TAI LAING TONE-5 AAB0 ; Other_Alphabetic # Mn TAI VIET MAI KANG AAB2..AAB4 ; Other_Alphabetic # Mn [3] TAI VIET VOWEL I..TAI VIET VOWEL U AAB7..AAB8 ; Other_Alphabetic # Mn [2] TAI VIET MAI KHIT..TAI VIET VOWEL IA @@ -740,6 +749,11 @@ FB1E ; Other_Alphabetic # Mn HEBREW POINT JUDEO-SPANISH VARIKA 1182C..1182E ; Other_Alphabetic # Mc [3] DOGRA VOWEL SIGN AA..DOGRA VOWEL SIGN II 1182F..11837 ; Other_Alphabetic # Mn [9] DOGRA VOWEL SIGN U..DOGRA SIGN ANUSVARA 11838 ; Other_Alphabetic # Mc DOGRA SIGN VISARGA +119D1..119D3 ; Other_Alphabetic # Mc [3] NANDINAGARI VOWEL SIGN AA..NANDINAGARI VOWEL SIGN II +119D4..119D7 ; Other_Alphabetic # Mn [4] NANDINAGARI VOWEL SIGN U..NANDINAGARI VOWEL SIGN VOCALIC RR +119DA..119DB ; Other_Alphabetic # Mn [2] NANDINAGARI VOWEL SIGN E..NANDINAGARI VOWEL SIGN AI +119DC..119DF ; Other_Alphabetic # Mc [4] NANDINAGARI VOWEL SIGN O..NANDINAGARI SIGN VISARGA +119E4 ; Other_Alphabetic # Mc NANDINAGARI VOWEL SIGN PRISHTHAMATRA E 11A01..11A0A ; Other_Alphabetic # Mn [10] ZANABAZAR SQUARE VOWEL SIGN I..ZANABAZAR SQUARE VOWEL LENGTH MARK 11A35..11A38 ; Other_Alphabetic # Mn [4] ZANABAZAR SQUARE SIGN CANDRABINDU..ZANABAZAR SQUARE SIGN ANUSVARA 11A39 ; Other_Alphabetic # Mc ZANABAZAR SQUARE SIGN VISARGA @@ -773,8 +787,9 @@ FB1E ; Other_Alphabetic # Mn HEBREW POINT JUDEO-SPANISH VARIKA 11D96 ; Other_Alphabetic # Mc GUNJALA GONDI SIGN VISARGA 11EF3..11EF4 ; Other_Alphabetic # Mn [2] MAKASAR VOWEL SIGN I..MAKASAR VOWEL SIGN U 11EF5..11EF6 ; Other_Alphabetic # Mc [2] MAKASAR VOWEL SIGN E..MAKASAR VOWEL SIGN O -16B30..16B36 ; Other_Alphabetic # Mn [7] PAHAWH HMONG MARK CIM TUB..PAHAWH HMONG MARK CIM TAUM -16F51..16F7E ; Other_Alphabetic # Mc [46] MIAO SIGN ASPIRATION..MIAO VOWEL SIGN NG +16F4F ; Other_Alphabetic # Mn MIAO SIGN CONSONANT MODIFIER BAR +16F51..16F87 ; Other_Alphabetic # Mc [55] MIAO SIGN ASPIRATION..MIAO VOWEL SIGN UI +16F8F..16F92 ; Other_Alphabetic # Mn [4] MIAO TONE RIGHT..MIAO TONE BELOW 1BC9E ; Other_Alphabetic # Mn DUPLOYAN DOUBLE MARK 1E000..1E006 ; Other_Alphabetic # Mn [7] COMBINING GLAGOLITIC LETTER AZU..COMBINING GLAGOLITIC LETTER ZHIVETE 1E008..1E018 ; Other_Alphabetic # Mn [17] COMBINING GLAGOLITIC LETTER ZEMLJA..COMBINING GLAGOLITIC LETTER HERU @@ -786,7 +801,7 @@ FB1E ; Other_Alphabetic # Mn HEBREW POINT JUDEO-SPANISH VARIKA 1F150..1F169 ; Other_Alphabetic # So [26] NEGATIVE CIRCLED LATIN CAPITAL LETTER A..NEGATIVE CIRCLED LATIN CAPITAL LETTER Z 1F170..1F189 ; Other_Alphabetic # So [26] NEGATIVE SQUARED LATIN CAPITAL LETTER A..NEGATIVE SQUARED LATIN CAPITAL LETTER Z -# Total code points: 1334 +# Total code points: 1377 # ================================================ @@ -798,7 +813,7 @@ FB1E ; Other_Alphabetic # Mn HEBREW POINT JUDEO-SPANISH VARIKA 4E00..9FEF ; Ideographic # Lo [20976] CJK UNIFIED IDEOGRAPH-4E00..CJK UNIFIED IDEOGRAPH-9FEF F900..FA6D ; Ideographic # Lo [366] CJK COMPATIBILITY IDEOGRAPH-F900..CJK COMPATIBILITY IDEOGRAPH-FA6D FA70..FAD9 ; Ideographic # Lo [106] CJK COMPATIBILITY IDEOGRAPH-FA70..CJK COMPATIBILITY IDEOGRAPH-FAD9 -17000..187F1 ; Ideographic # Lo [6130] TANGUT IDEOGRAPH-17000..TANGUT IDEOGRAPH-187F1 +17000..187F7 ; Ideographic # Lo [6136] TANGUT IDEOGRAPH-17000..TANGUT IDEOGRAPH-187F7 18800..18AF2 ; Ideographic # Lo [755] TANGUT COMPONENT-001..TANGUT COMPONENT-755 1B170..1B2FB ; Ideographic # Lo [396] NUSHU CHARACTER-1B170..NUSHU CHARACTER-1B2FB 20000..2A6D6 ; Ideographic # Lo [42711] CJK UNIFIED IDEOGRAPH-20000..CJK UNIFIED IDEOGRAPH-2A6D6 @@ -808,7 +823,7 @@ FA70..FAD9 ; Ideographic # Lo [106] CJK COMPATIBILITY IDEOGRAPH-FA70..CJK COM 2CEB0..2EBE0 ; Ideographic # Lo [7473] CJK UNIFIED IDEOGRAPH-2CEB0..CJK UNIFIED IDEOGRAPH-2EBE0 2F800..2FA1D ; Ideographic # Lo [542] CJK COMPATIBILITY IDEOGRAPH-2F800..CJK COMPATIBILITY IDEOGRAPH-2FA1D -# Total code points: 96184 +# Total code points: 96190 # ================================================ @@ -876,6 +891,7 @@ FA70..FAD9 ; Ideographic # Lo [106] CJK COMPATIBILITY IDEOGRAPH-FA70..CJK COM 0DCA ; Diacritic # Mn SINHALA SIGN AL-LAKUNA 0E47..0E4C ; Diacritic # Mn [6] THAI CHARACTER MAITAIKHU..THAI CHARACTER THANTHAKHAT 0E4E ; Diacritic # Mn THAI CHARACTER YAMAKKAN +0EBA ; Diacritic # Mn LAO SIGN PALI VIRAMA 0EC8..0ECC ; Diacritic # Mn [5] LAO TONE MAI EK..LAO CANCELLATION MARK 0F18..0F19 ; Diacritic # Mn [2] TIBETAN ASTROLOGICAL SIGN -KHYUD PA..TIBETAN ASTROLOGICAL SIGN SDONG TSHUGS 0F35 ; Diacritic # Mn TIBETAN MARK NGAS BZUNG NYI ZLA @@ -887,10 +903,13 @@ FA70..FAD9 ; Ideographic # Lo [106] CJK COMPATIBILITY IDEOGRAPH-FA70..CJK COM 0FC6 ; Diacritic # Mn TIBETAN SYMBOL PADMA GDAN 1037 ; Diacritic # Mn MYANMAR SIGN DOT BELOW 1039..103A ; Diacritic # Mn [2] MYANMAR SIGN VIRAMA..MYANMAR SIGN ASAT +1063..1064 ; Diacritic # Mc [2] MYANMAR TONE MARK SGAW KAREN HATHI..MYANMAR TONE MARK SGAW KAREN KE PHO +1069..106D ; Diacritic # Mc [5] MYANMAR SIGN WESTERN PWO KAREN TONE-1..MYANMAR SIGN WESTERN PWO KAREN TONE-5 1087..108C ; Diacritic # Mc [6] MYANMAR SIGN SHAN TONE-2..MYANMAR SIGN SHAN COUNCIL TONE-3 108D ; Diacritic # Mn MYANMAR SIGN SHAN COUNCIL EMPHATIC TONE 108F ; Diacritic # Mc MYANMAR SIGN RUMAI PALAUNG TONE-5 109A..109B ; Diacritic # Mc [2] MYANMAR SIGN KHAMTI TONE-1..MYANMAR SIGN KHAMTI TONE-3 +135D..135F ; Diacritic # Mn [3] ETHIOPIC COMBINING GEMINATION AND VOWEL LENGTH MARK..ETHIOPIC COMBINING GEMINATION MARK 17C9..17D3 ; Diacritic # Mn [11] KHMER SIGN MUUSIKATOAN..KHMER SIGN BATHAMASAT 17DD ; Diacritic # Mn KHMER SIGN ATTHACAN 1939..193B ; Diacritic # Mn [3] LIMBU SIGN MUKPHRENG..LIMBU SIGN SA-I @@ -935,9 +954,11 @@ A67C..A67D ; Diacritic # Mn [2] COMBINING CYRILLIC KAVYKA..COMBINING CYRILL A67F ; Diacritic # Lm CYRILLIC PAYEROK A69C..A69D ; Diacritic # Lm [2] MODIFIER LETTER CYRILLIC HARD SIGN..MODIFIER LETTER CYRILLIC SOFT SIGN A6F0..A6F1 ; Diacritic # Mn [2] BAMUM COMBINING MARK KOQNDON..BAMUM COMBINING MARK TUKWENTIS +A700..A716 ; Diacritic # Sk [23] MODIFIER LETTER CHINESE TONE YIN PING..MODIFIER LETTER EXTRA-LOW LEFT-STEM TONE BAR A717..A71F ; Diacritic # Lm [9] MODIFIER LETTER DOT VERTICAL BAR..MODIFIER LETTER LOW INVERTED EXCLAMATION MARK A720..A721 ; Diacritic # Sk [2] MODIFIER LETTER STRESS AND HIGH TONE..MODIFIER LETTER STRESS AND LOW TONE A788 ; Diacritic # Lm MODIFIER LETTER LOW CIRCUMFLEX ACCENT +A789..A78A ; Diacritic # Sk [2] MODIFIER LETTER COLON..MODIFIER LETTER SHORT EQUALS SIGN A7F8..A7F9 ; Diacritic # Lm [2] MODIFIER LETTER CAPITAL H WITH STROKE..MODIFIER LETTER SMALL LIGATURE OE A8C4 ; Diacritic # Mn SAURASHTRA SIGN VIRAMA A8E0..A8F1 ; Diacritic # Mn [18] COMBINING DEVANAGARI DIGIT ZERO..COMBINING DEVANAGARI SIGN AVAGRAHA @@ -992,6 +1013,7 @@ FFE3 ; Diacritic # Sk FULLWIDTH MACRON 116B7 ; Diacritic # Mn TAKRI SIGN NUKTA 1172B ; Diacritic # Mn AHOM SIGN KILLER 11839..1183A ; Diacritic # Mn [2] DOGRA SIGN VIRAMA..DOGRA SIGN NUKTA +119E0 ; Diacritic # Mn NANDINAGARI SIGN VIRAMA 11A34 ; Diacritic # Mn ZANABAZAR SQUARE SIGN VIRAMA 11A47 ; Diacritic # Mn ZANABAZAR SQUARE SUBJOINER 11A99 ; Diacritic # Mn SOYOMBO SUBJOINER @@ -1000,6 +1022,7 @@ FFE3 ; Diacritic # Sk FULLWIDTH MACRON 11D44..11D45 ; Diacritic # Mn [2] MASARAM GONDI SIGN HALANTA..MASARAM GONDI VIRAMA 11D97 ; Diacritic # Mn GUNJALA GONDI VIRAMA 16AF0..16AF4 ; Diacritic # Mn [5] BASSA VAH COMBINING HIGH TONE..BASSA VAH COMBINING HIGH-LOW TONE +16B30..16B36 ; Diacritic # Mn [7] PAHAWH HMONG MARK CIM TUB..PAHAWH HMONG MARK CIM TAUM 16F8F..16F92 ; Diacritic # Mn [4] MIAO TONE RIGHT..MIAO TONE BELOW 16F93..16F9F ; Diacritic # Lm [13] MIAO LETTER TONE-2..MIAO LETTER REFORMED TONE-8 1D167..1D169 ; Diacritic # Mn [3] MUSICAL SYMBOL COMBINING TREMOLO-1..MUSICAL SYMBOL COMBINING TREMOLO-3 @@ -1007,11 +1030,13 @@ FFE3 ; Diacritic # Sk FULLWIDTH MACRON 1D17B..1D182 ; Diacritic # Mn [8] MUSICAL SYMBOL COMBINING ACCENT..MUSICAL SYMBOL COMBINING LOURE 1D185..1D18B ; Diacritic # Mn [7] MUSICAL SYMBOL COMBINING DOIT..MUSICAL SYMBOL COMBINING TRIPLE TONGUE 1D1AA..1D1AD ; Diacritic # Mn [4] MUSICAL SYMBOL COMBINING DOWN BOW..MUSICAL SYMBOL COMBINING SNAP PIZZICATO +1E130..1E136 ; Diacritic # Mn [7] NYIAKENG PUACHUE HMONG TONE-B..NYIAKENG PUACHUE HMONG TONE-D +1E2EC..1E2EF ; Diacritic # Mn [4] WANCHO TONE TUP..WANCHO TONE KOINI 1E8D0..1E8D6 ; Diacritic # Mn [7] MENDE KIKAKUI COMBINING NUMBER TEENS..MENDE KIKAKUI COMBINING NUMBER MILLIONS 1E944..1E946 ; Diacritic # Mn [3] ADLAM ALIF LENGTHENER..ADLAM GEMINATION MARK 1E948..1E94A ; Diacritic # Mn [3] ADLAM CONSONANT MODIFIER..ADLAM NUKTA -# Total code points: 818 +# Total code points: 873 # ================================================ @@ -1043,9 +1068,11 @@ FF70 ; Extender # Lm HALFWIDTH KATAKANA-HIRAGANA PROLONGED SOUND 11A98 ; Extender # Mn SOYOMBO GEMINATION MARK 16B42..16B43 ; Extender # Lm [2] PAHAWH HMONG SIGN VOS NRUA..PAHAWH HMONG SIGN IB YAM 16FE0..16FE1 ; Extender # Lm [2] TANGUT ITERATION MARK..NUSHU ITERATION MARK +16FE3 ; Extender # Lm OLD CHINESE ITERATION MARK +1E13C..1E13D ; Extender # Lm [2] NYIAKENG PUACHUE HMONG SIGN XW XW..NYIAKENG PUACHUE HMONG SYLLABLE LENGTHENER 1E944..1E946 ; Extender # Mn [3] ADLAM ALIF LENGTHENER..ADLAM GEMINATION MARK -# Total code points: 44 +# Total code points: 47 # ================================================ @@ -1119,6 +1146,7 @@ FFFFE..FFFFF ; Noncharacter_Code_Point # Cn [2] <noncharacter-FFFFE>..<noncha 0D57 ; Other_Grapheme_Extend # Mc MALAYALAM AU LENGTH MARK 0DCF ; Other_Grapheme_Extend # Mc SINHALA VOWEL SIGN AELA-PILLA 0DDF ; Other_Grapheme_Extend # Mc SINHALA VOWEL SIGN GAYANUKITTA +1B35 ; Other_Grapheme_Extend # Mc BALINESE VOWEL SIGN TEDUNG 200C ; Other_Grapheme_Extend # Cf ZERO WIDTH NON-JOINER 302E..302F ; Other_Grapheme_Extend # Mc [2] HANGUL SINGLE DOT TONE MARK..HANGUL DOUBLE DOT TONE MARK FF9E..FF9F ; Other_Grapheme_Extend # Lm [2] HALFWIDTH KATAKANA VOICED SOUND MARK..HALFWIDTH KATAKANA SEMI-VOICED SOUND MARK @@ -1131,7 +1159,7 @@ FF9E..FF9F ; Other_Grapheme_Extend # Lm [2] HALFWIDTH KATAKANA VOICED SOUND 1D16E..1D172 ; Other_Grapheme_Extend # Mc [5] MUSICAL SYMBOL COMBINING FLAG-1..MUSICAL SYMBOL COMBINING FLAG-5 E0020..E007F ; Other_Grapheme_Extend # Cf [96] TAG SPACE..CANCEL TAG -# Total code points: 125 +# Total code points: 126 # ================================================ @@ -1547,10 +1575,7 @@ E0100..E01EF ; Variation_Selector # Mn [240] VARIATION SELECTOR-17..VARIATION S 2B74..2B75 ; Pattern_Syntax # Cn [2] <reserved-2B74>..<reserved-2B75> 2B76..2B95 ; Pattern_Syntax # So [32] NORTH WEST TRIANGLE-HEADED ARROW TO BAR..RIGHTWARDS BLACK ARROW 2B96..2B97 ; Pattern_Syntax # Cn [2] <reserved-2B96>..<reserved-2B97> -2B98..2BC8 ; Pattern_Syntax # So [49] THREE-D TOP-LIGHTED LEFTWARDS EQUILATERAL ARROWHEAD..BLACK MEDIUM RIGHT-POINTING TRIANGLE CENTRED -2BC9 ; Pattern_Syntax # Cn <reserved-2BC9> -2BCA..2BFE ; Pattern_Syntax # So [53] TOP HALF BLACK CIRCLE..REVERSED RIGHT ANGLE -2BFF ; Pattern_Syntax # Cn <reserved-2BFF> +2B98..2BFF ; Pattern_Syntax # So [104] THREE-D TOP-LIGHTED LEFTWARDS EQUILATERAL ARROWHEAD..HELLSCHREIBER PAUSE SYMBOL 2E00..2E01 ; Pattern_Syntax # Po [2] RIGHT ANGLE SUBSTITUTION MARKER..RIGHT ANGLE DOTTED SUBSTITUTION MARKER 2E02 ; Pattern_Syntax # Pi LEFT SUBSTITUTION BRACKET 2E03 ; Pattern_Syntax # Pf RIGHT SUBSTITUTION BRACKET @@ -1588,8 +1613,8 @@ E0100..E01EF ; Variation_Selector # Mn [240] VARIATION SELECTOR-17..VARIATION S 2E40 ; Pattern_Syntax # Pd DOUBLE HYPHEN 2E41 ; Pattern_Syntax # Po REVERSED COMMA 2E42 ; Pattern_Syntax # Ps DOUBLE LOW-REVERSED-9 QUOTATION MARK -2E43..2E4E ; Pattern_Syntax # Po [12] DASH WITH LEFT UPTURN..PUNCTUS ELEVATUS MARK -2E4F..2E7F ; Pattern_Syntax # Cn [49] <reserved-2E4F>..<reserved-2E7F> +2E43..2E4F ; Pattern_Syntax # Po [13] DASH WITH LEFT UPTURN..CORNISH VERSE DIVIDER +2E50..2E7F ; Pattern_Syntax # Cn [48] <reserved-2E50>..<reserved-2E7F> 3001..3003 ; Pattern_Syntax # Po [3] IDEOGRAPHIC COMMA..DITTO MARK 3008 ; Pattern_Syntax # Ps LEFT ANGLE BRACKET 3009 ; Pattern_Syntax # Pe RIGHT ANGLE BRACKET diff --git a/lib/stdlib/uc_spec/README-UPDATE.txt b/lib/stdlib/uc_spec/README-UPDATE.txt index e1f5c8fcd0..73274e512a 100644 --- a/lib/stdlib/uc_spec/README-UPDATE.txt +++ b/lib/stdlib/uc_spec/README-UPDATE.txt @@ -2,12 +2,10 @@ When updating the unicode version copy the necessary files to this directory. And update the test files in stdlib/test/unicode_util_SUITE_data/* -Unicode 11 was updated from: -https://www.unicode.org/Public/11.0.0/ucd/ -https://www.unicode.org/Public/11.0.0/ucd/auxiliary/ -https://www.unicode.org/Public/emoji/11.0/ +Unicode 12.1 was updated from: +https://www.unicode.org/Public/12.1.0/ucd/ +https://www.unicode.org/Public/12.1.0/ucd/auxiliary/ +https://www.unicode.org/Public/emoji/12.0/ Update the spec_version(..) function in the generator, gen_unicode_mod.escript - - diff --git a/lib/stdlib/uc_spec/SpecialCasing.txt b/lib/stdlib/uc_spec/SpecialCasing.txt index c90d09acb3..1c04aacf97 100644 --- a/lib/stdlib/uc_spec/SpecialCasing.txt +++ b/lib/stdlib/uc_spec/SpecialCasing.txt @@ -1,6 +1,6 @@ -# SpecialCasing-11.0.0.txt -# Date: 2018-02-22, 06:16:47 GMT -# © 2018 Unicode®, Inc. +# SpecialCasing-12.1.0.txt +# Date: 2019-03-10, 10:53:28 GMT +# © 2019 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # diff --git a/lib/stdlib/uc_spec/UnicodeData.txt b/lib/stdlib/uc_spec/UnicodeData.txt index ec32fafbce..e65aec52f7 100644 --- a/lib/stdlib/uc_spec/UnicodeData.txt +++ b/lib/stdlib/uc_spec/UnicodeData.txt @@ -640,7 +640,7 @@ 027F;LATIN SMALL LETTER REVERSED R WITH FISHHOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER REVERSED FISHHOOK R;;;; 0280;LATIN LETTER SMALL CAPITAL R;Ll;0;L;;;;;N;;;01A6;;01A6 0281;LATIN LETTER SMALL CAPITAL INVERTED R;Ll;0;L;;;;;N;;;;; -0282;LATIN SMALL LETTER S WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER S HOOK;;;; +0282;LATIN SMALL LETTER S WITH HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER S HOOK;;A7C5;;A7C5 0283;LATIN SMALL LETTER ESH;Ll;0;L;;;;;N;;;01A9;;01A9 0284;LATIN SMALL LETTER DOTLESS J WITH STROKE AND HOOK;Ll;0;L;;;;;N;LATIN SMALL LETTER DOTLESS J BAR HOOK;;;; 0285;LATIN SMALL LETTER SQUAT REVERSED ESH;Ll;0;L;;;;;N;;;;; @@ -2809,6 +2809,7 @@ 0C6D;TELUGU DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;; 0C6E;TELUGU DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;; 0C6F;TELUGU DIGIT NINE;Nd;0;L;;9;9;9;N;;;;; +0C77;TELUGU SIGN SIDDHAM;Po;0;L;;;;;N;;;;; 0C78;TELUGU FRACTION DIGIT ZERO FOR ODD POWERS OF FOUR;No;0;ON;;;;0;N;;;;; 0C79;TELUGU FRACTION DIGIT ONE FOR ODD POWERS OF FOUR;No;0;ON;;;;1;N;;;;; 0C7A;TELUGU FRACTION DIGIT TWO FOR ODD POWERS OF FOUR;No;0;ON;;;;2;N;;;;; @@ -3203,14 +3204,24 @@ 0E81;LAO LETTER KO;Lo;0;L;;;;;N;;;;; 0E82;LAO LETTER KHO SUNG;Lo;0;L;;;;;N;;;;; 0E84;LAO LETTER KHO TAM;Lo;0;L;;;;;N;;;;; +0E86;LAO LETTER PALI GHA;Lo;0;L;;;;;N;;;;; 0E87;LAO LETTER NGO;Lo;0;L;;;;;N;;;;; 0E88;LAO LETTER CO;Lo;0;L;;;;;N;;;;; +0E89;LAO LETTER PALI CHA;Lo;0;L;;;;;N;;;;; 0E8A;LAO LETTER SO TAM;Lo;0;L;;;;;N;;;;; +0E8C;LAO LETTER PALI JHA;Lo;0;L;;;;;N;;;;; 0E8D;LAO LETTER NYO;Lo;0;L;;;;;N;;;;; +0E8E;LAO LETTER PALI NYA;Lo;0;L;;;;;N;;;;; +0E8F;LAO LETTER PALI TTA;Lo;0;L;;;;;N;;;;; +0E90;LAO LETTER PALI TTHA;Lo;0;L;;;;;N;;;;; +0E91;LAO LETTER PALI DDA;Lo;0;L;;;;;N;;;;; +0E92;LAO LETTER PALI DDHA;Lo;0;L;;;;;N;;;;; +0E93;LAO LETTER PALI NNA;Lo;0;L;;;;;N;;;;; 0E94;LAO LETTER DO;Lo;0;L;;;;;N;;;;; 0E95;LAO LETTER TO;Lo;0;L;;;;;N;;;;; 0E96;LAO LETTER THO SUNG;Lo;0;L;;;;;N;;;;; 0E97;LAO LETTER THO TAM;Lo;0;L;;;;;N;;;;; +0E98;LAO LETTER PALI DHA;Lo;0;L;;;;;N;;;;; 0E99;LAO LETTER NO;Lo;0;L;;;;;N;;;;; 0E9A;LAO LETTER BO;Lo;0;L;;;;;N;;;;; 0E9B;LAO LETTER PO;Lo;0;L;;;;;N;;;;; @@ -3218,13 +3229,17 @@ 0E9D;LAO LETTER FO TAM;Lo;0;L;;;;;N;;;;; 0E9E;LAO LETTER PHO TAM;Lo;0;L;;;;;N;;;;; 0E9F;LAO LETTER FO SUNG;Lo;0;L;;;;;N;;;;; +0EA0;LAO LETTER PALI BHA;Lo;0;L;;;;;N;;;;; 0EA1;LAO LETTER MO;Lo;0;L;;;;;N;;;;; 0EA2;LAO LETTER YO;Lo;0;L;;;;;N;;;;; 0EA3;LAO LETTER LO LING;Lo;0;L;;;;;N;;;;; 0EA5;LAO LETTER LO LOOT;Lo;0;L;;;;;N;;;;; 0EA7;LAO LETTER WO;Lo;0;L;;;;;N;;;;; +0EA8;LAO LETTER SANSKRIT SHA;Lo;0;L;;;;;N;;;;; +0EA9;LAO LETTER SANSKRIT SSA;Lo;0;L;;;;;N;;;;; 0EAA;LAO LETTER SO SUNG;Lo;0;L;;;;;N;;;;; 0EAB;LAO LETTER HO SUNG;Lo;0;L;;;;;N;;;;; +0EAC;LAO LETTER PALI LLA;Lo;0;L;;;;;N;;;;; 0EAD;LAO LETTER O;Lo;0;L;;;;;N;;;;; 0EAE;LAO LETTER HO TAM;Lo;0;L;;;;;N;;;;; 0EAF;LAO ELLIPSIS;Lo;0;L;;;;;N;;;;; @@ -3238,6 +3253,7 @@ 0EB7;LAO VOWEL SIGN YY;Mn;0;NSM;;;;;N;;;;; 0EB8;LAO VOWEL SIGN U;Mn;118;NSM;;;;;N;;;;; 0EB9;LAO VOWEL SIGN UU;Mn;118;NSM;;;;;N;;;;; +0EBA;LAO SIGN PALI VIRAMA;Mn;9;NSM;;;;;N;;;;; 0EBB;LAO VOWEL SIGN MAI KON;Mn;0;NSM;;;;;N;;;;; 0EBC;LAO SEMIVOWEL SIGN LO;Mn;0;NSM;;;;;N;;;;; 0EBD;LAO SEMIVOWEL SIGN NYO;Lo;0;L;;;;;N;;;;; @@ -5079,7 +5095,7 @@ 166A;CANADIAN SYLLABICS CARRIER TTSEE;Lo;0;L;;;;;N;;;;; 166B;CANADIAN SYLLABICS CARRIER TTSI;Lo;0;L;;;;;N;;;;; 166C;CANADIAN SYLLABICS CARRIER TTSA;Lo;0;L;;;;;N;;;;; -166D;CANADIAN SYLLABICS CHI SIGN;Po;0;L;;;;;N;;;;; +166D;CANADIAN SYLLABICS CHI SIGN;So;0;L;;;;;N;;;;; 166E;CANADIAN SYLLABICS FULL STOP;Po;0;L;;;;;N;;;;; 166F;CANADIAN SYLLABICS QAI;Lo;0;L;;;;;N;;;;; 1670;CANADIAN SYLLABICS NGAI;Lo;0;L;;;;;N;;;;; @@ -6488,14 +6504,15 @@ 1CEF;VEDIC SIGN LONG ANUSVARA;Lo;0;L;;;;;N;;;;; 1CF0;VEDIC SIGN RTHANG LONG ANUSVARA;Lo;0;L;;;;;N;;;;; 1CF1;VEDIC SIGN ANUSVARA UBHAYATO MUKHA;Lo;0;L;;;;;N;;;;; -1CF2;VEDIC SIGN ARDHAVISARGA;Mc;0;L;;;;;N;;;;; -1CF3;VEDIC SIGN ROTATED ARDHAVISARGA;Mc;0;L;;;;;N;;;;; +1CF2;VEDIC SIGN ARDHAVISARGA;Lo;0;L;;;;;N;;;;; +1CF3;VEDIC SIGN ROTATED ARDHAVISARGA;Lo;0;L;;;;;N;;;;; 1CF4;VEDIC TONE CANDRA ABOVE;Mn;230;NSM;;;;;N;;;;; 1CF5;VEDIC SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;; 1CF6;VEDIC SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;; 1CF7;VEDIC SIGN ATIKRAMA;Mc;0;L;;;;;N;;;;; 1CF8;VEDIC TONE RING ABOVE;Mn;230;NSM;;;;;N;;;;; 1CF9;VEDIC TONE DOUBLE RING ABOVE;Mn;230;NSM;;;;;N;;;;; +1CFA;VEDIC SIGN DOUBLE ANUSVARA ANTARGOMUKHA;Lo;0;L;;;;;N;;;;; 1D00;LATIN LETTER SMALL CAPITAL A;Ll;0;L;;;;;N;;;;; 1D01;LATIN LETTER SMALL CAPITAL AE;Ll;0;L;;;;;N;;;;; 1D02;LATIN SMALL LETTER TURNED AE;Ll;0;L;;;;;N;;;;; @@ -6638,7 +6655,7 @@ 1D8B;LATIN SMALL LETTER ESH WITH PALATAL HOOK;Ll;0;L;;;;;N;;;;; 1D8C;LATIN SMALL LETTER V WITH PALATAL HOOK;Ll;0;L;;;;;N;;;;; 1D8D;LATIN SMALL LETTER X WITH PALATAL HOOK;Ll;0;L;;;;;N;;;;; -1D8E;LATIN SMALL LETTER Z WITH PALATAL HOOK;Ll;0;L;;;;;N;;;;; +1D8E;LATIN SMALL LETTER Z WITH PALATAL HOOK;Ll;0;L;;;;;N;;;A7C6;;A7C6 1D8F;LATIN SMALL LETTER A WITH RETROFLEX HOOK;Ll;0;L;;;;;N;;;;; 1D90;LATIN SMALL LETTER ALPHA WITH RETROFLEX HOOK;Ll;0;L;;;;;N;;;;; 1D91;LATIN SMALL LETTER D WITH HOOK AND TAIL;Ll;0;L;;;;;N;;;;; @@ -10165,6 +10182,7 @@ 2BC6;BLACK MEDIUM DOWN-POINTING TRIANGLE CENTRED;So;0;ON;;;;;N;;;;; 2BC7;BLACK MEDIUM LEFT-POINTING TRIANGLE CENTRED;So;0;ON;;;;;N;;;;; 2BC8;BLACK MEDIUM RIGHT-POINTING TRIANGLE CENTRED;So;0;ON;;;;;N;;;;; +2BC9;NEPTUNE FORM TWO;So;0;ON;;;;;N;;;;; 2BCA;TOP HALF BLACK CIRCLE;So;0;ON;;;;;N;;;;; 2BCB;BOTTOM HALF BLACK CIRCLE;So;0;ON;;;;;N;;;;; 2BCC;LIGHT FOUR POINTED BLACK CUSP;So;0;ON;;;;;N;;;;; @@ -10218,6 +10236,7 @@ 2BFC;DOUBLED SYMBOL;So;0;ON;;;;;N;;;;; 2BFD;PASSED SYMBOL;So;0;ON;;;;;N;;;;; 2BFE;REVERSED RIGHT ANGLE;So;0;ON;;;;;Y;;;;; +2BFF;HELLSCHREIBER PAUSE SYMBOL;So;0;ON;;;;;N;;;;; 2C00;GLAGOLITIC CAPITAL LETTER AZU;Lu;0;L;;;;;N;;;;2C30; 2C01;GLAGOLITIC CAPITAL LETTER BUKY;Lu;0;L;;;;;N;;;;2C31; 2C02;GLAGOLITIC CAPITAL LETTER VEDE;Lu;0;L;;;;;N;;;;2C32; @@ -10756,6 +10775,7 @@ 2E4C;MEDIEVAL COMMA;Po;0;ON;;;;;N;;;;; 2E4D;PARAGRAPHUS MARK;Po;0;ON;;;;;N;;;;; 2E4E;PUNCTUS ELEVATUS MARK;Po;0;ON;;;;;N;;;;; +2E4F;CORNISH VERSE DIVIDER;Po;0;ON;;;;;N;;;;; 2E80;CJK RADICAL REPEAT;So;0;ON;;;;;N;;;;; 2E81;CJK RADICAL CLIFF;So;0;ON;;;;;N;;;;; 2E82;CJK RADICAL SECOND ONE;So;0;ON;;;;;N;;;;; @@ -11836,6 +11856,7 @@ 32FC;CIRCLED KATAKANA WI;So;0;L;<circle> 30F0;;;;N;;;;; 32FD;CIRCLED KATAKANA WE;So;0;L;<circle> 30F1;;;;N;;;;; 32FE;CIRCLED KATAKANA WO;So;0;L;<circle> 30F2;;;;N;;;;; +32FF;SQUARE ERA NAME REIWA;So;0;L;<square> 4EE4 548C;;;;N;;;;; 3300;SQUARE APAATO;So;0;L;<square> 30A2 30D1 30FC 30C8;;;;N;SQUARED APAATO;;;; 3301;SQUARE ARUHUA;So;0;L;<square> 30A2 30EB 30D5 30A1;;;;N;SQUARED ARUHUA;;;; 3302;SQUARE ANPEA;So;0;L;<square> 30A2 30F3 30DA 30A2;;;;N;SQUARED ANPEA;;;; @@ -14060,7 +14081,7 @@ A790;LATIN CAPITAL LETTER N WITH DESCENDER;Lu;0;L;;;;;N;;;;A791; A791;LATIN SMALL LETTER N WITH DESCENDER;Ll;0;L;;;;;N;;;A790;;A790 A792;LATIN CAPITAL LETTER C WITH BAR;Lu;0;L;;;;;N;;;;A793; A793;LATIN SMALL LETTER C WITH BAR;Ll;0;L;;;;;N;;;A792;;A792 -A794;LATIN SMALL LETTER C WITH PALATAL HOOK;Ll;0;L;;;;;N;;;;; +A794;LATIN SMALL LETTER C WITH PALATAL HOOK;Ll;0;L;;;;;N;;;A7C4;;A7C4 A795;LATIN SMALL LETTER H WITH PALATAL HOOK;Ll;0;L;;;;;N;;;;; A796;LATIN CAPITAL LETTER B WITH FLOURISH;Lu;0;L;;;;;N;;;;A797; A797;LATIN SMALL LETTER B WITH FLOURISH;Ll;0;L;;;;;N;;;A796;;A796 @@ -14098,6 +14119,17 @@ A7B6;LATIN CAPITAL LETTER OMEGA;Lu;0;L;;;;;N;;;;A7B7; A7B7;LATIN SMALL LETTER OMEGA;Ll;0;L;;;;;N;;;A7B6;;A7B6 A7B8;LATIN CAPITAL LETTER U WITH STROKE;Lu;0;L;;;;;N;;;;A7B9; A7B9;LATIN SMALL LETTER U WITH STROKE;Ll;0;L;;;;;N;;;A7B8;;A7B8 +A7BA;LATIN CAPITAL LETTER GLOTTAL A;Lu;0;L;;;;;N;;;;A7BB; +A7BB;LATIN SMALL LETTER GLOTTAL A;Ll;0;L;;;;;N;;;A7BA;;A7BA +A7BC;LATIN CAPITAL LETTER GLOTTAL I;Lu;0;L;;;;;N;;;;A7BD; +A7BD;LATIN SMALL LETTER GLOTTAL I;Ll;0;L;;;;;N;;;A7BC;;A7BC +A7BE;LATIN CAPITAL LETTER GLOTTAL U;Lu;0;L;;;;;N;;;;A7BF; +A7BF;LATIN SMALL LETTER GLOTTAL U;Ll;0;L;;;;;N;;;A7BE;;A7BE +A7C2;LATIN CAPITAL LETTER ANGLICANA W;Lu;0;L;;;;;N;;;;A7C3; +A7C3;LATIN SMALL LETTER ANGLICANA W;Ll;0;L;;;;;N;;;A7C2;;A7C2 +A7C4;LATIN CAPITAL LETTER C WITH PALATAL HOOK;Lu;0;L;;;;;N;;;;A794; +A7C5;LATIN CAPITAL LETTER S WITH HOOK;Lu;0;L;;;;;N;;;;0282; +A7C6;LATIN CAPITAL LETTER Z WITH PALATAL HOOK;Lu;0;L;;;;;N;;;;1D8E; A7F7;LATIN EPIGRAPHIC LETTER SIDEWAYS I;Lo;0;L;;;;;N;;;;; A7F8;MODIFIER LETTER CAPITAL H WITH STROKE;Lm;0;L;<super> 0126;;;;N;;;;; A7F9;MODIFIER LETTER SMALL LIGATURE OE;Lm;0;L;<super> 0153;;;;N;;;;; @@ -14506,7 +14538,7 @@ A9B9;JAVANESE VOWEL SIGN SUKU MENDUT;Mn;0;NSM;;;;;N;;;;; A9BA;JAVANESE VOWEL SIGN TALING;Mc;0;L;;;;;N;;;;; A9BB;JAVANESE VOWEL SIGN DIRGA MURE;Mc;0;L;;;;;N;;;;; A9BC;JAVANESE VOWEL SIGN PEPET;Mn;0;NSM;;;;;N;;;;; -A9BD;JAVANESE CONSONANT SIGN KERET;Mc;0;L;;;;;N;;;;; +A9BD;JAVANESE CONSONANT SIGN KERET;Mn;0;NSM;;;;;N;;;;; A9BE;JAVANESE CONSONANT SIGN PENGKAL;Mc;0;L;;;;;N;;;;; A9BF;JAVANESE CONSONANT SIGN CAKRA;Mc;0;L;;;;;N;;;;; A9C0;JAVANESE PANGKON;Mc;9;L;;;;;N;;;;; @@ -14863,6 +14895,8 @@ AB62;LATIN SMALL LETTER OPEN OE;Ll;0;L;;;;;N;;;;; AB63;LATIN SMALL LETTER UO;Ll;0;L;;;;;N;;;;; AB64;LATIN SMALL LETTER INVERTED ALPHA;Ll;0;L;;;;;N;;;;; AB65;GREEK LETTER SMALL CAPITAL OMEGA;Ll;0;L;;;;;N;;;;; +AB66;LATIN SMALL LETTER DZ DIGRAPH WITH RETROFLEX HOOK;Ll;0;L;;;;;N;;;;; +AB67;LATIN SMALL LETTER TS DIGRAPH WITH RETROFLEX HOOK;Ll;0;L;;;;;N;;;;; AB70;CHEROKEE SMALL LETTER A;Ll;0;L;;;;;N;;;13A0;;13A0 AB71;CHEROKEE SMALL LETTER E;Ll;0;L;;;;;N;;;13A1;;13A1 AB72;CHEROKEE SMALL LETTER I;Ll;0;L;;;;;N;;;13A2;;13A2 @@ -19105,6 +19139,29 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 10F57;SOGDIAN PUNCTUATION CIRCLE WITH DOT;Po;0;AL;;;;;N;;;;; 10F58;SOGDIAN PUNCTUATION TWO CIRCLES WITH DOTS;Po;0;AL;;;;;N;;;;; 10F59;SOGDIAN PUNCTUATION HALF CIRCLE WITH DOT;Po;0;AL;;;;;N;;;;; +10FE0;ELYMAIC LETTER ALEPH;Lo;0;R;;;;;N;;;;; +10FE1;ELYMAIC LETTER BETH;Lo;0;R;;;;;N;;;;; +10FE2;ELYMAIC LETTER GIMEL;Lo;0;R;;;;;N;;;;; +10FE3;ELYMAIC LETTER DALETH;Lo;0;R;;;;;N;;;;; +10FE4;ELYMAIC LETTER HE;Lo;0;R;;;;;N;;;;; +10FE5;ELYMAIC LETTER WAW;Lo;0;R;;;;;N;;;;; +10FE6;ELYMAIC LETTER ZAYIN;Lo;0;R;;;;;N;;;;; +10FE7;ELYMAIC LETTER HETH;Lo;0;R;;;;;N;;;;; +10FE8;ELYMAIC LETTER TETH;Lo;0;R;;;;;N;;;;; +10FE9;ELYMAIC LETTER YODH;Lo;0;R;;;;;N;;;;; +10FEA;ELYMAIC LETTER KAPH;Lo;0;R;;;;;N;;;;; +10FEB;ELYMAIC LETTER LAMEDH;Lo;0;R;;;;;N;;;;; +10FEC;ELYMAIC LETTER MEM;Lo;0;R;;;;;N;;;;; +10FED;ELYMAIC LETTER NUN;Lo;0;R;;;;;N;;;;; +10FEE;ELYMAIC LETTER SAMEKH;Lo;0;R;;;;;N;;;;; +10FEF;ELYMAIC LETTER AYIN;Lo;0;R;;;;;N;;;;; +10FF0;ELYMAIC LETTER PE;Lo;0;R;;;;;N;;;;; +10FF1;ELYMAIC LETTER SADHE;Lo;0;R;;;;;N;;;;; +10FF2;ELYMAIC LETTER QOPH;Lo;0;R;;;;;N;;;;; +10FF3;ELYMAIC LETTER RESH;Lo;0;R;;;;;N;;;;; +10FF4;ELYMAIC LETTER SHIN;Lo;0;R;;;;;N;;;;; +10FF5;ELYMAIC LETTER TAW;Lo;0;R;;;;;N;;;;; +10FF6;ELYMAIC LIGATURE ZAYIN-YODH;Lo;0;R;;;;;N;;;;; 11000;BRAHMI SIGN CANDRABINDU;Mc;0;L;;;;;N;;;;; 11001;BRAHMI SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;; 11002;BRAHMI SIGN VISARGA;Mc;0;L;;;;;N;;;;; @@ -19887,6 +19944,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1145B;NEWA PLACEHOLDER MARK;Po;0;L;;;;;N;;;;; 1145D;NEWA INSERTION SIGN;Po;0;L;;;;;N;;;;; 1145E;NEWA SANDHI MARK;Mn;230;NSM;;;;;N;;;;; +1145F;NEWA LETTER VEDIC ANUSVARA;Lo;0;L;;;;;N;;;;; 11480;TIRHUTA ANJI;Lo;0;L;;;;;N;;;;; 11481;TIRHUTA LETTER A;Lo;0;L;;;;;N;;;;; 11482;TIRHUTA LETTER AA;Lo;0;L;;;;;N;;;;; @@ -20209,6 +20267,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 116B5;TAKRI VOWEL SIGN AU;Mn;0;NSM;;;;;N;;;;; 116B6;TAKRI SIGN VIRAMA;Mc;9;L;;;;;N;;;;; 116B7;TAKRI SIGN NUKTA;Mn;7;NSM;;;;;N;;;;; +116B8;TAKRI LETTER ARCHAIC KHA;Lo;0;L;;;;;N;;;;; 116C0;TAKRI DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;; 116C1;TAKRI DIGIT ONE;Nd;0;L;;1;1;1;N;;;;; 116C2;TAKRI DIGIT TWO;Nd;0;L;;2;2;2;N;;;;; @@ -20421,6 +20480,71 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 118F1;WARANG CITI NUMBER EIGHTY;No;0;L;;;;80;N;;;;; 118F2;WARANG CITI NUMBER NINETY;No;0;L;;;;90;N;;;;; 118FF;WARANG CITI OM;Lo;0;L;;;;;N;;;;; +119A0;NANDINAGARI LETTER A;Lo;0;L;;;;;N;;;;; +119A1;NANDINAGARI LETTER AA;Lo;0;L;;;;;N;;;;; +119A2;NANDINAGARI LETTER I;Lo;0;L;;;;;N;;;;; +119A3;NANDINAGARI LETTER II;Lo;0;L;;;;;N;;;;; +119A4;NANDINAGARI LETTER U;Lo;0;L;;;;;N;;;;; +119A5;NANDINAGARI LETTER UU;Lo;0;L;;;;;N;;;;; +119A6;NANDINAGARI LETTER VOCALIC R;Lo;0;L;;;;;N;;;;; +119A7;NANDINAGARI LETTER VOCALIC RR;Lo;0;L;;;;;N;;;;; +119AA;NANDINAGARI LETTER E;Lo;0;L;;;;;N;;;;; +119AB;NANDINAGARI LETTER AI;Lo;0;L;;;;;N;;;;; +119AC;NANDINAGARI LETTER O;Lo;0;L;;;;;N;;;;; +119AD;NANDINAGARI LETTER AU;Lo;0;L;;;;;N;;;;; +119AE;NANDINAGARI LETTER KA;Lo;0;L;;;;;N;;;;; +119AF;NANDINAGARI LETTER KHA;Lo;0;L;;;;;N;;;;; +119B0;NANDINAGARI LETTER GA;Lo;0;L;;;;;N;;;;; +119B1;NANDINAGARI LETTER GHA;Lo;0;L;;;;;N;;;;; +119B2;NANDINAGARI LETTER NGA;Lo;0;L;;;;;N;;;;; +119B3;NANDINAGARI LETTER CA;Lo;0;L;;;;;N;;;;; +119B4;NANDINAGARI LETTER CHA;Lo;0;L;;;;;N;;;;; +119B5;NANDINAGARI LETTER JA;Lo;0;L;;;;;N;;;;; +119B6;NANDINAGARI LETTER JHA;Lo;0;L;;;;;N;;;;; +119B7;NANDINAGARI LETTER NYA;Lo;0;L;;;;;N;;;;; +119B8;NANDINAGARI LETTER TTA;Lo;0;L;;;;;N;;;;; +119B9;NANDINAGARI LETTER TTHA;Lo;0;L;;;;;N;;;;; +119BA;NANDINAGARI LETTER DDA;Lo;0;L;;;;;N;;;;; +119BB;NANDINAGARI LETTER DDHA;Lo;0;L;;;;;N;;;;; +119BC;NANDINAGARI LETTER NNA;Lo;0;L;;;;;N;;;;; +119BD;NANDINAGARI LETTER TA;Lo;0;L;;;;;N;;;;; +119BE;NANDINAGARI LETTER THA;Lo;0;L;;;;;N;;;;; +119BF;NANDINAGARI LETTER DA;Lo;0;L;;;;;N;;;;; +119C0;NANDINAGARI LETTER DHA;Lo;0;L;;;;;N;;;;; +119C1;NANDINAGARI LETTER NA;Lo;0;L;;;;;N;;;;; +119C2;NANDINAGARI LETTER PA;Lo;0;L;;;;;N;;;;; +119C3;NANDINAGARI LETTER PHA;Lo;0;L;;;;;N;;;;; +119C4;NANDINAGARI LETTER BA;Lo;0;L;;;;;N;;;;; +119C5;NANDINAGARI LETTER BHA;Lo;0;L;;;;;N;;;;; +119C6;NANDINAGARI LETTER MA;Lo;0;L;;;;;N;;;;; +119C7;NANDINAGARI LETTER YA;Lo;0;L;;;;;N;;;;; +119C8;NANDINAGARI LETTER RA;Lo;0;L;;;;;N;;;;; +119C9;NANDINAGARI LETTER LA;Lo;0;L;;;;;N;;;;; +119CA;NANDINAGARI LETTER VA;Lo;0;L;;;;;N;;;;; +119CB;NANDINAGARI LETTER SHA;Lo;0;L;;;;;N;;;;; +119CC;NANDINAGARI LETTER SSA;Lo;0;L;;;;;N;;;;; +119CD;NANDINAGARI LETTER SA;Lo;0;L;;;;;N;;;;; +119CE;NANDINAGARI LETTER HA;Lo;0;L;;;;;N;;;;; +119CF;NANDINAGARI LETTER LLA;Lo;0;L;;;;;N;;;;; +119D0;NANDINAGARI LETTER RRA;Lo;0;L;;;;;N;;;;; +119D1;NANDINAGARI VOWEL SIGN AA;Mc;0;L;;;;;N;;;;; +119D2;NANDINAGARI VOWEL SIGN I;Mc;0;L;;;;;N;;;;; +119D3;NANDINAGARI VOWEL SIGN II;Mc;0;L;;;;;N;;;;; +119D4;NANDINAGARI VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;; +119D5;NANDINAGARI VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;; +119D6;NANDINAGARI VOWEL SIGN VOCALIC R;Mn;0;NSM;;;;;N;;;;; +119D7;NANDINAGARI VOWEL SIGN VOCALIC RR;Mn;0;NSM;;;;;N;;;;; +119DA;NANDINAGARI VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;; +119DB;NANDINAGARI VOWEL SIGN AI;Mn;0;NSM;;;;;N;;;;; +119DC;NANDINAGARI VOWEL SIGN O;Mc;0;L;;;;;N;;;;; +119DD;NANDINAGARI VOWEL SIGN AU;Mc;0;L;;;;;N;;;;; +119DE;NANDINAGARI SIGN ANUSVARA;Mc;0;L;;;;;N;;;;; +119DF;NANDINAGARI SIGN VISARGA;Mc;0;L;;;;;N;;;;; +119E0;NANDINAGARI SIGN VIRAMA;Mn;9;NSM;;;;;N;;;;; +119E1;NANDINAGARI SIGN AVAGRAHA;Lo;0;L;;;;;N;;;;; +119E2;NANDINAGARI SIGN SIDDHAM;Po;0;L;;;;;N;;;;; +119E3;NANDINAGARI HEADSTROKE;Lo;0;L;;;;;N;;;;; +119E4;NANDINAGARI VOWEL SIGN PRISHTHAMATRA E;Mc;0;L;;;;;N;;;;; 11A00;ZANABAZAR SQUARE LETTER A;Lo;0;L;;;;;N;;;;; 11A01;ZANABAZAR SQUARE VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;; 11A02;ZANABAZAR SQUARE VOWEL SIGN UE;Mn;0;NSM;;;;;N;;;;; @@ -20545,6 +20669,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 11A81;SOYOMBO LETTER SA;Lo;0;L;;;;;N;;;;; 11A82;SOYOMBO LETTER HA;Lo;0;L;;;;;N;;;;; 11A83;SOYOMBO LETTER KSSA;Lo;0;L;;;;;N;;;;; +11A84;SOYOMBO SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;; +11A85;SOYOMBO SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;; 11A86;SOYOMBO CLUSTER-INITIAL LETTER RA;Lo;0;L;;;;;N;;;;; 11A87;SOYOMBO CLUSTER-INITIAL LETTER LA;Lo;0;L;;;;;N;;;;; 11A88;SOYOMBO CLUSTER-INITIAL LETTER SHA;Lo;0;L;;;;;N;;;;; @@ -20959,6 +21085,57 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 11EF6;MAKASAR VOWEL SIGN O;Mc;0;L;;;;;N;;;;; 11EF7;MAKASAR PASSIMBANG;Po;0;L;;;;;N;;;;; 11EF8;MAKASAR END OF SECTION;Po;0;L;;;;;N;;;;; +11FC0;TAMIL FRACTION ONE THREE-HUNDRED-AND-TWENTIETH;No;0;L;;;;1/320;N;;;;; +11FC1;TAMIL FRACTION ONE ONE-HUNDRED-AND-SIXTIETH;No;0;L;;;;1/160;N;;;;; +11FC2;TAMIL FRACTION ONE EIGHTIETH;No;0;L;;;;1/80;N;;;;; +11FC3;TAMIL FRACTION ONE SIXTY-FOURTH;No;0;L;;;;1/64;N;;;;; +11FC4;TAMIL FRACTION ONE FORTIETH;No;0;L;;;;1/40;N;;;;; +11FC5;TAMIL FRACTION ONE THIRTY-SECOND;No;0;L;;;;1/32;N;;;;; +11FC6;TAMIL FRACTION THREE EIGHTIETHS;No;0;L;;;;3/80;N;;;;; +11FC7;TAMIL FRACTION THREE SIXTY-FOURTHS;No;0;L;;;;3/64;N;;;;; +11FC8;TAMIL FRACTION ONE TWENTIETH;No;0;L;;;;1/20;N;;;;; +11FC9;TAMIL FRACTION ONE SIXTEENTH-1;No;0;L;;;;1/16;N;;;;; +11FCA;TAMIL FRACTION ONE SIXTEENTH-2;No;0;L;;;;1/16;N;;;;; +11FCB;TAMIL FRACTION ONE TENTH;No;0;L;;;;1/10;N;;;;; +11FCC;TAMIL FRACTION ONE EIGHTH;No;0;L;;;;1/8;N;;;;; +11FCD;TAMIL FRACTION THREE TWENTIETHS;No;0;L;;;;3/20;N;;;;; +11FCE;TAMIL FRACTION THREE SIXTEENTHS;No;0;L;;;;3/16;N;;;;; +11FCF;TAMIL FRACTION ONE FIFTH;No;0;L;;;;1/5;N;;;;; +11FD0;TAMIL FRACTION ONE QUARTER;No;0;L;;;;1/4;N;;;;; +11FD1;TAMIL FRACTION ONE HALF-1;No;0;L;;;;1/2;N;;;;; +11FD2;TAMIL FRACTION ONE HALF-2;No;0;L;;;;1/2;N;;;;; +11FD3;TAMIL FRACTION THREE QUARTERS;No;0;L;;;;3/4;N;;;;; +11FD4;TAMIL FRACTION DOWNSCALING FACTOR KIIZH;No;0;L;;;;1/320;N;;;;; +11FD5;TAMIL SIGN NEL;So;0;ON;;;;;N;;;;; +11FD6;TAMIL SIGN CEVITU;So;0;ON;;;;;N;;;;; +11FD7;TAMIL SIGN AAZHAAKKU;So;0;ON;;;;;N;;;;; +11FD8;TAMIL SIGN UZHAKKU;So;0;ON;;;;;N;;;;; +11FD9;TAMIL SIGN MUUVUZHAKKU;So;0;ON;;;;;N;;;;; +11FDA;TAMIL SIGN KURUNI;So;0;ON;;;;;N;;;;; +11FDB;TAMIL SIGN PATHAKKU;So;0;ON;;;;;N;;;;; +11FDC;TAMIL SIGN MUKKURUNI;So;0;ON;;;;;N;;;;; +11FDD;TAMIL SIGN KAACU;Sc;0;ET;;;;;N;;;;; +11FDE;TAMIL SIGN PANAM;Sc;0;ET;;;;;N;;;;; +11FDF;TAMIL SIGN PON;Sc;0;ET;;;;;N;;;;; +11FE0;TAMIL SIGN VARAAKAN;Sc;0;ET;;;;;N;;;;; +11FE1;TAMIL SIGN PAARAM;So;0;ON;;;;;N;;;;; +11FE2;TAMIL SIGN KUZHI;So;0;ON;;;;;N;;;;; +11FE3;TAMIL SIGN VELI;So;0;ON;;;;;N;;;;; +11FE4;TAMIL WET CULTIVATION SIGN;So;0;ON;;;;;N;;;;; +11FE5;TAMIL DRY CULTIVATION SIGN;So;0;ON;;;;;N;;;;; +11FE6;TAMIL LAND SIGN;So;0;ON;;;;;N;;;;; +11FE7;TAMIL SALT PAN SIGN;So;0;ON;;;;;N;;;;; +11FE8;TAMIL TRADITIONAL CREDIT SIGN;So;0;ON;;;;;N;;;;; +11FE9;TAMIL TRADITIONAL NUMBER SIGN;So;0;ON;;;;;N;;;;; +11FEA;TAMIL CURRENT SIGN;So;0;ON;;;;;N;;;;; +11FEB;TAMIL AND ODD SIGN;So;0;ON;;;;;N;;;;; +11FEC;TAMIL SPENT SIGN;So;0;ON;;;;;N;;;;; +11FED;TAMIL TOTAL SIGN;So;0;ON;;;;;N;;;;; +11FEE;TAMIL IN POSSESSION SIGN;So;0;ON;;;;;N;;;;; +11FEF;TAMIL STARTING FROM SIGN;So;0;ON;;;;;N;;;;; +11FF0;TAMIL SIGN MUTHALIYA;So;0;ON;;;;;N;;;;; +11FF1;TAMIL SIGN VAKAIYARAA;So;0;ON;;;;;N;;;;; +11FFF;TAMIL PUNCTUATION END OF TEXT;Po;0;L;;;;;N;;;;; 12000;CUNEIFORM SIGN A;Lo;0;L;;;;;N;;;;; 12001;CUNEIFORM SIGN A TIMES A;Lo;0;L;;;;;N;;;;; 12002;CUNEIFORM SIGN A TIMES BAD;Lo;0;L;;;;;N;;;;; @@ -23264,6 +23441,15 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1342C;EGYPTIAN HIEROGLYPH AA030;Lo;0;L;;;;;N;;;;; 1342D;EGYPTIAN HIEROGLYPH AA031;Lo;0;L;;;;;N;;;;; 1342E;EGYPTIAN HIEROGLYPH AA032;Lo;0;L;;;;;N;;;;; +13430;EGYPTIAN HIEROGLYPH VERTICAL JOINER;Cf;0;L;;;;;N;;;;; +13431;EGYPTIAN HIEROGLYPH HORIZONTAL JOINER;Cf;0;L;;;;;N;;;;; +13432;EGYPTIAN HIEROGLYPH INSERT AT TOP START;Cf;0;L;;;;;N;;;;; +13433;EGYPTIAN HIEROGLYPH INSERT AT BOTTOM START;Cf;0;L;;;;;N;;;;; +13434;EGYPTIAN HIEROGLYPH INSERT AT TOP END;Cf;0;L;;;;;N;;;;; +13435;EGYPTIAN HIEROGLYPH INSERT AT BOTTOM END;Cf;0;L;;;;;N;;;;; +13436;EGYPTIAN HIEROGLYPH OVERLAY MIDDLE;Cf;0;L;;;;;N;;;;; +13437;EGYPTIAN HIEROGLYPH BEGIN SEGMENT;Cf;0;L;;;;;N;;;;; +13438;EGYPTIAN HIEROGLYPH END SEGMENT;Cf;0;L;;;;;N;;;;; 14400;ANATOLIAN HIEROGLYPH A001;Lo;0;L;;;;;N;;;;; 14401;ANATOLIAN HIEROGLYPH A002;Lo;0;L;;;;;N;;;;; 14402;ANATOLIAN HIEROGLYPH A003;Lo;0;L;;;;;N;;;;; @@ -24782,6 +24968,13 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 16F42;MIAO LETTER WA;Lo;0;L;;;;;N;;;;; 16F43;MIAO LETTER AH;Lo;0;L;;;;;N;;;;; 16F44;MIAO LETTER HHA;Lo;0;L;;;;;N;;;;; +16F45;MIAO LETTER BRI;Lo;0;L;;;;;N;;;;; +16F46;MIAO LETTER SYI;Lo;0;L;;;;;N;;;;; +16F47;MIAO LETTER DZYI;Lo;0;L;;;;;N;;;;; +16F48;MIAO LETTER TE;Lo;0;L;;;;;N;;;;; +16F49;MIAO LETTER TSE;Lo;0;L;;;;;N;;;;; +16F4A;MIAO LETTER RTE;Lo;0;L;;;;;N;;;;; +16F4F;MIAO SIGN CONSONANT MODIFIER BAR;Mn;0;NSM;;;;;N;;;;; 16F50;MIAO LETTER NASALIZATION;Lo;0;L;;;;;N;;;;; 16F51;MIAO SIGN ASPIRATION;Mc;0;L;;;;;N;;;;; 16F52;MIAO SIGN REFORMED VOICING;Mc;0;L;;;;;N;;;;; @@ -24829,6 +25022,15 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 16F7C;MIAO VOWEL SIGN OU;Mc;0;L;;;;;N;;;;; 16F7D;MIAO VOWEL SIGN N;Mc;0;L;;;;;N;;;;; 16F7E;MIAO VOWEL SIGN NG;Mc;0;L;;;;;N;;;;; +16F7F;MIAO VOWEL SIGN UOG;Mc;0;L;;;;;N;;;;; +16F80;MIAO VOWEL SIGN YUI;Mc;0;L;;;;;N;;;;; +16F81;MIAO VOWEL SIGN OG;Mc;0;L;;;;;N;;;;; +16F82;MIAO VOWEL SIGN OER;Mc;0;L;;;;;N;;;;; +16F83;MIAO VOWEL SIGN VW;Mc;0;L;;;;;N;;;;; +16F84;MIAO VOWEL SIGN IG;Mc;0;L;;;;;N;;;;; +16F85;MIAO VOWEL SIGN EA;Mc;0;L;;;;;N;;;;; +16F86;MIAO VOWEL SIGN IONG;Mc;0;L;;;;;N;;;;; +16F87;MIAO VOWEL SIGN UI;Mc;0;L;;;;;N;;;;; 16F8F;MIAO TONE RIGHT;Mn;0;NSM;;;;;N;;;;; 16F90;MIAO TONE TOP RIGHT;Mn;0;NSM;;;;;N;;;;; 16F91;MIAO TONE ABOVE;Mn;0;NSM;;;;;N;;;;; @@ -24848,8 +25050,10 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 16F9F;MIAO LETTER REFORMED TONE-8;Lm;0;L;;;;;N;;;;; 16FE0;TANGUT ITERATION MARK;Lm;0;L;;;;;N;;;;; 16FE1;NUSHU ITERATION MARK;Lm;0;L;;;;;N;;;;; +16FE2;OLD CHINESE HOOK MARK;Po;0;ON;;;;;N;;;;; +16FE3;OLD CHINESE ITERATION MARK;Lm;0;L;;;;;N;;;;; 17000;<Tangut Ideograph, First>;Lo;0;L;;;;;N;;;;; -187F1;<Tangut Ideograph, Last>;Lo;0;L;;;;;N;;;;; +187F7;<Tangut Ideograph, Last>;Lo;0;L;;;;;N;;;;; 18800;TANGUT COMPONENT-001;Lo;0;L;;;;;N;;;;; 18801;TANGUT COMPONENT-002;Lo;0;L;;;;;N;;;;; 18802;TANGUT COMPONENT-003;Lo;0;L;;;;;N;;;;; @@ -25892,6 +26096,13 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1B11C;HENTAIGANA LETTER WO-7;Lo;0;L;;;;;N;;;;; 1B11D;HENTAIGANA LETTER N-MU-MO-1;Lo;0;L;;;;;N;;;;; 1B11E;HENTAIGANA LETTER N-MU-MO-2;Lo;0;L;;;;;N;;;;; +1B150;HIRAGANA LETTER SMALL WI;Lo;0;L;;;;;N;;;;; +1B151;HIRAGANA LETTER SMALL WE;Lo;0;L;;;;;N;;;;; +1B152;HIRAGANA LETTER SMALL WO;Lo;0;L;;;;;N;;;;; +1B164;KATAKANA LETTER SMALL WI;Lo;0;L;;;;;N;;;;; +1B165;KATAKANA LETTER SMALL WE;Lo;0;L;;;;;N;;;;; +1B166;KATAKANA LETTER SMALL WO;Lo;0;L;;;;;N;;;;; +1B167;KATAKANA LETTER SMALL N;Lo;0;L;;;;;N;;;;; 1B170;NUSHU CHARACTER-1B170;Lo;0;L;;;;;N;;;;; 1B171;NUSHU CHARACTER-1B171;Lo;0;L;;;;;N;;;;; 1B172;NUSHU CHARACTER-1B172;Lo;0;L;;;;;N;;;;; @@ -28820,6 +29031,136 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1E028;COMBINING GLAGOLITIC LETTER BIG YUS;Mn;230;NSM;;;;;N;;;;; 1E029;COMBINING GLAGOLITIC LETTER IOTATED BIG YUS;Mn;230;NSM;;;;;N;;;;; 1E02A;COMBINING GLAGOLITIC LETTER FITA;Mn;230;NSM;;;;;N;;;;; +1E100;NYIAKENG PUACHUE HMONG LETTER MA;Lo;0;L;;;;;N;;;;; +1E101;NYIAKENG PUACHUE HMONG LETTER TSA;Lo;0;L;;;;;N;;;;; +1E102;NYIAKENG PUACHUE HMONG LETTER NTA;Lo;0;L;;;;;N;;;;; +1E103;NYIAKENG PUACHUE HMONG LETTER TA;Lo;0;L;;;;;N;;;;; +1E104;NYIAKENG PUACHUE HMONG LETTER HA;Lo;0;L;;;;;N;;;;; +1E105;NYIAKENG PUACHUE HMONG LETTER NA;Lo;0;L;;;;;N;;;;; +1E106;NYIAKENG PUACHUE HMONG LETTER XA;Lo;0;L;;;;;N;;;;; +1E107;NYIAKENG PUACHUE HMONG LETTER NKA;Lo;0;L;;;;;N;;;;; +1E108;NYIAKENG PUACHUE HMONG LETTER CA;Lo;0;L;;;;;N;;;;; +1E109;NYIAKENG PUACHUE HMONG LETTER LA;Lo;0;L;;;;;N;;;;; +1E10A;NYIAKENG PUACHUE HMONG LETTER SA;Lo;0;L;;;;;N;;;;; +1E10B;NYIAKENG PUACHUE HMONG LETTER ZA;Lo;0;L;;;;;N;;;;; +1E10C;NYIAKENG PUACHUE HMONG LETTER NCA;Lo;0;L;;;;;N;;;;; +1E10D;NYIAKENG PUACHUE HMONG LETTER NTSA;Lo;0;L;;;;;N;;;;; +1E10E;NYIAKENG PUACHUE HMONG LETTER KA;Lo;0;L;;;;;N;;;;; +1E10F;NYIAKENG PUACHUE HMONG LETTER DA;Lo;0;L;;;;;N;;;;; +1E110;NYIAKENG PUACHUE HMONG LETTER NYA;Lo;0;L;;;;;N;;;;; +1E111;NYIAKENG PUACHUE HMONG LETTER NRA;Lo;0;L;;;;;N;;;;; +1E112;NYIAKENG PUACHUE HMONG LETTER VA;Lo;0;L;;;;;N;;;;; +1E113;NYIAKENG PUACHUE HMONG LETTER NTXA;Lo;0;L;;;;;N;;;;; +1E114;NYIAKENG PUACHUE HMONG LETTER TXA;Lo;0;L;;;;;N;;;;; +1E115;NYIAKENG PUACHUE HMONG LETTER FA;Lo;0;L;;;;;N;;;;; +1E116;NYIAKENG PUACHUE HMONG LETTER RA;Lo;0;L;;;;;N;;;;; +1E117;NYIAKENG PUACHUE HMONG LETTER QA;Lo;0;L;;;;;N;;;;; +1E118;NYIAKENG PUACHUE HMONG LETTER YA;Lo;0;L;;;;;N;;;;; +1E119;NYIAKENG PUACHUE HMONG LETTER NQA;Lo;0;L;;;;;N;;;;; +1E11A;NYIAKENG PUACHUE HMONG LETTER PA;Lo;0;L;;;;;N;;;;; +1E11B;NYIAKENG PUACHUE HMONG LETTER XYA;Lo;0;L;;;;;N;;;;; +1E11C;NYIAKENG PUACHUE HMONG LETTER NPA;Lo;0;L;;;;;N;;;;; +1E11D;NYIAKENG PUACHUE HMONG LETTER DLA;Lo;0;L;;;;;N;;;;; +1E11E;NYIAKENG PUACHUE HMONG LETTER NPLA;Lo;0;L;;;;;N;;;;; +1E11F;NYIAKENG PUACHUE HMONG LETTER HAH;Lo;0;L;;;;;N;;;;; +1E120;NYIAKENG PUACHUE HMONG LETTER MLA;Lo;0;L;;;;;N;;;;; +1E121;NYIAKENG PUACHUE HMONG LETTER PLA;Lo;0;L;;;;;N;;;;; +1E122;NYIAKENG PUACHUE HMONG LETTER GA;Lo;0;L;;;;;N;;;;; +1E123;NYIAKENG PUACHUE HMONG LETTER RRA;Lo;0;L;;;;;N;;;;; +1E124;NYIAKENG PUACHUE HMONG LETTER A;Lo;0;L;;;;;N;;;;; +1E125;NYIAKENG PUACHUE HMONG LETTER AA;Lo;0;L;;;;;N;;;;; +1E126;NYIAKENG PUACHUE HMONG LETTER I;Lo;0;L;;;;;N;;;;; +1E127;NYIAKENG PUACHUE HMONG LETTER U;Lo;0;L;;;;;N;;;;; +1E128;NYIAKENG PUACHUE HMONG LETTER O;Lo;0;L;;;;;N;;;;; +1E129;NYIAKENG PUACHUE HMONG LETTER OO;Lo;0;L;;;;;N;;;;; +1E12A;NYIAKENG PUACHUE HMONG LETTER E;Lo;0;L;;;;;N;;;;; +1E12B;NYIAKENG PUACHUE HMONG LETTER EE;Lo;0;L;;;;;N;;;;; +1E12C;NYIAKENG PUACHUE HMONG LETTER W;Lo;0;L;;;;;N;;;;; +1E130;NYIAKENG PUACHUE HMONG TONE-B;Mn;230;NSM;;;;;N;;;;; +1E131;NYIAKENG PUACHUE HMONG TONE-M;Mn;230;NSM;;;;;N;;;;; +1E132;NYIAKENG PUACHUE HMONG TONE-J;Mn;230;NSM;;;;;N;;;;; +1E133;NYIAKENG PUACHUE HMONG TONE-V;Mn;230;NSM;;;;;N;;;;; +1E134;NYIAKENG PUACHUE HMONG TONE-S;Mn;230;NSM;;;;;N;;;;; +1E135;NYIAKENG PUACHUE HMONG TONE-G;Mn;230;NSM;;;;;N;;;;; +1E136;NYIAKENG PUACHUE HMONG TONE-D;Mn;230;NSM;;;;;N;;;;; +1E137;NYIAKENG PUACHUE HMONG SIGN FOR PERSON;Lm;0;L;;;;;N;;;;; +1E138;NYIAKENG PUACHUE HMONG SIGN FOR THING;Lm;0;L;;;;;N;;;;; +1E139;NYIAKENG PUACHUE HMONG SIGN FOR LOCATION;Lm;0;L;;;;;N;;;;; +1E13A;NYIAKENG PUACHUE HMONG SIGN FOR ANIMAL;Lm;0;L;;;;;N;;;;; +1E13B;NYIAKENG PUACHUE HMONG SIGN FOR INVERTEBRATE;Lm;0;L;;;;;N;;;;; +1E13C;NYIAKENG PUACHUE HMONG SIGN XW XW;Lm;0;L;;;;;N;;;;; +1E13D;NYIAKENG PUACHUE HMONG SYLLABLE LENGTHENER;Lm;0;L;;;;;N;;;;; +1E140;NYIAKENG PUACHUE HMONG DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;; +1E141;NYIAKENG PUACHUE HMONG DIGIT ONE;Nd;0;L;;1;1;1;N;;;;; +1E142;NYIAKENG PUACHUE HMONG DIGIT TWO;Nd;0;L;;2;2;2;N;;;;; +1E143;NYIAKENG PUACHUE HMONG DIGIT THREE;Nd;0;L;;3;3;3;N;;;;; +1E144;NYIAKENG PUACHUE HMONG DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;; +1E145;NYIAKENG PUACHUE HMONG DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;; +1E146;NYIAKENG PUACHUE HMONG DIGIT SIX;Nd;0;L;;6;6;6;N;;;;; +1E147;NYIAKENG PUACHUE HMONG DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;; +1E148;NYIAKENG PUACHUE HMONG DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;; +1E149;NYIAKENG PUACHUE HMONG DIGIT NINE;Nd;0;L;;9;9;9;N;;;;; +1E14E;NYIAKENG PUACHUE HMONG LOGOGRAM NYAJ;Lo;0;L;;;;;N;;;;; +1E14F;NYIAKENG PUACHUE HMONG CIRCLED CA;So;0;L;;;;;N;;;;; +1E2C0;WANCHO LETTER AA;Lo;0;L;;;;;N;;;;; +1E2C1;WANCHO LETTER A;Lo;0;L;;;;;N;;;;; +1E2C2;WANCHO LETTER BA;Lo;0;L;;;;;N;;;;; +1E2C3;WANCHO LETTER CA;Lo;0;L;;;;;N;;;;; +1E2C4;WANCHO LETTER DA;Lo;0;L;;;;;N;;;;; +1E2C5;WANCHO LETTER GA;Lo;0;L;;;;;N;;;;; +1E2C6;WANCHO LETTER YA;Lo;0;L;;;;;N;;;;; +1E2C7;WANCHO LETTER PHA;Lo;0;L;;;;;N;;;;; +1E2C8;WANCHO LETTER LA;Lo;0;L;;;;;N;;;;; +1E2C9;WANCHO LETTER NA;Lo;0;L;;;;;N;;;;; +1E2CA;WANCHO LETTER PA;Lo;0;L;;;;;N;;;;; +1E2CB;WANCHO LETTER TA;Lo;0;L;;;;;N;;;;; +1E2CC;WANCHO LETTER THA;Lo;0;L;;;;;N;;;;; +1E2CD;WANCHO LETTER FA;Lo;0;L;;;;;N;;;;; +1E2CE;WANCHO LETTER SA;Lo;0;L;;;;;N;;;;; +1E2CF;WANCHO LETTER SHA;Lo;0;L;;;;;N;;;;; +1E2D0;WANCHO LETTER JA;Lo;0;L;;;;;N;;;;; +1E2D1;WANCHO LETTER ZA;Lo;0;L;;;;;N;;;;; +1E2D2;WANCHO LETTER WA;Lo;0;L;;;;;N;;;;; +1E2D3;WANCHO LETTER VA;Lo;0;L;;;;;N;;;;; +1E2D4;WANCHO LETTER KA;Lo;0;L;;;;;N;;;;; +1E2D5;WANCHO LETTER O;Lo;0;L;;;;;N;;;;; +1E2D6;WANCHO LETTER AU;Lo;0;L;;;;;N;;;;; +1E2D7;WANCHO LETTER RA;Lo;0;L;;;;;N;;;;; +1E2D8;WANCHO LETTER MA;Lo;0;L;;;;;N;;;;; +1E2D9;WANCHO LETTER KHA;Lo;0;L;;;;;N;;;;; +1E2DA;WANCHO LETTER HA;Lo;0;L;;;;;N;;;;; +1E2DB;WANCHO LETTER E;Lo;0;L;;;;;N;;;;; +1E2DC;WANCHO LETTER I;Lo;0;L;;;;;N;;;;; +1E2DD;WANCHO LETTER NGA;Lo;0;L;;;;;N;;;;; +1E2DE;WANCHO LETTER U;Lo;0;L;;;;;N;;;;; +1E2DF;WANCHO LETTER LLHA;Lo;0;L;;;;;N;;;;; +1E2E0;WANCHO LETTER TSA;Lo;0;L;;;;;N;;;;; +1E2E1;WANCHO LETTER TRA;Lo;0;L;;;;;N;;;;; +1E2E2;WANCHO LETTER ONG;Lo;0;L;;;;;N;;;;; +1E2E3;WANCHO LETTER AANG;Lo;0;L;;;;;N;;;;; +1E2E4;WANCHO LETTER ANG;Lo;0;L;;;;;N;;;;; +1E2E5;WANCHO LETTER ING;Lo;0;L;;;;;N;;;;; +1E2E6;WANCHO LETTER ON;Lo;0;L;;;;;N;;;;; +1E2E7;WANCHO LETTER EN;Lo;0;L;;;;;N;;;;; +1E2E8;WANCHO LETTER AAN;Lo;0;L;;;;;N;;;;; +1E2E9;WANCHO LETTER NYA;Lo;0;L;;;;;N;;;;; +1E2EA;WANCHO LETTER UEN;Lo;0;L;;;;;N;;;;; +1E2EB;WANCHO LETTER YIH;Lo;0;L;;;;;N;;;;; +1E2EC;WANCHO TONE TUP;Mn;230;NSM;;;;;N;;;;; +1E2ED;WANCHO TONE TUPNI;Mn;230;NSM;;;;;N;;;;; +1E2EE;WANCHO TONE KOI;Mn;230;NSM;;;;;N;;;;; +1E2EF;WANCHO TONE KOINI;Mn;230;NSM;;;;;N;;;;; +1E2F0;WANCHO DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;; +1E2F1;WANCHO DIGIT ONE;Nd;0;L;;1;1;1;N;;;;; +1E2F2;WANCHO DIGIT TWO;Nd;0;L;;2;2;2;N;;;;; +1E2F3;WANCHO DIGIT THREE;Nd;0;L;;3;3;3;N;;;;; +1E2F4;WANCHO DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;; +1E2F5;WANCHO DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;; +1E2F6;WANCHO DIGIT SIX;Nd;0;L;;6;6;6;N;;;;; +1E2F7;WANCHO DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;; +1E2F8;WANCHO DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;; +1E2F9;WANCHO DIGIT NINE;Nd;0;L;;9;9;9;N;;;;; +1E2FF;WANCHO NGUN SIGN;Sc;0;ET;;;;;N;;;;; 1E800;MENDE KIKAKUI SYLLABLE M001 KI;Lo;0;R;;;;;N;;;;; 1E801;MENDE KIKAKUI SYLLABLE M002 KA;Lo;0;R;;;;;N;;;;; 1E802;MENDE KIKAKUI SYLLABLE M003 KU;Lo;0;R;;;;;N;;;;; @@ -29108,6 +29449,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1E948;ADLAM CONSONANT MODIFIER;Mn;230;NSM;;;;;N;;;;; 1E949;ADLAM GEMINATE CONSONANT MODIFIER;Mn;230;NSM;;;;;N;;;;; 1E94A;ADLAM NUKTA;Mn;7;NSM;;;;;N;;;;; +1E94B;ADLAM NASALIZATION MARK;Lm;0;R;;;;;N;;;;; 1E950;ADLAM DIGIT ZERO;Nd;0;R;;0;0;0;N;;;;; 1E951;ADLAM DIGIT ONE;Nd;0;R;;1;1;1;N;;;;; 1E952;ADLAM DIGIT TWO;Nd;0;R;;2;2;2;N;;;;; @@ -29188,6 +29530,67 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1ECB2;INDIC SIYAQ NUMBER ALTERNATE TWO;No;0;AL;;;;2;N;;;;; 1ECB3;INDIC SIYAQ NUMBER ALTERNATE TEN THOUSAND;No;0;AL;;;;10000;N;;;;; 1ECB4;INDIC SIYAQ ALTERNATE LAKH MARK;No;0;AL;;;;100000;N;;;;; +1ED01;OTTOMAN SIYAQ NUMBER ONE;No;0;AL;;;;1;N;;;;; +1ED02;OTTOMAN SIYAQ NUMBER TWO;No;0;AL;;;;2;N;;;;; +1ED03;OTTOMAN SIYAQ NUMBER THREE;No;0;AL;;;;3;N;;;;; +1ED04;OTTOMAN SIYAQ NUMBER FOUR;No;0;AL;;;;4;N;;;;; +1ED05;OTTOMAN SIYAQ NUMBER FIVE;No;0;AL;;;;5;N;;;;; +1ED06;OTTOMAN SIYAQ NUMBER SIX;No;0;AL;;;;6;N;;;;; +1ED07;OTTOMAN SIYAQ NUMBER SEVEN;No;0;AL;;;;7;N;;;;; +1ED08;OTTOMAN SIYAQ NUMBER EIGHT;No;0;AL;;;;8;N;;;;; +1ED09;OTTOMAN SIYAQ NUMBER NINE;No;0;AL;;;;9;N;;;;; +1ED0A;OTTOMAN SIYAQ NUMBER TEN;No;0;AL;;;;10;N;;;;; +1ED0B;OTTOMAN SIYAQ NUMBER TWENTY;No;0;AL;;;;20;N;;;;; +1ED0C;OTTOMAN SIYAQ NUMBER THIRTY;No;0;AL;;;;30;N;;;;; +1ED0D;OTTOMAN SIYAQ NUMBER FORTY;No;0;AL;;;;40;N;;;;; +1ED0E;OTTOMAN SIYAQ NUMBER FIFTY;No;0;AL;;;;50;N;;;;; +1ED0F;OTTOMAN SIYAQ NUMBER SIXTY;No;0;AL;;;;60;N;;;;; +1ED10;OTTOMAN SIYAQ NUMBER SEVENTY;No;0;AL;;;;70;N;;;;; +1ED11;OTTOMAN SIYAQ NUMBER EIGHTY;No;0;AL;;;;80;N;;;;; +1ED12;OTTOMAN SIYAQ NUMBER NINETY;No;0;AL;;;;90;N;;;;; +1ED13;OTTOMAN SIYAQ NUMBER ONE HUNDRED;No;0;AL;;;;100;N;;;;; +1ED14;OTTOMAN SIYAQ NUMBER TWO HUNDRED;No;0;AL;;;;200;N;;;;; +1ED15;OTTOMAN SIYAQ NUMBER THREE HUNDRED;No;0;AL;;;;300;N;;;;; +1ED16;OTTOMAN SIYAQ NUMBER FOUR HUNDRED;No;0;AL;;;;400;N;;;;; +1ED17;OTTOMAN SIYAQ NUMBER FIVE HUNDRED;No;0;AL;;;;500;N;;;;; +1ED18;OTTOMAN SIYAQ NUMBER SIX HUNDRED;No;0;AL;;;;600;N;;;;; +1ED19;OTTOMAN SIYAQ NUMBER SEVEN HUNDRED;No;0;AL;;;;700;N;;;;; +1ED1A;OTTOMAN SIYAQ NUMBER EIGHT HUNDRED;No;0;AL;;;;800;N;;;;; +1ED1B;OTTOMAN SIYAQ NUMBER NINE HUNDRED;No;0;AL;;;;900;N;;;;; +1ED1C;OTTOMAN SIYAQ NUMBER ONE THOUSAND;No;0;AL;;;;1000;N;;;;; +1ED1D;OTTOMAN SIYAQ NUMBER TWO THOUSAND;No;0;AL;;;;2000;N;;;;; +1ED1E;OTTOMAN SIYAQ NUMBER THREE THOUSAND;No;0;AL;;;;3000;N;;;;; +1ED1F;OTTOMAN SIYAQ NUMBER FOUR THOUSAND;No;0;AL;;;;4000;N;;;;; +1ED20;OTTOMAN SIYAQ NUMBER FIVE THOUSAND;No;0;AL;;;;5000;N;;;;; +1ED21;OTTOMAN SIYAQ NUMBER SIX THOUSAND;No;0;AL;;;;6000;N;;;;; +1ED22;OTTOMAN SIYAQ NUMBER SEVEN THOUSAND;No;0;AL;;;;7000;N;;;;; +1ED23;OTTOMAN SIYAQ NUMBER EIGHT THOUSAND;No;0;AL;;;;8000;N;;;;; +1ED24;OTTOMAN SIYAQ NUMBER NINE THOUSAND;No;0;AL;;;;9000;N;;;;; +1ED25;OTTOMAN SIYAQ NUMBER TEN THOUSAND;No;0;AL;;;;10000;N;;;;; +1ED26;OTTOMAN SIYAQ NUMBER TWENTY THOUSAND;No;0;AL;;;;20000;N;;;;; +1ED27;OTTOMAN SIYAQ NUMBER THIRTY THOUSAND;No;0;AL;;;;30000;N;;;;; +1ED28;OTTOMAN SIYAQ NUMBER FORTY THOUSAND;No;0;AL;;;;40000;N;;;;; +1ED29;OTTOMAN SIYAQ NUMBER FIFTY THOUSAND;No;0;AL;;;;50000;N;;;;; +1ED2A;OTTOMAN SIYAQ NUMBER SIXTY THOUSAND;No;0;AL;;;;60000;N;;;;; +1ED2B;OTTOMAN SIYAQ NUMBER SEVENTY THOUSAND;No;0;AL;;;;70000;N;;;;; +1ED2C;OTTOMAN SIYAQ NUMBER EIGHTY THOUSAND;No;0;AL;;;;80000;N;;;;; +1ED2D;OTTOMAN SIYAQ NUMBER NINETY THOUSAND;No;0;AL;;;;90000;N;;;;; +1ED2E;OTTOMAN SIYAQ MARRATAN;So;0;AL;;;;;N;;;;; +1ED2F;OTTOMAN SIYAQ ALTERNATE NUMBER TWO;No;0;AL;;;;2;N;;;;; +1ED30;OTTOMAN SIYAQ ALTERNATE NUMBER THREE;No;0;AL;;;;3;N;;;;; +1ED31;OTTOMAN SIYAQ ALTERNATE NUMBER FOUR;No;0;AL;;;;4;N;;;;; +1ED32;OTTOMAN SIYAQ ALTERNATE NUMBER FIVE;No;0;AL;;;;5;N;;;;; +1ED33;OTTOMAN SIYAQ ALTERNATE NUMBER SIX;No;0;AL;;;;6;N;;;;; +1ED34;OTTOMAN SIYAQ ALTERNATE NUMBER SEVEN;No;0;AL;;;;7;N;;;;; +1ED35;OTTOMAN SIYAQ ALTERNATE NUMBER EIGHT;No;0;AL;;;;8;N;;;;; +1ED36;OTTOMAN SIYAQ ALTERNATE NUMBER NINE;No;0;AL;;;;9;N;;;;; +1ED37;OTTOMAN SIYAQ ALTERNATE NUMBER TEN;No;0;AL;;;;10;N;;;;; +1ED38;OTTOMAN SIYAQ ALTERNATE NUMBER FOUR HUNDRED;No;0;AL;;;;400;N;;;;; +1ED39;OTTOMAN SIYAQ ALTERNATE NUMBER SIX HUNDRED;No;0;AL;;;;600;N;;;;; +1ED3A;OTTOMAN SIYAQ ALTERNATE NUMBER TWO THOUSAND;No;0;AL;;;;2000;N;;;;; +1ED3B;OTTOMAN SIYAQ ALTERNATE NUMBER TEN THOUSAND;No;0;AL;;;;10000;N;;;;; +1ED3C;OTTOMAN SIYAQ FRACTION ONE HALF;No;0;AL;;;;1/2;N;;;;; +1ED3D;OTTOMAN SIYAQ FRACTION ONE SIXTH;No;0;AL;;;;1/6;N;;;;; 1EE00;ARABIC MATHEMATICAL ALEF;Lo;0;AL;<font> 0627;;;;N;;;;; 1EE01;ARABIC MATHEMATICAL BEH;Lo;0;AL;<font> 0628;;;;N;;;;; 1EE02;ARABIC MATHEMATICAL JEEM;Lo;0;AL;<font> 062C;;;;N;;;;; @@ -29662,6 +30065,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F169;NEGATIVE CIRCLED LATIN CAPITAL LETTER Z;So;0;L;;;;;N;;;;; 1F16A;RAISED MC SIGN;So;0;ON;<super> 004D 0043;;;;N;;;;; 1F16B;RAISED MD SIGN;So;0;ON;<super> 004D 0044;;;;N;;;;; +1F16C;RAISED MR SIGN;So;0;ON;<super> 004D 0052;;;;N;;;;; 1F170;NEGATIVE SQUARED LATIN CAPITAL LETTER A;So;0;L;;;;;N;;;;; 1F171;NEGATIVE SQUARED LATIN CAPITAL LETTER B;So;0;L;;;;;N;;;;; 1F172;NEGATIVE SQUARED LATIN CAPITAL LETTER C;So;0;L;;;;;N;;;;; @@ -30794,6 +31198,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F6D2;SHOPPING TROLLEY;So;0;ON;;;;;N;;;;; 1F6D3;STUPA;So;0;ON;;;;;N;;;;; 1F6D4;PAGODA;So;0;ON;;;;;N;;;;; +1F6D5;HINDU TEMPLE;So;0;ON;;;;;N;;;;; 1F6E0;HAMMER AND WRENCH;So;0;ON;;;;;N;;;;; 1F6E1;SHIELD;So;0;ON;;;;;N;;;;; 1F6E2;OIL DRUM;So;0;ON;;;;;N;;;;; @@ -30817,6 +31222,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F6F7;SLED;So;0;ON;;;;;N;;;;; 1F6F8;FLYING SAUCER;So;0;ON;;;;;N;;;;; 1F6F9;SKATEBOARD;So;0;ON;;;;;N;;;;; +1F6FA;AUTO RICKSHAW;So;0;ON;;;;;N;;;;; 1F700;ALCHEMICAL SYMBOL FOR QUINTESSENCE;So;0;ON;;;;;N;;;;; 1F701;ALCHEMICAL SYMBOL FOR AIR;So;0;ON;;;;;N;;;;; 1F702;ALCHEMICAL SYMBOL FOR FIRE;So;0;ON;;;;;N;;;;; @@ -31022,6 +31428,18 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F7D6;NEGATIVE CIRCLED TRIANGLE;So;0;ON;;;;;N;;;;; 1F7D7;CIRCLED SQUARE;So;0;ON;;;;;N;;;;; 1F7D8;NEGATIVE CIRCLED SQUARE;So;0;ON;;;;;N;;;;; +1F7E0;LARGE ORANGE CIRCLE;So;0;ON;;;;;N;;;;; +1F7E1;LARGE YELLOW CIRCLE;So;0;ON;;;;;N;;;;; +1F7E2;LARGE GREEN CIRCLE;So;0;ON;;;;;N;;;;; +1F7E3;LARGE PURPLE CIRCLE;So;0;ON;;;;;N;;;;; +1F7E4;LARGE BROWN CIRCLE;So;0;ON;;;;;N;;;;; +1F7E5;LARGE RED SQUARE;So;0;ON;;;;;N;;;;; +1F7E6;LARGE BLUE SQUARE;So;0;ON;;;;;N;;;;; +1F7E7;LARGE ORANGE SQUARE;So;0;ON;;;;;N;;;;; +1F7E8;LARGE YELLOW SQUARE;So;0;ON;;;;;N;;;;; +1F7E9;LARGE GREEN SQUARE;So;0;ON;;;;;N;;;;; +1F7EA;LARGE PURPLE SQUARE;So;0;ON;;;;;N;;;;; +1F7EB;LARGE BROWN SQUARE;So;0;ON;;;;;N;;;;; 1F800;LEFTWARDS ARROW WITH SMALL TRIANGLE ARROWHEAD;So;0;ON;;;;;N;;;;; 1F801;UPWARDS ARROW WITH SMALL TRIANGLE ARROWHEAD;So;0;ON;;;;;N;;;;; 1F802;RIGHTWARDS ARROW WITH SMALL TRIANGLE ARROWHEAD;So;0;ON;;;;;N;;;;; @@ -31182,6 +31600,9 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F909;DOWNWARD FACING NOTCHED HOOK;So;0;ON;;;;;N;;;;; 1F90A;DOWNWARD FACING HOOK WITH DOT;So;0;ON;;;;;N;;;;; 1F90B;DOWNWARD FACING NOTCHED HOOK WITH DOT;So;0;ON;;;;;N;;;;; +1F90D;WHITE HEART;So;0;ON;;;;;N;;;;; +1F90E;BROWN HEART;So;0;ON;;;;;N;;;;; +1F90F;PINCHING HAND;So;0;ON;;;;;N;;;;; 1F910;ZIPPER-MOUTH FACE;So;0;ON;;;;;N;;;;; 1F911;MONEY-MOUTH FACE;So;0;ON;;;;;N;;;;; 1F912;FACE WITH THERMOMETER;So;0;ON;;;;;N;;;;; @@ -31229,6 +31650,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F93C;WRESTLERS;So;0;ON;;;;;N;;;;; 1F93D;WATER POLO;So;0;ON;;;;;N;;;;; 1F93E;HANDBALL;So;0;ON;;;;;N;;;;; +1F93F;DIVING MASK;So;0;ON;;;;;N;;;;; 1F940;WILTED FLOWER;So;0;ON;;;;;N;;;;; 1F941;DRUM WITH DRUMSTICKS;So;0;ON;;;;;N;;;;; 1F942;CLINKING GLASSES;So;0;ON;;;;;N;;;;; @@ -31278,11 +31700,13 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F96E;MOON CAKE;So;0;ON;;;;;N;;;;; 1F96F;BAGEL;So;0;ON;;;;;N;;;;; 1F970;SMILING FACE WITH SMILING EYES AND THREE HEARTS;So;0;ON;;;;;N;;;;; +1F971;YAWNING FACE;So;0;ON;;;;;N;;;;; 1F973;FACE WITH PARTY HORN AND PARTY HAT;So;0;ON;;;;;N;;;;; 1F974;FACE WITH UNEVEN EYES AND WAVY MOUTH;So;0;ON;;;;;N;;;;; 1F975;OVERHEATED FACE;So;0;ON;;;;;N;;;;; 1F976;FREEZING FACE;So;0;ON;;;;;N;;;;; 1F97A;FACE WITH PLEADING EYES;So;0;ON;;;;;N;;;;; +1F97B;SARI;So;0;ON;;;;;N;;;;; 1F97C;LAB COAT;So;0;ON;;;;;N;;;;; 1F97D;GOGGLES;So;0;ON;;;;;N;;;;; 1F97E;HIKING BOOT;So;0;ON;;;;;N;;;;; @@ -31322,6 +31746,14 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F9A0;MICROBE;So;0;ON;;;;;N;;;;; 1F9A1;BADGER;So;0;ON;;;;;N;;;;; 1F9A2;SWAN;So;0;ON;;;;;N;;;;; +1F9A5;SLOTH;So;0;ON;;;;;N;;;;; +1F9A6;OTTER;So;0;ON;;;;;N;;;;; +1F9A7;ORANGUTAN;So;0;ON;;;;;N;;;;; +1F9A8;SKUNK;So;0;ON;;;;;N;;;;; +1F9A9;FLAMINGO;So;0;ON;;;;;N;;;;; +1F9AA;OYSTER;So;0;ON;;;;;N;;;;; +1F9AE;GUIDE DOG;So;0;ON;;;;;N;;;;; +1F9AF;PROBING CANE;So;0;ON;;;;;N;;;;; 1F9B0;EMOJI COMPONENT RED HAIR;So;0;ON;;;;;N;;;;; 1F9B1;EMOJI COMPONENT CURLY HAIR;So;0;ON;;;;;N;;;;; 1F9B2;EMOJI COMPONENT BALD;So;0;ON;;;;;N;;;;; @@ -31332,9 +31764,26 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F9B7;TOOTH;So;0;ON;;;;;N;;;;; 1F9B8;SUPERHERO;So;0;ON;;;;;N;;;;; 1F9B9;SUPERVILLAIN;So;0;ON;;;;;N;;;;; +1F9BA;SAFETY VEST;So;0;ON;;;;;N;;;;; +1F9BB;EAR WITH HEARING AID;So;0;ON;;;;;N;;;;; +1F9BC;MOTORIZED WHEELCHAIR;So;0;ON;;;;;N;;;;; +1F9BD;MANUAL WHEELCHAIR;So;0;ON;;;;;N;;;;; +1F9BE;MECHANICAL ARM;So;0;ON;;;;;N;;;;; +1F9BF;MECHANICAL LEG;So;0;ON;;;;;N;;;;; 1F9C0;CHEESE WEDGE;So;0;ON;;;;;N;;;;; 1F9C1;CUPCAKE;So;0;ON;;;;;N;;;;; 1F9C2;SALT SHAKER;So;0;ON;;;;;N;;;;; +1F9C3;BEVERAGE BOX;So;0;ON;;;;;N;;;;; +1F9C4;GARLIC;So;0;ON;;;;;N;;;;; +1F9C5;ONION;So;0;ON;;;;;N;;;;; +1F9C6;FALAFEL;So;0;ON;;;;;N;;;;; +1F9C7;WAFFLE;So;0;ON;;;;;N;;;;; +1F9C8;BUTTER;So;0;ON;;;;;N;;;;; +1F9C9;MATE DRINK;So;0;ON;;;;;N;;;;; +1F9CA;ICE CUBE;So;0;ON;;;;;N;;;;; +1F9CD;STANDING PERSON;So;0;ON;;;;;N;;;;; +1F9CE;KNEELING PERSON;So;0;ON;;;;;N;;;;; +1F9CF;DEAF PERSON;So;0;ON;;;;;N;;;;; 1F9D0;FACE WITH MONOCLE;So;0;ON;;;;;N;;;;; 1F9D1;ADULT;So;0;ON;;;;;N;;;;; 1F9D2;CHILD;So;0;ON;;;;;N;;;;; @@ -31383,6 +31832,90 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1F9FD;SPONGE;So;0;ON;;;;;N;;;;; 1F9FE;RECEIPT;So;0;ON;;;;;N;;;;; 1F9FF;NAZAR AMULET;So;0;ON;;;;;N;;;;; +1FA00;NEUTRAL CHESS KING;So;0;ON;;;;;N;;;;; +1FA01;NEUTRAL CHESS QUEEN;So;0;ON;;;;;N;;;;; +1FA02;NEUTRAL CHESS ROOK;So;0;ON;;;;;N;;;;; +1FA03;NEUTRAL CHESS BISHOP;So;0;ON;;;;;N;;;;; +1FA04;NEUTRAL CHESS KNIGHT;So;0;ON;;;;;N;;;;; +1FA05;NEUTRAL CHESS PAWN;So;0;ON;;;;;N;;;;; +1FA06;WHITE CHESS KNIGHT ROTATED FORTY-FIVE DEGREES;So;0;ON;;;;;N;;;;; +1FA07;BLACK CHESS KNIGHT ROTATED FORTY-FIVE DEGREES;So;0;ON;;;;;N;;;;; +1FA08;NEUTRAL CHESS KNIGHT ROTATED FORTY-FIVE DEGREES;So;0;ON;;;;;N;;;;; +1FA09;WHITE CHESS KING ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA0A;WHITE CHESS QUEEN ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA0B;WHITE CHESS ROOK ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA0C;WHITE CHESS BISHOP ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA0D;WHITE CHESS KNIGHT ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA0E;WHITE CHESS PAWN ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA0F;BLACK CHESS KING ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA10;BLACK CHESS QUEEN ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA11;BLACK CHESS ROOK ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA12;BLACK CHESS BISHOP ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA13;BLACK CHESS KNIGHT ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA14;BLACK CHESS PAWN ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA15;NEUTRAL CHESS KING ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA16;NEUTRAL CHESS QUEEN ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA17;NEUTRAL CHESS ROOK ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA18;NEUTRAL CHESS BISHOP ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA19;NEUTRAL CHESS KNIGHT ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA1A;NEUTRAL CHESS PAWN ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA1B;WHITE CHESS KNIGHT ROTATED ONE HUNDRED THIRTY-FIVE DEGREES;So;0;ON;;;;;N;;;;; +1FA1C;BLACK CHESS KNIGHT ROTATED ONE HUNDRED THIRTY-FIVE DEGREES;So;0;ON;;;;;N;;;;; +1FA1D;NEUTRAL CHESS KNIGHT ROTATED ONE HUNDRED THIRTY-FIVE DEGREES;So;0;ON;;;;;N;;;;; +1FA1E;WHITE CHESS TURNED KING;So;0;ON;;;;;N;;;;; +1FA1F;WHITE CHESS TURNED QUEEN;So;0;ON;;;;;N;;;;; +1FA20;WHITE CHESS TURNED ROOK;So;0;ON;;;;;N;;;;; +1FA21;WHITE CHESS TURNED BISHOP;So;0;ON;;;;;N;;;;; +1FA22;WHITE CHESS TURNED KNIGHT;So;0;ON;;;;;N;;;;; +1FA23;WHITE CHESS TURNED PAWN;So;0;ON;;;;;N;;;;; +1FA24;BLACK CHESS TURNED KING;So;0;ON;;;;;N;;;;; +1FA25;BLACK CHESS TURNED QUEEN;So;0;ON;;;;;N;;;;; +1FA26;BLACK CHESS TURNED ROOK;So;0;ON;;;;;N;;;;; +1FA27;BLACK CHESS TURNED BISHOP;So;0;ON;;;;;N;;;;; +1FA28;BLACK CHESS TURNED KNIGHT;So;0;ON;;;;;N;;;;; +1FA29;BLACK CHESS TURNED PAWN;So;0;ON;;;;;N;;;;; +1FA2A;NEUTRAL CHESS TURNED KING;So;0;ON;;;;;N;;;;; +1FA2B;NEUTRAL CHESS TURNED QUEEN;So;0;ON;;;;;N;;;;; +1FA2C;NEUTRAL CHESS TURNED ROOK;So;0;ON;;;;;N;;;;; +1FA2D;NEUTRAL CHESS TURNED BISHOP;So;0;ON;;;;;N;;;;; +1FA2E;NEUTRAL CHESS TURNED KNIGHT;So;0;ON;;;;;N;;;;; +1FA2F;NEUTRAL CHESS TURNED PAWN;So;0;ON;;;;;N;;;;; +1FA30;WHITE CHESS KNIGHT ROTATED TWO HUNDRED TWENTY-FIVE DEGREES;So;0;ON;;;;;N;;;;; +1FA31;BLACK CHESS KNIGHT ROTATED TWO HUNDRED TWENTY-FIVE DEGREES;So;0;ON;;;;;N;;;;; +1FA32;NEUTRAL CHESS KNIGHT ROTATED TWO HUNDRED TWENTY-FIVE DEGREES;So;0;ON;;;;;N;;;;; +1FA33;WHITE CHESS KING ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA34;WHITE CHESS QUEEN ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA35;WHITE CHESS ROOK ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA36;WHITE CHESS BISHOP ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA37;WHITE CHESS KNIGHT ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA38;WHITE CHESS PAWN ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA39;BLACK CHESS KING ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA3A;BLACK CHESS QUEEN ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA3B;BLACK CHESS ROOK ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA3C;BLACK CHESS BISHOP ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA3D;BLACK CHESS KNIGHT ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA3E;BLACK CHESS PAWN ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA3F;NEUTRAL CHESS KING ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA40;NEUTRAL CHESS QUEEN ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA41;NEUTRAL CHESS ROOK ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA42;NEUTRAL CHESS BISHOP ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA43;NEUTRAL CHESS KNIGHT ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA44;NEUTRAL CHESS PAWN ROTATED TWO HUNDRED SEVENTY DEGREES;So;0;ON;;;;;N;;;;; +1FA45;WHITE CHESS KNIGHT ROTATED THREE HUNDRED FIFTEEN DEGREES;So;0;ON;;;;;N;;;;; +1FA46;BLACK CHESS KNIGHT ROTATED THREE HUNDRED FIFTEEN DEGREES;So;0;ON;;;;;N;;;;; +1FA47;NEUTRAL CHESS KNIGHT ROTATED THREE HUNDRED FIFTEEN DEGREES;So;0;ON;;;;;N;;;;; +1FA48;WHITE CHESS EQUIHOPPER;So;0;ON;;;;;N;;;;; +1FA49;BLACK CHESS EQUIHOPPER;So;0;ON;;;;;N;;;;; +1FA4A;NEUTRAL CHESS EQUIHOPPER;So;0;ON;;;;;N;;;;; +1FA4B;WHITE CHESS EQUIHOPPER ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA4C;BLACK CHESS EQUIHOPPER ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA4D;NEUTRAL CHESS EQUIHOPPER ROTATED NINETY DEGREES;So;0;ON;;;;;N;;;;; +1FA4E;WHITE CHESS KNIGHT-QUEEN;So;0;ON;;;;;N;;;;; +1FA4F;WHITE CHESS KNIGHT-ROOK;So;0;ON;;;;;N;;;;; +1FA50;WHITE CHESS KNIGHT-BISHOP;So;0;ON;;;;;N;;;;; +1FA51;BLACK CHESS KNIGHT-QUEEN;So;0;ON;;;;;N;;;;; +1FA52;BLACK CHESS KNIGHT-ROOK;So;0;ON;;;;;N;;;;; +1FA53;BLACK CHESS KNIGHT-BISHOP;So;0;ON;;;;;N;;;;; 1FA60;XIANGQI RED GENERAL;So;0;ON;;;;;N;;;;; 1FA61;XIANGQI RED MANDARIN;So;0;ON;;;;;N;;;;; 1FA62;XIANGQI RED ELEPHANT;So;0;ON;;;;;N;;;;; @@ -31397,6 +31930,22 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1FA6B;XIANGQI BLACK CHARIOT;So;0;ON;;;;;N;;;;; 1FA6C;XIANGQI BLACK CANNON;So;0;ON;;;;;N;;;;; 1FA6D;XIANGQI BLACK SOLDIER;So;0;ON;;;;;N;;;;; +1FA70;BALLET SHOES;So;0;ON;;;;;N;;;;; +1FA71;ONE-PIECE SWIMSUIT;So;0;ON;;;;;N;;;;; +1FA72;BRIEFS;So;0;ON;;;;;N;;;;; +1FA73;SHORTS;So;0;ON;;;;;N;;;;; +1FA78;DROP OF BLOOD;So;0;ON;;;;;N;;;;; +1FA79;ADHESIVE BANDAGE;So;0;ON;;;;;N;;;;; +1FA7A;STETHOSCOPE;So;0;ON;;;;;N;;;;; +1FA80;YO-YO;So;0;ON;;;;;N;;;;; +1FA81;KITE;So;0;ON;;;;;N;;;;; +1FA82;PARACHUTE;So;0;ON;;;;;N;;;;; +1FA90;RINGED PLANET;So;0;ON;;;;;N;;;;; +1FA91;CHAIR;So;0;ON;;;;;N;;;;; +1FA92;RAZOR;So;0;ON;;;;;N;;;;; +1FA93;AXE;So;0;ON;;;;;N;;;;; +1FA94;DIYA LAMP;So;0;ON;;;;;N;;;;; +1FA95;BANJO;So;0;ON;;;;;N;;;;; 20000;<CJK Ideograph Extension B, First>;Lo;0;L;;;;;N;;;;; 2A6D6;<CJK Ideograph Extension B, Last>;Lo;0;L;;;;;N;;;;; 2A700;<CJK Ideograph Extension C, First>;Lo;0;L;;;;;N;;;;; diff --git a/lib/stdlib/uc_spec/emoji-data.txt b/lib/stdlib/uc_spec/emoji-data.txt index 6e66455252..2fb5c3ff68 100644 --- a/lib/stdlib/uc_spec/emoji-data.txt +++ b/lib/stdlib/uc_spec/emoji-data.txt @@ -1,11 +1,11 @@ # emoji-data.txt -# Date: 2018-02-07, 07:55:18 GMT -# © 2018 Unicode®, Inc. +# Date: 2019-01-15, 12:10:05 GMT +# © 2019 Unicode®, Inc. # Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries. # For terms of use, see http://www.unicode.org/terms_of_use.html # # Emoji Data for UTS #51 -# Version: 11.0 +# Version: 12.0 # # For documentation and usage, see http://www.unicode.org/reports/tr51 # @@ -45,7 +45,7 @@ 25FB..25FE ; Emoji # 3.2 [4] (◻️..◾) white medium square..black medium-small square 2600..2604 ; Emoji # 1.1 [5] (☀️..☄️) sun..comet 260E ; Emoji # 1.1 [1] (☎️) telephone -2611 ; Emoji # 1.1 [1] (☑️) ballot box with check +2611 ; Emoji # 1.1 [1] (☑️) check box with check 2614..2615 ; Emoji # 4.0 [2] (☔..☕) umbrella with rain drops..hot beverage 2618 ; Emoji # 4.1 [1] (☘️) shamrock 261D ; Emoji # 1.1 [1] (☝️) index pointing up @@ -82,14 +82,14 @@ 26F7..26FA ; Emoji # 5.2 [4] (⛷️..⛺) skier..tent 26FD ; Emoji # 5.2 [1] (⛽) fuel pump 2702 ; Emoji # 1.1 [1] (✂️) scissors -2705 ; Emoji # 6.0 [1] (✅) white heavy check mark +2705 ; Emoji # 6.0 [1] (✅) check mark button 2708..2709 ; Emoji # 1.1 [2] (✈️..✉️) airplane..envelope 270A..270B ; Emoji # 6.0 [2] (✊..✋) raised fist..raised hand 270C..270D ; Emoji # 1.1 [2] (✌️..✍️) victory hand..writing hand 270F ; Emoji # 1.1 [1] (✏️) pencil 2712 ; Emoji # 1.1 [1] (✒️) black nib -2714 ; Emoji # 1.1 [1] (✔️) heavy check mark -2716 ; Emoji # 1.1 [1] (✖️) heavy multiplication x +2714 ; Emoji # 1.1 [1] (✔️) check mark +2716 ; Emoji # 1.1 [1] (✖️) multiplication sign 271D ; Emoji # 1.1 [1] (✝️) latin cross 2721 ; Emoji # 1.1 [1] (✡️) star of David 2728 ; Emoji # 6.0 [1] (✨) sparkles @@ -100,8 +100,8 @@ 274E ; Emoji # 6.0 [1] (❎) cross mark button 2753..2755 ; Emoji # 6.0 [3] (❓..❕) question mark..white exclamation mark 2757 ; Emoji # 5.2 [1] (❗) exclamation mark -2763..2764 ; Emoji # 1.1 [2] (❣️..❤️) heavy heart exclamation..red heart -2795..2797 ; Emoji # 6.0 [3] (➕..➗) heavy plus sign..heavy division sign +2763..2764 ; Emoji # 1.1 [2] (❣️..❤️) heart exclamation..red heart +2795..2797 ; Emoji # 6.0 [3] (➕..➗) plus sign..division sign 27A1 ; Emoji # 1.1 [1] (➡️) right arrow 27B0 ; Emoji # 6.0 [1] (➰) curly loop 27BF ; Emoji # 6.0 [1] (➿) double curly loop @@ -109,7 +109,7 @@ 2B05..2B07 ; Emoji # 4.0 [3] (⬅️..⬇️) left arrow..down arrow 2B1B..2B1C ; Emoji # 5.1 [2] (⬛..⬜) black large square..white large square 2B50 ; Emoji # 5.1 [1] (⭐) star -2B55 ; Emoji # 5.2 [1] (⭕) heavy large circle +2B55 ; Emoji # 5.2 [1] (⭕) hollow red circle 3030 ; Emoji # 1.1 [1] (〰️) wavy dash 303D ; Emoji # 3.2 [1] (〽️) part alternation mark 3297 ; Emoji # 1.1 [1] (㊗️) Japanese “congratulations” button @@ -206,7 +206,7 @@ 1F62E..1F62F ; Emoji # 6.1 [2] (😮..😯) face with open mouth..hushed face 1F630..1F633 ; Emoji # 6.0 [4] (😰..😳) anxious face with sweat..flushed face 1F634 ; Emoji # 6.1 [1] (😴) sleeping face -1F635..1F640 ; Emoji # 6.0 [12] (😵..🙀) dizzy face..weary cat face +1F635..1F640 ; Emoji # 6.0 [12] (😵..🙀) dizzy face..weary cat 1F641..1F642 ; Emoji # 7.0 [2] (🙁..🙂) slightly frowning face..slightly smiling face 1F643..1F644 ; Emoji # 8.0 [2] (🙃..🙄) upside-down face..face with rolling eyes 1F645..1F64F ; Emoji # 6.0 [11] (🙅..🙏) person gesturing NO..folded hands @@ -214,6 +214,7 @@ 1F6CB..1F6CF ; Emoji # 7.0 [5] (🛋️..🛏️) couch and lamp..bed 1F6D0 ; Emoji # 8.0 [1] (🛐) place of worship 1F6D1..1F6D2 ; Emoji # 9.0 [2] (🛑..🛒) stop sign..shopping cart +1F6D5 ; Emoji # 12.0 [1] (🛕) hindu temple 1F6E0..1F6E5 ; Emoji # 7.0 [6] (🛠️..🛥️) hammer and wrench..motor boat 1F6E9 ; Emoji # 7.0 [1] (🛩️) small airplane 1F6EB..1F6EC ; Emoji # 7.0 [2] (🛫..🛬) airplane departure..airplane arrival @@ -222,6 +223,9 @@ 1F6F4..1F6F6 ; Emoji # 9.0 [3] (🛴..🛶) kick scooter..canoe 1F6F7..1F6F8 ; Emoji # 10.0 [2] (🛷..🛸) sled..flying saucer 1F6F9 ; Emoji # 11.0 [1] (🛹) skateboard +1F6FA ; Emoji # 12.0 [1] (🛺) auto rickshaw +1F7E0..1F7EB ; Emoji # 12.0 [12] (🟠..🟫) orange circle..brown square +1F90D..1F90F ; Emoji # 12.0 [3] (🤍..🤏) white heart..pinching hand 1F910..1F918 ; Emoji # 8.0 [9] (🤐..🤘) zipper-mouth face..sign of the horns 1F919..1F91E ; Emoji # 9.0 [6] (🤙..🤞) call me hand..crossed fingers 1F91F ; Emoji # 10.0 [1] (🤟) love-you gesture @@ -231,27 +235,39 @@ 1F931..1F932 ; Emoji # 10.0 [2] (🤱..🤲) breast-feeding..palms up together 1F933..1F93A ; Emoji # 9.0 [8] (🤳..🤺) selfie..person fencing 1F93C..1F93E ; Emoji # 9.0 [3] (🤼..🤾) people wrestling..person playing handball +1F93F ; Emoji # 12.0 [1] (🤿) diving mask 1F940..1F945 ; Emoji # 9.0 [6] (🥀..🥅) wilted flower..goal net 1F947..1F94B ; Emoji # 9.0 [5] (🥇..🥋) 1st place medal..martial arts uniform 1F94C ; Emoji # 10.0 [1] (🥌) curling stone 1F94D..1F94F ; Emoji # 11.0 [3] (🥍..🥏) lacrosse..flying disc 1F950..1F95E ; Emoji # 9.0 [15] (🥐..🥞) croissant..pancakes 1F95F..1F96B ; Emoji # 10.0 [13] (🥟..🥫) dumpling..canned food -1F96C..1F970 ; Emoji # 11.0 [5] (🥬..🥰) leafy green..smiling face with 3 hearts +1F96C..1F970 ; Emoji # 11.0 [5] (🥬..🥰) leafy green..smiling face with hearts +1F971 ; Emoji # 12.0 [1] (🥱) yawning face 1F973..1F976 ; Emoji # 11.0 [4] (🥳..🥶) partying face..cold face 1F97A ; Emoji # 11.0 [1] (🥺) pleading face -1F97C..1F97F ; Emoji # 11.0 [4] (🥼..🥿) lab coat..woman’s flat shoe -1F980..1F984 ; Emoji # 8.0 [5] (🦀..🦄) crab..unicorn face +1F97B ; Emoji # 12.0 [1] (🥻) sari +1F97C..1F97F ; Emoji # 11.0 [4] (🥼..🥿) lab coat..flat shoe +1F980..1F984 ; Emoji # 8.0 [5] (🦀..🦄) crab..unicorn 1F985..1F991 ; Emoji # 9.0 [13] (🦅..🦑) eagle..squid 1F992..1F997 ; Emoji # 10.0 [6] (🦒..🦗) giraffe..cricket 1F998..1F9A2 ; Emoji # 11.0 [11] (🦘..🦢) kangaroo..swan -1F9B0..1F9B9 ; Emoji # 11.0 [10] (🦰..🦹) red-haired..supervillain +1F9A5..1F9AA ; Emoji # 12.0 [6] (🦥..🦪) sloth..oyster +1F9AE..1F9AF ; Emoji # 12.0 [2] (🦮..🦯) guide dog..probing cane +1F9B0..1F9B9 ; Emoji # 11.0 [10] (🦰..🦹) red hair..supervillain +1F9BA..1F9BF ; Emoji # 12.0 [6] (🦺..🦿) safety vest..mechanical leg 1F9C0 ; Emoji # 8.0 [1] (🧀) cheese wedge 1F9C1..1F9C2 ; Emoji # 11.0 [2] (🧁..🧂) cupcake..salt +1F9C3..1F9CA ; Emoji # 12.0 [8] (🧃..🧊) beverage box..ice cube +1F9CD..1F9CF ; Emoji # 12.0 [3] (🧍..🧏) person standing..deaf person 1F9D0..1F9E6 ; Emoji # 10.0 [23] (🧐..🧦) face with monocle..socks 1F9E7..1F9FF ; Emoji # 11.0 [25] (🧧..🧿) red envelope..nazar amulet +1FA70..1FA73 ; Emoji # 12.0 [4] (🩰..🩳) ballet shoes..shorts +1FA78..1FA7A ; Emoji # 12.0 [3] (🩸..🩺) drop of blood..stethoscope +1FA80..1FA82 ; Emoji # 12.0 [3] (🪀..🪂) yo-yo..parachute +1FA90..1FA95 ; Emoji # 12.0 [6] (🪐..🪕) ringed planet..banjo -# Total elements: 1250 +# Total elements: 1311 # ================================================ @@ -278,19 +294,19 @@ 26F5 ; Emoji_Presentation # 5.2 [1] (⛵) sailboat 26FA ; Emoji_Presentation # 5.2 [1] (⛺) tent 26FD ; Emoji_Presentation # 5.2 [1] (⛽) fuel pump -2705 ; Emoji_Presentation # 6.0 [1] (✅) white heavy check mark +2705 ; Emoji_Presentation # 6.0 [1] (✅) check mark button 270A..270B ; Emoji_Presentation # 6.0 [2] (✊..✋) raised fist..raised hand 2728 ; Emoji_Presentation # 6.0 [1] (✨) sparkles 274C ; Emoji_Presentation # 6.0 [1] (❌) cross mark 274E ; Emoji_Presentation # 6.0 [1] (❎) cross mark button 2753..2755 ; Emoji_Presentation # 6.0 [3] (❓..❕) question mark..white exclamation mark 2757 ; Emoji_Presentation # 5.2 [1] (❗) exclamation mark -2795..2797 ; Emoji_Presentation # 6.0 [3] (➕..➗) heavy plus sign..heavy division sign +2795..2797 ; Emoji_Presentation # 6.0 [3] (➕..➗) plus sign..division sign 27B0 ; Emoji_Presentation # 6.0 [1] (➰) curly loop 27BF ; Emoji_Presentation # 6.0 [1] (➿) double curly loop 2B1B..2B1C ; Emoji_Presentation # 5.1 [2] (⬛..⬜) black large square..white large square 2B50 ; Emoji_Presentation # 5.1 [1] (⭐) star -2B55 ; Emoji_Presentation # 5.2 [1] (⭕) heavy large circle +2B55 ; Emoji_Presentation # 5.2 [1] (⭕) hollow red circle 1F004 ; Emoji_Presentation # 5.1 [1] (🀄) mahjong red dragon 1F0CF ; Emoji_Presentation # 6.0 [1] (🃏) joker 1F18E ; Emoji_Presentation # 6.0 [1] (🆎) AB button (blood type) @@ -349,7 +365,7 @@ 1F62E..1F62F ; Emoji_Presentation # 6.1 [2] (😮..😯) face with open mouth..hushed face 1F630..1F633 ; Emoji_Presentation # 6.0 [4] (😰..😳) anxious face with sweat..flushed face 1F634 ; Emoji_Presentation # 6.1 [1] (😴) sleeping face -1F635..1F640 ; Emoji_Presentation # 6.0 [12] (😵..🙀) dizzy face..weary cat face +1F635..1F640 ; Emoji_Presentation # 6.0 [12] (😵..🙀) dizzy face..weary cat 1F641..1F642 ; Emoji_Presentation # 7.0 [2] (🙁..🙂) slightly frowning face..slightly smiling face 1F643..1F644 ; Emoji_Presentation # 8.0 [2] (🙃..🙄) upside-down face..face with rolling eyes 1F645..1F64F ; Emoji_Presentation # 6.0 [11] (🙅..🙏) person gesturing NO..folded hands @@ -357,10 +373,14 @@ 1F6CC ; Emoji_Presentation # 7.0 [1] (🛌) person in bed 1F6D0 ; Emoji_Presentation # 8.0 [1] (🛐) place of worship 1F6D1..1F6D2 ; Emoji_Presentation # 9.0 [2] (🛑..🛒) stop sign..shopping cart +1F6D5 ; Emoji_Presentation # 12.0 [1] (🛕) hindu temple 1F6EB..1F6EC ; Emoji_Presentation # 7.0 [2] (🛫..🛬) airplane departure..airplane arrival 1F6F4..1F6F6 ; Emoji_Presentation # 9.0 [3] (🛴..🛶) kick scooter..canoe 1F6F7..1F6F8 ; Emoji_Presentation # 10.0 [2] (🛷..🛸) sled..flying saucer 1F6F9 ; Emoji_Presentation # 11.0 [1] (🛹) skateboard +1F6FA ; Emoji_Presentation # 12.0 [1] (🛺) auto rickshaw +1F7E0..1F7EB ; Emoji_Presentation # 12.0 [12] (🟠..🟫) orange circle..brown square +1F90D..1F90F ; Emoji_Presentation # 12.0 [3] (🤍..🤏) white heart..pinching hand 1F910..1F918 ; Emoji_Presentation # 8.0 [9] (🤐..🤘) zipper-mouth face..sign of the horns 1F919..1F91E ; Emoji_Presentation # 9.0 [6] (🤙..🤞) call me hand..crossed fingers 1F91F ; Emoji_Presentation # 10.0 [1] (🤟) love-you gesture @@ -370,27 +390,39 @@ 1F931..1F932 ; Emoji_Presentation # 10.0 [2] (🤱..🤲) breast-feeding..palms up together 1F933..1F93A ; Emoji_Presentation # 9.0 [8] (🤳..🤺) selfie..person fencing 1F93C..1F93E ; Emoji_Presentation # 9.0 [3] (🤼..🤾) people wrestling..person playing handball +1F93F ; Emoji_Presentation # 12.0 [1] (🤿) diving mask 1F940..1F945 ; Emoji_Presentation # 9.0 [6] (🥀..🥅) wilted flower..goal net 1F947..1F94B ; Emoji_Presentation # 9.0 [5] (🥇..🥋) 1st place medal..martial arts uniform 1F94C ; Emoji_Presentation # 10.0 [1] (🥌) curling stone 1F94D..1F94F ; Emoji_Presentation # 11.0 [3] (🥍..🥏) lacrosse..flying disc 1F950..1F95E ; Emoji_Presentation # 9.0 [15] (🥐..🥞) croissant..pancakes 1F95F..1F96B ; Emoji_Presentation # 10.0 [13] (🥟..🥫) dumpling..canned food -1F96C..1F970 ; Emoji_Presentation # 11.0 [5] (🥬..🥰) leafy green..smiling face with 3 hearts +1F96C..1F970 ; Emoji_Presentation # 11.0 [5] (🥬..🥰) leafy green..smiling face with hearts +1F971 ; Emoji_Presentation # 12.0 [1] (🥱) yawning face 1F973..1F976 ; Emoji_Presentation # 11.0 [4] (🥳..🥶) partying face..cold face 1F97A ; Emoji_Presentation # 11.0 [1] (🥺) pleading face -1F97C..1F97F ; Emoji_Presentation # 11.0 [4] (🥼..🥿) lab coat..woman’s flat shoe -1F980..1F984 ; Emoji_Presentation # 8.0 [5] (🦀..🦄) crab..unicorn face +1F97B ; Emoji_Presentation # 12.0 [1] (🥻) sari +1F97C..1F97F ; Emoji_Presentation # 11.0 [4] (🥼..🥿) lab coat..flat shoe +1F980..1F984 ; Emoji_Presentation # 8.0 [5] (🦀..🦄) crab..unicorn 1F985..1F991 ; Emoji_Presentation # 9.0 [13] (🦅..🦑) eagle..squid 1F992..1F997 ; Emoji_Presentation # 10.0 [6] (🦒..🦗) giraffe..cricket 1F998..1F9A2 ; Emoji_Presentation # 11.0 [11] (🦘..🦢) kangaroo..swan -1F9B0..1F9B9 ; Emoji_Presentation # 11.0 [10] (🦰..🦹) red-haired..supervillain +1F9A5..1F9AA ; Emoji_Presentation # 12.0 [6] (🦥..🦪) sloth..oyster +1F9AE..1F9AF ; Emoji_Presentation # 12.0 [2] (🦮..🦯) guide dog..probing cane +1F9B0..1F9B9 ; Emoji_Presentation # 11.0 [10] (🦰..🦹) red hair..supervillain +1F9BA..1F9BF ; Emoji_Presentation # 12.0 [6] (🦺..🦿) safety vest..mechanical leg 1F9C0 ; Emoji_Presentation # 8.0 [1] (🧀) cheese wedge 1F9C1..1F9C2 ; Emoji_Presentation # 11.0 [2] (🧁..🧂) cupcake..salt +1F9C3..1F9CA ; Emoji_Presentation # 12.0 [8] (🧃..🧊) beverage box..ice cube +1F9CD..1F9CF ; Emoji_Presentation # 12.0 [3] (🧍..🧏) person standing..deaf person 1F9D0..1F9E6 ; Emoji_Presentation # 10.0 [23] (🧐..🧦) face with monocle..socks 1F9E7..1F9FF ; Emoji_Presentation # 11.0 [25] (🧧..🧿) red envelope..nazar amulet +1FA70..1FA73 ; Emoji_Presentation # 12.0 [4] (🩰..🩳) ballet shoes..shorts +1FA78..1FA7A ; Emoji_Presentation # 12.0 [3] (🩸..🩺) drop of blood..stethoscope +1FA80..1FA82 ; Emoji_Presentation # 12.0 [3] (🪀..🪂) yo-yo..parachute +1FA90..1FA95 ; Emoji_Presentation # 12.0 [6] (🪐..🪕) ringed planet..banjo -# Total elements: 1032 +# Total elements: 1093 # ================================================ @@ -417,12 +449,12 @@ 1F3CB..1F3CC ; Emoji_Modifier_Base # 7.0 [2] (🏋️..🏌️) person lifting weights..person golfing 1F442..1F443 ; Emoji_Modifier_Base # 6.0 [2] (👂..👃) ear..nose 1F446..1F450 ; Emoji_Modifier_Base # 6.0 [11] (👆..👐) backhand index pointing up..open hands -1F466..1F469 ; Emoji_Modifier_Base # 6.0 [4] (👦..👩) boy..woman -1F46E ; Emoji_Modifier_Base # 6.0 [1] (👮) police officer -1F470..1F478 ; Emoji_Modifier_Base # 6.0 [9] (👰..👸) bride with veil..princess +1F466..1F478 ; Emoji_Modifier_Base # 6.0 [19] (👦..👸) boy..princess 1F47C ; Emoji_Modifier_Base # 6.0 [1] (👼) baby angel 1F481..1F483 ; Emoji_Modifier_Base # 6.0 [3] (💁..💃) person tipping hand..woman dancing 1F485..1F487 ; Emoji_Modifier_Base # 6.0 [3] (💅..💇) nail polish..person getting haircut +1F48F ; Emoji_Modifier_Base # 6.0 [1] (💏) kiss +1F491 ; Emoji_Modifier_Base # 6.0 [1] (💑) couple with heart 1F4AA ; Emoji_Modifier_Base # 6.0 [1] (💪) flexed biceps 1F574..1F575 ; Emoji_Modifier_Base # 7.0 [2] (🕴️..🕵️) man in suit levitating..detective 1F57A ; Emoji_Modifier_Base # 9.0 [1] (🕺) man dancing @@ -434,20 +466,22 @@ 1F6B4..1F6B6 ; Emoji_Modifier_Base # 6.0 [3] (🚴..🚶) person biking..person walking 1F6C0 ; Emoji_Modifier_Base # 6.0 [1] (🛀) person taking bath 1F6CC ; Emoji_Modifier_Base # 7.0 [1] (🛌) person in bed +1F90F ; Emoji_Modifier_Base # 12.0 [1] (🤏) pinching hand 1F918 ; Emoji_Modifier_Base # 8.0 [1] (🤘) sign of the horns -1F919..1F91C ; Emoji_Modifier_Base # 9.0 [4] (🤙..🤜) call me hand..right-facing fist -1F91E ; Emoji_Modifier_Base # 9.0 [1] (🤞) crossed fingers +1F919..1F91E ; Emoji_Modifier_Base # 9.0 [6] (🤙..🤞) call me hand..crossed fingers 1F91F ; Emoji_Modifier_Base # 10.0 [1] (🤟) love-you gesture 1F926 ; Emoji_Modifier_Base # 9.0 [1] (🤦) person facepalming 1F930 ; Emoji_Modifier_Base # 9.0 [1] (🤰) pregnant woman 1F931..1F932 ; Emoji_Modifier_Base # 10.0 [2] (🤱..🤲) breast-feeding..palms up together 1F933..1F939 ; Emoji_Modifier_Base # 9.0 [7] (🤳..🤹) selfie..person juggling -1F93D..1F93E ; Emoji_Modifier_Base # 9.0 [2] (🤽..🤾) person playing water polo..person playing handball +1F93C..1F93E ; Emoji_Modifier_Base # 9.0 [3] (🤼..🤾) people wrestling..person playing handball 1F9B5..1F9B6 ; Emoji_Modifier_Base # 11.0 [2] (🦵..🦶) leg..foot 1F9B8..1F9B9 ; Emoji_Modifier_Base # 11.0 [2] (🦸..🦹) superhero..supervillain -1F9D1..1F9DD ; Emoji_Modifier_Base # 10.0 [13] (🧑..🧝) adult..elf +1F9BB ; Emoji_Modifier_Base # 12.0 [1] (🦻) ear with hearing aid +1F9CD..1F9CF ; Emoji_Modifier_Base # 12.0 [3] (🧍..🧏) person standing..deaf person +1F9D1..1F9DD ; Emoji_Modifier_Base # 10.0 [13] (🧑..🧝) person..elf -# Total elements: 106 +# Total elements: 120 # ================================================ @@ -462,7 +496,7 @@ FE0F ; Emoji_Component # 3.2 [1] () VARIATION SELECTOR-16 1F1E6..1F1FF ; Emoji_Component # 6.0 [26] (🇦..🇿) regional indicator symbol letter a..regional indicator symbol letter z 1F3FB..1F3FF ; Emoji_Component # 8.0 [5] (🏻..🏿) light skin tone..dark skin tone -1F9B0..1F9B3 ; Emoji_Component # 11.0 [4] (🦰..🦳) red-haired..white-haired +1F9B0..1F9B3 ; Emoji_Component # 11.0 [4] (🦰..🦳) red hair..white hair E0020..E007F ; Emoji_Component # 3.1 [96] (..) tag space..cancel tag # Total elements: 146 @@ -482,7 +516,7 @@ E0020..E007F ; Emoji_Component # 3.1 [96] (..) tag space..ca 21A9..21AA ; Extended_Pictographic# 1.1 [2] (↩️..↪️) right arrow curving left..left arrow curving right 231A..231B ; Extended_Pictographic# 1.1 [2] (⌚..⌛) watch..hourglass done 2328 ; Extended_Pictographic# 1.1 [1] (⌨️) keyboard -2388 ; Extended_Pictographic# 3.0 [1] (⎈️) HELM SYMBOL +2388 ; Extended_Pictographic# 3.0 [1] (⎈) HELM SYMBOL 23CF ; Extended_Pictographic# 4.0 [1] (⏏️) eject button 23E9..23F3 ; Extended_Pictographic# 6.0 [11] (⏩..⏳) fast-forward button..hourglass not done 23F8..23FA ; Extended_Pictographic# 7.0 [3] (⏸️..⏺️) pause button..record button @@ -491,42 +525,42 @@ E0020..E007F ; Emoji_Component # 3.1 [96] (..) tag space..ca 25B6 ; Extended_Pictographic# 1.1 [1] (▶️) play button 25C0 ; Extended_Pictographic# 1.1 [1] (◀️) reverse button 25FB..25FE ; Extended_Pictographic# 3.2 [4] (◻️..◾) white medium square..black medium-small square -2600..2605 ; Extended_Pictographic# 1.1 [6] (☀️..★️) sun..BLACK STAR -2607..2612 ; Extended_Pictographic# 1.1 [12] (☇️..☒️) LIGHTNING..BALLOT BOX WITH X +2600..2605 ; Extended_Pictographic# 1.1 [6] (☀️..★) sun..BLACK STAR +2607..2612 ; Extended_Pictographic# 1.1 [12] (☇..☒) LIGHTNING..BALLOT BOX WITH X 2614..2615 ; Extended_Pictographic# 4.0 [2] (☔..☕) umbrella with rain drops..hot beverage -2616..2617 ; Extended_Pictographic# 3.2 [2] (☖️..☗️) WHITE SHOGI PIECE..BLACK SHOGI PIECE +2616..2617 ; Extended_Pictographic# 3.2 [2] (☖..☗) WHITE SHOGI PIECE..BLACK SHOGI PIECE 2618 ; Extended_Pictographic# 4.1 [1] (☘️) shamrock -2619 ; Extended_Pictographic# 3.0 [1] (☙️) REVERSED ROTATED FLORAL HEART BULLET -261A..266F ; Extended_Pictographic# 1.1 [86] (☚️..♯️) BLACK LEFT POINTING INDEX..MUSIC SHARP SIGN -2670..2671 ; Extended_Pictographic# 3.0 [2] (♰️..♱️) WEST SYRIAC CROSS..EAST SYRIAC CROSS -2672..267D ; Extended_Pictographic# 3.2 [12] (♲️..♽️) UNIVERSAL RECYCLING SYMBOL..PARTIALLY-RECYCLED PAPER SYMBOL +2619 ; Extended_Pictographic# 3.0 [1] (☙) REVERSED ROTATED FLORAL HEART BULLET +261A..266F ; Extended_Pictographic# 1.1 [86] (☚..♯) BLACK LEFT POINTING INDEX..MUSIC SHARP SIGN +2670..2671 ; Extended_Pictographic# 3.0 [2] (♰..♱) WEST SYRIAC CROSS..EAST SYRIAC CROSS +2672..267D ; Extended_Pictographic# 3.2 [12] (♲..♽) UNIVERSAL RECYCLING SYMBOL..PARTIALLY-RECYCLED PAPER SYMBOL 267E..267F ; Extended_Pictographic# 4.1 [2] (♾️..♿) infinity..wheelchair symbol -2680..2685 ; Extended_Pictographic# 3.2 [6] (⚀️..⚅️) DIE FACE-1..DIE FACE-6 -2690..2691 ; Extended_Pictographic# 4.0 [2] (⚐️..⚑️) WHITE FLAG..BLACK FLAG +2680..2685 ; Extended_Pictographic# 3.2 [6] (⚀..⚅) DIE FACE-1..DIE FACE-6 +2690..2691 ; Extended_Pictographic# 4.0 [2] (⚐..⚑) WHITE FLAG..BLACK FLAG 2692..269C ; Extended_Pictographic# 4.1 [11] (⚒️..⚜️) hammer and pick..fleur-de-lis -269D ; Extended_Pictographic# 5.1 [1] (⚝️) OUTLINED WHITE STAR -269E..269F ; Extended_Pictographic# 5.2 [2] (⚞️..⚟️) THREE LINES CONVERGING RIGHT..THREE LINES CONVERGING LEFT +269D ; Extended_Pictographic# 5.1 [1] (⚝) OUTLINED WHITE STAR +269E..269F ; Extended_Pictographic# 5.2 [2] (⚞..⚟) THREE LINES CONVERGING RIGHT..THREE LINES CONVERGING LEFT 26A0..26A1 ; Extended_Pictographic# 4.0 [2] (⚠️..⚡) warning..high voltage -26A2..26B1 ; Extended_Pictographic# 4.1 [16] (⚢️..⚱️) DOUBLED FEMALE SIGN..funeral urn -26B2 ; Extended_Pictographic# 5.0 [1] (⚲️) NEUTER -26B3..26BC ; Extended_Pictographic# 5.1 [10] (⚳️..⚼️) CERES..SESQUIQUADRATE -26BD..26BF ; Extended_Pictographic# 5.2 [3] (⚽..⚿️) soccer ball..SQUARED KEY -26C0..26C3 ; Extended_Pictographic# 5.1 [4] (⛀️..⛃️) WHITE DRAUGHTS MAN..BLACK DRAUGHTS KING -26C4..26CD ; Extended_Pictographic# 5.2 [10] (⛄..⛍️) snowman without snow..DISABLED CAR +26A2..26B1 ; Extended_Pictographic# 4.1 [16] (⚢..⚱️) DOUBLED FEMALE SIGN..funeral urn +26B2 ; Extended_Pictographic# 5.0 [1] (⚲) NEUTER +26B3..26BC ; Extended_Pictographic# 5.1 [10] (⚳..⚼) CERES..SESQUIQUADRATE +26BD..26BF ; Extended_Pictographic# 5.2 [3] (⚽..⚿) soccer ball..SQUARED KEY +26C0..26C3 ; Extended_Pictographic# 5.1 [4] (⛀..⛃) WHITE DRAUGHTS MAN..BLACK DRAUGHTS KING +26C4..26CD ; Extended_Pictographic# 5.2 [10] (⛄..⛍) snowman without snow..DISABLED CAR 26CE ; Extended_Pictographic# 6.0 [1] (⛎) Ophiuchus -26CF..26E1 ; Extended_Pictographic# 5.2 [19] (⛏️..⛡️) pick..RESTRICTED LEFT ENTRY-2 -26E2 ; Extended_Pictographic# 6.0 [1] (⛢️) ASTRONOMICAL SYMBOL FOR URANUS -26E3 ; Extended_Pictographic# 5.2 [1] (⛣️) HEAVY CIRCLE WITH STROKE AND TWO DOTS ABOVE -26E4..26E7 ; Extended_Pictographic# 6.0 [4] (⛤️..⛧️) PENTAGRAM..INVERTED PENTAGRAM -26E8..26FF ; Extended_Pictographic# 5.2 [24] (⛨️..⛿️) BLACK CROSS ON SHIELD..WHITE FLAG WITH HORIZONTAL MIDDLE BLACK STRIPE -2700 ; Extended_Pictographic# 7.0 [1] (✀️) BLACK SAFETY SCISSORS -2701..2704 ; Extended_Pictographic# 1.1 [4] (✁️..✄️) UPPER BLADE SCISSORS..WHITE SCISSORS -2705 ; Extended_Pictographic# 6.0 [1] (✅) white heavy check mark +26CF..26E1 ; Extended_Pictographic# 5.2 [19] (⛏️..⛡) pick..RESTRICTED LEFT ENTRY-2 +26E2 ; Extended_Pictographic# 6.0 [1] (⛢) ASTRONOMICAL SYMBOL FOR URANUS +26E3 ; Extended_Pictographic# 5.2 [1] (⛣) HEAVY CIRCLE WITH STROKE AND TWO DOTS ABOVE +26E4..26E7 ; Extended_Pictographic# 6.0 [4] (⛤..⛧) PENTAGRAM..INVERTED PENTAGRAM +26E8..26FF ; Extended_Pictographic# 5.2 [24] (⛨..⛿) BLACK CROSS ON SHIELD..WHITE FLAG WITH HORIZONTAL MIDDLE BLACK STRIPE +2700 ; Extended_Pictographic# 7.0 [1] (✀) BLACK SAFETY SCISSORS +2701..2704 ; Extended_Pictographic# 1.1 [4] (✁..✄) UPPER BLADE SCISSORS..WHITE SCISSORS +2705 ; Extended_Pictographic# 6.0 [1] (✅) check mark button 2708..2709 ; Extended_Pictographic# 1.1 [2] (✈️..✉️) airplane..envelope 270A..270B ; Extended_Pictographic# 6.0 [2] (✊..✋) raised fist..raised hand 270C..2712 ; Extended_Pictographic# 1.1 [7] (✌️..✒️) victory hand..black nib -2714 ; Extended_Pictographic# 1.1 [1] (✔️) heavy check mark -2716 ; Extended_Pictographic# 1.1 [1] (✖️) heavy multiplication x +2714 ; Extended_Pictographic# 1.1 [1] (✔️) check mark +2716 ; Extended_Pictographic# 1.1 [1] (✖️) multiplication sign 271D ; Extended_Pictographic# 1.1 [1] (✝️) latin cross 2721 ; Extended_Pictographic# 1.1 [1] (✡️) star of David 2728 ; Extended_Pictographic# 6.0 [1] (✨) sparkles @@ -537,8 +571,8 @@ E0020..E007F ; Emoji_Component # 3.1 [96] (..) tag space..ca 274E ; Extended_Pictographic# 6.0 [1] (❎) cross mark button 2753..2755 ; Extended_Pictographic# 6.0 [3] (❓..❕) question mark..white exclamation mark 2757 ; Extended_Pictographic# 5.2 [1] (❗) exclamation mark -2763..2767 ; Extended_Pictographic# 1.1 [5] (❣️..❧️) heavy heart exclamation..ROTATED FLORAL HEART BULLET -2795..2797 ; Extended_Pictographic# 6.0 [3] (➕..➗) heavy plus sign..heavy division sign +2763..2767 ; Extended_Pictographic# 1.1 [5] (❣️..❧) heart exclamation..ROTATED FLORAL HEART BULLET +2795..2797 ; Extended_Pictographic# 6.0 [3] (➕..➗) plus sign..division sign 27A1 ; Extended_Pictographic# 1.1 [1] (➡️) right arrow 27B0 ; Extended_Pictographic# 6.0 [1] (➰) curly loop 27BF ; Extended_Pictographic# 6.0 [1] (➿) double curly loop @@ -546,45 +580,46 @@ E0020..E007F ; Emoji_Component # 3.1 [96] (..) tag space..ca 2B05..2B07 ; Extended_Pictographic# 4.0 [3] (⬅️..⬇️) left arrow..down arrow 2B1B..2B1C ; Extended_Pictographic# 5.1 [2] (⬛..⬜) black large square..white large square 2B50 ; Extended_Pictographic# 5.1 [1] (⭐) star -2B55 ; Extended_Pictographic# 5.2 [1] (⭕) heavy large circle +2B55 ; Extended_Pictographic# 5.2 [1] (⭕) hollow red circle 3030 ; Extended_Pictographic# 1.1 [1] (〰️) wavy dash 303D ; Extended_Pictographic# 3.2 [1] (〽️) part alternation mark 3297 ; Extended_Pictographic# 1.1 [1] (㊗️) Japanese “congratulations” button 3299 ; Extended_Pictographic# 1.1 [1] (㊙️) Japanese “secret” button -1F000..1F02B ; Extended_Pictographic# 5.1 [44] (🀀️..🀫️) MAHJONG TILE EAST WIND..MAHJONG TILE BACK -1F02C..1F02F ; Extended_Pictographic# NA [4] (️..️) <reserved-1F02C>..<reserved-1F02F> -1F030..1F093 ; Extended_Pictographic# 5.1[100] (🀰️..🂓️) DOMINO TILE HORIZONTAL BACK..DOMINO TILE VERTICAL-06-06 -1F094..1F09F ; Extended_Pictographic# NA [12] (️..️) <reserved-1F094>..<reserved-1F09F> -1F0A0..1F0AE ; Extended_Pictographic# 6.0 [15] (🂠️..🂮️) PLAYING CARD BACK..PLAYING CARD KING OF SPADES -1F0AF..1F0B0 ; Extended_Pictographic# NA [2] (️..️) <reserved-1F0AF>..<reserved-1F0B0> -1F0B1..1F0BE ; Extended_Pictographic# 6.0 [14] (🂱️..🂾️) PLAYING CARD ACE OF HEARTS..PLAYING CARD KING OF HEARTS -1F0BF ; Extended_Pictographic# 7.0 [1] (🂿️) PLAYING CARD RED JOKER -1F0C0 ; Extended_Pictographic# NA [1] (️) <reserved-1F0C0> -1F0C1..1F0CF ; Extended_Pictographic# 6.0 [15] (🃁️..🃏) PLAYING CARD ACE OF DIAMONDS..joker -1F0D0 ; Extended_Pictographic# NA [1] (️) <reserved-1F0D0> -1F0D1..1F0DF ; Extended_Pictographic# 6.0 [15] (🃑️..🃟️) PLAYING CARD ACE OF CLUBS..PLAYING CARD WHITE JOKER -1F0E0..1F0F5 ; Extended_Pictographic# 7.0 [22] (🃠️..🃵️) PLAYING CARD FOOL..PLAYING CARD TRUMP-21 -1F0F6..1F0FF ; Extended_Pictographic# NA [10] (️..️) <reserved-1F0F6>..<reserved-1F0FF> -1F10D..1F10F ; Extended_Pictographic# NA [3] (🄍️..🄏️) <reserved-1F10D>..<reserved-1F10F> -1F12F ; Extended_Pictographic# 11.0 [1] (🄯️) COPYLEFT SYMBOL -1F16C..1F16F ; Extended_Pictographic# NA [4] (🅬️..🅯️) <reserved-1F16C>..<reserved-1F16F> +1F000..1F02B ; Extended_Pictographic# 5.1 [44] (🀀..🀫) MAHJONG TILE EAST WIND..MAHJONG TILE BACK +1F02C..1F02F ; Extended_Pictographic# NA [4] (..) <reserved-1F02C>..<reserved-1F02F> +1F030..1F093 ; Extended_Pictographic# 5.1[100] (🀰..🂓) DOMINO TILE HORIZONTAL BACK..DOMINO TILE VERTICAL-06-06 +1F094..1F09F ; Extended_Pictographic# NA [12] (..) <reserved-1F094>..<reserved-1F09F> +1F0A0..1F0AE ; Extended_Pictographic# 6.0 [15] (🂠..🂮) PLAYING CARD BACK..PLAYING CARD KING OF SPADES +1F0AF..1F0B0 ; Extended_Pictographic# NA [2] (..) <reserved-1F0AF>..<reserved-1F0B0> +1F0B1..1F0BE ; Extended_Pictographic# 6.0 [14] (🂱..🂾) PLAYING CARD ACE OF HEARTS..PLAYING CARD KING OF HEARTS +1F0BF ; Extended_Pictographic# 7.0 [1] (🂿) PLAYING CARD RED JOKER +1F0C0 ; Extended_Pictographic# NA [1] () <reserved-1F0C0> +1F0C1..1F0CF ; Extended_Pictographic# 6.0 [15] (🃁..🃏) PLAYING CARD ACE OF DIAMONDS..joker +1F0D0 ; Extended_Pictographic# NA [1] () <reserved-1F0D0> +1F0D1..1F0DF ; Extended_Pictographic# 6.0 [15] (🃑..🃟) PLAYING CARD ACE OF CLUBS..PLAYING CARD WHITE JOKER +1F0E0..1F0F5 ; Extended_Pictographic# 7.0 [22] (🃠..🃵) PLAYING CARD FOOL..PLAYING CARD TRUMP-21 +1F0F6..1F0FF ; Extended_Pictographic# NA [10] (..) <reserved-1F0F6>..<reserved-1F0FF> +1F10D..1F10F ; Extended_Pictographic# NA [3] (🄍..🄏) <reserved-1F10D>..<reserved-1F10F> +1F12F ; Extended_Pictographic# 11.0 [1] (🄯) COPYLEFT SYMBOL +1F16C ; Extended_Pictographic# 12.0 [1] (🅬) RAISED MR SIGN +1F16D..1F16F ; Extended_Pictographic# NA [3] (🅭..🅯) <reserved-1F16D>..<reserved-1F16F> 1F170..1F171 ; Extended_Pictographic# 6.0 [2] (🅰️..🅱️) A button (blood type)..B button (blood type) 1F17E ; Extended_Pictographic# 6.0 [1] (🅾️) O button (blood type) 1F17F ; Extended_Pictographic# 5.2 [1] (🅿️) P button 1F18E ; Extended_Pictographic# 6.0 [1] (🆎) AB button (blood type) 1F191..1F19A ; Extended_Pictographic# 6.0 [10] (🆑..🆚) CL button..VS button -1F1AD..1F1E5 ; Extended_Pictographic# NA [57] (🆭️..️) <reserved-1F1AD>..<reserved-1F1E5> +1F1AD..1F1E5 ; Extended_Pictographic# NA [57] (🆭..) <reserved-1F1AD>..<reserved-1F1E5> 1F201..1F202 ; Extended_Pictographic# 6.0 [2] (🈁..🈂️) Japanese “here” button..Japanese “service charge” button -1F203..1F20F ; Extended_Pictographic# NA [13] (️..️) <reserved-1F203>..<reserved-1F20F> +1F203..1F20F ; Extended_Pictographic# NA [13] (..) <reserved-1F203>..<reserved-1F20F> 1F21A ; Extended_Pictographic# 5.2 [1] (🈚) Japanese “free of charge” button 1F22F ; Extended_Pictographic# 5.2 [1] (🈯) Japanese “reserved” button 1F232..1F23A ; Extended_Pictographic# 6.0 [9] (🈲..🈺) Japanese “prohibited” button..Japanese “open for business” button -1F23C..1F23F ; Extended_Pictographic# NA [4] (️..️) <reserved-1F23C>..<reserved-1F23F> -1F249..1F24F ; Extended_Pictographic# NA [7] (️..️) <reserved-1F249>..<reserved-1F24F> +1F23C..1F23F ; Extended_Pictographic# NA [4] (..) <reserved-1F23C>..<reserved-1F23F> +1F249..1F24F ; Extended_Pictographic# NA [7] (..) <reserved-1F249>..<reserved-1F24F> 1F250..1F251 ; Extended_Pictographic# 6.0 [2] (🉐..🉑) Japanese “bargain” button..Japanese “acceptable” button -1F252..1F25F ; Extended_Pictographic# NA [14] (️..️) <reserved-1F252>..<reserved-1F25F> -1F260..1F265 ; Extended_Pictographic# 10.0 [6] (🉠️..🉥️) ROUNDED SYMBOL FOR FU..ROUNDED SYMBOL FOR CAI -1F266..1F2FF ; Extended_Pictographic# NA[154] (️..️) <reserved-1F266>..<reserved-1F2FF> +1F252..1F25F ; Extended_Pictographic# NA [14] (..) <reserved-1F252>..<reserved-1F25F> +1F260..1F265 ; Extended_Pictographic# 10.0 [6] (🉠..🉥) ROUNDED SYMBOL FOR FU..ROUNDED SYMBOL FOR CAI +1F266..1F2FF ; Extended_Pictographic# NA[154] (..) <reserved-1F266>..<reserved-1F2FF> 1F300..1F320 ; Extended_Pictographic# 6.0 [33] (🌀..🌠) cyclone..shooting star 1F321..1F32C ; Extended_Pictographic# 7.0 [12] (🌡️..🌬️) thermometer..wind face 1F32D..1F32F ; Extended_Pictographic# 8.0 [3] (🌭..🌯) hot dog..burrito @@ -594,7 +629,7 @@ E0020..E007F ; Emoji_Component # 3.1 [96] (..) tag space..ca 1F37D ; Extended_Pictographic# 7.0 [1] (🍽️) fork and knife with plate 1F37E..1F37F ; Extended_Pictographic# 8.0 [2] (🍾..🍿) bottle with popping cork..popcorn 1F380..1F393 ; Extended_Pictographic# 6.0 [20] (🎀..🎓) ribbon..graduation cap -1F394..1F39F ; Extended_Pictographic# 7.0 [12] (🎔️..🎟️) HEART WITH TIP ON THE LEFT..admission tickets +1F394..1F39F ; Extended_Pictographic# 7.0 [12] (🎔..🎟️) HEART WITH TIP ON THE LEFT..admission tickets 1F3A0..1F3C4 ; Extended_Pictographic# 6.0 [37] (🎠..🏄) carousel horse..person surfing 1F3C5 ; Extended_Pictographic# 7.0 [1] (🏅) sports medal 1F3C6..1F3CA ; Extended_Pictographic# 6.0 [5] (🏆..🏊) trophy..person swimming @@ -602,7 +637,7 @@ E0020..E007F ; Emoji_Component # 3.1 [96] (..) tag space..ca 1F3CF..1F3D3 ; Extended_Pictographic# 8.0 [5] (🏏..🏓) cricket game..ping pong 1F3D4..1F3DF ; Extended_Pictographic# 7.0 [12] (🏔️..🏟️) snow-capped mountain..stadium 1F3E0..1F3F0 ; Extended_Pictographic# 6.0 [17] (🏠..🏰) house..castle -1F3F1..1F3F7 ; Extended_Pictographic# 7.0 [7] (🏱️..🏷️) WHITE PENNANT..label +1F3F1..1F3F7 ; Extended_Pictographic# 7.0 [7] (🏱..🏷️) WHITE PENNANT..label 1F3F8..1F3FA ; Extended_Pictographic# 8.0 [3] (🏸..🏺) badminton..amphora 1F400..1F43E ; Extended_Pictographic# 6.0 [63] (🐀..🐾) rat..paw prints 1F43F ; Extended_Pictographic# 7.0 [1] (🐿️) chipmunk @@ -611,15 +646,15 @@ E0020..E007F ; Emoji_Component # 3.1 [96] (..) tag space..ca 1F442..1F4F7 ; Extended_Pictographic# 6.0[182] (👂..📷) ear..camera 1F4F8 ; Extended_Pictographic# 7.0 [1] (📸) camera with flash 1F4F9..1F4FC ; Extended_Pictographic# 6.0 [4] (📹..📼) video camera..videocassette -1F4FD..1F4FE ; Extended_Pictographic# 7.0 [2] (📽️..📾️) film projector..PORTABLE STEREO +1F4FD..1F4FE ; Extended_Pictographic# 7.0 [2] (📽️..📾) film projector..PORTABLE STEREO 1F4FF ; Extended_Pictographic# 8.0 [1] (📿) prayer beads 1F500..1F53D ; Extended_Pictographic# 6.0 [62] (🔀..🔽) shuffle tracks button..downwards button -1F546..1F54A ; Extended_Pictographic# 7.0 [5] (🕆️..🕊️) WHITE LATIN CROSS..dove -1F54B..1F54F ; Extended_Pictographic# 8.0 [5] (🕋..🕏️) kaaba..BOWL OF HYGIEIA +1F546..1F54A ; Extended_Pictographic# 7.0 [5] (🕆..🕊️) WHITE LATIN CROSS..dove +1F54B..1F54F ; Extended_Pictographic# 8.0 [5] (🕋..🕏) kaaba..BOWL OF HYGIEIA 1F550..1F567 ; Extended_Pictographic# 6.0 [24] (🕐..🕧) one o’clock..twelve-thirty -1F568..1F579 ; Extended_Pictographic# 7.0 [18] (🕨️..🕹️) RIGHT SPEAKER..joystick +1F568..1F579 ; Extended_Pictographic# 7.0 [18] (🕨..🕹️) RIGHT SPEAKER..joystick 1F57A ; Extended_Pictographic# 9.0 [1] (🕺) man dancing -1F57B..1F5A3 ; Extended_Pictographic# 7.0 [41] (🕻️..🖣️) LEFT HAND TELEPHONE RECEIVER..BLACK DOWN POINTING BACKHAND INDEX +1F57B..1F5A3 ; Extended_Pictographic# 7.0 [41] (🕻..🖣) LEFT HAND TELEPHONE RECEIVER..BLACK DOWN POINTING BACKHAND INDEX 1F5A4 ; Extended_Pictographic# 9.0 [1] (🖤) black heart 1F5A5..1F5FA ; Extended_Pictographic# 7.0 [86] (🖥️..🗺️) desktop computer..world map 1F5FB..1F5FF ; Extended_Pictographic# 6.0 [5] (🗻..🗿) mount fuji..moai @@ -644,32 +679,37 @@ E0020..E007F ; Emoji_Component # 3.1 [96] (..) tag space..ca 1F62E..1F62F ; Extended_Pictographic# 6.1 [2] (😮..😯) face with open mouth..hushed face 1F630..1F633 ; Extended_Pictographic# 6.0 [4] (😰..😳) anxious face with sweat..flushed face 1F634 ; Extended_Pictographic# 6.1 [1] (😴) sleeping face -1F635..1F640 ; Extended_Pictographic# 6.0 [12] (😵..🙀) dizzy face..weary cat face +1F635..1F640 ; Extended_Pictographic# 6.0 [12] (😵..🙀) dizzy face..weary cat 1F641..1F642 ; Extended_Pictographic# 7.0 [2] (🙁..🙂) slightly frowning face..slightly smiling face 1F643..1F644 ; Extended_Pictographic# 8.0 [2] (🙃..🙄) upside-down face..face with rolling eyes 1F645..1F64F ; Extended_Pictographic# 6.0 [11] (🙅..🙏) person gesturing NO..folded hands 1F680..1F6C5 ; Extended_Pictographic# 6.0 [70] (🚀..🛅) rocket..left luggage -1F6C6..1F6CF ; Extended_Pictographic# 7.0 [10] (🛆️..🛏️) TRIANGLE WITH ROUNDED CORNERS..bed +1F6C6..1F6CF ; Extended_Pictographic# 7.0 [10] (🛆..🛏️) TRIANGLE WITH ROUNDED CORNERS..bed 1F6D0 ; Extended_Pictographic# 8.0 [1] (🛐) place of worship 1F6D1..1F6D2 ; Extended_Pictographic# 9.0 [2] (🛑..🛒) stop sign..shopping cart -1F6D3..1F6D4 ; Extended_Pictographic# 10.0 [2] (🛓️..🛔️) STUPA..PAGODA -1F6D5..1F6DF ; Extended_Pictographic# NA [11] (🛕️..🛟️) <reserved-1F6D5>..<reserved-1F6DF> +1F6D3..1F6D4 ; Extended_Pictographic# 10.0 [2] (🛓..🛔) STUPA..PAGODA +1F6D5 ; Extended_Pictographic# 12.0 [1] (🛕) hindu temple +1F6D6..1F6DF ; Extended_Pictographic# NA [10] (🛖..🛟) <reserved-1F6D6>..<reserved-1F6DF> 1F6E0..1F6EC ; Extended_Pictographic# 7.0 [13] (🛠️..🛬) hammer and wrench..airplane arrival -1F6ED..1F6EF ; Extended_Pictographic# NA [3] (️..️) <reserved-1F6ED>..<reserved-1F6EF> +1F6ED..1F6EF ; Extended_Pictographic# NA [3] (..) <reserved-1F6ED>..<reserved-1F6EF> 1F6F0..1F6F3 ; Extended_Pictographic# 7.0 [4] (🛰️..🛳️) satellite..passenger ship 1F6F4..1F6F6 ; Extended_Pictographic# 9.0 [3] (🛴..🛶) kick scooter..canoe 1F6F7..1F6F8 ; Extended_Pictographic# 10.0 [2] (🛷..🛸) sled..flying saucer 1F6F9 ; Extended_Pictographic# 11.0 [1] (🛹) skateboard -1F6FA..1F6FF ; Extended_Pictographic# NA [6] (🛺️..️) <reserved-1F6FA>..<reserved-1F6FF> -1F774..1F77F ; Extended_Pictographic# NA [12] (🝴️..🝿️) <reserved-1F774>..<reserved-1F77F> -1F7D5..1F7D8 ; Extended_Pictographic# 11.0 [4] (🟕️..🟘️) CIRCLED TRIANGLE..NEGATIVE CIRCLED SQUARE -1F7D9..1F7FF ; Extended_Pictographic# NA [39] (🟙️..️) <reserved-1F7D9>..<reserved-1F7FF> -1F80C..1F80F ; Extended_Pictographic# NA [4] (️..️) <reserved-1F80C>..<reserved-1F80F> -1F848..1F84F ; Extended_Pictographic# NA [8] (️..️) <reserved-1F848>..<reserved-1F84F> -1F85A..1F85F ; Extended_Pictographic# NA [6] (️..️) <reserved-1F85A>..<reserved-1F85F> -1F888..1F88F ; Extended_Pictographic# NA [8] (️..️) <reserved-1F888>..<reserved-1F88F> -1F8AE..1F8FF ; Extended_Pictographic# NA [82] (️..️) <reserved-1F8AE>..<reserved-1F8FF> -1F90C..1F90F ; Extended_Pictographic# NA [4] (🤌️..🤏️) <reserved-1F90C>..<reserved-1F90F> +1F6FA ; Extended_Pictographic# 12.0 [1] (🛺) auto rickshaw +1F6FB..1F6FF ; Extended_Pictographic# NA [5] (🛻..) <reserved-1F6FB>..<reserved-1F6FF> +1F774..1F77F ; Extended_Pictographic# NA [12] (🝴..🝿) <reserved-1F774>..<reserved-1F77F> +1F7D5..1F7D8 ; Extended_Pictographic# 11.0 [4] (🟕..🟘) CIRCLED TRIANGLE..NEGATIVE CIRCLED SQUARE +1F7D9..1F7DF ; Extended_Pictographic# NA [7] (🟙..) <reserved-1F7D9>..<reserved-1F7DF> +1F7E0..1F7EB ; Extended_Pictographic# 12.0 [12] (🟠..🟫) orange circle..brown square +1F7EC..1F7FF ; Extended_Pictographic# NA [20] (..) <reserved-1F7EC>..<reserved-1F7FF> +1F80C..1F80F ; Extended_Pictographic# NA [4] (..) <reserved-1F80C>..<reserved-1F80F> +1F848..1F84F ; Extended_Pictographic# NA [8] (..) <reserved-1F848>..<reserved-1F84F> +1F85A..1F85F ; Extended_Pictographic# NA [6] (..) <reserved-1F85A>..<reserved-1F85F> +1F888..1F88F ; Extended_Pictographic# NA [8] (..) <reserved-1F888>..<reserved-1F88F> +1F8AE..1F8FF ; Extended_Pictographic# NA [82] (..) <reserved-1F8AE>..<reserved-1F8FF> +1F90C ; Extended_Pictographic# NA [1] (🤌) <reserved-1F90C> +1F90D..1F90F ; Extended_Pictographic# 12.0 [3] (🤍..🤏) white heart..pinching hand 1F910..1F918 ; Extended_Pictographic# 8.0 [9] (🤐..🤘) zipper-mouth face..sign of the horns 1F919..1F91E ; Extended_Pictographic# 9.0 [6] (🤙..🤞) call me hand..crossed fingers 1F91F ; Extended_Pictographic# 10.0 [1] (🤟) love-you gesture @@ -679,35 +719,50 @@ E0020..E007F ; Emoji_Component # 3.1 [96] (..) tag space..ca 1F931..1F932 ; Extended_Pictographic# 10.0 [2] (🤱..🤲) breast-feeding..palms up together 1F933..1F93A ; Extended_Pictographic# 9.0 [8] (🤳..🤺) selfie..person fencing 1F93C..1F93E ; Extended_Pictographic# 9.0 [3] (🤼..🤾) people wrestling..person playing handball -1F93F ; Extended_Pictographic# NA [1] (🤿️) <reserved-1F93F> +1F93F ; Extended_Pictographic# 12.0 [1] (🤿) diving mask 1F940..1F945 ; Extended_Pictographic# 9.0 [6] (🥀..🥅) wilted flower..goal net 1F947..1F94B ; Extended_Pictographic# 9.0 [5] (🥇..🥋) 1st place medal..martial arts uniform 1F94C ; Extended_Pictographic# 10.0 [1] (🥌) curling stone 1F94D..1F94F ; Extended_Pictographic# 11.0 [3] (🥍..🥏) lacrosse..flying disc 1F950..1F95E ; Extended_Pictographic# 9.0 [15] (🥐..🥞) croissant..pancakes 1F95F..1F96B ; Extended_Pictographic# 10.0 [13] (🥟..🥫) dumpling..canned food -1F96C..1F970 ; Extended_Pictographic# 11.0 [5] (🥬..🥰) leafy green..smiling face with 3 hearts -1F971..1F972 ; Extended_Pictographic# NA [2] (🥱️..🥲️) <reserved-1F971>..<reserved-1F972> +1F96C..1F970 ; Extended_Pictographic# 11.0 [5] (🥬..🥰) leafy green..smiling face with hearts +1F971 ; Extended_Pictographic# 12.0 [1] (🥱) yawning face +1F972 ; Extended_Pictographic# NA [1] (🥲) <reserved-1F972> 1F973..1F976 ; Extended_Pictographic# 11.0 [4] (🥳..🥶) partying face..cold face -1F977..1F979 ; Extended_Pictographic# NA [3] (🥷️..🥹️) <reserved-1F977>..<reserved-1F979> +1F977..1F979 ; Extended_Pictographic# NA [3] (🥷..🥹) <reserved-1F977>..<reserved-1F979> 1F97A ; Extended_Pictographic# 11.0 [1] (🥺) pleading face -1F97B ; Extended_Pictographic# NA [1] (🥻️) <reserved-1F97B> -1F97C..1F97F ; Extended_Pictographic# 11.0 [4] (🥼..🥿) lab coat..woman’s flat shoe -1F980..1F984 ; Extended_Pictographic# 8.0 [5] (🦀..🦄) crab..unicorn face +1F97B ; Extended_Pictographic# 12.0 [1] (🥻) sari +1F97C..1F97F ; Extended_Pictographic# 11.0 [4] (🥼..🥿) lab coat..flat shoe +1F980..1F984 ; Extended_Pictographic# 8.0 [5] (🦀..🦄) crab..unicorn 1F985..1F991 ; Extended_Pictographic# 9.0 [13] (🦅..🦑) eagle..squid 1F992..1F997 ; Extended_Pictographic# 10.0 [6] (🦒..🦗) giraffe..cricket 1F998..1F9A2 ; Extended_Pictographic# 11.0 [11] (🦘..🦢) kangaroo..swan -1F9A3..1F9AF ; Extended_Pictographic# NA [13] (🦣️..🦯️) <reserved-1F9A3>..<reserved-1F9AF> -1F9B0..1F9B9 ; Extended_Pictographic# 11.0 [10] (🦰..🦹) red-haired..supervillain -1F9BA..1F9BF ; Extended_Pictographic# NA [6] (🦺️..🦿️) <reserved-1F9BA>..<reserved-1F9BF> +1F9A3..1F9A4 ; Extended_Pictographic# NA [2] (🦣..🦤) <reserved-1F9A3>..<reserved-1F9A4> +1F9A5..1F9AA ; Extended_Pictographic# 12.0 [6] (🦥..🦪) sloth..oyster +1F9AB..1F9AD ; Extended_Pictographic# NA [3] (🦫..🦭) <reserved-1F9AB>..<reserved-1F9AD> +1F9AE..1F9AF ; Extended_Pictographic# 12.0 [2] (🦮..🦯) guide dog..probing cane +1F9B0..1F9B9 ; Extended_Pictographic# 11.0 [10] (🦰..🦹) red hair..supervillain +1F9BA..1F9BF ; Extended_Pictographic# 12.0 [6] (🦺..🦿) safety vest..mechanical leg 1F9C0 ; Extended_Pictographic# 8.0 [1] (🧀) cheese wedge 1F9C1..1F9C2 ; Extended_Pictographic# 11.0 [2] (🧁..🧂) cupcake..salt -1F9C3..1F9CF ; Extended_Pictographic# NA [13] (🧃️..🧏️) <reserved-1F9C3>..<reserved-1F9CF> +1F9C3..1F9CA ; Extended_Pictographic# 12.0 [8] (🧃..🧊) beverage box..ice cube +1F9CB..1F9CC ; Extended_Pictographic# NA [2] (🧋..🧌) <reserved-1F9CB>..<reserved-1F9CC> +1F9CD..1F9CF ; Extended_Pictographic# 12.0 [3] (🧍..🧏) person standing..deaf person 1F9D0..1F9E6 ; Extended_Pictographic# 10.0 [23] (🧐..🧦) face with monocle..socks 1F9E7..1F9FF ; Extended_Pictographic# 11.0 [25] (🧧..🧿) red envelope..nazar amulet -1FA00..1FA5F ; Extended_Pictographic# NA [96] (🨀️..️) <reserved-1FA00>..<reserved-1FA5F> -1FA60..1FA6D ; Extended_Pictographic# 11.0 [14] (🩠️..🩭️) XIANGQI RED GENERAL..XIANGQI BLACK SOLDIER -1FA6E..1FFFD ; Extended_Pictographic# NA[1424] (️..️) <reserved-1FA6E>..<reserved-1FFFD> +1FA00..1FA53 ; Extended_Pictographic# 12.0 [84] (🨀..🩓) NEUTRAL CHESS KING..BLACK CHESS KNIGHT-BISHOP +1FA54..1FA5F ; Extended_Pictographic# NA [12] (..) <reserved-1FA54>..<reserved-1FA5F> +1FA60..1FA6D ; Extended_Pictographic# 11.0 [14] (🩠..🩭) XIANGQI RED GENERAL..XIANGQI BLACK SOLDIER +1FA6E..1FA6F ; Extended_Pictographic# NA [2] (..) <reserved-1FA6E>..<reserved-1FA6F> +1FA70..1FA73 ; Extended_Pictographic# 12.0 [4] (🩰..🩳) ballet shoes..shorts +1FA74..1FA77 ; Extended_Pictographic# NA [4] (🩴..🩷) <reserved-1FA74>..<reserved-1FA77> +1FA78..1FA7A ; Extended_Pictographic# 12.0 [3] (🩸..🩺) drop of blood..stethoscope +1FA7B..1FA7F ; Extended_Pictographic# NA [5] (🩻..) <reserved-1FA7B>..<reserved-1FA7F> +1FA80..1FA82 ; Extended_Pictographic# 12.0 [3] (🪀..🪂) yo-yo..parachute +1FA83..1FA8F ; Extended_Pictographic# NA [13] (🪃..) <reserved-1FA83>..<reserved-1FA8F> +1FA90..1FA95 ; Extended_Pictographic# 12.0 [6] (🪐..🪕) ringed planet..banjo +1FA96..1FFFD ; Extended_Pictographic# NA[1384] (🪖..) <reserved-1FA96>..<reserved-1FFFD> # Total elements: 3793 diff --git a/lib/stdlib/uc_spec/gen_unicode_mod.escript b/lib/stdlib/uc_spec/gen_unicode_mod.escript index de67b18afc..d820b9ed8e 100644 --- a/lib/stdlib/uc_spec/gen_unicode_mod.escript +++ b/lib/stdlib/uc_spec/gen_unicode_mod.escript @@ -191,7 +191,7 @@ gen_static(Fd) -> " {U,L} -> #{upper=>U,lower=>L,title=>U,fold=>L};\n" " {U,L,T,F} -> #{upper=>U,lower=>L,title=>T,fold=>F}\n" " end.\n\n"), - io:put_chars(Fd, "spec_version() -> {11,0}.\n\n\n"), + io:put_chars(Fd, "spec_version() -> {12,1}.\n\n\n"), io:put_chars(Fd, "class(Codepoint) -> {CCC,_,_} = unicode_table(Codepoint),\n CCC.\n\n"), io:put_chars(Fd, "-spec uppercase(unicode:chardata()) -> " "maybe_improper_list(gc(),unicode:chardata()).\n"), diff --git a/lib/syntax_tools/Makefile b/lib/syntax_tools/Makefile index 14ae6d4f97..d3e2aa9b2c 100644 --- a/lib/syntax_tools/Makefile +++ b/lib/syntax_tools/Makefile @@ -91,3 +91,5 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/syntax_tools/doc/src/Makefile b/lib/syntax_tools/doc/src/Makefile index b799c76177..3ff5b92cd7 100644 --- a/lib/syntax_tools/doc/src/Makefile +++ b/lib/syntax_tools/doc/src/Makefile @@ -28,21 +28,10 @@ VSN=$(SYNTAX_TOOLS_VSN) APPLICATION=syntax_tools # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- -# Man page source directory (with .erl files) -# ---------------------------------------------------- -SRC_DIR = $(ERL_TOP)/lib/syntax_tools/src -INC_DIR = $(ERL_TOP)/lib/syntax_tools/include - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = \ +EDOC_REF3_FILES = \ epp_dodger.xml \ erl_comment_scan.xml \ erl_prettypr.xml \ @@ -56,100 +45,20 @@ XML_REF3_FILES = \ prettypr.xml XML_PART_FILES = part.xml -XML_CHAPTER_FILES = chapter.xml +EDOC_CHAPTER_FILE = chapter.xml XML_NOTES_FILES = notes.xml BOOK_FILES = book.xml - XML_FILES=\ $(BOOK_FILES) $(XML_PART_FILES) $(XML_APPLICATION_FILES) \ $(XML_NOTES_FILES) -XML_GEN_FILES = $(XML_REF3_FILES:%=$(XMLDIR)/%) $(XML_CHAPTER_FILES:%=$(XMLDIR)/%) - -# ---------------------------------------------------- -INFO_FILE = ../../info - -HTML_FILES = \ - $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +HTML_EXTRA_FILES = ../../examples/demo.erl -EXAMPLES_DIR = ../../examples -EXAMPLES = $(EXAMPLES_DIR)/demo.erl - -SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) +XML_GEN_FILES = $(XML_CHAPTER_FILES:%=$(XMLDIR)/%) TOP_SPECS_FILE = specs.xml # ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -SPECS_FLAGS = -I../../include -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: man pdf html - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) - -$(XML_REF3_FILES:%=$(XMLDIR)/%): - $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript \ - -dir $(XMLDIR) $(SRC_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) - -$(XML_CHAPTER_FILES:%=$(XMLDIR)/%): - $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(VSN) \ - -chapter -dir $(XMLDIR) ../overview.edoc - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -xml: $(XML_REF3_FILES) $(XML_CHAPTER_FILES) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(XML_REF3_FILES) $(XML_CHAPTER_FILES) *.html - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f $(SPECDIR)/* - rm -f errs core *~ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - $(INSTALL_DIR) "$(RELSYSDIR)/examples" - $(INSTALL_DATA) $(EXAMPLES) "$(RELSYSDIR)/doc/html" - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index 7e741cc649..da22a91de0 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -598,8 +598,6 @@ skip_macro_args([{'receive',_}=T | Ts], Es, As) -> skip_macro_args(Ts, ['end' | Es], [T | As]); skip_macro_args([{'try',_}=T | Ts], Es, As) -> skip_macro_args(Ts, ['end' | Es], [T | As]); -skip_macro_args([{'cond',_}=T | Ts], Es, As) -> - skip_macro_args(Ts, ['end' | Es], [T | As]); skip_macro_args([{E,_}=T | Ts], [E], As) -> %final close {lists:reverse([T | As]), Ts}; skip_macro_args([{E,_}=T | Ts], [E | Es], As) -> %matching close diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index 6ad9bec2e6..75a5cd56bf 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -53,7 +53,7 @@ -type hook() :: 'none' | fun((erl_syntax:syntaxTree(), _, _) -> prettypr:document()). --type clause_t() :: 'case_expr' | 'cond_expr' | 'fun_expr' +-type clause_t() :: 'case_expr' | 'fun_expr' | 'if_expr' | 'receive_expr' | 'try_expr' | {'function', prettypr:document()} | 'spec'. @@ -66,7 +66,8 @@ paper = ?PAPER :: integer(), ribbon = ?RIBBON :: integer(), user = ?NOUSER :: term(), - encoding = epp:default_encoding() :: epp:source_encoding()}). + encoding = epp:default_encoding() :: epp:source_encoding(), + empty_lines = sets:new() :: sets:set(integer())}). -type context() :: #ctxt{}. @@ -358,7 +359,8 @@ layout(Node, Options) -> ribbon = proplists:get_value(ribbon, Options, ?RIBBON), user = proplists:get_value(user, Options), encoding = proplists:get_value(encoding, Options, - epp:default_encoding())}). + epp:default_encoding()), + empty_lines = proplists:get_value(empty_lines, Options, sets:new())}). lay(Node, Ctxt) -> case erl_syntax:get_ann(Node) of @@ -474,13 +476,13 @@ lay_2(Node, Ctxt) -> floating(text(",")), reset_prec(Ctxt), fun lay/2), beside(floating(text("{")), - beside(par(Es), + beside(sep(Es), floating(text("}")))); list -> Ctxt1 = reset_prec(Ctxt), Node1 = erl_syntax:compact_list(Node), - D1 = par(seq(erl_syntax:list_prefix(Node1), + D1 = sep(seq(erl_syntax:list_prefix(Node1), floating(text(",")), Ctxt1, fun lay/2)), D = case erl_syntax:list_suffix(Node1) of @@ -513,7 +515,7 @@ lay_2(Node, Ctxt) -> D2 = lay(Operator, reset_prec(Ctxt)), D3 = lay(erl_syntax:infix_expr_right(Node), set_prec(Ctxt, PrecR)), - D4 = par([D1, D2, D3], Ctxt#ctxt.sub_indent), + D4 = par([D1, D2, D3], Ctxt#ctxt.break_indent), maybe_parentheses(D4, Prec, Ctxt); prefix_expr -> @@ -535,7 +537,7 @@ lay_2(Node, Ctxt) -> '-' -> beside(D1, D2); _ -> - par([D1, D2], Ctxt#ctxt.sub_indent) + par([D1, D2], Ctxt#ctxt.break_indent) end, maybe_parentheses(D3, Prec, Ctxt); @@ -547,7 +549,7 @@ lay_2(Node, Ctxt) -> floating(text(",")), reset_prec(Ctxt), fun lay/2), D1 = beside(D, beside(text("("), - beside(par(As), + beside(sep(As), floating(text(")"))))), maybe_parentheses(D1, Prec, Ctxt); @@ -576,9 +578,7 @@ lay_2(Node, Ctxt) -> G -> lay(G, Ctxt1) end, - D3 = sep(seq(erl_syntax:clause_body(Node), - floating(text(",")), Ctxt1, - fun lay/2)), + D3 = lay_clause_expressions(erl_syntax:clause_body(Node), Ctxt1), case Ctxt#ctxt.clause of fun_expr -> make_fun_clause(D1, D2, D3, Ctxt); @@ -586,8 +586,6 @@ lay_2(Node, Ctxt) -> make_fun_clause(N, D1, D2, D3, Ctxt); if_expr -> make_if_clause(D1, D2, D3, Ctxt); - cond_expr -> - make_if_clause(D1, D2, D3, Ctxt); case_expr -> make_case_clause(D1, D2, D3, Ctxt); receive_expr -> @@ -614,32 +612,24 @@ lay_2(Node, Ctxt) -> D1 = lay(erl_syntax:case_expr_argument(Node), Ctxt1), D2 = lay_clauses(erl_syntax:case_expr_clauses(Node), case_expr, Ctxt1), - sep([par([follow(text("case"), D1, Ctxt1#ctxt.sub_indent), + sep([par([follow(text("case"), D1, Ctxt1#ctxt.break_indent), text("of")], Ctxt1#ctxt.break_indent), - nest(Ctxt1#ctxt.sub_indent, D2), + nest(Ctxt1#ctxt.break_indent, D2), text("end")]); if_expr -> Ctxt1 = reset_prec(Ctxt), D = lay_clauses(erl_syntax:if_expr_clauses(Node), if_expr, Ctxt1), - sep([follow(text("if"), D, Ctxt1#ctxt.sub_indent), - text("end")]); - - cond_expr -> - Ctxt1 = reset_prec(Ctxt), - D = lay_clauses(erl_syntax:cond_expr_clauses(Node), - cond_expr, Ctxt1), - sep([text("cond"), - nest(Ctxt1#ctxt.sub_indent, D), + sep([follow(text("if"), D, Ctxt1#ctxt.break_indent), text("end")]); fun_expr -> Ctxt1 = reset_prec(Ctxt), D = lay_clauses(erl_syntax:fun_expr_clauses(Node), fun_expr, Ctxt1), - sep([follow(text("fun"), D, Ctxt1#ctxt.sub_indent), + sep([follow(text("fun"), D, Ctxt1#ctxt.break_indent), text("end")]); named_fun_expr -> @@ -647,7 +637,7 @@ lay_2(Node, Ctxt) -> D1 = lay(erl_syntax:named_fun_expr_name(Node), Ctxt1), D = lay_clauses(erl_syntax:named_fun_expr_clauses(Node), {function,D1}, Ctxt1), - sep([follow(text("fun"), D, Ctxt1#ctxt.sub_indent), + sep([follow(text("fun"), D, Ctxt1#ctxt.break_indent), text("end")]); module_qualifier -> @@ -734,7 +724,7 @@ lay_2(Node, Ctxt) -> _ when Args =:= none -> lay(N, Ctxt1); _ -> - D1 = par(seq(Args, floating(text(",")), Ctxt1, + D1 = sep(seq(Args, text(","), Ctxt1, fun lay/2)), beside(lay(N, Ctxt1), beside(text("("), @@ -766,14 +756,14 @@ lay_2(Node, Ctxt) -> Es = seq(erl_syntax:block_expr_body(Node), floating(text(",")), Ctxt1, fun lay/2), sep([text("begin"), - nest(Ctxt1#ctxt.sub_indent, sep(Es)), + nest(Ctxt1#ctxt.break_indent, sep(Es)), text("end")]); catch_expr -> {Prec, PrecR} = preop_prec('catch'), D = lay(erl_syntax:catch_expr_body(Node), set_prec(Ctxt, PrecR)), - D1 = follow(text("catch"), D, Ctxt#ctxt.sub_indent), + D1 = follow(text("catch"), D, Ctxt#ctxt.break_indent), maybe_parentheses(D1, Prec, Ctxt); class_qualifier -> @@ -903,10 +893,10 @@ lay_2(Node, Ctxt) -> follow(floating(text("after")), append_clause_body(D4, D3, Ctxt1), - Ctxt1#ctxt.sub_indent)]) + Ctxt1#ctxt.break_indent)]) end, sep([text("receive"), - nest(Ctxt1#ctxt.sub_indent, D2), + nest(Ctxt1#ctxt.break_indent, D2), text("end")]); record_access -> @@ -1003,7 +993,7 @@ lay_2(Node, Ctxt) -> D1 = lay(erl_syntax:typed_record_field_body(Node), Ctxt1), D2 = lay(erl_syntax:typed_record_field_type(Node), set_prec(Ctxt, Prec)), - D3 = par([D1, floating(text(" ::")), D2], + D3 = par([D1, floating(text("::")), D2], Ctxt1#ctxt.break_indent), maybe_parentheses(D3, Prec, Ctxt); @@ -1018,7 +1008,7 @@ lay_2(Node, Ctxt) -> D2 = sep(seq(As, floating(text(",")), Ctxt1, fun lay/2)), [text("after"), - nest(Ctxt1#ctxt.sub_indent, D2) + nest(Ctxt1#ctxt.break_indent, D2) | Es0] end, Es2 = case erl_syntax:try_expr_handlers(Node) of @@ -1026,7 +1016,7 @@ lay_2(Node, Ctxt) -> Hs -> D3 = lay_clauses(Hs, try_expr, Ctxt1), [text("catch"), - nest(Ctxt1#ctxt.sub_indent, D3) + nest(Ctxt1#ctxt.break_indent, D3) | Es1] end, Es3 = case erl_syntax:try_expr_clauses(Node) of @@ -1034,10 +1024,10 @@ lay_2(Node, Ctxt) -> Cs -> D4 = lay_clauses(Cs, try_expr, Ctxt1), [text("of"), - nest(Ctxt1#ctxt.sub_indent, D4) + nest(Ctxt1#ctxt.break_indent, D4) | Es2] end, - sep([par([follow(text("try"), D1, Ctxt1#ctxt.sub_indent), + sep([par([follow(text("try"), D1, Ctxt1#ctxt.break_indent), hd(Es3)]) | tl(Es3)]); @@ -1213,12 +1203,12 @@ lay_2(Node, Ctxt) -> floating(text(",")), reset_prec(Ctxt), fun lay/2), beside(floating(text("{")), - beside(par(Es), floating(text("}")))) + beside(sep(Es), floating(text("}")))) end; type_union -> {_, Prec, PrecR} = type_inop_prec('|'), - Es = par(seq(erl_syntax:type_union_types(Node), + Es = sep(seq(erl_syntax:type_union_types(Node), floating(text(" |")), set_prec(Ctxt, PrecR), fun lay/2)), maybe_parentheses(Es, Prec, Ctxt); @@ -1504,5 +1494,27 @@ tidy_float_2([$e | Cs]) -> tidy_float_2([$e, $+ | Cs]); tidy_float_2([_C | Cs]) -> tidy_float_2(Cs); tidy_float_2([]) -> []. +lay_clause_expressions([H], Ctxt) -> + lay(H, Ctxt); +lay_clause_expressions([H | T], Ctxt) -> + Clause = beside(lay(H, Ctxt), floating(text(","))), + Next = lay_clause_expressions(T, Ctxt), + case is_last_and_before_empty_line(H, T, Ctxt) of + true -> + above(above(Clause, text("")), Next); + false -> + above(Clause, Next) + end; +lay_clause_expressions([], _) -> + empty(). + +is_last_and_before_empty_line(H, [], #ctxt{empty_lines = EmptyLines}) -> + try sets:is_element(erl_syntax:get_pos(H) + 1, EmptyLines) + catch error:badarith -> false + end; +is_last_and_before_empty_line(H, [H2 | _], #ctxt{empty_lines = EmptyLines}) -> + try ((erl_syntax:get_pos(H2) - erl_syntax:get_pos(H)) >= 2) and sets:is_element(erl_syntax:get_pos(H) + 1, EmptyLines) + catch error:badarith -> false + end. %% ===================================================================== diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 09ef0bf7a5..ed94bd383c 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -183,8 +183,6 @@ comment/2, comment_padding/1, comment_text/1, - cond_expr/1, - cond_expr_clauses/1, conjunction/1, conjunction_body/1, constrained_function_type/2, @@ -431,6 +429,7 @@ -record(tree, {type :: atom(), attr = #attr{} :: #attr{}, data :: term()}). +-type tree() :: #tree{}. %% `wrapper' records are used for attaching new-form node information to %% `erl_parse' trees. @@ -446,18 +445,20 @@ -record(wrapper, {type :: atom(), attr = #attr{} :: #attr{}, tree :: erl_parse()}). +-type wrapper() :: #wrapper{}. %% ===================================================================== --type syntaxTree() :: #tree{} | #wrapper{} | erl_parse(). +-type syntaxTree() :: tree() | wrapper() | erl_parse(). -type erl_parse() :: erl_parse:abstract_clause() | erl_parse:abstract_expr() | erl_parse:abstract_form() | erl_parse:abstract_type() | erl_parse:form_info() - %% To shut up Dialyzer: - | {bin_element, _, _, _, _}. + | erl_parse:af_binelement(term()) + | erl_parse:af_generator() + | erl_parse:af_remote_function(). %% The representation built by the Erlang standard library parser %% `erl_parse'. This is a subset of the {@link syntaxTree()} type. @@ -494,39 +495,38 @@ %% <td>class_qualifier</td> %% <td>clause</td> %% <td>comment</td> -%% <td>cond_expr</td> -%% </tr><tr> %% <td>conjunction</td> +%% </tr><tr> %% <td>constrained_function_type</td> %% <td>constraint</td> %% <td>disjunction</td> -%% </tr><tr> %% <td>eof_marker</td> +%% </tr><tr> %% <td>error_marker</td> %% <td>float</td> %% <td>form_list</td> -%% </tr><tr> %% <td>fun_expr</td> +%% </tr><tr> %% <td>fun_type</td> %% <td>function</td> %% <td>function_type</td> -%% </tr><tr> %% <td>generator</td> +%% </tr><tr> %% <td>if_expr</td> %% <td>implicit_fun</td> %% <td>infix_expr</td> -%% </tr><tr> %% <td>integer</td> +%% </tr><tr> %% <td>integer_range_type</td> %% <td>list</td> %% <td>list_comp</td> -%% </tr><tr> %% <td>macro</td> +%% </tr><tr> %% <td>map_expr</td> %% <td>map_field_assoc</td> %% <td>map_field_exact</td> -%% </tr><tr> %% <td>map_type</td> +%% </tr><tr> %% <td>map_type_assoc</td> %% <td>map_type_exact</td> %% <td>match_expr</td> @@ -556,6 +556,7 @@ %% <td>tuple_type</td> %% <td>typed_record_field</td> %% <td>type_application</td> +%% </tr><tr> %% <td>type_union</td> %% <td>underscore</td> %% <td>user_type_application</td> @@ -587,7 +588,6 @@ %% @see class_qualifier/2 %% @see clause/3 %% @see comment/2 -%% @see cond_expr/1 %% @see conjunction/1 %% @see constrained_function_type/2 %% @see constraint/2 @@ -673,7 +673,6 @@ type(Node) -> %% Composite types {'case', _, _, _} -> case_expr; {'catch', _, _} -> catch_expr; - {'cond', _, _} -> cond_expr; {'fun', _, {clauses, _}} -> fun_expr; {named_fun, _, _, _} -> named_fun_expr; {'fun', _, {function, _, _}} -> implicit_fun; @@ -6290,7 +6289,6 @@ if_expr_clauses(Node) -> %% @see case_expr_argument/1 %% @see clause/3 %% @see if_expr/1 -%% @see cond_expr/1 -record(case_expr, {argument :: syntaxTree(), clauses :: [syntaxTree()]}). @@ -6357,60 +6355,6 @@ case_expr_clauses(Node) -> %% ===================================================================== -%% @doc Creates an abstract cond-expression. If `Clauses' is -%% `[C1, ..., Cn]', the result represents "<code>cond -%% <em>C1</em>; ...; <em>Cn</em> end</code>". More exactly, if each -%% `Ci' represents "<code>() <em>Ei</em> -> -%% <em>Bi</em></code>", then the result represents "<code>cond -%% <em>E1</em> -> <em>B1</em>; ...; <em>En</em> -> <em>Bn</em> -%% end</code>". -%% -%% @see cond_expr_clauses/1 -%% @see clause/3 -%% @see case_expr/2 - -%% type(Node) = cond_expr -%% data(Node) = Clauses -%% -%% Clauses = [syntaxTree()] -%% -%% `erl_parse' representation: -%% -%% {'cond', Pos, Clauses} -%% -%% Clauses = [Clause] \ [] -%% Clause = {clause, ...} -%% -%% See `clause' for documentation on `erl_parse' clauses. - --spec cond_expr([syntaxTree()]) -> syntaxTree(). - -cond_expr(Clauses) -> - tree(cond_expr, Clauses). - -revert_cond_expr(Node) -> - Pos = get_pos(Node), - Clauses = [revert_clause(C) || C <- cond_expr_clauses(Node)], - {'cond', Pos, Clauses}. - - -%% ===================================================================== -%% @doc Returns the list of clause subtrees of a `cond_expr' node. -%% -%% @see cond_expr/1 - --spec cond_expr_clauses(syntaxTree()) -> [syntaxTree()]. - -cond_expr_clauses(Node) -> - case unwrap(Node) of - {'cond', _, Clauses} -> - Clauses; - Node1 -> - data(Node1) - end. - - -%% ===================================================================== %% @equiv receive_expr(Clauses, none, []) -spec receive_expr([syntaxTree()]) -> syntaxTree(). @@ -7534,8 +7478,6 @@ revert_root(Node) -> revert_char(Node); clause -> revert_clause(Node); - cond_expr -> - revert_cond_expr(Node); constrained_function_type -> revert_constrained_function_type(Node); constraint -> @@ -7802,8 +7744,6 @@ subtrees(T) -> [clause_patterns(T), [G], clause_body(T)] end; - cond_expr -> - [cond_expr_clauses(T)]; conjunction -> [conjunction_body(T)]; constrained_function_type -> @@ -8017,7 +7957,6 @@ make_tree(class_qualifier, [[A], [B]]) -> class_qualifier(A, B); make_tree(class_qualifier, [[A], [B], [C]]) -> class_qualifier(A, B, C); make_tree(clause, [P, B]) -> clause(P, none, B); make_tree(clause, [P, [G], B]) -> clause(P, G, B); -make_tree(cond_expr, [C]) -> cond_expr(C); make_tree(conjunction, [E]) -> conjunction(E); make_tree(constrained_function_type, [[F],C]) -> constrained_function_type(F, C); @@ -8239,7 +8178,7 @@ meta_call(F, As) -> %% ===================================================================== %% @equiv tree(Type, []) --spec tree(atom()) -> #tree{}. +-spec tree(atom()) -> tree(). tree(Type) -> tree(Type, []). @@ -8274,7 +8213,7 @@ tree(Type) -> %% @see data/1 %% @see type/1 --spec tree(atom(), term()) -> #tree{}. +-spec tree(atom(), term()) -> tree(). tree(Type, Data) -> #tree{type = Type, data = Data}. @@ -8330,7 +8269,7 @@ data(T) -> erlang:error({badarg, T}). %% trees. <em>Attaching a wrapper onto another wrapper structure is an %% error</em>. --spec wrap(erl_parse()) -> #wrapper{}. +-spec wrap(erl_parse()) -> wrapper(). wrap(Node) -> %% We assume that Node is an old-school `erl_parse' tree. @@ -8344,7 +8283,7 @@ wrap(Node) -> %% `erl_parse' tree; otherwise it returns `Node' %% itself. --spec unwrap(syntaxTree()) -> #tree{} | erl_parse(). +-spec unwrap(syntaxTree()) -> tree() | erl_parse(). unwrap(#wrapper{tree = Node}) -> Node; unwrap(Node) -> Node. % This could also be a new-form node. diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl index 352165893f..6185007235 100644 --- a/lib/syntax_tools/src/erl_syntax_lib.erl +++ b/lib/syntax_tools/src/erl_syntax_lib.erl @@ -528,8 +528,6 @@ vann(Tree, Env) -> vann_case_expr(Tree, Env); if_expr -> vann_if_expr(Tree, Env); - cond_expr -> - vann_cond_expr(Tree, Env); receive_expr -> vann_receive_expr(Tree, Env); catch_expr -> @@ -613,9 +611,6 @@ vann_if_expr(Tree, Env) -> Tree1 = rewrite(Tree, erl_syntax:if_expr(Cs1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. -vann_cond_expr(_Tree, _Env) -> - erlang:error({not_implemented,cond_expr}). - vann_catch_expr(Tree, Env) -> E = erl_syntax:catch_expr_body(Tree), {E1, _, Free} = vann(E, Env), diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index 5623aa6af3..d97afda0ea 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -319,7 +319,8 @@ file_1(Parent, Name, Opts) -> file_2(Name, Opts) -> Opts1 = Opts ++ file__defaults(), - Forms = read_module(Name, Opts1), + {Forms, EmptyLines} = read_module(Name, Opts1), + Opts2 = [{empty_lines, EmptyLines} | Opts1], Comments = erl_comment_scan:file(Name), Forms1 = erl_recomment:recomment_forms(Forms, Comments), Tree = module(Forms1, [{file, Name} | Opts1]), @@ -329,10 +330,10 @@ file_2(Name, Opts) -> false -> case proplists:get_bool(stdout, Opts1) of true -> - print_module(Tree, Opts1), + print_module(Tree, Opts2), ok; false -> - write_module(Tree, Name, Opts1), + write_module(Tree, Name, Opts2), ok end end. @@ -341,31 +342,25 @@ read_module(Name, Opts) -> verbose("reading module `~ts'.", [filename(Name)], Opts), case epp_dodger:parse_file(Name, [no_fail]) of {ok, Forms} -> - check_forms(Forms, Name), - Forms; + {Forms, empty_lines(Name)}; {error, R} -> error_read_file(Name), exit({error, R}) end. -check_forms(Fs, Name) -> - Fun = fun (F) -> - case erl_syntax:type(F) of - error_marker -> - S = case erl_syntax:error_marker_info(F) of - {_, M, D} -> - M:format_error(D); - _ -> - "unknown error" - end, - report_error({Name, erl_syntax:get_pos(F), - "\n ~ts"}, [S]), - exit(error); - _ -> - ok - end - end, - lists:foreach(Fun, Fs). +empty_lines(Name) -> + {ok, Data} = file:read_file(Name), + List = binary:split(Data, [<<"\n">>], [global]), + {ok, NonEmptyLineRe} = re:compile("\\S"), + {Res, _} = lists:foldl( + fun(Line, {Set, N}) -> + case re:run(Line, NonEmptyLineRe) of + {match, _} -> {Set, N + 1}; + nomatch -> {sets:add_element(N, Set), N + 1} + end + end, + {sets:new(), 1}, List), + Res. %% Create the target directory and make a backup file if necessary, %% then open the file, output the text and close the file @@ -1551,18 +1546,6 @@ visit_match_body(Ps, P, B, Tree, Env, St0) -> false -> visit_match_expr_final(P, B, Tree, Env, St0) end; - cond_expr -> - Cs = erl_syntax:cond_expr_clauses(B), - case multival_clauses(Cs, length(Ps), Ps) of - {true, Cs1} -> - report_export_vars(Env#env.file, - erl_syntax:get_pos(B), - "cond", Env#env.verbosity), - Tree1 = erl_syntax:cond_expr(Cs1), - {rewrite(Tree, Tree1), St0}; - false -> - visit_match_expr_final(P, B, Tree, Env, St0) - end; receive_expr -> %% Handle the timeout case as an extra clause. As = erl_syntax:receive_expr_action(B), diff --git a/lib/syntax_tools/src/prettypr.erl b/lib/syntax_tools/src/prettypr.erl index 61a8993b84..1f2dfffbdb 100644 --- a/lib/syntax_tools/src/prettypr.erl +++ b/lib/syntax_tools/src/prettypr.erl @@ -569,6 +569,9 @@ format(D, W, R) -> layout(L) -> lists:reverse(layout(0, L, [])). +layout(N, #above{d1 = #text{s = [_ | ""]}, d2 = L}, Cs) -> + %% Text for this line is empty. Print newline but no indentation. + layout(N, L, [$\n | Cs]); layout(N, #above{d1 = #text{s = S}, d2 = L}, Cs) -> layout(N, L, [$\n | flatrev(string_chars(S), indent(N, Cs))]); layout(N, #nest{n = N1, d = L}, Cs) -> @@ -578,8 +581,6 @@ layout(N, #text{s = S}, Cs) -> layout(_N, null, Cs) -> Cs. -indent(N, Cs) when N >= 8 -> - indent(N - 8, [$\t | Cs]); indent(N, Cs) when N > 0 -> indent(N - 1, [$\s | Cs]); indent(_N, Cs) -> diff --git a/lib/tftp/Makefile b/lib/tftp/Makefile index a4559fbc2e..d0397beaa0 100644 --- a/lib/tftp/Makefile +++ b/lib/tftp/Makefile @@ -43,36 +43,6 @@ include $(ERL_TOP)/make/otp_subdir.mk .PHONY: info gclean dialyzer dialyzer_plt dclean -info: - @echo "OS: $(OS)" - @echo "DOCB: $(DOCB)" - @echo "" - @echo "TFTP_VSN: $(TFTP_VSN)" - @echo "APP_VSN: $(APP_VSN)" - @echo "" - @echo "DIA_PLT: $(DIA_PLT)" - @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)" - @echo "" +DIA_PLT_APPS= -gclean: - git clean -fXd - -dclean: - rm -f $(DIA_PLT) - rm -f $(DIA_ANALYSIS) - -dialyzer_plt: $(DIA_PLT) - -$(DIA_PLT): - @echo "Building $(APPLICATION) plt file" - @dialyzer --build_plt \ - --output_plt $@ \ - -r ../$(APPLICATION)/ebin \ - --output $(DIA_ANALYSIS) \ - --verbose - -dialyzer: $(DIA_PLT) - @echo "Running dialyzer on $(APPLICATION)" - @dialyzer --plt $< \ - ../$(APPLICATION)/ebin \ - --verbose +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/tftp/doc/src/Makefile b/lib/tftp/doc/src/Makefile index 5d76799e41..e5ff8010fe 100644 --- a/lib/tftp/doc/src/Makefile +++ b/lib/tftp/doc/src/Makefile @@ -26,12 +26,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # ---------------------------------------------------- include ../../vsn.mk VSN=$(TFTP_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - +APPLICATION=tftp # ---------------------------------------------------- # Target Specs @@ -59,97 +54,6 @@ XML_FILES = \ $(XML_REF3_FILES) \ $(XML_APPLICATION_FILES) -# GIF_FILES = tftp.gif - - -# ---------------------------------------------------- - -HTML_FILES = \ - $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info -EXTRA_FILES = \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS # ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -ldocs: local_docs - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -clean clean_docs: clean_html clean_man clean_pdf - rm -rf $(XMLDIR) - rm -f errs core *~ - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -clean_pdf: - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - -clean_html: - rm -rf $(TOP_HTML_FILES) $(HTMLDIR)/* - -clean_man: - rm -f $(MAN3_FILES) - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: -info: - @echo "GIF_FILES:\n$(GIF_FILES)" - @echo "" - @echo "EXTRA_FILES:\n$(EXTRA_FILES)" - @echo "" - @echo "HTML_FILES:\n$(HTML_FILES)" - @echo "" - @echo "TOP_HTML_FILES:\n$(TOP_HTML_FILES)" - @echo "" - @echo "XML_REF3_FILES:\n$(XML_REF3_FILES)" - @echo "" - @echo "XML_REF6_FILES:\n$(XML_REF6_FILES)" - @echo "" - @echo "XML_CHAPTER_FILES:\n$(XML_CHAPTER_FILES)" - @echo "" +include $(ERL_TOP)/make/doc.mk diff --git a/lib/tftp/test/Makefile b/lib/tftp/test/Makefile index 99f36256b0..a68bc4df6f 100644 --- a/lib/tftp/test/Makefile +++ b/lib/tftp/test/Makefile @@ -114,7 +114,7 @@ SOURCE = $(ERL_FILES) $(HRL_FILES) TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) -TFTP_SPECS = tftp.spec tftp_bench.spec +TFTP_SPECS = tftp.spec COVER_FILE = tftp.cover TFTP_FILES = tftp.config $(TFTP_SPECS) diff --git a/lib/tftp/test/tftp_bench.spec b/lib/tftp/test/tftp_bench.spec deleted file mode 100644 index 43fa385c85..0000000000 --- a/lib/tftp/test/tftp_bench.spec +++ /dev/null @@ -1 +0,0 @@ -{suites,"../tftp_test",[]}. diff --git a/lib/tools/Makefile b/lib/tools/Makefile index e17e9cfd1e..d849989a2d 100644 --- a/lib/tools/Makefile +++ b/lib/tools/Makefile @@ -36,3 +36,6 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=compiler runtime_tools + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/tools/c_src/Makefile.in b/lib/tools/c_src/Makefile.in index 289322b6fa..19f1fd746b 100644 --- a/lib/tools/c_src/Makefile.in +++ b/lib/tools/c_src/Makefile.in @@ -22,7 +22,6 @@ include $(ERL_TOP)/make/output.mk include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/erts/include/internal/$(TARGET)/ethread.mk -USING_MINGW=@MIXED_CYGWIN_MINGW@ USING_VC=@MIXED_VC@ CC=@CC@ diff --git a/lib/tools/doc/src/Makefile b/lib/tools/doc/src/Makefile index 5ff4fe3113..f9bb2314a8 100644 --- a/lib/tools/doc/src/Makefile +++ b/lib/tools/doc/src/Makefile @@ -28,11 +28,6 @@ VSN=$(TOOLS_VSN) APPLICATION=tools # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml @@ -60,89 +55,25 @@ XML_CHAPTER_FILES = \ xref_chapter.xml \ notes.xml - BOOK_FILES = book.xml XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) -GIF_FILES = \ +IMAGE_FILES = \ venn1.gif \ venn2.gif -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) - TOP_SPECS_FILE = specs.xml -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -TOOLS_SRC=$(ERL_TOP)/lib/tools/src -TOOLS_INCLUDE=$(ERL_TOP)/lib/tools/include - -SPECS_FLAGS = -I$(TOOLS_SRC) -I$(TOOLS_INCLUDE) +NO_CHUNKS = erlang_mode.xml # ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f $(SPECDIR)/* - rm -f errs core *~ # erlang_mode doesn't have erlang source so we generate a dummy file for it. $(SPECDIR)/specs_erlang_mode.xml: - echo '<module name="erlang_mode"/>' > $(SPECDIR)/specs_erlang_mode.xml + $(gen_verbose)echo '<module name="erlang_mode"/>' > $(SPECDIR)/specs_erlang_mode.xml # ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/tools/doc/src/cprof.xml b/lib/tools/doc/src/cprof.xml index b6af8b6d28..791fb06ba1 100644 --- a/lib/tools/doc/src/cprof.xml +++ b/lib/tools/doc/src/cprof.xml @@ -44,7 +44,7 @@ </p> <p>Since breakpoints are used there is no need for special compilation of any module to be profiled. For now these - breakpoints can only be set on BEAM code so <term id="BIF"></term>s + breakpoints can only be set on BEAM code so BIFs cannot be call count traced. </p> <p>The size of the call counters is the host machine word diff --git a/lib/tools/doc/src/instrument.xml b/lib/tools/doc/src/instrument.xml index 7e9cbaebb0..7286e5c1cc 100644 --- a/lib/tools/doc/src/instrument.xml +++ b/lib/tools/doc/src/instrument.xml @@ -73,14 +73,12 @@ <desc> <p><c><anno>AllocatorType</anno></c> is the type of the allocator that employs this carrier.</p> - <p><c><anno>TotalSize</anno></c> is the total size of the carrier, - including its header.</p> - <p><c><anno>AllocatedSize</anno></c> is the combined size of the - carrier's allocated blocks, including their headers.</p> - <p><c><anno>AllocatedCount</anno></c> is the number of allocated - blocks in the carrier.</p> <p><c><anno>InPool</anno></c> is whether the carrier is in the migration pool.</p> + <p><c><anno>TotalSize</anno></c> is the total size of the carrier, + including its header.</p> + <p><c><anno>Allocations</anno></c> is a summary of the allocated blocks + in the carrier.</p> <p><c><anno>FreeBlocks</anno></c> is a histogram of the free block sizes in the carrier.</p> <p>If the carrier could not be scanned in full without harming the diff --git a/lib/tools/doc/src/xref.xml b/lib/tools/doc/src/xref.xml index ab3641a52f..91f152e678 100644 --- a/lib/tools/doc/src/xref.xml +++ b/lib/tools/doc/src/xref.xml @@ -46,7 +46,7 @@ <em>Module data</em>, which are extracted from BEAM files, include local functions, exported functions, local calls and external calls. By default, - calls to built-in functions (<term id="BIF"></term>) are ignored, but + calls to built-in functions (BIF) are ignored, but if the option <c>builtins</c>, accepted by some of this module's functions, is set to <c>true</c>, calls to BIFs are included as well. It is the analyzing OTP version that @@ -138,6 +138,9 @@ debug information, which is an abstract <tag>-deprecated({f,1}).</tag> <item>The exported function <c>f/1</c> is deprecated. Nothing is said whether <c>f/1</c> will be removed or not.</item> + <tag>-deprecated({f,1,"Use g/1 instead"}).</tag> + <item>As above but with a descriptive string. The string is currently + unused by <c>xref</c> but other tools can make use of it.</item> <tag>-deprecated({f,'_'}).</tag> <item>All exported functions <c>f/0</c>, <c>f/1</c> and so on are deprecated.</item> diff --git a/lib/tools/emacs/Makefile b/lib/tools/emacs/Makefile index b7775d1c8c..c19ad3668c 100644 --- a/lib/tools/emacs/Makefile +++ b/lib/tools/emacs/Makefile @@ -65,7 +65,9 @@ clean: rm -f $(TARGET_FILES) $(ELC_FILES) rm -f errs core *~ -docs: +DOC_TARGETS?=man + +docs: $(DOC_TARGETS) # ---------------------------------------------------- # Release Target @@ -77,14 +79,8 @@ release_spec: opt $(INSTALL_DATA) $(EL_FILES) $(README_FILES) \ "$(RELSYSDIR)/emacs" -ifeq ($(DOCTYPE),pdf) -release_docs_spec: -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: -else -release_docs_spec: docs +release_man_spec: $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" $(INSTALL_DATA) $(MAN_FILES) "$(RELEASE_PATH)/man/man3" -endif -endif + +release_docs_spec: $(DOC_TARGETS:%=release_%_spec) diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index dafb9d56ac..d4ac34b05f 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -883,9 +883,12 @@ resulting regexp is surrounded by \\_< and \\_>." "spawn_link" "spawn_monitor" "spawn_opt" + "spawn_request" + "spawn_request_abandon" "split_binary" "statistics" "term_to_binary" + "term_to_iovec" "time" "throw" "tl" @@ -912,7 +915,6 @@ resulting regexp is surrounded by \\_< and \\_>." "bump_reductions" "call_on_load_function" "cancel_timer" - "crasher" "crc32" "crc32_combine" "decode_packet" @@ -994,7 +996,6 @@ resulting regexp is surrounded by \\_< and \\_>." "set_cookie" "set_cpu_topology" "setnode" - "spawn_opt" "start_timer" "subtract" "suspend_process" @@ -1237,8 +1238,8 @@ This must be placed in front of `erlang-font-lock-keywords-vars'.") 1 'font-lock-type-face) ;; Don't highlight numerical constants. (list (if erlang-regexp-modern-p - "\\_<[0-9]+#\\([0-9a-zA-Z]+\\)" - "\\<[0-9]+#\\([0-9a-zA-Z]+\\)") + "\\_<\\([0-9]+\\(_[0-9]+\\)*#[0-9a-zA-Z]+\\(_[0-9a-zA-Z]+\\)*\\)" + "\\<\\([0-9]+\\(_[0-9]+\\)*#[0-9a-zA-Z]+\\(_[0-9a-zA-Z]+\\)*\\)") 1 nil t) (list (concat "^-record\\s-*(\\s-*" erlang-atom-regexp) 1 'font-lock-type-face)) @@ -1946,7 +1947,6 @@ The format is described in the documentation of `erlang-man-dirs'." '(("Man Pages" (("Error! Why?" erlang-man-describe-error))))))) - (defcustom erlang-man-download-url "http://erlang.org/download/otp_doc_man_22.1.tar.gz" "The URL from which the erlang-man-download function will download Erlang man pages " diff --git a/lib/tools/src/eprof.erl b/lib/tools/src/eprof.erl index 86e3d3a8b8..ee72bad234 100644 --- a/lib/tools/src/eprof.erl +++ b/lib/tools/src/eprof.erl @@ -28,7 +28,7 @@ stop/0, dump/0, dump_data/0, start_profiling/1, start_profiling/2, start_profiling/3, - profile/1, profile/2, profile/3, profile/4, profile/5, + profile/1, profile/2, profile/3, profile/4, profile/5, profile/6, stop_profiling/0, analyze/0, analyze/1, analyze/2, analyze/4, log/1]). diff --git a/lib/tools/src/instrument.erl b/lib/tools/src/instrument.erl index 0203fefe13..1d1edcbbea 100644 --- a/lib/tools/src/instrument.erl +++ b/lib/tools/src/instrument.erl @@ -94,11 +94,12 @@ alloc_hist_merge_hist(Index, A, B) -> -type carrier_info_list() :: {HistogramStart :: non_neg_integer(), Carriers :: [{AllocatorType :: atom(), + InPool :: boolean(), TotalSize :: non_neg_integer(), UnscannedSize :: non_neg_integer(), - AllocatedSize :: non_neg_integer(), - AllocatedCount :: non_neg_integer(), - InPool :: boolean(), + Allocations :: {Type :: atom(), + Count :: non_neg_integer(), + Size :: non_neg_integer()}, FreeBlocks :: block_histogram()}]}. -spec carriers() -> {ok, Result} | {error, Reason} when diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src index f0e0fc4bec..f812c0a391 100644 --- a/lib/tools/src/tools.app.src +++ b/lib/tools/src/tools.app.src @@ -43,6 +43,6 @@ ] }, {runtime_dependencies, ["stdlib-3.4","runtime_tools-1.8.14", - "kernel-5.4","erts-9.1","compiler-5.0"]} + "kernel-5.4","erts-9.1","compiler-5.0", "erts-@OTP-16327@"]} ] }. diff --git a/lib/tools/src/xref_base.erl b/lib/tools/src/xref_base.erl index a28c6ee283..ef348206ca 100644 --- a/lib/tools/src/xref_base.erl +++ b/lib/tools/src/xref_base.erl @@ -897,15 +897,20 @@ depr_fa(_F, _A, _X, _M, _I) -> undefined. %% deprecated_flag(Flag) -> integer() | undefined -%% Maps symbolic flags for deprecated functions to integers. +%% Maps symbolic flags for deprecated functions to their category indexes +%% in the deprecation tuple. +%% +%% {DF_1, DF_2, DF_3, DF} -%deprecated_flag(1) -> 1; -%deprecated_flag(2) -> 2; -%deprecated_flag(3) -> 3; deprecated_flag(next_version) -> 1; deprecated_flag(next_major_release) -> 2; deprecated_flag(eventually) -> 3; -deprecated_flag(_) -> undefined. +deprecated_flag(String) -> depr_desc(String). + +%% Strings fall into the general category, index 4. +depr_desc([Char | Str]) when is_integer(Char) -> depr_desc(Str); +depr_desc([]) -> 4; +depr_desc(_) -> undefined. %% -> {ok, Module, Bad, State} | throw(Error) %% Assumes: diff --git a/lib/tools/test/cprof_SUITE.erl b/lib/tools/test/cprof_SUITE.erl index 9cbc27fb17..39239a66a9 100644 --- a/lib/tools/test/cprof_SUITE.erl +++ b/lib/tools/test/cprof_SUITE.erl @@ -211,16 +211,12 @@ on_load_test(Config) -> Lr = seq_r(1, M, fun succ/1), N2 = cprof:pause(), {Module,0,[]} = cprof:analyse(Module), - M_1 = M - 1, M4__4 = M*4 - 4, M10_7 = M*10 - 7, {?MODULE,M10_7,[{{?MODULE,succ,1},M4__4}, + {{?MODULE,'-fun.succ/1-',1},M4__4}, {{?MODULE,seq_r,4},M}, {{?MODULE,seq,3},M}, - {{?MODULE,'-on_load_test/1-fun-5-',1},M_1}, - {{?MODULE,'-on_load_test/1-fun-4-',1},M_1}, - {{?MODULE,'-on_load_test/1-fun-3-',1},M_1}, - {{?MODULE,'-on_load_test/1-fun-2-',1},M_1}, {{?MODULE,seq_r,3},1}]} = cprof:analyse(?MODULE), N2 = cprof:stop(), @@ -246,18 +242,14 @@ modules_test(Config) -> Lr = seq_r(1, M, fun succ/1), N = cprof:pause(), Lr = lists:reverse(L), - M_1 = M - 1, M4_4 = M*4 - 4, M10_7 = M*10 - 7, M2__1 = M*2 + 1, {Tot,ModList} = cprof:analyse(), {value,{?MODULE,M10_7,[{{?MODULE,succ,1},M4_4}, + {{?MODULE,'-fun.succ/1-',1},M4_4}, {{?MODULE,seq_r,4},M}, {{?MODULE,seq,3},M}, - {{?MODULE,'-modules_test/1-fun-3-',1},M_1}, - {{?MODULE,'-modules_test/1-fun-2-',1},M_1}, - {{?MODULE,'-modules_test/1-fun-1-',1},M_1}, - {{?MODULE,'-modules_test/1-fun-0-',1},M_1}, {{?MODULE,seq_r,3},1}]}} = lists:keysearch(?MODULE, 1, ModList), {value,{Module,M2__1,[{{Module,seq_r,4},M}, diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl index f474669836..c1a5921e04 100644 --- a/lib/tools/test/instrument_SUITE.erl +++ b/lib/tools/test/instrument_SUITE.erl @@ -194,23 +194,19 @@ verify_carriers_output(#{ histogram_start := HistStart, %% Do the carriers look alright? CarrierSet = ordsets:from_list(AllCarriers), Verified = [C || {AllocType, + InPool, TotalSize, UnscannedSize, - AllocatedSize, - AllocatedCount, - InPool, + Allocations, FreeBlockHist} = C <- CarrierSet, is_atom(AllocType), + is_boolean(InPool), is_integer(TotalSize), TotalSize >= 1, is_integer(UnscannedSize), UnscannedSize < TotalSize, UnscannedSize >= 0, - is_integer(AllocatedSize), AllocatedSize < TotalSize, - AllocatedSize >= 0, - is_integer(AllocatedCount), AllocatedCount =< AllocatedSize, - AllocatedCount >= 0, - is_boolean(InPool), + is_list(Allocations), tuple_size(FreeBlockHist) =:= HistWidth, - carrier_block_check(AllocatedCount, FreeBlockHist)], + carrier_block_check(Allocations, FreeBlockHist)], [] = ordsets:subtract(CarrierSet, Verified), %% Do we have at least as many carriers as we've generated? @@ -229,8 +225,12 @@ verify_carriers_output(#{ histogram_start := HistStart, verify_carriers_output(#{}, {error, not_enabled}) -> ok. -carrier_block_check(AllocCount, FreeHist) -> - %% A carrier must contain at least one block, and th. number of free blocks +carrier_block_check(Allocations, FreeHist) -> + AllocCount = lists:foldl(fun({_Type, Count, _Size}, Acc) -> + Count + Acc + end, 0, Allocations), + + %% A carrier must contain at least one block, and the number of free blocks %% must not exceed the number of allocated blocks + 1. FreeCount = hist_sum(FreeHist), diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index da4f56c09b..d258966bc2 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -1098,10 +1098,8 @@ read_expected(Version) -> {POS4+5,{FF,{spm,spf,2}}}, {POS4+6,{FF,{dist,func,2}}}, {POS4+6,{FF,{erlang,spawn_link,4}}}, - {POS4+7,{FF,{erlang,spawn_opt,4}}}, {POS4+7,{FF,{read,bi,0}}}, {POS4+7,{FF,{spm,spf,2}}}, - {POS4+8,{FF,{erlang,spawn_opt,4}}}, {POS4+8,{FF,{read,bi,0}}}, {POS5+1,{FF,{erlang,spawn,1}}}, {POS5+2,{FF,{erlang,spawn,1}}}, @@ -1109,7 +1107,6 @@ read_expected(Version) -> {POS6+1,{FF,{erlang,spawn,2}}}, {POS6+2,{FF,{erlang,spawn_link,2}}}, {POS7+1,{FF,{erlang,spawn,4}}}, - {POS7+2,{FF,{erlang,spawn_opt,4}}}, {POS8+1,{FF,{hej,san,1}}}, {POS8+4,{FF,{a,b,1}}}, {POS8+6,{FF,{m,f,1}}}, @@ -1150,7 +1147,10 @@ read_expected(Version) -> {POS3+2, {FF,{erlang,spawn,3}}}, {POS3+3, {FF,{erlang,spawn_link,3}}}, {POS3+4, {FF,{erlang,spawn_link,3}}}, + {POS4+7, {FF,{erlang,spawn_opt,4}}}, + {POS4+8, {FF,{erlang,spawn_opt,4}}}, {POS6+4, {FF,{erlang,spawn,3}}}, + {POS7+2, {FF,{erlang,spawn_opt,4}}}, {POS8+4,{FF,{erlang,apply,2}}}, {POS8+5,{FF,{erlang,apply,2}}}, {POS8+6,{FF,{erlang,apply,3}}}, @@ -1479,12 +1479,13 @@ deprecated(Conf) when is_list(Conf) -> Test2= <<"-module(depr). - -export([t/0,f/1,bar/2,f/2,g/3]). + -export([t/0,f/1,bar/2,f/2,g/3,string/0]). -deprecated([{'_','_',eventually}]). % DF_3 -deprecated([{f,'_',next_major_release}]). % DF_2 -deprecated([{g,'_',next_version}]). % DF_1 -deprecated([{bar,2}]). % DF + -deprecated([{string,0,\"hello\"}]). % DF t() -> g(1,2, 3), @@ -1499,6 +1500,9 @@ deprecated(Conf) when is_list(Conf) -> g(F, G, H) -> ?MODULE:bar(F, {G,H}). + string() -> + ?MODULE:string(). + bar(_, _) -> ?MODULE:t(). ">>, @@ -1512,7 +1516,8 @@ deprecated(Conf) when is_list(Conf) -> M = depr, DFa_1 = usort([{{M,f,2},{M,g,3}}]), DFa_2 = usort(DFa_1++[{{M,f,1},{M,f,2}},{{M,t,0},{M,f,1}}]), - DFa_3 = usort(DFa_2++[{{M,bar,2},{M,t,0}},{{M,g,3},{M,bar,2}}]), + DFa_3 = usort(DFa_2++[{{M,bar,2},{M,t,0}},{{M,g,3},{M,bar,2}}, + {{M,string,0},{M,string,0}}]), DFa = DFa_3, {ok,DFa} = xref:analyze(s, deprecated_function_calls), diff --git a/lib/wx/Makefile b/lib/wx/Makefile index 2397950925..002887d9da 100644 --- a/lib/wx/Makefile +++ b/lib/wx/Makefile @@ -40,3 +40,5 @@ CLEANDIRS = $(SUBDIRS) api_gen SUB_DIRECTORIES=$(SUBDIRS) include $(ERL_TOP)/make/otp_subdir.mk + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/wx/api_gen/wx_gen_erl.erl b/lib/wx/api_gen/wx_gen_erl.erl index 797533309b..d029ae77cb 100644 --- a/lib/wx/api_gen/wx_gen_erl.erl +++ b/lib/wx/api_gen/wx_gen_erl.erl @@ -159,7 +159,13 @@ gen_class1(C=#class{name=Name,parent=Parent,methods=Ms,options=Opts}) -> w("-export_type([~s/0]).~n", [Name]), case lists:filter(fun({_F,Depr}) -> Depr end, ExportList) of [] -> ok; - Depr -> w("-deprecated([~s]).~n~n", [args(fun({EF,_}) -> EF end, ",", Depr, 60)]) + Depr -> + DepStr = "not available in wxWidgets-2.9 and later", + w("-deprecated([~s]).~n~n", + [args(fun({EF,_}) -> + [DFun,DArgs] = string:split(EF, "/"), + io_lib:format("{~s,~s,\"~s\"}", [DFun,DArgs,DepStr]) + end, ",\n ", Depr, 60)]) end, case lists:filter(fun({_,_,Depr}) -> Depr end, InExported) of [] -> ok; diff --git a/lib/wx/configure.in b/lib/wx/configure.in index f35e6cdbd0..5a69738544 100644 --- a/lib/wx/configure.in +++ b/lib/wx/configure.in @@ -82,7 +82,7 @@ LM_WINDOWS_ENVIRONMENT USER_CFLAGS=$CFLAGS -if test X"$MIXED_CYGWIN_VC" = X"yes" -o X"$MIXED_MSYS_VC" = X"yes"; then +if test X"$MIXED_VC" = X"yes" ; then CFLAGS="-Owx" fi @@ -319,7 +319,7 @@ dnl if test "$cross_compiling" = "yes"; then echo "Cross compilation of the wx driver is not supported yet, wx will NOT be usable" >> ./CONF_INFO WXERL_CAN_BUILD_DRIVER=false -elif test X"$MIXED_CYGWIN_VC" = X"no" -a X"$MIXED_MSYS_VC" = X"no"; then +elif test X"$MIXED_VC" = X"no"; then WX_VERSION=`wx-config --version` case $WX_VERSION in 2.8.*) @@ -392,7 +392,7 @@ define(wx_warn_text,[ fi else AC_MSG_CHECKING(for wxWidgets in standard locations) - + echo # Check whether --with-wxdir was given. AC_MSG_NOTICE(OptionCheck: [$with_wxdir $with_wx_prefix]) @@ -403,45 +403,40 @@ else if test "${with_wx_prefix+set}" = set; then : withval=$with_wx_prefix; CWXWIN0=$withval else - echo Setting it empty CWXWIN0="" fi fi - if test "x$MIXED_MSYS" = "xyes"; then - CWXWIN_CONFIG=`win2msys_path.sh $wx_config_name 2>/dev/null` - else - CWXWIN_CONFIG=`cygpath $wx_config_name 2>/dev/null` - fi + CWXWIN_CONFIG=`win32_path.sh -u $wx_config_name 2>/dev/null` CWXWIN1=`dirname $CWXWIN_CONFIG 2>/dev/null` CWXWIN2=`dirname $CWXWIN1 2>/dev/null` if test -z "$PROGRAMFILES" ; then - PROGRAMFILES=c:/Program Files + PROGRAMFILES="c:/Program Files" fi - - if test "x$MIXED_MSYS" = "xyes"; then - CWXWIN_PROG=`win2msys_path.sh "$PROGRAMFILES" 2>/dev/null` - else - CWXWIN_PROG=`cygpath -d "$PROGRAMFILES" | cygpath -f - 2>/dev/null` - fi + CWXWIN_PROG=`win32_path.sh -u "$PROGRAMFILES" 2>/dev/null` CWXWIN3="$CWXWIN_PROG/wxWidgets-3.*.* $CWXWIN_PROG/wxWidgets-2.*.*" CWXWIN4="$CWXWIN_PROG/wxMSW-3.*.* $CWXWIN_PROG/wxMSW-2.*.*" - DOC_OPT=/opt/local/pgm - CWX_DOCUMENTED="$DOC_OPT/wxWidgets-2.*.* $DOC_OPT/wxMSW-2.*.*" - CWX_DOCUMENTED="$DOC_OPT/wxWidgets-3.*.* $DOC_OPT/wxMSW-3.*.* $CWX_DOCUMENTED" + DOC_OPT1=/opt/local/pgm + DOC_OPT2=/mnt/c/opt/local/pgm + CWX_DOCUMENTED="$DOC_OPT1/wxWidgets-3.*.* $DOC_OPT1/wxMSW-3.*.*" + CWX_DOCUMENTED="$DOC_OPT2/wxWidgets-3.*.* $DOC_OPT2/wxMSW-3.*.* $CWX_DOCUMENTED" case $ac_cv_sizeof_void_p in 8) - DOC_OPT64=/opt/local64/pgm - CWX_DOCUMENTED="$DOC_OPT64/wxWidgets-2.*.* $DOC_OPT64/wxMSW-2.*.* $CWX_DOCUMENTED" - CWX_DOCUMENTED="$DOC_OPT64/wxWidgets-3.*.* $DOC_OPT64/wxMSW-3.*.* $CWX_DOCUMENTED" + DOC_OPT64_1=/opt/local64/pgm + DOC_OPT64_2=/mnt/c/opt/local64/pgm + CWX_DOCUMENTED="$DOC_OPT64_1/wxWidgets-3.*.* $DOC_OPT64_1/wxMSW-3.*.* $CWX_DOCUMENTED" + CWX_DOCUMENTED="$DOC_OPT64_2/wxWidgets-3.*.* $DOC_OPT64_2/wxMSW-3.*.* $CWX_DOCUMENTED" ;; *) - true + DOC_OPT3=/opt/local32/pgm + DOC_OPT4=/mnt/c/opt/local32/pgm + CWX_DOCUMENTED="$DOC_OPT3/wxWidgets-3.*.* $DOC_OPT3/wxMSW-3.*.* $CWX_DOCUMENTED" + CWX_DOCUMENTED="$DOC_OPT4/wxWidgets-3.*.* $DOC_OPT4/wxMSW-3.*.* $CWX_DOCUMENTED" ;; esac @@ -460,7 +455,7 @@ else WX_RESCOMP="rc.sh -I$WXINCLUDE_PLAIN -D __WIN32__" RC_FILE_TYPE=res for lib in $WX_LIBDIR $WX_LIBDIR64; do - maybe=`ls $lib/wxbase*.lib | egrep 'wxbase[[0-9]]*u\.lib'` + maybe=`ls $lib/wxbase*.lib 2> /dev/null | egrep 'wxbase[[0-9]]*u\.lib'` if test '!' -z "$maybe"; then corelib_number=`echo $maybe | sed 's,.*\([[0-9]].\)u\.lib,\1,'` WX_LIBDIR=$lib @@ -502,7 +497,36 @@ if test "$WXERL_CAN_BUILD_DRIVER" != "false"; then AC_SUBST(WX_HAVE_STATIC_LIBS) AC_SUBST(RC_FILE_TYPE) -AC_MSG_CHECKING(if wxwidgets have opengl support) +AC_MSG_CHECKING(for wxwidgets 2.8 compatibility ) +AC_LANG_PUSH(C++) +saved_CXXFLAGS=$CXXFLAGS +CXXFLAGS="$CXXFLAGS $WX_CXXFLAGS" + +AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #ifdef WIN32 + # include <windows.h> + #endif + #include "wx/wx.h" + ]], [[ + #if wxMAJOR_VERSION > 2 && WXWIN_COMPATIBILITY_2_8 == 1 + ; + #else + #error barf + #endif + ]])], + HAVE_COMPAT28_SUPPORT=yes, HAVE_COMPAT28_SUPPORT=no) + +CXXFLAGS=$saved_CXXFLAGS +AC_LANG_POP(C++) +AC_MSG_RESULT($HAVE_COMPAT28_SUPPORT) + +if test X"$HAVE_COMPAT28_SUPPORT" != X"yes" ; then + echo "wxWidgets was not compiled with --enable-compat28, wx will NOT be useable" >> ./CONF_INFO + WXERL_CAN_BUILD_DRIVER=false +fi + +AC_MSG_CHECKING(for wxwidgets opengl support) AC_LANG_PUSH(C++) saved_CXXFLAGS=$CXXFLAGS CXXFLAGS="$CXXFLAGS $WX_CXXFLAGS" diff --git a/lib/wx/doc/src/Makefile b/lib/wx/doc/src/Makefile index f66d63f63b..1d2b9824f4 100644 --- a/lib/wx/doc/src/Makefile +++ b/lib/wx/doc/src/Makefile @@ -37,10 +37,11 @@ ModsNoExt = $(ErlMods:%.erl=%) $(GenMods:%.erl=%) # Release directory specification XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = $(ErlMods:%.erl=%.xml) $(GenMods:%.erl=%.xml) +EDOC_REF3_FILES = $(ErlMods:%.erl=%.xml) +XML_REF3_FILES = $(GenMods:%.erl=%.xml) XML_PART_FILES = part.xml -XML_CHAPTER_FILES = chapter.xml +EDOC_CHAPTER_FILE = chapter.xml XML_NOTES_FILES = notes.xml BOOK_FILES = book.xml @@ -50,101 +51,27 @@ XML_FILES = \ $(XML_PART_FILES) $(XML_NOTES_FILES) XML_GEN_FILES = \ - $(XML_CHAPTER_FILES:%=$(XMLDIR)/%) \ - $(XML_REF3_FILES:%=$(XMLDIR)/%) \ - $(XML_APPLICATION_FILES:%=$(XMLDIR)/%) + $(XML_APPLICATION_FILES:%=$(XMLDIR)/%) \ + $(XML_REF3_FILES:%=$(XMLDIR)/%) -# ---------------------------------------------------- -INFO_FILE = ../../info - -HTML_FILES = \ - $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) +EDOC_FLAGS=-i ../../src -preprocess true -sort_functions false TOP_SPECS_FILE = specs.xml # ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -SPECS_FLAGS = -I../../include -I../../src -DVIPS_FLAGS += - -# ---------------------------------------------------- # Targets # ---------------------------------------------------- -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) +include $(ERL_TOP)/make/doc.mk -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -xml: $(XML_REF3_FILES) $(XML_CHAPTER_FILES) +$(XMLDIR)/%.xml: $(APP_SRC_DIR)/gen/%.erl + $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript \ + -def vsn $(VSN) $(EDOC_FLAGS) -dir $(XMLDIR) $< -ref_man.xml: ref_man.xml.src +ref_man.xml: ref_man.xml.src Makefile @echo Preparing $@ @cat ref_man.xml.src > $@ @for d in $(ModsNoExt); do \ echo " <xi:include href=\"$$d.xml\"/>" >> $@ ; \ done @echo "</application>" >> $@ - -$(ErlMods:%.erl=$(XMLDIR)/%.xml): - $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript \ - -def vsn $(VSN) -preprocess true -sort_functions false -dir $(XMLDIR) \ - ../../src/$(@:$(XMLDIR)/%.xml=%.erl) - -$(GenMods:%.erl=$(XMLDIR)/%.xml): - $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript \ - -def vsn $(VSN) -i ../../src -preprocess true -sort_functions false -dir $(XMLDIR) \ - ../../src/gen/$(@:$(XMLDIR)/%.xml=%.erl) - -$(XML_CHAPTER_FILES:%=$(XMLDIR)/%): ../overview.edoc - $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript \ - -def vsn $(VSN) -chapter -dir $(XMLDIR) $< - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f $(SPECDIR)/* - rm -f errs core *~ ../html/edoc-info - rm -f $(XML_GEN_FILES) *.html - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3_FILES) "$(RELEASE_PATH)/man/man3" - -release_spec: - -release_tests_spec: diff --git a/lib/wx/src/gen/wxCalendarCtrl.erl b/lib/wx/src/gen/wxCalendarCtrl.erl index 51116f601f..221de7bf69 100644 --- a/lib/wx/src/gen/wxCalendarCtrl.erl +++ b/lib/wx/src/gen/wxCalendarCtrl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2019. All Rights Reserved. +%% Copyright Ericsson AB 2008-2020. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -78,7 +78,8 @@ update/1,updateWindowUI/1,updateWindowUI/2,validate/1,warpPointer/3]). -export_type([wxCalendarCtrl/0]). --deprecated([enableYearChange/1,enableYearChange/2]). +-deprecated([{enableYearChange,1,"not available in wxWidgets-2.9 and later"}, + {enableYearChange,2,"not available in wxWidgets-2.9 and later"}]). %% @hidden parent_class(wxControl) -> true; diff --git a/lib/wx/src/gen/wxClientDC.erl b/lib/wx/src/gen/wxClientDC.erl index 4965536690..a29ab8cab8 100644 --- a/lib/wx/src/gen/wxClientDC.erl +++ b/lib/wx/src/gen/wxClientDC.erl @@ -55,7 +55,7 @@ startPage/1]). -export_type([wxClientDC/0]). --deprecated([new/0]). +-deprecated([{new,0,"not available in wxWidgets-2.9 and later"}]). -compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). diff --git a/lib/wx/src/gen/wxCursor.erl b/lib/wx/src/gen/wxCursor.erl index 689935576a..7a9033dbee 100644 --- a/lib/wx/src/gen/wxCursor.erl +++ b/lib/wx/src/gen/wxCursor.erl @@ -36,7 +36,8 @@ saveFile/4,setDepth/2,setHeight/2,setMask/2,setPalette/2,setWidth/2]). -export_type([wxCursor/0]). --deprecated([new/3,new/4]). +-deprecated([{new,3,"not available in wxWidgets-2.9 and later"}, + {new,4,"not available in wxWidgets-2.9 and later"}]). %% @hidden parent_class(wxBitmap) -> true; diff --git a/lib/wx/src/gen/wxDC.erl b/lib/wx/src/gen/wxDC.erl index 16bfcc3463..322f80e4f0 100644 --- a/lib/wx/src/gen/wxDC.erl +++ b/lib/wx/src/gen/wxDC.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2020. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -51,7 +51,7 @@ -export([parent_class/1]). -export_type([wxDC/0]). --deprecated([computeScaleAndOrigin/1]). +-deprecated([{computeScaleAndOrigin,1,"not available in wxWidgets-2.9 and later"}]). %% @hidden parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/gen/wxGraphicsRenderer.erl b/lib/wx/src/gen/wxGraphicsRenderer.erl index a1b67476e3..2e3e21bf50 100644 --- a/lib/wx/src/gen/wxGraphicsRenderer.erl +++ b/lib/wx/src/gen/wxGraphicsRenderer.erl @@ -33,7 +33,8 @@ -export([parent_class/1]). -export_type([wxGraphicsRenderer/0]). --deprecated([createLinearGradientBrush/7,createRadialGradientBrush/8]). +-deprecated([{createLinearGradientBrush,7,"not available in wxWidgets-2.9 and later"}, + {createRadialGradientBrush,8,"not available in wxWidgets-2.9 and later"}]). %% @hidden parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/gen/wxGridCellEditor.erl b/lib/wx/src/gen/wxGridCellEditor.erl index d14b1c994c..c4a730ed8b 100644 --- a/lib/wx/src/gen/wxGridCellEditor.erl +++ b/lib/wx/src/gen/wxGridCellEditor.erl @@ -32,7 +32,8 @@ -export([parent_class/1]). -export_type([wxGridCellEditor/0]). --deprecated([endEdit/4,paintBackground/3]). +-deprecated([{endEdit,4,"not available in wxWidgets-2.9 and later"}, + {paintBackground,3,"not available in wxWidgets-2.9 and later"}]). %% @hidden parent_class(_Class) -> erlang:error({badtype, ?MODULE}). diff --git a/lib/wx/src/gen/wxIdleEvent.erl b/lib/wx/src/gen/wxIdleEvent.erl index 1cb3e34ef6..d23943805e 100644 --- a/lib/wx/src/gen/wxIdleEvent.erl +++ b/lib/wx/src/gen/wxIdleEvent.erl @@ -39,7 +39,7 @@ resumePropagation/2,shouldPropagate/1,skip/1,skip/2,stopPropagation/1]). -export_type([wxIdleEvent/0]). --deprecated([canSend/1]). +-deprecated([{canSend,1,"not available in wxWidgets-2.9 and later"}]). %% @hidden parent_class(wxEvent) -> true; diff --git a/lib/wx/src/gen/wxMDIClientWindow.erl b/lib/wx/src/gen/wxMDIClientWindow.erl index 7eabc7d99a..cd603aa08b 100644 --- a/lib/wx/src/gen/wxMDIClientWindow.erl +++ b/lib/wx/src/gen/wxMDIClientWindow.erl @@ -72,7 +72,8 @@ update/1,updateWindowUI/1,updateWindowUI/2,validate/1,warpPointer/3]). -export_type([wxMDIClientWindow/0]). --deprecated([new/1,new/2]). +-deprecated([{new,1,"not available in wxWidgets-2.9 and later"}, + {new,2,"not available in wxWidgets-2.9 and later"}]). %% @hidden parent_class(wxWindow) -> true; diff --git a/lib/wx/src/gen/wxPaintDC.erl b/lib/wx/src/gen/wxPaintDC.erl index b571219020..bb61511302 100644 --- a/lib/wx/src/gen/wxPaintDC.erl +++ b/lib/wx/src/gen/wxPaintDC.erl @@ -55,7 +55,7 @@ startPage/1]). -export_type([wxPaintDC/0]). --deprecated([new/0]). +-deprecated([{new,0,"not available in wxWidgets-2.9 and later"}]). -compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). diff --git a/lib/wx/src/gen/wxPostScriptDC.erl b/lib/wx/src/gen/wxPostScriptDC.erl index 07764bca74..eb315341f1 100644 --- a/lib/wx/src/gen/wxPostScriptDC.erl +++ b/lib/wx/src/gen/wxPostScriptDC.erl @@ -54,7 +54,8 @@ startPage/1]). -export_type([wxPostScriptDC/0]). --deprecated([getResolution/0,setResolution/1]). +-deprecated([{getResolution,0,"not available in wxWidgets-2.9 and later"}, + {setResolution,1,"not available in wxWidgets-2.9 and later"}]). -compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). diff --git a/lib/wx/src/gen/wxWindowDC.erl b/lib/wx/src/gen/wxWindowDC.erl index 9b1045b84d..04856786a8 100644 --- a/lib/wx/src/gen/wxWindowDC.erl +++ b/lib/wx/src/gen/wxWindowDC.erl @@ -54,7 +54,7 @@ startPage/1]). -export_type([wxWindowDC/0]). --deprecated([new/0]). +-deprecated([{new,0,"not available in wxWidgets-2.9 and later"}]). -compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]). diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl index 181206c762..81d188b26a 100644 --- a/lib/wx/src/wx_object.erl +++ b/lib/wx/src/wx_object.erl @@ -117,12 +117,16 @@ start_link/3, start_link/4, stop/1, stop/3, call/2, call/3, + send_request/2, wait_response/1, wait_response/2, check_response/2, cast/2, reply/2, get_pid/1, set_pid/2 ]). +-type request_id() :: term(). +-type server_ref() :: Obj::wx:wx_object()|atom()|pid(). + %% -export([behaviour_info/1]). -callback init(Args :: term()) -> {#wx_ref{}, State :: term()} | {#wx_ref{}, State :: term(), timeout() | 'hibernate'} | @@ -317,6 +321,34 @@ call(Name, Request, Timeout) when is_atom(Name) orelse is_pid(Name) -> erlang:error({Reason, {?MODULE, call, [Name, Request, Timeout]}}) end. +%% @doc Make an send_request to a generic server. +%% and return a RequestId which can/should be used with wait_response/[1|2]. +%% Invokes handle_call(Request, From, State) in server. +-spec send_request(Obj, Request::term()) -> request_id() when + Obj::wx:wx_object()|atom()|pid(). +send_request(#wx_ref{state=Pid}, Request) -> + gen:send_request(Pid, '$gen_call', Request); +send_request(Pid, Request) when is_atom(Pid) orelse is_pid(Pid) -> + gen:send_request(Pid, '$gen_call', Request). + +%% @doc Wait infinitely for a reply from a generic server. +-spec wait_response(RequestId::request_id()) -> + {reply, Reply::term()} | {error, {term(), server_ref()}}. +wait_response(RequestId) -> + gen:wait_response(RequestId, infinity). + +%% @doc Wait 'timeout' for a reply from a generic server. +-spec wait_response(Key::request_id(), timeout()) -> + {reply, Reply::term()} | 'timeout' | {error, {term(), server_ref()}}. +wait_response(RequestId, Timeout) -> + gen:wait_response(RequestId, Timeout). + +%% @doc Check if a received message was a reply to a RequestId +-spec check_response(Msg::term(), Key::request_id()) -> + {reply, Reply::term()} | 'false' | {error, {term(), server_ref()}}. +check_response(Msg, RequestId) -> + gen:check_response(Msg, RequestId). + %% @doc Make a cast to a wx_object server. %% Invokes handle_cast(Request, State) in the server -spec cast(Obj, Request) -> ok when diff --git a/lib/wx/test/wx_basic_SUITE.erl b/lib/wx/test/wx_basic_SUITE.erl index ad03a378de..433b705673 100644 --- a/lib/wx/test/wx_basic_SUITE.erl +++ b/lib/wx/test/wx_basic_SUITE.erl @@ -394,10 +394,19 @@ wx_object(Config) -> {call, {Frame,Panel}, _} = wx_object:call(Frame, fun(US) -> US end), ?m(false, wxWindow:getParent(Panel) =:= Frame), ?m(true, wx:equal(wxWindow:getParent(Panel),Frame)), + flush(), + ReqId = wx_object:send_request(Frame, fun(_US) -> timer:sleep(10), yes end), + timeout = wx_object:wait_response(ReqId, 0), + {reply, {call, yes, {Me,{_,ReqId}}}} = wx_object:wait_response(ReqId, 1000), + ReqId2 = wx_object:send_request(Frame, yes), + [Msg] = flush(), + no_reply = wx_object:check_response(Msg, ReqId), + {reply, {call, yes, {Me,{_,ReqId2}}}} = wx_object:check_response(Msg, ReqId2), + FramePid = wx_object:get_pid(Frame), io:format("wx_object pid ~p~n",[FramePid]), FramePid ! foo3, - ?m([{info, foo3}|_], flush()), + ?m([{info, foo3}], flush()), ?m(ok, wx_object:cast(Frame, fun(_) -> hehe end)), ?m([{cast, hehe}|_], flush()), diff --git a/lib/xmerl/Makefile b/lib/xmerl/Makefile index a584aacbac..65a0af9e4a 100644 --- a/lib/xmerl/Makefile +++ b/lib/xmerl/Makefile @@ -50,12 +50,7 @@ SPECIAL_TARGETS = include $(ERL_TOP)/make/otp_subdir.mk -.PHONY: info version - -info: - @echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)" - @echo "APP_DIR: $(APP_DIR)" - @echo "APP_TAR_FILE: $(APP_TAR_FILE)" +.PHONY: version version: @echo "$(VSN)" @@ -97,3 +92,4 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/xmerl/doc/src/Makefile b/lib/xmerl/doc/src/Makefile index 0def492246..5effc831e2 100644 --- a/lib/xmerl/doc/src/Makefile +++ b/lib/xmerl/doc/src/Makefile @@ -28,33 +28,19 @@ VSN=$(XMERL_VSN) APPLICATION=xmerl # ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- -# Help application directory specification -# ---------------------------------------------------- - -EDOC_DIR = $(ERL_TOP)/lib/edoc -SYNTAX_TOOLS_DIR = $(ERL_TOP)/lib/syntax_tools - -# ---------------------------------------------------- # Target Specs # ---------------------------------------------------- XMERL_DIR = $(ERL_TOP)/lib/$(APPLICATION)/src -XMERL_MODULES = \ - xmerl_scan \ - xmerl \ - xmerl_xs \ - xmerl_eventp \ - xmerl_xpath \ - xmerl_xsd - +EDOC_REF3_FILES = \ + xmerl_scan.xml \ + xmerl.xml \ + xmerl_xs.xml \ + xmerl_eventp.xml \ + xmerl_xpath.xml \ + xmerl_xsd.xml XML_APPLICATION_FILES = ref_man.xml -XMERL_XML_FILES = $(XMERL_MODULES:%=$(XMLDIR)/%.xml) XML_REF3_FILES = xmerl_sax_parser.xml @@ -85,97 +71,15 @@ EXAMPLE_FILES = people2.txt people.txt motorcycles.txt motorcycles_dtd.txt \ new_motorcycles.txt new_motorcycles2.txt result_export.html \ motorcycles2.txt result_xs.html motorcycles2html.erl +HTML_EXTRA_FILES = $(EXAMPLE_FILES) $(HTML_EXAMPLE_FILES) $(HTML_STYLESHEET_FILES) + XML_FILES= \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) -XML_GEN_FILES = $(XMERL_XML_FILES) $(XML_CHAPTER_GEN_FILES) - -# ---------------------------------------------------- -INFO_FILE = ../../info - -HTML_FILES = $(XML_REF_MAN:%.xml=$(HTMLDIR)/%.html) \ - $(XML_HTML_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) $(XMERL_MODULES:%=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -$(XMERL_XML_FILES): - $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -dir $(XMLDIR) $(XMERL_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) - -man: $(MAN3_FILES) $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -xml: $(XMERL_XML_FILES) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(MAN6DIR)/* - rm -f $(XMERL_XML_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - - -info: - @echo "XML_PART_FILES: $(XML_PART_FILES)" - @echo "XML_APPLICATION_FILES: $(XML_APPLICATION_FILES)" - @echo "XMERL_XML_FILES: $(XMERL_XML_FILES)" - @echo "XMERL_MODULES: $(XMERL_MODULES)" - @echo "HTML_FILES: $(HTML_FILES)" - @echo "HTMLDIR: $(HTMLDIR)" - @echo "DEFAULT_GIF_FILES: $(DEFAULT_GIF_FILES)" - @echo "DEFAULT_HTML_FILES: $(DEFAULT_HTML_FILES)" +XML_GEN_FILES = $(XML_CHAPTER_GEN_FILES) # ---------------------------------------------------- # Release Target # ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(EXAMPLE_FILES) $(HTML_EXAMPLE_FILES) $(HTML_STYLESHEET_FILES) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: - - - -release_tests_spec: +include $(ERL_TOP)/make/doc.mk diff --git a/lib/xmerl/doc/src/xmerl_sax_parser.xml b/lib/xmerl/doc/src/xmerl_sax_parser.xml index 2390779028..0c5ecb5c2e 100644 --- a/lib/xmerl/doc/src/xmerl_sax_parser.xml +++ b/lib/xmerl/doc/src/xmerl_sax_parser.xml @@ -56,7 +56,7 @@ <taglist> <tag><c>{continuation_fun, ContinuationFun}</c></tag> <item> - <seealso marker="#ContinuationFun/1">ContinuationFun</seealso> is a call back function to decide what to do if + <seealso marker="#Module:ContinuationFun/1">ContinuationFun</seealso> is a call back function to decide what to do if the parser runs into EOF before the document is complete. </item> <tag><c>{continuation_state, term()}</c></tag> @@ -65,7 +65,7 @@ </item> <tag><c>{event_fun, EventFun}</c></tag> <item> - <seealso marker="#EventFun/3">EventFun</seealso> is the call back function for parser events. + <seealso marker="#Module:EventFun/3">EventFun</seealso> is the call back function for parser events. </item> <tag><c>{event_state, term()}</c></tag> <item> @@ -381,7 +381,7 @@ <funcs> <func> - <name since="">ContinuationFun(State) -> {NewBytes, NewState}</name> + <name since="">Module:ContinuationFun(State) -> {NewBytes, NewState}</name> <fsummary>Continuation call back function.</fsummary> <type> <v>State = NewState = term()</v> @@ -402,7 +402,7 @@ </func> <func> - <name since="">EventFun(Event, Location, State) -> NewState</name> + <name since="">Module:EventFun(Event, Location, State) -> NewState</name> <fsummary>Event call back function.</fsummary> <type> <v>Event = event()</v> |
